{- Language/Haskell/TH/Desugar/Util.hs

(c) Richard Eisenberg 2013
rae@cs.brynmawr.edu

Utility functions for th-desugar package.
-}

{-# LANGUAGE CPP, DeriveDataTypeable, DeriveGeneric, DeriveLift, RankNTypes,
             ScopedTypeVariables, TupleSections, AllowAmbiguousTypes,
             TemplateHaskellQuotes, TypeApplications #-}

module Language.Haskell.TH.Desugar.Util (
  newUniqueName,
  impossible,
  nameOccursIn, allNamesIn, mkTypeName, mkDataName, mkNameWith, isDataName,
  stripVarP_maybe, extractBoundNamesStmt,
  concatMapM, mapAccumLM, mapMaybeM, expectJustM,
  stripPlainTV_maybe,
  thirdOf3, splitAtList, extractBoundNamesDec,
  extractBoundNamesPat,
  tvbToType, tvbToTypeWithSig, tvbToTANormalWithSig,
  nameMatches, thdOf3, liftFst, liftSnd, firstMatch, firstMatchM,
  unboxedSumDegree_maybe, unboxedSumNameDegree_maybe,
  tupleDegree_maybe, tupleNameDegree_maybe, unboxedTupleDegree_maybe,
  unboxedTupleNameDegree_maybe, splitTuple_maybe,
  topEverywhereM, isInfixDataCon,
  isTypeKindName, typeKindName,
  unSigType, unfoldType, ForallTelescope(..), FunArgs(..), VisFunArg(..),
  filterVisFunArgs, ravelType, unravelType,
  TypeArg(..), applyType, filterTANormals, probablyWrongUnTypeArg,
  bindIP,
  DataFlavor(..)
  ) where

import Prelude hiding (mapM, foldl, concatMap, any)

import Language.Haskell.TH hiding ( cxt )
import Language.Haskell.TH.Datatype.TyVarBndr
import qualified Language.Haskell.TH.Desugar.OSet as OS
import Language.Haskell.TH.Desugar.OSet (OSet)
import Language.Haskell.TH.Syntax

import qualified Control.Monad.Fail as Fail
import Data.Foldable
import qualified Data.Kind as Kind
import Data.Generics ( Data, Typeable, everything, extM, gmapM, mkQ )
import Data.Traversable
import Data.Maybe
import GHC.Classes ( IP )
import GHC.Generics ( Generic )
import Unsafe.Coerce ( unsafeCoerce )

----------------------------------------

-- TH manipulations

----------------------------------------


-- | Like newName, but even more unique (unique across different splices),

-- and with unique @nameBase@s. Precondition: the string is a valid Haskell

-- alphanumeric identifier (could be upper- or lower-case).

newUniqueName :: Quasi q => String -> q Name
newUniqueName :: forall (q :: * -> *). Quasi q => String -> q Name
newUniqueName String
str = do
  Name
n <- forall (q :: * -> *). Quasi q => String -> q Name
qNewName String
str
  forall (q :: * -> *). Quasi q => String -> q Name
qNewName forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Name
n

-- | @mkNameWith lookup_fun mkName_fun str@ looks up the exact 'Name' of @str@

-- using the function @lookup_fun@. If it finds 'Just' the 'Name', meaning

-- that it is bound in the current scope, then it is returned. If it finds

-- 'Nothing', it assumes that @str@ is declared in the current module, and

-- uses @mkName_fun@ to construct the appropriate 'Name' to return.

mkNameWith :: Quasi q => (String -> q (Maybe Name))
                      -> (String -> String -> String -> Name)
                      -> String -> q Name
mkNameWith :: forall (q :: * -> *).
Quasi q =>
(String -> q (Maybe Name))
-> (String -> String -> String -> Name) -> String -> q Name
mkNameWith String -> q (Maybe Name)
lookup_fun String -> String -> String -> Name
mkName_fun String
str = do
  Maybe Name
m_name <- String -> q (Maybe Name)
lookup_fun String
str
  case Maybe Name
m_name of
    Just Name
name -> forall (m :: * -> *) a. Monad m => a -> m a
return Name
name
    Maybe Name
Nothing -> do
      Loc { loc_package :: Loc -> String
loc_package = String
pkg, loc_module :: Loc -> String
loc_module = String
modu } <- forall (m :: * -> *). Quasi m => m Loc
qLocation
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> String -> String -> Name
mkName_fun String
pkg String
modu String
str

-- | Like TH's @lookupTypeName@, but if this name is not bound, then we assume

-- it is declared in the current module.

mkTypeName :: Quasi q => String -> q Name
mkTypeName :: forall (q :: * -> *). Quasi q => String -> q Name
mkTypeName = forall (q :: * -> *).
Quasi q =>
(String -> q (Maybe Name))
-> (String -> String -> String -> Name) -> String -> q Name
mkNameWith (forall (m :: * -> *). Quasi m => Bool -> String -> m (Maybe Name)
qLookupName Bool
True) String -> String -> String -> Name
mkNameG_tc

-- | Like TH's @lookupDataName@, but if this name is not bound, then we assume

-- it is declared in the current module.

mkDataName :: Quasi q => String -> q Name
mkDataName :: forall (q :: * -> *). Quasi q => String -> q Name
mkDataName = forall (q :: * -> *).
Quasi q =>
(String -> q (Maybe Name))
-> (String -> String -> String -> Name) -> String -> q Name
mkNameWith (forall (m :: * -> *). Quasi m => Bool -> String -> m (Maybe Name)
qLookupName Bool
False) String -> String -> String -> Name
mkNameG_d

-- | Is this name a data constructor name? A 'False' answer means "unsure".

isDataName :: Name -> Bool
isDataName :: Name -> Bool
isDataName (Name OccName
_ (NameG NameSpace
DataName PkgName
_ ModName
_)) = Bool
True
isDataName Name
_                             = Bool
False

-- | Extracts the name out of a variable pattern, or returns @Nothing@

stripVarP_maybe :: Pat -> Maybe Name
stripVarP_maybe :: Pat -> Maybe Name
stripVarP_maybe (VarP Name
name) = forall a. a -> Maybe a
Just Name
name
stripVarP_maybe Pat
_           = forall a. Maybe a
Nothing

-- | Extracts the name out of a @PlainTV@, or returns @Nothing@

stripPlainTV_maybe :: TyVarBndr_ flag -> Maybe Name
stripPlainTV_maybe :: forall flag. TyVarBndr_ flag -> Maybe Name
stripPlainTV_maybe = forall r flag.
(Name -> r) -> (Name -> Kind -> r) -> TyVarBndr_ flag -> r
elimTV forall a. a -> Maybe a
Just (\Name
_ Kind
_ -> forall a. Maybe a
Nothing)

-- | Report that a certain TH construct is impossible

impossible :: Fail.MonadFail q => String -> q a
impossible :: forall (q :: * -> *) a. MonadFail q => String -> q a
impossible String
err = forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String
err forall a. [a] -> [a] -> [a]
++ String
"\n    This should not happen in Haskell.\n    Please email rae@cs.brynmawr.edu with your code if you see this.")

