{-# 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)

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

-- | A suitable implementation of Eq1’s liftEq for Generic1 types.
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)


-- | Generically-derivable lifting of the 'Ord' class to unary type constructors.
class GOrd1 f where
  -- | Lift a comparison function through the type constructor.
  --
  --   The function will usually be applied to a comparison function, but the more general type ensures that the implementation uses it to compare elements of the first container with elements of the second.
  gliftCompare :: (a -> b -> Ordering) -> f a -> f b -> Ordering

-- | A suitable implementation of Ord1’s liftCompare for Generic1 types.
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)


-- | Generically-derivable lifting of the 'Show' class to unary type constructors.
class GShow1 f where
  -- | showsPrec function for an application of the type constructor based on showsPrec and showList functions for the argument type.
  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
  -- | showsPrec function for the body of an application of the type constructor based on showsPrec and showList functions for the argument type.
  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]

-- | showList function for an application of the type constructor based on showsPrec and showList functions for the argument type. The default implementation using standard list syntax is correct for most types.
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)

-- | A suitable implementation of Show1’s liftShowsPrec for Generic1 types.
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

-- | A suitable implementation of Show1’s liftShowsPrec for Generic1 types.
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


-- Generics

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

-- | Used with the `DerivingVia` extension to provide fast derivations for
-- 'Eq1', 'Show1', and 'Ord1'.
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