{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE RecordWildCards #-}

module GHC.Debug.Types(module T
                      , Request(..)
                      , ForkOrPause(..)
                      , requestCommandId
                      , doRequest
                      , isWriteRequest
                      , withWriteRequest
                      , isImmutableRequest
                      , AnyReq(..)
                      , AnyResp(..)
                      , CommandId(..)
                      , SourceInformation(..)
                      , ClosureType(..)
                      , Version(..)

                      -- * Serialisation functions
                      , getIPE
                      , putIPE
                      , getInfoTable
                      , putInfoTable
                      , putRequest
                      , getCCS
                      , getCC
                      , putCCS
                      , putCC
                      , putIndexTable
                      , getIndexTable
                      , putCCSMainPtr
                      , getCCSMainPtr
                      , getProfilingMode
                      , putProfilingMode
                      , getRequest
                      ) where

import Control.Applicative
import Control.Exception
import Control.Monad
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C8
import Data.Word
import System.IO
import Data.Functor

import Data.Binary
import Data.Binary.Put
import Data.Binary.Get
import Data.Hashable

import GHC.Debug.Types.Closures as T
import GHC.Debug.Types.Ptr as T
import GHC.Debug.Types.Version
import GHC.Debug.Utils
import Control.Concurrent

-- | The decision about whether to fork the running process or
-- pause it running whilst we are debugging it.
data ForkOrPause = Pause | Fork deriving (ForkOrPause -> ForkOrPause -> Bool
(ForkOrPause -> ForkOrPause -> Bool)
-> (ForkOrPause -> ForkOrPause -> Bool) -> Eq ForkOrPause
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ForkOrPause -> ForkOrPause -> Bool
== :: ForkOrPause -> ForkOrPause -> Bool
$c/= :: ForkOrPause -> ForkOrPause -> Bool
/= :: ForkOrPause -> ForkOrPause -> Bool
Eq, Eq ForkOrPause
Eq ForkOrPause
-> (ForkOrPause -> ForkOrPause -> Ordering)
-> (ForkOrPause -> ForkOrPause -> Bool)
-> (ForkOrPause -> ForkOrPause -> Bool)
-> (ForkOrPause -> ForkOrPause -> Bool)
-> (ForkOrPause -> ForkOrPause -> Bool)
-> (ForkOrPause -> ForkOrPause -> ForkOrPause)
-> (ForkOrPause -> ForkOrPause -> ForkOrPause)
-> Ord ForkOrPause
ForkOrPause -> ForkOrPause -> Bool
ForkOrPause -> ForkOrPause -> Ordering
ForkOrPause -> ForkOrPause -> ForkOrPause
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ForkOrPause -> ForkOrPause -> Ordering
compare :: ForkOrPause -> ForkOrPause -> Ordering
$c< :: ForkOrPause -> ForkOrPause -> Bool
< :: ForkOrPause -> ForkOrPause -> Bool
$c<= :: ForkOrPause -> ForkOrPause -> Bool
<= :: ForkOrPause -> ForkOrPause -> Bool
$c> :: ForkOrPause -> ForkOrPause -> Bool
> :: ForkOrPause -> ForkOrPause -> Bool
$c>= :: ForkOrPause -> ForkOrPause -> Bool
>= :: ForkOrPause -> ForkOrPause -> Bool
$cmax :: ForkOrPause -> ForkOrPause -> ForkOrPause
max :: ForkOrPause -> ForkOrPause -> ForkOrPause
$cmin :: ForkOrPause -> ForkOrPause -> ForkOrPause
min :: ForkOrPause -> ForkOrPause -> ForkOrPause
Ord, Int -> ForkOrPause -> ShowS
[ForkOrPause] -> ShowS
ForkOrPause -> String
(Int -> ForkOrPause -> ShowS)
-> (ForkOrPause -> String)
-> ([ForkOrPause] -> ShowS)
-> Show ForkOrPause
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ForkOrPause -> ShowS
showsPrec :: Int -> ForkOrPause -> ShowS
$cshow :: ForkOrPause -> String
show :: ForkOrPause -> String
$cshowList :: [ForkOrPause] -> ShowS
showList :: [ForkOrPause] -> ShowS
Show, Int -> ForkOrPause
ForkOrPause -> Int
ForkOrPause -> [ForkOrPause]
ForkOrPause -> ForkOrPause
ForkOrPause -> ForkOrPause -> [ForkOrPause]
ForkOrPause -> ForkOrPause -> ForkOrPause -> [ForkOrPause]
(ForkOrPause -> ForkOrPause)
-> (ForkOrPause -> ForkOrPause)
-> (Int -> ForkOrPause)
-> (ForkOrPause -> Int)
-> (ForkOrPause -> [ForkOrPause])
-> (ForkOrPause -> ForkOrPause -> [ForkOrPause])
-> (ForkOrPause -> ForkOrPause -> [ForkOrPause])
-> (ForkOrPause -> ForkOrPause -> ForkOrPause -> [ForkOrPause])
-> Enum ForkOrPause
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ForkOrPause -> ForkOrPause
succ :: ForkOrPause -> ForkOrPause
$cpred :: ForkOrPause -> ForkOrPause
pred :: ForkOrPause -> ForkOrPause
$ctoEnum :: Int -> ForkOrPause
toEnum :: Int -> ForkOrPause
$cfromEnum :: ForkOrPause -> Int
fromEnum :: ForkOrPause -> Int
$cenumFrom :: ForkOrPause -> [ForkOrPause]
enumFrom :: ForkOrPause -> [ForkOrPause]
$cenumFromThen :: ForkOrPause -> ForkOrPause -> [ForkOrPause]
enumFromThen :: ForkOrPause -> ForkOrPause -> [ForkOrPause]
$cenumFromTo :: ForkOrPause -> ForkOrPause -> [ForkOrPause]
enumFromTo :: ForkOrPause -> ForkOrPause -> [ForkOrPause]
$cenumFromThenTo :: ForkOrPause -> ForkOrPause -> ForkOrPause -> [ForkOrPause]
enumFromThenTo :: ForkOrPause -> ForkOrPause -> ForkOrPause -> [ForkOrPause]
Enum)

instance Hashable ForkOrPause where
  hashWithSalt :: Int -> ForkOrPause -> Int
hashWithSalt Int
s ForkOrPause
v = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (ForkOrPause -> Int
forall a. Enum a => a -> Int
fromEnum ForkOrPause
v)

instance Binary ForkOrPause where
  put :: ForkOrPause -> Put
put     = Word8 -> Put
putWord8 (Word8 -> Put) -> (ForkOrPause -> Word8) -> ForkOrPause -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (ForkOrPause -> Int) -> ForkOrPause -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForkOrPause -> Int
forall a. Enum a => a -> Int
fromEnum
  get :: Get ForkOrPause
get     = Get Word8
getWord8 Get Word8 -> (Word8 -> Get ForkOrPause) -> Get ForkOrPause
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Get ForkOrPause
forall {a} {m :: * -> *} {a}.
(Eq a, Num a, Enum a, MonadFail m, Show a) =>
a -> m a
toBool
    where
      toBool :: a -> m a
toBool a
0 = a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> a
forall a. Enum a => Int -> a
toEnum Int
0)
      toBool a
1 = a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> a
forall a. Enum a => Int -> a
toEnum Int
1)
      toBool a
c = String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Could not map value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" to ForkOrPause")


-- | A request sent from the debugger to the debuggee parametrized on the result type.
data Request a where
    -- | Request protocol version
    RequestVersion :: Request Version
    -- | Pause the debuggee.
    RequestPause :: ForkOrPause -> Request ()
    -- | Resume the debuggee.
    RequestResume :: Request ()
    -- | Request the debuggee's root pointers.
    RequestRoots :: Request [ClosurePtr]
    -- | Request a closure
    RequestClosure :: ClosurePtr -> Request RawClosure
    -- | Request an info table
    RequestInfoTable :: InfoTablePtr -> Request RawInfoTable

    -- | Request the SRT of an info table. Some closures, like constructors, can never have SRTs.
    -- Thunks, functions and stack frames may have SRTs.
    -- Returns Nothing when the closure does not have an SRT.
    RequestSRT :: InfoTablePtr -> Request (Maybe ClosurePtr)

    -- | Wait for the debuggee to pause itself and then
    -- execute an action. It currently impossible to resume after
    -- a pause caused by a poll.
    RequestPoll :: Request ()
    -- | A client can save objects by calling a special RTS method
    -- This function returns the closures it saved.
    RequestSavedObjects :: Request [ClosurePtr]
    -- | Request the pointer bitmap for a stack frame at a given offset
    -- from a StackPtr.
    RequestStackBitmap :: StackPtr -> Word32 -> Request PtrBitmap
    -- | Decode the bitmap contained in a StgFunInfoTable
    -- Used by PAP and AP closure types.
    RequestFunBitmap :: Word16 -> ClosurePtr -> Request PtrBitmap
    -- | Request the constructor description for an info table.
    -- The info table must be from a 'ConstrClosure'
    RequestConstrDesc :: InfoTablePtr -> Request ConstrDesc
    -- | Lookup source information of an info table
    RequestSourceInfo :: InfoTablePtr -> Request (Maybe SourceInformation)
    -- | Copy all blocks from the process at once
    RequestAllBlocks :: Request [RawBlock]
    -- | Request the block which contains a specific pointer
    RequestBlock :: ClosurePtr -> Request RawBlock

    -- | Request the cost center stack
    RequestCCS :: CCSPtr -> Request CCSPayload
    -- | Request the cost center entry
    RequestCC :: CCPtr -> Request CCPayload
    -- | Request the index table.
    RequestIndexTable :: IndexTablePtr -> Request IndexTable
    -- | Request the CCS_MAIN pointer
    RequestCCSMainPtr :: Request CCSPtr


