{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE QuantifiedConstraints #-}
module Data.Functor.Classes (
Eq1(..), eq1,
Ord1(..), compare1,
Read1(..), readsPrec1, readPrec1,
liftReadListDefault, liftReadListPrecDefault,
Show1(..), showsPrec1,
Eq2(..), eq2,
Ord2(..), compare2,
Read2(..), readsPrec2, readPrec2,
liftReadList2Default, liftReadListPrec2Default,
Show2(..), showsPrec2,
readsData, readData,
readsUnaryWith, readUnaryWith,
readsBinaryWith, readBinaryWith,
showsUnaryWith,
showsBinaryWith,
readsUnary,
readsUnary1,
readsBinary1,
showsUnary,
showsUnary1,
showsBinary1,
) where
import Control.Applicative (Alternative((<|>)), Const(Const))
import GHC.Internal.Data.Functor.Identity (Identity(Identity))
import GHC.Internal.Data.Proxy (Proxy(Proxy))
import Data.List.NonEmpty (NonEmpty(..))
import GHC.Internal.Data.Ord (Down(Down))
import Data.Complex (Complex((:+)))
import GHC.Generics (Generic1(..), Generically1(..), V1, U1(..), Par1(..), Rec1(..), K1(..), M1(..) , (:+:)(..), (:*:)(..), (:.:)(..), URec(..), UAddr, UChar, UDouble, UFloat, UInt, UWord)
import GHC.Tuple (Solo (..))
import GHC.Internal.Read (expectP, list, paren, readField)
import GHC.Internal.Show (appPrec)
import GHC.Internal.Text.ParserCombinators.ReadPrec (ReadPrec, readPrec_to_S, readS_to_Prec, pfail)
import GHC.Internal.Text.Read (Read(..), parens, prec, step, reset)
import GHC.Internal.Text.Read.Lex (Lexeme(..))
import GHC.Internal.Text.Show (showListWith)
import Prelude
class (forall a. Eq a => Eq (f a)) => Eq1 f where
liftEq :: (a -> b -> Bool) -> f a -> f b -> Bool
default liftEq
:: (f ~ f' c, Eq2 f', Eq c)
=> (a -> b -> Bool) -> f a -> f b -> Bool
liftEq = (c -> c -> Bool) -> (a -> b -> Bool) -> f' c a -> f' c b -> Bool
forall a b c d.
(a -> b -> Bool) -> (c -> d -> Bool) -> f' a c -> f' b d -> Bool
forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 c -> c -> Bool
forall a. Eq a => a -> a -> Bool
(==)
eq1 :: (Eq1 f, Eq a) => f a -> f a -> Bool
eq1 :: forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
eq1 = (a -> a -> Bool) -> f a -> f a -> Bool
forall a b. (a -> b -> Bool) -> f a -> f b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
class (Eq1 f, forall a. Ord a => Ord (f a)) => Ord1 f where
liftCompare :: (a -> b -> Ordering) -> f a -> f b -> Ordering
default liftCompare
:: (f ~ f' c, Ord2 f', Ord c)
=> (a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare = (c -> c -> Ordering)
-> (a -> b -> Ordering) -> f' c a -> f' c b -> Ordering
forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f' a c -> f' b d -> Ordering
forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 c -> c -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
compare1 :: (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1 :: forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1 = (a -> a -> Ordering) -> f a -> f a -> Ordering
forall a b. (a -> b -> Ordering) -> f a -> f b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
class (forall a. Read a => Read (f a)) => Read1 f where
{-# MINIMAL liftReadsPrec | liftReadPrec #-}
liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl = ReadPrec (f a) -> Int -> ReadS (f a)
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S (ReadPrec (f a) -> Int -> ReadS (f a))
-> ReadPrec (f a) -> Int -> ReadS (f a)
forall a b. (a -> b) -> a -> b
$
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
liftReadPrec ((Int -> ReadS a) -> ReadPrec a
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec Int -> ReadS a
rp) ((Int -> ReadS [a]) -> ReadPrec [a]
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec (ReadS [a] -> Int -> ReadS [a]
forall a b. a -> b -> a
const ReadS [a]
rl))
liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadList Int -> ReadS a
rp ReadS [a]
rl = ReadPrec [f a] -> Int -> ReadS [f a]
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S
(ReadPrec (f a) -> ReadPrec [f a]
forall a. ReadPrec a -> ReadPrec [a]
list (ReadPrec (f a) -> ReadPrec [f a])
-> ReadPrec (f a) -> ReadPrec [f a]
forall a b. (a -> b) -> a -> b
$ ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
liftReadPrec ((Int -> ReadS a) -> ReadPrec a
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec Int -> ReadS a
rp) ((Int -> ReadS [a]) -> ReadPrec [a]
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec (ReadS [a] -> Int -> ReadS [a]
forall a b. a -> b -> a
const ReadS [a]
rl))) Int
0
liftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
rl = (Int -> ReadS (f a)) -> ReadPrec (f a)
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec ((Int -> ReadS (f a)) -> ReadPrec (f a))
-> (Int -> ReadS (f a)) -> ReadPrec (f a)
forall a b. (a -> b) -> a -> b
$
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec (ReadPrec a -> Int -> ReadS a
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S ReadPrec a
rp) (ReadPrec [a] -> Int -> ReadS [a]
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S ReadPrec [a]
rl Int
0)
liftReadListPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrec ReadPrec a
rp ReadPrec [a]
rl = (Int -> ReadS [f a]) -> ReadPrec [f a]
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec ((Int -> ReadS [f a]) -> ReadPrec [f a])
-> (Int -> ReadS [f a]) -> ReadPrec [f a]
forall a b. (a -> b) -> a -> b
$ \Int
_ ->
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadList (ReadPrec a -> Int -> ReadS a
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S ReadPrec a
rp) (ReadPrec [a] -> Int -> ReadS [a]
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S ReadPrec [a]
rl Int
0)
readsPrec1 :: (Read1 f, Read a) => Int -> ReadS (f a)
readsPrec1 :: forall (f :: * -> *) a. (Read1 f, Read a) => Int -> ReadS (f a)
readsPrec1 = (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
forall a. Read a => Int -> ReadS a
readsPrec ReadS [a]
forall a. Read a => ReadS [a]
readList
readPrec1 :: (Read1 f, Read a) => ReadPrec (f a)
readPrec1 :: forall (f :: * -> *) a. (Read1 f, Read a) => ReadPrec (f a)
readPrec1 = ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
liftReadPrec ReadPrec a
forall a. Read a => ReadPrec a
readPrec ReadPrec [a]
forall a. Read a => ReadPrec [a]
readListPrec
liftReadListDefault :: Read1 f => (Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadListDefault :: forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadListDefault Int -> ReadS a
rp ReadS [a]
rl = ReadPrec [f a] -> Int -> ReadS [f a]
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S
(ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrec ((Int -> ReadS a) -> ReadPrec a
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec Int -> ReadS a
rp) ((Int -> ReadS [a]) -> ReadPrec [a]
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec (ReadS [a] -> Int -> ReadS [a]
forall a b. a -> b -> a
const ReadS [a]
rl))) Int
0
liftReadListPrecDefault :: Read1 f => ReadPrec a -> ReadPrec [a]
-> ReadPrec [f a]
liftReadListPrecDefault :: forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrecDefault ReadPrec a
rp ReadPrec [a]
rl = ReadPrec (f a) -> ReadPrec [f a]
forall a. ReadPrec a -> ReadPrec [a]
list (ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
rl)
class (forall a. Show a => Show (f a)) => Show1 f where
liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->
Int -> f a -> ShowS
default liftShowsPrec
:: (f ~ f' b, Show2 f', Show b)
=> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec = (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> f' b a
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f' a b
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> b -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [b] -> ShowS
forall a. Show a => [a] -> ShowS
showList
liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->
[f a] -> ShowS
liftShowList Int -> a -> ShowS
sp [a] -> ShowS
sl = (f a -> ShowS) -> [f a] -> ShowS
forall a. (a -> ShowS) -> [a] -> ShowS
showListWith ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
0)
showsPrec1 :: (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1 :: forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1 = (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [a] -> ShowS
forall a. Show a => [a] -> ShowS
showList
class (forall a. Eq a => Eq1 (f a)) => Eq2 f where
liftEq2 :: (a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
eq2 :: (Eq2 f, Eq a, Eq b) => f a b -> f a b -> Bool
eq2 :: forall (f :: * -> * -> *) a b.
(Eq2 f, Eq a, Eq b) =>
f a b -> f a b -> Bool
eq2 = (a -> a -> Bool) -> (b -> b -> Bool) -> f a b -> f a b -> Bool
forall a b c d.
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) b -> b -> Bool
forall a. Eq a => a -> a -> Bool
(==)
class (Eq2 f, forall a. Ord a => Ord1 (f a)) => Ord2 f where
liftCompare2 :: (a -> b -> Ordering) -> (c -> d -> Ordering) ->
f a c -> f b d -> Ordering
compare2 :: (Ord2 f, Ord a, Ord b) => f a b -> f a b -> Ordering
compare2 :: forall (f :: * -> * -> *) a b.
(Ord2 f, Ord a, Ord b) =>
f a b -> f a b -> Ordering
compare2 = (a -> a -> Ordering)
-> (b -> b -> Ordering) -> f a b -> f a b -> Ordering
forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
class (forall a. Read a => Read1 (f a)) => Read2 f where
{-# MINIMAL liftReadsPrec2 | liftReadPrec2 #-}
liftReadsPrec2 :: (Int -> ReadS a) -> ReadS [a] ->
(Int -> ReadS b) -> ReadS [b] -> Int -> ReadS (f a b)
liftReadsPrec2 Int -> ReadS a
rp1 ReadS [a]
rl1 Int -> ReadS b
rp2 ReadS [b]
rl2 = ReadPrec (f a b) -> Int -> ReadS (f a b)
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S (ReadPrec (f a b) -> Int -> ReadS (f a b))
-> ReadPrec (f a b) -> Int -> ReadS (f a b)
forall a b. (a -> b) -> a -> b
$
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec (f a b)
forall a b.
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec (f a b)
forall (f :: * -> * -> *) a b.
Read2 f =>
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec (f a b)
liftReadPrec2 ((Int -> ReadS a) -> ReadPrec a
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec Int -> ReadS a
rp1) ((Int -> ReadS [a]) -> ReadPrec [a]
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec (ReadS [a] -> Int -> ReadS [a]
forall a b. a -> b -> a
const ReadS [a]
rl1))
((Int -> ReadS b) -> ReadPrec b
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec Int -> ReadS b
rp2) ((Int -> ReadS [b]) -> ReadPrec [b]
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec (ReadS [b] -> Int -> ReadS [b]
forall a b. a -> b -> a
const ReadS [b]
rl2))
liftReadList2 :: (Int -> ReadS a) -> ReadS [a] ->
(Int -> ReadS b) -> ReadS [b] -> ReadS [f a b]
liftReadList2 Int -> ReadS a
rp1 ReadS [a]
rl1 Int -> ReadS b
rp2 ReadS [b]
rl2 = ReadPrec [f a b] -> Int -> ReadS [f a b]
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S
(ReadPrec (f a b) -> ReadPrec [f a b]
forall a. ReadPrec a -> ReadPrec [a]
list (ReadPrec (f a b) -> ReadPrec [f a b])
-> ReadPrec (f a b) -> ReadPrec [f a b]
forall a b. (a -> b) -> a -> b
$ ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec (f a b)
forall a b.
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec (f a b)
forall (f :: * -> * -> *) a b.
Read2 f =>
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec (f a b)
liftReadPrec2 ((Int -> ReadS a) -> ReadPrec a
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec Int -> ReadS a
rp1) ((Int -> ReadS [a]) -> ReadPrec [a]
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec (ReadS [a] -> Int -> ReadS [a]
forall a b. a -> b -> a
const ReadS [a]
rl1))
((Int -> ReadS b) -> ReadPrec b
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec Int -> ReadS b
rp2) ((Int -> ReadS [b]) -> ReadPrec [b]
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec (ReadS [b] -> Int -> ReadS [b]
forall a b. a -> b -> a
const ReadS [b]
rl2))) Int
0
liftReadPrec2 :: ReadPrec a -> ReadPrec [a] ->
ReadPrec b -> ReadPrec [b] -> ReadPrec (f a b)
liftReadPrec2 ReadPrec a
rp1 ReadPrec [a]
rl1 ReadPrec b
rp2 ReadPrec [b]
rl2 = (Int -> ReadS (f a b)) -> ReadPrec (f a b)
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec ((Int -> ReadS (f a b)) -> ReadPrec (f a b))
-> (Int -> ReadS (f a b)) -> ReadPrec (f a b)
forall a b. (a -> b) -> a -> b
$
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
forall a b.
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
liftReadsPrec2 (ReadPrec a -> Int -> ReadS a
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S ReadPrec a
rp1) (ReadPrec [a] -> Int -> ReadS [a]
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S ReadPrec [a]
rl1 Int
0)
(ReadPrec b -> Int -> ReadS b
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S ReadPrec b
rp2) (ReadPrec [b] -> Int -> ReadS [b]
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S ReadPrec [b]
rl2 Int
0)
liftReadListPrec2 :: ReadPrec a -> ReadPrec [a] ->
ReadPrec b -> ReadPrec [b] -> ReadPrec [f a b]
liftReadListPrec2 ReadPrec a
rp1 ReadPrec [a]
rl1 ReadPrec b
rp2 ReadPrec [b]
rl2 = (Int -> ReadS [f a b]) -> ReadPrec [f a b]
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec ((Int -> ReadS [f a b]) -> ReadPrec [f a b])
-> (Int -> ReadS [f a b]) -> ReadPrec [f a b]
forall a b. (a -> b) -> a -> b
$ \Int
_ ->
(Int -> ReadS a)
-> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [f a b]
forall a b.
(Int -> ReadS a)
-> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [f a b]
forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [f a b]
liftReadList2 (ReadPrec a -> Int -> ReadS a
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S ReadPrec a
rp1) (ReadPrec [a] -> Int -> ReadS [a]
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S ReadPrec [a]
rl1 Int
0)
(ReadPrec b -> Int -> ReadS b
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S ReadPrec b
rp2) (ReadPrec [b] -> Int -> ReadS [b]
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S ReadPrec [b]
rl2 Int
0)
readsPrec2 :: (Read2 f, Read a, Read b) => Int -> ReadS (f a b)
readsPrec2 :: forall (f :: * -> * -> *) a b.
(Read2 f, Read a, Read b) =>
Int -> ReadS (f a b)
readsPrec2 = (Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
forall a b.
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
liftReadsPrec2 Int -> ReadS a
forall a. Read a => Int -> ReadS a
readsPrec ReadS [a]
forall a. Read a => ReadS [a]
readList Int -> ReadS b
forall a. Read a => Int -> ReadS a
readsPrec ReadS [b]
forall a. Read a => ReadS [a]
readList
readPrec2 :: (Read2 f, Read a, Read b) => ReadPrec (f a b)
readPrec2 :: forall (f :: * -> * -> *) a b.
(Read2 f, Read a, Read b) =>
ReadPrec (f a b)
readPrec2 = ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec (f a b)
forall a b.
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec (f a b)
forall (f :: * -> * -> *) a b.
Read2 f =>
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec (f a b)
liftReadPrec2 ReadPrec a
forall a. Read a => ReadPrec a
readPrec ReadPrec [a]
forall a. Read a => ReadPrec [a]
readListPrec ReadPrec b
forall a. Read a => ReadPrec a
readPrec ReadPrec [b]
forall a. Read a => ReadPrec [a]
readListPrec
liftReadList2Default :: Read2 f => (Int -> ReadS a) -> ReadS [a] ->
(Int -> ReadS b) -> ReadS [b] ->ReadS [f a b]
liftReadList2Default :: forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [f a b]
liftReadList2Default Int -> ReadS a
rp1 ReadS [a]
rl1 Int -> ReadS b
rp2 ReadS [b]
rl2 = ReadPrec [f a b] -> Int -> ReadS [f a b]
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S
(ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec [f a b]
forall a b.
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec [f a b]
forall (f :: * -> * -> *) a b.
Read2 f =>
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec [f a b]
liftReadListPrec2 ((Int -> ReadS a) -> ReadPrec a
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec Int -> ReadS a
rp1) ((Int -> ReadS [a]) -> ReadPrec [a]
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec (ReadS [a] -> Int -> ReadS [a]
forall a b. a -> b -> a
const ReadS [a]
rl1))
((Int -> ReadS b) -> ReadPrec b
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec Int -> ReadS b
rp2) ((Int -> ReadS [b]) -> ReadPrec [b]
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec (ReadS [b] -> Int -> ReadS [b]
forall a b. a -> b -> a
const ReadS [b]
rl2))) Int
0
liftReadListPrec2Default :: Read2 f => ReadPrec a -> ReadPrec [a] ->
ReadPrec b -> ReadPrec [b] -> ReadPrec [f a b]
liftReadListPrec2Default :: forall (f :: * -> * -> *) a b.
Read2 f =>
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec [f a b]
liftReadListPrec2Default ReadPrec a
rp1 ReadPrec [a]
rl1 ReadPrec b
rp2 ReadPrec [b]
rl2 = ReadPrec (f a b) -> ReadPrec [f a b]
forall a. ReadPrec a -> ReadPrec [a]
list (ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec (f a b)
forall a b.
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec (f a b)
forall (f :: * -> * -> *) a b.
Read2 f =>
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec (f a b)
liftReadPrec2 ReadPrec a
rp1 ReadPrec [a]
rl1 ReadPrec b
rp2 ReadPrec [b]
rl2)
class (forall a. Show a => Show1 (f a)) => Show2 f where
liftShowsPrec2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->
(Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> f a b -> ShowS
liftShowList2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->
(Int -> b -> ShowS) -> ([b] -> ShowS) -> [f a b] -> ShowS
liftShowList2 Int -> a -> ShowS
sp1 [a] -> ShowS
sl1 Int -> b -> ShowS
sp2 [b] -> ShowS
sl2 =
(f a b -> ShowS) -> [f a b] -> ShowS
forall a. (a -> ShowS) -> [a] -> ShowS
showListWith ((Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
sp1 [a] -> ShowS
sl1 Int -> b -> ShowS
sp2 [b] -> ShowS
sl2 Int
0)
showsPrec2 :: (Show2 f, Show a, Show b) => Int -> f a b -> ShowS
showsPrec2 :: forall (f :: * -> * -> *) a b.
(Show2 f, Show a, Show b) =>
Int -> f a b -> ShowS
showsPrec2 = (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [a] -> ShowS
forall a. Show a => [a] -> ShowS
showList Int -> b -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [b] -> ShowS
forall a. Show a => [a] -> ShowS
showList
instance Eq1 Maybe where
liftEq :: forall a b. (a -> b -> Bool) -> Maybe a -> Maybe b -> Bool
liftEq a -> b -> Bool
_ Maybe a
Nothing Maybe b
Nothing = Bool
True
liftEq a -> b -> Bool
_ Maybe a
Nothing (Just b
_) = Bool
False
liftEq a -> b -> Bool
_ (Just a
_) Maybe b
Nothing = Bool
False
liftEq a -> b -> Bool
eq (Just a
x) (Just b
y) = a -> b -> Bool
eq a
x b
y
instance Ord1 Maybe where
liftCompare :: forall a b. (a -> b -> Ordering) -> Maybe a -> Maybe b -> Ordering
liftCompare a -> b -> Ordering
_ Maybe a
Nothing Maybe b
Nothing = Ordering
EQ
liftCompare a -> b -> Ordering
_ Maybe a
Nothing (Just b
_) = Ordering
LT
liftCompare a -> b -> Ordering
_ (Just a
_) Maybe b
Nothing = Ordering
GT
liftCompare a -> b -> Ordering
comp (Just a
x) (Just b
y) = a -> b -> Ordering
comp a
x b
y
instance Read1 Maybe where
liftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (Maybe a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
_ =
ReadPrec (Maybe a) -> ReadPrec (Maybe a)
forall a. ReadPrec a -> ReadPrec a
parens (Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident String
"Nothing") ReadPrec () -> ReadPrec (Maybe a) -> ReadPrec (Maybe a)
forall a b. ReadPrec a -> ReadPrec b -> ReadPrec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe a -> ReadPrec (Maybe a)
forall a. a -> ReadPrec a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing)
ReadPrec (Maybe a) -> ReadPrec (Maybe a) -> ReadPrec (Maybe a)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
ReadPrec (Maybe a) -> ReadPrec (Maybe a)
forall a. ReadPrec a -> ReadPrec a
readData (ReadPrec a -> String -> (a -> Maybe a) -> ReadPrec (Maybe a)
forall a t. ReadPrec a -> String -> (a -> t) -> ReadPrec t
readUnaryWith ReadPrec a
rp String
"Just" a -> Maybe a
forall a. a -> Maybe a
Just)
liftReadListPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [Maybe a]
liftReadListPrec = ReadPrec a -> ReadPrec [a] -> ReadPrec [Maybe a]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrecDefault
liftReadList :: forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [Maybe a]
liftReadList = (Int -> ReadS a) -> ReadS [a] -> ReadS [Maybe a]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadListDefault
instance Show1 Maybe where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Maybe a -> ShowS
liftShowsPrec Int -> a -> ShowS
_ [a] -> ShowS
_ Int
_ Maybe a
Nothing = String -> ShowS
showString String
"Nothing"
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
_ Int
d (Just a
x) = (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> a -> ShowS
sp String
"Just" Int
d a
x
instance Eq1 [] where
liftEq :: forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
liftEq a -> b -> Bool
_ [] [] = Bool
True
liftEq a -> b -> Bool
_ [] (b
_:[b]
_) = Bool
False
liftEq a -> b -> Bool
_ (a
_:[a]
_) [] = Bool
False
liftEq a -> b -> Bool
eq (a
x:[a]
xs) (b
y:[b]
ys) = a -> b -> Bool
eq a
x b
y Bool -> Bool -> Bool
&& (a -> b -> Bool) -> [a] -> [b] -> Bool
forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq [a]
xs [b]
ys
instance Ord1 [] where
liftCompare :: forall a b. (a -> b -> Ordering) -> [a] -> [b] -> Ordering
liftCompare a -> b -> Ordering
_ [] [] = Ordering
EQ
liftCompare a -> b -> Ordering
_ [] (b
_:[b]
_) = Ordering
LT
liftCompare a -> b -> Ordering
_ (a
_:[a]
_) [] = Ordering
GT
liftCompare a -> b -> Ordering
comp (a
x:[a]
xs) (b
y:[b]
ys) = a -> b -> Ordering
comp a
x b
y Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` (a -> b -> Ordering) -> [a] -> [b] -> Ordering
forall a b. (a -> b -> Ordering) -> [a] -> [b] -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
comp [a]
xs [b]
ys
instance Read1 [] where
liftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [a]
liftReadPrec ReadPrec a
_ ReadPrec [a]
rl = ReadPrec [a]
rl
liftReadListPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [[a]]
liftReadListPrec = ReadPrec a -> ReadPrec [a] -> ReadPrec [[a]]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrecDefault
liftReadList :: forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [[a]]
liftReadList = (Int -> ReadS a) -> ReadS [a] -> ReadS [[a]]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadListDefault
instance Show1 [] where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> [a] -> ShowS
liftShowsPrec Int -> a -> ShowS
_ [a] -> ShowS
sl Int
_ = [a] -> ShowS
sl
instance Eq1 NonEmpty where
liftEq :: forall a b. (a -> b -> Bool) -> NonEmpty a -> NonEmpty b -> Bool
liftEq a -> b -> Bool
eq (a
a :| [a]
as) (b
b :| [b]
bs) = a -> b -> Bool
eq a
a b
b Bool -> Bool -> Bool
&& (a -> b -> Bool) -> [a] -> [b] -> Bool
forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq [a]
as [b]
bs
instance Ord1 NonEmpty where
liftCompare :: forall a b.
(a -> b -> Ordering) -> NonEmpty a -> NonEmpty b -> Ordering
liftCompare a -> b -> Ordering
cmp (a
a :| [a]
as) (b
b :| [b]
bs) = a -> b -> Ordering
cmp a
a b
b Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` (a -> b -> Ordering) -> [a] -> [b] -> Ordering
forall a b. (a -> b -> Ordering) -> [a] -> [b] -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp [a]
as [b]
bs
instance Read1 NonEmpty where
liftReadsPrec :: forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (NonEmpty a)
liftReadsPrec Int -> ReadS a
rdP ReadS [a]
rdL Int
p String
s = Bool -> ReadS (NonEmpty a) -> ReadS (NonEmpty a)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
5) (\String
s' -> do
(a, s'') <- Int -> ReadS a
rdP Int
6 String
s'
(":|", s''') <- lex s''
(as, s'''') <- rdL s'''
return (a :| as, s'''')) String
s
instance Show1 NonEmpty where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> NonEmpty a -> ShowS
liftShowsPrec Int -> a -> ShowS
shwP [a] -> ShowS
shwL Int
p (a
a :| [a]
as) = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
5) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
Int -> a -> ShowS
shwP Int
6 a
a ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" :| " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> ShowS
shwL [a]
as
instance Eq2 (,) where
liftEq2 :: forall a b c d.
(a -> b -> Bool) -> (c -> d -> Bool) -> (a, c) -> (b, d) -> Bool
liftEq2 a -> b -> Bool
e1 c -> d -> Bool
e2 (a
x1, c
y1) (b
x2, d
y2) = a -> b -> Bool
e1 a
x1 b
x2 Bool -> Bool -> Bool
&& c -> d -> Bool
e2 c
y1 d
y2
instance Ord2 (,) where
liftCompare2 :: forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> (a, c) -> (b, d) -> Ordering
liftCompare2 a -> b -> Ordering
comp1 c -> d -> Ordering
comp2 (a
x1, c
y1) (b
x2, d
y2) =
a -> b -> Ordering
comp1 a
x1 b
x2 Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` c -> d -> Ordering
comp2 c
y1 d
y2
instance Read2 (,) where
liftReadPrec2 :: forall a b.
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec (a, b)
liftReadPrec2 ReadPrec a
rp1 ReadPrec [a]
_ ReadPrec b
rp2 ReadPrec [b]
_ = ReadPrec (a, b) -> ReadPrec (a, b)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (a, b) -> ReadPrec (a, b))
-> ReadPrec (a, b) -> ReadPrec (a, b)
forall a b. (a -> b) -> a -> b
$ ReadPrec (a, b) -> ReadPrec (a, b)
forall a. ReadPrec a -> ReadPrec a
paren (ReadPrec (a, b) -> ReadPrec (a, b))
-> ReadPrec (a, b) -> ReadPrec (a, b)
forall a b. (a -> b) -> a -> b
$ do
x <- ReadPrec a
rp1
expectP (Punc ",")
y <- rp2
return (x,y)
liftReadListPrec2 :: forall a b.
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec [(a, b)]
liftReadListPrec2 = ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec [(a, b)]
forall (f :: * -> * -> *) a b.
Read2 f =>
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec [f a b]
liftReadListPrec2Default
liftReadList2 :: forall a b.
(Int -> ReadS a)
-> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [(a, b)]
liftReadList2 = (Int -> ReadS a)
-> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [(a, b)]
forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [f a b]
liftReadList2Default
instance Show2 (,) where
liftShowsPrec2 :: forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> (a, b)
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
sp1 [a] -> ShowS
_ Int -> b -> ShowS
sp2 [b] -> ShowS
_ Int
_ (a
x, b
y) =
Char -> ShowS
showChar Char
'(' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
sp1 Int
0 a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
',' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> b -> ShowS
sp2 Int
0 b
y ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
')'
instance Eq1 Solo where
liftEq :: forall a b. (a -> b -> Bool) -> Solo a -> Solo b -> Bool
liftEq a -> b -> Bool
eq (MkSolo a
a) (MkSolo b
b) = a
a a -> b -> Bool
`eq` b
b
instance (Eq a) => Eq1 ((,) a) where
liftEq :: forall a b. (a -> b -> Bool) -> (a, a) -> (a, b) -> Bool
liftEq = (a -> a -> Bool) -> (a -> b -> Bool) -> (a, a) -> (a, b) -> Bool
forall a b c d.
(a -> b -> Bool) -> (c -> d -> Bool) -> (a, c) -> (b, d) -> Bool
forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Ord1 Solo where
liftCompare :: forall a b. (a -> b -> Ordering) -> Solo a -> Solo b -> Ordering
liftCompare a -> b -> Ordering
cmp (MkSolo a
a) (MkSolo b
b) = a -> b -> Ordering
cmp a
a b
b
instance (Ord a) => Ord1 ((,) a) where
liftCompare :: forall a b. (a -> b -> Ordering) -> (a, a) -> (a, b) -> Ordering
liftCompare = (a -> a -> Ordering)
-> (a -> b -> Ordering) -> (a, a) -> (a, b) -> Ordering
forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> (a, c) -> (b, d) -> Ordering
forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance Read1 Solo where
liftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (Solo a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
_ = ReadPrec (Solo a) -> ReadPrec (Solo a)
forall a. ReadPrec a -> ReadPrec a
readData (ReadPrec a -> String -> (a -> Solo a) -> ReadPrec (Solo a)
forall a t. ReadPrec a -> String -> (a -> t) -> ReadPrec t
readUnaryWith ReadPrec a
rp String
"MkSolo" a -> Solo a
forall a. a -> Solo a
MkSolo)
liftReadListPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [Solo a]
liftReadListPrec = ReadPrec a -> ReadPrec [a] -> ReadPrec [Solo a]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrecDefault
liftReadList :: forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [Solo a]
liftReadList = (Int -> ReadS a) -> ReadS [a] -> ReadS [Solo a]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadListDefault
instance (Read a) => Read1 ((,) a) where
liftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (a, a)
liftReadPrec = ReadPrec a
-> ReadPrec [a] -> ReadPrec a -> ReadPrec [a] -> ReadPrec (a, a)
forall a b.
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec (a, b)
forall (f :: * -> * -> *) a b.
Read2 f =>
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec (f a b)
liftReadPrec2 ReadPrec a
forall a. Read a => ReadPrec a
readPrec ReadPrec [a]
forall a. Read a => ReadPrec [a]
readListPrec
liftReadListPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [(a, a)]
liftReadListPrec = ReadPrec a -> ReadPrec [a] -> ReadPrec [(a, a)]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrecDefault
liftReadList :: forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [(a, a)]
liftReadList = (Int -> ReadS a) -> ReadS [a] -> ReadS [(a, a)]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadListDefault
instance Show1 Solo where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Solo a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
_ Int
d (MkSolo a
x) = (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> a -> ShowS
sp String
"MkSolo" Int
d a
x
instance (Show a) => Show1 ((,) a) where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> (a, a) -> ShowS
liftShowsPrec = (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> (a, a)
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> (a, b)
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [a] -> ShowS
forall a. Show a => [a] -> ShowS
showList
instance Eq a => Eq2 ((,,) a) where
liftEq2 :: forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> (a, a, c) -> (a, b, d) -> Bool
liftEq2 a -> b -> Bool
e1 c -> d -> Bool
e2 (a
u1, a
x1, c
y1) (a
v1, b
x2, d
y2) =
a
u1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
v1 Bool -> Bool -> Bool
&&
a -> b -> Bool
e1 a
x1 b
x2 Bool -> Bool -> Bool
&& c -> d -> Bool
e2 c
y1 d
y2
instance Ord a => Ord2 ((,,) a) where
liftCompare2 :: forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> (a, a, c) -> (a, b, d) -> Ordering
liftCompare2 a -> b -> Ordering
comp1 c -> d -> Ordering
comp2 (a
u1, a
x1, c
y1) (a
v1, b
x2, d
y2) =
a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
u1 a
v1 Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend`
a -> b -> Ordering
comp1 a
x1 b
x2 Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` c -> d -> Ordering
comp2 c
y1 d
y2
instance Read a => Read2 ((,,) a) where
liftReadPrec2 :: forall a b.
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec (a, a, b)
liftReadPrec2 ReadPrec a
rp1 ReadPrec [a]
_ ReadPrec b
rp2 ReadPrec [b]
_ = ReadPrec (a, a, b) -> ReadPrec (a, a, b)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (a, a, b) -> ReadPrec (a, a, b))
-> ReadPrec (a, a, b) -> ReadPrec (a, a, b)
forall a b. (a -> b) -> a -> b
$ ReadPrec (a, a, b) -> ReadPrec (a, a, b)
forall a. ReadPrec a -> ReadPrec a
paren (ReadPrec (a, a, b) -> ReadPrec (a, a, b))
-> ReadPrec (a, a, b) -> ReadPrec (a, a, b)
forall a b. (a -> b) -> a -> b
$ do
x1 <- ReadPrec a
forall a. Read a => ReadPrec a
readPrec
expectP (Punc ",")
y1 <- rp1
expectP (Punc ",")
y2 <- rp2
return (x1,y1,y2)
liftReadListPrec2 :: forall a b.
ReadPrec a
-> ReadPrec [a]
-> ReadPrec b
-> ReadPrec [b]
-> ReadPrec [(a, a, b)]
liftReadListPrec2 = ReadPrec a
-> ReadPrec [a]
-> ReadPrec b
-> ReadPrec [b]
-> ReadPrec [(a, a, b)]
forall (f :: * -> * -> *) a b.
Read2 f =>
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec [f a b]
liftReadListPrec2Default
liftReadList2 :: forall a b.
(Int -> ReadS a)
-> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [(a, a, b)]
liftReadList2 = (Int -> ReadS a)
-> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [(a, a, b)]
forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [f a b]
liftReadList2Default
instance Show a => Show2 ((,,) a) where
liftShowsPrec2 :: forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> (a, a, b)
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
sp1 [a] -> ShowS
_ Int -> b -> ShowS
sp2 [b] -> ShowS
_ Int
_ (a
x1,a
y1,b
y2)
= Char -> ShowS
showChar Char
'(' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 a
x1
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
',' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
sp1 Int
0 a
y1
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
',' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> b -> ShowS
sp2 Int
0 b
y2
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
')'
instance (Eq a, Eq b) => Eq1 ((,,) a b) where
liftEq :: forall a b. (a -> b -> Bool) -> (a, b, a) -> (a, b, b) -> Bool
liftEq = (b -> b -> Bool)
-> (a -> b -> Bool) -> (a, b, a) -> (a, b, b) -> Bool
forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> (a, a, c) -> (a, b, d) -> Bool
forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 b -> b -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance (Ord a, Ord b) => Ord1 ((,,) a b) where
liftCompare :: forall a b.
(a -> b -> Ordering) -> (a, b, a) -> (a, b, b) -> Ordering
liftCompare = (b -> b -> Ordering)
-> (a -> b -> Ordering) -> (a, b, a) -> (a, b, b) -> Ordering
forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> (a, a, c) -> (a, b, d) -> Ordering
forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance (Read a, Read b) => Read1 ((,,) a b) where
liftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (a, b, a)
liftReadPrec = ReadPrec b
-> ReadPrec [b] -> ReadPrec a -> ReadPrec [a] -> ReadPrec (a, b, a)
forall a b.
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec (a, a, b)
forall (f :: * -> * -> *) a b.
Read2 f =>
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec (f a b)
liftReadPrec2 ReadPrec b
forall a. Read a => ReadPrec a
readPrec ReadPrec [b]
forall a. Read a => ReadPrec [a]
readListPrec
liftReadListPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [(a, b, a)]
liftReadListPrec = ReadPrec a -> ReadPrec [a] -> ReadPrec [(a, b, a)]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrecDefault
liftReadList :: forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [(a, b, a)]
liftReadList = (Int -> ReadS a) -> ReadS [a] -> ReadS [(a, b, a)]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadListDefault
instance (Show a, Show b) => Show1 ((,,) a b) where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> (a, b, a) -> ShowS
liftShowsPrec = (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> (a, b, a)
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> (a, a, b)
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> b -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [b] -> ShowS
forall a. Show a => [a] -> ShowS
showList
instance (Eq a, Eq b) => Eq2 ((,,,) a b) where
liftEq2 :: forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> (a, b, a, c) -> (a, b, b, d) -> Bool
liftEq2 a -> b -> Bool
e1 c -> d -> Bool
e2 (a
u1, b
u2, a
x1, c
y1) (a
v1, b
v2, b
x2, d
y2) =
a
u1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
v1 Bool -> Bool -> Bool
&&
b
u2 b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
v2 Bool -> Bool -> Bool
&&
a -> b -> Bool
e1 a
x1 b
x2 Bool -> Bool -> Bool
&& c -> d -> Bool
e2 c
y1 d
y2
instance (Ord a, Ord b) => Ord2 ((,,,) a b) where
liftCompare2 :: forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> (a, b, a, c) -> (a, b, b, d) -> Ordering
liftCompare2 a -> b -> Ordering
comp1 c -> d -> Ordering
comp2 (a
u1, b
u2, a
x1, c
y1) (a
v1, b
v2, b
x2, d
y2) =
a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
u1 a
v1 Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend`
b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare b
u2 b
v2 Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend`
a -> b -> Ordering
comp1 a
x1 b
x2 Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` c -> d -> Ordering
comp2 c
y1 d
y2
instance (Read a, Read b) => Read2 ((,,,) a b) where
liftReadPrec2 :: forall a b.
ReadPrec a
-> ReadPrec [a]
-> ReadPrec b
-> ReadPrec [b]
-> ReadPrec (a, b, a, b)
liftReadPrec2 ReadPrec a
rp1 ReadPrec [a]
_ ReadPrec b
rp2 ReadPrec [b]
_ = ReadPrec (a, b, a, b) -> ReadPrec (a, b, a, b)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (a, b, a, b) -> ReadPrec (a, b, a, b))
-> ReadPrec (a, b, a, b) -> ReadPrec (a, b, a, b)
forall a b. (a -> b) -> a -> b
$ ReadPrec (a, b, a, b) -> ReadPrec (a, b, a, b)
forall a. ReadPrec a -> ReadPrec a
paren (ReadPrec (a, b, a, b) -> ReadPrec (a, b, a, b))
-> ReadPrec (a, b, a, b) -> ReadPrec (a, b, a, b)
forall a b. (a -> b) -> a -> b
$ do
x1 <- ReadPrec a
forall a. Read a => ReadPrec a
readPrec
expectP (Punc ",")
x2 <- readPrec
expectP (Punc ",")
y1 <- rp1
expectP (Punc ",")
y2 <- rp2
return (x1,x2,y1,y2)
liftReadListPrec2 :: forall a b.
ReadPrec a
-> ReadPrec [a]
-> ReadPrec b
-> ReadPrec [b]
-> ReadPrec [(a, b, a, b)]
liftReadListPrec2 = ReadPrec a
-> ReadPrec [a]
-> ReadPrec b
-> ReadPrec [b]
-> ReadPrec [(a, b, a, b)]
forall (f :: * -> * -> *) a b.
Read2 f =>
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec [f a b]
liftReadListPrec2Default
liftReadList2 :: forall a b.
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> ReadS [(a, b, a, b)]
liftReadList2 = (Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> ReadS [(a, b, a, b)]
forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [f a b]
liftReadList2Default
instance (Show a, Show b) => Show2 ((,,,) a b) where
liftShowsPrec2 :: forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> (a, b, a, b)
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
sp1 [a] -> ShowS
_ Int -> b -> ShowS
sp2 [b] -> ShowS
_ Int
_ (a
x1,b
x2,a
y1,b
y2)
= Char -> ShowS
showChar Char
'(' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 a
x1
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
',' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> b -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 b
x2
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
',' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
sp1 Int
0 a
y1
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
',' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> b -> ShowS
sp2 Int
0 b
y2
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
')'
instance (Eq a, Eq b, Eq c) => Eq1 ((,,,) a b c) where
liftEq :: forall a b.
(a -> b -> Bool) -> (a, b, c, a) -> (a, b, c, b) -> Bool
liftEq = (c -> c -> Bool)
-> (a -> b -> Bool) -> (a, b, c, a) -> (a, b, c, b) -> Bool
forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> (a, b, a, c) -> (a, b, b, d) -> Bool
forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 c -> c -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance (Ord a, Ord b, Ord c) => Ord1 ((,,,) a b c) where
liftCompare :: forall a b.
(a -> b -> Ordering) -> (a, b, c, a) -> (a, b, c, b) -> Ordering
liftCompare = (c -> c -> Ordering)
-> (a -> b -> Ordering) -> (a, b, c, a) -> (a, b, c, b) -> Ordering
forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> (a, b, a, c) -> (a, b, b, d) -> Ordering
forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 c -> c -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance (Read a, Read b, Read c) => Read1 ((,,,) a b c) where
liftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (a, b, c, a)
liftReadPrec = ReadPrec c
-> ReadPrec [c]
-> ReadPrec a
-> ReadPrec [a]
-> ReadPrec (a, b, c, a)
forall a b.
ReadPrec a
-> ReadPrec [a]
-> ReadPrec b
-> ReadPrec [b]
-> ReadPrec (a, b, a, b)
forall (f :: * -> * -> *) a b.
Read2 f =>
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec (f a b)
liftReadPrec2 ReadPrec c
forall a. Read a => ReadPrec a
readPrec ReadPrec [c]
forall a. Read a => ReadPrec [a]
readListPrec
liftReadListPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [(a, b, c, a)]
liftReadListPrec = ReadPrec a -> ReadPrec [a] -> ReadPrec [(a, b, c, a)]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrecDefault
liftReadList :: forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [(a, b, c, a)]
liftReadList = (Int -> ReadS a) -> ReadS [a] -> ReadS [(a, b, c, a)]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadListDefault
instance (Show a, Show b, Show c) => Show1 ((,,,) a b c) where
liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> (a, b, c, a) -> ShowS
liftShowsPrec = (Int -> c -> ShowS)
-> ([c] -> ShowS)
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> (a, b, c, a)
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> (a, b, a, b)
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> c -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [c] -> ShowS
forall a. Show a => [a] -> ShowS
showList
instance (Generic1 f, Eq1 (Rep1 f)) => Eq1 (Generically1 f) where
liftEq :: (a1 -> a2 -> Bool) -> (Generically1 f a1 -> Generically1 f a2 -> Bool)
liftEq :: forall a b.
(a -> b -> Bool) -> Generically1 f a -> Generically1 f b -> Bool
liftEq a1 -> a2 -> Bool
(===) (Generically1 f a1
as1) (Generically1 f a2
as2) = (a1 -> a2 -> Bool) -> Rep1 f a1 -> Rep1 f a2 -> Bool
forall a b. (a -> b -> Bool) -> Rep1 f a -> Rep1 f b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a1 -> a2 -> Bool
(===) (f a1 -> Rep1 f a1
forall a. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f a1
as1) (f a2 -> Rep1 f a2
forall a. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f a2
as2)
instance (Generic1 f, Ord1 (Rep1 f)) => Ord1 (Generically1 f) where
liftCompare :: (a1 -> a2 -> Ordering) -> (Generically1 f a1 -> Generically1 f a2 -> Ordering)
liftCompare :: forall a b.
(a -> b -> Ordering)
-> Generically1 f a -> Generically1 f b -> Ordering
liftCompare a1 -> a2 -> Ordering
cmp (Generically1 f a1
as1) (Generically1 f a2
as2) = (a1 -> a2 -> Ordering) -> Rep1 f a1 -> Rep1 f a2 -> Ordering
forall a b.
(a -> b -> Ordering) -> Rep1 f a -> Rep1 f b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a1 -> a2 -> Ordering
cmp (f a1 -> Rep1 f a1
forall a. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f a1
as1) (f a2 -> Rep1 f a2
forall a. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f a2
as2)
instance Eq2 Either where
liftEq2 :: forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> Either a c -> Either b d -> Bool
liftEq2 a -> b -> Bool
e1 c -> d -> Bool
_ (Left a
x) (Left b
y) = a -> b -> Bool
e1 a
x b
y
liftEq2 a -> b -> Bool
_ c -> d -> Bool
_ (Left a
_) (Right d
_) = Bool
False
liftEq2 a -> b -> Bool
_ c -> d -> Bool
_ (Right c
_) (Left b
_) = Bool
False
liftEq2 a -> b -> Bool
_ c -> d -> Bool
e2 (Right c
x) (Right d
y) = c -> d -> Bool
e2 c
x d
y
instance Ord2 Either where
liftCompare2 :: forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> Either a c -> Either b d -> Ordering
liftCompare2 a -> b -> Ordering
comp1 c -> d -> Ordering
_ (Left a
x) (Left b
y) = a -> b -> Ordering
comp1 a
x b
y
liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
_ (Left a
_) (Right d
_) = Ordering
LT
liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
_ (Right c
_) (Left b
_) = Ordering
GT
liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
comp2 (Right c
x) (Right d
y) = c -> d -> Ordering
comp2 c
x d
y
instance Read2 Either where
liftReadPrec2 :: forall a b.
ReadPrec a
-> ReadPrec [a]
-> ReadPrec b
-> ReadPrec [b]
-> ReadPrec (Either a b)
liftReadPrec2 ReadPrec a
rp1 ReadPrec [a]
_ ReadPrec b
rp2 ReadPrec [b]
_ = ReadPrec (Either a b) -> ReadPrec (Either a b)
forall a. ReadPrec a -> ReadPrec a
readData (ReadPrec (Either a b) -> ReadPrec (Either a b))
-> ReadPrec (Either a b) -> ReadPrec (Either a b)
forall a b. (a -> b) -> a -> b
$
ReadPrec a -> String -> (a -> Either a b) -> ReadPrec (Either a b)
forall a t. ReadPrec a -> String -> (a -> t) -> ReadPrec t
readUnaryWith ReadPrec a
rp1 String
"Left" a -> Either a b
forall a b. a -> Either a b
Left ReadPrec (Either a b)
-> ReadPrec (Either a b) -> ReadPrec (Either a b)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
ReadPrec b -> String -> (b -> Either a b) -> ReadPrec (Either a b)
forall a t. ReadPrec a -> String -> (a -> t) -> ReadPrec t
readUnaryWith ReadPrec b
rp2 String
"Right" b -> Either a b
forall a b. b -> Either a b
Right
liftReadListPrec2 :: forall a b.
ReadPrec a
-> ReadPrec [a]
-> ReadPrec b
-> ReadPrec [b]
-> ReadPrec [Either a b]
liftReadListPrec2 = ReadPrec a
-> ReadPrec [a]
-> ReadPrec b
-> ReadPrec [b]
-> ReadPrec [Either a b]
forall (f :: * -> * -> *) a b.
Read2 f =>
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec [f a b]
liftReadListPrec2Default
liftReadList2 :: forall a b.
(Int -> ReadS a)
-> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [Either a b]
liftReadList2 = (Int -> ReadS a)
-> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [Either a b]
forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [f a b]
liftReadList2Default
instance Show2 Either where
liftShowsPrec2 :: forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> Either a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
sp1 [a] -> ShowS
_ Int -> b -> ShowS
_ [b] -> ShowS
_ Int
d (Left a
x) = (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> a -> ShowS
sp1 String
"Left" Int
d a
x
liftShowsPrec2 Int -> a -> ShowS
_ [a] -> ShowS
_ Int -> b -> ShowS
sp2 [b] -> ShowS
_ Int
d (Right b
x) = (Int -> b -> ShowS) -> String -> Int -> b -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> b -> ShowS
sp2 String
"Right" Int
d b
x
instance (Eq a) => Eq1 (Either a) where
liftEq :: forall a b. (a -> b -> Bool) -> Either a a -> Either a b -> Bool
liftEq = (a -> a -> Bool)
-> (a -> b -> Bool) -> Either a a -> Either a b -> Bool
forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> Either a c -> Either b d -> Bool
forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance (Ord a) => Ord1 (Either a) where
liftCompare :: forall a b.
(a -> b -> Ordering) -> Either a a -> Either a b -> Ordering
liftCompare = (a -> a -> Ordering)
-> (a -> b -> Ordering) -> Either a a -> Either a b -> Ordering
forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> Either a c -> Either b d -> Ordering
forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance (Read a) => Read1 (Either a) where
liftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (Either a a)
liftReadPrec = ReadPrec a
-> ReadPrec [a]
-> ReadPrec a
-> ReadPrec [a]
-> ReadPrec (Either a a)
forall a b.
ReadPrec a
-> ReadPrec [a]
-> ReadPrec b
-> ReadPrec [b]
-> ReadPrec (Either a b)
forall (f :: * -> * -> *) a b.
Read2 f =>
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec (f a b)
liftReadPrec2 ReadPrec a
forall a. Read a => ReadPrec a
readPrec ReadPrec [a]
forall a. Read a => ReadPrec [a]
readListPrec
liftReadListPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [Either a a]
liftReadListPrec = ReadPrec a -> ReadPrec [a] -> ReadPrec [Either a a]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrecDefault
liftReadList :: forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [Either a a]
liftReadList = (Int -> ReadS a) -> ReadS [a] -> ReadS [Either a a]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadListDefault
instance (Show a) => Show1 (Either a) where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Either a a -> ShowS
liftShowsPrec = (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> Either a a
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> Either a b
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [a] -> ShowS
forall a. Show a => [a] -> ShowS
showList
instance Eq1 Identity where
liftEq :: forall a b. (a -> b -> Bool) -> Identity a -> Identity b -> Bool
liftEq a -> b -> Bool
eq (Identity a
x) (Identity b
y) = a -> b -> Bool
eq a
x b
y
instance Ord1 Identity where
liftCompare :: forall a b.
(a -> b -> Ordering) -> Identity a -> Identity b -> Ordering
liftCompare a -> b -> Ordering
comp (Identity a
x) (Identity b
y) = a -> b -> Ordering
comp a
x b
y
instance Read1 Identity where
liftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (Identity a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
_ = ReadPrec (Identity a) -> ReadPrec (Identity a)
forall a. ReadPrec a -> ReadPrec a
readData (ReadPrec (Identity a) -> ReadPrec (Identity a))
-> ReadPrec (Identity a) -> ReadPrec (Identity a)
forall a b. (a -> b) -> a -> b
$
ReadPrec a -> String -> (a -> Identity a) -> ReadPrec (Identity a)
forall a t. ReadPrec a -> String -> (a -> t) -> ReadPrec t
readUnaryWith ReadPrec a
rp String
"Identity" a -> Identity a
forall a. a -> Identity a
Identity
liftReadListPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [Identity a]
liftReadListPrec = ReadPrec a -> ReadPrec [a] -> ReadPrec [Identity a]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrecDefault
liftReadList :: forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [Identity a]
liftReadList = (Int -> ReadS a) -> ReadS [a] -> ReadS [Identity a]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadListDefault
instance Show1 Identity where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Identity a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
_ Int
d (Identity a
x) = (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> a -> ShowS
sp String
"Identity" Int
d a
x
instance Eq2 Const where
liftEq2 :: forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> Const a c -> Const b d -> Bool
liftEq2 a -> b -> Bool
eq c -> d -> Bool
_ (Const a
x) (Const b
y) = a -> b -> Bool
eq a
x b
y
instance Ord2 Const where
liftCompare2 :: forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> Const a c -> Const b d -> Ordering
liftCompare2 a -> b -> Ordering
comp c -> d -> Ordering
_ (Const a
x) (Const b
y) = a -> b -> Ordering
comp a
x b
y
instance Read2 Const where
liftReadPrec2 :: forall a b.
ReadPrec a
-> ReadPrec [a]
-> ReadPrec b
-> ReadPrec [b]
-> ReadPrec (Const a b)
liftReadPrec2 ReadPrec a
rp ReadPrec [a]
_ ReadPrec b
_ ReadPrec [b]
_ = ReadPrec (Const a b) -> ReadPrec (Const a b)
forall a. ReadPrec a -> ReadPrec a
readData (ReadPrec (Const a b) -> ReadPrec (Const a b))
-> ReadPrec (Const a b) -> ReadPrec (Const a b)
forall a b. (a -> b) -> a -> b
$
ReadPrec a -> String -> (a -> Const a b) -> ReadPrec (Const a b)
forall a t. ReadPrec a -> String -> (a -> t) -> ReadPrec t
readUnaryWith ReadPrec a
rp String
"Const" a -> Const a b
forall {k} a (b :: k). a -> Const a b
Const
liftReadListPrec2 :: forall a b.
ReadPrec a
-> ReadPrec [a]
-> ReadPrec b
-> ReadPrec [b]
-> ReadPrec [Const a b]
liftReadListPrec2 = ReadPrec a
-> ReadPrec [a]
-> ReadPrec b
-> ReadPrec [b]
-> ReadPrec [Const a b]
forall (f :: * -> * -> *) a b.
Read2 f =>
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec [f a b]
liftReadListPrec2Default
liftReadList2 :: forall a b.
(Int -> ReadS a)
-> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [Const a b]
liftReadList2 = (Int -> ReadS a)
-> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [Const a b]
forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [f a b]
liftReadList2Default
instance Show2 Const where
liftShowsPrec2 :: forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> Const a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
sp [a] -> ShowS
_ Int -> b -> ShowS
_ [b] -> ShowS
_ Int
d (Const a
x) = (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> a -> ShowS
sp String
"Const" Int
d a
x
instance (Eq a) => Eq1 (Const a) where
liftEq :: forall a b. (a -> b -> Bool) -> Const a a -> Const a b -> Bool
liftEq = (a -> a -> Bool)
-> (a -> b -> Bool) -> Const a a -> Const a b -> Bool
forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> Const a c -> Const b d -> Bool
forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance (Ord a) => Ord1 (Const a) where
liftCompare :: forall a b.
(a -> b -> Ordering) -> Const a a -> Const a b -> Ordering
liftCompare = (a -> a -> Ordering)
-> (a -> b -> Ordering) -> Const a a -> Const a b -> Ordering
forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> Const a c -> Const b d -> Ordering
forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance (Read a) => Read1 (Const a) where
liftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (Const a a)
liftReadPrec = ReadPrec a
-> ReadPrec [a]
-> ReadPrec a
-> ReadPrec [a]
-> ReadPrec (Const a a)
forall a b.
ReadPrec a
-> ReadPrec [a]
-> ReadPrec b
-> ReadPrec [b]
-> ReadPrec (Const a b)
forall (f :: * -> * -> *) a b.
Read2 f =>
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec (f a b)
liftReadPrec2 ReadPrec a
forall a. Read a => ReadPrec a
readPrec ReadPrec [a]
forall a. Read a => ReadPrec [a]
readListPrec
liftReadListPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [Const a a]
liftReadListPrec = ReadPrec a -> ReadPrec [a] -> ReadPrec [Const a a]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrecDefault
liftReadList :: forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [Const a a]
liftReadList = (Int -> ReadS a) -> ReadS [a] -> ReadS [Const a a]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadListDefault
instance (Show a) => Show1 (Const a) where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Const a a -> ShowS
liftShowsPrec = (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> Const a a
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> Const a b
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [a] -> ShowS
forall a. Show a => [a] -> ShowS
showList
instance Eq1 Proxy where
liftEq :: forall a b. (a -> b -> Bool) -> Proxy a -> Proxy b -> Bool
liftEq a -> b -> Bool
_ Proxy a
_ Proxy b
_ = Bool
True
instance Ord1 Proxy where
liftCompare :: forall a b. (a -> b -> Ordering) -> Proxy a -> Proxy b -> Ordering
liftCompare a -> b -> Ordering
_ Proxy a
_ Proxy b
_ = Ordering
EQ
instance Show1 Proxy where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Proxy a -> ShowS
liftShowsPrec Int -> a -> ShowS
_ [a] -> ShowS
_ Int
_ Proxy a
_ = String -> ShowS
showString String
"Proxy"
instance Read1 Proxy where
liftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (Proxy a)
liftReadPrec ReadPrec a
_ ReadPrec [a]
_ = ReadPrec (Proxy a) -> ReadPrec (Proxy a)
forall a. ReadPrec a -> ReadPrec a
parens (Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident String
"Proxy") ReadPrec () -> ReadPrec (Proxy a) -> ReadPrec (Proxy a)
forall a b. ReadPrec a -> ReadPrec b -> ReadPrec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Proxy a -> ReadPrec (Proxy a)
forall a. a -> ReadPrec a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Proxy a
forall {k} (t :: k). Proxy t
Proxy)
liftReadListPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [Proxy a]
liftReadListPrec = ReadPrec a -> ReadPrec [a] -> ReadPrec [Proxy a]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrecDefault
liftReadList :: forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [Proxy a]
liftReadList = (Int -> ReadS a) -> ReadS [a] -> ReadS [Proxy a]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadListDefault
instance Eq1 Down where
liftEq :: forall a b. (a -> b -> Bool) -> Down a -> Down b -> Bool
liftEq a -> b -> Bool
eq (Down a
x) (Down b
y) = a -> b -> Bool
eq a
x b
y
instance Ord1 Down where
liftCompare :: forall a b. (a -> b -> Ordering) -> Down a -> Down b -> Ordering
liftCompare a -> b -> Ordering
comp (Down a
x) (Down b
y) = case a -> b -> Ordering
comp a
x b
y of
Ordering
LT -> Ordering
GT
Ordering
EQ -> Ordering
EQ
Ordering
GT -> Ordering
LT
instance Read1 Down where
liftReadsPrec :: forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Down a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
_ = (String -> ReadS (Down a)) -> Int -> ReadS (Down a)
forall a. (String -> ReadS a) -> Int -> ReadS a
readsData ((String -> ReadS (Down a)) -> Int -> ReadS (Down a))
-> (String -> ReadS (Down a)) -> Int -> ReadS (Down a)
forall a b. (a -> b) -> a -> b
$
(Int -> ReadS a)
-> String -> (a -> Down a) -> String -> ReadS (Down a)
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith Int -> ReadS a
rp String
"Down" a -> Down a
forall a. a -> Down a
Down
instance Show1 Down where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Down a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
_ Int
d (Down a
x) = (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> a -> ShowS
sp String
"Down" Int
d a
x
instance Eq1 Complex where
liftEq :: forall a b. (a -> b -> Bool) -> Complex a -> Complex b -> Bool
liftEq a -> b -> Bool
eq (a
x :+ a
y) (b
u :+ b
v) = a -> b -> Bool
eq a
x b
u Bool -> Bool -> Bool
&& a -> b -> Bool
eq a
y b
v
instance Read1 Complex where
liftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (Complex a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
_ = ReadPrec (Complex a) -> ReadPrec (Complex a)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (Complex a) -> ReadPrec (Complex a))
-> ReadPrec (Complex a) -> ReadPrec (Complex a)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (Complex a) -> ReadPrec (Complex a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
complexPrec (ReadPrec (Complex a) -> ReadPrec (Complex a))
-> ReadPrec (Complex a) -> ReadPrec (Complex a)
forall a b. (a -> b) -> a -> b
$ do
x <- ReadPrec a -> ReadPrec a
forall a. ReadPrec a -> ReadPrec a
step ReadPrec a
rp
expectP (Symbol ":+")
y <- step rp
return (x :+ y)
where
complexPrec :: Int
complexPrec = Int
6
liftReadListPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [Complex a]
liftReadListPrec = ReadPrec a -> ReadPrec [a] -> ReadPrec [Complex a]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrecDefault
liftReadList :: forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [Complex a]
liftReadList = (Int -> ReadS a) -> ReadS [a] -> ReadS [Complex a]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadListDefault
instance Show1 Complex where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Complex a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
_ Int
d (a
x :+ a
y) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
complexPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
Int -> a -> ShowS
sp (Int
complexPrecInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" :+ " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
sp (Int
complexPrecInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
y
where
complexPrec :: Int
complexPrec = Int
6
readsData :: (String -> ReadS a) -> Int -> ReadS a
readsData :: forall a. (String -> ReadS a) -> Int -> ReadS a
readsData String -> ReadS a
reader Int
d =
Bool -> ReadS a -> ReadS a
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ReadS a -> ReadS a) -> ReadS a -> ReadS a
forall a b. (a -> b) -> a -> b
$ \ String
r -> [(a, String)
res | (String
kw,String
s) <- ReadS String
lex String
r, (a, String)
res <- String -> ReadS a
reader String
kw String
s]
readData :: ReadPrec a -> ReadPrec a
readData :: forall a. ReadPrec a -> ReadPrec a
readData ReadPrec a
reader = ReadPrec a -> ReadPrec a
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec a -> ReadPrec a) -> ReadPrec a -> ReadPrec a
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec a -> ReadPrec a
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 ReadPrec a
reader
readsUnaryWith :: (Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith :: forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith Int -> ReadS a
rp String
name a -> t
cons String
kw String
s =
[(a -> t
cons a
x,String
t) | String
kw String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name, (a
x,String
t) <- Int -> ReadS a
rp Int
11 String
s]
readUnaryWith :: ReadPrec a -> String -> (a -> t) -> ReadPrec t
readUnaryWith :: forall a t. ReadPrec a -> String -> (a -> t) -> ReadPrec t
readUnaryWith ReadPrec a
rp String
name a -> t
cons = do
Lexeme -> ReadPrec ()
expectP (Lexeme -> ReadPrec ()) -> Lexeme -> ReadPrec ()
forall a b. (a -> b) -> a -> b
$ String -> Lexeme
Ident String
name
x <- ReadPrec a -> ReadPrec a
forall a. ReadPrec a -> ReadPrec a
step ReadPrec a
rp
return $ cons x
readsBinaryWith :: (Int -> ReadS a) -> (Int -> ReadS b) ->
String -> (a -> b -> t) -> String -> ReadS t
readsBinaryWith :: forall a b t.
(Int -> ReadS a)
-> (Int -> ReadS b) -> String -> (a -> b -> t) -> String -> ReadS t
readsBinaryWith Int -> ReadS a
rp1 Int -> ReadS b
rp2 String
name a -> b -> t
cons String
kw String
s =
[(a -> b -> t
cons a
x b
y,String
u) | String
kw String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name, (a
x,String
t) <- Int -> ReadS a
rp1 Int
11 String
s, (b
y,String
u) <- Int -> ReadS b
rp2 Int
11 String
t]
readBinaryWith :: ReadPrec a -> ReadPrec b ->
String -> (a -> b -> t) -> ReadPrec t
readBinaryWith :: forall a b t.
ReadPrec a -> ReadPrec b -> String -> (a -> b -> t) -> ReadPrec t
readBinaryWith ReadPrec a
rp1 ReadPrec b
rp2 String
name a -> b -> t
cons = do
Lexeme -> ReadPrec ()
expectP (Lexeme -> ReadPrec ()) -> Lexeme -> ReadPrec ()
forall a b. (a -> b) -> a -> b
$ String -> Lexeme
Ident String
name
x <- ReadPrec a -> ReadPrec a
forall a. ReadPrec a -> ReadPrec a
step ReadPrec a
rp1
y <- step rp2
return $ cons x y
showsUnaryWith :: (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith :: forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> a -> ShowS
sp String
name Int
d a
x = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
name ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
sp Int
11 a
x
showsBinaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) ->
String -> Int -> a -> b -> ShowS
showsBinaryWith :: forall a b.
(Int -> a -> ShowS)
-> (Int -> b -> ShowS) -> String -> Int -> a -> b -> ShowS
showsBinaryWith Int -> a -> ShowS
sp1 Int -> b -> ShowS
sp2 String
name Int
d a
x b
y = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
name ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
sp1 Int
11 a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> b -> ShowS
sp2 Int
11 b
y
{-# DEPRECATED readsUnary "Use 'readsUnaryWith' to define 'liftReadsPrec'" #-}
readsUnary :: (Read a) => String -> (a -> t) -> String -> ReadS t
readsUnary :: forall a t. Read a => String -> (a -> t) -> String -> ReadS t
readsUnary String
name a -> t
cons String
kw String
s =
[(a -> t
cons a
x,String
t) | String
kw String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name, (a
x,String
t) <- Int -> ReadS a
forall a. Read a => Int -> ReadS a
readsPrec Int
11 String
s]
{-# DEPRECATED readsUnary1 "Use 'readsUnaryWith' to define 'liftReadsPrec'" #-}
readsUnary1 :: (Read1 f, Read a) => String -> (f a -> t) -> String -> ReadS t
readsUnary1 :: forall (f :: * -> *) a t.
(Read1 f, Read a) =>
String -> (f a -> t) -> String -> ReadS t
readsUnary1 String
name f a -> t
cons String
kw String
s =
[(f a -> t
cons f a
x,String
t) | String
kw String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name, (f a
x,String
t) <- Int -> ReadS (f a)
forall (f :: * -> *) a. (Read1 f, Read a) => Int -> ReadS (f a)
readsPrec1 Int
11 String
s]
{-# DEPRECATED readsBinary1
"Use 'readsBinaryWith' to define 'liftReadsPrec'" #-}
readsBinary1 :: (Read1 f, Read1 g, Read a) =>
String -> (f a -> g a -> t) -> String -> ReadS t
readsBinary1 :: forall (f :: * -> *) (g :: * -> *) a t.
(Read1 f, Read1 g, Read a) =>
String -> (f a -> g a -> t) -> String -> ReadS t
readsBinary1 String
name f a -> g a -> t
cons String
kw String
s =
[(f a -> g a -> t
cons f a
x g a
y,String
u) | String
kw String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name,
(f a
x,String
t) <- Int -> ReadS (f a)
forall (f :: * -> *) a. (Read1 f, Read a) => Int -> ReadS (f a)
readsPrec1 Int
11 String
s, (g a
y,String
u) <- Int -> ReadS (g a)
forall (f :: * -> *) a. (Read1 f, Read a) => Int -> ReadS (f a)
readsPrec1 Int
11 String
t]
{-# DEPRECATED showsUnary "Use 'showsUnaryWith' to define 'liftShowsPrec'" #-}
showsUnary :: (Show a) => String -> Int -> a -> ShowS
showsUnary :: forall a. Show a => String -> Int -> a -> ShowS
showsUnary String
name Int
d a
x = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
name ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
x
{-# DEPRECATED showsUnary1 "Use 'showsUnaryWith' to define 'liftShowsPrec'" #-}
showsUnary1 :: (Show1 f, Show a) => String -> Int -> f a -> ShowS
showsUnary1 :: forall (f :: * -> *) a.
(Show1 f, Show a) =>
String -> Int -> f a -> ShowS
showsUnary1 String
name Int
d f a
x = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
name ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f a -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1 Int
11 f a
x
{-# DEPRECATED showsBinary1
"Use 'showsBinaryWith' to define 'liftShowsPrec'" #-}
showsBinary1 :: (Show1 f, Show1 g, Show a) =>
String -> Int -> f a -> g a -> ShowS
showsBinary1 :: forall (f :: * -> *) (g :: * -> *) a.
(Show1 f, Show1 g, Show a) =>
String -> Int -> f a -> g a -> ShowS
showsBinary1 String
name Int
d f a
x g a
y = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
name ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f a -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1 Int
11 f a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> g a -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1 Int
11 g a
y
instance Eq1 V1 where
liftEq :: forall a b. (a -> b -> Bool) -> V1 a -> V1 b -> Bool
liftEq a -> b -> Bool
_ = \V1 a
_ V1 b
_ -> Bool
True
instance Ord1 V1 where
liftCompare :: forall a b. (a -> b -> Ordering) -> V1 a -> V1 b -> Ordering
liftCompare a -> b -> Ordering
_ = \V1 a
_ V1 b
_ -> Ordering
EQ
instance Show1 V1 where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> V1 a -> ShowS
liftShowsPrec Int -> a -> ShowS
_ [a] -> ShowS
_ Int
_ = \V1 a
_ -> String -> ShowS
showString String
"V1"
instance Read1 V1 where
liftReadsPrec :: forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (V1 a)
liftReadsPrec Int -> ReadS a
_ ReadS [a]
_ = ReadPrec (V1 a) -> Int -> ReadS (V1 a)
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S ReadPrec (V1 a)
forall a. ReadPrec a
pfail
liftReadListPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [V1 a]
liftReadListPrec = ReadPrec a -> ReadPrec [a] -> ReadPrec [V1 a]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrecDefault
liftReadList :: forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [V1 a]
liftReadList = (Int -> ReadS a) -> ReadS [a] -> ReadS [V1 a]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadListDefault
instance Eq1 U1 where
liftEq :: forall a b. (a -> b -> Bool) -> U1 a -> U1 b -> Bool
liftEq a -> b -> Bool
_ = \U1 a
_ U1 b
_ -> Bool
True
instance Ord1 U1 where
liftCompare :: forall a b. (a -> b -> Ordering) -> U1 a -> U1 b -> Ordering
liftCompare a -> b -> Ordering
_ = \U1 a
_ U1 b
_ -> Ordering
EQ
instance Show1 U1 where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> U1 a -> ShowS
liftShowsPrec Int -> a -> ShowS
_ [a] -> ShowS
_ Int
_ = \U1 a
U1 -> String -> ShowS
showString String
"U1"
instance Read1 U1 where
liftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (U1 a)
liftReadPrec ReadPrec a
_ ReadPrec [a]
_ =
ReadPrec (U1 a) -> ReadPrec (U1 a)
forall a. ReadPrec a -> ReadPrec a
parens (Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident String
"U1") ReadPrec () -> ReadPrec (U1 a) -> ReadPrec (U1 a)
forall a b. ReadPrec a -> ReadPrec b -> ReadPrec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> U1 a -> ReadPrec (U1 a)
forall a. a -> ReadPrec a
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 a
forall k (p :: k). U1 p
U1)
liftReadListPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [U1 a]
liftReadListPrec = ReadPrec a -> ReadPrec [a] -> ReadPrec [U1 a]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrecDefault
liftReadList :: forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [U1 a]
liftReadList = (Int -> ReadS a) -> ReadS [a] -> ReadS [U1 a]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadListDefault
instance Eq1 Par1 where
liftEq :: forall a b. (a -> b -> Bool) -> Par1 a -> Par1 b -> Bool
liftEq a -> b -> Bool
eq = \(Par1 a
a) (Par1 b
a') -> a -> b -> Bool
eq a
a b
a'
instance Ord1 Par1 where
liftCompare :: forall a b. (a -> b -> Ordering) -> Par1 a -> Par1 b -> Ordering
liftCompare a -> b -> Ordering
cmp = \(Par1 a
a) (Par1 b
a') -> a -> b -> Ordering
cmp a
a b
a'
instance Show1 Par1 where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Par1 a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
_ Int
d = \(Par1 { unPar1 :: forall p. Par1 p -> p
unPar1 = a
a }) ->
(Int -> a -> ShowS) -> String -> String -> Int -> a -> ShowS
forall a.
(Int -> a -> ShowS) -> String -> String -> Int -> a -> ShowS
showsSingleFieldRecordWith Int -> a -> ShowS
sp String
"Par1" String
"unPar1" Int
d a
a
instance Read1 Par1 where
liftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (Par1 a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
_ =
ReadPrec a
-> String -> String -> (a -> Par1 a) -> ReadPrec (Par1 a)
forall a t.
ReadPrec a -> String -> String -> (a -> t) -> ReadPrec t
readsSingleFieldRecordWith ReadPrec a
rp String
"Par1" String
"unPar1" a -> Par1 a
forall p. p -> Par1 p
Par1
liftReadListPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [Par1 a]
liftReadListPrec = ReadPrec a -> ReadPrec [a] -> ReadPrec [Par1 a]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrecDefault
liftReadList :: forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [Par1 a]
liftReadList = (Int -> ReadS a) -> ReadS [a] -> ReadS [Par1 a]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadListDefault
instance Eq1 f => Eq1 (Rec1 f) where
liftEq :: forall a b. (a -> b -> Bool) -> Rec1 f a -> Rec1 f b -> Bool
liftEq a -> b -> Bool
eq = \(Rec1 f a
a) (Rec1 f b
a') -> (a -> b -> Bool) -> f a -> f b -> Bool
forall a b. (a -> b -> Bool) -> f a -> f b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq f a
a f b
a'
instance Ord1 f => Ord1 (Rec1 f) where
liftCompare :: forall a b.
(a -> b -> Ordering) -> Rec1 f a -> Rec1 f b -> Ordering
liftCompare a -> b -> Ordering
cmp = \(Rec1 f a
a) (Rec1 f b
a') -> (a -> b -> Ordering) -> f a -> f b -> Ordering
forall a b. (a -> b -> Ordering) -> f a -> f b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp f a
a f b
a'
instance Show1 f => Show1 (Rec1 f) where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Rec1 f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d = \(Rec1 { unRec1 :: forall k (f :: k -> *) (p :: k). Rec1 f p -> f p
unRec1 = f a
a }) ->
(Int -> f a -> ShowS) -> String -> String -> Int -> f a -> ShowS
forall a.
(Int -> a -> ShowS) -> String -> String -> Int -> a -> ShowS
showsSingleFieldRecordWith ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) String
"Rec1" String
"unRec1" Int
d f a
a
instance Read1 f => Read1 (Rec1 f) where
liftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (Rec1 f a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
rl =
ReadPrec (f a)
-> String -> String -> (f a -> Rec1 f a) -> ReadPrec (Rec1 f a)
forall a t.
ReadPrec a -> String -> String -> (a -> t) -> ReadPrec t
readsSingleFieldRecordWith (ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
rl) String
"Rec1" String
"unRec1" f a -> Rec1 f a
forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1
liftReadListPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [Rec1 f a]
liftReadListPrec = ReadPrec a -> ReadPrec [a] -> ReadPrec [Rec1 f a]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrecDefault
liftReadList :: forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [Rec1 f a]
liftReadList = (Int -> ReadS a) -> ReadS [a] -> ReadS [Rec1 f a]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadListDefault
instance Eq c => Eq1 (K1 i c) where
liftEq :: forall a b. (a -> b -> Bool) -> K1 i c a -> K1 i c b -> Bool
liftEq a -> b -> Bool
_ = \(K1 c
a) (K1 c
a') -> c
a c -> c -> Bool
forall a. Eq a => a -> a -> Bool
== c
a'
instance Ord c => Ord1 (K1 i c) where
liftCompare :: forall a b.
(a -> b -> Ordering) -> K1 i c a -> K1 i c b -> Ordering
liftCompare a -> b -> Ordering
_ = \(K1 c
a) (K1 c
a') -> c -> c -> Ordering
forall a. Ord a => a -> a -> Ordering
compare c
a c
a'
instance Show c => Show1 (K1 i c) where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> K1 i c a -> ShowS
liftShowsPrec Int -> a -> ShowS
_ [a] -> ShowS
_ Int
d = \(K1 { unK1 :: forall k i c (p :: k). K1 i c p -> c
unK1 = c
a }) ->
(Int -> c -> ShowS) -> String -> String -> Int -> c -> ShowS
forall a.
(Int -> a -> ShowS) -> String -> String -> Int -> a -> ShowS
showsSingleFieldRecordWith Int -> c -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec String
"K1" String
"unK1" Int
d c
a
instance Read c => Read1 (K1 i c) where
liftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (K1 i c a)
liftReadPrec ReadPrec a
_ ReadPrec [a]
_ = ReadPrec (K1 i c a) -> ReadPrec (K1 i c a)
forall a. ReadPrec a -> ReadPrec a
readData (ReadPrec (K1 i c a) -> ReadPrec (K1 i c a))
-> ReadPrec (K1 i c a) -> ReadPrec (K1 i c a)
forall a b. (a -> b) -> a -> b
$
ReadPrec c
-> String -> String -> (c -> K1 i c a) -> ReadPrec (K1 i c a)
forall a t.
ReadPrec a -> String -> String -> (a -> t) -> ReadPrec t
readsSingleFieldRecordWith ReadPrec c
forall a. Read a => ReadPrec a
readPrec String
"K1" String
"unK1" c -> K1 i c a
forall k i c (p :: k). c -> K1 i c p
K1
liftReadListPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [K1 i c a]
liftReadListPrec = ReadPrec a -> ReadPrec [a] -> ReadPrec [K1 i c a]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrecDefault
liftReadList :: forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [K1 i c a]
liftReadList = (Int -> ReadS a) -> ReadS [a] -> ReadS [K1 i c a]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadListDefault
instance Eq1 f => Eq1 (M1 i c f) where
liftEq :: forall a b. (a -> b -> Bool) -> M1 i c f a -> M1 i c f b -> Bool
liftEq a -> b -> Bool
eq = \(M1 f a
a) (M1 f b
a') -> (a -> b -> Bool) -> f a -> f b -> Bool
forall a b. (a -> b -> Bool) -> f a -> f b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq f a
a f b
a'
instance Ord1 f => Ord1 (M1 i c f) where
liftCompare :: forall a b.
(a -> b -> Ordering) -> M1 i c f a -> M1 i c f b -> Ordering
liftCompare a -> b -> Ordering
cmp = \(M1 f a
a) (M1 f b
a') -> (a -> b -> Ordering) -> f a -> f b -> Ordering
forall a b. (a -> b -> Ordering) -> f a -> f b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp f a
a f b
a'
instance Show1 f => Show1 (M1 i c f) where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> M1 i c f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d = \(M1 { unM1 :: forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 = f a
a }) ->
(Int -> f a -> ShowS) -> String -> String -> Int -> f a -> ShowS
forall a.
(Int -> a -> ShowS) -> String -> String -> Int -> a -> ShowS
showsSingleFieldRecordWith ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) String
"M1" String
"unM1" Int
d f a
a
instance Read1 f => Read1 (M1 i c f) where
liftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (M1 i c f a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
rl = ReadPrec (M1 i c f a) -> ReadPrec (M1 i c f a)
forall a. ReadPrec a -> ReadPrec a
readData (ReadPrec (M1 i c f a) -> ReadPrec (M1 i c f a))
-> ReadPrec (M1 i c f a) -> ReadPrec (M1 i c f a)
forall a b. (a -> b) -> a -> b
$
ReadPrec (f a)
-> String -> String -> (f a -> M1 i c f a) -> ReadPrec (M1 i c f a)
forall a t.
ReadPrec a -> String -> String -> (a -> t) -> ReadPrec t
readsSingleFieldRecordWith (ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
rl) String
"M1" String
"unM1" f a -> M1 i c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1
liftReadListPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [M1 i c f a]
liftReadListPrec = ReadPrec a -> ReadPrec [a] -> ReadPrec [M1 i c f a]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrecDefault
liftReadList :: forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [M1 i c f a]
liftReadList = (Int -> ReadS a) -> ReadS [a] -> ReadS [M1 i c f a]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadListDefault
instance (Eq1 f, Eq1 g) => Eq1 (f :+: g) where
liftEq :: forall a b. (a -> b -> Bool) -> (:+:) f g a -> (:+:) f g b -> Bool
liftEq a -> b -> Bool
eq = \(:+:) f g a
lhs (:+:) f g b
rhs -> case ((:+:) f g a
lhs, (:+:) f g b
rhs) of
(L1 f a
a, L1 f b
a') -> (a -> b -> Bool) -> f a -> f b -> Bool
forall a b. (a -> b -> Bool) -> f a -> f b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq f a
a f b
a'
(R1 g a
b, R1 g b
b') -> (a -> b -> Bool) -> g a -> g b -> Bool
forall a b. (a -> b -> Bool) -> g a -> g b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq g a
b g b
b'
((:+:) f g a, (:+:) f g b)
_ -> Bool
False
instance (Ord1 f, Ord1 g) => Ord1 (f :+: g) where
liftCompare :: forall a b.
(a -> b -> Ordering) -> (:+:) f g a -> (:+:) f g b -> Ordering
liftCompare a -> b -> Ordering
cmp = \(:+:) f g a
lhs (:+:) f g b
rhs -> case ((:+:) f g a
lhs, (:+:) f g b
rhs) of
(L1 f a
_, R1 g b
_) -> Ordering
LT
(R1 g a
_, L1 f b
_) -> Ordering
GT
(L1 f a
a, L1 f b
a') -> (a -> b -> Ordering) -> f a -> f b -> Ordering
forall a b. (a -> b -> Ordering) -> f a -> f b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp f a
a f b
a'
(R1 g a
b, R1 g b
b') -> (a -> b -> Ordering) -> g a -> g b -> Ordering
forall a b. (a -> b -> Ordering) -> g a -> g b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp g a
b g b
b'
instance (Show1 f, Show1 g) => Show1 (f :+: g) where
liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> (:+:) f g a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d = \(:+:) f g a
x -> case (:+:) f g a
x of
L1 f a
a -> (Int -> f a -> ShowS) -> String -> Int -> f a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) String
"L1" Int
d f a
a
R1 g a
b -> (Int -> g a -> ShowS) -> String -> Int -> g a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> g a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> g a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) String
"R1" Int
d g a
b
instance (Read1 f, Read1 g) => Read1 (f :+: g) where
liftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec ((:+:) f g a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
rl = ReadPrec ((:+:) f g a) -> ReadPrec ((:+:) f g a)
forall a. ReadPrec a -> ReadPrec a
readData (ReadPrec ((:+:) f g a) -> ReadPrec ((:+:) f g a))
-> ReadPrec ((:+:) f g a) -> ReadPrec ((:+:) f g a)
forall a b. (a -> b) -> a -> b
$
ReadPrec (f a)
-> String -> (f a -> (:+:) f g a) -> ReadPrec ((:+:) f g a)
forall a t. ReadPrec a -> String -> (a -> t) -> ReadPrec t
readUnaryWith (ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
rl) String
"L1" f a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 ReadPrec ((:+:) f g a)
-> ReadPrec ((:+:) f g a) -> ReadPrec ((:+:) f g a)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
ReadPrec (g a)
-> String -> (g a -> (:+:) f g a) -> ReadPrec ((:+:) f g a)
forall a t. ReadPrec a -> String -> (a -> t) -> ReadPrec t
readUnaryWith (ReadPrec a -> ReadPrec [a] -> ReadPrec (g a)
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (g a)
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
rl) String
"R1" g a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1
liftReadListPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [(:+:) f g a]
liftReadListPrec = ReadPrec a -> ReadPrec [a] -> ReadPrec [(:+:) f g a]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrecDefault
liftReadList :: forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [(:+:) f g a]
liftReadList = (Int -> ReadS a) -> ReadS [a] -> ReadS [(:+:) f g a]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadListDefault
instance (Eq1 f, Eq1 g) => Eq1 (f :*: g) where
liftEq :: forall a b. (a -> b -> Bool) -> (:*:) f g a -> (:*:) f g b -> Bool
liftEq a -> b -> Bool
eq = \(f a
f :*: g a
g) (f b
f' :*: g b
g') -> (a -> b -> Bool) -> f a -> f b -> Bool
forall a b. (a -> b -> Bool) -> f a -> f b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq f a
f f b
f' Bool -> Bool -> Bool
&& (a -> b -> Bool) -> g a -> g b -> Bool
forall a b. (a -> b -> Bool) -> g a -> g b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq g a
g g b
g'
instance (Ord1 f, Ord1 g) => Ord1 (f :*: g) where
liftCompare :: forall a b.
(a -> b -> Ordering) -> (:*:) f g a -> (:*:) f g b -> Ordering
liftCompare a -> b -> Ordering
cmp = \(f a
f :*: g a
g) (f b
f' :*: g b
g') -> (a -> b -> Ordering) -> f a -> f b -> Ordering
forall a b. (a -> b -> Ordering) -> f a -> f b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp f a
f f b
f' Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (a -> b -> Ordering) -> g a -> g b -> Ordering
forall a b. (a -> b -> Ordering) -> g a -> g b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp g a
g g b
g'
instance (Show1 f, Show1 g) => Show1 (f :*: g) where
liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> (:*:) f g a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d = \(f a
a :*: g a
b) ->
(Int -> f a -> ShowS)
-> (Int -> g a -> ShowS)
-> Int
-> String
-> Int
-> f a
-> g a
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> (Int -> b -> ShowS) -> Int -> String -> Int -> a -> b -> ShowS
showsBinaryOpWith
((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl)
((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> g a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> g a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl)
Int
7
String
":*:"
Int
d
f a
a
g a
b
instance (Read1 f, Read1 g) => Read1 (f :*: g) where
liftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec ((:*:) f g a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
rl = ReadPrec ((:*:) f g a) -> ReadPrec ((:*:) f g a)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec ((:*:) f g a) -> ReadPrec ((:*:) f g a))
-> ReadPrec ((:*:) f g a) -> ReadPrec ((:*:) f g a)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec ((:*:) f g a) -> ReadPrec ((:*:) f g a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
6 (ReadPrec ((:*:) f g a) -> ReadPrec ((:*:) f g a))
-> ReadPrec ((:*:) f g a) -> ReadPrec ((:*:) f g a)
forall a b. (a -> b) -> a -> b
$
ReadPrec (f a)
-> ReadPrec (g a)
-> String
-> (f a -> g a -> (:*:) f g a)
-> ReadPrec ((:*:) f g a)
forall a b t.
ReadPrec a -> ReadPrec b -> String -> (a -> b -> t) -> ReadPrec t
readBinaryOpWith (ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
rl) (ReadPrec a -> ReadPrec [a] -> ReadPrec (g a)
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (g a)
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
rl) String
":*:" f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:)
liftReadListPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [(:*:) f g a]
liftReadListPrec = ReadPrec a -> ReadPrec [a] -> ReadPrec [(:*:) f g a]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrecDefault
liftReadList :: forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [(:*:) f g a]
liftReadList = (Int -> ReadS a) -> ReadS [a] -> ReadS [(:*:) f g a]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadListDefault
instance (Eq1 f, Eq1 g) => Eq1 (f :.: g) where
liftEq :: forall a b. (a -> b -> Bool) -> (:.:) f g a -> (:.:) f g b -> Bool
liftEq a -> b -> Bool
eq = \(Comp1 f (g a)
a) (Comp1 f (g b)
a') -> (g a -> g b -> Bool) -> f (g a) -> f (g b) -> Bool
forall a b. (a -> b -> Bool) -> f a -> f b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq ((a -> b -> Bool) -> g a -> g b -> Bool
forall a b. (a -> b -> Bool) -> g a -> g b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq) f (g a)
a f (g b)
a'
instance (Ord1 f, Ord1 g) => Ord1 (f :.: g) where
liftCompare :: forall a b.
(a -> b -> Ordering) -> (:.:) f g a -> (:.:) f g b -> Ordering
liftCompare a -> b -> Ordering
cmp = \(Comp1 f (g a)
a) (Comp1 f (g b)
a') -> (g a -> g b -> Ordering) -> f (g a) -> f (g b) -> Ordering
forall a b. (a -> b -> Ordering) -> f a -> f b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare ((a -> b -> Ordering) -> g a -> g b -> Ordering
forall a b. (a -> b -> Ordering) -> g a -> g b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp) f (g a)
a f (g b)
a'
instance (Show1 f, Show1 g) => Show1 (f :.: g) where
liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> (:.:) f g a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d = \(Comp1 { unComp1 :: forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
unComp1 = f (g a)
a }) ->
(Int -> f (g a) -> ShowS)
-> String -> String -> Int -> f (g a) -> ShowS
forall a.
(Int -> a -> ShowS) -> String -> String -> Int -> a -> ShowS
showsSingleFieldRecordWith
((Int -> g a -> ShowS)
-> ([g a] -> ShowS) -> Int -> f (g a) -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> g a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> g a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) ((Int -> a -> ShowS) -> ([a] -> ShowS) -> [g a] -> ShowS
forall a. (Int -> a -> ShowS) -> ([a] -> ShowS) -> [g a] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList Int -> a -> ShowS
sp [a] -> ShowS
sl))
String
"Comp1"
String
"unComp1"
Int
d
f (g a)
a
instance (Read1 f, Read1 g) => Read1 (f :.: g) where
liftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec ((:.:) f g a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
rl = ReadPrec ((:.:) f g a) -> ReadPrec ((:.:) f g a)
forall a. ReadPrec a -> ReadPrec a
readData (ReadPrec ((:.:) f g a) -> ReadPrec ((:.:) f g a))
-> ReadPrec ((:.:) f g a) -> ReadPrec ((:.:) f g a)
forall a b. (a -> b) -> a -> b
$
ReadPrec (f (g a))
-> String
-> String
-> (f (g a) -> (:.:) f g a)
-> ReadPrec ((:.:) f g a)
forall a t.
ReadPrec a -> String -> String -> (a -> t) -> ReadPrec t
readsSingleFieldRecordWith
(ReadPrec (g a) -> ReadPrec [g a] -> ReadPrec (f (g a))
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
liftReadPrec (ReadPrec a -> ReadPrec [a] -> ReadPrec (g a)
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (g a)
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
rl) (ReadPrec a -> ReadPrec [a] -> ReadPrec [g a]
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [g a]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrec ReadPrec a
rp ReadPrec [a]
rl))
String
"Comp1"
String
"unComp1"
f (g a) -> (:.:) f g a
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1
liftReadListPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [(:.:) f g a]
liftReadListPrec = ReadPrec a -> ReadPrec [a] -> ReadPrec [(:.:) f g a]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrecDefault
liftReadList :: forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [(:.:) f g a]
liftReadList = (Int -> ReadS a) -> ReadS [a] -> ReadS [(:.:) f g a]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadListDefault
instance Eq1 UAddr where
liftEq :: forall a b. (a -> b -> Bool) -> UAddr a -> UAddr b -> Bool
liftEq a -> b -> Bool
_ = \(UAddr Addr#
a) (UAddr Addr#
b) -> Addr# -> URec (Ptr ()) (ZonkAny 23)
forall k (p :: k). Addr# -> URec (Ptr ()) p
UAddr Addr#
a URec (Ptr ()) (ZonkAny 23) -> URec (Ptr ()) (ZonkAny 23) -> Bool
forall a. Eq a => a -> a -> Bool
== Addr# -> URec (Ptr ()) (ZonkAny 23)
forall k (p :: k). Addr# -> URec (Ptr ()) p
UAddr Addr#
b
instance Ord1 UAddr where
liftCompare :: forall a b. (a -> b -> Ordering) -> UAddr a -> UAddr b -> Ordering
liftCompare a -> b -> Ordering
_ = \(UAddr Addr#
a) (UAddr Addr#
b) -> URec (Ptr ()) (ZonkAny 11)
-> URec (Ptr ()) (ZonkAny 11) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Addr# -> URec (Ptr ()) (ZonkAny 11)
forall k (p :: k). Addr# -> URec (Ptr ()) p
UAddr Addr#
a) (Addr# -> URec (Ptr ()) (ZonkAny 11)
forall k (p :: k). Addr# -> URec (Ptr ()) p
UAddr Addr#
b)
instance Show1 UAddr where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> UAddr a -> ShowS
liftShowsPrec Int -> a -> ShowS
_ [a] -> ShowS
_ = Int -> UAddr a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance Eq1 UChar where
liftEq :: forall a b. (a -> b -> Bool) -> UChar a -> UChar b -> Bool
liftEq a -> b -> Bool
_ = \(UChar Char#
a) (UChar Char#
b) -> Char# -> URec Char (ZonkAny 21)
forall k (p :: k). Char# -> URec Char p
UChar Char#
a URec Char (ZonkAny 21) -> URec Char (ZonkAny 21) -> Bool
forall a. Eq a => a -> a -> Bool
== Char# -> URec Char (ZonkAny 21)
forall k (p :: k). Char# -> URec Char p
UChar Char#
b
instance Ord1 UChar where
liftCompare :: forall a b. (a -> b -> Ordering) -> UChar a -> UChar b -> Ordering
liftCompare a -> b -> Ordering
_ = \(UChar Char#
a) (UChar Char#
b) -> URec Char (ZonkAny 9) -> URec Char (ZonkAny 9) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Char# -> URec Char (ZonkAny 9)
forall k (p :: k). Char# -> URec Char p
UChar Char#
a) (Char# -> URec Char (ZonkAny 9)
forall k (p :: k). Char# -> URec Char p
UChar Char#
b)
instance Show1 UChar where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> UChar a -> ShowS
liftShowsPrec Int -> a -> ShowS
_ [a] -> ShowS
_ = Int -> UChar a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance Eq1 UDouble where
liftEq :: forall a b. (a -> b -> Bool) -> UDouble a -> UDouble b -> Bool
liftEq a -> b -> Bool
_ = \(UDouble Double#
a) (UDouble Double#
b) -> Double# -> URec Double (ZonkAny 19)
forall k (p :: k). Double# -> URec Double p
UDouble Double#
a URec Double (ZonkAny 19) -> URec Double (ZonkAny 19) -> Bool
forall a. Eq a => a -> a -> Bool
== Double# -> URec Double (ZonkAny 19)
forall k (p :: k). Double# -> URec Double p
UDouble Double#
b
instance Ord1 UDouble where
liftCompare :: forall a b.
(a -> b -> Ordering) -> UDouble a -> UDouble b -> Ordering
liftCompare a -> b -> Ordering
_ = \(UDouble Double#
a) (UDouble Double#
b) -> URec Double (ZonkAny 7) -> URec Double (ZonkAny 7) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Double# -> URec Double (ZonkAny 7)
forall k (p :: k). Double# -> URec Double p
UDouble Double#
a) (Double# -> URec Double (ZonkAny 7)
forall k (p :: k). Double# -> URec Double p
UDouble Double#
b)
instance Show1 UDouble where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> UDouble a -> ShowS
liftShowsPrec Int -> a -> ShowS
_ [a] -> ShowS
_ = Int -> UDouble a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance Eq1 UFloat where
liftEq :: forall a b. (a -> b -> Bool) -> UFloat a -> UFloat b -> Bool
liftEq a -> b -> Bool
_ = \(UFloat Float#
a) (UFloat Float#
b) -> Float# -> URec Float (ZonkAny 17)
forall k (p :: k). Float# -> URec Float p
UFloat Float#
a URec Float (ZonkAny 17) -> URec Float (ZonkAny 17) -> Bool
forall a. Eq a => a -> a -> Bool
== Float# -> URec Float (ZonkAny 17)
forall k (p :: k). Float# -> URec Float p
UFloat Float#
b
instance Ord1 UFloat where
liftCompare :: forall a b.
(a -> b -> Ordering) -> UFloat a -> UFloat b -> Ordering
liftCompare a -> b -> Ordering
_ = \(UFloat Float#
a) (UFloat Float#
b) -> URec Float (ZonkAny 5) -> URec Float (ZonkAny 5) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float# -> URec Float (ZonkAny 5)
forall k (p :: k). Float# -> URec Float p
UFloat Float#
a) (Float# -> URec Float (ZonkAny 5)
forall k (p :: k). Float# -> URec Float p
UFloat Float#
b)
instance Show1 UFloat where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> UFloat a -> ShowS
liftShowsPrec Int -> a -> ShowS
_ [a] -> ShowS
_ = Int -> UFloat a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance Eq1 UInt where
liftEq :: forall a b. (a -> b -> Bool) -> UInt a -> UInt b -> Bool
liftEq a -> b -> Bool
_ = \(UInt Int#
a) (UInt Int#
b) -> Int# -> URec Int (ZonkAny 15)
forall k (p :: k). Int# -> URec Int p
UInt Int#
a URec Int (ZonkAny 15) -> URec Int (ZonkAny 15) -> Bool
forall a. Eq a => a -> a -> Bool
== Int# -> URec Int (ZonkAny 15)
forall k (p :: k). Int# -> URec Int p
UInt Int#
b
instance Ord1 UInt where
liftCompare :: forall a b. (a -> b -> Ordering) -> UInt a -> UInt b -> Ordering
liftCompare a -> b -> Ordering
_ = \(UInt Int#
a) (UInt Int#
b) -> URec Int (ZonkAny 3) -> URec Int (ZonkAny 3) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int# -> URec Int (ZonkAny 3)
forall k (p :: k). Int# -> URec Int p
UInt Int#
a) (Int# -> URec Int (ZonkAny 3)
forall k (p :: k). Int# -> URec Int p
UInt Int#
b)
instance Show1 UInt where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> UInt a -> ShowS
liftShowsPrec Int -> a -> ShowS
_ [a] -> ShowS
_ = Int -> UInt a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance Eq1 UWord where
liftEq :: forall a b. (a -> b -> Bool) -> UWord a -> UWord b -> Bool
liftEq a -> b -> Bool
_ = \(UWord Word#
a) (UWord Word#
b) -> Word# -> URec Word (ZonkAny 13)
forall k (p :: k). Word# -> URec Word p
UWord Word#
a URec Word (ZonkAny 13) -> URec Word (ZonkAny 13) -> Bool
forall a. Eq a => a -> a -> Bool
== Word# -> URec Word (ZonkAny 13)
forall k (p :: k). Word# -> URec Word p
UWord Word#
b
instance Ord1 UWord where
liftCompare :: forall a b. (a -> b -> Ordering) -> UWord a -> UWord b -> Ordering
liftCompare a -> b -> Ordering
_ = \(UWord Word#
a) (UWord Word#
b) -> URec Word (ZonkAny 1) -> URec Word (ZonkAny 1) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Word# -> URec Word (ZonkAny 1)
forall k (p :: k). Word# -> URec Word p
UWord Word#
a) (Word# -> URec Word (ZonkAny 1)
forall k (p :: k). Word# -> URec Word p
UWord Word#
b)
instance Show1 UWord where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> UWord a -> ShowS
liftShowsPrec Int -> a -> ShowS
_ [a] -> ShowS
_ = Int -> UWord a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
showsSingleFieldRecordWith :: (Int -> a -> ShowS) -> String -> String -> Int -> a -> ShowS
showsSingleFieldRecordWith :: forall a.
(Int -> a -> ShowS) -> String -> String -> Int -> a -> ShowS
showsSingleFieldRecordWith Int -> a -> ShowS
sp String
name String
field Int
d a
x =
Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
name ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
field ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
sp Int
0 a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'
readsSingleFieldRecordWith :: ReadPrec a -> String -> String -> (a -> t) -> ReadPrec t
readsSingleFieldRecordWith :: forall a t.
ReadPrec a -> String -> String -> (a -> t) -> ReadPrec t
readsSingleFieldRecordWith ReadPrec a
rp String
name String
field a -> t
cons = ReadPrec t -> ReadPrec t
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec t -> ReadPrec t) -> ReadPrec t -> ReadPrec t
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec t -> ReadPrec t
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
11 (ReadPrec t -> ReadPrec t) -> ReadPrec t -> ReadPrec t
forall a b. (a -> b) -> a -> b
$ do
Lexeme -> ReadPrec ()
expectP (Lexeme -> ReadPrec ()) -> Lexeme -> ReadPrec ()
forall a b. (a -> b) -> a -> b
$ String -> Lexeme
Ident String
name
Lexeme -> ReadPrec ()
expectP (Lexeme -> ReadPrec ()) -> Lexeme -> ReadPrec ()
forall a b. (a -> b) -> a -> b
$ String -> Lexeme
Punc String
"{"
x <- String -> ReadPrec a -> ReadPrec a
forall a. String -> ReadPrec a -> ReadPrec a
readField String
field (ReadPrec a -> ReadPrec a) -> ReadPrec a -> ReadPrec a
forall a b. (a -> b) -> a -> b
$ ReadPrec a -> ReadPrec a
forall a. ReadPrec a -> ReadPrec a
reset ReadPrec a
rp
expectP $ Punc "}"
pure $ cons x
showsBinaryOpWith
:: (Int -> a -> ShowS)
-> (Int -> b -> ShowS)
-> Int
-> String
-> Int
-> a
-> b
-> ShowS
showsBinaryOpWith :: forall a b.
(Int -> a -> ShowS)
-> (Int -> b -> ShowS) -> Int -> String -> Int -> a -> b -> ShowS
showsBinaryOpWith Int -> a -> ShowS
sp1 Int -> b -> ShowS
sp2 Int
opPrec String
name Int
d a
x b
y = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
opPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
Int -> a -> ShowS
sp1 Int
opPrec a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
name ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> b -> ShowS
sp2 Int
opPrec b
y
readBinaryOpWith
:: ReadPrec a
-> ReadPrec b
-> String
-> (a -> b -> t)
-> ReadPrec t
readBinaryOpWith :: forall a b t.
ReadPrec a -> ReadPrec b -> String -> (a -> b -> t) -> ReadPrec t
readBinaryOpWith ReadPrec a
rp1 ReadPrec b
rp2 String
name a -> b -> t
cons =
a -> b -> t
cons (a -> b -> t) -> ReadPrec a -> ReadPrec (b -> t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec a -> ReadPrec a
forall a. ReadPrec a -> ReadPrec a
step ReadPrec a
rp1 ReadPrec (b -> t) -> ReadPrec () -> ReadPrec (b -> t)
forall a b. ReadPrec a -> ReadPrec b -> ReadPrec a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Symbol String
name) ReadPrec (b -> t) -> ReadPrec b -> ReadPrec t
forall a b. ReadPrec (a -> b) -> ReadPrec a -> ReadPrec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadPrec b -> ReadPrec b
forall a. ReadPrec a -> ReadPrec a
step ReadPrec b
rp2