-- | Convert a 'TyVarBndr' into a 'Type', dropping the kind signature

-- (if it has one).

tvbToType :: TyVarBndr_ flag -> Type
tvbToType :: forall flag. TyVarBndr_ flag -> Kind
tvbToType = Name -> Kind
VarT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall flag. TyVarBndr_ flag -> Name
tvName

-- | Convert a 'TyVarBndr' into a 'Type', preserving the kind signature

-- (if it has one).

tvbToTypeWithSig :: TyVarBndr_ flag -> Type
tvbToTypeWithSig :: forall flag. TyVarBndr_ flag -> Kind
tvbToTypeWithSig = forall r flag.
(Name -> r) -> (Name -> Kind -> r) -> TyVarBndr_ flag -> r
elimTV Name -> Kind
VarT (\Name
n Kind
k -> Kind -> Kind -> Kind
SigT (Name -> Kind
VarT Name
n) Kind
k)

-- | Convert a 'TyVarBndr' into a 'TypeArg' (specifically, a 'TANormal'),

-- preserving the kind signature (if it has one).

tvbToTANormalWithSig :: TyVarBndr_ flag -> TypeArg
tvbToTANormalWithSig :: forall flag. TyVarBndr_ flag -> TypeArg
tvbToTANormalWithSig = Kind -> TypeArg
TANormal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall flag. TyVarBndr_ flag -> Kind
tvbToTypeWithSig

-- | Do two names name the same thing?

nameMatches :: Name -> Name -> Bool
nameMatches :: Name -> Name -> Bool
nameMatches n1 :: Name
n1@(Name OccName
occ1 NameFlavour
flav1) n2 :: Name
n2@(Name OccName
occ2 NameFlavour
flav2)
  | NameFlavour
NameS <- NameFlavour
flav1 = OccName
occ1 forall a. Eq a => a -> a -> Bool
== OccName
occ2
  | NameFlavour
NameS <- NameFlavour
flav2 = OccName
occ1 forall a. Eq a => a -> a -> Bool
== OccName
occ2
  | NameQ ModName
mod1 <- NameFlavour
flav1
  , NameQ ModName
mod2 <- NameFlavour
flav2
  = ModName
mod1 forall a. Eq a => a -> a -> Bool
== ModName
mod2 Bool -> Bool -> Bool
&& OccName
occ1 forall a. Eq a => a -> a -> Bool
== OccName
occ2
  | NameQ ModName
mod1 <- NameFlavour
flav1
  , NameG NameSpace
_ PkgName
_ ModName
mod2 <- NameFlavour
flav2
  = ModName
mod1 forall a. Eq a => a -> a -> Bool
== ModName
mod2 Bool -> Bool -> Bool
&& OccName
occ1 forall a. Eq a => a -> a -> Bool
== OccName
occ2
  | NameG NameSpace
_ PkgName
_ ModName
mod1 <- NameFlavour
flav1
  , NameQ ModName
mod2 <- NameFlavour
flav2
  = ModName
mod1 forall a. Eq a => a -> a -> Bool
== ModName
mod2 Bool -> Bool -> Bool
&& OccName
occ1 forall a. Eq a => a -> a -> Bool
== OccName
occ2
  | Bool
otherwise
  = Name
n1 forall a. Eq a => a -> a -> Bool
== Name
n2

-- | Extract the degree of a tuple

tupleDegree_maybe :: String -> Maybe Int
tupleDegree_maybe :: String -> Maybe Int
tupleDegree_maybe String
s = do
  Char
'(' : String
s1 <- forall (m :: * -> *) a. Monad m => a -> m a
return String
s
  (String
commas, String
")") <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
== Char
',') String
s1
  let degree :: Int
degree
        | String
"" <- String
commas = Int
0
        | Bool
otherwise    = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
commas forall a. Num a => a -> a -> a
+ Int
1
  forall (m :: * -> *) a. Monad m => a -> m a
return Int
degree

-- | Extract the degree of a tuple name

tupleNameDegree_maybe :: Name -> Maybe Int
tupleNameDegree_maybe :: Name -> Maybe Int
tupleNameDegree_maybe = String -> Maybe Int
tupleDegree_maybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
nameBase

-- | Extract the degree of an unboxed sum

unboxedSumDegree_maybe :: String -> Maybe Int
unboxedSumDegree_maybe :: String -> Maybe Int
unboxedSumDegree_maybe = Char -> String -> Maybe Int
unboxedSumTupleDegree_maybe Char
'|'

-- | Extract the degree of an unboxed sum name

unboxedSumNameDegree_maybe :: Name -> Maybe Int
unboxedSumNameDegree_maybe :: Name -> Maybe Int
unboxedSumNameDegree_maybe = String -> Maybe Int
unboxedSumDegree_maybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
nameBase

-- | Extract the degree of an unboxed tuple

unboxedTupleDegree_maybe :: String -> Maybe Int
unboxedTupleDegree_maybe :: String -> Maybe Int
unboxedTupleDegree_maybe = Char -> String -> Maybe Int
unboxedSumTupleDegree_maybe Char
','

-- | Extract the degree of an unboxed sum or tuple

unboxedSumTupleDegree_maybe :: Char -> String -> Maybe Int
unboxedSumTupleDegree_maybe :: Char -> String -> Maybe Int
unboxedSumTupleDegree_maybe Char
sep String
s = do
  Char
'(' : Char
'#' : String
s1 <- forall (m :: * -> *) a. Monad m => a -> m a
return String
s
  (String
seps, String
"#)") <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
== Char
sep) String
s1
  let degree :: Int
degree
        | String
"" <- String
seps = Int
0
        | Bool
otherwise  = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
seps forall a. Num a => a -> a -> a
+ Int
1
  forall (m :: * -> *) a. Monad m => a -> m a
return Int
degree

-- | Extract the degree of an unboxed tuple name

unboxedTupleNameDegree_maybe :: Name -> Maybe Int
unboxedTupleNameDegree_maybe :: Name -> Maybe Int
unboxedTupleNameDegree_maybe = String -> Maybe Int
unboxedTupleDegree_maybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
nameBase

