{-# 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 { [Pat]
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; Pat -> m Pat
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Pat] -> Pat
TupP [Pat]
ps1)}

unboxedTupP :: Quote m => [m Pat] -> m Pat
unboxedTupP :: forall (m :: * -> *). Quote m => [m Pat] -> m Pat
unboxedTupP [m Pat]
ps = do { [Pat]
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; Pat -> m Pat
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Pat] -> Pat
UnboxedTupP [Pat]
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 { Pat
p1 <- m Pat
p; Pat -> m Pat
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pat -> Int -> Int -> Pat
UnboxedSumP Pat
p1 Int
alt Int
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 [Pat]
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
                  [Type]
ts' <- [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]
ts
                  Pat -> m Pat
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> [Type] -> [Pat] -> Pat
ConP Name
n [Type]
ts' [Pat]
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 Pat
p1' <- m Pat
p1
                    Pat
p2' <- m Pat
p2
                    Pat -> m Pat
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pat -> Name -> Pat -> Pat
InfixP Pat
p1' Name
n Pat
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 Pat
p1' <- m Pat
p1
                     Pat
p2' <- m Pat
p2
                     Pat -> m Pat
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pat -> Name -> Pat -> Pat
UInfixP Pat
p1' Name
n Pat
p2')
parensP :: Quote m => m Pat -> m Pat
parensP :: forall (m :: * -> *). Quote m => m Pat -> m Pat
parensP m Pat
p = do Pat
p' <- m Pat
p
               Pat -> m Pat
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pat -> Pat
ParensP Pat
p')

tildeP :: Quote m => m Pat -> m Pat
tildeP :: forall (m :: * -> *). Quote m => m Pat -> m Pat
tildeP m Pat
p = do Pat
p' <- m Pat
p
              Pat -> m Pat
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pat -> Pat
TildeP Pat
p')
bangP :: Quote m => m Pat -> m Pat
bangP :: forall (m :: * -> *). Quote m => m Pat -> m Pat
bangP m Pat
p = do Pat
p' <- m Pat
p
             Pat -> m Pat
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pat -> Pat
BangP Pat
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 Pat
p' <- m Pat
p
             Pat -> m Pat
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Pat -> Pat
AsP Name
n Pat
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 [FieldPat]
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
                Pat -> m Pat
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> [FieldPat] -> Pat
RecP Name
n [FieldPat]
fps')
listP :: Quote m => [m Pat] -> m Pat
listP :: forall (m :: * -> *). Quote m => [m Pat] -> m Pat
listP [m Pat]
ps = do [Pat]
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
              Pat -> m Pat
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Pat] -> Pat
ListP [Pat]
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 Pat
p' <- m Pat
p
              Type
t' <- m Type
t
              Pat -> m Pat
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pat -> Type -> Pat
SigP Pat
p' Type
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 Exp
e' <- m Exp
e
               Pat
p' <- m Pat
p
               Pat -> m Pat
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Pat -> Pat
ViewP Exp
e' Pat
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 Pat
p' <- m Pat
p
                  FieldPat -> m FieldPat
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name
n, Pat
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 { [Dec]
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; Stmt -> m Stmt
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Dec] -> Stmt
LetS [Dec]
ds1) }

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

parS :: Quote m => [[m Stmt]] -> m Stmt
parS :: forall (m :: * -> *). Quote m => [[m Stmt]] -> m Stmt
parS [[m Stmt]]
sss = do { [[Stmt]]
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; Stmt -> m Stmt
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[Stmt]] -> Stmt
ParS [[Stmt]]
sss1) }

recS :: Quote m => [m Stmt] -> m Stmt
recS :: forall (m :: * -> *). Quote m => [m Stmt] -> m Stmt
recS [m Stmt]
ss = do { [Stmt]
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; Stmt -> m Stmt
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Stmt] -> Stmt
RecS [Stmt]
ss1) }

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

