{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}

-- | Utilities for reifying simplified datatype info. It omits details
-- that aren't usually relevant to generating instances that work with
-- the datatype. This makes it easier to use TH to derive instances.
--
-- The \"Simple\" in the module name refers to the simplicity of the
-- datatypes, not the module itself, which exports quite a few things
-- which are useful in some circumstance or another. I anticipate that
-- the most common uses of this will be the following APIs:
--
-- * Getting info about a @data@ or @newtype@ declaration, via
--   'DataType', 'reifyDataType', and 'DataCon'. This is useful for
--   writing something which generates declarations based on a datatype,
--   one of the most common uses of Template Haskell.
--
-- * Getting nicely structured info about a named type. See 'TypeInfo'
--   and 'reifyType'. This does not yet support reifying typeclasses,
--   primitive type constructors, or type variables ('TyVarI').
--
-- Currently, this module supports reifying simplified versions of the
-- following 'Info' constructors:
--
-- * 'TyConI' with 'DataD' and 'NewtypeD' (becomes a 'DataType' value)
--
-- * 'FamilyI' becomes a 'DataFamily' or 'TypeFamily' value.
--
-- * 'DataConI' becomes a 'DataCon' value.
--
-- In the future it will hopefully also have support for the remaining
-- 'Info' constructors, 'ClassI', 'ClassOpI', 'PrimTyConI', 'VarI', and
-- 'TyVarI'.
module TH.ReifySimple
    (
    -- * Reifying simplified type info
      TypeInfo, reifyType, infoToType
    , reifyTypeNoDataKinds, infoToTypeNoDataKinds
    -- * Reifying simplified info for specific declaration varieties
    -- ** Datatype info
    , DataType(..), reifyDataType, infoToDataType
    -- ** Data constructor info
    , DataCon(..), reifyDataCon, infoToDataCon, typeToDataCon
    -- ** Data family info
    , DataFamily(..), DataInst(..), reifyDataFamily, infoToDataFamily
    -- ** Type family info
    , TypeFamily(..), TypeInst(..), reifyTypeFamily, infoToTypeFamily
    -- * Other utilities
    , conToDataCons
    , reifyDataTypeSubstituted
    ) where

import           Control.Applicative
import           Data.Data (Data, gmapT)
import           Data.Generics.Aliases (extT)
import qualified Data.Map as M
import           Data.Typeable (Typeable)
import           GHC.Generics (Generic)
import           Language.Haskell.TH
#if MIN_VERSION_template_haskell(2,16,0)
                                     hiding (reifyType)
#endif
import           Language.Haskell.TH.Instances ()
import           TH.Utilities

data TypeInfo
    = DataTypeInfo DataType
    | DataFamilyInfo DataFamily
    | TypeFamilyInfo TypeFamily
    | LiftedDataConInfo DataCon

-- | Reifies a 'Name' as a 'TypeInfo', and calls 'fail' if this doesn't
-- work. Use 'reify' with 'infoToType' if you want to handle the failure
-- case more gracefully.
--
-- This does not yet support reifying typeclasses, primitive type
-- constructors, or type variables ('TyVarI').
reifyType :: Name -> Q TypeInfo
reifyType :: Name -> Q TypeInfo
reifyType Name
name = do
   Info
info <- Name -> Q Info
reify Name
name
   Maybe TypeInfo
mres <- Info -> Q (Maybe TypeInfo)
infoToType Info
info
   case Maybe TypeInfo
mres of
       Just TypeInfo
res -> forall (m :: * -> *) a. Monad m => a -> m a
return TypeInfo
res
       Maybe TypeInfo
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
           String
"Expected to reify a data type, data family, or type family. Instead got:\n" forall a. [a] -> [a] -> [a]
++
           forall a. Ppr a => a -> String
pprint Info
info

-- | Convert an 'Info' into a 'TypeInfo' if possible, and otherwise
-- yield 'Nothing'.  Needs to run in 'Q' so that
infoToType :: Info -> Q (Maybe TypeInfo)
infoToType :: Info -> Q (Maybe TypeInfo)
infoToType Info
info =
    case (Info -> Maybe TypeInfo
infoToTypeNoDataKinds Info
info, Info -> Maybe DataCon
infoToDataCon Info
info) of
       (Just TypeInfo
result, Maybe DataCon
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just TypeInfo
result)
       (Maybe TypeInfo
Nothing, Just DataCon
dc) -> do
#if MIN_VERSION_template_haskell(2,11,0)
           Bool
dataKindsEnabled <- Extension -> Q Bool
isExtEnabled Extension
DataKinds
#else
           reportWarning $
               "For " ++ pprint (dcName dc) ++
               ", assuming DataKinds is on, and yielding LiftedDataConInfo."
           let dataKindsEnabled = True
#endif
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
dataKindsEnabled then forall a. a -> Maybe a
Just (DataCon -> TypeInfo
LiftedDataConInfo DataCon
dc) else forall a. Maybe a
Nothing
       (Maybe TypeInfo
Nothing, Maybe DataCon
Nothing) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- | Reifies type info, but instead of yielding a 'LiftedDataConInfo',
-- will instead yield 'Nothing'.
reifyTypeNoDataKinds :: Name -> Q (Maybe TypeInfo)
reifyTypeNoDataKinds :: Name -> Q (Maybe TypeInfo)
reifyTypeNoDataKinds = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Info -> Maybe TypeInfo
infoToTypeNoDataKinds forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Q Info
reify

