{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RecordWildCards #-}
-- | This module provides a simple implementation, which can be a lot faster if
-- network latency is not an issue.
module GHC.Debug.Client.Monad.Simple
  ( Debuggee
  , DebugM(..)
  , runSimple
  ) where

import Control.Concurrent
import GHC.Debug.Types
import qualified Data.HashMap.Strict as HM
import System.IO
import Data.IORef
import Data.List
import Data.Ord
import Control.Tracer

import GHC.Debug.Client.BlockCache
import GHC.Debug.Client.RequestCache
import GHC.Debug.Client.Monad.Class

import Control.Monad.Fix
import Control.Monad.Reader
import Data.Binary
--import Debug.Trace


data Debuggee = Debuggee { -- Keep track of how many of each request we make
                           Debuggee -> Maybe (IORef (HashMap CommandId FetchStats))
debuggeeRequestCount :: Maybe (IORef (HM.HashMap CommandId FetchStats))
                         , Debuggee -> IORef BlockCache
debuggeeBlockCache :: IORef BlockCache
                         , Debuggee -> MVar RequestCache
debuggeeRequestCache :: MVar RequestCache
                         , Debuggee -> Maybe (MVar Handle)
debuggeeHandle :: Maybe (MVar Handle)
                         , Debuggee -> Tracer IO String
debuggeeTrace :: Tracer IO String
                         }

data FetchStats = FetchStats { FetchStats -> Int
_networkRequests :: !Int, FetchStats -> Int
_cachedRequests :: !Int }

logRequestIO :: Bool -> IORef (HM.HashMap CommandId FetchStats) -> Request resp -> IO ()
logRequestIO :: forall resp.
Bool
-> IORef (HashMap CommandId FetchStats) -> Request resp -> IO ()
logRequestIO Bool
cached IORef (HashMap CommandId FetchStats)
hmref Request resp
req =
  forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (HashMap CommandId FetchStats)
hmref ((,()) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
HM.alter Maybe FetchStats -> Maybe FetchStats
alter_fn (forall a. Request a -> CommandId
requestCommandId Request resp
req))

  where
    alter_fn :: Maybe FetchStats -> Maybe FetchStats
alter_fn = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe FetchStats
emptyFetchStats FetchStats -> FetchStats
upd_fn
    emptyFetchStats :: FetchStats
emptyFetchStats = Int -> Int -> FetchStats
FetchStats Int
1 Int
0
    upd_fn :: FetchStats -> FetchStats
upd_fn (FetchStats Int
nr Int
cr)
      | Bool
cached = Int -> Int -> FetchStats
FetchStats Int
nr (Int
cr forall a. Num a => a -> a -> a
+ Int
1)
      | Bool
otherwise = Int -> Int -> FetchStats
FetchStats (Int
nr forall a. Num a => a -> a -> a
+ Int
1) Int
cr

logRequest :: Bool -> Request resp -> ReaderT Debuggee IO ()
logRequest :: forall resp. Bool -> Request resp -> ReaderT Debuggee IO ()
logRequest Bool
cached Request resp
req = do
  Maybe (IORef (HashMap CommandId FetchStats))
mhm <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Debuggee -> Maybe (IORef (HashMap CommandId FetchStats))
debuggeeRequestCount
  case Maybe (IORef (HashMap CommandId FetchStats))
mhm of
    Just IORef (HashMap CommandId FetchStats)
hm -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall resp.
Bool
-> IORef (HashMap CommandId FetchStats) -> Request resp -> IO ()
logRequestIO Bool
cached IORef (HashMap CommandId FetchStats)
hm Request resp
req
    Maybe (IORef (HashMap CommandId FetchStats))
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

ppRequestLog :: HM.HashMap CommandId FetchStats -> String
ppRequestLog :: HashMap CommandId FetchStats -> String
ppRequestLog HashMap CommandId FetchStats
hm = [String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => (a, FetchStats) -> String
row [(CommandId, FetchStats)]
items)
  where
    row :: (a, FetchStats) -> String
row (a
cid, FetchStats Int
net Int
cache) = [String] -> String
unwords [forall a. Show a => a -> String
show a
cid forall a. [a] -> [a] -> [a]
++ String
":", forall a. Show a => a -> String
show Int
net, forall a. Show a => a -> String
show Int
cache]
    items :: [(CommandId, FetchStats)]
items = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> a
fst) (forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap CommandId FetchStats
hm)

data Snapshot = Snapshot {
                    Snapshot -> Word32
_version :: Word32
                  , Snapshot -> RequestCache
_rqc :: RequestCache
                  }