data SourceInformation = SourceInformation { SourceInformation -> String
infoName        :: !String
                                         , SourceInformation -> ClosureType
infoClosureType :: !ClosureType
                                         , SourceInformation -> String
infoType        :: !String
                                         , SourceInformation -> String
infoLabel       :: !String
                                         , SourceInformation -> String
infoModule      :: !String
                                         , SourceInformation -> String
infoPosition    :: !String }
                                         deriving (Int -> SourceInformation -> ShowS
[SourceInformation] -> ShowS
SourceInformation -> String
(Int -> SourceInformation -> ShowS)
-> (SourceInformation -> String)
-> ([SourceInformation] -> ShowS)
-> Show SourceInformation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourceInformation -> ShowS
showsPrec :: Int -> SourceInformation -> ShowS
$cshow :: SourceInformation -> String
show :: SourceInformation -> String
$cshowList :: [SourceInformation] -> ShowS
showList :: [SourceInformation] -> ShowS
Show, SourceInformation -> SourceInformation -> Bool
(SourceInformation -> SourceInformation -> Bool)
-> (SourceInformation -> SourceInformation -> Bool)
-> Eq SourceInformation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SourceInformation -> SourceInformation -> Bool
== :: SourceInformation -> SourceInformation -> Bool
$c/= :: SourceInformation -> SourceInformation -> Bool
/= :: SourceInformation -> SourceInformation -> Bool
Eq, Eq SourceInformation
Eq SourceInformation
-> (SourceInformation -> SourceInformation -> Ordering)
-> (SourceInformation -> SourceInformation -> Bool)
-> (SourceInformation -> SourceInformation -> Bool)
-> (SourceInformation -> SourceInformation -> Bool)
-> (SourceInformation -> SourceInformation -> Bool)
-> (SourceInformation -> SourceInformation -> SourceInformation)
-> (SourceInformation -> SourceInformation -> SourceInformation)
-> Ord SourceInformation
SourceInformation -> SourceInformation -> Bool
SourceInformation -> SourceInformation -> Ordering
SourceInformation -> SourceInformation -> SourceInformation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SourceInformation -> SourceInformation -> Ordering
compare :: SourceInformation -> SourceInformation -> Ordering
$c< :: SourceInformation -> SourceInformation -> Bool
< :: SourceInformation -> SourceInformation -> Bool
$c<= :: SourceInformation -> SourceInformation -> Bool
<= :: SourceInformation -> SourceInformation -> Bool
$c> :: SourceInformation -> SourceInformation -> Bool
> :: SourceInformation -> SourceInformation -> Bool
$c>= :: SourceInformation -> SourceInformation -> Bool
>= :: SourceInformation -> SourceInformation -> Bool
$cmax :: SourceInformation -> SourceInformation -> SourceInformation
max :: SourceInformation -> SourceInformation -> SourceInformation
$cmin :: SourceInformation -> SourceInformation -> SourceInformation
min :: SourceInformation -> SourceInformation -> SourceInformation
Ord)

eq1request :: Request a -> Request b -> Bool
eq1request :: forall a b. Request a -> Request b -> Bool
eq1request Request a
r1 Request b
r2 =
  case Request a
r1 of
    Request a
RequestVersion -> case Request b
r2 of {Request b
RequestVersion -> Bool
True; Request b
_ -> Bool
False}
    RequestPause ForkOrPause
f1 -> case Request b
r2 of {RequestPause ForkOrPause
f2 -> ForkOrPause
f1 ForkOrPause -> ForkOrPause -> Bool
forall a. Eq a => a -> a -> Bool
== ForkOrPause
f2; Request b
_ -> Bool
False }
    Request a
RequestResume  -> case Request b
r2 of {Request b
RequestResume -> Bool
True; Request b
_ -> Bool
False }
    Request a
RequestRoots   -> case Request b
r2 of {Request b
RequestRoots -> Bool
True; Request b
_ -> Bool
False }
    RequestClosure ClosurePtr
