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