{-# LANGUAGE CPP #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}

#if __GLASGOW_HASKELL__ >= 806
{-# LANGUAGE QuantifiedConstraints #-}
#endif

{-|
Module:      Data.Functor.Classes.Generic
Copyright:   (C) 2015-2016 Edward Kmett, Ryan Scott
License:     BSD-style (see the file LICENSE)
Maintainer:  Ryan Scott
Stability:   Provisional
Portability: GHC

Internal functionality for "Data.Functor.Classes.Generic".

This is an internal module and, as such, the API is not guaranteed to remain the
same between any given release.
-}
module Data.Functor.Classes.Generic.Internal
  ( -- * Options
    Options(..)
  , defaultOptions
  , latestGHCOptions
    -- * 'Eq1'
  , liftEqDefault
  , liftEqOptions
  , GEq1(..)
    -- * 'Ord1'
  , liftCompareDefault
  , liftCompareOptions
  , GOrd1(..)
    -- * 'Read1'
  , liftReadsPrecDefault
  , liftReadsPrecOptions
  , GRead1(..)
  , GRead1Con(..)
    -- * 'Show1'
  , liftShowsPrecDefault
  , liftShowsPrecOptions
  , GShow1(..)
  , GShow1Con(..)
    -- * 'Eq'
  , eqDefault
  , GEq(..)
    -- * 'Ord'
  , compareDefault
  , GOrd(..)
    -- * 'Read'
  , readsPrecDefault
  , GRead(..)
    -- * 'Show'
  , showsPrecDefault
  , showsPrecOptions
  , GShow(..)
    -- * 'FunctorClassesDefault'
  , FunctorClassesDefault(..)
  -- * Miscellaneous types
  , ConType(..)
  , IsNullaryDataType(..)
  , IsNullaryCon(..)
  ) where

import Data.Char (isSymbol, ord)
import Data.Functor.Classes
import GHC.Exts
import GHC.Generics hiding (prec)
import GHC.Read (expectP, list, paren, parens)
import GHC.Show (appPrec, appPrec1, showSpace)
import Text.ParserCombinators.ReadPrec
import Text.Read (Read(..))
import Text.Read.Lex (Lexeme(..))
import Text.Show (showListWith)


-------------------------------------------------------------------------------
-- * Options
-------------------------------------------------------------------------------

-- | Options that further configure how the functions in
-- "Data.Functor.Classes.Generic" should behave. Currently, the 'Options' have
-- no effect (but this may change in the future).
data Options = Options

-- | Options that match the behavior of the installed version of GHC.
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = Options
Options

-- | Options that match the behavior of the most recent GHC release.
latestGHCOptions :: Options
latestGHCOptions :: Options
latestGHCOptions = Options
Options

-------------------------------------------------------------------------------
-- * Eq
-------------------------------------------------------------------------------

-- | A default @('==')@ implementation for 'Generic1' instances that leverages
-- 'Eq1'.
eqDefault :: (GEq (Rep1 f a), Generic1 f) => f a -> f a -> Bool
eqDefault :: forall (f :: * -> *) a.
(GEq (Rep1 f a), Generic1 f) =>
f a -> f a -> Bool
eqDefault f a
m f a
n = Rep1 f a -> Rep1 f a -> Bool
forall a. GEq a => a -> a -> Bool
geq (f a -> Rep1 f a
forall a. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f a
m) (f a -> Rep1 f a
forall a. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f a
n)

-- | Class of generic representation types that can be checked for equality.
class GEq a where
  geq :: a -> a -> Bool

instance Eq c => GEq (K1 i c p) where
  geq :: K1 i c p -> K1 i c p -> Bool
geq (K1 c
c) (K1 c
d) = c
c c -> c -> Bool
forall a. Eq a => a -> a -> Bool
== c
d

instance (GEq (f p), GEq (g p)) => GEq ((f :*: g) p) where
  geq :: (:*:) f g p -> (:*:) f g p -> Bool
geq (f p
a :*: g p
b) (f p
c :*: g p
d) = f p -> f p -> Bool
forall a. GEq a => a -> a -> Bool
geq f p
a f p
c Bool -> Bool -> Bool
&& g p -> g p -> Bool
forall a. GEq a => a -> a -> Bool
geq g p
b g p
d

instance (GEq (f p), GEq (g p)) => GEq ((f :+: g) p) where
  geq :: (:+:) f g p -> (:+:) f g p -> Bool
geq (L1 f p
a) (L1 f p
c) = f p -> f p -> Bool
forall a. GEq a => a -> a -> Bool
geq f p
a f p
c
  geq (R1 g p
b) (R1 g p
d) = g p -> g p -> Bool
forall a. GEq a => a -> a -> Bool
geq g p
b g p
d
  geq (:+:) f g p
_      (:+:) f g p
_      = Bool
False

instance GEq (f p) => GEq (M1 i c f p) where
  geq :: M1 i c f p -> M1 i c f p -> Bool
geq (M1 f p
a) (M1 f p
b) = f p -> f p -> Bool
forall a. GEq a => a -> a -> Bool
geq f p
a f p
b

instance GEq (U1 p) where
  geq :: U1 p -> U1 p -> Bool
geq U1 p
U1 U1 p
U1 = Bool
True

instance GEq (V1 p) where
  geq :: V1 p -> V1 p -> Bool
geq V1 p
_ V1 p
_ = Bool
True

instance Eq p => GEq (Par1 p) where
  geq :: Par1 p -> Par1 p -> Bool
geq (Par1 p
a) (Par1 p
b) = p
a p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== p
b

instance (Eq1 f, Eq p) => GEq (Rec1 f p) where
  geq :: Rec1 f p -> Rec1 f p -> Bool
geq (Rec1 f p
a) (Rec1 f p
b) = f p -> f p -> Bool
forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
eq1 f p
a f p
b

instance (Eq1 f, GEq (g p)) => GEq ((f :.: g) p) where
  geq :: (:.:) f g p -> (:.:) f g p -> Bool
geq (Comp1 f (g p)
m) (Comp1 f (g p)
n) = (g p -> g p -> Bool) -> f (g p) -> f (g p) -> 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 g p -> g p -> Bool
forall a. GEq a => a -> a -> Bool
geq f (g p)
m f (g p)
n

-- Unboxed types
instance GEq (UAddr p) where
  geq :: UAddr p -> UAddr p -> Bool
geq = UAddr p -> UAddr p -> Bool
forall p q. UAddr p -> UAddr q -> Bool
eqUAddr

instance GEq (UChar p) where
  geq :: UChar p -> UChar p -> Bool
geq = UChar p -> UChar p -> Bool
forall p q. UChar p -> UChar q -> Bool
eqUChar

instance GEq (UDouble p) where
  geq :: UDouble p -> UDouble p -> Bool
geq = UDouble p -> UDouble p -> Bool
forall p q. UDouble p -> UDouble q -> Bool
eqUDouble

instance GEq (UFloat p) where
  geq :: UFloat p -> UFloat p -> Bool
geq = UFloat p -> UFloat p -> Bool
forall p q. UFloat p -> UFloat q -> Bool
eqUFloat

instance GEq (UInt p) where
  geq :: UInt p -> UInt p -> Bool
geq = UInt p -> UInt p -> Bool
forall p q. UInt p -> UInt q -> Bool
eqUInt

instance GEq (UWord p) where
  geq :: UWord p -> UWord p -> Bool
geq = UWord p -> UWord p -> Bool
forall p q. UWord p -> UWord q -> Bool
eqUWord

-------------------------------------------------------------------------------
-- * Eq1
-------------------------------------------------------------------------------

-- | A sensible default 'liftEq' implementation for 'Generic1' instances.
liftEqDefault :: (GEq1 (Rep1 f), Generic1 f)
              => (a -> b -> Bool) -> f a -> f b -> Bool
liftEqDefault :: forall (f :: * -> *) a b.
(GEq1 (Rep1 f), Generic1 f) =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEqDefault = Options -> (a -> b -> Bool) -> f a -> f b -> Bool
forall (f :: * -> *) a b.
(GEq1 (Rep1 f), Generic1 f) =>
Options -> (a -> b -> Bool) -> f a -> f b -> Bool
liftEqOptions Options
defaultOptions

-- | Like 'liftEqDefault', but with configurable 'Options'. Currently,
-- the 'Options' have no effect (but this may change in the future).
liftEqOptions :: (GEq1 (Rep1 f), Generic1 f)
              => Options -> (a -> b -> Bool) -> f a -> f b -> Bool
liftEqOptions :: forall (f :: * -> *) a b.
(GEq1 (Rep1 f), Generic1 f) =>
Options -> (a -> b -> Bool) -> f a -> f b -> Bool
liftEqOptions Options
_ a -> b -> Bool
f f a
m f b
n = (a -> b -> Bool) -> Rep1 f a -> Rep1 f b -> Bool
forall a b. (a -> b -> Bool) -> Rep1 f a -> Rep1 f b -> Bool
forall (t :: * -> *) a b.
GEq1 t =>
(a -> b -> Bool) -> t a -> t b -> Bool
gliftEq a -> b -> Bool
f (f a -> Rep1 f a
forall a. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f a
m) (f b -> Rep1 f b
forall a. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f b
n)

-- | Class of generic representation types that can lift equality through unary
-- type constructors.
class
#if __GLASGOW_HASKELL__ >= 806
    (forall a. Eq a => GEq (t a)) =>
#endif
    GEq1 t where
  gliftEq :: (a -> b -> Bool) -> t a -> t b -> Bool

instance Eq c => GEq1 (K1 i c) where
  gliftEq :: forall a b. (a -> b -> Bool) -> K1 i c a -> K1 i c b -> Bool
gliftEq a -> b -> Bool
_ (K1 c
c) (K1 c
d) = c
c c -> c -> Bool
forall a. Eq a => a -> a -> Bool
== c
d

instance (GEq1 f, GEq1 g) => GEq1 (f :*: g) where
  gliftEq :: forall a b. (a -> b -> Bool) -> (:*:) f g a -> (:*:) f g b -> Bool
gliftEq a -> b -> Bool
f (f a
a :*: g a
b) (f b
c :*: g b
d) = (a -> b -> Bool) -> f a -> f b -> Bool
forall a b. (a -> b -> Bool) -> f a -> f b -> Bool
forall (t :: * -> *) a b.
GEq1 t =>
(a -> b -> Bool) -> t a -> t b -> Bool
gliftEq a -> b -> Bool
f f a
a f b
c Bool -> Bool -> Bool
&& (a -> b -> Bool) -> g a -> g b -> Bool
forall a b. (a -> b -> Bool) -> g a -> g b -> Bool
forall (t :: * -> *) a b.
GEq1 t =>
(a -> b -> Bool) -> t a -> t b -> Bool
gliftEq a -> b -> Bool
f g a
b g b
d

instance (GEq1 f, GEq1 g) => GEq1 (f :+: g) where
  gliftEq :: forall a b. (a -> b -> Bool) -> (:+:) f g a -> (:+:) f g b -> Bool
gliftEq a -> b -> Bool
f (L1 f a
a) (L1 f b
c) = (a -> b -> Bool) -> f a -> f b -> Bool
forall a b. (a -> b -> Bool) -> f a -> f b -> Bool
forall (t :: * -> *) a b.
GEq1 t =>
(a -> b -> Bool) -> t a -> t b -> Bool
gliftEq a -> b -> Bool
f f a
a f b
c
  gliftEq a -> b -> Bool
f (R1 g a
b) (R1 g b
d) = (a -> b -> Bool) -> g a -> g b -> Bool
forall a b. (a -> b -> Bool) -> g a -> g b -> Bool
forall (t :: * -> *) a b.
GEq1 t =>
(a -> b -> Bool) -> t a -> t b -> Bool
gliftEq a -> b -> Bool
f g a
b g b
d
  gliftEq a -> b -> Bool
_ (:+:) f g a
_      (:+:) f g b
_      = Bool
False

instance GEq1 f => GEq1 (M1 i c f) where
  gliftEq :: forall a b. (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 a b. (a -> b -> Bool) -> f a -> f b -> Bool
forall (t :: * -> *) a b.
GEq1 t =>
(a -> b -> Bool) -> t a -> t b -> Bool
gliftEq a -> b -> Bool
f f a
a f b
b

instance GEq1 U1 where
  gliftEq :: forall a b. (a -> b -> Bool) -> U1 a -> U1 b -> Bool
gliftEq a -> b -> Bool
_ U1 a
U1 U1 b
U1 = Bool
True

instance GEq1 V1 where
  gliftEq :: forall a b. (a -> b -> Bool) -> V1 a -> V1 b -> Bool
gliftEq a -> b -> Bool
_ V1 a
_ V1 b
_ = Bool
True

instance GEq1 Par1 where
  gliftEq :: forall a b. (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 Eq1 f => GEq1 (Rec1 f) where
  gliftEq :: forall a b. (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 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
f f a
a f b
b

instance (Eq1 f, GEq1 g) => GEq1 (f :.: g) where
  gliftEq :: forall a b. (a -> b -> Bool) -> (:.:) f g a -> (:.:) f g b -> Bool
gliftEq a -> b -> Bool
f (Comp1 f (g a)
m) (Comp1 f (g b)
n) = (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 (t :: * -> *) a b.
GEq1 t =>
(a -> b -> Bool) -> t a -> t b -> Bool
gliftEq a -> b -> Bool
f) f (g a)
m f (g b)
n

-- Unboxed types
instance GEq1 UAddr where
  gliftEq :: forall a b. (a -> b -> Bool) -> UAddr a -> UAddr b -> Bool
gliftEq a -> b -> Bool
_ = UAddr a -> UAddr b -> Bool
forall p q. UAddr p -> UAddr q -> Bool
eqUAddr

instance GEq1 UChar where
  gliftEq :: forall a b. (a -> b -> Bool) -> UChar a -> UChar b -> Bool
gliftEq a -> b -> Bool
_ = UChar a -> UChar b -> Bool
forall p q. UChar p -> UChar q -> Bool
eqUChar

instance GEq1 UDouble where
  gliftEq :: forall a b. (a -> b -> Bool) -> UDouble a -> UDouble b -> Bool
gliftEq a -> b -> Bool
_ = UDouble a -> UDouble b -> Bool
forall p q. UDouble p -> UDouble q -> Bool
eqUDouble

instance GEq1 UFloat where
  gliftEq :: forall a b. (a -> b -> Bool) -> UFloat a -> UFloat b -> Bool
gliftEq a -> b -> Bool
_ = UFloat a -> UFloat b -> Bool
forall p q. UFloat p -> UFloat q -> Bool
eqUFloat

instance GEq1 UInt where
  gliftEq :: forall a b. (a -> b -> Bool) -> UInt a -> UInt b -> Bool
gliftEq a -> b -> Bool
_ = UInt a -> UInt b -> Bool
forall p q. UInt p -> UInt q -> Bool
eqUInt

instance GEq1 UWord where
  gliftEq :: forall a b. (a -> b -> Bool) -> UWord a -> UWord b -> Bool
gliftEq a -> b -> Bool
_ = UWord a -> UWord b -> Bool
forall p q. UWord p -> UWord q -> Bool
eqUWord

eqUAddr :: UAddr p -> UAddr q -> Bool
eqUAddr :: forall p q. UAddr p -> UAddr q -> Bool
eqUAddr (UAddr Addr#
a1) (UAddr Addr#
a2) = Int# -> Bool
isTrue# (Addr# -> Addr# -> Int#
eqAddr# Addr#
a1 Addr#
a2)

eqUChar :: UChar p -> UChar q -> Bool
eqUChar :: forall p q. UChar p -> UChar q -> Bool
eqUChar (UChar Char#
c1) (UChar Char#
c2) = Int# -> Bool
isTrue# (Char# -> Char# -> Int#
eqChar# Char#
c1 Char#
c2)

eqUDouble :: UDouble p -> UDouble q -> Bool
eqUDouble :: forall p q. UDouble p -> UDouble q -> Bool
eqUDouble (UDouble Double#
d1) (UDouble Double#
d2) = Int# -> Bool
isTrue# (Double#
d1 Double# -> Double# -> Int#
==## Double#
d2)

eqUFloat :: UFloat p -> UFloat q -> Bool
eqUFloat :: forall p q. UFloat p -> UFloat q -> Bool
eqUFloat (UFloat Float#
f1) (UFloat Float#
f2) = Int# -> Bool
isTrue# (Float# -> Float# -> Int#
eqFloat# Float#
f1 Float#
f2)

eqUInt :: UInt p -> UInt q -> Bool
eqUInt :: forall p q. UInt p -> UInt q -> Bool
eqUInt (UInt Int#
i1) (UInt Int#
i2) = Int# -> Bool
isTrue# (Int#
i1 Int# -> Int# -> Int#
==# Int#
i2)