-- | Convert an 'Info into a 'TypeInfo' if possible. If it's a data
-- constructor, instead of yielding 'LiftedDataConInfo', it will instead
-- yield 'Nothing'.
infoToTypeNoDataKinds :: Info -> Maybe TypeInfo
infoToTypeNoDataKinds :: Info -> Maybe TypeInfo
infoToTypeNoDataKinds Info
info =
   (DataType -> TypeInfo
DataTypeInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Info -> Maybe DataType
infoToDataType Info
info) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
   (DataFamily -> TypeInfo
DataFamilyInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Info -> Maybe DataFamily
infoToDataFamily Info
info) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
   (TypeFamily -> TypeInfo
TypeFamilyInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Info -> Maybe TypeFamily
infoToTypeFamily Info
info)

--------------------------------------------------------------------------------
-- Reifying specific declaration varieties

-- | Simplified info about a 'DataD'. Omits deriving, strictness,
-- kind info, and whether it's @data@ or @newtype@.
data DataType = DataType
    { DataType -> Name
dtName :: Name
    , DataType -> [Name]
dtTvs :: [Name]
    , DataType -> Cxt
dtCxt :: Cxt
    , DataType -> [DataCon]
dtCons :: [DataCon]
    } deriving (DataType -> DataType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataType -> DataType -> Bool
$c/= :: DataType -> DataType -> Bool
== :: DataType -> DataType -> Bool
$c== :: DataType -> DataType -> Bool
Eq, Int -> DataType -> ShowS
[DataType] -> ShowS
DataType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataType] -> ShowS
$cshowList :: [DataType] -> ShowS
show :: DataType -> String
$cshow :: DataType -> String
showsPrec :: Int -> DataType -> ShowS
$cshowsPrec :: Int -> DataType -> ShowS
Show, Eq DataType
DataType -> DataType -> Bool
DataType -> DataType -> Ordering
DataType -> DataType -> DataType
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 :: DataType -> DataType -> DataType
$cmin :: DataType -> DataType -> DataType
max :: DataType -> DataType -> DataType
$cmax :: DataType -> DataType -> DataType
>= :: DataType -> DataType -> Bool
$c>= :: DataType -> DataType -> Bool
> :: DataType -> DataType -> Bool
$c> :: DataType -> DataType -> Bool
<= :: DataType -> DataType -> Bool
$c<= :: DataType -> DataType -> Bool
< :: DataType -> DataType -> Bool
$c< :: DataType -> DataType -> Bool
compare :: DataType -> DataType -> Ordering
$ccompare :: DataType -> DataType -> Ordering
Ord, Typeable DataType
DataType -> DataType
DataType -> Constr
(forall b. Data b => b -> b) -> DataType -> DataType
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) -> DataType -> u
forall u. (forall d. Data d => d -> u) -> DataType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DataType -> m DataType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataType -> m DataType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataType -> c DataType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataType)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataType -> m DataType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataType -> m DataType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataType -> m DataType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataType -> m DataType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DataType -> m DataType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DataType -> m DataType
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DataType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DataType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> DataType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DataType -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataType -> r
gmapT :: (forall b. Data b => b -> b) -> DataType -> DataType
$cgmapT :: (forall b. Data b => b -> b) -> DataType -> DataType
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataType)
dataTypeOf :: DataType -> DataType
$cdataTypeOf :: DataType -> DataType
toConstr :: DataType -> Constr
$ctoConstr :: DataType -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataType -> c DataType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataType -> c DataType
Data, Typeable, forall x. Rep DataType x -> DataType
forall x. DataType -> Rep DataType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DataType x -> DataType
$cfrom :: forall x. DataType -> Rep DataType x
Generic)

-- | Simplified info about a 'Con'. Omits deriving, strictness, and kind
-- info. This is much nicer than consuming 'Con' directly, because it
-- unifies all the constructors into one.
data DataCon = DataCon
    { DataCon -> Name
dcName :: Name
    , DataCon -> [Name]
dcTvs :: [Name]
    , DataCon -> Cxt
dcCxt :: Cxt
    , DataCon -> [(Maybe Name, Type)]
dcFields :: [(Maybe Name, Type)]
    } deriving (DataCon -> DataCon -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataCon -> DataCon -> Bool
$c/= :: DataCon -> DataCon -> Bool
== :: DataCon -> DataCon -> Bool
$c== :: DataCon -> DataCon -> Bool
Eq, Int -> DataCon -> ShowS
[DataCon] -> ShowS
DataCon -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataCon] -> ShowS
$cshowList :: [DataCon] -> ShowS
show :: DataCon -> String
$cshow :: DataCon -> String
showsPrec :: Int -> DataCon -> ShowS
$cshowsPrec :: Int -> DataCon -> ShowS
Show, Eq DataCon
DataCon -> DataCon -> Bool
DataCon -> DataCon -> Ordering
DataCon -> DataCon -> DataCon
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 :: DataCon -> DataCon -> DataCon
$cmin :: DataCon -> DataCon -> DataCon
max :: DataCon -> DataCon -> DataCon
$cmax :: DataCon -> DataCon -> DataCon
>= :: DataCon -> DataCon -> Bool
$c>= :: DataCon -> DataCon -> Bool
> :: DataCon -> DataCon -> Bool
$c> :: DataCon -> DataCon -> Bool
<= :: DataCon -> DataCon -> Bool
$c<= :: DataCon -> DataCon -> Bool
< :: DataCon -> DataCon -> Bool
$c< :: DataCon -> DataCon -> Bool
compare :: DataCon -> DataCon -> Ordering
$ccompare :: DataCon -> DataCon -> Ordering
Ord, Typeable DataCon
DataCon -> DataType
DataCon -> Constr
(forall b. Data b => b -> b) -> DataCon -> DataCon
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) -> DataCon -> u
forall u. (forall d. Data d => d -> u) -> DataCon -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataCon -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataCon -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DataCon -> m DataCon
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataCon -> m DataCon
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataCon
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataCon -> c DataCon
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataCon)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataCon)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataCon -> m DataCon
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataCon -> m DataCon
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataCon -> m DataCon
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataCon -> m DataCon
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DataCon -> m DataCon
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DataCon -> m DataCon
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DataCon -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DataCon -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> DataCon -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DataCon -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataCon -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataCon -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataCon -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataCon -> r
gmapT :: (forall b. Data b => b -> b) -> DataCon -> DataCon
$cgmapT :: (forall b. Data b => b -> b) -> DataCon -> DataCon
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataCon)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataCon)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataCon)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataCon)
dataTypeOf :: DataCon -> DataType
$cdataTypeOf :: DataCon -> DataType
toConstr :: DataCon -> Constr
$ctoConstr :: DataCon -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataCon
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataCon
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataCon -> c DataCon
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataCon -> c DataCon
Data, Typeable, forall x. Rep DataCon x -> DataCon
forall x. DataCon -> Rep DataCon x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DataCon x -> DataCon
$cfrom :: forall x. DataCon -> Rep DataCon x
Generic)