snapshotVersion :: Word32
snapshotVersion :: Word32
snapshotVersion = Word32
0

instance Binary Snapshot where
  get :: Get Snapshot
get = do
    Word32
v <- forall t. Binary t => Get t
get
    if Word32
v forall a. Eq a => a -> a -> Bool
== Word32
snapshotVersion
      then Word32 -> RequestCache -> Snapshot
Snapshot Word32
v forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
      else forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Wrong snapshot version.\nGot: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word32
v forall a. [a] -> [a] -> [a]
++ String
"\nExpected: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word32
snapshotVersion)
  put :: Snapshot -> Put
put (Snapshot Word32
v RequestCache
c1) = do
    forall t. Binary t => t -> Put
put Word32
v
    forall t. Binary t => t -> Put
put RequestCache
c1


instance DebugMonad DebugM where
  type DebugEnv DebugM = Debuggee
  request :: forall resp.
(Show resp, Typeable resp) =>
Request resp -> DebugM resp
request = forall a. ReaderT Debuggee IO a -> DebugM a
DebugM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall resp. Request resp -> ReaderT Debuggee IO resp
simpleReq
  requestBlock :: forall resp.
(Show resp, Typeable resp) =>
BlockCacheRequest resp -> DebugM resp
requestBlock = forall resp. BlockCacheRequest resp -> DebugM resp
blockReq
  traceMsg :: String -> DebugM ()
traceMsg String
s = forall a. ReaderT Debuggee IO a -> DebugM a
DebugM forall a b. (a -> b) -> a -> b
$ do
    Debuggee{Maybe (IORef (HashMap CommandId FetchStats))
Maybe (MVar Handle)
IORef BlockCache
MVar RequestCache
Tracer IO String
debuggeeTrace :: Tracer IO String
debuggeeHandle :: Maybe (MVar Handle)
debuggeeRequestCache :: MVar RequestCache
debuggeeBlockCache :: IORef BlockCache
debuggeeRequestCount :: Maybe (IORef (HashMap CommandId FetchStats))
debuggeeTrace :: Debuggee -> Tracer IO String
debuggeeHandle :: Debuggee -> Maybe (MVar Handle)
debuggeeRequestCache :: Debuggee -> MVar RequestCache
debuggeeBlockCache :: Debuggee -> IORef BlockCache
debuggeeRequestCount :: Debuggee -> Maybe (IORef (HashMap CommandId FetchStats))
..} <- forall r (m :: * -> *). MonadReader r m => m r
ask
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
traceWith Tracer IO String
debuggeeTrace String
s

  printRequestLog :: DebugEnv DebugM -> IO ()
printRequestLog DebugEnv DebugM
e = do
    case Debuggee -> Maybe (IORef (HashMap CommandId FetchStats))
debuggeeRequestCount DebugEnv DebugM
e of
      Just IORef (HashMap CommandId FetchStats)
hm_ref -> do
        forall a. IORef a -> IO a
readIORef IORef (HashMap CommandId FetchStats)
hm_ref forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap CommandId FetchStats -> String
ppRequestLog
      Maybe (IORef (HashMap CommandId FetchStats))
Nothing -> String -> IO ()
putStrLn String
"No request log in Simple(TM) mode"
  runDebug :: forall a. DebugEnv DebugM -> DebugM a -> IO a
runDebug = forall a. Debuggee -> DebugM a -> IO a
runSimple
  runDebugTrace :: forall a. DebugEnv DebugM -> DebugM a -> IO (a, [String])
