{-# LANGUAGE GADTs, DeriveGeneric, StandaloneDeriving, ScopedTypeVariables,
    GeneralizedNewtypeDeriving, ExistentialQuantification, RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-orphans #-}

-- |
-- Remote GHCi message types and serialization.
--
-- For details on Remote GHCi, see Note [Remote GHCi] in
-- compiler/ghci/GHCi.hs.
--
module GHCi.Message
  ( Message(..), Msg(..)
  , THMessage(..), THMsg(..)
  , QResult(..)
  , EvalStatus_(..), EvalStatus, EvalResult(..), EvalOpts(..), EvalExpr(..)
  , SerializableException(..)
  , toSerializableException, fromSerializableException
  , THResult(..), THResultType(..)
  , ResumeContext(..)
  , QState(..)
  , getMessage, putMessage, getTHMessage, putTHMessage
  , Pipe(..), remoteCall, remoteTHCall, readPipe, writePipe
  ) where

import Prelude -- See note [Why do we import Prelude here?]
import GHCi.RemoteTypes
import GHCi.FFI
import GHCi.TH.Binary ()
import GHCi.BreakArray

import GHC.LanguageExtensions
import GHC.Exts.Heap
import GHC.ForeignSrcLang
import GHC.Fingerprint
import Control.Concurrent
import Control.Exception
import Data.Binary
import Data.Binary.Get
import Data.Binary.Put
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
import Data.Dynamic
import Data.Typeable (TypeRep)
import Data.IORef
import Data.Map (Map)
import Foreign
import GHC.Generics
import GHC.Stack.CCS
import qualified Language.Haskell.TH        as TH
import qualified Language.Haskell.TH.Syntax as TH
import System.Exit
import System.IO
import System.IO.Error

-- -----------------------------------------------------------------------------
-- The RPC protocol between GHC and the interactive server

-- | A @Message a@ is a message that returns a value of type @a@.
-- These are requests sent from GHC to the server.
data Message a where
  -- | Exit the iserv process
  Shutdown :: Message ()

  -- RTS Linker -------------------------------------------

  -- These all invoke the corresponding functions in the RTS Linker API.
  InitLinker :: Message ()
  LookupSymbol :: String -> Message (Maybe (RemotePtr ()))
  LookupClosure :: String -> Message (Maybe HValueRef)
  LoadDLL :: String -> Message (Maybe String)
  LoadArchive :: String -> Message () -- error?
  LoadObj :: String -> Message () -- error?
  UnloadObj :: String -> Message () -- error?
  AddLibrarySearchPath :: String -> Message (RemotePtr ())
  RemoveLibrarySearchPath :: RemotePtr () -> Message Bool
  ResolveObjs :: Message Bool
  FindSystemLibrary :: String -> Message (Maybe String)

  -- Interpreter -------------------------------------------

  -- | Create a set of BCO objects, and return HValueRefs to them
  -- Note: Each ByteString contains a Binary-encoded [ResolvedBCO], not
  -- a ResolvedBCO. The list is to allow us to serialise the ResolvedBCOs
  -- in parallel. See @createBCOs@ in compiler/ghci/GHCi.hsc.
  CreateBCOs :: [LB.ByteString] -> Message [HValueRef]

  -- | Release 'HValueRef's
  FreeHValueRefs :: [HValueRef] -> Message ()

  -- | Add entries to the Static Pointer Table
  AddSptEntry :: Fingerprint -> HValueRef -> Message ()

  -- | Malloc some data and return a 'RemotePtr' to it
  MallocData :: ByteString -> Message (RemotePtr ())
  MallocStrings :: [ByteString] -> Message [RemotePtr ()]

  -- | Calls 'GHCi.FFI.prepareForeignCall'
  PrepFFI :: FFIConv -> [FFIType] -> FFIType -> Message (RemotePtr C_ffi_cif)

  -- | Free data previously created by 'PrepFFI'
  FreeFFI :: RemotePtr C_ffi_cif -> Message ()

  -- | Create an info table for a constructor
  MkConInfoTable
   :: Int     -- ptr words
   -> Int     -- non-ptr words
   -> Int     -- constr tag
   -> Int     -- pointer tag
   -> [Word8] -- constructor desccription
   -> Message (RemotePtr StgInfoTable)

  -- | Evaluate a statement
  EvalStmt
    :: EvalOpts
    -> EvalExpr HValueRef {- IO [a] -}
    -> Message (EvalStatus [HValueRef]) {- [a] -}

  -- | Resume evaluation of a statement after a breakpoint
  ResumeStmt
   :: EvalOpts
   -> RemoteRef (ResumeContext [HValueRef])
   -> Message (EvalStatus [HValueRef])

  -- | Abandon evaluation of a statement after a breakpoint
  AbandonStmt
   :: RemoteRef (ResumeContext [HValueRef])
   -> Message ()

  -- | Evaluate something of type @IO String@
  EvalString
    :: HValueRef {- IO String -}
    -> Message (EvalResult String)

  -- | Evaluate something of type @String -> IO String@
  EvalStringToString
    :: HValueRef {- String -> IO String -}
    -> String
    -> Message (EvalResult String)

  -- | Evaluate something of type @IO ()@
  EvalIO
   :: HValueRef {- IO a -}
   -> Message (EvalResult ())

  -- | Create a set of CostCentres with the same module name
  MkCostCentres
   :: String     -- module, RemotePtr so it can be shared
   -> [(String,String)] -- (name, SrcSpan)
   -> Message [RemotePtr CostCentre]

  -- | Show a 'CostCentreStack' as a @[String]@
  CostCentreStackInfo
   :: RemotePtr CostCentreStack
   -> Message [String]

  -- | Create a new array of breakpoint flags
  NewBreakArray
   :: Int                               -- size
   -> Message (RemoteRef BreakArray)

  -- | Enable a breakpoint
  EnableBreakpoint
   :: RemoteRef BreakArray
   -> Int                               -- index
   -> Bool                              -- on or off
   -> Message ()

  -- | Query the status of a breakpoint (True <=> enabled)
  BreakpointStatus
   :: RemoteRef BreakArray
   -> Int                               -- index
   -> Message Bool                      -- True <=> enabled

  -- | Get a reference to a free variable at a breakpoint
  GetBreakpointVar
   :: HValueRef                         -- the AP_STACK from EvalBreak
   -> Int
   -> Message (Maybe HValueRef)

  -- Template Haskell -------------------------------------------
  -- For more details on how TH works with Remote GHCi, see
  -- Note [Remote Template Haskell] in libraries/ghci/GHCi/TH.hs.

  -- | Start a new TH module, return a state token that should be
  StartTH :: Message (RemoteRef (IORef QState))

  -- | Evaluate a TH computation.
  --
  -- Returns a ByteString, because we have to force the result
  -- before returning it to ensure there are no errors lurking
  -- in it.  The TH types don't have NFData instances, and even if
  -- they did, we have to serialize the value anyway, so we might
  -- as well serialize it to force it.
  RunTH
   :: RemoteRef (IORef QState)
   -> HValueRef {- e.g. TH.Q TH.Exp -}
   -> THResultType
   -> Maybe TH.Loc
   -> Message (QResult ByteString)

  -- | Run the given mod finalizers.
  RunModFinalizers :: RemoteRef (IORef QState)
                   -> [RemoteRef (TH.Q ())]
                   -> Message (QResult ())

  -- | Remote interface to GHC.Exts.Heap.getClosureData. This is used by
  -- the GHCi debugger to inspect values in the heap for :print and
  -- type reconstruction.
  GetClosure
    :: HValueRef
    -> Message (GenClosure HValueRef)

  -- | Evaluate something. This is used to support :force in GHCi.
  Seq
    :: HValueRef
    -> Message (EvalResult ())

deriving instance Show (Message a)


-- | Template Haskell return values
data QResult a
  = QDone a
    -- ^ RunTH finished successfully; return value follows
  | QException String
    -- ^ RunTH threw an exception
  | QFail String
    -- ^ RunTH called 'fail'
  deriving ((forall x. QResult a -> Rep (QResult a) x)
-> (forall x. Rep (QResult a) x -> QResult a)
-> Generic (QResult a)
forall x. Rep (QResult a) x -> QResult a
forall x. QResult a -> Rep (QResult a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (QResult a) x -> QResult a
forall a x. QResult a -> Rep (QResult a) x
$cto :: forall a x. Rep (QResult a) x -> QResult a
$cfrom :: forall a x. QResult a -> Rep (QResult a) x
Generic, Int -> QResult a -> ShowS
[QResult a] -> ShowS
QResult a -> String
(Int -> QResult a -> ShowS)
-> (QResult a -> String)
-> ([QResult a] -> ShowS)
-> Show (QResult a)
forall a. Show a => Int -> QResult a -> ShowS
forall a. Show a => [QResult a] -> ShowS
forall a. Show a => QResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QResult a] -> ShowS
$cshowList :: forall a. Show a => [QResult a] -> ShowS
show :: QResult a -> String
$cshow :: forall a. Show a => QResult a -> String
showsPrec :: Int -> QResult a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> QResult a -> ShowS
Show)

instance Binary a => Binary (QResult a)


-- | Messages sent back to GHC from GHCi.TH, to implement the methods
-- of 'Quasi'.  For an overview of how TH works with Remote GHCi, see
-- Note [Remote Template Haskell] in GHCi.TH.
data THMessage a where
  NewName :: String -> THMessage (THResult TH.Name)
  Report :: Bool -> String -> THMessage (THResult ())
  LookupName :: Bool -> String -> THMessage (THResult (Maybe TH.Name))
  Reify :: TH.Name -> THMessage (THResult TH.Info)
  ReifyFixity :: TH.Name -> THMessage (THResult (Maybe TH.Fixity))
  ReifyInstances :: TH.Name -> [TH.Type] -> THMessage (THResult [TH.Dec])
  ReifyRoles :: TH.Name -> THMessage (THResult [TH.Role])
  ReifyAnnotations :: TH.AnnLookup -> TypeRep
    -> THMessage (THResult [ByteString])
  ReifyModule :: TH.Module -> THMessage (THResult TH.ModuleInfo)
  ReifyConStrictness :: TH.Name -> THMessage (THResult [TH.DecidedStrictness])

  AddDependentFile :: FilePath -> THMessage (THResult ())
  AddTempFile :: String -> THMessage (THResult FilePath)
  AddModFinalizer :: RemoteRef (TH.Q ()) -> THMessage (THResult ())
  AddCorePlugin :: String -> THMessage (THResult ())
  AddTopDecls :: [TH.Dec] -> THMessage (THResult ())
  AddForeignFilePath :: ForeignSrcLang -> FilePath -> THMessage (THResult ())
  IsExtEnabled :: Extension -> THMessage (THResult Bool)
  ExtsEnabled :: THMessage (THResult [Extension])

  StartRecover :: THMessage ()
  EndRecover :: Bool -> THMessage ()
  FailIfErrs :: THMessage (THResult ())

  -- | Indicates that this RunTH is finished, and the next message
  -- will be the result of RunTH (a QResult).
  RunTHDone :: THMessage ()

deriving instance Show (THMessage a)

data THMsg = forall a . (Binary a, Show a) => THMsg (THMessage a)

getTHMessage :: Get THMsg
getTHMessage :: Get THMsg
getTHMessage = do
  Word8
b <- Get Word8
getWord8
  case Word8
b of
    0  -> THMessage (THResult Name) -> THMsg
forall a. (Binary a, Show a) => THMessage a -> THMsg
THMsg (THMessage (THResult Name) -> THMsg)
-> (String -> THMessage (THResult Name)) -> String -> THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> THMessage (THResult Name)
NewName (String -> THMsg) -> Get String -> Get THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get
    1  -> THMessage (THResult ()) -> THMsg
forall a. (Binary a, Show a) => THMessage a -> THMsg
THMsg (THMessage (THResult ()) -> THMsg)
-> Get (THMessage (THResult ())) -> Get THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> String -> THMessage (THResult ())
Report (Bool -> String -> THMessage (THResult ()))
-> Get Bool -> Get (String -> THMessage (THResult ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
forall t. Binary t => Get t
get Get (String -> THMessage (THResult ()))
-> Get String -> Get (THMessage (THResult ()))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get String
forall t. Binary t => Get t
get)
    2  -> THMessage (THResult (Maybe Name)) -> THMsg
forall a. (Binary a, Show a) => THMessage a -> THMsg
THMsg (THMessage (THResult (Maybe Name)) -> THMsg)
-> Get (THMessage (THResult (Maybe Name))) -> Get THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> String -> THMessage (THResult (Maybe Name))
LookupName (Bool -> String -> THMessage (THResult (Maybe Name)))
-> Get Bool -> Get (String -> THMessage (THResult (Maybe Name)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
forall t. Binary t => Get t
get Get (String -> THMessage (THResult (Maybe Name)))
-> Get String -> Get (THMessage (THResult (Maybe Name)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get String
forall t. Binary t => Get t
get)
    3  -> THMessage (THResult Info) -> THMsg
forall a. (Binary a, Show a) => THMessage a -> THMsg
THMsg (THMessage (THResult Info) -> THMsg)
-> (Name -> THMessage (THResult Info)) -> Name -> THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> THMessage (THResult Info)
Reify (Name -> THMsg) -> Get Name -> Get THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Name
forall t. Binary t => Get t
get
    4  -> THMessage (THResult (Maybe Fixity)) -> THMsg
forall a. (Binary a, Show a) => THMessage a -> THMsg
THMsg (THMessage (THResult (Maybe Fixity)) -> THMsg)
-> (Name -> THMessage (THResult (Maybe Fixity))) -> Name -> THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> THMessage (THResult (Maybe Fixity))
ReifyFixity (Name -> THMsg) -> Get Name -> Get THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Name
forall t. Binary t => Get t
get
    5  -> THMessage (THResult [Dec]) -> THMsg
forall a. (Binary a, Show a) => THMessage a -> THMsg
THMsg (THMessage (THResult [Dec]) -> THMsg)
-> Get (THMessage (THResult [Dec])) -> Get THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Name -> [Type] -> THMessage (THResult [Dec])
ReifyInstances (Name -> [Type] -> THMessage (THResult [Dec]))
-> Get Name -> Get ([Type] -> THMessage (THResult [Dec]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Name
forall t. Binary t => Get t
get Get ([Type] -> THMessage (THResult [Dec]))
-> Get [Type] -> Get (THMessage (THResult [Dec]))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [Type]
forall t. Binary t => Get t
get)
    6  -> THMessage (THResult [Role]) -> THMsg
forall a. (Binary a, Show a) => THMessage a -> THMsg
THMsg (THMessage (THResult [Role]) -> THMsg)
-> (Name -> THMessage (THResult [Role])) -> Name -> THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> THMessage (THResult [Role])
ReifyRoles (Name -> THMsg) -> Get Name -> Get THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Name
forall t. Binary t => Get t
get
    7  -> THMessage (THResult [ByteString]) -> THMsg
forall a. (Binary a, Show a) => THMessage a -> THMsg
THMsg (THMessage (THResult [ByteString]) -> THMsg)
-> Get (THMessage (THResult [ByteString])) -> Get THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AnnLookup -> TypeRep -> THMessage (THResult [ByteString])
ReifyAnnotations (AnnLookup -> TypeRep -> THMessage (THResult [ByteString]))
-> Get AnnLookup
-> Get (TypeRep -> THMessage (THResult [ByteString]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get AnnLookup
forall t. Binary t => Get t
get Get (TypeRep -> THMessage (THResult [ByteString]))
-> Get TypeRep -> Get (THMessage (THResult [ByteString]))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get TypeRep
forall t. Binary t => Get t
get)
    8  -> THMessage (THResult ModuleInfo) -> THMsg
forall a. (Binary a, Show a) => THMessage a -> THMsg
THMsg (THMessage (THResult ModuleInfo) -> THMsg)
-> (Module -> THMessage (THResult ModuleInfo)) -> Module -> THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Module -> THMessage (THResult ModuleInfo)
ReifyModule (Module -> THMsg) -> Get Module -> Get THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Module
forall t. Binary t => Get t
get
    9  -> THMessage (THResult [DecidedStrictness]) -> THMsg
forall a. (Binary a, Show a) => THMessage a -> THMsg
THMsg (THMessage (THResult [DecidedStrictness]) -> THMsg)
-> (Name -> THMessage (THResult [DecidedStrictness]))
-> Name
-> THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> THMessage (THResult [DecidedStrictness])
ReifyConStrictness (Name -> THMsg) -> Get Name -> Get THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Name
forall t. Binary t => Get t
get
    10 -> THMessage (THResult ()) -> THMsg
forall a. (Binary a, Show a) => THMessage a -> THMsg
THMsg (THMessage (THResult ()) -> THMsg)
-> (String -> THMessage (THResult ())) -> String -> THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> THMessage (THResult ())
AddDependentFile (String -> THMsg) -> Get String -> Get THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get
    11 -> THMessage (THResult String) -> THMsg
forall a. (Binary a, Show a) => THMessage a -> THMsg
THMsg (THMessage (THResult String) -> THMsg)
-> (String -> THMessage (THResult String)) -> String -> THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> THMessage (THResult String)
AddTempFile (String -> THMsg) -> Get String -> Get THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get
    12 -> THMessage (THResult ()) -> THMsg
forall a. (Binary a, Show a) => THMessage a -> THMsg
THMsg (THMessage (THResult ()) -> THMsg)
-> ([Dec] -> THMessage (THResult ())) -> [Dec] -> THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Dec] -> THMessage (THResult ())
AddTopDecls ([Dec] -> THMsg) -> Get [Dec] -> Get THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Dec]
forall t. Binary t => Get t
get
    13 -> THMessage (THResult Bool) -> THMsg
forall a. (Binary a, Show a) => THMessage a -> THMsg
THMsg (THMessage (THResult Bool) -> THMsg)
-> Get (THMessage (THResult Bool)) -> Get THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Extension -> THMessage (THResult Bool)
IsExtEnabled (Extension -> THMessage (THResult Bool))
-> Get Extension -> Get (THMessage (THResult Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Extension
forall t. Binary t => Get t
get)
    14 -> THMessage (THResult [Extension]) -> THMsg
forall a. (Binary a, Show a) => THMessage a -> THMsg
THMsg (THMessage (THResult [Extension]) -> THMsg)
-> Get (THMessage (THResult [Extension])) -> Get THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> THMessage (THResult [Extension])
-> Get (THMessage (THResult [Extension]))
forall (m :: * -> *) a. Monad m => a -> m a
return THMessage (THResult [Extension])
ExtsEnabled
    15 -> THMessage () -> THMsg
forall a. (Binary a, Show a) => THMessage a -> THMsg
THMsg (THMessage () -> THMsg) -> Get (THMessage ()) -> Get THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> THMessage () -> Get (THMessage ())
forall (m :: * -> *) a. Monad m => a -> m a
return THMessage ()
StartRecover
    16 -> THMessage () -> THMsg
forall a. (Binary a, Show a) => THMessage a -> THMsg
THMsg (THMessage () -> THMsg) -> (Bool -> THMessage ()) -> Bool -> THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> THMessage ()
EndRecover (Bool -> THMsg) -> Get Bool -> Get THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
forall t. Binary t => Get t
get
    17 -> THMessage (THResult ()) -> THMsg
forall a. (Binary a, Show a) => THMessage a -> THMsg
THMsg (THMessage (THResult ()) -> THMsg)
-> Get (THMessage (THResult ())) -> Get THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> THMessage (THResult ()) -> Get (THMessage (THResult ()))
forall (m :: * -> *) a. Monad m => a -> m a
return THMessage (THResult ())
FailIfErrs
    18 -> THMsg -> Get THMsg
forall (m :: * -> *) a. Monad m => a -> m a
return (THMessage () -> THMsg
forall a. (Binary a, Show a) => THMessage a -> THMsg
THMsg THMessage ()
RunTHDone)
    19 -> THMessage (THResult ()) -> THMsg
forall a. (Binary a, Show a) => THMessage a -> THMsg
THMsg (THMessage (THResult ()) -> THMsg)
-> (RemoteRef (Q ()) -> THMessage (THResult ()))
-> RemoteRef (Q ())
-> THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RemoteRef (Q ()) -> THMessage (THResult ())
AddModFinalizer (RemoteRef (Q ()) -> THMsg) -> Get (RemoteRef (Q ())) -> Get THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (RemoteRef (Q ()))
forall t. Binary t => Get t
get
    20 -> THMessage (THResult ()) -> THMsg
forall a. (Binary a, Show a) => THMessage a -> THMsg
THMsg (THMessage (THResult ()) -> THMsg)
-> Get (THMessage (THResult ())) -> Get THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ForeignSrcLang -> String -> THMessage (THResult ())
AddForeignFilePath (ForeignSrcLang -> String -> THMessage (THResult ()))
-> Get ForeignSrcLang -> Get (String -> THMessage (THResult ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ForeignSrcLang
forall t. Binary t => Get t
get Get (String -> THMessage (THResult ()))
-> Get String -> Get (THMessage (THResult ()))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get String
forall t. Binary t => Get t
get)
    _  -> THMessage (THResult ()) -> THMsg
forall a. (Binary a, Show a) => THMessage a -> THMsg
THMsg (THMessage (THResult ()) -> THMsg)
-> (String -> THMessage (THResult ())) -> String -> THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> THMessage (THResult ())
AddCorePlugin (String -> THMsg) -> Get String -> Get THMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get

putTHMessage :: THMessage a -> Put
putTHMessage :: THMessage a -> Put
putTHMessage m :: THMessage a
m = case THMessage a
m of
  NewName a :: String
a                   -> Word8 -> Put
putWord8 0  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
a
  Report a :: Bool
a b :: String
b                  -> Word8 -> Put
putWord8 1  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Put
forall t. Binary t => t -> Put
put Bool
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
b
  LookupName a :: Bool
a b :: String
b              -> Word8 -> Put
putWord8 2  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Put
forall t. Binary t => t -> Put
put Bool
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
b
  Reify a :: Name
a                     -> Word8 -> Put
putWord8 3  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Name -> Put
forall t. Binary t => t -> Put
put Name
a
  ReifyFixity a :: Name
a               -> Word8 -> Put
putWord8 4  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Name -> Put
forall t. Binary t => t -> Put
put Name
a
  ReifyInstances a :: Name
a b :: [Type]
b          -> Word8 -> Put
putWord8 5  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Name -> Put
forall t. Binary t => t -> Put
put Name
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Type] -> Put
forall t. Binary t => t -> Put
put [Type]
b
  ReifyRoles a :: Name
a                -> Word8 -> Put
putWord8 6  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Name -> Put
forall t. Binary t => t -> Put
put Name
a
  ReifyAnnotations a :: AnnLookup
a b :: TypeRep
b        -> Word8 -> Put
putWord8 7  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AnnLookup -> Put
forall t. Binary t => t -> Put
put AnnLookup
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeRep -> Put
forall t. Binary t => t -> Put
put TypeRep
b
  ReifyModule a :: Module
a               -> Word8 -> Put
putWord8 8  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Module -> Put
forall t. Binary t => t -> Put
put Module
a
  ReifyConStrictness a :: Name
a        -> Word8 -> Put
putWord8 9  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Name -> Put
forall t. Binary t => t -> Put
put Name
a
  AddDependentFile a :: String
a          -> Word8 -> Put
putWord8 10 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
a
  AddTempFile a :: String
a               -> Word8 -> Put
putWord8 11 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
a
  AddTopDecls a :: [Dec]
a               -> Word8 -> Put
putWord8 12 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Dec] -> Put
forall t. Binary t => t -> Put
put [Dec]
a
  IsExtEnabled a :: Extension
a              -> Word8 -> Put
putWord8 13 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Extension -> Put
forall t. Binary t => t -> Put
put Extension
a
  ExtsEnabled                 -> Word8 -> Put
putWord8 14
  StartRecover                -> Word8 -> Put
putWord8 15
  EndRecover a :: Bool
a                -> Word8 -> Put
putWord8 16 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Put
forall t. Binary t => t -> Put
put Bool
a
  FailIfErrs                  -> Word8 -> Put
putWord8 17
  RunTHDone                   -> Word8 -> Put
putWord8 18
  AddModFinalizer a :: RemoteRef (Q ())
a           -> Word8 -> Put
putWord8 19 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RemoteRef (Q ()) -> Put
forall t. Binary t => t -> Put
put RemoteRef (Q ())
a
  AddForeignFilePath lang :: ForeignSrcLang
lang a :: String
a   -> Word8 -> Put
putWord8 20 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ForeignSrcLang -> Put
forall t. Binary t => t -> Put
put ForeignSrcLang
lang Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
a
  AddCorePlugin a :: String
a             -> Word8 -> Put
putWord8 21 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
a


data EvalOpts = EvalOpts
  { EvalOpts -> Bool
useSandboxThread :: Bool
  , EvalOpts -> Bool
singleStep :: Bool
  , EvalOpts -> Bool
breakOnException :: Bool
  , EvalOpts -> Bool
breakOnError :: Bool
  }
  deriving ((forall x. EvalOpts -> Rep EvalOpts x)
-> (forall x. Rep EvalOpts x -> EvalOpts) -> Generic EvalOpts
forall x. Rep EvalOpts x -> EvalOpts
forall x. EvalOpts -> Rep EvalOpts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EvalOpts x -> EvalOpts
$cfrom :: forall x. EvalOpts -> Rep EvalOpts x
Generic, Int -> EvalOpts -> ShowS
[EvalOpts] -> ShowS
EvalOpts -> String
(Int -> EvalOpts -> ShowS)
-> (EvalOpts -> String) -> ([EvalOpts] -> ShowS) -> Show EvalOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvalOpts] -> ShowS
$cshowList :: [EvalOpts] -> ShowS
show :: EvalOpts -> String
$cshow :: EvalOpts -> String
showsPrec :: Int -> EvalOpts -> ShowS
$cshowsPrec :: Int -> EvalOpts -> ShowS
Show)

instance Binary EvalOpts

data ResumeContext a = ResumeContext
  { ResumeContext a -> MVar ()
resumeBreakMVar :: MVar ()
  , ResumeContext a -> MVar (EvalStatus a)
resumeStatusMVar :: MVar (EvalStatus a)
  , ResumeContext a -> ThreadId
resumeThreadId :: ThreadId
  }

-- | We can pass simple expressions to EvalStmt, consisting of values
-- and application.  This allows us to wrap the statement to be
-- executed in another function, which is used by GHCi to implement
-- :set args and :set prog.  It might be worthwhile to extend this
-- little language in the future.
data EvalExpr a
  = EvalThis a
  | EvalApp (EvalExpr a) (EvalExpr a)
  deriving ((forall x. EvalExpr a -> Rep (EvalExpr a) x)
-> (forall x. Rep (EvalExpr a) x -> EvalExpr a)
-> Generic (EvalExpr a)
forall x. Rep (EvalExpr a) x -> EvalExpr a
forall x. EvalExpr a -> Rep (EvalExpr a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (EvalExpr a) x -> EvalExpr a
forall a x. EvalExpr a -> Rep (EvalExpr a) x
$cto :: forall a x. Rep (EvalExpr a) x -> EvalExpr a
$cfrom :: forall a x. EvalExpr a -> Rep (EvalExpr a) x
Generic, Int -> EvalExpr a -> ShowS
[EvalExpr a] -> ShowS
EvalExpr a -> String
(Int -> EvalExpr a -> ShowS)
-> (EvalExpr a -> String)
-> ([EvalExpr a] -> ShowS)
-> Show (EvalExpr a)
forall a. Show a => Int -> EvalExpr a -> ShowS
forall a. Show a => [EvalExpr a] -> ShowS
forall a. Show a => EvalExpr a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvalExpr a] -> ShowS
$cshowList :: forall a. Show a => [EvalExpr a] -> ShowS
show :: EvalExpr a -> String
$cshow :: forall a. Show a => EvalExpr a -> String
showsPrec :: Int -> EvalExpr a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> EvalExpr a -> ShowS
Show)

instance Binary a => Binary (EvalExpr a)

type EvalStatus a = EvalStatus_ a a

data EvalStatus_ a b
  = EvalComplete Word64 (EvalResult a)
  | EvalBreak Bool
       HValueRef{- AP_STACK -}
       Int {- break index -}
       Int {- uniq of ModuleName -}
       (RemoteRef (ResumeContext b))
       (RemotePtr CostCentreStack) -- Cost centre stack
  deriving ((forall x. EvalStatus_ a b -> Rep (EvalStatus_ a b) x)
-> (forall x. Rep (EvalStatus_ a b) x -> EvalStatus_ a b)
-> Generic (EvalStatus_ a b)
forall x. Rep (EvalStatus_ a b) x -> EvalStatus_ a b
forall x. EvalStatus_ a b -> Rep (EvalStatus_ a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (EvalStatus_ a b) x -> EvalStatus_ a b
forall a b x. EvalStatus_ a b -> Rep (EvalStatus_ a b) x
$cto :: forall a b x. Rep (EvalStatus_ a b) x -> EvalStatus_ a b
$cfrom :: forall a b x. EvalStatus_ a b -> Rep (EvalStatus_ a b) x
Generic, Int -> EvalStatus_ a b -> ShowS
[EvalStatus_ a b] -> ShowS
EvalStatus_ a b -> String
(Int -> EvalStatus_ a b -> ShowS)
-> (EvalStatus_ a b -> String)
-> ([EvalStatus_ a b] -> ShowS)
-> Show (EvalStatus_ a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. Show a => Int -> EvalStatus_ a b -> ShowS
forall a b. Show a => [EvalStatus_ a b] -> ShowS
forall a b. Show a => EvalStatus_ a b -> String
showList :: [EvalStatus_ a b] -> ShowS
$cshowList :: forall a b. Show a => [EvalStatus_ a b] -> ShowS
show :: EvalStatus_ a b -> String
$cshow :: forall a b. Show a => EvalStatus_ a b -> String
showsPrec :: Int -> EvalStatus_ a b -> ShowS
$cshowsPrec :: forall a b. Show a => Int -> EvalStatus_ a b -> ShowS
Show)

instance Binary a => Binary (EvalStatus_ a b)

data EvalResult a
  = EvalException SerializableException
  | EvalSuccess a
  deriving ((forall x. EvalResult a -> Rep (EvalResult a) x)
-> (forall x. Rep (EvalResult a) x -> EvalResult a)
-> Generic (EvalResult a)
forall x. Rep (EvalResult a) x -> EvalResult a
forall x. EvalResult a -> Rep (EvalResult a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (EvalResult a) x -> EvalResult a
forall a x. EvalResult a -> Rep (EvalResult a) x
$cto :: forall a x. Rep (EvalResult a) x -> EvalResult a
$cfrom :: forall a x. EvalResult a -> Rep (EvalResult a) x
Generic, Int -> EvalResult a -> ShowS
[EvalResult a] -> ShowS
EvalResult a -> String
(Int -> EvalResult a -> ShowS)
-> (EvalResult a -> String)
-> ([EvalResult a] -> ShowS)
-> Show (EvalResult a)
forall a. Show a => Int -> EvalResult a -> ShowS
forall a. Show a => [EvalResult a] -> ShowS
forall a. Show a => EvalResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvalResult a] -> ShowS
$cshowList :: forall a. Show a => [EvalResult a] -> ShowS
show :: EvalResult a -> String
$cshow :: forall a. Show a => EvalResult a -> String
showsPrec :: Int -> EvalResult a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> EvalResult a -> ShowS
Show)

instance Binary a => Binary (EvalResult a)

-- SomeException can't be serialized because it contains dynamic
-- types.  However, we do very limited things with the exceptions that
-- are thrown by interpreted computations:
--
-- * We print them, e.g. "*** Exception: <something>"
-- * UserInterrupt has a special meaning
-- * In ghc -e, exitWith should exit with the appropriate exit code
--
-- So all we need to do is distinguish UserInterrupt and ExitCode, and
-- all other exceptions can be represented by their 'show' string.
--
data SerializableException
  = EUserInterrupt
  | EExitCode ExitCode
  | EOtherException String
  deriving ((forall x. SerializableException -> Rep SerializableException x)
-> (forall x. Rep SerializableException x -> SerializableException)
-> Generic SerializableException
forall x. Rep SerializableException x -> SerializableException
forall x. SerializableException -> Rep SerializableException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SerializableException x -> SerializableException
$cfrom :: forall x. SerializableException -> Rep SerializableException x
Generic, Int -> SerializableException -> ShowS
[SerializableException] -> ShowS
SerializableException -> String
(Int -> SerializableException -> ShowS)
-> (SerializableException -> String)
-> ([SerializableException] -> ShowS)
-> Show SerializableException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SerializableException] -> ShowS
$cshowList :: [SerializableException] -> ShowS
show :: SerializableException -> String
$cshow :: SerializableException -> String
showsPrec :: Int -> SerializableException -> ShowS
$cshowsPrec :: Int -> SerializableException -> ShowS
Show)

toSerializableException :: SomeException -> SerializableException
toSerializableException :: SomeException -> SerializableException
toSerializableException ex :: SomeException
ex
  | Just UserInterrupt <- SomeException -> Maybe AsyncException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
ex  = SerializableException
EUserInterrupt
  | Just (ExitCode
ec::ExitCode) <- SomeException -> Maybe ExitCode
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
ex = (ExitCode -> SerializableException
EExitCode ExitCode
ec)
  | Bool
otherwise = String -> SerializableException
EOtherException (SomeException -> String
forall a. Show a => a -> String
show (SomeException
ex :: SomeException))

fromSerializableException :: SerializableException -> SomeException
fromSerializableException :: SerializableException -> SomeException
fromSerializableException EUserInterrupt = AsyncException -> SomeException
forall e. Exception e => e -> SomeException
toException AsyncException
UserInterrupt
fromSerializableException (EExitCode c :: ExitCode
c) = ExitCode -> SomeException
forall e. Exception e => e -> SomeException
toException ExitCode
c
fromSerializableException (EOtherException str :: String
str) = ErrorCall -> SomeException
forall e. Exception e => e -> SomeException
toException (String -> ErrorCall
ErrorCall String
str)

instance Binary ExitCode
instance Binary SerializableException

data THResult a
  = THException String
  | THComplete a
  deriving ((forall x. THResult a -> Rep (THResult a) x)
-> (forall x. Rep (THResult a) x -> THResult a)
-> Generic (THResult a)
forall x. Rep (THResult a) x -> THResult a
forall x. THResult a -> Rep (THResult a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (THResult a) x -> THResult a
forall a x. THResult a -> Rep (THResult a) x
$cto :: forall a x. Rep (THResult a) x -> THResult a
$cfrom :: forall a x. THResult a -> Rep (THResult a) x
Generic, Int -> THResult a -> ShowS
[THResult a] -> ShowS
THResult a -> String
(Int -> THResult a -> ShowS)
-> (THResult a -> String)
-> ([THResult a] -> ShowS)
-> Show (THResult a)
forall a. Show a => Int -> THResult a -> ShowS
forall a. Show a => [THResult a] -> ShowS
forall a. Show a => THResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [THResult a] -> ShowS
$cshowList :: forall a. Show a => [THResult a] -> ShowS
show :: THResult a -> String
$cshow :: forall a. Show a => THResult a -> String
showsPrec :: Int -> THResult a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> THResult a -> ShowS
Show)

instance Binary a => Binary (THResult a)

data THResultType = THExp | THPat | THType | THDec | THAnnWrapper
  deriving (Int -> THResultType
THResultType -> Int
THResultType -> [THResultType]
THResultType -> THResultType
THResultType -> THResultType -> [THResultType]
THResultType -> THResultType -> THResultType -> [THResultType]
(THResultType -> THResultType)
-> (THResultType -> THResultType)
-> (Int -> THResultType)
-> (THResultType -> Int)
-> (THResultType -> [THResultType])
-> (THResultType -> THResultType -> [THResultType])
-> (THResultType -> THResultType -> [THResultType])
-> (THResultType -> THResultType -> THResultType -> [THResultType])
-> Enum THResultType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: THResultType -> THResultType -> THResultType -> [THResultType]
$cenumFromThenTo :: THResultType -> THResultType -> THResultType -> [THResultType]
enumFromTo :: THResultType -> THResultType -> [THResultType]
$cenumFromTo :: THResultType -> THResultType -> [THResultType]
enumFromThen :: THResultType -> THResultType -> [THResultType]
$cenumFromThen :: THResultType -> THResultType -> [THResultType]
enumFrom :: THResultType -> [THResultType]
$cenumFrom :: THResultType -> [THResultType]
fromEnum :: THResultType -> Int
$cfromEnum :: THResultType -> Int
toEnum :: Int -> THResultType
$ctoEnum :: Int -> THResultType
pred :: THResultType -> THResultType
$cpred :: THResultType -> THResultType
succ :: THResultType -> THResultType
$csucc :: THResultType -> THResultType
Enum, Int -> THResultType -> ShowS
[THResultType] -> ShowS
THResultType -> String
(Int -> THResultType -> ShowS)
-> (THResultType -> String)
-> ([THResultType] -> ShowS)
-> Show THResultType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [THResultType] -> ShowS
$cshowList :: [THResultType] -> ShowS
show :: THResultType -> String
$cshow :: THResultType -> String
showsPrec :: Int -> THResultType -> ShowS
$cshowsPrec :: Int -> THResultType -> ShowS
Show, (forall x. THResultType -> Rep THResultType x)
-> (forall x. Rep THResultType x -> THResultType)
-> Generic THResultType
forall x. Rep THResultType x -> THResultType
forall x. THResultType -> Rep THResultType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep THResultType x -> THResultType
$cfrom :: forall x. THResultType -> Rep THResultType x
Generic)

instance Binary THResultType

-- | The server-side Template Haskell state.  This is created by the
-- StartTH message.  A new one is created per module that GHC
-- typechecks.
data QState = QState
  { QState -> Map TypeRep Dynamic
qsMap        :: Map TypeRep Dynamic
       -- ^ persistent data between splices in a module
  , QState -> Maybe Loc
qsLocation   :: Maybe TH.Loc
       -- ^ location for current splice, if any
  , QState -> Pipe
qsPipe :: Pipe
       -- ^ pipe to communicate with GHC
  }
instance Show QState where show :: QState -> String
show _ = "<QState>"

-- Orphan instances of Binary for Ptr / FunPtr by conversion to Word64.
-- This is to support Binary StgInfoTable which includes these.
instance Binary (Ptr a) where
  put :: Ptr a -> Put
put p :: Ptr a
p = Word64 -> Put
forall t. Binary t => t -> Put
put (WordPtr -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Ptr a -> WordPtr
forall a. Ptr a -> WordPtr
ptrToWordPtr Ptr a
p) :: Word64)
  get :: Get (Ptr a)
get = (WordPtr -> Ptr a
forall a. WordPtr -> Ptr a
wordPtrToPtr (WordPtr -> Ptr a) -> (Word64 -> WordPtr) -> Word64 -> Ptr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> WordPtr
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Word64 -> Ptr a) -> Get Word64 -> Get (Ptr a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Word64
forall t. Binary t => Get t
get :: Get Word64)

instance Binary (FunPtr a) where
  put :: FunPtr a -> Put
put = Ptr Any -> Put
forall t. Binary t => t -> Put
put (Ptr Any -> Put) -> (FunPtr a -> Ptr Any) -> FunPtr a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunPtr a -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr
  get :: Get (FunPtr a)
get = Ptr Any -> FunPtr a
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr (Ptr Any -> FunPtr a) -> Get (Ptr Any) -> Get (FunPtr a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Ptr Any)
forall t. Binary t => Get t
get

-- Binary instances to support the GetClosure message
instance Binary StgInfoTable
instance Binary ClosureType
instance Binary PrimType
instance Binary a => Binary (GenClosure a)

data Msg = forall a . (Binary a, Show a) => Msg (Message a)

getMessage :: Get Msg
getMessage :: Get Msg
getMessage = do
    Word8
b <- Get Word8
getWord8
    case Word8
b of
      0  -> Message () -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message () -> Msg) -> Get (Message ()) -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message () -> Get (Message ())
forall (m :: * -> *) a. Monad m => a -> m a
return Message ()
Shutdown
      1  -> Message () -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message () -> Msg) -> Get (Message ()) -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message () -> Get (Message ())
forall (m :: * -> *) a. Monad m => a -> m a
return Message ()
InitLinker
      2  -> Message (Maybe (RemotePtr ())) -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message (Maybe (RemotePtr ())) -> Msg)
-> (String -> Message (Maybe (RemotePtr ()))) -> String -> Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Message (Maybe (RemotePtr ()))
LookupSymbol (String -> Msg) -> Get String -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get
      3  -> Message (Maybe HValueRef) -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message (Maybe HValueRef) -> Msg)
-> (String -> Message (Maybe HValueRef)) -> String -> Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Message (Maybe HValueRef)
LookupClosure (String -> Msg) -> Get String -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get
      4  -> Message (Maybe String) -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message (Maybe String) -> Msg)
