{-# LANGUAGE ScopedTypeVariables, StandaloneDeriving, DeriveGeneric,
    TupleSections, RecordWildCards, InstanceSigs, CPP #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

-- |
-- Running TH splices
--
module GHCi.TH
  ( startTH
  , runModFinalizerRefs
  , runTH
  , GHCiQException(..)
  ) where

{- Note [Remote Template Haskell]

Here is an overview of how TH works with -fexternal-interpreter.

Initialisation
~~~~~~~~~~~~~~

GHC sends a StartTH message to the server (see GHC.Tc.Gen.Splice.getTHState):

   StartTH :: Message (RemoteRef (IORef QState))

The server creates an initial QState object, makes an IORef to it, and
returns a RemoteRef to this to GHC. (see GHCi.TH.startTH below).

This happens once per module, the first time we need to run a TH
splice.  The reference that GHC gets back is kept in
tcg_th_remote_state in the TcGblEnv, and passed to each RunTH call
that follows.


For each splice
~~~~~~~~~~~~~~~

1. GHC compiles a splice to byte code, and sends it to the server: in
   a CreateBCOs message:

   CreateBCOs :: [LB.ByteString] -> Message [HValueRef]

2. The server creates the real byte-code objects in its heap, and
   returns HValueRefs to GHC.  HValueRef is the same as RemoteRef
   HValue.

3. GHC sends a RunTH message to the server:

  RunTH
   :: RemoteRef (IORef QState)
        -- The state returned by StartTH in step1
   -> HValueRef
        -- The HValueRef we got in step 4, points to the code for the splice
   -> THResultType
        -- Tells us what kind of splice this is (decl, expr, type, etc.)
   -> Maybe TH.Loc
        -- Source location
   -> Message (QResult ByteString)
        -- Eventually it will return a QResult back to GHC.  The
        -- ByteString here is the (encoded) result of the splice.

4. The server runs the splice code.

5. Each time the splice code calls a method of the Quasi class, such
   as qReify, a message is sent from the server to GHC.  These
   messages are defined by the THMessage type.  GHC responds with the
   result of the request, e.g. in the case of qReify it would be the
   TH.Info for the requested entity.

6. When the splice has been fully evaluated, the server sends
   RunTHDone back to GHC.  This tells GHC that the server has finished
   sending THMessages and will send the QResult next.

8. The server then sends a QResult back to GHC, which is notionally
   the response to the original RunTH message.  The QResult indicates
   whether the splice succeeded, failed, or threw an exception.


After typechecking
~~~~~~~~~~~~~~~~~~

GHC sends a FinishTH message to the server (see GHC.Tc.Gen.Splice.finishTH).
The server runs any finalizers that were added by addModuleFinalizer.


Other Notes on TH / Remote GHCi

  * Note [Remote GHCi] in compiler/ghci/GHCi.hs
  * Note [External GHCi pointers] in compiler/ghci/GHCi.hs
  * Note [TH recover with -fexternal-interpreter] in GHC.Tc.Gen.Splice
-}

import Prelude -- See note [Why do we import Prelude here?]
import GHCi.Message
import GHCi.RemoteTypes
import GHC.Serialized

import Control.Exception
import Control.Monad.IO.Class (MonadIO (..))
import Data.Binary
import Data.Binary.Put
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
import Data.Data
import Data.Dynamic
import Data.Either
import Data.IORef
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe
import GHC.Desugar
import qualified Language.Haskell.TH        as TH
import qualified Language.Haskell.TH.Syntax as TH
import Unsafe.Coerce

-- | Create a new instance of 'QState'
initQState :: Pipe -> QState
initQState :: Pipe -> QState
initQState Pipe
p = Map TypeRep Dynamic -> Maybe Loc -> Pipe -> QState
QState Map TypeRep Dynamic
forall k a. Map k a
M.empty Maybe Loc
forall a. Maybe a
Nothing Pipe
p

-- | The monad in which we run TH computations on the server
newtype GHCiQ a = GHCiQ { GHCiQ a -> QState -> IO (a, QState)
runGHCiQ :: QState -> IO (a, QState) }

-- | The exception thrown by "fail" in the GHCiQ monad
data GHCiQException = GHCiQException QState String
  deriving Int -> GHCiQException -> ShowS
[GHCiQException] -> ShowS
GHCiQException -> String
(Int -> GHCiQException -> ShowS)
-> (GHCiQException -> String)
-> ([GHCiQException] -> ShowS)
-> Show GHCiQException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GHCiQException] -> ShowS
$cshowList :: [GHCiQException] -> ShowS
show :: GHCiQException -> String
$cshow :: GHCiQException -> String
showsPrec :: Int -> GHCiQException -> ShowS
$cshowsPrec :: Int -> GHCiQException -> ShowS
External instance of the constraint type Show Char
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show QState
External instance of the constraint type Ord Int
Show

