{-# 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 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)
                         }

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 = forall a. ReaderT Debuggee IO a -> DebugM a
DebugM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn
  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 :: Mode -> IO (DebugEnv DebugM)
newEnv Mode
m = case Mode
m of
               SnapshotMode String
f -> String -> IO Debuggee
mkSnapshotEnv String
f
               SocketMode Handle
h -> Handle -> IO Debuggee
mkHandleEnv 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
debuggeeHandle :: Maybe (MVar Handle)
debuggeeRequestCache :: MVar RequestCache
debuggeeBlockCache :: IORef BlockCache
debuggeeRequestCount :: Maybe (IORef (HashMap CommandId FetchStats))
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
debuggeeHandle :: Maybe (MVar Handle)
debuggeeRequestCache :: MVar RequestCache
debuggeeBlockCache :: IORef BlockCache
debuggeeRequestCount :: Maybe (IORef (HashMap CommandId FetchStats))
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 :: (RequestCache, BlockCache) -> Maybe Handle -> IO Debuggee
mkEnv :: (RequestCache, BlockCache) -> Maybe Handle -> IO Debuggee
mkEnv (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)
-> Debuggee
Debuggee Maybe (IORef (HashMap CommandId FetchStats))
mcount IORef BlockCache
bc MVar RequestCache
rc Maybe (MVar Handle)
mhdl

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

mkSnapshotEnv :: FilePath -> IO Debuggee
mkSnapshotEnv :: String -> IO Debuggee
mkSnapshotEnv 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
  (RequestCache, BlockCache) -> Maybe Handle -> IO Debuggee
mkEnv (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
debuggeeHandle :: Maybe (MVar Handle)
debuggeeRequestCache :: MVar RequestCache
debuggeeBlockCache :: IORef BlockCache
debuggeeRequestCount :: Maybe (IORef (HashMap CommandId FetchStats))
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
  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.
(forall a. Request a -> IO a)
-> IORef BlockCache -> BlockCacheRequest resp -> IO resp
handleBlockReq (\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)