{-# Language CPP, DeriveDataTypeable #-}
#if MIN_VERSION_base(4,4,0)
#define HAS_GENERICS
{-# Language DeriveGeneric #-}
#endif
#if MIN_VERSION_template_haskell(2,12,0)
{-# Language Safe #-}
#elif __GLASGOW_HASKELL__ >= 702
{-# Language Trustworthy #-}
#endif
module Language.Haskell.TH.Datatype
(
DatatypeInfo(..)
, ConstructorInfo(..)
, DatatypeVariant(..)
, ConstructorVariant(..)
, FieldStrictness(..)
, Unpackedness(..)
, Strictness(..)
, reifyDatatype
, reifyConstructor
, reifyRecord
, normalizeInfo
, normalizeDec
, normalizeCon
, lookupByConstructorName
, lookupByRecordName
, TypeSubstitution(..)
, quantifyType
, freeVariablesWellScoped
, freshenFreeVariables
, equalPred
, classPred
, asEqualPred
, asClassPred
, dataDCompat
, newtypeDCompat
, tySynInstDCompat
, pragLineDCompat
, arrowKCompat
, isStrictAnnot
, notStrictAnnot
, unpackedAnnot
, resolveTypeSynonyms
, resolveKindSynonyms
, resolvePredSynonyms
, resolveInfixT
, reifyFixityCompat
, showFixity
, showFixityDirection
, unifyTypes
, tvName
, tvKind
, datatypeType
) where
import Data.Data (Typeable, Data)
import Data.Foldable (foldMap, foldl')
import Data.List (mapAccumL, nub, find, union, (\\))
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Traversable as T
import Control.Monad
import Language.Haskell.TH
#if MIN_VERSION_template_haskell(2,11,0)
hiding (Extension(..))
#endif
import Language.Haskell.TH.Datatype.Internal
import Language.Haskell.TH.Datatype.TyVarBndr
import Language.Haskell.TH.Lib (arrowK, starK)
#ifdef HAS_GENERICS
import GHC.Generics (Generic)
#endif
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative(..), (<$>))
import Data.Monoid (Monoid(..))
#endif
data DatatypeInfo = DatatypeInfo
{ DatatypeInfo -> Cxt
datatypeContext :: Cxt
, DatatypeInfo -> Name
datatypeName :: Name
, DatatypeInfo -> [TyVarBndrUnit]
datatypeVars :: [TyVarBndrUnit]
, DatatypeInfo -> Cxt
datatypeInstTypes :: [Type]
, DatatypeInfo -> DatatypeVariant
datatypeVariant :: DatatypeVariant
, DatatypeInfo -> [ConstructorInfo]
datatypeCons :: [ConstructorInfo]
}
deriving (Int -> DatatypeInfo -> ShowS
[DatatypeInfo] -> ShowS
DatatypeInfo -> String
(Int -> DatatypeInfo -> ShowS)
-> (DatatypeInfo -> String)
-> ([DatatypeInfo] -> ShowS)
-> Show DatatypeInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DatatypeInfo] -> ShowS
$cshowList :: [DatatypeInfo] -> ShowS
show :: DatatypeInfo -> String
$cshow :: DatatypeInfo -> String
showsPrec :: Int -> DatatypeInfo -> ShowS
$cshowsPrec :: Int -> DatatypeInfo -> ShowS
Show, DatatypeInfo -> DatatypeInfo -> Bool
(DatatypeInfo -> DatatypeInfo -> Bool)
-> (DatatypeInfo -> DatatypeInfo -> Bool) -> Eq DatatypeInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DatatypeInfo -> DatatypeInfo -> Bool
$c/= :: DatatypeInfo -> DatatypeInfo -> Bool
== :: DatatypeInfo -> DatatypeInfo -> Bool
$c== :: DatatypeInfo -> DatatypeInfo -> Bool
Eq, Typeable, Typeable DatatypeInfo
DataType
Constr
Typeable DatatypeInfo
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DatatypeInfo -> c DatatypeInfo)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DatatypeInfo)
-> (DatatypeInfo -> Constr)
-> (DatatypeInfo -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DatatypeInfo))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DatatypeInfo))
-> ((forall b. Data b => b -> b) -> DatatypeInfo -> DatatypeInfo)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DatatypeInfo -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DatatypeInfo -> r)
-> (forall u. (forall d. Data d => d -> u) -> DatatypeInfo -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> DatatypeInfo -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DatatypeInfo -> m DatatypeInfo)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DatatypeInfo -> m DatatypeInfo)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DatatypeInfo -> m DatatypeInfo)
-> Data DatatypeInfo
DatatypeInfo -> DataType
DatatypeInfo -> Constr
(forall b. Data b => b -> b) -> DatatypeInfo -> DatatypeInfo
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DatatypeInfo -> c DatatypeInfo
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DatatypeInfo
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> DatatypeInfo -> u
forall u. (forall d. Data d => d -> u) -> DatatypeInfo -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DatatypeInfo -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DatatypeInfo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DatatypeInfo -> m DatatypeInfo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DatatypeInfo -> m DatatypeInfo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DatatypeInfo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DatatypeInfo -> c DatatypeInfo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DatatypeInfo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DatatypeInfo)
$cDatatypeInfo :: Constr
$tDatatypeInfo :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> DatatypeInfo -> m DatatypeInfo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DatatypeInfo -> m DatatypeInfo
gmapMp :: (forall d. Data d => d -> m d) -> DatatypeInfo -> m DatatypeInfo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DatatypeInfo -> m DatatypeInfo
gmapM :: (forall d. Data d => d -> m d) -> DatatypeInfo -> m DatatypeInfo
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DatatypeInfo -> m DatatypeInfo
gmapQi :: Int -> (forall d. Data d => d -> u) -> DatatypeInfo -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DatatypeInfo -> u
gmapQ :: (forall d. Data d => d -> u) -> DatatypeInfo -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DatatypeInfo -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DatatypeInfo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DatatypeInfo -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DatatypeInfo -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DatatypeInfo -> r
gmapT :: (forall b. Data b => b -> b) -> DatatypeInfo -> DatatypeInfo
$cgmapT :: (forall b. Data b => b -> b) -> DatatypeInfo -> DatatypeInfo
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DatatypeInfo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DatatypeInfo)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DatatypeInfo)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DatatypeInfo)
dataTypeOf :: DatatypeInfo -> DataType
$cdataTypeOf :: DatatypeInfo -> DataType
toConstr :: DatatypeInfo -> Constr
$ctoConstr :: DatatypeInfo -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DatatypeInfo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DatatypeInfo
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DatatypeInfo -> c DatatypeInfo
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DatatypeInfo -> c DatatypeInfo
$cp1Data :: Typeable DatatypeInfo
Data
#ifdef HAS_GENERICS
,(forall x. DatatypeInfo -> Rep DatatypeInfo x)
-> (forall x. Rep DatatypeInfo x -> DatatypeInfo)
-> Generic DatatypeInfo
forall x. Rep DatatypeInfo x -> DatatypeInfo
forall x. DatatypeInfo -> Rep DatatypeInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DatatypeInfo x -> DatatypeInfo
$cfrom :: forall x. DatatypeInfo -> Rep DatatypeInfo x
Generic
#endif
)
data DatatypeVariant
= Datatype
| Newtype
| DataInstance
| NewtypeInstance
deriving (Int -> DatatypeVariant -> ShowS
[DatatypeVariant] -> ShowS
DatatypeVariant -> String
(Int -> DatatypeVariant -> ShowS)
-> (DatatypeVariant -> String)
-> ([DatatypeVariant] -> ShowS)
-> Show DatatypeVariant
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DatatypeVariant] -> ShowS
$cshowList :: [DatatypeVariant] -> ShowS
show :: DatatypeVariant -> String
$cshow :: DatatypeVariant -> String
showsPrec :: Int -> DatatypeVariant -> ShowS
$cshowsPrec :: Int -> DatatypeVariant -> ShowS
Show, ReadPrec [DatatypeVariant]
ReadPrec DatatypeVariant
Int -> ReadS DatatypeVariant
ReadS [DatatypeVariant]
(Int -> ReadS DatatypeVariant)
-> ReadS [DatatypeVariant]
-> ReadPrec DatatypeVariant
-> ReadPrec [DatatypeVariant]
-> Read DatatypeVariant
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DatatypeVariant]
$creadListPrec :: ReadPrec [DatatypeVariant]
readPrec :: ReadPrec DatatypeVariant
$creadPrec :: ReadPrec DatatypeVariant
readList :: ReadS [DatatypeVariant]
$creadList :: ReadS [DatatypeVariant]
readsPrec :: Int -> ReadS DatatypeVariant
$creadsPrec :: Int -> ReadS DatatypeVariant
Read, DatatypeVariant -> DatatypeVariant -> Bool
(DatatypeVariant -> DatatypeVariant -> Bool)
-> (DatatypeVariant -> DatatypeVariant -> Bool)
-> Eq DatatypeVariant
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DatatypeVariant -> DatatypeVariant -> Bool
$c/= :: DatatypeVariant -> DatatypeVariant -> Bool
== :: DatatypeVariant -> DatatypeVariant -> Bool
$c== :: DatatypeVariant -> DatatypeVariant -> Bool
Eq, Eq DatatypeVariant
Eq DatatypeVariant
-> (DatatypeVariant -> DatatypeVariant -> Ordering)
-> (DatatypeVariant -> DatatypeVariant -> Bool)
-> (DatatypeVariant -> DatatypeVariant -> Bool)
-> (DatatypeVariant -> DatatypeVariant -> Bool)
-> (DatatypeVariant -> DatatypeVariant -> Bool)
-> (DatatypeVariant -> DatatypeVariant -> DatatypeVariant)
-> (DatatypeVariant -> DatatypeVariant -> DatatypeVariant)
-> Ord DatatypeVariant
DatatypeVariant -> DatatypeVariant -> Bool
DatatypeVariant -> DatatypeVariant -> Ordering
DatatypeVariant -> DatatypeVariant -> DatatypeVariant
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DatatypeVariant -> DatatypeVariant -> DatatypeVariant
$cmin :: DatatypeVariant -> DatatypeVariant -> DatatypeVariant
max :: DatatypeVariant -> DatatypeVariant -> DatatypeVariant
$cmax :: DatatypeVariant -> DatatypeVariant -> DatatypeVariant
>= :: DatatypeVariant -> DatatypeVariant -> Bool
$c>= :: DatatypeVariant -> DatatypeVariant -> Bool
> :: DatatypeVariant -> DatatypeVariant -> Bool
$c> :: DatatypeVariant -> DatatypeVariant -> Bool
<= :: DatatypeVariant -> DatatypeVariant -> Bool
$c<= :: DatatypeVariant -> DatatypeVariant -> Bool
< :: DatatypeVariant -> DatatypeVariant -> Bool
$c< :: DatatypeVariant -> DatatypeVariant -> Bool
compare :: DatatypeVariant -> DatatypeVariant -> Ordering
$ccompare :: DatatypeVariant -> DatatypeVariant -> Ordering
$cp1Ord :: Eq DatatypeVariant
Ord, Typeable, Typeable DatatypeVariant
DataType
Constr
Typeable DatatypeVariant
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DatatypeVariant -> c DatatypeVariant)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DatatypeVariant)
-> (DatatypeVariant -> Constr)
-> (DatatypeVariant -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DatatypeVariant))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DatatypeVariant))
-> ((forall b. Data b => b -> b)
-> DatatypeVariant -> DatatypeVariant)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DatatypeVariant -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DatatypeVariant -> r)
-> (forall u.
(forall d. Data d => d -> u) -> DatatypeVariant -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> DatatypeVariant -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DatatypeVariant -> m DatatypeVariant)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DatatypeVariant -> m DatatypeVariant)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DatatypeVariant -> m DatatypeVariant)
-> Data DatatypeVariant
DatatypeVariant -> DataType
DatatypeVariant -> Constr
(forall b. Data b => b -> b) -> DatatypeVariant -> DatatypeVariant
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DatatypeVariant -> c DatatypeVariant
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DatatypeVariant
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> DatatypeVariant -> u
forall u. (forall d. Data d => d -> u) -> DatatypeVariant -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DatatypeVariant -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DatatypeVariant -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DatatypeVariant -> m DatatypeVariant
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DatatypeVariant -> m DatatypeVariant
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DatatypeVariant
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DatatypeVariant -> c DatatypeVariant
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DatatypeVariant)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DatatypeVariant)
$cNewtypeInstance :: Constr
$cDataInstance :: Constr
$cNewtype :: Constr
$cDatatype :: Constr
$tDatatypeVariant :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> DatatypeVariant -> m DatatypeVariant
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DatatypeVariant -> m DatatypeVariant
gmapMp :: (forall d. Data d => d -> m d)
-> DatatypeVariant -> m DatatypeVariant
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DatatypeVariant -> m DatatypeVariant
gmapM :: (forall d. Data d => d -> m d)
-> DatatypeVariant -> m DatatypeVariant
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DatatypeVariant -> m DatatypeVariant
gmapQi :: Int -> (forall d. Data d => d -> u) -> DatatypeVariant -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DatatypeVariant -> u
gmapQ :: (forall d. Data d => d -> u) -> DatatypeVariant -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DatatypeVariant -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DatatypeVariant -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DatatypeVariant -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DatatypeVariant -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DatatypeVariant -> r
gmapT :: (forall b. Data b => b -> b) -> DatatypeVariant -> DatatypeVariant
$cgmapT :: (forall b. Data b => b -> b) -> DatatypeVariant -> DatatypeVariant
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DatatypeVariant)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DatatypeVariant)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DatatypeVariant)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DatatypeVariant)
dataTypeOf :: DatatypeVariant -> DataType
$cdataTypeOf :: DatatypeVariant -> DataType
toConstr :: DatatypeVariant -> Constr
$ctoConstr :: DatatypeVariant -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DatatypeVariant
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DatatypeVariant
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DatatypeVariant -> c DatatypeVariant
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DatatypeVariant -> c DatatypeVariant
$cp1Data :: Typeable DatatypeVariant
Data
#ifdef HAS_GENERICS
,(forall x. DatatypeVariant -> Rep DatatypeVariant x)
-> (forall x. Rep DatatypeVariant x -> DatatypeVariant)
-> Generic DatatypeVariant
forall x. Rep DatatypeVariant x -> DatatypeVariant
forall x. DatatypeVariant -> Rep DatatypeVariant x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DatatypeVariant x -> DatatypeVariant
$cfrom :: forall x. DatatypeVariant -> Rep DatatypeVariant x
Generic
#endif
)
data ConstructorInfo = ConstructorInfo
{ ConstructorInfo -> Name
constructorName :: Name
, ConstructorInfo -> [TyVarBndrUnit]
constructorVars :: [TyVarBndrUnit]
, ConstructorInfo -> Cxt
constructorContext :: Cxt
, ConstructorInfo -> Cxt
constructorFields :: [Type]
, ConstructorInfo -> [FieldStrictness]
constructorStrictness :: [FieldStrictness]
, ConstructorInfo -> ConstructorVariant
constructorVariant :: ConstructorVariant
}
deriving (Int -> ConstructorInfo -> ShowS
[ConstructorInfo] -> ShowS
ConstructorInfo -> String
(Int -> ConstructorInfo -> ShowS)
-> (ConstructorInfo -> String)
-> ([ConstructorInfo] -> ShowS)
-> Show ConstructorInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConstructorInfo] -> ShowS
$cshowList :: [ConstructorInfo] -> ShowS
show :: ConstructorInfo -> String
$cshow :: ConstructorInfo -> String
showsPrec :: Int -> ConstructorInfo -> ShowS
$cshowsPrec :: Int -> ConstructorInfo -> ShowS
Show, ConstructorInfo -> ConstructorInfo -> Bool
(ConstructorInfo -> ConstructorInfo -> Bool)
-> (ConstructorInfo -> ConstructorInfo -> Bool)
-> Eq ConstructorInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConstructorInfo -> ConstructorInfo -> Bool
$c/= :: ConstructorInfo -> ConstructorInfo -> Bool
== :: ConstructorInfo -> ConstructorInfo -> Bool
$c== :: ConstructorInfo -> ConstructorInfo -> Bool
Eq, Typeable, Typeable ConstructorInfo
DataType
Constr
Typeable ConstructorInfo
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ConstructorInfo -> c ConstructorInfo)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConstructorInfo)
-> (ConstructorInfo -> Constr)
-> (ConstructorInfo -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ConstructorInfo))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ConstructorInfo))
-> ((forall b. Data b => b -> b)
-> ConstructorInfo -> ConstructorInfo)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConstructorInfo -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConstructorInfo -> r)
-> (forall u.
(forall d. Data d => d -> u) -> ConstructorInfo -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> ConstructorInfo -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ConstructorInfo -> m ConstructorInfo)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ConstructorInfo -> m ConstructorInfo)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ConstructorInfo -> m ConstructorInfo)
-> Data ConstructorInfo
ConstructorInfo -> DataType
ConstructorInfo -> Constr
(forall b. Data b => b -> b) -> ConstructorInfo -> ConstructorInfo
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ConstructorInfo -> c ConstructorInfo
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConstructorInfo
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ConstructorInfo -> u
forall u. (forall d. Data d => d -> u) -> ConstructorInfo -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConstructorInfo -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConstructorInfo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ConstructorInfo -> m ConstructorInfo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ConstructorInfo -> m ConstructorInfo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConstructorInfo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ConstructorInfo -> c ConstructorInfo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ConstructorInfo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ConstructorInfo)
$cConstructorInfo :: Constr
$tConstructorInfo :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ConstructorInfo -> m ConstructorInfo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ConstructorInfo -> m ConstructorInfo
gmapMp :: (forall d. Data d => d -> m d)
-> ConstructorInfo -> m ConstructorInfo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ConstructorInfo -> m ConstructorInfo
gmapM :: (forall d. Data d => d -> m d)
-> ConstructorInfo -> m ConstructorInfo
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ConstructorInfo -> m ConstructorInfo
gmapQi :: Int -> (forall d. Data d => d -> u) -> ConstructorInfo -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ConstructorInfo -> u
gmapQ :: (forall d. Data d => d -> u) -> ConstructorInfo -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ConstructorInfo -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConstructorInfo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConstructorInfo -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConstructorInfo -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConstructorInfo -> r
gmapT :: (forall b. Data b => b -> b) -> ConstructorInfo -> ConstructorInfo
$cgmapT :: (forall b. Data b => b -> b) -> ConstructorInfo -> ConstructorInfo
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ConstructorInfo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ConstructorInfo)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ConstructorInfo)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ConstructorInfo)
dataTypeOf :: ConstructorInfo -> DataType
$cdataTypeOf :: ConstructorInfo -> DataType
toConstr :: ConstructorInfo -> Constr
$ctoConstr :: ConstructorInfo -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConstructorInfo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConstructorInfo
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ConstructorInfo -> c ConstructorInfo
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ConstructorInfo -> c ConstructorInfo
$cp1Data :: Typeable ConstructorInfo
Data
#ifdef HAS_GENERICS
,(forall x. ConstructorInfo -> Rep ConstructorInfo x)
-> (forall x. Rep ConstructorInfo x -> ConstructorInfo)
-> Generic ConstructorInfo
forall x. Rep ConstructorInfo x -> ConstructorInfo
forall x. ConstructorInfo -> Rep ConstructorInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConstructorInfo x -> ConstructorInfo
$cfrom :: forall x. ConstructorInfo -> Rep ConstructorInfo x
Generic
#endif
)
data ConstructorVariant
= NormalConstructor
| InfixConstructor
| RecordConstructor [Name]
deriving (Int -> ConstructorVariant -> ShowS
[ConstructorVariant] -> ShowS
ConstructorVariant -> String
(Int -> ConstructorVariant -> ShowS)
-> (ConstructorVariant -> String)
-> ([ConstructorVariant] -> ShowS)
-> Show ConstructorVariant
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConstructorVariant] -> ShowS
$cshowList :: [ConstructorVariant] -> ShowS
show :: ConstructorVariant -> String
$cshow :: ConstructorVariant -> String
showsPrec :: Int -> ConstructorVariant -> ShowS
$cshowsPrec :: Int -> ConstructorVariant -> ShowS
Show, ConstructorVariant -> ConstructorVariant -> Bool
(ConstructorVariant -> ConstructorVariant -> Bool)
-> (ConstructorVariant -> ConstructorVariant -> Bool)
-> Eq ConstructorVariant
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConstructorVariant -> ConstructorVariant -> Bool
$c/= :: ConstructorVariant -> ConstructorVariant -> Bool
== :: ConstructorVariant -> ConstructorVariant -> Bool
$c== :: ConstructorVariant -> ConstructorVariant -> Bool
Eq, Eq ConstructorVariant
Eq ConstructorVariant
-> (ConstructorVariant -> ConstructorVariant -> Ordering)
-> (ConstructorVariant -> ConstructorVariant -> Bool)
-> (ConstructorVariant -> ConstructorVariant -> Bool)
-> (ConstructorVariant -> ConstructorVariant -> Bool)
-> (ConstructorVariant -> ConstructorVariant -> Bool)
-> (ConstructorVariant -> ConstructorVariant -> ConstructorVariant)
-> (ConstructorVariant -> ConstructorVariant -> ConstructorVariant)
-> Ord ConstructorVariant
ConstructorVariant -> ConstructorVariant -> Bool
ConstructorVariant -> ConstructorVariant -> Ordering
ConstructorVariant -> ConstructorVariant -> ConstructorVariant
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ConstructorVariant -> ConstructorVariant -> ConstructorVariant
$cmin :: ConstructorVariant -> ConstructorVariant -> ConstructorVariant
max :: ConstructorVariant -> ConstructorVariant -> ConstructorVariant
$cmax :: ConstructorVariant -> ConstructorVariant -> ConstructorVariant
>= :: ConstructorVariant -> ConstructorVariant -> Bool
$c>= :: ConstructorVariant -> ConstructorVariant -> Bool
> :: ConstructorVariant -> ConstructorVariant -> Bool
$c> :: ConstructorVariant -> ConstructorVariant -> Bool
<= :: ConstructorVariant -> ConstructorVariant -> Bool
$c<= :: ConstructorVariant -> ConstructorVariant -> Bool
< :: ConstructorVariant -> ConstructorVariant -> Bool
$c< :: ConstructorVariant -> ConstructorVariant -> Bool
compare :: ConstructorVariant -> ConstructorVariant -> Ordering
$ccompare :: ConstructorVariant -> ConstructorVariant -> Ordering
$cp1Ord :: Eq ConstructorVariant
Ord, Typeable, Typeable ConstructorVariant
DataType
Constr
Typeable ConstructorVariant
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ConstructorVariant
-> c ConstructorVariant)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConstructorVariant)
-> (ConstructorVariant -> Constr)
-> (ConstructorVariant -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ConstructorVariant))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ConstructorVariant))
-> ((forall b. Data b => b -> b)
-> ConstructorVariant -> ConstructorVariant)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConstructorVariant -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConstructorVariant -> r)
-> (forall u.
(forall d. Data d => d -> u) -> ConstructorVariant -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> ConstructorVariant -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ConstructorVariant -> m ConstructorVariant)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ConstructorVariant -> m ConstructorVariant)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ConstructorVariant -> m ConstructorVariant)
-> Data ConstructorVariant
ConstructorVariant -> DataType
ConstructorVariant -> Constr
(forall b. Data b => b -> b)
-> ConstructorVariant -> ConstructorVariant
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ConstructorVariant
-> c ConstructorVariant
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConstructorVariant
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ConstructorVariant -> u
forall u. (forall d. Data d => d -> u) -> ConstructorVariant -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConstructorVariant -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConstructorVariant -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ConstructorVariant -> m ConstructorVariant
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ConstructorVariant -> m ConstructorVariant
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConstructorVariant
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ConstructorVariant
-> c ConstructorVariant
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ConstructorVariant)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ConstructorVariant)
$cRecordConstructor :: Constr
$cInfixConstructor :: Constr
$cNormalConstructor :: Constr
$tConstructorVariant :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ConstructorVariant -> m ConstructorVariant
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ConstructorVariant -> m ConstructorVariant
gmapMp :: (forall d. Data d => d -> m d)
-> ConstructorVariant -> m ConstructorVariant
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ConstructorVariant -> m ConstructorVariant
gmapM :: (forall d. Data d => d -> m d)
-> ConstructorVariant -> m ConstructorVariant
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ConstructorVariant -> m ConstructorVariant
gmapQi :: Int -> (forall d. Data d => d -> u) -> ConstructorVariant -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ConstructorVariant -> u
gmapQ :: (forall d. Data d => d -> u) -> ConstructorVariant -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ConstructorVariant -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConstructorVariant -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConstructorVariant -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConstructorVariant -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConstructorVariant -> r
gmapT :: (forall b. Data b => b -> b)
-> ConstructorVariant -> ConstructorVariant
$cgmapT :: (forall b. Data b => b -> b)
-> ConstructorVariant -> ConstructorVariant
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ConstructorVariant)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ConstructorVariant)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ConstructorVariant)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ConstructorVariant)
dataTypeOf :: ConstructorVariant -> DataType
$cdataTypeOf :: ConstructorVariant -> DataType
toConstr :: ConstructorVariant -> Constr
$ctoConstr :: ConstructorVariant -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConstructorVariant
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConstructorVariant
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ConstructorVariant
-> c ConstructorVariant
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ConstructorVariant
-> c ConstructorVariant
$cp1Data :: Typeable ConstructorVariant
Data
#ifdef HAS_GENERICS
,(forall x. ConstructorVariant -> Rep ConstructorVariant x)
-> (forall x. Rep ConstructorVariant x -> ConstructorVariant)
-> Generic ConstructorVariant
forall x. Rep ConstructorVariant x -> ConstructorVariant
forall x. ConstructorVariant -> Rep ConstructorVariant x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConstructorVariant x -> ConstructorVariant
$cfrom :: forall x. ConstructorVariant -> Rep ConstructorVariant x
Generic
#endif
)
data FieldStrictness = FieldStrictness
{ FieldStrictness -> Unpackedness
fieldUnpackedness :: Unpackedness
, FieldStrictness -> Strictness
fieldStrictness :: Strictness
}
deriving (Int -> FieldStrictness -> ShowS
[FieldStrictness] -> ShowS
FieldStrictness -> String
(Int -> FieldStrictness -> ShowS)
-> (FieldStrictness -> String)
-> ([FieldStrictness] -> ShowS)
-> Show FieldStrictness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldStrictness] -> ShowS
$cshowList :: [FieldStrictness] -> ShowS
show :: FieldStrictness -> String
$cshow :: FieldStrictness -> String
showsPrec :: Int -> FieldStrictness -> ShowS
$cshowsPrec :: Int -> FieldStrictness -> ShowS
Show, FieldStrictness -> FieldStrictness -> Bool
(FieldStrictness -> FieldStrictness -> Bool)
-> (FieldStrictness -> FieldStrictness -> Bool)
-> Eq FieldStrictness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldStrictness -> FieldStrictness -> Bool
$c/= :: FieldStrictness -> FieldStrictness -> Bool
== :: FieldStrictness -> FieldStrictness -> Bool
$c== :: FieldStrictness -> FieldStrictness -> Bool
Eq, Eq FieldStrictness
Eq FieldStrictness
-> (FieldStrictness -> FieldStrictness -> Ordering)
-> (FieldStrictness -> FieldStrictness -> Bool)
-> (FieldStrictness -> FieldStrictness -> Bool)
-> (FieldStrictness -> FieldStrictness -> Bool)
-> (FieldStrictness -> FieldStrictness -> Bool)
-> (FieldStrictness -> FieldStrictness -> FieldStrictness)
-> (FieldStrictness -> FieldStrictness -> FieldStrictness)
-> Ord FieldStrictness
FieldStrictness -> FieldStrictness -> Bool
FieldStrictness -> FieldStrictness -> Ordering
FieldStrictness -> FieldStrictness -> FieldStrictness
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FieldStrictness -> FieldStrictness -> FieldStrictness
$cmin :: FieldStrictness -> FieldStrictness -> FieldStrictness
max :: FieldStrictness -> FieldStrictness -> FieldStrictness
$cmax :: FieldStrictness -> FieldStrictness -> FieldStrictness
>= :: FieldStrictness -> FieldStrictness -> Bool
$c>= :: FieldStrictness -> FieldStrictness -> Bool
> :: FieldStrictness -> FieldStrictness -> Bool
$c> :: FieldStrictness -> FieldStrictness -> Bool
<= :: FieldStrictness -> FieldStrictness -> Bool
$c<= :: FieldStrictness -> FieldStrictness -> Bool
< :: FieldStrictness -> FieldStrictness -> Bool
$c< :: FieldStrictness -> FieldStrictness -> Bool
compare :: FieldStrictness -> FieldStrictness -> Ordering
$ccompare :: FieldStrictness -> FieldStrictness -> Ordering
$cp1Ord :: Eq FieldStrictness
Ord, Typeable, Typeable FieldStrictness
DataType
Constr
Typeable FieldStrictness
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FieldStrictness -> c FieldStrictness)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldStrictness)
-> (FieldStrictness -> Constr)
-> (FieldStrictness -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FieldStrictness))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FieldStrictness))
-> ((forall b. Data b => b -> b)
-> FieldStrictness -> FieldStrictness)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldStrictness -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldStrictness -> r)
-> (forall u.
(forall d. Data d => d -> u) -> FieldStrictness -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> FieldStrictness -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FieldStrictness -> m FieldStrictness)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FieldStrictness -> m FieldStrictness)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FieldStrictness -> m FieldStrictness)
-> Data FieldStrictness
FieldStrictness -> DataType
FieldStrictness -> Constr
(forall b. Data b => b -> b) -> FieldStrictness -> FieldStrictness
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FieldStrictness -> c FieldStrictness
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldStrictness
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> FieldStrictness -> u
forall u. (forall d. Data d => d -> u) -> FieldStrictness -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldStrictness -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldStrictness -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FieldStrictness -> m FieldStrictness
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FieldStrictness -> m FieldStrictness
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldStrictness
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FieldStrictness -> c FieldStrictness
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FieldStrictness)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FieldStrictness)
$cFieldStrictness :: Constr
$tFieldStrictness :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> FieldStrictness -> m FieldStrictness
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FieldStrictness -> m FieldStrictness
gmapMp :: (forall d. Data d => d -> m d)
-> FieldStrictness -> m FieldStrictness
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FieldStrictness -> m FieldStrictness
gmapM :: (forall d. Data d => d -> m d)
-> FieldStrictness -> m FieldStrictness
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FieldStrictness -> m FieldStrictness
gmapQi :: Int -> (forall d. Data d => d -> u) -> FieldStrictness -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FieldStrictness -> u
gmapQ :: (forall d. Data d => d -> u) -> FieldStrictness -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FieldStrictness -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldStrictness -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldStrictness -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldStrictness -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldStrictness -> r
gmapT :: (forall b. Data b => b -> b) -> FieldStrictness -> FieldStrictness
$cgmapT :: (forall b. Data b => b -> b) -> FieldStrictness -> FieldStrictness
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FieldStrictness)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FieldStrictness)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c FieldStrictness)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FieldStrictness)
dataTypeOf :: FieldStrictness -> DataType
$cdataTypeOf :: FieldStrictness -> DataType
toConstr :: FieldStrictness -> Constr
$ctoConstr :: FieldStrictness -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldStrictness
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldStrictness
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FieldStrictness -> c FieldStrictness
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FieldStrictness -> c FieldStrictness
$cp1Data :: Typeable FieldStrictness
Data
#ifdef HAS_GENERICS
,(forall x. FieldStrictness -> Rep FieldStrictness x)
-> (forall x. Rep FieldStrictness x -> FieldStrictness)
-> Generic FieldStrictness
forall x. Rep FieldStrictness x -> FieldStrictness
forall x. FieldStrictness -> Rep FieldStrictness x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FieldStrictness x -> FieldStrictness
$cfrom :: forall x. FieldStrictness -> Rep FieldStrictness x
Generic
#endif
)
data Unpackedness
= UnspecifiedUnpackedness
| NoUnpack
| Unpack
deriving (Int -> Unpackedness -> ShowS
[Unpackedness] -> ShowS
Unpackedness -> String
(Int -> Unpackedness -> ShowS)
-> (Unpackedness -> String)
-> ([Unpackedness] -> ShowS)
-> Show Unpackedness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unpackedness] -> ShowS
$cshowList :: [Unpackedness] -> ShowS
show :: Unpackedness -> String
$cshow :: Unpackedness -> String
showsPrec :: Int -> Unpackedness -> ShowS
$cshowsPrec :: Int -> Unpackedness -> ShowS
Show, Unpackedness -> Unpackedness -> Bool
(Unpackedness -> Unpackedness -> Bool)
-> (Unpackedness -> Unpackedness -> Bool) -> Eq Unpackedness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Unpackedness -> Unpackedness -> Bool
$c/= :: Unpackedness -> Unpackedness -> Bool
== :: Unpackedness -> Unpackedness -> Bool
$c== :: Unpackedness -> Unpackedness -> Bool
Eq, Eq Unpackedness
Eq Unpackedness
-> (Unpackedness -> Unpackedness -> Ordering)
-> (Unpackedness -> Unpackedness -> Bool)
-> (Unpackedness -> Unpackedness -> Bool)
-> (Unpackedness -> Unpackedness -> Bool)
-> (Unpackedness -> Unpackedness -> Bool)
-> (Unpackedness -> Unpackedness -> Unpackedness)
-> (Unpackedness -> Unpackedness -> Unpackedness)
-> Ord Unpackedness
Unpackedness -> Unpackedness -> Bool
Unpackedness -> Unpackedness -> Ordering
Unpackedness -> Unpackedness -> Unpackedness
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Unpackedness -> Unpackedness -> Unpackedness
$cmin :: Unpackedness -> Unpackedness -> Unpackedness
max :: Unpackedness -> Unpackedness -> Unpackedness
$cmax :: Unpackedness -> Unpackedness -> Unpackedness
>= :: Unpackedness -> Unpackedness -> Bool
$c>= :: Unpackedness -> Unpackedness -> Bool
> :: Unpackedness -> Unpackedness -> Bool
$c> :: Unpackedness -> Unpackedness -> Bool
<= :: Unpackedness -> Unpackedness -> Bool
$c<= :: Unpackedness -> Unpackedness -> Bool
< :: Unpackedness -> Unpackedness -> Bool
$c< :: Unpackedness -> Unpackedness -> Bool
compare :: Unpackedness -> Unpackedness -> Ordering
$ccompare :: Unpackedness -> Unpackedness -> Ordering
$cp1Ord :: Eq Unpackedness
Ord, Typeable, Typeable Unpackedness
DataType
Constr
Typeable Unpackedness
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Unpackedness -> c Unpackedness)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Unpackedness)
-> (Unpackedness -> Constr)
-> (Unpackedness -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Unpackedness))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Unpackedness))
-> ((forall b. Data b => b -> b) -> Unpackedness -> Unpackedness)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Unpackedness -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Unpackedness -> r)
-> (forall u. (forall d. Data d => d -> u) -> Unpackedness -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> Unpackedness -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Unpackedness -> m Unpackedness)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Unpackedness -> m Unpackedness)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Unpackedness -> m Unpackedness)
-> Data Unpackedness
Unpackedness -> DataType
Unpackedness -> Constr
(forall b. Data b => b -> b) -> Unpackedness -> Unpackedness
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Unpackedness -> c Unpackedness
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Unpackedness
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Unpackedness -> u
forall u. (forall d. Data d => d -> u) -> Unpackedness -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Unpackedness -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Unpackedness -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Unpackedness -> m Unpackedness
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Unpackedness -> m Unpackedness
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Unpackedness
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Unpackedness -> c Unpackedness
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Unpackedness)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Unpackedness)
$cUnpack :: Constr
$cNoUnpack :: Constr
$cUnspecifiedUnpackedness :: Constr
$tUnpackedness :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Unpackedness -> m Unpackedness
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Unpackedness -> m Unpackedness
gmapMp :: (forall d. Data d => d -> m d) -> Unpackedness -> m Unpackedness
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Unpackedness -> m Unpackedness
gmapM :: (forall d. Data d => d -> m d) -> Unpackedness -> m Unpackedness
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Unpackedness -> m Unpackedness
gmapQi :: Int -> (forall d. Data d => d -> u) -> Unpackedness -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Unpackedness -> u
gmapQ :: (forall d. Data d => d -> u) -> Unpackedness -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Unpackedness -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Unpackedness -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Unpackedness -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Unpackedness -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Unpackedness -> r
gmapT :: (forall b. Data b => b -> b) -> Unpackedness -> Unpackedness
$cgmapT :: (forall b. Data b => b -> b) -> Unpackedness -> Unpackedness
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Unpackedness)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Unpackedness)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Unpackedness)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Unpackedness)
dataTypeOf :: Unpackedness -> DataType
$cdataTypeOf :: Unpackedness -> DataType
toConstr :: Unpackedness -> Constr
$ctoConstr :: Unpackedness -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Unpackedness
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Unpackedness
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Unpackedness -> c Unpackedness
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Unpackedness -> c Unpackedness
$cp1Data :: Typeable Unpackedness
Data
#ifdef HAS_GENERICS
,(forall x. Unpackedness -> Rep Unpackedness x)
-> (forall x. Rep Unpackedness x -> Unpackedness)
-> Generic Unpackedness
forall x. Rep Unpackedness x -> Unpackedness
forall x. Unpackedness -> Rep Unpackedness x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Unpackedness x -> Unpackedness
$cfrom :: forall x. Unpackedness -> Rep Unpackedness x
Generic
#endif
)
data Strictness
= UnspecifiedStrictness
| Lazy
| Strict
deriving (Int -> Strictness -> ShowS
[Strictness] -> ShowS
Strictness -> String
(Int -> Strictness -> ShowS)
-> (Strictness -> String)
-> ([Strictness] -> ShowS)
-> Show Strictness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Strictness] -> ShowS
$cshowList :: [Strictness] -> ShowS
show :: Strictness -> String
$cshow :: Strictness -> String
showsPrec :: Int -> Strictness -> ShowS
$cshowsPrec :: Int -> Strictness -> ShowS
Show, Strictness -> Strictness -> Bool
(Strictness -> Strictness -> Bool)
-> (Strictness -> Strictness -> Bool) -> Eq Strictness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Strictness -> Strictness -> Bool
$c/= :: Strictness -> Strictness -> Bool
== :: Strictness -> Strictness -> Bool
$c== :: Strictness -> Strictness -> Bool
Eq, Eq Strictness
Eq Strictness
-> (Strictness -> Strictness -> Ordering)
-> (Strictness -> Strictness -> Bool)
-> (Strictness -> Strictness -> Bool)
-> (Strictness -> Strictness -> Bool)
-> (Strictness -> Strictness -> Bool)
-> (Strictness -> Strictness -> Strictness)
-> (Strictness -> Strictness -> Strictness)
-> Ord Strictness
Strictness -> Strictness -> Bool
Strictness -> Strictness -> Ordering
Strictness -> Strictness -> Strictness
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Strictness -> Strictness -> Strictness
$cmin :: Strictness -> Strictness -> Strictness
max :: Strictness -> Strictness -> Strictness
$cmax :: Strictness -> Strictness -> Strictness
>= :: Strictness -> Strictness -> Bool
$c>= :: Strictness -> Strictness -> Bool
> :: Strictness -> Strictness -> Bool
$c> :: Strictness -> Strictness -> Bool
<= :: Strictness -> Strictness -> Bool
$c<= :: Strictness -> Strictness -> Bool
< :: Strictness -> Strictness -> Bool
$c< :: Strictness -> Strictness -> Bool
compare :: Strictness -> Strictness -> Ordering
$ccompare :: Strictness -> Strictness -> Ordering
$cp1Ord :: Eq Strictness
Ord, Typeable, Typeable Strictness
DataType
Constr
Typeable Strictness
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Strictness -> c Strictness)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Strictness)
-> (Strictness -> Constr)
-> (Strictness -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Strictness))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Strictness))
-> ((forall b. Data b => b -> b) -> Strictness -> Strictness)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Strictness -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Strictness -> r)
-> (forall u. (forall d. Data d => d -> u) -> Strictness -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> Strictness -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Strictness -> m Strictness)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Strictness -> m Strictness)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Strictness -> m Strictness)
-> Data Strictness
Strictness -> DataType
Strictness -> Constr
(forall b. Data b => b -> b) -> Strictness -> Strictness
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Strictness -> c Strictness
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Strictness
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Strictness -> u
forall u. (forall d. Data d => d -> u) -> Strictness -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Strictness -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Strictness -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Strictness -> m Strictness
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Strictness -> m Strictness
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Strictness
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Strictness -> c Strictness
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Strictness)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Strictness)
$cStrict :: Constr
$cLazy :: Constr
$cUnspecifiedStrictness :: Constr
$tStrictness :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Strictness -> m Strictness
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Strictness -> m Strictness
gmapMp :: (forall d. Data d => d -> m d) -> Strictness -> m Strictness
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Strictness -> m Strictness
gmapM :: (forall d. Data d => d -> m d) -> Strictness -> m Strictness
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Strictness -> m Strictness
gmapQi :: Int -> (forall d. Data d => d -> u) -> Strictness -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Strictness -> u
gmapQ :: (forall d. Data d => d -> u) -> Strictness -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Strictness -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Strictness -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Strictness -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Strictness -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Strictness -> r
gmapT :: (forall b. Data b => b -> b) -> Strictness -> Strictness
$cgmapT :: (forall b. Data b => b -> b) -> Strictness -> Strictness
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Strictness)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Strictness)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Strictness)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Strictness)
dataTypeOf :: Strictness -> DataType
$cdataTypeOf :: Strictness -> DataType
toConstr :: Strictness -> Constr
$ctoConstr :: Strictness -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Strictness
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Strictness
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Strictness -> c Strictness
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Strictness -> c Strictness
$cp1Data :: Typeable Strictness
Data
#ifdef HAS_GENERICS
,(forall x. Strictness -> Rep Strictness x)
-> (forall x. Rep Strictness x -> Strictness) -> Generic Strictness
forall x. Rep Strictness x -> Strictness
forall x. Strictness -> Rep Strictness x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Strictness x -> Strictness
$cfrom :: forall x. Strictness -> Rep Strictness x
Generic
#endif
)
isStrictAnnot, notStrictAnnot, unpackedAnnot :: FieldStrictness
isStrictAnnot :: FieldStrictness
isStrictAnnot = Unpackedness -> Strictness -> FieldStrictness
FieldStrictness Unpackedness
UnspecifiedUnpackedness Strictness
Strict
notStrictAnnot :: FieldStrictness
notStrictAnnot = Unpackedness -> Strictness -> FieldStrictness
FieldStrictness Unpackedness
UnspecifiedUnpackedness Strictness
UnspecifiedStrictness
unpackedAnnot :: FieldStrictness
unpackedAnnot = Unpackedness -> Strictness -> FieldStrictness
FieldStrictness Unpackedness
Unpack Strictness
Strict
datatypeType :: DatatypeInfo -> Type
datatypeType :: DatatypeInfo -> Type
datatypeType DatatypeInfo
di
= (Type -> Type -> Type) -> Type -> Cxt -> Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
AppT (Name -> Type
ConT (DatatypeInfo -> Name
datatypeName DatatypeInfo
di))
(Cxt -> Type) -> Cxt -> Type
forall a b. (a -> b) -> a -> b
$ (Type -> Type) -> Cxt -> Cxt
forall a b. (a -> b) -> [a] -> [b]
map Type -> Type
stripSigT
(Cxt -> Cxt) -> Cxt -> Cxt
forall a b. (a -> b) -> a -> b
$ DatatypeInfo -> Cxt
datatypeInstTypes DatatypeInfo
di
reifyDatatype ::
Name ->
Q DatatypeInfo
reifyDatatype :: Name -> Q DatatypeInfo
reifyDatatype Name
n = String -> Bool -> Info -> Q DatatypeInfo
normalizeInfo' String
"reifyDatatype" Bool
isReified (Info -> Q DatatypeInfo) -> Q Info -> Q DatatypeInfo
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Name -> Q Info
reify Name
n
reifyConstructor ::
Name ->
Q ConstructorInfo
reifyConstructor :: Name -> Q ConstructorInfo
reifyConstructor Name
conName = do
DatatypeInfo
dataInfo <- Name -> Q DatatypeInfo
reifyDatatype Name
conName
ConstructorInfo -> Q ConstructorInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (ConstructorInfo -> Q ConstructorInfo)
-> ConstructorInfo -> Q ConstructorInfo
forall a b. (a -> b) -> a -> b
$ Name -> DatatypeInfo -> ConstructorInfo
lookupByConstructorName Name
conName DatatypeInfo
dataInfo
reifyRecord ::
Name ->
Q ConstructorInfo
reifyRecord :: Name -> Q ConstructorInfo
reifyRecord Name
recordName = do
DatatypeInfo
dataInfo <- Name -> Q DatatypeInfo
reifyDatatype Name
recordName
ConstructorInfo -> Q ConstructorInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (ConstructorInfo -> Q ConstructorInfo)
-> ConstructorInfo -> Q ConstructorInfo
forall a b. (a -> b) -> a -> b
$ Name -> DatatypeInfo -> ConstructorInfo
lookupByRecordName Name
recordName DatatypeInfo
dataInfo
lookupByConstructorName ::
Name ->
DatatypeInfo ->
ConstructorInfo
lookupByConstructorName :: Name -> DatatypeInfo -> ConstructorInfo
lookupByConstructorName Name
conName DatatypeInfo
dataInfo =
case (ConstructorInfo -> Bool)
-> [ConstructorInfo] -> Maybe ConstructorInfo
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
conName) (Name -> Bool)
-> (ConstructorInfo -> Name) -> ConstructorInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstructorInfo -> Name
constructorName) (DatatypeInfo -> [ConstructorInfo]
datatypeCons DatatypeInfo
dataInfo) of
Just ConstructorInfo
conInfo -> ConstructorInfo
conInfo
Maybe ConstructorInfo
Nothing -> String -> ConstructorInfo
forall a. HasCallStack => String -> a
error (String -> ConstructorInfo) -> String -> ConstructorInfo
forall a b. (a -> b) -> a -> b
$ String
"Datatype " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Name -> String
nameBase (DatatypeInfo -> Name
datatypeName DatatypeInfo
dataInfo)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" does not have a constructor named " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Name -> String
nameBase Name
conName
lookupByRecordName ::
Name ->
DatatypeInfo ->
ConstructorInfo
lookupByRecordName :: Name -> DatatypeInfo -> ConstructorInfo
lookupByRecordName Name
recordName DatatypeInfo
dataInfo =
case (ConstructorInfo -> Bool)
-> [ConstructorInfo] -> Maybe ConstructorInfo
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Name -> ConstructorInfo -> Bool
conHasRecord Name
recordName) (DatatypeInfo -> [ConstructorInfo]
datatypeCons DatatypeInfo
dataInfo) of
Just ConstructorInfo
conInfo -> ConstructorInfo
conInfo
Maybe ConstructorInfo
Nothing -> String -> ConstructorInfo
forall a. HasCallStack => String -> a
error (String -> ConstructorInfo) -> String -> ConstructorInfo
forall a b. (a -> b) -> a -> b
$ String
"Datatype " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Name -> String
nameBase (DatatypeInfo -> Name
datatypeName DatatypeInfo
dataInfo)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" does not have any constructors with a "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"record selector named " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Name -> String
nameBase Name
recordName
normalizeInfo :: Info -> Q DatatypeInfo
normalizeInfo :: Info -> Q DatatypeInfo
normalizeInfo = String -> Bool -> Info -> Q DatatypeInfo
normalizeInfo' String
"normalizeInfo" Bool
isn'tReified
normalizeInfo' :: String -> IsReifiedDec -> Info -> Q DatatypeInfo
normalizeInfo' :: String -> Bool -> Info -> Q DatatypeInfo
normalizeInfo' String
entry Bool
reifiedDec Info
i =
case Info
i of
PrimTyConI{} -> String -> Q DatatypeInfo
forall (m :: * -> *) a. MonadFail m => String -> m a
bad String
"Primitive type not supported"
ClassI{} -> String -> Q DatatypeInfo
forall (m :: * -> *) a. MonadFail m => String -> m a
bad String
"Class not supported"
#if MIN_VERSION_template_haskell(2,11,0)
FamilyI DataFamilyD{} [Dec]
_ ->
#elif MIN_VERSION_template_haskell(2,7,0)
FamilyI (FamilyD DataFam _ _ _) _ ->
#else
TyConI (FamilyD DataFam _ _ _) ->
#endif
String -> Q DatatypeInfo
forall (m :: * -> *) a. MonadFail m => String -> m a
bad String
"Use a value constructor to reify a data family instance"
#if MIN_VERSION_template_haskell(2,7,0)
FamilyI Dec
_ [Dec]
_ -> String -> Q DatatypeInfo
forall (m :: * -> *) a. MonadFail m => String -> m a
bad String
"Type families not supported"
#endif
TyConI Dec
dec -> Bool -> Dec -> Q DatatypeInfo
normalizeDecFor Bool
reifiedDec Dec
dec
#if MIN_VERSION_template_haskell(2,11,0)
DataConI Name
name Type
_ Name
parent -> Name -> Name -> Q DatatypeInfo
reifyParent Name
name Name
parent
#else
DataConI name _ parent _ -> reifyParent name parent
#endif
#if MIN_VERSION_template_haskell(2,11,0)
VarI Name
recName Type
recTy Maybe Dec
_ -> Name -> Type -> Q DatatypeInfo
reifyRecordType Name
recName Type
recTy
#else
VarI recName recTy _ _ -> reifyRecordType recName recTy
#endif
Info
_ -> String -> Q DatatypeInfo
forall (m :: * -> *) a. MonadFail m => String -> m a
bad String
"Expected a type constructor"
where
bad :: String -> m a
bad String
msg = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
entry String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg)
reifyParent :: Name -> Name -> Q DatatypeInfo
reifyParent :: Name -> Name -> Q DatatypeInfo
reifyParent Name
con = String -> (DatatypeInfo -> Bool) -> Name -> Q DatatypeInfo
reifyParentWith String
"reifyParent" DatatypeInfo -> Bool
p
where
p :: DatatypeInfo -> Bool
p :: DatatypeInfo -> Bool
p DatatypeInfo
info = Name
con Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (ConstructorInfo -> Name) -> [ConstructorInfo] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map ConstructorInfo -> Name
constructorName (DatatypeInfo -> [ConstructorInfo]
datatypeCons DatatypeInfo
info)
reifyRecordType :: Name -> Type -> Q DatatypeInfo
reifyRecordType :: Name -> Type -> Q DatatypeInfo
reifyRecordType Name
recName Type
recTy =
let ([TyVarBndrUnit]
_, Cxt
_, Cxt
argTys :|- Type
_) = Type -> ([TyVarBndrUnit], Cxt, NonEmptySnoc Type)
uncurryType Type
recTy
in case Cxt
argTys of
Type
dataTy:Cxt
_ -> Type -> Q DatatypeInfo
decomposeDataType Type
dataTy
Cxt
_ -> Q DatatypeInfo
forall a. Q a
notRecSelFailure
where
decomposeDataType :: Type -> Q DatatypeInfo
decomposeDataType :: Type -> Q DatatypeInfo
decomposeDataType Type
ty =
do case Type -> NonEmpty Type
decomposeType Type
ty of
ConT Name
parent :| Cxt
_ -> String -> (DatatypeInfo -> Bool) -> Name -> Q DatatypeInfo
reifyParentWith String
"reifyRecordType" DatatypeInfo -> Bool
p Name
parent
NonEmpty Type
_ -> Q DatatypeInfo
forall a. Q a
notRecSelFailure
notRecSelFailure :: Q a
notRecSelFailure :: Q a
notRecSelFailure = String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q a) -> String -> Q a
forall a b. (a -> b) -> a -> b
$
String
"reifyRecordType: Not a record selector type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
Name -> String
nameBase Name
recName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" :: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
recTy
p :: DatatypeInfo -> Bool
p :: DatatypeInfo -> Bool
p DatatypeInfo
info = (ConstructorInfo -> Bool) -> [ConstructorInfo] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Name -> ConstructorInfo -> Bool
conHasRecord Name
recName) (DatatypeInfo -> [ConstructorInfo]
datatypeCons DatatypeInfo
info)
reifyParentWith ::
String ->
(DatatypeInfo -> Bool) ->
Name ->
Q DatatypeInfo
reifyParentWith :: String -> (DatatypeInfo -> Bool) -> Name -> Q DatatypeInfo
reifyParentWith String
prefix DatatypeInfo -> Bool
p Name
n =
do Info
info <- Name -> Q Info
reify Name
n
case Info
info of
#if !(MIN_VERSION_template_haskell(2,11,0))
TyConI FamilyD{} -> dataFamiliesOnOldGHCsError
#endif
TyConI Dec
dec -> Bool -> Dec -> Q DatatypeInfo
normalizeDecFor Bool
isReified Dec
dec
#if MIN_VERSION_template_haskell(2,7,0)
FamilyI Dec
dec [Dec]
instances ->
do [Dec]
instances1 <- (Dec -> Q Dec) -> [Dec] -> Q [Dec]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Dec -> Dec -> Q Dec
repairDataFam Dec
dec) [Dec]
instances
[DatatypeInfo]
instances2 <- (Dec -> Q DatatypeInfo) -> [Dec] -> Q [DatatypeInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> Dec -> Q DatatypeInfo
normalizeDecFor Bool
isReified) [Dec]
instances1
case (DatatypeInfo -> Bool) -> [DatatypeInfo] -> Maybe DatatypeInfo
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find DatatypeInfo -> Bool
p [DatatypeInfo]
instances2 of
Just DatatypeInfo
inst -> DatatypeInfo -> Q DatatypeInfo
forall (m :: * -> *) a. Monad m => a -> m a
return DatatypeInfo
inst
Maybe DatatypeInfo
Nothing -> String -> Q DatatypeInfo
forall a. String -> Q a
panic String
"lost the instance"
#endif
Info
_ -> String -> Q DatatypeInfo
forall a. String -> Q a
panic String
"unexpected parent"
where
dataFamiliesOnOldGHCsError :: Q a
dataFamiliesOnOldGHCsError :: Q a
dataFamiliesOnOldGHCsError = String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q a) -> String -> Q a
forall a b. (a -> b) -> a -> b
$
String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": Data family instances can only be reified with GHC 7.4 or later"
panic :: String -> Q a
panic :: String -> Q a
panic String
message = String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q a) -> String -> Q a
forall a b. (a -> b) -> a -> b
$ String
"PANIC: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
message
#if MIN_VERSION_template_haskell(2,8,0) && (!MIN_VERSION_template_haskell(2,10,0))
sanitizeStars :: Kind -> Kind
sanitizeStars = go
where
go :: Kind -> Kind
go (AppT t1 t2) = AppT (go t1) (go t2)
go (SigT t k) = SigT (go t) (go k)
go (ConT n) | n == starKindName = StarT
go t = t
repairVarKindsWith' :: [TyVarBndrUnit] -> Maybe Kind -> [Type] -> Q [Type]
repairVarKindsWith' dvars dkind ts =
let kindVars = freeVariables . map kindPart
kindPart (KindedTV _ k) = [k]
kindPart (PlainTV _ ) = []
nparams = length dvars
kparams = kindVars dvars
(tsKinds,tsNoKinds) = splitAt (length kparams) ts
tsKinds' = map sanitizeStars tsKinds
extraTys = drop (length tsNoKinds) (bndrParams dvars)
ts' = tsNoKinds ++ extraTys
in fmap (applySubstitution (Map.fromList (zip kparams tsKinds'))) $
repairVarKindsWith dvars dkind ts'
repairDataFam ::
Dec ->
Dec ->
Q Dec
repairDataFam
(FamilyD _ _ dvars dk)
(NewtypeInstD cx n ts con deriv) = do
ts' <- repairVarKindsWith' dvars dk ts
return $ NewtypeInstD cx n ts' con deriv
repairDataFam
(FamilyD _ _ dvars dk)
(DataInstD cx n ts cons deriv) = do
ts' <- repairVarKindsWith' dvars dk ts
return $ DataInstD cx n ts' cons deriv
#else
repairDataFam :: Dec -> Dec -> Q Dec
repairDataFam Dec
famD Dec
instD
# if MIN_VERSION_template_haskell(2,15,0)
| DataFamilyD Name
_ [TyVarBndrUnit]
dvars Maybe Type
dk <- Dec
famD
, NewtypeInstD Cxt
cx Maybe [TyVarBndrUnit]
mbInstVars Type
nts Maybe Type
k Con
c [DerivClause]
deriv <- Dec
instD
, Type
con :| Cxt
ts <- Type -> NonEmpty Type
decomposeType Type
nts
= do Cxt
ts' <- [TyVarBndrUnit] -> Maybe Type -> Cxt -> Q Cxt
repairVarKindsWith [TyVarBndrUnit]
dvars Maybe Type
dk Cxt
ts
Dec -> Q Dec
forall (m :: * -> *) a. Monad m => a -> m a
return (Dec -> Q Dec) -> Dec -> Q Dec
forall a b. (a -> b) -> a -> b
$ Cxt
-> Maybe [TyVarBndrUnit]
-> Type
-> Maybe Type
-> Con
-> [DerivClause]
-> Dec
NewtypeInstD Cxt
cx Maybe [TyVarBndrUnit]
mbInstVars ((Type -> Type -> Type) -> Type -> Cxt -> Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Type -> Type -> Type
AppT Type
con Cxt
ts') Maybe Type
k Con
c [DerivClause]
deriv
| DataFamilyD Name
_ [TyVarBndrUnit]
dvars Maybe Type
dk <- Dec
famD
, DataInstD Cxt
cx Maybe [TyVarBndrUnit]
mbInstVars Type
nts Maybe Type
k [Con]
c [DerivClause]
deriv <- Dec
instD
, Type
con :| Cxt
ts <- Type -> NonEmpty Type
decomposeType Type
nts
= do Cxt
ts' <- [TyVarBndrUnit] -> Maybe Type -> Cxt -> Q Cxt
repairVarKindsWith [TyVarBndrUnit]
dvars Maybe Type
dk Cxt
ts
Dec -> Q Dec
forall (m :: * -> *) a. Monad m => a -> m a
return (Dec -> Q Dec) -> Dec -> Q Dec
forall a b. (a -> b) -> a -> b
$ Cxt
-> Maybe [TyVarBndrUnit]
-> Type
-> Maybe Type
-> [Con]
-> [DerivClause]
-> Dec
DataInstD Cxt
cx Maybe [TyVarBndrUnit]
mbInstVars ((Type -> Type -> Type) -> Type -> Cxt -> Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Type -> Type -> Type
AppT Type
con Cxt
ts') Maybe Type
k [Con]
c [DerivClause]
deriv
# elif MIN_VERSION_template_haskell(2,11,0)
| DataFamilyD _ dvars dk <- famD
, NewtypeInstD cx n ts k c deriv <- instD
= do ts' <- repairVarKindsWith dvars dk ts
return $ NewtypeInstD cx n ts' k c deriv
| DataFamilyD _ dvars dk <- famD
, DataInstD cx n ts k c deriv <- instD
= do ts' <- repairVarKindsWith dvars dk ts
return $ DataInstD cx n ts' k c deriv
# else
| FamilyD _ _ dvars dk <- famD
, NewtypeInstD cx n ts c deriv <- instD
= do ts' <- repairVarKindsWith dvars dk ts
return $ NewtypeInstD cx n ts' c deriv
| FamilyD _ _ dvars dk <- famD
, DataInstD cx n ts c deriv <- instD
= do ts' <- repairVarKindsWith dvars dk ts
return $ DataInstD cx n ts' c deriv
# endif
#endif
repairDataFam Dec
_ Dec
instD = Dec -> Q Dec
forall (m :: * -> *) a. Monad m => a -> m a
return Dec
instD
repairVarKindsWith :: [TyVarBndrUnit] -> Maybe Kind -> [Type] -> Q [Type]
repairVarKindsWith :: [TyVarBndrUnit] -> Maybe Type -> Cxt -> Q Cxt
repairVarKindsWith [TyVarBndrUnit]
tvbs Maybe Type
mbKind Cxt
ts = do
[TyVarBndrUnit]
extra_tvbs <- Type -> Q [TyVarBndrUnit]
mkExtraKindBinders (Type -> Q [TyVarBndrUnit]) -> Type -> Q [TyVarBndrUnit]
forall a b. (a -> b) -> a -> b
$ Type -> Maybe Type -> Type
forall a. a -> Maybe a -> a
fromMaybe Type
starK Maybe Type
mbKind
let tvbs' :: [TyVarBndrUnit]
tvbs' = [TyVarBndrUnit]
tvbs [TyVarBndrUnit] -> [TyVarBndrUnit] -> [TyVarBndrUnit]
forall a. [a] -> [a] -> [a]
++ [TyVarBndrUnit]
extra_tvbs
Cxt -> Q Cxt
forall (m :: * -> *) a. Monad m => a -> m a
return (Cxt -> Q Cxt) -> Cxt -> Q Cxt
forall a b. (a -> b) -> a -> b
$ (TyVarBndrUnit -> Type -> Type) -> [TyVarBndrUnit] -> Cxt -> Cxt
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith TyVarBndrUnit -> Type -> Type
forall flag. TyVarBndrUnit -> Type -> Type
stealKindForType [TyVarBndrUnit]
tvbs' Cxt
ts
stealKindForType :: TyVarBndr_ flag -> Type -> Type
stealKindForType :: TyVarBndrUnit -> Type -> Type
stealKindForType TyVarBndrUnit
tvb t :: Type
t@VarT{} = Type -> Type -> Type
SigT Type
t (TyVarBndrUnit -> Type
forall flag. TyVarBndrUnit -> Type
tvKind TyVarBndrUnit
tvb)
stealKindForType TyVarBndrUnit
_ Type
t = Type
t
normalizeDec :: Dec -> Q DatatypeInfo
normalizeDec :: Dec -> Q DatatypeInfo
normalizeDec = Bool -> Dec -> Q DatatypeInfo
normalizeDecFor Bool
isn'tReified
normalizeDecFor :: IsReifiedDec -> Dec -> Q DatatypeInfo
normalizeDecFor :: Bool -> Dec -> Q DatatypeInfo
normalizeDecFor Bool
isReified Dec
dec =
case Dec
dec of
#if MIN_VERSION_template_haskell(2,12,0)
NewtypeD Cxt
context Name
name [TyVarBndrUnit]
tyvars Maybe Type
mbKind Con
con [DerivClause]
_derives ->
Cxt
-> Name
-> [TyVarBndrUnit]
-> Maybe Type
-> [Con]
-> DatatypeVariant
-> Q DatatypeInfo
normalizeDataD Cxt
context Name
name [TyVarBndrUnit]
tyvars Maybe Type
mbKind [Con
con] DatatypeVariant
Newtype
DataD Cxt
context Name
name [TyVarBndrUnit]
tyvars Maybe Type
mbKind [Con]
cons [DerivClause]
_derives ->
Cxt
-> Name
-> [TyVarBndrUnit]
-> Maybe Type
-> [Con]
-> DatatypeVariant
-> Q DatatypeInfo
normalizeDataD Cxt
context Name
name [TyVarBndrUnit]
tyvars Maybe Type
mbKind [Con]
cons DatatypeVariant
Datatype
# if MIN_VERSION_template_haskell(2,15,0)
NewtypeInstD Cxt
context Maybe [TyVarBndrUnit]
mbTyvars Type
nameInstTys Maybe Type
mbKind Con
con [DerivClause]
_derives ->
String
-> Cxt
-> Maybe [TyVarBndrUnit]
-> Type
-> Maybe Type
-> [Con]
-> DatatypeVariant
-> Q DatatypeInfo
normalizeDataInstDPostTH2'15 String
"newtype" Cxt
context Maybe [TyVarBndrUnit]
mbTyvars Type
nameInstTys
Maybe Type
mbKind [Con
con] DatatypeVariant
NewtypeInstance
DataInstD Cxt
context Maybe [TyVarBndrUnit]
mbTyvars Type
nameInstTys Maybe Type
mbKind [Con]
cons [DerivClause]
_derives ->
String
-> Cxt
-> Maybe [TyVarBndrUnit]
-> Type
-> Maybe Type
-> [Con]
-> DatatypeVariant
-> Q DatatypeInfo
normalizeDataInstDPostTH2'15 String
"data" Cxt
context Maybe [TyVarBndrUnit]
mbTyvars Type
nameInstTys
Maybe Type
mbKind [Con]
cons DatatypeVariant
DataInstance
# else
NewtypeInstD context name instTys mbKind con _derives ->
normalizeDataInstDPreTH2'15 context name instTys mbKind [con] NewtypeInstance
DataInstD context name instTys mbKind cons _derives ->
normalizeDataInstDPreTH2'15 context name instTys mbKind cons DataInstance
# endif
#elif MIN_VERSION_template_haskell(2,11,0)
NewtypeD context name tyvars mbKind con _derives ->
normalizeDataD context name tyvars mbKind [con] Newtype
DataD context name tyvars mbKind cons _derives ->
normalizeDataD context name tyvars mbKind cons Datatype
NewtypeInstD context name instTys mbKind con _derives ->
normalizeDataInstDPreTH2'15 context name instTys mbKind [con] NewtypeInstance
DataInstD context name instTys mbKind cons _derives ->
normalizeDataInstDPreTH2'15 context name instTys mbKind cons DataInstance
#else
NewtypeD context name tyvars con _derives ->
normalizeDataD context name tyvars Nothing [con] Newtype
DataD context name tyvars cons _derives ->
normalizeDataD context name tyvars Nothing cons Datatype
NewtypeInstD context name instTys con _derives ->
normalizeDataInstDPreTH2'15 context name instTys Nothing [con] NewtypeInstance
DataInstD context name instTys cons _derives ->
normalizeDataInstDPreTH2'15 context name instTys Nothing cons DataInstance
#endif
Dec
_ -> String -> Q DatatypeInfo
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"normalizeDecFor: DataD or NewtypeD required"
where
repair13618' :: DatatypeInfo -> Q DatatypeInfo
repair13618' :: DatatypeInfo -> Q DatatypeInfo
repair13618' di :: DatatypeInfo
di@DatatypeInfo{datatypeVariant :: DatatypeInfo -> DatatypeVariant
datatypeVariant = DatatypeVariant
variant}
| Bool
isReified Bool -> Bool -> Bool
&& DatatypeVariant -> Bool
isFamInstVariant DatatypeVariant
variant
= DatatypeInfo -> Q DatatypeInfo
repair13618 DatatypeInfo
di
| Bool
otherwise
= DatatypeInfo -> Q DatatypeInfo
forall (m :: * -> *) a. Monad m => a -> m a
return DatatypeInfo
di
datatypeFreeVars :: [Type] -> Maybe Kind -> [TyVarBndrUnit]
datatypeFreeVars :: Cxt -> Maybe Type -> [TyVarBndrUnit]
datatypeFreeVars Cxt
instTys Maybe Type
mbKind =
Cxt -> [TyVarBndrUnit]
freeVariablesWellScoped (Cxt -> [TyVarBndrUnit]) -> Cxt -> [TyVarBndrUnit]
forall a b. (a -> b) -> a -> b
$ Cxt
instTys Cxt -> Cxt -> Cxt
forall a. [a] -> [a] -> [a]
++
#if MIN_VERSION_template_haskell(2,8,0)
Maybe Type -> Cxt
forall a. Maybe a -> [a]
maybeToList Maybe Type
mbKind
#else
[]
#endif
normalizeDataD :: Cxt -> Name -> [TyVarBndrUnit] -> Maybe Kind
-> [Con] -> DatatypeVariant -> Q DatatypeInfo
normalizeDataD :: Cxt
-> Name
-> [TyVarBndrUnit]
-> Maybe Type
-> [Con]
-> DatatypeVariant
-> Q DatatypeInfo
normalizeDataD Cxt
context Name
name [TyVarBndrUnit]
tyvars Maybe Type
mbKind [Con]
cons DatatypeVariant
variant =
let params :: Cxt
params = [TyVarBndrUnit] -> Cxt
forall flag. [TyVarBndrUnit] -> Cxt
bndrParams [TyVarBndrUnit]
tyvars in
Cxt
-> Name
-> [TyVarBndrUnit]
-> Cxt
-> Maybe Type
-> [Con]
-> DatatypeVariant
-> Q DatatypeInfo
normalize' Cxt
context Name
name (Cxt -> Maybe Type -> [TyVarBndrUnit]
datatypeFreeVars Cxt
params Maybe Type
mbKind)
Cxt
params Maybe Type
mbKind [Con]
cons DatatypeVariant
variant
normalizeDataInstDPostTH2'15
:: String -> Cxt -> Maybe [TyVarBndrUnit] -> Type -> Maybe Kind
-> [Con] -> DatatypeVariant -> Q DatatypeInfo
normalizeDataInstDPostTH2'15 :: String
-> Cxt
-> Maybe [TyVarBndrUnit]
-> Type
-> Maybe Type
-> [Con]
-> DatatypeVariant
-> Q DatatypeInfo
normalizeDataInstDPostTH2'15 String
what Cxt
context Maybe [TyVarBndrUnit]
mbTyvars Type
nameInstTys
Maybe Type
mbKind [Con]
cons DatatypeVariant
variant =
case Type -> NonEmpty Type
decomposeType Type
nameInstTys of
ConT Name
name :| Cxt
instTys ->
Cxt
-> Name
-> [TyVarBndrUnit]
-> Cxt
-> Maybe Type
-> [Con]
-> DatatypeVariant
-> Q DatatypeInfo
normalize' Cxt
context Name
name
([TyVarBndrUnit] -> Maybe [TyVarBndrUnit] -> [TyVarBndrUnit]
forall a. a -> Maybe a -> a
fromMaybe (Cxt -> Maybe Type -> [TyVarBndrUnit]
datatypeFreeVars Cxt
instTys Maybe Type
mbKind) Maybe [TyVarBndrUnit]
mbTyvars)
Cxt
instTys Maybe Type
mbKind [Con]
cons DatatypeVariant
variant
NonEmpty Type
_ -> String -> Q DatatypeInfo
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q DatatypeInfo) -> String -> Q DatatypeInfo
forall a b. (a -> b) -> a -> b
$ String
"Unexpected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
what String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" instance head: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Ppr a => a -> String
pprint Type
nameInstTys
normalizeDataInstDPreTH2'15
:: Cxt -> Name -> [Type] -> Maybe Kind
-> [Con] -> DatatypeVariant -> Q DatatypeInfo
normalizeDataInstDPreTH2'15 :: Cxt
-> Name
-> Cxt
-> Maybe Type
-> [Con]
-> DatatypeVariant
-> Q DatatypeInfo
normalizeDataInstDPreTH2'15 Cxt
context Name
name Cxt
instTys Maybe Type
mbKind [Con]
cons DatatypeVariant
variant =
Cxt
-> Name
-> [TyVarBndrUnit]
-> Cxt
-> Maybe Type
-> [Con]
-> DatatypeVariant
-> Q DatatypeInfo
normalize' Cxt
context Name
name (Cxt -> Maybe Type -> [TyVarBndrUnit]
datatypeFreeVars Cxt
instTys Maybe Type
mbKind)
Cxt
instTys Maybe Type
mbKind [Con]
cons DatatypeVariant
variant
normalize' :: Cxt -> Name -> [TyVarBndrUnit] -> [Type] -> Maybe Kind
-> [Con] -> DatatypeVariant -> Q DatatypeInfo
normalize' :: Cxt
-> Name
-> [TyVarBndrUnit]
-> Cxt
-> Maybe Type
-> [Con]
-> DatatypeVariant
-> Q DatatypeInfo
normalize' Cxt
context Name
name [TyVarBndrUnit]
tvbs Cxt
instTys Maybe Type
mbKind [Con]
cons DatatypeVariant
variant = do
[TyVarBndrUnit]
extra_tvbs <- Type -> Q [TyVarBndrUnit]
mkExtraKindBinders (Type -> Q [TyVarBndrUnit]) -> Type -> Q [TyVarBndrUnit]
forall a b. (a -> b) -> a -> b
$ Type -> Maybe Type -> Type
forall a. a -> Maybe a -> a
fromMaybe Type
starK Maybe Type
mbKind
let tvbs' :: [TyVarBndrUnit]
tvbs' = [TyVarBndrUnit]
tvbs [TyVarBndrUnit] -> [TyVarBndrUnit] -> [TyVarBndrUnit]
forall a. [a] -> [a] -> [a]
++ [TyVarBndrUnit]
extra_tvbs
instTys' :: Cxt
instTys' = Cxt
instTys Cxt -> Cxt -> Cxt
forall a. [a] -> [a] -> [a]
++ [TyVarBndrUnit] -> Cxt
forall flag. [TyVarBndrUnit] -> Cxt
bndrParams [TyVarBndrUnit]
extra_tvbs
DatatypeInfo
dec <- Bool
-> Cxt
-> Name
-> [TyVarBndrUnit]
-> Cxt
-> [Con]
-> DatatypeVariant
-> Q DatatypeInfo
normalizeDec' Bool
isReified Cxt
context Name
name [TyVarBndrUnit]
tvbs' Cxt
instTys' [Con]
cons DatatypeVariant
variant
DatatypeInfo -> Q DatatypeInfo
repair13618' (DatatypeInfo -> Q DatatypeInfo) -> DatatypeInfo -> Q DatatypeInfo
forall a b. (a -> b) -> a -> b
$ Bool -> DatatypeInfo -> DatatypeInfo
giveDIVarsStarKinds Bool
isReified DatatypeInfo
dec
mkExtraKindBinders :: Kind -> Q [TyVarBndrUnit]
Type
kind = do
Type
kind' <- Type -> Q Type
resolveKindSynonyms Type
kind
let ([TyVarBndrUnit]
_, Cxt
_, Cxt
args :|- Type
_) = Type -> ([TyVarBndrUnit], Cxt, NonEmptySnoc Type)
uncurryKind Type
kind'
[Name]
names <- Int -> Q Name -> Q [Name]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Cxt -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Cxt
args) (String -> Q Name
newName String
"x")
[TyVarBndrUnit] -> Q [TyVarBndrUnit]
forall (m :: * -> *) a. Monad m => a -> m a
return ([TyVarBndrUnit] -> Q [TyVarBndrUnit])
-> [TyVarBndrUnit] -> Q [TyVarBndrUnit]
forall a b. (a -> b) -> a -> b
$ (Name -> Type -> TyVarBndrUnit) -> [Name] -> Cxt -> [TyVarBndrUnit]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Name -> Type -> TyVarBndrUnit
kindedTV [Name]
names Cxt
args
isFamInstVariant :: DatatypeVariant -> Bool
isFamInstVariant :: DatatypeVariant -> Bool
isFamInstVariant DatatypeVariant
dv =
case DatatypeVariant
dv of
DatatypeVariant
Datatype -> Bool
False
DatatypeVariant
Newtype -> Bool
False
DatatypeVariant
DataInstance -> Bool
True
DatatypeVariant
NewtypeInstance -> Bool
True
bndrParams :: [TyVarBndr_ flag] -> [Type]
bndrParams :: [TyVarBndrUnit] -> Cxt
bndrParams = (TyVarBndrUnit -> Type) -> [TyVarBndrUnit] -> Cxt
forall a b. (a -> b) -> [a] -> [b]
map ((TyVarBndrUnit -> Type) -> [TyVarBndrUnit] -> Cxt)
-> (TyVarBndrUnit -> Type) -> [TyVarBndrUnit] -> Cxt
forall a b. (a -> b) -> a -> b
$ (Name -> Type) -> (Name -> Type -> Type) -> TyVarBndrUnit -> Type
forall r flag.
(Name -> r) -> (Name -> Type -> r) -> TyVarBndrUnit -> r
elimTV Name -> Type
VarT (\Name
n Type
k -> Type -> Type -> Type
SigT (Name -> Type
VarT Name
n) Type
k)
stripSigT :: Type -> Type
stripSigT :: Type -> Type
stripSigT (SigT Type
t Type
_) = Type
t
stripSigT Type
t = Type
t
normalizeDec' ::
IsReifiedDec ->
Cxt ->
Name ->
[TyVarBndrUnit] ->
[Type] ->
[Con] ->
DatatypeVariant ->
Q DatatypeInfo
normalizeDec' :: Bool
-> Cxt
-> Name
-> [TyVarBndrUnit]
-> Cxt
-> [Con]
-> DatatypeVariant
-> Q DatatypeInfo
normalizeDec' Bool
reifiedDec Cxt
context Name
name [TyVarBndrUnit]
params Cxt
instTys [Con]
cons DatatypeVariant
variant =
do [ConstructorInfo]
cons' <- [[ConstructorInfo]] -> [ConstructorInfo]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ConstructorInfo]] -> [ConstructorInfo])
-> Q [[ConstructorInfo]] -> Q [ConstructorInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Con -> Q [ConstructorInfo]) -> [Con] -> Q [[ConstructorInfo]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool
-> Name
-> [TyVarBndrUnit]
-> Cxt
-> DatatypeVariant
-> Con
-> Q [ConstructorInfo]
normalizeConFor Bool
reifiedDec Name
name [TyVarBndrUnit]
params Cxt
instTys DatatypeVariant
variant) [Con]
cons
DatatypeInfo -> Q DatatypeInfo
forall (m :: * -> *) a. Monad m => a -> m a
return DatatypeInfo :: Cxt
-> Name
-> [TyVarBndrUnit]
-> Cxt
-> DatatypeVariant
-> [ConstructorInfo]
-> DatatypeInfo
DatatypeInfo
{ datatypeContext :: Cxt
datatypeContext = Cxt
context
, datatypeName :: Name
datatypeName = Name
name
, datatypeVars :: [TyVarBndrUnit]
datatypeVars = [TyVarBndrUnit]
params
, datatypeInstTypes :: Cxt
datatypeInstTypes = Cxt
instTys
, datatypeCons :: [ConstructorInfo]
datatypeCons = [ConstructorInfo]
cons'
, datatypeVariant :: DatatypeVariant
datatypeVariant = DatatypeVariant
variant
}
normalizeCon ::
Name ->
[TyVarBndrUnit] ->
[Type] ->
DatatypeVariant ->
Con ->
Q [ConstructorInfo]
normalizeCon :: Name
-> [TyVarBndrUnit]
-> Cxt
-> DatatypeVariant
-> Con
-> Q [ConstructorInfo]
normalizeCon = Bool
-> Name
-> [TyVarBndrUnit]
-> Cxt
-> DatatypeVariant
-> Con
-> Q [ConstructorInfo]
normalizeConFor Bool
isn'tReified
normalizeConFor ::
IsReifiedDec ->
Name ->
[TyVarBndrUnit] ->
[Type] ->
DatatypeVariant ->
Con ->
Q [ConstructorInfo]
normalizeConFor :: Bool
-> Name
-> [TyVarBndrUnit]
-> Cxt
-> DatatypeVariant
-> Con
-> Q [ConstructorInfo]
normalizeConFor Bool
reifiedDec Name
typename [TyVarBndrUnit]
params Cxt
instTys DatatypeVariant
variant =
([ConstructorInfo] -> [ConstructorInfo])
-> Q [ConstructorInfo] -> Q [ConstructorInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ConstructorInfo -> ConstructorInfo)
-> [ConstructorInfo] -> [ConstructorInfo]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> ConstructorInfo -> ConstructorInfo
giveCIVarsStarKinds Bool
reifiedDec)) (Q [ConstructorInfo] -> Q [ConstructorInfo])
-> (Con -> Q [ConstructorInfo]) -> Con -> Q [ConstructorInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Con -> Q [ConstructorInfo]
dispatch
where
checkGadtFixity :: [Type] -> Name -> Q ConstructorVariant
checkGadtFixity :: Cxt -> Name -> Q ConstructorVariant
checkGadtFixity Cxt
ts Name
n = do
#if MIN_VERSION_template_haskell(2,11,0)
Maybe Fixity
mbFi <- Maybe Fixity -> Q (Maybe Fixity)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Fixity
forall a. Maybe a
Nothing Q (Maybe Fixity) -> Q (Maybe Fixity) -> Q (Maybe Fixity)
forall a. Q a -> Q a -> Q a
`recover` Name -> Q (Maybe Fixity)
reifyFixity Name
n
let userSuppliedFixity :: Bool
userSuppliedFixity = Maybe Fixity -> Bool
forall a. Maybe a -> Bool
isJust Maybe Fixity
mbFi
#else
mbFi <- reifyFixityCompat n
let userSuppliedFixity = isJust mbFi && mbFi /= Just defaultFixity
#endif
ConstructorVariant -> Q ConstructorVariant
forall (m :: * -> *) a. Monad m => a -> m a
return (ConstructorVariant -> Q ConstructorVariant)
-> ConstructorVariant -> Q ConstructorVariant
forall a b. (a -> b) -> a -> b
$ if String -> Bool
isInfixDataCon (Name -> String
nameBase Name
n)
Bool -> Bool -> Bool
&& Cxt -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Cxt
ts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
Bool -> Bool -> Bool
&& Bool
userSuppliedFixity
then ConstructorVariant
InfixConstructor
else ConstructorVariant
NormalConstructor
isInfixDataCon :: String -> Bool
isInfixDataCon :: String -> Bool
isInfixDataCon (Char
':':String
_) = Bool
True
isInfixDataCon String
_ = Bool
False
dispatch :: Con -> Q [ConstructorInfo]
dispatch :: Con -> Q [ConstructorInfo]
dispatch =
let defaultCase :: Con -> Q [ConstructorInfo]
defaultCase :: Con -> Q [ConstructorInfo]
defaultCase = [TyVarBndrUnit] -> Cxt -> Bool -> Con -> Q [ConstructorInfo]
go [] [] Bool
False
where
go :: [TyVarBndrUnit]
-> Cxt
-> Bool
-> Con
-> Q [ConstructorInfo]
go :: [TyVarBndrUnit] -> Cxt -> Bool -> Con -> Q [ConstructorInfo]
go [TyVarBndrUnit]
tyvars Cxt
context Bool
gadt Con
c =
case Con
c of
NormalC Name
n [BangType]
xs -> do
let ([Bang]
bangs, Cxt
ts) = [BangType] -> ([Bang], Cxt)
forall a b. [(a, b)] -> ([a], [b])
unzip [BangType]
xs
stricts :: [FieldStrictness]
stricts = (Bang -> FieldStrictness) -> [Bang] -> [FieldStrictness]
forall a b. (a -> b) -> [a] -> [b]
map Bang -> FieldStrictness
normalizeStrictness [Bang]
bangs
ConstructorVariant
fi <- if Bool
gadt
then Cxt -> Name -> Q ConstructorVariant
checkGadtFixity Cxt
ts Name
n
else ConstructorVariant -> Q ConstructorVariant
forall (m :: * -> *) a. Monad m => a -> m a
return ConstructorVariant
NormalConstructor
[ConstructorInfo] -> Q [ConstructorInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return [Name
-> [TyVarBndrUnit]
-> Cxt
-> Cxt
-> [FieldStrictness]
-> ConstructorVariant
-> ConstructorInfo
ConstructorInfo Name
n [TyVarBndrUnit]
tyvars Cxt
context Cxt
ts [FieldStrictness]
stricts ConstructorVariant
fi]
InfixC BangType
l Name
n BangType
r ->
let ([Bang]
bangs, Cxt
ts) = [BangType] -> ([Bang], Cxt)
forall a b. [(a, b)] -> ([a], [b])
unzip [BangType
l,BangType
r]
stricts :: [FieldStrictness]
stricts = (Bang -> FieldStrictness) -> [Bang] -> [FieldStrictness]
forall a b. (a -> b) -> [a] -> [b]
map Bang -> FieldStrictness
normalizeStrictness [Bang]
bangs in
[ConstructorInfo] -> Q [ConstructorInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return [Name
-> [TyVarBndrUnit]
-> Cxt
-> Cxt
-> [FieldStrictness]
-> ConstructorVariant
-> ConstructorInfo
ConstructorInfo Name
n [TyVarBndrUnit]
tyvars Cxt
context Cxt
ts [FieldStrictness]
stricts
ConstructorVariant
InfixConstructor]
RecC Name
n [VarBangType]
xs ->
let fns :: [Name]
fns = [VarBangType] -> [Name]
forall a b. [(Name, a, b)] -> [Name]
takeFieldNames [VarBangType]
xs
stricts :: [FieldStrictness]
stricts = [VarBangType] -> [FieldStrictness]
forall a b. [(a, Bang, b)] -> [FieldStrictness]
takeFieldStrictness [VarBangType]
xs in
[ConstructorInfo] -> Q [ConstructorInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return [Name
-> [TyVarBndrUnit]
-> Cxt
-> Cxt
-> [FieldStrictness]
-> ConstructorVariant
-> ConstructorInfo
ConstructorInfo Name
n [TyVarBndrUnit]
tyvars Cxt
context
([VarBangType] -> Cxt
forall a b. [(a, b, Type)] -> Cxt
takeFieldTypes [VarBangType]
xs) [FieldStrictness]
stricts ([Name] -> ConstructorVariant
RecordConstructor [Name]
fns)]
ForallC [TyVarBndrUnit]
tyvars' Cxt
context' Con
c' ->
[TyVarBndrUnit] -> Cxt -> Bool -> Con -> Q [ConstructorInfo]
go (() -> [TyVarBndrUnit] -> [TyVarBndrUnit]
forall newFlag oldFlag.
newFlag -> [TyVarBndrUnit] -> [TyVarBndrUnit]
changeTVFlags () [TyVarBndrUnit]
tyvars'[TyVarBndrUnit] -> [TyVarBndrUnit] -> [TyVarBndrUnit]
forall a. [a] -> [a] -> [a]
++[TyVarBndrUnit]
tyvars) (Cxt
context'Cxt -> Cxt -> Cxt
forall a. [a] -> [a] -> [a]
++Cxt
context) Bool
True Con
c'
#if MIN_VERSION_template_haskell(2,11,0)
GadtC [Name]
ns [BangType]
xs Type
innerType ->
let ([Bang]
bangs, Cxt
ts) = [BangType] -> ([Bang], Cxt)
forall a b. [(a, b)] -> ([a], [b])
unzip [BangType]
xs
stricts :: [FieldStrictness]
stricts = (Bang -> FieldStrictness) -> [Bang] -> [FieldStrictness]
forall a b. (a -> b) -> [a] -> [b]
map Bang -> FieldStrictness
normalizeStrictness [Bang]
bangs in
[Name]
-> Type
-> Cxt
-> [FieldStrictness]
-> (Name -> Q ConstructorVariant)
-> Q [ConstructorInfo]
gadtCase [Name]
ns Type
innerType Cxt
ts [FieldStrictness]
stricts (Cxt -> Name -> Q ConstructorVariant
checkGadtFixity Cxt
ts)
RecGadtC [Name]
ns [VarBangType]
xs Type
innerType ->
let fns :: [Name]
fns = [VarBangType] -> [Name]
forall a b. [(Name, a, b)] -> [Name]
takeFieldNames [VarBangType]
xs
stricts :: [FieldStrictness]
stricts = [VarBangType] -> [FieldStrictness]
forall a b. [(a, Bang, b)] -> [FieldStrictness]
takeFieldStrictness [VarBangType]
xs in
[Name]
-> Type
-> Cxt
-> [FieldStrictness]
-> (Name -> Q ConstructorVariant)
-> Q [ConstructorInfo]
gadtCase [Name]
ns Type
innerType ([VarBangType] -> Cxt
forall a b. [(a, b, Type)] -> Cxt
takeFieldTypes [VarBangType]
xs) [FieldStrictness]
stricts
(Q ConstructorVariant -> Name -> Q ConstructorVariant
forall a b. a -> b -> a
const (Q ConstructorVariant -> Name -> Q ConstructorVariant)
-> Q ConstructorVariant -> Name -> Q ConstructorVariant
forall a b. (a -> b) -> a -> b
$ ConstructorVariant -> Q ConstructorVariant
forall (m :: * -> *) a. Monad m => a -> m a
return (ConstructorVariant -> Q ConstructorVariant)
-> ConstructorVariant -> Q ConstructorVariant
forall a b. (a -> b) -> a -> b
$ [Name] -> ConstructorVariant
RecordConstructor [Name]
fns)
where
gadtCase :: [Name]
-> Type
-> Cxt
-> [FieldStrictness]
-> (Name -> Q ConstructorVariant)
-> Q [ConstructorInfo]
gadtCase = Name
-> [TyVarBndrUnit]
-> Cxt
-> [TyVarBndrUnit]
-> Cxt
-> [Name]
-> Type
-> Cxt
-> [FieldStrictness]
-> (Name -> Q ConstructorVariant)
-> Q [ConstructorInfo]
normalizeGadtC Name
typename [TyVarBndrUnit]
params Cxt
instTys [TyVarBndrUnit]
tyvars Cxt
context
#endif
#if MIN_VERSION_template_haskell(2,8,0) && (!MIN_VERSION_template_haskell(2,10,0))
dataFamCompatCase :: Con -> Q [ConstructorInfo]
dataFamCompatCase = go []
where
go tyvars c =
case c of
NormalC n xs ->
let stricts = map (normalizeStrictness . fst) xs in
dataFamCase' n stricts NormalConstructor
InfixC l n r ->
let stricts = map (normalizeStrictness . fst) [l,r] in
dataFamCase' n stricts InfixConstructor
RecC n xs ->
let stricts = takeFieldStrictness xs in
dataFamCase' n stricts
(RecordConstructor (takeFieldNames xs))
ForallC tyvars' context' c' ->
go (tyvars'++tyvars) c'
dataFamCase' :: Name -> [FieldStrictness]
-> ConstructorVariant
-> Q [ConstructorInfo]
dataFamCase' n stricts variant = do
mbInfo <- reifyMaybe n
case mbInfo of
Just (DataConI _ ty _ _) -> do
let (tyvars, context, argTys :|- returnTy) = uncurryType ty
returnTy' <- resolveTypeSynonyms returnTy
normalizeGadtC typename params instTys tyvars context [n]
returnTy' argTys stricts (const $ return variant)
_ -> fail $ unlines
[ "normalizeCon: Cannot reify constructor " ++ nameBase n
, "You are likely calling normalizeDec on GHC 7.6 or 7.8 on a data family"
, "whose type variables have been eta-reduced due to GHC Trac #9692."
, "Unfortunately, without being able to reify the constructor's type,"
, "there is no way to recover the eta-reduced type variables in general."
, "A recommended workaround is to use reifyDatatype instead."
]
mightHaveBeenEtaReduced :: [Type] -> Bool
mightHaveBeenEtaReduced ts =
case unsnoc ts of
Nothing -> False
Just (initTs :|- lastT) ->
case varTName lastT of
Nothing -> False
Just n -> not (n `elem` freeVariables initTs)
unsnoc :: [a] -> Maybe (NonEmptySnoc a)
unsnoc [] = Nothing
unsnoc (x:xs) = case unsnoc xs of
Just (a :|- b) -> Just ((x:a) :|- b)
Nothing -> Just ([] :|- x)
varTName :: Type -> Maybe Name
varTName (SigT t _) = varTName t
varTName (VarT n) = Just n
varTName _ = Nothing
in case variant of
DataInstance
| reifiedDec, mightHaveBeenEtaReduced instTys
-> dataFamCompatCase
NewtypeInstance
| reifiedDec, mightHaveBeenEtaReduced instTys
-> dataFamCompatCase
_ -> defaultCase
#else
in Con -> Q [ConstructorInfo]
defaultCase
#endif
#if MIN_VERSION_template_haskell(2,11,0)
normalizeStrictness :: Bang -> FieldStrictness
normalizeStrictness :: Bang -> FieldStrictness
normalizeStrictness (Bang SourceUnpackedness
upk SourceStrictness
str) =
Unpackedness -> Strictness -> FieldStrictness
FieldStrictness (SourceUnpackedness -> Unpackedness
normalizeSourceUnpackedness SourceUnpackedness
upk)
(SourceStrictness -> Strictness
normalizeSourceStrictness SourceStrictness
str)
where
normalizeSourceUnpackedness :: SourceUnpackedness -> Unpackedness
normalizeSourceUnpackedness :: SourceUnpackedness -> Unpackedness
normalizeSourceUnpackedness SourceUnpackedness
NoSourceUnpackedness = Unpackedness
UnspecifiedUnpackedness
normalizeSourceUnpackedness SourceUnpackedness
SourceNoUnpack = Unpackedness
NoUnpack
normalizeSourceUnpackedness SourceUnpackedness
SourceUnpack = Unpackedness
Unpack
normalizeSourceStrictness :: SourceStrictness -> Strictness
normalizeSourceStrictness :: SourceStrictness -> Strictness
normalizeSourceStrictness SourceStrictness
NoSourceStrictness = Strictness
UnspecifiedStrictness
normalizeSourceStrictness SourceStrictness
SourceLazy = Strictness
Lazy
normalizeSourceStrictness SourceStrictness
SourceStrict = Strictness
Strict
#else
normalizeStrictness :: Strict -> FieldStrictness
normalizeStrictness IsStrict = isStrictAnnot
normalizeStrictness NotStrict = notStrictAnnot
# if MIN_VERSION_template_haskell(2,7,0)
normalizeStrictness Unpacked = unpackedAnnot
# endif
#endif
normalizeGadtC ::
Name ->
[TyVarBndrUnit] ->
[Type] ->
[TyVarBndrUnit] ->
Cxt ->
[Name] ->
Type ->
[Type] ->
[FieldStrictness] ->
(Name -> Q ConstructorVariant)
->
Q [ConstructorInfo]
normalizeGadtC :: Name
-> [TyVarBndrUnit]
-> Cxt
-> [TyVarBndrUnit]
-> Cxt
-> [Name]
-> Type
-> Cxt
-> [FieldStrictness]
-> (Name -> Q ConstructorVariant)
-> Q [ConstructorInfo]
normalizeGadtC Name
typename [TyVarBndrUnit]
params Cxt
instTys [TyVarBndrUnit]
tyvars Cxt
context [Name]
names Type
innerType
Cxt
fields [FieldStrictness]
stricts Name -> Q ConstructorVariant
getVariant =
do
let implicitTyvars :: [TyVarBndrUnit]
implicitTyvars = Cxt -> [TyVarBndrUnit]
freeVariablesWellScoped
[[TyVarBndrUnit] -> Cxt -> Cxt -> Type -> Type
curryType (Specificity -> [TyVarBndrUnit] -> [TyVarBndrUnit]
forall newFlag oldFlag.
newFlag -> [TyVarBndrUnit] -> [TyVarBndrUnit]
changeTVFlags Specificity
SpecifiedSpec [TyVarBndrUnit]
tyvars)
Cxt
context Cxt
fields Type
innerType]
allTyvars :: [TyVarBndrUnit]
allTyvars = [TyVarBndrUnit]
implicitTyvars [TyVarBndrUnit] -> [TyVarBndrUnit] -> [TyVarBndrUnit]
forall a. [a] -> [a] -> [a]
++ [TyVarBndrUnit]
tyvars
let conBoundNames :: [Name]
conBoundNames =
(TyVarBndrUnit -> [Name]) -> [TyVarBndrUnit] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\TyVarBndrUnit
tvb -> TyVarBndrUnit -> Name
forall flag. TyVarBndrUnit -> Name
tvName TyVarBndrUnit
tvbName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:Type -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables (TyVarBndrUnit -> Type
forall flag. TyVarBndrUnit -> Type
tvKind TyVarBndrUnit
tvb)) [TyVarBndrUnit]
allTyvars
Map Name Name
conSubst <- Map Name (Q Name) -> Q (Map Name Name)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
T.sequence (Map Name (Q Name) -> Q (Map Name Name))
-> Map Name (Q Name) -> Q (Map Name Name)
forall a b. (a -> b) -> a -> b
$ [(Name, Q Name)] -> Map Name (Q Name)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (Name
n, String -> Q Name
newName (Name -> String
nameBase Name
n))
| Name
n <- [Name]
conBoundNames ]
let conSubst' :: Map Name Type
conSubst' = (Name -> Type) -> Map Name Name -> Map Name Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> Type
VarT Map Name Name
conSubst
renamedTyvars :: [TyVarBndrUnit]
renamedTyvars =
(TyVarBndrUnit -> TyVarBndrUnit)
-> [TyVarBndrUnit] -> [TyVarBndrUnit]
forall a b. (a -> b) -> [a] -> [b]
map ((Name -> TyVarBndrUnit)
-> (Name -> Type -> TyVarBndrUnit)
-> TyVarBndrUnit
-> TyVarBndrUnit
forall r flag.
(Name -> r) -> (Name -> Type -> r) -> TyVarBndrUnit -> r
elimTV (\Name
n -> Name -> TyVarBndrUnit
plainTV (Map Name Name
conSubst Map Name Name -> Name -> Name
forall k a. Ord k => Map k a -> k -> a
Map.! Name
n))
(\Name
n Type
k -> Name -> Type -> TyVarBndrUnit
kindedTV (Map Name Name
conSubst Map Name Name -> Name -> Name
forall k a. Ord k => Map k a -> k -> a
Map.! Name
n)
(Map Name Type -> Type -> Type
forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
conSubst' Type
k))) [TyVarBndrUnit]
allTyvars
renamedContext :: Cxt
renamedContext = Map Name Type -> Cxt -> Cxt
forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
conSubst' Cxt
context
renamedInnerType :: Type
renamedInnerType = Map Name Type -> Type -> Type
forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
conSubst' Type
innerType
renamedFields :: Cxt
renamedFields = Map Name Type -> Cxt -> Cxt
forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
conSubst' Cxt
fields
Type
innerType' <- Type -> Q Type
resolveTypeSynonyms Type
renamedInnerType
case Type -> NonEmpty Type
decomposeType Type
innerType' of
ConT Name
innerTyCon :| Cxt
ts | Name
typename Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
innerTyCon ->
let (Map Name Name
substName, Cxt
context1) =
Map Name Type
-> Map Name Type -> (Map Name Name, Cxt) -> (Map Name Name, Cxt)
closeOverKinds ([TyVarBndrUnit] -> Map Name Type
forall flag. [TyVarBndrUnit] -> Map Name Type
kindsOfFVsOfTvbs [TyVarBndrUnit]
renamedTyvars)
([TyVarBndrUnit] -> Map Name Type
forall flag. [TyVarBndrUnit] -> Map Name Type
kindsOfFVsOfTvbs [TyVarBndrUnit]
params)
(Cxt -> Cxt -> (Map Name Name, Cxt)
mergeArguments Cxt
instTys Cxt
ts)
subst :: Map Name Type
subst = Name -> Type
VarT (Name -> Type) -> Map Name Name -> Map Name Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Name Name
substName
exTyvars :: [TyVarBndrUnit]
exTyvars = [ TyVarBndrUnit
tv | TyVarBndrUnit
tv <- [TyVarBndrUnit]
renamedTyvars, Name -> Map Name Type -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.notMember (TyVarBndrUnit -> Name
forall flag. TyVarBndrUnit -> Name
tvName TyVarBndrUnit
tv) Map Name Type
subst ]
exTyvars' :: [TyVarBndrUnit]
exTyvars' = Map Name Type -> [TyVarBndrUnit] -> [TyVarBndrUnit]
forall flag. Map Name Type -> [TyVarBndrUnit] -> [TyVarBndrUnit]
substTyVarBndrKinds Map Name Type
subst [TyVarBndrUnit]
exTyvars
context2 :: Cxt
context2 = Map Name Type -> Cxt -> Cxt
forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
subst (Cxt
context1 Cxt -> Cxt -> Cxt
forall a. [a] -> [a] -> [a]
++ Cxt
renamedContext)
fields' :: Cxt
fields' = Map Name Type -> Cxt -> Cxt
forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
subst Cxt
renamedFields
in [Q ConstructorInfo] -> Q [ConstructorInfo]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ Name
-> [TyVarBndrUnit]
-> Cxt
-> Cxt
-> [FieldStrictness]
-> ConstructorVariant
-> ConstructorInfo
ConstructorInfo Name
name [TyVarBndrUnit]
forall flag. [TyVarBndrUnit]
exTyvars' Cxt
context2
Cxt
fields' [FieldStrictness]
stricts (ConstructorVariant -> ConstructorInfo)
-> Q ConstructorVariant -> Q ConstructorInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q ConstructorVariant
variantQ
| Name
name <- [Name]
names
, let variantQ :: Q ConstructorVariant
variantQ = Name -> Q ConstructorVariant
getVariant Name
name
]
NonEmpty Type
_ -> String -> Q [ConstructorInfo]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"normalizeGadtC: Expected type constructor application"
closeOverKinds :: Map Name Kind
-> Map Name Kind
-> (Map Name Name, Cxt)
-> (Map Name Name, Cxt)
closeOverKinds :: Map Name Type
-> Map Name Type -> (Map Name Name, Cxt) -> (Map Name Name, Cxt)
closeOverKinds Map Name Type
domainFVKinds Map Name Type
rangeFVKinds = (Map Name Name, Cxt) -> (Map Name Name, Cxt)
go
where
go :: (Map Name Name, Cxt) -> (Map Name Name, Cxt)
go :: (Map Name Name, Cxt) -> (Map Name Name, Cxt)
go (Map Name Name
subst, Cxt
context) =
let substList :: [(Name, Name)]
substList = Map Name Name -> [(Name, Name)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Name Name
subst
(Cxt
kindsInner, Cxt
kindsOuter) =
[(Type, Type)] -> (Cxt, Cxt)
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Type, Type)] -> (Cxt, Cxt)) -> [(Type, Type)] -> (Cxt, Cxt)
forall a b. (a -> b) -> a -> b
$
((Name, Name) -> Maybe (Type, Type))
-> [(Name, Name)] -> [(Type, Type)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Name
d, Name
r) -> do Type
d' <- Name -> Map Name Type -> Maybe Type
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
d Map Name Type
domainFVKinds
Type
r' <- Name -> Map Name Type -> Maybe Type
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
r Map Name Type
rangeFVKinds
(Type, Type) -> Maybe (Type, Type)
forall (m :: * -> *) a. Monad m => a -> m a
return (Type
d', Type
r'))
[(Name, Name)]
substList
(Map Name Name
kindSubst, Cxt
kindContext) = Cxt -> Cxt -> (Map Name Name, Cxt)
mergeArgumentKinds Cxt
kindsOuter Cxt
kindsInner
(Map Name Name
restSubst, Cxt
restContext)
= if Map Name Name -> Bool
forall k a. Map k a -> Bool
Map.null Map Name Name
kindSubst
then (Map Name Name
forall k a. Map k a
Map.empty, [])
else (Map Name Name, Cxt) -> (Map Name Name, Cxt)
go (Map Name Name
kindSubst, Cxt
kindContext)
finalSubst :: Map Name Name
finalSubst = [Map Name Name] -> Map Name Name
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions [Map Name Name
subst, Map Name Name
kindSubst, Map Name Name
restSubst]
finalContext :: Cxt
finalContext = Cxt -> Cxt
forall a. Eq a => [a] -> [a]
nub (Cxt -> Cxt) -> Cxt -> Cxt
forall a b. (a -> b) -> a -> b
$ [Cxt] -> Cxt
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Cxt
context, Cxt
kindContext, Cxt
restContext]
in (Map Name Name
finalSubst, Cxt
finalContext)
kindsOfFVsOfTypes :: [Type] -> Map Name Kind
kindsOfFVsOfTypes :: Cxt -> Map Name Type
kindsOfFVsOfTypes = (Type -> Map Name Type) -> Cxt -> Map Name Type
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Type -> Map Name Type
go
where
go :: Type -> Map Name Kind
go :: Type -> Map Name Type
go (AppT Type
t1 Type
t2) = Type -> Map Name Type
go Type
t1 Map Name Type -> Map Name Type -> Map Name Type
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Type -> Map Name Type
go Type
t2
go (SigT Type
t Type
k) =
let kSigs :: Map Name Type
kSigs =
#if MIN_VERSION_template_haskell(2,8,0)
Type -> Map Name Type
go Type
k
#else
Map.empty
#endif
in case Type
t of
VarT Name
n -> Name -> Type -> Map Name Type -> Map Name Type
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
n Type
k Map Name Type
kSigs
Type
_ -> Type -> Map Name Type
go Type
t Map Name Type -> Map Name Type -> Map Name Type
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Map Name Type
kSigs
go (ForallT {}) = Map Name Type
forall a. a
forallError
#if MIN_VERSION_template_haskell(2,16,0)
go (ForallVisT {}) = Map Name Type
forall a. a
forallError
#endif
go Type
_ = Map Name Type
forall k a. Map k a
Map.empty
forallError :: a
forallError :: a
forallError = String -> a
forall a. HasCallStack => String -> a
error String
"`forall` type used in data family pattern"
kindsOfFVsOfTvbs :: [TyVarBndr_ flag] -> Map Name Kind
kindsOfFVsOfTvbs :: [TyVarBndrUnit] -> Map Name Type
kindsOfFVsOfTvbs = (TyVarBndrUnit -> Map Name Type)
-> [TyVarBndrUnit] -> Map Name Type
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TyVarBndrUnit -> Map Name Type
forall flag. TyVarBndrUnit -> Map Name Type
go
where
go :: TyVarBndr_ flag -> Map Name Kind
go :: TyVarBndrUnit -> Map Name Type
go = (Name -> Map Name Type)
-> (Name -> Type -> Map Name Type)
-> TyVarBndrUnit
-> Map Name Type
forall r flag.
(Name -> r) -> (Name -> Type -> r) -> TyVarBndrUnit -> r
elimTV (\Name
n -> Name -> Type -> Map Name Type
forall k a. k -> a -> Map k a
Map.singleton Name
n Type
starK)
(\Name
n Type
k -> let kSigs :: Map Name Type
kSigs =
#if MIN_VERSION_template_haskell(2,8,0)
Cxt -> Map Name Type
kindsOfFVsOfTypes [Type
k]
#else
Map.empty
#endif
in Name -> Type -> Map Name Type -> Map Name Type
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
n Type
k Map Name Type
kSigs)
mergeArguments ::
[Type] ->
[Type] ->
(Map Name Name, Cxt)
mergeArguments :: Cxt -> Cxt -> (Map Name Name, Cxt)
mergeArguments Cxt
ns Cxt
ts = ((Type, Type) -> (Map Name Name, Cxt) -> (Map Name Name, Cxt))
-> (Map Name Name, Cxt) -> [(Type, Type)] -> (Map Name Name, Cxt)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Type, Type) -> (Map Name Name, Cxt) -> (Map Name Name, Cxt)
aux (Map Name Name
forall k a. Map k a
Map.empty, []) (Cxt -> Cxt -> [(Type, Type)]
forall a b. [a] -> [b] -> [(a, b)]
zip Cxt
ns Cxt
ts)
where
aux :: (Type, Type) -> (Map Name Name, Cxt) -> (Map Name Name, Cxt)
aux (Type
f `AppT` Type
x, Type
g `AppT` Type
y) (Map Name Name, Cxt)
sc =
(Type, Type) -> (Map Name Name, Cxt) -> (Map Name Name, Cxt)
aux (Type
x,Type
y) ((Type, Type) -> (Map Name Name, Cxt) -> (Map Name Name, Cxt)
aux (Type
f,Type
g) (Map Name Name, Cxt)
sc)
aux (VarT Name
n,Type
p) (Map Name Name
subst, Cxt
context) =
case Type
p of
VarT Name
m | Name
m Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n -> (Map Name Name
subst, Cxt
context)
| Just Name
n' <- Name -> Map Name Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
m Map Name Name
subst
, Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n' -> (Map Name Name
subst, Cxt
context)
| Name -> Map Name Name -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.notMember Name
m Map Name Name
subst -> (Name -> Name -> Map Name Name -> Map Name Name
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
m Name
n Map Name Name
subst, Cxt
context)
Type
_ -> (Map Name Name
subst, Type -> Type -> Type
equalPred (Name -> Type
VarT Name
n) Type
p Type -> Cxt -> Cxt
forall a. a -> [a] -> [a]
: Cxt
context)
aux (SigT Type
x Type
_, Type
y) (Map Name Name, Cxt)
sc = (Type, Type) -> (Map Name Name, Cxt) -> (Map Name Name, Cxt)
aux (Type
x,Type
y) (Map Name Name, Cxt)
sc
aux (Type
x, SigT Type
y Type
_) (Map Name Name, Cxt)
sc = (Type, Type) -> (Map Name Name, Cxt) -> (Map Name Name, Cxt)
aux (Type
x,Type
y) (Map Name Name, Cxt)
sc
aux (Type, Type)
_ (Map Name Name, Cxt)
sc = (Map Name Name, Cxt)
sc
mergeArgumentKinds ::
[Kind] ->
[Kind] ->
(Map Name Name, Cxt)
#if MIN_VERSION_template_haskell(2,8,0)
mergeArgumentKinds :: Cxt -> Cxt -> (Map Name Name, Cxt)
mergeArgumentKinds = Cxt -> Cxt -> (Map Name Name, Cxt)
mergeArguments
#else
mergeArgumentKinds _ _ = (Map.empty, [])
#endif
resolveTypeSynonyms :: Type -> Q Type
resolveTypeSynonyms :: Type -> Q Type
resolveTypeSynonyms Type
t =
let (Type
f, [TypeArg]
xs) = Type -> (Type, [TypeArg])
decomposeTypeArgs Type
t
normal_xs :: Cxt
normal_xs = [TypeArg] -> Cxt
filterTANormals [TypeArg]
xs
defaultCase :: Type -> Q Type
defaultCase :: Type -> Q Type
defaultCase Type
ty = (Type -> TypeArg -> Type) -> Type -> [TypeArg] -> Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> TypeArg -> Type
appTypeArg Type
ty ([TypeArg] -> Type) -> Q [TypeArg] -> Q Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TypeArg -> Q TypeArg) -> [TypeArg] -> Q [TypeArg]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TypeArg -> Q TypeArg
resolveTypeArgSynonyms [TypeArg]
xs
expandCon :: Name
-> Type
-> Q Type
expandCon :: Name -> Type -> Q Type
expandCon Name
n Type
ty = do
Maybe Info
mbInfo <- Name -> Q (Maybe Info)
reifyMaybe Name
n
case Maybe Info
mbInfo of
Just (TyConI (TySynD Name
_ [TyVarBndrUnit]
synvars Type
def))
| Cxt -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Cxt
normal_xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [TyVarBndrUnit] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TyVarBndrUnit]
synvars
-> Type -> Q Type
resolveTypeSynonyms (Type -> Q Type) -> Type -> Q Type
forall a b. (a -> b) -> a -> b
$ [TyVarBndrUnit] -> Cxt -> Type -> Type
forall flag. [TyVarBndrUnit] -> Cxt -> Type -> Type
expandSynonymRHS [TyVarBndrUnit]
synvars Cxt
normal_xs Type
def
Maybe Info
_ -> Type -> Q Type
defaultCase Type
ty
in case Type
f of
ForallT [TyVarBndrUnit]
tvbs Cxt
ctxt Type
body ->
[TyVarBndrUnit] -> Cxt -> Type -> Type
ForallT ([TyVarBndrUnit] -> Cxt -> Type -> Type)
-> Q [TyVarBndrUnit] -> Q (Cxt -> Type -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (TyVarBndrUnit -> Q TyVarBndrUnit)
-> [TyVarBndrUnit] -> Q [TyVarBndrUnit]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TyVarBndrUnit -> Q TyVarBndrUnit
forall flag. TyVarBndrUnit -> Q TyVarBndrUnit
resolve_tvb_syns [TyVarBndrUnit]
tvbs
Q (Cxt -> Type -> Type) -> Q Cxt -> Q (Type -> Type)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` (Type -> Q Type) -> Cxt -> Q Cxt
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type -> Q Type
resolvePredSynonyms Cxt
ctxt
Q (Type -> Type) -> Q Type -> Q Type
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` Type -> Q Type
resolveTypeSynonyms Type
body
SigT Type
ty Type
ki -> do
Type
ty' <- Type -> Q Type
resolveTypeSynonyms Type
ty
Type
ki' <- Type -> Q Type
resolveKindSynonyms Type
ki
Type -> Q Type
defaultCase (Type -> Q Type) -> Type -> Q Type
forall a b. (a -> b) -> a -> b
$ Type -> Type -> Type
SigT Type
ty' Type
ki'
ConT Name
n -> Name -> Type -> Q Type
expandCon Name
n Type
f
#if MIN_VERSION_template_haskell(2,11,0)
InfixT Type
t1 Name
n Type
t2 -> do
Type
t1' <- Type -> Q Type
resolveTypeSynonyms Type
t1
Type
t2' <- Type -> Q Type
resolveTypeSynonyms Type
t2
Name -> Type -> Q Type
expandCon Name
n (Type -> Name -> Type -> Type
InfixT Type
t1' Name
n Type
t2')
UInfixT Type
t1 Name
n Type
t2 -> do
Type
t1' <- Type -> Q Type
resolveTypeSynonyms Type
t1
Type
t2' <- Type -> Q Type
resolveTypeSynonyms Type
t2
Name -> Type -> Q Type
expandCon Name
n (Type -> Name -> Type -> Type
UInfixT Type
t1' Name
n Type
t2')
#endif
#if MIN_VERSION_template_haskell(2,15,0)
ImplicitParamT String
n Type
t -> do
String -> Type -> Type
ImplicitParamT String
n (Type -> Type) -> Q Type -> Q Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Q Type
resolveTypeSynonyms Type
t
#endif
#if MIN_VERSION_template_haskell(2,16,0)
ForallVisT [TyVarBndrUnit]
tvbs Type
body ->
[TyVarBndrUnit] -> Type -> Type
ForallVisT ([TyVarBndrUnit] -> Type -> Type)
-> Q [TyVarBndrUnit] -> Q (Type -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (TyVarBndrUnit -> Q TyVarBndrUnit)
-> [TyVarBndrUnit] -> Q [TyVarBndrUnit]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TyVarBndrUnit -> Q TyVarBndrUnit
forall flag. TyVarBndrUnit -> Q TyVarBndrUnit
resolve_tvb_syns [TyVarBndrUnit]
tvbs
Q (Type -> Type) -> Q Type -> Q Type
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` Type -> Q Type
resolveTypeSynonyms Type
body
#endif
#if MIN_VERSION_template_haskell(2,19,0)
PromotedInfixT t1 n t2 -> do
t1' <- resolveTypeSynonyms t1
t2' <- resolveTypeSynonyms t2
return $ PromotedInfixT t1' n t2'
PromotedUInfixT t1 n t2 -> do
t1' <- resolveTypeSynonyms t1
t2' <- resolveTypeSynonyms t2
return $ PromotedUInfixT t1' n t2'
#endif
Type
_ -> Type -> Q Type
defaultCase Type
f
resolveTypeArgSynonyms :: TypeArg -> Q TypeArg
resolveTypeArgSynonyms :: TypeArg -> Q TypeArg
resolveTypeArgSynonyms (TANormal Type
t) = Type -> TypeArg
TANormal (Type -> TypeArg) -> Q Type -> Q TypeArg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Q Type
resolveTypeSynonyms Type
t
resolveTypeArgSynonyms (TyArg Type
k) = Type -> TypeArg
TyArg (Type -> TypeArg) -> Q Type -> Q TypeArg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Q Type
resolveKindSynonyms Type
k
resolveKindSynonyms :: Kind -> Q Kind
#if MIN_VERSION_template_haskell(2,8,0)
resolveKindSynonyms :: Type -> Q Type
resolveKindSynonyms = Type -> Q Type
resolveTypeSynonyms
#else
resolveKindSynonyms = return
#endif
resolve_tvb_syns :: TyVarBndr_ flag -> Q (TyVarBndr_ flag)
resolve_tvb_syns :: TyVarBndrUnit -> Q TyVarBndrUnit
resolve_tvb_syns = (Type -> Q Type) -> TyVarBndrUnit -> Q TyVarBndrUnit
forall (m :: * -> *) flag.
Monad m =>
(Type -> m Type) -> TyVarBndrUnit -> m TyVarBndrUnit
mapMTVKind Type -> Q Type
resolveKindSynonyms
expandSynonymRHS ::
[TyVarBndr_ flag] ->
[Type] ->
Type ->
Type
expandSynonymRHS :: [TyVarBndrUnit] -> Cxt -> Type -> Type
expandSynonymRHS [TyVarBndrUnit]
synvars Cxt
ts Type
def =
let argNames :: [Name]
argNames = (TyVarBndrUnit -> Name) -> [TyVarBndrUnit] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndrUnit -> Name
forall flag. TyVarBndrUnit -> Name
tvName [TyVarBndrUnit]
synvars
(Cxt
args,Cxt
rest) = Int -> Cxt -> (Cxt, Cxt)
forall a. Int -> [a] -> ([a], [a])
splitAt ([Name] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
argNames) Cxt
ts
subst :: Map Name Type
subst = [(Name, Type)] -> Map Name Type
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Name] -> Cxt -> [(Name, Type)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
argNames Cxt
args)
in (Type -> Type -> Type) -> Type -> Cxt -> Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
AppT (Map Name Type -> Type -> Type
forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
subst Type
def) Cxt
rest
resolvePredSynonyms :: Pred -> Q Pred
#if MIN_VERSION_template_haskell(2,10,0)
resolvePredSynonyms :: Type -> Q Type
resolvePredSynonyms = Type -> Q Type
resolveTypeSynonyms
#else
resolvePredSynonyms (ClassP n ts) = do
mbInfo <- reifyMaybe n
case mbInfo of
Just (TyConI (TySynD _ synvars def))
| length ts >= length synvars
-> resolvePredSynonyms $ typeToPred $ expandSynonymRHS synvars ts def
_ -> ClassP n <$> mapM resolveTypeSynonyms ts
resolvePredSynonyms (EqualP t1 t2) = do
t1' <- resolveTypeSynonyms t1
t2' <- resolveTypeSynonyms t2
return (EqualP t1' t2')
typeToPred :: Type -> Pred
typeToPred t =
let f :| xs = decomposeType t in
case f of
ConT n
| n == eqTypeName
# if __GLASGOW_HASKELL__ == 704
, [_,t1,t2] <- xs
# else
, [t1,t2] <- xs
# endif
-> EqualP t1 t2
| otherwise
-> ClassP n xs
_ -> error $ "typeToPred: Can't handle type " ++ show t
#endif
decomposeType :: Type -> NonEmpty Type
decomposeType :: Type -> NonEmpty Type
decomposeType Type
t =
case Type -> (Type, [TypeArg])
decomposeTypeArgs Type
t of
(Type
f, [TypeArg]
x) -> Type
f Type -> Cxt -> NonEmpty Type
forall a. a -> [a] -> NonEmpty a
:| [TypeArg] -> Cxt
filterTANormals [TypeArg]
x
decomposeTypeArgs :: Type -> (Type, [TypeArg])
decomposeTypeArgs :: Type -> (Type, [TypeArg])
decomposeTypeArgs = [TypeArg] -> Type -> (Type, [TypeArg])
go []
where
go :: [TypeArg] -> Type -> (Type, [TypeArg])
go :: [TypeArg] -> Type -> (Type, [TypeArg])
go [TypeArg]
args (AppT Type
f Type
x) = [TypeArg] -> Type -> (Type, [TypeArg])
go (Type -> TypeArg
TANormal Type
xTypeArg -> [TypeArg] -> [TypeArg]
forall a. a -> [a] -> [a]
:[TypeArg]
args) Type
f
#if MIN_VERSION_template_haskell(2,11,0)
go [TypeArg]
args (ParensT Type
t) = [TypeArg] -> Type -> (Type, [TypeArg])
go [TypeArg]
args Type
t
#endif
#if MIN_VERSION_template_haskell(2,15,0)
go [TypeArg]
args (AppKindT Type
f Type
x) = [TypeArg] -> Type -> (Type, [TypeArg])
go (Type -> TypeArg
TyArg Type
xTypeArg -> [TypeArg] -> [TypeArg]
forall a. a -> [a] -> [a]
:[TypeArg]
args) Type
f
#endif
go [TypeArg]
args Type
t = (Type
t, [TypeArg]
args)
data TypeArg
= TANormal Type
| TyArg Kind
appTypeArg :: Type -> TypeArg -> Type
appTypeArg :: Type -> TypeArg -> Type
appTypeArg Type
f (TANormal Type
x) = Type
f Type -> Type -> Type
`AppT` Type
x
appTypeArg Type
f (TyArg Type
_k) =
#if MIN_VERSION_template_haskell(2,15,0)
Type
f Type -> Type -> Type
`AppKindT` Type
_k
#else
f
#endif
filterTANormals :: [TypeArg] -> [Type]
filterTANormals :: [TypeArg] -> Cxt
filterTANormals = (TypeArg -> Maybe Type) -> [TypeArg] -> Cxt
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TypeArg -> Maybe Type
f
where
f :: TypeArg -> Maybe Type
f :: TypeArg -> Maybe Type
f (TANormal Type
t) = Type -> Maybe Type
forall a. a -> Maybe a
Just Type
t
f (TyArg {}) = Maybe Type
forall a. Maybe a
Nothing
data NonEmpty a = a :| [a]
data NonEmptySnoc a = [a] :|- a
uncurryType :: Type -> ([TyVarBndrSpec], Cxt, NonEmptySnoc Type)
uncurryType :: Type -> ([TyVarBndrUnit], Cxt, NonEmptySnoc Type)
uncurryType = [TyVarBndrUnit]
-> Cxt -> Cxt -> Type -> ([TyVarBndrUnit], Cxt, NonEmptySnoc Type)
go [] [] []
where
go :: [TyVarBndrUnit]
-> Cxt -> Cxt -> Type -> ([TyVarBndrUnit], Cxt, NonEmptySnoc Type)
go [TyVarBndrUnit]
tvbs Cxt
ctxt Cxt
args (AppT (AppT Type
ArrowT Type
t1) Type
t2) = [TyVarBndrUnit]
-> Cxt -> Cxt -> Type -> ([TyVarBndrUnit], Cxt, NonEmptySnoc Type)
go [TyVarBndrUnit]
tvbs Cxt
ctxt (Type
t1Type -> Cxt -> Cxt
forall a. a -> [a] -> [a]
:Cxt
args) Type
t2
go [TyVarBndrUnit]
tvbs Cxt
ctxt Cxt
args (ForallT [TyVarBndrUnit]
tvbs' Cxt
ctxt' Type
t) = [TyVarBndrUnit]
-> Cxt -> Cxt -> Type -> ([TyVarBndrUnit], Cxt, NonEmptySnoc Type)
go ([TyVarBndrUnit]
tvbs[TyVarBndrUnit] -> [TyVarBndrUnit] -> [TyVarBndrUnit]
forall a. [a] -> [a] -> [a]
++[TyVarBndrUnit]
tvbs') (Cxt
ctxtCxt -> Cxt -> Cxt
forall a. [a] -> [a] -> [a]
++Cxt
ctxt') Cxt
args Type
t
go [TyVarBndrUnit]
tvbs Cxt
ctxt Cxt
args Type
t = ([TyVarBndrUnit]
tvbs, Cxt
ctxt, Cxt -> Cxt
forall a. [a] -> [a]
reverse Cxt
args Cxt -> Type -> NonEmptySnoc Type
forall a. [a] -> a -> NonEmptySnoc a
:|- Type
t)
uncurryKind :: Kind -> ([TyVarBndrSpec], Cxt, NonEmptySnoc Kind)
#if MIN_VERSION_template_haskell(2,8,0)
uncurryKind :: Type -> ([TyVarBndrUnit], Cxt, NonEmptySnoc Type)
uncurryKind = Type -> ([TyVarBndrUnit], Cxt, NonEmptySnoc Type)
uncurryType
#else
uncurryKind = go []
where
go args (ArrowK k1 k2) = go (k1:args) k2
go args StarK = ([], [], reverse args :|- StarK)
#endif
curryType :: [TyVarBndrSpec] -> Cxt -> [Type] -> Type -> Type
curryType :: [TyVarBndrUnit] -> Cxt -> Cxt -> Type -> Type
curryType [TyVarBndrUnit]
tvbs Cxt
ctxt Cxt
args Type
res =
[TyVarBndrUnit] -> Cxt -> Type -> Type
ForallT [TyVarBndrUnit]
tvbs Cxt
ctxt (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ (Type -> Type -> Type) -> Type -> Cxt -> Type
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Type
arg Type
t -> Type
ArrowT Type -> Type -> Type
`AppT` Type
arg Type -> Type -> Type
`AppT` Type
t) Type
res Cxt
args
resolveInfixT :: Type -> Q Type
#if MIN_VERSION_template_haskell(2,11,0)
resolveInfixT :: Type -> Q Type
resolveInfixT (ForallT [TyVarBndrUnit]
vs Cxt
cx Type
t) = [TyVarBndrUnit] -> Cxt -> Type -> Type
ForallT ([TyVarBndrUnit] -> Cxt -> Type -> Type)
-> Q [TyVarBndrUnit] -> Q (Cxt -> Type -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TyVarBndrUnit -> Q TyVarBndrUnit)
-> [TyVarBndrUnit] -> Q [TyVarBndrUnit]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Type -> Q Type) -> TyVarBndrUnit -> Q TyVarBndrUnit
forall (f :: * -> *) flag.
Applicative f =>
(Type -> f Type) -> TyVarBndrUnit -> f TyVarBndrUnit
traverseTVKind Type -> Q Type
resolveInfixT) [TyVarBndrUnit]
vs
Q (Cxt -> Type -> Type) -> Q Cxt -> Q (Type -> Type)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Type -> Q Type) -> Cxt -> Q Cxt
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type -> Q Type
resolveInfixT Cxt
cx
Q (Type -> Type) -> Q Type -> Q Type
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Q Type
resolveInfixT Type
t
resolveInfixT (Type
f `AppT` Type
x) = Type -> Q Type
resolveInfixT Type
f Q Type -> Q Type -> Q Type
`appT` Type -> Q Type
resolveInfixT Type
x
resolveInfixT (ParensT Type
t) = Type -> Q Type
resolveInfixT Type
t
resolveInfixT (InfixT Type
l Name
o Type
r) = Name -> Q Type
conT Name
o Q Type -> Q Type -> Q Type
`appT` Type -> Q Type
resolveInfixT Type
l Q Type -> Q Type -> Q Type
`appT` Type -> Q Type
resolveInfixT Type
r
resolveInfixT (SigT Type
t Type
k) = Type -> Type -> Type
SigT (Type -> Type -> Type) -> Q Type -> Q (Type -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Q Type
resolveInfixT Type
t Q (Type -> Type) -> Q Type -> Q Type
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Q Type
resolveInfixT Type
k
resolveInfixT t :: Type
t@UInfixT{} = Type -> Q Type
resolveInfixT (Type -> Q Type) -> Q Type -> Q Type
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< InfixList -> Q Type
resolveInfixT1 (Type -> InfixList
gatherUInfixT Type
t)
# if MIN_VERSION_template_haskell(2,15,0)
resolveInfixT (Type
f `AppKindT` Type
x) = Q Type -> Q Type -> Q Type
appKindT (Type -> Q Type
resolveInfixT Type
f) (Type -> Q Type
resolveInfixT Type
x)
resolveInfixT (ImplicitParamT String
n Type
t)
= String -> Q Type -> Q Type
implicitParamT String
n (Q Type -> Q Type) -> Q Type -> Q Type
forall a b. (a -> b) -> a -> b
$ Type -> Q Type
resolveInfixT Type
t
# endif
# if MIN_VERSION_template_haskell(2,16,0)
resolveInfixT (ForallVisT [TyVarBndrUnit]
vs Type
t) = [TyVarBndrUnit] -> Type -> Type
ForallVisT ([TyVarBndrUnit] -> Type -> Type)
-> Q [TyVarBndrUnit] -> Q (Type -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TyVarBndrUnit -> Q TyVarBndrUnit)
-> [TyVarBndrUnit] -> Q [TyVarBndrUnit]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Type -> Q Type) -> TyVarBndrUnit -> Q TyVarBndrUnit
forall (f :: * -> *) flag.
Applicative f =>
(Type -> f Type) -> TyVarBndrUnit -> f TyVarBndrUnit
traverseTVKind Type -> Q Type
resolveInfixT) [TyVarBndrUnit]
vs
Q (Type -> Type) -> Q Type -> Q Type
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Q Type
resolveInfixT Type
t
# endif
# if MIN_VERSION_template_haskell(2,19,0)
resolveInfixT (PromotedInfixT l o r)
= promotedT o `appT` resolveInfixT l `appT` resolveInfixT r
resolveInfixT t@PromotedUInfixT{}
= resolveInfixT =<< resolveInfixT1 (gatherUInfixT t)
# endif
resolveInfixT Type
t = Type -> Q Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
t
gatherUInfixT :: Type -> InfixList
gatherUInfixT :: Type -> InfixList
gatherUInfixT (UInfixT Type
l Name
o Type
r) = InfixList -> Name -> Bool -> InfixList -> InfixList
ilAppend (Type -> InfixList
gatherUInfixT Type
l) Name
o Bool
False (Type -> InfixList
gatherUInfixT Type
r)
# if MIN_VERSION_template_haskell(2,19,0)
gatherUInfixT (PromotedUInfixT l o r) = ilAppend (gatherUInfixT l) o True (gatherUInfixT r)
# endif
gatherUInfixT Type
t = Type -> InfixList
ILNil Type
t
resolveInfixT1 :: InfixList -> TypeQ
resolveInfixT1 :: InfixList -> Q Type
resolveInfixT1 = [(Type, Name, Bool, Fixity)] -> InfixList -> Q Type
go []
where
go :: [(Type,Name,Bool,Fixity)] -> InfixList -> TypeQ
go :: [(Type, Name, Bool, Fixity)] -> InfixList -> Q Type
go [(Type, Name, Bool, Fixity)]
ts (ILNil Type
u) = Type -> Q Type
forall (m :: * -> *) a. Monad m => a -> m a
return ((Type -> (Type, Name, Bool, Fixity) -> Type)
-> Type -> [(Type, Name, Bool, Fixity)] -> Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Type
acc (Type
l,Name
o,Bool
p,Fixity
_) -> Bool -> Name -> Type
mkConT Bool
p Name
o Type -> Type -> Type
`AppT` Type
l Type -> Type -> Type
`AppT` Type
acc) Type
u [(Type, Name, Bool, Fixity)]
ts)
go [(Type, Name, Bool, Fixity)]
ts (ILCons Type
l Name
o Bool
p InfixList
r) =
do Fixity
ofx <- Fixity -> Maybe Fixity -> Fixity
forall a. a -> Maybe a -> a
fromMaybe Fixity
defaultFixity (Maybe Fixity -> Fixity) -> Q (Maybe Fixity) -> Q Fixity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Q (Maybe Fixity)
reifyFixityCompat Name
o
let push :: Q Type
push = [(Type, Name, Bool, Fixity)] -> InfixList -> Q Type
go ((Type
l,Name
o,Bool
p,Fixity
ofx)(Type, Name, Bool, Fixity)
-> [(Type, Name, Bool, Fixity)] -> [(Type, Name, Bool, Fixity)]
forall a. a -> [a] -> [a]
:[(Type, Name, Bool, Fixity)]
ts) InfixList
r
case [(Type, Name, Bool, Fixity)]
ts of
(Type
l1,Name
o1,Bool
p1,Fixity
o1fx):[(Type, Name, Bool, Fixity)]
ts' ->
case Fixity -> Fixity -> Maybe Bool
compareFixity Fixity
o1fx Fixity
ofx of
Just Bool
True -> [(Type, Name, Bool, Fixity)] -> InfixList -> Q Type
go ((Bool -> Name -> Type
mkConT Bool
p1 Name
o1 Type -> Type -> Type
`AppT` Type
l1 Type -> Type -> Type
`AppT` Type
l, Name
o, Bool
p, Fixity
ofx)(Type, Name, Bool, Fixity)
-> [(Type, Name, Bool, Fixity)] -> [(Type, Name, Bool, Fixity)]
forall a. a -> [a] -> [a]
:[(Type, Name, Bool, Fixity)]
ts') InfixList
r
Just Bool
False -> Q Type
push
Maybe Bool
Nothing -> String -> Q Type
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Name -> Fixity -> Name -> Fixity -> String
precedenceError Name
o1 Fixity
o1fx Name
o Fixity
ofx)
[(Type, Name, Bool, Fixity)]
_ -> Q Type
push
mkConT :: Bool -> Name -> Type
mkConT :: Bool -> Name -> Type
mkConT Bool
promoted = if Bool
promoted then Name -> Type
PromotedT else Name -> Type
ConT
compareFixity :: Fixity -> Fixity -> Maybe Bool
compareFixity :: Fixity -> Fixity -> Maybe Bool
compareFixity (Fixity Int
n1 FixityDirection
InfixL) (Fixity Int
n2 FixityDirection
InfixL) = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Int
n1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n2)
compareFixity (Fixity Int
n1 FixityDirection
InfixR) (Fixity Int
n2 FixityDirection
InfixR) = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Int
n1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n2)
compareFixity (Fixity Int
n1 FixityDirection
_ ) (Fixity Int
n2 FixityDirection
_ ) =
case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n1 Int
n2 of
Ordering
GT -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
Ordering
LT -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
Ordering
EQ -> Maybe Bool
forall a. Maybe a
Nothing
precedenceError :: Name -> Fixity -> Name -> Fixity -> String
precedenceError :: Name -> Fixity -> Name -> Fixity -> String
precedenceError Name
o1 Fixity
ofx1 Name
o2 Fixity
ofx2 =
String
"Precedence parsing error: cannot mix ‘" String -> ShowS
forall a. [a] -> [a] -> [a]
++
Name -> String
nameBase Name
o1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"’ [" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Fixity -> String
showFixity Fixity
ofx1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"] and ‘" String -> ShowS
forall a. [a] -> [a] -> [a]
++
Name -> String
nameBase Name
o2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"’ [" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Fixity -> String
showFixity Fixity
ofx2 String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"] in the same infix type expression"
data InfixList
= ILCons Type
Name
Bool
InfixList
| ILNil Type
ilAppend :: InfixList -> Name -> Bool -> InfixList -> InfixList
ilAppend :: InfixList -> Name -> Bool -> InfixList -> InfixList
ilAppend (ILNil Type
l) Name
o Bool
p InfixList
r = Type -> Name -> Bool -> InfixList -> InfixList
ILCons Type
l Name
o Bool
p InfixList
r
ilAppend (ILCons Type
l1 Name
o1 Bool
p1 InfixList
r1) Name
o Bool
p InfixList
r = Type -> Name -> Bool -> InfixList -> InfixList
ILCons Type
l1 Name
o1 Bool
p1 (InfixList -> Name -> Bool -> InfixList -> InfixList
ilAppend InfixList
r1 Name
o Bool
p InfixList
r)
#else
resolveInfixT = return
#endif
showFixity :: Fixity -> String
showFixity :: Fixity -> String
showFixity (Fixity Int
n FixityDirection
d) = FixityDirection -> String
showFixityDirection FixityDirection
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
showFixityDirection :: FixityDirection -> String
showFixityDirection :: FixityDirection -> String
showFixityDirection FixityDirection
InfixL = String
"infixl"
showFixityDirection FixityDirection
InfixR = String
"infixr"
showFixityDirection FixityDirection
InfixN = String
"infix"
takeFieldNames :: [(Name,a,b)] -> [Name]
takeFieldNames :: [(Name, a, b)] -> [Name]
takeFieldNames [(Name, a, b)]
xs = [Name
a | (Name
a,a
_,b
_) <- [(Name, a, b)]
xs]
#if MIN_VERSION_template_haskell(2,11,0)
takeFieldStrictness :: [(a,Bang,b)] -> [FieldStrictness]
#else
takeFieldStrictness :: [(a,Strict,b)] -> [FieldStrictness]
#endif
takeFieldStrictness :: [(a, Bang, b)] -> [FieldStrictness]
takeFieldStrictness [(a, Bang, b)]
xs = [Bang -> FieldStrictness
normalizeStrictness Bang
a | (a
_,Bang
a,b
_) <- [(a, Bang, b)]
xs]
takeFieldTypes :: [(a,b,Type)] -> [Type]
takeFieldTypes :: [(a, b, Type)] -> Cxt
takeFieldTypes [(a, b, Type)]
xs = [Type
a | (a
_,b
_,Type
a) <- [(a, b, Type)]
xs]
conHasRecord :: Name -> ConstructorInfo -> Bool
conHasRecord :: Name -> ConstructorInfo -> Bool
conHasRecord Name
recName ConstructorInfo
info =
case ConstructorInfo -> ConstructorVariant
constructorVariant ConstructorInfo
info of
ConstructorVariant
NormalConstructor -> Bool
False
ConstructorVariant
InfixConstructor -> Bool
False
RecordConstructor [Name]
fields -> Name
recName Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
fields
quantifyType :: Type -> Type
quantifyType :: Type -> Type
quantifyType Type
t
| [TyVarBndrUnit] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVarBndrUnit]
tvbs
= Type
t
| ForallT [TyVarBndrUnit]
tvbs' Cxt
ctxt' Type
t' <- Type
t
= [TyVarBndrUnit] -> Cxt -> Type -> Type
ForallT ([TyVarBndrUnit]
tvbs [TyVarBndrUnit] -> [TyVarBndrUnit] -> [TyVarBndrUnit]
forall a. [a] -> [a] -> [a]
++ [TyVarBndrUnit]
tvbs') Cxt
ctxt' Type
t'
| Bool
otherwise
= [TyVarBndrUnit] -> Cxt -> Type -> Type
ForallT [TyVarBndrUnit]
tvbs [] Type
t
where
tvbs :: [TyVarBndrUnit]
tvbs = Specificity -> [TyVarBndrUnit] -> [TyVarBndrUnit]
forall newFlag oldFlag.
newFlag -> [TyVarBndrUnit] -> [TyVarBndrUnit]
changeTVFlags Specificity
SpecifiedSpec ([TyVarBndrUnit] -> [TyVarBndrUnit])
-> [TyVarBndrUnit] -> [TyVarBndrUnit]
forall a b. (a -> b) -> a -> b
$ Cxt -> [TyVarBndrUnit]
freeVariablesWellScoped [Type
t]
freeVariablesWellScoped :: [Type] -> [TyVarBndrUnit]
freeVariablesWellScoped :: Cxt -> [TyVarBndrUnit]
freeVariablesWellScoped Cxt
tys =
let fvs :: [Name]
fvs :: [Name]
fvs = Cxt -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables Cxt
tys
varKindSigs :: Map Name Kind
varKindSigs :: Map Name Type
varKindSigs = (Type -> Map Name Type) -> Cxt -> Map Name Type
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Type -> Map Name Type
go_ty Cxt
tys
where
go_ty :: Type -> Map Name Kind
go_ty :: Type -> Map Name Type
go_ty (ForallT [TyVarBndrUnit]
tvbs Cxt
ctxt Type
t) =
(TyVarBndrUnit -> Map Name Type -> Map Name Type)
-> Map Name Type -> [TyVarBndrUnit] -> Map Name Type
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\TyVarBndrUnit
tvb -> Name -> Map Name Type -> Map Name Type
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (TyVarBndrUnit -> Name
forall flag. TyVarBndrUnit -> Name
tvName TyVarBndrUnit
tvb))
((Type -> Map Name Type) -> Cxt -> Map Name Type
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Type -> Map Name Type
go_pred Cxt
ctxt Map Name Type -> Map Name Type -> Map Name Type
forall a. Monoid a => a -> a -> a
`mappend` Type -> Map Name Type
go_ty Type
t) [TyVarBndrUnit]
tvbs
go_ty (AppT Type
t1 Type
t2) = Type -> Map Name Type
go_ty Type
t1 Map Name Type -> Map Name Type -> Map Name Type
forall a. Monoid a => a -> a -> a
`mappend` Type -> Map Name Type
go_ty Type
t2
go_ty (SigT Type
t Type
k) =
let kSigs :: Map Name Type
kSigs =
#if MIN_VERSION_template_haskell(2,8,0)
Type -> Map Name Type
go_ty Type
k
#else
mempty
#endif
in case Type
t of
VarT Name
n -> Name -> Type -> Map Name Type -> Map Name Type
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
n Type
k Map Name Type
kSigs
Type
_ -> Type -> Map Name Type
go_ty Type
t Map Name Type -> Map Name Type -> Map Name Type
forall a. Monoid a => a -> a -> a
`mappend` Map Name Type
kSigs
#if MIN_VERSION_template_haskell(2,15,0)
go_ty (AppKindT Type
t Type
k) = Type -> Map Name Type
go_ty Type
t Map Name Type -> Map Name Type -> Map Name Type
forall a. Monoid a => a -> a -> a
`mappend` Type -> Map Name Type
go_ty Type
k
go_ty (ImplicitParamT String
_ Type
t) = Type -> Map Name Type
go_ty Type
t
#endif
#if MIN_VERSION_template_haskell(2,16,0)
go_ty (ForallVisT [TyVarBndrUnit]
tvbs Type
t) =
(TyVarBndrUnit -> Map Name Type -> Map Name Type)
-> Map Name Type -> [TyVarBndrUnit] -> Map Name Type
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\TyVarBndrUnit
tvb -> Name -> Map Name Type -> Map Name Type
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (TyVarBndrUnit -> Name
forall flag. TyVarBndrUnit -> Name
tvName TyVarBndrUnit
tvb)) (Type -> Map Name Type
go_ty Type
t) [TyVarBndrUnit]
tvbs
#endif
go_ty Type
_ = Map Name Type
forall a. Monoid a => a
mempty
go_pred :: Pred -> Map Name Kind
#if MIN_VERSION_template_haskell(2,10,0)
go_pred :: Type -> Map Name Type
go_pred = Type -> Map Name Type
go_ty
#else
go_pred (ClassP _ ts) = foldMap go_ty ts
go_pred (EqualP t1 t2) = go_ty t1 `mappend` go_ty t2
#endif
scopedSort :: [Name] -> [Name]
scopedSort :: [Name] -> [Name]
scopedSort = [Name] -> [Set Name] -> [Name] -> [Name]
go [] []
go :: [Name]
-> [Set Name]
-> [Name]
-> [Name]
go :: [Name] -> [Set Name] -> [Name] -> [Name]
go [Name]
acc [Set Name]
_fv_list [] = [Name] -> [Name]
forall a. [a] -> [a]
reverse [Name]
acc
go [Name]
acc [Set Name]
fv_list (Name
tv:[Name]
tvs)
= [Name] -> [Set Name] -> [Name] -> [Name]
go [Name]
acc' [Set Name]
fv_list' [Name]
tvs
where
([Name]
acc', [Set Name]
fv_list') = Name -> [Name] -> [Set Name] -> ([Name], [Set Name])
insert Name
tv [Name]
acc [Set Name]
fv_list
insert :: Name
-> [Name]
-> [Set Name]
-> ([Name], [Set Name])
insert :: Name -> [Name] -> [Set Name] -> ([Name], [Set Name])
insert Name
tv [] [] = ([Name
tv], [Name -> Set Name
kindFVSet Name
tv])
insert Name
tv (Name
a:[Name]
as) (Set Name
fvs:[Set Name]
fvss)
| Name
tv Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Name
fvs
, ([Name]
as', [Set Name]
fvss') <- Name -> [Name] -> [Set Name] -> ([Name], [Set Name])
insert Name
tv [Name]
as [Set Name]
fvss
= (Name
aName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
as', Set Name
fvs Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set Name
fv_tv Set Name -> [Set Name] -> [Set Name]
forall a. a -> [a] -> [a]
: [Set Name]
fvss')
| Bool
otherwise
= (Name
tvName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:Name
aName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
as, Set Name
fvs Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set Name
fv_tv Set Name -> [Set Name] -> [Set Name]
forall a. a -> [a] -> [a]
: Set Name
fvs Set Name -> [Set Name] -> [Set Name]
forall a. a -> [a] -> [a]
: [Set Name]
fvss)
where
fv_tv :: Set Name
fv_tv = Name -> Set Name
kindFVSet Name
tv
insert Name
_ [Name]
_ [Set Name]
_ = String -> ([Name], [Set Name])
forall a. HasCallStack => String -> a
error String
"scopedSort"
kindFVSet :: Name -> Set Name
kindFVSet Name
n =
Set Name -> (Type -> Set Name) -> Maybe Type -> Set Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set Name
forall a. Set a
Set.empty ([Name] -> Set Name
forall a. Ord a => [a] -> Set a
Set.fromList ([Name] -> Set Name) -> (Type -> [Name]) -> Type -> Set Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables) (Name -> Map Name Type -> Maybe Type
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n Map Name Type
varKindSigs)
ascribeWithKind :: Name -> TyVarBndrUnit
ascribeWithKind Name
n =
TyVarBndrUnit
-> (Type -> TyVarBndrUnit) -> Maybe Type -> TyVarBndrUnit
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Name -> TyVarBndrUnit
plainTV Name
n) (Name -> Type -> TyVarBndrUnit
kindedTV Name
n) (Name -> Map Name Type -> Maybe Type
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n Map Name Type
varKindSigs)
isKindBinderOnOldGHCs :: b -> Bool
isKindBinderOnOldGHCs
#if __GLASGOW_HASKELL__ >= 800
= Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
False
#else
= (`elem` kindVars)
where
kindVars = freeVariables $ Map.elems varKindSigs
#endif
in (Name -> TyVarBndrUnit) -> [Name] -> [TyVarBndrUnit]
forall a b. (a -> b) -> [a] -> [b]
map Name -> TyVarBndrUnit
ascribeWithKind ([Name] -> [TyVarBndrUnit]) -> [Name] -> [TyVarBndrUnit]
forall a b. (a -> b) -> a -> b
$
(Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Name -> Bool) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Bool
forall b. b -> Bool
isKindBinderOnOldGHCs) ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$
[Name] -> [Name]
scopedSort [Name]
fvs
freshenFreeVariables :: Type -> Q Type
freshenFreeVariables :: Type -> Q Type
freshenFreeVariables Type
t =
do let xs :: [(Name, Q Type)]
xs = [ (Name
n, Name -> Type
VarT (Name -> Type) -> Q Name -> Q Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Q Name
newName (Name -> String
nameBase Name
n)) | Name
n <- Type -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
t]
Map Name Type
subst <- Map Name (Q Type) -> Q (Map Name Type)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
T.sequence ([(Name, Q Type)] -> Map Name (Q Type)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Name, Q Type)]
xs)
Type -> Q Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Name Type -> Type -> Type
forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
subst Type
t)
class TypeSubstitution a where
applySubstitution :: Map Name Type -> a -> a
freeVariables :: a -> [Name]
instance TypeSubstitution a => TypeSubstitution [a] where
freeVariables :: [a] -> [Name]
freeVariables = [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub ([Name] -> [Name]) -> ([a] -> [Name]) -> [a] -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Name]] -> [Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Name]] -> [Name]) -> ([a] -> [[Name]]) -> [a] -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [Name]) -> [a] -> [[Name]]
forall a b. (a -> b) -> [a] -> [b]
map a -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables
applySubstitution :: Map Name Type -> [a] -> [a]
applySubstitution = (a -> a) -> [a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a) -> [a] -> [a])
-> (Map Name Type -> a -> a) -> Map Name Type -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Name Type -> a -> a
forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution
instance TypeSubstitution Type where
applySubstitution :: Map Name Type -> Type -> Type
applySubstitution Map Name Type
subst = Type -> Type
go
where
go :: Type -> Type
go (ForallT [TyVarBndrUnit]
tvs Cxt
context Type
t) =
let (Map Name Type
subst', [TyVarBndrUnit]
tvs') = Map Name Type
-> [TyVarBndrUnit] -> (Map Name Type, [TyVarBndrUnit])
forall flag.
Map Name Type
-> [TyVarBndrUnit] -> (Map Name Type, [TyVarBndrUnit])
substTyVarBndrs Map Name Type
subst [TyVarBndrUnit]
tvs in
[TyVarBndrUnit] -> Cxt -> Type -> Type
ForallT [TyVarBndrUnit]
forall flag. [TyVarBndrUnit]
tvs'
(Map Name Type -> Cxt -> Cxt
forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
subst' Cxt
context)
(Map Name Type -> Type -> Type
forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
subst' Type
t)
go (AppT Type
f Type
x) = Type -> Type -> Type
AppT (Type -> Type
go Type
f) (Type -> Type
go Type
x)
go (SigT Type
t Type
k) = Type -> Type -> Type
SigT (Type -> Type
go Type
t) (Map Name Type -> Type -> Type
forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
subst Type
k)
go (VarT Name
v) = Type -> Name -> Map Name Type -> Type
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (Name -> Type
VarT Name
v) Name
v Map Name Type
subst
#if MIN_VERSION_template_haskell(2,11,0)
go (InfixT Type
l Name
c Type
r) = Type -> Name -> Type -> Type
InfixT (Type -> Type
go Type
l) Name
c (Type -> Type
go Type
r)
go (UInfixT Type
l Name
c Type
r) = Type -> Name -> Type -> Type
UInfixT (Type -> Type
go Type
l) Name
c (Type -> Type
go Type
r)
go (ParensT Type
t) = Type -> Type
ParensT (Type -> Type
go Type
t)
#endif
#if MIN_VERSION_template_haskell(2,15,0)
go (AppKindT Type
t Type
k) = Type -> Type -> Type
AppKindT (Type -> Type
go Type
t) (Type -> Type
go Type
k)
go (ImplicitParamT String
n Type
t)
= String -> Type -> Type
ImplicitParamT String
n (Type -> Type
go Type
t)
#endif
#if MIN_VERSION_template_haskell(2,16,0)
go (ForallVisT [TyVarBndrUnit]
tvs Type
t) =
let (Map Name Type
subst', [TyVarBndrUnit]
tvs') = Map Name Type
-> [TyVarBndrUnit] -> (Map Name Type, [TyVarBndrUnit])
forall flag.
Map Name Type
-> [TyVarBndrUnit] -> (Map Name Type, [TyVarBndrUnit])
substTyVarBndrs Map Name Type
subst [TyVarBndrUnit]
tvs in
[TyVarBndrUnit] -> Type -> Type
ForallVisT [TyVarBndrUnit]
forall flag. [TyVarBndrUnit]
tvs'
(Map Name Type -> Type -> Type
forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
subst' Type
t)
#endif
#if MIN_VERSION_template_haskell(2,19,0)
go (PromotedInfixT l c r)
= PromotedInfixT (go l) c (go r)
go (PromotedUInfixT l c r)
= PromotedUInfixT (go l) c (go r)
#endif
go Type
t = Type
t
subst_tvbs :: [TyVarBndr_ flag] -> (Map Name Type -> a) -> a
subst_tvbs :: [TyVarBndrUnit] -> (Map Name Type -> a) -> a
subst_tvbs [TyVarBndrUnit]
tvs Map Name Type -> a
k = Map Name Type -> a
k (Map Name Type -> a) -> Map Name Type -> a
forall a b. (a -> b) -> a -> b
$ (Map Name Type -> Name -> Map Name Type)
-> Map Name Type -> [Name] -> Map Name Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Name -> Map Name Type -> Map Name Type)
-> Map Name Type -> Name -> Map Name Type
forall a b c. (a -> b -> c) -> b -> a -> c
flip Name -> Map Name Type -> Map Name Type
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete) Map Name Type
subst ((TyVarBndrUnit -> Name) -> [TyVarBndrUnit] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndrUnit -> Name
forall flag. TyVarBndrUnit -> Name
tvName [TyVarBndrUnit]
tvs)
freeVariables :: Type -> [Name]
freeVariables Type
t =
case Type
t of
ForallT [TyVarBndrUnit]
tvs Cxt
context Type
t' ->
[TyVarBndrUnit] -> [Name] -> [Name]
forall flag. [TyVarBndrUnit] -> [Name] -> [Name]
fvs_under_forall [TyVarBndrUnit]
tvs (Cxt -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables Cxt
context [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
`union` Type -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
t')
AppT Type
f Type
x -> Type -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
f [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
`union` Type -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
x
SigT Type
t' Type
k -> Type -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
t' [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
`union` Type -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
k
VarT Name
v -> [Name
v]
#if MIN_VERSION_template_haskell(2,11,0)
InfixT Type
l Name
_ Type
r -> Type -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
l [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
`union` Type -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
r
UInfixT Type
l Name
_ Type
r -> Type -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
l [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
`union` Type -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
r
ParensT Type
t' -> Type -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
t'
#endif
#if MIN_VERSION_template_haskell(2,15,0)
AppKindT Type
t Type
k -> Type -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
t [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
`union` Type -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
k
ImplicitParamT String
_ Type
t
-> Type -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
t
#endif
#if MIN_VERSION_template_haskell(2,16,0)
ForallVisT [TyVarBndrUnit]
tvs Type
t'
-> [TyVarBndrUnit] -> [Name] -> [Name]
forall flag. [TyVarBndrUnit] -> [Name] -> [Name]
fvs_under_forall [TyVarBndrUnit]
tvs (Type -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
t')
#endif
#if MIN_VERSION_template_haskell(2,19,0)
PromotedInfixT l _ r
-> freeVariables l `union` freeVariables r
PromotedUInfixT l _ r
-> freeVariables l `union` freeVariables r
#endif
Type
_ -> []
where
fvs_under_forall :: [TyVarBndr_ flag] -> [Name] -> [Name]
fvs_under_forall :: [TyVarBndrUnit] -> [Name] -> [Name]
fvs_under_forall [TyVarBndrUnit]
tvs [Name]
fvs =
(Cxt -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables ((TyVarBndrUnit -> Type) -> [TyVarBndrUnit] -> Cxt
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndrUnit -> Type
forall flag. TyVarBndrUnit -> Type
tvKind [TyVarBndrUnit]
tvs) [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
`union` [Name]
fvs)
[Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
\\ (TyVarBndrUnit -> Name) -> [TyVarBndrUnit] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndrUnit -> Name
forall flag. TyVarBndrUnit -> Name
tvName [TyVarBndrUnit]
tvs
instance TypeSubstitution ConstructorInfo where
freeVariables :: ConstructorInfo -> [Name]
freeVariables ConstructorInfo
ci =
(Cxt -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables ((TyVarBndrUnit -> Type) -> [TyVarBndrUnit] -> Cxt
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndrUnit -> Type
forall flag. TyVarBndrUnit -> Type
tvKind (ConstructorInfo -> [TyVarBndrUnit]
constructorVars ConstructorInfo
ci))
[Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
`union` Cxt -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables (ConstructorInfo -> Cxt
constructorContext ConstructorInfo
ci)
[Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
`union` Cxt -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables (ConstructorInfo -> Cxt
constructorFields ConstructorInfo
ci))
[Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
\\ (TyVarBndrUnit -> Name
forall flag. TyVarBndrUnit -> Name
tvName (TyVarBndrUnit -> Name) -> [TyVarBndrUnit] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConstructorInfo -> [TyVarBndrUnit]
constructorVars ConstructorInfo
ci)
applySubstitution :: Map Name Type -> ConstructorInfo -> ConstructorInfo
applySubstitution Map Name Type
subst ConstructorInfo
ci =
let subst' :: Map Name Type
subst' = (Map Name Type -> Name -> Map Name Type)
-> Map Name Type -> [Name] -> Map Name Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Name -> Map Name Type -> Map Name Type)
-> Map Name Type -> Name -> Map Name Type
forall a b c. (a -> b -> c) -> b -> a -> c
flip Name -> Map Name Type -> Map Name Type
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete) Map Name Type
subst ((TyVarBndrUnit -> Name) -> [TyVarBndrUnit] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndrUnit -> Name
forall flag. TyVarBndrUnit -> Name
tvName (ConstructorInfo -> [TyVarBndrUnit]
constructorVars ConstructorInfo
ci)) in
ConstructorInfo
ci { constructorVars :: [TyVarBndrUnit]
constructorVars = (TyVarBndrUnit -> TyVarBndrUnit)
-> [TyVarBndrUnit] -> [TyVarBndrUnit]
forall a b. (a -> b) -> [a] -> [b]
map ((Type -> Type) -> TyVarBndrUnit -> TyVarBndrUnit
forall flag. (Type -> Type) -> TyVarBndrUnit -> TyVarBndrUnit
mapTVKind (Map Name Type -> Type -> Type
forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
subst'))
(ConstructorInfo -> [TyVarBndrUnit]
constructorVars ConstructorInfo
ci)
, constructorContext :: Cxt
constructorContext = Map Name Type -> Cxt -> Cxt
forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
subst' (ConstructorInfo -> Cxt
constructorContext ConstructorInfo
ci)
, constructorFields :: Cxt
constructorFields = Map Name Type -> Cxt -> Cxt
forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
subst' (ConstructorInfo -> Cxt
constructorFields ConstructorInfo
ci)
}
#if !MIN_VERSION_template_haskell(2,10,0)
instance TypeSubstitution Pred where
freeVariables (ClassP _ xs) = freeVariables xs
freeVariables (EqualP x y) = freeVariables x `union` freeVariables y
applySubstitution p (ClassP n xs) = ClassP n (applySubstitution p xs)
applySubstitution p (EqualP x y) = EqualP (applySubstitution p x)
(applySubstitution p y)
#endif
#if !MIN_VERSION_template_haskell(2,8,0)
instance TypeSubstitution Kind where
freeVariables _ = []
applySubstitution _ k = k
#endif
substTyVarBndrs :: Map Name Type -> [TyVarBndr_ flag] -> (Map Name Type, [TyVarBndr_ flag])
substTyVarBndrs :: Map Name Type
-> [TyVarBndrUnit] -> (Map Name Type, [TyVarBndrUnit])
substTyVarBndrs = (Map Name Type -> TyVarBndrUnit -> (Map Name Type, TyVarBndrUnit))
-> Map Name Type
-> [TyVarBndrUnit]
-> (Map Name Type, [TyVarBndrUnit])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL Map Name Type -> TyVarBndrUnit -> (Map Name Type, TyVarBndrUnit)
forall flag.
Map Name Type -> TyVarBndrUnit -> (Map Name Type, TyVarBndrUnit)
substTyVarBndr
substTyVarBndr :: Map Name Type -> TyVarBndr_ flag -> (Map Name Type, TyVarBndr_ flag)
substTyVarBndr :: Map Name Type -> TyVarBndrUnit -> (Map Name Type, TyVarBndrUnit)
substTyVarBndr Map Name Type
subst TyVarBndrUnit
tvb
| Name
tvbName Name -> Map Name Type -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map Name Type
subst
= (Name -> Map Name Type -> Map Name Type
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Name
tvbName Map Name Type
subst, (Type -> Type) -> TyVarBndrUnit -> TyVarBndrUnit
forall flag. (Type -> Type) -> TyVarBndrUnit -> TyVarBndrUnit
mapTVKind (Map Name Type -> Type -> Type
forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
subst) TyVarBndrUnit
tvb)
| Name
tvbName Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Name
substRangeFVs
= (Map Name Type
subst, (Type -> Type) -> TyVarBndrUnit -> TyVarBndrUnit
forall flag. (Type -> Type) -> TyVarBndrUnit -> TyVarBndrUnit
mapTVKind (Map Name Type -> Type -> Type
forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
subst) TyVarBndrUnit
tvb)
| Bool
otherwise
= let tvbName' :: Name
tvbName' = Name -> Name
evade Name
tvbName in
( Name -> Type -> Map Name Type -> Map Name Type
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
tvbName (Name -> Type
VarT Name
tvbName') Map Name Type
subst
, (Name -> Name)
-> (Any -> Any) -> (Type -> Type) -> TyVarBndrUnit -> TyVarBndrUnit
forall flag flag'.
(Name -> Name)
-> (flag -> flag')
-> (Type -> Type)
-> TyVarBndrUnit
-> TyVarBndrUnit
mapTV (\Name
_ -> Name
tvbName') Any -> Any
forall a. a -> a
id (Map Name Type -> Type -> Type
forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
subst) TyVarBndrUnit
tvb
)
where
tvbName :: Name
tvbName :: Name
tvbName = TyVarBndrUnit -> Name
forall flag. TyVarBndrUnit -> Name
tvName TyVarBndrUnit
tvb
substRangeFVs :: Set Name
substRangeFVs :: Set Name
substRangeFVs = [Name] -> Set Name
forall a. Ord a => [a] -> Set a
Set.fromList ([Name] -> Set Name) -> [Name] -> Set Name
forall a b. (a -> b) -> a -> b
$ Cxt -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables (Cxt -> [Name]) -> Cxt -> [Name]
forall a b. (a -> b) -> a -> b
$ Map Name Type -> Cxt
forall k a. Map k a -> [a]
Map.elems Map Name Type
subst
evade :: Name -> Name
evade :: Name -> Name
evade Name
n | Name
n Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Name
substRangeFVs
= Name -> Name
evade (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ Name -> Name
bump Name
n
| Bool
otherwise
= Name
n
bump :: Name -> Name
bump :: Name -> Name
bump Name
n = String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Char
'f'Char -> ShowS
forall a. a -> [a] -> [a]
:Name -> String
nameBase Name
n
substTyVarBndrKinds :: Map Name Type -> [TyVarBndr_ flag] -> [TyVarBndr_ flag]
substTyVarBndrKinds :: Map Name Type -> [TyVarBndrUnit] -> [TyVarBndrUnit]
substTyVarBndrKinds Map Name Type
subst = (TyVarBndrUnit -> TyVarBndrUnit)
-> [TyVarBndrUnit] -> [TyVarBndrUnit]
forall a b. (a -> b) -> [a] -> [b]
map (Map Name Type -> TyVarBndrUnit -> TyVarBndrUnit
forall flag. Map Name Type -> TyVarBndrUnit -> TyVarBndrUnit
substTyVarBndrKind Map Name Type
subst)
substTyVarBndrKind :: Map Name Type -> TyVarBndr_ flag -> TyVarBndr_ flag
substTyVarBndrKind :: Map Name Type -> TyVarBndrUnit -> TyVarBndrUnit
substTyVarBndrKind Map Name Type
subst = (Type -> Type) -> TyVarBndrUnit -> TyVarBndrUnit
forall flag. (Type -> Type) -> TyVarBndrUnit -> TyVarBndrUnit
mapTVKind (Map Name Type -> Type -> Type
forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
subst)
combineSubstitutions :: Map Name Type -> Map Name Type -> Map Name Type
combineSubstitutions :: Map Name Type -> Map Name Type -> Map Name Type
combineSubstitutions Map Name Type
x Map Name Type
y = Map Name Type -> Map Name Type -> Map Name Type
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union ((Type -> Type) -> Map Name Type -> Map Name Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map Name Type -> Type -> Type
forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
y) Map Name Type
x) Map Name Type
y
unifyTypes :: [Type] -> Q (Map Name Type)
unifyTypes :: Cxt -> Q (Map Name Type)
unifyTypes [] = Map Name Type -> Q (Map Name Type)
forall (m :: * -> *) a. Monad m => a -> m a
return Map Name Type
forall k a. Map k a
Map.empty
unifyTypes (Type
t:Cxt
ts) =
do Type
t':Cxt
ts' <- (Type -> Q Type) -> Cxt -> Q Cxt
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type -> Q Type
resolveTypeSynonyms (Type
tType -> Cxt -> Cxt
forall a. a -> [a] -> [a]
:Cxt
ts)
let aux :: Map Name Type -> Type -> Either (Type, Type) (Map Name Type)
aux Map Name Type
sub Type
u =
do Map Name Type
sub' <- Type -> Type -> Either (Type, Type) (Map Name Type)
unify' (Map Name Type -> Type -> Type
forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
sub Type
t')
(Map Name Type -> Type -> Type
forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
sub Type
u)
Map Name Type -> Either (Type, Type) (Map Name Type)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Name Type -> Map Name Type -> Map Name Type
combineSubstitutions Map Name Type
sub Map Name Type
sub')
case (Map Name Type -> Type -> Either (Type, Type) (Map Name Type))
-> Map Name Type -> Cxt -> Either (Type, Type) (Map Name Type)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Map Name Type -> Type -> Either (Type, Type) (Map Name Type)
aux Map Name Type
forall k a. Map k a
Map.empty Cxt
ts' of
Right Map Name Type
m -> Map Name Type -> Q (Map Name Type)
forall (m :: * -> *) a. Monad m => a -> m a
return Map Name Type
m
Left (Type
x,Type
y) ->
String -> Q (Map Name Type)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q (Map Name Type)) -> String -> Q (Map Name Type)
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Unable to unify types "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Type -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Type
x
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" and "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Type -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Type
y
ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
""
unify' :: Type -> Type -> Either (Type,Type) (Map Name Type)
unify' :: Type -> Type -> Either (Type, Type) (Map Name Type)
unify' (VarT Name
n) (VarT Name
m) | Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
m = Map Name Type -> Either (Type, Type) (Map Name Type)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Name Type
forall k a. Map k a
Map.empty
unify' (VarT Name
n) Type
t | Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Type -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
t = (Type, Type) -> Either (Type, Type) (Map Name Type)
forall a b. a -> Either a b
Left (Name -> Type
VarT Name
n, Type
t)
| Bool
otherwise = Map Name Type -> Either (Type, Type) (Map Name Type)
forall a b. b -> Either a b
Right (Name -> Type -> Map Name Type
forall k a. k -> a -> Map k a
Map.singleton Name
n Type
t)
unify' Type
t (VarT Name
n) | Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Type -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
t = (Type, Type) -> Either (Type, Type) (Map Name Type)
forall a b. a -> Either a b
Left (Name -> Type
VarT Name
n, Type
t)
| Bool
otherwise = Map Name Type -> Either (Type, Type) (Map Name Type)
forall a b. b -> Either a b
Right (Name -> Type -> Map Name Type
forall k a. k -> a -> Map k a
Map.singleton Name
n Type
t)
unify' (AppT Type
f1 Type
x1) (AppT Type
f2 Type
x2) =
do Map Name Type
sub1 <- Type -> Type -> Either (Type, Type) (Map Name Type)
unify' Type
f1 Type
f2
Map Name Type
sub2 <- Type -> Type -> Either (Type, Type) (Map Name Type)
unify' (Map Name Type -> Type -> Type
forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
sub1 Type
x1) (Map Name Type -> Type -> Type
forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
sub1 Type
x2)
Map Name Type -> Either (Type, Type) (Map Name Type)
forall a b. b -> Either a b
Right (Map Name Type -> Map Name Type -> Map Name Type
combineSubstitutions Map Name Type
sub1 Map Name Type
sub2)
unify' (SigT Type
t Type
_) Type
u = Type -> Type -> Either (Type, Type) (Map Name Type)
unify' Type
t Type
u
unify' Type
t (SigT Type
u Type
_) = Type -> Type -> Either (Type, Type) (Map Name Type)
unify' Type
t Type
u
unify' Type
t Type
u
| Type
t Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
u = Map Name Type -> Either (Type, Type) (Map Name Type)
forall a b. b -> Either a b
Right Map Name Type
forall k a. Map k a
Map.empty
| Bool
otherwise = (Type, Type) -> Either (Type, Type) (Map Name Type)
forall a b. a -> Either a b
Left (Type
t,Type
u)
equalPred :: Type -> Type -> Pred
equalPred :: Type -> Type -> Type
equalPred Type
x Type
y =
#if MIN_VERSION_template_haskell(2,10,0)
Type -> Type -> Type
AppT (Type -> Type -> Type
AppT Type
EqualityT Type
x) Type
y
#else
EqualP x y
#endif
classPred :: Name -> [Type] -> Pred
classPred :: Name -> Cxt -> Type
classPred =
#if MIN_VERSION_template_haskell(2,10,0)
(Type -> Type -> Type) -> Type -> Cxt -> Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
AppT (Type -> Cxt -> Type) -> (Name -> Type) -> Name -> Cxt -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Type
ConT
#else
ClassP
#endif
asEqualPred :: Pred -> Maybe (Type,Type)
#if MIN_VERSION_template_haskell(2,10,0)
asEqualPred :: Type -> Maybe (Type, Type)
asEqualPred (Type
EqualityT `AppT` Type
x `AppT` Type
y) = (Type, Type) -> Maybe (Type, Type)
forall a. a -> Maybe a
Just (Type
x,Type
y)
asEqualPred (ConT Name
eq `AppT` Type
x `AppT` Type
y) | Name
eq Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
eqTypeName = (Type, Type) -> Maybe (Type, Type)
forall a. a -> Maybe a
Just (Type
x,Type
y)
#else
asEqualPred (EqualP x y) = Just (x,y)
#endif
asEqualPred Type
_ = Maybe (Type, Type)
forall a. Maybe a
Nothing
asClassPred :: Pred -> Maybe (Name, [Type])
#if MIN_VERSION_template_haskell(2,10,0)
asClassPred :: Type -> Maybe (Name, Cxt)
asClassPred Type
t =
case Type -> NonEmpty Type
decomposeType Type
t of
ConT Name
f :| Cxt
xs | Name
f Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
eqTypeName -> (Name, Cxt) -> Maybe (Name, Cxt)
forall a. a -> Maybe a
Just (Name
f,Cxt
xs)
NonEmpty Type
_ -> Maybe (Name, Cxt)
forall a. Maybe a
Nothing
#else
asClassPred (ClassP f xs) = Just (f,xs)
asClassPred _ = Nothing
#endif
type IsReifiedDec = Bool
isReified, isn'tReified :: IsReifiedDec
isReified :: Bool
isReified = Bool
True
isn'tReified :: Bool
isn'tReified = Bool
False
giveDIVarsStarKinds :: IsReifiedDec -> DatatypeInfo -> DatatypeInfo
Bool
isReified DatatypeInfo
info =
DatatypeInfo
info { datatypeVars :: [TyVarBndrUnit]
datatypeVars = (TyVarBndrUnit -> TyVarBndrUnit)
-> [TyVarBndrUnit] -> [TyVarBndrUnit]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> TyVarBndrUnit -> TyVarBndrUnit
giveTyVarBndrStarKind Bool
isReified) (DatatypeInfo -> [TyVarBndrUnit]
datatypeVars DatatypeInfo
info)
, datatypeInstTypes :: Cxt
datatypeInstTypes = (Type -> Type) -> Cxt -> Cxt
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Type -> Type
giveTypeStarKind Bool
isReified) (DatatypeInfo -> Cxt
datatypeInstTypes DatatypeInfo
info) }
giveCIVarsStarKinds :: IsReifiedDec -> ConstructorInfo -> ConstructorInfo
Bool
isReified ConstructorInfo
info =
ConstructorInfo
info { constructorVars :: [TyVarBndrUnit]
constructorVars = (TyVarBndrUnit -> TyVarBndrUnit)
-> [TyVarBndrUnit] -> [TyVarBndrUnit]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> TyVarBndrUnit -> TyVarBndrUnit
giveTyVarBndrStarKind Bool
isReified) (ConstructorInfo -> [TyVarBndrUnit]
constructorVars ConstructorInfo
info) }
giveTyVarBndrStarKind :: IsReifiedDec -> TyVarBndrUnit -> TyVarBndrUnit
giveTyVarBndrStarKind :: Bool -> TyVarBndrUnit -> TyVarBndrUnit
giveTyVarBndrStarKind Bool
isReified TyVarBndrUnit
tvb
| Bool
isReified
= (Name -> TyVarBndrUnit)
-> (Name -> Type -> TyVarBndrUnit)
-> TyVarBndrUnit
-> TyVarBndrUnit
forall r flag.
(Name -> r) -> (Name -> Type -> r) -> TyVarBndrUnit -> r
elimTV (\Name
n -> Name -> Type -> TyVarBndrUnit
kindedTV Name
n Type
starK) (\Name
_ Type
_ -> TyVarBndrUnit
tvb) TyVarBndrUnit
tvb
| Bool
otherwise
= TyVarBndrUnit
tvb
giveTypeStarKind :: IsReifiedDec -> Type -> Type
giveTypeStarKind :: Bool -> Type -> Type
giveTypeStarKind Bool
isReified Type
t
| Bool
isReified
= case Type
t of
VarT Name
n -> Type -> Type -> Type
SigT Type
t Type
starK
Type
_ -> Type
t
| Bool
otherwise
= Type
t
repair13618 :: DatatypeInfo -> Q DatatypeInfo
repair13618 :: DatatypeInfo -> Q DatatypeInfo
repair13618 DatatypeInfo
info =
do Map Name Type
s <- Map Name (Q Type) -> Q (Map Name Type)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
T.sequence ([(Name, Q Type)] -> Map Name (Q Type)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Name, Q Type)]
substList)
DatatypeInfo -> Q DatatypeInfo
forall (m :: * -> *) a. Monad m => a -> m a
return DatatypeInfo
info { datatypeCons :: [ConstructorInfo]
datatypeCons = Map Name Type -> [ConstructorInfo] -> [ConstructorInfo]
forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
s (DatatypeInfo -> [ConstructorInfo]
datatypeCons DatatypeInfo
info) }
where
used :: [Name]
used = [ConstructorInfo] -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables (DatatypeInfo -> [ConstructorInfo]
datatypeCons DatatypeInfo
info)
bound :: [Name]
bound = (TyVarBndrUnit -> Name) -> [TyVarBndrUnit] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndrUnit -> Name
forall flag. TyVarBndrUnit -> Name
tvName (DatatypeInfo -> [TyVarBndrUnit]
datatypeVars DatatypeInfo
info)
free :: [Name]
free = [Name]
used [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Name]
bound
substList :: [(Name, Q Type)]
substList =
[ (Name
u, Name -> [Name] -> Q Type
forall a. Show a => a -> [Name] -> Q Type
substEntry Name
u [Name]
vs)
| Name
u <- [Name]
free
, let vs :: [Name]
vs = [Name
v | Name
v <- [Name]
bound, Name -> String
nameBase Name
v String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> String
nameBase Name
u]
]
substEntry :: a -> [Name] -> Q Type
substEntry a
_ [Name
v] = Name -> Q Type
varT Name
v
substEntry a
u [] = String -> Q Type
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Impossible free variable: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
u)
substEntry a
u [Name]
_ = String -> Q Type
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Ambiguous free variable: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
u)
dataDCompat ::
CxtQ ->
Name ->
[TyVarBndrUnit] ->
[ConQ] ->
[Name] ->
DecQ
#if MIN_VERSION_template_haskell(2,12,0)
dataDCompat :: Q Cxt -> Name -> [TyVarBndrUnit] -> [ConQ] -> [Name] -> Q Dec
dataDCompat Q Cxt
c Name
n [TyVarBndrUnit]
ts [ConQ]
cs [Name]
ds =
Q Cxt
-> Name
-> [TyVarBndrUnit]
-> Maybe Type
-> [ConQ]
-> [DerivClauseQ]
-> Q Dec
dataD Q Cxt
c Name
n [TyVarBndrUnit]
ts Maybe Type
forall a. Maybe a
Nothing [ConQ]
cs
(if [Name] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
ds then [] else [Maybe DerivStrategy -> [Q Type] -> DerivClauseQ
derivClause Maybe DerivStrategy
forall a. Maybe a
Nothing ((Name -> Q Type) -> [Name] -> [Q Type]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Q Type
conT [Name]
ds)])
#elif MIN_VERSION_template_haskell(2,11,0)
dataDCompat c n ts cs ds =
dataD c n ts Nothing cs
(return (map ConT ds))
#else
dataDCompat = dataD
#endif
newtypeDCompat ::
CxtQ ->
Name ->
[TyVarBndrUnit] ->
ConQ ->
[Name] ->
DecQ
#if MIN_VERSION_template_haskell(2,12,0)
newtypeDCompat :: Q Cxt -> Name -> [TyVarBndrUnit] -> ConQ -> [Name] -> Q Dec
newtypeDCompat Q Cxt
c Name
n [TyVarBndrUnit]
ts ConQ
cs [Name]
ds =
Q Cxt
-> Name
-> [TyVarBndrUnit]
-> Maybe Type
-> ConQ
-> [DerivClauseQ]
-> Q Dec
newtypeD Q Cxt
c Name
n [TyVarBndrUnit]
ts Maybe Type
forall a. Maybe a
Nothing ConQ
cs
(if [Name] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
ds then [] else [Maybe DerivStrategy -> [Q Type] -> DerivClauseQ
derivClause Maybe DerivStrategy
forall a. Maybe a
Nothing ((Name -> Q Type) -> [Name] -> [Q Type]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Q Type
conT [Name]
ds)])
#elif MIN_VERSION_template_haskell(2,11,0)
newtypeDCompat c n ts cs ds =
newtypeD c n ts Nothing cs
(return (map ConT ds))
#else
newtypeDCompat = newtypeD
#endif
tySynInstDCompat ::
Name ->
Maybe [Q TyVarBndrUnit] ->
[TypeQ] ->
TypeQ ->
DecQ
#if MIN_VERSION_template_haskell(2,15,0)
tySynInstDCompat :: Name -> Maybe [Q TyVarBndrUnit] -> [Q Type] -> Q Type -> Q Dec
tySynInstDCompat Name
n Maybe [Q TyVarBndrUnit]
mtvbs [Q Type]
ps Q Type
r = TySynEqn -> Dec
TySynInstD (TySynEqn -> Dec) -> Q TySynEqn -> Q Dec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe [TyVarBndrUnit] -> Type -> Type -> TySynEqn
TySynEqn (Maybe [TyVarBndrUnit] -> Type -> Type -> TySynEqn)
-> Q (Maybe [TyVarBndrUnit]) -> Q (Type -> Type -> TySynEqn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Q TyVarBndrUnit] -> Q [TyVarBndrUnit])
-> Maybe [Q TyVarBndrUnit] -> Q (Maybe [TyVarBndrUnit])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Q TyVarBndrUnit] -> Q [TyVarBndrUnit]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence Maybe [Q TyVarBndrUnit]
mtvbs
Q (Type -> Type -> TySynEqn) -> Q Type -> Q (Type -> TySynEqn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Q Type -> Q Type -> Q Type) -> Q Type -> [Q Type] -> Q Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Q Type -> Q Type -> Q Type
appT (Name -> Q Type
conT Name
n) [Q Type]
ps
Q (Type -> TySynEqn) -> Q Type -> Q TySynEqn
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Q Type
r)
#elif MIN_VERSION_template_haskell(2,9,0)
tySynInstDCompat n _ ps r = TySynInstD n <$> (TySynEqn <$> sequence ps <*> r)
#else
tySynInstDCompat n _ = tySynInstD n
#endif
pragLineDCompat ::
Int ->
String ->
Maybe DecQ
#if MIN_VERSION_template_haskell(2,10,0)
pragLineDCompat :: Int -> String -> Maybe (Q Dec)
pragLineDCompat Int
ln String
fn = Q Dec -> Maybe (Q Dec)
forall a. a -> Maybe a
Just (Int -> String -> Q Dec
pragLineD Int
ln String
fn)
#else
pragLineDCompat _ _ = Nothing
#endif
arrowKCompat :: Kind -> Kind -> Kind
#if MIN_VERSION_template_haskell(2,8,0)
arrowKCompat :: Type -> Type -> Type
arrowKCompat Type
x Type
y = Type
arrowK Type -> Type -> Type
`appK` Type
x Type -> Type -> Type
`appK` Type
y
#else
arrowKCompat = arrowK
#endif
reifyFixityCompat :: Name -> Q (Maybe Fixity)
#if MIN_VERSION_template_haskell(2,11,0)
reifyFixityCompat :: Name -> Q (Maybe Fixity)
reifyFixityCompat Name
n = Q (Maybe Fixity) -> Q (Maybe Fixity) -> Q (Maybe Fixity)
forall a. Q a -> Q a -> Q a
recover (Maybe Fixity -> Q (Maybe Fixity)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Fixity
forall a. Maybe a
Nothing) ((Maybe Fixity -> Maybe Fixity -> Maybe Fixity
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Fixity -> Maybe Fixity
forall a. a -> Maybe a
Just Fixity
defaultFixity) (Maybe Fixity -> Maybe Fixity)
-> Q (Maybe Fixity) -> Q (Maybe Fixity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Q (Maybe Fixity)
reifyFixity Name
n)
#else
reifyFixityCompat n = recover (return Nothing) $
do info <- reify n
return $! case info of
ClassOpI _ _ _ fixity -> Just fixity
DataConI _ _ _ fixity -> Just fixity
VarI _ _ _ fixity -> Just fixity
_ -> Nothing
#endif
reifyMaybe :: Name -> Q (Maybe Info)
reifyMaybe :: Name -> Q (Maybe Info)
reifyMaybe Name
n = Maybe Info -> Q (Maybe Info)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Info
forall a. Maybe a
Nothing Q (Maybe Info) -> Q (Maybe Info) -> Q (Maybe Info)
forall a. Q a -> Q a -> Q a
`recover` (Info -> Maybe Info) -> Q Info -> Q (Maybe Info)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Info -> Maybe Info
forall a. a -> Maybe a
Just (Name -> Q Info
reify Name
n)