NewRead.hs

import GHC.Read (list)

import Text.ParserCombinators.ReadPrec (ReadPrec, readPrec_to_S, readS_to_Prec)
import Text.Read (Read(..))

-- | Lifting of the 'Read' class to unary type constructors.
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.
    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.
    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.
    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'.
    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.
readsPrec1 :: (Read1 f, Read a) => Int -> ReadS (f a)
readsPrec1 = liftReadsPrec readsPrec readList

-- | Lift the standard 'readPrec' and 'readListPrec' functions through the
-- type constructor.
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'.
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'.
liftReadListPrecDefault :: Read1 f => ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrecDefault rp rl = list (liftReadPrec rp rl)

-- | Lifting of the 'Read' class to binary type constructors.
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.
    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.
    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.
    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'.
    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.
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.
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'.
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'.
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)