-- | If the argument is a tuple type, return the components

splitTuple_maybe :: Type -> Maybe [Type]
splitTuple_maybe :: Kind -> Maybe [Kind]
splitTuple_maybe Kind
t = [Kind] -> Kind -> Maybe [Kind]
go [] Kind
t
  where go :: [Kind] -> Kind -> Maybe [Kind]
go [Kind]
args (Kind
t1 `AppT` Kind
t2) = [Kind] -> Kind -> Maybe [Kind]
go (Kind
t2forall a. a -> [a] -> [a]
:[Kind]
args) Kind
t1
        go [Kind]
args (Kind
t1 `SigT` Kind
_k) = [Kind] -> Kind -> Maybe [Kind]
go [Kind]
args Kind
t1
        go [Kind]
args (ConT Name
con_name)
          | Just Int
degree <- Name -> Maybe Int
tupleNameDegree_maybe Name
con_name
          , forall (t :: * -> *) a. Foldable t => t a -> Int
length [Kind]
args forall a. Eq a => a -> a -> Bool
== Int
degree
          = forall a. a -> Maybe a
Just [Kind]
args
        go [Kind]
args (TupleT Int
degree)
          | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Kind]
args forall a. Eq a => a -> a -> Bool
== Int
degree
          = forall a. a -> Maybe a
Just [Kind]
args
        go [Kind]
_ Kind
_ = forall a. Maybe a
Nothing

-- | The type variable binders in a @forall@. This is not used by the TH AST

-- itself, but this is used as an intermediate data type in 'FAForalls'.

data ForallTelescope
  = ForallVis [TyVarBndrUnit]
    -- ^ A visible @forall@ (e.g., @forall a -> {...}@).

    --   These do not have any notion of specificity, so we use

    --   '()' as a placeholder value in the 'TyVarBndr's.

  | ForallInvis [TyVarBndrSpec]
    -- ^ An invisible @forall@ (e.g., @forall a {b} c -> {...}@),

    --   where each binder has a 'Specificity'.

  deriving (ForallTelescope -> ForallTelescope -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ForallTelescope -> ForallTelescope -> Bool
$c/= :: ForallTelescope -> ForallTelescope -> Bool
== :: ForallTelescope -> ForallTelescope -> Bool
$c== :: ForallTelescope -> ForallTelescope -> Bool
Eq, Int -> ForallTelescope -> ShowS
[ForallTelescope] -> ShowS
ForallTelescope -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ForallTelescope] -> ShowS
$cshowList :: [ForallTelescope] -> ShowS
show :: ForallTelescope -> String
$cshow :: ForallTelescope -> String
showsPrec :: Int -> ForallTelescope -> ShowS
$cshowsPrec :: Int -> ForallTelescope -> ShowS
Show, Typeable ForallTelescope
ForallTelescope -> DataType
ForallTelescope -> Constr
(forall b. Data b => b -> b) -> ForallTelescope -> ForallTelescope
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) -> ForallTelescope -> u
forall u. (forall d. Data d => d -> u) -> ForallTelescope -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ForallTelescope -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ForallTelescope -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ForallTelescope -> m ForallTelescope
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ForallTelescope -> m ForallTelescope
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ForallTelescope
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ForallTelescope -> c ForallTelescope
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ForallTelescope)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ForallTelescope)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ForallTelescope -> m ForallTelescope
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ForallTelescope -> m ForallTelescope
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ForallTelescope -> m ForallTelescope
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ForallTelescope -> m ForallTelescope
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ForallTelescope -> m ForallTelescope
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ForallTelescope -> m ForallTelescope
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ForallTelescope -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ForallTelescope -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ForallTelescope -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ForallTelescope -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ForallTelescope -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ForallTelescope -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ForallTelescope -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ForallTelescope -> r
gmapT :: (forall b. Data b => b -> b) -> ForallTelescope -> ForallTelescope
$cgmapT :: (forall b. Data b => b -> b) -> ForallTelescope -> ForallTelescope
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ForallTelescope)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ForallTelescope)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ForallTelescope)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ForallTelescope)
dataTypeOf :: ForallTelescope -> DataType
$cdataTypeOf :: ForallTelescope -> DataType
toConstr :: ForallTelescope -> Constr
$ctoConstr :: ForallTelescope -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ForallTelescope
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ForallTelescope
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ForallTelescope -> c ForallTelescope
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ForallTelescope -> c ForallTelescope
Data)

-- | The list of arguments in a function 'Type'.

data FunArgs
  = FANil
    -- ^ No more arguments.

  | FAForalls ForallTelescope FunArgs
    -- ^ A series of @forall@ed type variables followed by a dot (if

    --   'ForallInvis') or an arrow (if 'ForallVis'). For example,

    --   the type variables @a1 ... an@ in @forall a1 ... an. r@.

  | FACxt Cxt FunArgs
    -- ^ A series of constraint arguments followed by @=>@. For example,

    --   the @(c1, ..., cn)@ in @(c1, ..., cn) => r@.

  | FAAnon Type FunArgs
    -- ^ An anonymous argument followed by an arrow. For example, the @a@

    --   in @a -> r@.

  deriving (FunArgs -> FunArgs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunArgs -> FunArgs -> Bool
$c/= :: FunArgs -> FunArgs -> Bool
== :: FunArgs -> FunArgs -> Bool
$c== :: FunArgs -> FunArgs -> Bool
Eq, Int -> FunArgs -> ShowS
[FunArgs] -> ShowS
FunArgs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunArgs] -> ShowS
$cshowList :: [FunArgs] -> ShowS
show :: FunArgs -> String
$cshow :: FunArgs -> String
showsPrec :: Int -> FunArgs -> ShowS
$cshowsPrec :: Int -> FunArgs -> ShowS
Show, Typeable FunArgs
FunArgs -> DataType
FunArgs -> Constr
(forall b. Data b => b -> b) -> FunArgs -> FunArgs
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) -> FunArgs -> u
forall u. (forall d. Data d => d -> u) -> FunArgs -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunArgs -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunArgs -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FunArgs -> m FunArgs
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FunArgs -> m FunArgs
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunArgs
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunArgs -> c FunArgs
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunArgs)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FunArgs)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FunArgs -> m FunArgs
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FunArgs -> m FunArgs
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FunArgs -> m FunArgs
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FunArgs -> m FunArgs
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FunArgs -> m FunArgs
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FunArgs -> m FunArgs
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FunArgs -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FunArgs -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> FunArgs -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FunArgs -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunArgs -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunArgs -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunArgs -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunArgs -> r
gmapT :: (forall b. Data b => b -> b) -> FunArgs -> FunArgs
$cgmapT :: (forall b. Data b => b -> b) -> FunArgs -> FunArgs
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FunArgs)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FunArgs)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunArgs)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunArgs)
dataTypeOf :: FunArgs -> DataType
$cdataTypeOf :: FunArgs -> DataType
toConstr :: FunArgs -> Constr
$ctoConstr :: FunArgs -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunArgs
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunArgs
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunArgs -> c FunArgs
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunArgs -> c FunArgs
Data)

