/ src / Generics / Pointless /
src/Generics/Pointless/Functors.hs
1
2 -----------------------------------------------------------------------------
3 -- |
4 -- Module : Generics.Pointless.Functors
5 -- Copyright : (c) 2008 University of Minho
6 -- License : BSD3
7 --
8 -- Maintainer : hpacheco@di.uminho.pt
9 -- Stability : experimental
10 -- Portability : non-portable
11 --
12 -- Pointless Haskell:
13 -- point-free programming with recursion patterns as hylomorphisms
14 --
15 -- This module defines data types as fixed points of functor.
16 -- Pointless Haskell works on a view of data types as fixed points of functors, in the same style as the PolyP (<http://www.cse.chalmers.se/~patrikj/poly/polyp/>) library.
17 -- Instead of using an explicit fixpoint operator, a type function is used to relate the data types with their equivalent functor representations.
18 --
19 -----------------------------------------------------------------------------
20
21 module Generics.Pointless.Functors where
22
23 import Generics.Pointless.Combinators
24 import Prelude hiding (Functor(..))
25
26 -- * Functors
27
28 -- ** Definition and operations over functors
29
30 -- | Identity functor.
31 newtype Id x = Id {unId :: x}
32
33 -- | Constant functor.
34 newtype Const t x = Const {unConst :: t}
35
36 -- | Sum of functors.
37 infixr 5 :+:
38 data (g :+: h) x = Inl (g x) | Inr (h x)
39
40 -- | Product of functors.
41 infixr 6 :*:
42 data (g :*: h) x = g x :*: h x
43
44 -- | Composition of functors.
45 infixr 9 :@:
46 newtype (g :@: h) x = Comp {unComp :: g (h x)}
47
48 -- | Explicit fixpoint operator.
49 newtype Fix f = Fix { -- | The unfolding of the fixpoint of a functor is a the functor applied to its fixpoint.
50 --
51 -- 'unFix' is specialized with the application of 'Rep' in order to subsume functor application
52 unFix :: Rep f (Fix f)
53 }
54
55 instance Show (Rep f (Fix f)) => Show (Fix f) where
56 show (Fix f) = "(Fix " ++ show f ++ ")"
57
58 -- | Family of patterns functors of data types.
59 --
60 -- The type function is not necessarily injective, this is, different data types can have the same base functor.
61 type family PF a :: * -> *
62 -- ^ Semantically, we can say that @a = 'Fix' f@.
63
64 type instance PF (Fix f) = f
65 -- ^ The pattern functor of the fixpoint of a functor is the functor itself.
66
67 -- | Family of functor representations.
68 --
69 -- The 'Rep' family implements the implicit coercion between the application of a functor and the structurally equivalent sum of products.
70 type family Rep (f :: * -> *) x :: *
71 -- ^ Functors applied to types can be represented as sums of products.
72
73 type instance Rep Id x = x
74 -- ^ The identity functor applied to some type is the type itself.
75
76 type instance Rep (Const t) x = t
77 -- ^ The constant functor applied to some type is the type parameterized by the functor.
78
79 type instance Rep (g :+: h) x = Rep g x `Either` Rep h x
80 -- ^ The application of a sum of functors to some type is the sum of applying the functors to the argument type.
81
82 type instance Rep (g :*: h) x = (Rep g x,Rep h x)
83 -- ^ The application of a product of functors to some type is the product of applying the functors to the argument type.
84
85 type instance Rep (g :@: h) x = Rep g (Rep h x)
86 -- ^ The application of a composition of functors to some type is the nested application of the functors to the argument type.
87 --
88 -- This particular instance requires that nexted type function application is enabled as a type system extension.
89
90 type instance Rep [] x = [x]
91 -- ^ The application of the list functor to some type returns a list of the argument type.
92
93 -- | Polytypic 'Prelude.Functor' class for functor representations
94 class Functor (f :: * -> *) where
95 fmap :: Fix f -- ^ For desambiguation purposes, the type of the functor must be passed as an explicit paramaeter to 'fmap'
96 -> (x -> y) -> Rep f x -> Rep f y -- ^ The mapping over representations
97
98 instance Functor Id where
99 fmap _ f = f
100 -- ^ The identity functor applies the mapping function the argument type
101
102 instance Functor (Const t) where
103 fmap _ f = id
104 -- ^ The constant functor preserves the argument type
105
106 instance (Functor g,Functor h) => Functor (g :+: h) where
107 fmap _ f (Left x) = Left (fmap (_L :: Fix g) f x)
108 fmap _ f (Right x) = Right (fmap (_L :: Fix h) f x)
109 -- ^ The sum functor recursively applies the mapping function to each alternative
110
111 instance (Functor g,Functor h) => Functor (g :*: h) where
112 fmap _ f (x,y) = (fmap (_L :: Fix g) f x,fmap (_L :: Fix h) f y)
113 -- ^ The product functor recursively applies the mapping function to both sides
114
115 instance (Functor g,Functor h) => Functor (g :@: h) where
116 fmap _ f x = fmap (_L :: Fix g) (fmap (_L :: Fix h) f) x
117 -- ^ The composition functor applies in the nesting of the mapping function to the nested functor applications
118
119 instance Functor [] where
120 fmap _ f l = map f l
121 -- ^ The list functor maps the specific 'map' function over lists of types
122
123 -- | Short alias to express the structurally equivalent sum of products for some data type
124 type F a x = Rep (PF a) x
125
126 -- | Polytypic map function
127 pmap :: Functor (PF a) => a -- ^ A value of a data type that is the fixed point of the desired functor
128 -> (x -> y) -> F a x -> F a y -- ^ The mapping over the equivalent sum of products
129 pmap (_::a) f = fmap (_L :: Fix (PF a)) f
130
131 -- | The 'Mu' class provides the value-level translation between data types and their sum of products representations
132 class Mu a where
133 -- | Packs a sum of products into one equivalent data type
134 inn :: F a a -> a
135 -- | unpacks a data type into the equivalent sum of products
136 out :: a -> F a a
137
138 instance Mu (Fix f) where
139 inn = Fix
140 out = unFix
141 -- ^ Expanding/contracting the fixed point of a functor is the same as consuming/applying it's single type constructor
142
143 -- ** Fixpoint combinators
144
145 -- | In order to simplify type-level composition of functors, we can create fixpoint combinators that implicitely assume fixpoint application.
146
147 data I = FixId
148 -- ^ Semantically, we can say that @'I' = 'Fix' 'Id'@.
149 type instance PF I = Id
150
151 instance Mu I where
152 inn = id
153 out = id
154
155 data K a = FixConst {unFixConst :: a}
156 -- ^ Semantically, we can say that @'K' t = 'Fix' ('Const' t)@.
157 type instance PF (K a) = Const a
158
159 instance Mu (K a) where
160 inn = FixConst
161 out = unFixConst
162
163 infixr 5 :+!:
164 data (a :+!: b) = FixSum {unFixSum :: F (a :+!: b) (a :+!: b)}
165 -- ^ Semantically, we can say that @'Fix' f :+!: 'Fix' g = 'Fix' (f :+: g)@.
166 type instance PF (a :+!: b) = PF a :+: PF b
167
168 instance Mu (a :+!: b) where
169 inn = FixSum
170 out = unFixSum
171
172 infixr 6 :*!:
173 data (a :*!: b) = FixProd {unFixProd :: F (a :*!: b) (a :*!: b)}
174 -- ^ Semantically, we can say that @'Fix' f :*!: 'Fix' g = 'Fix' (f :*: g)@.
175 type instance PF (a :*!: b) = PF a :*: PF b
176
177 instance Mu (a :*!: b) where
178 inn = FixProd
179 out = unFixProd
180
181 infixr 9 :@!:
182 data (a :@!: b) = FixComp {unFixComp :: F (a :@!: b) (a :@!: b)}
183 -- ^ Semantically, we can say that @'Fix' f :\@!: 'Fix' g = 'Fix' (f ':\@: g)@.
184 type instance PF (a :@!: b) = PF a :@: PF b
185
186 instance Mu (a :@!: b) where
187 inn = FixComp
188 out = unFixComp
189
190 -- * Default definitions for commonly used data types
191
192 -- ** List
193
194 type instance PF [a] = Const One :+: Const a :*: Id
195
196 instance Mu [a] where
197 inn (Left _) = []
198 inn (Right (x,xs)) = x:xs
199 out [] = Left _L
200 out (x:xs) = Right (x,xs)
201
202 nil :: One -> [a]
203 nil = inn . inl
204
205 cons :: (a,[a]) -> [a]
206 cons = inn . inr
207
208 -- ** Int
209
210 type instance PF Int = Const One :+: Id
211
212 instance (Mu Int) where
213 inn (Left _) = 0
214 inn (Right n) = succ n
215 out 0 = Left _L
216 out n = Right (pred n)
217
218 zero :: One -> Int
219 zero = inn . inl
220
221 suck :: Int -> Int
222 suck = inn . inr
223
224 -- ** Bool
225
226 type instance PF Bool = Const One :+: Const One
227
228 instance Mu Bool where
229 inn (Left _) = True
230 inn (Right _) = False
231 out True = Left _L
232 out False = Right _L
233
234 true :: One -> Bool
235 true = inn . inl
236
237 false :: One -> Bool
238 false = inn . inr
239
240 -- ** Maybe
241
242 type instance PF (Maybe a) = Const One :+: Const a
243
244 instance Mu (Maybe a) where
245 inn (Left _) = Nothing
246 inn (Right x) = Just x
247 out Nothing = Left _L
248 out (Just x) = Right x
249
250 maybe2bool :: Maybe a -> Bool
251 maybe2bool = inn . (id -|- bang) . out