sarsi 0.0.3.0 → 0.0.4.0
raw patch · 17 files changed
+225/−147 lines, 17 filesdep +data-msgpackdep −msgpackdep ~basedep ~cryptonitedep ~machinesnew-component:exe:sarsi-rs
Dependencies added: data-msgpack
Dependencies removed: msgpack
Dependency ranges changed: base, cryptonite, machines, machines-io, machines-process, process, sarsi, text
Files
- sarsi-hs/Main.hs +4/−50
- sarsi-nvim/Data/MessagePack/RPC.hs +6/−7
- sarsi-nvim/Main.hs +24/−23
- sarsi-nvim/NVIM/Client.hs +3/−6
- sarsi-rs/Main.hs +12/−0
- sarsi-vi/Main.hs +1/−2
- sarsi.cabal +22/−15
- sarsi/Main.hs +2/−1
- src/Codec/GHC/Log.hs +9/−3
- src/Codec/Sarsi.hs +7/−8
- src/Codec/Sarsi/GHC.hs +3/−2
- src/Codec/Sarsi/Rust.hs +37/−0
- src/Codec/Sarsi/SBT.hs +3/−4
- src/Codec/Sarsi/SBT/Machine.hs +2/−1
- src/Sarsi/Tools/Shell.hs +61/−0
- src/Sarsi/Tools/Trace.hs +29/−0
- src/Sarsi/Trace.hs +0/−25
sarsi-hs/Main.hs view
@@ -2,59 +2,13 @@ module Main where import Codec.GHC.Log (messageParser)-import Codec.Sarsi (Event(..), Level(..), Message(..)) import Codec.Sarsi.GHC (fromGHCLog) import Data.Attoparsec.Text.Machine (streamParser)-import Data.Machine (ProcessT, (<~), asParts, auto, autoM, prepended, runT_, source)-import Data.List (foldl')-import Sarsi (getBroker, getTopic)-import Sarsi.Producer (produce)-import System.Environment (getArgs)-import System.IO (stderr)-import System.IO.Machine (byLine)-import System.Process (StdStream(..), shell, std_in, std_err)-import System.Process.Machine (callProcessMachines, mStdErr)-import System.Exit (ExitCode, exitWith)--import qualified Data.List as List-import qualified Data.Text as Text-import qualified Data.Text.IO as TextIO-import qualified Sarsi as Sarsi--title :: String-title = concat [Sarsi.title, "-hs"]+import Data.Machine ((<~), asParts, auto)+import Sarsi.Tools.Shell (mainShell) --- TODO Use Wee/Tee to merge stdout/stderr (keep echoText splitted).-callShell :: String -> ProcessT IO Message a -> IO (ExitCode, [a])-callShell cmd sink = callProcessMachines byLine createProc (mStdErr pipeline)+main :: IO ()+main = mainShell "haskell" (asParts <~ auto unpack <~ streamParser messageParser) where- pipeline = sink <~ asParts <~ auto unpack <~ streamParser messageParser <~ echoText stderr <~ appendCR unpack (Right msg) = [fromGHCLog msg] unpack (Left _) = []- echoText h = autoM $ (\txt -> TextIO.hPutStr h txt >> return txt)- createProc = (shell cmd) { std_in = Inherit, std_err = CreatePipe }- appendCR = auto $ (`Text.snoc` '\n')--producer :: String -> ProcessT IO Event Event -> IO ExitCode-producer cmd sink = do- (ec, xs) <- callShell cmd pipeline- let finish = createFinish xs- putStrLn $ concat [title, ": ", show finish]- runT_ $ sink <~ source [finish]- return ec- where- pipeline = sink <~ prepended [Start $ Text.pack "haskell"] <~ auto Notify- createFinish xs = foldl' f empty xs- where- empty = Finish 0 0- f (Finish e w) (Notify (Message _ Warning _)) = Finish e (w + 1)- f (Finish e w) (Notify (Message _ Error _)) = Finish (e + 1) w- f finish _ = finish--main :: IO ()-main = do- args <- getArgs- b <- getBroker- t <- getTopic b "."- ec <- produce t $ producer (concat $ List.intersperse " " args)- exitWith ec
sarsi-nvim/Data/MessagePack/RPC.hs view
@@ -1,33 +1,32 @@ module Data.MessagePack.RPC where import Data.Binary (Get, Put, get, getWord8, put)+import Data.Int (Int64) import Data.MessagePack (Object(..)) import Data.Text (Text)-import Data.Vector (Vector) import qualified Data.MessagePack as MP-import qualified Data.Vector as Vector data Answer = Success Object | Error Object deriving Show data Request = Request- { requestMessageID :: Int+ { requestMessageID :: Int64 , requestMethod :: Text- , requestParams :: Vector Object }+ , requestParams :: [Object] } deriving Show putRequest :: Request -> Put putRequest (Request msgID method params) =- MP.putArray id $ Vector.fromList $ [MP.putInt 0, MP.putInt msgID, MP.putStr method, MP.putArray put params]+ MP.putArray id [MP.putInt 0, MP.putInt msgID, MP.putStr method, MP.putArray put params] data Message = Response- { responseMessageID :: Int+ { responseMessageID :: Int64 , responseAnswer :: Answer } | Notification { notificationMethod :: Text- , notificationParams :: Vector Object }+ , notificationParams :: [Object] } deriving Show getMessage :: Get Message
sarsi-nvim/Main.hs view
@@ -2,7 +2,7 @@ import Codec.Sarsi (Event(..), Level(..), Location(..), Message(..)) import Data.Machine (ProcessT, (<~), asParts, final, scan, sinkPart_, runT)-import Data.MessagePack.Object (Object(..), toObject)+import Data.MessagePack.Object (Object(..)) import NVIM.Client (Command(..), runCommand) import Sarsi (getBroker, getTopic, title) import Sarsi.Consumer (consumeOrWait)@@ -10,36 +10,37 @@ import System.IO.Machine (sinkIO) import qualified Data.Text as Text-import qualified Data.Map as Map-import qualified Data.Vector as Vector echo :: String -> Command-echo str = VimCommand [toObject $ concat ["echo \"", str, "\""]]+echo str = VimCommand [ObjectStr . Text.pack $ concat ["echo \"", str, "\""]] echom :: String -> Command-echom str = VimCommand [toObject $ concat ["echom \"", title, ": ", str, "\""]]+echom str = VimCommand [ObjectStr . Text.pack $ concat ["echom \"", title, ": ", str, "\""]] setqflist :: String -> [Object] -> Command-setqflist action items = VimCallFunction (Text.pack "setqflist") [toObject items, toObject action]+setqflist action items = VimCallFunction (Text.pack "setqflist") [ObjectArray items, ObjectStr $ Text.pack action] +setqflistEmpty :: Command+setqflistEmpty = setqflist "r" []+ -- TODO Sanitize text description by escaping special characters mkQuickFix :: Message -> Object-mkQuickFix (Message (Location fp col ln) lvl txts) = toObject . Map.fromList $- [ ("filename", toObject fp)- , ("lnum", ObjectInt ln)- , ("col", ObjectInt col)- , ("type", toObject $ tpe lvl)- , ("text", toObject $ Text.unlines $ Vector.toList txts) ]+mkQuickFix (Message (Location fp col ln) lvl txts) = ObjectMap $+ [ (ObjectStr $ Text.pack "filename", ObjectStr fp)+ , (ObjectStr $ Text.pack "lnum", ObjectInt ln)+ , (ObjectStr $ Text.pack "col", ObjectInt col)+ , (ObjectStr $ Text.pack "type", ObjectStr . Text.pack $ tpe lvl)+ , (ObjectStr $ Text.pack "text", ObjectStr $ Text.unlines txts) ] where tpe Error = "E" tpe Warning = "W" -convert :: Bool -> Event -> (Bool, [Command])-convert _ e@(Start _) = (True, [echom $ show e])-convert _ e@(Finish _ _) = (True, [echom $ show e])-convert first (Notify msg@(Message loc lvl _)) = (False, xs) where+convert :: Int -> Event -> (Int, [Command])+convert _ e@(Start _) = (0, [echom $ show e])+convert i e@(Finish _ _) = (0, (echom $ show e) : (if i == 0 then [setqflistEmpty] else []))+convert i (Notify msg@(Message loc lvl _)) = (i + 1, xs) where xs =- [ setqflist (if first then "r" else "a") [mkQuickFix msg]+ [ setqflist (if i == 0 then "r" else "a") [mkQuickFix msg] , echo $ concat [show loc, " ", show lvl] ] main :: IO ()@@ -50,12 +51,12 @@ t <- getTopic b "." consumeOrWait t consumer where- consumer Nothing src = consumer (Just True) src- consumer (Just b) src = do- b' <- runT $ final <~ sinkPart_ id (sinkIO publish <~ asParts) <~ converter b <~ src- return (Left $ head b')- converter :: Bool -> ProcessT IO Event (Bool, [Command])- converter b = scan f (b, []) where f (first, _) event = convert first event+ consumer Nothing src = consumer (Just 0) src+ consumer (Just i) src = do+ i' <- runT $ final <~ sinkPart_ id (sinkIO publish <~ asParts) <~ converter i <~ src+ return (Left $ head i')+ converter :: Int -> ProcessT IO Event (Int, [Command])+ converter i = scan f (i, []) where f (first, _) event = convert first event publish cmd = do _ <- runCommand cmd return ()
sarsi-nvim/NVIM/Client.hs view
@@ -7,12 +7,11 @@ import Data.ByteString (hGetSome, hPut) import Data.ByteString.Lazy (toStrict) import Data.Machine ((<~), asParts, auto, final, run, source)-import Data.MessagePack.Object (Object(..), toObject)+import Data.MessagePack.Object (Object(..)) import Data.MessagePack.RPC (Answer(..), Request(..), Message(..), getMessage, putRequest) import Data.Text (Text) import System.IO (Handle, stdin, stdout) import qualified Data.Text as Text-import qualified Data.Vector as Vector data Command = VimCommand [Object] | VimCallFunction Text [Object] @@ -29,10 +28,8 @@ mkAnswer [a] = a mkAnswer _ = Error $ ObjectStr $ Text.pack "No RPC answer received." mkRequest (VimCommand xs) =- Request 0 (Text.pack "vim_command") $ Vector.fromList xs+ Request 0 (Text.pack "vim_command") xs mkRequest (VimCallFunction m xs) =- Request 0 (Text.pack "vim_call_function") $ Vector.fromList $- [ toObject m- , toObject $ Vector.fromList xs ]+ Request 0 (Text.pack "vim_call_function") [ ObjectStr m, ObjectArray xs ] unpack (Right (Response _ a)) = [a] unpack _ = []
+ sarsi-rs/Main.hs view
@@ -0,0 +1,12 @@+module Main where++import Codec.Sarsi.Rust (messageParser)+import Data.Attoparsec.Text.Machine (streamParser)+import Data.Machine ((<~), asParts, auto)+import Sarsi.Tools.Shell (mainShell)++main :: IO ()+main = mainShell "rust" (asParts <~ auto unpack <~ streamParser messageParser)+ where+ unpack (Right msg) = [msg]+ unpack (Left _) = []
sarsi-vi/Main.hs view
@@ -12,7 +12,6 @@ import qualified Data.List as List import qualified Data.Text as Text-import qualified Data.Vector as Vector import qualified Sarsi as Sarsi -- TODO Remove the MVar by impl. scanM ((a -> b -> m a) -> a -> ProcessT m (k b) a) in machines@@ -25,7 +24,7 @@ toVi (Message (Location fp col ln) lvl txts) = Text.concat [header, pack " ", body] where header = Text.concat $ List.intersperse (pack ":") [fp, pack $ show ln, pack $ show col, tpe lvl]- body = Text.concat $ List.intersperse (pack " ") $ Vector.toList txts+ body = Text.concat $ List.intersperse (pack " ") txts tpe Error = pack "e" tpe Warning = pack "w"
sarsi.cabal view
@@ -1,5 +1,5 @@ name: sarsi-version: 0.0.3.0+version: 0.0.4.0 synopsis: A universal quickfix toolkit and his protocol. description:@@ -21,12 +21,14 @@ exposed-modules: Codec.Sarsi Codec.Sarsi.GHC+ Codec.Sarsi.Rust Codec.Sarsi.SBT Codec.Sarsi.SBT.Machine Sarsi Sarsi.Consumer Sarsi.Producer- Sarsi.Trace+ Sarsi.Tools.Shell+ Sarsi.Tools.Trace -- TODO Extract in a `codec-ghc-log` module Codec.GHC.Log -- TODO Extract in a `machines-attoparsec` module@@ -39,7 +41,8 @@ , binary >= 0.7 && < 0.9 , bytestring >= 0.10 && < 0.11 , containers >= 0.5 && < 0.6- , cryptonite >= 0.10 && < 0.14+ , cryptonite >= 0.10 && < 0.21+ , data-msgpack >= 0.0.3 && < 0.1 , directory >= 1.2 && < 1.3 , filepath >= 1.4 && < 1.5 , fsnotify >= 0.2 && < 0.3@@ -47,7 +50,6 @@ , machines-binary >= 0.3.0.2 && < 0.4 , machines-process >= 0.2.0.6 && < 0.3 , machines-io >= 0.2.0.12 && < 0.3- , msgpack >= 1.0 && < 1.1 , network >= 2.6 && < 2.7 , process >= 1.1 && < 1.5 , stm >= 2.4 && < 2.5@@ -61,7 +63,7 @@ build-depends: base , Cabal- , sarsi == 0.0.3.0+ , sarsi == 0.0.4.0 hs-source-dirs: sarsi ghc-options: -Wall -threaded default-language: Haskell2010@@ -70,13 +72,8 @@ main-is: Main.hs build-depends: base- , sarsi == 0.0.3.0+ , sarsi == 0.0.4.0 , machines- , machines-io- , machines-process- , process- , text- , fsnotify >= 0.2 && < 0.3 hs-source-dirs: sarsi-hs ghc-options: -Wall -dynamic -threaded default-language: Haskell2010@@ -92,7 +89,7 @@ -- NVIM.Info build-depends: base- , sarsi == 0.0.3.0+ , sarsi == 0.0.4.0 , machines , binary , bytestring@@ -100,7 +97,7 @@ , machines , machines-binary , machines-io- , msgpack+ , data-msgpack , network , process , text@@ -110,12 +107,22 @@ ghc-options: -Wall -dynamic -threaded default-language: Haskell2010 +executable sarsi-rs+ main-is: Main.hs+ build-depends: + base+ , sarsi == 0.0.4.0+ , machines+ hs-source-dirs: sarsi-rs+ ghc-options: -Wall -dynamic -threaded+ default-language: Haskell2010+ executable sarsi-sbt main-is: Main.hs other-modules: build-depends: base- , sarsi == 0.0.3.0+ , sarsi == 0.0.4.0 , machines , machines-io , machines-process@@ -129,7 +136,7 @@ main-is: Main.hs build-depends: base- , sarsi == 0.0.3.0+ , sarsi == 0.0.4.0 , directory , filepath , machines
sarsi/Main.hs view
@@ -2,7 +2,7 @@ import Distribution.Text import Sarsi (getBroker, getSockAddr, getTopic, title)-import Sarsi.Trace (traceHS, traceSBT)+import Sarsi.Tools.Trace (traceHS, traceRS, traceSBT) import System.IO (stdin) import System.Environment (getArgs) @@ -11,6 +11,7 @@ main :: IO () main = getArgs >>= run where run ["--trace-hs"] = traceHS stdin+ run ["--trace-rs"] = traceRS stdin run ["--trace-sbt"] = traceSBT stdin run ["--version"] = putStrLn $ concat [title, "-", display version] run _ = do
src/Codec/GHC/Log.hs view
@@ -19,10 +19,16 @@ n <- decimal <* char sepChar c <- decimal <* char sepChar l <- choice- [ string " Warning:" *> return Warning- , return Error ]+ [ choice+ [ string " warning:" *> return Warning+ , string " error:" *> return Error ]+ -- Before GHC 8.0+ , choice+ [ string " Warning:" *> return Warning+ , return Error ] ] txt <- choice- [ return <$> untilLineBreak <* ("\n" <* end)+ [ (string " [" *> untilLineBreak <* "\n") *> (multilinesComment <* end)+ , return <$> untilLineBreak <* ("\n" <* end) , takeLineBreak *> (multilinesComment <* end) ] return $ Message fp (Pos c n) l txt where
src/Codec/Sarsi.hs view
@@ -1,17 +1,16 @@ module Codec.Sarsi where +import Data.Int (Int64) import Data.Text (Text, unpack) import Data.Binary (Get, Put)-import Data.Vector (Vector) import qualified Data.MessagePack.Get as Get import qualified Data.MessagePack.Put as Put import qualified Data.Text as Text-import qualified Data.Vector as Vector data Event = Start { label :: Text }- | Finish { errors :: Int, warnings :: Int }+ | Finish { errors :: Int64, warnings :: Int64 } | Notify { message :: Message } instance Show Event where@@ -36,11 +35,11 @@ putEvent (Finish es ws) = Put.putInt 1 *> Put.putInt es *> Put.putInt ws putEvent (Notify m) = Put.putInt 2 *> putMessage m -data Message = Message Location Level (Vector Text)+data Message = Message Location Level [Text] instance Show Message where show (Message loc lvl txts) =- (concat [show loc, " ", show lvl, "\n"]) ++ (unlines $ Text.unpack <$> Vector.toList txts)+ (concat [show loc, " ", show lvl, "\n"]) ++ (unlines $ Text.unpack <$> txts) getMessage :: Get Message getMessage = Message <$> getLocation <*> getLevel <*> Get.getArray Get.getStr@@ -48,7 +47,7 @@ putMessage :: Message -> Put putMessage (Message loc lvl txt) = putLocation loc *> putLevel lvl *> Put.putArray Put.putStr txt -data Location = Location { filePath :: Text, column :: Int, line :: Int }+data Location = Location { filePath :: Text, column :: Int64, line :: Int64 } instance Show Location where show (Location fp c l) = concat [Text.unpack fp, "@", show l, ":", show c]@@ -63,8 +62,8 @@ deriving (Enum, Show) getLevel :: Get Level-getLevel = fmap toEnum Get.getInt+getLevel = fmap (toEnum . fromIntegral) Get.getInt putLevel :: Level -> Put-putLevel = Put.putInt . fromEnum+putLevel = Put.putInt . fromIntegral . fromEnum
src/Codec/Sarsi/GHC.hs view
@@ -4,11 +4,12 @@ import Data.Text (strip) import qualified Codec.GHC.Log as Log-import qualified Data.Vector as Vector fromGHCLog :: Log.Message -> Message fromGHCLog (Log.Message fp (Log.Pos col ln) lvl texts) =- Message (Location (strip fp) col ln) (fromGHCLevel lvl) (Vector.fromList $ strip <$> texts)+ Message+ (Location (strip fp) (fromIntegral col) (fromIntegral ln))+ (fromGHCLevel lvl) (strip <$> texts) fromGHCLevel :: Log.Level -> Level fromGHCLevel Log.Warning = Warning
+ src/Codec/Sarsi/Rust.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}+module Codec.Sarsi.Rust where++import Codec.Sarsi (Level(..), Location(..), Message(..))++import Data.Attoparsec.Text++messageParser :: Parser Message+messageParser = choice [formatA, formatB] where+ formatA = do+ fp <- takeWhile1 (\c -> c /= sepChar && c /= '\n' && c /= '\r') <* char sepChar+ n <- decimal <* char sepChar+ c <- decimal <* char sepChar+ _ <- untilSep <* char sepChar+ _ <- untilSpace *> space+ l <- choice+ [ string "warning: " *> return Warning+ , string "error: " *> return Error ]+ txt <- untilLineBreak <* ("\n" <* end)+ return $ Message (Location fp c n) l [txt]++ formatB = do+ l <- choice+ [ string "warning" *> untilSep0 *> string ": " *> return Warning+ , string "error" *> untilSep0 *> string ": " *> return Error ]+ txt <- untilLineBreak <* "\n"+ fp <- many1 space *> "--> " *> untilSep <* char sepChar+ n <- decimal <* char sepChar+ c <- decimal <* end+ return $ Message (Location fp c n) l [txt]++ untilSep = takeWhile1 $ \w -> w /= sepChar+ untilSep0 = Data.Attoparsec.Text.takeWhile $ \w -> w /= ':'+ untilSpace = takeWhile1 $ \w -> w /= ' '+ end = choice [const () <$> "\n", endOfInput, return ()]+ sepChar = ':'+ untilLineBreak = takeWhile1 $ \w -> w /= '\n' && w /= '\r'
src/Codec/Sarsi/SBT.hs view
@@ -8,7 +8,6 @@ import qualified Data.Attoparsec.Text as AttoText import qualified Data.Text as Text-import qualified Data.Vector as Vector data SBTEvent = CompileStart Text | TaskFinish Bool Text | Throw Message deriving Show@@ -36,13 +35,13 @@ ts <- manyTill' (lineStart *> (untilLineBreak <* "\n")) (lookAhead $ column') col <- column' _ <- end- return $ Message (Location fp (col) ln) lvl $ formatTxts t ts+ return $ Message (Location fp (fromIntegral col) ln) lvl $ formatTxts t ts where level = choice [string "[error]" *> return Error, string "[warn]" *> return Warning] lineStart = level <* space sepChar = ':'- formatTxts t [] = Vector.singleton t- formatTxts t ts = Vector.fromList $ t : init ts+ formatTxts t [] = [t]+ formatTxts t ts = t : init ts column' = level *> ((length <$> many1 space) <* "^\n") cleanEC :: Parser Text
src/Codec/Sarsi/SBT/Machine.hs view
@@ -3,6 +3,7 @@ import Codec.Sarsi (Event(..), Message(..), Level(..)) import Codec.Sarsi.SBT (SBTEvent(..), eventParser, cleanEC, untilLineBreak, end) import Data.Attoparsec.Text.Machine (processParser, streamParser)+import Data.Int (Int64) import Data.Machine (ProcessT, (<~), asParts, auto, scan) import Data.Text (Text) @@ -29,7 +30,7 @@ unpackLine (Left _) = [] -data Session = Session { isBuilding :: Bool, counts :: (Int, Int) }+data Session = Session { isBuilding :: Bool, counts :: (Int64, Int64) } deriving Show emptySession :: Session
+ src/Sarsi/Tools/Shell.hs view
@@ -0,0 +1,61 @@+module Sarsi.Tools.Shell where++import Codec.Sarsi (Event(..), Level(..), Message(..))+import Data.Machine (ProcessT, Is, (<~), auto, autoM, prepended, runT, runT_, source, wye, repeatedly, awaits, yield, Y(Z))+import Data.List (foldl')+import Data.Text (Text)+import Sarsi (getBroker, getTopic)+import Sarsi.Producer (produce)+import System.Environment (getArgs)+import System.IO (stderr, stdout)+import System.IO.Machine (byLine)+import System.Process (StdStream(..), shell, std_in, std_err, std_out)+import System.Process.Machine (ProcessMachines, callProcessMachines)+import System.Exit (ExitCode, exitWith)++import qualified Data.List as List+import qualified Data.Text as Text+import qualified Data.Text.IO as TextIO+import qualified Sarsi as Sarsi++-- TODO Contribute to machine-process (as alt to mStdErr, mStdOut)+mStdOutputs :: ProcessT IO (Either a a) b -> ProcessMachines a a0 (Is a0) -> IO [b]+mStdOutputs mp (_, Just stdOut, Just stdErr) = runT $ mp <~ wye stdErr stdOut slurp where+ slurp = repeatedly $ do+ res <- awaits Z+ yield res+mStdOutputs _ _ = return []++callShell :: String -> ProcessT IO Text Message -> ProcessT IO Message a -> IO (ExitCode, [a])+callShell cmd parser sink = callProcessMachines byLine createProc (mStdOutputs pipeline)+ where+ pipeline = sink <~ parser <~ appendCR <~ echo+ echo = autoM $ \res -> case res of+ Left txt -> TextIO.hPutStrLn stderr txt >> return txt+ Right txt -> TextIO.hPutStrLn stdout txt >> return txt+ createProc = (shell cmd) { std_in = Inherit, std_err = CreatePipe, std_out = CreatePipe }+ appendCR = auto $ (`Text.snoc` '\n')++producer :: String -> String -> ProcessT IO Text Message -> ProcessT IO Event Event -> IO ExitCode+producer lbl cmd parser sink = do+ (ec, xs) <- callShell cmd parser pipeline+ let finish = createFinish xs+ putStrLn $ concat [Sarsi.title, ": ", show finish]+ runT_ $ sink <~ source [finish]+ return ec+ where+ pipeline = sink <~ prepended [Start $ Text.pack lbl] <~ auto Notify+ createFinish xs = foldl' f empty xs+ where+ empty = Finish 0 0+ f (Finish e w) (Notify (Message _ Warning _)) = Finish e (w + 1)+ f (Finish e w) (Notify (Message _ Error _)) = Finish (e + 1) w+ f finish _ = finish++mainShell :: String -> ProcessT IO Text Message -> IO ()+mainShell lbl parser = do+ args <- getArgs+ b <- getBroker+ t <- getTopic b "."+ ec <- produce t $ producer lbl (concat $ List.intersperse " " args) parser+ exitWith ec
+ src/Sarsi/Tools/Trace.hs view
@@ -0,0 +1,29 @@+module Sarsi.Tools.Trace where++import Data.Machine ((<~), auto, runT_)+import Data.Attoparsec.Text (Parser)+import Data.Attoparsec.Text.Machine (streamParser)+import System.IO (Handle)+import System.IO.Machine (byLine, printer, sourceHandle)++import qualified Codec.GHC.Log as GHC+import qualified Codec.Sarsi.Rust as Rust+import qualified Codec.Sarsi.SBT as SBT+import qualified Data.Text as Text++traceHS :: Handle -> IO ()+traceHS = traceParser GHC.messageParser++traceRS :: Handle -> IO ()+traceRS = traceParser Rust.messageParser++traceSBT :: Handle -> IO ()+traceSBT = traceParser SBT.eventParser++traceParser :: Show a => Parser a -> Handle -> IO ()+traceParser parser h = do+ runT_ $ printer <~ streamParser parser <~ appendCR <~ sourceHandle byLine h+ where+ appendCR = auto $ (`Text.snoc` '\n')++
− src/Sarsi/Trace.hs
@@ -1,25 +0,0 @@-module Sarsi.Trace where--import Data.Machine ((<~), auto, runT_)-import Data.Attoparsec.Text (Parser)-import Data.Attoparsec.Text.Machine (streamParser)-import System.IO (Handle)-import System.IO.Machine (byLine, printer, sourceHandle)--import qualified Codec.GHC.Log as GHC-import qualified Codec.Sarsi.SBT as SBT-import qualified Data.Text as Text--traceHS :: Handle -> IO ()-traceHS = traceParser GHC.messageParser--traceSBT :: Handle -> IO ()-traceSBT = traceParser SBT.eventParser--traceParser :: Show a => Parser a -> Handle -> IO ()-traceParser parser h = do- runT_ $ printer <~ streamParser parser <~ appendCR <~ sourceHandle byLine h- where- appendCR = auto $ (`Text.snoc` '\n')--