-- | A /visible/ function argument type (i.e., one that must be supplied

-- explicitly in the source code). This is in contrast to /invisible/

-- arguments (e.g., the @c@ in @c => r@), which are instantiated without

-- the need for explicit user input.

data VisFunArg
  = VisFADep TyVarBndrUnit
    -- ^ A visible @forall@ (e.g., @forall a -> a@).

  | VisFAAnon Type
    -- ^ An anonymous argument followed by an arrow (e.g., @a -> r@).

  deriving (VisFunArg -> VisFunArg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VisFunArg -> VisFunArg -> Bool
$c/= :: VisFunArg -> VisFunArg -> Bool
== :: VisFunArg -> VisFunArg -> Bool
$c== :: VisFunArg -> VisFunArg -> Bool
Eq, Int -> VisFunArg -> ShowS
[VisFunArg] -> ShowS
VisFunArg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VisFunArg] -> ShowS
$cshowList :: [VisFunArg] -> ShowS
show :: VisFunArg -> String
$cshow :: VisFunArg -> String
showsPrec :: Int -> VisFunArg -> ShowS
$cshowsPrec :: Int -> VisFunArg -> ShowS
Show, Typeable VisFunArg
VisFunArg -> DataType
VisFunArg -> Constr
(forall b. Data b => b -> b) -> VisFunArg -> VisFunArg
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) -> VisFunArg -> u
forall u. (forall d. Data d => d -> u) -> VisFunArg -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VisFunArg -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VisFunArg -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> VisFunArg -> m VisFunArg
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VisFunArg -> m VisFunArg
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VisFunArg
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VisFunArg -> c VisFunArg
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VisFunArg)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c VisFunArg)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VisFunArg -> m VisFunArg
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VisFunArg -> m VisFunArg
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VisFunArg -> m VisFunArg
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VisFunArg -> m VisFunArg
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> VisFunArg -> m VisFunArg
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> VisFunArg -> m VisFunArg
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> VisFunArg -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> VisFunArg -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> VisFunArg -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> VisFunArg -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VisFunArg -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VisFunArg -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VisFunArg -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VisFunArg -> r
gmapT :: (forall b. Data b => b -> b) -> VisFunArg -> VisFunArg
$cgmapT :: (forall b. Data b => b -> b) -> VisFunArg -> VisFunArg
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c VisFunArg)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c VisFunArg)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VisFunArg)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VisFunArg)
dataTypeOf :: VisFunArg -> DataType
$cdataTypeOf :: VisFunArg -> DataType
toConstr :: VisFunArg -> Constr
$ctoConstr :: VisFunArg -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VisFunArg
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VisFunArg
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VisFunArg -> c VisFunArg
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VisFunArg -> c VisFunArg
Data)

-- | Filter the visible function arguments from a list of 'FunArgs'.

filterVisFunArgs :: FunArgs -> [VisFunArg]
filterVisFunArgs :: FunArgs -> [VisFunArg]
filterVisFunArgs FunArgs
FANil = []
filterVisFunArgs (FAForalls ForallTelescope
tele FunArgs
args) =
  case ForallTelescope
tele of
    ForallVis [TyVarBndrUnit]
tvbs -> forall a b. (a -> b) -> [a] -> [b]
map TyVarBndrUnit -> VisFunArg
VisFADep [TyVarBndrUnit]
tvbs forall a. [a] -> [a] -> [a]
++ [VisFunArg]
args'
    ForallInvis [TyVarBndrSpec]
_  -> [VisFunArg]
args'
  where
    args' :: [VisFunArg]
args' = FunArgs -> [VisFunArg]
filterVisFunArgs FunArgs
args
filterVisFunArgs (FACxt [Kind]
_ FunArgs
args) =
  FunArgs -> [VisFunArg]
filterVisFunArgs FunArgs
args
filterVisFunArgs (FAAnon Kind
t FunArgs
args) =
  Kind -> VisFunArg
VisFAAnon Kind
tforall a. a -> [a] -> [a]
:FunArgs -> [VisFunArg]
filterVisFunArgs FunArgs
args

-- | Reconstruct an arrow 'Type' from its argument and result types.

ravelType :: FunArgs -> Type -> Type
ravelType :: FunArgs -> Kind -> Kind
ravelType FunArgs
FANil Kind
res = Kind
res
-- We need a special case for FAForalls ForallInvis followed by FACxt so that we may

-- collapse them into a single ForallT when raveling.

-- See Note [Desugaring and sweetening ForallT] in L.H.T.Desugar.Core.

ravelType (FAForalls (ForallInvis [TyVarBndrSpec]
tvbs) (FACxt [Kind]
p FunArgs
args)) Kind
res =
  [TyVarBndrSpec] -> [Kind] -> Kind -> Kind
ForallT [TyVarBndrSpec]
tvbs [Kind]
p (FunArgs -> Kind -> Kind
ravelType FunArgs
args Kind
res)
ravelType (FAForalls (ForallInvis  [TyVarBndrSpec]
tvbs)  FunArgs
args)  Kind
res = [TyVarBndrSpec] -> [Kind] -> Kind -> Kind
ForallT [TyVarBndrSpec]
tvbs [] (FunArgs -> Kind -> Kind
ravelType FunArgs
args Kind
res)
ravelType (FAForalls (ForallVis   [TyVarBndrUnit]
_tvbs) FunArgs
_args) Kind
_res =
#if __GLASGOW_HASKELL__ >= 809
      [TyVarBndrUnit] -> Kind -> Kind
ForallVisT [TyVarBndrUnit]
_tvbs (FunArgs -> Kind -> Kind
ravelType FunArgs
_args Kind
_res)
#else
      error "Visible dependent quantification supported only on GHC 8.10+"