-> (String -> Message (Maybe String)) -> String -> Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Message (Maybe String)
LoadDLL (String -> Msg) -> Get String -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get
      5  -> Message () -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message () -> Msg) -> (String -> Message ()) -> String -> Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Message ()
LoadArchive (String -> Msg) -> Get String -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get
      6  -> Message () -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message () -> Msg) -> (String -> Message ()) -> String -> Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Message ()
LoadObj (String -> Msg) -> Get String -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get
      7  -> Message () -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message () -> Msg) -> (String -> Message ()) -> String -> Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Message ()
UnloadObj (String -> Msg) -> Get String -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get
      8  -> Message (RemotePtr ()) -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message (RemotePtr ()) -> Msg)
-> (String -> Message (RemotePtr ())) -> String -> Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Message (RemotePtr ())
AddLibrarySearchPath (String -> Msg) -> Get String -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get
      9  -> Message Bool -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message Bool -> Msg)
-> (RemotePtr () -> Message Bool) -> RemotePtr () -> Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RemotePtr () -> Message Bool
RemoveLibrarySearchPath (RemotePtr () -> Msg) -> Get (RemotePtr ()) -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (RemotePtr ())
forall t. Binary t => Get t
get
      10 -> Message Bool -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message Bool -> Msg) -> Get (Message Bool) -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message Bool -> Get (Message Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return Message Bool
ResolveObjs
      11 -> Message (Maybe String) -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message (Maybe String) -> Msg)
