{-# 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(..)
, 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
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")
data Request a where
RequestVersion :: Request Version
RequestPause :: ForkOrPause -> Request ()
RequestResume :: Request ()
RequestRoots :: Request [ClosurePtr]
RequestClosure :: ClosurePtr -> Request RawClosure
RequestInfoTable :: InfoTablePtr -> Request RawInfoTable
RequestSRT :: InfoTablePtr -> Request (Maybe ClosurePtr)
RequestPoll :: Request ()
RequestSavedObjects :: Request [ClosurePtr]
RequestStackBitmap :: StackPtr -> Word32 -> Request PtrBitmap
RequestFunBitmap :: Word16 -> ClosurePtr -> Request PtrBitmap
RequestConstrDesc :: InfoTablePtr -> Request ConstrDesc
RequestSourceInfo :: InfoTablePtr -> Request (Maybe SourceInformation)
RequestAllBlocks :: Request [RawBlock]
RequestBlock :: ClosurePtr -> Request RawBlock
RequestCCS :: CCSPtr -> Request CCSPayload
RequestCC :: CCPtr -> Request CCPayload
RequestIndexTable :: IndexTablePtr -> Request IndexTable
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 }
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
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 (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
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
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
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
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
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
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