#endif
ravelType (FACxt [Kind]
cxt FunArgs
args) Kind
res = [TyVarBndrSpec] -> [Kind] -> Kind -> Kind
ForallT [] [Kind]
cxt (FunArgs -> Kind -> Kind
ravelType FunArgs
args Kind
res)
ravelType (FAAnon Kind
t FunArgs
args)  Kind
res = Kind -> Kind -> Kind
AppT (Kind -> Kind -> Kind
AppT Kind
ArrowT Kind
t) (FunArgs -> Kind -> Kind
ravelType FunArgs
args Kind
res)

-- | Decompose a function 'Type' into its arguments (the 'FunArgs') and its

-- result type (the 'Type).

unravelType :: Type -> (FunArgs, Type)
unravelType :: Kind -> (FunArgs, Kind)
unravelType (ForallT [TyVarBndrSpec]
tvbs [Kind]
cxt Kind
ty) =
  let (FunArgs
args, Kind
res) = Kind -> (FunArgs, Kind)
unravelType Kind
ty in
  (ForallTelescope -> FunArgs -> FunArgs
FAForalls ([TyVarBndrSpec] -> ForallTelescope
ForallInvis [TyVarBndrSpec]
tvbs) ([Kind] -> FunArgs -> FunArgs
FACxt [Kind]
cxt FunArgs
args), Kind
res)
unravelType (AppT (AppT Kind
ArrowT Kind
t1) Kind
t2) =
  let (FunArgs
args, Kind
res) = Kind -> (FunArgs, Kind)
unravelType Kind
t2 in
  (Kind -> FunArgs -> FunArgs
FAAnon Kind
t1 FunArgs
args, Kind
res)
#if __GLASGOW_HASKELL__ >= 809
unravelType (ForallVisT [TyVarBndrUnit]
tvbs Kind
ty) =
  let (FunArgs
args, Kind
res) = Kind -> (FunArgs, Kind)
unravelType Kind
ty in
  (ForallTelescope -> FunArgs -> FunArgs
FAForalls ([TyVarBndrUnit] -> ForallTelescope
ForallVis [TyVarBndrUnit]
tvbs) FunArgs
args, Kind
res)
#endif
unravelType Kind
t = (FunArgs
FANil, Kind
t)

-- | Remove all of the explicit kind signatures from a 'Type'.

unSigType :: Type -> Type
unSigType :: Kind -> Kind
unSigType (SigT Kind
t Kind
_) = Kind
t
unSigType (AppT Kind
f Kind
x) = Kind -> Kind -> Kind
AppT (Kind -> Kind
unSigType Kind
f) (Kind -> Kind
unSigType Kind
x)
unSigType (ForallT [TyVarBndrSpec]
tvbs [Kind]
ctxt Kind
t) =
  [TyVarBndrSpec] -> [Kind] -> Kind -> Kind
ForallT [TyVarBndrSpec]
tvbs (forall a b. (a -> b) -> [a] -> [b]
map Kind -> Kind
unSigPred [Kind]
ctxt) (Kind -> Kind
unSigType Kind
t)
unSigType (InfixT Kind
t1 Name
n Kind
t2)  = Kind -> Name -> Kind -> Kind
InfixT (Kind -> Kind
unSigType Kind
t1) Name
n (Kind -> Kind
unSigType Kind
t2)
unSigType (UInfixT Kind
t1 Name
n Kind
t2) = Kind -> Name -> Kind -> Kind
UInfixT (Kind -> Kind
unSigType Kind
t1) Name
n (Kind -> Kind
unSigType Kind
t2)
unSigType (ParensT Kind
t)       = Kind -> Kind
ParensT (Kind -> Kind
unSigType Kind
t)
#if __GLASGOW_HASKELL__ >= 807
unSigType (AppKindT Kind
t Kind
k)       = Kind -> Kind -> Kind
AppKindT (Kind -> Kind
unSigType Kind
t) (Kind -> Kind
unSigType Kind
k)
unSigType (ImplicitParamT String
n Kind
t) = String -> Kind -> Kind
ImplicitParamT String
n (Kind -> Kind
unSigType Kind
t)
#endif
unSigType Kind
t = Kind
t

-- | Remove all of the explicit kind signatures from a 'Pred'.

unSigPred :: Pred -> Pred
unSigPred :: Kind -> Kind
unSigPred = Kind -> Kind
unSigType

-- | Decompose an applied type into its individual components. For example, this:

--

-- @

-- Proxy \@Type Char

-- @

--

-- would be unfolded to this:

--

-- @

-- ('ConT' ''Proxy, ['TyArg' ('ConT' ''Type), 'TANormal' ('ConT' ''Char)])

-- @

unfoldType :: Type -> (Type, [TypeArg])
unfoldType :: Kind -> (Kind, [TypeArg])
unfoldType = [TypeArg] -> Kind -> (Kind, [TypeArg])
go []
  where
    go :: [TypeArg] -> Type -> (Type, [TypeArg])
    go :: [TypeArg] -> Kind -> (Kind, [TypeArg])
go [TypeArg]
acc (ForallT [TyVarBndrSpec]
_ [Kind]
_ Kind
ty) = [TypeArg] -> Kind -> (Kind, [TypeArg])
go [TypeArg]
acc Kind
ty
    go [TypeArg]
acc (AppT Kind
ty1 Kind
ty2)   = [TypeArg] -> Kind -> (Kind, [TypeArg])
go (Kind -> TypeArg
TANormal Kind
ty2forall a. a -> [a] -> [a]
:[TypeArg]
acc) Kind
ty1
    go [TypeArg]
acc (SigT Kind
ty Kind
_)      = [TypeArg] -> Kind -> (Kind, [TypeArg])
go [TypeArg]
acc Kind
ty
    go [TypeArg]
acc (ParensT Kind
ty)     = [TypeArg] -> Kind -> (Kind, [TypeArg])
go [TypeArg]
acc Kind
ty
#if __GLASGOW_HASKELL__ >= 807
    go [TypeArg]
acc (AppKindT Kind
ty Kind
ki) = [TypeArg] -> Kind -> (Kind, [TypeArg])
go (Kind -> TypeArg
TyArg Kind
kiforall a. a -> [a] -> [a]
:[TypeArg]
acc) Kind
ty
#endif
    go [TypeArg]
acc Kind
ty               = (Kind
ty, [TypeArg]
acc)

-- | An argument to a type, either a normal type ('TANormal') or a visible

-- kind application ('TyArg').

--

-- 'TypeArg' is useful when decomposing an application of a 'Type' to its

-- arguments (e.g., in 'unfoldType').

data TypeArg
  = TANormal Type
  | TyArg Kind
  deriving (TypeArg -> TypeArg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeArg -> TypeArg -> Bool
$c/= :: TypeArg -> TypeArg -> Bool
== :: TypeArg -> TypeArg -> Bool
$c== :: TypeArg -> TypeArg -> Bool
Eq, Int -> TypeArg -> ShowS
[TypeArg] -> ShowS
TypeArg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeArg] -> ShowS
$cshowList :: [TypeArg] -> ShowS
show :: TypeArg -> String
$cshow :: TypeArg -> String
showsPrec :: Int -> TypeArg -> ShowS
$cshowsPrec :: Int -> TypeArg -> ShowS
Show, Typeable TypeArg
TypeArg -> DataType
TypeArg -> Constr
(forall b. Data b => b -> b) -> TypeArg -> TypeArg
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) -> TypeArg -> u
forall u. (forall d. Data d => d -> u) -> TypeArg -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeArg -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeArg -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeArg -> m TypeArg
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeArg -> m TypeArg
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeArg
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeArg -> c TypeArg
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeArg)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeArg)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeArg -> m TypeArg
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeArg -> m TypeArg
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeArg -> m TypeArg
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeArg -> m TypeArg
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeArg -> m TypeArg
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeArg -> m TypeArg
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TypeArg -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TypeArg -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TypeArg -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TypeArg -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeArg -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeArg -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeArg -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeArg -> r
gmapT :: (forall b. Data b => b -> b) -> TypeArg -> TypeArg
$cgmapT :: (forall b. Data b => b -> b) -> TypeArg -> TypeArg
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeArg)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeArg)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeArg)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeArg)
dataTypeOf :: TypeArg -> DataType
$cdataTypeOf :: TypeArg -> DataType
toConstr :: TypeArg -> Constr
$ctoConstr :: TypeArg -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeArg
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeArg
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeArg -> c TypeArg
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeArg -> c TypeArg
Data)