-> (String -> Message (Maybe String)) -> String -> Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Message (Maybe String)
FindSystemLibrary (String -> Msg) -> Get String -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get
      12 -> Message [HValueRef] -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message [HValueRef] -> Msg)
-> ([ByteString] -> Message [HValueRef]) -> [ByteString] -> Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString] -> Message [HValueRef]
CreateBCOs ([ByteString] -> Msg) -> Get [ByteString] -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [ByteString]
forall t. Binary t => Get t
get
      13 -> Message () -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message () -> Msg)
-> ([HValueRef] -> Message ()) -> [HValueRef] -> Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HValueRef] -> Message ()
FreeHValueRefs ([HValueRef] -> Msg) -> Get [HValueRef] -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [HValueRef]
forall t. Binary t => Get t
get
      14 -> Message (RemotePtr ()) -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message (RemotePtr ()) -> Msg)
-> (ByteString -> Message (RemotePtr ())) -> ByteString -> Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Message (RemotePtr ())
MallocData (ByteString -> Msg) -> Get ByteString -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
forall t. Binary t => Get t
get
      15 -> Message [RemotePtr ()] -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message [RemotePtr ()] -> Msg)
-> ([ByteString] -> Message [RemotePtr ()]) -> [ByteString] -> Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString] -> Message [RemotePtr ()]
MallocStrings ([ByteString] -> Msg) -> Get [ByteString] -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [ByteString]
forall t. Binary t => Get t
get
      16 -> Message (RemotePtr C_ffi_cif) -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message (RemotePtr C_ffi_cif) -> Msg)
