{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

module HOCD.Monad
  ( OCDT
  , runOCDT
  , MonadOCD(..)
  , halt
  , halt'
  , reset
  , resetHalt
  , resetHaltInit
  , resume
  , resumeAt
  , step
  , stepTo
  , readMem
  , readMem32
  , readMemCount
  , writeMem
  , writeMem32
  , registers
  , readReg
  , writeReg
  , version
  , raw
  ) where

import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
import Control.Monad.Except (MonadError, throwError)
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad.Reader (MonadReader, ask)
import Control.Monad.Trans (MonadTrans, lift)
import Control.Monad.Trans.Except (ExceptT, runExceptT)
import Control.Monad.Trans.Reader (ReaderT, runReaderT)
import Control.Monad.Trans.State (StateT)
import Data.Bits (FiniteBits(..))
import Data.ByteString (ByteString)
import Data.Map (Map)
import Data.Word (Word32)
import HOCD.Command
  ( Command(..)
  , Capture(..)
  , Halt(..)
  , Resume(..)
  , Reset(..)
  , ResetMode(..)
  , Step(..)
  , ReadMemory(..)
  , WriteMemory(..)
  , Registers(..)
  , ReadRegister(..)
  , WriteRegister(..)
  , Version(..)
  , Raw(..)
  , subChar
  )
import HOCD.Error (OCDError(..))
import HOCD.Types (MemAddress, RegisterInfo, RegisterName)
import Network.Socket (Socket)
import Text.Printf (PrintfArg)

import qualified Data.ByteString.Char8
import qualified Network.Socket.ByteString

newtype OCDT m a = OCDT
  { forall (m :: * -> *) a.
OCDT m a -> ExceptT OCDError (ReaderT Socket m) a
_unOCDT
      :: ExceptT OCDError
          (ReaderT Socket m) a
  }
  deriving
    ( (forall a b. (a -> b) -> OCDT m a -> OCDT m b)
-> (forall a b. a -> OCDT m b -> OCDT m a) -> Functor (OCDT m)
forall a b. a -> OCDT m b -> OCDT m a
forall a b. (a -> b) -> OCDT m a -> OCDT m b
forall (m :: * -> *) a b. Functor m => a -> OCDT m b -> OCDT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> OCDT m a -> OCDT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> OCDT m a -> OCDT m b
fmap :: forall a b. (a -> b) -> OCDT m a -> OCDT m b
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> OCDT m b -> OCDT m a
<$ :: forall a b. a -> OCDT m b -> OCDT m a
Functor
    , Functor (OCDT m)
Functor (OCDT m) =>
(forall a. a -> OCDT m a)
-> (forall a b. OCDT m (a -> b) -> OCDT m a -> OCDT m b)
-> (forall a b c.
    (a -> b -> c) -> OCDT m a -> OCDT m b -> OCDT m c)
-> (forall a b. OCDT m a -> OCDT m b -> OCDT m b)
-> (forall a b. OCDT m a -> OCDT m b -> OCDT m a)
-> Applicative (OCDT m)
forall a. a -> OCDT m a
forall a b. OCDT m a -> OCDT m b -> OCDT m a
forall a b. OCDT m a -> OCDT m b -> OCDT m b
forall a b. OCDT m (a -> b) -> OCDT m a -> OCDT m b
forall a b c. (a -> b -> c) -> OCDT m a -> OCDT m b -> OCDT m c
forall (m :: * -> *). Monad m => Functor (OCDT m)
forall (m :: * -> *) a. Monad m => a -> OCDT m a
forall (m :: * -> *) a b.
Monad m =>
OCDT m a -> OCDT m b -> OCDT m a
forall (m :: * -> *) a b.
Monad m =>
OCDT m a -> OCDT m b -> OCDT m b
forall (m :: * -> *) a b.
Monad m =>
OCDT m (a -> b) -> OCDT m a -> OCDT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> OCDT m a -> OCDT m b -> OCDT m 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
$cpure :: forall (m :: * -> *) a. Monad m => a -> OCDT m a
pure :: forall a. a -> OCDT m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
OCDT m (a -> b) -> OCDT m a -> OCDT m b
<*> :: forall a b. OCDT m (a -> b) -> OCDT m a -> OCDT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> OCDT m a -> OCDT m b -> OCDT m c
liftA2 :: forall a b c. (a -> b -> c) -> OCDT m a -> OCDT m b -> OCDT m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
OCDT m a -> OCDT m b -> OCDT m b
*> :: forall a b. OCDT m a -> OCDT m b -> OCDT m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
OCDT m a -> OCDT m b -> OCDT m a
<* :: forall a b. OCDT m a -> OCDT m b -> OCDT m a
Applicative
    , Applicative (OCDT m)
Applicative (OCDT m) =>
(forall a b. OCDT m a -> (a -> OCDT m b) -> OCDT m b)
-> (forall a b. OCDT m a -> OCDT m b -> OCDT m b)
-> (forall a. a -> OCDT m a)
-> Monad (OCDT m)
forall a. a -> OCDT m a
forall a b. OCDT m a -> OCDT m b -> OCDT m b
forall a b. OCDT m a -> (a -> OCDT m b) -> OCDT m b
forall (m :: * -> *). Monad m => Applicative (OCDT m)
forall (m :: * -> *) a. Monad m => a -> OCDT m a
forall (m :: * -> *) a b.
Monad m =>
OCDT m a -> OCDT m b -> OCDT m b
forall (m :: * -> *) a b.
Monad m =>
OCDT m a -> (a -> OCDT m b) -> OCDT m 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
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
OCDT m a -> (a -> OCDT m b) -> OCDT m b
>>= :: forall a b. OCDT m a -> (a -> OCDT m b) -> OCDT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
OCDT m a -> OCDT m b -> OCDT m b
>> :: forall a b. OCDT m a -> OCDT m b -> OCDT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> OCDT m a
return :: forall a. a -> OCDT m a
Monad
    , MonadReader Socket
    , MonadError OCDError
    , MonadThrow (OCDT m)
MonadThrow (OCDT m) =>
(forall e a.
 (HasCallStack, Exception e) =>
 OCDT m a -> (e -> OCDT m a) -> OCDT m a)
-> MonadCatch (OCDT m)
forall e a.
(HasCallStack, Exception e) =>
OCDT m a -> (e -> OCDT m a) -> OCDT m a
forall (m :: * -> *). MonadCatch m => MonadThrow (OCDT m)
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
OCDT m a -> (e -> OCDT m a) -> OCDT m a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
OCDT m a -> (e -> OCDT m a) -> OCDT m a
catch :: forall e a.
(HasCallStack, Exception e) =>
OCDT m a -> (e -> OCDT m a) -> OCDT m a
MonadCatch
    , MonadCatch (OCDT m)
MonadCatch (OCDT m) =>
(forall b.
 HasCallStack =>
 ((forall a. OCDT m a -> OCDT m a) -> OCDT m b) -> OCDT m b)
-> (forall b.
    HasCallStack =>
    ((forall a. OCDT m a -> OCDT m a) -> OCDT m b) -> OCDT m b)
-> (forall a b c.
    HasCallStack =>
    OCDT m a
    -> (a -> ExitCase b -> OCDT m c)
    -> (a -> OCDT m b)
    -> OCDT m (b, c))
-> MonadMask (OCDT m)
forall b.
HasCallStack =>
((forall a. OCDT m a -> OCDT m a) -> OCDT m b) -> OCDT m b
forall a b c.
HasCallStack =>
OCDT m a
-> (a -> ExitCase b -> OCDT m c)
-> (a -> OCDT m b)
-> OCDT m (b, c)
forall (m :: * -> *). MonadMask m => MonadCatch (OCDT m)
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. OCDT m a -> OCDT m a) -> OCDT m b) -> OCDT m b
forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
OCDT m a
-> (a -> ExitCase b -> OCDT m c)
-> (a -> OCDT m b)
-> OCDT m (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
    HasCallStack =>
    ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    HasCallStack =>
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. OCDT m a -> OCDT m a) -> OCDT m b) -> OCDT m b
mask :: forall b.
HasCallStack =>
((forall a. OCDT m a -> OCDT m a) -> OCDT m b) -> OCDT m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. OCDT m a -> OCDT m a) -> OCDT m b) -> OCDT m b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. OCDT m a -> OCDT m a) -> OCDT m b) -> OCDT m b
$cgeneralBracket :: forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
OCDT m a
-> (a -> ExitCase b -> OCDT m c)
-> (a -> OCDT m b)
-> OCDT m (b, c)
generalBracket :: forall a b c.
HasCallStack =>
OCDT m a
-> (a -> ExitCase b -> OCDT m c)
-> (a -> OCDT m b)
-> OCDT m (b, c)
MonadMask
    , Monad (OCDT m)
