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
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
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
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
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