-> Get (Message (RemotePtr C_ffi_cif)) -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FFIConv -> [FFIType] -> FFIType -> Message (RemotePtr C_ffi_cif)
PrepFFI (FFIConv -> [FFIType] -> FFIType -> Message (RemotePtr C_ffi_cif))
-> Get FFIConv
-> Get ([FFIType] -> FFIType -> Message (RemotePtr C_ffi_cif))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get FFIConv
forall t. Binary t => Get t
get Get ([FFIType] -> FFIType -> Message (RemotePtr C_ffi_cif))
-> Get [FFIType] -> Get (FFIType -> Message (RemotePtr C_ffi_cif))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [FFIType]
forall t. Binary t => Get t
get Get (FFIType -> Message (RemotePtr C_ffi_cif))
-> Get FFIType -> Get (Message (RemotePtr C_ffi_cif))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FFIType
forall t. Binary t => Get t
get)
      17 -> Message () -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message () -> Msg)
-> (RemotePtr C_ffi_cif -> Message ())
-> RemotePtr C_ffi_cif
-> Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RemotePtr C_ffi_cif -> Message ()
FreeFFI (RemotePtr C_ffi_cif -> Msg)
-> Get (RemotePtr C_ffi_cif) -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (RemotePtr C_ffi_cif)
forall t. Binary t => Get t
get
      18 -> Message (RemotePtr StgInfoTable) -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message (RemotePtr StgInfoTable) -> Msg)