-- | Simplified info about a data family. Omits deriving, strictness, and
-- kind info.
data DataFamily = DataFamily
    { DataFamily -> Name
dfName :: Name
    , DataFamily -> [Name]
dfTvs :: [Name]
    , DataFamily -> [DataInst]
dfInsts :: [DataInst]
    } deriving (DataFamily -> DataFamily -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataFamily -> DataFamily -> Bool
$c/= :: DataFamily -> DataFamily -> Bool
== :: DataFamily -> DataFamily -> Bool
$c== :: DataFamily -> DataFamily -> Bool
Eq, Int -> DataFamily -> ShowS
[DataFamily] -> ShowS
DataFamily -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataFamily] -> ShowS
$cshowList :: [DataFamily] -> ShowS
show :: DataFamily -> String
$cshow :: DataFamily -> String
showsPrec :: Int -> DataFamily -> ShowS
$cshowsPrec :: Int -> DataFamily -> ShowS
Show, Eq DataFamily
DataFamily -> DataFamily -> Bool
DataFamily -> DataFamily -> Ordering
DataFamily -> DataFamily -> DataFamily
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 :: DataFamily -> DataFamily -> DataFamily
$cmin :: DataFamily -> DataFamily -> DataFamily
max :: DataFamily -> DataFamily -> DataFamily
$cmax :: DataFamily -> DataFamily -> DataFamily
>= :: DataFamily -> DataFamily -> Bool
$c>= :: DataFamily -> DataFamily -> Bool
> :: DataFamily -> DataFamily -> Bool
$c> :: DataFamily -> DataFamily -> Bool
<= :: DataFamily -> DataFamily -> Bool
$c<= :: DataFamily -> DataFamily -> Bool
< :: DataFamily -> DataFamily -> Bool
$c< :: DataFamily -> DataFamily -> Bool
compare :: DataFamily -> DataFamily -> Ordering
$ccompare :: DataFamily -> DataFamily -> Ordering
Ord, Typeable DataFamily
DataFamily -> DataType
DataFamily -> Constr
(forall b. Data b => b -> b) -> DataFamily -> DataFamily
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) -> DataFamily -> u
forall u. (forall d. Data d => d -> u) -> DataFamily -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataFamily -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataFamily -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DataFamily -> m DataFamily
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataFamily -> m DataFamily
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataFamily
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataFamily -> c DataFamily
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataFamily)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataFamily)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataFamily -> m DataFamily
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataFamily -> m DataFamily
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataFamily -> m DataFamily
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataFamily -> m DataFamily
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DataFamily -> m DataFamily
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DataFamily -> m DataFamily
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DataFamily -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DataFamily -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> DataFamily -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DataFamily -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataFamily -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataFamily -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataFamily -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataFamily -> r
gmapT :: (forall b. Data b => b -> b) -> DataFamily -> DataFamily
$cgmapT :: (forall b. Data b => b -> b) -> DataFamily -> DataFamily
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataFamily)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataFamily)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataFamily)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataFamily)
dataTypeOf :: DataFamily -> DataType
$cdataTypeOf :: DataFamily -> DataType
toConstr :: DataFamily -> Constr
$ctoConstr :: DataFamily -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataFamily
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataFamily
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataFamily -> c DataFamily
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataFamily -> c DataFamily
Data, Typeable, forall x. Rep DataFamily x -> DataFamily
forall x. DataFamily -> Rep DataFamily x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DataFamily x -> DataFamily
$cfrom :: forall x. DataFamily -> Rep DataFamily x
Generic)