instance Exception GHCiQException

instance Functor GHCiQ where
  fmap :: (a -> b) -> GHCiQ a -> GHCiQ b
fmap a -> b
f (GHCiQ QState -> IO (a, QState)
s) = (QState -> IO (b, QState)) -> GHCiQ b
forall a. (QState -> IO (a, QState)) -> GHCiQ a
GHCiQ ((QState -> IO (b, QState)) -> GHCiQ b)
-> (QState -> IO (b, QState)) -> GHCiQ b
forall a b. (a -> b) -> a -> b
$ ((a, QState) -> (b, QState)) -> IO (a, QState) -> IO (b, QState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
fmap (\(a
x,QState
s') -> (a -> b
f a
x,QState
s')) (IO (a, QState) -> IO (b, QState))
-> (QState -> IO (a, QState)) -> QState -> IO (b, QState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QState -> IO (a, QState)
s

instance Applicative GHCiQ where
  GHCiQ (a -> b)
f <*> :: GHCiQ (a -> b) -> GHCiQ a -> GHCiQ b
<*> GHCiQ a
a = (QState -> IO (b, QState)) -> GHCiQ b
forall a. (QState -> IO (a, QState)) -> GHCiQ a
GHCiQ ((QState -> IO (b, QState)) -> GHCiQ b)
-> (QState -> IO (b, QState)) -> GHCiQ b
forall a b. (a -> b) -> a -> b
$ \QState
s ->
    do (a -> b
f',QState
s')  <- GHCiQ (a -> b) -> QState -> IO (a -> b, QState)
forall a. GHCiQ a -> QState -> IO (a, QState)
runGHCiQ GHCiQ (a -> b)
f QState
s
       (a
a',QState
s'') <- GHCiQ a -> QState -> IO (a, QState)
forall a. GHCiQ a -> QState -> IO (a, QState)
runGHCiQ GHCiQ a
a QState
s'
       (b, QState) -> IO (b, QState)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (a -> b
f' a
a', QState
s'')
  pure :: a -> GHCiQ a
pure a
x = (QState -> IO (a, QState)) -> GHCiQ a
forall a. (QState -> IO (a, QState)) -> GHCiQ a
GHCiQ (\QState
s -> (a, QState) -> IO (a, QState)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (a
x,QState
s))

instance Monad GHCiQ where
  GHCiQ a
m >>= :: GHCiQ a -> (a -> GHCiQ b) -> GHCiQ b
>>= a -> GHCiQ b
f = (QState -> IO (b, QState)) -> GHCiQ b
forall a. (QState -> IO (a, QState)) -> GHCiQ a
GHCiQ ((QState -> IO (b, QState)) -> GHCiQ b)
-> (QState -> IO (b, QState)) -> GHCiQ b
forall a b. (a -> b) -> a -> b
$ \QState
s ->
    do (a
m', QState
s')  <- GHCiQ a -> QState -> IO (a, QState)
forall a. GHCiQ a -> QState -> IO (a, QState)
runGHCiQ GHCiQ a
m QState
s
       (b
a,  QState
s'') <- GHCiQ b -> QState -> IO (b, QState)
forall a. GHCiQ a -> QState -> IO (a, QState)
runGHCiQ (a -> GHCiQ b
f a
m') QState
s'
       (b, QState) -> IO (b, QState)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (b
a, QState
s'')

instance MonadFail GHCiQ where
  fail :: String -> GHCiQ a
fail String
err  = (QState -> IO (a, QState)) -> GHCiQ a
forall a. (QState -> IO (a, QState)) -> GHCiQ a
GHCiQ ((QState -> IO (a, QState)) -> GHCiQ a)
-> (QState -> IO (a, QState)) -> GHCiQ a
forall a b. (a -> b) -> a -> b
$ \QState
s -> GHCiQException -> IO (a, QState)
forall e a. Exception e => e -> IO a
Instance of class: Exception of the constraint type Exception GHCiQException
throwIO (QState -> String -> GHCiQException
GHCiQException QState
s String
err)

getState :: GHCiQ QState
getState :: GHCiQ QState
getState = (QState -> IO (QState, QState)) -> GHCiQ QState
forall a. (QState -> IO (a, QState)) -> GHCiQ a
GHCiQ ((QState -> IO (QState, QState)) -> GHCiQ QState)
-> (QState -> IO (QState, QState)) -> GHCiQ QState
forall a b. (a -> b) -> a -> b
$ \QState
s -> (QState, QState) -> IO (QState, QState)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (QState
s,QState
s)

noLoc :: TH.Loc
noLoc :: Loc
noLoc = String -> String -> String -> CharPos -> CharPos -> Loc
TH.Loc String
"<no file>" String
"<no package>" String
"<no module>" (Int
0,Int
0) (Int
0,Int
0)

-- | Send a 'THMessage' to GHC and return the result.
ghcCmd :: Binary a => THMessage (THResult a) -> GHCiQ a
ghcCmd :: THMessage (THResult a) -> GHCiQ a
ghcCmd THMessage (THResult a)
m = (QState -> IO (a, QState)) -> GHCiQ a
forall a. (QState -> IO (a, QState)) -> GHCiQ a
GHCiQ ((QState -> IO (a, QState)) -> GHCiQ a)
-> (QState -> IO (a, QState)) -> GHCiQ a
forall a b. (a -> b) -> a -> b
$ \QState
s -> do
  THResult a
r <- Pipe -> THMessage (THResult a) -> IO (THResult a)
forall a. Binary a => Pipe -> THMessage a -> IO a
External instance of the constraint type forall a. Binary a => Binary (THResult a)
Evidence bound by a type signature of the constraint type Binary a
remoteTHCall (QState -> Pipe
qsPipe QState
s) THMessage (THResult a)
m
  case THResult a
r of
    THException String
str -> GHCiQException -> IO (a, QState)
forall e a. Exception e => e -> IO a
Instance of class: Exception of the constraint type Exception GHCiQException
throwIO (QState -> String -> GHCiQException
GHCiQException QState
s String
str)
    THComplete a
res -> (a, QState) -> IO (a, QState)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (a
res, QState
s)

instance MonadIO GHCiQ where
  liftIO :: IO a -> GHCiQ a
liftIO IO a
m = (QState -> IO (a, QState)) -> GHCiQ a
forall a. (QState -> IO (a, QState)) -> GHCiQ a
GHCiQ ((QState -> IO (a, QState)) -> GHCiQ a)
-> (QState -> IO (a, QState)) -> GHCiQ a
forall a b. (a -> b) -> a -> b
$ \QState
s -> (a -> (a, QState)) -> IO a -> IO (a, QState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
fmap (,QState
s) IO a
m

instance TH.Quasi GHCiQ where
  qNewName :: String -> GHCiQ Name
qNewName String
str = THMessage (THResult Name) -> GHCiQ Name
forall a. Binary a => THMessage (THResult a) -> GHCiQ a
External instance of the constraint type Binary Name
ghcCmd (String -> THMessage (THResult Name)
NewName String
str)
  qReport :: Bool -> String -> GHCiQ ()
qReport Bool
isError String
msg = THMessage (THResult ()) -> GHCiQ ()
forall a. Binary a => THMessage (THResult a) -> GHCiQ a
External instance of the constraint type Binary ()
ghcCmd (Bool -> String -> THMessage (THResult ())
Report Bool
isError String
msg)

  -- See Note [TH recover with -fexternal-interpreter] in GHC.Tc.Gen.Splice
  qRecover :: GHCiQ a -> GHCiQ a -> GHCiQ a
qRecover (GHCiQ QState -> IO (a, QState)
h) GHCiQ a
a = (QState -> IO (a, QState)) -> GHCiQ a
forall a. (QState -> IO (a, QState)) -> GHCiQ a
GHCiQ ((QState -> IO (a, QState)) -> GHCiQ a)
-> (QState -> IO (a, QState)) -> GHCiQ a
forall a b. (a -> b) -> a -> b
$ \QState
s -> ((forall a. IO a -> IO a) -> IO (a, QState)) -> IO (a, QState)
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO (a, QState)) -> IO (a, QState))
-> ((forall a. IO a -> IO a) -> IO (a, QState)) -> IO (a, QState)
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
unmask -> do
    Pipe -> THMessage () -> IO ()
forall a. Binary a => Pipe -> THMessage a -> IO a
External instance of the constraint type Binary ()
remoteTHCall (QState -> Pipe
qsPipe QState
s) THMessage ()
StartRecover
    Either GHCiQException (a, QState)
e <- IO (a, QState) -> IO (Either GHCiQException (a, QState))
forall e a. Exception e => IO a -> IO (Either e a)
Instance of class: Exception of the constraint type Exception GHCiQException
try (IO (a, QState) -> IO (Either GHCiQException (a, QState)))
-> IO (a, QState) -> IO (Either GHCiQException (a, QState))
forall a b. (a -> b) -> a -> b
$ IO (a, QState) -> IO (a, QState)
forall a. IO a -> IO a
unmask (IO (a, QState) -> IO (a, QState))
-> IO (a, QState) -> IO (a, QState)
forall a b. (a -> b) -> a -> b
$ GHCiQ a -> QState -> IO (a, QState)
forall a. GHCiQ a -> QState -> IO (a, QState)
runGHCiQ (GHCiQ a
a GHCiQ a -> GHCiQ () -> GHCiQ a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
Instance of class: Applicative of the constraint type Applicative GHCiQ
<* THMessage (THResult ()) -> GHCiQ ()
forall a. Binary a => THMessage (THResult a) -> GHCiQ a
External instance of the constraint type Binary ()
ghcCmd THMessage (THResult ())
FailIfErrs) QState
s
    Pipe -> THMessage () -> IO ()
forall a. Binary a => Pipe -> THMessage a -> IO a
External instance of the constraint type Binary ()
remoteTHCall (QState -> Pipe
qsPipe QState
s) (Bool -> THMessage ()
EndRecover (Either GHCiQException (a, QState) -> Bool
forall a b. Either a b -> Bool
isLeft Either GHCiQException (a, QState)
e))
    case Either GHCiQException (a, QState)
e of
      Left GHCiQException{} -> QState -> IO (a, QState)
h QState
s
      Right (a, QState)
r -> (a, QState) -> IO (a, QState)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (a, QState)
r
  qLookupName :: Bool -> String -> GHCiQ (Maybe Name)
qLookupName Bool
isType String
occ = THMessage (THResult (Maybe Name)) -> GHCiQ (Maybe Name)
forall a. Binary a => THMessage (THResult a) -> GHCiQ a
External instance of the constraint type forall a. Binary a => Binary (Maybe a)
External instance of the constraint type Binary Name
ghcCmd (Bool -> String -> THMessage (THResult (Maybe Name))
LookupName Bool
isType String
occ)
  qReify :: Name -> GHCiQ Info
qReify Name
name = THMessage (THResult Info) -> GHCiQ Info
forall a. Binary a => THMessage (THResult a) -> GHCiQ a
External instance of the constraint type Binary Info
ghcCmd (Name -> THMessage (THResult Info)
Reify Name
name)
  qReifyFixity :: Name -> GHCiQ (Maybe Fixity)
qReifyFixity Name
name = THMessage (THResult (Maybe Fixity)) -> GHCiQ (Maybe Fixity)
forall a. Binary a => THMessage (THResult a) -> GHCiQ a
External instance of the constraint type forall a. Binary a => Binary (Maybe a)
External instance of the constraint type Binary Fixity
ghcCmd (Name -> THMessage (THResult (Maybe Fixity))
ReifyFixity Name
name)
  qReifyType :: Name -> GHCiQ Type
qReifyType Name
name = THMessage (THResult Type) -> GHCiQ Type
forall a. Binary a => THMessage (THResult a) -> GHCiQ a
External instance of the constraint type Binary Type
ghcCmd (Name -> THMessage (THResult Type)
ReifyType Name
name)
  qReifyInstances :: Name -> [Type] -> GHCiQ [Dec]
qReifyInstances Name
name [Type]
tys = THMessage (THResult [Dec]) -> GHCiQ [Dec]
forall a. Binary a => THMessage (THResult a) -> GHCiQ a
External instance of the constraint type forall a. Binary a => Binary [a]
External instance of the constraint type Binary Dec
ghcCmd (Name -> [Type] -> THMessage (THResult [Dec])
ReifyInstances Name
name [Type]
tys)
  qReifyRoles :: Name -> GHCiQ [Role]
qReifyRoles Name
name = THMessage (THResult [Role]) -> GHCiQ [Role]
forall a. Binary a => THMessage (THResult a) -> GHCiQ a
External instance of the constraint type forall a. Binary a => Binary [a]
External instance of the constraint type Binary Role
ghcCmd (Name -> THMessage (THResult [Role])
ReifyRoles Name
name)

  -- To reify annotations, we send GHC the AnnLookup and also the
  -- TypeRep of the thing we're looking for, to avoid needing to
  -- serialize irrelevant annotations.
  qReifyAnnotations :: forall a . Data a => TH.AnnLookup -> GHCiQ [a]
  qReifyAnnotations :: AnnLookup -> GHCiQ [a]
qReifyAnnotations AnnLookup
lookup =
    (ByteString -> a) -> [ByteString] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ([Word8] -> a
forall a. Data a => [Word8] -> a
Evidence bound by a type signature of the constraint type Data a
deserializeWithData ([Word8] -> a) -> (ByteString -> [Word8]) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack) ([ByteString] -> [a]) -> GHCiQ [ByteString] -> GHCiQ [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor GHCiQ
<$>
      THMessage (THResult [ByteString]) -> GHCiQ [ByteString]
forall a. Binary a => THMessage (THResult a) -> GHCiQ a
External instance of the constraint type forall a. Binary a => Binary [a]
External instance of the constraint type Binary ByteString
ghcCmd (AnnLookup -> TypeRep -> THMessage (THResult [ByteString])
ReifyAnnotations AnnLookup
lookup TypeRep
typerep)
    where typerep :: TypeRep
typerep = a -> TypeRep
forall a. Typeable a => a -> TypeRep
External instance of the constraint type forall a. Data a => Typeable a
Evidence bound by a type signature of the constraint type Data a
typeOf (a
forall a. HasCallStack => a
undefined :: a)

  qReifyModule :: Module -> GHCiQ ModuleInfo
qReifyModule Module
m = THMessage (THResult ModuleInfo) -> GHCiQ ModuleInfo
forall a. Binary a => THMessage (THResult a) -> GHCiQ a
External instance of the constraint type Binary ModuleInfo
ghcCmd (Module -> THMessage (THResult ModuleInfo)
ReifyModule Module
m)
  qReifyConStrictness :: Name -> GHCiQ [DecidedStrictness]
qReifyConStrictness Name
name = THMessage (THResult [DecidedStrictness])
-> GHCiQ [DecidedStrictness]
forall a. Binary a => THMessage (THResult a) -> GHCiQ a
External instance of the constraint type forall a. Binary a => Binary [a]
External instance of the constraint type Binary DecidedStrictness
ghcCmd (Name -> THMessage (THResult [DecidedStrictness])
ReifyConStrictness Name
name)
  qLocation :: GHCiQ Loc
qLocation = Loc -> Maybe Loc -> Loc
forall a. a -> Maybe a -> a
fromMaybe Loc
noLoc (Maybe Loc -> Loc) -> (QState -> Maybe Loc) -> QState -> Loc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QState -> Maybe Loc
qsLocation (QState -> Loc) -> GHCiQ QState -> GHCiQ Loc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor GHCiQ
<$> GHCiQ QState
getState
  qAddDependentFile :: String -> GHCiQ ()
qAddDependentFile String
file = THMessage (THResult ()) -> GHCiQ ()
forall a. Binary a => THMessage (THResult a) -> GHCiQ a
External instance of the constraint type Binary ()
ghcCmd (String -> THMessage (THResult ())
AddDependentFile String
file)
  qAddTempFile :: String -> GHCiQ String
qAddTempFile String
suffix = THMessage (THResult String) -> GHCiQ String
forall a. Binary a => THMessage (THResult a) -> GHCiQ a
External instance of the constraint type forall a. Binary a => Binary [a]
External instance of the constraint type Binary Char
ghcCmd (String -> THMessage (THResult String)
AddTempFile String
suffix)
  qAddTopDecls :: [Dec] -> GHCiQ ()
qAddTopDecls [Dec]
decls = THMessage (THResult ()) -> GHCiQ ()
forall a. Binary a => THMessage (THResult a) -> GHCiQ a
External instance of the constraint type Binary ()
ghcCmd ([Dec] -> THMessage (THResult ())
AddTopDecls [Dec]
decls)
  qAddForeignFilePath :: ForeignSrcLang -> String -> GHCiQ ()
qAddForeignFilePath ForeignSrcLang
lang String
fp = THMessage (THResult ()) -> GHCiQ ()
forall a. Binary a => THMessage (THResult a) -> GHCiQ a
External instance of the constraint type Binary ()
ghcCmd (ForeignSrcLang -> String -> THMessage (THResult ())
AddForeignFilePath ForeignSrcLang
lang String
fp)
  qAddModFinalizer :: Q () -> GHCiQ ()
qAddModFinalizer Q ()
fin = (QState -> IO (RemoteRef (Q ()), QState))
-> GHCiQ (RemoteRef (Q ()))
forall a. (QState -> IO (a, QState)) -> GHCiQ a
GHCiQ (\QState
s -> Q () -> IO (RemoteRef (Q ()))
forall a. a -> IO (RemoteRef a)
mkRemoteRef Q ()
fin IO (RemoteRef (Q ()))
-> (RemoteRef (Q ()) -> IO (RemoteRef (Q ()), QState))
-> IO (RemoteRef (Q ()), QState)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
External instance of the constraint type Monad IO
>>= (RemoteRef (Q ()), QState) -> IO (RemoteRef (Q ()), QState)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ((RemoteRef (Q ()), QState) -> IO (RemoteRef (Q ()), QState))
-> (RemoteRef (Q ()) -> (RemoteRef (Q ()), QState))
-> RemoteRef (Q ())
-> IO (RemoteRef (Q ()), QState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, QState
s)) GHCiQ (RemoteRef (Q ()))
-> (RemoteRef (Q ()) -> GHCiQ ()) -> GHCiQ ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Instance of class: Monad of the constraint type Monad GHCiQ
>>=
                         THMessage (THResult ()) -> GHCiQ ()
forall a. Binary a => THMessage (THResult a) -> GHCiQ a
External instance of the constraint type Binary ()
ghcCmd (THMessage (THResult ()) -> GHCiQ ())
-> (RemoteRef (Q ()) -> THMessage (THResult ()))
-> RemoteRef (Q ())
-> GHCiQ ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteRef (Q ()) -> THMessage (THResult ())
AddModFinalizer
  qAddCorePlugin :: String -> GHCiQ ()
qAddCorePlugin String
str = THMessage (THResult ()) -> GHCiQ ()
forall a. Binary a => THMessage (THResult a) -> GHCiQ a
External instance of the constraint type Binary ()
ghcCmd (String -> THMessage (THResult ())
AddCorePlugin String
str)
  qGetQ :: GHCiQ (Maybe a)
qGetQ = (QState -> IO (Maybe a, QState)) -> GHCiQ (Maybe a)
forall a. (QState -> IO (a, QState)) -> GHCiQ a
GHCiQ ((QState -> IO (Maybe a, QState)) -> GHCiQ (Maybe a))
-> (QState -> IO (Maybe a, QState)) -> GHCiQ (Maybe a)
forall a b. (a -> b) -> a -> b
$ \QState
s ->
    let lookup :: forall a. Typeable a => Map TypeRep Dynamic -> Maybe a
        lookup :: Map TypeRep Dynamic -> Maybe a
lookup Map TypeRep Dynamic
m = Dynamic -> Maybe a
forall a. Typeable a => Dynamic -> Maybe a
Evidence bound by a type signature of the constraint type Typeable a
fromDynamic (Dynamic -> Maybe a) -> Maybe Dynamic -> Maybe a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
External instance of the constraint type Monad Maybe
=<< TypeRep -> Map TypeRep Dynamic -> Maybe Dynamic
forall k a. Ord k => k -> Map k a -> Maybe a
External instance of the constraint type Ord TypeRep
M.lookup (a -> TypeRep
forall a. Typeable a => a -> TypeRep
Evidence bound by a type signature of the constraint type Typeable a
typeOf (a
forall a. HasCallStack => a
undefined::a)) Map TypeRep Dynamic
m
    in (Maybe a, QState) -> IO (Maybe a, QState)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (Map TypeRep Dynamic -> Maybe a
forall a. Typeable a => Map TypeRep Dynamic -> Maybe a
Evidence bound by a type signature of the constraint type Typeable a
lookup (QState -> Map TypeRep Dynamic
qsMap QState
s), QState
s)
  qPutQ :: a -> GHCiQ ()
qPutQ a
k = (QState -> IO ((), QState)) -> GHCiQ ()
forall a. (QState -> IO (a, QState)) -> GHCiQ a
GHCiQ ((QState -> IO ((), QState)) -> GHCiQ ())
-> (QState -> IO ((), QState)) -> GHCiQ ()
forall a b. (a -> b) -> a -> b
$ \QState
s ->
    ((), QState) -> IO ((), QState)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ((), QState
s { qsMap :: Map TypeRep Dynamic
qsMap = TypeRep -> Dynamic -> Map TypeRep Dynamic -> Map TypeRep Dynamic
forall k a. Ord k => k -> a -> Map k a -> Map k a
External instance of the constraint type Ord TypeRep
M.insert (a -> TypeRep
forall a. Typeable a => a -> TypeRep
Evidence bound by a type signature of the constraint type Typeable a
typeOf a
k) (a -> Dynamic
forall a. Typeable a => a -> Dynamic
Evidence bound by a type signature of the constraint type Typeable a
toDyn a
k) (QState -> Map TypeRep Dynamic
qsMap QState
s) })
  qIsExtEnabled :: Extension -> GHCiQ Bool
qIsExtEnabled Extension
x = THMessage (THResult Bool) -> GHCiQ Bool
forall a. Binary a => THMessage (THResult a) -> GHCiQ a
External instance of the constraint type Binary Bool
ghcCmd (Extension -> THMessage (THResult Bool)
IsExtEnabled Extension
x)
  qExtsEnabled :: GHCiQ [Extension]
qExtsEnabled = THMessage (THResult [Extension]) -> GHCiQ [Extension]
forall a. Binary a => THMessage (THResult a) -> GHCiQ a
External instance of the constraint type forall a. Binary a => Binary [a]
External instance of the constraint type Binary Extension
ghcCmd THMessage (THResult [Extension])
ExtsEnabled

-- | The implementation of the 'StartTH' message: create
-- a new IORef QState, and return a RemoteRef to it.
startTH :: IO (RemoteRef (IORef QState))
startTH :: IO (RemoteRef (IORef QState))
startTH = do
  IORef QState
r <- QState -> IO (IORef QState)
forall a. a -> IO (IORef a)
newIORef (Pipe -> QState
initQState (String -> Pipe
forall a. HasCallStack => String -> a
error String
"startTH: no pipe"))
  IORef QState -> IO (RemoteRef (IORef QState))
forall a. a -> IO (RemoteRef a)
mkRemoteRef IORef QState
r

-- | Runs the mod finalizers.
--
-- The references must be created on the caller process.
runModFinalizerRefs :: Pipe -> RemoteRef (IORef QState)
                    -> [RemoteRef (TH.Q ())]
                    -> IO ()
runModFinalizerRefs :: Pipe -> RemoteRef (IORef QState) -> [RemoteRef (Q ())] -> IO ()
runModFinalizerRefs Pipe
pipe RemoteRef (IORef QState)
rstate [RemoteRef (Q ())]
qrefs = do
  [Q ()]
qs <- (RemoteRef (Q ()) -> IO (Q ())) -> [RemoteRef (Q ())] -> IO [Q ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
External instance of the constraint type Monad IO
External instance of the constraint type Traversable []
mapM RemoteRef (Q ()) -> IO (Q ())
forall a. RemoteRef a -> IO a
localRef [RemoteRef (Q ())]
qrefs
  IORef QState
qstateref <- RemoteRef (IORef QState) -> IO (IORef QState)
forall a. RemoteRef a -> IO a
localRef RemoteRef (IORef QState)
rstate
  QState
qstate <- IORef QState -> IO QState
forall a. IORef a -> IO a
readIORef IORef QState
qstateref
  ((), QState)
_ <- GHCiQ () -> QState -> IO ((), QState)
forall a. GHCiQ a -> QState -> IO (a, QState)
runGHCiQ (Q () -> GHCiQ ()
forall (m :: * -> *) a. Quasi m => Q a -> m a
Instance of class: Quasi of the constraint type Quasi GHCiQ
TH.runQ (Q () -> GHCiQ ()) -> Q () -> GHCiQ ()
forall a b. (a -> b) -> a -> b
$ [Q ()] -> Q ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
External instance of the constraint type Monad Q
External instance of the constraint type Foldable []
sequence_ [Q ()]
qs) QState
qstate { qsPipe :: Pipe
qsPipe = Pipe
pipe }
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ()

-- | The implementation of the 'RunTH' message
runTH
  :: Pipe
  -> RemoteRef (IORef QState)
      -- ^ The TH state, created by 'startTH'
  -> HValueRef
      -- ^ The splice to run
  -> THResultType
      -- ^ What kind of splice it is
  -> Maybe TH.Loc
      -- ^ The source location
  -> IO ByteString
      -- ^ Returns an (encoded) result that depends on the THResultType

runTH :: Pipe
-> RemoteRef (IORef QState)
-> HValueRef
-> THResultType
-> Maybe Loc
-> IO ByteString
runTH Pipe
pipe RemoteRef (IORef QState)
rstate HValueRef
rhv THResultType
ty Maybe Loc
mb_loc = do
  HValue
hv <- HValueRef -> IO HValue
forall a. RemoteRef a -> IO a
localRef HValueRef
rhv
  case THResultType
ty of
    THResultType
THExp -> Pipe
-> RemoteRef (IORef QState) -> Maybe Loc -> Q Exp -> IO ByteString
forall a.
Binary a =>
Pipe
-> RemoteRef (IORef QState) -> Maybe Loc -> Q a -> IO ByteString
External instance of the constraint type Binary Exp
runTHQ Pipe
pipe RemoteRef (IORef QState)
rstate Maybe Loc
mb_loc (HValue -> Q Exp
forall a b. a -> b
unsafeCoerce HValue
hv :: TH.Q TH.Exp)
    THResultType
THPat -> Pipe
-> RemoteRef (IORef QState) -> Maybe Loc -> Q Pat -> IO ByteString
forall a.
Binary a =>
Pipe
-> RemoteRef (IORef QState) -> Maybe Loc -> Q a -> IO ByteString
External instance of the constraint type Binary Pat
runTHQ Pipe
pipe RemoteRef (IORef QState)
rstate Maybe Loc
mb_loc (HValue -> Q Pat
forall a b. a -> b
unsafeCoerce HValue
hv :: TH.Q TH.Pat)
    THResultType
THType -> Pipe
-> RemoteRef (IORef QState) -> Maybe Loc -> Q Type -> IO ByteString
forall a.
Binary a =>
Pipe
-> RemoteRef (IORef QState) -> Maybe Loc -> Q a -> IO ByteString
External instance of the constraint type Binary Type
runTHQ Pipe
pipe RemoteRef (IORef QState)
rstate Maybe Loc
mb_loc (HValue -> Q Type
forall a b. a -> b
unsafeCoerce HValue
hv :: TH.Q TH.Type)
    THResultType
THDec -> Pipe
-> RemoteRef (IORef QState)
-> Maybe Loc
-> Q [Dec]
-> IO ByteString
forall a.
Binary a =>
Pipe
-> RemoteRef (IORef QState) -> Maybe Loc -> Q a -> IO ByteString
External instance of the constraint type forall a. Binary a => Binary [a]
External instance of the constraint type Binary Dec
runTHQ Pipe
pipe RemoteRef (IORef QState)
rstate Maybe Loc
mb_loc (HValue -> Q [Dec]
forall a b. a -> b
unsafeCoerce HValue
hv :: TH.Q [TH.Dec])
    THResultType
THAnnWrapper -> do
      AnnotationWrapper
hv <- HValue -> AnnotationWrapper
forall a b. a -> b
unsafeCoerce (HValue -> AnnotationWrapper) -> IO HValue -> IO AnnotationWrapper
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
<$> HValueRef -> IO HValue
forall a. RemoteRef a -> IO a
localRef HValueRef
rhv
      case AnnotationWrapper
hv :: AnnotationWrapper of
        AnnotationWrapper a
thing -> ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$!
          ByteString -> ByteString
LB.toStrict (Put -> ByteString
runPut (Serialized -> Put
forall t. Binary t => t -> Put
External instance of the constraint type Binary Serialized
put ((a -> [Word8]) -> a -> Serialized
forall a. Typeable a => (a -> [Word8]) -> a -> Serialized
External instance of the constraint type forall a. Data a => Typeable a
Evidence bound by a pattern of the constraint type Data a
toSerialized a -> [Word8]
forall a. Data a => a -> [Word8]
Evidence bound by a pattern of the constraint type Data a
serializeWithData a
thing)))

-- | Run a Q computation.
runTHQ
  :: Binary a => Pipe -> RemoteRef (IORef QState) -> Maybe TH.Loc -> TH.Q a
  -> IO ByteString
runTHQ :: Pipe
-> RemoteRef (IORef QState) -> Maybe Loc -> Q a -> IO ByteString
runTHQ Pipe
pipe RemoteRef (IORef QState)
rstate Maybe Loc
mb_loc Q a
ghciq = do
  IORef QState
qstateref <- RemoteRef (IORef QState) -> IO (IORef QState)
forall a. RemoteRef a -> IO a
localRef RemoteRef (IORef QState)
rstate
  QState
qstate <- IORef QState -> IO QState
forall a. IORef a -> IO a
readIORef IORef QState
qstateref
  let st :: QState
st = QState
qstate { qsLocation :: Maybe Loc
qsLocation = Maybe Loc
mb_loc, qsPipe :: Pipe
qsPipe = Pipe
pipe }
  (a
r,QState
new_state) <- GHCiQ a -> QState -> IO (a, QState)
forall a. GHCiQ a -> QState -> IO (a, QState)
runGHCiQ (Q a -> GHCiQ a
forall (m :: * -> *) a. Quasi m => Q a -> m a
Instance of class: Quasi of the constraint type Quasi GHCiQ
TH.runQ Q a
ghciq) QState
st
  IORef QState -> QState -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef QState
qstateref QState
new_state
  ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString
LB.toStrict (Put -> ByteString
runPut (a -> Put
forall t. Binary t => t -> Put
Evidence bound by a type signature of the constraint type Binary a
put a
r))