-> Get (Message (RemotePtr StgInfoTable)) -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int
-> Int -> Int -> Int -> [Word8] -> Message (RemotePtr StgInfoTable)
MkConInfoTable (Int
 -> Int
 -> Int
 -> Int
 -> [Word8]
 -> Message (RemotePtr StgInfoTable))
-> Get Int
-> Get
     (Int -> Int -> Int -> [Word8] -> Message (RemotePtr StgInfoTable))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
forall t. Binary t => Get t
get Get
  (Int -> Int -> Int -> [Word8] -> Message (RemotePtr StgInfoTable))
-> Get Int
-> Get (Int -> Int -> [Word8] -> Message (RemotePtr StgInfoTable))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
forall t. Binary t => Get t
get Get (Int -> Int -> [Word8] -> Message (RemotePtr StgInfoTable))
-> Get Int
-> Get (Int -> [Word8] -> Message (RemotePtr StgInfoTable))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
forall t. Binary t => Get t
get Get (Int -> [Word8] -> Message (RemotePtr StgInfoTable))
-> Get Int -> Get ([Word8] -> Message (RemotePtr StgInfoTable))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
forall t. Binary t => Get t
get Get ([Word8] -> Message (RemotePtr StgInfoTable))
-> Get [Word8] -> Get (Message (RemotePtr StgInfoTable))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [Word8]
forall t. Binary t => Get t
get)
      19 -> Message (EvalStatus [HValueRef]) -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message (EvalStatus [HValueRef]) -> Msg)
