module Debugger.Render
  ( renderToStdOut
  , renderIO
  , renderScript
  ) where

import Control.Monad.Reader
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Debugger.Statement


-- | Renders a GDB script and writes it to stdout.
renderToStdOut :: Script -> IO ()
renderToStdOut :: Script -> IO ()
renderToStdOut Script
script =
  let txt :: Text
txt = Script -> Text
renderScript Script
script
   in Text -> IO ()
TIO.putStrLn Text
txt

-- | Renders a GDB script and writes it to the given file path.
renderIO :: Script -> FilePath -> IO ()
renderIO :: Script -> FilePath -> IO ()
renderIO Script
script FilePath
path =
  let txt :: Text
txt = Script -> Text
renderScript Script
script
   in FilePath -> Text -> IO ()
TIO.writeFile FilePath
path Text
txt

-- | Renders a GDB script
renderScript :: Script -> T.Text
renderScript :: Script -> Text
renderScript Script
script =
  [Text] -> Text
interleaveNewlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Statement -> Text) -> Script -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Statement -> Text
render Script
script

render :: Statement -> T.Text
render :: Statement -> Text
render Statement
stmt = Reader Int Text -> Int -> Text
forall r a. Reader r a -> r -> a
runReader (Statement -> Reader Int Text
go Statement
stmt) Int
0
  where
    go :: Statement -> Reader Int Text
go = \case
      Break Location
loc ->
        Text -> Reader Int Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Reader Int Text) -> Text -> Reader Int Text
forall a b. (a -> b) -> a -> b
$ Text
"break " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Location -> Text
renderLoc Location
loc
      Command Id
bp Script
stmts -> do
        [Text]
block <- (Int -> Int)
-> ReaderT Int Identity [Text] -> ReaderT Int Identity [Text]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) (ReaderT Int Identity [Text] -> ReaderT Int Identity [Text])
-> ReaderT Int Identity [Text] -> ReaderT Int Identity [Text]
forall a b. (a -> b) -> a -> b
$ (Statement -> Reader Int Text)
-> Script -> ReaderT Int Identity [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Text -> Reader Int Text
forall (m :: * -> *). MonadReader Int m => Text -> m Text
indent (Text -> Reader Int Text)
-> (Statement -> Reader Int Text) -> Statement -> Reader Int Text
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Statement -> Reader Int Text
go) Script
stmts
        -- need to indent the end explicitly, because lines will be joined
        -- together before returning and only start is indented
        Text
end <- Text -> Reader Int Text
forall (m :: * -> *). MonadReader Int m => Text -> m Text
indent Text
"end"
        Text -> Reader Int Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Reader Int Text) -> Text -> Reader Int Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
interleaveNewlines
          [ Text
"command " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Id -> Text
renderId Id
bp
          , [Text] -> Text
interleaveNewlines [Text]
block
          , Text
end
          ]
      Statement
Continue ->
        Text -> Reader Int Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"continue"
      Next Maybe Int
count ->
        Text -> Reader Int Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Reader Int Text) -> Text -> Reader Int Text
forall a b. (a -> b) -> a -> b
$ Text
"next" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Int -> Text
renderCount Maybe Int
count
      Step Maybe Int
count ->
        Text -> Reader Int Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Reader Int Text) -> Text -> Reader Int Text
forall a b. (a -> b) -> a -> b
$ Text
"step" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Int -> Text
renderCount Maybe Int
count
      Statement
Run ->
        Text -> Reader Int Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"run"
      Statement
Reset ->
        Text -> Reader Int Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"monitor reset"
      Set Text
var Text
expr ->
        Text -> Reader Int Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Reader Int Text) -> Text -> Reader Int Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text
"set", Text
var, Text
"=", Text
expr]
      Call Text
expr ->
        Text -> Reader Int Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Reader Int Text) -> Text -> Reader Int Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text
"call", Text
expr]
      Print Text
val ->
        Text -> Reader Int Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Reader Int Text) -> Text -> Reader Int Text
forall a b. (a -> b) -> a -> b
$ Text
"print " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
val Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
      Delete Selection
sel ->
        Text -> Reader Int Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Reader Int Text) -> Text -> Reader Int Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"delete " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Selection -> Text
renderSelection Selection
sel
      Disable Selection
sel ->
        Text -> Reader Int Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Reader Int Text) -> Text -> Reader Int Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"disable " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Selection -> Text
renderSelection Selection
sel
      Enable Selection
sel ->
        Text -> Reader Int Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Reader Int Text) -> Text -> Reader Int Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"enable " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Selection -> Text
renderSelection Selection
sel
      Shell Text
cmd ->
        Text -> Reader Int Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Reader Int Text) -> Text -> Reader Int Text
forall a b. (a -> b) -> a -> b
$ Text
"shell " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cmd
      Source FilePath
file ->
        Text -> Reader Int Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Reader Int Text) -> Text -> Reader Int Text
forall a b. (a -> b) -> a -> b
$ Text
"source " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
file
      Target TargetConfig
target ->
        Text -> Reader Int Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Reader Int Text) -> Text -> Reader Int Text
forall a b. (a -> b) -> a -> b
$ Text
"target " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TargetConfig -> Text
renderTargetConfig TargetConfig
target
      Info InfoOptions
opts ->
        Text -> Reader Int Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Reader Int Text) -> Text -> Reader Int Text
forall a b. (a -> b) -> a -> b
$ Text
"info " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> InfoOptions -> Text
renderInfoOpts InfoOptions
opts

    indent :: Text -> m Text
indent Text
txt = do
      Int
spaces <- m Int
forall r (m :: * -> *). MonadReader r m => m r
ask
      let indentation :: Text
indentation = Int -> Text -> Text
T.replicate Int
spaces Text
" "
      Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text
indentation Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt


renderId :: Id -> T.Text
renderId :: Id -> Text
renderId (Id Text
txt) = Text
txt

renderLoc :: Location -> T.Text
renderLoc :: Location -> Text
renderLoc = \case
  Function Text
func -> Text
func
  File FilePath
path Int
line -> FilePath -> Text
T.pack FilePath
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
line)

renderSelection :: Selection -> T.Text
renderSelection :: Selection -> Text
renderSelection = \case
  Single Id
bp -> Id -> Text
renderId Id
bp
  Many [Id]
bps -> Text -> [Text] -> Text
T.intercalate Text
" " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Id -> Text) -> [Id] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Id -> Text
renderId [Id]
bps
  Selection
All -> Text
""

renderTargetConfig :: TargetConfig -> T.Text
renderTargetConfig :: TargetConfig -> Text
renderTargetConfig = \case
  Remote Int
port -> Text
"remote tcp:localhost:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
port)

renderInfoOpts :: InfoOptions -> T.Text
renderInfoOpts :: InfoOptions -> Text
renderInfoOpts = \case
  InfoOptions
Breakpoints -> Text
"breakpoints"

renderCount :: Maybe Int -> T.Text
renderCount :: Maybe Int -> Text
renderCount = \case
  Maybe Int
Nothing -> Text
""
  Just Int
x -> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
x)

interleaveNewlines :: [T.Text] -> T.Text
interleaveNewlines :: [Text] -> Text
interleaveNewlines [Text]
txts = Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
txts