-- | Simplified info about a data family instance. Omits deriving,
-- strictness, and kind info.
data DataInst = DataInst
    { DataInst -> Name
diName :: Name
    , DataInst -> Cxt
diCxt :: Cxt
    , DataInst -> Cxt
diParams :: [Type]
    , DataInst -> [DataCon]
diCons :: [DataCon]
    } deriving (DataInst -> DataInst -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataInst -> DataInst -> Bool
$c/= :: DataInst -> DataInst -> Bool
== :: DataInst -> DataInst -> Bool
$c== :: DataInst -> DataInst -> Bool
Eq, Int -> DataInst -> ShowS
[DataInst] -> ShowS
DataInst -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataInst] -> ShowS
$cshowList :: [DataInst] -> ShowS
show :: DataInst -> String
$cshow :: DataInst -> String
showsPrec :: Int -> DataInst -> ShowS
$cshowsPrec :: Int -> DataInst -> ShowS
Show, Eq DataInst
DataInst -> DataInst -> Bool
DataInst -> DataInst -> Ordering
DataInst -> DataInst -> DataInst
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 :: DataInst -> DataInst -> DataInst
$cmin :: DataInst -> DataInst -> DataInst
max :: DataInst -> DataInst -> DataInst
$cmax :: DataInst -> DataInst -> DataInst
>= :: DataInst -> DataInst -> Bool
$c>= :: DataInst -> DataInst -> Bool
> :: DataInst -> DataInst -> Bool
$c> :: DataInst -> DataInst -> Bool
<= :: DataInst -> DataInst -> Bool
$c<= :: DataInst -> DataInst -> Bool
< :: DataInst -> DataInst -> Bool
$c< :: DataInst -> DataInst -> Bool
compare :: DataInst -> DataInst -> Ordering
$ccompare :: DataInst -> DataInst -> Ordering
Ord, Typeable DataInst
DataInst -> DataType
DataInst -> Constr
(forall b. Data b => b -> b) -> DataInst -> DataInst
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) -> DataInst -> u
forall u. (forall d. Data d => d -> u) -> DataInst -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataInst -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataInst -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DataInst -> m DataInst
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataInst -> m DataInst
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataInst
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataInst -> c DataInst
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataInst)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataInst)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataInst -> m DataInst
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataInst -> m DataInst
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataInst -> m DataInst
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataInst -> m DataInst
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DataInst -> m DataInst
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DataInst -> m DataInst
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DataInst -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DataInst -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> DataInst -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DataInst -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataInst -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataInst -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataInst -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataInst -> r
gmapT :: (forall b. Data b => b -> b) -> DataInst -> DataInst
$cgmapT :: (forall b. Data b => b -> b) -> DataInst -> DataInst
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataInst)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataInst)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataInst)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataInst)
dataTypeOf :: DataInst -> DataType
$cdataTypeOf :: DataInst -> DataType
toConstr :: DataInst -> Constr
$ctoConstr :: DataInst -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataInst
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataInst
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataInst -> c DataInst
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataInst -> c DataInst
Data, Typeable, forall x. Rep DataInst x -> DataInst
forall x. DataInst -> Rep DataInst x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DataInst x -> DataInst
$cfrom :: forall x. DataInst -> Rep DataInst x
Generic)

-- | Simplified info about a type family. Omits kind info and injectivity
-- info.
data TypeFamily = TypeFamily
    { TypeFamily -> Name
tfName :: Name
    , TypeFamily -> [Name]
tfTvs :: [Name]
    , TypeFamily -> [TypeInst]
tfInsts :: [TypeInst]
    } deriving (TypeFamily -> TypeFamily -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeFamily -> TypeFamily -> Bool
$c/= :: TypeFamily -> TypeFamily -> Bool
== :: TypeFamily -> TypeFamily -> Bool
$c== :: TypeFamily -> TypeFamily -> Bool
Eq, Int -> TypeFamily -> ShowS
[TypeFamily] -> ShowS
TypeFamily -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeFamily] -> ShowS
$cshowList :: [TypeFamily] -> ShowS
show :: TypeFamily -> String
$cshow :: TypeFamily -> String
showsPrec :: Int -> TypeFamily -> ShowS
$cshowsPrec :: Int -> TypeFamily -> ShowS
Show, Eq TypeFamily
TypeFamily -> TypeFamily -> Bool
TypeFamily -> TypeFamily -> Ordering
TypeFamily -> TypeFamily -> TypeFamily
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 :: TypeFamily -> TypeFamily -> TypeFamily
$cmin :: TypeFamily -> TypeFamily -> TypeFamily
max :: TypeFamily -> TypeFamily -> TypeFamily
$cmax :: TypeFamily -> TypeFamily -> TypeFamily
>= :: TypeFamily -> TypeFamily -> Bool
$c>= :: TypeFamily -> TypeFamily -> Bool
> :: TypeFamily -> TypeFamily -> Bool
$c> :: TypeFamily -> TypeFamily -> Bool
<= :: TypeFamily -> TypeFamily -> Bool
$c<= :: TypeFamily -> TypeFamily -> Bool
< :: TypeFamily -> TypeFamily -> Bool
$c< :: TypeFamily -> TypeFamily -> Bool
compare :: TypeFamily -> TypeFamily -> Ordering
$ccompare :: TypeFamily -> TypeFamily -> Ordering
Ord, Typeable TypeFamily
TypeFamily -> DataType
TypeFamily -> Constr
(forall b. Data b => b -> b) -> TypeFamily -> TypeFamily
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) -> TypeFamily -> u
forall u. (forall d. Data d => d -> u) -> TypeFamily -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeFamily -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeFamily -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeFamily -> m TypeFamily
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeFamily -> m TypeFamily
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeFamily
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeFamily -> c TypeFamily
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeFamily)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeFamily)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeFamily -> m TypeFamily
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeFamily -> m TypeFamily
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeFamily -> m TypeFamily
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeFamily -> m TypeFamily
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeFamily -> m TypeFamily
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeFamily -> m TypeFamily
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TypeFamily -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TypeFamily -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TypeFamily -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TypeFamily -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeFamily -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeFamily -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeFamily -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeFamily -> r
gmapT :: (forall b. Data b => b -> b) -> TypeFamily -> TypeFamily
$cgmapT :: (forall b. Data b => b -> b) -> TypeFamily -> TypeFamily
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeFamily)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeFamily)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeFamily)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeFamily)
dataTypeOf :: TypeFamily -> DataType
$cdataTypeOf :: TypeFamily -> DataType
toConstr :: TypeFamily -> Constr
$ctoConstr :: TypeFamily -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeFamily
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeFamily
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeFamily -> c TypeFamily
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeFamily -> c TypeFamily
Data, Typeable, forall x. Rep TypeFamily x -> TypeFamily
forall x. TypeFamily -> Rep TypeFamily x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TypeFamily x -> TypeFamily
$cfrom :: forall x. TypeFamily -> Rep TypeFamily x
Generic)