-> Get (Message (EvalStatus [HValueRef])) -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EvalOpts -> EvalExpr HValueRef -> Message (EvalStatus [HValueRef])
EvalStmt (EvalOpts
 -> EvalExpr HValueRef -> Message (EvalStatus [HValueRef]))
-> Get EvalOpts
-> Get (EvalExpr HValueRef -> Message (EvalStatus [HValueRef]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get EvalOpts
forall t. Binary t => Get t
get Get (EvalExpr HValueRef -> Message (EvalStatus [HValueRef]))
-> Get (EvalExpr HValueRef)
-> Get (Message (EvalStatus [HValueRef]))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (EvalExpr HValueRef)
forall t. Binary t => Get t
get)
      20 -> Message (EvalStatus [HValueRef]) -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message (EvalStatus [HValueRef]) -> Msg)
-> Get (Message (EvalStatus [HValueRef])) -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EvalOpts
-> RemoteRef (ResumeContext [HValueRef])
-> Message (EvalStatus [HValueRef])
ResumeStmt (EvalOpts
 -> RemoteRef (ResumeContext [HValueRef])
 -> Message (EvalStatus [HValueRef]))
-> Get EvalOpts
-> Get
     (RemoteRef (ResumeContext [HValueRef])
      -> Message (EvalStatus [HValueRef]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get EvalOpts
forall t. Binary t => Get t
get Get
  (RemoteRef (ResumeContext [HValueRef])
   -> Message (EvalStatus [HValueRef]))
-> Get (RemoteRef (ResumeContext [HValueRef]))
-> Get (Message (EvalStatus [HValueRef]))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (RemoteRef (ResumeContext [HValueRef]))
forall t. Binary t => Get t
get)
      21 -> Message () -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message () -> Msg) -> Get (Message ()) -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RemoteRef (ResumeContext [HValueRef]) -> Message ()
AbandonStmt (RemoteRef (ResumeContext [HValueRef]) -> Message ())
-> Get (RemoteRef (ResumeContext [HValueRef])) -> Get (Message ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (RemoteRef (ResumeContext [HValueRef]))
forall t. Binary t => Get t
get)
      22 -> Message (EvalResult String) -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message (EvalResult String) -> Msg)
-> Get (Message (EvalResult String)) -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HValueRef -> Message (EvalResult String)
EvalString (HValueRef -> Message (EvalResult String))
-> Get HValueRef -> Get (Message (EvalResult String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get HValueRef
forall t. Binary t => Get t
get)
      23 -> Message (EvalResult String) -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message (EvalResult String) -> Msg)
-> Get (Message (EvalResult String)) -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HValueRef -> String -> Message (EvalResult String)
EvalStringToString (HValueRef -> String -> Message (EvalResult String))
-> Get HValueRef -> Get (String -> Message (EvalResult String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get HValueRef
forall t. Binary t => Get t
get Get (String -> Message (EvalResult String))
-> Get String -> Get (Message (EvalResult String))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get String
forall t. Binary t => Get t
get)
      24 -> Message (EvalResult ()) -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message (EvalResult ()) -> Msg)
-> Get (Message (EvalResult ())) -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HValueRef -> Message (EvalResult ())
EvalIO (HValueRef -> Message (EvalResult ()))
-> Get HValueRef -> Get (Message (EvalResult ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get HValueRef
forall t. Binary t => Get t
get)
      25 -> Message [RemotePtr CostCentre] -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message [RemotePtr CostCentre] -> Msg)
-> Get (Message [RemotePtr CostCentre]) -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> [(String, String)] -> Message [RemotePtr CostCentre]
MkCostCentres (String -> [(String, String)] -> Message [RemotePtr CostCentre])
-> Get String
-> Get ([(String, String)] -> Message [RemotePtr CostCentre])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get Get ([(String, String)] -> Message [RemotePtr CostCentre])
-> Get [(String, String)] -> Get (Message [RemotePtr CostCentre])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [(String, String)]
forall t. Binary t => Get t
get)
      26 -> Message [String] -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message [String] -> Msg) -> Get (Message [String]) -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RemotePtr CostCentreStack -> Message [String]
CostCentreStackInfo (RemotePtr CostCentreStack -> Message [String])
-> Get (RemotePtr CostCentreStack) -> Get (Message [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (RemotePtr CostCentreStack)
forall t. Binary t => Get t
get)
      27 -> Message (RemoteRef BreakArray) -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message (RemoteRef BreakArray) -> Msg)
-> Get (Message (RemoteRef BreakArray)) -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Message (RemoteRef BreakArray)
NewBreakArray (Int -> Message (RemoteRef BreakArray))
-> Get Int -> Get (Message (RemoteRef BreakArray))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
forall t. Binary t => Get t
get)
      28 -> Message () -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message () -> Msg) -> Get (Message ()) -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RemoteRef BreakArray -> Int -> Bool -> Message ()
EnableBreakpoint (RemoteRef BreakArray -> Int -> Bool -> Message ())
-> Get (RemoteRef BreakArray) -> Get (Int -> Bool -> Message ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (RemoteRef BreakArray)
forall t. Binary t => Get t
get Get (Int -> Bool -> Message ())
-> Get Int -> Get (Bool -> Message ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
forall t. Binary t => Get t
get Get (Bool -> Message ()) -> Get Bool -> Get (Message ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Bool
forall t. Binary t => Get t
get)
      29 -> Message Bool -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message Bool -> Msg) -> Get (Message Bool) -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RemoteRef BreakArray -> Int -> Message Bool
BreakpointStatus (RemoteRef BreakArray -> Int -> Message Bool)
-> Get (RemoteRef BreakArray) -> Get (Int -> Message Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (RemoteRef BreakArray)
forall t. Binary t => Get t
get Get (Int -> Message Bool) -> Get Int -> Get (Message Bool)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
forall t. Binary t => Get t
get)
      30 -> Message (Maybe HValueRef) -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message (Maybe HValueRef) -> Msg)
-> Get (Message (Maybe HValueRef)) -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HValueRef -> Int -> Message (Maybe HValueRef)
GetBreakpointVar (HValueRef -> Int -> Message (Maybe HValueRef))
-> Get HValueRef -> Get (Int -> Message (Maybe HValueRef))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get HValueRef
forall t. Binary t => Get t
get Get (Int -> Message (Maybe HValueRef))
-> Get Int -> Get (Message (Maybe HValueRef))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
forall t. Binary t => Get t
get)
      31 -> Message (RemoteRef (IORef QState)) -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message (RemoteRef (IORef QState)) -> Msg)
