{-# OPTIONS_HADDOCK not-home #-} -- we want users to import Language.Haskell.TH.Syntax instead
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs#-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE UnboxedSums #-}

-- | This module is used internally in GHC's integration with Template Haskell
-- and defines the Monads of Template Haskell, and associated definitions.
--
-- This is not a part of the public API, and as such, there are no API
-- guarantees for this module from version to version.
--
-- Import "Language.Haskell.TH" or "Language.Haskell.TH.Syntax" instead!
module GHC.Internal.TH.Monad
    ( module GHC.Internal.TH.Monad
    ) where

#ifdef BOOTSTRAP_TH
import Prelude
import Data.Data hiding (Fixity(..))
import Data.IORef
import System.IO.Unsafe ( unsafePerformIO )
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Fix (MonadFix (..))
import Control.Exception (BlockedIndefinitelyOnMVar (..), catch, throwIO)
import Control.Exception.Base (FixIOException (..))
import Control.Concurrent.MVar (newEmptyMVar, readMVar, putMVar)
import System.IO        ( hPutStrLn, stderr )
import qualified Data.Kind as Kind (Type)
import GHC.IO.Unsafe    ( unsafeDupableInterleaveIO )
import GHC.Types        (TYPE, RuntimeRep(..))
#else
import GHC.Internal.Base hiding (NonEmpty(..),Type, Module, sequence)
import GHC.Internal.Data.Data hiding (Fixity(..))
import GHC.Internal.Data.Traversable
import GHC.Internal.IORef
import GHC.Internal.System.IO
import GHC.Internal.Data.Foldable
import GHC.Internal.Data.Typeable
import GHC.Internal.Control.Monad.IO.Class
import GHC.Internal.Control.Monad.Fail
import GHC.Internal.Control.Monad.Fix
import GHC.Internal.Control.Exception
import GHC.Internal.Num
import GHC.Internal.IO.Unsafe
import GHC.Internal.MVar
import GHC.Internal.IO.Exception
import qualified GHC.Internal.Types as Kind (Type)
#endif
import GHC.Internal.ForeignSrcLang
import GHC.Internal.LanguageExtensions
import GHC.Internal.TH.Syntax

-----------------------------------------------------
--
--              The Quasi class
--
-----------------------------------------------------

class (MonadIO m, MonadFail m) => Quasi m where
  -- | Fresh names. See 'newName'.
  qNewName :: String -> m Name

  ------- Error reporting and recovery -------
  -- | Report an error (True) or warning (False)
  -- ...but carry on; use 'fail' to stop. See 'report'.
  qReport  :: Bool -> String -> m ()

  -- | See 'recover'.
  qRecover :: m a -- ^ the error handler
           -> m a -- ^ action which may fail
           -> m a -- ^ Recover from the monadic 'fail'

  ------- Inspect the type-checker's environment -------
  -- | True <=> type namespace, False <=> value namespace. See 'lookupName'.
  qLookupName :: Bool -> String -> m (Maybe Name)
  -- | See 'reify'.
  qReify          :: Name -> m Info
  -- | See 'reifyFixity'.
  qReifyFixity    :: Name -> m (Maybe Fixity)
  -- | See 'reifyType'.
  qReifyType      :: Name -> m Type
  -- | Is (n tys) an instance? Returns list of matching instance Decs (with
  -- empty sub-Decs) Works for classes and type functions. See 'reifyInstances'.
  qReifyInstances :: Name -> [Type] -> m [Dec]
  -- | See 'reifyRoles'.
  qReifyRoles         :: Name -> m [Role]
  -- | See 'reifyAnnotations'.
  qReifyAnnotations   :: Data a => AnnLookup -> m [a]
  -- | See 'reifyModule'.
  qReifyModule        :: Module -> m ModuleInfo
  -- | See 'reifyConStrictness'.
  qReifyConStrictness :: Name -> m [DecidedStrictness]

  -- | See 'location'.
  qLocation :: m Loc

  -- | Input/output (dangerous). See 'runIO'.
  qRunIO :: IO a -> m a
  qRunIO = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
  -- | See 'getPackageRoot'.
  qGetPackageRoot :: m FilePath

  -- | See 'addDependentFile'.
  qAddDependentFile :: FilePath -> m ()

  -- | See 'addDependentDirectory'.
  qAddDependentDirectory :: FilePath -> m ()

  -- | See 'addTempFile'.
  qAddTempFile :: String -> m FilePath

  -- | See 'addTopDecls'.
  qAddTopDecls :: [Dec] -> m ()

  -- | See 'addForeignFilePath'.
  qAddForeignFilePath :: ForeignSrcLang -> String -> m ()

  -- | See 'addModFinalizer'.
  qAddModFinalizer :: Q () -> m ()

  -- | See 'addCorePlugin'.
  qAddCorePlugin :: String -> m ()

  -- | See 'getQ'.
  qGetQ :: Typeable a => m (Maybe a)

  -- | See 'putQ'.
  qPutQ :: Typeable a => a -> m ()

  -- | See 'isExtEnabled'.
  qIsExtEnabled :: Extension -> m Bool
  -- | See 'extsEnabled'.
  qExtsEnabled :: m [Extension]

  -- | See 'putDoc'.
  qPutDoc :: DocLoc -> String -> m ()
  -- | See 'getDoc'.
  qGetDoc :: DocLoc -> m (Maybe String)

-----------------------------------------------------
--      The IO instance of Quasi
-----------------------------------------------------

--  | This instance is used only when running a Q
--  computation in the IO monad, usually just to
--  print the result.  There is no interesting
--  type environment, so reification isn't going to
--  work.
instance Quasi IO where
  qNewName :: FilePath -> IO Name
qNewName = FilePath -> IO Name
newNameIO

  qReport :: Bool -> FilePath -> IO ()
qReport Bool
True  FilePath
msg = Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath
"Template Haskell error: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
msg)
  qReport Bool
False FilePath
msg = Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath
"Template Haskell error: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
msg)

  qLookupName :: Bool -> FilePath -> IO (Maybe Name)
qLookupName Bool
_ FilePath
_       = FilePath -> IO (Maybe Name)
forall a. FilePath -> IO a
badIO FilePath
"lookupName"
  qReify :: Name -> IO Info
qReify Name
_              = FilePath -> IO Info
forall a. FilePath -> IO a
badIO FilePath
"reify"
  qReifyFixity :: Name -> IO (Maybe Fixity)
qReifyFixity Name
_        = FilePath -> IO (Maybe Fixity)
forall a. FilePath -> IO a
badIO FilePath
"reifyFixity"
  qReifyType :: Name -> IO Type
qReifyType Name
_          = FilePath -> IO Type
forall a. FilePath -> IO a
badIO FilePath
"reifyFixity"
  qReifyInstances :: Name -> [Type] -> IO [Dec]
qReifyInstances Name
_ [Type]
_   = FilePath -> IO [Dec]
forall a. FilePath -> IO a
badIO FilePath
"reifyInstances"
  qReifyRoles :: Name -> IO [Role]
qReifyRoles Name
_         = FilePath -> IO [Role]
forall a. FilePath -> IO a
badIO FilePath
"reifyRoles"
  qReifyAnnotations :: forall a. Data a => AnnLookup -> IO [a]
qReifyAnnotations AnnLookup
_   = FilePath -> IO [a]
forall a. FilePath -> IO a
badIO FilePath
"reifyAnnotations"
  qReifyModule :: Module -> IO ModuleInfo