fromR :: Quote m => m Exp -> m Range
fromR :: forall (m :: * -> *). Quote m => m Exp -> m Range
fromR m Exp
x = do { Exp
a <- m Exp
x; Range -> m Range
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Range
FromR Exp
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 { Exp
a <- m Exp
x; Exp
b <- m Exp
y; Range -> m Range
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Exp -> Range
FromThenR Exp
a Exp
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 { Exp
a <- m Exp
x; Exp
b <- m Exp
y; Range -> m Range
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Exp -> Range
FromToR Exp
a Exp
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 { Exp
a <- m Exp
x; Exp
b <- m Exp
y; Exp
c <- m Exp
z;
                         Range -> m Range
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Exp -> Exp -> Range
FromThenToR Exp
a Exp
b Exp
c) }
-------------------------------------------------------------------------------
-- *   Body

normalB :: Quote m => m Exp -> m Body
normalB :: forall (m :: * -> *). Quote m => m Exp -> m Body
normalB m Exp
e = do { Exp
e1 <- m Exp
e; Body -> m Body
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Body
NormalB Exp
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 { [(Guard, Exp)]
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; Body -> m Body
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Guard, Exp)] -> Body
GuardedB [(Guard, Exp)]
ges') }

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

normalG :: Quote m => m Exp -> m Guard
normalG :: forall (m :: * -> *). Quote m => m Exp -> m Guard
normalG m Exp
e = do { Exp
e1 <- m Exp
e; Guard -> m Guard
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Guard
NormalG Exp
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 { Exp
g1 <- m Exp
g; Exp
e1 <- m Exp
e; (Guard, Exp) -> m (Guard, Exp)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Guard
NormalG Exp
g1, Exp
e1) }

patG :: Quote m => [m Stmt] -> m Guard
patG :: forall (m :: * -> *). Quote m => [m Stmt] -> m Guard
patG [m Stmt]
ss = do { [Stmt]
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; Guard -> m Guard
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Stmt] -> Guard
PatG [Stmt]
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 { [Stmt]
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;
                  Exp
e'  <- m Exp
e;
                  (Guard, Exp) -> m (Guard, Exp)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Stmt] -> Guard
PatG [Stmt]
ss', Exp
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 { Pat
p' <- m Pat
p;
                      Body
r' <- m Body
rhs;
                      [Dec]
ds' <- [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;
                      Match -> m Match
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pat -> Body -> [Dec] -> Match
Match Pat
p' Body
r' [Dec]
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 { [Pat]
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;
                      Body
r' <- m Body
r;
                      [Dec]
ds' <- [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;
                      Clause -> m Clause
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Pat] -> Body -> [Dec] -> Clause
Clause [Pat]
ps' Body
r' [Dec]
ds') }


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

-- | Dynamically binding a variable (unhygenic)
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 { Exp
a <- m Exp
x; Exp
b <- m Exp
y; Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Exp -> Exp
AppE Exp
a Exp
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 { Exp
a <- m Exp
x; Type
s <- m Type
t; Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Type -> Exp
AppTypeE Exp
a Type
s) }

parensE :: Quote m => m Exp -> m Exp
parensE :: forall (m :: * -> *). Quote m => m Exp -> m Exp
parensE m Exp
x = do { Exp
x' <- m Exp
x; Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Exp
ParensE Exp
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 { Exp
x' <- m Exp
x; Exp
s' <- m Exp
s; Exp
y' <- m Exp
y;
                     Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Exp -> Exp -> Exp
UInfixE Exp
x' Exp
s' Exp
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 { Exp
a <- m Exp
x; Exp
s' <- m Exp
s; Exp
b <- m Exp
y;
                                  Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
a) Exp
s' (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
b))}
infixE Maybe (m Exp)
Nothing  m Exp
s (Just m Exp
y) = do { Exp
s' <- m Exp
s; Exp
b <- m Exp
y;
                                  Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE Maybe Exp
forall a. Maybe a
Nothing Exp
s' (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
b))}
infixE (Just m Exp
x) m Exp
s Maybe (m Exp)
Nothing  = do { Exp
a <- m Exp
x; Exp
s' <- m Exp
s;
                                  Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
a) Exp
s' Maybe Exp
forall a. Maybe a
Nothing)}
infixE Maybe (m Exp)
Nothing  m Exp
s Maybe (m Exp)
Nothing  = do { Exp
s' <- m Exp
s; Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE Maybe Exp
forall a. Maybe a
Nothing Exp
s' Maybe Exp
forall a. Maybe a
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 [Pat]
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
               Exp
e' <- m Exp
e
               Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Pat] -> Exp -> Exp