-- | Apply one 'Type' to a list of arguments.

applyType :: Type -> [TypeArg] -> Type
applyType :: Kind -> [TypeArg] -> Kind
applyType = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Kind -> TypeArg -> Kind
apply
  where
    apply :: Type -> TypeArg -> Type
    apply :: Kind -> TypeArg -> Kind
apply Kind
f (TANormal Kind
x) = Kind
f Kind -> Kind -> Kind
`AppT` Kind
x
    apply Kind
f (TyArg Kind
_x)   =
#if __GLASGOW_HASKELL__ >= 807
                           Kind
f Kind -> Kind -> Kind
`AppKindT` Kind
_x
#else
                           -- VKA isn't supported, so

                           -- conservatively drop the argument

                           f
#endif

-- | Filter the normal type arguments from a list of 'TypeArg's.

filterTANormals :: [TypeArg] -> [Type]
filterTANormals :: [TypeArg] -> [Kind]
filterTANormals = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TypeArg -> Maybe Kind
getTANormal
  where
    getTANormal :: TypeArg -> Maybe Type
    getTANormal :: TypeArg -> Maybe Kind
getTANormal (TANormal Kind
t) = forall a. a -> Maybe a
Just Kind
t
    getTANormal (TyArg {})   = forall a. Maybe a
Nothing

-- | Extract the underlying 'Type' or 'Kind' from a 'TypeArg'. This forgets

-- information about whether a type is a normal argument or not, so use with

-- caution.

probablyWrongUnTypeArg :: TypeArg -> Type
probablyWrongUnTypeArg :: TypeArg -> Kind
probablyWrongUnTypeArg (TANormal Kind
t) = Kind
t
probablyWrongUnTypeArg (TyArg Kind
k)    = Kind
k

----------------------------------------

-- Free names, etc.

----------------------------------------


-- | Check if a name occurs anywhere within a TH tree.

nameOccursIn :: Data a => Name -> a -> Bool
nameOccursIn :: forall a. Data a => Name -> a -> Bool
nameOccursIn Name
n = forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
everything Bool -> Bool -> Bool
(||) forall a b. (a -> b) -> a -> b
$ forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ Bool
False (forall a. Eq a => a -> a -> Bool
== Name
n)

-- | Extract all Names mentioned in a TH tree.

allNamesIn :: Data a => a -> [Name]
allNamesIn :: forall a. Data a => a -> [Name]
allNamesIn = forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
everything forall a. [a] -> [a] -> [a]
(++) forall a b. (a -> b) -> a -> b
$ forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ [] (forall a. a -> [a] -> [a]
:[])

-- | Extract the names bound in a @Stmt@

extractBoundNamesStmt :: Stmt -> OSet Name
extractBoundNamesStmt :: Stmt -> OSet Name
extractBoundNamesStmt (BindS Pat
pat Exp
_) = Pat -> OSet Name
extractBoundNamesPat Pat
pat
extractBoundNamesStmt (LetS [Dec]
decs)   = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Dec -> OSet Name
extractBoundNamesDec [Dec]
decs
extractBoundNamesStmt (NoBindS Exp
_)   = forall a. OSet a
OS.empty
extractBoundNamesStmt (ParS [[Stmt]]
stmtss) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Stmt -> OSet Name
extractBoundNamesStmt) [[Stmt]]
stmtss
#if __GLASGOW_HASKELL__ >= 807
extractBoundNamesStmt (RecS [Stmt]
stmtss) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Stmt -> OSet Name
extractBoundNamesStmt [Stmt]
stmtss
#endif

-- | Extract the names bound in a @Dec@ that could appear in a @let@ expression.

extractBoundNamesDec :: Dec -> OSet Name
extractBoundNamesDec :: Dec -> OSet Name
extractBoundNamesDec (FunD Name
name [Clause]
_)  = forall a. a -> OSet a
OS.singleton Name
name
extractBoundNamesDec (ValD Pat
pat Body
_ [Dec]
_) = Pat -> OSet Name
extractBoundNamesPat Pat
pat
extractBoundNamesDec Dec
_              = forall a. OSet a
OS.empty

-- | Extract the names bound in a @Pat@

extractBoundNamesPat :: Pat -> OSet Name
extractBoundNamesPat :: Pat -> OSet Name
extractBoundNamesPat (LitP Lit
_)              = forall a. OSet a
OS.empty
extractBoundNamesPat (VarP Name
name)           = forall a. a -> OSet a
OS.singleton Name
name
extractBoundNamesPat (TupP [Pat]
pats)           = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Pat -> OSet Name
extractBoundNamesPat [Pat]
pats
extractBoundNamesPat (UnboxedTupP [Pat]
pats)    = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Pat -> OSet Name
extractBoundNamesPat [Pat]
pats
extractBoundNamesPat (ConP Name
_
#if __GLASGOW_HASKELL__ >= 901
                             [Kind]
_
#endif
                               [Pat]
pats)       = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Pat -> OSet Name
extractBoundNamesPat [Pat]
pats
extractBoundNamesPat (InfixP Pat
p1 Name
_ Pat
p2)      = Pat -> OSet Name
extractBoundNamesPat Pat
p1 forall a. Ord a => OSet a -> OSet a -> OSet a
`OS.union`
                                             Pat -> OSet Name