qReifyModule Module
_        = FilePath -> IO ModuleInfo
forall a. FilePath -> IO a
badIO FilePath
"reifyModule"
  qReifyConStrictness :: Name -> IO [DecidedStrictness]
qReifyConStrictness Name
_ = FilePath -> IO [DecidedStrictness]
forall a. FilePath -> IO a
badIO FilePath
"reifyConStrictness"
  qLocation :: IO Loc
qLocation             = FilePath -> IO Loc
forall a. FilePath -> IO a
badIO FilePath
"currentLocation"
  qRecover :: forall a. IO a -> IO a -> IO a
qRecover IO a
_ IO a
_          = FilePath -> IO a
forall a. FilePath -> IO a
badIO FilePath
"recover" -- Maybe we could fix this?
  qGetPackageRoot :: IO FilePath
qGetPackageRoot       = FilePath -> IO FilePath
forall a. FilePath -> IO a
badIO FilePath
"getProjectRoot"
  qAddDependentFile :: FilePath -> IO ()
qAddDependentFile FilePath
_   = FilePath -> IO ()
forall a. FilePath -> IO a
badIO FilePath
"addDependentFile"
  qAddTempFile :: FilePath -> IO FilePath
qAddTempFile FilePath
_        = FilePath -> IO FilePath
forall a. FilePath -> IO a
badIO FilePath
"addTempFile"
  qAddTopDecls :: [Dec] -> IO ()
qAddTopDecls [Dec]
_        = FilePath -> IO ()
forall a. FilePath -> IO a
badIO FilePath
"addTopDecls"
  qAddForeignFilePath :: ForeignSrcLang -> FilePath -> IO ()
qAddForeignFilePath ForeignSrcLang
_ FilePath
_ = FilePath -> IO ()
forall a. FilePath -> IO a
badIO FilePath
"addForeignFilePath"
  qAddModFinalizer :: Q () -> IO ()
qAddModFinalizer Q ()
_    = FilePath -> IO ()
forall a. FilePath -> IO a
badIO FilePath
"addModFinalizer"
  qAddCorePlugin :: FilePath -> IO ()
qAddCorePlugin FilePath
_      = FilePath -> IO ()
forall a. FilePath -> IO a
badIO FilePath
"addCorePlugin"
  qGetQ :: forall a. Typeable a => IO (Maybe a)
qGetQ                 = FilePath -> IO (Maybe a)
forall a. FilePath -> IO a
badIO FilePath
"getQ"
  qPutQ :: forall a. Typeable a => a -> IO ()
qPutQ a
_               = FilePath -> IO ()
forall a. FilePath -> IO a
badIO FilePath
"putQ"
  qIsExtEnabled :: Extension -> IO Bool
qIsExtEnabled Extension
_       = FilePath -> IO Bool
forall a. FilePath -> IO a
badIO FilePath
"isExtEnabled"
  qExtsEnabled :: IO [Extension]
qExtsEnabled          = FilePath -> IO [Extension]
forall a. FilePath -> IO a
badIO FilePath
"extsEnabled"
  qPutDoc :: DocLoc -> FilePath -> IO ()
qPutDoc DocLoc
_ FilePath
_           = FilePath -> IO ()
forall a. FilePath -> IO a
badIO FilePath
"putDoc"
  qGetDoc :: DocLoc -> IO (Maybe FilePath)
qGetDoc DocLoc
_             = FilePath -> IO (Maybe FilePath)
forall a. FilePath -> IO a
badIO FilePath
"getDoc"
  qAddDependentDirectory :: FilePath -> IO ()
qAddDependentDirectory FilePath
_ = FilePath -> IO ()
forall a. FilePath -> IO a
badIO FilePath
"AddDependentDirectory"

instance Quote IO where
  newName :: FilePath -> IO Name
newName = FilePath -> IO Name
newNameIO

newNameIO :: String -> IO Name
newNameIO :: FilePath -> IO Name
newNameIO FilePath
s = do { n <- IORef Integer -> (Integer -> (Integer, Integer)) -> IO Integer
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef Integer
counter (\Integer
x -> (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1, Integer
x))
                 ; pure (mkNameU s n) }

