{-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE Trustworthy #-}

-- |
-- GHC.Internal.TH.Lib exposes some additional functionality that
-- is used internally in GHC's integration with Template Haskell. This is not a
-- part of the public API, and as such, there are no API guarantees for this
-- module from version to version.

-- Why do we have both GHC.Internal.TH.Lib and
-- Language.Haskell.TH.Lib? Ultimately, it's because the functions in the
-- former (which are tailored for GHC's use) need different type signatures
-- than the ones in the latter. Syncing up the Internal type signatures would
-- involve a massive amount of breaking changes, so for the time being, we
-- relegate as many changes as we can to just the Internal module, where it
-- is safe to break things.

module GHC.Internal.TH.Lib where

import GHC.Internal.TH.Syntax hiding (Role, InjectivityAnn)
import qualified GHC.Internal.TH.Syntax as TH
#ifdef BOOTSTRAP_TH
import Control.Applicative(liftA, Applicative(..))
import qualified Data.Kind as Kind (Type)
import Data.Word( Word8 )
import Data.List.NonEmpty ( NonEmpty(..) )
import GHC.Exts (TYPE)
import Prelude hiding (Applicative(..))
#else
import GHC.Internal.Base hiding (Type, Module, inline)
import GHC.Internal.Data.Foldable
import GHC.Internal.Data.Functor
import GHC.Internal.Data.Maybe
import GHC.Internal.Data.Traversable (traverse, sequenceA)
import GHC.Internal.Integer
import GHC.Internal.List (zip)
import GHC.Internal.Real
import GHC.Internal.Show
import GHC.Internal.Word
import qualified GHC.Types as Kind (Type)
#endif

----------------------------------------------------------
-- * Type synonyms
----------------------------------------------------------

-- | Representation-polymorphic since /template-haskell-2.17.0.0/.
type TExpQ :: TYPE r -> Kind.Type
type TExpQ a = Q (TExp a)

type CodeQ :: TYPE r -> Kind.Type
type CodeQ = Code Q

type InfoQ               = Q Info
type PatQ                = Q Pat
type FieldPatQ           = Q FieldPat
type ExpQ                = Q Exp
type DecQ                = Q Dec
type DecsQ               = Q [Dec]
type Decs                = [Dec] -- Defined as it is more convenient to wire-in
type ConQ                = Q Con
type TypeQ               = Q Type
type KindQ               = Q Kind
type TyLitQ              = Q TyLit
type CxtQ                = Q Cxt
type PredQ               = Q Pred
type DerivClauseQ        = Q DerivClause
type MatchQ              = Q Match
type ClauseQ             = Q Clause
type BodyQ               = Q Body
type GuardQ              = Q Guard
type StmtQ               = Q Stmt
type RangeQ              = Q Range
type SourceStrictnessQ   = Q SourceStrictness
type SourceUnpackednessQ = Q SourceUnpackedness
type BangQ               = Q Bang
type BangTypeQ           = Q BangType
type VarBangTypeQ        = Q VarBangType
type StrictTypeQ         = Q StrictType
type VarStrictTypeQ      = Q VarStrictType
type FieldExpQ           = Q FieldExp
type RuleBndrQ           = Q RuleBndr
type TySynEqnQ           = Q TySynEqn
type PatSynDirQ          = Q PatSynDir
type PatSynArgsQ         = Q PatSynArgs
type FamilyResultSigQ    = Q FamilyResultSig
type DerivStrategyQ      = Q DerivStrategy

-- must be defined here for DsMeta to find it
type Role                = TH.Role
type InjectivityAnn      = TH.InjectivityAnn

type TyVarBndrUnit       = TyVarBndr ()
type TyVarBndrSpec       = TyVarBndr Specificity
type TyVarBndrVis        = TyVarBndr BndrVis

----------------------------------------------------------
-- * Lowercase pattern syntax functions
----------------------------------------------------------

intPrimL    :: Integer -> Lit
intPrimL :: Integer -> Lit
intPrimL    = Integer -> Lit
IntPrimL
wordPrimL    :: Integer -> Lit
wordPrimL :: Integer -> Lit
wordPrimL    = Integer -> Lit
WordPrimL
floatPrimL  :: Rational -> Lit
floatPrimL :: Rational -> Lit
floatPrimL  = Rational -> Lit
FloatPrimL
doublePrimL :: Rational -> Lit
doublePrimL :: Rational -> Lit
doublePrimL = Rational -> Lit
DoublePrimL
integerL    :: Integer -> Lit
integerL :: Integer -> Lit
integerL    = Integer -> Lit
IntegerL
charL       :: Char -> Lit
charL :: Char -> Lit
charL       = Char -> Lit
CharL
charPrimL   :: Char -> Lit
charPrimL :: Char -> Lit
charPrimL   = Char -> Lit
CharPrimL
stringL     :: String -> Lit
stringL :: String -> Lit
stringL     = String -> Lit
StringL
stringPrimL :: [Word8] -> Lit
stringPrimL :: [Word8] -> Lit
stringPrimL = [Word8] -> Lit
StringPrimL
bytesPrimL :: Bytes -> Lit
bytesPrimL :: Bytes -> Lit
bytesPrimL = Bytes -> Lit
BytesPrimL
rationalL   :: Rational -> Lit
rationalL :: Rational -> Lit
rationalL   = Rational -> Lit
RationalL

litP :: Quote m => Lit -> m Pat
litP :: forall (m :: * -> *). Quote m => Lit -> m Pat
litP Lit
l = Pat -> m Pat
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lit -> Pat
LitP Lit
l)

varP :: Quote m => Name -> m Pat
varP :: forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
v = Pat -> m Pat
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Pat
VarP Name
v)

tupP :: Quote m => [m Pat] -> m Pat
tupP :: forall (m :: * -> *). Quote m => [m Pat] -> m Pat
tupP [m Pat]
ps = do { ps1 <- [m Pat] -> m [Pat]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m Pat]
ps; pure (TupP ps1)}

unboxedTupP :: Quote m => [m Pat] -> m Pat
unboxedTupP :: forall (m :: * -> *). Quote m => [m Pat] -> m Pat
unboxedTupP [m Pat]
ps = do { ps1 <- [m Pat] -> m [Pat]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m Pat]
ps; pure (UnboxedTupP ps1)}

unboxedSumP :: Quote m => m Pat -> SumAlt -> SumArity -> m Pat
unboxedSumP :: forall (m :: * -> *). Quote m => m Pat -> Int -> Int -> m Pat
unboxedSumP m Pat
p Int
alt Int
arity = do { p1 <- m Pat
p; pure (UnboxedSumP p1 alt arity) }

conP :: Quote m => Name -> [m Type] -> [m Pat] -> m Pat
conP :: forall (m :: * -> *).
Quote m =>
Name -> [m Type] -> [m Pat] -> m Pat
conP Name
n [m Type]
ts [m Pat]
ps = do ps' <- [m Pat] -> m [Pat]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m Pat]
ps
                  ts' <- sequenceA ts
                  pure (ConP n ts' ps')
infixP :: Quote m => m Pat -> Name -> m Pat -> m Pat
infixP :: forall (m :: * -> *). Quote m => m Pat -> Name -> m Pat -> m Pat
infixP m Pat
p1 Name
n m Pat
p2 = do p1' <- m Pat
p1
                    p2' <- p2
                    pure (InfixP p1' n p2')
uInfixP :: Quote m => m Pat -> Name -> m Pat -> m Pat
uInfixP :: forall (m :: * -> *). Quote m => m Pat -> Name -> m Pat -> m Pat
uInfixP m Pat
p1 Name
n m Pat
p2 = do p1' <- m Pat
p1
                     p2' <- p2
                     pure (UInfixP p1' n p2')