extractBoundNamesPat Pat
p2
extractBoundNamesPat (UInfixP Pat
p1 Name
_ Pat
p2)     = Pat -> OSet Name
extractBoundNamesPat Pat
p1 forall a. Ord a => OSet a -> OSet a -> OSet a
`OS.union`
                                             Pat -> OSet Name
extractBoundNamesPat Pat
p2
extractBoundNamesPat (ParensP Pat
pat)         = Pat -> OSet Name
extractBoundNamesPat Pat
pat
extractBoundNamesPat (TildeP Pat
pat)          = Pat -> OSet Name
extractBoundNamesPat Pat
pat
extractBoundNamesPat (BangP Pat
pat)           = Pat -> OSet Name
extractBoundNamesPat Pat
pat
extractBoundNamesPat (AsP Name
name Pat
pat)        = forall a. a -> OSet a
OS.singleton Name
name forall a. Ord a => OSet a -> OSet a -> OSet a
`OS.union`
                                             Pat -> OSet Name
extractBoundNamesPat Pat
pat
extractBoundNamesPat Pat
WildP                 = forall a. OSet a
OS.empty
extractBoundNamesPat (RecP Name
_ [FieldPat]
field_pats)   = let ([Name]
_, [Pat]
pats) = forall a b. [(a, b)] -> ([a], [b])
unzip [FieldPat]
field_pats in
                                             forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Pat -> OSet Name
extractBoundNamesPat [Pat]
pats
extractBoundNamesPat (ListP [Pat]
pats)          = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Pat -> OSet Name
extractBoundNamesPat [Pat]
pats
extractBoundNamesPat (SigP Pat
pat Kind
_)          = Pat -> OSet Name
extractBoundNamesPat Pat
pat
extractBoundNamesPat (ViewP Exp
_ Pat
pat)         = Pat -> OSet Name
extractBoundNamesPat Pat
pat
#if __GLASGOW_HASKELL__ >= 801
extractBoundNamesPat (UnboxedSumP Pat
pat Int
_ Int
_) = Pat -> OSet Name
extractBoundNamesPat Pat
pat
#endif

----------------------------------------

-- General utility

----------------------------------------


-- dirty implementation of explicit-to-implicit conversion

newtype MagicIP name a r = MagicIP (IP name a => r)

-- | Get an implicit param constraint (@IP name a@, which is the desugared

-- form of @(?name :: a)@) from an explicit value.

--

-- This function is only available with GHC 8.0 or later.

bindIP :: forall name a r. a -> (IP name a => r) -> r
bindIP :: forall (name :: Symbol) a r. a -> (IP name a => r) -> r
bindIP a
val IP name a => r
k = (forall a b. a -> b
unsafeCoerce (forall (name :: Symbol) a r. (IP name a => r) -> MagicIP name a r
MagicIP @name IP name a => r
k) :: a -> r) a
val

-- like GHC's

splitAtList :: [a] -> [b] -> ([b], [b])
splitAtList :: forall a b. [a] -> [b] -> ([b], [b])
splitAtList [] [b]
x = ([], [b]
x)
splitAtList (a
_ : [a]
t) (b
x : [b]
xs) =
  let ([b]
as, [b]
bs) = forall a b. [a] -> [b] -> ([b], [b])
splitAtList [a]
t [b]
xs in
  (b
x forall a. a -> [a] -> [a]
: [b]
as, [b]
bs)
splitAtList (a
_ : [a]
_) [] = ([], [])

thdOf3 :: (a,b,c) -> c
thdOf3 :: forall a b c. (a, b, c) -> c
thdOf3 (a
_,b
_,c
c) = c
c

liftFst :: (a -> b) -> (a, c) -> (b, c)
liftFst :: forall a b c. (a -> b) -> (a, c) -> (b, c)
liftFst a -> b
f (a
a,c
c) = (a -> b
f a
a, c
c)

liftSnd :: (a -> b) -> (c, a) -> (c, b)
liftSnd :: forall a b c. (a -> b) -> (c, a) -> (c, b)
liftSnd a -> b
f (c
c,a
a) = (c
c, a -> b
f a
a)

thirdOf3 :: (a -> b) -> (c, d, a) -> (c, d, b)
thirdOf3 :: forall a b c d. (a -> b) -> (c, d, a) -> (c, d, b)
thirdOf3 a -> b
f (c
c, d
d, a
a) = (c
c, d
d, a -> b
f a
a)

-- lift concatMap into a monad

-- could this be more efficient?

-- | Concatenate the result of a @mapM@

concatMapM :: (Monad monad, Monoid monoid, Traversable t)
           => (a -> monad monoid) -> t a -> monad monoid
concatMapM :: forall (monad :: * -> *) monoid (t :: * -> *) a.
(Monad monad, Monoid monoid, Traversable t) =>
(a -> monad monoid) -> t a -> monad monoid
concatMapM a -> monad monoid
fn t a
list = do
  t monoid
bss <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> monad monoid
fn t a
list
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold t monoid
bss

-- like GHC's

-- | Monadic version of mapAccumL

mapAccumLM :: Monad m
            => (acc -> x -> m (acc, y)) -- ^ combining function

            -> acc                      -- ^ initial state

            -> [x]                      -- ^ inputs

            -> m (acc, [y])             -- ^ final state, outputs