-- | Simplified info about a type family instance. Omits nothing.
data TypeInst = TypeInst
    { TypeInst -> Name
tiName :: Name
    , TypeInst -> Cxt
tiParams :: [Type]
    , TypeInst -> Type
tiType :: Type
    } deriving (TypeInst -> TypeInst -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeInst -> TypeInst -> Bool
$c/= :: TypeInst -> TypeInst -> Bool
== :: TypeInst -> TypeInst -> Bool
$c== :: TypeInst -> TypeInst -> Bool
Eq, Int -> TypeInst -> ShowS
[TypeInst] -> ShowS
TypeInst -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeInst] -> ShowS
$cshowList :: [TypeInst] -> ShowS
show :: TypeInst -> String
$cshow :: TypeInst -> String
showsPrec :: Int -> TypeInst -> ShowS
$cshowsPrec :: Int -> TypeInst -> ShowS
Show, Eq TypeInst
TypeInst -> TypeInst -> Bool
TypeInst -> TypeInst -> Ordering
TypeInst -> TypeInst -> TypeInst
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 :: TypeInst -> TypeInst -> TypeInst
$cmin :: TypeInst -> TypeInst -> TypeInst
max :: TypeInst -> TypeInst -> TypeInst
$cmax :: TypeInst -> TypeInst -> TypeInst
>= :: TypeInst -> TypeInst -> Bool
$c>= :: TypeInst -> TypeInst -> Bool
> :: TypeInst -> TypeInst -> Bool
$c> :: TypeInst -> TypeInst -> Bool
<= :: TypeInst -> TypeInst -> Bool
$c<= :: TypeInst -> TypeInst -> Bool
< :: TypeInst -> TypeInst -> Bool
$c< :: TypeInst -> TypeInst -> Bool
compare :: TypeInst -> TypeInst -> Ordering
$ccompare :: TypeInst -> TypeInst -> Ordering
Ord, Typeable TypeInst
TypeInst -> DataType
TypeInst -> Constr
(forall b. Data b => b -> b) -> TypeInst -> TypeInst
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) -> TypeInst -> u
forall u. (forall d. Data d => d -> u) -> TypeInst -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeInst -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeInst -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeInst -> m TypeInst
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeInst -> m TypeInst
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeInst
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeInst -> c TypeInst
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeInst)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeInst)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeInst -> m TypeInst
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeInst -> m TypeInst
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeInst -> m TypeInst
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeInst -> m TypeInst
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeInst -> m TypeInst
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeInst -> m TypeInst
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TypeInst -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TypeInst -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TypeInst -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TypeInst -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeInst -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeInst -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeInst -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeInst -> r
gmapT :: (forall b. Data b => b -> b) -> TypeInst -> TypeInst
$cgmapT :: (forall b. Data b => b -> b) -> TypeInst -> TypeInst
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeInst)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeInst)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeInst)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeInst)
dataTypeOf :: TypeInst -> DataType
$cdataTypeOf :: TypeInst -> DataType
toConstr :: TypeInst -> Constr
$ctoConstr :: TypeInst -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeInst
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeInst
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeInst -> c TypeInst
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeInst -> c TypeInst
Data, Typeable, forall x. Rep TypeInst x -> TypeInst
forall x. TypeInst -> Rep TypeInst x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TypeInst x -> TypeInst
$cfrom :: forall x. TypeInst -> Rep TypeInst x
Generic)

-- | Reify the given data or newtype declaration, and yields its
-- 'DataType' representation.
reifyDataType :: Name -> Q DataType
reifyDataType :: Name -> Q DataType
reifyDataType Name
name = do
    Info
info <- Name -> Q Info
reify Name
name
    case Info -> Maybe DataType
infoToDataType Info
info of
        Maybe DataType
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Expected to reify a datatype. Instead got:\n" forall a. [a] -> [a] -> [a]
++ forall a. Ppr a => a -> String
pprint Info
info
        Just DataType
x -> forall (m :: * -> *) a. Monad m => a -> m a
return DataType
x

-- | Reify the given data constructor.
reifyDataCon :: Name -> Q DataCon
reifyDataCon :: Name -> Q DataCon
reifyDataCon Name
name = do
    Info
info <- Name -> Q Info
reify Name
name
    case Info -> Maybe DataCon
infoToDataCon Info
info of
        Maybe DataCon
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Expected to reify a constructor. Instead got:\n" forall a. [a] -> [a] -> [a]
++ forall a. Ppr a => a -> String
pprint Info
info
        Just DataCon
x -> forall (m :: * -> *) a. Monad m => a -> m a
return DataCon
x