runDebugTrace DebugEnv DebugM
e DebugM a
a = (,[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. DebugMonad m => DebugEnv m -> m a -> IO a
runDebug DebugEnv DebugM
e DebugM a
a
  newEnv :: Tracer IO String -> Mode -> IO (DebugEnv DebugM)
newEnv Tracer IO String
t Mode
m = case Mode
m of
               SnapshotMode String
f -> Tracer IO String -> String -> IO Debuggee
mkSnapshotEnv Tracer IO String
t String
f
               SocketMode Handle
h -> Tracer IO String -> Handle -> IO Debuggee
mkHandleEnv Tracer IO String
t Handle
h

  loadCache :: String -> DebugM ()
loadCache String
fp = forall a. ReaderT Debuggee IO a -> DebugM a
DebugM forall a b. (a -> b) -> a -> b
$ do
    (Snapshot Word32
_ RequestCache
new_req_cache) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Binary a => String -> IO a
decodeFile String
fp
    Debuggee{Maybe (IORef (HashMap CommandId FetchStats))
Maybe (MVar Handle)
IORef BlockCache
MVar RequestCache
Tracer IO String
debuggeeTrace :: Tracer IO String
debuggeeHandle :: Maybe (MVar Handle)
debuggeeRequestCache :: MVar RequestCache
debuggeeBlockCache :: IORef BlockCache
debuggeeRequestCount :: Maybe (IORef (HashMap CommandId FetchStats))
debuggeeTrace :: Debuggee -> Tracer IO String
debuggeeHandle :: Debuggee -> Maybe (MVar Handle)
debuggeeRequestCache :: Debuggee -> MVar RequestCache
debuggeeBlockCache :: Debuggee -> IORef BlockCache
debuggeeRequestCount :: Debuggee -> Maybe (IORef (HashMap CommandId FetchStats))
..} <- forall r (m :: * -> *). MonadReader r m => m r
ask
    RequestCache
_old_rc <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO a
swapMVar MVar RequestCache
debuggeeRequestCache RequestCache
new_req_cache
    -- Fill up the block cache with the cached blocks
    let block_c :: BlockCache
block_c = RequestCache -> BlockCache
initBlockCacheFromReqCache RequestCache
new_req_cache
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef BlockCache
debuggeeBlockCache BlockCache
block_c

  saveCache :: String -> DebugM ()
saveCache String
fp = forall a. ReaderT Debuggee IO a -> DebugM a
DebugM forall a b. (a -> b) -> a -> b
$ do
    Debuggee{Maybe (IORef (HashMap CommandId FetchStats))
Maybe (MVar Handle)
IORef BlockCache
MVar RequestCache
Tracer IO String
debuggeeTrace :: Tracer IO String
debuggeeHandle :: Maybe (MVar Handle)
debuggeeRequestCache :: MVar RequestCache
debuggeeBlockCache :: IORef BlockCache
debuggeeRequestCount :: Maybe (IORef (HashMap CommandId FetchStats))
debuggeeTrace :: Debuggee -> Tracer IO String
debuggeeHandle :: Debuggee -> Maybe (MVar Handle)
debuggeeRequestCache :: Debuggee -> MVar RequestCache
debuggeeBlockCache :: Debuggee -> IORef BlockCache
debuggeeRequestCount :: Debuggee -> Maybe (IORef (HashMap CommandId FetchStats))
..} <- forall r (m :: * -> *). MonadReader r m => m r
ask
    Just RequestCache
req_cache <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO (Maybe a)
tryReadMVar MVar RequestCache
debuggeeRequestCache
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Binary a => String -> a -> IO ()
encodeFile String
fp (Word32 -> RequestCache -> Snapshot
Snapshot Word32
snapshotVersion RequestCache
req_cache)

  unsafeLiftIO :: forall a. IO a -> DebugM a
unsafeLiftIO IO a
f = forall a. ReaderT Debuggee IO a -> DebugM a
DebugM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
f


initBlockCacheFromReqCache :: RequestCache -> BlockCache
initBlockCacheFromReqCache :: RequestCache -> BlockCache
initBlockCacheFromReqCache RequestCache
new_req_cache  =
  case forall resp. Request resp -> RequestCache -> Maybe resp
lookupReq Request [RawBlock]
RequestAllBlocks RequestCache
new_req_cache of
        Just [RawBlock]
bs -> [RawBlock] -> BlockCache -> BlockCache
addBlocks [RawBlock]
bs BlockCache
emptyBlockCache
        Maybe [RawBlock]
Nothing -> BlockCache
emptyBlockCache



runSimple :: Debuggee -> DebugM a -> IO a
runSimple :: forall a. Debuggee -> DebugM a -> IO a
runSimple Debuggee
d (DebugM ReaderT Debuggee IO a
a) = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Debuggee IO a
a Debuggee
d

mkEnv :: Tracer IO String
      -> (RequestCache, BlockCache)
      -> Maybe Handle
      -> IO Debuggee
mkEnv :: Tracer IO String
-> (RequestCache, BlockCache) -> Maybe Handle -> IO Debuggee
mkEnv Tracer IO String
trace_msg (RequestCache
req_c, BlockCache
block_c) Maybe Handle
h = do
  let enable_stats :: Bool
enable_stats = Bool
False
  Maybe (IORef (HashMap CommandId FetchStats))
mcount <- if Bool
enable_stats then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef forall k v. HashMap k v
HM.empty else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
  IORef BlockCache
bc <- forall a. a -> IO (IORef a)
newIORef  BlockCache
block_c
  MVar RequestCache
rc <- forall a. a -> IO (MVar a)
newMVar RequestCache
req_c
  Maybe (MVar Handle)
mhdl <-  forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. a -> IO (MVar a)
newMVar Maybe Handle
h
  return $ Maybe (IORef (HashMap CommandId FetchStats))
-> IORef BlockCache
-> MVar RequestCache
-> Maybe (MVar Handle)
-> Tracer IO String
-> Debuggee
Debuggee Maybe (IORef (HashMap CommandId FetchStats))
mcount IORef BlockCache
bc MVar RequestCache
rc Maybe (MVar Handle)
mhdl Tracer IO String
trace_msg

mkHandleEnv :: Tracer IO String -> Handle -> IO Debuggee
mkHandleEnv :: Tracer IO String -> Handle -> IO Debuggee
mkHandleEnv Tracer IO String
trace_msg Handle
h = Tracer IO String
-> (RequestCache, BlockCache) -> Maybe Handle -> IO Debuggee
mkEnv Tracer IO String
trace_msg (RequestCache
emptyRequestCache, BlockCache
emptyBlockCache) (forall a. a -> Maybe a
Just Handle
h)

mkSnapshotEnv :: Tracer IO String -> FilePath -> IO Debuggee
mkSnapshotEnv :: Tracer IO String -> String -> IO Debuggee
mkSnapshotEnv Tracer IO String
trace_msg String
fp = do
  Snapshot Word32
_ RequestCache
req_c <- forall a. Binary a => String -> IO a
decodeFile String
fp
  let block_c :: BlockCache
block_c = RequestCache -> BlockCache
initBlockCacheFromReqCache RequestCache
req_c
  Tracer IO String
-> (RequestCache, BlockCache) -> Maybe Handle -> IO Debuggee
mkEnv Tracer IO String
trace_msg (RequestCache
req_c, BlockCache
block_c) forall a. Maybe a
Nothing

-- TODO: Sending multiple pauses will clear the cache, should keep track of
-- the pause state and only clear caches if the state changes.
simpleReq :: Request resp -> ReaderT Debuggee IO resp
simpleReq :: forall resp. Request resp -> ReaderT Debuggee IO resp
simpleReq Request resp
req | forall a. Request a -> Bool
isWriteRequest Request resp
req = forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Debuggee{Maybe (IORef (HashMap CommandId FetchStats))
Maybe (MVar Handle)
IORef BlockCache
MVar RequestCache
Tracer IO String
debuggeeTrace :: Tracer IO String
debuggeeHandle :: Maybe (MVar Handle)
debuggeeRequestCache :: MVar RequestCache
debuggeeBlockCache :: IORef BlockCache
debuggeeRequestCount :: Maybe (IORef (HashMap CommandId FetchStats))
debuggeeTrace :: Debuggee -> Tracer IO String
debuggeeHandle :: Debuggee -> Maybe (MVar Handle)
debuggeeRequestCache :: Debuggee -> MVar RequestCache
debuggeeBlockCache :: Debuggee -> IORef BlockCache
debuggeeRequestCount :: Debuggee -> Maybe (IORef (HashMap CommandId FetchStats))
..} -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a (r :: * -> *).
Request a -> r a -> ((a ~ ()) => Request a -> r a) -> r a
withWriteRequest Request resp
req (forall a. HasCallStack => String -> a
error String
"non-write") forall a b. (a -> b) -> a -> b
$ \Request resp
wreq -> do
  case Maybe (MVar Handle)
debuggeeHandle of
    Just MVar Handle
h -> do
      forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef BlockCache
debuggeeBlockCache (forall a b. a -> b -> a
const (BlockCache
emptyBlockCache, ()))
      forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar RequestCache
debuggeeRequestCache (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestCache -> RequestCache
clearMovableRequests)
      forall a. MVar Handle -> Request a -> IO a
doRequest MVar Handle
h Request resp
wreq
    -- Ignore write requests in snapshot mode
    Maybe (MVar Handle)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
simpleReq Request resp
req = do
  MVar RequestCache
rc_var <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Debuggee -> MVar RequestCache
debuggeeRequestCache
  RequestCache
rc <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
readMVar MVar RequestCache
rc_var
  case forall resp. Request resp -> RequestCache -> Maybe resp
lookupReq Request resp
req RequestCache
rc of
    Just resp
res -> do
      forall resp. Bool -> Request resp -> ReaderT Debuggee IO ()
logRequest Bool
True Request resp
req
      return resp
res
    Maybe resp
Nothing -> do
      Maybe (MVar Handle)
mh <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Debuggee -> Maybe (MVar Handle)
debuggeeHandle
      case Maybe (MVar Handle)
mh of
        Maybe (MVar Handle)
Nothing -> forall a. HasCallStack => String -> a
error (String
"Cache Miss:" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Request resp
req)
        Just MVar Handle
h -> do
          resp
res <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar Handle -> Request a -> IO a
doRequest MVar Handle
h Request resp
req
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar RequestCache
rc_var (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall resp. Request resp -> resp -> RequestCache -> RequestCache
cacheReq Request resp
req resp
res)
          forall resp. Bool -> Request resp -> ReaderT Debuggee IO ()
logRequest Bool
False Request resp
req
          return resp
res

blockReq :: BlockCacheRequest resp -> DebugM resp
blockReq :: forall resp. BlockCacheRequest resp -> DebugM resp
blockReq BlockCacheRequest resp
req = forall a. ReaderT Debuggee IO a -> DebugM a
DebugM forall a b. (a -> b) -> a -> b
$ do
  IORef BlockCache
bc  <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Debuggee -> IORef BlockCache
debuggeeBlockCache
  Tracer IO String
tracer  <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Debuggee -> Tracer IO String
debuggeeTrace
  Debuggee
env <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall resp.
Tracer IO String
-> (forall a. Request a -> IO a)
-> IORef BlockCache
-> BlockCacheRequest resp
-> IO resp
handleBlockReq Tracer IO String
tracer (\Request a
r -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall resp. Request resp -> ReaderT Debuggee IO resp
simpleReq Request a
r) Debuggee
env) IORef BlockCache
bc BlockCacheRequest resp
req

newtype DebugM a = DebugM (ReaderT Debuggee IO a)
                   -- Only derive the instances that DebugMonad needs
                    deriving (Monad DebugM
forall a. String -> DebugM a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: forall a. String -> DebugM a
$cfail :: forall a. String -> DebugM a
MonadFail, forall a b. a -> DebugM b -> DebugM a
forall a b. (a -> b) -> DebugM a -> DebugM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> DebugM b -> DebugM a
$c<$ :: forall a b. a -> DebugM b -> DebugM a
fmap :: forall a b. (a -> b) -> DebugM a -> DebugM b
$cfmap :: forall a b. (a -> b) -> DebugM a -> DebugM b
Functor, Functor DebugM
forall a. a -> DebugM a
forall a b. DebugM a -> DebugM b -> DebugM a
forall a b. DebugM a -> DebugM b -> DebugM b
forall a b. DebugM (a -> b) -> DebugM a -> DebugM b
forall a b c. (a -> b -> c) -> DebugM a -> DebugM b -> DebugM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. DebugM a -> DebugM b -> DebugM a
$c<* :: forall a b. DebugM a -> DebugM b -> DebugM a
*> :: forall a b. DebugM a -> DebugM b -> DebugM b
$c*> :: forall a b. DebugM a -> DebugM b -> DebugM b
liftA2 :: forall a b c. (a -> b -> c) -> DebugM a -> DebugM b -> DebugM c
$cliftA2 :: forall a b c. (a -> b -> c) -> DebugM a -> DebugM b -> DebugM c
<*> :: forall a b. DebugM (a -> b) -> DebugM a -> DebugM b
$c<*> :: forall a b. DebugM (a -> b) -> DebugM a -> DebugM b
pure :: forall a. a -> DebugM a
$cpure :: forall a. a -> DebugM a
Applicative, Applicative DebugM
forall a. a -> DebugM a
forall a b. DebugM a -> DebugM b -> DebugM b
forall a b. DebugM a -> (a -> DebugM b) -> DebugM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> DebugM a
$creturn :: forall a. a -> DebugM a
>> :: forall a b. DebugM a -> DebugM b -> DebugM b
$c>> :: forall a b. DebugM a -> DebugM b -> DebugM b
>>= :: forall a b. DebugM a -> (a -> DebugM b) -> DebugM b
$c>>= :: forall a b. DebugM a -> (a -> DebugM b) -> DebugM b
Monad, Monad DebugM
forall a. (a -> DebugM a) -> DebugM a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: forall a. (a -> DebugM a) -> DebugM a
$cmfix :: forall a. (a -> DebugM a) -> DebugM a
MonadFix)