LamE [Pat]
ps' Exp
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 { [Maybe Exp]
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; Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Maybe Exp] -> Exp
TupE [Maybe Exp]
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 { [Maybe Exp]
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; Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Maybe Exp] -> Exp
UnboxedTupE [Maybe Exp]
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 { Exp
e1 <- m Exp
e; Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Int -> Int -> Exp
UnboxedSumE Exp
e1 Int
alt Int
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 { Exp
a <- m Exp
x; Exp
b <- m Exp
y; Exp
c <- m Exp
z; Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Exp -> Exp -> Exp
CondE Exp
a Exp
b Exp
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 { [Dec]
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; Exp
e2 <- m Exp
e; Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Dec] -> Exp -> Exp
LetE [Dec]
ds2 Exp
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 { Exp
e1 <- m Exp
e; [Match]
ms1 <- [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; Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> [Match] -> Exp
CaseE Exp
e1 [Match]
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 { [Stmt]
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; Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ModName -> [Stmt] -> Exp
DoE Maybe ModName
m [Stmt]
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 { [Stmt]
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; Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ModName -> [Stmt] -> Exp
MDoE Maybe ModName
m [Stmt]
ss1) }

compE :: Quote m => [m Stmt] -> m Exp
compE :: forall (m :: * -> *). Quote m => [m Stmt] -> m Exp
compE [m Stmt]
ss = do { [Stmt]
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; Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Stmt] -> Exp
CompE [Stmt]
ss1) }

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

listE :: Quote m => [m Exp] -> m Exp
listE :: forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE [m Exp]
es = do { [Exp]
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; Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Exp] -> Exp
ListE [Exp]
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 { Exp
e1 <- m Exp
e; Type
t1 <- m Type
t; Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Type -> Exp
SigE Exp
e1 Type
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 { [(Name, Exp)]
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; Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> [(Name, Exp)] -> Exp
RecConE Name
c [(Name, Exp)]
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 { Exp
e1 <- m Exp
e; [(Name, Exp)]
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; Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> [(Name, Exp)] -> Exp
RecUpdE Exp
e1 [(Name, Exp)]
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 { Exp
e' <- m Exp
e; (Name, Exp) -> m (Name, Exp)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name
s,Exp
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
  Exp
e' <- m Exp
e
  Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> String -> Exp
GetFieldE Exp
e' String
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 { Exp
a <- m Exp
x; Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Range -> Exp
ArithSeqE (Exp -> Range
FromR Exp
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 { Exp
a <- m Exp
x; Exp
b <- m Exp
y; Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Range -> Exp
ArithSeqE (Exp -> Exp -> Range
FromThenR Exp
a Exp
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 { Exp
a <- m Exp
x; Exp
b <- m Exp
y; Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Range -> Exp
ArithSeqE (Exp -> Exp -> Range
FromToR Exp
a Exp
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 { Exp
a <- m Exp
x; Exp
b <- m Exp
y; Exp
c <- m Exp
z;
                         Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Range -> Exp
ArithSeqE (Exp -> Exp -> Exp -> Range
FromThenToR Exp
a Exp
b Exp
c)) }


-------------------------------------------------------------------------------
-- *   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 { Pat
p' <- m Pat
p
     ; [Dec]
ds' <- [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
     ; Body
b' <- m Body
b
     ; Dec -> m Dec
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pat -> Body -> [Dec] -> Dec
ValD Pat
p' Body
b' [Dec]
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 { [Clause]
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
    ; Dec -> m Dec
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> [Clause] -> Dec
FunD Name
nm [Clause]
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 { [TyVarBndr BndrVis]
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
     ; Type
rhs1 <- m Type
rhs
     ; Dec -> m Dec
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> [TyVarBndr BndrVis] -> Type -> Dec
TySynD Name
tc [TyVarBndr BndrVis]
tvs1 Type
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
    [Type]
ctxt1   <- m [Type]
ctxt
    [TyVarBndr BndrVis]
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
    Maybe Type
ksig1   <- Maybe (m Type) -> m (Maybe Type)
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 Type)
ksig
    [Con]
cons1   <- [m Con] -> m [Con]
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 Con]
cons
    [DerivClause]
derivs1 <- [m DerivClause] -> m [DerivClause]
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 DerivClause]
derivs
    Dec -> m Dec
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Type]
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Type
-> [Con]
-> [DerivClause]
-> Dec
DataD [Type]
ctxt1 Name
tc [TyVarBndr BndrVis]
tvs1 Maybe Type
ksig1 [Con]
cons1 [DerivClause]
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
    [Type]
ctxt1   <- m [Type]
ctxt
    [TyVarBndr BndrVis]
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
    Maybe Type
ksig1   <- Maybe (m Type) -> m (Maybe Type)
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 Type)
ksig
    Con
con1    <- m Con
con
    [DerivClause]
derivs1 <- [m DerivClause] -> m [DerivClause]
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 DerivClause]
derivs
    Dec -> m Dec
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Type]
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Type
-> Con
-> [DerivClause]
-> Dec
NewtypeD [Type]
ctxt1 Name
tc [TyVarBndr BndrVis]
tvs1 Maybe Type
ksig1 Con
con1 [DerivClause]
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
    [TyVarBndr BndrVis]
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
    Maybe Type
ksig1   <- Maybe (m Type) -> m (Maybe Type)
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 Type)
ksig
    [Con]
cons1   <- [m Con] -> m [Con]
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 Con]
cons
    Dec -> m Dec
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> [TyVarBndr BndrVis] -> Maybe Type -> [Con] -> Dec
TypeDataD Name
tc [TyVarBndr BndrVis]
tvs1 Maybe Type
ksig1 [Con]
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
    [TyVarBndr BndrVis]
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
    [Dec]
decs1 <- [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]
decs
    [Type]
ctxt1 <- m [Type]
ctxt
    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
$ [Type] -> Name -> [TyVarBndr BndrVis] -> [FunDep] -> [Dec] -> Dec
ClassD [Type]
ctxt1 Name
cls [TyVarBndr BndrVis]
tvs1 [FunDep]
fds [Dec]
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
    [Type]
ctxt1 <- m [Type]
ctxt
    [Dec]
decs1 <- [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]
decs
    Type
ty1   <- m Type
ty
    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
$ Maybe Overlap -> [Type] -> Type -> [Dec] -> Dec
InstanceD Maybe Overlap
o [Type]
ctxt1 Type
ty1 [Dec]
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 Type
ty' <- m Type
ty
      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
$ Foreign -> Dec
ForeignD (Callconv -> Safety -> String -> Name -> Type -> Foreign
ImportF Callconv
cc Safety
s String
str Name
n Type
ty')

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

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

infixND :: Quote m => Int -> Name -> m Dec
infixND :: forall (m :: * -> *). Quote m => Int -> Name -> m Dec
infixND Int
prec Name
nm = Dec -> m Dec
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fixity -> Name -> Dec
InfixD (Int -> FixityDirection -> Fixity
Fixity Int
prec FixityDirection
InfixN) 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
      Type
ty1    <- m Type
ty
      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 -> Type -> Maybe Inline -> Phases -> Pragma
SpecialiseP Name
n Type
ty1 Maybe Inline
forall a. Maybe a
Nothing Phases
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
      Type
ty1    <- m Type
ty
      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 -> Type -> Maybe Inline -> Phases -> Pragma
SpecialiseP Name
n Type
ty1 (Inline -> Maybe Inline
forall a. a -> Maybe a
Just Inline
inline) Phases
phases

pragSpecInstD :: Quote m => m Type -> m Dec
pragSpecInstD :: forall (m :: * -> *). Quote m => m Type -> m Dec
pragSpecInstD m Type
ty
  = do
      Type
ty1    <- m Type
ty
      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
$ Type -> Pragma
SpecialiseInstP Type
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
      Maybe [TyVarBndr ()]
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
      [RuleBndr]
tm_bndrs1 <- [m RuleBndr] -> m [RuleBndr]
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 RuleBndr]
tm_bndrs
      Exp
lhs1   <- m Exp
lhs
      Exp
rhs1   <- m Exp
rhs
      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
$ String
-> Maybe [TyVarBndr ()]
-> [RuleBndr]
-> Exp
-> Exp
-> Phases
-> Pragma
RuleP String
n Maybe [TyVarBndr ()]
ty_bndrs1 [RuleBndr]
tm_bndrs1 Exp
lhs1 Exp
rhs1 Phases
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
      Exp
exp1 <- m Exp
expr
      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
$ AnnTarget -> Exp -> Pragma
AnnP AnnTarget
target Exp
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

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
    [Type]
ctxt1   <- m [Type]
ctxt
    Maybe [TyVarBndr ()]
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
    Type
ty1    <- m Type
ty
    Maybe Type
ksig1   <- Maybe (m Type) -> m (Maybe Type)
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 Type)
ksig
    [Con]
cons1   <- [m Con] -> m [Con]
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 Con]
cons
    [DerivClause]
derivs1 <- [m DerivClause] -> m [DerivClause]
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 DerivClause]
derivs
    Dec -> m Dec
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Type]
-> Maybe [TyVarBndr ()]
-> Type
-> Maybe Type
-> [Con]
-> [DerivClause]
-> Dec
DataInstD [Type]
ctxt1 Maybe [TyVarBndr ()]
mb_bndrs1 Type
ty1 Maybe Type
ksig1 [Con]
cons1 [DerivClause]
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
    [Type]
ctxt1   <- m [Type]
ctxt
    Maybe [TyVarBndr ()]
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
    Type
ty1    <- m Type
ty
    Maybe Type
ksig1   <- Maybe (m Type) -> m (Maybe Type)
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 Type)
ksig
    Con