parensP :: Quote m => m Pat -> m Pat
parensP :: forall (m :: * -> *). Quote m => m Pat -> m Pat
parensP m Pat
p = do p' <- m Pat
p
               pure (ParensP p')

tildeP :: Quote m => m Pat -> m Pat
tildeP :: forall (m :: * -> *). Quote m => m Pat -> m Pat
tildeP m Pat
p = do p' <- m Pat
p
              pure (TildeP p')
bangP :: Quote m => m Pat -> m Pat
bangP :: forall (m :: * -> *). Quote m => m Pat -> m Pat
bangP m Pat
p = do p' <- m Pat
p
             pure (BangP p')
asP :: Quote m => Name -> m Pat -> m Pat
asP :: forall (m :: * -> *). Quote m => Name -> m Pat -> m Pat
asP Name
n m Pat
p = do p' <- m Pat
p
             pure (AsP n p')
wildP :: Quote m => m Pat
wildP :: forall (m :: * -> *). Quote m => m Pat
wildP = Pat -> m Pat
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pat
WildP
recP :: Quote m => Name -> [m FieldPat] -> m Pat
recP :: forall (m :: * -> *). Quote m => Name -> [m FieldPat] -> m Pat
recP Name
n [m FieldPat]
fps = do fps' <- [m FieldPat] -> m [FieldPat]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m FieldPat]
fps
                pure (RecP n fps')
listP :: Quote m => [m Pat] -> m Pat
listP :: forall (m :: * -> *). Quote m => [m Pat] -> m Pat
listP [m Pat]
ps = do ps' <- [m Pat] -> m [Pat]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m Pat]
ps
              pure (ListP ps')
sigP :: Quote m => m Pat -> m Type -> m Pat
sigP :: forall (m :: * -> *). Quote m => m Pat -> m Type -> m Pat
sigP m Pat
p m Type
t = do p' <- m Pat
p
              t' <- t
              pure (SigP p' t')
typeP :: Quote m => m Type -> m Pat
typeP :: forall (m :: * -> *). Quote m => m Type -> m Pat
typeP m Type
t = do t' <- m Type
t
             pure (TypeP t')
invisP :: Quote m => m Type -> m Pat
invisP :: forall (m :: * -> *). Quote m => m Type -> m Pat
invisP m Type
t = do t' <- m Type
t
              pure (InvisP t')
viewP :: Quote m => m Exp -> m Pat -> m Pat
viewP :: forall (m :: * -> *). Quote m => m Exp -> m Pat -> m Pat
viewP m Exp
e m Pat
p = do e' <- m Exp
e
               p' <- p
               pure (ViewP e' p')

orP :: Quote m => (NonEmpty (m Pat)) -> m Pat
orP :: forall (m :: * -> *). Quote m => NonEmpty (m Pat) -> m Pat
orP NonEmpty (m Pat)
ps = do ps' <- NonEmpty (m Pat) -> m (NonEmpty Pat)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
NonEmpty (f a) -> f (NonEmpty a)
sequenceA NonEmpty (m Pat)
ps
            pure (OrP ps')

fieldPat :: Quote m => Name -> m Pat -> m FieldPat
fieldPat :: forall (m :: * -> *). Quote m => Name -> m Pat -> m FieldPat
fieldPat Name
n m Pat
p = do p' <- m Pat
p
                  pure (n, p')


-------------------------------------------------------------------------------
-- *   Stmt

bindS :: Quote m => m Pat -> m Exp -> m Stmt
bindS :: forall (m :: * -> *). Quote m => m Pat -> m Exp -> m Stmt
bindS m Pat
p m Exp
e = (Pat -> Exp -> Stmt) -> m Pat -> m Exp -> m Stmt
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Pat -> Exp -> Stmt
BindS m Pat
p m Exp
e

letS :: Quote m => [m Dec] -> m Stmt
letS :: forall (m :: * -> *). Quote m => [m Dec] -> m Stmt
letS [m Dec]
ds = do { ds1 <- [m Dec] -> m [Dec]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m Dec]
ds; pure (LetS ds1) }

noBindS :: Quote m => m Exp -> m Stmt
noBindS :: forall (m :: * -> *). Quote m => m Exp -> m Stmt
noBindS m Exp
e = do { e1 <- m Exp
e; pure (NoBindS e1) }

parS :: Quote m => [[m Stmt]] -> m Stmt
parS :: forall (m :: * -> *). Quote m => [[m Stmt]] -> m Stmt
parS [[m Stmt]]
sss = do { sss1 <- ([m Stmt] -> m [Stmt]) -> [[m Stmt]] -> m [[Stmt]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse [m Stmt] -> m [Stmt]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [[m Stmt]]
sss; pure (ParS sss1) }

recS :: Quote m => [m Stmt] -> m Stmt
recS :: forall (m :: * -> *). Quote m => [m Stmt] -> m Stmt
recS [m Stmt]
ss = do { ss1 <- [m Stmt] -> m [Stmt]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m Stmt]
ss; pure (RecS ss1) }

-------------------------------------------------------------------------------
-- *   Range

fromR :: Quote m => m Exp -> m Range
fromR :: forall (m :: * -> *). Quote m => m Exp -> m Range
fromR m Exp
x = do { a <- m Exp
x; pure (FromR a) }

fromThenR :: Quote m => m Exp -> m Exp -> m Range
fromThenR :: forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Range
fromThenR m Exp
x m Exp
y = do { a <- m Exp
x; b <- y; pure (FromThenR a b) }

fromToR :: Quote m => m Exp -> m Exp -> m Range
fromToR :: forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Range
fromToR m Exp
x m Exp
y = do { a <- m Exp
x; b <- y; pure (FromToR a b) }

fromThenToR :: Quote m => m Exp -> m Exp -> m Exp -> m Range
fromThenToR :: forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Range
fromThenToR m Exp
x m Exp
y m Exp
z = do { a <- m Exp
x; b <- y; c <- z;
                         pure (FromThenToR a b c) }
-------------------------------------------------------------------------------
-- *   Body

normalB :: Quote m => m Exp -> m Body
normalB :: forall (m :: * -> *). Quote m => m Exp -> m Body
normalB m Exp
e = do { e1 <- m Exp
e; pure (NormalB e1) }

guardedB :: Quote m => [m (Guard,Exp)] -> m Body
guardedB :: forall (m :: * -> *). Quote m => [m (Guard, Exp)] -> m Body
guardedB [m (Guard, Exp)]
ges = do { ges' <- [m (Guard, Exp)] -> m [(Guard, Exp)]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m (Guard, Exp)]
ges; pure (GuardedB ges') }

-------------------------------------------------------------------------------
-- *   Guard

normalG :: Quote m => m Exp -> m Guard
normalG :: forall (m :: * -> *). Quote m => m Exp -> m Guard
normalG m Exp
e = do { e1 <- m Exp
e; pure (NormalG e1) }

normalGE :: Quote m => m Exp -> m Exp -> m (Guard, Exp)
normalGE :: forall (m :: * -> *). Quote m => m Exp -> m Exp -> m (Guard, Exp)
normalGE m Exp
g m Exp
e = do { g1 <- m Exp
g; e1 <- e; pure (NormalG g1, e1) }

patG :: Quote m => [m Stmt] -> m Guard
patG :: forall (m :: * -> *). Quote m => [m Stmt] -> m Guard
patG [m Stmt]
ss = do { ss' <- [m Stmt] -> m [Stmt]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m Stmt]
ss; pure (PatG ss') }

patGE :: Quote m => [m Stmt] -> m Exp -> m (Guard, Exp)
patGE :: forall (m :: * -> *).
Quote m =>
[m Stmt] -> m Exp -> m (Guard, Exp)
patGE [m Stmt]
ss m Exp
e = do { ss' <- [m Stmt] -> m [Stmt]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m Stmt]
ss;
                  e'  <- e;
                  pure (PatG ss', e') }

-------------------------------------------------------------------------------
-- *   Match and Clause

-- | Use with 'caseE'
match :: Quote m => m Pat -> m Body -> [m Dec] -> m Match
match :: forall (m :: * -> *).
Quote m =>
m Pat -> m Body -> [m Dec] -> m Match
match m Pat
p m Body
rhs [m Dec]
ds = do { p' <- m Pat
p;
                      r' <- rhs;
                      ds' <- sequenceA ds;
                      pure (Match p' r' ds') }

-- | Use with 'funD'
clause :: Quote m => [m Pat] -> m Body -> [m Dec] -> m Clause
clause :: forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause [m Pat]
ps m Body
r [m Dec]
ds = do { ps' <- [m Pat] -> m [Pat]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m Pat]
ps;
                      r' <- r;
                      ds' <- sequenceA ds;
                      pure (Clause ps' r' ds') }

---------------------------------------------------------------------------
-- *   Exp

-- | Dynamically binding a variable (unhygienic)
dyn :: Quote m => String -> m Exp
dyn :: forall (m :: * -> *). Quote m => String -> m Exp
dyn String
s = Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE (String -> Name
mkName String
s))

varE :: Quote m => Name -> m Exp
varE :: forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
s = Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
VarE Name
s)

conE :: Quote m => Name -> m Exp
conE :: forall (m :: * -> *). Quote m => Name -> m Exp
conE Name
s =  Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
ConE Name
s)

litE :: Quote m => Lit -> m Exp
litE :: forall (m :: * -> *). Quote m => Lit -> m Exp
litE Lit
c = Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lit -> Exp
LitE Lit
c)

appE :: Quote m => m Exp -> m Exp -> m Exp
appE :: forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE m Exp
x m Exp
y = do { a <- m Exp
x; b <- y; pure (AppE a b)}

appTypeE :: Quote m => m Exp -> m Type -> m Exp
appTypeE :: forall (m :: * -> *). Quote m => m Exp -> m Type -> m Exp
appTypeE m Exp
x m Type
t = do { a <- m Exp
x; s <- t; pure (AppTypeE a s) }

parensE :: Quote m => m Exp -> m Exp
parensE :: forall (m :: * -> *). Quote m => m Exp -> m Exp
parensE m Exp
x = do { x' <- m Exp
x; pure (ParensE x') }

uInfixE :: Quote m => m Exp -> m Exp -> m Exp -> m Exp
uInfixE :: forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
uInfixE m Exp
x m Exp
s m Exp
y = do { x' <- m Exp
x; s' <- s; y' <- y;
                     pure (UInfixE x' s' y') }

infixE :: Quote m => Maybe (m Exp) -> m Exp -> Maybe (m Exp) -> m Exp
infixE :: forall (m :: * -> *).
Quote m =>
Maybe (m Exp) -> m Exp -> Maybe (m Exp) -> m Exp
infixE (Just m Exp
x) m Exp
s (Just m Exp
y) = do { a <- m Exp
x; s' <- s; b <- y;
                                  pure (InfixE (Just a) s' (Just b))}
infixE Maybe (m Exp)
Nothing  m Exp
s (Just m Exp
y) = do { s' <- m Exp
s; b <- y;
                                  pure (InfixE Nothing s' (Just b))}
infixE (Just m Exp
x) m Exp
s Maybe (m Exp)
Nothing  = do { a <- m Exp
x; s' <- s;
                                  pure (InfixE (Just a) s' Nothing)}
infixE Maybe (m Exp)
Nothing  m Exp
s Maybe (m Exp)
Nothing  = do { s' <- m Exp
s; pure (InfixE Nothing s' Nothing) }

infixApp :: Quote m => m Exp -> m Exp -> m Exp -> m Exp
infixApp :: forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
infixApp m Exp
x m Exp
y m Exp
z = Maybe (m Exp) -> m Exp -> Maybe (m Exp) -> m Exp
forall (m :: * -> *).
Quote m =>
Maybe (m Exp) -> m Exp -> Maybe (m Exp) -> m Exp
infixE (m Exp -> Maybe (m Exp)
forall a. a -> Maybe a
Just m Exp
x) m Exp
y (m Exp -> Maybe (m Exp)
forall a. a -> Maybe a
Just m Exp
z)
sectionL :: Quote m => m Exp -> m Exp -> m Exp
sectionL :: forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
sectionL m Exp
x m Exp
y = Maybe (m Exp) -> m Exp -> Maybe (m Exp) -> m Exp
forall (m :: * -> *).
Quote m =>
Maybe (m Exp) -> m Exp -> Maybe (m Exp) -> m Exp
infixE (m Exp -> Maybe (m Exp)
forall a. a -> Maybe a
Just m Exp
x) m Exp
y Maybe (m Exp)
forall a. Maybe a
Nothing
sectionR :: Quote m => m Exp -> m Exp -> m Exp
sectionR :: forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
sectionR m Exp
x m Exp
y = Maybe (m Exp) -> m Exp -> Maybe (m Exp) -> m Exp
forall (m :: * -> *).
Quote m =>
Maybe (m Exp) -> m Exp -> Maybe (m Exp) -> m Exp
infixE Maybe (m Exp)
forall a. Maybe a
Nothing m Exp
x (m Exp -> Maybe (m Exp)
forall a. a -> Maybe a
Just m Exp
y)

lamE :: Quote m => [m Pat] -> m Exp -> m Exp
lamE :: forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
lamE [m Pat]
ps m Exp
e = do ps' <- [m Pat] -> m [Pat]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m Pat]
ps
               e' <- e
               pure (LamE ps' e')

-- | Single-arg lambda
lam1E :: Quote m => m Pat -> m Exp -> m Exp
lam1E :: forall (m :: * -> *). Quote m => m Pat -> m Exp -> m Exp
lam1E m Pat
p m Exp
e = [m Pat] -> m Exp -> m Exp
forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
lamE [m Pat
p] m Exp
e

-- | Lambda-case (@\case@)
lamCaseE :: Quote m => [m Match] -> m Exp
lamCaseE :: forall (m :: * -> *). Quote m => [m Match] -> m Exp
lamCaseE [m Match]
ms = [Match] -> Exp
LamCaseE ([Match] -> Exp) -> m [Match] -> m Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [m Match] -> m [Match]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m Match]
ms

-- | Lambda-cases (@\cases@)
lamCasesE :: Quote m => [m Clause] -> m Exp
lamCasesE :: forall (m :: * -> *). Quote m => [m Clause] -> m Exp
lamCasesE [m Clause]
ms = [Clause] -> Exp
LamCasesE ([Clause] -> Exp) -> m [Clause] -> m Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [m Clause] -> m [Clause]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m Clause]
ms

tupE :: Quote m => [Maybe (m Exp)] -> m Exp
tupE :: forall (m :: * -> *). Quote m => [Maybe (m Exp)] -> m Exp
tupE [Maybe (m Exp)]
es = do { es1 <- (Maybe (m Exp) -> m (Maybe Exp))
-> [Maybe (m Exp)] -> m [Maybe Exp]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Maybe (m Exp) -> m (Maybe Exp)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => Maybe (f a) -> f (Maybe a)
sequenceA [Maybe (m Exp)]
es; pure (TupE es1)}

unboxedTupE :: Quote m => [Maybe (m Exp)] -> m Exp
unboxedTupE :: forall (m :: * -> *). Quote m => [Maybe (m Exp)] -> m Exp
unboxedTupE [Maybe (m Exp)]
es = do { es1 <- (Maybe (m Exp) -> m (Maybe Exp))
-> [Maybe (m Exp)] -> m [Maybe Exp]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Maybe (m Exp) -> m (Maybe Exp)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => Maybe (f a) -> f (Maybe a)
sequenceA [Maybe (m Exp)]
es; pure (UnboxedTupE es1)}

unboxedSumE :: Quote m => m Exp -> SumAlt -> SumArity -> m Exp
unboxedSumE :: forall (m :: * -> *). Quote m => m Exp -> Int -> Int -> m Exp
unboxedSumE m Exp
e Int
alt Int
arity = do { e1 <- m Exp
e; pure (UnboxedSumE e1 alt arity) }

condE :: Quote m => m Exp -> m Exp -> m Exp -> m Exp
condE :: forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
condE m Exp
x m Exp
y m Exp
z =  do { a <- m Exp
x; b <- y; c <- z; pure (CondE a b c)}

multiIfE :: Quote m => [m (Guard, Exp)] -> m Exp
multiIfE :: forall (m :: * -> *). Quote m => [m (Guard, Exp)] -> m Exp
multiIfE [m (Guard, Exp)]
alts = [(Guard, Exp)] -> Exp
MultiIfE ([(Guard, Exp)] -> Exp) -> m [(Guard, Exp)] -> m Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [m (Guard, Exp)] -> m [(Guard, Exp)]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m (Guard, Exp)]
alts

letE :: Quote m => [m Dec] -> m Exp -> m Exp
letE :: forall (m :: * -> *). Quote m => [m Dec] -> m Exp -> m Exp
letE [m Dec]
ds m Exp
e = do { ds2 <- [m Dec] -> m [Dec]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m Dec]
ds; e2 <- e; pure (LetE ds2 e2) }

caseE :: Quote m => m Exp -> [m Match] -> m Exp
caseE :: forall (m :: * -> *). Quote m => m Exp -> [m Match] -> m Exp
caseE m Exp
e [m Match]
ms = do { e1 <- m Exp
e; ms1 <- sequenceA ms; pure (CaseE e1 ms1) }

doE :: Quote m => Maybe ModName -> [m Stmt] -> m Exp
doE :: forall (m :: * -> *). Quote m => Maybe ModName -> [m Stmt] -> m Exp
doE Maybe ModName
m [m Stmt]
ss = do { ss1 <- [m Stmt] -> m [Stmt]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m Stmt]
ss; pure (DoE m ss1) }

mdoE :: Quote m => Maybe ModName -> [m Stmt] -> m Exp
mdoE :: forall (m :: * -> *). Quote m => Maybe ModName -> [m Stmt] -> m Exp
mdoE Maybe ModName
m [m Stmt]
ss = do { ss1 <- [m Stmt] -> m [Stmt]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m Stmt]
ss; pure (MDoE m ss1) }

compE :: Quote m => [m Stmt] -> m Exp
compE :: forall (m :: * -> *). Quote m => [m Stmt] -> m Exp
compE [m Stmt]
ss = do { ss1 <- [m Stmt] -> m [Stmt]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m Stmt]
ss; pure (CompE ss1) }

arithSeqE :: Quote m => m Range -> m Exp
arithSeqE :: forall (m :: * -> *). Quote m => m Range -> m Exp
arithSeqE m Range
r = do { r' <- m Range
r; pure (ArithSeqE r') }

listE :: Quote m => [m Exp] -> m Exp
listE :: forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE [m Exp]
es = do { es1 <- [m Exp] -> m [Exp]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m Exp]
es; pure (ListE es1) }

sigE :: Quote m => m Exp -> m Type -> m Exp
sigE :: forall (m :: * -> *). Quote m => m Exp -> m Type -> m Exp
sigE m Exp
e m Type
t = do { e1 <- m Exp
e; t1 <- t; pure (SigE e1 t1) }

recConE :: Quote m => Name -> [m (Name,Exp)] -> m Exp
recConE :: forall (m :: * -> *). Quote m => Name -> [m (Name, Exp)] -> m Exp
recConE Name
c [m (Name, Exp)]
fs = do { flds <- [m (Name, Exp)] -> m [(Name, Exp)]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m (Name, Exp)]
fs; pure (RecConE c flds) }

recUpdE :: Quote m => m Exp -> [m (Name,Exp)] -> m Exp
recUpdE :: forall (m :: * -> *). Quote m => m Exp -> [m (Name, Exp)] -> m Exp
recUpdE m Exp
e [m (Name, Exp)]
fs = do { e1 <- m Exp
e; flds <- sequenceA fs; pure (RecUpdE e1 flds) }

stringE :: Quote m => String -> m Exp
stringE :: forall (m :: * -> *). Quote m => String -> m Exp
stringE = Lit -> m Exp
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (Lit -> m Exp) -> (String -> Lit) -> String -> m Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Lit
stringL

fieldExp :: Quote m => Name -> m Exp -> m (Name, Exp)
fieldExp :: forall (m :: * -> *). Quote m => Name -> m Exp -> m (Name, Exp)
fieldExp Name
s m Exp
e = do { e' <- m Exp
e; pure (s,e') }

-- | @staticE x = [| static x |]@
staticE :: Quote m => m Exp -> m Exp
staticE :: forall (m :: * -> *). Quote m => m Exp -> m Exp
staticE = (Exp -> Exp) -> m Exp -> m Exp
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp -> Exp
StaticE

unboundVarE :: Quote m => Name -> m Exp
unboundVarE :: forall (m :: * -> *). Quote m => Name -> m Exp
unboundVarE Name
s = Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
UnboundVarE Name
s)

labelE :: Quote m => String -> m Exp
labelE :: forall (m :: * -> *). Quote m => String -> m Exp
labelE String
s = Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Exp
LabelE String
s)

implicitParamVarE :: Quote m => String -> m Exp
implicitParamVarE :: forall (m :: * -> *). Quote m => String -> m Exp
implicitParamVarE String
n = Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Exp
ImplicitParamVarE String
n)

getFieldE :: Quote m => m Exp -> String -> m Exp
getFieldE :: forall (m :: * -> *). Quote m => m Exp -> String -> m Exp
getFieldE m Exp
e String
f = do
  e' <- m Exp
e
  pure (GetFieldE e' f)

projectionE :: Quote m => NonEmpty String -> m Exp
projectionE :: forall (m :: * -> *). Quote m => NonEmpty String -> m Exp
projectionE NonEmpty String
xs = Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty String -> Exp
ProjectionE NonEmpty String
xs)

typedSpliceE :: Quote m => m Exp -> m Exp
typedSpliceE :: forall (m :: * -> *). Quote m => m Exp -> m Exp
typedSpliceE = (Exp -> Exp) -> m Exp -> m Exp
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp -> Exp
TypedSpliceE

typedBracketE :: Quote m => m Exp -> m Exp
typedBracketE :: forall (m :: * -> *). Quote m => m Exp -> m Exp
typedBracketE = (Exp -> Exp) -> m Exp -> m Exp
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp -> Exp
TypedBracketE

-- ** 'arithSeqE' Shortcuts
fromE :: Quote m => m Exp -> m Exp
fromE :: forall (m :: * -> *). Quote m => m Exp -> m Exp
fromE m Exp
x = do { a <- m Exp
x; pure (ArithSeqE (FromR a)) }

fromThenE :: Quote m => m Exp -> m Exp -> m Exp
fromThenE :: forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
fromThenE m Exp
x m Exp
y = do { a <- m Exp
x; b <- y; pure (ArithSeqE (FromThenR a b)) }

fromToE :: Quote m => m Exp -> m Exp -> m Exp
fromToE :: forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
fromToE m Exp
x m Exp
y = do { a <- m Exp
x; b <- y; pure (ArithSeqE (FromToR a b)) }

fromThenToE :: Quote m => m Exp -> m Exp -> m Exp -> m Exp
fromThenToE :: forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
fromThenToE m Exp
x m Exp
y m Exp
z = do { a <- m Exp
x; b <- y; c <- z;
                         pure (ArithSeqE (FromThenToR a b c)) }

typeE :: Quote m => m Type -> m Exp
typeE :: forall (m :: * -> *). Quote m => m Type -> m Exp
typeE = (Type -> Exp) -> m Type -> m Exp
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type -> Exp
TypeE

forallE :: Quote m => [m (TyVarBndr Specificity)] -> m Exp -> m Exp
forallE :: forall (m :: * -> *).
Quote m =>
[m (TyVarBndr Specificity)] -> m Exp -> m Exp
forallE [m (TyVarBndr Specificity)]
tvars m Exp
body = [TyVarBndr Specificity] -> Exp -> Exp
ForallE ([TyVarBndr Specificity] -> Exp -> Exp)
-> m [TyVarBndr Specificity] -> m (Exp -> Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [m (TyVarBndr Specificity)] -> m [TyVarBndr Specificity]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m (TyVarBndr Specificity)]
tvars m (Exp -> Exp) -> m Exp -> m Exp
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Exp
body

forallVisE :: Quote m => [m (TyVarBndr ())] -> m Exp -> m Exp
forallVisE :: forall (m :: * -> *).
Quote m =>
[m (TyVarBndr ())] -> m Exp -> m Exp
forallVisE [m (TyVarBndr ())]
tvars m Exp
body = [TyVarBndr ()] -> Exp -> Exp
ForallVisE ([TyVarBndr ()] -> Exp -> Exp)
-> m [TyVarBndr ()] -> m (Exp -> Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [m (TyVarBndr ())] -> m [TyVarBndr ()]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m (TyVarBndr ())]
tvars m (Exp -> Exp) -> m Exp -> m Exp
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Exp
body

constrainedE :: Quote m => [m Exp] -> m Exp -> m Exp
constrainedE :: forall (m :: * -> *). Quote m => [m Exp] -> m Exp -> m Exp
constrainedE [m Exp]
ctx m Exp
body = [Exp] -> Exp -> Exp
ConstrainedE ([Exp] -> Exp -> Exp) -> m [Exp] -> m (Exp -> Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [m Exp] -> m [Exp]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m Exp]
ctx m (Exp -> Exp) -> m Exp -> m Exp
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Exp
body

-------------------------------------------------------------------------------
-- *   Dec

valD :: Quote m => m Pat -> m Body -> [m Dec] -> m Dec
valD :: forall (m :: * -> *).
Quote m =>
m Pat -> m Body -> [m Dec] -> m Dec
valD m Pat
p m Body
b [m Dec]
ds =
  do { p' <- m Pat
p
     ; ds' <- sequenceA ds
     ; b' <- b
     ; pure (ValD p' b' ds')
     }

funD :: Quote m => Name -> [m Clause] -> m Dec
funD :: forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD Name
nm [m Clause]
cs =
 do { cs1 <- [m Clause] -> m [Clause]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m Clause]
cs
    ; pure (FunD nm cs1)
    }

tySynD :: Quote m => Name -> [m (TyVarBndr BndrVis)] -> m Type -> m Dec
tySynD :: forall (m :: * -> *).
Quote m =>
Name -> [m (TyVarBndr BndrVis)] -> m Type -> m Dec
tySynD Name
tc [m (TyVarBndr BndrVis)]
tvs m Type
rhs =
  do { tvs1 <- [m (TyVarBndr BndrVis)] -> m [TyVarBndr BndrVis]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m (TyVarBndr BndrVis)]
tvs
     ; rhs1 <- rhs
     ; pure (TySynD tc tvs1 rhs1)
     }

dataD :: Quote m => m Cxt -> Name -> [m (TyVarBndr BndrVis)] -> Maybe (m Kind) -> [m Con]
      -> [m DerivClause] -> m Dec
dataD :: forall (m :: * -> *).
Quote m =>
m [Type]
-> Name
-> [m (TyVarBndr BndrVis)]
-> Maybe (m Type)
-> [m Con]
-> [m DerivClause]
-> m Dec
dataD m [Type]
ctxt Name
tc [m (TyVarBndr BndrVis)]
tvs Maybe (m Type)
ksig [m Con]
cons [m DerivClause]
derivs =
  do
    ctxt1   <- m [Type]
ctxt
    tvs1    <- sequenceA tvs
    ksig1   <- sequenceA ksig
    cons1   <- sequenceA cons
    derivs1 <- sequenceA derivs
    pure (DataD ctxt1 tc tvs1 ksig1 cons1 derivs1)

newtypeD :: Quote m => m Cxt -> Name -> [m (TyVarBndr BndrVis)] -> Maybe (m Kind) -> m Con
         -> [m DerivClause] -> m Dec
newtypeD :: forall (m :: * -> *).
Quote m =>
m [Type]
-> Name
-> [m (TyVarBndr BndrVis)]
-> Maybe (m Type)
-> m Con
-> [m DerivClause]
-> m Dec
newtypeD m [Type]
ctxt Name
tc [m (TyVarBndr BndrVis)]
tvs Maybe (m Type)
ksig m Con
con [m DerivClause]
derivs =
  do
    ctxt1   <- m [Type]
ctxt
    tvs1    <- sequenceA tvs
    ksig1   <- sequenceA ksig
    con1    <- con
    derivs1 <- sequenceA derivs
    pure (NewtypeD ctxt1 tc tvs1 ksig1 con1 derivs1)

typeDataD :: Quote m => Name -> [m (TyVarBndr BndrVis)] -> Maybe (m Kind) -> [m Con]
      -> m Dec
typeDataD :: forall (m :: * -> *).
Quote m =>
Name
-> [m (TyVarBndr BndrVis)] -> Maybe (m Type) -> [m Con] -> m Dec
typeDataD Name
tc [m (TyVarBndr BndrVis)]
tvs Maybe (m Type)
ksig [m Con]
cons =
  do
    tvs1    <- [m (TyVarBndr BndrVis)] -> m [TyVarBndr BndrVis]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m (TyVarBndr BndrVis)]
tvs
    ksig1   <- sequenceA ksig
    cons1   <- sequenceA cons
    pure (TypeDataD tc tvs1 ksig1 cons1)

classD :: Quote m => m Cxt -> Name -> [m (TyVarBndr BndrVis)] -> [FunDep] -> [m Dec] -> m Dec
classD :: forall (m :: * -> *).
Quote m =>
m [Type]
-> Name -> [m (TyVarBndr BndrVis)] -> [FunDep] -> [m Dec] -> m Dec
classD m [Type]
ctxt Name
cls [m (TyVarBndr BndrVis)]
tvs [FunDep]
fds [m Dec]
decs =
  do
    tvs1  <- [m (TyVarBndr BndrVis)] -> m [TyVarBndr BndrVis]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m (TyVarBndr BndrVis)]
tvs
    decs1 <- sequenceA decs
    ctxt1 <- ctxt
    pure $ ClassD ctxt1 cls tvs1 fds decs1

instanceD :: Quote m => m Cxt -> m Type -> [m Dec] -> m Dec
instanceD :: forall (m :: * -> *).
Quote m =>
m [Type] -> m Type -> [m Dec] -> m Dec
instanceD = Maybe Overlap -> m [Type] -> m Type -> [m Dec] -> m Dec
forall (m :: * -> *).
Quote m =>
Maybe Overlap -> m [Type] -> m Type -> [m Dec] -> m Dec
instanceWithOverlapD Maybe Overlap
forall a. Maybe a
Nothing

instanceWithOverlapD :: Quote m => Maybe Overlap -> m Cxt -> m Type -> [m Dec] -> m Dec
instanceWithOverlapD :: forall (m :: * -> *).
Quote m =>
Maybe Overlap -> m [Type] -> m Type -> [m Dec] -> m Dec
instanceWithOverlapD Maybe Overlap
o m [Type]
ctxt m Type
ty [m Dec]
decs =
  do
    ctxt1 <- m [Type]
ctxt
    decs1 <- sequenceA decs
    ty1   <- ty
    pure $ InstanceD o ctxt1 ty1 decs1



sigD :: Quote m => Name -> m Type -> m Dec
sigD :: forall (m :: * -> *). Quote m => Name -> m Type -> m Dec
sigD Name
fun m Type
ty = (Type -> Dec) -> m Type -> m Dec
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA (Name -> Type -> Dec
SigD Name
fun) (m Type -> m Dec) -> m Type -> m Dec
forall a b. (a -> b) -> a -> b
$ m Type
ty

kiSigD :: Quote m => Name -> m Kind -> m Dec
kiSigD :: forall (m :: * -> *). Quote m => Name -> m Type -> m Dec
kiSigD Name
fun m Type
ki = (Type -> Dec) -> m Type -> m Dec
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA (Name -> Type -> Dec
KiSigD Name
fun) (m Type -> m Dec) -> m Type -> m Dec
forall a b. (a -> b) -> a -> b
$ m Type
ki

forImpD :: Quote m => Callconv -> Safety -> String -> Name -> m Type -> m Dec
forImpD :: forall (m :: * -> *).
Quote m =>
Callconv -> Safety -> String -> Name -> m Type -> m Dec
forImpD Callconv
cc Safety
s String
str Name
n m Type
ty
 = do ty' <- m Type
ty
      pure $ ForeignD (ImportF cc s str n ty')

infixLD :: Quote m => Int -> Name -> m Dec
infixLD :: forall (m :: * -> *). Quote m => Int -> Name -> m Dec
infixLD Int
prec = Int -> NamespaceSpecifier -> Name -> m Dec
forall (m :: * -> *).
Quote m =>
Int -> NamespaceSpecifier -> Name -> m Dec
infixLWithSpecD Int
prec NamespaceSpecifier
NoNamespaceSpecifier

infixRD :: Quote m => Int -> Name -> m Dec
infixRD :: forall (m :: * -> *). Quote m => Int -> Name -> m Dec
infixRD Int
prec = Int -> NamespaceSpecifier -> Name -> m Dec
forall (m :: * -> *).
Quote m =>
Int -> NamespaceSpecifier -> Name -> m Dec
infixRWithSpecD Int
prec NamespaceSpecifier
NoNamespaceSpecifier

infixND :: Quote m => Int -> Name -> m Dec
infixND :: forall (m :: * -> *). Quote m => Int -> Name -> m Dec
infixND Int
prec = Int -> NamespaceSpecifier -> Name -> m Dec
forall (m :: * -> *).
Quote m =>
Int -> NamespaceSpecifier -> Name -> m Dec
infixNWithSpecD Int
prec NamespaceSpecifier
NoNamespaceSpecifier

infixLWithSpecD :: Quote m => Int -> NamespaceSpecifier -> Name -> m Dec
infixLWithSpecD :: forall (m :: * -> *).
Quote m =>
Int -> NamespaceSpecifier -> Name -> m Dec
infixLWithSpecD Int
prec NamespaceSpecifier
ns_spec Name
nm = Dec -> m Dec
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fixity -> NamespaceSpecifier -> Name -> Dec
InfixD (Int -> FixityDirection -> Fixity
Fixity Int
prec FixityDirection
InfixL) NamespaceSpecifier
ns_spec Name
nm)

infixRWithSpecD :: Quote m => Int -> NamespaceSpecifier -> Name -> m Dec
infixRWithSpecD :: forall (m :: * -> *).
Quote m =>
Int -> NamespaceSpecifier -> Name -> m Dec
infixRWithSpecD Int
prec NamespaceSpecifier
ns_spec Name
nm = Dec -> m Dec
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fixity -> NamespaceSpecifier -> Name -> Dec
InfixD (Int -> FixityDirection -> Fixity
Fixity Int
prec FixityDirection
InfixR) NamespaceSpecifier
ns_spec Name
nm)

infixNWithSpecD :: Quote m => Int -> NamespaceSpecifier -> Name -> m Dec
infixNWithSpecD :: forall (m :: * -> *).
Quote m =>
Int -> NamespaceSpecifier -> Name -> m Dec
infixNWithSpecD Int
prec NamespaceSpecifier
ns_spec Name
nm = Dec -> m Dec
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fixity -> NamespaceSpecifier -> Name -> Dec
InfixD (Int -> FixityDirection -> Fixity
Fixity Int
prec FixityDirection
InfixN) NamespaceSpecifier
ns_spec Name
nm)

defaultD :: Quote m => [m Type] -> m Dec
defaultD :: forall (m :: * -> *). Quote m => [m Type] -> m Dec
defaultD [m Type]
tys = [Type] -> Dec
DefaultD ([Type] -> Dec) -> m [Type] -> m Dec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [m Type] -> m [Type]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m Type]
tys

pragInlD :: Quote m => Name -> Inline -> RuleMatch -> Phases -> m Dec
pragInlD :: forall (m :: * -> *).
Quote m =>
Name -> Inline -> RuleMatch -> Phases -> m Dec
pragInlD Name
name Inline
inline RuleMatch
rm Phases
phases
  = Dec -> m Dec
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> m Dec) -> Dec -> m Dec
forall a b. (a -> b) -> a -> b
$ Pragma -> Dec
PragmaD (Pragma -> Dec) -> Pragma -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> Inline -> RuleMatch -> Phases -> Pragma
InlineP Name
name Inline
inline RuleMatch
rm Phases
phases

pragOpaqueD :: Quote m => Name -> m Dec
pragOpaqueD :: forall (m :: * -> *). Quote m => Name -> m Dec
pragOpaqueD Name
name = Dec -> m Dec
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> m Dec) -> Dec -> m Dec
forall a b. (a -> b) -> a -> b
$ Pragma -> Dec
PragmaD (Pragma -> Dec) -> Pragma -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> Pragma
OpaqueP Name
name

pragSpecD :: Quote m => Name -> m Type -> Phases -> m Dec
pragSpecD :: forall (m :: * -> *). Quote m => Name -> m Type -> Phases -> m Dec
pragSpecD Name
n m Type
ty Phases
phases
  = do
      ty1    <- m Type
ty
      pure $ PragmaD $ SpecialiseP n ty1 Nothing phases

pragSpecInlD :: Quote m => Name -> m Type -> Inline -> Phases -> m Dec
pragSpecInlD :: forall (m :: * -> *).
Quote m =>
Name -> m Type -> Inline -> Phases -> m Dec
pragSpecInlD Name
n m Type
ty Inline
inline Phases
phases
  = do
      ty1    <- m Type
ty
      pure $ PragmaD $ SpecialiseP n ty1 (Just inline) phases

pragSpecInstD :: Quote m => m Type -> m Dec
pragSpecInstD :: forall (m :: * -> *). Quote m => m Type -> m Dec
pragSpecInstD m Type
ty
  = do
      ty1    <- m Type
ty
      pure $ PragmaD $ SpecialiseInstP ty1

pragRuleD :: Quote m => String -> Maybe [m (TyVarBndr ())] -> [m RuleBndr] -> m Exp -> m Exp
          -> Phases -> m Dec
pragRuleD :: forall (m :: * -> *).
Quote m =>
String
-> Maybe [m (TyVarBndr ())]
-> [m RuleBndr]
-> m Exp
-> m Exp
-> Phases
-> m Dec
pragRuleD String
n Maybe [m (TyVarBndr ())]
ty_bndrs [m RuleBndr]
tm_bndrs m Exp
lhs m Exp
rhs Phases
phases
  = do
      ty_bndrs1 <- ([m (TyVarBndr ())] -> m [TyVarBndr ()])
-> Maybe [m (TyVarBndr ())] -> m (Maybe [TyVarBndr ()])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse [m (TyVarBndr ())] -> m [TyVarBndr ()]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA Maybe [m (TyVarBndr ())]
ty_bndrs
      tm_bndrs1 <- sequenceA tm_bndrs
      lhs1   <- lhs
      rhs1   <- rhs
      pure $ PragmaD $ RuleP n ty_bndrs1 tm_bndrs1 lhs1 rhs1 phases

pragAnnD :: Quote m => AnnTarget -> m Exp -> m Dec
pragAnnD :: forall (m :: * -> *). Quote m => AnnTarget -> m Exp -> m Dec
pragAnnD AnnTarget
target m Exp
expr
  = do
      exp1 <- m Exp
expr
      pure $ PragmaD $ AnnP target exp1

pragLineD :: Quote m => Int -> String -> m Dec
pragLineD :: forall (m :: * -> *). Quote m => Int -> String -> m Dec
pragLineD Int
line String
file = Dec -> m Dec
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> m Dec) -> Dec -> m Dec
forall a b. (a -> b) -> a -> b
$ Pragma -> Dec
PragmaD (Pragma -> Dec) -> Pragma -> Dec
forall a b. (a -> b) -> a -> b
$ Int -> String -> Pragma
LineP Int
line String
file

pragCompleteD :: Quote m => [Name] -> Maybe Name -> m Dec
pragCompleteD :: forall (m :: * -> *). Quote m => [Name] -> Maybe Name -> m Dec
pragCompleteD [Name]
cls Maybe Name
mty = Dec -> m Dec
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> m Dec) -> Dec -> m Dec
forall a b. (a -> b) -> a -> b
$ Pragma -> Dec
PragmaD (Pragma -> Dec) -> Pragma -> Dec
forall a b. (a -> b) -> a -> b
$ [Name] -> Maybe Name -> Pragma
CompleteP [Name]
cls Maybe Name
mty

pragSCCFunD :: Quote m => Name -> m Dec
pragSCCFunD :: forall (m :: * -> *). Quote m => Name -> m Dec
pragSCCFunD Name
nm = Dec -> m Dec
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> m Dec) -> Dec -> m Dec
forall a b. (a -> b) -> a -> b
$ Pragma -> Dec
PragmaD (Pragma -> Dec) -> Pragma -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> Maybe String -> Pragma
SCCP Name
nm Maybe String
forall a. Maybe a
Nothing

pragSCCFunNamedD :: Quote m => Name -> String -> m Dec
pragSCCFunNamedD :: forall (m :: * -> *). Quote m => Name -> String -> m Dec
pragSCCFunNamedD Name
nm String
str = Dec -> m Dec
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> m Dec) -> Dec -> m Dec
forall a b. (a -> b) -> a -> b
$ Pragma -> Dec
PragmaD (Pragma -> Dec) -> Pragma -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> Maybe String -> Pragma
SCCP Name
nm (String -> Maybe String
forall a. a -> Maybe a
Just String
str)

dataInstD :: Quote m => m Cxt -> (Maybe [m (TyVarBndr ())]) -> m Type -> Maybe (m Kind) -> [m Con]
          -> [m DerivClause] -> m Dec
dataInstD :: forall (m :: * -> *).
Quote m =>
m [Type]
-> Maybe [m (TyVarBndr ())]
-> m Type
-> Maybe (m Type)
-> [m Con]
-> [m DerivClause]
-> m Dec
dataInstD m [Type]
ctxt Maybe [m (TyVarBndr ())]
mb_bndrs m Type
ty Maybe (m Type)
ksig [m Con]
cons [m DerivClause]
derivs =
  do
    ctxt1   <- m [Type]
ctxt
    mb_bndrs1 <- traverse sequenceA mb_bndrs
    ty1    <- ty
    ksig1   <- sequenceA ksig
    cons1   <- sequenceA cons
    derivs1 <- sequenceA derivs
    pure (DataInstD ctxt1 mb_bndrs1 ty1 ksig1 cons1 derivs1)

newtypeInstD :: Quote m => m Cxt -> (Maybe [m (TyVarBndr ())]) -> m Type -> Maybe (m Kind) -> m Con
             -> [m DerivClause] -> m Dec
newtypeInstD :: forall (m :: * -> *).
Quote m =>
m [Type]
-> Maybe [m (TyVarBndr ())]
-> m Type
-> Maybe (m Type)
-> m Con
-> [m DerivClause]
-> m Dec
newtypeInstD m [Type]
ctxt Maybe [m (TyVarBndr ())]
mb_bndrs m Type
ty Maybe (m Type)
ksig m Con
con [m DerivClause]
derivs =
  do
    ctxt1   <- m [Type]
ctxt
    mb_bndrs1 <- traverse sequenceA mb_bndrs
    ty1    <- ty
    ksig1   <- sequenceA ksig
    con1    <- con
    derivs1 <- sequenceA derivs
    pure (NewtypeInstD ctxt1 mb_bndrs1 ty1 ksig1 con1 derivs1)

tySynInstD :: Quote m => m TySynEqn -> m Dec
tySynInstD :: forall (m :: * -> *). Quote m => m TySynEqn -> m Dec
tySynInstD m TySynEqn
eqn =
  do
    eqn1 <- m TySynEqn
eqn
    pure (TySynInstD eqn1)

dataFamilyD :: Quote m => Name -> [m (TyVarBndr BndrVis)] -> Maybe (m Kind) -> m Dec
dataFamilyD :: forall (m :: * -> *).
Quote m =>
Name -> [m (TyVarBndr BndrVis)] -> Maybe (m Type) -> m Dec
dataFamilyD Name
tc [m (TyVarBndr BndrVis)]
tvs Maybe (m Type)
kind =
  do tvs'  <- [m (TyVarBndr BndrVis)] -> m [TyVarBndr BndrVis]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m (TyVarBndr BndrVis)]
tvs
     kind' <- sequenceA kind
     pure $ DataFamilyD tc tvs' kind'

openTypeFamilyD :: Quote m => Name -> [m (TyVarBndr BndrVis)] -> m FamilyResultSig
                -> Maybe InjectivityAnn -> m Dec
openTypeFamilyD :: forall (m :: * -> *).
Quote m =>
Name
-> [m (TyVarBndr BndrVis)]
-> m FamilyResultSig
-> Maybe InjectivityAnn
-> m Dec
openTypeFamilyD Name
tc [m (TyVarBndr BndrVis)]
tvs m FamilyResultSig
res Maybe InjectivityAnn
inj =
  do tvs' <- [m (TyVarBndr BndrVis)] -> m [TyVarBndr BndrVis]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m (TyVarBndr BndrVis)]
tvs
     res' <- res
     pure $ OpenTypeFamilyD (TypeFamilyHead tc tvs' res' inj)

closedTypeFamilyD :: Quote m => Name -> [m (TyVarBndr BndrVis)] -> m FamilyResultSig
                  -> Maybe InjectivityAnn -> [m TySynEqn] -> m Dec
closedTypeFamilyD :: forall (m :: * -> *).
Quote m =>
Name
-> [m (TyVarBndr BndrVis)]
-> m FamilyResultSig
-> Maybe InjectivityAnn
-> [m TySynEqn]
-> m Dec
closedTypeFamilyD Name
tc [m (TyVarBndr BndrVis)]
tvs m FamilyResultSig
result Maybe InjectivityAnn
injectivity [m TySynEqn]
eqns =
  do tvs1    <- [m (TyVarBndr BndrVis)] -> m [TyVarBndr BndrVis]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m (TyVarBndr BndrVis)]
tvs
     result1 <- result
     eqns1   <- sequenceA eqns
     pure (ClosedTypeFamilyD (TypeFamilyHead tc tvs1 result1 injectivity) eqns1)

roleAnnotD :: Quote m => Name -> [Role] -> m Dec
roleAnnotD :: forall (m :: * -> *). Quote m => Name -> [Role] -> m Dec
roleAnnotD Name
name [Role]
roles = Dec -> m Dec
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> m Dec) -> Dec -> m Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Role] -> Dec
RoleAnnotD Name
name [Role]
roles

standaloneDerivD :: Quote m => m Cxt -> m Type -> m Dec
standaloneDerivD :: forall (m :: * -> *). Quote m => m [Type] -> m Type -> m Dec
standaloneDerivD = Maybe (m DerivStrategy) -> m [Type] -> m Type -> m Dec
forall (m :: * -> *).
Quote m =>
Maybe (m DerivStrategy) -> m [Type] -> m Type -> m Dec
standaloneDerivWithStrategyD Maybe (m DerivStrategy)
forall a. Maybe a
Nothing

standaloneDerivWithStrategyD :: Quote m => Maybe (m DerivStrategy) -> m Cxt -> m Type -> m Dec
standaloneDerivWithStrategyD :: forall (m :: * -> *).
Quote m =>
Maybe (m DerivStrategy) -> m [Type] -> m Type -> m Dec
standaloneDerivWithStrategyD Maybe (m DerivStrategy)
mdsq m [Type]
ctxtq m Type
tyq =
  do
    mds  <- Maybe (m DerivStrategy) -> m (Maybe DerivStrategy)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => Maybe (f a) -> f (Maybe a)
sequenceA Maybe (m DerivStrategy)
mdsq
    ctxt <- ctxtq
    ty   <- tyq
    pure $ StandaloneDerivD mds ctxt ty

defaultSigD :: Quote m => Name -> m Type -> m Dec
defaultSigD :: forall (m :: * -> *). Quote m => Name -> m Type -> m Dec
defaultSigD Name
n m Type
tyq =
  do
    ty <- m Type
tyq
    pure $ DefaultSigD n ty

-- | Pattern synonym declaration
patSynD :: Quote m => Name -> m PatSynArgs -> m PatSynDir -> m Pat -> m Dec
patSynD :: forall (m :: * -> *).
Quote m =>
Name -> m PatSynArgs -> m PatSynDir -> m Pat -> m Dec
patSynD Name
name m PatSynArgs
args m PatSynDir
dir m Pat
pat = do
  args'    <- m PatSynArgs
args
  dir'     <- dir
  pat'     <- pat
  pure (PatSynD name args' dir' pat')

-- | Pattern synonym type signature
patSynSigD :: Quote m => Name -> m Type -> m Dec
patSynSigD :: forall (m :: * -> *). Quote m => Name -> m Type -> m Dec
patSynSigD Name
nm m Type
ty =
  do ty' <- m Type
ty
     pure $ PatSynSigD nm ty'

-- | Implicit parameter binding declaration. Can only be used in let
-- and where clauses which consist entirely of implicit bindings.
implicitParamBindD :: Quote m => String -> m Exp -> m Dec
implicitParamBindD :: forall (m :: * -> *). Quote m => String -> m Exp -> m Dec
implicitParamBindD String
n m Exp
e =
  do
    e' <- m Exp
e
    pure $ ImplicitParamBindD n e'

tySynEqn :: Quote m => (Maybe [m (TyVarBndr ())]) -> m Type -> m Type -> m TySynEqn
tySynEqn :: forall (m :: * -> *).
Quote m =>
Maybe [m (TyVarBndr ())] -> m Type -> m Type -> m TySynEqn
tySynEqn Maybe [m (TyVarBndr ())]
mb_bndrs m Type
lhs m Type
rhs =
  do
    mb_bndrs1 <- ([m (TyVarBndr ())] -> m [TyVarBndr ()])
-> Maybe [m (TyVarBndr ())] -> m (Maybe [TyVarBndr ()])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse [m (TyVarBndr ())] -> m [TyVarBndr ()]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA Maybe [m (TyVarBndr ())]
mb_bndrs
    lhs1 <- lhs
    rhs1 <- rhs
    pure (TySynEqn mb_bndrs1 lhs1 rhs1)

cxt :: Quote m => [m Pred] -> m Cxt
cxt :: forall (m :: * -> *). Quote m => [m Type] -> m [Type]
cxt = [m Type] -> m [Type]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA

derivClause :: Quote m => Maybe (m DerivStrategy) -> [m Pred] -> m DerivClause
derivClause :: forall (m :: * -> *).
Quote m =>
Maybe (m DerivStrategy) -> [m Type] -> m DerivClause
derivClause Maybe (m DerivStrategy)
mds [m Type]
p = do mds' <- Maybe (m DerivStrategy) -> m (Maybe DerivStrategy)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => Maybe (f a) -> f (Maybe a)
sequenceA Maybe (m DerivStrategy)
mds
                       p'   <- cxt p
                       pure $ DerivClause mds' p'

stockStrategy :: Quote m => m DerivStrategy
stockStrategy :: forall (m :: * -> *). Quote m => m DerivStrategy
stockStrategy = DerivStrategy -> m DerivStrategy
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DerivStrategy
StockStrategy

anyclassStrategy :: Quote m => m DerivStrategy
anyclassStrategy :: forall (m :: * -> *). Quote m => m DerivStrategy
anyclassStrategy = DerivStrategy -> m DerivStrategy
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DerivStrategy
AnyclassStrategy

newtypeStrategy :: Quote m => m DerivStrategy
newtypeStrategy :: forall (m :: * -> *). Quote m => m DerivStrategy
newtypeStrategy = DerivStrategy -> m DerivStrategy
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DerivStrategy
NewtypeStrategy

viaStrategy :: Quote m => m Type -> m DerivStrategy
viaStrategy :: forall (m :: * -> *). Quote m => m Type -> m DerivStrategy
viaStrategy = (Type -> DerivStrategy) -> m Type -> m DerivStrategy
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type -> DerivStrategy
ViaStrategy

normalC :: Quote m => Name -> [m BangType] -> m Con
normalC :: forall (m :: * -> *). Quote m => Name -> [m BangType] -> m Con
normalC Name
con [m BangType]
strtys = ([BangType] -> Con) -> m [BangType] -> m Con
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA (Name -> [BangType] -> Con
NormalC Name
con) (m [BangType] -> m Con) -> m [BangType] -> m Con
forall a b. (a -> b) -> a -> b
$ [m BangType] -> m [BangType]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m BangType]
strtys

recC :: Quote m => Name -> [m VarBangType] -> m Con
recC :: forall (m :: * -> *). Quote m => Name -> [m VarBangType] -> m Con
recC Name
con [m VarBangType]
varstrtys = ([VarBangType] -> Con) -> m [VarBangType] -> m Con
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA (Name -> [VarBangType] -> Con
RecC Name
con) (m [VarBangType] -> m Con) -> m [VarBangType] -> m Con
forall a b. (a -> b) -> a -> b
$ [m VarBangType] -> m [VarBangType]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m VarBangType]
varstrtys

infixC :: Quote m => m (Bang, Type) -> Name -> m (Bang, Type) -> m Con
infixC :: forall (m :: * -> *).
Quote m =>
m BangType -> Name -> m BangType -> m Con
infixC m BangType
st1 Name
con m BangType
st2 = do st1' <- m BangType
st1
                        st2' <- st2
                        pure $ InfixC st1' con st2'

forallC :: Quote m => [m (TyVarBndr Specificity)] -> m Cxt -> m Con -> m Con
forallC :: forall (m :: * -> *).
Quote m =>
[m (TyVarBndr Specificity)] -> m [Type] -> m Con -> m Con
forallC [m (TyVarBndr Specificity)]
ns m [Type]
ctxt m Con
con = do
  ns'   <- [m (TyVarBndr Specificity)] -> m [TyVarBndr Specificity]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m (TyVarBndr Specificity)]
ns
  ctxt' <- ctxt
  con'  <- con
  pure $ ForallC ns' ctxt' con'

gadtC :: Quote m => [Name] -> [m StrictType] -> m Type -> m Con
gadtC :: forall (m :: * -> *).
Quote m =>
[Name] -> [m BangType] -> m Type -> m Con
gadtC [Name]
cons [m BangType]
strtys m Type
ty = ([BangType] -> Type -> Con) -> m [BangType] -> m Type -> m Con
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ([Name] -> [BangType] -> Type -> Con
GadtC [Name]
cons) ([m BangType] -> m [BangType]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m BangType]
strtys) m Type
ty