eqUWord :: UWord p -> UWord q -> Bool
eqUWord :: forall p q. UWord p -> UWord q -> Bool
eqUWord (UWord Word#
w1) (UWord Word#
w2) = Int# -> Bool
isTrue# (Word# -> Word# -> Int#
eqWord# Word#
w1 Word#
w2)

-------------------------------------------------------------------------------
-- * Ord
-------------------------------------------------------------------------------

-- | A default 'compare' implementation for 'Generic1' instances that leverages
-- 'Ord1'.
compareDefault :: (GOrd (Rep1 f a), Generic1 f) => f a -> f a -> Ordering
compareDefault :: forall (f :: * -> *) a.
(GOrd (Rep1 f a), Generic1 f) =>
f a -> f a -> Ordering
compareDefault f a
m f a
n = Rep1 f a -> Rep1 f a -> Ordering
forall a. GOrd a => a -> a -> Ordering
gcompare (f a -> Rep1 f a
forall a. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f a
m) (f a -> Rep1 f a
forall a. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f a
n)

-- | Class of generic representation types that can be totally ordered.
class GEq a => GOrd a where
  gcompare :: a -> a -> Ordering

instance Ord c => GOrd (K1 i c p) where
  gcompare :: K1 i c p -> K1 i c p -> Ordering
gcompare (K1 c
c) (K1 c
d) = c -> c -> Ordering
forall a. Ord a => a -> a -> Ordering
compare c
c c
d

instance (GOrd (f p), GOrd (g p)) => GOrd ((f :*: g) p) where
  gcompare :: (:*:) f g p -> (:*:) f g p -> Ordering
gcompare (f p
a :*: g p
b) (f p
c :*: g p
d) = f p -> f p -> Ordering
forall a. GOrd a => a -> a -> Ordering
gcompare f p
a f p
c Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` g p -> g p -> Ordering
forall a. GOrd a => a -> a -> Ordering
gcompare g p
b g p
d

instance (GOrd (f p), GOrd (g p)) => GOrd ((f :+: g) p) where
  gcompare :: (:+:) f g p -> (:+:) f g p -> Ordering
gcompare (L1 f p
a) (L1 f p
c) = f p -> f p -> Ordering
forall a. GOrd a => a -> a -> Ordering
gcompare f p
a f p
c
  gcompare L1{}   R1{}   = Ordering
LT
  gcompare R1{}   L1{}   = Ordering
GT
  gcompare (R1 g p
b) (R1 g p
d) = g p -> g p -> Ordering
forall a. GOrd a => a -> a -> Ordering
gcompare g p
b g p
d

instance GOrd (f p) => GOrd (M1 i c f p) where
  gcompare :: M1 i c f p -> M1 i c f p -> Ordering
gcompare (M1 f p
a) (M1 f p
b) = f p -> f p -> Ordering
forall a. GOrd a => a -> a -> Ordering
gcompare f p
a f p
b

instance GOrd (U1 p) where
  gcompare :: U1 p -> U1 p -> Ordering
gcompare U1 p
U1 U1 p
U1 = Ordering
EQ

instance GOrd (V1 p) where
  gcompare :: V1 p -> V1 p -> Ordering
gcompare V1 p
_ V1 p
_ = Ordering
EQ

instance Ord p => GOrd (Par1 p) where
  gcompare :: Par1 p -> Par1 p -> Ordering
gcompare (Par1 p
a) (Par1 p
b) = p -> p -> Ordering
forall a. Ord a => a -> a -> Ordering
compare p
a p
b

instance (Ord1 f, Ord p) => GOrd (Rec1 f p) where
  gcompare :: Rec1 f p -> Rec1 f p -> Ordering
gcompare (Rec1 f p
a) (Rec1 f p
b) = f p -> f p -> Ordering
forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1 f p
a f p
b

instance (Ord1 f, GOrd (g p)) => GOrd ((f :.: g) p) where
  gcompare :: (:.:) f g p -> (:.:) f g p -> Ordering
gcompare (Comp1 f (g p)
m) (Comp1 f (g p)
n) = (g p -> g p -> Ordering) -> f (g p) -> f (g p) -> 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 g p -> g p -> Ordering
forall a. GOrd a => a -> a -> Ordering
gcompare f (g p)
m f (g p)
n

-- Unboxed types
instance GOrd (UAddr p) where
  gcompare :: UAddr p -> UAddr p -> Ordering
gcompare = UAddr p -> UAddr p -> Ordering
forall p q. UAddr p -> UAddr q -> Ordering
compareUAddr

instance GOrd (UChar p) where
  gcompare :: UChar p -> UChar p -> Ordering
gcompare = UChar p -> UChar p -> Ordering
forall p q. UChar p -> UChar q -> Ordering
compareUChar

instance GOrd (UDouble p) where
  gcompare :: UDouble p -> UDouble p -> Ordering
gcompare = UDouble p -> UDouble p -> Ordering
forall p q. UDouble p -> UDouble q -> Ordering
compareUDouble

instance GOrd (UFloat p) where
  gcompare :: UFloat p -> UFloat p -> Ordering
gcompare = UFloat p -> UFloat p -> Ordering
forall p q. UFloat p -> UFloat q -> Ordering
compareUFloat

instance GOrd (UInt p) where
  gcompare :: UInt p -> UInt p -> Ordering
gcompare = UInt p -> UInt p -> Ordering
forall p q. UInt p -> UInt q -> Ordering
compareUInt

instance GOrd (UWord p) where
  gcompare :: UWord p -> UWord p -> Ordering
gcompare = UWord p -> UWord p -> Ordering
forall p q. UWord p -> UWord q -> Ordering
compareUWord

-------------------------------------------------------------------------------
-- * Ord1
-------------------------------------------------------------------------------

-- | A sensible default 'liftCompare' implementation for 'Generic1' instances.
liftCompareDefault :: (GOrd1 (Rep1 f), Generic1 f)
                   => (a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompareDefault :: forall (f :: * -> *) a b.
(GOrd1 (Rep1 f), Generic1 f) =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompareDefault = Options -> (a -> b -> Ordering) -> f a -> f b -> Ordering
forall (f :: * -> *) a b.
(GOrd1 (Rep1 f), Generic1 f) =>
Options -> (a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompareOptions Options
defaultOptions

-- | Like 'liftCompareDefault', but with configurable 'Options'. Currently,
-- the 'Options' have no effect (but this may change in the future).
liftCompareOptions :: (GOrd1 (Rep1 f), Generic1 f)
                   => Options -> (a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompareOptions :: forall (f :: * -> *) a b.
(GOrd1 (Rep1 f), Generic1 f) =>
Options -> (a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompareOptions Options
_ a -> b -> Ordering
f f a
m f b
n = (a -> b -> Ordering) -> Rep1 f a -> Rep1 f b -> Ordering
forall a b.
(a -> b -> Ordering) -> Rep1 f a -> Rep1 f b -> Ordering
forall (t :: * -> *) a b.
GOrd1 t =>
(a -> b -> Ordering) -> t a -> t b -> Ordering
gliftCompare a -> b -> Ordering
f (f a -> Rep1 f a
forall a. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f a
m) (f b -> Rep1 f b
forall a. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f b
n)

-- | Class of generic representation types that can lift a total order through
-- unary type constructors.
class ( GEq1 t
#if __GLASGOW_HASKELL__ >= 806
      , forall a. Ord a => GOrd (t a)
#endif
      ) => GOrd1 t where
  gliftCompare :: (a -> b -> Ordering) -> t a -> t b -> Ordering

instance Ord c => GOrd1 (K1 i c) where
  gliftCompare :: forall a b.
(a -> b -> Ordering) -> K1 i c a -> K1 i c b -> Ordering
gliftCompare a -> b -> Ordering
_ (K1 c
c) (K1 c
d) = c -> c -> Ordering
forall a. Ord a => a -> a -> Ordering
compare c
c c
d

instance (GOrd1 f, GOrd1 g) => GOrd1 (f :*: g) where
  gliftCompare :: forall a b.
(a -> b -> Ordering) -> (:*:) f g a -> (:*:) f g b -> Ordering
gliftCompare a -> b -> Ordering
f (f a
a :*: g a
b) (f b
c :*: g b
d) =
    (a -> b -> Ordering) -> f a -> f b -> Ordering
forall a b. (a -> b -> Ordering) -> f a -> f b -> Ordering
forall (t :: * -> *) a b.
GOrd1 t =>
(a -> b -> Ordering) -> t a -> t b -> Ordering
gliftCompare a -> b -> Ordering
f f a
a f b
c Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` (a -> b -> Ordering) -> g a -> g b -> Ordering
forall a b. (a -> b -> Ordering) -> g a -> g b -> Ordering
forall (t :: * -> *) a b.
GOrd1 t =>
(a -> b -> Ordering) -> t a -> t b -> Ordering
gliftCompare a -> b -> Ordering
f g a
b g b
d

instance (GOrd1 f, GOrd1 g) => GOrd1 (f :+: g) where
  gliftCompare :: forall a b.