con1    <- m Con
con
    [DerivClause]
derivs1 <- [m DerivClause] -> m [DerivClause]
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 DerivClause]
derivs
    Dec -> m Dec
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Type]
-> Maybe [TyVarBndr ()]
-> Type
-> Maybe Type
-> Con
-> [DerivClause]
-> Dec
NewtypeInstD [Type]
ctxt1 Maybe [TyVarBndr ()]
mb_bndrs1 Type
ty1 Maybe Type
ksig1 Con
con1 [DerivClause]
derivs1)

tySynInstD :: Quote m => m TySynEqn -> m Dec
tySynInstD :: forall (m :: * -> *). Quote m => m TySynEqn -> m Dec
tySynInstD m TySynEqn
eqn =
  do
    TySynEqn
eqn1 <- m TySynEqn
eqn
    Dec -> m Dec
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TySynEqn -> Dec
TySynInstD TySynEqn
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 [TyVarBndr BndrVis]
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
     Maybe Type
kind' <- Maybe (m Type) -> m (Maybe Type)
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 Type)
kind
     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 -> [TyVarBndr BndrVis] -> Maybe Type -> Dec
DataFamilyD Name
tc [TyVarBndr BndrVis]
tvs' Maybe Type
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 [TyVarBndr BndrVis]
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
     FamilyResultSig