-- | Reify the given data family, and yield its 'DataFamily'
-- representation.
reifyDataFamily :: Name -> Q DataFamily
reifyDataFamily :: Name -> Q DataFamily
reifyDataFamily Name
name = do
    Info
info <- Name -> Q Info
reify Name
name
    case Info -> Maybe DataFamily
infoToDataFamily Info
info of
        Maybe DataFamily
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Expected to reify a data family. Instead got:\n" forall a. [a] -> [a] -> [a]
++ forall a. Ppr a => a -> String
pprint Info
info
        Just DataFamily
x -> forall (m :: * -> *) a. Monad m => a -> m a
return DataFamily
x

-- | Reify the given type family instance declaration, and yields its
-- 'TypeInst' representation.
reifyTypeFamily :: Name -> Q TypeFamily
reifyTypeFamily :: Name -> Q TypeFamily
reifyTypeFamily Name
name = do
    Info
info <- Name -> Q Info
reify Name
name
    case Info -> Maybe TypeFamily
infoToTypeFamily Info
info of
        Maybe TypeFamily
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Expected to reify a type family. Instead got:\n" forall a. [a] -> [a] -> [a]
++ forall a. Ppr a => a -> String
pprint Info
info
        Just TypeFamily
x -> forall (m :: * -> *) a. Monad m => a -> m a
return TypeFamily
x

infoToDataType :: Info -> Maybe DataType
infoToDataType :: Info -> Maybe DataType
infoToDataType Info
info = case Info
info of
#if MIN_VERSION_template_haskell(2,11,0)
    TyConI (DataD Cxt
preds Name
name [TyVarBndr ()]
tvs Maybe Type
_kind [Con]
cons [DerivClause]
_deriving) ->
#else
    TyConI (DataD preds name tvs cons _deriving) ->
#endif
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Cxt -> [DataCon] -> DataType
DataType Name
name (forall a b. (a -> b) -> [a] -> [b]
map forall flag. TyVarBndr_ flag -> Name
tyVarBndrName [TyVarBndr ()]
tvs) Cxt
preds (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Con -> [DataCon]
conToDataCons [Con]
cons)
#if MIN_VERSION_template_haskell(2,11,0)
    TyConI (NewtypeD Cxt
preds Name
name [TyVarBndr ()]
tvs Maybe Type
_kind Con
con [DerivClause]
_deriving) ->
#else
    TyConI (NewtypeD preds name tvs con _deriving) ->
#endif
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Cxt -> [DataCon] -> DataType
DataType Name
name (forall a b. (a -> b) -> [a] -> [b]
map forall flag. TyVarBndr_ flag -> Name
tyVarBndrName [TyVarBndr ()]
tvs) Cxt
preds (Con -> [DataCon]
conToDataCons Con
con)
    Info
_ -> forall a. Maybe a
Nothing

infoToDataFamily :: Info -> Maybe DataFamily
infoToDataFamily :: Info -> Maybe DataFamily
infoToDataFamily Info
info = case Info
info of
#if MIN_VERSION_template_haskell(2,11,0)
    FamilyI (DataFamilyD Name
name [TyVarBndr ()]
tvs Maybe Type
_kind) [Dec]
insts ->
#else
    FamilyI (FamilyD DataFam name tvs _kind) insts ->
#endif
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> [DataInst] -> DataFamily
DataFamily Name
name (forall a b. (a -> b) -> [a] -> [b]
map forall flag. TyVarBndr_ flag -> Name
tyVarBndrName [TyVarBndr ()]
tvs) (forall a b. (a -> b) -> [a] -> [b]
map Dec -> DataInst
go [Dec]
insts)
    Info
_ -> forall a. Maybe a
Nothing
  where
#if MIN_VERSION_template_haskell(2,15,0)
    go :: Dec -> DataInst
go (NewtypeInstD Cxt
preds Maybe [TyVarBndr ()]
_ Type
lhs Maybe Type
_kind Con
con [DerivClause]
_deriving)
      | ConT Name
name:Cxt
params <- Type -> Cxt
unAppsT Type
lhs
#elif MIN_VERSION_template_haskell(2,11,0)
    go (NewtypeInstD preds name params _kind con _deriving)
#else
    go (NewtypeInstD preds name params       con _deriving)
#endif
      = Name -> Cxt -> Cxt -> [DataCon] -> DataInst
DataInst Name
name Cxt
preds Cxt
params (Con -> [DataCon]
conToDataCons Con
con)
#if MIN_VERSION_template_haskell(2,15,0)
    go (DataInstD Cxt
preds Maybe [TyVarBndr ()]
_ Type
lhs Maybe Type
_kind [Con]
cons [DerivClause]
_deriving)
      | ConT Name
name:Cxt
params <- Type -> Cxt
unAppsT Type
lhs
#elif MIN_VERSION_template_haskell(2,11,0)
    go (DataInstD preds name params _kind cons _deriving)
#else
    go (DataInstD preds name params       cons _deriving)
#endif
      = Name -> Cxt -> Cxt -> [DataCon] -> DataInst
DataInst Name
name Cxt
preds Cxt
params (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Con -> [DataCon]
conToDataCons [Con]
cons)
    go Dec
info' = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$
        String
"Unexpected instance in FamilyI in infoToDataInsts:\n" forall a. [a] -> [a] -> [a]
++ forall a. Ppr a => a -> String
pprint Dec
info'

