{-# LANGUAGE TypeOperators, RankNTypes, UndecidableInstances, FlexibleInstances, FlexibleContexts #-}
{-# options_ghc -Wno-name-shadowing #-}
module Data.Functor.Classes.Generic
( Eq1(..)
, genericLiftEq
, Ord1(..)
, genericLiftCompare
, Show1(..)
, GShow1Options(..)
, defaultGShow1Options
, genericLiftShowsPrec
, genericLiftShowsPrecWithOptions
, Generically (..)
) where
import Data.Functor.Classes
import Data.List (intersperse)
import GHC.Generics
import Text.Show (showListWith)
class GEq1 f where
gliftEq :: (a -> b -> Bool) -> f a -> f b -> Bool
genericLiftEq :: (Generic1 f, GEq1 (Rep1 f)) => (a -> b -> Bool) -> f a -> f b -> Bool
genericLiftEq :: (a -> b -> Bool) -> f a -> f b -> Bool
genericLiftEq a -> b -> Bool
f f a
a f b
b = (a -> b -> Bool) -> Rep1 f a -> Rep1 f b -> Bool
forall (f :: * -> *) a b.
GEq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
gliftEq a -> b -> Bool
f (f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f a
a) (f b -> Rep1 f b
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f b
b)
class GOrd1 f where
gliftCompare :: (a -> b -> Ordering) -> f a -> f b -> Ordering
genericLiftCompare :: (Generic1 f, GOrd1 (Rep1 f)) => (a -> b -> Ordering) -> f a -> f b -> Ordering
genericLiftCompare :: (a -> b -> Ordering) -> f a -> f b -> Ordering
genericLiftCompare a -> b -> Ordering
f f a
a f b
b = (a -> b -> Ordering) -> Rep1 f a -> Rep1 f b -> Ordering
forall (f :: * -> *) a b.
GOrd1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
gliftCompare a -> b -> Ordering
f (f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f a
a) (f b -> Rep1 f b
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f b
b)
class GShow1 f where
gliftShowsPrec :: GShow1Options -> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
newtype GShow1Options = GShow1Options { GShow1Options -> Bool
optionsUseRecordSyntax :: Bool }
defaultGShow1Options :: GShow1Options
defaultGShow1Options :: GShow1Options
defaultGShow1Options = GShow1Options :: Bool -> GShow1Options
GShow1Options { optionsUseRecordSyntax :: Bool
optionsUseRecordSyntax = Bool
False }
class GShow1 f => GShow1Body f where
gliftShowsPrecBody :: GShow1Options -> Fixity -> Bool -> String -> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
gliftShowsPrecAll :: GShow1Options -> Bool -> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> [ShowS]
gliftShowsPrecAll GShow1Options
opts Bool
_ Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d f a
a = [GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
GShow1 f =>
GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
gliftShowsPrec GShow1Options
opts Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d f a
a]
gliftShowList :: GShow1 f => GShow1Options -> (Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
gliftShowList :: GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
gliftShowList GShow1Options
opts Int -> a -> ShowS
sp [a] -> ShowS
sl = (f a -> ShowS) -> [f a] -> ShowS
forall a. (a -> ShowS) -> [a] -> ShowS
showListWith (GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
GShow1 f =>
GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
gliftShowsPrec GShow1Options
opts Int -> a -> ShowS
sp [a] -> ShowS
sl Int
0)
genericLiftShowsPrec :: (Generic1 f, GShow1 (Rep1 f)) => (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
genericLiftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
genericLiftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d = GShow1Options
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> Rep1 f a
-> ShowS
forall (f :: * -> *) a.
GShow1 f =>
GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
gliftShowsPrec GShow1Options
defaultGShow1Options Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (Rep1 f a -> ShowS) -> (f a -> Rep1 f a) -> f a -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1
genericLiftShowsPrecWithOptions :: (Generic1 f, GShow1 (Rep1 f)) => GShow1Options -> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
genericLiftShowsPrecWithOptions :: GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
genericLiftShowsPrecWithOptions GShow1Options
options Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d = GShow1Options
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> Rep1 f a
-> ShowS
forall (f :: * -> *) a.
GShow1 f =>
GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
gliftShowsPrec GShow1Options
options Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (Rep1 f a -> ShowS) -> (f a -> Rep1 f a) -> f a -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1
instance GEq1 U1 where
gliftEq :: (a -> b -> Bool) -> U1 a -> U1 b -> Bool
gliftEq a -> b -> Bool
_ U1 a
_ U1 b
_ = Bool
True
instance GEq1 Par1 where
gliftEq :: (a -> b -> Bool) -> Par1 a -> Par1 b -> Bool
gliftEq a -> b -> Bool
f (Par1 a
a) (Par1 b
b) = a -> b -> Bool
f a
a b
b
instance Eq c => GEq1 (K1 i c) where
gliftEq :: (a -> b -> Bool) -> K1 i c a -> K1 i c b -> Bool
gliftEq a -> b -> Bool
_ (K1 c
a) (K1 c
b) = c
a c -> c -> Bool
forall a. Eq a => a -> a -> Bool
== c
b
instance Eq1 f => GEq1 (Rec1 f) where
gliftEq :: (a -> b -> Bool) -> Rec1 f a -> Rec1 f b -> Bool
gliftEq a -> b -> Bool
f (Rec1 f a
a) (Rec1 f b
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
f f a
a f b
b
instance GEq1 f => GEq1 (M1 i c f) where
gliftEq :: (a -> b -> Bool) -> M1 i c f a -> M1 i c f b -> Bool
gliftEq a -> b -> Bool
f (M1 f a
a) (M1 f b
b) = (a -> b -> Bool) -> f a -> f b -> Bool
forall (f :: * -> *) a b.
GEq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
gliftEq a -> b -> Bool
f f a
a f b
b
instance (GEq1 f, GEq1 g) => GEq1 (f :+: g) where
gliftEq :: (a -> b -> Bool) -> (:+:) f g a -> (:+:) f g b -> Bool
gliftEq a -> b -> Bool
f (:+:) f g a
a (:+:) f g b
b = case ((:+:) f g a
a, (:+:) f g b
b) of
(L1 f a
a, L1 f b
b) -> (a -> b -> Bool) -> f a -> f b -> Bool
forall (f :: * -> *) a b.
GEq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
gliftEq a -> b -> Bool
f f a
a f b
b
(R1 g a
a, R1 g b
b) -> (a -> b -> Bool) -> g a -> g b -> Bool
forall (f :: * -> *) a b.
GEq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
gliftEq a -> b -> Bool
f g a
a g b
b
((:+:) f g a, (:+:) f g b)
_ -> Bool
False
instance (GEq1 f, GEq1 g) => GEq1 (f :*: g) where
gliftEq :: (a -> b -> Bool) -> (:*:) f g a -> (:*:) f g b -> Bool
gliftEq a -> b -> Bool
f (f a
a1 :*: g a
b1) (f b
a2 :*: g b
b2) = (a -> b -> Bool) -> f a -> f b -> Bool
forall (f :: * -> *) a b.
GEq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
gliftEq a -> b -> Bool
f f a
a1 f b
a2 Bool -> Bool -> Bool
&& (a -> b -> Bool) -> g a -> g b -> Bool
forall (f :: * -> *) a b.
GEq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
gliftEq a -> b -> Bool
f g a
b1 g b
b2
instance (Eq1 f, GEq1 g) => GEq1 (f :.: g) where
gliftEq :: (a -> b -> Bool) -> (:.:) f g a -> (:.:) f g b -> Bool
gliftEq a -> b -> Bool
f (Comp1 f (g a)
a) (Comp1 f (g b)
b) = (g a -> g b -> Bool) -> f (g a) -> f (g 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 (f :: * -> *) a b.
GEq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
gliftEq a -> b -> Bool
f) f (g a)
a f (g b)
b
instance GOrd1 U1 where
gliftCompare :: (a -> b -> Ordering) -> U1 a -> U1 b -> Ordering
gliftCompare a -> b -> Ordering
_ U1 a
_ U1 b
_ = Ordering
EQ
instance GOrd1 Par1 where
gliftCompare :: (a -> b -> Ordering) -> Par1 a -> Par1 b -> Ordering
gliftCompare a -> b -> Ordering
f (Par1 a
a) (Par1 b
b) = a -> b -> Ordering
f a
a b
b
instance Ord c => GOrd1 (K1 i c) where
gliftCompare :: (a -> b -> Ordering) -> K1 i c a -> K1 i c b -> Ordering
gliftCompare a -> b -> Ordering
_ (K1 c
a) (K1 c
b) = c -> c -> Ordering
forall a. Ord a => a -> a -> Ordering
compare c
a c
b
instance Ord1 f => GOrd1 (Rec1 f) where
gliftCompare :: (a -> b -> Ordering) -> Rec1 f a -> Rec1 f b -> Ordering
gliftCompare a -> b -> Ordering
f (Rec1 f a
a) (Rec1 f b
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
f f a
a f b
b
instance GOrd1 f => GOrd1 (M1 i c f) where
gliftCompare :: (a -> b -> Ordering) -> M1 i c f a -> M1 i c f b -> Ordering
gliftCompare a -> b -> Ordering
f (M1 f a
a) (M1 f b
b) = (a -> b -> Ordering) -> f a -> f b -> Ordering
forall (f :: * -> *) a b.
GOrd1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
gliftCompare a -> b -> Ordering
f f a
a f b
b
instance (GOrd1 f, GOrd1 g) => GOrd1 (f :+: g) where
gliftCompare :: (a -> b -> Ordering) -> (:+:) f g a -> (:+:) f g b -> Ordering
gliftCompare a -> b -> Ordering
f (:+:) f g a
a (:+:) f g b
b = case ((:+:) f g a
a, (:+:) f g b
b) of
(L1 f a
a, L1 f b
b) -> (a -> b -> Ordering) -> f a -> f b -> Ordering
forall (f :: * -> *) a b.
GOrd1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
gliftCompare a -> b -> Ordering
f f a
a f b
b
(R1 g a
a, R1 g b
b) -> (a -> b -> Ordering) -> g a -> g b -> Ordering
forall (f :: * -> *) a b.
GOrd1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
gliftCompare a -> b -> Ordering
f g a
a g b
b
(L1 f a
_, R1 g b
_) -> Ordering
LT
(R1 g a
_, L1 f b
_) -> Ordering
GT
instance (GOrd1 f, GOrd1 g) => GOrd1 (f :*: g) where
gliftCompare :: (a -> b -> Ordering) -> (:*:) f g a -> (:*:) f g b -> Ordering
gliftCompare a -> b -> Ordering
f (f a
a1 :*: g a
b1) (f b
a2 :*: g b
b2) = (a -> b -> Ordering) -> f a -> f b -> Ordering
forall (f :: * -> *) a b.
GOrd1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
gliftCompare a -> b -> Ordering
f f a
a1 f b
a2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (a -> b -> Ordering) -> g a -> g b -> Ordering
forall (f :: * -> *) a b.
GOrd1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
gliftCompare a -> b -> Ordering
f g a
b1 g b
b2
instance (Ord1 f, GOrd1 g) => GOrd1 (f :.: g) where
gliftCompare :: (a -> b -> Ordering) -> (:.:) f g a -> (:.:) f g b -> Ordering
gliftCompare a -> b -> Ordering
f (Comp1 f (g a)
a) (Comp1 f (g b)
b) = (g a -> g b -> Ordering) -> f (g a) -> f (g 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 (f :: * -> *) a b.
GOrd1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
gliftCompare a -> b -> Ordering
f) f (g a)
a f (g b)
b
instance GShow1 U1 where
gliftShowsPrec :: GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> U1 a -> ShowS
gliftShowsPrec GShow1Options
_ Int -> a -> ShowS
_ [a] -> ShowS
_ Int
_ U1 a
_ = ShowS
forall a. a -> a
id
instance GShow1 Par1 where
gliftShowsPrec :: GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Par1 a -> ShowS
gliftShowsPrec GShow1Options
_ Int -> a -> ShowS
sp [a] -> ShowS
_ Int
d (Par1 a
a) = Int -> a -> ShowS
sp Int
d a
a
instance Show c => GShow1 (K1 i c) where
gliftShowsPrec :: GShow1Options
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> K1 i c a
-> ShowS
gliftShowsPrec GShow1Options
_ Int -> a -> ShowS
_ [a] -> ShowS
_ Int
d (K1 c
a) = Int -> c -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d c
a
instance Show1 f => GShow1 (Rec1 f) where
gliftShowsPrec :: GShow1Options
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> Rec1 f a
-> ShowS
gliftShowsPrec GShow1Options
_ Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (Rec1 f a
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
d f a
a
instance GShow1 f => GShow1 (M1 D c f) where
gliftShowsPrec :: GShow1Options
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> M1 D c f a
-> ShowS
gliftShowsPrec GShow1Options
opts Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (M1 f a
a) = GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
GShow1 f =>
GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
gliftShowsPrec GShow1Options
opts Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d f a
a
instance (Constructor c, GShow1Body f) => GShow1 (M1 C c f) where
gliftShowsPrec :: GShow1Options
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> M1 C c f a
-> ShowS
gliftShowsPrec GShow1Options
opts Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d M1 C c f a
m = GShow1Options
-> Fixity
-> Bool
-> String
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> f a
-> ShowS
forall (f :: * -> *) a.
GShow1Body f =>
GShow1Options
-> Fixity
-> Bool
-> String
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> f a
-> ShowS
gliftShowsPrecBody GShow1Options
opts (M1 C c f a -> Fixity
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Fixity
conFixity M1 C c f a
m) (M1 C c f a -> Bool
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Bool
conIsRecord M1 C c f a
m Bool -> Bool -> Bool
&& GShow1Options -> Bool
optionsUseRecordSyntax GShow1Options
opts) (M1 C c f a -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName M1 C c f a
m) Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (M1 C c f a -> f a
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 M1 C c f a
m)
instance GShow1Body U1 where
gliftShowsPrecBody :: GShow1Options
-> Fixity
-> Bool
-> String
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> U1 a
-> ShowS
gliftShowsPrecBody GShow1Options
_ Fixity
_ Bool
_ String
conName Int -> a -> ShowS
_ [a] -> ShowS
_ Int
_ U1 a
_ = String -> ShowS
showString String
conName
instance (Selector s, GShow1 f) => GShow1Body (M1 S s f) where
gliftShowsPrecBody :: GShow1Options
-> Fixity
-> Bool
-> String
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> M1 S s f a
-> ShowS
gliftShowsPrecBody GShow1Options
opts Fixity
_ Bool
conIsRecord String
conName Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d M1 S s f a
m = 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
conName 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
. Bool -> ShowS -> ShowS
showBraces Bool
conIsRecord ((ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ShowS
forall a. a -> a
id (GShow1Options
-> Bool
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> M1 S s f a
-> [ShowS]
forall (f :: * -> *) a.
GShow1Body f =>
GShow1Options
-> Bool
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> f a
-> [ShowS]
gliftShowsPrecAll GShow1Options
opts Bool
conIsRecord Int -> a -> ShowS
sp [a] -> ShowS
sl Int
11 M1 S s f a
m))
gliftShowsPrecAll :: GShow1Options
-> Bool
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> M1 S s f a
-> [ShowS]
gliftShowsPrecAll GShow1Options
opts Bool
conIsRecord Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d M1 S s f a
m = [ (if Bool
conIsRecord Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (M1 S s f a -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName M1 S s f a
m)) then String -> ShowS
showString (M1 S s f a -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName M1 S s f a
m) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" = " else ShowS
forall a. a -> a
id) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
GShow1 f =>
GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
gliftShowsPrec GShow1Options
opts Int -> a -> ShowS
sp [a] -> ShowS
sl (if Bool
conIsRecord then Int
0 else Int
d) (M1 S s f a -> f a
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 M1 S s f a
m) ]
instance (GShow1Body f, GShow1Body g) => GShow1Body (f :*: g) where
gliftShowsPrecBody :: GShow1Options
-> Fixity
-> Bool
-> String
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> (:*:) f g a
-> ShowS
gliftShowsPrecBody GShow1Options
opts Fixity
conFixity Bool
conIsRecord String
conName Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (f a
a :*: g a
b) = case Fixity
conFixity of
Fixity
Prefix -> 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
conName 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
. if Bool
conIsRecord
then Bool -> ShowS -> ShowS
showBraces Bool
True ((ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ShowS
forall a. a -> a
id (ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
intersperse (String -> ShowS
showString String
", ") (GShow1Options
-> Bool
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> (:*:) f g a
-> [ShowS]
forall (f :: * -> *) a.
GShow1Body f =>
GShow1Options
-> Bool
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> f a
-> [ShowS]
gliftShowsPrecAll GShow1Options
opts Bool
conIsRecord Int -> a -> ShowS
sp [a] -> ShowS
sl Int
11 (f a
a f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g a
b))))
else (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ShowS
forall a. a -> a
id (ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
intersperse (String -> ShowS
showString String
" ") (GShow1Options
-> Bool
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> (:*:) f g a
-> [ShowS]
forall (f :: * -> *) a.
GShow1Body f =>
GShow1Options
-> Bool
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> f a
-> [ShowS]
gliftShowsPrecAll GShow1Options
opts Bool
conIsRecord Int -> a -> ShowS
sp [a] -> ShowS
sl Int
11 (f a
a f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g a
b)))
Infix Associativity
_ Int
prec -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
prec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
GShow1 f =>
GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
gliftShowsPrec GShow1Options
opts Int -> a -> ShowS
sp [a] -> ShowS
sl (Int -> Int
forall a. Enum a => a -> a
succ Int
prec) f a
a 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
conName 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
. GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> g a -> ShowS
forall (f :: * -> *) a.
GShow1 f =>
GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
gliftShowsPrec GShow1Options
opts Int -> a -> ShowS
sp [a] -> ShowS
sl (Int -> Int
forall a. Enum a => a -> a
succ Int
prec) g a
b
gliftShowsPrecAll :: GShow1Options
-> Bool
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> (:*:) f g a
-> [ShowS]
gliftShowsPrecAll GShow1Options
opts Bool
conIsRecord Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (f a
a :*: g a
b) = GShow1Options
-> Bool
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> f a
-> [ShowS]
forall (f :: * -> *) a.
GShow1Body f =>
GShow1Options
-> Bool
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> f a
-> [ShowS]
gliftShowsPrecAll GShow1Options
opts Bool
conIsRecord Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d f a
a [ShowS] -> [ShowS] -> [ShowS]
forall a. Semigroup a => a -> a -> a
<> GShow1Options
-> Bool
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> g a
-> [ShowS]
forall (f :: * -> *) a.
GShow1Body f =>
GShow1Options
-> Bool
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> f a
-> [ShowS]
gliftShowsPrecAll GShow1Options
opts Bool
conIsRecord Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d g a
b
instance GShow1 f => GShow1 (M1 S c f) where
gliftShowsPrec :: GShow1Options
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> M1 S c f a
-> ShowS
gliftShowsPrec GShow1Options
opts Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (M1 f a
a) = GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
GShow1 f =>
GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
gliftShowsPrec GShow1Options
opts Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d f a
a
instance (GShow1 f, GShow1 g) => GShow1 (f :+: g) where
gliftShowsPrec :: GShow1Options
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> (:+:) f g a
-> ShowS
gliftShowsPrec GShow1Options
opts Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (L1 f a
l) = GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
GShow1 f =>
GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
gliftShowsPrec GShow1Options
opts Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d f a
l
gliftShowsPrec GShow1Options
opts Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (R1 g a
r) = GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> g a -> ShowS
forall (f :: * -> *) a.
GShow1 f =>
GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
gliftShowsPrec GShow1Options
opts Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d g a
r
instance (GShow1 f, GShow1 g) => GShow1 (f :*: g) where
gliftShowsPrec :: GShow1Options
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> (:*:) f g a
-> ShowS
gliftShowsPrec GShow1Options
opts Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (f a
a :*: g a
b) = GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
GShow1 f =>
GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
gliftShowsPrec GShow1Options
opts Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d f a
a 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
. GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> g a -> ShowS
forall (f :: * -> *) a.
GShow1 f =>
GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
gliftShowsPrec GShow1Options
opts Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d g a
b
instance (Show1 f, GShow1 g) => GShow1 (f :.: g) where
gliftShowsPrec :: GShow1Options
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> (:.:) f g a
-> ShowS
gliftShowsPrec GShow1Options
opts Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (Comp1 f (g a)
a) = (Int -> g a -> ShowS)
-> ([g a] -> ShowS) -> Int -> f (g a) -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec (GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> g a -> ShowS
forall (f :: * -> *) a.
GShow1 f =>
GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
gliftShowsPrec GShow1Options
opts Int -> a -> ShowS
sp [a] -> ShowS
sl) (GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> [g a] -> ShowS
forall (f :: * -> *) a.
GShow1 f =>
GShow1Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
gliftShowList GShow1Options
opts Int -> a -> ShowS
sp [a] -> ShowS
sl) Int
d f (g a)
a
showBraces :: Bool -> ShowS -> ShowS
showBraces :: Bool -> ShowS -> ShowS
showBraces Bool
should ShowS
rest = if Bool
should then Char -> ShowS
showChar Char
'{' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
rest ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}' else ShowS
rest
newtype Generically f a = Generically { Generically f a -> f a
unGenerically :: f a }
instance (Generic1 f, GEq1 (Rep1 f)) => Eq1 (Generically f) where liftEq :: (a -> b -> Bool) -> Generically f a -> Generically f b -> Bool
liftEq a -> b -> Bool
eq (Generically f a
a1) (Generically f b
a2) = (a -> b -> Bool) -> f a -> f b -> Bool
forall (f :: * -> *) a b.
(Generic1 f, GEq1 (Rep1 f)) =>
(a -> b -> Bool) -> f a -> f b -> Bool
genericLiftEq a -> b -> Bool
eq f a
a1 f b
a2
instance (Generic1 f, GEq1 (Rep1 f), GOrd1 (Rep1 f)) => Ord1 (Generically f) where liftCompare :: (a -> b -> Ordering)
-> Generically f a -> Generically f b -> Ordering
liftCompare a -> b -> Ordering
compare (Generically f a
a1) (Generically f b
a2) = (a -> b -> Ordering) -> f a -> f b -> Ordering
forall (f :: * -> *) a b.
(Generic1 f, GOrd1 (Rep1 f)) =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
genericLiftCompare a -> b -> Ordering
compare f a
a1 f b
a2
instance (Generic1 f, GShow1 (Rep1 f)) => Show1 (Generically f) where liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Generically f a -> ShowS
liftShowsPrec Int -> a -> ShowS
d [a] -> ShowS
sp Int
sl = (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
(Generic1 f, GShow1 (Rep1 f)) =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
genericLiftShowsPrec Int -> a -> ShowS
d [a] -> ShowS
sp Int
sl (f a -> ShowS)
-> (Generically f a -> f a) -> Generically f a -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Generically f a -> f a
forall (f :: * -> *) a. Generically f a -> f a
unGenerically