res' <- m FamilyResultSig
res
     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
$ TypeFamilyHead -> Dec
OpenTypeFamilyD (Name
-> [TyVarBndr BndrVis]
-> FamilyResultSig
-> Maybe InjectivityAnn
-> TypeFamilyHead
TypeFamilyHead Name
tc [TyVarBndr BndrVis]
tvs' FamilyResultSig
res' Maybe InjectivityAnn
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 [TyVarBndr BndrVis]
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
     FamilyResultSig
result1 <- m FamilyResultSig
result
     [TySynEqn]
eqns1   <- [m TySynEqn] -> m [TySynEqn]
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 TySynEqn]
eqns
     Dec -> m Dec
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeFamilyHead -> [TySynEqn] -> Dec
ClosedTypeFamilyD (Name
-> [TyVarBndr BndrVis]
-> FamilyResultSig
-> Maybe InjectivityAnn
-> TypeFamilyHead
TypeFamilyHead Name
tc [TyVarBndr BndrVis]
tvs1 FamilyResultSig
result1 Maybe InjectivityAnn
injectivity) [TySynEqn]
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
    Maybe DerivStrategy
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
    [Type]
ctxt <- m [Type]
ctxtq
    Type
ty   <- m Type
tyq
    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
$ Maybe DerivStrategy -> [Type] -> Type -> Dec
StandaloneDerivD Maybe DerivStrategy
mds [Type]
ctxt Type
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
    Type