infoToTypeFamily :: Info -> Maybe TypeFamily
infoToTypeFamily :: Info -> Maybe TypeFamily
infoToTypeFamily Info
info = case Info
info of
#if MIN_VERSION_template_haskell(2,11,0)
    FamilyI (ClosedTypeFamilyD (TypeFamilyHead Name
name [TyVarBndr ()]
tvs FamilyResultSig
_result Maybe InjectivityAnn
_injectivity) [TySynEqn]
eqns) [Dec]
_ ->
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> [TypeInst] -> TypeFamily
TypeFamily Name
name (forall a b. (a -> b) -> [a] -> [b]
map forall flag. TyVarBndr_ flag -> Name
tyVarBndrName [TyVarBndr ()]
tvs) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Name -> TySynEqn -> TypeInst
goEqn Name
name) [TySynEqn]
eqns
    FamilyI (OpenTypeFamilyD (TypeFamilyHead Name
name [TyVarBndr ()]
tvs FamilyResultSig
_result Maybe InjectivityAnn
_injectivity)) [Dec]
insts ->
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> [TypeInst] -> TypeFamily
TypeFamily Name
name (forall a b. (a -> b) -> [a] -> [b]
map forall flag. TyVarBndr_ flag -> Name
tyVarBndrName [TyVarBndr ()]
tvs) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Name -> Dec -> TypeInst
goInst Name
name) [Dec]
insts
#else
    FamilyI (ClosedTypeFamilyD name tvs _kind eqns) [] ->
        Just $ TypeFamily name (map tyVarBndrName tvs) $ map (goEqn name) eqns
    FamilyI (FamilyD TypeFam name tvs _kind) insts ->
        Just $ TypeFamily name (map tyVarBndrName tvs) $ map (goInst name) insts
#endif
    Info
_ -> forall a. Maybe a
Nothing
  where
#if MIN_VERSION_template_haskell(2,15,0)
    toParams :: Cxt -> Type -> Cxt
toParams Cxt
ps (AppT Type
ty Type
p) = Cxt -> Type -> Cxt
toParams (Type
p forall a. a -> [a] -> [a]
: Cxt
ps) Type
ty
    toParams Cxt
ps (AppKindT Type
ty Type
_) = Cxt -> Type -> Cxt
toParams Cxt
ps Type
ty
    toParams Cxt
ps Type
_ = Cxt
ps
    goEqn :: Name -> TySynEqn -> TypeInst
goEqn Name
name (TySynEqn Maybe [TyVarBndr ()]
_ Type
lty Type
rty) = Name -> Cxt -> Type -> TypeInst
TypeInst Name
name (Cxt -> Type -> Cxt
toParams [] Type
lty) Type
rty
    goInst :: Name -> Dec -> TypeInst
goInst Name
name (TySynInstD TySynEqn
eqn) = Name -> TySynEqn -> TypeInst
goEqn Name
name TySynEqn
eqn
    goInst Name
_ Dec
info' = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$
        String
"Unexpected instance in FamilyI in infoToTypeInsts:\n" forall a. [a] -> [a] -> [a]
++ forall a. Ppr a => a -> String
pprint Dec
info'
#else
    goEqn name (TySynEqn params ty) = TypeInst name params ty
    goInst name (TySynInstD _ eqn) = goEqn name eqn
    goInst _ info' = error $
        "Unexpected instance in FamilyI in infoToTypeInsts:\n" ++ pprint info'
#endif

infoToDataCon :: Info -> Maybe DataCon
infoToDataCon :: Info -> Maybe DataCon
infoToDataCon Info
info = case Info
info of
#if MIN_VERSION_template_haskell(2,11,0)
    DataConI Name
name Type
ty Name
_parent ->
#else
    DataConI name ty _parent _fixity ->
#endif
        forall a. a -> Maybe a
Just (Name -> Type -> DataCon
typeToDataCon Name
name Type
ty)
    Info
_ -> forall a. Maybe a
Nothing

-- | Creates a 'DataCon' given the 'Name' and 'Type' of a
-- data-constructor.  Note that the result the function type is *not* checked to match the provided 'Name'.
typeToDataCon :: Name -> Type -> DataCon
typeToDataCon :: Name -> Type -> DataCon
typeToDataCon Name
dcName Type
ty0 = DataCon {Cxt
[Name]
Name
forall {a}. [(Maybe a, Type)]
dcFields :: forall {a}. [(Maybe a, Type)]
dcCxt :: Cxt
dcTvs :: [Name]
dcName :: Name
dcFields :: [(Maybe Name, Type)]
dcCxt :: Cxt
dcTvs :: [Name]
dcName :: Name
..}
  where
    ([Name]
dcTvs, Cxt
dcCxt, [(Maybe a, Type)]
dcFields) = case Type
ty0 of
        ForallT [TyVarBndr Specificity]
tvs Cxt
preds Type
ty -> (forall a b. (a -> b) -> [a] -> [b]
map forall flag. TyVarBndr_ flag -> Name
tyVarBndrName [TyVarBndr Specificity]
tvs, Cxt
preds, forall {a}. Type -> [(Maybe a, Type)]
typeToFields Type
ty)
        Type
ty -> ([], [], forall {a}. Type -> [(Maybe a, Type)]
typeToFields Type
ty)
    -- TODO: Should we sanity check the result type?
    typeToFields :: Type -> [(Maybe a, Type)]
typeToFields = forall a. [a] -> [a]
init forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Maybe a
Nothing, ) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Cxt
unAppsT

-- | Convert a 'Con' to a list of 'DataCon'. The result is a list
-- because 'GadtC' and 'RecGadtC' can define multiple constructors.
conToDataCons :: Con -> [DataCon]
conToDataCons :: Con -> [DataCon]
conToDataCons = \case
    NormalC Name
