module Sarsi.Tools.Trace where

import qualified Codec.GHC.Log as GHC
import Codec.Sarsi.Curses (cleanLine, cleaningCurses)
import qualified Codec.Sarsi.Rust as Rust
import qualified Codec.Sarsi.SBT as SBT
import qualified Codec.Sarsi.SBT.Machine as SBTM
import Data.Attoparsec.Text (Parser)
import Data.Attoparsec.Text.Machine (streamParser)
import Data.Machine (ProcessT, asParts, auto, autoM, runT_, (<~))
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as TextIO
import System.IO (Handle)
import System.IO.Machine (byLine, printer, sourceHandle)

traceCleanCurses :: Handle -> IO ()
traceCleanCurses :: Handle -> IO ()
traceCleanCurses Handle
h = MachineT IO Any () -> IO ()
forall (m :: * -> *) (k :: * -> *) b.
Monad m =>
MachineT m k b -> m ()
runT_ (MachineT IO Any () -> IO ()) -> MachineT IO Any () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Either String Text -> IO ())
-> MachineT IO (Is (Either String Text)) ()
forall (k :: * -> * -> *) (m :: * -> *) a b.
(Category k, Monad m) =>
(a -> m b) -> MachineT m (k a) b
autoM Either String Text -> IO ()
forall a. Show a => Either a Text -> IO ()
printing MachineT IO (Is (Either String Text)) ()
-> MachineT IO Any (Either String Text) -> MachineT IO Any ()
forall (m :: * -> *) b c (k :: * -> *).
Monad m =>
ProcessT m b c -> MachineT m k b -> MachineT m k c
<~ MachineT IO (Is Text) (Either String Text)
preprocessing MachineT IO (Is Text) (Either String Text)
-> MachineT IO Any Text -> MachineT IO Any (Either String Text)
forall (m :: * -> *) b c (k :: * -> *).
Monad m =>
ProcessT m b c -> MachineT m k b -> MachineT m k c
<~ ProcessT IO Text Text
appendLF ProcessT IO Text Text
-> MachineT IO Any Text -> MachineT IO Any Text
forall (m :: * -> *) b c (k :: * -> *).
Monad m =>
ProcessT m b c -> MachineT m k b -> MachineT m k c
<~ DataModeIO IO Text -> Handle -> SourceIO IO Text
forall (m :: * -> *) a. DataModeIO m a -> Handle -> SourceIO m a
sourceHandle DataModeIO IO Text
forall a (m :: * -> *). IOData a => DataModeIO m a
byLine Handle
h
  where
    printing :: Either a Text -> IO ()
printing (Right Text
s) = Text -> IO ()
TextIO.putStrLn Text
s
    printing Either a Text
e = String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Either a Text -> String
forall a. Show a => a -> String
show Either a Text
e
    preprocessing :: MachineT IO (Is Text) (Either String Text)
preprocessing = Parser Text -> MachineT IO (Is Text) (Either String Text)
forall (m :: * -> *) a.
Monad m =>
Parser a -> ProcessT m Text (Either String a)
streamParser Parser Text
cleaningCurses MachineT IO (Is Text) (Either String Text)
-> ProcessT IO Text Text
-> MachineT IO (Is Text) (Either String Text)
forall (m :: * -> *) b c (k :: * -> *).
Monad m =>
ProcessT m b c -> MachineT m k b -> MachineT m k c
<~ MachineT IO (Is [Text]) Text
forall (f :: * -> *) a. Foldable f => Process (f a) a
asParts MachineT IO (Is [Text]) Text
-> MachineT IO (Is Text) [Text] -> ProcessT IO Text Text
forall (m :: * -> *) b c (k :: * -> *).
Monad m =>
ProcessT m b c -> MachineT m k b -> MachineT m k c
<~ (Either String Text -> [Text])
-> Process (Either String Text) [Text]
forall (k :: * -> * -> *) a b. Automaton k => k a b -> Process a b
auto Either String Text -> [Text]
forall a. Either a Text -> [Text]
unpackLine MachineT IO (Is (Either String Text)) [Text]
-> MachineT IO (Is Text) (Either String Text)
-> MachineT IO (Is Text) [Text]
forall (m :: * -> *) b c (k :: * -> *).
Monad m =>
ProcessT m b c -> MachineT m k b -> MachineT m k c
<~ MachineT IO (Is Text) (Either String Text)
asLines
      where
        asLines :: MachineT IO (Is Text) (Either String Text)
asLines = Parser Text -> MachineT IO (Is Text) (Either String Text)
forall (m :: * -> *) a.
Monad m =>
Parser a -> ProcessT m Text (Either String a)
streamParser (Parser Text -> MachineT IO (Is Text) (Either String Text))
-> Parser Text -> MachineT IO (Is Text) (Either String Text)
forall a b. (a -> b) -> a -> b
$ Parser Text
SBT.untilLineBreak Parser Text -> Parser Text () -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
SBT.end
    unpackLine :: Either a Text -> [Text]