recGadtC :: Quote m => [Name] -> [m VarStrictType] -> m Type -> m Con
recGadtC :: forall (m :: * -> *).
Quote m =>
[Name] -> [m VarBangType] -> m Type -> m Con
recGadtC [Name]
cons [m VarBangType]
varstrtys m Type
ty = ([VarBangType] -> Type -> Con)
-> m [VarBangType] -> m Type -> m Con
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ([Name] -> [VarBangType] -> Type -> Con
RecGadtC [Name]
cons) ([m VarBangType] -> m [VarBangType]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m VarBangType]
varstrtys) m Type
ty

-------------------------------------------------------------------------------
-- *   Type

forallT :: Quote m => [m (TyVarBndr Specificity)] -> m Cxt -> m Type -> m Type
forallT :: forall (m :: * -> *).
Quote m =>
[m (TyVarBndr Specificity)] -> m [Type] -> m Type -> m Type
forallT [m (TyVarBndr Specificity)]
tvars m [Type]
ctxt m Type
ty = do
    tvars1 <- [m (TyVarBndr Specificity)] -> m [TyVarBndr Specificity]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m (TyVarBndr Specificity)]
tvars
    ctxt1  <- ctxt
    ty1    <- ty
    pure $ ForallT tvars1 ctxt1 ty1