badIO :: String -> IO a
badIO :: forall a. FilePath -> IO a
badIO FilePath
op = do   { Bool -> FilePath -> IO ()
forall (m :: * -> *). Quasi m => Bool -> FilePath -> m ()
qReport Bool
True (FilePath
"Can't do `" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
op FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' in the IO monad")
                ; FilePath -> IO a
forall a. HasCallStack => FilePath -> IO a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
FilePath -> m a
fail FilePath
"Template Haskell failure" }

-- Global variable to generate unique symbols
counter :: IORef Uniq
{-# NOINLINE counter #-}
counter :: IORef Integer
counter = IO (IORef Integer) -> IORef Integer
forall a. IO a -> a
unsafePerformIO (Integer -> IO (IORef Integer)
forall a. a -> IO (IORef a)
newIORef Integer
0)


-----------------------------------------------------
--
--              The Q monad
--
-----------------------------------------------------

-- | In short, 'Q' provides the 'Quasi' operations in one neat monad for the
-- user.
--
-- The longer story, is that 'Q' wraps an arbitrary 'Quasi'-able monad.
-- The perceptive reader notices that 'Quasi' has only two instances, 'Q'
-- itself and 'IO', neither of which have concrete implementations.'Q' plays
-- the trick of [dependency
-- inversion](https://en.wikipedia.org/wiki/Dependency_inversion_principle),
-- providing an abstract interface for the user which is later concretely
-- fufilled by an concrete 'Quasi' instance, internal to GHC.
newtype Q a = Q { forall a. Q a -> forall (m :: * -> *). Quasi m => m a
unQ :: forall m. Quasi m => m a }

-- | \"Runs\" the 'Q' monad. Normal users of Template Haskell
-- should not need this function, as the splice brackets @$( ... )@
-- are the usual way of running a 'Q' computation.
--
-- This function is primarily used in GHC internals, and for debugging
-- splices by running them in 'IO'.
--
-- Note that many functions in 'Q', such as 'reify' and other compiler
-- queries, are not supported when running 'Q' in 'IO'; these operations
-- simply fail at runtime. Indeed, the only operations guaranteed to succeed
-- are 'newName', 'runIO', 'reportError' and 'reportWarning'.
runQ :: Quasi m => Q a -> m a
runQ :: forall (m :: * -> *) a. Quasi m => Q a -> m a
runQ (Q forall (m :: * -> *). Quasi m => m a
m) = m a
forall (m :: * -> *). Quasi m => m a
m

instance Monad Q where
  Q forall (m :: * -> *). Quasi m => m a
m >>= :: forall a b. Q a -> (a -> Q b) -> Q b
>>= a -> Q b
k  = (forall (m :: * -> *). Quasi m => m b) -> Q b
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (m a
forall (m :: * -> *). Quasi m => m a
m m a -> (a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> Q b -> forall (m :: * -> *). Quasi m => m b
forall a. Q a -> forall (m :: * -> *). Quasi m => m a
unQ (a -> Q b
k a
x))
  >> :: forall a b. Q a -> Q b -> Q b
(>>) = Q a -> Q b -> Q b
forall a b. Q a -> Q b -> Q b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)

instance MonadFail Q where
  fail :: forall a. HasCallStack => FilePath -> Q a
fail FilePath
s     = Bool -> FilePath -> Q ()
report Bool
True FilePath
s Q () -> Q a -> Q a
forall a b. Q a -> Q b -> Q b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (forall (m :: * -> *). Quasi m => m a) -> Q a
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (FilePath -> m a
forall a. HasCallStack => FilePath -> m a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
FilePath -> m a
fail FilePath
"Q monad failure")

instance Functor Q where
  fmap :: forall a b. (a -> b) -> Q a -> Q b
fmap a -> b
f (Q forall (m :: * -> *). Quasi m => m a
x) = (forall (m :: * -> *). Quasi m => m b) -> Q b
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q ((a -> b) -> m a -> m b
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f m a
forall (m :: * -> *). Quasi m => m a
x)

instance Applicative Q where
  pure :: forall a. a -> Q a
pure a
x = (forall (m :: * -> *). Quasi m => m a) -> Q a
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
  Q forall (m :: * -> *). Quasi m => m (a -> b)
f <*> :: forall a b. Q (a -> b) -> Q a -> Q b
<*> Q forall (m :: * -> *). Quasi m => m a
x = (forall (m :: * -> *). Quasi m => m b) -> Q b
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (m (a -> b)
forall (m :: * -> *). Quasi m => m (a -> b)
f m (a -> b) -> m a -> m b
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m a
forall (m :: * -> *). Quasi m => m a
x)
  Q forall (m :: * -> *). Quasi m => m a
m *> :: forall a b. Q a -> Q b -> Q b
*> Q forall (m :: * -> *). Quasi m => m b
n = (forall (m :: * -> *). Quasi m => m b) -> Q b
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (m a
forall (m :: * -> *). Quasi m => m a
m m a -> m b -> m b
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m b
forall (m :: * -> *). Quasi m => m b
n)

-- | @since 2.17.0.0
instance Semigroup a => Semigroup (Q a) where
  <> :: Q a -> Q a -> Q a
(<>) = (a -> a -> a) -> Q a -> Q a -> Q a
forall a b c. (a -> b -> c) -> Q a -> Q b -> Q c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)

-- | @since 2.17.0.0
instance Monoid a => Monoid (Q a) where
  mempty :: Q a
mempty = a -> Q a
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty

-- | If the function passed to 'mfix' inspects its argument,
-- the resulting action will throw a 'FixIOException'.
--
-- @since 2.17.0.0
instance MonadFix Q where
  -- We use the same blackholing approach as in fixIO.
  -- See Note [Blackholing in fixIO] in System.IO in base.
  mfix :: forall a. (a -> Q a) -> Q a
mfix a -> Q a
k = do
    m <- IO (MVar a) -> Q (MVar a)
forall a. IO a -> Q a
runIO IO (MVar a)
forall a. IO (MVar a)
newEmptyMVar
    ans <- runIO (unsafeDupableInterleaveIO
             (readMVar m `catch` \BlockedIndefinitelyOnMVar
BlockedIndefinitelyOnMVar ->
                                    FixIOException -> IO a
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO FixIOException
FixIOException))
    result <- k ans
    runIO (putMVar m result)
    return result


-----------------------------------------------------
--
--              The Quote class
--
-----------------------------------------------------



-- | The 'Quote' class implements the minimal interface which is necessary for
-- desugaring quotations.
--
-- * The @Monad m@ superclass is needed to stitch together the different
-- AST fragments.
-- * 'newName' is used when desugaring binding structures such as lambdas
-- to generate fresh names.
--
-- Therefore the type of an untyped quotation in GHC is `Quote m => m Exp`
--
-- For many years the type of a quotation was fixed to be `Q Exp` but by
-- more precisely specifying the minimal interface it enables the `Exp` to
-- be extracted purely from the quotation without interacting with `Q`.
class Monad m => Quote m where
  {- |
  Generate a fresh name, which cannot be captured.

  For example, this:

  @f = $(do
    nm1 <- newName \"x\"
    let nm2 = 'mkName' \"x\"
    return ('LamE' ['VarP' nm1] (LamE [VarP nm2] ('VarE' nm1)))
   )@

  will produce the splice

  >f = \x0 -> \x -> x0

  In particular, the occurrence @VarE nm1@ refers to the binding @VarP nm1@,
  and is not captured by the binding @VarP nm2@.

  Although names generated by @newName@ cannot /be captured/, they can
  /capture/ other names. For example, this:

  >g = $(do
  >  nm1 <- newName "x"
  >  let nm2 = mkName "x"
  >  return (LamE [VarP nm2] (LamE [VarP nm1] (VarE nm2)))
  > )

  will produce the splice

  >g = \x -> \x0 -> x0

  since the occurrence @VarE nm2@ is captured by the innermost binding
  of @x@, namely @VarP nm1@.
  -}
  newName :: String -> m Name

instance Quote Q where
  newName :: FilePath -> Q Name
newName FilePath
s = (forall (m :: * -> *). Quasi m => m Name) -> Q Name
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (FilePath -> m Name
forall (m :: * -> *). Quasi m => FilePath -> m Name
qNewName FilePath
s)

-----------------------------------------------------
--
--              The TExp type
--
-----------------------------------------------------

type TExp :: TYPE r -> Kind.Type
type role TExp nominal   -- See Note [Role of TExp]
newtype TExp a = TExp
  { forall a. TExp a -> Exp
unType :: Exp -- ^ Underlying untyped Template Haskell expression
  }
-- ^ Typed wrapper around an 'Exp'.
--
-- This is the typed representation of terms produced by typed quotes.
--
-- Representation-polymorphic since /template-haskell-2.16.0.0/.

-- | Discard the type annotation and produce a plain Template Haskell
-- expression
--
-- Representation-polymorphic since /template-haskell-2.16.0.0/.
unTypeQ :: forall (r :: RuntimeRep) (a :: TYPE r) m . Quote m => m (TExp a) -> m Exp
unTypeQ :: forall a (m :: * -> *). Quote m => m (TExp a) -> m Exp
unTypeQ m (TExp a)
m = do { TExp e <- m (TExp a)
m
               ; return e }

-- | Annotate the Template Haskell expression with a type
--
-- This is unsafe because GHC cannot check for you that the expression
-- really does have the type you claim it has.
--
-- Representation-polymorphic since /template-haskell-2.16.0.0/.
unsafeTExpCoerce :: forall (r :: RuntimeRep) (a :: TYPE r) m .
                      Quote m => m Exp -> m (TExp a)
unsafeTExpCoerce :: forall a (m :: * -> *). Quote m => m Exp -> m (TExp a)
unsafeTExpCoerce m Exp
m = do { e <- m Exp
m
                        ; return (TExp e) }

{- Note [Role of TExp]
~~~~~~~~~~~~~~~~~~~~~~
TExp's argument must have a nominal role, not phantom as would
be inferred (#8459).  Consider

  e :: Code Q Age
  e = [|| MkAge 3 ||]

  foo = $(coerce e) + 4::Int

The splice will evaluate to (MkAge 3) and you can't add that to
4::Int. So you can't coerce a (Code Q Age) to a (Code Q Int). -}

-- Code constructor
#if __GLASGOW_HASKELL__ >= 909
type Code :: (Kind.Type -> Kind.Type) -> forall r. TYPE r -> Kind.Type
  -- See Note [Foralls to the right in Code]
#else
type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type
#endif
type role Code representational nominal   -- See Note [Role of TExp]
newtype Code m a = Code
  { forall (m :: * -> *) a. Code m a -> m (TExp a)
examineCode :: m (TExp a) -- ^ Underlying monadic value
  }
-- ^ Represents an expression which has type @a@, built in monadic context @m@. Built on top of 'TExp', typed
-- expressions allow for type-safe splicing via:
--
--   - typed quotes, written as @[|| ... ||]@ where @...@ is an expression; if
--     that expression has type @a@, then the quotation has type
--     @Quote m => Code m a@
--
--   - typed splices inside of typed quotes, written as @$$(...)@ where @...@
--     is an arbitrary expression of type @Quote m => Code m a@
--
-- Traditional expression quotes and splices let us construct ill-typed
-- expressions:
--
-- >>> fmap ppr $ runQ (unTypeCode [| True == $( [| "foo" |] ) |])
-- GHC.Internal.Types.True GHC.Internal.Classes.== "foo"
-- >>> GHC.Internal.Types.True GHC.Internal.Classes.== "foo"
-- <interactive> error:
--     • Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
--     • In the second argument of ‘(==)’, namely ‘"foo"’
--       In the expression: True == "foo"
--       In an equation for ‘it’: it = True == "foo"
--
-- With typed expressions, the type error occurs when /constructing/ the
-- Template Haskell expression:
--
-- >>> fmap ppr $ runQ (unTypeCode [|| True == $$( [|| "foo" ||] ) ||])
-- <interactive> error:
--     • Couldn't match type ‘[Char]’ with ‘Bool’
--       Expected type: Code Q Bool
--         Actual type: Code Q [Char]
--     • In the Template Haskell quotation [|| "foo" ||]
--       In the expression: [|| "foo" ||]
--       In the Template Haskell splice $$([|| "foo" ||])


{- Note [Foralls to the right in Code]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Code has the following type signature:
   type Code :: (Kind.Type -> Kind.Type) -> forall r. TYPE r -> Kind.Type

This allows us to write
   data T (f :: forall r . (TYPE r) -> Type) = MkT (f Int) (f Int#)

   tcodeq :: T (Code Q)
   tcodeq = MkT [||5||] [||5#||]

If we used the slightly more straightforward signature
   type Code :: foral r. (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type

then the example above would become ill-typed.  (See #23592 for some discussion.)
-}

-- | Unsafely convert an untyped code representation into a typed code
-- representation.
unsafeCodeCoerce :: forall (r :: RuntimeRep) (a :: TYPE r) m .
                      Quote m => m Exp -> Code m a
unsafeCodeCoerce :: forall a (m :: * -> *). Quote m => m Exp -> Code m a
unsafeCodeCoerce m Exp
m = m (TExp a) -> Code m a
forall (m :: * -> *) a. m (TExp a) -> Code m a
Code (m Exp -> m (TExp a)
forall a (m :: * -> *). Quote m => m Exp -> m (TExp a)
unsafeTExpCoerce m Exp
m)

-- | Lift a monadic action producing code into the typed 'Code'
-- representation
liftCode :: forall (r :: RuntimeRep) (a :: TYPE r) m . m (TExp a) -> Code m a
liftCode :: forall a (m :: * -> *). m (TExp a) -> Code m a
liftCode = m (TExp a) -> Code m a
forall (m :: * -> *) a. m (TExp a) -> Code m a
Code

-- | Extract the untyped representation from the typed representation
unTypeCode :: forall (r :: RuntimeRep) (a :: TYPE r) m . Quote m
           => Code m a -> m Exp
unTypeCode :: forall a (m :: * -> *). Quote m => Code m a -> m Exp
unTypeCode = m (TExp a) -> m Exp
forall a (m :: * -> *). Quote m => m (TExp a) -> m Exp
unTypeQ (m (TExp a) -> m Exp)
-> (Code m a -> m (TExp a)) -> Code m a -> m Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code m a -> m (TExp a)
forall (m :: * -> *) a. Code m a -> m (TExp a)
examineCode

-- | Modify the ambient monad used during code generation. For example, you
-- can use `hoistCode` to handle a state effect:
-- @
--  handleState :: Code (StateT Int Q) a -> Code Q a
--  handleState = hoistCode (flip runState 0)
-- @
hoistCode :: forall m n (r :: RuntimeRep) (a :: TYPE r) . Monad m
          => (forall x . m x -> n x) -> Code m a -> Code n a
hoistCode :: forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
(forall x. m x -> n x) -> Code m a -> Code n a
hoistCode forall x. m x -> n x
f (Code m (TExp a)
a) = n (TExp a) -> Code n a
forall (m :: * -> *) a. m (TExp a) -> Code m a
Code (m (TExp a) -> n (TExp a)
forall x. m x -> n x
f m (TExp a)
a)


-- | Variant of '(>>=)' which allows effectful computations to be injected
-- into code generation.
bindCode :: forall m a (r :: RuntimeRep) (b :: TYPE r) . Monad m
         => m a -> (a -> Code m b) -> Code m b
bindCode :: forall (m :: * -> *) a b.
Monad m =>
m a -> (a -> Code m b) -> Code m b
bindCode m a
q a -> Code m b
k = m (TExp b) -> Code m b
forall a (m :: * -> *). m (TExp a) -> Code m a
liftCode (m a
q m a -> (a -> m (TExp b)) -> m (TExp b)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Code m b -> m (TExp b)
forall (m :: * -> *) a. Code m a -> m (TExp a)
examineCode (Code m b -> m (TExp b)) -> (a -> Code m b) -> a -> m (TExp b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Code m b
k)

-- | Variant of '(>>)' which allows effectful computations to be injected
-- into code generation.
bindCode_ :: forall m a (r :: RuntimeRep) (b :: TYPE r) . Monad m
          => m a -> Code m b -> Code m b
bindCode_ :: forall (m :: * -> *) a b. Monad m => m a -> Code m b -> Code m b
bindCode_ m a
q Code m b
c = m (TExp b) -> Code m b
forall a (m :: * -> *). m (TExp a) -> Code m a
liftCode ( m a
q m a -> m (TExp b) -> m (TExp b)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Code m b -> m (TExp b)
forall (m :: * -> *) a. Code m a -> m (TExp a)
examineCode Code m b
c)

-- | A useful combinator for embedding monadic actions into 'Code'
-- @
-- myCode :: ... => Code m a
-- myCode = joinCode $ do
--   x <- someSideEffect
--   return (makeCodeWith x)
-- @
joinCode :: forall m (r :: RuntimeRep) (a :: TYPE r) . Monad m
         => m (Code m a) -> Code m a
joinCode :: forall (m :: * -> *) a. Monad m => m (Code m a) -> Code m a
joinCode = (m (Code m a) -> (Code m a -> Code m a) -> Code m a)
-> (Code m a -> Code m a) -> m (Code m a) -> Code m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip m (Code m a) -> (Code m a -> Code m a) -> Code m a
forall (m :: * -> *) a b.
Monad m =>
m a -> (a -> Code m b) -> Code m b
bindCode Code m a -> Code m a
forall a. a -> a
id

----------------------------------------------------
-- Packaged versions for the programmer, hiding the Quasi-ness


-- | Report an error (True) or warning (False),
-- but carry on; use 'fail' to stop.
report  :: Bool -> String -> Q ()
report :: Bool -> FilePath -> Q ()
report Bool
b FilePath
s = (forall (m :: * -> *). Quasi m => m ()) -> Q ()
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (Bool -> FilePath -> m ()
forall (m :: * -> *). Quasi m => Bool -> FilePath -> m ()
qReport Bool
b FilePath
s)
{-# DEPRECATED report "Use reportError or reportWarning instead" #-} -- deprecated in 7.6

-- | Report an error to the user, but allow the current splice's computation to carry on. To abort the computation, use 'fail'.
reportError :: String -> Q ()
reportError :: FilePath -> Q ()
reportError = Bool -> FilePath -> Q ()
report Bool
True

-- | Report a warning to the user, and carry on.
reportWarning :: String -> Q ()
reportWarning :: FilePath -> Q ()
reportWarning = Bool -> FilePath -> Q ()
report Bool
False

-- | Recover from errors raised by 'reportError' or 'fail'.
recover :: Q a -- ^ handler to invoke on failure
        -> Q a -- ^ computation to run
        -> Q a
recover :: forall a. Q a -> Q a -> Q a
recover (Q forall (m :: * -> *). Quasi m => m a
r) (Q forall (m :: * -> *). Quasi m => m a
m) = (forall (m :: * -> *). Quasi m => m a) -> Q a
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (m a -> m a -> m a
forall a. m a -> m a -> m a
forall (m :: * -> *) a. Quasi m => m a -> m a -> m a
qRecover m a
forall (m :: * -> *). Quasi m => m a
r m a
forall (m :: * -> *). Quasi m => m a
m)

-- We don't export lookupName; the Bool isn't a great API
-- Instead we export lookupTypeName, lookupValueName
lookupName :: Bool -> String -> Q (Maybe Name)
lookupName :: Bool -> FilePath -> Q (Maybe Name)
lookupName Bool
ns FilePath
s = (forall (m :: * -> *). Quasi m => m (Maybe Name)) -> Q (Maybe Name)
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (Bool -> FilePath -> m (Maybe Name)
forall (m :: * -> *). Quasi m => Bool -> FilePath -> m (Maybe Name)
qLookupName Bool
ns FilePath
s)

-- | Look up the given name in the (type namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.
lookupTypeName :: String -> Q (Maybe Name)
lookupTypeName :: FilePath -> Q (Maybe Name)
lookupTypeName  FilePath
s = (forall (m :: * -> *). Quasi m => m (Maybe Name)) -> Q (Maybe Name)
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (Bool -> FilePath -> m (Maybe Name)
forall (m :: * -> *). Quasi m => Bool -> FilePath -> m (Maybe Name)
qLookupName Bool
True FilePath
s)

-- | Look up the given name in the (value namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.
lookupValueName :: String -> Q (Maybe Name)
lookupValueName :: FilePath -> Q (Maybe Name)
lookupValueName FilePath
s = (forall (m :: * -> *). Quasi m => m (Maybe Name)) -> Q (Maybe Name)
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (Bool -> FilePath -> m (Maybe Name)
forall (m :: * -> *). Quasi m => Bool -> FilePath -> m (Maybe Name)
qLookupName Bool
False FilePath
s)

{-
Note [Name lookup]
~~~~~~~~~~~~~~~~~~
-}
{- $namelookup #namelookup#
The functions 'lookupTypeName' and 'lookupValueName' provide
a way to query the current splice's context for what names
are in scope. The function 'lookupTypeName' queries the type
namespace, whereas 'lookupValueName' queries the value namespace,
but the functions are otherwise identical.

A call @lookupValueName s@ will check if there is a value
with name @s@ in scope at the current splice's location. If
there is, the @Name@ of this value is returned;
if not, then @Nothing@ is returned.

The returned name cannot be \"captured\".
For example:

> f = "global"
> g = $( do
>          Just nm <- lookupValueName "f"
>          [| let f = "local" in $( varE nm ) |]

In this case, @g = \"global\"@; the call to @lookupValueName@
returned the global @f@, and this name was /not/ captured by
the local definition of @f@.

The lookup is performed in the context of the /top-level/ splice
being run. For example:

> f = "global"
> g = $( [| let f = "local" in
>            $(do
>                Just nm <- lookupValueName "f"
>                varE nm
>             ) |] )

Again in this example, @g = \"global\"@, because the call to
@lookupValueName@ queries the context of the outer-most @$(...)@.

Operators should be queried without any surrounding parentheses, like so:

> lookupValueName "+"

Qualified names are also supported, like so:

> lookupValueName "Prelude.+"
> lookupValueName "Prelude.map"

-}


{- | 'reify' looks up information about the 'Name'. It will fail with
a compile error if the 'Name' is not visible. A 'Name' is visible if it is
imported or defined in a prior top-level declaration group. See the
documentation for 'newDeclarationGroup' for more details.

It is sometimes useful to construct the argument name using 'lookupTypeName' or 'lookupValueName'
to ensure that we are reifying from the right namespace. For instance, in this context:

> data D = D

which @D@ does @reify (mkName \"D\")@ return information about? (Answer: @D@-the-type, but don't rely on it.)
To ensure we get information about @D@-the-value, use 'lookupValueName':

> do
>   Just nm <- lookupValueName "D"
>   reify nm

and to get information about @D@-the-type, use 'lookupTypeName'.
-}
reify :: Name -> Q Info
reify :: Name -> Q Info
reify Name
v = (forall (m :: * -> *). Quasi m => m Info) -> Q Info
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (Name -> m Info
forall (m :: * -> *). Quasi m => Name -> m Info
qReify Name
v)

{- | @reifyFixity nm@ attempts to find a fixity declaration for @nm@. For
example, if the function @foo@ has the fixity declaration @infixr 7 foo@, then
@reifyFixity 'foo@ would return @'Just' ('Fixity' 7 'InfixR')@. If the function
@bar@ does not have a fixity declaration, then @reifyFixity 'bar@ returns
'Nothing', so you may assume @bar@ has 'defaultFixity'.
-}
reifyFixity :: Name -> Q (Maybe Fixity)
reifyFixity :: Name -> Q (Maybe Fixity)
reifyFixity Name
nm = (forall (m :: * -> *). Quasi m => m (Maybe Fixity))
-> Q (Maybe Fixity)
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (Name -> m (Maybe Fixity)
forall (m :: * -> *). Quasi m => Name -> m (Maybe Fixity)
qReifyFixity Name
nm)

{- | @reifyType nm@ attempts to find the type or kind of @nm@. For example,
@reifyType 'not@   returns @Bool -> Bool@, and
@reifyType ''Bool@ returns @Type@.
This works even if there's no explicit signature and the type or kind is inferred.
-}
reifyType :: Name -> Q Type
reifyType :: Name -> Q Type
reifyType Name
nm = (forall (m :: * -> *). Quasi m => m Type) -> Q Type
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (Name -> m Type
forall (m :: * -> *). Quasi m => Name -> m Type
qReifyType Name
nm)

{- | Template Haskell is capable of reifying information about types and
terms defined in previous declaration groups. Top-level declaration splices break up
declaration groups.

For an example, consider this  code block. We define a datatype @X@ and
then try to call 'reify' on the datatype.

@
module Check where

data X = X
    deriving Eq

$(do
    info <- reify ''X
    runIO $ print info
 )
@

This code fails to compile, noting that @X@ is not available for reification at the site of 'reify'. We can fix this by creating a new declaration group using an empty top-level splice:

@
data X = X
    deriving Eq

$(pure [])

$(do
    info <- reify ''X
    runIO $ print info
 )
@

We provide 'newDeclarationGroup' as a means of documenting this behavior
and providing a name for the pattern.

Since top level splices infer the presence of the @$( ... )@ brackets, we can also write:

@
data X = X
    deriving Eq

newDeclarationGroup

$(do
    info <- reify ''X
    runIO $ print info
 )
@

-}
newDeclarationGroup :: Q [Dec]
newDeclarationGroup :: Q [Dec]
newDeclarationGroup = [Dec] -> Q [Dec]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

{- | @reifyInstances nm tys@ returns a list of all visible instances (see below for "visible")
of @nm tys@. That is,
if @nm@ is the name of a type class, then all instances of this class at the types @tys@
are returned. Alternatively, if @nm@ is the name of a data family or type family,
all instances of this family at the types @tys@ are returned.

Note that this is a \"shallow\" test; the declarations returned merely have
instance heads which unify with @nm tys@, they need not actually be satisfiable.

  - @reifyInstances ''Eq [ 'TupleT' 2 \``AppT`\` 'ConT' ''A \``AppT`\` 'ConT' ''B ]@ contains
    the @instance (Eq a, Eq b) => Eq (a, b)@ regardless of whether @A@ and
    @B@ themselves implement 'Eq'

  - @reifyInstances ''Show [ 'VarT' ('mkName' "a") ]@ produces every available
    instance of 'Show'

There is one edge case: @reifyInstances ''Typeable tys@ currently always
produces an empty list (no matter what @tys@ are given).

In principle, the *visible* instances are
* all instances defined in a prior top-level declaration group
  (see docs on @newDeclarationGroup@), or
* all instances defined in any module transitively imported by the
  module being compiled

However, actually searching all modules transitively below the one being
compiled is unreasonably expensive, so @reifyInstances@ will report only the
instance for modules that GHC has had some cause to visit during this
compilation.  This is a shortcoming: @reifyInstances@ might fail to report
instances for a type that is otherwise unusued, or instances defined in a
different component.  You can work around this shortcoming by explicitly importing the modules
whose instances you want to be visible. GHC issue <https://gitlab.haskell.org/ghc/ghc/-/issues/20529#note_388980 #20529>
has some discussion around this.

-}
reifyInstances :: Name -> [Type] -> Q [InstanceDec]
reifyInstances :: Name -> [Type] -> Q [Dec]
reifyInstances Name
cls [Type]
tys = (forall (m :: * -> *). Quasi m => m [Dec]) -> Q [Dec]
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (Name -> [Type] -> m [Dec]
forall (m :: * -> *). Quasi m => Name -> [Type] -> m [Dec]
qReifyInstances Name
cls [Type]
tys)

{- | @reifyRoles nm@ returns the list of roles associated with the parameters
(both visible and invisible) of
the tycon @nm@. Fails if @nm@ cannot be found or is not a tycon.
The returned list should never contain 'InferR'.

An invisible parameter to a tycon is often a kind parameter. For example, if
we have

@
type Proxy :: forall k. k -> Type
data Proxy a = MkProxy
@

and @reifyRoles Proxy@, we will get @['NominalR', 'PhantomR']@. The 'NominalR' is
the role of the invisible @k@ parameter. Kind parameters are always nominal.
-}
reifyRoles :: Name -> Q [Role]
reifyRoles :: Name -> Q [Role]
reifyRoles Name
nm = (forall (m :: * -> *). Quasi m => m [Role]) -> Q [Role]
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (Name -> m [Role]
forall (m :: * -> *). Quasi m => Name -> m [Role]
qReifyRoles Name
nm)

-- | @reifyAnnotations target@ returns the list of annotations
-- associated with @target@.  Only the annotations that are
-- appropriately typed is returned.  So if you have @Int@ and @String@
-- annotations for the same target, you have to call this function twice.
reifyAnnotations :: Data a => AnnLookup -> Q [a]
reifyAnnotations :: forall a. Data a => AnnLookup -> Q [a]
reifyAnnotations AnnLookup
an = (forall (m :: * -> *). Quasi m => m [a]) -> Q [a]
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (AnnLookup -> m [a]
forall a. Data a => AnnLookup -> m [a]
forall (m :: * -> *) a. (Quasi m, Data a) => AnnLookup -> m [a]
qReifyAnnotations AnnLookup
an)

-- | @reifyModule mod@ looks up information about module @mod@.  To
-- look up the current module, call this function with the return
-- value of 'Language.Haskell.TH.Lib.thisModule'.
reifyModule :: Module -> Q ModuleInfo
reifyModule :: Module -> Q ModuleInfo
reifyModule Module
m = (forall (m :: * -> *). Quasi m => m ModuleInfo) -> Q ModuleInfo
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (Module -> m ModuleInfo
forall (m :: * -> *). Quasi m => Module -> m ModuleInfo
qReifyModule Module
m)

-- | @reifyConStrictness nm@ looks up the strictness information for the fields
-- of the constructor with the name @nm@. Note that the strictness information
-- that 'reifyConStrictness' returns may not correspond to what is written in
-- the source code. For example, in the following data declaration:
--
-- @
-- data Pair a = Pair a a
-- @
--
-- 'reifyConStrictness' would return @['DecidedLazy', DecidedLazy]@ under most
-- circumstances, but it would return @['DecidedStrict', DecidedStrict]@ if the
-- @-XStrictData@ language extension was enabled.
reifyConStrictness :: Name -> Q [DecidedStrictness]
reifyConStrictness :: Name -> Q [DecidedStrictness]
reifyConStrictness Name
n = (forall (m :: * -> *). Quasi m => m [DecidedStrictness])
-> Q [DecidedStrictness]
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (Name -> m [DecidedStrictness]
forall (m :: * -> *). Quasi m => Name -> m [DecidedStrictness]
qReifyConStrictness Name
n)

-- | Is the list of instances returned by 'reifyInstances' nonempty?
--
-- If you're confused by an instance not being visible despite being
-- defined in the same module and above the splice in question, see the
-- docs for 'newDeclarationGroup' for a possible explanation.
isInstance :: Name -> [Type] -> Q Bool
isInstance :: Name -> [Type] -> Q Bool
isInstance Name
nm [Type]
tys = do { decs <- Name -> [Type] -> Q [Dec]
reifyInstances Name
nm [Type]
tys
                       ; return (not (null decs)) }

-- | The location at which this computation is spliced.
location :: Q Loc
location :: Q Loc
location = (forall (m :: * -> *). Quasi m => m Loc) -> Q Loc
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q m Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation

-- |The 'runIO' function lets you run an I\/O computation in the 'Q' monad.
-- Take care: you are guaranteed the ordering of calls to 'runIO' within
-- a single 'Q' computation, but not about the order in which splices are run.
--
-- Note: for various murky reasons, stdout and stderr handles are not
-- necessarily flushed when the compiler finishes running, so you should
-- flush them yourself.
runIO :: IO a -> Q a
runIO :: forall a. IO a -> Q a
runIO IO a
m = (forall (m :: * -> *). Quasi m => m a) -> Q a
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. Quasi m => IO a -> m a
qRunIO IO a
m)

-- | Get the package root for the current package which is being compiled.
-- This can be set explicitly with the -package-root flag but is normally
-- just the current working directory.
--
-- The motivation for this flag is to provide a principled means to remove the
-- assumption from splices that they will be executed in the directory where the
-- cabal file resides. Projects such as haskell-language-server can't and don't
-- change directory when compiling files but instead set the -package-root flag
-- appropriately.
getPackageRoot :: Q FilePath
getPackageRoot :: Q FilePath
getPackageRoot = (forall (m :: * -> *). Quasi m => m FilePath) -> Q FilePath
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q m FilePath
forall (m :: * -> *). Quasi m => m FilePath
qGetPackageRoot

-- | Record external directories that runIO is using (dependent upon).
-- The compiler can then recognize that it should re-compile the Haskell file
-- when a directory changes.
--
-- Notes:
--
--   * ghc -M does not know about these dependencies - it does not execute TH.
--
--   * The dependency is shallow, based only on the direct content.
--     Basically, it only sees a list of names. It does not look at directory
--     metadata, recurse into subdirectories, or look at file contents. As
--     long as the list of names remains the same, the directory is considered
--     unchanged.
--
--   * The state of the directory is read at the interface generation time,
--     not at the time of the function call.
addDependentDirectory :: FilePath -> Q ()
addDependentDirectory :: FilePath -> Q ()
addDependentDirectory FilePath
dp = (forall (m :: * -> *). Quasi m => m ()) -> Q ()
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (FilePath -> m ()
forall (m :: * -> *). Quasi m => FilePath -> m ()
qAddDependentDirectory FilePath
dp)

-- | Record external files that runIO is using (dependent upon).
-- The compiler can then recognize that it should re-compile the Haskell file
-- when an external file changes.
--
-- Expects an absolute file path.
--
-- Notes:
--
--   * ghc -M does not know about these dependencies - it does not execute TH.
--
--   * The dependency is based on file content, not a modification time
addDependentFile :: FilePath -> Q ()
addDependentFile :: FilePath -> Q ()
addDependentFile FilePath
fp = (forall (m :: * -> *). Quasi m => m ()) -> Q ()
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (FilePath -> m ()
forall (m :: * -> *). Quasi m => FilePath -> m ()
qAddDependentFile FilePath
fp)

-- | Obtain a temporary file path with the given suffix. The compiler will
-- delete this file after compilation.
addTempFile :: String -> Q FilePath
addTempFile :: FilePath -> Q FilePath
addTempFile FilePath
suffix = (forall (m :: * -> *). Quasi m => m FilePath) -> Q FilePath
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (FilePath -> m FilePath
forall (m :: * -> *). Quasi m => FilePath -> m FilePath
qAddTempFile FilePath
suffix)

-- | Add additional top-level declarations. The added declarations will be type
-- checked along with the current declaration group.
addTopDecls :: [Dec] -> Q ()
addTopDecls :: [Dec] -> Q ()
addTopDecls [Dec]
ds = (forall (m :: * -> *). Quasi m => m ()) -> Q ()
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q ([Dec] -> m ()
forall (m :: * -> *). Quasi m => [Dec] -> m ()
qAddTopDecls [Dec]
ds)


-- | Emit a foreign file which will be compiled and linked to the object for
-- the current module. Currently only languages that can be compiled with
-- the C compiler are supported, and the flags passed as part of -optc will
-- be also applied to the C compiler invocation that will compile them.
--
-- Note that for non-C languages (for example C++) @extern "C"@ directives
-- must be used to get symbols that we can access from Haskell.
--
-- To get better errors, it is recommended to use #line pragmas when
-- emitting C files, e.g.
--
-- > {-# LANGUAGE CPP #-}
-- > ...
-- > addForeignSource LangC $ unlines
-- >   [ "#line " ++ show (__LINE__ + 1) ++ " " ++ show __FILE__
-- >   , ...
-- >   ]
addForeignSource :: ForeignSrcLang -> String -> Q ()
addForeignSource :: ForeignSrcLang -> FilePath -> Q ()
addForeignSource ForeignSrcLang
lang FilePath
src = do
  let suffix :: FilePath
suffix = case ForeignSrcLang
lang of
                 ForeignSrcLang
LangC      -> FilePath
"c"
                 ForeignSrcLang
LangCxx    -> FilePath
"cpp"
                 ForeignSrcLang
LangObjc   -> FilePath
"m"
                 ForeignSrcLang
LangObjcxx -> FilePath
"mm"
                 ForeignSrcLang
LangAsm    -> FilePath
"s"
                 ForeignSrcLang
LangJs     -> FilePath
"js"
                 ForeignSrcLang
RawObject  -> FilePath
"a"
  path <- FilePath -> Q FilePath
addTempFile FilePath
suffix
  runIO $ writeFile path src
  addForeignFilePath lang path

-- | Same as 'addForeignSource', but expects to receive a path pointing to the
-- foreign file instead of a 'String' of its contents. Consider using this in
-- conjunction with 'addTempFile'.
--
-- This is a good alternative to 'addForeignSource' when you are trying to
-- directly link in an object file.
addForeignFilePath :: ForeignSrcLang -> FilePath -> Q ()
addForeignFilePath :: ForeignSrcLang -> FilePath -> Q ()
addForeignFilePath ForeignSrcLang
lang FilePath
fp = (forall (m :: * -> *). Quasi m => m ()) -> Q ()
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (ForeignSrcLang -> FilePath -> m ()
forall (m :: * -> *). Quasi m => ForeignSrcLang -> FilePath -> m ()
qAddForeignFilePath ForeignSrcLang
lang FilePath
fp)

-- | Add a finalizer that will run in the Q monad after the current module has
-- been type checked. This only makes sense when run within a top-level splice.
--
-- The finalizer is given the local type environment at the splice point. Thus
-- 'reify' is able to find the local definitions when executed inside the
-- finalizer.
addModFinalizer :: Q () -> Q ()
addModFinalizer :: Q () -> Q ()
addModFinalizer Q ()
act = (forall (m :: * -> *). Quasi m => m ()) -> Q ()
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (Q () -> m ()
forall (m :: * -> *). Quasi m => Q () -> m ()
qAddModFinalizer (Q () -> forall (m :: * -> *). Quasi m => m ()
forall a. Q a -> forall (m :: * -> *). Quasi m => m a
unQ Q ()
act))

-- | Adds a core plugin to the compilation pipeline.
--
-- @addCorePlugin m@ has almost the same effect as passing @-fplugin=m@ to ghc
-- in the command line. The major difference is that the plugin module @m@
-- must not belong to the current package. When TH executes, it is too late
-- to tell the compiler that we needed to compile first a plugin module in the
-- current package.
addCorePlugin :: String -> Q ()
addCorePlugin :: FilePath -> Q ()
addCorePlugin FilePath
plugin = (forall (m :: * -> *). Quasi m => m ()) -> Q ()
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (FilePath -> m ()
forall (m :: * -> *). Quasi m => FilePath -> m ()
qAddCorePlugin FilePath
plugin)

-- | Get state from the 'Q' monad. Note that the state is local to the
-- Haskell module in which the Template Haskell expression is executed.
getQ :: Typeable a => Q (Maybe a)
getQ :: forall a. Typeable a => Q (Maybe a)
getQ = (forall (m :: * -> *). Quasi m => m (Maybe a)) -> Q (Maybe a)
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q m (Maybe a)
forall a. Typeable a => m (Maybe a)
forall (m :: * -> *). Quasi m => m (Maybe a)
forall (m :: * -> *) a. (Quasi m, Typeable a) => m (Maybe a)
qGetQ

-- | Replace the state in the 'Q' monad. Note that the state is local to the
-- Haskell module in which the Template Haskell expression is executed.
putQ :: Typeable a => a -> Q ()
putQ :: forall a. Typeable a => a -> Q ()
putQ a
x = (forall (m :: * -> *). Quasi m => m ()) -> Q ()
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (a -> m ()
forall a. Typeable a => a -> m ()
forall (m :: * -> *) a. (Quasi m, Typeable a) => a -> m ()
qPutQ a
x)

-- | Determine whether the given language extension is enabled in the 'Q' monad.
isExtEnabled :: Extension -> Q Bool
isExtEnabled :: Extension -> Q Bool
isExtEnabled Extension
ext = (forall (m :: * -> *). Quasi m => m Bool) -> Q Bool
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (Extension -> m Bool
forall (m :: * -> *). Quasi m => Extension -> m Bool
qIsExtEnabled Extension
ext)

-- | List all enabled language extensions.
extsEnabled :: Q [Extension]
extsEnabled :: Q [Extension]
extsEnabled = (forall (m :: * -> *). Quasi m => m [Extension]) -> Q [Extension]
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q m [Extension]
forall (m :: * -> *). Quasi m => m [Extension]
qExtsEnabled

-- | Add Haddock documentation to the specified location. This will overwrite
-- any documentation at the location if it already exists. This will reify the
-- specified name, so it must be in scope when you call it. If you want to add
-- documentation to something that you are currently splicing, you can use
-- 'addModFinalizer' e.g.
--
-- > do
-- >   let nm = mkName "x"
-- >   addModFinalizer $ putDoc (DeclDoc nm) "Hello"
-- >   [d| $(varP nm) = 42 |]
--
-- The helper functions 'withDecDoc' and 'withDecsDoc' will do this for you, as
-- will the 'funD_doc' and other @_doc@ combinators.
-- You most likely want to have the @-haddock@ flag turned on when using this.
-- Adding documentation to anything outside of the current module will cause an
-- error.
putDoc :: DocLoc -> String -> Q ()
putDoc :: DocLoc -> FilePath -> Q ()
putDoc DocLoc
t FilePath
s = (forall (m :: * -> *). Quasi m => m ()) -> Q ()
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (DocLoc -> FilePath -> m ()
forall (m :: * -> *). Quasi m => DocLoc -> FilePath -> m ()
qPutDoc DocLoc
t FilePath
s)

-- | Retrieves the Haddock documentation at the specified location, if one
-- exists.
-- It can be used to read documentation on things defined outside of the current
-- module, provided that those modules were compiled with the @-haddock@ flag.
getDoc :: DocLoc -> Q (Maybe String)
getDoc :: DocLoc -> Q (Maybe FilePath)
getDoc DocLoc
n = (forall (m :: * -> *). Quasi m => m (Maybe FilePath))
-> Q (Maybe FilePath)
forall a. (forall (m :: * -> *). Quasi m => m a) -> Q a
Q (DocLoc -> m (Maybe FilePath)
forall (m :: * -> *). Quasi m => DocLoc -> m (Maybe FilePath)
qGetDoc DocLoc
n)

instance MonadIO Q where
  liftIO :: forall a. IO a -> Q a
liftIO = IO a -> Q a
forall a. IO a -> Q a
runIO

instance Quasi Q where
  qNewName :: FilePath -> Q Name
qNewName            = FilePath -> Q Name
forall (m :: * -> *). Quote m => FilePath -> m Name
newName
  qReport :: Bool -> FilePath -> Q ()
qReport             = Bool -> FilePath -> Q ()
report
  qRecover :: forall a. Q a -> Q a -> Q a
qRecover            = Q a -> Q a -> Q a
forall a. Q a -> Q a -> Q a
recover
  qReify :: Name -> Q Info
qReify              = Name -> Q Info
reify
  qReifyFixity :: Name -> Q (Maybe Fixity)
qReifyFixity        = Name -> Q (Maybe Fixity)
reifyFixity
  qReifyType :: Name -> Q Type
qReifyType          = Name -> Q Type
reifyType
  qReifyInstances :: Name -> [Type] -> Q [Dec]
qReifyInstances     = Name -> [Type] -> Q [Dec]
reifyInstances
  qReifyRoles :: Name -> Q [Role]
qReifyRoles         = Name -> Q [Role]
reifyRoles
  qReifyAnnotations :: forall a. Data a => AnnLookup -> Q [a]
qReifyAnnotations   = AnnLookup -> Q [a]
forall a. Data a => AnnLookup -> Q [a]
reifyAnnotations
  qReifyModule :: Module -> Q ModuleInfo
qReifyModule        = Module -> Q ModuleInfo
reifyModule
  qReifyConStrictness :: Name -> Q [DecidedStrictness]
qReifyConStrictness = Name -> Q [DecidedStrictness]
reifyConStrictness
  qLookupName :: Bool -> FilePath -> Q (Maybe Name)
qLookupName         = Bool -> FilePath -> Q (Maybe Name)
lookupName
  qLocation :: Q Loc
qLocation           = Q Loc
location
  qGetPackageRoot :: Q FilePath
qGetPackageRoot     = Q FilePath
getPackageRoot
  qAddDependentFile :: FilePath -> Q ()
qAddDependentFile   = FilePath -> Q ()
addDependentFile
  qAddDependentDirectory :: FilePath -> Q ()
qAddDependentDirectory = FilePath -> Q ()
addDependentDirectory
  qAddTempFile :: FilePath -> Q FilePath
qAddTempFile        = FilePath -> Q FilePath
addTempFile
  qAddTopDecls :: [Dec] -> Q ()
qAddTopDecls        = [Dec] -> Q ()
addTopDecls
  qAddForeignFilePath :: ForeignSrcLang -> FilePath -> Q ()
qAddForeignFilePath = ForeignSrcLang -> FilePath -> Q ()
addForeignFilePath
  qAddModFinalizer :: Q () -> Q ()
qAddModFinalizer    = Q () -> Q ()
addModFinalizer
  qAddCorePlugin :: FilePath -> Q ()
qAddCorePlugin      = FilePath -> Q ()
addCorePlugin
  qGetQ :: forall a. Typeable a => Q (Maybe a)
qGetQ               = Q (Maybe a)
forall a. Typeable a => Q (Maybe a)
getQ
  qPutQ :: forall a. Typeable a => a -> Q ()
qPutQ               = a -> Q ()
forall a. Typeable a => a -> Q ()
putQ
  qIsExtEnabled :: Extension -> Q Bool
qIsExtEnabled       = Extension -> Q Bool
isExtEnabled
  qExtsEnabled :: Q [Extension]
qExtsEnabled        = Q [Extension]
extsEnabled
  qPutDoc :: DocLoc -> FilePath -> Q ()
qPutDoc             = DocLoc -> FilePath -> Q ()
putDoc
  qGetDoc :: DocLoc -> Q (Maybe FilePath)
qGetDoc             = DocLoc -> Q (Maybe FilePath)
getDoc


----------------------------------------------------
-- The following operations are used solely in GHC.HsToCore.Quote when
-- desugaring brackets. They are not necessary for the user, who can use
-- ordinary return and (>>=) etc

-- | This function is only used in 'GHC.HsToCore.Quote' when desugaring
-- brackets. This is not necessary for the user, who can use the ordinary
-- 'return' and '(>>=)' operations.
sequenceQ :: forall m . Monad m => forall a . [m a] -> m [a]
sequenceQ :: forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequenceQ = [m a] -> m [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence