-- NOTE: meant to be imported qualified
module Debugger.Builder
  ( Builder
  , ToSelection(..)
  , runBuilder
  , break
  , command
  , continue
  , step
  , stepN
  , next
  , nextN
  , run
  , reset
  , print
  , set
  , call
  , delete
  , disable
  , enable
  , source
  , shell
  , target
  , info
  ) where

import Prelude hiding (break, print)
import Control.Monad.State.Strict
import qualified Data.Text as T
import qualified Data.DList as DList
import Debugger.Statement


type Counter = Int

data BuilderState
  = BuilderState
  { BuilderState -> DList Statement
stmts :: DList.DList Statement
  , BuilderState -> Counter
varCounter :: Counter
  }

-- | Builder pattern that allows using monadic do-syntax to build a GDB script.
newtype Builder a
  = Builder (State BuilderState a)
  deriving (a -> Builder b -> Builder a
(a -> b) -> Builder a -> Builder b
(forall a b. (a -> b) -> Builder a -> Builder b)
-> (forall a b. a -> Builder b -> Builder a) -> Functor Builder
forall a b. a -> Builder b -> Builder a
forall a b. (a -> b) -> Builder a -> Builder b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Builder b -> Builder a
$c<$ :: forall a b. a -> Builder b -> Builder a
fmap :: (a -> b) -> Builder a -> Builder b
$cfmap :: forall a b. (a -> b) -> Builder a -> Builder b
Functor, Functor Builder
a -> Builder a
Functor Builder
-> (forall a. a -> Builder a)
-> (forall a b. Builder (a -> b) -> Builder a -> Builder b)
-> (forall a b c.
    (a -> b -> c) -> Builder a -> Builder b -> Builder c)
-> (forall a b. Builder a -> Builder b -> Builder b)
-> (forall a b. Builder a -> Builder b -> Builder a)
-> Applicative Builder
Builder a -> Builder b -> Builder b
Builder a -> Builder b -> Builder a
Builder (a -> b) -> Builder a -> Builder b
(a -> b -> c) -> Builder a -> Builder b -> Builder c
forall a. a -> Builder a
forall a b. Builder a -> Builder b -> Builder a
forall a b. Builder a -> Builder b -> Builder b
forall a b. Builder (a -> b) -> Builder a -> Builder b
forall a b c. (a -> b -> c) -> Builder a -> Builder b -> Builder 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
<* :: Builder a -> Builder b -> Builder a
$c<* :: forall a b. Builder a -> Builder b -> Builder a
*> :: Builder a -> Builder b -> Builder b
$c*> :: forall a b. Builder a -> Builder b -> Builder b
liftA2 :: (a -> b -> c) -> Builder a -> Builder b -> Builder c
$cliftA2 :: forall a b c. (a -> b -> c) -> Builder a -> Builder b -> Builder c
<*> :: Builder (a -> b) -> Builder a -> Builder b
$c<*> :: forall a b. Builder (a -> b) -> Builder a -> Builder b
pure :: a -> Builder a
$cpure :: forall a. a -> Builder a
$cp1Applicative :: Functor Builder
Applicative, Applicative Builder
a -> Builder a
Applicative Builder
-> (forall a b. Builder a -> (a -> Builder b) -> Builder b)
-> (forall a b. Builder a -> Builder b -> Builder b)
-> (forall a. a -> Builder a)
-> Monad Builder
Builder a -> (a -> Builder b) -> Builder b
Builder a -> Builder b -> Builder b
forall a. a -> Builder a
forall a b. Builder a -> Builder b -> Builder b
forall a b. Builder a -> (a -> Builder b) -> Builder 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 :: a -> Builder a
$creturn :: forall a. a -> Builder a
>> :: Builder a -> Builder b -> Builder b
$c>> :: forall a b. Builder a -> Builder b -> Builder b
>>= :: Builder a -> (a -> Builder b) -> Builder b
$c>>= :: forall a b. Builder a -> (a -> Builder b) -> Builder b
$cp1Monad :: Applicative Builder
Monad, MonadState BuilderState)
  via State BuilderState


-- | Creates a GDB script based on a builder.
runBuilder :: Builder a -> Script
runBuilder :: Builder a -> Script
runBuilder = Counter -> Builder a -> Script
forall a. Counter -> Builder a -> Script
runBuilder' Counter
0

runBuilder' :: Counter -> Builder a -> [Statement]
runBuilder' :: Counter -> Builder a -> Script
runBuilder' Counter
counter (Builder State BuilderState a
m) =
  let result :: BuilderState