forallVisT :: Quote m => [m (TyVarBndr ())] -> m Type -> m Type
forallVisT :: forall (m :: * -> *).
Quote m =>
[m (TyVarBndr ())] -> m Type -> m Type
forallVisT [m (TyVarBndr ())]
tvars m Type
ty = [TyVarBndr ()] -> Type -> Type
ForallVisT ([TyVarBndr ()] -> Type -> Type)
-> m [TyVarBndr ()] -> m (Type -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [m (TyVarBndr ())] -> m [TyVarBndr ()]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m (TyVarBndr ())]
tvars m (Type -> Type) -> m Type -> m Type
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Type
ty

varT :: Quote m => Name -> m Type
varT :: forall (m :: * -> *). Quote m => Name -> m Type
varT = Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> m Type) -> (Name -> Type) -> Name -> m Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Type
VarT

conT :: Quote m => Name -> m Type
conT :: forall (m :: * -> *). Quote m => Name -> m Type
conT = Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> m Type) -> (Name -> Type) -> Name -> m Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Type
ConT

infixT :: Quote m => m Type -> Name -> m Type -> m Type
infixT :: forall (m :: * -> *). Quote m => m Type -> Name -> m Type -> m Type
infixT m Type
t1 Name
n m Type
t2 = do t1' <- m Type
t1
                    t2' <- t2
                    pure (InfixT t1' n t2')