-> Get (Message (RemoteRef (IORef QState))) -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message (RemoteRef (IORef QState))
-> Get (Message (RemoteRef (IORef QState)))
forall (m :: * -> *) a. Monad m => a -> m a
return Message (RemoteRef (IORef QState))
StartTH
      32 -> Message (QResult ()) -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message (QResult ()) -> Msg)
-> Get (Message (QResult ())) -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RemoteRef (IORef QState)
-> [RemoteRef (Q ())] -> Message (QResult ())
RunModFinalizers (RemoteRef (IORef QState)
 -> [RemoteRef (Q ())] -> Message (QResult ()))
-> Get (RemoteRef (IORef QState))
-> Get ([RemoteRef (Q ())] -> Message (QResult ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (RemoteRef (IORef QState))
forall t. Binary t => Get t
get Get ([RemoteRef (Q ())] -> Message (QResult ()))
-> Get [RemoteRef (Q ())] -> Get (Message (QResult ()))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [RemoteRef (Q ())]
forall t. Binary t => Get t
get)
      33 -> Message () -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message () -> Msg) -> Get (Message ()) -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Fingerprint -> HValueRef -> Message ()
AddSptEntry (Fingerprint -> HValueRef -> Message ())
-> Get Fingerprint -> Get (HValueRef -> Message ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Fingerprint
forall t. Binary t => Get t
get Get (HValueRef -> Message ()) -> Get HValueRef -> Get (Message ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get HValueRef
forall t. Binary t => Get t
get)
      34 -> Message (QResult ByteString) -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message (QResult ByteString) -> Msg)
-> Get (Message (QResult ByteString)) -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RemoteRef (IORef QState)
-> HValueRef
-> THResultType
-> Maybe Loc
-> Message (QResult ByteString)
RunTH (RemoteRef (IORef QState)
 -> HValueRef
 -> THResultType
 -> Maybe Loc
 -> Message (QResult ByteString))
-> Get (RemoteRef (IORef QState))
-> Get
     (HValueRef
      -> THResultType -> Maybe Loc -> Message (QResult ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (RemoteRef (IORef QState))
forall t. Binary t => Get t
get Get
  (HValueRef
   -> THResultType -> Maybe Loc -> Message (QResult ByteString))
-> Get HValueRef
-> Get (THResultType -> Maybe Loc -> Message (QResult ByteString))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get HValueRef
forall t. Binary t => Get t
get Get (THResultType -> Maybe Loc -> Message (QResult ByteString))
-> Get THResultType
-> Get (Maybe Loc -> Message (QResult ByteString))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get THResultType
forall t. Binary t => Get t
get Get (Maybe Loc -> Message (QResult ByteString))
-> Get (Maybe Loc) -> Get (Message (QResult ByteString))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Maybe Loc)
forall t. Binary t => Get t
get)
      35 -> Message (GenClosure HValueRef) -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message (GenClosure HValueRef) -> Msg)
-> Get (Message (GenClosure HValueRef)) -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HValueRef -> Message (GenClosure HValueRef)
GetClosure (HValueRef -> Message (GenClosure HValueRef))
-> Get HValueRef -> Get (Message (GenClosure HValueRef))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get HValueRef
forall t. Binary t => Get t
get)
      _  -> Message (EvalResult ()) -> Msg
forall a. (Binary a, Show a) => Message a -> Msg
Msg (Message (EvalResult ()) -> Msg)
-> Get (Message (EvalResult ())) -> Get Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HValueRef -> Message (EvalResult ())
Seq (HValueRef -> Message (EvalResult ()))
-> Get HValueRef -> Get (Message (EvalResult ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get HValueRef
forall t. Binary t => Get t
get)

putMessage :: Message a -> Put
putMessage :: Message a -> Put
putMessage m :: Message a
m = case Message a
m of
  Shutdown                    -> Word8 -> Put
putWord8 0
  InitLinker                  -> Word8 -> Put
putWord8 1
  LookupSymbol str :: String
str            -> Word8 -> Put
putWord8 2  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
str
  LookupClosure str :: String
str           -> Word8 -> Put
putWord8 3  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
str
  LoadDLL str :: String
str                 -> Word8 -> Put
putWord8 4  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
str
  LoadArchive str :: String
str             -> Word8 -> Put
putWord8 5  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
str
  LoadObj str :: String
str                 -> Word8 -> Put
putWord8 6  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
str
  UnloadObj str :: String
str               -> Word8 -> Put
putWord8 7  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
str
  AddLibrarySearchPath str :: String
str    -> Word8 -> Put
putWord8 8  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
str
  RemoveLibrarySearchPath ptr :: RemotePtr ()
ptr -> Word8 -> Put
putWord8 9  Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RemotePtr () -> Put
forall t. Binary t => t -> Put
put RemotePtr ()
ptr
  ResolveObjs                 -> Word8 -> Put
putWord8 10
  FindSystemLibrary str :: String
str       -> Word8 -> Put
putWord8 11 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
str
  CreateBCOs bco :: [ByteString]
bco              -> Word8 -> Put
putWord8 12 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [ByteString] -> Put
forall t. Binary t => t -> Put
put [ByteString]
bco
  FreeHValueRefs val :: [HValueRef]
val          -> Word8 -> Put
putWord8 13 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [HValueRef] -> Put
forall t. Binary t => t -> Put
put [HValueRef]
val
  MallocData bs :: ByteString
bs               -> Word8 -> Put
putWord8 14 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
forall t. Binary t => t -> Put
put ByteString
bs
  MallocStrings bss :: [ByteString]
bss           -> Word8 -> Put
putWord8 15 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [ByteString] -> Put
forall t. Binary t => t -> Put
put [ByteString]
bss
  PrepFFI conv :: FFIConv
conv args :: [FFIType]
args res :: FFIType
res       -> Word8 -> Put
putWord8 16 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FFIConv -> Put
forall t. Binary t => t -> Put
put FFIConv
conv Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [FFIType] -> Put
forall t. Binary t => t -> Put
put [FFIType]
args Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FFIType -> Put
forall t. Binary t => t -> Put
put FFIType
res
  FreeFFI p :: RemotePtr C_ffi_cif
p                   -> Word8 -> Put
putWord8 17 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RemotePtr C_ffi_cif -> Put
forall t. Binary t => t -> Put
put RemotePtr C_ffi_cif
p
  MkConInfoTable p :: Int
p n :: Int
n t :: Int
t pt :: Int
pt d :: [Word8]
d   -> Word8 -> Put
putWord8 18 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
forall t. Binary t => t -> Put
put Int
p Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
forall t. Binary t => t -> Put
put Int
n Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
forall t. Binary t => t -> Put
put Int
t Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
forall t. Binary t => t -> Put
put Int
pt Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Word8] -> Put
forall t. Binary t => t -> Put
put [Word8]
d
  EvalStmt opts :: EvalOpts
opts val :: EvalExpr HValueRef
val           -> Word8 -> Put
putWord8 19 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EvalOpts -> Put
forall t. Binary t => t -> Put
put EvalOpts
opts Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EvalExpr HValueRef -> Put
forall t. Binary t => t -> Put
put EvalExpr HValueRef
val
  ResumeStmt opts :: EvalOpts
opts val :: RemoteRef (ResumeContext [HValueRef])
val         -> Word8 -> Put
putWord8 20 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EvalOpts -> Put
forall t. Binary t => t -> Put
put EvalOpts
opts Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RemoteRef (ResumeContext [HValueRef]) -> Put
forall t. Binary t => t -> Put
put RemoteRef (ResumeContext [HValueRef])
val
  AbandonStmt val :: RemoteRef (ResumeContext [HValueRef])
val             -> Word8 -> Put
putWord8 21 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RemoteRef (ResumeContext [HValueRef]) -> Put
forall t. Binary t => t -> Put
put RemoteRef (ResumeContext [HValueRef])
val
  EvalString val :: HValueRef
val              -> Word8 -> Put
putWord8 22 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HValueRef -> Put
forall t. Binary t => t -> Put
put HValueRef
val
  EvalStringToString str :: HValueRef
str val :: String
val  -> Word8 -> Put
putWord8 23 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HValueRef -> Put
forall t. Binary t => t -> Put
put HValueRef
str Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
val
  EvalIO val :: HValueRef
val                  -> Word8 -> Put
putWord8 24 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HValueRef -> Put
forall t. Binary t => t -> Put
put HValueRef
val
  MkCostCentres mod :: String
mod ccs :: [(String, String)]
ccs       -> Word8 -> Put
putWord8 25 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
mod Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(String, String)] -> Put
forall t. Binary t => t -> Put
put [(String, String)]
ccs
  CostCentreStackInfo ptr :: RemotePtr CostCentreStack