unpackLine (Right Text
txt) = [(Text -> Text
cleanLine Text
txt) Text -> Char -> Text
`Text.snoc` Char
'\n']
    unpackLine (Left a
_) = []

traceHS :: Handle -> IO ()
traceHS :: Handle -> IO ()
traceHS = Parser Message -> Handle -> IO ()
forall a. Show a => Parser a -> Handle -> IO ()
traceParser Parser Message
GHC.messageParser

traceRS :: Handle -> IO ()
traceRS :: Handle -> IO ()
traceRS = Parser Message -> Handle -> IO ()
forall a. Show a => Parser a -> Handle -> IO ()
traceParser Parser Message
Rust.messageParser

traceSBT :: Handle -> IO ()
traceSBT :: Handle -> IO ()
traceSBT = Parser SBTEvent -> Handle -> IO ()
forall a. Show a => Parser a -> Handle -> IO ()
traceParser Parser SBTEvent
SBT.eventParser

traceSBTCurses :: Handle -> IO ()
traceSBTCurses :: Handle -> IO ()
traceSBTCurses Handle
h = MachineT IO Any Any -> IO ()
forall (m :: * -> *) (k :: * -> *) b.
Monad m =>
MachineT m k b -> m ()
runT_ (MachineT IO Any Any -> IO ()) -> MachineT IO Any Any -> IO ()
forall a b. (a -> b) -> a -> b
$ ProcessT IO SBTEvent Any
forall a (m :: * -> *). Show a => SinkIO m a
printer ProcessT IO SBTEvent Any
-> MachineT IO Any SBTEvent -> MachineT IO Any Any
forall (m :: * -> *) b c (k :: * -> *).
Monad m =>
ProcessT m b c -> MachineT m k b -> MachineT m k c
<~ ProcessT IO Text SBTEvent
forall (m :: * -> *). Monad m => ProcessT m Text SBTEvent
SBTM.eventProcess' ProcessT IO Text SBTEvent
-> MachineT IO Any Text -> MachineT IO Any SBTEvent
forall (m :: * -> *) b c (k :: * -> *).
Monad m =>
ProcessT m b c -> MachineT m k b -> MachineT m k c
<~ ProcessT IO Text Text
appendLF ProcessT IO Text Text
-> MachineT IO Any Text -> MachineT IO Any Text
forall (m :: * -> *) b c (k :: * -> *).
Monad m =>
ProcessT m b c -> MachineT m k b -> MachineT m k c
<~ DataModeIO IO Text -> Handle -> SourceIO IO Text
forall (m :: * -> *) a. DataModeIO m a -> Handle -> SourceIO m a
sourceHandle DataModeIO IO Text
forall a (m :: * -> *). IOData a => DataModeIO m a
byLine Handle
h

traceParser :: Show a => Parser a -> Handle -> IO ()
traceParser :: Parser a -> Handle -> IO ()
traceParser Parser a
parser Handle
h = do
  MachineT IO Any Any -> IO ()
forall (m :: * -> *) (k :: * -> *) b.
Monad m =>
MachineT m k b -> m ()
runT_ (MachineT IO Any Any -> IO ()) -> MachineT IO Any Any -> IO ()
forall a b. (a -> b) -> a -> b
$ ProcessT IO (Either String a) Any
forall a (m :: * -> *). Show a => SinkIO m a
printer ProcessT IO (Either String a) Any
-> MachineT IO Any (Either String a) -> MachineT IO Any Any
forall (m :: * -> *) b c (k :: * -> *).
Monad m =>
ProcessT m b c -> MachineT m k b -> MachineT m k c
<~ Parser a -> ProcessT IO Text (Either String a)
forall (m :: * -> *) a.
Monad m =>
Parser a -> ProcessT m Text (Either String a)
streamParser Parser a
parser ProcessT IO Text (Either String a)
-> MachineT IO Any Text -> MachineT IO Any (Either String a)
forall (m :: * -> *) b c (k :: * -> *).
Monad m =>
ProcessT m b c -> MachineT m k b -> MachineT m k c
<~ ProcessT IO Text Text
appendLF ProcessT IO Text Text
-> MachineT IO Any Text -> MachineT IO Any Text
forall (m :: * -> *) b c (k :: * -> *).
Monad m =>
ProcessT m b c -> MachineT m k b -> MachineT m k c
<~ DataModeIO IO Text -> Handle -> SourceIO IO Text
forall (m :: * -> *) a. DataModeIO m a -> Handle -> SourceIO m a
sourceHandle DataModeIO IO Text
forall a (m :: * -> *). IOData a => DataModeIO m a
byLine Handle
h

appendLF :: ProcessT IO Text Text
appendLF :: ProcessT IO Text Text
appendLF = (Text -> Text) -> Process Text Text
forall (k :: * -> * -> *) a b. Automaton k => k a b -> Process a b
auto ((Text -> Text) -> Process Text Text)
-> (Text -> Text) -> Process Text Text
forall a b. (a -> b) -> a -> b
$ (Text -> Char -> Text
`Text.snoc` Char
'\n')