uInfixT :: Quote m => m Type -> Name -> m Type -> m Type
uInfixT :: forall (m :: * -> *). Quote m => m Type -> Name -> m Type -> m Type
uInfixT m Type
t1 Name
n m Type
t2 = do t1' <- m Type
t1
                     t2' <- t2
                     pure (UInfixT t1' n t2')

promotedInfixT :: Quote m => m Type -> Name -> m Type -> m Type
promotedInfixT :: forall (m :: * -> *). Quote m => m Type -> Name -> m Type -> m Type
promotedInfixT m Type
t1 Name
n m Type
t2 = do t1' <- m Type
t1
                            t2' <- t2
                            pure (PromotedInfixT t1' n t2')

promotedUInfixT :: Quote m => m Type -> Name -> m Type -> m Type
promotedUInfixT :: forall (m :: * -> *). Quote m => m Type -> Name -> m Type -> m Type
promotedUInfixT m Type
t1 Name
n m Type
t2 = do t1' <- m Type
t1
                             t2' <- t2
                             pure (PromotedUInfixT t1' n t2')

parensT :: Quote m => m Type -> m Type
parensT :: forall (m :: * -> *). Quote m => m Type -> m Type
parensT m Type
t = do t' <- m Type
t
               pure (ParensT t')

appT :: Quote m => m Type -> m Type -> m Type
appT :: forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT m Type
t1 m Type
t2 = do
           t1' <- m Type
t1
           t2' <- t2
           pure $ AppT t1' t2'

appKindT :: Quote m => m Type -> m Kind -> m Type
appKindT :: forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appKindT m Type
ty m Type
ki = do
               ty' <- m Type
ty
               ki' <- ki
               pure $ AppKindT ty' ki'

arrowT :: Quote m => m Type
arrowT :: forall (m :: * -> *). Quote m => m Type
arrowT = Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
ArrowT

mulArrowT :: Quote m => m Type
mulArrowT :: forall (m :: * -> *). Quote m => m Type
mulArrowT = Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
MulArrowT

listT :: Quote m => m Type
listT :: forall (m :: * -> *). Quote m => m Type
listT = Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
ListT

litT :: Quote m => m TyLit -> m Type
litT :: forall (m :: * -> *). Quote m => m TyLit -> m Type
litT m TyLit
l = (TyLit -> Type) -> m TyLit -> m Type
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TyLit -> Type
LitT m TyLit
l

tupleT :: Quote m => Int -> m Type
tupleT :: forall (m :: * -> *). Quote m => Int -> m Type
tupleT Int
i = Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Type
TupleT Int
i)

unboxedTupleT :: Quote m => Int -> m Type
unboxedTupleT :: forall (m :: * -> *). Quote m => Int -> m Type
unboxedTupleT Int
i = Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Type
UnboxedTupleT Int
i)

unboxedSumT :: Quote m => SumArity -> m Type
unboxedSumT :: forall (m :: * -> *). Quote m => Int -> m Type
unboxedSumT Int
arity = Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Type
UnboxedSumT Int
arity)

sigT :: Quote m => m Type -> m Kind -> m Type
sigT :: forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
sigT m Type
t m Type
k
  = do
      t' <- m Type
t
      k' <- k
      pure $ SigT t' k'

equalityT :: Quote m => m Type
equalityT :: forall (m :: * -> *). Quote m => m Type
equalityT = Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
EqualityT

wildCardT :: Quote m => m Type
wildCardT :: forall (m :: * -> *). Quote m => m Type
wildCardT = Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
WildCardT

implicitParamT :: Quote m => String -> m Type -> m Type
implicitParamT :: forall (m :: * -> *). Quote m => String -> m Type -> m Type
implicitParamT String
n m Type
t
  = do
      t' <- m Type
t
      pure $ ImplicitParamT n t'

{-# DEPRECATED classP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please use 'conT' and 'appT'." #-}
classP :: Quote m => Name -> [m Type] -> m Pred
classP :: forall (m :: * -> *). Quote m => Name -> [m Type] -> m Type
classP Name
cla [m Type]
tys
  = do
      tysl <- [m Type] -> m [Type]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m Type]
tys
      pure (foldl AppT (ConT cla) tysl)

{-# DEPRECATED equalP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please see 'equalityT'." #-}
equalP :: Quote m => m Type -> m Type -> m Pred
equalP :: forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
equalP m Type
tleft m Type
tright
  = do
      tleft1  <- m Type
tleft
      tright1 <- tright
      eqT <- equalityT
      pure (foldl AppT eqT [tleft1, tright1])

promotedT :: Quote m => Name -> m Type
promotedT :: forall (m :: * -> *). Quote m => Name -> m Type
promotedT = Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> m Type) -> (Name -> Type) -> Name -> m Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Type
PromotedT

promotedTupleT :: Quote m => Int -> m Type
promotedTupleT :: forall (m :: * -> *). Quote m => Int -> m Type
promotedTupleT Int
i = Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Type
PromotedTupleT Int
i)

promotedNilT :: Quote m => m Type
promotedNilT :: forall (m :: * -> *). Quote m => m Type
promotedNilT = Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
PromotedNilT

promotedConsT :: Quote m => m Type
promotedConsT :: forall (m :: * -> *). Quote m => m Type
promotedConsT = Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
PromotedConsT

noSourceUnpackedness, sourceNoUnpack, sourceUnpack :: Quote m => m SourceUnpackedness
noSourceUnpackedness :: forall (m :: * -> *). Quote m => m SourceUnpackedness
noSourceUnpackedness = SourceUnpackedness -> m SourceUnpackedness
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SourceUnpackedness
NoSourceUnpackedness
sourceNoUnpack :: forall (m :: * -> *). Quote m => m SourceUnpackedness
sourceNoUnpack       = SourceUnpackedness -> m SourceUnpackedness
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SourceUnpackedness
SourceNoUnpack
sourceUnpack :: forall (m :: * -> *). Quote m => m SourceUnpackedness
sourceUnpack         = SourceUnpackedness -> m SourceUnpackedness
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SourceUnpackedness
SourceUnpack

noSourceStrictness, sourceLazy, sourceStrict :: Quote m => m SourceStrictness
noSourceStrictness :: forall (m :: * -> *). Quote m => m SourceStrictness
noSourceStrictness = SourceStrictness -> m SourceStrictness
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SourceStrictness
NoSourceStrictness
sourceLazy :: forall (m :: * -> *). Quote m => m SourceStrictness
sourceLazy         = SourceStrictness -> m SourceStrictness
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SourceStrictness
SourceLazy
sourceStrict :: forall (m :: * -> *). Quote m => m SourceStrictness
sourceStrict       = SourceStrictness -> m SourceStrictness
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SourceStrictness
SourceStrict