Monad (OCDT m) =>
(forall e a. (HasCallStack, Exception e) => e -> OCDT m a)
-> MonadThrow (OCDT m)
forall e a. (HasCallStack, Exception e) => e -> OCDT m a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
forall (m :: * -> *). MonadThrow m => Monad (OCDT m)
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> OCDT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> OCDT m a
throwM :: forall e a. (HasCallStack, Exception e) => e -> OCDT m a
MonadThrow
    , Monad (OCDT m)
Monad (OCDT m) => (forall a. IO a -> OCDT m a) -> MonadIO (OCDT m)
forall a. IO a -> OCDT m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (OCDT m)
forall (m :: * -> *) a. MonadIO m => IO a -> OCDT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> OCDT m a
liftIO :: forall a. IO a -> OCDT m a
MonadIO
    )

instance MonadTrans OCDT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> OCDT m a
lift = ExceptT OCDError (ReaderT Socket m) a -> OCDT m a
forall (m :: * -> *) a.
ExceptT OCDError (ReaderT Socket m) a -> OCDT m a
OCDT (ExceptT OCDError (ReaderT Socket m) a -> OCDT m a)
-> (m a -> ExceptT OCDError (ReaderT Socket m) a)
-> m a
-> OCDT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT Socket m a -> ExceptT OCDError (ReaderT Socket m) a
forall (m :: * -> *) a. Monad m => m a -> ExceptT OCDError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT Socket m a -> ExceptT OCDError (ReaderT Socket m) a)
-> (m a -> ReaderT Socket m a)
-> m a
-> ExceptT OCDError (ReaderT Socket m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderT Socket m a
forall (m :: * -> *) a. Monad m => m a -> ReaderT Socket m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- | Run OCDT transformer
runOCDT
  :: Monad m
  => Socket
  -> OCDT m a
  -> m (Either OCDError a)
runOCDT :: forall (m :: * -> *) a.
Monad m =>
Socket -> OCDT m a -> m (Either OCDError a)
runOCDT Socket
sock =
    (ReaderT Socket m (Either OCDError a)
-> Socket -> m (Either OCDError a)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` Socket
sock)
  (ReaderT Socket m (Either OCDError a) -> m (Either OCDError a))
-> (OCDT m a -> ReaderT Socket m (Either OCDError a))
-> OCDT m a
-> m (Either OCDError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT OCDError (ReaderT Socket m) a
-> ReaderT Socket m (Either OCDError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
  (ExceptT OCDError (ReaderT Socket m) a
 -> ReaderT Socket m (Either OCDError a))
-> (OCDT m a -> ExceptT OCDError (ReaderT Socket m) a)
-> OCDT m a
-> ReaderT Socket m (Either OCDError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OCDT m a -> ExceptT OCDError (ReaderT Socket m) a
forall (m :: * -> *) a.
OCDT m a -> ExceptT OCDError (ReaderT Socket m) a
_unOCDT

class ( MonadIO m
      , MonadError OCDError m
      ) => MonadOCD m where

  getSocket :: m Socket
  default getSocket
    :: ( MonadTrans t
       , MonadOCD m'
       , m ~ t m'
       )
    => m Socket
  getSocket = m' Socket -> t m' Socket
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m' Socket
forall (m :: * -> *). MonadOCD m => m Socket
getSocket

instance MonadIO m => MonadOCD (OCDT m) where
  getSocket :: OCDT m Socket
getSocket = OCDT m Socket
forall r (m :: * -> *). MonadReader r m => m r
ask

instance MonadOCD m => MonadOCD (StateT s m)
instance MonadOCD m => MonadOCD (ReaderT r m)
instance MonadOCD m => MonadOCD (ExceptT OCDError m)

-- | Perform RPC call
rpc
  :: ( MonadOCD m
     , Command req
     )
  => req
  -> m (Reply req)
rpc :: forall (m :: * -> *) req.
(MonadOCD m, Command req) =>
req -> m (Reply req)
rpc req
cmd = do
  Socket
sock <- m Socket
forall (m :: * -> *). MonadOCD m => m Socket
getSocket
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
    Socket -> ByteString -> IO ()
Network.Socket.ByteString.sendAll
      Socket
sock
      (ByteString -> ByteString
rpcCmd (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ req -> ByteString
forall req. Command req => req -> ByteString
request req
cmd)
  req -> ByteString -> Either OCDError (Reply req)
forall req.
Command req =>
req -> ByteString -> Either OCDError (Reply req)
reply req
cmd (ByteString -> Either OCDError (Reply req))
-> m ByteString -> m (Either OCDError (Reply req))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket -> m ByteString
forall {m :: * -> *}. MonadIO m => Socket -> m ByteString
recvTillSub Socket
sock
  m (Either OCDError (Reply req))
-> (Either OCDError (Reply req) -> m (Reply req)) -> m (Reply req)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (OCDError -> m (Reply req))
-> (Reply req -> m (Reply req))
-> Either OCDError (Reply req)
-> m (Reply req)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either OCDError -> m (Reply req)
forall a. OCDError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Reply req -> m (Reply req)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  where
    recvTillSub :: Socket -> m ByteString
recvTillSub Socket
s = do
      ByteString
msg <-
        IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Socket -> Int -> IO ByteString
Network.Socket.ByteString.recv
            Socket
s
            Int
1024
      if ByteString -> Char
Data.ByteString.Char8.last ByteString
msg Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
subChar
      then ByteString -> m ByteString
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
msg
      else Socket -> m ByteString
recvTillSub Socket
s m ByteString -> (ByteString -> m ByteString) -> m ByteString
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> m ByteString
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString)
-> (ByteString -> ByteString) -> ByteString -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
msg ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>)

    -- | Terminate with \SUB
    rpcCmd :: ByteString -> ByteString
    rpcCmd :: ByteString -> ByteString
rpcCmd =
      (ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Char -> ByteString
Data.ByteString.Char8.singleton Char
subChar)

-- | Halt target
halt
  :: MonadOCD m
  => m ByteString
halt :: forall (m :: * -> *). MonadOCD m => m ByteString
halt = Capture Halt -> m (Reply (Capture Halt))
forall (m :: * -> *) req.
(MonadOCD m, Command req) =>
req -> m (Reply req)
rpc (Capture Halt -> m (Reply (Capture Halt)))
-> Capture Halt -> m (Reply (Capture Halt))
forall a b. (a -> b) -> a -> b
$ Halt -> Capture Halt
forall a. a -> Capture a
Capture Halt
Halt

-- | Halt target, discarding reply
halt'
  :: MonadOCD m
  => m ()
halt' :: forall (m :: * -> *). MonadOCD m => m ()
halt' = m ByteString
forall (m :: * -> *). MonadOCD m => m ByteString
halt m ByteString -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Reset target (default "reset run")
reset
  :: MonadOCD m
  => m ()
reset :: forall (m :: * -> *). MonadOCD m => m ()
reset = Reset -> m (Reply Reset)
forall (m :: * -> *) req.
(MonadOCD m, Command req) =>
req -> m (Reply req)
rpc (Reset -> m (Reply Reset)) -> Reset -> m (Reply Reset)
forall a b. (a -> b) -> a -> b
$ ResetMode -> Reset
Reset ResetMode
ResetMode_Run

-- | Reset target and halt execution
resetHalt
  :: MonadOCD m
  => m ()
resetHalt :: forall (m :: * -> *). MonadOCD m => m ()
resetHalt = Reset -> m (Reply Reset)
forall (m :: * -> *) req.
(MonadOCD m, Command req) =>
req -> m (Reply req)
rpc (Reset -> m (Reply Reset)) -> Reset -> m (Reply Reset)
forall a b. (a -> b) -> a -> b
$ ResetMode -> Reset
Reset ResetMode
ResetMode_Halt

-- | Reset target, halt execution
-- and execute reset-init script
resetHaltInit
  :: MonadOCD m
  => m ()
resetHaltInit :: forall (m :: * -> *). MonadOCD m => m ()
resetHaltInit = Reset -> m (Reply Reset)
forall (m :: * -> *) req.
(MonadOCD m, Command req) =>
req -> m (Reply req)
rpc (Reset -> m (Reply Reset)) -> Reset -> m (Reply Reset)
forall a b. (a -> b) -> a -> b
$ ResetMode -> Reset
Reset ResetMode
ResetMode_Init

-- | Resume execution
resume
  :: MonadOCD m
  => m ()
resume :: forall (m :: * -> *). MonadOCD m => m ()
resume = Resume -> m (Reply Resume)
forall (m :: * -> *) req.
(MonadOCD m, Command req) =>
req -> m (Reply req)
rpc (Resume -> m (Reply Resume)) -> Resume -> m (Reply Resume)
forall a b. (a -> b) -> a -> b
$ Maybe MemAddress -> Resume
Resume Maybe MemAddress
forall a. Maybe a
Nothing

-- | Resume execution at @MemAddress@
resumeAt
  :: MonadOCD m
  => MemAddress
  -> m ()
resumeAt :: forall (m :: * -> *). MonadOCD m => MemAddress -> m ()
resumeAt = Resume -> m ()
Resume -> m (Reply Resume)
forall (m :: * -> *) req.
(MonadOCD m, Command req) =>
req -> m (Reply req)
rpc (Resume -> m ()) -> (MemAddress -> Resume) -> MemAddress -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe MemAddress -> Resume
Resume (Maybe MemAddress -> Resume)
-> (MemAddress -> Maybe MemAddress) -> MemAddress -> Resume
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemAddress -> Maybe MemAddress
forall a. a -> Maybe a
Just

-- | Single-step target at its current code position
step
  :: MonadOCD m
  => m ()
step :: forall (m :: * -> *). MonadOCD m => m ()
step = Step -> m (Reply Step)
forall (m :: * -> *) req.
(MonadOCD m, Command req) =>
req -> m (Reply req)
rpc (Step -> m (Reply Step)) -> Step -> m (Reply Step)
forall a b. (a -> b) -> a -> b
$ Maybe MemAddress -> Step
Step Maybe MemAddress
forall a. Maybe a
Nothing

-- | Single-step target to code position
-- at @MemAddress@
stepTo
  :: MonadOCD m
  => MemAddress
  -> m ()
stepTo :: forall (m :: * -> *). MonadOCD m => MemAddress -> m ()
stepTo = Step -> m ()
Step -> m (Reply Step)
forall (m :: * -> *) req.
(MonadOCD m, Command req) =>
req -> m (Reply req)
rpc (Step -> m ()) -> (MemAddress -> Step) -> MemAddress -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe MemAddress -> Step
Step (Maybe MemAddress -> Step)
-> (MemAddress -> Maybe MemAddress) -> MemAddress -> Step
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemAddress -> Maybe MemAddress
forall a. a -> Maybe a
Just

-- | Read multiple memory segments from @MemAddress@
-- according to count argument. Segment size depends
-- on Word type.
readMemCount
  :: forall a m
   . ( MonadOCD m
     , FiniteBits a
     , Integral a
     )
  => MemAddress -- ^ Memory address to read from
  -> Int -- ^ Count
  -> m [a]
readMemCount :: forall a (m :: * -> *).
(MonadOCD m, FiniteBits a, Integral a) =>
MemAddress -> Int -> m [a]
readMemCount MemAddress
ma Int
c =
  ReadMemory a -> m (Reply (ReadMemory a))
forall (m :: * -> *) req.
(MonadOCD m, Command req) =>
req -> m (Reply req)
rpc
    ReadMemory
      { readMemoryAddr :: MemAddress
readMemoryAddr = MemAddress
ma
      , readMemoryCount :: Int
readMemoryCount = Int
c
      }

-- | Read single memory segment from @MemAddress@
-- Segment size depends on Word type.
readMem
  :: forall a m
   . ( MonadOCD m
     , FiniteBits a
     , Integral a
     )
  => MemAddress -- ^ Memory address to read from
  -> m a
readMem :: forall a (m :: * -> *).
(MonadOCD m, FiniteBits a, Integral a) =>
MemAddress -> m a
readMem MemAddress
ma =
  MemAddress -> Int -> m [a]
forall a (m :: * -> *).
(MonadOCD m, FiniteBits a, Integral a) =>
MemAddress -> Int -> m [a]
readMemCount MemAddress
ma Int
1
  m [a] -> ([a] -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        [a
one] -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
one
        [a]
_ -> OCDError -> m a
forall a. OCDError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError OCDError
OCDError_ExpectedOneButGotMore

-- | Shorthand for reading @Word32@ sized segment
readMem32
  :: MonadOCD m
  => MemAddress -- ^ Memory address to read from
  -> m Word32
readMem32 :: forall (m :: * -> *). MonadOCD m => MemAddress -> m Word32
readMem32 = forall a (m :: * -> *).
(MonadOCD m, FiniteBits a, Integral a) =>
MemAddress -> m a
readMem @Word32

-- | Write multiple memory segments to @MemAddress@
writeMem
  :: forall a m
   . ( MonadOCD m
     , FiniteBits a
     , PrintfArg a
     , Integral a
     )
  => MemAddress -- ^ Memory address to write to
  -> [a] -- ^ Data to write
  -> m ()
writeMem :: forall a (m :: * -> *).
(MonadOCD m, FiniteBits a, PrintfArg a, Integral a) =>
MemAddress -> [a] -> m ()
writeMem MemAddress
ma [a]
xs =
  WriteMemory a -> m (Reply (WriteMemory a))
forall (m :: * -> *) req.
(MonadOCD m, Command req) =>
req -> m (Reply req)
rpc
    WriteMemory
      { writeMemoryAddr :: MemAddress
writeMemoryAddr = MemAddress
ma
      , writeMemoryData :: [a]
writeMemoryData = [a]
xs
      }

-- | Shorthand for writing @Word32@ sized segment
writeMem32
  :: MonadOCD m
  => MemAddress -- ^ Memory address to write to
  -> [Word32] -- ^ Data to write
  -> m ()
writeMem32 :: forall (m :: * -> *). MonadOCD m => MemAddress -> [Word32] -> m ()
writeMem32 = forall a (m :: * -> *).
(MonadOCD m, FiniteBits a, PrintfArg a, Integral a) =>
MemAddress -> [a] -> m ()
writeMem @Word32

registers
  :: MonadOCD m
  => m (Map RegisterName RegisterInfo)
registers :: forall (m :: * -> *).
MonadOCD m =>
m (Map RegisterName RegisterInfo)
registers = Registers -> m (Reply Registers)
forall (m :: * -> *) req.
(MonadOCD m, Command req) =>
req -> m (Reply req)
rpc Registers
Registers

-- | Read a CPU register
readReg
  :: forall a m
   . ( MonadOCD m
     , FiniteBits a
     , Integral a
     )
  => RegisterName -- ^ Name of the register to query
  -> m a
readReg :: forall a (m :: * -> *).
(MonadOCD m, FiniteBits a, Integral a) =>
RegisterName -> m a
readReg = ReadRegister a -> m a
ReadRegister a -> m (Reply (ReadRegister a))
forall (m :: * -> *) req.
(MonadOCD m, Command req) =>
req -> m (Reply req)
rpc (ReadRegister a -> m a)
-> (RegisterName -> ReadRegister a) -> RegisterName -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegisterName -> ReadRegister a
forall a. RegisterName -> ReadRegister a
ReadRegister

-- | Write a CPU register
writeReg
  :: forall a m
   . ( MonadOCD m
     , FiniteBits a
     , Integral a
     , PrintfArg a
     )
  => RegisterName -- ^ Name of the register to write to
  -> a -- ^ Value to write
  -> m ()
writeReg :: forall a (m :: * -> *).
(MonadOCD m, FiniteBits a, Integral a, PrintfArg a) =>
RegisterName -> a -> m ()
writeReg RegisterName
rn a
x =
  WriteRegister a -> m (Reply (WriteRegister a))
forall (m :: * -> *) req.
(MonadOCD m, Command req) =>
req -> m (Reply req)
rpc
  (WriteRegister a -> m (Reply (WriteRegister a)))
-> WriteRegister a -> m (Reply (WriteRegister a))
forall a b. (a -> b) -> a -> b
$ WriteRegister
    { writeRegisterName :: RegisterName
writeRegisterName = RegisterName
rn
    , writeRegisterValue :: a
writeRegisterValue = a
x
    }

-- | Query OpenOCD version
version
  :: MonadOCD m
  => m ByteString
version :: forall (m :: * -> *). MonadOCD m => m ByteString
version = Version -> m (Reply Version)
forall (m :: * -> *) req.
(MonadOCD m, Command req) =>
req -> m (Reply req)
rpc Version
Version

-- | Send raw OpenOCD command
-- Escape hatch for commands that are not
-- part defined as part of hocd api
raw
  :: MonadOCD m
  => ByteString
  -> m ByteString
raw :: forall (m :: * -> *). MonadOCD m => ByteString -> m ByteString
raw = Raw -> m ByteString
Raw -> m (Reply Raw)
forall (m :: * -> *) req.
(MonadOCD m, Command req) =>
req -> m (Reply req)
rpc (Raw -> m ByteString)
-> (ByteString -> Raw) -> ByteString -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Raw
Raw