result = State BuilderState a -> BuilderState -> BuilderState
forall s a. State s a -> s -> s
execState State BuilderState a
m (DList Statement -> Counter -> BuilderState
BuilderState DList Statement
forall a. DList a
DList.empty Counter
counter)
   in DList Statement -> Script -> Script
forall a. DList a -> [a] -> [a]
DList.apply (BuilderState -> DList Statement
stmts BuilderState
result) []

-- | Emits a breakpoint statement.
--   Returns the 'Id' that corresponds with this newly set breakpoint.
break :: Location -> Builder Id
break :: Location -> Builder Id
break Location
loc = do
  Statement -> Builder ()
emit (Statement -> Builder ()) -> Statement -> Builder ()
forall a b. (a -> b) -> a -> b
$ Location -> Statement
Break Location
loc
  Var
var <- Builder Var
newBreakpointVar
  Var -> Var -> Builder ()
set Var
var Var
"$bpnum"
  Id -> Builder Id
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Id -> Builder Id) -> Id -> Builder Id
forall a b. (a -> b) -> a -> b
$ Var -> Id
Id Var
var

-- | Emits a command statement, that should be triggered when a breakpoint is triggered.
command :: Id -> Builder () -> Builder ()
command :: Id -> Builder () -> Builder ()
command Id
bp Builder ()
cmds = do
  Counter
counter <- (BuilderState -> Counter) -> Builder Counter
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets BuilderState -> Counter
varCounter
  let statements :: Script
statements = Counter -> Builder () -> Script
forall a. Counter -> Builder a -> Script
runBuilder' Counter
counter Builder ()
cmds
  Statement -> Builder ()
emit (Statement -> Builder ()) -> Statement -> Builder ()
forall a b. (a -> b) -> a -> b
$ Id -> Script -> Statement
Command Id
bp Script
statements

-- | Emits a continue statement.
continue :: Builder ()
continue :: Builder ()
continue = Statement -> Builder ()
emit Statement
Continue

-- | Emits a run statement.
run :: Builder ()
run :: Builder ()
run = Statement -> Builder ()
emit Statement
Run

-- | Emits a reset statement.
reset :: Builder ()
reset :: Builder ()
reset = Statement -> Builder ()
emit Statement
Reset

-- | Emits a print statement.
print :: Expr -> Builder ()
print :: Var -> Builder ()
print = Statement -> Builder ()
emit (Statement -> Builder ())
-> (Var -> Statement) -> Var -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> Statement
Print

-- | Emits a set statement.
set :: Var -> Expr -> Builder ()
set :: Var -> Var -> Builder ()
set Var
var Var
value = Statement -> Builder ()
emit (Statement -> Builder ()) -> Statement -> Builder ()
forall a b. (a -> b) -> a -> b
$ Var -> Var -> Statement
Set Var
var Var
value

-- | Emits a call statement.
call :: Expr -> Builder ()
call :: Var -> Builder ()
call = Statement -> Builder ()
emit (Statement -> Builder ())
-> (Var -> Statement) -> Var -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> Statement
Call

-- | Helper typeclass, used for manipulating 1, many, or all 'Id's.
class ToSelection a where
  toSelection :: a -> Selection

instance ToSelection Id where
  toSelection :: Id -> Selection
toSelection = Id -> Selection
Single

instance ToSelection [Id] where
  toSelection :: [Id] -> Selection
toSelection = [Id] -> Selection
Many

instance ToSelection Selection where
  toSelection :: Selection -> Selection
toSelection = Selection -> Selection
forall a. a -> a
id

-- | Emits a delete statement.
delete :: ToSelection a => a -> Builder ()
delete :: a -> Builder ()
delete = Statement -> Builder ()
emit (Statement -> Builder ()) -> (a -> Statement) -> a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selection -> Statement
Delete (Selection -> Statement) -> (a -> Selection) -> a -> Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Selection
forall a. ToSelection a => a -> Selection
toSelection

-- | Emits a disable statement.
disable :: ToSelection a => a -> Builder ()
disable :: a -> Builder ()
disable = Statement -> Builder ()
emit (Statement -> Builder ()) -> (a -> Statement) -> a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selection -> Statement
Disable (Selection -> Statement) -> (a -> Selection) -> a -> Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Selection
forall a. ToSelection a => a -> Selection
toSelection