ty <- m Type
tyq
    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 -> Type -> Dec
DefaultSigD Name
n Type
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
  PatSynArgs
args'    <- m PatSynArgs
args
  PatSynDir
dir'     <- m PatSynDir
dir
  Pat
pat'     <- m Pat
pat
  Dec -> m Dec
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> PatSynArgs -> PatSynDir -> Pat -> Dec
PatSynD Name
name PatSynArgs
args' PatSynDir
dir' Pat
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 Type
ty' <- m Type
ty
     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 -> Type -> Dec
PatSynSigD Name
nm Type
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
    Exp
e' <- m Exp
e
    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
$ String -> Exp -> Dec
ImplicitParamBindD String
n Exp
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
    Maybe [TyVarBndr ()]
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
    Type
lhs1 <- m Type
lhs
    Type
rhs1 <- m Type
rhs
    TySynEqn -> m TySynEqn
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [TyVarBndr ()] -> Type -> Type -> TySynEqn
TySynEqn Maybe [TyVarBndr ()]
mb_bndrs1 Type
lhs1 Type
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 Maybe DerivStrategy
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
                       [Type]
p'   <- [m Type] -> m [Type]
forall (m :: * -> *). Quote m => [m Type] -> m [Type]
cxt [m Type]
p
                       DerivClause -> m DerivClause
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DerivClause -> m DerivClause) -> DerivClause -> m DerivClause
forall a b. (a -> b) -> a -> b
$ Maybe DerivStrategy -> [Type] -> DerivClause
DerivClause Maybe DerivStrategy
mds' [Type]
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 BangType
st1' <- m BangType
st1
                        BangType
st2' <- m BangType
st2
                        Con -> m Con
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Con -> m Con) -> Con -> m Con
forall a b. (a -> b) -> a -> b
$ BangType -> Name -> BangType -> Con
InfixC BangType
st1' Name
con BangType
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
  [TyVarBndr Specificity]
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
  [Type]
ctxt' <- m [Type]
ctxt
  Con
con'  <- m Con
con
  Con -> m Con
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Con -> m Con) -> Con -> m Con
forall a b. (a -> b) -> a -> b
$ [TyVarBndr Specificity] -> [Type] -> Con -> Con
ForallC [TyVarBndr Specificity]
ns' [Type]
ctxt' Con
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
    [TyVarBndr Specificity]
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
    [Type]
ctxt1  <- m [Type]
ctxt
    Type
