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