{-# 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 -> [Type]
datatypeContext :: Cxt
, DatatypeInfo -> Name
datatypeName :: Name
, DatatypeInfo -> [TyVarBndrUnit]
datatypeVars :: [TyVarBndrUnit]
, DatatypeInfo -> [Type]
datatypeInstTypes :: [Type]
, DatatypeInfo -> DatatypeVariant
datatypeVariant :: DatatypeVariant
, DatatypeInfo -> [ConstructorInfo]
datatypeCons :: [ConstructorInfo]
}
deriving (Int -> DatatypeInfo -> ShowS
[DatatypeInfo] -> ShowS
DatatypeInfo -> String
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
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
DatatypeInfo -> DataType
DatatypeInfo -> Constr
(forall b. Data b => b -> b) -> DatatypeInfo -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> DatatypeInfo -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DatatypeInfo -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> DatatypeInfo -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DatatypeInfo -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data
#ifdef HAS_GENERICS
,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
| TypeData
deriving (Int -> DatatypeVariant -> ShowS
[DatatypeVariant] -> ShowS
DatatypeVariant -> String
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]
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
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
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
Ord, Typeable, Typeable DatatypeVariant
DatatypeVariant -> DataType
DatatypeVariant -> Constr
(forall b. Data b => b -> b) -> DatatypeVariant -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u.
Int -> (forall d. Data d => d -> u) -> DatatypeVariant -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DatatypeVariant -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> DatatypeVariant -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DatatypeVariant -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data
#ifdef HAS_GENERICS
,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 -> [Type]
constructorContext :: Cxt
, ConstructorInfo -> [Type]
constructorFields :: [Type]
, ConstructorInfo -> [FieldStrictness]
constructorStrictness :: [FieldStrictness]
, ConstructorInfo -> ConstructorVariant
constructorVariant :: ConstructorVariant
}
deriving (Int -> ConstructorInfo -> ShowS
[ConstructorInfo] -> ShowS
ConstructorInfo -> String
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
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
ConstructorInfo -> DataType
ConstructorInfo -> Constr
(forall b. Data b => b -> b) -> ConstructorInfo -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u.
Int -> (forall d. Data d => d -> u) -> ConstructorInfo -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ConstructorInfo -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ConstructorInfo -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ConstructorInfo -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data
#ifdef HAS_GENERICS
,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
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
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
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
Ord, Typeable, Typeable ConstructorVariant
ConstructorVariant -> DataType
ConstructorVariant -> Constr
(forall b. Data b => b -> b)
-> ConstructorVariant -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u.
Int -> (forall d. Data d => d -> u) -> ConstructorVariant -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ConstructorVariant -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ConstructorVariant -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ConstructorVariant -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data
#ifdef HAS_GENERICS
,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
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
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
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
Ord, Typeable, Typeable FieldStrictness
FieldStrictness -> DataType
FieldStrictness -> Constr
(forall b. Data b => b -> b) -> FieldStrictness -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u.
Int -> (forall d. Data d => d -> u) -> FieldStrictness -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FieldStrictness -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> FieldStrictness -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FieldStrictness -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data
#ifdef HAS_GENERICS
,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
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
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
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
Ord, Typeable, Typeable Unpackedness
Unpackedness -> DataType
Unpackedness -> Constr
(forall b. Data b => b -> b) -> Unpackedness -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> Unpackedness -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Unpackedness -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Unpackedness -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Unpackedness -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data
#ifdef HAS_GENERICS
,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
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
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
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
Ord, Typeable, Typeable Strictness
Strictness -> DataType
Strictness -> Constr
(forall b. Data b => b -> b) -> Strictness -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> Strictness -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Strictness -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Strictness -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Strictness -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data
#ifdef HAS_GENERICS
,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
= 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))
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Type -> Type
stripSigT
forall a b. (a -> b) -> a -> b
$ DatatypeInfo -> [Type]
datatypeInstTypes DatatypeInfo
di
reifyDatatype ::
Name ->
Q DatatypeInfo
reifyDatatype :: Name -> Q DatatypeInfo
reifyDatatype Name
n = String -> Bool -> Info -> Q DatatypeInfo
normalizeInfo' String
"reifyDatatype" Bool
isReified 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
forall (m :: * -> *) a. Monad m => a -> m a
return 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
forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== Name
conName) 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 -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Datatype " forall a. [a] -> [a] -> [a]
++ Name -> String
nameBase (DatatypeInfo -> Name
datatypeName DatatypeInfo
dataInfo)
forall a. [a] -> [a] -> [a]
++ String
" does not have a constructor named " forall a. [a] -> [a] -> [a]
++ Name -> String
nameBase Name
conName
lookupByRecordName ::
Name ->
DatatypeInfo ->
ConstructorInfo
lookupByRecordName :: Name -> DatatypeInfo -> ConstructorInfo
lookupByRecordName Name
recordName DatatypeInfo
dataInfo =
case 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 -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Datatype " forall a. [a] -> [a] -> [a]
++ Name -> String
nameBase (DatatypeInfo -> Name
datatypeName DatatypeInfo
dataInfo)
forall a. [a] -> [a] -> [a]
++ String
" does not have any constructors with a "
forall a. [a] -> [a] -> [a]
++ String
"record selector named " 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{} -> forall {m :: * -> *} {a}. MonadFail m => String -> m a
bad String
"Primitive type not supported"
ClassI{} -> 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
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]
_ -> 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
_ -> forall {m :: * -> *} {a}. MonadFail m => String -> m a
bad String
"Expected a type constructor"
where
bad :: String -> m a
bad String
msg = forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
entry forall a. [a] -> [a] -> [a]
++ String
": " 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` 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 ([TyVarBndrSpec]
_, [Type]
_, [Type]
argTys :|- Type
_) = Type -> ([TyVarBndrSpec], [Type], NonEmptySnoc Type)
uncurryType Type
recTy
in case [Type]
argTys of
Type
dataTy:[Type]
_ -> Type -> Q DatatypeInfo
decomposeDataType Type
dataTy
[Type]
_ -> 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 :| [Type]
_ -> String -> (DatatypeInfo -> Bool) -> Name -> Q DatatypeInfo
reifyParentWith String
"reifyRecordType" DatatypeInfo -> Bool
p Name
parent
NonEmpty Type
_ -> forall a. Q a
notRecSelFailure
notRecSelFailure :: Q a
notRecSelFailure :: forall a. Q a
notRecSelFailure = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
String
"reifyRecordType: Not a record selector type: " forall a. [a] -> [a] -> [a]
++
Name -> String
nameBase Name
recName forall a. [a] -> [a] -> [a]
++ String
" :: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Type
recTy
p :: DatatypeInfo -> Bool
p :: DatatypeInfo -> Bool
p DatatypeInfo
info = 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 <- 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 <- 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 forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find DatatypeInfo -> Bool
p [DatatypeInfo]
instances2 of
Just DatatypeInfo
inst -> forall (m :: * -> *) a. Monad m => a -> m a
return DatatypeInfo
inst
Maybe DatatypeInfo
Nothing -> forall a. String -> Q a
panic String
"lost the instance"
#endif
Info
_ -> forall a. String -> Q a
panic String
"unexpected parent"
where
dataFamiliesOnOldGHCsError :: Q a
dataFamiliesOnOldGHCsError :: forall a. Q a
dataFamiliesOnOldGHCsError = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
String
prefix forall a. [a] -> [a] -> [a]
++ String
": Data family instances can only be reified with GHC 7.4 or later"
panic :: String -> Q a
panic :: forall a. String -> Q a
panic String
message = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"PANIC: " forall a. [a] -> [a] -> [a]
++ String
prefix forall a. [a] -> [a] -> [a]
++ String
" " 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 [Type]
cx Maybe [TyVarBndrUnit]
mbInstVars Type
nts Maybe Type
k Con
c [DerivClause]
deriv <- Dec
instD
, Type
con :| [Type]
ts <- Type -> NonEmpty Type
decomposeType Type
nts
= do [Type]
ts' <- [TyVarBndrUnit] -> Maybe Type -> [Type] -> Q [Type]
repairVarKindsWith [TyVarBndrUnit]
dvars Maybe Type
dk [Type]
ts
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Type]
-> Maybe [TyVarBndrUnit]
-> Type
-> Maybe Type
-> Con
-> [DerivClause]
-> Dec
NewtypeInstD [Type]
cx Maybe [TyVarBndrUnit]
mbInstVars (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Type -> Type -> Type
AppT Type
con [Type]
ts') Maybe Type
k Con
c [DerivClause]
deriv
| DataFamilyD Name
_ [TyVarBndrUnit]
dvars Maybe Type
dk <- Dec
famD
, DataInstD [Type]
cx Maybe [TyVarBndrUnit]
mbInstVars Type
nts Maybe Type
k [Con]
c [DerivClause]
deriv <- Dec
instD
, Type
con :| [Type]
ts <- Type -> NonEmpty Type
decomposeType Type
nts
= do [Type]
ts' <- [TyVarBndrUnit] -> Maybe Type -> [Type] -> Q [Type]
repairVarKindsWith [TyVarBndrUnit]
dvars Maybe Type
dk [Type]
ts
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Type]
-> Maybe [TyVarBndrUnit]
-> Type
-> Maybe Type
-> [Con]
-> [DerivClause]
-> Dec
DataInstD [Type]
cx Maybe [TyVarBndrUnit]
mbInstVars (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Type -> Type -> Type
AppT Type
con [Type]
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 = forall (m :: * -> *) a. Monad m => a -> m a
return Dec
instD
repairVarKindsWith :: [TyVarBndrUnit] -> Maybe Kind -> [Type] -> Q [Type]
repairVarKindsWith :: [TyVarBndrUnit] -> Maybe Type -> [Type] -> Q [Type]
repairVarKindsWith [TyVarBndrUnit]
tvbs Maybe Type
mbKind [Type]
ts = do
[TyVarBndrUnit]
extra_tvbs <- Type -> Q [TyVarBndrUnit]
mkExtraKindBinders forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Type
starK Maybe Type
mbKind
let tvbs' :: [TyVarBndrUnit]
tvbs' = [TyVarBndrUnit]
tvbs forall a. [a] -> [a] -> [a]
++ [TyVarBndrUnit]
extra_tvbs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall flag. TyVarBndr_ flag -> Type -> Type
stealKindForType [TyVarBndrUnit]
tvbs' [Type]
ts
stealKindForType :: TyVarBndr_ flag -> Type -> Type
stealKindForType :: forall flag. TyVarBndr_ flag -> Type -> Type
stealKindForType TyVarBndr_ flag
tvb t :: Type
t@VarT{} = Type -> Type -> Type
SigT Type
t (forall flag. TyVarBndr_ flag -> Type
tvKind TyVarBndr_ flag
tvb)
stealKindForType TyVarBndr_ flag
_ 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,20,0)
TypeDataD name tyvars mbKind cons ->
normalizeDataD [] name tyvars mbKind cons TypeData
#endif
#if MIN_VERSION_template_haskell(2,12,0)
NewtypeD [Type]
context Name
name [TyVarBndrUnit]
tyvars Maybe Type
mbKind Con
con [DerivClause]
_derives ->
[Type]
-> Name
-> [TyVarBndrUnit]
-> Maybe Type
-> [Con]
-> DatatypeVariant
-> Q DatatypeInfo
normalizeDataD [Type]
context Name
name [TyVarBndrUnit]
tyvars Maybe Type
mbKind [Con
con] DatatypeVariant
Newtype
DataD [Type]
context Name
name [TyVarBndrUnit]
tyvars Maybe Type
mbKind [Con]
cons [DerivClause]
_derives ->
[Type]
-> Name
-> [TyVarBndrUnit]
-> Maybe Type
-> [Con]
-> DatatypeVariant
-> Q DatatypeInfo
normalizeDataD [Type]
context Name
name [TyVarBndrUnit]
tyvars Maybe Type
mbKind [Con]
cons DatatypeVariant
Datatype
# if MIN_VERSION_template_haskell(2,15,0)
NewtypeInstD [Type]
context Maybe [TyVarBndrUnit]
mbTyvars Type
nameInstTys Maybe Type
mbKind Con
con [DerivClause]
_derives ->
String
-> [Type]
-> Maybe [TyVarBndrUnit]
-> Type
-> Maybe Type
-> [Con]
-> DatatypeVariant
-> Q DatatypeInfo
normalizeDataInstDPostTH2'15 String
"newtype" [Type]
context Maybe [TyVarBndrUnit]
mbTyvars Type
nameInstTys
Maybe Type
mbKind [Con
con] DatatypeVariant
NewtypeInstance
DataInstD [Type]
context Maybe [TyVarBndrUnit]
mbTyvars Type
nameInstTys Maybe Type
mbKind [Con]
cons [DerivClause]
_derives ->
String
-> [Type]
-> Maybe [TyVarBndrUnit]
-> Type
-> Maybe Type
-> [Con]
-> DatatypeVariant
-> Q DatatypeInfo
normalizeDataInstDPostTH2'15 String
"data" [Type]
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
_ -> 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
= forall (m :: * -> *) a. Monad m => a -> m a
return DatatypeInfo
di
datatypeFreeVars :: [Type] -> Maybe Kind -> [TyVarBndrUnit]
datatypeFreeVars :: [Type] -> Maybe Type -> [TyVarBndrUnit]
datatypeFreeVars [Type]
instTys Maybe Type
mbKind =
[Type] -> [TyVarBndrUnit]
freeVariablesWellScoped forall a b. (a -> b) -> a -> b
$ [Type]
instTys forall a. [a] -> [a] -> [a]
++
#if MIN_VERSION_template_haskell(2,8,0)
forall a. Maybe a -> [a]
maybeToList Maybe Type
mbKind
#else
[]
#endif
normalizeDataD :: Cxt -> Name -> [TyVarBndrUnit] -> Maybe Kind
-> [Con] -> DatatypeVariant -> Q DatatypeInfo
normalizeDataD :: [Type]
-> Name
-> [TyVarBndrUnit]
-> Maybe Type
-> [Con]
-> DatatypeVariant
-> Q DatatypeInfo
normalizeDataD [Type]
context Name
name [TyVarBndrUnit]
tyvars Maybe Type
mbKind [Con]
cons DatatypeVariant
variant =
let params :: [Type]
params = forall flag. [TyVarBndr_ flag] -> [Type]
bndrParams [TyVarBndrUnit]
tyvars in
[Type]
-> Name
-> [TyVarBndrUnit]
-> [Type]
-> Maybe Type
-> [Con]
-> DatatypeVariant
-> Q DatatypeInfo
normalize' [Type]
context Name
name ([Type] -> Maybe Type -> [TyVarBndrUnit]
datatypeFreeVars [Type]
params Maybe Type
mbKind)
[Type]
params Maybe Type
mbKind [Con]
cons DatatypeVariant
variant
normalizeDataInstDPostTH2'15
:: String -> Cxt -> Maybe [TyVarBndrUnit] -> Type -> Maybe Kind
-> [Con] -> DatatypeVariant -> Q DatatypeInfo
normalizeDataInstDPostTH2'15 :: String
-> [Type]
-> Maybe [TyVarBndrUnit]
-> Type
-> Maybe Type
-> [Con]
-> DatatypeVariant
-> Q DatatypeInfo
normalizeDataInstDPostTH2'15 String
what [Type]
context Maybe [TyVarBndrUnit]
mbTyvars Type
nameInstTys
Maybe Type
mbKind [Con]
cons DatatypeVariant
variant =
case Type -> NonEmpty Type
decomposeType Type
nameInstTys of
ConT Name
name :| [Type]
instTys ->
[Type]
-> Name
-> [TyVarBndrUnit]
-> [Type]
-> Maybe Type
-> [Con]
-> DatatypeVariant
-> Q DatatypeInfo
normalize' [Type]
context Name
name
(forall a. a -> Maybe a -> a
fromMaybe ([Type] -> Maybe Type -> [TyVarBndrUnit]
datatypeFreeVars [Type]
instTys Maybe Type
mbKind) Maybe [TyVarBndrUnit]
mbTyvars)
[Type]
instTys Maybe Type
mbKind [Con]
cons DatatypeVariant
variant
NonEmpty Type
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unexpected " forall a. [a] -> [a] -> [a]
++ String
what forall a. [a] -> [a] -> [a]
++ String
" instance head: " forall a. [a] -> [a] -> [a]
++ forall a. Ppr a => a -> String
pprint Type
nameInstTys
normalizeDataInstDPreTH2'15
:: Cxt -> Name -> [Type] -> Maybe Kind
-> [Con] -> DatatypeVariant -> Q DatatypeInfo
normalizeDataInstDPreTH2'15 :: [Type]
-> Name
-> [Type]
-> Maybe Type
-> [Con]
-> DatatypeVariant
-> Q DatatypeInfo
normalizeDataInstDPreTH2'15 [Type]
context Name
name [Type]
instTys Maybe Type
mbKind [Con]
cons DatatypeVariant
variant =
[Type]
-> Name
-> [TyVarBndrUnit]
-> [Type]
-> Maybe Type
-> [Con]
-> DatatypeVariant
-> Q DatatypeInfo
normalize' [Type]
context Name
name ([Type] -> Maybe Type -> [TyVarBndrUnit]
datatypeFreeVars [Type]
instTys Maybe Type
mbKind)
[Type]
instTys Maybe Type
mbKind [Con]
cons DatatypeVariant
variant
normalize' :: Cxt -> Name -> [TyVarBndrUnit] -> [Type] -> Maybe Kind
-> [Con] -> DatatypeVariant -> Q DatatypeInfo
normalize' :: [Type]
-> Name
-> [TyVarBndrUnit]
-> [Type]
-> Maybe Type
-> [Con]
-> DatatypeVariant
-> Q DatatypeInfo
normalize' [Type]
context Name
name [TyVarBndrUnit]
tvbs [Type]
instTys Maybe Type
mbKind [Con]
cons DatatypeVariant
variant = do
[TyVarBndrUnit]
extra_tvbs <- Type -> Q [TyVarBndrUnit]
mkExtraKindBinders forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Type
starK Maybe Type
mbKind
let tvbs' :: [TyVarBndrUnit]
tvbs' = [TyVarBndrUnit]
tvbs forall a. [a] -> [a] -> [a]
++ [TyVarBndrUnit]
extra_tvbs
instTys' :: [Type]
instTys' = [Type]
instTys forall a. [a] -> [a] -> [a]
++ forall flag. [TyVarBndr_ flag] -> [Type]
bndrParams [TyVarBndrUnit]
extra_tvbs
DatatypeInfo
dec <- Bool
-> [Type]
-> Name
-> [TyVarBndrUnit]
-> [Type]
-> [Con]
-> DatatypeVariant
-> Q DatatypeInfo
normalizeDec' Bool
isReified [Type]
context Name
name [TyVarBndrUnit]
tvbs' [Type]
instTys' [Con]
cons DatatypeVariant
variant
DatatypeInfo -> Q DatatypeInfo
repair13618' 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 ([TyVarBndrSpec]
_, [Type]
_, [Type]
args :|- Type
_) = Type -> ([TyVarBndrSpec], [Type], NonEmptySnoc Type)
uncurryKind Type
kind'
[Name]
names <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
args) (forall (m :: * -> *). Quote m => String -> m Name
newName String
"x")
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Name -> Type -> TyVarBndrUnit
kindedTV [Name]
names [Type]
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
DatatypeVariant
TypeData -> Bool
False
bndrParams :: [TyVarBndr_ flag] -> [Type]
bndrParams :: forall flag. [TyVarBndr_ flag] -> [Type]
bndrParams = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ forall r flag.
(Name -> r) -> (Name -> Type -> r) -> TyVarBndr_ flag -> 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
-> [Type]
-> Name
-> [TyVarBndrUnit]
-> [Type]
-> [Con]
-> DatatypeVariant
-> Q DatatypeInfo
normalizeDec' Bool
reifiedDec [Type]
context Name
name [TyVarBndrUnit]
params [Type]
instTys [Con]
cons DatatypeVariant
variant =
do [ConstructorInfo]
cons' <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool
-> Name
-> [TyVarBndrUnit]
-> [Type]
-> DatatypeVariant
-> Con
-> Q [ConstructorInfo]
normalizeConFor Bool
reifiedDec Name
name [TyVarBndrUnit]
params [Type]
instTys DatatypeVariant
variant) [Con]
cons
forall (m :: * -> *) a. Monad m => a -> m a
return DatatypeInfo
{ datatypeContext :: [Type]
datatypeContext = [Type]
context
, datatypeName :: Name
datatypeName = Name
name
, datatypeVars :: [TyVarBndrUnit]
datatypeVars = [TyVarBndrUnit]
params
, datatypeInstTypes :: [Type]
datatypeInstTypes = [Type]
instTys
, datatypeCons :: [ConstructorInfo]
datatypeCons = [ConstructorInfo]
cons'
, datatypeVariant :: DatatypeVariant
datatypeVariant = DatatypeVariant
variant
}
normalizeCon ::
Name ->
[TyVarBndrUnit] ->
[Type] ->
DatatypeVariant ->
Con ->
Q [ConstructorInfo]
normalizeCon :: Name
-> [TyVarBndrUnit]
-> [Type]
-> DatatypeVariant
-> Con
-> Q [ConstructorInfo]
normalizeCon = Bool
-> Name
-> [TyVarBndrUnit]
-> [Type]
-> DatatypeVariant
-> Con
-> Q [ConstructorInfo]
normalizeConFor Bool
isn'tReified
normalizeConFor ::
IsReifiedDec ->
Name ->
[TyVarBndrUnit] ->
[Type] ->
DatatypeVariant ->
Con ->
Q [ConstructorInfo]
normalizeConFor :: Bool
-> Name
-> [TyVarBndrUnit]
-> [Type]
-> DatatypeVariant
-> Con
-> Q [ConstructorInfo]
normalizeConFor Bool
reifiedDec Name
typename [TyVarBndrUnit]
params [Type]
instTys DatatypeVariant
variant =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map (Bool -> ConstructorInfo -> ConstructorInfo
giveCIVarsStarKinds Bool
reifiedDec)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Con -> Q [ConstructorInfo]
dispatch
where
checkGadtFixity :: [Type] -> Name -> Q ConstructorVariant
checkGadtFixity :: [Type] -> Name -> Q ConstructorVariant
checkGadtFixity [Type]
ts Name
n = do
#if MIN_VERSION_template_haskell(2,11,0)
Maybe Fixity
mbFi <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing forall a. Q a -> Q a -> Q a
`recover` Name -> Q (Maybe Fixity)
reifyFixity Name
n
let userSuppliedFixity :: Bool
userSuppliedFixity = forall a. Maybe a -> Bool
isJust Maybe Fixity
mbFi
#else
mbFi <- reifyFixityCompat n
let userSuppliedFixity = isJust mbFi && mbFi /= Just defaultFixity
#endif
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if String -> Bool
isInfixDataCon (Name -> String
nameBase Name
n)
Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
ts 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] -> [Type] -> Bool -> Con -> Q [ConstructorInfo]
go [] [] Bool
False
where
go :: [TyVarBndrUnit]
-> Cxt
-> Bool
-> Con
-> Q [ConstructorInfo]
go :: [TyVarBndrUnit] -> [Type] -> Bool -> Con -> Q [ConstructorInfo]
go [TyVarBndrUnit]
tyvars [Type]
context Bool
gadt Con
c =
case Con
c of
NormalC Name
n [BangType]
xs -> do
let ([Bang]
bangs, [Type]
ts) = forall a b. [(a, b)] -> ([a], [b])
unzip [BangType]
xs
stricts :: [FieldStrictness]
stricts = forall a b. (a -> b) -> [a] -> [b]
map Bang -> FieldStrictness
normalizeStrictness [Bang]
bangs
ConstructorVariant
fi <- if Bool
gadt
then [Type] -> Name -> Q ConstructorVariant
checkGadtFixity [Type]
ts Name
n
else forall (m :: * -> *) a. Monad m => a -> m a
return ConstructorVariant
NormalConstructor
forall (m :: * -> *) a. Monad m => a -> m a
return [Name
-> [TyVarBndrUnit]
-> [Type]
-> [Type]
-> [FieldStrictness]
-> ConstructorVariant
-> ConstructorInfo
ConstructorInfo Name
n [TyVarBndrUnit]
tyvars [Type]
context [Type]
ts [FieldStrictness]
stricts ConstructorVariant
fi]
InfixC BangType
l Name
n BangType
r ->
let ([Bang]
bangs, [Type]
ts) = forall a b. [(a, b)] -> ([a], [b])
unzip [BangType
l,BangType
r]
stricts :: [FieldStrictness]
stricts = forall a b. (a -> b) -> [a] -> [b]
map Bang -> FieldStrictness
normalizeStrictness [Bang]
bangs in
forall (m :: * -> *) a. Monad m => a -> m a
return [Name
-> [TyVarBndrUnit]
-> [Type]
-> [Type]
-> [FieldStrictness]
-> ConstructorVariant
-> ConstructorInfo
ConstructorInfo Name
n [TyVarBndrUnit]
tyvars [Type]
context [Type]
ts [FieldStrictness]
stricts
ConstructorVariant
InfixConstructor]
RecC Name
n [VarBangType]
xs ->
let fns :: [Name]
fns = forall a b. [(Name, a, b)] -> [Name]
takeFieldNames [VarBangType]
xs
stricts :: [FieldStrictness]
stricts = forall a b. [(a, Bang, b)] -> [FieldStrictness]
takeFieldStrictness [VarBangType]
xs in
forall (m :: * -> *) a. Monad m => a -> m a
return [Name
-> [TyVarBndrUnit]
-> [Type]
-> [Type]
-> [FieldStrictness]
-> ConstructorVariant
-> ConstructorInfo
ConstructorInfo Name
n [TyVarBndrUnit]
tyvars [Type]
context
(forall a b. [(a, b, Type)] -> [Type]
takeFieldTypes [VarBangType]
xs) [FieldStrictness]
stricts ([Name] -> ConstructorVariant
RecordConstructor [Name]
fns)]
ForallC [TyVarBndrSpec]
tyvars' [Type]
context' Con
c' ->
[TyVarBndrUnit] -> [Type] -> Bool -> Con -> Q [ConstructorInfo]
go (forall newFlag oldFlag.
newFlag -> [TyVarBndr_ oldFlag] -> [TyVarBndr_ newFlag]
changeTVFlags () [TyVarBndrSpec]
tyvars'forall a. [a] -> [a] -> [a]
++[TyVarBndrUnit]
tyvars) ([Type]
context'forall a. [a] -> [a] -> [a]
++[Type]
context) Bool
True Con
c'
#if MIN_VERSION_template_haskell(2,11,0)
GadtC [Name]
ns [BangType]
xs Type
innerType ->
let ([Bang]
bangs, [Type]
ts) = forall a b. [(a, b)] -> ([a], [b])
unzip [BangType]
xs
stricts :: [FieldStrictness]
stricts = forall a b. (a -> b) -> [a] -> [b]
map Bang -> FieldStrictness
normalizeStrictness [Bang]
bangs in
[Name]
-> Type
-> [Type]
-> [FieldStrictness]
-> (Name -> Q ConstructorVariant)
-> Q [ConstructorInfo]
gadtCase [Name]
ns Type
innerType [Type]
ts [FieldStrictness]
stricts ([Type] -> Name -> Q ConstructorVariant
checkGadtFixity [Type]
ts)
RecGadtC [Name]
ns [VarBangType]
xs Type
innerType ->
let fns :: [Name]
fns = forall a b. [(Name, a, b)] -> [Name]
takeFieldNames [VarBangType]
xs
stricts :: [FieldStrictness]
stricts = forall a b. [(a, Bang, b)] -> [FieldStrictness]
takeFieldStrictness [VarBangType]
xs in
[Name]
-> Type
-> [Type]
-> [FieldStrictness]
-> (Name -> Q ConstructorVariant)
-> Q [ConstructorInfo]
gadtCase [Name]
ns Type
innerType (forall a b. [(a, b, Type)] -> [Type]
takeFieldTypes [VarBangType]
xs) [FieldStrictness]
stricts
(forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Name] -> ConstructorVariant
RecordConstructor [Name]
fns)
where
gadtCase :: [Name]
-> Type
-> [Type]
-> [FieldStrictness]
-> (Name -> Q ConstructorVariant)
-> Q [ConstructorInfo]
gadtCase = Name
-> [TyVarBndrUnit]
-> [Type]
-> [TyVarBndrUnit]
-> [Type]
-> [Name]
-> Type
-> [Type]
-> [FieldStrictness]
-> (Name -> Q ConstructorVariant)
-> Q [ConstructorInfo]
normalizeGadtC Name
typename [TyVarBndrUnit]
params [Type]
instTys [TyVarBndrUnit]
tyvars [Type]
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]
-> [Type]
-> [TyVarBndrUnit]
-> [Type]
-> [Name]
-> Type
-> [Type]
-> [FieldStrictness]
-> (Name -> Q ConstructorVariant)
-> Q [ConstructorInfo]
normalizeGadtC Name
typename [TyVarBndrUnit]
params [Type]
instTys [TyVarBndrUnit]
tyvars [Type]
context [Name]
names Type
innerType
[Type]
fields [FieldStrictness]
stricts Name -> Q ConstructorVariant
getVariant =
do
let implicitTyvars :: [TyVarBndrUnit]
implicitTyvars = [Type] -> [TyVarBndrUnit]
freeVariablesWellScoped
[[TyVarBndrSpec] -> [Type] -> [Type] -> Type -> Type
curryType (forall newFlag oldFlag.
newFlag -> [TyVarBndr_ oldFlag] -> [TyVarBndr_ newFlag]
changeTVFlags Specificity
SpecifiedSpec [TyVarBndrUnit]
tyvars)
[Type]
context [Type]
fields Type
innerType]
allTyvars :: [TyVarBndrUnit]
allTyvars = [TyVarBndrUnit]
implicitTyvars forall a. [a] -> [a] -> [a]
++ [TyVarBndrUnit]
tyvars
let conBoundNames :: [Name]
conBoundNames =
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\TyVarBndrUnit
tvb -> forall flag. TyVarBndr_ flag -> Name
tvName TyVarBndrUnit
tvbforall a. a -> [a] -> [a]
:forall a. TypeSubstitution a => a -> [Name]
freeVariables (forall flag. TyVarBndr_ flag -> Type
tvKind TyVarBndrUnit
tvb)) [TyVarBndrUnit]
allTyvars
Map Name Name
conSubst <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
T.sequence forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (Name
n, forall (m :: * -> *). Quote m => String -> m Name
newName (Name -> String
nameBase Name
n))
| Name
n <- [Name]
conBoundNames ]
let conSubst' :: Map Name Type
conSubst' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> Type
VarT Map Name Name
conSubst
renamedTyvars :: [TyVarBndrUnit]
renamedTyvars =
forall a b. (a -> b) -> [a] -> [b]
map (forall r flag.
(Name -> r) -> (Name -> Type -> r) -> TyVarBndr_ flag -> r
elimTV (\Name
n -> Name -> TyVarBndrUnit
plainTV (Map Name Name
conSubst 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 forall k a. Ord k => Map k a -> k -> a
Map.! Name
n)
(forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
conSubst' Type
k))) [TyVarBndrUnit]
allTyvars
renamedContext :: [Type]
renamedContext = forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
conSubst' [Type]
context
renamedInnerType :: Type
renamedInnerType = forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
conSubst' Type
innerType
renamedFields :: [Type]
renamedFields = forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
conSubst' [Type]
fields
Type
innerType' <- Type -> Q Type
resolveTypeSynonyms Type
renamedInnerType
case Type -> NonEmpty Type
decomposeType Type
innerType' of
ConT Name
innerTyCon :| [Type]
ts | Name
typename forall a. Eq a => a -> a -> Bool
== Name
innerTyCon ->
let (Map Name Name
substName, [Type]
context1) =
Map Name Type
-> Map Name Type
-> (Map Name Name, [Type])
-> (Map Name Name, [Type])
closeOverKinds (forall flag. [TyVarBndr_ flag] -> Map Name Type
kindsOfFVsOfTvbs [TyVarBndrUnit]
renamedTyvars)
(forall flag. [TyVarBndr_ flag] -> Map Name Type
kindsOfFVsOfTvbs [TyVarBndrUnit]
params)
([Type] -> [Type] -> (Map Name Name, [Type])
mergeArguments [Type]
instTys [Type]
ts)
subst :: Map Name Type
subst = Name -> Type
VarT 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, forall k a. Ord k => k -> Map k a -> Bool
Map.notMember (forall flag. TyVarBndr_ flag -> Name
tvName TyVarBndrUnit
tv) Map Name Type
subst ]
exTyvars' :: [TyVarBndrUnit]
exTyvars' = forall flag.
Map Name Type -> [TyVarBndr_ flag] -> [TyVarBndr_ flag]
substTyVarBndrKinds Map Name Type
subst [TyVarBndrUnit]
exTyvars
context2 :: [Type]
context2 = forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
subst ([Type]
context1 forall a. [a] -> [a] -> [a]
++ [Type]
renamedContext)
fields' :: [Type]
fields' = forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
subst [Type]
renamedFields
in forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ Name
-> [TyVarBndrUnit]
-> [Type]
-> [Type]
-> [FieldStrictness]
-> ConstructorVariant
-> ConstructorInfo
ConstructorInfo Name
name [TyVarBndrUnit]
exTyvars' [Type]
context2
[Type]
fields' [FieldStrictness]
stricts 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
_ -> 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, [Type])
-> (Map Name Name, [Type])
closeOverKinds Map Name Type
domainFVKinds Map Name Type
rangeFVKinds = (Map Name Name, [Type]) -> (Map Name Name, [Type])
go
where
go :: (Map Name Name, Cxt) -> (Map Name Name, Cxt)
go :: (Map Name Name, [Type]) -> (Map Name Name, [Type])
go (Map Name Name
subst, [Type]
context) =
let substList :: [(Name, Name)]
substList = forall k a. Map k a -> [(k, a)]
Map.toList Map Name Name
subst
([Type]
kindsInner, [Type]
kindsOuter) =
forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Name
d, Name
r) -> do Type
d' <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
d Map Name Type
domainFVKinds
Type
r' <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
r Map Name Type
rangeFVKinds
forall (m :: * -> *) a. Monad m => a -> m a
return (Type
d', Type
r'))
[(Name, Name)]
substList
(Map Name Name
kindSubst, [Type]
kindContext) = [Type] -> [Type] -> (Map Name Name, [Type])
mergeArgumentKinds [Type]
kindsOuter [Type]
kindsInner
(Map Name Name
restSubst, [Type]
restContext)
= if forall k a. Map k a -> Bool
Map.null Map Name Name
kindSubst
then (forall k a. Map k a
Map.empty, [])
else (Map Name Name, [Type]) -> (Map Name Name, [Type])
go (Map Name Name
kindSubst, [Type]
kindContext)
finalSubst :: Map Name Name
finalSubst = 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 :: [Type]
finalContext = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Type]
context, [Type]
kindContext, [Type]
restContext]
in (Map Name Name
finalSubst, [Type]
finalContext)
kindsOfFVsOfTypes :: [Type] -> Map Name Kind
kindsOfFVsOfTypes :: [Type] -> Map Name Type
kindsOfFVsOfTypes = 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 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 -> 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 forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Map Name Type
kSigs
go (ForallT {}) = forall a. a
forallError
#if MIN_VERSION_template_haskell(2,16,0)
go (ForallVisT {}) = forall a. a
forallError
#endif
go Type
_ = forall k a. Map k a
Map.empty
forallError :: a
forallError :: forall a. a
forallError = forall a. HasCallStack => String -> a
error String
"`forall` type used in data family pattern"
kindsOfFVsOfTvbs :: [TyVarBndr_ flag] -> Map Name Kind
kindsOfFVsOfTvbs :: forall flag. [TyVarBndr_ flag] -> Map Name Type
kindsOfFVsOfTvbs = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall flag. TyVarBndr_ flag -> Map Name Type
go
where
go :: TyVarBndr_ flag -> Map Name Kind
go :: forall flag. TyVarBndr_ flag -> Map Name Type
go = forall r flag.
(Name -> r) -> (Name -> Type -> r) -> TyVarBndr_ flag -> r
elimTV (\Name
n -> 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)
[Type] -> Map Name Type
kindsOfFVsOfTypes [Type
k]
#else
Map.empty
#endif
in 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 :: [Type] -> [Type] -> (Map Name Name, [Type])
mergeArguments [Type]
ns [Type]
ts = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Type, Type) -> (Map Name Name, [Type]) -> (Map Name Name, [Type])
aux (forall k a. Map k a
Map.empty, []) (forall a b. [a] -> [b] -> [(a, b)]
zip [Type]
ns [Type]
ts)
where
aux :: (Type, Type) -> (Map Name Name, [Type]) -> (Map Name Name, [Type])
aux (Type
f `AppT` Type
x, Type
g `AppT` Type
y) (Map Name Name, [Type])
sc =
(Type, Type) -> (Map Name Name, [Type]) -> (Map Name Name, [Type])
aux (Type
x,Type
y) ((Type, Type) -> (Map Name Name, [Type]) -> (Map Name Name, [Type])
aux (Type
f,Type
g) (Map Name Name, [Type])
sc)
aux (VarT Name
n,Type
p) (Map Name Name
subst, [Type]
context) =
case Type
p of
VarT Name
m | Name
m forall a. Eq a => a -> a -> Bool
== Name
n -> (Map Name Name
subst, [Type]
context)
| Just Name
n' <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
m Map Name Name
subst
, Name
n forall a. Eq a => a -> a -> Bool
== Name
n' -> (Map Name Name
subst, [Type]
context)
| forall k a. Ord k => k -> Map k a -> Bool
Map.notMember Name
m Map Name Name
subst -> (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
m Name
n Map Name Name
subst, [Type]
context)
Type
_ -> (Map Name Name
subst, Type -> Type -> Type
equalPred (Name -> Type
VarT Name
n) Type
p forall a. a -> [a] -> [a]
: [Type]
context)
aux (SigT Type
x Type
_, Type
y) (Map Name Name, [Type])
sc = (Type, Type) -> (Map Name Name, [Type]) -> (Map Name Name, [Type])
aux (Type
x,Type
y) (Map Name Name, [Type])
sc
aux (Type
x, SigT Type
y Type
_) (Map Name Name, [Type])
sc = (Type, Type) -> (Map Name Name, [Type]) -> (Map Name Name, [Type])
aux (Type
x,Type
y) (Map Name Name, [Type])
sc
aux (Type, Type)
_ (Map Name Name, [Type])
sc = (Map Name Name, [Type])
sc
mergeArgumentKinds ::
[Kind] ->
[Kind] ->
(Map Name Name, Cxt)
#if MIN_VERSION_template_haskell(2,8,0)
mergeArgumentKinds :: [Type] -> [Type] -> (Map Name Name, [Type])
mergeArgumentKinds = [Type] -> [Type] -> (Map Name Name, [Type])
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 :: [Type]
normal_xs = [TypeArg] -> [Type]
filterTANormals [TypeArg]
xs
defaultCase :: Type -> Q Type
defaultCase :: Type -> Q Type
defaultCase Type
ty = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> TypeArg -> Type
appTypeArg Type
ty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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))
| forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
normal_xs forall a. Ord a => a -> a -> Bool
>= forall (t :: * -> *) a. Foldable t => t a -> Int
length [TyVarBndrUnit]
synvars
-> Type -> Q Type
resolveTypeSynonyms forall a b. (a -> b) -> a -> b
$ forall flag. [TyVarBndr_ flag] -> [Type] -> Type -> Type
expandSynonymRHS [TyVarBndrUnit]
synvars [Type]
normal_xs Type
def
Maybe Info
_ -> Type -> Q Type
defaultCase Type
ty
in case Type
f of
ForallT [TyVarBndrSpec]
tvbs [Type]
ctxt Type
body ->
[TyVarBndrSpec] -> [Type] -> Type -> Type
ForallT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall flag. TyVarBndr_ flag -> Q (TyVarBndr_ flag)
resolve_tvb_syns [TyVarBndrSpec]
tvbs
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type -> Q Type
resolvePredSynonyms [Type]
ctxt
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 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 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall flag. TyVarBndr_ flag -> Q (TyVarBndr_ flag)
resolve_tvb_syns [TyVarBndrUnit]
tvbs
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 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 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 :: forall flag. TyVarBndr_ flag -> Q (TyVarBndr_ flag)
resolve_tvb_syns = forall (m :: * -> *) flag.
Monad m =>
(Type -> m Type) -> TyVarBndr_ flag -> m (TyVarBndr_ flag)
mapMTVKind Type -> Q Type
resolveKindSynonyms
expandSynonymRHS ::
[TyVarBndr_ flag] ->
[Type] ->
Type ->
Type
expandSynonymRHS :: forall flag. [TyVarBndr_ flag] -> [Type] -> Type -> Type
expandSynonymRHS [TyVarBndr_ flag]
synvars [Type]
ts Type
def =
let argNames :: [Name]
argNames = forall a b. (a -> b) -> [a] -> [b]
map forall flag. TyVarBndr_ flag -> Name
tvName [TyVarBndr_ flag]
synvars
([Type]
args,[Type]
rest) = forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
argNames) [Type]
ts
subst :: Map Name Type
subst = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
argNames [Type]
args)
in forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
AppT (forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
subst Type
def) [Type]
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 forall a. a -> [a] -> NonEmpty a
:| [TypeArg] -> [Type]
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
xforall 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
xforall 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] -> [Type]
filterTANormals = 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) = forall a. a -> Maybe a
Just Type
t
f (TyArg {}) = forall a. Maybe a
Nothing
data NonEmpty a = a :| [a]
data NonEmptySnoc a = [a] :|- a
uncurryType :: Type -> ([TyVarBndrSpec], Cxt, NonEmptySnoc Type)
uncurryType :: Type -> ([TyVarBndrSpec], [Type], NonEmptySnoc Type)
uncurryType = [TyVarBndrSpec]
-> [Type]
-> [Type]
-> Type
-> ([TyVarBndrSpec], [Type], NonEmptySnoc Type)
go [] [] []
where
go :: [TyVarBndrSpec]
-> [Type]
-> [Type]
-> Type
-> ([TyVarBndrSpec], [Type], NonEmptySnoc Type)
go [TyVarBndrSpec]
tvbs [Type]
ctxt [Type]
args (AppT (AppT Type
ArrowT Type
t1) Type
t2) = [TyVarBndrSpec]
-> [Type]
-> [Type]
-> Type
-> ([TyVarBndrSpec], [Type], NonEmptySnoc Type)
go [TyVarBndrSpec]
tvbs [Type]
ctxt (Type
t1forall a. a -> [a] -> [a]
:[Type]
args) Type
t2
go [TyVarBndrSpec]
tvbs [Type]
ctxt [Type]
args (ForallT [TyVarBndrSpec]
tvbs' [Type]
ctxt' Type
t) = [TyVarBndrSpec]
-> [Type]
-> [Type]
-> Type
-> ([TyVarBndrSpec], [Type], NonEmptySnoc Type)
go ([TyVarBndrSpec]
tvbsforall a. [a] -> [a] -> [a]
++[TyVarBndrSpec]
tvbs') ([Type]
ctxtforall a. [a] -> [a] -> [a]
++[Type]
ctxt') [Type]
args Type
t
go [TyVarBndrSpec]
tvbs [Type]
ctxt [Type]
args Type
t = ([TyVarBndrSpec]
tvbs, [Type]
ctxt, forall a. [a] -> [a]
reverse [Type]
args forall a. [a] -> a -> NonEmptySnoc a
:|- Type
t)
uncurryKind :: Kind -> ([TyVarBndrSpec], Cxt, NonEmptySnoc Kind)
#if MIN_VERSION_template_haskell(2,8,0)
uncurryKind :: Type -> ([TyVarBndrSpec], [Type], NonEmptySnoc Type)
uncurryKind = Type -> ([TyVarBndrSpec], [Type], 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 :: [TyVarBndrSpec] -> [Type] -> [Type] -> Type -> Type
curryType [TyVarBndrSpec]
tvbs [Type]
ctxt [Type]
args Type
res =
[TyVarBndrSpec] -> [Type] -> Type -> Type
ForallT [TyVarBndrSpec]
tvbs [Type]
ctxt forall a b. (a -> b) -> a -> b
$ 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 [Type]
args
resolveInfixT :: Type -> Q Type
#if MIN_VERSION_template_haskell(2,11,0)
resolveInfixT :: Type -> Q Type
resolveInfixT (ForallT [TyVarBndrSpec]
vs [Type]
cx Type
t) = [TyVarBndrSpec] -> [Type] -> Type -> Type
ForallT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (f :: * -> *) flag.
Applicative f =>
(Type -> f Type) -> TyVarBndr_ flag -> f (TyVarBndr_ flag)
traverseTVKind Type -> Q Type
resolveInfixT) [TyVarBndrSpec]
vs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type -> Q Type
resolveInfixT [Type]
cx
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 forall (m :: * -> *). Quote m => m Type -> m Type -> m 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) = forall (m :: * -> *). Quote m => Name -> m Type
conT Name
o forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Type -> Q Type
resolveInfixT Type
l forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Type -> Q Type
resolveInfixT Type
r
resolveInfixT (SigT Type
t Type
k) = Type -> Type -> Type
SigT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Q Type
resolveInfixT Type
t 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 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) = forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appKindT (Type -> Q Type
resolveInfixT Type
f) (Type -> Q Type
resolveInfixT Type
x)
resolveInfixT (ImplicitParamT String
n Type
t)
= forall (m :: * -> *). Quote m => String -> m Type -> m Type
implicitParamT String
n 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (f :: * -> *) flag.
Applicative f =>
(Type -> f Type) -> TyVarBndr_ flag -> f (TyVarBndr_ flag)
traverseTVKind Type -> Q Type
resolveInfixT) [TyVarBndrUnit]
vs
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 = 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) = forall (m :: * -> *) a. Monad m => a -> m a
return (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 <- forall a. a -> Maybe a -> a
fromMaybe Fixity
defaultFixity 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)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)forall a. a -> [a] -> [a]
:[(Type, Name, Bool, Fixity)]
ts') InfixList
r
Just Bool
False -> Q Type
push
Maybe Bool
Nothing -> 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) = forall a. a -> Maybe a
Just (Int
n1 forall a. Ord a => a -> a -> Bool
>= Int
n2)
compareFixity (Fixity Int
n1 FixityDirection
InfixR) (Fixity Int
n2 FixityDirection
InfixR) = forall a. a -> Maybe a
Just (Int
n1 forall a. Ord a => a -> a -> Bool
> Int
n2)
compareFixity (Fixity Int
n1 FixityDirection
_ ) (Fixity Int
n2 FixityDirection
_ ) =
case forall a. Ord a => a -> a -> Ordering
compare Int
n1 Int
n2 of
Ordering
GT -> forall a. a -> Maybe a
Just Bool
True
Ordering
LT -> forall a. a -> Maybe a
Just Bool
False
Ordering
EQ -> 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 ‘" forall a. [a] -> [a] -> [a]
++
Name -> String
nameBase Name
o1 forall a. [a] -> [a] -> [a]
++ String
"’ [" forall a. [a] -> [a] -> [a]
++ Fixity -> String
showFixity Fixity
ofx1 forall a. [a] -> [a] -> [a]
++ String
"] and ‘" forall a. [a] -> [a] -> [a]
++
Name -> String
nameBase Name
o2 forall a. [a] -> [a] -> [a]
++ String
"’ [" forall a. [a] -> [a] -> [a]
++ Fixity -> String
showFixity Fixity
ofx2 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 forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ 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 :: forall a b. [(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 :: forall a b. [(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 :: forall a b. [(a, b, Type)] -> [Type]
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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
fields
quantifyType :: Type -> Type
quantifyType :: Type -> Type
quantifyType Type
t
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVarBndrSpec]
tvbs
= Type
t
| ForallT [TyVarBndrSpec]
tvbs' [Type]
ctxt' Type
t' <- Type
t
= [TyVarBndrSpec] -> [Type] -> Type -> Type
ForallT ([TyVarBndrSpec]
tvbs forall a. [a] -> [a] -> [a]
++ [TyVarBndrSpec]
tvbs') [Type]
ctxt' Type
t'
| Bool
otherwise
= [TyVarBndrSpec] -> [Type] -> Type -> Type
ForallT [TyVarBndrSpec]
tvbs [] Type
t
where
tvbs :: [TyVarBndrSpec]
tvbs = forall newFlag oldFlag.
newFlag -> [TyVarBndr_ oldFlag] -> [TyVarBndr_ newFlag]
changeTVFlags Specificity
SpecifiedSpec forall a b. (a -> b) -> a -> b
$ [Type] -> [TyVarBndrUnit]
freeVariablesWellScoped [Type
t]
freeVariablesWellScoped :: [Type] -> [TyVarBndrUnit]
freeVariablesWellScoped :: [Type] -> [TyVarBndrUnit]
freeVariablesWellScoped [Type]
tys =
let fvs :: [Name]
fvs :: [Name]
fvs = forall a. TypeSubstitution a => a -> [Name]
freeVariables [Type]
tys
varKindSigs :: Map Name Kind
varKindSigs :: Map Name Type
varKindSigs = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Type -> Map Name Type
go_ty [Type]
tys
where
go_ty :: Type -> Map Name Kind
go_ty :: Type -> Map Name Type
go_ty (ForallT [TyVarBndrSpec]
tvbs [Type]
ctxt Type
t) =
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\TyVarBndrSpec
tvb -> forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (forall flag. TyVarBndr_ flag -> Name
tvName TyVarBndrSpec
tvb))
(forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Type -> Map Name Type
go_pred [Type]
ctxt forall a. Monoid a => a -> a -> a
`mappend` Type -> Map Name Type
go_ty Type
t) [TyVarBndrSpec]
tvbs
go_ty (AppT Type
t1 Type
t2) = Type -> Map Name Type
go_ty Type
t1 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 -> 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 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 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) =
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\TyVarBndrUnit
tvb -> forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (forall flag. TyVarBndr_ flag -> Name
tvName TyVarBndrUnit
tvb)) (Type -> Map Name Type
go_ty Type
t) [TyVarBndrUnit]
tvbs
#endif
go_ty 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 [] = 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 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
aforall a. a -> [a] -> [a]
:[Name]
as', Set Name
fvs forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set Name
fv_tv forall a. a -> [a] -> [a]
: [Set Name]
fvss')
| Bool
otherwise
= (Name
tvforall a. a -> [a] -> [a]
:Name
aforall a. a -> [a] -> [a]
:[Name]
as, Set Name
fvs forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set Name
fv_tv forall a. a -> [a] -> [a]
: Set Name
fvs 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]
_ = forall a. HasCallStack => String -> a
error String
"scopedSort"
kindFVSet :: Name -> Set Name
kindFVSet Name
n =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Set a
Set.empty (forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TypeSubstitution a => a -> [Name]
freeVariables) (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 =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Name -> TyVarBndrUnit
plainTV Name
n) (Name -> Type -> TyVarBndrUnit
kindedTV Name
n) (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
= forall a b. a -> b -> a
const Bool
False
#else
= (`elem` kindVars)
where
kindVars = freeVariables $ Map.elems varKindSigs
#endif
in forall a b. (a -> b) -> [a] -> [b]
map Name -> TyVarBndrUnit
ascribeWithKind forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {b}. b -> Bool
isKindBinderOnOldGHCs) 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Quote m => String -> m Name
newName (Name -> String
nameBase Name
n)) | Name
n <- forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
t]
Map Name Type
subst <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
T.sequence (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Name, Q Type)]
xs)
forall (m :: * -> *) a. Monad m => a -> m a
return (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 = forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. TypeSubstitution a => a -> [Name]
freeVariables
applySubstitution :: Map Name Type -> [a] -> [a]
applySubstitution = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 [TyVarBndrSpec]
tvs [Type]
context Type
t) =
let (Map Name Type
subst', [TyVarBndrSpec]
tvs') = forall flag.
Map Name Type
-> [TyVarBndr_ flag] -> (Map Name Type, [TyVarBndr_ flag])
substTyVarBndrs Map Name Type
subst [TyVarBndrSpec]
tvs in
[TyVarBndrSpec] -> [Type] -> Type -> Type
ForallT [TyVarBndrSpec]
tvs'
(forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
subst' [Type]
context)
(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) (forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
subst Type
k)
go (VarT Name
v) = 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') = forall flag.
Map Name Type
-> [TyVarBndr_ flag] -> (Map Name Type, [TyVarBndr_ flag])
substTyVarBndrs Map Name Type
subst [TyVarBndrUnit]
tvs in
[TyVarBndrUnit] -> Type -> Type
ForallVisT [TyVarBndrUnit]
tvs'
(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 :: forall flag a. [TyVarBndr_ flag] -> (Map Name Type -> a) -> a
subst_tvbs [TyVarBndr_ flag]
tvs Map Name Type -> a
k = Map Name Type -> a
k forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Map k a
Map.delete) Map Name Type
subst (forall a b. (a -> b) -> [a] -> [b]
map forall flag. TyVarBndr_ flag -> Name
tvName [TyVarBndr_ flag]
tvs)
freeVariables :: Type -> [Name]
freeVariables Type
t =
case Type
t of
ForallT [TyVarBndrSpec]
tvs [Type]
context Type
t' ->
forall flag. [TyVarBndr_ flag] -> [Name] -> [Name]
fvs_under_forall [TyVarBndrSpec]
tvs (forall a. TypeSubstitution a => a -> [Name]
freeVariables [Type]
context forall a. Eq a => [a] -> [a] -> [a]
`union` forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
t')
AppT Type
f Type
x -> forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
f forall a. Eq a => [a] -> [a] -> [a]
`union` forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
x
SigT Type
t' Type
k -> forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
t' forall a. Eq a => [a] -> [a] -> [a]
`union` 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 -> forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
l forall a. Eq a => [a] -> [a] -> [a]
`union` forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
r
UInfixT Type
l Name
_ Type
r -> forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
l forall a. Eq a => [a] -> [a] -> [a]
`union` forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
r
ParensT Type
t' -> forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
t'
#endif
#if MIN_VERSION_template_haskell(2,15,0)
AppKindT Type
t Type
k -> forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
t forall a. Eq a => [a] -> [a] -> [a]
`union` forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
k
ImplicitParamT String
_ Type
t
-> forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
t
#endif
#if MIN_VERSION_template_haskell(2,16,0)
ForallVisT [TyVarBndrUnit]
tvs Type
t'
-> forall flag. [TyVarBndr_ flag] -> [Name] -> [Name]
fvs_under_forall [TyVarBndrUnit]
tvs (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 :: forall flag. [TyVarBndr_ flag] -> [Name] -> [Name]
fvs_under_forall [TyVarBndr_ flag]
tvs [Name]
fvs =
(forall a. TypeSubstitution a => a -> [Name]
freeVariables (forall a b. (a -> b) -> [a] -> [b]
map forall flag. TyVarBndr_ flag -> Type
tvKind [TyVarBndr_ flag]
tvs) forall a. Eq a => [a] -> [a] -> [a]
`union` [Name]
fvs)
forall a. Eq a => [a] -> [a] -> [a]
\\ forall a b. (a -> b) -> [a] -> [b]
map forall flag. TyVarBndr_ flag -> Name
tvName [TyVarBndr_ flag]
tvs
instance TypeSubstitution ConstructorInfo where
freeVariables :: ConstructorInfo -> [Name]
freeVariables ConstructorInfo
ci =
(forall a. TypeSubstitution a => a -> [Name]
freeVariables (forall a b. (a -> b) -> [a] -> [b]
map forall flag. TyVarBndr_ flag -> Type
tvKind (ConstructorInfo -> [TyVarBndrUnit]
constructorVars ConstructorInfo
ci))
forall a. Eq a => [a] -> [a] -> [a]
`union` forall a. TypeSubstitution a => a -> [Name]
freeVariables (ConstructorInfo -> [Type]
constructorContext ConstructorInfo
ci)
forall a. Eq a => [a] -> [a] -> [a]
`union` forall a. TypeSubstitution a => a -> [Name]
freeVariables (ConstructorInfo -> [Type]
constructorFields ConstructorInfo
ci))
forall a. Eq a => [a] -> [a] -> [a]
\\ (forall flag. TyVarBndr_ flag -> Name
tvName 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' = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Map k a
Map.delete) Map Name Type
subst (forall a b. (a -> b) -> [a] -> [b]
map forall flag. TyVarBndr_ flag -> Name
tvName (ConstructorInfo -> [TyVarBndrUnit]
constructorVars ConstructorInfo
ci)) in
ConstructorInfo
ci { constructorVars :: [TyVarBndrUnit]
constructorVars = forall a b. (a -> b) -> [a] -> [b]
map (forall flag. (Type -> Type) -> TyVarBndr_ flag -> TyVarBndr_ flag
mapTVKind (forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
subst'))
(ConstructorInfo -> [TyVarBndrUnit]
constructorVars ConstructorInfo
ci)
, constructorContext :: [Type]
constructorContext = forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
subst' (ConstructorInfo -> [Type]
constructorContext ConstructorInfo
ci)
, constructorFields :: [Type]
constructorFields = forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
subst' (ConstructorInfo -> [Type]
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 :: forall flag.
Map Name Type
-> [TyVarBndr_ flag] -> (Map Name Type, [TyVarBndr_ flag])
substTyVarBndrs = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL forall flag.
Map Name Type
-> TyVarBndr_ flag -> (Map Name Type, TyVarBndr_ flag)
substTyVarBndr
substTyVarBndr :: Map Name Type -> TyVarBndr_ flag -> (Map Name Type, TyVarBndr_ flag)
substTyVarBndr :: forall flag.
Map Name Type
-> TyVarBndr_ flag -> (Map Name Type, TyVarBndr_ flag)
substTyVarBndr Map Name Type
subst TyVarBndr_ flag
tvb
| Name
tvbName forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map Name Type
subst
= (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Name
tvbName Map Name Type
subst, forall flag. (Type -> Type) -> TyVarBndr_ flag -> TyVarBndr_ flag
mapTVKind (forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
subst) TyVarBndr_ flag
tvb)
| Name
tvbName forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Name
substRangeFVs
= (Map Name Type
subst, forall flag. (Type -> Type) -> TyVarBndr_ flag -> TyVarBndr_ flag
mapTVKind (forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
subst) TyVarBndr_ flag
tvb)
| Bool
otherwise
= let tvbName' :: Name
tvbName' = Name -> Name
evade Name
tvbName in
( 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
, forall flag flag'.
(Name -> Name)
-> (flag -> flag')
-> (Type -> Type)
-> TyVarBndr_ flag
-> TyVarBndr_ flag'
mapTV (\Name
_ -> Name
tvbName') forall a. a -> a
id (forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
subst) TyVarBndr_ flag
tvb
)
where
tvbName :: Name
tvbName :: Name
tvbName = forall flag. TyVarBndr_ flag -> Name
tvName TyVarBndr_ flag
tvb
substRangeFVs :: Set Name
substRangeFVs :: Set Name
substRangeFVs = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a. TypeSubstitution a => a -> [Name]
freeVariables forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
Map.elems Map Name Type
subst
evade :: Name -> Name
evade :: Name -> Name
evade Name
n | Name
n forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Name
substRangeFVs
= Name -> Name
evade 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 forall a b. (a -> b) -> a -> b
$ Char
'f'forall a. a -> [a] -> [a]
:Name -> String
nameBase Name
n
substTyVarBndrKinds :: Map Name Type -> [TyVarBndr_ flag] -> [TyVarBndr_ flag]
substTyVarBndrKinds :: forall flag.
Map Name Type -> [TyVarBndr_ flag] -> [TyVarBndr_ flag]
substTyVarBndrKinds Map Name Type
subst = forall a b. (a -> b) -> [a] -> [b]
map (forall flag. Map Name Type -> TyVarBndr_ flag -> TyVarBndr_ flag
substTyVarBndrKind Map Name Type
subst)
substTyVarBndrKind :: Map Name Type -> TyVarBndr_ flag -> TyVarBndr_ flag
substTyVarBndrKind :: forall flag. Map Name Type -> TyVarBndr_ flag -> TyVarBndr_ flag
substTyVarBndrKind Map Name Type
subst = forall flag. (Type -> Type) -> TyVarBndr_ flag -> TyVarBndr_ flag
mapTVKind (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 = forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 :: [Type] -> Q (Map Name Type)
unifyTypes [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall k a. Map k a
Map.empty
unifyTypes (Type
t:[Type]
ts) =
do Type
t':[Type]
ts' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type -> Q Type
resolveTypeSynonyms (Type
tforall a. a -> [a] -> [a]
:[Type]
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' (forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
sub Type
t')
(forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
sub Type
u)
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 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 forall k a. Map k a
Map.empty [Type]
ts' of
Right Map Name Type
m -> forall (m :: * -> *) a. Monad m => a -> m a
return Map Name Type
m
Left (Type
x,Type
y) ->
forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Unable to unify types "
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Type
x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" and "
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Type
y
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 forall a. Eq a => a -> a -> Bool
== Name
m = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k a. Map k a
Map.empty
unify' (VarT Name
n) Type
t | Name
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
t = forall a b. a -> Either a b
Left (Name -> Type
VarT Name
n, Type
t)
| Bool
otherwise = forall a b. b -> Either a b
Right (forall k a. k -> a -> Map k a
Map.singleton Name
n Type
t)
unify' Type
t (VarT Name
n) | Name
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a. TypeSubstitution a => a -> [Name]
freeVariables Type
t = forall a b. a -> Either a b
Left (Name -> Type
VarT Name
n, Type
t)
| Bool
otherwise = forall a b. b -> Either a b
Right (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' (forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
sub1 Type
x1) (forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
sub1 Type
x2)
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 forall a. Eq a => a -> a -> Bool
== Type
u = forall a b. b -> Either a b
Right forall k a. Map k a
Map.empty
| Bool
otherwise = 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 -> [Type] -> Type
classPred =
#if MIN_VERSION_template_haskell(2,10,0)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
AppT 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) = forall a. a -> Maybe a
Just (Type
x,Type
y)
asEqualPred (ConT Name
eq `AppT` Type
x `AppT` Type
y) | Name
eq forall a. Eq a => a -> a -> Bool
== Name
eqTypeName = forall a. a -> Maybe a
Just (Type
x,Type
y)
#else
asEqualPred (EqualP x y) = Just (x,y)
#endif
asEqualPred Type
_ = forall a. Maybe a
Nothing
asClassPred :: Pred -> Maybe (Name, [Type])
#if MIN_VERSION_template_haskell(2,10,0)
asClassPred :: Type -> Maybe (Name, [Type])
asClassPred Type
t =
case Type -> NonEmpty Type
decomposeType Type
t of
ConT Name
f :| [Type]
xs | Name
f forall a. Eq a => a -> a -> Bool
/= Name
eqTypeName -> forall a. a -> Maybe a
Just (Name
f,[Type]
xs)
NonEmpty Type
_ -> 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 = forall a b. (a -> b) -> [a] -> [b]
map (Bool -> TyVarBndrUnit -> TyVarBndrUnit
giveTyVarBndrStarKind Bool
isReified) (DatatypeInfo -> [TyVarBndrUnit]
datatypeVars DatatypeInfo
info)
, datatypeInstTypes :: [Type]
datatypeInstTypes = forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Type -> Type
giveTypeStarKind Bool
isReified) (DatatypeInfo -> [Type]
datatypeInstTypes DatatypeInfo
info) }
giveCIVarsStarKinds :: IsReifiedDec -> ConstructorInfo -> ConstructorInfo
Bool
isReified ConstructorInfo
info =
ConstructorInfo
info { constructorVars :: [TyVarBndrUnit]
constructorVars = 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
= forall r flag.
(Name -> r) -> (Name -> Type -> r) -> TyVarBndr_ flag -> 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 <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
T.sequence (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Name, Q Type)]
substList)
forall (m :: * -> *) a. Monad m => a -> m a
return DatatypeInfo
info { datatypeCons :: [ConstructorInfo]
datatypeCons = forall a. TypeSubstitution a => Map Name Type -> a -> a
applySubstitution Map Name Type
s (DatatypeInfo -> [ConstructorInfo]
datatypeCons DatatypeInfo
info) }
where
used :: [Name]
used = forall a. TypeSubstitution a => a -> [Name]
freeVariables (DatatypeInfo -> [ConstructorInfo]
datatypeCons DatatypeInfo
info)
bound :: [Name]
bound = forall a b. (a -> b) -> [a] -> [b]
map forall flag. TyVarBndr_ flag -> Name
tvName (DatatypeInfo -> [TyVarBndrUnit]
datatypeVars DatatypeInfo
info)
free :: [Name]
free = [Name]
used forall a. Eq a => [a] -> [a] -> [a]
\\ [Name]
bound
substList :: [(Name, Q Type)]
substList =
[ (Name
u, forall {m :: * -> *} {a}.
(Quote m, MonadFail m, Show a) =>
a -> [Name] -> m 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 forall a. Eq a => a -> a -> Bool
== Name -> String
nameBase Name
u]
]
substEntry :: a -> [Name] -> m Type
substEntry a
_ [Name
v] = forall (m :: * -> *). Quote m => Name -> m Type
varT Name
v
substEntry a
u [] = forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Impossible free variable: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
u)
substEntry a
u [Name]
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Ambiguous free variable: " forall a. [a] -> [a] -> [a]
++ 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 [Type] -> Name -> [TyVarBndrUnit] -> [ConQ] -> [Name] -> Q Dec
dataDCompat Q [Type]
c Name
n [TyVarBndrUnit]
ts [ConQ]
cs [Name]
ds =
forall (m :: * -> *).
Quote m =>
m [Type]
-> Name
-> [TyVarBndrUnit]
-> Maybe Type
-> [m Con]
-> [m DerivClause]
-> m Dec
dataD Q [Type]
c Name
n [TyVarBndrUnit]
ts forall a. Maybe a
Nothing [ConQ]
cs
(if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
ds then [] else [forall (m :: * -> *).
Quote m =>
Maybe DerivStrategy -> [m Type] -> m DerivClause
derivClause forall a. Maybe a
Nothing (forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *). Quote m => Name -> m 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 [Type] -> Name -> [TyVarBndrUnit] -> ConQ -> [Name] -> Q Dec
newtypeDCompat Q [Type]
c Name
n [TyVarBndrUnit]
ts ConQ
cs [Name]
ds =
forall (m :: * -> *).
Quote m =>
m [Type]
-> Name
-> [TyVarBndrUnit]
-> Maybe Type
-> m Con
-> [m DerivClause]
-> m Dec
newtypeD Q [Type]
c Name
n [TyVarBndrUnit]
ts forall a. Maybe a
Nothing ConQ
cs
(if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
ds then [] else [forall (m :: * -> *).
Quote m =>
Maybe DerivStrategy -> [m Type] -> m DerivClause
derivClause forall a. Maybe a
Nothing (forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *). Quote m => Name -> m 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe [TyVarBndrUnit] -> Type -> Type -> TySynEqn
TySynEqn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence Maybe [Q TyVarBndrUnit]
mtvbs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (forall (m :: * -> *). Quote m => Name -> m Type
conT Name
n) [Q Type]
ps
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 = forall a. a -> Maybe a
Just (forall (m :: * -> *). Quote m => Int -> String -> m 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 = forall a. Q a -> Q a -> Q a
recover (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) ((forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall a. a -> Maybe a
Just Fixity
defaultFixity) 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 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing forall a. Q a -> Q a -> Q a
`recover` forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just (Name -> Q Info
reify Name
n)