(a -> b -> Ordering) -> (:+:) f g a -> (:+:) f g b -> Ordering
gliftCompare a -> b -> Ordering
f (L1 f a
a) (L1 f b
c) = (a -> b -> Ordering) -> f a -> f b -> Ordering
forall a b. (a -> b -> Ordering) -> f a -> f b -> Ordering
forall (t :: * -> *) a b.
GOrd1 t =>
(a -> b -> Ordering) -> t a -> t b -> Ordering
gliftCompare a -> b -> Ordering
f f a
a f b
c
  gliftCompare a -> b -> Ordering
_ L1{}   R1{}   = Ordering
LT
  gliftCompare a -> b -> Ordering
_ R1{}   L1{}   = Ordering
GT
  gliftCompare a -> b -> Ordering
f (R1 g a
b) (R1 g b
d) = (a -> b -> Ordering) -> g a -> g b -> Ordering
forall a b. (a -> b -> Ordering) -> g a -> g b -> Ordering
forall (t :: * -> *) a b.
GOrd1 t =>
(a -> b -> Ordering) -> t a -> t b -> Ordering
gliftCompare a -> b -> Ordering
f g a
b g b
d

instance GOrd1 f => GOrd1 (M1 i c f) where
  gliftCompare :: forall a b.
(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 a b. (a -> b -> Ordering) -> f a -> f b -> Ordering
forall (t :: * -> *) a b.
GOrd1 t =>
(a -> b -> Ordering) -> t a -> t b -> Ordering
gliftCompare a -> b -> Ordering
f f a
a f b
b

instance GOrd1 U1 where
  gliftCompare :: forall a b. (a -> b -> Ordering) -> U1 a -> U1 b -> Ordering
gliftCompare a -> b -> Ordering
_ U1 a
U1 U1 b
U1 = Ordering
EQ

instance GOrd1 V1 where
  gliftCompare :: forall a b. (a -> b -> Ordering) -> V1 a -> V1 b -> Ordering
gliftCompare a -> b -> Ordering
_ V1 a
_ V1 b
_ = Ordering
EQ

instance GOrd1 Par1 where
  gliftCompare :: forall a b. (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 Ord1 f => GOrd1 (Rec1 f) where
  gliftCompare :: forall a b.
(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 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
f f a
a f b
b

instance (Ord1 f, GOrd1 g) => GOrd1 (f :.: g) where
  gliftCompare :: forall a b.
(a -> b -> Ordering) -> (:.:) f g a -> (:.:) f g b -> Ordering
gliftCompare a -> b -> Ordering
f (Comp1 f (g a)
m) (Comp1 f (g b)
n) = (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 (t :: * -> *) a b.
GOrd1 t =>
(a -> b -> Ordering) -> t a -> t b -> Ordering
gliftCompare a -> b -> Ordering
f) f (g a)
m f (g b)
n

-- Unboxed types
instance GOrd1 UAddr where
  gliftCompare :: forall a b. (a -> b -> Ordering) -> UAddr a -> UAddr b -> Ordering
gliftCompare a -> b -> Ordering
_ = UAddr a -> UAddr b -> Ordering
forall p q. UAddr p -> UAddr q -> Ordering
compareUAddr

instance GOrd1 UChar where
  gliftCompare :: forall a b. (a -> b -> Ordering) -> UChar a -> UChar b -> Ordering
gliftCompare a -> b -> Ordering
_ = UChar a -> UChar b -> Ordering
forall p q. UChar p -> UChar q -> Ordering
compareUChar

instance GOrd1 UDouble where
  gliftCompare :: forall a b.
(a -> b -> Ordering) -> UDouble a -> UDouble b -> Ordering
gliftCompare a -> b -> Ordering
_ = UDouble a -> UDouble b -> Ordering
forall p q. UDouble p -> UDouble q -> Ordering
compareUDouble

instance GOrd1 UFloat where
  gliftCompare :: forall a b.
(a -> b -> Ordering) -> UFloat a -> UFloat b -> Ordering
gliftCompare a -> b -> Ordering
_ = UFloat a -> UFloat b -> Ordering
forall p q. UFloat p -> UFloat q -> Ordering
compareUFloat

instance GOrd1 UInt where
  gliftCompare :: forall a b. (a -> b -> Ordering) -> UInt a -> UInt b -> Ordering
gliftCompare a -> b -> Ordering
_ = UInt a -> UInt b -> Ordering
forall p q. UInt p -> UInt q -> Ordering
compareUInt

instance GOrd1 UWord where
  gliftCompare :: forall a b. (a -> b -> Ordering) -> UWord a -> UWord b -> Ordering
gliftCompare a -> b -> Ordering
_ = UWord a -> UWord b -> Ordering
forall p q. UWord p -> UWord q -> Ordering
compareUWord

compareUAddr :: UAddr p -> UAddr q -> Ordering
compareUAddr :: forall p q. UAddr p -> UAddr q -> Ordering
compareUAddr (UAddr Addr#
a1) (UAddr Addr#
a2) = Int# -> Int# -> Ordering
primCompare (Addr# -> Addr# -> Int#
eqAddr# Addr#
a1 Addr#
a2) (Addr# -> Addr# -> Int#
leAddr# Addr#
a1 Addr#
a2)

compareUChar :: UChar p -> UChar q -> Ordering
compareUChar :: forall p q. UChar p -> UChar q -> Ordering
compareUChar (UChar Char#
c1) (UChar Char#
c2) = Int# -> Int# -> Ordering
primCompare (Char# -> Char# -> Int#
eqChar# Char#
c1 Char#
c2) (Char# -> Char# -> Int#
leChar# Char#
c1 Char#
c2)

compareUDouble :: UDouble p -> UDouble q -> Ordering
compareUDouble :: forall p q. UDouble p -> UDouble q -> Ordering
compareUDouble (UDouble Double#
d1) (UDouble Double#
d2) = Int# -> Int# -> Ordering
primCompare (Double#
d1 Double# -> Double# -> Int#
==## Double#
d2) (Double#
d1 Double# -> Double# -> Int#
<=## Double#
d2)

compareUFloat :: UFloat p -> UFloat q -> Ordering
compareUFloat :: forall p q. UFloat p -> UFloat q -> Ordering
compareUFloat (UFloat Float#
f1) (UFloat Float#
f2) = Int# -> Int# -> Ordering
primCompare (Float# -> Float# -> Int#
eqFloat# Float#
f1 Float#
f2) (Float# -> Float# -> Int#
leFloat# Float#
f1 Float#
f2)

compareUInt :: UInt p -> UInt q -> Ordering
compareUInt :: forall p q. UInt p -> UInt q -> Ordering
compareUInt (UInt Int#
i1) (UInt Int#
i2) = Int# -> Int# -> Ordering
primCompare (Int#
i1 Int# -> Int# -> Int#
==# Int#
i2) (Int#
i1 Int# -> Int# -> Int#
<=# Int#
i2)

compareUWord :: UWord p -> UWord q -> Ordering
compareUWord :: forall p q. UWord p -> UWord q -> Ordering
compareUWord (UWord Word#
w1) (UWord Word#
w2) = Int# -> Int# -> Ordering
primCompare (Word# -> Word# -> Int#
eqWord# Word#
w1 Word#
w2) (Word# -> Word# -> Int#
leWord# Word#
w1 Word#
w2)

primCompare :: Int# -> Int# -> Ordering
primCompare :: Int# -> Int# -> Ordering
primCompare Int#
eq Int#
le = if Int# -> Bool
isTrue# Int#
eq then Ordering
EQ
                    else if Int# -> Bool
isTrue# Int#
le then Ordering
LT
                    else Ordering
GT

-------------------------------------------------------------------------------
-- * Read
-------------------------------------------------------------------------------

-- | A default 'readsPrec' implementation for 'Generic1' instances that leverages
-- 'Read1'.
readsPrecDefault :: (GRead (Rep1 f a), Generic1 f) => Int -> ReadS (f a)
readsPrecDefault :: forall (f :: * -> *) a.
(GRead (Rep1 f a), Generic1 f) =>
Int -> ReadS (f a)
readsPrecDefault Int
p = ReadPrec (f a) -> Int -> ReadS (f a)
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S ((Rep1 f a -> f a) -> ReadPrec (Rep1 f a) -> ReadPrec (f a)
forall a b. (a -> b) -> ReadPrec a -> ReadPrec b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep1 f a -> f a
forall a. Rep1 f a -> f a
forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
to1 ReadPrec (Rep1 f a)
forall a. GRead a => ReadPrec a
greadPrec) Int
p

-- | Class of generic representation types that can be parsed from a 'String'.
class GRead a where
  greadPrec :: ReadPrec a

instance (GRead (f p), IsNullaryDataType f) => GRead (D1 d f p) where
  greadPrec :: ReadPrec (D1 d f p)
greadPrec = ReadPrec (f p) -> ReadPrec (D1 d f p)
forall (d :: Meta) (f :: * -> *) p.
IsNullaryDataType f =>
ReadPrec (f p) -> ReadPrec (D1 d f p)
d1ReadPrec ReadPrec (f p)
forall a. GRead a => ReadPrec a
greadPrec

instance GRead (V1 p) where
  greadPrec :: ReadPrec (V1 p)
greadPrec = ReadPrec (V1 p)
forall a. ReadPrec a
pfail

instance (GRead (f p), GRead (g p)) => GRead ((f :+: g) p) where
  greadPrec :: ReadPrec ((:+:) f g p)
greadPrec = (f p -> (:+:) f g p) -> ReadPrec (f p) -> ReadPrec ((:+:) f g p)
forall a b. (a -> b) -> ReadPrec a -> ReadPrec b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f p -> (:+:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 ReadPrec (f p)
forall a. GRead a => ReadPrec a
greadPrec ReadPrec ((:+:) f g p)
-> ReadPrec ((:+:) f g p) -> ReadPrec ((:+:) f g p)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++ (g p -> (:+:) f g p) -> ReadPrec (g p) -> ReadPrec ((:+:) f g p)
forall a b. (a -> b) -> ReadPrec a -> ReadPrec b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g p -> (:+:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 ReadPrec (g p)
forall a. GRead a => ReadPrec a
greadPrec

instance (Constructor c, GReadCon (f p), IsNullaryCon f) => GRead (C1 c f p) where
  greadPrec :: ReadPrec (C1 c f p)
greadPrec = (ConType -> ReadPrec (f p)) -> ReadPrec (C1 c f p)
forall (c :: Meta) (f :: * -> *) p.
(Constructor c, IsNullaryCon f) =>
(ConType -> ReadPrec (f p)) -> ReadPrec (C1 c f p)
c1ReadPrec ConType -> ReadPrec (f p)
forall a. GReadCon a => ConType -> ReadPrec a
greadPrecCon

-- | Class of generic representation types that can be parsed from a 'String',
-- and for which the 'ConType' has been determined.
class GReadCon a where
  greadPrecCon :: ConType -> ReadPrec a

instance GReadCon (U1 p) where
  greadPrecCon :: ConType -> ReadPrec (U1 p)
greadPrecCon ConType
_ = U1 p -> ReadPrec (U1 p)
forall a. a -> ReadPrec a
forall (m :: * -> *) a. Monad m => a -> m a
return U1 p
forall k (p :: k). U1 p
U1

instance Read c => GReadCon (K1 i c p) where
  greadPrecCon :: ConType -> ReadPrec (K1 i c p)
greadPrecCon ConType
_ = ReadPrec c -> ReadPrec (K1 i c p)
forall c i p. ReadPrec c -> ReadPrec (K1 i c p)
coerceK1 ReadPrec c
forall a. Read a => ReadPrec a
readPrec

instance (Selector s, GReadCon (f p)) => GReadCon (S1 s f p) where
  greadPrecCon :: ConType -> ReadPrec (S1 s f p)
greadPrecCon = ReadPrec (f p) -> ReadPrec (S1 s f p)
forall (s :: Meta) (f :: * -> *) p.
Selector s =>
ReadPrec (f p) -> ReadPrec (S1 s f p)
s1ReadPrec (ReadPrec (f p) -> ReadPrec (S1 s f p))
-> (ConType -> ReadPrec (f p)) -> ConType -> ReadPrec (S1 s f p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConType -> ReadPrec (f p)
forall a. GReadCon a => ConType -> ReadPrec a
greadPrecCon

instance (GReadCon (f p), GReadCon (g p)) => GReadCon ((f :*: g) p) where
  greadPrecCon :: ConType -> ReadPrec ((:*:) f g p)
greadPrecCon ConType
t = ConType
-> ReadPrec (f p) -> ReadPrec (g p) -> ReadPrec ((:*:) f g p)
forall (f :: * -> *) p (g :: * -> *).
ConType
-> ReadPrec (f p) -> ReadPrec (g p) -> ReadPrec ((:*:) f g p)
productReadPrec ConType
t (ConType -> ReadPrec (f p)
forall a. GReadCon a => ConType -> ReadPrec a
greadPrecCon ConType
t) (ConType -> ReadPrec (g p)
forall a. GReadCon a => ConType -> ReadPrec a
greadPrecCon ConType
t)

instance Read p => GReadCon (Par1 p) where
  greadPrecCon :: ConType -> ReadPrec (Par1 p)
greadPrecCon ConType
_ = ReadPrec p -> ReadPrec (Par1 p)
forall p. ReadPrec p -> ReadPrec (Par1 p)
coercePar1 ReadPrec p
forall a. Read a => ReadPrec a
readPrec

instance (Read1 f, Read p) => GReadCon (Rec1 f p) where
  greadPrecCon :: ConType -> ReadPrec (Rec1 f p)
greadPrecCon ConType
_ = ReadPrec (f p) -> ReadPrec (Rec1 f p)
forall (f :: * -> *) a. ReadPrec (f a) -> ReadPrec (Rec1 f a)
coerceRec1 (ReadPrec (f p) -> ReadPrec (Rec1 f p))
-> ReadPrec (f p) -> ReadPrec (Rec1 f p)
forall a b. (a -> b) -> a -> b
$ (Int -> ReadS (f p)) -> ReadPrec (f p)
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec ((Int -> ReadS (f p)) -> ReadPrec (f p))
-> (Int -> ReadS (f p)) -> ReadPrec (f p)
forall a b. (a -> b) -> a -> b
$
      (Int -> ReadS p) -> ReadS [p] -> Int -> ReadS (f p)
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 p -> Int -> ReadS p
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S ReadPrec p
forall a. Read a => ReadPrec a
readPrec) (ReadPrec [p] -> Int -> ReadS [p]
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S ReadPrec [p]
forall a. Read a => ReadPrec [a]
readListPrec Int
0)

instance (Read1 f, GReadCon (g p)) => GReadCon ((f :.: g) p) where
  greadPrecCon :: ConType -> ReadPrec ((:.:) f g p)
greadPrecCon ConType
t = ReadPrec (f (g p)) -> ReadPrec ((:.:) f g p)
forall (f :: * -> *) (g :: * -> *) a.
ReadPrec (f (g a)) -> ReadPrec ((:.:) f g a)
coerceComp1 (ReadPrec (f (g p)) -> ReadPrec ((:.:) f g p))
-> ReadPrec (f (g p)) -> ReadPrec ((:.:) f g p)
forall a b. (a -> b) -> a -> b
$ (Int -> ReadS (f (g p))) -> ReadPrec (f (g p))
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec ((Int -> ReadS (f (g p))) -> ReadPrec (f (g p)))
-> (Int -> ReadS (f (g p))) -> ReadPrec (f (g p))
forall a b. (a -> b) -> a -> b
$
      (Int -> ReadS (g p)) -> ReadS [g p] -> Int -> ReadS (f (g p))
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 (g p) -> Int -> ReadS (g p)
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S       ReadPrec (g p)
grpc)
                    (ReadPrec [g p] -> Int -> ReadS [g p]
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S (ReadPrec (g p) -> ReadPrec [g p]
forall a. ReadPrec a -> ReadPrec [a]
list ReadPrec (g p)
grpc) Int
0)
    where
      grpc :: ReadPrec (g p)
grpc = ConType -> ReadPrec (g p)
forall a. GReadCon a => ConType -> ReadPrec a
greadPrecCon ConType
t

-------------------------------------------------------------------------------
-- * Read1
-------------------------------------------------------------------------------

-- | A sensible default 'liftReadsPrec' implementation for 'Generic1' instances.
liftReadsPrecDefault :: (GRead1 (Rep1 f), Generic1 f)
                     => (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrecDefault :: forall (f :: * -> *) a.
(GRead1 (Rep1 f), Generic1 f) =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrecDefault = Options -> (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
forall (f :: * -> *) a.
(GRead1 (Rep1 f), Generic1 f) =>
Options -> (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrecOptions Options
defaultOptions

-- | Like 'liftReadsPrecDefault', but with configurable 'Options'. Currently,
-- the 'Options' have no effect (but this may change in the future).
liftReadsPrecOptions :: (GRead1 (Rep1 f), Generic1 f)
                     => Options -> (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrecOptions :: forall (f :: * -> *) a.
(GRead1 (Rep1 f), Generic1 f) =>
Options -> (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrecOptions Options
_ Int -> ReadS a
rp ReadS [a]
rl Int
p =
  ReadPrec (f a) -> Int -> ReadS (f a)
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S ((Rep1 f a -> f a) -> ReadPrec (Rep1 f a) -> ReadPrec (f a)
forall a b. (a -> b) -> ReadPrec a -> ReadPrec b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep1 f a -> f a
forall a. Rep1 f a -> f a
forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
to1 (ReadPrec (Rep1 f a) -> ReadPrec (f a))
-> ReadPrec (Rep1 f a) -> ReadPrec (f a)
forall a b. (a -> b) -> a -> b
$ ReadPrec a -> ReadPrec [a] -> ReadPrec (Rep1 f a)
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (Rep1 f a)
forall (f :: * -> *) a.
GRead1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
gliftReadPrec
                                      ((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
p

coerceM1 :: ReadPrec (f p) -> ReadPrec (M1 i c f p)
coerceM1 :: forall (f :: * -> *) p i (c :: Meta).
ReadPrec (f p) -> ReadPrec (M1 i c f p)
coerceM1 = ReadPrec (f p) -> ReadPrec (M1 i c f p)
forall a b. Coercible a b => a -> b
coerce

coercePar1 :: ReadPrec p -> ReadPrec (Par1 p)
coercePar1 :: forall p. ReadPrec p -> ReadPrec (Par1 p)
coercePar1 = ReadPrec p -> ReadPrec (Par1 p)
forall a b. Coercible a b => a -> b
coerce

coerceRec1 :: ReadPrec (f a) -> ReadPrec (Rec1 f a)
coerceRec1 :: forall (f :: * -> *) a. ReadPrec (f a) -> ReadPrec (Rec1 f a)
coerceRec1 = ReadPrec (f a) -> ReadPrec (Rec1 f a)
forall a b. Coercible a b => a -> b
coerce

coerceComp1 :: ReadPrec (f (g a)) -> ReadPrec ((f :.: g) a)
coerceComp1 :: forall (f :: * -> *) (g :: * -> *) a.
ReadPrec (f (g a)) -> ReadPrec ((:.:) f g a)
coerceComp1 = ReadPrec (f (g a)) -> ReadPrec ((:.:) f g a)
forall a b. Coercible a b => a -> b
coerce

coerceK1 :: ReadPrec c -> ReadPrec (K1 i c p)
coerceK1 :: forall c i p. ReadPrec c -> ReadPrec (K1 i c p)
coerceK1 = ReadPrec c -> ReadPrec (K1 i c p)
forall a b. Coercible a b => a -> b
coerce

isSymVar :: String -> Bool
isSymVar :: String -> Bool
isSymVar String
""    = Bool
False
isSymVar (Char
c:String
_) = Char -> Bool
startsVarSym Char
c

startsVarSym :: Char -> Bool
startsVarSym :: Char -> Bool
startsVarSym Char
c = Char -> Bool
startsVarSymASCII Char
c Bool -> Bool -> Bool
|| (Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0x7f Bool -> Bool -> Bool
&& Char -> Bool
isSymbol Char
c) -- Infix Ids

startsVarSymASCII :: Char -> Bool
startsVarSymASCII :: Char -> Bool
startsVarSymASCII Char
c = Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"!#$%&*+./<=>?@\\^|~-"

snocView :: [a] -> Maybe ([a],a)
        -- Split off the last element
snocView :: forall a. [a] -> Maybe ([a], a)
snocView [] = Maybe ([a], a)
forall a. Maybe a
Nothing
snocView [a]
xs = [a] -> [a] -> Maybe ([a], a)
forall {a}. [a] -> [a] -> Maybe ([a], a)
go [] [a]
xs
  where
      -- Invariant: second arg is non-empty
    go :: [a] -> [a] -> Maybe ([a], a)
go [a]
acc [a
a]    = ([a], a) -> Maybe ([a], a)
forall a. a -> Maybe a
Just ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
acc, a
a)
    go [a]
acc (a
a:[a]
as) = [a] -> [a] -> Maybe ([a], a)
go (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc) [a]
as
    go [a]
_ [] = String -> Maybe ([a], a)
forall a. HasCallStack => String -> a
error String
"Util: snocView"

identHLexemes :: String -> [Lexeme]
identHLexemes :: String -> [Lexeme]
identHLexemes String
s | Just (String
ss, Char
'#') <- String -> Maybe (String, Char)
forall a. [a] -> Maybe ([a], a)
snocView String
s = [String -> Lexeme
Ident String
ss, String -> Lexeme
Symbol String
"#"]
                | Bool
otherwise                    = [String -> Lexeme
Ident String
s]

-- | Class of generic representation types for unary type constructors that can
-- be parsed from a 'String'.
class
#if __GLASGOW_HASKELL__ >= 806
    (forall a. Read a => GRead (f a)) =>
#endif
    GRead1 f where
  gliftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)

instance (GRead1 f, IsNullaryDataType f) => GRead1 (D1 d f) where
  gliftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (D1 d f a)
gliftReadPrec ReadPrec a
rp ReadPrec [a]
rl = ReadPrec (f a) -> ReadPrec (D1 d f a)
forall (d :: Meta) (f :: * -> *) p.
IsNullaryDataType f =>
ReadPrec (f p) -> ReadPrec (D1 d f p)
d1ReadPrec (ReadPrec (f a) -> ReadPrec (D1 d f a))
-> ReadPrec (f a) -> ReadPrec (D1 d 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.
GRead1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
gliftReadPrec ReadPrec a
rp ReadPrec [a]
rl

d1ReadPrec :: forall d f p. IsNullaryDataType f
           => ReadPrec (f p) -> ReadPrec (D1 d f p)
d1ReadPrec :: forall (d :: Meta) (f :: * -> *) p.
IsNullaryDataType f =>
ReadPrec (f p) -> ReadPrec (D1 d f p)
d1ReadPrec ReadPrec (f p)
rp = ReadPrec (f p) -> ReadPrec (M1 D d f p)
forall (f :: * -> *) p i (c :: Meta).
ReadPrec (f p) -> ReadPrec (M1 i c f p)
coerceM1 (ReadPrec (f p) -> ReadPrec (M1 D d f p))
-> ReadPrec (f p) -> ReadPrec (M1 D d f p)
forall a b. (a -> b) -> a -> b
$ ReadPrec (f p) -> ReadPrec (f p)
forall a. ReadPrec a -> ReadPrec a
parensIfNonNullary ReadPrec (f p)
rp
  where
    x :: f p
    x :: f p
x = f p
forall a. HasCallStack => a
undefined

    parensIfNonNullary :: ReadPrec a -> ReadPrec a
    parensIfNonNullary :: forall a. ReadPrec a -> ReadPrec a
parensIfNonNullary = if f p -> Bool
forall a. f a -> Bool
forall (f :: * -> *) a. IsNullaryDataType f => f a -> Bool
isNullaryDataType f p
x
                            then ReadPrec a -> ReadPrec a
forall a. a -> a
id
                            else ReadPrec a -> ReadPrec a
forall a. ReadPrec a -> ReadPrec a
parens

instance GRead1 V1 where
  gliftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (V1 a)
gliftReadPrec ReadPrec a
_ ReadPrec [a]
_ = ReadPrec (V1 a)
forall a. ReadPrec a
pfail

instance (GRead1 f, GRead1 g) => GRead1 (f :+: g) where
  gliftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec ((:+:) f g a)
gliftReadPrec ReadPrec a
rp ReadPrec [a]
rl =
    (f a -> (:+:) f g a) -> ReadPrec (f a) -> ReadPrec ((:+:) f g a)
forall a b. (a -> b) -> ReadPrec a -> ReadPrec b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
forall (f :: * -> *) a.
GRead1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
gliftReadPrec ReadPrec a
rp ReadPrec [a]
rl) ReadPrec ((:+:) f g a)
-> ReadPrec ((:+:) f g a) -> ReadPrec ((:+:) f g a)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++ (g a -> (:+:) f g a) -> ReadPrec (g a) -> ReadPrec ((:+:) f g a)
forall a b. (a -> b) -> ReadPrec a -> ReadPrec b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (ReadPrec a -> ReadPrec [a] -> ReadPrec (g a)
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (g a)
forall (f :: * -> *) a.
GRead1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
gliftReadPrec ReadPrec a
rp ReadPrec [a]
rl)

instance (Constructor c, GRead1Con f, IsNullaryCon f) => GRead1 (C1 c f) where
  gliftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (C1 c f a)
gliftReadPrec ReadPrec a
rp ReadPrec [a]
rl = (ConType -> ReadPrec (f a)) -> ReadPrec (C1 c f a)
forall (c :: Meta) (f :: * -> *) p.
(Constructor c, IsNullaryCon f) =>
(ConType -> ReadPrec (f p)) -> ReadPrec (C1 c f p)
c1ReadPrec ((ConType -> ReadPrec (f a)) -> ReadPrec (C1 c f a))
-> (ConType -> ReadPrec (f a)) -> ReadPrec (C1 c f a)
forall a b. (a -> b) -> a -> b
$ \ConType
t -> ConType -> ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
forall a. ConType -> ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
forall (f :: * -> *) a.
GRead1Con f =>
ConType -> ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
gliftReadPrecCon ConType
t ReadPrec a
rp ReadPrec [a]
rl

c1ReadPrec :: forall c f p. (Constructor c, IsNullaryCon f)
           => (ConType -> ReadPrec (f p)) -> ReadPrec (C1 c f p)
c1ReadPrec :: forall (c :: Meta) (f :: * -> *) p.
(Constructor c, IsNullaryCon f) =>
(ConType -> ReadPrec (f p)) -> ReadPrec (C1 c f p)
c1ReadPrec ConType -> ReadPrec (f p)
rpc =
  ReadPrec (f p) -> ReadPrec (M1 C c f p)
forall (f :: * -> *) p i (c :: Meta).
ReadPrec (f p) -> ReadPrec (M1 i c f p)
coerceM1 (ReadPrec (f p) -> ReadPrec (M1 C c f p))
-> ReadPrec (f p) -> ReadPrec (M1 C c f p)
forall a b. (a -> b) -> a -> b
$ case Fixity
fixity of
    Fixity
Prefix -> ReadPrec (f p) -> ReadPrec (f p)
forall a. ReadPrec a -> ReadPrec a
precIfNonNullary (ReadPrec (f p) -> ReadPrec (f p))
-> ReadPrec (f p) -> ReadPrec (f p)
forall a b. (a -> b) -> a -> b
$ do
                if M1 C c f p -> Bool
forall (c :: Meta) (f :: * -> *) p.
Constructor c =>
C1 c f p -> Bool
conIsTuple M1 C c f p
c
                   then () -> ReadPrec ()
forall a. a -> ReadPrec a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                   else let cn :: String
cn = M1 C c f p -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> String
conName M1 C c f p
c
                        in if String -> Bool
isInfixDataCon String
cn
                              then Char -> ReadPrec () -> Char -> ReadPrec ()
forall a. Char -> ReadPrec a -> Char -> ReadPrec a
readSurround Char
'(' (Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Symbol String
cn)) Char
')'
                              else (Lexeme -> ReadPrec ()) -> [Lexeme] -> ReadPrec ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Lexeme -> ReadPrec ()
expectP ([Lexeme] -> ReadPrec ()) -> [Lexeme] -> ReadPrec ()
forall a b. (a -> b) -> a -> b
$ String -> [Lexeme]
identHLexemes String
cn
                ConType -> ReadPrec (f p) -> ReadPrec (f p)
forall a. ConType -> ReadPrec a -> ReadPrec a
readBraces ConType
t (ConType -> ReadPrec (f p)
rpc ConType
t)
    Infix Associativity
_ Int
m -> Int -> ReadPrec (f p) -> ReadPrec (f p)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
m (ReadPrec (f p) -> ReadPrec (f p))
-> ReadPrec (f p) -> ReadPrec (f p)
forall a b. (a -> b) -> a -> b
$ ConType -> ReadPrec (f p)
rpc ConType
t
  where
    c :: C1 c f p
    c :: M1 C c f p
c = M1 C c f p
forall a. HasCallStack => a
undefined

    x :: f p
    x :: f p
x = f p
forall a. HasCallStack => a
undefined

    fixity :: Fixity
    fixity :: Fixity
fixity = M1 C c f p -> Fixity
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Fixity
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> Fixity
conFixity M1 C c f p
c

    precIfNonNullary :: ReadPrec a -> ReadPrec a
    precIfNonNullary :: forall a. ReadPrec a -> ReadPrec a
precIfNonNullary = if f p -> Bool
forall a. f a -> Bool
forall (f :: * -> *) a. IsNullaryCon f => f a -> Bool
isNullaryCon f p
x
                          then ReadPrec a -> ReadPrec a
forall a. a -> a
id
                          else Int -> ReadPrec a -> ReadPrec a
forall a. Int -> ReadPrec a -> ReadPrec a
prec (if M1 C c f p -> Bool
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Bool
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> Bool
conIsRecord M1 C c f p
c
                                        then Int
appPrec1
                                        else Int
appPrec)

    t :: ConType
    t :: ConType
t = if M1 C c f p -> Bool
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Bool
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> Bool
conIsRecord M1 C c f p
c
        then ConType
Rec
        else case M1 C c f p -> Bool
forall (c :: Meta) (f :: * -> *) p.
Constructor c =>
C1 c f p -> Bool
conIsTuple M1 C c f p
c of
            Bool
True  -> ConType
Tup
            Bool
False -> case Fixity
fixity of
                Fixity
Prefix    -> ConType
Pref
                Infix Associativity
_ Int
_ -> String -> ConType
Inf (String -> ConType) -> String -> ConType
forall a b. (a -> b) -> a -> b
$ M1 C c f p -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> String
conName M1 C c f p
c

readBraces :: ConType -> ReadPrec a -> ReadPrec a
readBraces :: forall a. ConType -> ReadPrec a -> ReadPrec a
readBraces ConType
Rec     ReadPrec a
r = Char -> ReadPrec a -> Char -> ReadPrec a
forall a. Char -> ReadPrec a -> Char -> ReadPrec a
readSurround Char
'{' ReadPrec a
r Char
'}'
readBraces ConType
Tup     ReadPrec a
r = ReadPrec a -> ReadPrec a
forall a. ReadPrec a -> ReadPrec a
paren ReadPrec a
r
readBraces ConType
Pref    ReadPrec a
r = ReadPrec a
r
readBraces (Inf String
_) ReadPrec a
r = ReadPrec a
r

readSurround :: Char -> ReadPrec a -> Char -> ReadPrec a
readSurround :: forall a. Char -> ReadPrec a -> Char -> ReadPrec a
readSurround Char
c1 ReadPrec a
r Char
c2 = do
  Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Punc [Char
c1])
  r' <- ReadPrec a
r
  expectP (Punc [c2])
  return r'

-- | Class of generic representation types for unary type constructors that
-- can be parsed from a 'String', and for which the 'ConType' has been
-- determined.
class
#if __GLASGOW_HASKELL__ >= 806
    (forall a. Read a => GReadCon (f a)) =>
#endif
    GRead1Con f where
  gliftReadPrecCon :: ConType -> ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)

instance GRead1Con U1 where
  gliftReadPrecCon :: forall a. ConType -> ReadPrec a -> ReadPrec [a] -> ReadPrec (U1 a)
gliftReadPrecCon ConType
_ ReadPrec a
_ ReadPrec [a]
_ = U1 a -> ReadPrec (U1 a)
forall a. a -> ReadPrec a
forall (m :: * -> *) a. Monad m => a -> m a
return U1 a
forall k (p :: k). U1 p
U1

instance Read c => GRead1Con (K1 i c) where
  gliftReadPrecCon :: forall a.
ConType -> ReadPrec a -> ReadPrec [a] -> ReadPrec (K1 i c a)
gliftReadPrecCon ConType
_ ReadPrec a
_ ReadPrec [a]
_ = ReadPrec c -> ReadPrec (K1 i c a)
forall c i p. ReadPrec c -> ReadPrec (K1 i c p)
coerceK1 ReadPrec c
forall a. Read a => ReadPrec a
readPrec

instance (Selector s, GRead1Con f) => GRead1Con (S1 s f) where
  gliftReadPrecCon :: forall a.
ConType -> ReadPrec a -> ReadPrec [a] -> ReadPrec (S1 s f a)
gliftReadPrecCon ConType
t ReadPrec a
rp ReadPrec [a]
rl = ReadPrec (f a) -> ReadPrec (S1 s f a)
forall (s :: Meta) (f :: * -> *) p.
Selector s =>
ReadPrec (f p) -> ReadPrec (S1 s f p)
s1ReadPrec (ReadPrec (f a) -> ReadPrec (S1 s f a))
-> ReadPrec (f a) -> ReadPrec (S1 s f a)
forall a b. (a -> b) -> a -> b
$ ConType -> ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
forall a. ConType -> ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
forall (f :: * -> *) a.
GRead1Con f =>
ConType -> ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
gliftReadPrecCon ConType
t ReadPrec a
rp ReadPrec [a]
rl

s1ReadPrec :: forall s f p. Selector s
           => ReadPrec (f p) -> ReadPrec (S1 s f p)
s1ReadPrec :: forall (s :: Meta) (f :: * -> *) p.
Selector s =>
ReadPrec (f p) -> ReadPrec (S1 s f p)
s1ReadPrec ReadPrec (f p)
rp
  | String
selectorName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" = ReadPrec (f p) -> ReadPrec (M1 S s f p)
forall (f :: * -> *) p i (c :: Meta).
ReadPrec (f p) -> ReadPrec (M1 i c f p)
coerceM1 (ReadPrec (f p) -> ReadPrec (M1 S s f p))
-> ReadPrec (f p) -> ReadPrec (M1 S s f p)
forall a b. (a -> b) -> a -> b
$ ReadPrec (f p) -> ReadPrec (f p)
forall a. ReadPrec a -> ReadPrec a
step ReadPrec (f p)
rp
  | Bool
otherwise          = ReadPrec (f p) -> ReadPrec (M1 S s f p)
forall (f :: * -> *) p i (c :: Meta).
ReadPrec (f p) -> ReadPrec (M1 i c f p)
coerceM1 (ReadPrec (f p) -> ReadPrec (M1 S s f p))
-> ReadPrec (f p) -> ReadPrec (M1 S s f p)
forall a b. (a -> b) -> a -> b
$ do
                            (Lexeme -> ReadPrec ()) -> [Lexeme] -> ReadPrec ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Lexeme -> ReadPrec ()
expectP ([Lexeme] -> ReadPrec ()) -> [Lexeme] -> ReadPrec ()
forall a b. (a -> b) -> a -> b
$ String -> [Lexeme]
readLblLexemes String
selectorName
                            Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Punc String
"=")
                            ReadPrec (f p) -> ReadPrec (f p)
forall a. ReadPrec a -> ReadPrec a
reset ReadPrec (f p)
rp
  where
    selectorName :: String
    selectorName :: String
selectorName = M1 S s f p -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> String
selName (M1 S s f p
forall a. HasCallStack => a
undefined :: S1 s f p)

    readLblLexemes :: String -> [Lexeme]
    readLblLexemes :: String -> [Lexeme]
readLblLexemes String
lbl | String -> Bool
isSymVar String
lbl
                       = [String -> Lexeme
Punc String
"(", String -> Lexeme
Symbol String
lbl, String -> Lexeme
Punc String
")"]
                       | Bool
otherwise
                       = String -> [Lexeme]
identHLexemes String
lbl

instance (GRead1Con f, GRead1Con g) => GRead1Con (f :*: g) where
  gliftReadPrecCon :: forall a.
ConType -> ReadPrec a -> ReadPrec [a] -> ReadPrec ((:*:) f g a)
gliftReadPrecCon ConType
t ReadPrec a
rp ReadPrec [a]
rl =
    ConType
-> ReadPrec (f a) -> ReadPrec (g a) -> ReadPrec ((:*:) f g a)
forall (f :: * -> *) p (g :: * -> *).
ConType
-> ReadPrec (f p) -> ReadPrec (g p) -> ReadPrec ((:*:) f g p)
productReadPrec ConType
t (ConType -> ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
forall a. ConType -> ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
forall (f :: * -> *) a.
GRead1Con f =>
ConType -> ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
gliftReadPrecCon ConType
t ReadPrec a
rp ReadPrec [a]
rl) (ConType -> ReadPrec a -> ReadPrec [a] -> ReadPrec (g a)
forall a. ConType -> ReadPrec a -> ReadPrec [a] -> ReadPrec (g a)
forall (f :: * -> *) a.
GRead1Con f =>
ConType -> ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
gliftReadPrecCon ConType
t ReadPrec a
rp ReadPrec [a]
rl)

productReadPrec :: ConType -> ReadPrec (f p) -> ReadPrec (g p) -> ReadPrec ((f :*: g) p)
productReadPrec :: forall (f :: * -> *) p (g :: * -> *).
ConType
-> ReadPrec (f p) -> ReadPrec (g p) -> ReadPrec ((:*:) f g p)
productReadPrec ConType
t ReadPrec (f p)
rpf ReadPrec (g p)
rpg = do
    l <- ReadPrec (f p)
rpf
    case t of
         ConType
Rec   -> Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Punc String
",")
         Inf String
o -> String -> ReadPrec ()
infixPrec String
o
         ConType
Tup   -> Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Punc String
",")
         ConType
Pref  -> () -> ReadPrec ()
forall a. a -> ReadPrec a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    r <- rpg
    return (l :*: r)
  where
    infixPrec :: String -> ReadPrec ()
    infixPrec :: String -> ReadPrec ()
infixPrec String
o = if String -> Bool
isInfixDataCon String
o
                     then Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Symbol String
o)
                     else (Lexeme -> ReadPrec ()) -> [Lexeme] -> ReadPrec ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Lexeme -> ReadPrec ()
expectP ([Lexeme] -> ReadPrec ()) -> [Lexeme] -> ReadPrec ()
forall a b. (a -> b) -> a -> b
$
                              [String -> Lexeme
Punc String
"`"] [Lexeme] -> [Lexeme] -> [Lexeme]
forall a. [a] -> [a] -> [a]
++ String -> [Lexeme]
identHLexemes String
o [Lexeme] -> [Lexeme] -> [Lexeme]
forall a. [a] -> [a] -> [a]
++ [String -> Lexeme
Punc String
"`"]

instance GRead1Con Par1 where
  gliftReadPrecCon :: forall a.
ConType -> ReadPrec a -> ReadPrec [a] -> ReadPrec (Par1 a)
gliftReadPrecCon ConType
_ ReadPrec a
rp ReadPrec [a]
_ = ReadPrec a -> ReadPrec (Par1 a)
forall p. ReadPrec p -> ReadPrec (Par1 p)
coercePar1 ReadPrec a
rp

instance Read1 f => GRead1Con (Rec1 f) where
  gliftReadPrecCon :: forall a.
ConType -> ReadPrec a -> ReadPrec [a] -> ReadPrec (Rec1 f a)
gliftReadPrecCon ConType
_ ReadPrec a
rp ReadPrec [a]
rl = ReadPrec (f a) -> ReadPrec (Rec1 f a)
forall (f :: * -> *) a. ReadPrec (f a) -> ReadPrec (Rec1 f a)
coerceRec1 (ReadPrec (f a) -> ReadPrec (Rec1 f a))
-> ReadPrec (f a) -> ReadPrec (Rec1 f a)
forall a b. (a -> b) -> a -> b
$ (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)

instance (Read1 f, GRead1Con g) => GRead1Con (f :.: g) where
  gliftReadPrecCon :: forall a.
ConType -> ReadPrec a -> ReadPrec [a] -> ReadPrec ((:.:) f g a)
gliftReadPrecCon ConType
t ReadPrec a
rp ReadPrec [a]
rl = ReadPrec (f (g a)) -> ReadPrec ((:.:) f g a)
forall (f :: * -> *) (g :: * -> *) a.
ReadPrec (f (g a)) -> ReadPrec ((:.:) f g a)
coerceComp1 (ReadPrec (f (g a)) -> ReadPrec ((:.:) f g a))
-> ReadPrec (f (g a)) -> ReadPrec ((:.:) f g a)
forall a b. (a -> b) -> a -> b
$ (Int -> ReadS (f (g a))) -> ReadPrec (f (g a))
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec ((Int -> ReadS (f (g a))) -> ReadPrec (f (g a)))
-> (Int -> ReadS (f (g a))) -> ReadPrec (f (g a))
forall a b. (a -> b) -> a -> b
$
      (Int -> ReadS (g a)) -> ReadS [g a] -> Int -> ReadS (f (g 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 (g a) -> Int -> ReadS (g a)
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S       ReadPrec (g a)
grpc)
                    (ReadPrec [g a] -> Int -> ReadS [g a]
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S (ReadPrec (g a) -> ReadPrec [g a]
forall a. ReadPrec a -> ReadPrec [a]
list ReadPrec (g a)
grpc) Int
0)
    where
      grpc :: ReadPrec (g a)
grpc = ConType -> ReadPrec a -> ReadPrec [a] -> ReadPrec (g a)
forall a. ConType -> ReadPrec a -> ReadPrec [a] -> ReadPrec (g a)
forall (f :: * -> *) a.
GRead1Con f =>
ConType -> ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
gliftReadPrecCon ConType
t ReadPrec a
rp ReadPrec [a]
rl

-------------------------------------------------------------------------------
-- * Show
-------------------------------------------------------------------------------

-- | A default 'showsPrec' implementation for 'Generic1' instances that leverages
-- 'Show1'.
showsPrecDefault :: (GShow (Rep1 f a), Generic1 f)
                 => Int -> f a -> ShowS
showsPrecDefault :: forall (f :: * -> *) a.
(GShow (Rep1 f a), Generic1 f) =>
Int -> f a -> ShowS
showsPrecDefault = Options -> Int -> f a -> ShowS
forall (f :: * -> *) a.
(GShow (Rep1 f a), Generic1 f) =>
Options -> Int -> f a -> ShowS
showsPrecOptions Options
defaultOptions

-- | Like 'showsPrecDefault', but with configurable 'Options'. Currently, the
-- 'Options' have no effect (but this may change in the future).
showsPrecOptions :: (GShow (Rep1 f a), Generic1 f)
                 => Options -> Int -> f a -> ShowS
showsPrecOptions :: forall (f :: * -> *) a.
(GShow (Rep1 f a), Generic1 f) =>
Options -> Int -> f a -> ShowS
showsPrecOptions Options
_ Int
p = Int -> Rep1 f a -> ShowS
forall a. GShow a => Int -> a -> ShowS
gshowsPrec Int
p (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 a. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1

-- | Class of generic representation types that can be converted to a 'String'.
class GShow a where
  gshowsPrec :: Int -> a -> ShowS

instance GShow (f p) => GShow (D1 d f p) where
  gshowsPrec :: Int -> D1 d f p -> ShowS
gshowsPrec Int
p (M1 f p
x) = Int -> f p -> ShowS
forall a. GShow a => Int -> a -> ShowS
gshowsPrec Int
p f p
x

instance GShow (V1 p) where
  gshowsPrec :: Int -> V1 p -> ShowS
gshowsPrec = Int -> V1 p -> ShowS
forall p. Int -> V1 p -> ShowS
v1ShowsPrec

instance (GShow (f p), GShow (g p)) => GShow ((f :+: g) p) where
  gshowsPrec :: Int -> (:+:) f g p -> ShowS
gshowsPrec Int
p (L1 f p
x) = Int -> f p -> ShowS
forall a. GShow a => Int -> a -> ShowS
gshowsPrec Int
p f p
x
  gshowsPrec Int
p (R1 g p
x) = Int -> g p -> ShowS
forall a. GShow a => Int -> a -> ShowS
gshowsPrec Int
p g p
x

instance (Constructor c, GShowCon (f p), IsNullaryCon f) => GShow (C1 c f p) where
  gshowsPrec :: Int -> C1 c f p -> ShowS
gshowsPrec = (ConType -> Int -> f p -> ShowS) -> Int -> C1 c f p -> ShowS
forall (c :: Meta) (f :: * -> *) p.
(Constructor c, IsNullaryCon f) =>
(ConType -> Int -> f p -> ShowS) -> Int -> C1 c f p -> ShowS
c1ShowsPrec ConType -> Int -> f p -> ShowS
forall a. GShowCon a => ConType -> Int -> a -> ShowS
gshowsPrecCon

-- | Class of generic representation types that can be converted to a 'String', and
-- for which the 'ConType' has been determined.
class GShowCon a where
  gshowsPrecCon :: ConType -> Int -> a -> ShowS

instance GShowCon (U1 p) where
  gshowsPrecCon :: ConType -> Int -> U1 p -> ShowS
gshowsPrecCon ConType
_ Int
_ U1 p
U1 = ShowS
forall a. a -> a
id

instance Show c => GShowCon (K1 i c p) where
  gshowsPrecCon :: ConType -> Int -> K1 i c p -> ShowS
gshowsPrecCon ConType
_ Int
p (K1 c
x) = Int -> c -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p c
x

instance (Selector s, GShowCon (f p)) => GShowCon (S1 s f p) where
  gshowsPrecCon :: ConType -> Int -> S1 s f p -> ShowS
gshowsPrecCon = (Int -> f p -> ShowS) -> Int -> S1 s f p -> ShowS
forall (s :: Meta) (f :: * -> *) p.
Selector s =>
(Int -> f p -> ShowS) -> Int -> S1 s f p -> ShowS
s1ShowsPrec ((Int -> f p -> ShowS) -> Int -> S1 s f p -> ShowS)
-> (ConType -> Int -> f p -> ShowS)
-> ConType
-> Int
-> S1 s f p
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConType -> Int -> f p -> ShowS
forall a. GShowCon a => ConType -> Int -> a -> ShowS
gshowsPrecCon

instance (GShowCon (f p), GShowCon (g p)) => GShowCon ((f :*: g) p) where
  gshowsPrecCon :: ConType -> Int -> (:*:) f g p -> ShowS
gshowsPrecCon ConType
t = (Int -> f p -> ShowS)
-> (Int -> g p -> ShowS) -> ConType -> Int -> (:*:) f g p -> ShowS
forall (f :: * -> *) p (g :: * -> *).
(Int -> f p -> ShowS)
-> (Int -> g p -> ShowS) -> ConType -> Int -> (:*:) f g p -> ShowS
productShowsPrec (ConType -> Int -> f p -> ShowS
forall a. GShowCon a => ConType -> Int -> a -> ShowS
gshowsPrecCon ConType
t) (ConType -> Int -> g p -> ShowS
forall a. GShowCon a => ConType -> Int -> a -> ShowS
gshowsPrecCon ConType
t) ConType
t

instance Show p => GShowCon (Par1 p) where
  gshowsPrecCon :: ConType -> Int -> Par1 p -> ShowS
gshowsPrecCon ConType
_ Int
p (Par1 p
x) = Int -> p -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p p
x

instance (Show1 f, Show p) => GShowCon (Rec1 f p) where
  gshowsPrecCon :: ConType -> Int -> Rec1 f p -> ShowS
gshowsPrecCon ConType
_ Int
p (Rec1 f p
x) = (Int -> p -> ShowS) -> ([p] -> ShowS) -> Int -> f p -> 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 -> p -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [p] -> ShowS
forall a. Show a => [a] -> ShowS
showList Int
p f p
x

instance (Show1 f, GShowCon (g p)) => GShowCon ((f :.: g) p) where
  gshowsPrecCon :: ConType -> Int -> (:.:) f g p -> ShowS
gshowsPrecCon ConType
t Int
p (Comp1 f (g p)
x) =
    let glspc :: Int -> g p -> ShowS
glspc = ConType -> Int -> g p -> ShowS
forall a. GShowCon a => ConType -> Int -> a -> ShowS
gshowsPrecCon ConType
t
    in (Int -> g p -> ShowS)
-> ([g p] -> ShowS) -> Int -> f (g p) -> 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 -> g p -> ShowS
glspc ((g p -> ShowS) -> [g p] -> ShowS
forall a. (a -> ShowS) -> [a] -> ShowS
showListWith (Int -> g p -> ShowS
glspc Int
0)) Int
p f (g p)
x

instance GShowCon (UChar p) where
  gshowsPrecCon :: ConType -> Int -> UChar p -> ShowS
gshowsPrecCon ConType
_ = Int -> UChar p -> ShowS
forall p. Int -> UChar p -> ShowS
uCharShowsPrec

instance GShowCon (UDouble p) where
  gshowsPrecCon :: ConType -> Int -> UDouble p -> ShowS
gshowsPrecCon ConType
_ = Int -> UDouble p -> ShowS
forall p. Int -> UDouble p -> ShowS
uDoubleShowsPrec

instance GShowCon (UFloat p) where
  gshowsPrecCon :: ConType -> Int -> UFloat p -> ShowS
gshowsPrecCon ConType
_ = Int -> UFloat p -> ShowS
forall p. Int -> UFloat p -> ShowS
uFloatShowsPrec

instance GShowCon (UInt p) where
  gshowsPrecCon :: ConType -> Int -> UInt p -> ShowS
gshowsPrecCon ConType
_ = Int -> UInt p -> ShowS
forall p. Int -> UInt p -> ShowS
uIntShowsPrec

instance GShowCon (UWord p) where
  gshowsPrecCon :: ConType -> Int -> UWord p -> ShowS
gshowsPrecCon ConType
_ = Int -> UWord p -> ShowS
forall p. Int -> UWord p -> ShowS
uWordShowsPrec

-------------------------------------------------------------------------------
-- * Show1
-------------------------------------------------------------------------------

-- | A sensible default 'liftShowsPrec' implementation for 'Generic1' instances.
liftShowsPrecDefault :: (GShow1 (Rep1 f), Generic1 f)
                     => (Int -> a -> ShowS) -> ([a] -> ShowS)
                     -> Int -> f a -> ShowS
liftShowsPrecDefault :: forall (f :: * -> *) a.
(GShow1 (Rep1 f), Generic1 f) =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrecDefault = Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
(GShow1 (Rep1 f), Generic1 f) =>
Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrecOptions Options
defaultOptions

-- | Like 'liftShowsPrecDefault', but with configurable 'Options'. Currently,
-- the 'Options' have no effect (but this may change in the future).
liftShowsPrecOptions :: (GShow1 (Rep1 f), Generic1 f)
                     => Options -> (Int -> a -> ShowS) -> ([a] -> ShowS)
                     -> Int -> f a -> ShowS
liftShowsPrecOptions :: forall (f :: * -> *) a.
(GShow1 (Rep1 f), Generic1 f) =>
Options
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrecOptions Options
_ Int -> a -> ShowS
sp [a] -> ShowS
sl Int
p = (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Rep1 f a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Rep1 f a -> ShowS
forall (f :: * -> *) a.
GShow1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
gliftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
p (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 a. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1

-- | Class of generic representation types for unary type constructors that can
-- be converted to a 'String'.
class
#if __GLASGOW_HASKELL__ >= 806
    (forall a. Show a => GShow (f a)) =>
#endif
    GShow1 f where
  gliftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS)
                 -> Int -> f a -> ShowS

instance GShow1 f => GShow1 (D1 d f) where
  gliftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> D1 d f a -> ShowS
gliftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
p (M1 f a
x) = (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
GShow1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
gliftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
p f a
x

instance GShow1 V1 where
  gliftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> V1 a -> ShowS
gliftShowsPrec Int -> a -> ShowS
_ [a] -> ShowS
_ = Int -> V1 a -> ShowS
forall p. Int -> V1 p -> ShowS
v1ShowsPrec

v1ShowsPrec :: Int -> V1 p -> ShowS
v1ShowsPrec :: forall p. Int -> V1 p -> ShowS
v1ShowsPrec Int
_ V1 p
x = case V1 p
x of {}

instance (GShow1 f, GShow1 g) => GShow1 (f :+: g) where
  gliftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> (:+:) f g a -> ShowS
gliftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
p (L1 f a
x) = (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
GShow1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
gliftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
p f a
x
  gliftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
p (R1 g a
x) = (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> g a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> g a -> ShowS
forall (f :: * -> *) a.
GShow1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
gliftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
p g a
x

instance (Constructor c, GShow1Con f, IsNullaryCon f) => GShow1 (C1 c f) where
  gliftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> C1 c f a -> ShowS
gliftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl = (ConType -> Int -> f a -> ShowS) -> Int -> C1 c f a -> ShowS
forall (c :: Meta) (f :: * -> *) p.
(Constructor c, IsNullaryCon f) =>
(ConType -> Int -> f p -> ShowS) -> Int -> C1 c f p -> ShowS
c1ShowsPrec ((ConType -> Int -> f a -> ShowS) -> Int -> C1 c f a -> ShowS)
-> (ConType -> Int -> f a -> ShowS) -> Int -> C1 c f a -> ShowS
forall a b. (a -> b) -> a -> b
$ \ConType
t -> ConType
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall a.
ConType
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
GShow1Con f =>
ConType
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
gliftShowsPrecCon ConType
t Int -> a -> ShowS
sp [a] -> ShowS
sl

c1ShowsPrec :: (Constructor c, IsNullaryCon f)
            => (ConType -> Int -> f p -> ShowS) -> Int -> C1 c f p -> ShowS
c1ShowsPrec :: forall (c :: Meta) (f :: * -> *) p.
(Constructor c, IsNullaryCon f) =>
(ConType -> Int -> f p -> ShowS) -> Int -> C1 c f p -> ShowS
c1ShowsPrec ConType -> Int -> f p -> ShowS
sp Int
p c :: C1 c f p
c@(M1 f p
x) = case Fixity
fixity of
    Fixity
Prefix -> Bool -> ShowS -> ShowS
showParen ( Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec
                           Bool -> Bool -> Bool
&& Bool -> Bool
not (f p -> Bool
forall a. f a -> Bool
forall (f :: * -> *) a. IsNullaryCon f => f a -> Bool
isNullaryCon f p
x Bool -> Bool -> Bool
|| C1 c f p -> Bool
forall (c :: Meta) (f :: * -> *) p.
Constructor c =>
C1 c f p -> Bool
conIsTuple C1 c f p
c)
                         ) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
           (if C1 c f p -> Bool
forall (c :: Meta) (f :: * -> *) p.
Constructor c =>
C1 c f p -> Bool
conIsTuple C1 c f p
c
               then ShowS
forall a. a -> a
id
               else let cn :: String
cn = C1 c f p -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> String
conName C1 c f p
c
                    in Bool -> ShowS -> ShowS
showParen (String -> Bool
isInfixDataCon String
cn) (String -> ShowS
showString String
cn))
         ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if f p -> Bool
forall a. f a -> Bool
forall (f :: * -> *) a. IsNullaryCon f => f a -> Bool
isNullaryCon f p
x Bool -> Bool -> Bool
|| C1 c f p -> Bool
forall (c :: Meta) (f :: * -> *) p.
Constructor c =>
C1 c f p -> Bool
conIsTuple C1 c f p
c
               then ShowS
forall a. a -> a
id
               else Char -> ShowS
showChar Char
' ')
         ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConType -> ShowS -> ShowS
showBraces ConType
t (ConType -> Int -> f p -> ShowS
sp ConType
t Int
appPrec1 f p
x)
    Infix Associativity
_ Int
m -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
m) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ConType -> Int -> f p -> ShowS
sp ConType
t (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) f p
x
  where
    fixity :: Fixity
    fixity :: Fixity
fixity = C1 c f p -> Fixity
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Fixity
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> Fixity
conFixity C1 c f p
c

    t :: ConType
    t :: ConType
t = if C1 c f p -> Bool
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Bool
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> Bool
conIsRecord C1 c f p
c
        then ConType
Rec
        else case C1 c f p -> Bool
forall (c :: Meta) (f :: * -> *) p.
Constructor c =>
C1 c f p -> Bool
conIsTuple C1 c f p
c of
            Bool
True  -> ConType
Tup
            Bool
False -> case Fixity
fixity of
                Fixity
Prefix    -> ConType
Pref
                Infix Associativity
_ Int
_ -> String -> ConType
Inf (String -> ConType) -> String -> ConType
forall a b. (a -> b) -> a -> b
$ C1 c f p -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> String
conName C1 c f p
c

showBraces :: ConType -> ShowS -> ShowS
showBraces :: ConType -> ShowS -> ShowS
showBraces ConType
Rec     ShowS
b = Char -> ShowS
showChar Char
'{' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
b ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'
showBraces ConType
Tup     ShowS
b = Char -> ShowS
showChar Char
'(' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
b ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
')'
showBraces ConType
Pref    ShowS
b = ShowS
b
showBraces (Inf String
_) ShowS
b = ShowS
b

-- | Class of generic representation types for unary type constructors that can
-- be converted to a 'String', and for which the 'ConType' has been determined.
class
#if __GLASGOW_HASKELL__ >= 806
    (forall a. Show a => GShowCon (f a)) =>
#endif
    GShow1Con f where
  gliftShowsPrecCon :: ConType -> (Int -> a -> ShowS) -> ([a] -> ShowS)
                    -> Int -> f a -> ShowS

instance GShow1Con U1 where
  gliftShowsPrecCon :: forall a.
ConType
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> U1 a -> ShowS
gliftShowsPrecCon ConType
_ Int -> a -> ShowS
_ [a] -> ShowS
_ Int
_ U1 a
U1 = ShowS
forall a. a -> a
id

instance Show c => GShow1Con (K1 i c) where
  gliftShowsPrecCon :: forall a.
ConType
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> K1 i c a
-> ShowS
gliftShowsPrecCon ConType
_ Int -> a -> ShowS
_ [a] -> ShowS
_ Int
p (K1 c
x) = Int -> c -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p c
x

instance (Selector s, GShow1Con f) => GShow1Con (S1 s f) where
  gliftShowsPrecCon :: forall a.
ConType
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> S1 s f a
-> ShowS
gliftShowsPrecCon ConType
t Int -> a -> ShowS
sp [a] -> ShowS
sl = (Int -> f a -> ShowS) -> Int -> S1 s f a -> ShowS
forall (s :: Meta) (f :: * -> *) p.
Selector s =>
(Int -> f p -> ShowS) -> Int -> S1 s f p -> ShowS
s1ShowsPrec ((Int -> f a -> ShowS) -> Int -> S1 s f a -> ShowS)
-> (Int -> f a -> ShowS) -> Int -> S1 s f a -> ShowS
forall a b. (a -> b) -> a -> b
$ ConType
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall a.
ConType
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
GShow1Con f =>
ConType
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
gliftShowsPrecCon ConType
t Int -> a -> ShowS
sp [a] -> ShowS
sl

s1ShowsPrec :: Selector s => (Int -> f p -> ShowS) -> Int -> S1 s f p -> ShowS
s1ShowsPrec :: forall (s :: Meta) (f :: * -> *) p.
Selector s =>
(Int -> f p -> ShowS) -> Int -> S1 s f p -> ShowS
s1ShowsPrec Int -> f p -> ShowS
sp Int
p sel :: S1 s f p
sel@(M1 f p
x)
  | S1 s f p -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> String
selName S1 s f p
sel String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" =   Int -> f p -> ShowS
sp Int
p f p
x
  | Bool
otherwise         =   ShowS
infixRec
                        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 -> f p -> ShowS
sp Int
0 f p
x
  where
    infixRec :: ShowS
    infixRec :: ShowS
infixRec | String -> Bool
isSymVar String
selectorName
             = Char -> ShowS
showChar Char
'(' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
selectorName ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
')'
             | Bool
otherwise
             = String -> ShowS
showString String
selectorName

    selectorName :: String
    selectorName :: String
selectorName = S1 s f p -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> String
selName S1 s f p
sel

instance (GShow1Con f, GShow1Con g) => GShow1Con (f :*: g) where
  gliftShowsPrecCon :: forall a.
ConType
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> (:*:) f g a
-> ShowS
gliftShowsPrecCon ConType
t Int -> a -> ShowS
sp [a] -> ShowS
sl =
    (Int -> f a -> ShowS)
-> (Int -> g a -> ShowS) -> ConType -> Int -> (:*:) f g a -> ShowS
forall (f :: * -> *) p (g :: * -> *).
(Int -> f p -> ShowS)
-> (Int -> g p -> ShowS) -> ConType -> Int -> (:*:) f g p -> ShowS
productShowsPrec (ConType
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall a.
ConType
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
GShow1Con f =>
ConType
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
gliftShowsPrecCon ConType
t Int -> a -> ShowS
sp [a] -> ShowS
sl)
                     (ConType
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> g a -> ShowS
forall a.
ConType
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> g a -> ShowS
forall (f :: * -> *) a.
GShow1Con f =>
ConType
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
gliftShowsPrecCon ConType
t Int -> a -> ShowS
sp [a] -> ShowS
sl)
                     ConType
t

productShowsPrec :: (Int -> f p -> ShowS) -> (Int -> g p -> ShowS)
                 -> ConType -> Int -> (f :*: g) p -> ShowS
productShowsPrec :: forall (f :: * -> *) p (g :: * -> *).
(Int -> f p -> ShowS)
-> (Int -> g p -> ShowS) -> ConType -> Int -> (:*:) f g p -> ShowS
productShowsPrec Int -> f p -> ShowS
spf Int -> g p -> ShowS
spg ConType
t Int
p (f p
a :*: g p
b) =
  case ConType
t of
       ConType
Rec ->     Int -> f p -> ShowS
spf Int
0 f p
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
. Int -> g p -> ShowS
spg Int
0 g p
b

       Inf String
o ->   Int -> f p -> ShowS
spf Int
p f p
a
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showSpace
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
infixOp String
o
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showSpace
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> g p -> ShowS
spg Int
p g p
b

       ConType
Tup ->     Int -> f p -> ShowS
spf Int
0 f p
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
. Int -> g p -> ShowS
spg Int
0 g p
b

       ConType
Pref ->    Int -> f p -> ShowS
spf Int
p f p
a
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showSpace
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> g p -> ShowS
spg Int
p g p
b
  where
    infixOp :: String -> ShowS
    infixOp :: String -> ShowS
infixOp String
o = if String -> Bool
isInfixDataCon String
o
                   then String -> ShowS
showString String
o
                   else Char -> ShowS
showChar Char
'`' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
o ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'`'

instance GShow1Con Par1 where
  gliftShowsPrecCon :: forall a.
ConType
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Par1 a -> ShowS
gliftShowsPrecCon ConType
_ Int -> a -> ShowS
sp [a] -> ShowS
_ Int
p (Par1 a
x) = Int -> a -> ShowS
sp Int
p a
x

instance Show1 f => GShow1Con (Rec1 f) where
  gliftShowsPrecCon :: forall a.
ConType
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> Rec1 f a
-> ShowS
gliftShowsPrecCon ConType
_ Int -> a -> ShowS
sp [a] -> ShowS
sl Int
p (Rec1 f a
x) = (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
p f a
x

instance (Show1 f, GShow1Con g) => GShow1Con (f :.: g) where
  gliftShowsPrecCon :: forall a.
ConType
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> (:.:) f g a
-> ShowS
gliftShowsPrecCon ConType
t Int -> a -> ShowS
sp [a] -> ShowS
sl Int
p (Comp1 f (g a)
x) =
    let glspc :: Int -> g a -> ShowS
glspc = ConType
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> g a -> ShowS
forall a.
ConType
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> g a -> ShowS
forall (f :: * -> *) a.
GShow1Con f =>
ConType
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
gliftShowsPrecCon ConType
t Int -> a -> ShowS
sp [a] -> ShowS
sl
    in (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 -> g a -> ShowS
glspc ((g a -> ShowS) -> [g a] -> ShowS
forall a. (a -> ShowS) -> [a] -> ShowS
showListWith (Int -> g a -> ShowS
glspc Int
0)) Int
p f (g a)
x

instance GShow1Con UChar where
  gliftShowsPrecCon :: forall a.
ConType
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> UChar a -> ShowS
gliftShowsPrecCon ConType
_ Int -> a -> ShowS
_ [a] -> ShowS
_ = Int -> UChar a -> ShowS
forall p. Int -> UChar p -> ShowS
uCharShowsPrec

instance GShow1Con UDouble where
  gliftShowsPrecCon :: forall a.
ConType
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> UDouble a
-> ShowS
gliftShowsPrecCon ConType
_ Int -> a -> ShowS
_ [a] -> ShowS
_ = Int -> UDouble a -> ShowS
forall p. Int -> UDouble p -> ShowS
uDoubleShowsPrec

instance GShow1Con UFloat where
  gliftShowsPrecCon :: forall a.
ConType
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> UFloat a
-> ShowS
gliftShowsPrecCon ConType
_ Int -> a -> ShowS
_ [a] -> ShowS
_ = Int -> UFloat a -> ShowS
forall p. Int -> UFloat p -> ShowS
uFloatShowsPrec

instance GShow1Con UInt where
  gliftShowsPrecCon :: forall a.
ConType
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> UInt a -> ShowS
gliftShowsPrecCon ConType
_ Int -> a -> ShowS
_ [a] -> ShowS
_ = Int -> UInt a -> ShowS
forall p. Int -> UInt p -> ShowS
uIntShowsPrec

instance GShow1Con UWord where
  gliftShowsPrecCon :: forall a.
ConType
-> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> UWord a -> ShowS
gliftShowsPrecCon ConType
_ Int -> a -> ShowS
_ [a] -> ShowS
_ = Int -> UWord a -> ShowS
forall p. Int -> UWord p -> ShowS
uWordShowsPrec

uCharShowsPrec :: Int -> UChar p -> ShowS
uCharShowsPrec :: forall p. Int -> UChar p -> ShowS
uCharShowsPrec Int
p (UChar Char#
c) = Char -> ShowS
forall a. Show a => a -> ShowS
shows (Char# -> Char
C# Char#
c) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
oneHash

uDoubleShowsPrec :: Int -> UDouble p -> ShowS
uDoubleShowsPrec :: forall p. Int -> UDouble p -> ShowS
uDoubleShowsPrec Int
p (UDouble Double#
d) = Double -> ShowS
forall a. Show a => a -> ShowS
shows (Double# -> Double
D# Double#
d) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
twoHash

uFloatShowsPrec :: Int -> UFloat p -> ShowS
uFloatShowsPrec :: forall p. Int -> UFloat p -> ShowS
uFloatShowsPrec Int
p (UFloat Float#
f) = Float -> ShowS
forall a. Show a => a -> ShowS
shows (Float# -> Float
F# Float#
f) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
oneHash

uIntShowsPrec :: Int -> UInt p -> ShowS
uIntShowsPrec :: forall p. Int -> UInt p -> ShowS
uIntShowsPrec Int
p (UInt Int#
i) = Int -> ShowS
forall a. Show a => a -> ShowS
shows (Int# -> Int
I# Int#
i) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
oneHash

uWordShowsPrec :: Int -> UWord p -> ShowS
uWordShowsPrec :: forall p. Int -> UWord p -> ShowS
uWordShowsPrec Int
p (UWord Word#
w) = Word -> ShowS
forall a. Show a => a -> ShowS
shows (Word# -> Word
W# Word#
w) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
twoHash

oneHash, twoHash :: ShowS
oneHash :: ShowS
oneHash = Char -> ShowS
showChar Char
'#'
twoHash :: ShowS
twoHash = String -> ShowS
showString String
"##"

-------------------------------------------------------------------------------
-- * GenericFunctorClasses
-------------------------------------------------------------------------------

-- | An adapter newtype, suitable for @DerivingVia@. Its 'Eq1', 'Ord1',
-- 'Read1', and 'Show1' instances leverage 'Generic1'-based defaults.
newtype FunctorClassesDefault f a =
  FunctorClassesDefault { forall (f :: * -> *) a. FunctorClassesDefault f a -> f a
getFunctorClassesDefault :: f a }

instance (GEq1 (Rep1 f), Generic1 f) => Eq1 (FunctorClassesDefault f) where
   liftEq :: forall a b.
(a -> b -> Bool)
-> FunctorClassesDefault f a -> FunctorClassesDefault f b -> Bool
liftEq a -> b -> Bool
f (FunctorClassesDefault f a
x) (FunctorClassesDefault f b
y) = (a -> b -> Bool) -> f a -> f b -> Bool
forall (f :: * -> *) a b.
(GEq1 (Rep1 f), Generic1 f) =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEqDefault a -> b -> Bool
f f a
x f b
y
instance (GOrd1 (Rep1 f), Generic1 f) => Ord1 (FunctorClassesDefault f) where
   liftCompare :: forall a b.
(a -> b -> Ordering)
-> FunctorClassesDefault f a
-> FunctorClassesDefault f b
-> Ordering
liftCompare a -> b -> Ordering
f (FunctorClassesDefault f a
x) (FunctorClassesDefault f b
y) = (a -> b -> Ordering) -> f a -> f b -> Ordering
forall (f :: * -> *) a b.
(GOrd1 (Rep1 f), Generic1 f) =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompareDefault a -> b -> Ordering
f f a
x f b
y
instance (GRead1 (Rep1 f), Generic1 f) => Read1 (FunctorClassesDefault f) where
   liftReadsPrec :: forall a.
(Int -> ReadS a)
-> ReadS [a] -> Int -> ReadS (FunctorClassesDefault f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl Int
p = ReadS (f a) -> ReadS (FunctorClassesDefault f a)
forall (f :: * -> *) a.
ReadS (f a) -> ReadS (FunctorClassesDefault f a)
coerceFCD ((Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
forall (f :: * -> *) a.
(GRead1 (Rep1 f), Generic1 f) =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrecDefault Int -> ReadS a
rp ReadS [a]
rl Int
p)
instance (GShow1 (Rep1 f), Generic1 f) => Show1 (FunctorClassesDefault f) where
   liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> FunctorClassesDefault f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
p (FunctorClassesDefault f a
x) = (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
(GShow1 (Rep1 f), Generic1 f) =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrecDefault Int -> a -> ShowS
sp [a] -> ShowS
sl Int
p f a
x

instance (GEq (Rep1 f a), Generic1 f) => Eq (FunctorClassesDefault f a) where
  FunctorClassesDefault f a
x == :: FunctorClassesDefault f a -> FunctorClassesDefault f a -> Bool
== FunctorClassesDefault f a
y = f a -> f a -> Bool
forall (f :: * -> *) a.
(GEq (Rep1 f a), Generic1 f) =>
f a -> f a -> Bool
eqDefault f a
x f a
y
instance (GOrd (Rep1 f a), Generic1 f) => Ord (FunctorClassesDefault f a) where
  compare :: FunctorClassesDefault f a -> FunctorClassesDefault f a -> Ordering
compare (FunctorClassesDefault f a
x) (FunctorClassesDefault f a
y) = f a -> f a -> Ordering
forall (f :: * -> *) a.
(GOrd (Rep1 f a), Generic1 f) =>
f a -> f a -> Ordering
compareDefault f a
x f a
y
instance (GRead (Rep1 f a), Generic1 f) => Read (FunctorClassesDefault f a) where
  readsPrec :: Int -> ReadS (FunctorClassesDefault f a)
readsPrec Int
p = ReadS (f a) -> ReadS (FunctorClassesDefault f a)
forall (f :: * -> *) a.
ReadS (f a) -> ReadS (FunctorClassesDefault f a)
coerceFCD (Int -> ReadS (f a)
forall (f :: * -> *) a.
(GRead (Rep1 f a), Generic1 f) =>
Int -> ReadS (f a)
readsPrecDefault Int
p)
instance (GShow (Rep1 f a), Generic1 f) => Show (FunctorClassesDefault f a) where
  showsPrec :: Int -> FunctorClassesDefault f a -> ShowS
showsPrec Int
p (FunctorClassesDefault f a
x) = Int -> f a -> ShowS
forall (f :: * -> *) a.
(GShow (Rep1 f a), Generic1 f) =>
Int -> f a -> ShowS
showsPrecDefault Int
p f a
x

coerceFCD :: ReadS (f a) -> ReadS (FunctorClassesDefault f a)
coerceFCD :: forall (f :: * -> *) a.
ReadS (f a) -> ReadS (FunctorClassesDefault f a)
coerceFCD = (String -> [(f a, String)])
-> String -> [(FunctorClassesDefault f a, String)]
forall a b. Coercible a b => a -> b
coerce

-------------------------------------------------------------------------------
-- * Shared code
-------------------------------------------------------------------------------

-- | Whether a constructor is a record ('Rec'), a tuple ('Tup'), is prefix ('Pref'),
-- or infix ('Inf').
data ConType = Rec | Tup | Pref | Inf String

conIsTuple :: Constructor c => C1 c f p -> Bool
conIsTuple :: forall (c :: Meta) (f :: * -> *) p.
Constructor c =>
C1 c f p -> Bool
conIsTuple = String -> Bool
isTupleString (String -> Bool) -> (M1 C c f p -> String) -> M1 C c f p -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 C c f p -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> String
conName

isTupleString :: String -> Bool
isTupleString :: String -> Bool
isTupleString (Char
'(':Char
',':String
_) = Bool
True
isTupleString String
_           = Bool
False

isInfixDataCon :: String -> Bool
isInfixDataCon :: String -> Bool
isInfixDataCon (Char
':':String
_) = Bool
True
isInfixDataCon String
_       = Bool
False

-- | Class of generic representation types that represent a data type with
-- zero or more constructors.
class IsNullaryDataType f where
    -- | Returns 'True' if the data type has no constructors.
    isNullaryDataType :: f a -> Bool

instance IsNullaryDataType (f :+: g) where
    isNullaryDataType :: forall a. (:+:) f g a -> Bool
isNullaryDataType (:+:) f g a
_ = Bool
False

instance IsNullaryDataType (C1 c f) where
    isNullaryDataType :: forall a. C1 c f a -> Bool
isNullaryDataType C1 c f a
_ = Bool
False

-- | Class of generic representation types that represent a constructor with
-- zero or more fields.
class IsNullaryCon f where
    -- | Returns 'True' if the constructor has no fields.
    isNullaryCon :: f a -> Bool

instance IsNullaryDataType V1 where
    isNullaryDataType :: forall a. V1 a -> Bool
isNullaryDataType V1 a
_ = Bool
True

instance IsNullaryCon U1 where
    isNullaryCon :: forall a. U1 a -> Bool
isNullaryCon U1 a
_ = Bool
True

instance IsNullaryCon Par1 where
    isNullaryCon :: forall a. Par1 a -> Bool
isNullaryCon Par1 a
_ = Bool
False

instance IsNullaryCon (K1 i c) where
    isNullaryCon :: forall a. K1 i c a -> Bool
isNullaryCon K1 i c a
_ = Bool
False

instance IsNullaryCon f => IsNullaryCon (S1 s f) where
    isNullaryCon :: forall a. S1 s f a -> Bool
isNullaryCon (M1 f a
x) = f a -> Bool
forall a. f a -> Bool
forall (f :: * -> *) a. IsNullaryCon f => f a -> Bool
isNullaryCon f a
x

instance IsNullaryCon (Rec1 f) where
    isNullaryCon :: forall a. Rec1 f a -> Bool
isNullaryCon Rec1 f a
_ = Bool
False

instance IsNullaryCon (f :*: g) where
    isNullaryCon :: forall a. (:*:) f g a -> Bool
isNullaryCon (:*:) f g a
_ = Bool
False

instance IsNullaryCon (f :.: g) where
    isNullaryCon :: forall a. (:.:) f g a -> Bool
isNullaryCon (:.:) f g a
_ = Bool
False

instance IsNullaryCon UChar where
    isNullaryCon :: forall a. UChar a -> Bool
isNullaryCon UChar a
_ = Bool
False

instance IsNullaryCon UDouble where
    isNullaryCon :: forall a. UDouble a -> Bool
isNullaryCon UDouble a
_ = Bool
False

instance IsNullaryCon UFloat where
    isNullaryCon :: forall a. UFloat a -> Bool
isNullaryCon UFloat a
_ = Bool
False

instance IsNullaryCon UInt where
    isNullaryCon :: forall a. UInt a -> Bool
isNullaryCon UInt a
_ = Bool
False

instance IsNullaryCon UWord where
    isNullaryCon :: forall a. UWord a -> Bool
isNullaryCon UWord a
_ = Bool
False