{-# DEPRECATED isStrict
    ["Use 'bang'. See https://gitlab.haskell.org/ghc/ghc/wikis/migration/8.0. ",
     "Example usage: 'bang noSourceUnpackedness sourceStrict'"] #-}
{-# DEPRECATED notStrict
    ["Use 'bang'. See https://gitlab.haskell.org/ghc/ghc/wikis/migration/8.0. ",
     "Example usage: 'bang noSourceUnpackedness noSourceStrictness'"] #-}
{-# DEPRECATED unpacked
    ["Use 'bang'. See https://gitlab.haskell.org/ghc/ghc/wikis/migration/8.0. ",
     "Example usage: 'bang sourceUnpack sourceStrict'"] #-}
isStrict, notStrict, unpacked :: Quote m => m Strict
isStrict :: forall (m :: * -> *). Quote m => m Strict
isStrict = m SourceUnpackedness -> m SourceStrictness -> m Strict
forall (m :: * -> *).
Quote m =>
m SourceUnpackedness -> m SourceStrictness -> m Strict
bang m SourceUnpackedness
forall (m :: * -> *). Quote m => m SourceUnpackedness
noSourceUnpackedness m SourceStrictness
forall (m :: * -> *). Quote m => m SourceStrictness
sourceStrict
notStrict :: forall (m :: * -> *). Quote m => m Strict
notStrict = m SourceUnpackedness -> m SourceStrictness -> m Strict
forall (m :: * -> *).
Quote m =>
m SourceUnpackedness -> m SourceStrictness -> m Strict
bang m SourceUnpackedness
forall (m :: * -> *). Quote m => m SourceUnpackedness
noSourceUnpackedness m SourceStrictness
forall (m :: * -> *). Quote m => m SourceStrictness
noSourceStrictness
unpacked :: forall (m :: * -> *). Quote m => m Strict
unpacked = m SourceUnpackedness -> m SourceStrictness -> m Strict
forall (m :: * -> *).
Quote m =>
m SourceUnpackedness -> m SourceStrictness -> m Strict
bang m SourceUnpackedness
forall (m :: * -> *). Quote m => m SourceUnpackedness
sourceUnpack m SourceStrictness
forall (m :: * -> *). Quote m => m SourceStrictness
sourceStrict

bang :: Quote m => m SourceUnpackedness -> m SourceStrictness -> m Bang
bang :: forall (m :: * -> *).
Quote m =>
m SourceUnpackedness -> m SourceStrictness -> m Strict
bang m SourceUnpackedness
u m SourceStrictness
s = do u' <- m SourceUnpackedness
u
              s' <- s
              pure (Bang u' s')

bangType :: Quote m => m Bang -> m Type -> m BangType
bangType :: forall (m :: * -> *). Quote m => m Strict -> m Type -> m BangType
bangType = (Strict -> Type -> BangType) -> m Strict -> m Type -> m BangType
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,)

varBangType :: Quote m => Name -> m BangType -> m VarBangType
varBangType :: forall (m :: * -> *).
Quote m =>
Name -> m BangType -> m VarBangType
varBangType Name
v m BangType
bt = (\(Strict
b, Type
t) -> (Name
v, Strict
b, Type
t)) (BangType -> VarBangType) -> m BangType -> m VarBangType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m BangType
bt

{-# DEPRECATED strictType
               "As of @template-haskell-2.11.0.0@, 'StrictType' has been replaced by 'BangType'. Please use 'bangType' instead." #-}
strictType :: Quote m => m Strict -> m Type -> m StrictType
strictType :: forall (m :: * -> *). Quote m => m Strict -> m Type -> m BangType
strictType = m Strict -> m Type -> m BangType
forall (m :: * -> *). Quote m => m Strict -> m Type -> m BangType
bangType

{-# DEPRECATED varStrictType
               "As of @template-haskell-2.11.0.0@, 'VarStrictType' has been replaced by 'VarBangType'. Please use 'varBangType' instead." #-}
varStrictType :: Quote m => Name -> m StrictType -> m VarStrictType
varStrictType :: forall (m :: * -> *).
Quote m =>
Name -> m BangType -> m VarBangType
varStrictType = Name -> m BangType -> m VarBangType
forall (m :: * -> *).
Quote m =>
Name -> m BangType -> m VarBangType
varBangType

-- * Type Literals

-- MonadFail here complicates things (a lot) because it would mean we would
-- have to emit a MonadFail constraint during typechecking if there was any
-- chance the desugaring would use numTyLit, which in general is hard to
-- predict.
numTyLit :: Quote m => Integer -> m TyLit
numTyLit :: forall (m :: * -> *). Quote m => Integer -> m TyLit
numTyLit Integer
n = if Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 then TyLit -> m TyLit
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> TyLit
NumTyLit Integer
n)
                       else String -> m TyLit
forall a. HasCallStack => String -> a
error (String
"Negative type-level number: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
n)

strTyLit :: Quote m => String -> m TyLit
strTyLit :: forall (m :: * -> *). Quote m => String -> m TyLit
strTyLit String
s = TyLit -> m TyLit
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> TyLit
StrTyLit String
s)

charTyLit :: Quote m => Char -> m TyLit
charTyLit :: forall (m :: * -> *). Quote m => Char -> m TyLit
charTyLit Char
c = TyLit -> m TyLit
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> TyLit
CharTyLit Char
c)

-------------------------------------------------------------------------------
-- *   Kind

plainTV :: Quote m => Name -> m (TyVarBndr ())
plainTV :: forall (m :: * -> *). Quote m => Name -> m (TyVarBndr ())
plainTV Name
n = TyVarBndr () -> m (TyVarBndr ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyVarBndr () -> m (TyVarBndr ()))
-> TyVarBndr () -> m (TyVarBndr ())
forall a b. (a -> b) -> a -> b
$ Name -> () -> TyVarBndr ()
forall flag. Name -> flag -> TyVarBndr flag
PlainTV Name
n ()

plainInvisTV :: Quote m => Name -> Specificity -> m (TyVarBndr Specificity)
plainInvisTV :: forall (m :: * -> *).
Quote m =>
Name -> Specificity -> m (TyVarBndr Specificity)
plainInvisTV Name
n Specificity
s = TyVarBndr Specificity -> m (TyVarBndr Specificity)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyVarBndr Specificity -> m (TyVarBndr Specificity))
-> TyVarBndr Specificity -> m (TyVarBndr Specificity)
forall a b. (a -> b) -> a -> b
$ Name -> Specificity -> TyVarBndr Specificity
forall flag. Name -> flag -> TyVarBndr flag
PlainTV Name
n Specificity
s

plainBndrTV :: Quote m => Name -> BndrVis -> m (TyVarBndr BndrVis)
plainBndrTV :: forall (m :: * -> *).
Quote m =>
Name -> BndrVis -> m (TyVarBndr BndrVis)
plainBndrTV Name
n BndrVis
v = TyVarBndr BndrVis -> m (TyVarBndr BndrVis)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyVarBndr BndrVis -> m (TyVarBndr BndrVis))
-> TyVarBndr BndrVis -> m (TyVarBndr BndrVis)
forall a b. (a -> b) -> a -> b
$ Name -> BndrVis -> TyVarBndr BndrVis
forall flag. Name -> flag -> TyVarBndr flag
PlainTV Name
n BndrVis
v

kindedTV :: Quote m => Name -> m Kind -> m (TyVarBndr ())
kindedTV :: forall (m :: * -> *). Quote m => Name -> m Type -> m (TyVarBndr ())
kindedTV Name
n = (Type -> TyVarBndr ()) -> m Type -> m (TyVarBndr ())
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name -> () -> Type -> TyVarBndr ()
forall flag. Name -> flag -> Type -> TyVarBndr flag
KindedTV Name
n ())

kindedInvisTV :: Quote m => Name -> Specificity -> m Kind -> m (TyVarBndr Specificity)
kindedInvisTV :: forall (m :: * -> *).
Quote m =>
Name -> Specificity -> m Type -> m (TyVarBndr Specificity)
kindedInvisTV Name
n Specificity
s = (Type -> TyVarBndr Specificity)
-> m Type -> m (TyVarBndr Specificity)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name -> Specificity -> Type -> TyVarBndr Specificity
forall flag. Name -> flag -> Type -> TyVarBndr flag
KindedTV Name
n Specificity
s)

kindedBndrTV :: Quote m => Name -> BndrVis -> m Kind -> m (TyVarBndr BndrVis)
kindedBndrTV :: forall (m :: * -> *).
Quote m =>
Name -> BndrVis -> m Type -> m (TyVarBndr BndrVis)
kindedBndrTV Name
n BndrVis
v = (Type -> TyVarBndr BndrVis) -> m Type -> m (TyVarBndr BndrVis)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name -> BndrVis -> Type -> TyVarBndr BndrVis
forall flag. Name -> flag -> Type -> TyVarBndr flag
KindedTV Name
n BndrVis
v)

specifiedSpec :: Specificity
specifiedSpec :: Specificity
specifiedSpec = Specificity
SpecifiedSpec

inferredSpec :: Specificity
inferredSpec :: Specificity
inferredSpec = Specificity
InferredSpec

bndrReq :: BndrVis
bndrReq :: BndrVis
bndrReq = BndrVis
BndrReq

bndrInvis :: BndrVis
bndrInvis :: BndrVis
bndrInvis = BndrVis
BndrInvis

varK :: Name -> Kind
varK :: Name -> Type
varK = Name -> Type
VarT

conK :: Name -> Kind
conK :: Name -> Type
conK = Name -> Type
ConT

tupleK :: Int -> Kind
tupleK :: Int -> Type
tupleK = Int -> Type
TupleT

arrowK ::  Kind
arrowK :: Type
arrowK = Type
ArrowT

listK ::  Kind
listK :: Type
listK = Type
ListT

appK :: Kind -> Kind -> Kind
appK :: Type -> Type -> Type
appK = Type -> Type -> Type
AppT

starK :: Quote m => m Kind
starK :: forall (m :: * -> *). Quote m => m Type
starK = Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
StarT

constraintK :: Quote m => m Kind
constraintK :: forall (m :: * -> *). Quote m => m Type
constraintK = Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
ConstraintT

-------------------------------------------------------------------------------
-- *   Type family result

noSig :: Quote m => m FamilyResultSig
noSig :: forall (m :: * -> *). Quote m => m FamilyResultSig
noSig = FamilyResultSig -> m FamilyResultSig
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FamilyResultSig
NoSig

kindSig :: Quote m => m Kind -> m FamilyResultSig
kindSig :: forall (m :: * -> *). Quote m => m Type -> m FamilyResultSig
kindSig = (Type -> FamilyResultSig) -> m Type -> m FamilyResultSig
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type -> FamilyResultSig
KindSig

tyVarSig :: Quote m => m (TyVarBndr ()) -> m FamilyResultSig
tyVarSig :: forall (m :: * -> *).
Quote m =>
m (TyVarBndr ()) -> m FamilyResultSig
tyVarSig = (TyVarBndr () -> FamilyResultSig)
-> m (TyVarBndr ()) -> m FamilyResultSig
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TyVarBndr () -> FamilyResultSig
TyVarSig

-------------------------------------------------------------------------------
-- *   Injectivity annotation

injectivityAnn :: Name -> [Name] -> InjectivityAnn
injectivityAnn :: Name -> [Name] -> InjectivityAnn
injectivityAnn = Name -> [Name] -> InjectivityAnn
TH.InjectivityAnn

-------------------------------------------------------------------------------
-- *   Role

nominalR, representationalR, phantomR, inferR :: Role
nominalR :: Role
nominalR          = Role
NominalR
representationalR :: Role
representationalR = Role
RepresentationalR
phantomR :: Role
phantomR          = Role
PhantomR
inferR :: Role
inferR            = Role
InferR

-------------------------------------------------------------------------------
-- *   Callconv

cCall, stdCall, cApi, prim, javaScript :: Callconv
cCall :: Callconv
cCall      = Callconv
CCall
stdCall :: Callconv
stdCall    = Callconv
StdCall
cApi :: Callconv
cApi       = Callconv
CApi
prim :: Callconv
prim       = Callconv
Prim
javaScript :: Callconv
javaScript = Callconv
JavaScript

-------------------------------------------------------------------------------
-- *   Safety

unsafe, safe, interruptible :: Safety
unsafe :: Safety
unsafe = Safety
Unsafe
safe :: Safety
safe = Safety
Safe
interruptible :: Safety
interruptible = Safety
Interruptible

-------------------------------------------------------------------------------
-- *   FunDep

funDep ::  [Name] -> [Name] -> FunDep
funDep :: [Name] -> [Name] -> FunDep
funDep = [Name] -> [Name] -> FunDep
FunDep

-------------------------------------------------------------------------------
-- *   RuleBndr
ruleVar :: Quote m => Name -> m RuleBndr
ruleVar :: forall (m :: * -> *). Quote m => Name -> m RuleBndr
ruleVar = RuleBndr -> m RuleBndr
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RuleBndr -> m RuleBndr)
-> (Name -> RuleBndr) -> Name -> m RuleBndr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> RuleBndr
RuleVar

typedRuleVar :: Quote m => Name -> m Type -> m RuleBndr
typedRuleVar :: forall (m :: * -> *). Quote m => Name -> m Type -> m RuleBndr
typedRuleVar Name
n m Type
ty = Name -> Type -> RuleBndr
TypedRuleVar Name
n (Type -> RuleBndr) -> m Type -> m RuleBndr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Type
ty

-------------------------------------------------------------------------------
-- *   AnnTarget
valueAnnotation ::  Name -> AnnTarget
valueAnnotation :: Name -> AnnTarget
valueAnnotation = Name -> AnnTarget
ValueAnnotation

typeAnnotation ::  Name -> AnnTarget
typeAnnotation :: Name -> AnnTarget
typeAnnotation = Name -> AnnTarget
TypeAnnotation

moduleAnnotation :: AnnTarget
moduleAnnotation :: AnnTarget
moduleAnnotation = AnnTarget
ModuleAnnotation

-------------------------------------------------------------------------------
-- * Pattern Synonyms (sub constructs)

unidir, implBidir :: Quote m => m PatSynDir
unidir :: forall (m :: * -> *). Quote m => m PatSynDir
unidir    = PatSynDir -> m PatSynDir
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PatSynDir
Unidir
implBidir :: forall (m :: * -> *). Quote m => m PatSynDir
implBidir = PatSynDir -> m PatSynDir
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PatSynDir
ImplBidir

explBidir :: Quote m => [m Clause] -> m PatSynDir
explBidir :: forall (m :: * -> *). Quote m => [m Clause] -> m PatSynDir
explBidir [m Clause]
cls = do
  cls' <- [m Clause] -> m [Clause]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m Clause]
cls
  pure (ExplBidir cls')

prefixPatSyn :: Quote m => [Name] -> m PatSynArgs
prefixPatSyn :: forall (m :: * -> *). Quote m => [Name] -> m PatSynArgs
prefixPatSyn [Name]
args = PatSynArgs -> m PatSynArgs
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PatSynArgs -> m PatSynArgs) -> PatSynArgs -> m PatSynArgs
forall a b. (a -> b) -> a -> b
$ [Name] -> PatSynArgs
PrefixPatSyn [Name]
args

recordPatSyn :: Quote m => [Name] -> m PatSynArgs
recordPatSyn :: forall (m :: * -> *). Quote m => [Name] -> m PatSynArgs
recordPatSyn [Name]
sels = PatSynArgs -> m PatSynArgs
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PatSynArgs -> m PatSynArgs) -> PatSynArgs -> m PatSynArgs
forall a b. (a -> b) -> a -> b
$ [Name] -> PatSynArgs
RecordPatSyn [Name]
sels