-- | Emits an enable statement.
enable :: a -> Builder ()
enable = Statement -> Builder ()
emit (Statement -> Builder ()) -> (a -> Statement) -> a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selection -> Statement
Enable (Selection -> Statement) -> (a -> Selection) -> a -> Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Selection
forall a. ToSelection a => a -> Selection
toSelection
enable :: ToSelection a => a -> Builder ()

-- | Emits a "next" statement. If you want to repeat next N times, use 'nextN'.
next :: Builder ()
next :: Builder ()
next = Statement -> Builder ()
emit (Statement -> Builder ()) -> Statement -> Builder ()
forall a b. (a -> b) -> a -> b
$ Maybe Counter -> Statement
Next Maybe Counter
forall a. Maybe a
Nothing

-- | Emits a "next" statement that is repeated N times.
nextN :: Int -> Builder ()
nextN :: Counter -> Builder ()
nextN = Statement -> Builder ()
emit (Statement -> Builder ())
-> (Counter -> Statement) -> Counter -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Counter -> Statement
Next (Maybe Counter -> Statement)
-> (Counter -> Maybe Counter) -> Counter -> Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Counter -> Maybe Counter
forall a. a -> Maybe a
Just

-- | Emits a step statement. If you want to step N times, use 'stepN'.
step :: Builder ()
step :: Builder ()
step = Statement -> Builder ()
emit (Statement -> Builder ()) -> Statement -> Builder ()
forall a b. (a -> b) -> a -> b
$ Maybe Counter -> Statement
Step Maybe Counter
forall a. Maybe a
Nothing

-- | Emits a step statement that is repeated N times.
stepN :: Int -> Builder ()
stepN :: Counter -> Builder ()
stepN = Statement -> Builder ()
emit (Statement -> Builder ())
-> (Counter -> Statement) -> Counter -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Counter -> Statement
Step (Maybe Counter -> Statement)
-> (Counter -> Maybe Counter) -> Counter -> Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Counter -> Maybe Counter
forall a. a -> Maybe a
Just

-- | Emits a shell statement.
shell :: ShellCommand -> Builder ()
shell :: Var -> Builder ()
shell = Statement -> Builder ()
emit (Statement -> Builder ())
-> (Var -> Statement) -> Var -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> Statement
Shell

-- | Emits a source statement.
source :: FilePath -> Builder ()
source :: FilePath -> Builder ()
source = Statement -> Builder ()
emit (Statement -> Builder ())
-> (FilePath -> Statement) -> FilePath -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Statement
Source

-- | Emits a target statement.
target :: TargetConfig -> Builder ()
target :: TargetConfig -> Builder ()
target = Statement -> Builder ()
emit (Statement -> Builder ())
-> (TargetConfig -> Statement) -> TargetConfig -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetConfig -> Statement
Target

-- | Emits an info statement.
info :: InfoOptions -> Builder ()
info :: InfoOptions -> Builder ()
info = Statement -> Builder ()
emit (Statement -> Builder ())
-> (InfoOptions -> Statement) -> InfoOptions -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InfoOptions -> Statement
Info

emit :: Statement -> Builder ()
emit :: Statement -> Builder ()
emit Statement
stmt =
  (BuilderState -> BuilderState) -> Builder ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((BuilderState -> BuilderState) -> Builder ())
-> (BuilderState -> BuilderState) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \BuilderState
s -> BuilderState
s { stmts :: DList Statement
stmts = DList Statement -> Statement -> DList Statement
forall a. DList a -> a -> DList a
DList.snoc (BuilderState -> DList Statement
stmts BuilderState
s) Statement
stmt }

newBreakpointVar :: Builder Var
newBreakpointVar :: Builder Var
newBreakpointVar = do
  Counter
currentId <- (BuilderState -> Counter) -> Builder Counter
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets BuilderState -> Counter
varCounter
  (BuilderState -> BuilderState) -> Builder ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((BuilderState -> BuilderState) -> Builder ())
-> (BuilderState -> BuilderState) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \BuilderState
s -> BuilderState
s { varCounter :: Counter
varCounter = BuilderState -> Counter
varCounter BuilderState
s Counter -> Counter -> Counter
forall a. Num a => a -> a -> a
+ Counter
1 }
  Var -> Builder Var
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var -> Builder Var) -> Var -> Builder Var
forall a b. (a -> b) -> a -> b
$ Var
"$var" Var -> Var -> Var
forall a. Semigroup a => a -> a -> a
<> FilePath -> Var
T.pack (Counter -> FilePath
forall a. Show a => a -> FilePath
show Counter
currentId)