c734fc04187a953fc077bdb2e55d1a28b5101b18
[packages/transformers.git] / Data / Functor / Classes.hs
1 {-# LANGUAGE CPP #-}
2 #if __GLASGOW_HASKELL__ >= 709
3 {-# LANGUAGE AutoDeriveTypeable #-}
4 #endif
5 -----------------------------------------------------------------------------
6 -- |
7 -- Module : Data.Functor.Classes
8 -- Copyright : (c) Ross Paterson 2013
9 -- License : BSD-style (see the file LICENSE)
10 --
11 -- Maintainer : R.Paterson@city.ac.uk
12 -- Stability : experimental
13 -- Portability : portable
14 --
15 -- Liftings of the Prelude classes 'Eq', 'Ord', 'Read' and 'Show' to
16 -- unary and binary type constructors.
17 --
18 -- These classes are needed to express the constraints on arguments of
19 -- transformers in portable Haskell. Thus for a new transformer @T@,
20 -- one might write instances like
21 --
22 -- > instance (Eq1 f) => Eq1 (T f) where ...
23 -- > instance (Ord1 f) => Ord1 (T f) where ...
24 -- > instance (Read1 f) => Read1 (T f) where ...
25 -- > instance (Show1 f) => Show1 (T f) where ...
26 --
27 -- If these instances can be defined, defining instances of the base
28 -- classes is mechanical:
29 --
30 -- > instance (Eq1 f, Eq a) => Eq (T f a) where (==) = eq1
31 -- > instance (Ord1 f, Ord a) => Ord (T f a) where compare = compare1
32 -- > instance (Read1 f, Read a) => Read (T f a) where readsPrec = readsPrec1
33 -- > instance (Show1 f, Show a) => Show (T f a) where showsPrec = showsPrec1
34 --
35 -----------------------------------------------------------------------------
36
37 module Data.Functor.Classes (
38 -- * Liftings of Prelude classes
39 -- ** For unary constructors
40 Eq1(..),
41 Ord1(..),
42 Read1(..),
43 Show1(..),
44 -- ** For binary constructors
45 Eq2(..),
46 Ord2(..),
47 Read2(..),
48 Show2(..),
49 -- * Helper functions
50 -- $example
51 readsData,
52 readsUnaryWith,
53 readsBinaryWith,
54 showsUnaryWith,
55 showsBinaryWith,
56 -- ** Obsolete helpers
57 readsUnary,
58 readsUnary1,
59 readsBinary1,
60 showsUnary,
61 showsUnary1,
62 showsBinary1,
63 ) where
64
65 import Control.Applicative (Const(Const))
66 import Data.Functor.Identity (Identity(Identity))
67
68 -- | Lifting of the 'Eq' class to unary type constructors.
69 class Eq1 f where
70 -- | Lift an equality test through the type constructor.
71 eqWith :: (a -> a -> Bool) -> f a -> f a -> Bool
72
73 -- | Lift the standard @('==')@ function through the type constructor.
74 eq1 :: (Eq a) => f a -> f a -> Bool
75 eq1 = eqWith (==)
76
77 -- | Lifting of the 'Ord' class to unary type constructors.
78 class (Eq1 f) => Ord1 f where
79 -- | Lift a 'compare' function through the type constructor.
80 compareWith :: (a -> a -> Ordering) -> f a -> f a -> Ordering
81
82 -- | Lift the standard 'compare' function through the type constructor.
83 compare1 :: (Ord a) => f a -> f a -> Ordering
84 compare1 = compareWith compare
85
86 -- | Lifting of the 'Read' class to unary type constructors.
87 class Read1 f where
88 -- | Lift a 'readsPrec' function through the type constructor.
89 readsPrecWith :: (Int -> ReadS a) -> Int -> ReadS (f a)
90
91 -- | Lift the standard 'readsPrec' function through the type constructor.
92 readsPrec1 :: (Read a) => Int -> ReadS (f a)
93 readsPrec1 = readsPrecWith readsPrec
94
95 -- | Lifting of the 'Show' class to unary type constructors.
96 class Show1 f where
97 -- | Lift a 'showsPrec' function through the type constructor.
98 showsPrecWith :: (Int -> a -> ShowS) -> Int -> f a -> ShowS
99
100 -- | Lift the standard 'showsPrec' function through the type constructor.
101 showsPrec1 :: (Show a) => Int -> f a -> ShowS
102 showsPrec1 = showsPrecWith showsPrec
103
104 -- | Lifting of the 'Eq' class to binary type constructors.
105 class Eq2 f where
106 -- | Lift equality tests through the type constructor.
107 eqWith2 :: (a -> a -> Bool) -> (b -> b -> Bool) -> f a b -> f a b -> Bool
108
109 -- | Lift the standard @('==')@ function through the type constructor.
110 eq2 :: (Eq a, Eq b) => f a b -> f a b -> Bool
111 eq2 = eqWith2 (==) (==)
112
113 -- | Lifting of the 'Ord' class to binary type constructors.
114 class (Eq2 f) => Ord2 f where
115 -- | Lift 'compare' functions through the type constructor.
116 compareWith2 :: (a -> a -> Ordering) -> (b -> b -> Ordering) ->
117 f a b -> f a b -> Ordering
118
119 -- | Lift the standard 'compare' function through the type constructor.
120 compare2 :: (Ord a, Ord b) => f a b -> f a b -> Ordering
121 compare2 = compareWith2 compare compare
122
123 -- | Lifting of the 'Read' class to binary type constructors.
124 class Read2 f where
125 -- | Lift 'readsPrec' functions through the type constructor.
126 readsPrecWith2 :: (Int -> ReadS a) -> (Int -> ReadS b) ->
127 Int -> ReadS (f a b)
128
129 -- | Lift the standard 'readsPrec' function through the type constructor.
130 readsPrec2 :: (Read a, Read b) => Int -> ReadS (f a b)
131 readsPrec2 = readsPrecWith2 readsPrec readsPrec
132
133 -- | Lifting of the 'Show' class to binary type constructors.
134 class Show2 f where
135 -- | Lift 'showsPrec' functions through the type constructor.
136 showsPrecWith2 :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) ->
137 Int -> f a b -> ShowS
138
139 -- | Lift the standard 'showsPrec' function through the type constructor.
140 showsPrec2 :: (Show a, Show b) => Int -> f a b -> ShowS
141 showsPrec2 = showsPrecWith2 showsPrec showsPrec
142
143 -- Instances for Prelude type constructors
144
145 instance Eq1 Maybe where
146 eqWith _ Nothing Nothing = True
147 eqWith _ Nothing (Just _) = False
148 eqWith _ (Just _) Nothing = False
149 eqWith eq (Just x) (Just y) = eq x y
150
151 instance Ord1 Maybe where
152 compareWith _ Nothing Nothing = EQ
153 compareWith _ Nothing (Just _) = LT
154 compareWith _ (Just _) Nothing = GT
155 compareWith comp (Just x) (Just y) = comp x y
156
157 instance Read1 Maybe where
158 readsPrecWith rp d =
159 readParen False (\ r -> [(Nothing,s) | ("Nothing",s) <- lex r])
160 `mappend`
161 readsData (readsUnaryWith rp "Just" Just) d
162
163 instance Show1 Maybe where
164 showsPrecWith _ _ Nothing = showString "Nothing"
165 showsPrecWith sp d (Just x) = showsUnaryWith sp "Just" d x
166
167 instance Eq1 [] where
168 eqWith _ [] [] = True
169 eqWith _ [] (_:_) = False
170 eqWith _ (_:_) [] = False
171 eqWith eq (x:xs) (y:ys) = eq x y && eqWith eq xs ys
172
173 instance Ord1 [] where
174 compareWith _ [] [] = EQ
175 compareWith _ [] (_:_) = LT
176 compareWith _ (_:_) [] = GT
177 compareWith comp (x:xs) (y:ys) = comp x y `mappend` compareWith comp xs ys
178
179 instance Read1 [] where
180 readsPrecWith rp _ = readParen False $ \ r ->
181 [pr | ("[",s) <- lex r, pr <- readl s]
182 where
183 readl s = [([],t) | ("]",t) <- lex s] ++
184 [(x:xs,u) | (x,t) <- rp 0 s, (xs,u) <- readl' t]
185 readl' s = [([],t) | ("]",t) <- lex s] ++
186 [(x:xs,v) | (",",t) <- lex s, (x,u) <- rp 0 t, (xs,v) <- readl' u]
187
188
189 instance Show1 [] where
190 showsPrecWith sp _ [] = showString "[]"
191 showsPrecWith sp _ (x:xs) = showChar '[' . sp 0 x . showl xs
192 where
193 showl [] = showChar ']'
194 showl (x:xs) = showChar ',' . sp 0 x . showl xs
195
196 instance Eq2 (,) where
197 eqWith2 eq1 eq2 (x1, y1) (x2, y2) = eq1 x1 x2 && eq2 y1 y2
198
199 instance Ord2 (,) where
200 compareWith2 comp1 comp2 (x1, y1) (x2, y2) =
201 comp1 x1 x2 `mappend` comp2 y1 y2
202
203 instance Read2 (,) where
204 readsPrecWith2 rp1 rp2 _ = readParen False $ \ r ->
205 [((x,y), w) | ("(",s) <- lex r,
206 (x,t) <- rp1 0 s,
207 (",",u) <- lex t,
208 (y,v) <- rp2 0 u,
209 (")",w) <- lex v]
210
211 instance Show2 (,) where
212 showsPrecWith2 sp1 sp2 _ (x, y) =
213 showChar '(' . sp1 0 x . showChar ',' . sp2 0 y . showChar ')'
214
215 instance (Eq a) => Eq1 ((,) a) where
216 eqWith = eqWith2 (==)
217
218 instance (Ord a) => Ord1 ((,) a) where
219 compareWith = compareWith2 compare
220
221 instance (Read a) => Read1 ((,) a) where
222 readsPrecWith = readsPrecWith2 readsPrec
223
224 instance (Show a) => Show1 ((,) a) where
225 showsPrecWith = showsPrecWith2 showsPrec
226
227 instance Eq2 Either where
228 eqWith2 eq1 _ (Left x) (Left y) = eq1 x y
229 eqWith2 _ _ (Left _) (Right _) = False
230 eqWith2 _ _ (Right _) (Left _) = False
231 eqWith2 _ eq2 (Right x) (Right y) = eq2 x y
232
233 instance Ord2 Either where
234 compareWith2 comp1 _ (Left x) (Left y) = comp1 x y
235 compareWith2 _ _ (Left _) (Right _) = LT
236 compareWith2 _ _ (Right _) (Left _) = GT
237 compareWith2 _ comp2 (Right x) (Right y) = comp2 x y
238
239 instance Read2 Either where
240 readsPrecWith2 rp1 rp2 = readsData $
241 readsUnaryWith rp1 "Left" Left `mappend`
242 readsUnaryWith rp2 "Right" Right
243
244 instance Show2 Either where
245 showsPrecWith2 sp1 _ d (Left x) = showsUnaryWith sp1 "Left" d x
246 showsPrecWith2 _ sp2 d (Right x) = showsUnaryWith sp2 "Right" d x
247
248 instance (Eq a) => Eq1 (Either a) where
249 eqWith = eqWith2 (==)
250
251 instance (Ord a) => Ord1 (Either a) where
252 compareWith = compareWith2 compare
253
254 instance (Read a) => Read1 (Either a) where
255 readsPrecWith = readsPrecWith2 readsPrec
256
257 instance (Show a) => Show1 (Either a) where
258 showsPrecWith = showsPrecWith2 showsPrec
259
260 -- Instances for other functors defined in the base package
261
262 instance Eq1 Identity where
263 eqWith eq (Identity x) (Identity y) = eq x y
264
265 instance Ord1 Identity where
266 compareWith comp (Identity x) (Identity y) = comp x y
267
268 instance Read1 Identity where
269 readsPrecWith rp = readsData $
270 readsUnaryWith rp "Identity" Identity
271
272 instance Show1 Identity where
273 showsPrecWith sp d (Identity x) = showsUnaryWith sp "Identity" d x
274
275 instance Eq2 Const where
276 eqWith2 eq _ (Const x) (Const y) = eq x y
277
278 instance Ord2 Const where
279 compareWith2 comp _ (Const x) (Const y) = comp x y
280
281 instance Read2 Const where
282 readsPrecWith2 rp _ = readsData $
283 readsUnaryWith rp "Const" Const
284
285 instance Show2 Const where
286 showsPrecWith2 sp _ d (Const x) = showsUnaryWith sp "Const" d x
287
288 instance (Eq a) => Eq1 (Const a) where
289 eqWith = eqWith2 (==)
290 instance (Ord a) => Ord1 (Const a) where
291 compareWith = compareWith2 compare
292 instance (Read a) => Read1 (Const a) where
293 readsPrecWith = readsPrecWith2 readsPrec
294 instance (Show a) => Show1 (Const a) where
295 showsPrecWith = showsPrecWith2 showsPrec
296
297 -- Building blocks
298
299 -- | @'readsData' p d@ is a parser for datatypes where each alternative
300 -- begins with a data constructor. It parses the constructor and
301 -- passes it to @p@. Parsers for various constructors can be constructed
302 -- with 'readsUnary', 'readsUnary1' and 'readsBinary1', and combined with
303 -- @mappend@ from the @Monoid@ class.
304 readsData :: (String -> ReadS a) -> Int -> ReadS a
305 readsData reader d =
306 readParen (d > 10) $ \ r -> [res | (kw,s) <- lex r, res <- reader kw s]
307
308 -- | @'readsUnaryWith' rp n c n'@ matches the name of a unary data constructor
309 -- and then parses its argument using @rp@.
310 readsUnaryWith :: (Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
311 readsUnaryWith rp name cons kw s =
312 [(cons x,t) | kw == name, (x,t) <- rp 11 s]
313
314 -- | @'readsBinaryWith' rp1 rp2 n c n'@ matches the name of a binary
315 -- data constructor and then parses its arguments using @rp1@ and @rp2@
316 -- respectively.
317 readsBinaryWith :: (Int -> ReadS a) -> (Int -> ReadS b) ->
318 String -> (a -> b -> t) -> String -> ReadS t
319 readsBinaryWith rp1 rp2 name cons kw s =
320 [(cons x y,u) | kw == name, (x,t) <- rp1 11 s, (y,u) <- rp2 11 t]
321
322 -- | @'showsUnaryWith' sp n d x@ produces the string representation of a
323 -- unary data constructor with name @n@ and argument @x@, in precedence
324 -- context @d@.
325 showsUnaryWith :: (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
326 showsUnaryWith sp name d x = showParen (d > 10) $
327 showString name . showChar ' ' . sp 11 x
328
329 -- | @'showsBinaryWith' sp1 sp2 n d x y@ produces the string
330 -- representation of a binary data constructor with name @n@ and arguments
331 -- @x@ and @y@, in precedence context @d@.
332 showsBinaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) ->
333 String -> Int -> a -> b -> ShowS
334 showsBinaryWith sp1 sp2 name d x y = showParen (d > 10) $
335 showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y
336
337 -- Obsolete building blocks
338
339 -- | @'readsUnary' n c n'@ matches the name of a unary data constructor
340 -- and then parses its argument using 'readsPrec'.
341 {-# DEPRECATED readsUnary "Use readsUnaryWith to define readsPrecWith" #-}
342 readsUnary :: (Read a) => String -> (a -> t) -> String -> ReadS t
343 readsUnary name cons kw s =
344 [(cons x,t) | kw == name, (x,t) <- readsPrec 11 s]
345
346 -- | @'readsUnary1' n c n'@ matches the name of a unary data constructor
347 -- and then parses its argument using 'readsPrec1'.
348 {-# DEPRECATED readsUnary1 "Use readsUnaryWith to define readsPrecWith" #-}
349 readsUnary1 :: (Read1 f, Read a) => String -> (f a -> t) -> String -> ReadS t
350 readsUnary1 name cons kw s =
351 [(cons x,t) | kw == name, (x,t) <- readsPrec1 11 s]
352
353 -- | @'readsBinary1' n c n'@ matches the name of a binary data constructor
354 -- and then parses its arguments using 'readsPrec1'.
355 {-# DEPRECATED readsBinary1 "Use readsBinaryWith to define readsPrecWith" #-}
356 readsBinary1 :: (Read1 f, Read1 g, Read a) =>
357 String -> (f a -> g a -> t) -> String -> ReadS t
358 readsBinary1 name cons kw s =
359 [(cons x y,u) | kw == name,
360 (x,t) <- readsPrec1 11 s, (y,u) <- readsPrec1 11 t]
361
362 -- | @'showsUnary' n d x@ produces the string representation of a unary data
363 -- constructor with name @n@ and argument @x@, in precedence context @d@.
364 {-# DEPRECATED showsUnary "Use showsUnaryWith to define showsPrecWith" #-}
365 showsUnary :: (Show a) => String -> Int -> a -> ShowS
366 showsUnary name d x = showParen (d > 10) $
367 showString name . showChar ' ' . showsPrec 11 x
368
369 -- | @'showsUnary1' n d x@ produces the string representation of a unary data
370 -- constructor with name @n@ and argument @x@, in precedence context @d@.
371 {-# DEPRECATED showsUnary1 "Use showsUnaryWith to define showsPrecWith" #-}
372 showsUnary1 :: (Show1 f, Show a) => String -> Int -> f a -> ShowS
373 showsUnary1 name d x = showParen (d > 10) $
374 showString name . showChar ' ' . showsPrec1 11 x
375
376 -- | @'showsBinary1' n d x y@ produces the string representation of a binary
377 -- data constructor with name @n@ and arguments @x@ and @y@, in precedence
378 -- context @d@.
379 {-# DEPRECATED showsBinary1 "Use showsBinaryWith to define showsPrecWith" #-}
380 showsBinary1 :: (Show1 f, Show1 g, Show a) =>
381 String -> Int -> f a -> g a -> ShowS
382 showsBinary1 name d x y = showParen (d > 10) $
383 showString name . showChar ' ' . showsPrec1 11 x .
384 showChar ' ' . showsPrec1 11 y
385
386 {- $example
387 These functions can be used to assemble 'Read' and 'Show' instances for
388 new algebraic types. For example, given the definition
389
390 > data T f a = Zero a | One (f a) | Two a (f a)
391
392 a standard 'Read1' instance may be defined as
393
394 > instance (Read1 f) => Read1 (T f) where
395 > readsPrecWith rp = readsData $
396 > readsUnaryWith rp "Zero" Zero `mappend`
397 > readsUnaryWith (readsPrecWith rp) "One" One `mappend`
398 > readsBinaryWith rp (readsPrecWith rp) "Two" Two
399
400 and the corresponding 'Show1' instance as
401
402 > instance (Show1 f) => Show1 (T f) where
403 > showsPrecWith sp d (Zero x) =
404 > showsUnaryWith sp "Zero" d x
405 > showsPrecWith sp d (One x) =
406 > showsUnaryWith (showsPrecWith sp) "One" d x
407 > showsPrecWith sp d (Two x y) =
408 > showsBinaryWith sp (showsPrecWith sp) "Two" d x y
409
410 -}