infixPatSyn :: Quote m => Name -> Name -> m PatSynArgs
infixPatSyn :: forall (m :: * -> *). Quote m => Name -> Name -> m PatSynArgs
infixPatSyn Name
arg1 Name
arg2 = PatSynArgs -> m PatSynArgs
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PatSynArgs -> m PatSynArgs) -> PatSynArgs -> m PatSynArgs
forall a b. (a -> b) -> a -> b
$ Name -> Name -> PatSynArgs
InfixPatSyn Name
arg1 Name
arg2

--------------------------------------------------------------
-- * Useful helper function

appsE :: Quote m => [m Exp] -> m Exp
appsE :: forall (m :: * -> *). Quote m => [m Exp] -> m Exp
appsE [] = String -> m Exp
forall a. HasCallStack => String -> a
error String
"appsE []"
appsE [m Exp
x] = m Exp
x
appsE (m Exp
x:m Exp
y:[m Exp]
zs) = [m Exp] -> m Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
appsE ( (m Exp -> m Exp -> m Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE m Exp
x m Exp
y) m Exp -> [m Exp] -> [m Exp]
forall a. a -> [a] -> [a]
: [m Exp]
zs )

-- | pure the Module at the place of splicing.  Can be used as an
-- input for 'reifyModule'.
thisModule :: Q Module
thisModule :: Q Module
thisModule = do
  loc <- Q Loc
location
  pure $ Module (mkPkgName $ loc_package loc) (mkModName $ loc_module loc)

--------------------------------------------------------------
-- * Documentation combinators

-- | Attaches Haddock documentation to the declaration provided. Unlike
-- 'putDoc', the names do not need to be in scope when calling this function so
-- it can be used for quoted declarations and anything else currently being
-- spliced.
-- Not all declarations can have documentation attached to them. For those that
-- can't, 'withDecDoc' will return it unchanged without any side effects.
withDecDoc :: String -> Q Dec -> Q Dec
withDecDoc :: String -> Q Dec -> Q Dec
withDecDoc String
doc Q Dec
dec = do
  dec' <- Q Dec
dec
  case doc_loc dec' of
    Just DocLoc
