Data/Functor/Classes.hs

    {-# LANGUAGE Safe #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Data.Functor.Classes
    -- Copyright   :  (c) Ross Paterson 2013
    -- License     :  BSD-style (see the file LICENSE)
    --
    -- Maintainer  :  libraries@haskell.org
    -- Stability   :  experimental
    -- Portability :  portable
    --
    -- Liftings of the Prelude classes 'Eq', 'Ord', 'Read' and 'Show' to
    -- unary and binary type constructors.
    --
    -- These classes are needed to express the constraints on arguments of
    -- transformers in portable Haskell.  Thus for a new transformer @T@,
    -- one might write instances like
    --
    -- > instance (Eq1 f) => Eq1 (T f) where ...
    -- > instance (Ord1 f) => Ord1 (T f) where ...
    -- > instance (Read1 f) => Read1 (T f) where ...
    -- > instance (Show1 f) => Show1 (T f) where ...
    --
    -- If these instances can be defined, defining instances of the base
    -- classes is mechanical:
    --
    -- > instance (Eq1 f, Eq a) => Eq (T f a) where (==) = eq1
    -- > instance (Ord1 f, Ord a) => Ord (T f a) where compare = compare1
    -- > instance (Read1 f, Read a) => Read (T f a) where
    -- >   readPrec     = readPrec1
    -- >   readListPrec = readListPrecDefault
    -- > instance (Show1 f, Show a) => Show (T f a) where showsPrec = showsPrec1
    --
    -- @since 4.9.0.0
    -----------------------------------------------------------------------------

    module Data.Functor.Classes (
        -- * Liftings of Prelude classes
        -- ** For unary constructors
        Eq1(..), eq1,
        Ord1(..), compare1,
        Read1(..), readsPrec1, readPrec1,
        liftReadListDefault, liftReadListPrecDefault,
        Show1(..), showsPrec1,
        -- ** For binary constructors
        Eq2(..), eq2,
        Ord2(..), compare2,
        Read2(..), readsPrec2, readPrec2,
        liftReadList2Default, liftReadListPrec2Default,
        Show2(..), showsPrec2,
        -- * Helper functions
        -- $example
        readsData, readData,
        readsUnaryWith, readUnaryWith,
        readsBinaryWith, readBinaryWith,
        showsUnaryWith,
        showsBinaryWith,
        -- ** Obsolete helpers
        readsUnary,
        readsUnary1,
        readsBinary1,
        showsUnary,
        showsUnary1,
        showsBinary1,
      ) where

    import Control.Applicative (Alternative((<|>)), Const(Const))

    import Data.Functor.Identity (Identity(Identity))
    import Data.Proxy (Proxy(Proxy))
    import Data.Monoid (mappend)

    import GHC.Read (expectP, list, paren)

    import Text.ParserCombinators.ReadPrec (ReadPrec, readPrec_to_S, readS_to_Prec)
    import Text.Read (Read(..), parens, prec, step)
    import Text.Read.Lex (Lexeme(..))
    import Text.Show (showListWith)

    -- | Lifting of the 'Eq' class to unary type constructors.
    --
    -- @since 4.9.0.0
    class Eq1 f where
        -- | Lift an equality test through the type constructor.
        --
        -- The function will usually be applied to an equality function,
        -- but the more general type ensures that the implementation uses
        -- it to compare elements of the first container with elements of
        -- the second.
        --
        -- @since 4.9.0.0
        liftEq :: (a -> b -> Bool) -> f a -> f b -> Bool

    -- | Lift the standard @('==')@ function through the type constructor.
    --
    -- @since 4.9.0.0
    eq1 :: (Eq1 f, Eq a) => f a -> f a -> Bool
    eq1 = liftEq (==)

    -- | Lifting of the 'Ord' class to unary type constructors.
    --
    -- @since 4.9.0.0
    class (Eq1 f) => Ord1 f where
        -- | Lift a 'compare' function through the type constructor.
        --
        -- The function will usually be applied to a comparison function,
        -- but the more general type ensures that the implementation uses
        -- it to compare elements of the first container with elements of
        -- the second.
        --
        -- @since 4.9.0.0
        liftCompare :: (a -> b -> Ordering) -> f a -> f b -> Ordering

    -- | Lift the standard 'compare' function through the type constructor.
    --
    -- @since 4.9.0.0
    compare1 :: (Ord1 f, Ord a) => f a -> f a -> Ordering
    compare1 = liftCompare compare

    -- | Lifting of the 'Read' class to unary type constructors.
    --
    -- Both 'liftReadsPrec' and 'liftReadPrec' exist to match the interface
    -- provided in the 'Read' type class, but it is recommended to implement
    -- 'Read1' instances using 'liftReadPrec' as opposed to 'liftReadsPrec', since
    -- the former is more efficient than the latter. For example:
    --
    -- @
    -- instance 'Read1' T where
    --   'liftReadPrec'     = ...
    --   'liftReadListPrec' = 'liftReadListPrecDefault'
    -- @
    --
    -- For more information, refer to the documentation for the 'Read' class.
    --
    -- @since 4.9.0.0
    class Read1 f where
        {-# MINIMAL liftReadsPrec | liftReadPrec #-}

        -- | 'readsPrec' function for an application of the type constructor
        -- based on 'readsPrec' and 'readList' functions for the argument type.
        --
        -- @since 4.9.0.0
        liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
        liftReadsPrec rp rl = readPrec_to_S $
            liftReadPrec (readS_to_Prec rp) (readS_to_Prec (const rl))

        -- | 'readList' function for an application of the type constructor
        -- based on 'readsPrec' and 'readList' functions for the argument type.
        -- The default implementation using standard list syntax is correct
        -- for most types.
        --
        -- @since 4.9.0.0
        liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
        liftReadList rp rl = readPrec_to_S
            (list $ liftReadPrec (readS_to_Prec rp) (readS_to_Prec (const rl))) 0

        -- | 'readPrec' function for an application of the type constructor
        -- based on 'readPrec' and 'readListPrec' functions for the argument type.
        --
        -- @since 4.10.0.0
        liftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
        liftReadPrec rp rl = readS_to_Prec $
            liftReadsPrec (readPrec_to_S rp) (readPrec_to_S rl 0)

        -- | 'readListPrec' function for an application of the type constructor
        -- based on 'readPrec' and 'readListPrec' functions for the argument type.
        --
        -- The default definition uses 'liftReadList'. Instances that define
        -- 'liftReadPrec' should also define 'liftReadListPrec' as
        -- 'liftReadListPrecDefault'.
        --
        -- @since 4.10.0.0
        liftReadListPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
        liftReadListPrec rp rl = readS_to_Prec $ \_ ->
            liftReadList (readPrec_to_S rp) (readPrec_to_S rl 0)

    -- | Lift the standard 'readsPrec' and 'readList' functions through the
    -- type constructor.
    --
    -- @since 4.9.0.0
    readsPrec1 :: (Read1 f, Read a) => Int -> ReadS (f a)
    readsPrec1 = liftReadsPrec readsPrec readList

    -- | Lift the standard 'readPrec' and 'readListPrec' functions through the
    -- type constructor.
    --
    -- @since 4.10.0.0
    readPrec1 :: (Read1 f, Read a) => ReadPrec (f a)
    readPrec1 = liftReadPrec readPrec readListPrec

    -- | A possible replacement definition for the 'liftReadList' method.
    -- This is only needed for 'Read1' instances where 'liftReadListPrec' isn't
    -- defined as 'liftReadListPrecDefault'.
    --
    -- @since 4.10.0.0
    liftReadListDefault :: Read1 f => (Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
    liftReadListDefault rp rl = readPrec_to_S
        (liftReadListPrec (readS_to_Prec rp) (readS_to_Prec (const rl))) 0

    -- | A possible replacement definition for the 'liftReadListPrec' method,
    -- defined using 'liftReadPrec'.
    --
    -- @since 4.10.0.0
    liftReadListPrecDefault :: Read1 f => ReadPrec a -> ReadPrec [a]
                            -> ReadPrec [f a]
    liftReadListPrecDefault rp rl = list (liftReadPrec rp rl)

    -- | Lifting of the 'Show' class to unary type constructors.
    --
    -- @since 4.9.0.0
    class Show1 f where
        -- | 'showsPrec' function for an application of the type constructor
        -- based on 'showsPrec' and 'showList' functions for the argument type.
        --
        -- @since 4.9.0.0
        liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->
            Int -> f a -> ShowS

        -- | 'showList' function for an application of the type constructor
        -- based on 'showsPrec' and 'showList' functions for the argument type.
        -- The default implementation using standard list syntax is correct
        -- for most types.
        --
        -- @since 4.9.0.0
        liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->
            [f a] -> ShowS
        liftShowList sp sl = showListWith (liftShowsPrec sp sl 0)

    -- | Lift the standard 'showsPrec' and 'showList' functions through the
    -- type constructor.
    --
    -- @since 4.9.0.0
    showsPrec1 :: (Show1 f, Show a) => Int -> f a -> ShowS
    showsPrec1 = liftShowsPrec showsPrec showList

    -- | Lifting of the 'Eq' class to binary type constructors.
    --
    -- @since 4.9.0.0
    class Eq2 f where
        -- | Lift equality tests through the type constructor.
        --
        -- The function will usually be applied to equality functions,
        -- but the more general type ensures that the implementation uses
        -- them to compare elements of the first container with elements of
        -- the second.
        --
        -- @since 4.9.0.0
        liftEq2 :: (a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool

    -- | Lift the standard @('==')@ function through the type constructor.
    --
    -- @since 4.9.0.0
    eq2 :: (Eq2 f, Eq a, Eq b) => f a b -> f a b -> Bool
    eq2 = liftEq2 (==) (==)

    -- | Lifting of the 'Ord' class to binary type constructors.
    --
    -- @since 4.9.0.0
    class (Eq2 f) => Ord2 f where
        -- | Lift 'compare' functions through the type constructor.
        --
        -- The function will usually be applied to comparison functions,
        -- but the more general type ensures that the implementation uses
        -- them to compare elements of the first container with elements of
        -- the second.
        --
        -- @since 4.9.0.0
        liftCompare2 :: (a -> b -> Ordering) -> (c -> d -> Ordering) ->
            f a c -> f b d -> Ordering

    -- | Lift the standard 'compare' function through the type constructor.
    --
    -- @since 4.9.0.0
    compare2 :: (Ord2 f, Ord a, Ord b) => f a b -> f a b -> Ordering
    compare2 = liftCompare2 compare compare

    -- | Lifting of the 'Read' class to binary type constructors.
    --
    -- Both 'liftReadsPrec2' and 'liftReadPrec2' exist to match the interface
    -- provided in the 'Read' type class, but it is recommended to implement
    -- 'Read2' instances using 'liftReadPrec2' as opposed to 'liftReadsPrec2',
    -- since the former is more efficient than the latter. For example:
    --
    -- @
    -- instance 'Read2' T where
    --   'liftReadPrec2'     = ...
    --   'liftReadListPrec2' = 'liftReadListPrec2Default'
    -- @
    --
    -- For more information, refer to the documentation for the 'Read' class.
    -- @since 4.9.0.0
    class Read2 f where
        {-# MINIMAL liftReadsPrec2 | liftReadPrec2 #-}

        -- | 'readsPrec' function for an application of the type constructor
        -- based on 'readsPrec' and 'readList' functions for the argument types.
        --
        -- @since 4.9.0.0
        liftReadsPrec2 :: (Int -> ReadS a) -> ReadS [a] ->
            (Int -> ReadS b) -> ReadS [b] -> Int -> ReadS (f a b)
        liftReadsPrec2 rp1 rl1 rp2 rl2 = readPrec_to_S $
            liftReadPrec2 (readS_to_Prec rp1) (readS_to_Prec (const rl1))
                          (readS_to_Prec rp2) (readS_to_Prec (const rl2))

        -- | 'readList' function for an application of the type constructor
        -- based on 'readsPrec' and 'readList' functions for the argument types.
        -- The default implementation using standard list syntax is correct
        -- for most types.
        --
        -- @since 4.9.0.0
        liftReadList2 :: (Int -> ReadS a) -> ReadS [a] ->
            (Int -> ReadS b) -> ReadS [b] -> ReadS [f a b]
        liftReadList2 rp1 rl1 rp2 rl2 = readPrec_to_S
           (list $ liftReadPrec2 (readS_to_Prec rp1) (readS_to_Prec (const rl1))
                                 (readS_to_Prec rp2) (readS_to_Prec (const rl2))) 0

        -- | 'readPrec' function for an application of the type constructor
        -- based on 'readPrec' and 'readListPrec' functions for the argument types.
        --
        -- @since 4.10.0.0
        liftReadPrec2 :: ReadPrec a -> ReadPrec [a] ->
            ReadPrec b -> ReadPrec [b] -> ReadPrec (f a b)
        liftReadPrec2 rp1 rl1 rp2 rl2 = readS_to_Prec $
            liftReadsPrec2 (readPrec_to_S rp1) (readPrec_to_S rl1 0)
                           (readPrec_to_S rp2) (readPrec_to_S rl2 0)

        -- | 'readListPrec' function for an application of the type constructor
        -- based on 'readPrec' and 'readListPrec' functions for the argument types.
        --
        -- The default definition uses 'liftReadList2'. Instances that define
        -- 'liftReadPrec2' should also define 'liftReadListPrec2' as
        -- 'liftReadListPrec2Default'.
        --
        -- @since 4.10.0.0
        liftReadListPrec2 :: ReadPrec a -> ReadPrec [a] ->
            ReadPrec b -> ReadPrec [b] -> ReadPrec [f a b]
        liftReadListPrec2 rp1 rl1 rp2 rl2 = readS_to_Prec $ \_ ->
            liftReadList2 (readPrec_to_S rp1) (readPrec_to_S rl1 0)
                          (readPrec_to_S rp2) (readPrec_to_S rl2 0)

    -- | Lift the standard 'readsPrec' function through the type constructor.
    --
    -- @since 4.9.0.0
    readsPrec2 :: (Read2 f, Read a, Read b) => Int -> ReadS (f a b)
    readsPrec2 = liftReadsPrec2 readsPrec readList readsPrec readList

    -- | Lift the standard 'readPrec' function through the type constructor.
    --
    -- @since 4.10.0.0
    readPrec2 :: (Read2 f, Read a, Read b) => ReadPrec (f a b)
    readPrec2 = liftReadPrec2 readPrec readListPrec readPrec readListPrec

    -- | A possible replacement definition for the 'liftReadList2' method.
    -- This is only needed for 'Read2' instances where 'liftReadListPrec2' isn't
    -- defined as 'liftReadListPrec2Default'.
    --
    -- @since 4.10.0.0
    liftReadList2Default :: Read2 f => (Int -> ReadS a) -> ReadS [a] ->
        (Int -> ReadS b) -> ReadS [b] ->ReadS [f a b]
    liftReadList2Default rp1 rl1 rp2 rl2 = readPrec_to_S
        (liftReadListPrec2 (readS_to_Prec rp1) (readS_to_Prec (const rl1))
                           (readS_to_Prec rp2) (readS_to_Prec (const rl2))) 0

    -- | A possible replacement definition for the 'liftReadListPrec2' method,
    -- defined using 'liftReadPrec2'.
    --
    -- @since 4.10.0.0
    liftReadListPrec2Default :: Read2 f => ReadPrec a -> ReadPrec [a] ->
        ReadPrec b -> ReadPrec [b] -> ReadPrec [f a b]
    liftReadListPrec2Default rp1 rl1 rp2 rl2 = list (liftReadPrec2 rp1 rl1 rp2 rl2)

    -- | Lifting of the 'Show' class to binary type constructors.
    --
    -- @since 4.9.0.0
    class Show2 f where
        -- | 'showsPrec' function for an application of the type constructor
        -- based on 'showsPrec' and 'showList' functions for the argument types.
        --
        -- @since 4.9.0.0
        liftShowsPrec2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->
            (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> f a b -> ShowS

        -- | 'showList' function for an application of the type constructor
        -- based on 'showsPrec' and 'showList' functions for the argument types.
        -- The default implementation using standard list syntax is correct
        -- for most types.
        --
        -- @since 4.9.0.0
        liftShowList2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->
            (Int -> b -> ShowS) -> ([b] -> ShowS) -> [f a b] -> ShowS
        liftShowList2 sp1 sl1 sp2 sl2 =
            showListWith (liftShowsPrec2 sp1 sl1 sp2 sl2 0)

    -- | Lift the standard 'showsPrec' function through the type constructor.
    --
    -- @since 4.9.0.0
    showsPrec2 :: (Show2 f, Show a, Show b) => Int -> f a b -> ShowS
    showsPrec2 = liftShowsPrec2 showsPrec showList showsPrec showList

    -- Instances for Prelude type constructors

    -- | @since 4.9.0.0
    instance Eq1 Maybe where
        liftEq _ Nothing Nothing = True
        liftEq _ Nothing (Just _) = False
        liftEq _ (Just _) Nothing = False
        liftEq eq (Just x) (Just y) = eq x y

    -- | @since 4.9.0.0
    instance Ord1 Maybe where
        liftCompare _ Nothing Nothing = EQ
        liftCompare _ Nothing (Just _) = LT
        liftCompare _ (Just _) Nothing = GT
        liftCompare comp (Just x) (Just y) = comp x y

    -- | @since 4.9.0.0
    instance Read1 Maybe where
        liftReadPrec rp _ =
            parens (expectP (Ident "Nothing") *> pure Nothing)
            <|>
            readData (readUnaryWith rp "Just" Just)

        liftReadListPrec = liftReadListPrecDefault
        liftReadList     = liftReadListDefault

    -- | @since 4.9.0.0
    instance Show1 Maybe where
        liftShowsPrec _ _ _ Nothing = showString "Nothing"
        liftShowsPrec sp _ d (Just x) = showsUnaryWith sp "Just" d x

    -- | @since 4.9.0.0
    instance Eq1 [] where
        liftEq _ [] [] = True
        liftEq _ [] (_:_) = False
        liftEq _ (_:_) [] = False
        liftEq eq (x:xs) (y:ys) = eq x y && liftEq eq xs ys

    -- | @since 4.9.0.0
    instance Ord1 [] where
        liftCompare _ [] [] = EQ
        liftCompare _ [] (_:_) = LT
        liftCompare _ (_:_) [] = GT
        liftCompare comp (x:xs) (y:ys) = comp x y `mappend` liftCompare comp xs ys

    -- | @since 4.9.0.0
    instance Read1 [] where
        liftReadPrec _ rl = rl
        liftReadListPrec  = liftReadListPrecDefault
        liftReadList      = liftReadListDefault

    -- | @since 4.9.0.0
    instance Show1 [] where
        liftShowsPrec _ sl _ = sl

    -- | @since 4.9.0.0
    instance Eq2 (,) where
        liftEq2 e1 e2 (x1, y1) (x2, y2) = e1 x1 x2 && e2 y1 y2

    -- | @since 4.9.0.0
    instance Ord2 (,) where
        liftCompare2 comp1 comp2 (x1, y1) (x2, y2) =
            comp1 x1 x2 `mappend` comp2 y1 y2

    -- | @since 4.9.0.0
    instance Read2 (,) where
        liftReadPrec2 rp1 _ rp2 _ = parens $ paren $ do
            x <- rp1
            expectP (Punc ",")
            y <- rp2
            return (x,y)

        liftReadListPrec2 = liftReadListPrec2Default
        liftReadList2     = liftReadList2Default

    -- | @since 4.9.0.0
    instance Show2 (,) where
        liftShowsPrec2 sp1 _ sp2 _ _ (x, y) =
            showChar '(' . sp1 0 x . showChar ',' . sp2 0 y . showChar ')'

    -- | @since 4.9.0.0
    instance (Eq a) => Eq1 ((,) a) where
        liftEq = liftEq2 (==)

    -- | @since 4.9.0.0
    instance (Ord a) => Ord1 ((,) a) where
        liftCompare = liftCompare2 compare

    -- | @since 4.9.0.0
    instance (Read a) => Read1 ((,) a) where
        liftReadPrec = liftReadPrec2 readPrec readListPrec

        liftReadListPrec = liftReadListPrecDefault
        liftReadList     = liftReadListDefault

    -- | @since 4.9.0.0
    instance (Show a) => Show1 ((,) a) where
        liftShowsPrec = liftShowsPrec2 showsPrec showList

    -- | @since 4.9.0.0
    instance Eq2 Either where
        liftEq2 e1 _ (Left x) (Left y) = e1 x y
        liftEq2 _ _ (Left _) (Right _) = False
        liftEq2 _ _ (Right _) (Left _) = False
        liftEq2 _ e2 (Right x) (Right y) = e2 x y

    -- | @since 4.9.0.0
    instance Ord2 Either where
        liftCompare2 comp1 _ (Left x) (Left y) = comp1 x y
        liftCompare2 _ _ (Left _) (Right _) = LT
        liftCompare2 _ _ (Right _) (Left _) = GT
        liftCompare2 _ comp2 (Right x) (Right y) = comp2 x y

    -- | @since 4.9.0.0
    instance Read2 Either where
        liftReadPrec2 rp1 _ rp2 _ = readData $
             readUnaryWith rp1 "Left" Left <|>
             readUnaryWith rp2 "Right" Right

        liftReadListPrec2 = liftReadListPrec2Default
        liftReadList2     = liftReadList2Default

    -- | @since 4.9.0.0
    instance Show2 Either where
        liftShowsPrec2 sp1 _ _ _ d (Left x) = showsUnaryWith sp1 "Left" d x
        liftShowsPrec2 _ _ sp2 _ d (Right x) = showsUnaryWith sp2 "Right" d x

    -- | @since 4.9.0.0
    instance (Eq a) => Eq1 (Either a) where
        liftEq = liftEq2 (==)

    -- | @since 4.9.0.0
    instance (Ord a) => Ord1 (Either a) where
        liftCompare = liftCompare2 compare

    -- | @since 4.9.0.0
    instance (Read a) => Read1 (Either a) where
        liftReadPrec = liftReadPrec2 readPrec readListPrec

        liftReadListPrec = liftReadListPrecDefault
        liftReadList     = liftReadListDefault

    -- | @since 4.9.0.0
    instance (Show a) => Show1 (Either a) where
        liftShowsPrec = liftShowsPrec2 showsPrec showList

    -- Instances for other functors defined in the base package

    -- | @since 4.9.0.0
    instance Eq1 Identity where
        liftEq eq (Identity x) (Identity y) = eq x y

    -- | @since 4.9.0.0
    instance Ord1 Identity where
        liftCompare comp (Identity x) (Identity y) = comp x y

    -- | @since 4.9.0.0
    instance Read1 Identity where
        liftReadPrec rp _ = readData $
             readUnaryWith rp "Identity" Identity

        liftReadListPrec = liftReadListPrecDefault
        liftReadList     = liftReadListDefault

    -- | @since 4.9.0.0
    instance Show1 Identity where
        liftShowsPrec sp _ d (Identity x) = showsUnaryWith sp "Identity" d x

    -- | @since 4.9.0.0
    instance Eq2 Const where
        liftEq2 eq _ (Const x) (Const y) = eq x y

    -- | @since 4.9.0.0
    instance Ord2 Const where
        liftCompare2 comp _ (Const x) (Const y) = comp x y

    -- | @since 4.9.0.0
    instance Read2 Const where
        liftReadPrec2 rp _ _ _ = readData $
             readUnaryWith rp "Const" Const

        liftReadListPrec2 = liftReadListPrec2Default
        liftReadList2     = liftReadList2Default

    -- | @since 4.9.0.0
    instance Show2 Const where
        liftShowsPrec2 sp _ _ _ d (Const x) = showsUnaryWith sp "Const" d x

    -- | @since 4.9.0.0
    instance (Eq a) => Eq1 (Const a) where
        liftEq = liftEq2 (==)
    -- | @since 4.9.0.0
    instance (Ord a) => Ord1 (Const a) where
        liftCompare = liftCompare2 compare
    -- | @since 4.9.0.0
    instance (Read a) => Read1 (Const a) where
        liftReadPrec = liftReadPrec2 readPrec readListPrec

        liftReadListPrec = liftReadListPrecDefault
        liftReadList     = liftReadListDefault
    -- | @since 4.9.0.0
    instance (Show a) => Show1 (Const a) where
        liftShowsPrec = liftShowsPrec2 showsPrec showList

    -- Proxy unfortunately imports this module, hence these instances are placed
    -- here,
    -- | @since 4.9.0.0
    instance Eq1 Proxy where
      liftEq _ _ _ = True

    -- | @since 4.9.0.0
    instance Ord1 Proxy where
      liftCompare _ _ _ = EQ

    -- | @since 4.9.0.0
    instance Show1 Proxy where
      liftShowsPrec _ _ _ _ = showString "Proxy"

    -- | @since 4.9.0.0
    instance Read1 Proxy where
      liftReadPrec _ _ = parens (expectP (Ident "Proxy") *> pure Proxy)

      liftReadListPrec = liftReadListPrecDefault
      liftReadList     = liftReadListDefault

    -- Building blocks

    -- | @'readsData' p d@ is a parser for datatypes where each alternative
    -- begins with a data constructor.  It parses the constructor and
    -- passes it to @p@.  Parsers for various constructors can be constructed
    -- with 'readsUnary', 'readsUnary1' and 'readsBinary1', and combined with
    -- @mappend@ from the @Monoid@ class.
    --
    -- @since 4.9.0.0
    readsData :: (String -> ReadS a) -> Int -> ReadS a
    readsData reader d =
        readParen (d > 10) $ \ r -> [res | (kw,s) <- lex r, res <- reader kw s]

    -- | @'readData' p@ is a parser for datatypes where each alternative
    -- begins with a data constructor.  It parses the constructor and
    -- passes it to @p@.  Parsers for various constructors can be constructed
    -- with 'readUnaryWith' and 'readBinaryWith', and combined with
    -- '(<|>)' from the 'Alternative' class.
    --
    -- @since 4.10.0.0
    readData :: ReadPrec a -> ReadPrec a
    readData reader = parens $ prec 10 reader

    -- | @'readsUnaryWith' rp n c n'@ matches the name of a unary data constructor
    -- and then parses its argument using @rp@.
    --
    -- @since 4.9.0.0
    readsUnaryWith :: (Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
    readsUnaryWith rp name cons kw s =
        [(cons x,t) | kw == name, (x,t) <- rp 11 s]

    -- | @'readUnaryWith' rp n c'@ matches the name of a unary data constructor
    -- and then parses its argument using @rp@.
    --
    -- @since 4.10.0.0
    readUnaryWith :: ReadPrec a -> String -> (a -> t) -> ReadPrec t
    readUnaryWith rp name cons = do
        expectP $ Ident name
        x <- step rp
        return $ cons x

    -- | @'readsBinaryWith' rp1 rp2 n c n'@ matches the name of a binary
    -- data constructor and then parses its arguments using @rp1@ and @rp2@
    -- respectively.
    --
    -- @since 4.9.0.0
    readsBinaryWith :: (Int -> ReadS a) -> (Int -> ReadS b) ->
        String -> (a -> b -> t) -> String -> ReadS t
    readsBinaryWith rp1 rp2 name cons kw s =
        [(cons x y,u) | kw == name, (x,t) <- rp1 11 s, (y,u) <- rp2 11 t]

    -- | @'readBinaryWith' rp1 rp2 n c'@ matches the name of a binary
    -- data constructor and then parses its arguments using @rp1@ and @rp2@
    -- respectively.
    --
    -- @since 4.10.0.0
    readBinaryWith :: ReadPrec a -> ReadPrec b ->
        String -> (a -> b -> t) -> ReadPrec t
    readBinaryWith rp1 rp2 name cons = do
        expectP $ Ident name
        x <- step rp1
        y <- step rp2
        return $ cons x y

    -- | @'showsUnaryWith' sp n d x@ produces the string representation of a
    -- unary data constructor with name @n@ and argument @x@, in precedence
    -- context @d@.
    --
    -- @since 4.9.0.0
    showsUnaryWith :: (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
    showsUnaryWith sp name d x = showParen (d > 10) $
        showString name . showChar ' ' . sp 11 x

    -- | @'showsBinaryWith' sp1 sp2 n d x y@ produces the string
    -- representation of a binary data constructor with name @n@ and arguments
    -- @x@ and @y@, in precedence context @d@.
    --
    -- @since 4.9.0.0
    showsBinaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) ->
        String -> Int -> a -> b -> ShowS
    showsBinaryWith sp1 sp2 name d x y = showParen (d > 10) $
        showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y

    -- Obsolete building blocks

    -- | @'readsUnary' n c n'@ matches the name of a unary data constructor
    -- and then parses its argument using 'readsPrec'.
    --
    -- @since 4.9.0.0
    {-# DEPRECATED readsUnary "Use readsUnaryWith to define liftReadsPrec" #-}
    readsUnary :: (Read a) => String -> (a -> t) -> String -> ReadS t
    readsUnary name cons kw s =
        [(cons x,t) | kw == name, (x,t) <- readsPrec 11 s]

    -- | @'readsUnary1' n c n'@ matches the name of a unary data constructor
    -- and then parses its argument using 'readsPrec1'.
    --
    -- @since 4.9.0.0
    {-# DEPRECATED readsUnary1 "Use readsUnaryWith to define liftReadsPrec" #-}
    readsUnary1 :: (Read1 f, Read a) => String -> (f a -> t) -> String -> ReadS t
    readsUnary1 name cons kw s =
        [(cons x,t) | kw == name, (x,t) <- readsPrec1 11 s]

    -- | @'readsBinary1' n c n'@ matches the name of a binary data constructor
    -- and then parses its arguments using 'readsPrec1'.
    --
    -- @since 4.9.0.0
    {-# DEPRECATED readsBinary1 "Use readsBinaryWith to define liftReadsPrec" #-}
    readsBinary1 :: (Read1 f, Read1 g, Read a) =>
        String -> (f a -> g a -> t) -> String -> ReadS t
    readsBinary1 name cons kw s =
        [(cons x y,u) | kw == name,
            (x,t) <- readsPrec1 11 s, (y,u) <- readsPrec1 11 t]

    -- | @'showsUnary' n d x@ produces the string representation of a unary data
    -- constructor with name @n@ and argument @x@, in precedence context @d@.
    --
    -- @since 4.9.0.0
    {-# DEPRECATED showsUnary "Use showsUnaryWith to define liftShowsPrec" #-}
    showsUnary :: (Show a) => String -> Int -> a -> ShowS
    showsUnary name d x = showParen (d > 10) $
        showString name . showChar ' ' . showsPrec 11 x

    -- | @'showsUnary1' n d x@ produces the string representation of a unary data
    -- constructor with name @n@ and argument @x@, in precedence context @d@.
    --
    -- @since 4.9.0.0
    {-# DEPRECATED showsUnary1 "Use showsUnaryWith to define liftShowsPrec" #-}
    showsUnary1 :: (Show1 f, Show a) => String -> Int -> f a -> ShowS
    showsUnary1 name d x = showParen (d > 10) $
        showString name . showChar ' ' . showsPrec1 11 x

    -- | @'showsBinary1' n d x y@ produces the string representation of a binary
    -- data constructor with name @n@ and arguments @x@ and @y@, in precedence
    -- context @d@.
    --
    -- @since 4.9.0.0
    {-# DEPRECATED showsBinary1 "Use showsBinaryWith to define liftShowsPrec" #-}
    showsBinary1 :: (Show1 f, Show1 g, Show a) =>
        String -> Int -> f a -> g a -> ShowS
    showsBinary1 name d x y = showParen (d > 10) $
        showString name . showChar ' ' . showsPrec1 11 x .
            showChar ' ' . showsPrec1 11 y

    {- $example
    These functions can be used to assemble 'Read' and 'Show' instances for
    new algebraic types.  For example, given the definition

    > data T f a = Zero a | One (f a) | Two a (f a)

    a standard 'Read1' instance may be defined as

    > instance (Read1 f) => Read1 (T f) where
    >     liftReadPrec rp rl = readData $
    >         readUnaryWith rp "Zero" Zero <|>
    >         readUnaryWith (liftReadPrec rp rl) "One" One <|>
    >         readBinaryWith rp (liftReadPrec rp rl) "Two" Two
    >     liftReadListPrec = liftReadListPrecDefault

    and the corresponding 'Show1' instance as

    > instance (Show1 f) => Show1 (T f) where
    >     liftShowsPrec sp _ d (Zero x) =
    >         showsUnaryWith sp "Zero" d x
    >     liftShowsPrec sp sl d (One x) =
    >         showsUnaryWith (liftShowsPrec sp sl) "One" d x
    >     liftShowsPrec sp sl d (Two x y) =
    >         showsBinaryWith sp (liftShowsPrec sp sl) "Two" d x y

    -}