{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE Trustworthy #-}

-- |
-- Language.Haskell.TH.Lib.Internal 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 Language.Haskell.TH.Lib.Internal 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 Language.Haskell.TH.Lib.Internal where

import Language.Haskell.TH.Syntax hiding (Role, InjectivityAnn)
import qualified Language.Haskell.TH.Syntax as 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(..))

----------------------------------------------------------
-- * 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')


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

-------------------------------------------------------------------------------
-- *   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 (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
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
                ]