mapAccumLM :: forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM acc -> x -> m (acc, y)
_ acc
s []     = forall (m :: * -> *) a. Monad m => a -> m a
return (acc
s, [])
mapAccumLM acc -> x -> m (acc, y)
f acc
s (x
x:[x]
xs) = do
    (acc
s1, y
x')  <- acc -> x -> m (acc, y)
f acc
s x
x
    (acc
s2, [y]
xs') <- forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM acc -> x -> m (acc, y)
f acc
s1 [x]
xs
    forall (m :: * -> *) a. Monad m => a -> m a
return    (acc
s2, y
x' forall a. a -> [a] -> [a]
: [y]
xs')

-- like GHC's

mapMaybeM :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM a -> m (Maybe b)
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
mapMaybeM a -> m (Maybe b)
f (a
x:[a]
xs) = do
  Maybe b
y <- a -> m (Maybe b)
f a
x
  [b]
ys <- forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM a -> m (Maybe b)
f [a]
xs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe b
y of
    Maybe b
Nothing -> [b]
ys
    Just b
z  -> b
z forall a. a -> [a] -> [a]
: [b]
ys

expectJustM :: Fail.MonadFail m => String -> Maybe a -> m a
expectJustM :: forall (m :: * -> *) a. MonadFail m => String -> Maybe a -> m a
expectJustM String
_   (Just a
x) = forall (m :: * -> *) a. Monad m => a -> m a
return a
x
expectJustM String
err Maybe a
Nothing  = forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
err

firstMatch :: (a -> Maybe b) -> [a] -> Maybe b
firstMatch :: forall a b. (a -> Maybe b) -> [a] -> Maybe b
firstMatch a -> Maybe b
f [a]
xs = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe b
f [a]
xs

firstMatchM :: Monad m => (a -> m (Maybe b)) -> [a] -> m (Maybe b)
firstMatchM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
firstMatchM a -> m (Maybe b)
f [a]
xs = forall a. [a] -> Maybe a
listToMaybe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM a -> m (Maybe b)
f [a]
xs

-- | Semi-shallow version of 'everywhereM' - does not recurse into children of nodes of type @a@ (only applies the handler to them).

--

-- >>> topEverywhereM (pure . fmap (*10) :: [Integer] -> Identity [Integer]) ([1,2,3] :: [Integer], "foo" :: String)

-- Identity ([10,20,30],"foo")

--

-- >>> everywhereM (mkM (pure . fmap (*10) :: [Integer] -> Identity [Integer])) ([1,2,3] :: [Integer], "foo" :: String)

-- Identity ([10,200,3000],"foo")

topEverywhereM :: (Typeable a, Data b, Monad m) => (a -> m a) -> b -> m b
topEverywhereM :: forall a b (m :: * -> *).
(Typeable a, Data b, Monad m) =>
(a -> m a) -> b -> m b
topEverywhereM a -> m a
handler =
  forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> a -> m a
gmapM (forall a b (m :: * -> *).
(Typeable a, Data b, Monad m) =>
(a -> m a) -> b -> m b
topEverywhereM a -> m a
handler) forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(a -> m a) -> (b -> m b) -> a -> m a
`extM` a -> m a
handler

-- Checks if a String names a valid Haskell infix data constructor

-- (i.e., does it begin with a colon?).

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

-- | Returns 'True' if the argument 'Name' is that of 'Kind.Type'

-- (or @*@ or 'Kind.★', to support older GHCs).

isTypeKindName :: Name -> Bool
isTypeKindName :: Name -> Bool
isTypeKindName Name
n = Name
n forall a. Eq a => a -> a -> Bool
== Name
typeKindName
#if __GLASGOW_HASKELL__ < 805
                || n == starKindName
                || n == uniStarKindName
#endif

-- | The 'Name' of the kind 'Kind.Type'.

-- 2. The kind @*@ on older GHCs.

typeKindName :: Name
typeKindName :: Name
typeKindName = ''Kind.Type

#if __GLASGOW_HASKELL__ < 805
-- | The 'Name' of the kind @*@.

starKindName :: Name
starKindName = ''(Kind.*)

-- | The 'Name' of the kind 'Kind.★'.

uniStarKindName :: Name
uniStarKindName = ''(Kind.★)
#endif

-- | Is a data type or data instance declaration a @newtype@ declaration, a

-- @data@ declaration, or a @type data@ declaration?

data DataFlavor
  = Newtype  -- ^ @newtype@

  | Data     -- ^ @data@

  | TypeData -- ^ @type data@

  deriving (DataFlavor -> DataFlavor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataFlavor -> DataFlavor -> Bool
$c/= :: DataFlavor -> DataFlavor -> Bool
== :: DataFlavor -> DataFlavor -> Bool
$c== :: DataFlavor -> DataFlavor -> Bool
Eq, Int -> DataFlavor -> ShowS
[DataFlavor] -> ShowS
DataFlavor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataFlavor] -> ShowS
$cshowList :: [DataFlavor] -> ShowS
show :: DataFlavor -> String
$cshow :: DataFlavor -> String
showsPrec :: Int -> DataFlavor -> ShowS
$cshowsPrec :: Int -> DataFlavor -> ShowS
Show, Typeable DataFlavor
DataFlavor -> DataType
DataFlavor -> Constr
(forall b. Data b => b -> b) -> DataFlavor -> DataFlavor
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) -> DataFlavor -> u
forall u. (forall d. Data d => d -> u) -> DataFlavor -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataFlavor -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataFlavor -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DataFlavor -> m DataFlavor
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataFlavor -> m DataFlavor
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataFlavor
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataFlavor -> c DataFlavor
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataFlavor)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataFlavor)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataFlavor -> m DataFlavor
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataFlavor -> m DataFlavor
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataFlavor -> m DataFlavor
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataFlavor -> m DataFlavor
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DataFlavor -> m DataFlavor
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DataFlavor -> m DataFlavor
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DataFlavor -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DataFlavor -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> DataFlavor -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DataFlavor -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataFlavor -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataFlavor -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataFlavor -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataFlavor -> r
gmapT :: (forall b. Data b => b -> b) -> DataFlavor -> DataFlavor
$cgmapT :: (forall b. Data b => b -> b) -> DataFlavor -> DataFlavor
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataFlavor)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataFlavor)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataFlavor)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataFlavor)
dataTypeOf :: DataFlavor -> DataType
$cdataTypeOf :: DataFlavor -> DataType
toConstr :: DataFlavor -> Constr
$ctoConstr :: DataFlavor -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataFlavor
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataFlavor
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataFlavor -> c DataFlavor
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataFlavor -> c DataFlavor
Data, forall x. Rep DataFlavor x -> DataFlavor
forall x. DataFlavor -> Rep DataFlavor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DataFlavor x -> DataFlavor
$cfrom :: forall x. DataFlavor -> Rep DataFlavor x
Generic, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => DataFlavor -> m Exp
forall (m :: * -> *). Quote m => DataFlavor -> Code m DataFlavor
liftTyped :: forall (m :: * -> *). Quote m => DataFlavor -> Code m DataFlavor
$cliftTyped :: forall (m :: * -> *). Quote m => DataFlavor -> Code m DataFlavor
lift :: forall (m :: * -> *). Quote m => DataFlavor -> m Exp
$clift :: forall (m :: * -> *). Quote m => DataFlavor -> m Exp
Lift)