loc -> Q () -> Q ()
forall (m :: * -> *). Quasi m => Q () -> m ()
qAddModFinalizer (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$ DocLoc -> String -> Q ()
forall (m :: * -> *). Quasi m => DocLoc -> String -> m ()
qPutDoc DocLoc
loc String
doc
    Maybe DocLoc
Nothing  -> () -> Q ()
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  pure dec'
  where
    doc_loc :: Dec -> Maybe DocLoc
doc_loc (FunD Name
n [Clause]
_)                                     = DocLoc -> Maybe DocLoc
forall a. a -> Maybe a
Just (DocLoc -> Maybe DocLoc) -> DocLoc -> Maybe DocLoc
forall a b. (a -> b) -> a -> b
$ Name -> DocLoc
DeclDoc Name
n
    doc_loc (ValD (VarP Name
n) Body
_ [Dec]
_)                            = DocLoc -> Maybe DocLoc
forall a. a -> Maybe a
Just (DocLoc -> Maybe DocLoc) -> DocLoc -> Maybe DocLoc
forall a b. (a -> b) -> a -> b
$ Name -> DocLoc
DeclDoc Name
n
    doc_loc (DataD [Type]
_ Name
n [TyVarBndr BndrVis]
_ Maybe Type
_ [Con]
_ [DerivClause]
_)                            = DocLoc -> Maybe DocLoc
forall a. a -> Maybe a
Just (DocLoc -> Maybe DocLoc) -> DocLoc -> Maybe DocLoc
forall a b. (a -> b) -> a -> b
$ Name -> DocLoc
DeclDoc Name
n
    doc_loc (NewtypeD [Type]
_ Name
n [TyVarBndr BndrVis]
_ Maybe Type
_ Con
_ [DerivClause]
_)                         = DocLoc -> Maybe DocLoc
forall a. a -> Maybe a
Just (DocLoc -> Maybe DocLoc) -> DocLoc -> Maybe DocLoc
forall a b. (a -> b) -> a -> b
$ Name -> DocLoc
DeclDoc Name
n
    doc_loc (TypeDataD Name
n [TyVarBndr BndrVis]
_ Maybe Type
_ [Con]
_)                            = DocLoc -> Maybe DocLoc
forall a. a -> Maybe a
Just (DocLoc -> Maybe DocLoc) -> DocLoc -> Maybe DocLoc
forall a b. (a -> b) -> a -> b
$ Name -> DocLoc
DeclDoc Name
n
    doc_loc (TySynD Name
n [TyVarBndr BndrVis]
_ Type
_)                                 = DocLoc -> Maybe DocLoc
forall a. a -> Maybe a
Just (DocLoc -> Maybe DocLoc) -> DocLoc -> Maybe DocLoc
forall a b. (a -> b) -> a -> b
$ Name -> DocLoc
DeclDoc Name
n
    doc_loc (ClassD [Type]
_ Name
n [TyVarBndr BndrVis]
_ [FunDep]
_ [Dec]
_)                             = DocLoc -> Maybe DocLoc
forall a. a -> Maybe a
Just (DocLoc -> Maybe DocLoc) -> DocLoc -> Maybe DocLoc
forall a b. (a -> b) -> a -> b
$ Name -> DocLoc
DeclDoc Name
n
    doc_loc (SigD Name
n Type
_)                                     = DocLoc -> Maybe DocLoc
forall a. a -> Maybe a
Just (DocLoc -> Maybe DocLoc) -> DocLoc -> Maybe DocLoc
forall a b. (a -> b) -> a -> b
$ Name -> DocLoc
DeclDoc Name
n
    doc_loc (ForeignD (ImportF Callconv
_ Safety
_ String
_ Name
n Type
_))                 = DocLoc -> Maybe DocLoc
forall a. a -> Maybe a
Just (DocLoc -> Maybe DocLoc) -> DocLoc -> Maybe DocLoc
forall a b. (a -> b) -> a -> b
$ Name -> DocLoc
DeclDoc Name
n
    doc_loc (ForeignD (ExportF Callconv
_ String
_ Name
n Type
_))                   = DocLoc -> Maybe DocLoc
forall a. a -> Maybe a
Just (DocLoc -> Maybe DocLoc) -> DocLoc -> Maybe DocLoc
forall a b. (a -> b) -> a -> b
$ Name -> DocLoc
DeclDoc Name
n
    doc_loc (InfixD Fixity
_ NamespaceSpecifier
_ Name
n)                                 = DocLoc -> Maybe DocLoc
forall a. a -> Maybe a
Just (DocLoc -> Maybe DocLoc) -> DocLoc -> Maybe DocLoc
forall a b. (a -> b) -> a -> b
$ Name -> DocLoc
DeclDoc Name
n
    doc_loc (DataFamilyD Name
n [TyVarBndr BndrVis]
_ Maybe Type
_)                            = DocLoc -> Maybe DocLoc
forall a. a -> Maybe a
Just (DocLoc -> Maybe DocLoc) -> DocLoc -> Maybe DocLoc
forall a b. (a -> b) -> a -> b
$ Name -> DocLoc
DeclDoc Name
n
    doc_loc (OpenTypeFamilyD (TypeFamilyHead Name
n [TyVarBndr BndrVis]
_ FamilyResultSig
_ Maybe InjectivityAnn
_))     = DocLoc -> Maybe DocLoc
forall a. a -> Maybe a
Just (DocLoc -> Maybe DocLoc) -> DocLoc -> Maybe DocLoc
forall a b. (a -> b) -> a -> b
$ Name -> DocLoc
DeclDoc Name
n
    doc_loc (ClosedTypeFamilyD (TypeFamilyHead Name
n [TyVarBndr BndrVis]
_ FamilyResultSig
_ Maybe InjectivityAnn
_) [TySynEqn]
_) = DocLoc -> Maybe DocLoc
forall a. a -> Maybe a
Just (DocLoc -> Maybe DocLoc) -> DocLoc -> Maybe DocLoc
forall a b. (a -> b) -> a -> b
$ Name -> DocLoc
DeclDoc Name
n
    doc_loc (PatSynD Name
n PatSynArgs
_ PatSynDir
_ Pat
_)                              = DocLoc -> Maybe DocLoc
forall a. a -> Maybe a
Just (DocLoc -> Maybe DocLoc) -> DocLoc -> Maybe DocLoc
forall a b. (a -> b) -> a -> b
$ Name -> DocLoc
DeclDoc Name
n
    doc_loc (PatSynSigD Name
n Type
_)                               = DocLoc -> Maybe DocLoc
forall a. a -> Maybe a
Just (DocLoc -> Maybe DocLoc) -> DocLoc -> Maybe DocLoc
forall a b. (a -> b) -> a -> b
$ Name -> DocLoc
DeclDoc Name
n

    -- For instances we just pass along the full type
    doc_loc (InstanceD Maybe Overlap
_ [Type]
_ Type
t [Dec]
_)           = DocLoc -> Maybe DocLoc
forall a. a -> Maybe a
Just (DocLoc -> Maybe DocLoc) -> DocLoc -> Maybe DocLoc
forall a b. (a -> b) -> a -> b
$ Type -> DocLoc
InstDoc Type
t
    doc_loc (DataInstD [Type]
_ Maybe [TyVarBndr ()]
_ Type
t Maybe Type
_ [Con]
_ [DerivClause]
_)       = DocLoc -> Maybe DocLoc
forall a. a -> Maybe a
Just (DocLoc -> Maybe DocLoc) -> DocLoc -> Maybe DocLoc
forall a b. (a -> b) -> a -> b
$ Type -> DocLoc
InstDoc Type
t
    doc_loc (NewtypeInstD [Type]
_ Maybe [TyVarBndr ()]
_ Type
t Maybe Type
_ Con
_ [DerivClause]
_)    = DocLoc -> Maybe DocLoc
forall a. a -> Maybe a
Just (DocLoc -> Maybe DocLoc) -> DocLoc -> Maybe DocLoc
forall a b. (a -> b) -> a -> b
$ Type -> DocLoc
InstDoc Type
t
    doc_loc (TySynInstD (TySynEqn Maybe [TyVarBndr ()]
_ Type
t Type
_)) = DocLoc -> Maybe DocLoc
forall a. a -> Maybe a
Just (DocLoc -> Maybe DocLoc) -> DocLoc -> Maybe DocLoc
forall a b. (a -> b) -> a -> b
$ Type -> DocLoc
InstDoc Type
t

    -- Declarations that can't have documentation attached to
    -- ValDs that aren't a simple variable pattern
    doc_loc (ValD Pat
_ Body
_ [Dec]
_)             = Maybe DocLoc
forall a. Maybe a
Nothing
    doc_loc (KiSigD Name
_ Type
_)             = Maybe DocLoc
forall a. Maybe a
Nothing
    doc_loc (PragmaD Pragma
_)              = Maybe DocLoc
forall a. Maybe a
Nothing
    doc_loc (RoleAnnotD Name
_ [Role]
_)         = Maybe DocLoc
forall a. Maybe a
Nothing
    doc_loc (StandaloneDerivD Maybe DerivStrategy
_ [Type]
_ Type
_) = Maybe DocLoc
forall a. Maybe a
Nothing
    doc_loc (DefaultSigD Name
_ Type
_)        = Maybe DocLoc
forall a. Maybe a
Nothing
    doc_loc (ImplicitParamBindD String
_ Exp
_) = Maybe DocLoc
forall a. Maybe a
Nothing
    doc_loc (DefaultD [Type]
_)             = Maybe DocLoc
forall a. Maybe a
Nothing

-- | Variant of 'withDecDoc' that applies the same documentation to
-- multiple declarations. Useful for documenting quoted declarations.
withDecsDoc :: String -> Q [Dec] -> Q [Dec]
withDecsDoc :: String -> Q [Dec] -> Q [Dec]
withDecsDoc String
doc Q [Dec]
decs = Q [Dec]
decs Q [Dec] -> ([Dec] -> Q [Dec]) -> Q [Dec]
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Dec -> Q Dec) -> [Dec] -> Q [Dec]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (String -> Q Dec -> Q Dec
withDecDoc String
doc (Q Dec -> Q Dec) -> (Dec -> Q Dec) -> Dec -> Q Dec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dec -> Q Dec
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

-- | Variant of 'funD' that attaches Haddock documentation.
funD_doc :: Name -> [Q Clause]
         -> Maybe String -- ^ Documentation to attach to function
         -> [Maybe String] -- ^ Documentation to attach to arguments
         -> Q Dec
funD_doc :: Name -> [Q Clause] -> Maybe String -> [Maybe String] -> Q Dec
funD_doc Name
nm [Q Clause]
cs Maybe String
mfun_doc [Maybe String]
arg_docs = do
  Q () -> Q ()
forall (m :: * -> *). Quasi m => Q () -> m ()
qAddModFinalizer (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$ [Q ()] -> Q ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
    [DocLoc -> String -> Q ()
putDoc (Name -> Int -> DocLoc
ArgDoc Name
nm Int
i) String
s | (Int
i, Just String
s) <- [Int] -> [Maybe String] -> [(Int, Maybe String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Maybe String]
arg_docs]
  let dec :: Q Dec
dec = Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD Name
nm [Q Clause]
cs
  case Maybe String
mfun_doc of
    Just String
fun_doc -> String -> Q Dec -> Q Dec
withDecDoc String
fun_doc Q Dec
dec
    Maybe String
Nothing -> Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD Name
nm [Q Clause]
cs

-- | Variant of 'dataD' that attaches Haddock documentation.
dataD_doc :: Q Cxt -> Name -> [Q (TyVarBndr BndrVis)] -> Maybe (Q Kind)
          -> [(Q Con, Maybe String, [Maybe String])]
          -- ^ List of constructors, documentation for the constructor, and
          -- documentation for the arguments
          -> [Q DerivClause]
          -> Maybe String
          -- ^ Documentation to attach to the data declaration
          -> Q Dec
dataD_doc :: Q [Type]
-> Name
-> [Q (TyVarBndr BndrVis)]
-> Maybe (Q Type)
-> [(Q Con, Maybe String, [Maybe String])]
-> [Q DerivClause]
-> Maybe String
-> Q Dec
dataD_doc Q [Type]
ctxt Name
tc [Q (TyVarBndr BndrVis)]
tvs Maybe (Q Type)
ksig [(Q Con, Maybe String, [Maybe String])]
cons_with_docs [Q DerivClause]
derivs Maybe String
mdoc = do
  Q () -> Q ()
forall (m :: * -> *). Quasi m => Q () -> m ()
qAddModFinalizer (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$ ((Q Con, Maybe String, [Maybe String]) -> Q ())
-> [(Q Con, Maybe String, [Maybe String])] -> Q ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Q Con, Maybe String, [Maybe String]) -> Q ()
docCons [(Q Con, Maybe String, [Maybe String])]
cons_with_docs
  let dec :: Q Dec
dec = Q [Type]
-> Name
-> [Q (TyVarBndr BndrVis)]
-> Maybe (Q Type)
-> [Q Con]
-> [Q DerivClause]
-> Q Dec
forall (m :: * -> *).
Quote m =>
m [Type]
-> Name
-> [m (TyVarBndr BndrVis)]
-> Maybe (m Type)
-> [m Con]
-> [m DerivClause]
-> m Dec
dataD Q [Type]
ctxt Name
tc [Q (TyVarBndr BndrVis)]
tvs Maybe (Q Type)
ksig (((Q Con, Maybe String, [Maybe String]) -> Q Con)
-> [(Q Con, Maybe String, [Maybe String])] -> [Q Con]
forall a b. (a -> b) -> [a] -> [b]
map (\(Q Con
con, Maybe String
_, [Maybe String]
_) -> Q Con
con) [(Q Con, Maybe String, [Maybe String])]
cons_with_docs) [Q DerivClause]
derivs
  Q Dec -> (String -> Q Dec) -> Maybe String -> Q Dec
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Q Dec
dec ((String -> Q Dec -> Q Dec) -> Q Dec -> String -> Q Dec
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Q Dec -> Q Dec
withDecDoc Q Dec
dec) Maybe String
mdoc

-- | Variant of 'newtypeD' that attaches Haddock documentation.
newtypeD_doc :: Q Cxt -> Name -> [Q (TyVarBndr BndrVis)] -> Maybe (Q Kind)
             -> (Q Con, Maybe String, [Maybe String])
             -- ^ The constructor, documentation for the constructor, and
             -- documentation for the arguments
             -> [Q DerivClause]
             -> Maybe String
             -- ^ Documentation to attach to the newtype declaration
             -> Q Dec
newtypeD_doc :: Q [Type]
-> Name
-> [Q (TyVarBndr BndrVis)]
-> Maybe (Q Type)
-> (Q Con, Maybe String, [Maybe String])
-> [Q DerivClause]
-> Maybe String
-> Q Dec
newtypeD_doc Q [Type]
ctxt Name
tc [Q (TyVarBndr BndrVis)]
tvs Maybe (Q Type)
ksig con_with_docs :: (Q Con, Maybe String, [Maybe String])
con_with_docs@(Q Con
con, Maybe String
_, [Maybe String]
_) [Q DerivClause]
derivs Maybe String
mdoc = do
  Q () -> Q ()
forall (m :: * -> *). Quasi m => Q () -> m ()
qAddModFinalizer (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$ (Q Con, Maybe String, [Maybe String]) -> Q ()
docCons (Q Con, Maybe String, [Maybe String])
con_with_docs
  let dec :: Q Dec
dec = Q [Type]
-> Name
-> [Q (TyVarBndr BndrVis)]
-> Maybe (Q Type)
-> Q Con
-> [Q DerivClause]
-> Q Dec
forall (m :: * -> *).
Quote m =>
m [Type]
-> Name
-> [m (TyVarBndr BndrVis)]
-> Maybe (m Type)
-> m Con
-> [m DerivClause]
-> m Dec
newtypeD Q [Type]
ctxt Name
tc [Q (TyVarBndr BndrVis)]
tvs Maybe (Q Type)
ksig Q Con
con [Q DerivClause]
derivs
  Q Dec -> (String -> Q Dec) -> Maybe String -> Q Dec
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Q Dec
dec ((String -> Q Dec -> Q Dec) -> Q Dec -> String -> Q Dec
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Q Dec -> Q Dec
withDecDoc Q Dec
dec) Maybe String
mdoc

-- | Variant of 'typeDataD' that attaches Haddock documentation.
typeDataD_doc :: Name -> [Q (TyVarBndr BndrVis)] -> Maybe (Q Kind)
          -> [(Q Con, Maybe String, [Maybe String])]
          -- ^ List of constructors, documentation for the constructor, and
          -- documentation for the arguments
          -> Maybe String
          -- ^ Documentation to attach to the data declaration
          -> Q Dec
typeDataD_doc :: Name
-> [Q (TyVarBndr BndrVis)]
-> Maybe (Q Type)
-> [(Q Con, Maybe String, [Maybe String])]
-> Maybe String
-> Q Dec
typeDataD_doc Name
tc [Q (TyVarBndr BndrVis)]
tvs Maybe (Q Type)
ksig [(Q Con, Maybe String, [Maybe String])]
cons_with_docs Maybe String
mdoc = do
  Q () -> Q ()
forall (m :: * -> *). Quasi m => Q () -> m ()
qAddModFinalizer (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$ ((Q Con, Maybe String, [Maybe String]) -> Q ())
-> [(Q Con, Maybe String, [Maybe String])] -> Q ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Q Con, Maybe String, [Maybe String]) -> Q ()
docCons [(Q Con, Maybe String, [Maybe String])]
cons_with_docs
  let dec :: Q Dec
dec = Name
-> [Q (TyVarBndr BndrVis)] -> Maybe (Q Type) -> [Q Con] -> Q Dec
forall (m :: * -> *).
Quote m =>
Name
-> [m (TyVarBndr BndrVis)] -> Maybe (m Type) -> [m Con] -> m Dec
typeDataD Name
tc [Q (TyVarBndr BndrVis)]
tvs Maybe (Q Type)
ksig (((Q Con, Maybe String, [Maybe String]) -> Q Con)
-> [(Q Con, Maybe String, [Maybe String])] -> [Q Con]
forall a b. (a -> b) -> [a] -> [b]
map (\(Q Con
con, Maybe String
_, [Maybe String]
_) -> Q Con
con) [(Q Con, Maybe String, [Maybe String])]
cons_with_docs)
  Q Dec -> (String -> Q Dec) -> Maybe String -> Q Dec
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Q Dec
dec ((String -> Q Dec -> Q Dec) -> Q Dec -> String -> Q Dec
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Q Dec -> Q Dec
withDecDoc Q Dec
dec) Maybe String
mdoc

-- | Variant of 'dataInstD' that attaches Haddock documentation.
dataInstD_doc :: Q Cxt -> (Maybe [Q (TyVarBndr ())]) -> Q Type -> Maybe (Q Kind)
              -> [(Q Con, Maybe String, [Maybe String])]
              -- ^ List of constructors, documentation for the constructor, and
              -- documentation for the arguments
              -> [Q DerivClause]
              -> Maybe String
              -- ^ Documentation to attach to the instance declaration
              -> Q Dec
dataInstD_doc :: Q [Type]
-> Maybe [Q (TyVarBndr ())]
-> Q Type
-> Maybe (Q Type)
-> [(Q Con, Maybe String, [Maybe String])]
-> [Q DerivClause]
-> Maybe String
-> Q Dec
dataInstD_doc Q [Type]
ctxt Maybe [Q (TyVarBndr ())]
mb_bndrs Q Type
ty Maybe (Q Type)
ksig [(Q Con, Maybe String, [Maybe String])]
cons_with_docs [Q DerivClause]
derivs Maybe String
mdoc = do
  Q () -> Q ()
forall (m :: * -> *). Quasi m => Q () -> m ()
qAddModFinalizer (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$ ((Q Con, Maybe String, [Maybe String]) -> Q ())
-> [(Q Con, Maybe String, [Maybe String])] -> Q ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Q Con, Maybe String, [Maybe String]) -> Q ()
docCons [(Q Con, Maybe String, [Maybe String])]
cons_with_docs
  let dec :: Q Dec
dec = Q [Type]
-> Maybe [Q (TyVarBndr ())]
-> Q Type
-> Maybe (Q Type)
-> [Q Con]
-> [Q DerivClause]
-> Q Dec
forall (m :: * -> *).
Quote m =>
m [Type]
-> Maybe [m (TyVarBndr ())]
-> m Type
-> Maybe (m Type)
-> [m Con]
-> [m DerivClause]
-> m Dec
dataInstD Q [Type]
ctxt Maybe [Q (TyVarBndr ())]
mb_bndrs Q Type
ty Maybe (Q Type)
ksig (((Q Con, Maybe String, [Maybe String]) -> Q Con)
-> [(Q Con, Maybe String, [Maybe String])] -> [Q Con]
forall a b. (a -> b) -> [a] -> [b]
map (\(Q Con
con, Maybe String
_, [Maybe String]
_) -> Q Con
con) [(Q Con, Maybe String, [Maybe String])]
cons_with_docs)
              [Q DerivClause]
derivs
  Q Dec -> (String -> Q Dec) -> Maybe String -> Q Dec
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Q Dec
dec ((String -> Q Dec -> Q Dec) -> Q Dec -> String -> Q Dec
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Q Dec -> Q Dec
withDecDoc Q Dec
dec) Maybe String
mdoc

-- | Variant of 'newtypeInstD' that attaches Haddock documentation.
newtypeInstD_doc :: Q Cxt -> (Maybe [Q (TyVarBndr ())]) -> Q Type
                 -> Maybe (Q Kind)
                 -> (Q Con, Maybe String, [Maybe String])
                 -- ^ The constructor, documentation for the constructor, and
                 -- documentation for the arguments
                 -> [Q DerivClause]
                 -> Maybe String
                 -- ^ Documentation to attach to the instance declaration
                 -> Q Dec
newtypeInstD_doc :: Q [Type]
-> Maybe [Q (TyVarBndr ())]
-> Q Type
-> Maybe (Q Type)
-> (Q Con, Maybe String, [Maybe String])
-> [Q DerivClause]
-> Maybe String
-> Q Dec
newtypeInstD_doc Q [Type]
ctxt Maybe [Q (TyVarBndr ())]
mb_bndrs Q Type
ty Maybe (Q Type)
ksig con_with_docs :: (Q Con, Maybe String, [Maybe String])
con_with_docs@(Q Con
con, Maybe String
_, [Maybe String]
_) [Q DerivClause]
derivs Maybe String
mdoc = do
  Q () -> Q ()
forall (m :: * -> *). Quasi m => Q () -> m ()
qAddModFinalizer (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$ (Q Con, Maybe String, [Maybe String]) -> Q ()
docCons (Q Con, Maybe String, [Maybe String])
con_with_docs
  let dec :: Q Dec
dec = Q [Type]
-> Maybe [Q (TyVarBndr ())]
-> Q Type
-> Maybe (Q Type)
-> Q Con
-> [Q DerivClause]
-> Q Dec
forall (m :: * -> *).
Quote m =>
m [Type]
-> Maybe [m (TyVarBndr ())]
-> m Type
-> Maybe (m Type)
-> m Con
-> [m DerivClause]
-> m Dec
newtypeInstD Q [Type]
ctxt Maybe [Q (TyVarBndr ())]
mb_bndrs Q Type
ty Maybe (Q Type)
ksig Q Con
con [Q DerivClause]
derivs
  Q Dec -> (String -> Q Dec) -> Maybe String -> Q Dec
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Q Dec
dec ((String -> Q Dec -> Q Dec) -> Q Dec -> String -> Q Dec
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Q Dec -> Q Dec
withDecDoc Q Dec
dec) Maybe String
mdoc

-- | Variant of 'patSynD' that attaches Haddock documentation.
patSynD_doc :: Name -> Q PatSynArgs -> Q PatSynDir -> Q Pat
            -> Maybe String   -- ^ Documentation to attach to the pattern synonym
            -> [Maybe String] -- ^ Documentation to attach to the pattern arguments
            -> Q Dec
patSynD_doc :: Name
-> Q PatSynArgs
-> Q PatSynDir
-> Q Pat
-> Maybe String
-> [Maybe String]
-> Q Dec
patSynD_doc Name
name Q PatSynArgs
args Q PatSynDir
dir Q Pat
pat Maybe String
mdoc [Maybe String]
arg_docs = do
  Q () -> Q ()
forall (m :: * -> *). Quasi m => Q () -> m ()
qAddModFinalizer (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$ [Q ()] -> Q ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
    [DocLoc -> String -> Q ()
putDoc (Name -> Int -> DocLoc
ArgDoc Name
name Int
i) String
s | (Int
i, Just String
s) <- [Int] -> [Maybe String] -> [(Int, Maybe String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Maybe String]
arg_docs]
  let dec :: Q Dec
dec = Name -> Q PatSynArgs -> Q PatSynDir -> Q Pat -> Q Dec
forall (m :: * -> *).
Quote m =>
Name -> m PatSynArgs -> m PatSynDir -> m Pat -> m Dec
patSynD Name
name Q PatSynArgs
args Q PatSynDir
dir Q Pat
pat
  Q Dec -> (String -> Q Dec) -> Maybe String -> Q Dec
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Q Dec
dec ((String -> Q Dec -> Q Dec) -> Q Dec -> String -> Q Dec
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Q Dec -> Q Dec
withDecDoc Q Dec
dec) Maybe String
mdoc

-- | Document a data/newtype constructor with its arguments.
docCons :: (Q Con, Maybe String, [Maybe String]) -> Q ()
docCons :: (Q Con, Maybe String, [Maybe String]) -> Q ()
docCons (Q Con
c, Maybe String
md, [Maybe String]
arg_docs) = do
  c' <- Q Con
c
  -- Attach docs to the constructors
  sequence_ [ putDoc (DeclDoc nm) d | Just d <- [md], nm <- get_cons_names c' ]
  -- Attach docs to the arguments
  case c' of
    -- Record selector documentation isn't stored in the argument map,
    -- but in the declaration map instead
    RecC Name
_ [VarBangType]
var_bang_types ->
      [Q ()] -> Q ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ DocLoc -> String -> Q ()
putDoc (Name -> DocLoc
DeclDoc Name
nm) String
arg_doc
                  | (Just String
arg_doc, (Name
nm, Strict
_, Type
_)) <- [Maybe String] -> [VarBangType] -> [(Maybe String, VarBangType)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Maybe String]
arg_docs [VarBangType]
var_bang_types
                ]
    Con
_ ->
      [Q ()] -> Q ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ DocLoc -> String -> Q ()
putDoc (Name -> Int -> DocLoc
ArgDoc Name
nm Int
i) String
arg_doc
                    | Name
nm <- Con -> [Name]
get_cons_names Con
c'
                    , (Int
i, Just String
arg_doc) <- [Int] -> [Maybe String] -> [(Int, Maybe String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Maybe String]
arg_docs
                ]