1{-# LANGUAGE Safe #-}
2-----------------------------------------------------------------------------
3-- |
4-- Module      :  Data.Functor.Classes
5-- Copyright   :  (c) Ross Paterson 2013
6-- License     :  BSD-style (see the file LICENSE)
7--
8-- Maintainer  :  libraries@haskell.org
9-- Stability   :  experimental
10-- Portability :  portable
11--
12-- Liftings of the Prelude classes 'Eq', 'Ord', 'Read' and 'Show' to
13-- unary and binary type constructors.
14--
15-- These classes are needed to express the constraints on arguments of
16-- transformers in portable Haskell.  Thus for a new transformer @T@,
17-- one might write instances like
18--
19-- > instance (Eq1 f) => Eq1 (T f) where ...
20-- > instance (Ord1 f) => Ord1 (T f) where ...
21-- > instance (Read1 f) => Read1 (T f) where ...
22-- > instance (Show1 f) => Show1 (T f) where ...
23--
24-- If these instances can be defined, defining instances of the base
25-- classes is mechanical:
26--
27-- > instance (Eq1 f, Eq a) => Eq (T f a) where (==) = eq1
28-- > instance (Ord1 f, Ord a) => Ord (T f a) where compare = compare1
29-- > instance (Read1 f, Read a) => Read (T f a) where
30-- >   readPrec     = readPrec1
31-- >   readListPrec = readListPrecDefault
32-- > instance (Show1 f, Show a) => Show (T f a) where showsPrec = showsPrec1
33--
34-- @since 4.9.0.0
35-----------------------------------------------------------------------------
36
37module Data.Functor.Classes (
38    -- * Liftings of Prelude classes
39    -- ** For unary constructors
40    Eq1(..), eq1,
41    Ord1(..), compare1,
42    Read1(..), readsPrec1, readPrec1,
43    liftReadListDefault, liftReadListPrecDefault,
44    Show1(..), showsPrec1,
45    -- ** For binary constructors
46    Eq2(..), eq2,
47    Ord2(..), compare2,
48    Read2(..), readsPrec2, readPrec2,
49    liftReadList2Default, liftReadListPrec2Default,
50    Show2(..), showsPrec2,
51    -- * Helper functions
52    -- $example
53    readsData, readData,
54    readsUnaryWith, readUnaryWith,
55    readsBinaryWith, readBinaryWith,
56    showsUnaryWith,
57    showsBinaryWith,
58    -- ** Obsolete helpers
59    readsUnary,
60    readsUnary1,
61    readsBinary1,
62    showsUnary,
63    showsUnary1,
64    showsBinary1,
65  ) where
66
67import Control.Applicative (Alternative((<|>)), Const(Const))
68
69import Data.Functor.Identity (Identity(Identity))
70import Data.Proxy (Proxy(Proxy))
71import Data.List.NonEmpty (NonEmpty(..))
72import Data.Ord (Down(Down))
73
74import GHC.Read (expectP, list, paren)
75
76import Text.ParserCombinators.ReadPrec (ReadPrec, readPrec_to_S, readS_to_Prec)
77import Text.Read (Read(..), parens, prec, step)
78import Text.Read.Lex (Lexeme(..))
79import Text.Show (showListWith)
80
81-- | Lifting of the 'Eq' class to unary type constructors.
82--
83-- @since 4.9.0.0
84class Eq1 f where
85    -- | Lift an equality test through the type constructor.
86    --
87    -- The function will usually be applied to an equality function,
88    -- but the more general type ensures that the implementation uses
89    -- it to compare elements of the first container with elements of
90    -- the second.
91    --
92    -- @since 4.9.0.0
93    liftEq :: (a -> b -> Bool) -> f a -> f b -> Bool
94
95-- | Lift the standard @('==')@ function through the type constructor.
96--
97-- @since 4.9.0.0
98eq1 :: (Eq1 f, Eq a) => f a -> f a -> Bool
99eq1 = liftEq (==)
100
101-- | Lifting of the 'Ord' class to unary type constructors.
102--
103-- @since 4.9.0.0
104class (Eq1 f) => Ord1 f where
105    -- | Lift a 'compare' function through the type constructor.
106    --
107    -- The function will usually be applied to a comparison function,
108    -- but the more general type ensures that the implementation uses
109    -- it to compare elements of the first container with elements of
110    -- the second.
111    --
112    -- @since 4.9.0.0
113    liftCompare :: (a -> b -> Ordering) -> f a -> f b -> Ordering
114
115-- | Lift the standard 'compare' function through the type constructor.
116--
117-- @since 4.9.0.0
118compare1 :: (Ord1 f, Ord a) => f a -> f a -> Ordering
119compare1 = liftCompare compare
120
121-- | Lifting of the 'Read' class to unary type constructors.
122--
123-- Both 'liftReadsPrec' and 'liftReadPrec' exist to match the interface
124-- provided in the 'Read' type class, but it is recommended to implement
125-- 'Read1' instances using 'liftReadPrec' as opposed to 'liftReadsPrec', since
126-- the former is more efficient than the latter. For example:
127--
128-- @
129-- instance 'Read1' T where
130--   'liftReadPrec'     = ...
131--   'liftReadListPrec' = 'liftReadListPrecDefault'
132-- @
133--
134-- For more information, refer to the documentation for the 'Read' class.
135--
136-- @since 4.9.0.0
137class Read1 f where
138    {-# MINIMAL liftReadsPrec | liftReadPrec #-}
139
140    -- | 'readsPrec' function for an application of the type constructor
141    -- based on 'readsPrec' and 'readList' functions for the argument type.
142    --
143    -- @since 4.9.0.0
144    liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
145    liftReadsPrec rp rl = readPrec_to_S $
146        liftReadPrec (readS_to_Prec rp) (readS_to_Prec (const rl))
147
148    -- | 'readList' function for an application of the type constructor
149    -- based on 'readsPrec' and 'readList' functions for the argument type.
150    -- The default implementation using standard list syntax is correct
151    -- for most types.
152    --
153    -- @since 4.9.0.0
154    liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
155    liftReadList rp rl = readPrec_to_S
156        (list $ liftReadPrec (readS_to_Prec rp) (readS_to_Prec (const rl))) 0
157
158    -- | 'readPrec' function for an application of the type constructor
159    -- based on 'readPrec' and 'readListPrec' functions for the argument type.
160    --
161    -- @since 4.10.0.0
162    liftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
163    liftReadPrec rp rl = readS_to_Prec $
164        liftReadsPrec (readPrec_to_S rp) (readPrec_to_S rl 0)
165
166    -- | 'readListPrec' function for an application of the type constructor
167    -- based on 'readPrec' and 'readListPrec' functions for the argument type.
168    --
169    -- The default definition uses 'liftReadList'. Instances that define
170    -- 'liftReadPrec' should also define 'liftReadListPrec' as
171    -- 'liftReadListPrecDefault'.
172    --
173    -- @since 4.10.0.0
174    liftReadListPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
175    liftReadListPrec rp rl = readS_to_Prec $ \_ ->
176        liftReadList (readPrec_to_S rp) (readPrec_to_S rl 0)
177
178-- | Lift the standard 'readsPrec' and 'readList' functions through the
179-- type constructor.
180--
181-- @since 4.9.0.0
182readsPrec1 :: (Read1 f, Read a) => Int -> ReadS (f a)
183readsPrec1 = liftReadsPrec readsPrec readList
184
185-- | Lift the standard 'readPrec' and 'readListPrec' functions through the
186-- type constructor.
187--
188-- @since 4.10.0.0
189readPrec1 :: (Read1 f, Read a) => ReadPrec (f a)
190readPrec1 = liftReadPrec readPrec readListPrec
191
192-- | A possible replacement definition for the 'liftReadList' method.
193-- This is only needed for 'Read1' instances where 'liftReadListPrec' isn't
194-- defined as 'liftReadListPrecDefault'.
195--
196-- @since 4.10.0.0
197liftReadListDefault :: Read1 f => (Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
198liftReadListDefault rp rl = readPrec_to_S
199    (liftReadListPrec (readS_to_Prec rp) (readS_to_Prec (const rl))) 0
200
201-- | A possible replacement definition for the 'liftReadListPrec' method,
202-- defined using 'liftReadPrec'.
203--
204-- @since 4.10.0.0
205liftReadListPrecDefault :: Read1 f => ReadPrec a -> ReadPrec [a]
206                        -> ReadPrec [f a]
207liftReadListPrecDefault rp rl = list (liftReadPrec rp rl)
208
209-- | Lifting of the 'Show' class to unary type constructors.
210--
211-- @since 4.9.0.0
212class Show1 f where
213    -- | 'showsPrec' function for an application of the type constructor
214    -- based on 'showsPrec' and 'showList' functions for the argument type.
215    --
216    -- @since 4.9.0.0
217    liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->
218        Int -> f a -> ShowS
219
220    -- | 'showList' function for an application of the type constructor
221    -- based on 'showsPrec' and 'showList' functions for the argument type.
222    -- The default implementation using standard list syntax is correct
223    -- for most types.
224    --
225    -- @since 4.9.0.0
226    liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->
227        [f a] -> ShowS
228    liftShowList sp sl = showListWith (liftShowsPrec sp sl 0)
229
230-- | Lift the standard 'showsPrec' and 'showList' functions through the
231-- type constructor.
232--
233-- @since 4.9.0.0
234showsPrec1 :: (Show1 f, Show a) => Int -> f a -> ShowS
235showsPrec1 = liftShowsPrec showsPrec showList
236
237-- | Lifting of the 'Eq' class to binary type constructors.
238--
239-- @since 4.9.0.0
240class Eq2 f where
241    -- | Lift equality tests through the type constructor.
242    --
243    -- The function will usually be applied to equality functions,
244    -- but the more general type ensures that the implementation uses
245    -- them to compare elements of the first container with elements of
246    -- the second.
247    --
248    -- @since 4.9.0.0
249    liftEq2 :: (a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
250
251-- | Lift the standard @('==')@ function through the type constructor.
252--
253-- @since 4.9.0.0
254eq2 :: (Eq2 f, Eq a, Eq b) => f a b -> f a b -> Bool
255eq2 = liftEq2 (==) (==)
256
257-- | Lifting of the 'Ord' class to binary type constructors.
258--
259-- @since 4.9.0.0
260class (Eq2 f) => Ord2 f where
261    -- | Lift 'compare' functions through the type constructor.
262    --
263    -- The function will usually be applied to comparison functions,
264    -- but the more general type ensures that the implementation uses
265    -- them to compare elements of the first container with elements of
266    -- the second.
267    --
268    -- @since 4.9.0.0
269    liftCompare2 :: (a -> b -> Ordering) -> (c -> d -> Ordering) ->
270        f a c -> f b d -> Ordering
271
272-- | Lift the standard 'compare' function through the type constructor.
273--
274-- @since 4.9.0.0
275compare2 :: (Ord2 f, Ord a, Ord b) => f a b -> f a b -> Ordering
276compare2 = liftCompare2 compare compare
277
278-- | Lifting of the 'Read' class to binary type constructors.
279--
280-- Both 'liftReadsPrec2' and 'liftReadPrec2' exist to match the interface
281-- provided in the 'Read' type class, but it is recommended to implement
282-- 'Read2' instances using 'liftReadPrec2' as opposed to 'liftReadsPrec2',
283-- since the former is more efficient than the latter. For example:
284--
285-- @
286-- instance 'Read2' T where
287--   'liftReadPrec2'     = ...
288--   'liftReadListPrec2' = 'liftReadListPrec2Default'
289-- @
290--
291-- For more information, refer to the documentation for the 'Read' class.
292-- @since 4.9.0.0
293class Read2 f where
294    {-# MINIMAL liftReadsPrec2 | liftReadPrec2 #-}
295
296    -- | 'readsPrec' function for an application of the type constructor
297    -- based on 'readsPrec' and 'readList' functions for the argument types.
298    --
299    -- @since 4.9.0.0
300    liftReadsPrec2 :: (Int -> ReadS a) -> ReadS [a] ->
301        (Int -> ReadS b) -> ReadS [b] -> Int -> ReadS (f a b)
302    liftReadsPrec2 rp1 rl1 rp2 rl2 = readPrec_to_S $
303        liftReadPrec2 (readS_to_Prec rp1) (readS_to_Prec (const rl1))
304                      (readS_to_Prec rp2) (readS_to_Prec (const rl2))
305
306    -- | 'readList' function for an application of the type constructor
307    -- based on 'readsPrec' and 'readList' functions for the argument types.
308    -- The default implementation using standard list syntax is correct
309    -- for most types.
310    --
311    -- @since 4.9.0.0
312    liftReadList2 :: (Int -> ReadS a) -> ReadS [a] ->
313        (Int -> ReadS b) -> ReadS [b] -> ReadS [f a b]
314    liftReadList2 rp1 rl1 rp2 rl2 = readPrec_to_S
315       (list $ liftReadPrec2 (readS_to_Prec rp1) (readS_to_Prec (const rl1))
316                             (readS_to_Prec rp2) (readS_to_Prec (const rl2))) 0
317
318    -- | 'readPrec' function for an application of the type constructor
319    -- based on 'readPrec' and 'readListPrec' functions for the argument types.
320    --
321    -- @since 4.10.0.0
322    liftReadPrec2 :: ReadPrec a -> ReadPrec [a] ->
323        ReadPrec b -> ReadPrec [b] -> ReadPrec (f a b)
324    liftReadPrec2 rp1 rl1 rp2 rl2 = readS_to_Prec $
325        liftReadsPrec2 (readPrec_to_S rp1) (readPrec_to_S rl1 0)
326                       (readPrec_to_S rp2) (readPrec_to_S rl2 0)
327
328    -- | 'readListPrec' function for an application of the type constructor
329    -- based on 'readPrec' and 'readListPrec' functions for the argument types.
330    --
331    -- The default definition uses 'liftReadList2'. Instances that define
332    -- 'liftReadPrec2' should also define 'liftReadListPrec2' as
333    -- 'liftReadListPrec2Default'.
334    --
335    -- @since 4.10.0.0
336    liftReadListPrec2 :: ReadPrec a -> ReadPrec [a] ->
337        ReadPrec b -> ReadPrec [b] -> ReadPrec [f a b]
338    liftReadListPrec2 rp1 rl1 rp2 rl2 = readS_to_Prec $ \_ ->
339        liftReadList2 (readPrec_to_S rp1) (readPrec_to_S rl1 0)
340                      (readPrec_to_S rp2) (readPrec_to_S rl2 0)
341
342-- | Lift the standard 'readsPrec' function through the type constructor.
343--
344-- @since 4.9.0.0
345readsPrec2 :: (Read2 f, Read a, Read b) => Int -> ReadS (f a b)
346readsPrec2 = liftReadsPrec2 readsPrec readList readsPrec readList
347
348-- | Lift the standard 'readPrec' function through the type constructor.
349--
350-- @since 4.10.0.0
351readPrec2 :: (Read2 f, Read a, Read b) => ReadPrec (f a b)
352readPrec2 = liftReadPrec2 readPrec readListPrec readPrec readListPrec
353
354-- | A possible replacement definition for the 'liftReadList2' method.
355-- This is only needed for 'Read2' instances where 'liftReadListPrec2' isn't
356-- defined as 'liftReadListPrec2Default'.
357--
358-- @since 4.10.0.0
359liftReadList2Default :: Read2 f => (Int -> ReadS a) -> ReadS [a] ->
360    (Int -> ReadS b) -> ReadS [b] ->ReadS [f a b]
361liftReadList2Default rp1 rl1 rp2 rl2 = readPrec_to_S
362    (liftReadListPrec2 (readS_to_Prec rp1) (readS_to_Prec (const rl1))
363                       (readS_to_Prec rp2) (readS_to_Prec (const rl2))) 0
364
365-- | A possible replacement definition for the 'liftReadListPrec2' method,
366-- defined using 'liftReadPrec2'.
367--
368-- @since 4.10.0.0
369liftReadListPrec2Default :: Read2 f => ReadPrec a -> ReadPrec [a] ->
370    ReadPrec b -> ReadPrec [b] -> ReadPrec [f a b]
371liftReadListPrec2Default rp1 rl1 rp2 rl2 = list (liftReadPrec2 rp1 rl1 rp2 rl2)
372
373-- | Lifting of the 'Show' class to binary type constructors.
374--
375-- @since 4.9.0.0
376class Show2 f where
377    -- | 'showsPrec' function for an application of the type constructor
378    -- based on 'showsPrec' and 'showList' functions for the argument types.
379    --
380    -- @since 4.9.0.0
381    liftShowsPrec2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->
382        (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> f a b -> ShowS
383
384    -- | 'showList' function for an application of the type constructor
385    -- based on 'showsPrec' and 'showList' functions for the argument types.
386    -- The default implementation using standard list syntax is correct
387    -- for most types.
388    --
389    -- @since 4.9.0.0
390    liftShowList2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->
391        (Int -> b -> ShowS) -> ([b] -> ShowS) -> [f a b] -> ShowS
392    liftShowList2 sp1 sl1 sp2 sl2 =
393        showListWith (liftShowsPrec2 sp1 sl1 sp2 sl2 0)
394
395-- | Lift the standard 'showsPrec' function through the type constructor.
396--
397-- @since 4.9.0.0
398showsPrec2 :: (Show2 f, Show a, Show b) => Int -> f a b -> ShowS
399showsPrec2 = liftShowsPrec2 showsPrec showList showsPrec showList
400
401-- Instances for Prelude type constructors
402
403-- | @since 4.9.0.0
404instance Eq1 Maybe where
405    liftEq _ Nothing Nothing = True
406    liftEq _ Nothing (Just _) = False
407    liftEq _ (Just _) Nothing = False
408    liftEq eq (Just x) (Just y) = eq x y
409
410-- | @since 4.9.0.0
411instance Ord1 Maybe where
412    liftCompare _ Nothing Nothing = EQ
413    liftCompare _ Nothing (Just _) = LT
414    liftCompare _ (Just _) Nothing = GT
415    liftCompare comp (Just x) (Just y) = comp x y
416
417-- | @since 4.9.0.0
418instance Read1 Maybe where
419    liftReadPrec rp _ =
420        parens (expectP (Ident "Nothing") *> pure Nothing)
421        <|>
422        readData (readUnaryWith rp "Just" Just)
423
424    liftReadListPrec = liftReadListPrecDefault
425    liftReadList     = liftReadListDefault
426
427-- | @since 4.9.0.0
428instance Show1 Maybe where
429    liftShowsPrec _ _ _ Nothing = showString "Nothing"
430    liftShowsPrec sp _ d (Just x) = showsUnaryWith sp "Just" d x
431
432-- | @since 4.9.0.0
433instance Eq1 [] where
434    liftEq _ [] [] = True
435    liftEq _ [] (_:_) = False
436    liftEq _ (_:_) [] = False
437    liftEq eq (x:xs) (y:ys) = eq x y && liftEq eq xs ys
438
439-- | @since 4.9.0.0
440instance Ord1 [] where
441    liftCompare _ [] [] = EQ
442    liftCompare _ [] (_:_) = LT
443    liftCompare _ (_:_) [] = GT
444    liftCompare comp (x:xs) (y:ys) = comp x y `mappend` liftCompare comp xs ys
445
446-- | @since 4.9.0.0
447instance Read1 [] where
448    liftReadPrec _ rl = rl
449    liftReadListPrec  = liftReadListPrecDefault
450    liftReadList      = liftReadListDefault
451
452-- | @since 4.9.0.0
453instance Show1 [] where
454    liftShowsPrec _ sl _ = sl
455
456-- | @since 4.10.0.0
457instance Eq1 NonEmpty where
458  liftEq eq (a :| as) (b :| bs) = eq a b && liftEq eq as bs
459
460-- | @since 4.10.0.0
461instance Ord1 NonEmpty where
462  liftCompare cmp (a :| as) (b :| bs) = cmp a b `mappend` liftCompare cmp as bs
463
464-- | @since 4.10.0.0
465instance Read1 NonEmpty where
466  liftReadsPrec rdP rdL p s = readParen (p > 5) (\s' -> do
467    (a, s'') <- rdP 6 s'
468    (":|", s''') <- lex s''
469    (as, s'''') <- rdL s'''
470    return (a :| as, s'''')) s
471
472-- | @since 4.10.0.0
473instance Show1 NonEmpty where
474  liftShowsPrec shwP shwL p (a :| as) = showParen (p > 5) $
475    shwP 6 a . showString " :| " . shwL as
476
477-- | @since 4.9.0.0
478instance Eq2 (,) where
479    liftEq2 e1 e2 (x1, y1) (x2, y2) = e1 x1 x2 && e2 y1 y2
480
481-- | @since 4.9.0.0
482instance Ord2 (,) where
483    liftCompare2 comp1 comp2 (x1, y1) (x2, y2) =
484        comp1 x1 x2 `mappend` comp2 y1 y2
485
486-- | @since 4.9.0.0
487instance Read2 (,) where
488    liftReadPrec2 rp1 _ rp2 _ = parens $ paren $ do
489        x <- rp1
490        expectP (Punc ",")
491        y <- rp2
492        return (x,y)
493
494    liftReadListPrec2 = liftReadListPrec2Default
495    liftReadList2     = liftReadList2Default
496
497-- | @since 4.9.0.0
498instance Show2 (,) where
499    liftShowsPrec2 sp1 _ sp2 _ _ (x, y) =
500        showChar '(' . sp1 0 x . showChar ',' . sp2 0 y . showChar ')'
501
502-- | @since 4.9.0.0
503instance (Eq a) => Eq1 ((,) a) where
504    liftEq = liftEq2 (==)
505
506-- | @since 4.9.0.0
507instance (Ord a) => Ord1 ((,) a) where
508    liftCompare = liftCompare2 compare
509
510-- | @since 4.9.0.0
511instance (Read a) => Read1 ((,) a) where
512    liftReadPrec = liftReadPrec2 readPrec readListPrec
513
514    liftReadListPrec = liftReadListPrecDefault
515    liftReadList     = liftReadListDefault
516
517-- | @since 4.9.0.0
518instance (Show a) => Show1 ((,) a) where
519    liftShowsPrec = liftShowsPrec2 showsPrec showList
520
521-- | @since 4.9.0.0
522instance Eq2 Either where
523    liftEq2 e1 _ (Left x) (Left y) = e1 x y
524    liftEq2 _ _ (Left _) (Right _) = False
525    liftEq2 _ _ (Right _) (Left _) = False
526    liftEq2 _ e2 (Right x) (Right y) = e2 x y
527
528-- | @since 4.9.0.0
529instance Ord2 Either where
530    liftCompare2 comp1 _ (Left x) (Left y) = comp1 x y
531    liftCompare2 _ _ (Left _) (Right _) = LT
532    liftCompare2 _ _ (Right _) (Left _) = GT
533    liftCompare2 _ comp2 (Right x) (Right y) = comp2 x y
534
535-- | @since 4.9.0.0
536instance Read2 Either where
537    liftReadPrec2 rp1 _ rp2 _ = readData $
538         readUnaryWith rp1 "Left" Left <|>
539         readUnaryWith rp2 "Right" Right
540
541    liftReadListPrec2 = liftReadListPrec2Default
542    liftReadList2     = liftReadList2Default
543
544-- | @since 4.9.0.0
545instance Show2 Either where
546    liftShowsPrec2 sp1 _ _ _ d (Left x) = showsUnaryWith sp1 "Left" d x
547    liftShowsPrec2 _ _ sp2 _ d (Right x) = showsUnaryWith sp2 "Right" d x
548
549-- | @since 4.9.0.0
550instance (Eq a) => Eq1 (Either a) where
551    liftEq = liftEq2 (==)
552
553-- | @since 4.9.0.0
554instance (Ord a) => Ord1 (Either a) where
555    liftCompare = liftCompare2 compare
556
557-- | @since 4.9.0.0
558instance (Read a) => Read1 (Either a) where
559    liftReadPrec = liftReadPrec2 readPrec readListPrec
560
561    liftReadListPrec = liftReadListPrecDefault
562    liftReadList     = liftReadListDefault
563
564-- | @since 4.9.0.0
565instance (Show a) => Show1 (Either a) where
566    liftShowsPrec = liftShowsPrec2 showsPrec showList
567
568-- Instances for other functors defined in the base package
569
570-- | @since 4.9.0.0
571instance Eq1 Identity where
572    liftEq eq (Identity x) (Identity y) = eq x y
573
574-- | @since 4.9.0.0
575instance Ord1 Identity where
576    liftCompare comp (Identity x) (Identity y) = comp x y
577
578-- | @since 4.9.0.0
579instance Read1 Identity where
580    liftReadPrec rp _ = readData $
581         readUnaryWith rp "Identity" Identity
582
583    liftReadListPrec = liftReadListPrecDefault
584    liftReadList     = liftReadListDefault
585
586-- | @since 4.9.0.0
587instance Show1 Identity where
588    liftShowsPrec sp _ d (Identity x) = showsUnaryWith sp "Identity" d x
589
590-- | @since 4.9.0.0
591instance Eq2 Const where
592    liftEq2 eq _ (Const x) (Const y) = eq x y
593
594-- | @since 4.9.0.0
595instance Ord2 Const where
596    liftCompare2 comp _ (Const x) (Const y) = comp x y
597
598-- | @since 4.9.0.0
599instance Read2 Const where
600    liftReadPrec2 rp _ _ _ = readData $
601         readUnaryWith rp "Const" Const
602
603    liftReadListPrec2 = liftReadListPrec2Default
604    liftReadList2     = liftReadList2Default
605
606-- | @since 4.9.0.0
607instance Show2 Const where
608    liftShowsPrec2 sp _ _ _ d (Const x) = showsUnaryWith sp "Const" d x
609
610-- | @since 4.9.0.0
611instance (Eq a) => Eq1 (Const a) where
612    liftEq = liftEq2 (==)
613-- | @since 4.9.0.0
614instance (Ord a) => Ord1 (Const a) where
615    liftCompare = liftCompare2 compare
616-- | @since 4.9.0.0
617instance (Read a) => Read1 (Const a) where
618    liftReadPrec = liftReadPrec2 readPrec readListPrec
619
620    liftReadListPrec = liftReadListPrecDefault
621    liftReadList     = liftReadListDefault
622-- | @since 4.9.0.0
623instance (Show a) => Show1 (Const a) where
624    liftShowsPrec = liftShowsPrec2 showsPrec showList
625
626-- Proxy unfortunately imports this module, hence these instances are placed
627-- here,
628-- | @since 4.9.0.0
629instance Eq1 Proxy where
630  liftEq _ _ _ = True
631
632-- | @since 4.9.0.0
633instance Ord1 Proxy where
634  liftCompare _ _ _ = EQ
635
636-- | @since 4.9.0.0
637instance Show1 Proxy where
638  liftShowsPrec _ _ _ _ = showString "Proxy"
639
640-- | @since 4.9.0.0
641instance Read1 Proxy where
642  liftReadPrec _ _ = parens (expectP (Ident "Proxy") *> pure Proxy)
643
644  liftReadListPrec = liftReadListPrecDefault
645  liftReadList     = liftReadListDefault
646
647-- | @since 4.12.0.0
648instance Eq1 Down where
649    liftEq eq (Down x) (Down y) = eq x y
650
651-- | @since 4.12.0.0
652instance Ord1 Down where
653    liftCompare comp (Down x) (Down y) = comp x y
654
655-- | @since 4.12.0.0
656instance Read1 Down where
657    liftReadsPrec rp _ = readsData $
658         readsUnaryWith rp "Down" Down
659
660-- | @since 4.12.0.0
661instance Show1 Down where
662    liftShowsPrec sp _ d (Down x) = showsUnaryWith sp "Down" d x
663
664
665-- Building blocks
666
667-- | @'readsData' p d@ is a parser for datatypes where each alternative
668-- begins with a data constructor.  It parses the constructor and
669-- passes it to @p@.  Parsers for various constructors can be constructed
670-- with 'readsUnary', 'readsUnary1' and 'readsBinary1', and combined with
671-- @mappend@ from the @Monoid@ class.
672--
673-- @since 4.9.0.0
674readsData :: (String -> ReadS a) -> Int -> ReadS a
675readsData reader d =
676    readParen (d > 10) $ \ r -> [res | (kw,s) <- lex r, res <- reader kw s]
677
678-- | @'readData' p@ is a parser for datatypes where each alternative
679-- begins with a data constructor.  It parses the constructor and
680-- passes it to @p@.  Parsers for various constructors can be constructed
681-- with 'readUnaryWith' and 'readBinaryWith', and combined with
682-- '(<|>)' from the 'Alternative' class.
683--
684-- @since 4.10.0.0
685readData :: ReadPrec a -> ReadPrec a
686readData reader = parens $ prec 10 reader
687
688-- | @'readsUnaryWith' rp n c n'@ matches the name of a unary data constructor
689-- and then parses its argument using @rp@.
690--
691-- @since 4.9.0.0
692readsUnaryWith :: (Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
693readsUnaryWith rp name cons kw s =
694    [(cons x,t) | kw == name, (x,t) <- rp 11 s]
695
696-- | @'readUnaryWith' rp n c'@ matches the name of a unary data constructor
697-- and then parses its argument using @rp@.
698--
699-- @since 4.10.0.0
700readUnaryWith :: ReadPrec a -> String -> (a -> t) -> ReadPrec t
701readUnaryWith rp name cons = do
702    expectP $ Ident name
703    x <- step rp
704    return $ cons x
705
706-- | @'readsBinaryWith' rp1 rp2 n c n'@ matches the name of a binary
707-- data constructor and then parses its arguments using @rp1@ and @rp2@
708-- respectively.
709--
710-- @since 4.9.0.0
711readsBinaryWith :: (Int -> ReadS a) -> (Int -> ReadS b) ->
712    String -> (a -> b -> t) -> String -> ReadS t
713readsBinaryWith rp1 rp2 name cons kw s =
714    [(cons x y,u) | kw == name, (x,t) <- rp1 11 s, (y,u) <- rp2 11 t]
715
716-- | @'readBinaryWith' rp1 rp2 n c'@ matches the name of a binary
717-- data constructor and then parses its arguments using @rp1@ and @rp2@
718-- respectively.
719--
720-- @since 4.10.0.0
721readBinaryWith :: ReadPrec a -> ReadPrec b ->
722    String -> (a -> b -> t) -> ReadPrec t
723readBinaryWith rp1 rp2 name cons = do
724    expectP $ Ident name
725    x <- step rp1
726    y <- step rp2
727    return $ cons x y
728
729-- | @'showsUnaryWith' sp n d x@ produces the string representation of a
730-- unary data constructor with name @n@ and argument @x@, in precedence
731-- context @d@.
732--
733-- @since 4.9.0.0
734showsUnaryWith :: (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
735showsUnaryWith sp name d x = showParen (d > 10) $
736    showString name . showChar ' ' . sp 11 x
737
738-- | @'showsBinaryWith' sp1 sp2 n d x y@ produces the string
739-- representation of a binary data constructor with name @n@ and arguments
740-- @x@ and @y@, in precedence context @d@.
741--
742-- @since 4.9.0.0
743showsBinaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) ->
744    String -> Int -> a -> b -> ShowS
745showsBinaryWith sp1 sp2 name d x y = showParen (d > 10) $
746    showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y
747
748-- Obsolete building blocks
749
750-- | @'readsUnary' n c n'@ matches the name of a unary data constructor
751-- and then parses its argument using 'readsPrec'.
752--
753-- @since 4.9.0.0
754{-# DEPRECATED readsUnary "Use 'readsUnaryWith' to define 'liftReadsPrec'" #-}
755readsUnary :: (Read a) => String -> (a -> t) -> String -> ReadS t
756readsUnary name cons kw s =
757    [(cons x,t) | kw == name, (x,t) <- readsPrec 11 s]
758
759-- | @'readsUnary1' n c n'@ matches the name of a unary data constructor
760-- and then parses its argument using 'readsPrec1'.
761--
762-- @since 4.9.0.0
763{-# DEPRECATED readsUnary1 "Use 'readsUnaryWith' to define 'liftReadsPrec'" #-}
764readsUnary1 :: (Read1 f, Read a) => String -> (f a -> t) -> String -> ReadS t
765readsUnary1 name cons kw s =
766    [(cons x,t) | kw == name, (x,t) <- readsPrec1 11 s]
767
768-- | @'readsBinary1' n c n'@ matches the name of a binary data constructor
769-- and then parses its arguments using 'readsPrec1'.
770--
771-- @since 4.9.0.0
772{-# DEPRECATED readsBinary1
773      "Use 'readsBinaryWith' to define 'liftReadsPrec'" #-}
774readsBinary1 :: (Read1 f, Read1 g, Read a) =>
775    String -> (f a -> g a -> t) -> String -> ReadS t
776readsBinary1 name cons kw s =
777    [(cons x y,u) | kw == name,
778        (x,t) <- readsPrec1 11 s, (y,u) <- readsPrec1 11 t]
779
780-- | @'showsUnary' n d x@ produces the string representation of a unary data
781-- constructor with name @n@ and argument @x@, in precedence context @d@.
782--
783-- @since 4.9.0.0
784{-# DEPRECATED showsUnary "Use 'showsUnaryWith' to define 'liftShowsPrec'" #-}
785showsUnary :: (Show a) => String -> Int -> a -> ShowS
786showsUnary name d x = showParen (d > 10) $
787    showString name . showChar ' ' . showsPrec 11 x
788
789-- | @'showsUnary1' n d x@ produces the string representation of a unary data
790-- constructor with name @n@ and argument @x@, in precedence context @d@.
791--
792-- @since 4.9.0.0
793{-# DEPRECATED showsUnary1 "Use 'showsUnaryWith' to define 'liftShowsPrec'" #-}
794showsUnary1 :: (Show1 f, Show a) => String -> Int -> f a -> ShowS
795showsUnary1 name d x = showParen (d > 10) $
796    showString name . showChar ' ' . showsPrec1 11 x
797
798-- | @'showsBinary1' n d x y@ produces the string representation of a binary
799-- data constructor with name @n@ and arguments @x@ and @y@, in precedence
800-- context @d@.
801--
802-- @since 4.9.0.0
803{-# DEPRECATED showsBinary1
804      "Use 'showsBinaryWith' to define 'liftShowsPrec'" #-}
805showsBinary1 :: (Show1 f, Show1 g, Show a) =>
806    String -> Int -> f a -> g a -> ShowS
807showsBinary1 name d x y = showParen (d > 10) $
808    showString name . showChar ' ' . showsPrec1 11 x .
809        showChar ' ' . showsPrec1 11 y
810
811{- $example
812These functions can be used to assemble 'Read' and 'Show' instances for
813new algebraic types.  For example, given the definition
814
815> data T f a = Zero a | One (f a) | Two a (f a)
816
817a standard 'Read1' instance may be defined as
818
819> instance (Read1 f) => Read1 (T f) where
820>     liftReadPrec rp rl = readData $
821>         readUnaryWith rp "Zero" Zero <|>
822>         readUnaryWith (liftReadPrec rp rl) "One" One <|>
823>         readBinaryWith rp (liftReadPrec rp rl) "Two" Two
824>     liftReadListPrec = liftReadListPrecDefault
825
826and the corresponding 'Show1' instance as
827
828> instance (Show1 f) => Show1 (T f) where
829>     liftShowsPrec sp _ d (Zero x) =
830>         showsUnaryWith sp "Zero" d x
831>     liftShowsPrec sp sl d (One x) =
832>         showsUnaryWith (liftShowsPrec sp sl) "One" d x
833>     liftShowsPrec sp sl d (Two x y) =
834>         showsBinaryWith sp (liftShowsPrec sp sl) "Two" d x y
835
836-}
837