ty1    <- m Type
ty
    Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> m Type) -> Type -> m Type
forall a b. (a -> b) -> a -> b
$ [TyVarBndr Specificity] -> [Type] -> Type -> Type
ForallT [TyVarBndr Specificity]
tvars1 [Type]
ctxt1 Type
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 Type
t1' <- m Type
t1
                    Type
t2' <- m Type
t2
                    Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Name -> Type -> Type
InfixT Type
t1' Name
n Type
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 Type
t1' <- m Type
t1
                     Type
t2' <- m Type
t2
                     Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Name -> Type -> Type
UInfixT Type
t1' Name
n Type
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 Type
t1' <- m Type
t1
                            Type
t2' <- m Type
t2
                            Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Name -> Type -> Type
PromotedInfixT Type
t1' Name
n Type
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 Type
t1' <- m Type
t1
                             Type
t2' <- m Type
t2
                             Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Name -> Type -> Type
PromotedUInfixT Type
t1' Name
n Type
t2')

parensT :: Quote m => m Type -> m Type
parensT :: forall (m :: * -> *). Quote m => m Type -> m Type
parensT m Type
t = do Type
t' <- m Type
t
               Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Type
ParensT Type
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
           Type
t1' <- m Type
t1
           Type
t2' <- m Type
t2
           Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> m Type) -> Type -> m Type
forall a b. (a -> b) -> a -> b
$ Type -> Type -> Type
AppT Type
t1' Type
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
               Type
ty' <- m Type
ty
               Type
ki' <- m Type
ki
               Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> m Type) -> Type -> m Type
forall a b. (a -> b) -> a -> b
$ Type -> Type -> Type
AppKindT Type
ty' Type
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
      Type
t' <- m Type
t
      Type
k' <- m Type
k
      Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> m Type) -> Type -> m Type
forall a b. (a -> b) -> a -> b
$ Type -> Type -> Type
SigT Type
t' Type
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
      Type
t' <- m Type
t
      Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> m Type) -> Type -> m Type
forall a b. (a -> b) -> a -> b
$ String -> Type -> Type
ImplicitParamT String
n Type
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
      [Type]
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
      Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Type -> Type -> Type) -> Type -> [Type] -> Type
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
AppT (Name -> Type
ConT Name
cla) [Type]
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
      Type
tleft1  <- m Type
tleft
      Type
tright1 <- m Type
tright
      Type
eqT <- m Type
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 -> Type -> Type) -> Type -> [Type] -> Type
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
AppT Type
eqT [Type
tleft1, Type
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 SourceUnpackedness
u' <- m SourceUnpackedness
u
              SourceStrictness
s' <- m SourceStrictness
s
              Strict -> m Strict
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourceUnpackedness -> SourceStrictness -> Strict
Bang SourceUnpackedness
u' SourceStrictness
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
  [Clause]
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
  PatSynDir -> m PatSynDir
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Clause] -> PatSynDir
ExplBidir [Clause]
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
loc <- Q Loc
location
  Module -> Q Module
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Module -> Q Module) -> Module -> Q Module
forall a b. (a -> b) -> a -> b
$ PkgName -> ModName -> Module
Module (String -> PkgName
mkPkgName (String -> PkgName) -> String -> PkgName
forall a b. (a -> b) -> a -> b
$ Loc -> String
loc_package Loc
loc) (String -> ModName
mkModName (String -> ModName) -> String -> ModName
forall a b. (a -> b) -> a -> b
$ Loc -> String
loc_module Loc
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
dec' <- Q Dec
dec
  case Dec -> Maybe DocLoc
doc_loc Dec
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 ()
  Dec -> Q Dec
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Dec
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
_ 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
  Con
c' <- Q Con
c
  -- Attach docs to the constructors
  [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
d | Just String
d <- [Maybe String
md], Name
nm <- Con -> [Name]
get_cons_names Con
c' ]
  -- Attach docs to the arguments
  case Con
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
                ]