cs -> case Request b
r2 of {(RequestClosure ClosurePtr
cs') -> ClosurePtr
cs ClosurePtr -> ClosurePtr -> Bool
forall a. Eq a => a -> a -> Bool
== ClosurePtr
cs'; Request b
_ -> Bool
False }
    RequestInfoTable InfoTablePtr
itp -> case Request b
r2 of { (RequestInfoTable InfoTablePtr
itp') ->  InfoTablePtr
itp InfoTablePtr -> InfoTablePtr -> Bool
forall a. Eq a => a -> a -> Bool
== InfoTablePtr
itp'; Request b
_ -> Bool
False }
    RequestSRT InfoTablePtr
itp -> case Request b
r2 of { (RequestSRT InfoTablePtr
itp') ->  InfoTablePtr
itp InfoTablePtr -> InfoTablePtr -> Bool
forall a. Eq a => a -> a -> Bool
== InfoTablePtr
itp'; Request b
_ -> Bool
False }
    Request a
RequestPoll           -> case Request b
r2 of { Request b
RequestPoll -> Bool
True; Request b
_ -> Bool
False }
    Request a
RequestSavedObjects    -> case Request b
r2 of {Request b
RequestSavedObjects -> Bool
True; Request b
_ -> Bool
False }
    RequestStackBitmap StackPtr
p Word32
o      -> case Request b
r2 of {(RequestStackBitmap StackPtr
p' Word32
o') -> StackPtr
p StackPtr -> StackPtr -> Bool
forall a. Eq a => a -> a -> Bool
== StackPtr
p' Bool -> Bool -> Bool
&& Word32
o Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
o'; Request b
_ -> Bool
False }
    RequestFunBitmap Word16
n ClosurePtr
cp    -> case Request b
r2 of {(RequestFunBitmap Word16
n' ClosurePtr
cp') -> Word16
n Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
n' Bool -> Bool -> Bool
&& ClosurePtr
cp ClosurePtr -> ClosurePtr -> Bool
forall a. Eq a => a -> a -> Bool
== ClosurePtr
cp'; Request b
_ -> Bool
False }
    RequestConstrDesc InfoTablePtr
cp   -> case Request b
r2 of { (RequestConstrDesc InfoTablePtr
cp') -> InfoTablePtr
cp InfoTablePtr -> InfoTablePtr -> Bool
forall a. Eq a => a -> a -> Bool
== InfoTablePtr
cp'; Request b
_ -> Bool
False }
    RequestSourceInfo InfoTablePtr
itp  -> case Request b
r2 of { (RequestSourceInfo InfoTablePtr
itp') -> InfoTablePtr
itp InfoTablePtr -> InfoTablePtr -> Bool
forall a. Eq a => a -> a -> Bool
== InfoTablePtr
itp'; Request b
_ -> Bool
False }
    Request a
RequestAllBlocks       -> case Request b
r2 of { Request b
RequestAllBlocks -> Bool
True; Request b
_ -> Bool
False }
    RequestBlock ClosurePtr
cp        -> case Request b
r2 of { RequestBlock ClosurePtr
cp' -> ClosurePtr
cp ClosurePtr -> ClosurePtr -> Bool
forall a. Eq a => a -> a -> Bool
== ClosurePtr
cp'; Request b
_ -> Bool
False }
    RequestCCS CCSPtr
cp       -> case Request b
r2 of { RequestCCS CCSPtr
cp' -> CCSPtr
cp CCSPtr -> CCSPtr -> Bool
forall a. Eq a => a -> a -> Bool
== CCSPtr
cp'; Request b
_ -> Bool
False }
    RequestCC CCPtr
cp       -> case Request b
r2 of { RequestCC CCPtr
cp' -> CCPtr
cp CCPtr -> CCPtr -> Bool
forall a. Eq a => a -> a -> Bool
== CCPtr
cp'; Request b
_ -> Bool
False }
    RequestIndexTable IndexTablePtr
cp -> case Request b
r2 of { RequestIndexTable IndexTablePtr
cp' -> IndexTablePtr
cp IndexTablePtr -> IndexTablePtr -> Bool
forall a. Eq a => a -> a -> Bool
== IndexTablePtr
cp'; Request b
_ -> Bool
False }
    Request a
RequestCCSMainPtr -> case Request b
r2 of { Request b
RequestCCSMainPtr -> Bool
True; Request b
_ -> Bool
False }

-- | Whether a request mutates the debuggee state, don't cache these ones
isWriteRequest :: Request a -> Bool
isWriteRequest :: forall a. Request a -> Bool
isWriteRequest Request a
r = Const Bool a -> Bool
forall {k} a (b :: k). Const a b -> a
getConst (Const Bool a -> Bool) -> Const Bool a -> Bool
forall a b. (a -> b) -> a -> b
$ Request a
-> Const Bool a
-> ((a ~ ()) => Request a -> Const Bool a)
-> Const Bool a
forall a (r :: * -> *).
Request a -> r a -> ((a ~ ()) => Request a -> r a) -> r a
withWriteRequest Request a
r (Bool -> Const Bool a
forall {k} a (b :: k). a -> Const a b
Const Bool
False) (Const Bool a -> Request a -> Const Bool a
forall a b. a -> b -> a
const (Bool -> Const Bool a
forall {k} a (b :: k). a -> Const a b
Const Bool
True))

withWriteRequest :: Request a -> r a -> ((a ~ ()) => Request a -> r a) -> r a
withWriteRequest :: forall a (r :: * -> *).
Request a -> r a -> ((a ~ ()) => Request a -> r a) -> r a
withWriteRequest Request a
r r a
def (a ~ ()) => Request a -> r a
k =
  case Request a
r of
    RequestPause ForkOrPause
f -> (a ~ ()) => Request a -> r a
Request a -> r a
k (ForkOrPause -> Request ()
RequestPause ForkOrPause
f)
    Request a
RequestResume -> (a ~ ()) => Request a -> r a
Request a -> r a
k Request a
Request ()
RequestResume
    Request a
RequestPoll -> (a ~ ()) => Request a -> r a
Request a -> r a
k Request a
Request ()
RequestPoll
    Request a
_ -> r a
def

-- | Requests which will always answer the same.
-- For example, info tables are immutable and so requesting an info table
-- will always result in the same value and is safe to cache across pause
-- lines.
isImmutableRequest :: Request a -> Bool
isImmutableRequest :: forall a. Request a -> Bool
isImmutableRequest Request a
r =
  case Request a
r of
    RequestVersion {} -> Bool
True
    RequestInfoTable {} -> Bool
True
    RequestSRT {} -> Bool
True
    RequestSourceInfo {} -> Bool
True
    RequestConstrDesc {} -> Bool
True
    RequestCCS {} -> Bool
True
    RequestCC {} -> Bool
True
    Request a
_ -> Bool
False


deriving instance Show (Request a)
deriving instance Eq (Request a)

instance Hashable (Request a) where
  hashWithSalt :: Int -> Request a -> Int
hashWithSalt Int
s Request a
r = case Request a
r of
    Request a
RequestVersion ->  Int
s Int -> CommandId -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` CommandId
cmdRequestVersion
    RequestPause ForkOrPause
f ->  Int
s Int -> ForkOrPause -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` ForkOrPause
f Int -> CommandId -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` CommandId
cmdRequestPause
    Request a
RequestResume  ->  Int
s Int -> CommandId -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` CommandId
cmdRequestResume
    Request a
RequestRoots   -> Int
s Int -> CommandId -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` CommandId
cmdRequestRoots
    RequestClosure ClosurePtr
cs -> Int
s Int -> CommandId -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` CommandId
cmdRequestClosures Int -> ClosurePtr -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` ClosurePtr
cs
    RequestInfoTable InfoTablePtr
itp -> Int
s Int -> CommandId -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` CommandId
cmdRequestInfoTables Int -> InfoTablePtr -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` InfoTablePtr
itp
    RequestSRT InfoTablePtr
itp        -> Int
s Int -> CommandId -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` CommandId
cmdRequestSRT Int -> InfoTablePtr -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` InfoTablePtr
itp
    Request a
RequestPoll           -> Int
s Int -> CommandId -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` CommandId
cmdRequestPoll
    Request a
RequestSavedObjects    -> Int
s Int -> CommandId -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` CommandId
cmdRequestSavedObjects
    RequestStackBitmap StackPtr
p Word32
o -> Int
s Int -> CommandId -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` CommandId
cmdRequestStackBitmap Int -> StackPtr -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` StackPtr
p Int -> Word32 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word32
o
    RequestFunBitmap Word16
n ClosurePtr
cp  -> Int
s Int -> CommandId -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` CommandId
cmdRequestFunBitmap Int -> ClosurePtr -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` ClosurePtr
cp Int -> Word16 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word16
n
    RequestConstrDesc InfoTablePtr
cp   -> Int
s Int -> CommandId -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` CommandId
cmdRequestConstrDesc Int -> InfoTablePtr -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` InfoTablePtr
cp
    RequestSourceInfo InfoTablePtr
itp  -> Int
s Int -> CommandId -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` CommandId
cmdRequestSourceInfo Int -> InfoTablePtr -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` InfoTablePtr
itp
    Request a
RequestAllBlocks       -> Int
s Int -> CommandId -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` CommandId
cmdRequestAllBlocks
    RequestBlock ClosurePtr
cp        -> Int
s Int -> CommandId -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` CommandId
cmdRequestBlock Int -> ClosurePtr -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` ClosurePtr
cp
    RequestCCS CCSPtr
cp          -> Int
s Int -> CommandId -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` CommandId
cmdRequestCCS Int -> CCSPtr -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` CCSPtr
cp
    RequestCC CCPtr
cp           -> Int
s Int -> CommandId -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` CommandId
cmdRequestCC  Int -> CCPtr -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` CCPtr
cp
    RequestIndexTable IndexTablePtr
cp   -> Int
s Int -> CommandId -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` CommandId
cmdRequestIndexTable  Int -> IndexTablePtr -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` IndexTablePtr
cp
    Request a
RequestCCSMainPtr      -> Int
s Int -> CommandId -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` CommandId
cmdRequestCCSMainPtr


newtype CommandId = CommandId Word32
                  deriving (CommandId -> CommandId -> Bool
(CommandId -> CommandId -> Bool)
-> (CommandId -> CommandId -> Bool) -> Eq CommandId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommandId -> CommandId -> Bool
== :: CommandId -> CommandId -> Bool
$c/= :: CommandId -> CommandId -> Bool
/= :: CommandId -> CommandId -> Bool
Eq, Eq CommandId
Eq CommandId
-> (CommandId -> CommandId -> Ordering)
-> (CommandId -> CommandId -> Bool)
-> (CommandId -> CommandId -> Bool)
-> (CommandId -> CommandId -> Bool)
-> (CommandId -> CommandId -> Bool)
-> (CommandId -> CommandId -> CommandId)
-> (CommandId -> CommandId -> CommandId)
-> Ord CommandId
CommandId -> CommandId -> Bool
CommandId -> CommandId -> Ordering
CommandId -> CommandId -> CommandId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CommandId -> CommandId -> Ordering
compare :: CommandId -> CommandId -> Ordering
$c< :: CommandId -> CommandId -> Bool
< :: CommandId -> CommandId -> Bool
$c<= :: CommandId -> CommandId -> Bool
<= :: CommandId -> CommandId -> Bool
$c> :: CommandId -> CommandId -> Bool
> :: CommandId -> CommandId -> Bool
$c>= :: CommandId -> CommandId -> Bool
>= :: CommandId -> CommandId -> Bool
$cmax :: CommandId -> CommandId -> CommandId
max :: CommandId -> CommandId -> CommandId
$cmin :: CommandId -> CommandId -> CommandId
min :: CommandId -> CommandId -> CommandId
Ord, Int -> CommandId -> ShowS
[CommandId] -> ShowS
CommandId -> String
(Int -> CommandId -> ShowS)
-> (CommandId -> String)
-> ([CommandId] -> ShowS)
-> Show CommandId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommandId -> ShowS
showsPrec :: Int -> CommandId -> ShowS
$cshow :: CommandId -> String
show :: CommandId -> String
$cshowList :: [CommandId] -> ShowS
showList :: [CommandId] -> ShowS
Show)
                  deriving newtype (Get CommandId
[CommandId] -> Put
CommandId -> Put
(CommandId -> Put)
-> Get CommandId -> ([CommandId] -> Put) -> Binary CommandId
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: CommandId -> Put
put :: CommandId -> Put
$cget :: Get CommandId
get :: Get CommandId
$cputList :: [CommandId] -> Put
putList :: [CommandId] -> Put
Binary, Eq CommandId
Eq CommandId
-> (Int -> CommandId -> Int)
-> (CommandId -> Int)
-> Hashable CommandId
Int -> CommandId -> Int
CommandId -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> CommandId -> Int
hashWithSalt :: Int -> CommandId -> Int
$chash :: CommandId -> Int
hash :: CommandId -> Int
Hashable)

requestCommandId :: Request a -> CommandId
requestCommandId :: forall a. Request a -> CommandId
requestCommandId Request a
r = case Request a
r of
    RequestVersion {} -> CommandId
cmdRequestVersion
    RequestPause {}   -> CommandId
cmdRequestPause
    RequestResume {}  -> CommandId
cmdRequestResume
    RequestRoots {}   -> CommandId
cmdRequestRoots
    RequestClosure {}  -> CommandId
cmdRequestClosures
    RequestInfoTable {}  -> CommandId
cmdRequestInfoTables
    RequestSRT {}        -> CommandId
cmdRequestSRT
    RequestPoll {}         -> CommandId
cmdRequestPoll
    RequestSavedObjects {} -> CommandId
cmdRequestSavedObjects
    RequestStackBitmap {}       -> CommandId
cmdRequestStackBitmap
    RequestFunBitmap {}       -> CommandId
cmdRequestFunBitmap
    RequestConstrDesc {}   -> CommandId
cmdRequestConstrDesc
    RequestSourceInfo {}   -> CommandId
cmdRequestSourceInfo
    RequestAllBlocks {} -> CommandId
cmdRequestAllBlocks
    RequestBlock {} -> CommandId
cmdRequestBlock
    RequestCCS{} -> CommandId
cmdRequestCCS
    RequestCC{} -> CommandId
cmdRequestCC
    RequestIndexTable{} -> CommandId
cmdRequestIndexTable
    RequestCCSMainPtr{} -> CommandId
cmdRequestCCSMainPtr

cmdRequestVersion :: CommandId
cmdRequestVersion :: CommandId
cmdRequestVersion = Word32 -> CommandId
CommandId Word32
1

cmdRequestPause :: CommandId
cmdRequestPause :: CommandId
cmdRequestPause = Word32 -> CommandId
CommandId Word32
2

cmdRequestResume :: CommandId
cmdRequestResume :: CommandId
cmdRequestResume = Word32 -> CommandId
CommandId Word32
3

cmdRequestRoots :: CommandId
cmdRequestRoots :: CommandId
cmdRequestRoots = Word32 -> CommandId
CommandId Word32
4

cmdRequestClosures :: CommandId
cmdRequestClosures :: CommandId
cmdRequestClosures = Word32 -> CommandId
CommandId Word32
5

cmdRequestInfoTables :: CommandId
cmdRequestInfoTables :: CommandId
cmdRequestInfoTables = Word32 -> CommandId
CommandId Word32
6

cmdRequestStackBitmap :: CommandId
cmdRequestStackBitmap :: CommandId
cmdRequestStackBitmap = Word32 -> CommandId
CommandId Word32
7

cmdRequestPoll :: CommandId
cmdRequestPoll :: CommandId
cmdRequestPoll = Word32 -> CommandId
CommandId Word32
8

cmdRequestSavedObjects :: CommandId
cmdRequestSavedObjects :: CommandId
cmdRequestSavedObjects = Word32 -> CommandId
CommandId Word32
9

cmdRequestConstrDesc :: CommandId
cmdRequestConstrDesc :: CommandId
cmdRequestConstrDesc = Word32 -> CommandId
CommandId Word32
11

cmdRequestSourceInfo :: CommandId
cmdRequestSourceInfo :: CommandId
cmdRequestSourceInfo = Word32 -> CommandId
CommandId Word32
12

cmdRequestAllBlocks :: CommandId
cmdRequestAllBlocks :: CommandId
cmdRequestAllBlocks = Word32 -> CommandId
CommandId Word32
14

cmdRequestBlock :: CommandId
cmdRequestBlock :: CommandId
cmdRequestBlock = Word32 -> CommandId
CommandId Word32
15

cmdRequestFunBitmap :: CommandId
cmdRequestFunBitmap :: CommandId
cmdRequestFunBitmap = Word32 -> CommandId
CommandId Word32
16

cmdRequestSRT :: CommandId
cmdRequestSRT :: CommandId
cmdRequestSRT  = Word32 -> CommandId
CommandId Word32
17

cmdRequestCCS :: CommandId
cmdRequestCCS :: CommandId
cmdRequestCCS  = Word32 -> CommandId
CommandId Word32
18

cmdRequestCC :: CommandId
cmdRequestCC :: CommandId
cmdRequestCC  = Word32 -> CommandId
CommandId Word32
19

cmdRequestIndexTable :: CommandId
cmdRequestIndexTable :: CommandId
cmdRequestIndexTable  = Word32 -> CommandId
CommandId Word32
20

cmdRequestCCSMainPtr :: CommandId
cmdRequestCCSMainPtr :: CommandId
cmdRequestCCSMainPtr  = Word32 -> CommandId
CommandId Word32
21

data AnyReq = forall req . AnyReq !(Request req)

instance Hashable AnyReq where
  hashWithSalt :: Int -> AnyReq -> Int
hashWithSalt Int
s (AnyReq Request req
r) = Int -> Request req -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s Request req
r

instance Eq AnyReq where
  (AnyReq Request req
r1) == :: AnyReq -> AnyReq -> Bool
== (AnyReq Request req
r2) = Request req -> Request req -> Bool
forall a b. Request a -> Request b -> Bool
eq1request Request req
r1 Request req
r2

data AnyResp = forall a . AnyResp !a !(a -> Put)

putCommand :: CommandId -> Put -> Put
putCommand :: CommandId -> Put -> Put
putCommand CommandId
c Put
body = do
    Word32 -> Put
putWord32be (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
4 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
BSL.length ByteString
body')
    CommandId -> Put
forall t. Binary t => t -> Put
put CommandId
c
    ByteString -> Put
putLazyByteString ByteString
body'
  where
    body' :: ByteString
body' = Put -> ByteString
runPut Put
body

putRequest :: Request a -> Put
putRequest :: forall a. Request a -> Put
putRequest Request a
RequestVersion        = CommandId -> Put -> Put
putCommand CommandId
cmdRequestVersion Put
forall a. Monoid a => a
mempty
putRequest (RequestPause ForkOrPause
p)      = CommandId -> Put -> Put
putCommand CommandId
cmdRequestPause (ForkOrPause -> Put
forall t. Binary t => t -> Put
put ForkOrPause
p)
putRequest Request a
RequestResume         = CommandId -> Put -> Put
putCommand CommandId
cmdRequestResume Put
forall a. Monoid a => a
mempty
putRequest Request a
RequestRoots          = CommandId -> Put -> Put
putCommand CommandId
cmdRequestRoots Put
forall a. Monoid a => a
mempty
putRequest (RequestClosure ClosurePtr
cs)  =
  CommandId -> Put -> Put
putCommand CommandId
cmdRequestClosures (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ do
    Word16 -> Put
putWord16be Word16
1
    ClosurePtr -> Put
forall t. Binary t => t -> Put
put ClosurePtr
cs
putRequest (RequestInfoTable InfoTablePtr
ts) =
  CommandId -> Put -> Put
putCommand CommandId
cmdRequestInfoTables (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ do
    Word16 -> Put
putWord16be Word16
1
    InfoTablePtr -> Put
forall t. Binary t => t -> Put
put InfoTablePtr
ts
putRequest (RequestSRT InfoTablePtr
ts) =
  CommandId -> Put -> Put
putCommand CommandId
cmdRequestSRT (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ do
    Word16 -> Put
putWord16be Word16
1
    InfoTablePtr -> Put
forall t. Binary t => t -> Put
put InfoTablePtr
ts
putRequest (RequestStackBitmap StackPtr
sp Word32
o)       =
  CommandId -> Put -> Put
putCommand CommandId
cmdRequestStackBitmap (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ StackPtr -> Put
forall t. Binary t => t -> Put
put StackPtr
sp Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
putWord32be Word32
o
putRequest (RequestFunBitmap Word16
n ClosurePtr
cp)       =
  CommandId -> Put -> Put
putCommand CommandId
cmdRequestFunBitmap (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ ClosurePtr -> Put
forall t. Binary t => t -> Put
put ClosurePtr
cp Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Put
putWord16be Word16
n
putRequest (RequestConstrDesc InfoTablePtr
itb) =
  CommandId -> Put -> Put
putCommand CommandId
cmdRequestConstrDesc (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ InfoTablePtr -> Put
forall t. Binary t => t -> Put
put InfoTablePtr
itb
putRequest Request a
RequestPoll           = CommandId -> Put -> Put
putCommand CommandId
cmdRequestPoll Put
forall a. Monoid a => a
mempty
putRequest Request a
RequestSavedObjects   = CommandId -> Put -> Put
putCommand CommandId
cmdRequestSavedObjects Put
forall a. Monoid a => a
mempty
--putRequest (RequestFindPtr c)       =
--  putCommand cmdRequestFindPtr $ put c
putRequest (RequestSourceInfo InfoTablePtr
it) = CommandId -> Put -> Put
putCommand CommandId
cmdRequestSourceInfo (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ InfoTablePtr -> Put
forall t. Binary t => t -> Put
put InfoTablePtr
it
putRequest (Request a
RequestAllBlocks) = CommandId -> Put -> Put
putCommand CommandId
cmdRequestAllBlocks (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ () -> Put
forall a. a -> PutM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
putRequest (RequestBlock ClosurePtr
cp)  = CommandId -> Put -> Put
putCommand CommandId
cmdRequestBlock (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ ClosurePtr -> Put
forall t. Binary t => t -> Put
put ClosurePtr
cp
putRequest (RequestCCS CCSPtr
cp)  = CommandId -> Put -> Put
putCommand CommandId
cmdRequestCCS (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ CCSPtr -> Put
forall t. Binary t => t -> Put
put CCSPtr
cp
putRequest (RequestCC CCPtr
cp)  = CommandId -> Put -> Put
putCommand CommandId
cmdRequestCC (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ CCPtr -> Put
forall t. Binary t => t -> Put
put CCPtr
cp
putRequest (RequestIndexTable IndexTablePtr
cp)  = CommandId -> Put -> Put
putCommand CommandId
cmdRequestIndexTable (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ IndexTablePtr -> Put
forall t. Binary t => t -> Put
put IndexTablePtr
cp
putRequest Request a
RequestCCSMainPtr  = CommandId -> Put -> Put
putCommand CommandId
cmdRequestCCSMainPtr Put
forall a. Monoid a => a
mempty

-- This is used to serialise the RequestCache
getRequest :: Get AnyReq
getRequest :: Get AnyReq
getRequest = do
  Word32
len <- Get Word32
getWord32be
  Int -> Get AnyReq -> Get AnyReq
forall a. Int -> Get a -> Get a
isolate (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len) (Get AnyReq -> Get AnyReq) -> Get AnyReq -> Get AnyReq
forall a b. (a -> b) -> a -> b
$ do
    CommandId
cmd <- Get CommandId
forall t. Binary t => Get t
get
    if
      | CommandId
cmd CommandId -> CommandId -> Bool
forall a. Eq a => a -> a -> Bool
== CommandId
cmdRequestVersion -> AnyReq -> Get AnyReq
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Request Version -> AnyReq
forall req. Request req -> AnyReq
AnyReq Request Version
RequestVersion)
      | CommandId
cmd CommandId -> CommandId -> Bool
forall a. Eq a => a -> a -> Bool
== CommandId
cmdRequestPause   -> do
          ForkOrPause
b <- Get ForkOrPause
forall t. Binary t => Get t
get
          return (Request () -> AnyReq
forall req. Request req -> AnyReq
AnyReq (ForkOrPause -> Request ()
RequestPause ForkOrPause
b))
      | CommandId
cmd CommandId -> CommandId -> Bool
forall a. Eq a => a -> a -> Bool
== CommandId
cmdRequestResume  -> AnyReq -> Get AnyReq
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Request () -> AnyReq
forall req. Request req -> AnyReq
AnyReq Request ()
RequestResume)
      | CommandId
cmd CommandId -> CommandId -> Bool
forall a. Eq a => a -> a -> Bool
== CommandId
cmdRequestRoots   -> AnyReq -> Get AnyReq
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Request [ClosurePtr] -> AnyReq
forall req. Request req -> AnyReq
AnyReq Request [ClosurePtr]
RequestRoots)
      | CommandId
cmd CommandId -> CommandId -> Bool
forall a. Eq a => a -> a -> Bool
== CommandId
cmdRequestClosures -> do
          Word16
_n <- Get Word16
getWord16be
--          cs <- replicateM (fromIntegral n) get
          ClosurePtr
cp <- Get ClosurePtr
forall t. Binary t => Get t
get
          return (Request RawClosure -> AnyReq
forall req. Request req -> AnyReq
AnyReq (ClosurePtr -> Request RawClosure
RequestClosure ClosurePtr
cp))
      | CommandId
cmd CommandId -> CommandId -> Bool
forall a. Eq a => a -> a -> Bool
== CommandId
cmdRequestInfoTables -> do
          Word16
_n <- Get Word16
getWord16be
          --itbs <- replicateM (fromIntegral n) get
          InfoTablePtr
itb <- Get InfoTablePtr
forall t. Binary t => Get t
get
          return (Request RawInfoTable -> AnyReq
forall req. Request req -> AnyReq
AnyReq (InfoTablePtr -> Request RawInfoTable
RequestInfoTable InfoTablePtr
itb))
      | CommandId
cmd CommandId -> CommandId -> Bool
forall a. Eq a => a -> a -> Bool
== CommandId
cmdRequestSRT -> do
          Word16
_n <- Get Word16
getWord16be
          InfoTablePtr
itb <- Get InfoTablePtr
forall t. Binary t => Get t
get
          return (Request (Maybe ClosurePtr) -> AnyReq
forall req. Request req -> AnyReq
AnyReq (InfoTablePtr -> Request (Maybe ClosurePtr)
RequestSRT InfoTablePtr
itb))
      | CommandId
cmd CommandId -> CommandId -> Bool
forall a. Eq a => a -> a -> Bool
== CommandId
cmdRequestStackBitmap -> do
          StackPtr
sp <- Get StackPtr
forall t. Binary t => Get t
get
          Word32
o  <- Get Word32
getWord32be
          return (Request PtrBitmap -> AnyReq
forall req. Request req -> AnyReq
AnyReq (StackPtr -> Word32 -> Request PtrBitmap
RequestStackBitmap StackPtr
sp Word32
o))
      | CommandId
cmd CommandId -> CommandId -> Bool
forall a. Eq a => a -> a -> Bool
== CommandId
cmdRequestFunBitmap -> do
          ClosurePtr
cp <- Get ClosurePtr
forall t. Binary t => Get t
get
          Word16
n <- Get Word16
getWord16be
          return (Request PtrBitmap -> AnyReq
forall req. Request req -> AnyReq
AnyReq (Word16 -> ClosurePtr -> Request PtrBitmap
RequestFunBitmap Word16
n ClosurePtr
cp))
      | CommandId
cmd CommandId -> CommandId -> Bool
forall a. Eq a => a -> a -> Bool
== CommandId
cmdRequestConstrDesc -> do
          InfoTablePtr
itb <- Get InfoTablePtr
forall t. Binary t => Get t
get
          return (Request ConstrDesc -> AnyReq
forall req. Request req -> AnyReq
AnyReq (InfoTablePtr -> Request ConstrDesc
RequestConstrDesc InfoTablePtr
itb))
      | CommandId
cmd CommandId -> CommandId -> Bool
forall a. Eq a => a -> a -> Bool
== CommandId
cmdRequestPoll -> AnyReq -> Get AnyReq
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Request () -> AnyReq
forall req. Request req -> AnyReq
AnyReq Request ()
RequestPoll)
      | CommandId
cmd CommandId -> CommandId -> Bool
forall a. Eq a => a -> a -> Bool
== CommandId
cmdRequestSavedObjects -> AnyReq -> Get AnyReq
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Request [ClosurePtr] -> AnyReq
forall req. Request req -> AnyReq
AnyReq Request [ClosurePtr]
RequestSavedObjects)
      | CommandId
cmd CommandId -> CommandId -> Bool
forall a. Eq a => a -> a -> Bool
== CommandId
cmdRequestSourceInfo -> do
          InfoTablePtr
it <- Get InfoTablePtr
forall t. Binary t => Get t
get
          return (Request (Maybe SourceInformation) -> AnyReq
forall req. Request req -> AnyReq
AnyReq (InfoTablePtr -> Request (Maybe SourceInformation)
RequestSourceInfo InfoTablePtr
it))
      | CommandId
cmd CommandId -> CommandId -> Bool
forall a. Eq a => a -> a -> Bool
== CommandId
cmdRequestAllBlocks -> AnyReq -> Get AnyReq
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Request [RawBlock] -> AnyReq
forall req. Request req -> AnyReq
AnyReq Request [RawBlock]
RequestAllBlocks)
      | CommandId
cmd CommandId -> CommandId -> Bool
forall a. Eq a => a -> a -> Bool
== CommandId
cmdRequestBlock -> do
            ClosurePtr
cp <- Get ClosurePtr
forall t. Binary t => Get t
get
            return (Request RawBlock -> AnyReq
forall req. Request req -> AnyReq
AnyReq (ClosurePtr -> Request RawBlock
RequestBlock ClosurePtr
cp))
      | CommandId
cmd CommandId -> CommandId -> Bool
forall a. Eq a => a -> a -> Bool
== CommandId
cmdRequestCCS -> do
            CCSPtr
cp <- Get CCSPtr
forall t. Binary t => Get t
get
            return (Request (GenCCSPayload CCSPtr CCPtr) -> AnyReq
forall req. Request req -> AnyReq
AnyReq (CCSPtr -> Request (GenCCSPayload CCSPtr CCPtr)
RequestCCS CCSPtr
cp))
      | CommandId
cmd CommandId -> CommandId -> Bool
forall a. Eq a => a -> a -> Bool
== CommandId
cmdRequestCC -> do
            CCPtr
cp <- Get CCPtr
forall t. Binary t => Get t
get
            return (Request CCPayload -> AnyReq
forall req. Request req -> AnyReq
AnyReq (CCPtr -> Request CCPayload
RequestCC CCPtr
cp))
      | CommandId
cmd CommandId -> CommandId -> Bool
forall a. Eq a => a -> a -> Bool
== CommandId
cmdRequestIndexTable -> do
            IndexTablePtr
cp <- Get IndexTablePtr
forall t. Binary t => Get t
get
            return (Request IndexTable -> AnyReq
forall req. Request req -> AnyReq
AnyReq (IndexTablePtr -> Request IndexTable
RequestIndexTable IndexTablePtr
cp))
      | CommandId
cmd CommandId -> CommandId -> Bool
forall a. Eq a => a -> a -> Bool
== CommandId
cmdRequestCCSMainPtr -> AnyReq -> Get AnyReq
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Request CCSPtr -> AnyReq
forall req. Request req -> AnyReq
AnyReq Request CCSPtr
RequestCCSMainPtr)
      | Bool
otherwise -> String -> Get AnyReq
forall a. HasCallStack => String -> a
error (CommandId -> String
forall a. Show a => a -> String
show CommandId
cmd)


getResponse :: Request a -> Get a
getResponse :: forall a. Request a -> Get a
getResponse Request a
RequestVersion       = Word32 -> Word32 -> Maybe ProfilingMode -> Bool -> a
Word32 -> Word32 -> Maybe ProfilingMode -> Bool -> Version
Version (Word32 -> Word32 -> Maybe ProfilingMode -> Bool -> a)
-> Get Word32 -> Get (Word32 -> Maybe ProfilingMode -> Bool -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
forall t. Binary t => Get t
get Get (Word32 -> Maybe ProfilingMode -> Bool -> a)
-> Get Word32 -> Get (Maybe ProfilingMode -> Bool -> a)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
forall t. Binary t => Get t
get Get (Maybe ProfilingMode -> Bool -> a)
-> Get (Maybe ProfilingMode) -> Get (Bool -> a)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Maybe ProfilingMode)
getProfilingMode Get (Bool -> a) -> Get Bool -> Get a
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Bool
forall t. Binary t => Get t
get
getResponse RequestPause {}      = Get a
forall t. Binary t => Get t
get
getResponse Request a
RequestResume        = Get a
forall t. Binary t => Get t
get
getResponse Request a
RequestRoots         = Get ClosurePtr -> Get [ClosurePtr]
forall a. Get a -> Get [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Get ClosurePtr
forall t. Binary t => Get t
get
getResponse (RequestClosure {}) = Get a
forall t. Binary t => Get t
get
getResponse (RequestInfoTable {}) = Get a
Get RawInfoTable
getInfoTable
getResponse (RequestSRT {}) = do
  ClosurePtr
cptr <- Get ClosurePtr
forall t. Binary t => Get t
get
  pure $ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ClosurePtr
cptr ClosurePtr -> ClosurePtr -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64 -> ClosurePtr
UntaggedClosurePtr Word64
0) Maybe () -> ClosurePtr -> Maybe ClosurePtr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ClosurePtr
cptr

--    zipWith (\p (it, r) -> (StgInfoTableWithPtr p it, r)) itps
--      <$> replicateM (length itps) getInfoTable
getResponse (RequestStackBitmap {}) = Get a
forall t. Binary t => Get t
get
getResponse (RequestFunBitmap {}) = Get a
forall t. Binary t => Get t
get
getResponse (RequestConstrDesc InfoTablePtr
_)  = Get a
Get ConstrDesc
getConstrDesc
getResponse Request a
RequestPoll          = Get a
forall t. Binary t => Get t
get
getResponse Request a
RequestSavedObjects  = Get ClosurePtr -> Get [ClosurePtr]
forall a. Get a -> Get [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Get ClosurePtr
forall t. Binary t => Get t
get
getResponse (RequestSourceInfo InfoTablePtr
_c) = Get a
Get (Maybe SourceInformation)
getIPE
getResponse Request a
RequestAllBlocks = Get RawBlock -> Get [RawBlock]
forall a. Get a -> Get [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Get RawBlock
forall t. Binary t => Get t
get
getResponse RequestBlock {}  = Get a
forall t. Binary t => Get t
get
getResponse (RequestCCS {}) = Get a
Get (GenCCSPayload CCSPtr CCPtr)
getCCS

getResponse (RequestCC {}) = Get a
Get CCPayload
getCC
getResponse (RequestIndexTable {}) = Get a
Get IndexTable
getIndexTable
getResponse (RequestCCSMainPtr {}) = Get a
Get CCSPtr
getCCSMainPtr

getProfilingMode :: Get (Maybe ProfilingMode)
getProfilingMode :: Get (Maybe ProfilingMode)
getProfilingMode = do
  Word8
w <- Get Word8
getWord8
  case Word8
w of
    Word8
0 -> Maybe ProfilingMode -> Get (Maybe ProfilingMode)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ProfilingMode -> Get (Maybe ProfilingMode))
-> Maybe ProfilingMode -> Get (Maybe ProfilingMode)
forall a b. (a -> b) -> a -> b
$ Maybe ProfilingMode
forall a. Maybe a
Nothing
    Word8
1 -> Maybe ProfilingMode -> Get (Maybe ProfilingMode)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ProfilingMode -> Get (Maybe ProfilingMode))
-> Maybe ProfilingMode -> Get (Maybe ProfilingMode)
forall a b. (a -> b) -> a -> b
$ ProfilingMode -> Maybe ProfilingMode
forall a. a -> Maybe a
Just ProfilingMode
NoProfiling
    Word8
2 -> Maybe ProfilingMode -> Get (Maybe ProfilingMode)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ProfilingMode -> Get (Maybe ProfilingMode))
-> Maybe ProfilingMode -> Get (Maybe ProfilingMode)
forall a b. (a -> b) -> a -> b
$ ProfilingMode -> Maybe ProfilingMode
forall a. a -> Maybe a
Just ProfilingMode
RetainerProfiling
    Word8
3 -> Maybe ProfilingMode -> Get (Maybe ProfilingMode)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ProfilingMode -> Get (Maybe ProfilingMode))
-> Maybe ProfilingMode -> Get (Maybe ProfilingMode)
forall a b. (a -> b) -> a -> b
$ ProfilingMode -> Maybe ProfilingMode
forall a. a -> Maybe a
Just ProfilingMode
LDVProfiling
    Word8
4 -> Maybe ProfilingMode -> Get (Maybe ProfilingMode)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ProfilingMode -> Get (Maybe ProfilingMode))
-> Maybe ProfilingMode -> Get (Maybe ProfilingMode)
forall a b. (a -> b) -> a -> b
$ ProfilingMode -> Maybe ProfilingMode
forall a. a -> Maybe a
Just ProfilingMode
EraProfiling
    Word8
5 -> Maybe ProfilingMode -> Get (Maybe ProfilingMode)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ProfilingMode -> Get (Maybe ProfilingMode))
-> Maybe ProfilingMode -> Get (Maybe ProfilingMode)
forall a b. (a -> b) -> a -> b
$ ProfilingMode -> Maybe ProfilingMode
forall a. a -> Maybe a
Just ProfilingMode
OtherProfiling
    Word8
_ -> String -> Get (Maybe ProfilingMode)
forall a. HasCallStack => String -> a
error (String -> Get (Maybe ProfilingMode))
-> String -> Get (Maybe ProfilingMode)
forall a b. (a -> b) -> a -> b
$ String
"Unknown profiling mode: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Word8 -> String
forall a. Show a => a -> String
show Word8
w)

putProfilingMode :: Maybe ProfilingMode -> Put
putProfilingMode :: Maybe ProfilingMode -> Put
putProfilingMode Maybe ProfilingMode
Nothing = Word8 -> Put
putWord8 Word8
0
putProfilingMode (Just ProfilingMode
mode) =
  case ProfilingMode
mode of
    ProfilingMode
NoProfiling -> Word8 -> Put
putWord8 Word8
1
    ProfilingMode
RetainerProfiling -> Word8 -> Put
putWord8 Word8
2
    ProfilingMode
LDVProfiling -> Word8 -> Put
putWord8 Word8
3
    ProfilingMode
EraProfiling -> Word8 -> Put
putWord8 Word8
4
    ProfilingMode
OtherProfiling -> Word8 -> Put
putWord8 Word8
5

getCCS :: Get CCSPayload
getCCS :: Get (GenCCSPayload CCSPtr CCPtr)
getCCS = do
  Int64
ccsID <- Get Int64
getInt64le
  CCPtr
ccsCc <- Get CCPtr
forall t. Binary t => Get t
get
  Maybe CCSPtr
ccsPrevStack <- do
    CCSPtr
p <- Get CCSPtr
forall t. Binary t => Get t
get
    pure $ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (CCSPtr
p CCSPtr -> CCSPtr -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64 -> CCSPtr
CCSPtr Word64
0) Maybe () -> CCSPtr -> Maybe CCSPtr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$>  CCSPtr
p
  Maybe IndexTablePtr
ccsIndexTable <- do
    IndexTablePtr
p <- Get IndexTablePtr
forall t. Binary t => Get t
get
    pure $ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (IndexTablePtr
p IndexTablePtr -> IndexTablePtr -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64 -> IndexTablePtr
IndexTablePtr Word64
0) Maybe () -> IndexTablePtr -> Maybe IndexTablePtr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$>  IndexTablePtr
p
  Maybe CCSPtr
ccsRoot <- do
    CCSPtr
p <- Get CCSPtr
forall t. Binary t => Get t
get
    pure $ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (CCSPtr
p CCSPtr -> CCSPtr -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64 -> CCSPtr
CCSPtr Word64
0) Maybe () -> CCSPtr -> Maybe CCSPtr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$>  CCSPtr
p
  Word
ccsDepth <- Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word) -> Get Word64 -> Get Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le
  Word64
ccsSccCount <- Get Word64
getWord64le
  Word
ccsSelected <- Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word) -> Get Word64 -> Get Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le
  Word
ccsTimeTicks <- Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word) -> Get Word64 -> Get Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le
  Word64
ccsMemAlloc <- Get Word64
getWord64le
  Word64
ccsInheritedAlloc <- Get Word64
getWord64le
  Word
ccsInheritedTicks <- Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word) -> Get Word64 -> Get Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le
  pure CCSPayload{Int64
Maybe IndexTablePtr
Maybe CCSPtr
Word
Word64
CCPtr
ccsID :: Int64
ccsCc :: CCPtr
ccsPrevStack :: Maybe CCSPtr
ccsIndexTable :: Maybe IndexTablePtr
ccsRoot :: Maybe CCSPtr
ccsDepth :: Word
ccsSccCount :: Word64
ccsSelected :: Word
ccsTimeTicks :: Word
ccsMemAlloc :: Word64
ccsInheritedAlloc :: Word64
ccsInheritedTicks :: Word
ccsID :: Int64
ccsCc :: CCPtr
ccsPrevStack :: Maybe CCSPtr
ccsIndexTable :: Maybe IndexTablePtr
ccsRoot :: Maybe CCSPtr
ccsDepth :: Word
ccsSccCount :: Word64
ccsSelected :: Word
ccsTimeTicks :: Word
ccsMemAlloc :: Word64
ccsInheritedAlloc :: Word64
ccsInheritedTicks :: Word
..}


putCCS :: CCSPayload -> Put
putCCS :: GenCCSPayload CCSPtr CCPtr -> Put
putCCS CCSPayload{Int64
Maybe IndexTablePtr
Maybe CCSPtr
Word
Word64
CCPtr
ccsID :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Int64
ccsCc :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> ccPtr
ccsPrevStack :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Maybe ccsPtr
ccsIndexTable :: forall ccsPtr ccPtr.
GenCCSPayload ccsPtr ccPtr -> Maybe IndexTablePtr
ccsRoot :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Maybe CCSPtr
ccsDepth :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word
ccsSccCount :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word64
ccsSelected :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word
ccsTimeTicks :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word
ccsMemAlloc :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word64
ccsInheritedAlloc :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word64
ccsInheritedTicks :: forall ccsPtr ccPtr. GenCCSPayload ccsPtr ccPtr -> Word
ccsID :: Int64
ccsCc :: CCPtr
ccsPrevStack :: Maybe CCSPtr
ccsIndexTable :: Maybe IndexTablePtr
ccsRoot :: Maybe CCSPtr
ccsDepth :: Word
ccsSccCount :: Word64
ccsSelected :: Word
ccsTimeTicks :: Word
ccsMemAlloc :: Word64
ccsInheritedAlloc :: Word64
ccsInheritedTicks :: Word
..} = do
  Int64 -> Put
putInt64le Int64
ccsID
  CCPtr -> Put
forall t. Binary t => t -> Put
put CCPtr
ccsCc
  case Maybe CCSPtr
ccsPrevStack of
    Maybe CCSPtr
Nothing -> CCSPtr -> Put
forall t. Binary t => t -> Put
put (Word64 -> CCSPtr
CCSPtr Word64
0)
    Just CCSPtr
x -> CCSPtr -> Put
forall t. Binary t => t -> Put
put CCSPtr
x
  case Maybe IndexTablePtr
ccsIndexTable of
    Maybe IndexTablePtr
Nothing -> IndexTablePtr -> Put
forall t. Binary t => t -> Put
put (Word64 -> IndexTablePtr
IndexTablePtr Word64
0)
    Just IndexTablePtr
x -> IndexTablePtr -> Put
forall t. Binary t => t -> Put
put IndexTablePtr
x
  case Maybe CCSPtr
ccsRoot of
    Maybe CCSPtr
Nothing -> CCSPtr -> Put
forall t. Binary t => t -> Put
put (Word64 -> CCSPtr
CCSPtr Word64
0)
    Just CCSPtr
x -> CCSPtr -> Put
forall t. Binary t => t -> Put
put CCSPtr
x
  Word64 -> Put
putWord64le (Word64 -> Put) -> Word64 -> Put
forall a b. (a -> b) -> a -> b
$ Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
ccsDepth
  Word64 -> Put
putWord64le Word64
ccsSccCount
  Word64 -> Put
putWord64le (Word64 -> Put) -> Word64 -> Put
forall a b. (a -> b) -> a -> b
$ Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
ccsSelected
  Word64 -> Put
putWord64le (Word64 -> Put) -> Word64 -> Put
forall a b. (a -> b) -> a -> b
$ Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
ccsTimeTicks
  Word64 -> Put
putWord64le Word64
ccsMemAlloc
  Word64 -> Put
putWord64le Word64
ccsInheritedAlloc
  Word64 -> Put
putWord64le (Word64 -> Put) -> Word64 -> Put
forall a b. (a -> b) -> a -> b
$ Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
ccsInheritedTicks

getCC :: Get CCPayload
getCC :: Get CCPayload
getCC = do
  Int64
ccID <- Get Int64
getInt64le
  String
ccLabel <- Get String
getString
  String
ccMod <- Get String
getString
  String
ccLoc <- Get String
getString
  Word64
ccMemAlloc <- Get Word64
forall t. Binary t => Get t
get
  Word
ccTimeTicks <- Get Word
forall t. Binary t => Get t
get
  Bool
ccIsCaf <- (\Word64
i -> if Word64
i Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 then Bool
False else Bool
True ) (Word64 -> Bool) -> Get Word64 -> Get Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64be
  Maybe CCPtr
ccLink <- do
    CCPtr
p <- Get CCPtr
forall t. Binary t => Get t
get
    pure $ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (CCPtr
p CCPtr -> CCPtr -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64 -> CCPtr
CCPtr Word64
0) Maybe () -> CCPtr -> Maybe CCPtr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$>  CCPtr
p
  pure CCPayload{Bool
Int64
String
Maybe CCPtr
Word
Word64
ccID :: Int64
ccLabel :: String
ccMod :: String
ccLoc :: String
ccMemAlloc :: Word64
ccTimeTicks :: Word
ccIsCaf :: Bool
ccLink :: Maybe CCPtr
ccID :: Int64
ccLabel :: String
ccMod :: String
ccLoc :: String
ccMemAlloc :: Word64
ccTimeTicks :: Word
ccIsCaf :: Bool
ccLink :: Maybe CCPtr
..}
  where
    getString :: Get String
getString = do
      Int32
len <- Get Int32
getInt32be
      ByteString -> String
C8.unpack (ByteString -> String) -> Get ByteString -> Get String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
len)

putCC :: CCPayload -> Put
putCC :: CCPayload -> Put
putCC CCPayload{Bool
Int64
String
Maybe CCPtr
Word
Word64
ccID :: CCPayload -> Int64
ccLabel :: CCPayload -> String
ccMod :: CCPayload -> String
ccLoc :: CCPayload -> String
ccMemAlloc :: CCPayload -> Word64
ccTimeTicks :: CCPayload -> Word
ccIsCaf :: CCPayload -> Bool
ccLink :: CCPayload -> Maybe CCPtr
ccID :: Int64
ccLabel :: String
ccMod :: String
ccLoc :: String
ccMemAlloc :: Word64
ccTimeTicks :: Word
ccIsCaf :: Bool
ccLink :: Maybe CCPtr
..} = do
  Int64 -> Put
putInt64le Int64
ccID
  String -> Put
putString String
ccLabel
  String -> Put
putString String
ccMod
  String -> Put
putString String
ccLoc
  Word64 -> Put
forall t. Binary t => t -> Put
put Word64
ccMemAlloc
  Word -> Put
forall t. Binary t => t -> Put
put Word
ccTimeTicks
  if Bool
ccIsCaf
    then Word64 -> Put
putWord64le Word64
0
    else Word64 -> Put
putWord64le Word64
1
  case Maybe CCPtr
ccLink of
    Maybe CCPtr
Nothing -> CCPtr -> Put
forall t. Binary t => t -> Put
put (Word64 -> CCPtr
CCPtr Word64
0)
    Just CCPtr
x -> CCPtr -> Put
forall t. Binary t => t -> Put
put CCPtr
x
  where
    putString :: String -> Put
putString String
xs = do
      Int32 -> Put
putInt32be (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
xs)
      ByteString -> Put
putByteString (String -> ByteString
C8.pack String
xs)

getIndexTable :: Get IndexTable
getIndexTable :: Get IndexTable
getIndexTable = do
  CCPtr
itCostCentre <- Get CCPtr
forall t. Binary t => Get t
get
  CCSPtr
itCostCentreStack <- Get CCSPtr
forall t. Binary t => Get t
get
  Maybe IndexTablePtr
itNext <- do
    IndexTablePtr
p <- Get IndexTablePtr
forall t. Binary t => Get t
get
    pure $ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (IndexTablePtr
p IndexTablePtr -> IndexTablePtr -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64 -> IndexTablePtr
IndexTablePtr Word64
0) Maybe () -> IndexTablePtr -> Maybe IndexTablePtr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IndexTablePtr
p
  Bool
itBackEdge <- (\Word8
i -> if Word8
i Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 then Bool
False else Bool
True) (Word8 -> Bool) -> Get Word8 -> Get Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
  pure IndexTable{Bool
Maybe IndexTablePtr
CCPtr
CCSPtr
itCostCentre :: CCPtr
itCostCentreStack :: CCSPtr
itNext :: Maybe IndexTablePtr
itBackEdge :: Bool
itCostCentre :: CCPtr
itCostCentreStack :: CCSPtr
itNext :: Maybe IndexTablePtr
itBackEdge :: Bool
..}

putIndexTable :: IndexTable -> Put
putIndexTable :: IndexTable -> Put
putIndexTable IndexTable {Bool
Maybe IndexTablePtr
CCPtr
CCSPtr
itCostCentre :: IndexTable -> CCPtr
itCostCentreStack :: IndexTable -> CCSPtr
itNext :: IndexTable -> Maybe IndexTablePtr
itBackEdge :: IndexTable -> Bool
itCostCentre :: CCPtr
itCostCentreStack :: CCSPtr
itNext :: Maybe IndexTablePtr
itBackEdge :: Bool
..} = do
  CCPtr -> Put
forall t. Binary t => t -> Put
put CCPtr
itCostCentre
  CCSPtr -> Put
forall t. Binary t => t -> Put
put CCSPtr
itCostCentreStack
  case Maybe IndexTablePtr
itNext of
    Maybe IndexTablePtr
Nothing -> IndexTablePtr -> Put
forall t. Binary t => t -> Put
put (Word64 -> IndexTablePtr
IndexTablePtr Word64
0)
    Just IndexTablePtr
x -> IndexTablePtr -> Put
forall t. Binary t => t -> Put
put IndexTablePtr
x
  if Bool
itBackEdge
    then Word8 -> Put
putWord8 Word8
0
    else Word8 -> Put
putWord8 Word8
1

getCCSMainPtr :: Get CCSPtr
getCCSMainPtr :: Get CCSPtr
getCCSMainPtr = Get CCSPtr
forall t. Binary t => Get t
get

putCCSMainPtr :: CCSPtr -> Put
putCCSMainPtr :: CCSPtr -> Put
putCCSMainPtr = CCSPtr -> Put
forall t. Binary t => t -> Put
put

getConstrDesc :: Get ConstrDesc
getConstrDesc :: Get ConstrDesc
getConstrDesc = do
  Int32
len <- Get Int32
getInt32be
  String -> ConstrDesc
parseConstrDesc (String -> ConstrDesc)
-> (ByteString -> String) -> ByteString -> ConstrDesc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
C8.unpack (ByteString -> ConstrDesc) -> Get ByteString -> Get ConstrDesc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
len)

getIPE :: Get (Maybe SourceInformation)
getIPE :: Get (Maybe SourceInformation)
getIPE = do
  Int32
num <- Get Int32
getInt32be
  [String]
res <- Int -> Get String -> Get [String]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
num) Get String
getOne
  case [String]
res of
    (String
id_name:String
cty:String
ty:String
lab:String
modu:String
loc:[]) ->
      Maybe SourceInformation -> Get (Maybe SourceInformation)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SourceInformation -> Get (Maybe SourceInformation))
-> (SourceInformation -> Maybe SourceInformation)
-> SourceInformation
-> Get (Maybe SourceInformation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceInformation -> Maybe SourceInformation
forall a. a -> Maybe a
Just (SourceInformation -> Get (Maybe SourceInformation))
-> SourceInformation -> Get (Maybe SourceInformation)
forall a b. (a -> b) -> a -> b
$! String
-> ClosureType
-> String
-> String
-> String
-> String
-> SourceInformation
SourceInformation String
id_name (String -> ClosureType
readCTy String
cty) String
ty String
lab String
modu String
loc
    [] -> Maybe SourceInformation -> Get (Maybe SourceInformation)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SourceInformation
forall a. Maybe a
Nothing
    [String]
fs -> String -> Get (Maybe SourceInformation)
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ((String, [String], Int32) -> String
forall a. Show a => a -> String
show (String
"Expecting 6 or 0 fields in IPE" :: String,  [String]
fs,Int32
num))
  where
    getOne :: Get String
getOne = do
      !Int32
len <- Get Int32
getInt32be
      !String
res <- ByteString -> String
C8.unpack (ByteString -> String) -> Get ByteString -> Get String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
len)
      String -> Get String
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return String
res
    -- All constructor nodes get 0, this is a wibble in the implementation
    -- of IPEs
    readCTy :: String -> ClosureType
readCTy String
"0" = ClosureType
CONSTR
    readCTy String
n   = Int -> ClosureType
forall a. Enum a => Int -> a
toEnum (forall a. Read a => String -> a
read @Int String
n)

putIPE :: Maybe SourceInformation -> Put
putIPE :: Maybe SourceInformation -> Put
putIPE Maybe SourceInformation
Nothing = Int32 -> Put
putInt32be Int32
0
putIPE (Just (SourceInformation String
a ClosureType
ty String
b String
c String
d String
e)) = do
  Int32 -> Put
putInt32be Int32
6
  String -> Put
putOne String
a
  String -> Put
putOne (Int -> String
forall a. Show a => a -> String
show (ClosureType -> Int
forall a. Enum a => a -> Int
fromEnum ClosureType
ty))
  String -> Put
putOne String
b
  String -> Put
putOne String
c
  String -> Put
putOne String
d
  String -> Put
putOne String
e
  where
    putOne :: String -> Put
putOne String
s = do
      Int32 -> Put
putInt32be (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s)
      ByteString -> Put
putByteString (String -> ByteString
C8.pack String
s)




getInfoTable :: Get RawInfoTable
getInfoTable :: Get RawInfoTable
getInfoTable = do
  !Int32
len <- Get Int32
getInt32be
  !RawInfoTable
r <- ByteString -> RawInfoTable
RawInfoTable (ByteString -> RawInfoTable) -> Get ByteString -> Get RawInfoTable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
len)
  RawInfoTable -> Get RawInfoTable
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return RawInfoTable
r

putInfoTable :: RawInfoTable -> Put
putInfoTable :: RawInfoTable -> Put
putInfoTable (RawInfoTable ByteString
rc) = do
  let n :: Int
n = ByteString -> Int
BS.length ByteString
rc
  Word32 -> Put
putWord32be (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
  ByteString -> Put
putByteString ByteString
rc



data Error = BadCommand
           | BadStack
           | AlreadyPaused
           | NotPaused
           | NoResume
           deriving stock (Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
/= :: Error -> Error -> Bool
Eq, Eq Error
Eq Error
-> (Error -> Error -> Ordering)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Error)
-> (Error -> Error -> Error)
-> Ord Error
Error -> Error -> Bool
Error -> Error -> Ordering
Error -> Error -> Error
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Error -> Error -> Ordering
compare :: Error -> Error -> Ordering
$c< :: Error -> Error -> Bool
< :: Error -> Error -> Bool
$c<= :: Error -> Error -> Bool
<= :: Error -> Error -> Bool
$c> :: Error -> Error -> Bool
> :: Error -> Error -> Bool
$c>= :: Error -> Error -> Bool
>= :: Error -> Error -> Bool
$cmax :: Error -> Error -> Error
max :: Error -> Error -> Error
$cmin :: Error -> Error -> Error
min :: Error -> Error -> Error
Ord, Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Error -> ShowS
showsPrec :: Int -> Error -> ShowS
$cshow :: Error -> String
show :: Error -> String
$cshowList :: [Error] -> ShowS
showList :: [Error] -> ShowS
Show)

instance Exception Error

data ResponseCode = Okay
                  | OkayContinues
                  | Error Error
                  deriving stock (ResponseCode -> ResponseCode -> Bool
(ResponseCode -> ResponseCode -> Bool)
-> (ResponseCode -> ResponseCode -> Bool) -> Eq ResponseCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResponseCode -> ResponseCode -> Bool
== :: ResponseCode -> ResponseCode -> Bool
$c/= :: ResponseCode -> ResponseCode -> Bool
/= :: ResponseCode -> ResponseCode -> Bool
Eq, Eq ResponseCode
Eq ResponseCode
-> (ResponseCode -> ResponseCode -> Ordering)
-> (ResponseCode -> ResponseCode -> Bool)
-> (ResponseCode -> ResponseCode -> Bool)
-> (ResponseCode -> ResponseCode -> Bool)
-> (ResponseCode -> ResponseCode -> Bool)
-> (ResponseCode -> ResponseCode -> ResponseCode)
-> (ResponseCode -> ResponseCode -> ResponseCode)
-> Ord ResponseCode
ResponseCode -> ResponseCode -> Bool
ResponseCode -> ResponseCode -> Ordering
ResponseCode -> ResponseCode -> ResponseCode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ResponseCode -> ResponseCode -> Ordering
compare :: ResponseCode -> ResponseCode -> Ordering
$c< :: ResponseCode -> ResponseCode -> Bool
< :: ResponseCode -> ResponseCode -> Bool
$c<= :: ResponseCode -> ResponseCode -> Bool
<= :: ResponseCode -> ResponseCode -> Bool
$c> :: ResponseCode -> ResponseCode -> Bool
> :: ResponseCode -> ResponseCode -> Bool
$c>= :: ResponseCode -> ResponseCode -> Bool
>= :: ResponseCode -> ResponseCode -> Bool
$cmax :: ResponseCode -> ResponseCode -> ResponseCode
max :: ResponseCode -> ResponseCode -> ResponseCode
$cmin :: ResponseCode -> ResponseCode -> ResponseCode
min :: ResponseCode -> ResponseCode -> ResponseCode
Ord, Int -> ResponseCode -> ShowS
[ResponseCode] -> ShowS
ResponseCode -> String
(Int -> ResponseCode -> ShowS)
-> (ResponseCode -> String)
-> ([ResponseCode] -> ShowS)
-> Show ResponseCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResponseCode -> ShowS
showsPrec :: Int -> ResponseCode -> ShowS
$cshow :: ResponseCode -> String
show :: ResponseCode -> String
$cshowList :: [ResponseCode] -> ShowS
showList :: [ResponseCode] -> ShowS
Show)

getResponseCode :: Get ResponseCode
getResponseCode :: Get ResponseCode
getResponseCode = Get Word16
getWord16be Get Word16 -> (Word16 -> Get ResponseCode) -> Get ResponseCode
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word16 -> Get ResponseCode
forall {a} {f :: * -> *}.
(Eq a, Num a, MonadFail f) =>
a -> f ResponseCode
f
  where
    f :: a -> f ResponseCode
f a
0x0   = ResponseCode -> f ResponseCode
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResponseCode
Okay
    f a
0x1   = ResponseCode -> f ResponseCode
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResponseCode
OkayContinues
    f a
0x100 = ResponseCode -> f ResponseCode
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResponseCode -> f ResponseCode) -> ResponseCode -> f ResponseCode
forall a b. (a -> b) -> a -> b
$ Error -> ResponseCode
Error Error
BadCommand
    f a
0x104 = ResponseCode -> f ResponseCode
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResponseCode -> f ResponseCode) -> ResponseCode -> f ResponseCode
forall a b. (a -> b) -> a -> b
$ Error -> ResponseCode
Error Error
BadStack
    f a
0x101 = ResponseCode -> f ResponseCode
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResponseCode -> f ResponseCode) -> ResponseCode -> f ResponseCode
forall a b. (a -> b) -> a -> b
$ Error -> ResponseCode
Error Error
AlreadyPaused
    f a
0x102 = ResponseCode -> f ResponseCode
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResponseCode -> f ResponseCode) -> ResponseCode -> f ResponseCode
forall a b. (a -> b) -> a -> b
$ Error -> ResponseCode
Error Error
NotPaused
    f a
0x103 = ResponseCode -> f ResponseCode
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResponseCode -> f ResponseCode) -> ResponseCode -> f ResponseCode
forall a b. (a -> b) -> a -> b
$ Error -> ResponseCode
Error Error
NoResume
    f a
_     = String -> f ResponseCode
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unknown response code"

data Stream a r = Next !a (Stream a r)
                | End r

readFrames :: Handle -> IO (Stream BS.ByteString (Maybe Error))
readFrames :: Handle -> IO (Stream ByteString (Maybe Error))
readFrames Handle
hdl = do
    (Word32
respLen, ResponseCode
status) <- Get (Word32, ResponseCode) -> ByteString -> (Word32, ResponseCode)
forall a. HasCallStack => Get a -> ByteString -> a
runGet_ Get (Word32, ResponseCode)
frameHeader (ByteString -> (Word32, ResponseCode))
-> IO ByteString -> IO (Word32, ResponseCode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> Int -> IO ByteString
BSL.hGet Handle
hdl Int
6
    ByteString
respBody <- Handle -> Int -> IO ByteString
BS.hGet Handle
hdl (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
respLen)
    case ResponseCode
status of
      ResponseCode
OkayContinues -> do Stream ByteString (Maybe Error)
rest <- Handle -> IO (Stream ByteString (Maybe Error))
readFrames Handle
hdl
                          return $ ByteString
-> Stream ByteString (Maybe Error)
-> Stream ByteString (Maybe Error)
forall a r. a -> Stream a r -> Stream a r
Next ByteString
respBody Stream ByteString (Maybe Error)
rest
      ResponseCode
Okay     -> Stream ByteString (Maybe Error)
-> IO (Stream ByteString (Maybe Error))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream ByteString (Maybe Error)
 -> IO (Stream ByteString (Maybe Error)))
-> Stream ByteString (Maybe Error)
-> IO (Stream ByteString (Maybe Error))
forall a b. (a -> b) -> a -> b
$ ByteString
-> Stream ByteString (Maybe Error)
-> Stream ByteString (Maybe Error)
forall a r. a -> Stream a r -> Stream a r
Next ByteString
respBody (Maybe Error -> Stream ByteString (Maybe Error)
forall a r. r -> Stream a r
End Maybe Error
forall a. Maybe a
Nothing)
      Error Error
err-> Stream ByteString (Maybe Error)
-> IO (Stream ByteString (Maybe Error))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream ByteString (Maybe Error)
 -> IO (Stream ByteString (Maybe Error)))
-> Stream ByteString (Maybe Error)
-> IO (Stream ByteString (Maybe Error))
forall a b. (a -> b) -> a -> b
$ Maybe Error -> Stream ByteString (Maybe Error)
forall a r. r -> Stream a r
End (Error -> Maybe Error
forall a. a -> Maybe a
Just Error
err)
  where
    frameHeader :: Get (Word32, ResponseCode)
    frameHeader :: Get (Word32, ResponseCode)
frameHeader =
      (,) (Word32 -> ResponseCode -> (Word32, ResponseCode))
-> Get Word32 -> Get (ResponseCode -> (Word32, ResponseCode))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
          Get (ResponseCode -> (Word32, ResponseCode))
-> Get ResponseCode -> Get (Word32, ResponseCode)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ResponseCode
getResponseCode

throwStream :: Exception e => Stream a (Maybe e) -> [a]
throwStream :: forall e a. Exception e => Stream a (Maybe e) -> [a]
throwStream = Stream a (Maybe e) -> [a]
forall e a. Exception e => Stream a (Maybe e) -> [a]
f
  where
    f :: Stream a (Maybe e) -> [a]
f (Next a
x Stream a (Maybe e)
rest)  = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Stream a (Maybe e) -> [a]
f Stream a (Maybe e)
rest
    f (End Maybe e
Nothing)  = []
    f (End (Just e
e)) = e -> [a]
forall a e. Exception e => e -> a
throw e
e

concatStream :: Stream BS.ByteString (Maybe Error) -> BSL.ByteString
concatStream :: Stream ByteString (Maybe Error) -> ByteString
concatStream = [ByteString] -> ByteString
BSL.fromChunks ([ByteString] -> ByteString)
-> (Stream ByteString (Maybe Error) -> [ByteString])
-> Stream ByteString (Maybe Error)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream ByteString (Maybe Error) -> [ByteString]
forall e a. Exception e => Stream a (Maybe e) -> [a]
throwStream

-- | Perform a request
doRequest :: MVar Handle -> Request a -> IO a
doRequest :: forall a. MVar Handle -> Request a -> IO a
doRequest MVar Handle
mhdl Request a
req = MVar Handle -> (Handle -> IO a) -> IO a
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar Handle
mhdl ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Handle
hdl -> do
    Handle -> ByteString -> IO ()
BSL.hPutStr Handle
hdl (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Request a -> Put
forall a. Request a -> Put
putRequest Request a
req
    Stream ByteString (Maybe Error)
bframes <- Handle -> IO (Stream ByteString (Maybe Error))
readFrames Handle
hdl
    let x :: a
x = Get a -> ByteString -> a
forall a. HasCallStack => Get a -> ByteString -> a
runGet_ (Request a -> Get a
forall a. Request a -> Get a
getResponse Request a
req) (Stream ByteString (Maybe Error) -> ByteString
concatStream Stream ByteString (Maybe Error)
bframes)
    return a
x