ptr     -> Word8 -> Put
putWord8 26 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RemotePtr CostCentreStack -> Put
forall t. Binary t => t -> Put
put RemotePtr CostCentreStack
ptr
  NewBreakArray sz :: Int
sz            -> Word8 -> Put
putWord8 27 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
forall t. Binary t => t -> Put
put Int
sz
  EnableBreakpoint arr :: RemoteRef BreakArray
arr ix :: Int
ix b :: Bool
b   -> Word8 -> Put
putWord8 28 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RemoteRef BreakArray -> Put
forall t. Binary t => t -> Put
put RemoteRef BreakArray
arr Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
forall t. Binary t => t -> Put
put Int
ix Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Put
forall t. Binary t => t -> Put
put Bool
b
  BreakpointStatus arr :: RemoteRef BreakArray
arr ix :: Int
ix     -> Word8 -> Put
putWord8 29 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RemoteRef BreakArray -> Put
forall t. Binary t => t -> Put
put RemoteRef BreakArray
arr Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
forall t. Binary t => t -> Put
put Int
ix
  GetBreakpointVar a :: HValueRef
a b :: Int
b        -> Word8 -> Put
putWord8 30 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HValueRef -> Put
forall t. Binary t => t -> Put
put HValueRef
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
forall t. Binary t => t -> Put
put Int
b
  StartTH                     -> Word8 -> Put
putWord8 31
  RunModFinalizers a :: RemoteRef (IORef QState)
a b :: [RemoteRef (Q ())]
b        -> Word8 -> Put
putWord8 32 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RemoteRef (IORef QState) -> Put
forall t. Binary t => t -> Put
put RemoteRef (IORef QState)
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [RemoteRef (Q ())] -> Put
forall t. Binary t => t -> Put
put [RemoteRef (Q ())]
b
  AddSptEntry a :: Fingerprint
a b :: HValueRef
b             -> Word8 -> Put
putWord8 33 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Fingerprint -> Put
forall t. Binary t => t -> Put
put Fingerprint
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HValueRef -> Put
forall t. Binary t => t -> Put
put HValueRef
b
  RunTH st :: RemoteRef (IORef QState)
st q :: HValueRef
q loc :: THResultType
loc ty :: Maybe Loc
ty           -> Word8 -> Put
putWord8 34 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RemoteRef (IORef QState) -> Put
forall t. Binary t => t -> Put
put RemoteRef (IORef QState)
st Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HValueRef -> Put
forall t. Binary t => t -> Put
put HValueRef
q Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> THResultType -> Put
forall t. Binary t => t -> Put
put THResultType
loc Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Loc -> Put
forall t. Binary t => t -> Put
put Maybe Loc
ty
  GetClosure a :: HValueRef
a                -> Word8 -> Put
putWord8 35 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HValueRef -> Put
forall t. Binary t => t -> Put
put HValueRef
a
  Seq a :: HValueRef
a                       -> Word8 -> Put
putWord8 36 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HValueRef -> Put
forall t. Binary t => t -> Put
put HValueRef
a

-- -----------------------------------------------------------------------------
-- Reading/writing messages

data Pipe = Pipe
  { Pipe -> Handle
pipeRead :: Handle
  , Pipe -> Handle
pipeWrite ::  Handle
  , Pipe -> IORef (Maybe ByteString)
pipeLeftovers :: IORef (Maybe ByteString)
  }

remoteCall :: Binary a => Pipe -> Message a -> IO a
remoteCall :: Pipe -> Message a -> IO a
remoteCall pipe :: Pipe
pipe msg :: Message a
msg = do
  Pipe -> Put -> IO ()
writePipe Pipe
pipe (Message a -> Put
forall a. Message a -> Put
putMessage Message a
msg)
  Pipe -> Get a -> IO a
forall a. Pipe -> Get a -> IO a
readPipe Pipe
pipe Get a
forall t. Binary t => Get t
get

remoteTHCall :: Binary a => Pipe -> THMessage a -> IO a
remoteTHCall :: Pipe -> THMessage a -> IO a
remoteTHCall pipe :: Pipe
pipe msg :: THMessage a
msg = do
  Pipe -> Put -> IO ()
writePipe Pipe
pipe (THMessage a -> Put
forall a. THMessage a -> Put
putTHMessage THMessage a
msg)
  Pipe -> Get a -> IO a
forall a. Pipe -> Get a -> IO a
readPipe Pipe
pipe Get a
forall t. Binary t => Get t
get

writePipe :: Pipe -> Put -> IO ()
writePipe :: Pipe -> Put -> IO ()
writePipe Pipe{..} put :: Put
put
  | ByteString -> Bool
LB.null ByteString
bs = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise  = do
    Handle -> ByteString -> IO ()
LB.hPut Handle
pipeWrite ByteString
bs
    Handle -> IO ()
hFlush Handle
pipeWrite
 where
  bs :: ByteString
bs = Put -> ByteString
runPut Put
put

readPipe :: Pipe -> Get a -> IO a
readPipe :: Pipe -> Get a -> IO a
readPipe Pipe{..} get :: Get a
get = do
  Maybe ByteString
leftovers <- IORef (Maybe ByteString) -> IO (Maybe ByteString)
forall a. IORef a -> IO a
readIORef IORef (Maybe ByteString)
pipeLeftovers
  Maybe (a, Maybe ByteString)
m <- Handle
-> Get a -> Maybe ByteString -> IO (Maybe (a, Maybe ByteString))
forall a.
Handle
-> Get a -> Maybe ByteString -> IO (Maybe (a, Maybe ByteString))
getBin Handle
pipeRead Get a
get Maybe ByteString
leftovers
  case Maybe (a, Maybe ByteString)
m of
    Nothing -> IOError -> IO a
forall a e. Exception e => e -> a
throw (IOError -> IO a) -> IOError -> IO a
forall a b. (a -> b) -> a -> b
$
      IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
eofErrorType "GHCi.Message.remoteCall" (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
pipeRead) Maybe String
forall a. Maybe a
Nothing
    Just (result :: a
result, new_leftovers :: Maybe ByteString
new_leftovers) -> do
      IORef (Maybe ByteString) -> Maybe ByteString -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe ByteString)
pipeLeftovers Maybe ByteString
new_leftovers
      a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

getBin
  :: Handle -> Get a -> Maybe ByteString
  -> IO (Maybe (a, Maybe ByteString))

getBin :: Handle
-> Get a -> Maybe ByteString -> IO (Maybe (a, Maybe ByteString))
getBin h :: Handle
h get :: Get a
get leftover :: Maybe ByteString
leftover = Maybe ByteString -> Decoder a -> IO (Maybe (a, Maybe ByteString))
go Maybe ByteString
leftover (Get a -> Decoder a
forall a. Get a -> Decoder a
runGetIncremental Get a
get)
 where
   go :: Maybe ByteString -> Decoder a -> IO (Maybe (a, Maybe ByteString))
go Nothing (Done leftover :: ByteString
leftover _ msg :: a
msg) =
     Maybe (a, Maybe ByteString) -> IO (Maybe (a, Maybe ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, Maybe ByteString) -> Maybe (a, Maybe ByteString)
forall a. a -> Maybe a
Just (a
msg, if ByteString -> Bool
B.null ByteString
leftover then Maybe ByteString
forall a. Maybe a
Nothing else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
leftover))
   go _ Done{} = ErrorCall -> IO (Maybe (a, Maybe ByteString))
forall e a. Exception e => e -> IO a
throwIO (String -> ErrorCall
ErrorCall "getBin: Done with leftovers")
   go (Just leftover :: ByteString
leftover) (Partial fun :: Maybe ByteString -> Decoder a
fun) = do
     Maybe ByteString -> Decoder a -> IO (Maybe (a, Maybe ByteString))
go Maybe ByteString
forall a. Maybe a
Nothing (Maybe ByteString -> Decoder a
fun (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
leftover))
   go Nothing (Partial fun :: Maybe ByteString -> Decoder a
fun) = do
     -- putStrLn "before hGetSome"
     ByteString
b <- Handle -> Int -> IO ByteString
B.hGetSome Handle
h (32Int -> Int -> Int
forall a. Num a => a -> a -> a
*1024)
     -- printf "hGetSome: %d\n" (B.length b)
     if ByteString -> Bool
B.null ByteString
b
        then Maybe (a, Maybe ByteString) -> IO (Maybe (a, Maybe ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (a, Maybe ByteString)
forall a. Maybe a
Nothing
        else Maybe ByteString -> Decoder a -> IO (Maybe (a, Maybe ByteString))
go Maybe ByteString
forall a. Maybe a
Nothing (Maybe ByteString -> Decoder a
fun (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
b))
   go _lft :: Maybe ByteString
_lft (Fail _rest :: ByteString
_rest _off :: ByteOffset
_off str :: String
str) =
     ErrorCall -> IO (Maybe (a, Maybe ByteString))
forall e a. Exception e => e -> IO a
throwIO (String -> ErrorCall
ErrorCall ("getBin: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str))