name [BangType]
slots ->
        [Name -> [Name] -> Cxt -> [(Maybe Name, Type)] -> DataCon
DataCon Name
name [] [] (forall a b. (a -> b) -> [a] -> [b]
map (\(Bang
_, Type
ty) -> (forall a. Maybe a
Nothing, Type
ty)) [BangType]
slots)]
    RecC Name
name [VarBangType]
fields ->
        [Name -> [Name] -> Cxt -> [(Maybe Name, Type)] -> DataCon
DataCon Name
name [] [] (forall a b. (a -> b) -> [a] -> [b]
map (\(Name
n, Bang
_, Type
ty) -> (forall a. a -> Maybe a
Just Name
n, Type
ty)) [VarBangType]
fields)]
    InfixC (Bang
_, Type
ty1) Name
name (Bang
_, Type
ty2) ->
        [Name -> [Name] -> Cxt -> [(Maybe Name, Type)] -> DataCon
DataCon Name
name [] [] [(forall a. Maybe a
Nothing, Type
ty1), (forall a. Maybe a
Nothing, Type
ty2)]]
    ForallC [TyVarBndr Specificity]
tvs Cxt
preds Con
con ->
        forall a b. (a -> b) -> [a] -> [b]
map (\(DataCon Name
name [Name]
tvs0 Cxt
preds0 [(Maybe Name, Type)]
fields) ->
            Name -> [Name] -> Cxt -> [(Maybe Name, Type)] -> DataCon
DataCon Name
name ([Name]
tvs0 forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall flag. TyVarBndr_ flag -> Name
tyVarBndrName [TyVarBndr Specificity]
tvs) (Cxt
preds0 forall a. [a] -> [a] -> [a]
++ Cxt
preds) [(Maybe Name, Type)]
fields) (Con -> [DataCon]
conToDataCons Con
con)
#if MIN_VERSION_template_haskell(2,11,0)
    GadtC [Name]
ns [BangType]
slots Type
_ ->
        forall a b. (a -> b) -> [a] -> [b]
map (\Name
dn -> Name -> [Name] -> Cxt -> [(Maybe Name, Type)] -> DataCon
DataCon Name
dn [] [] (forall a b. (a -> b) -> [a] -> [b]
map (\(Bang
_, Type
ty) -> (forall a. Maybe a
Nothing, Type
ty)) [BangType]
slots)) [Name]
ns
    RecGadtC [Name]
ns [VarBangType]
fields Type
_ ->
        forall a b. (a -> b) -> [a] -> [b]
map (\Name
dn -> Name -> [Name] -> Cxt -> [(Maybe Name, Type)] -> DataCon
DataCon Name
dn [] [] (forall a b. (a -> b) -> [a] -> [b]
map (\(Name
fn, Bang
_, Type
ty) -> (forall a. a -> Maybe a
Just Name
fn, Type
ty)) [VarBangType]
fields)) [Name]
ns
#endif

-- | Like 'reifyDataType', but takes a 'Type' instead of just the 'Name'
-- of the datatype. It expects a normal datatype argument (see
-- 'typeToNamedCon').
reifyDataTypeSubstituted :: Type -> Q DataType
reifyDataTypeSubstituted :: Type -> Q DataType
reifyDataTypeSubstituted Type
ty =
    case Type -> Maybe (Name, Cxt)
typeToNamedCon Type
ty of
        Maybe (Name, Cxt)
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Expected a datatype, but reifyDataTypeSubstituted was applied to " forall a. [a] -> [a] -> [a]
++ forall a. Ppr a => a -> String
pprint Type
ty
        Just (Name
n, Cxt
args) -> do
            DataType
dt <- Name -> Q DataType
reifyDataType Name
n
            let cons' :: [DataCon]
cons' = forall a. Data a => Map Name Type -> a -> a
substituteTvs (forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (forall a b. [a] -> [b] -> [(a, b)]
zip (DataType -> [Name]
dtTvs DataType
dt) Cxt
args)) (DataType -> [DataCon]
dtCons DataType
dt)
            forall (m :: * -> *) a. Monad m => a -> m a
return (DataType
dt { dtCons :: [DataCon]
dtCons = [DataCon]
cons' })

-- TODO: add various handy generics based traversals to TH.Utilities

substituteTvs :: Data a => M.Map Name Type -> a -> a
substituteTvs :: forall a. Data a => Map Name Type -> a -> a
substituteTvs Map Name Type
mp = forall a. Data a => (Type -> Type) -> a -> a
transformTypes Type -> Type
go
  where
    go :: Type -> Type
go (VarT Name
name) | Just Type
ty <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
name Map Name Type
mp = Type
ty
    go Type
ty = forall a. Data a => (forall b. Data b => b -> b) -> a -> a
gmapT (forall a. Data a => Map Name Type -> a -> a
substituteTvs Map Name Type
mp) Type
ty

transformTypes :: Data a => (Type -> Type) -> a -> a
transformTypes :: forall a. Data a => (Type -> Type) -> a -> a
transformTypes Type -> Type
f = forall a. Data a => (forall b. Data b => b -> b) -> a -> a
gmapT (forall a. Data a => (Type -> Type) -> a -> a
transformTypes Type -> Type
f) forall a b.
(Typeable a, Typeable b) =>
(a -> a) -> (b -> b) -> a -> a
`extT` (forall a. a -> a
id :: String -> String) forall a b.
(Typeable a, Typeable b) =>
(a -> a) -> (b -> b) -> a -> a
`extT` Type -> Type
f