diff --git a/sarsi-nvim/Main.hs b/sarsi-nvim/Main.hs --- a/sarsi-nvim/Main.hs +++ b/sarsi-nvim/Main.hs @@ -1,7 +1,7 @@ module Main where import Codec.Sarsi (Event(..), Level(..), Location(..), Message(..)) -import Data.Machine (ProcessT, (<~), asParts, auto, final, scan, sinkPart_, runT) +import Data.Machine (ProcessT, (<~), asParts, final, scan, sinkPart_, runT) import Data.MessagePack.Object (Object(..), toObject) import NVIM.Client (Command(..), runCommand) import Sarsi (getBroker, getTopic, title) diff --git a/sarsi-sbt/Main.hs b/sarsi-sbt/Main.hs --- a/sarsi-sbt/Main.hs +++ b/sarsi-sbt/Main.hs @@ -11,7 +11,7 @@ import System.Process (StdStream(..), shell, std_in, std_out) import System.Process.Machine (ProcessMachines, callProcessMachines) import System.IO (BufferMode(NoBuffering), hSetBuffering, stdin, stdout) -import System.IO.Machine (IOSink, byChunk) +import System.IO.Machine (byChunk) import qualified Data.List as List import qualified Data.Text.IO as TextIO diff --git a/sarsi-vi/Main.hs b/sarsi-vi/Main.hs new file mode 100644 --- /dev/null +++ b/sarsi-vi/Main.hs @@ -0,0 +1,70 @@ +module Main where + +import Data.Machine (ProcessT, (<~), asParts, final, scan, sinkPart_, runT) +import Codec.Sarsi (Event(..), Message(..), Level(..), Location(..)) +import Control.Concurrent.MVar (MVar, newMVar, readMVar, swapMVar) +import Data.Text (Text, pack) +import Data.Text.IO (hPutStrLn) +import Sarsi (Topic(..), getBroker, getTopic) +import Sarsi.Consumer (consumeOrWait) +import System.IO (Handle, IOMode(WriteMode), hClose, hFlush, openFile) +import System.IO.Machine (sinkIO) + +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 + +title :: String +title = concat [Sarsi.title, "-vi"] + +-- :set efm=%f:%l:%c:%t\ %m +toVi :: Message -> Text +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 + tpe Error = pack "e" + tpe Warning = pack "w" + +data Action = Append | Replace deriving Show +data LogEvent = LogEvent Action Text deriving Show + +data Command = Throw LogEvent | Echo String + +convert :: Bool -> Event -> (Bool, [Command]) +convert first (Notify msg@(Message loc lvl _)) = (False, [Throw e, Echo $ concat [show loc, " ", show lvl]]) + where + e = LogEvent mode $ toVi msg + mode = if first then Replace else Append +convert _ e = (True, [Echo $show e]) + +converter :: Bool -> ProcessT IO Event (Bool, [Command]) +converter first = scan f (first, []) where f (first', _) event = convert first' event + +dump :: FilePath -> Maybe Handle -> Command -> IO (Maybe Handle) +dump _ h (Echo txt) = (putStrLn $ concat [title, ": ", txt]) >> return h +dump fp Nothing e = openFile fp WriteMode >>= \h -> dump fp (Just h) e +dump _ (Just h) (Throw (LogEvent Append txt)) = fmap (const $ Just h) $ (hPutStrLn h txt >> hFlush h) +dump fp (Just h) (Throw (LogEvent Replace txt)) = hClose h >> dump fp Nothing (Throw $ LogEvent Append txt) + +writer :: FilePath -> MVar (Maybe Handle) -> Command -> IO () +writer tp var c = do + h <- readMVar var + h' <- dump fp h c + _ <- swapMVar var h' + return () + where fp = tp ++ ".vi" + +main :: IO () +main = do + b <- getBroker + t <- getTopic b "." + var <- newMVar Nothing + consumeOrWait t $ consumer t var + where + consumer (Topic _ tp) var first src = do + res <- runT $ final <~ sinkPart_ id ((sinkIO $ writer tp var) <~ asParts) <~ converter (maybe True id first) <~ src + return $ Left $ head res diff --git a/sarsi.cabal b/sarsi.cabal --- a/sarsi.cabal +++ b/sarsi.cabal @@ -1,5 +1,5 @@ name: sarsi -version: 0.0.2.0 +version: 0.0.3.0 synopsis: A universal quickfix toolkit and his protocol. description: @@ -61,17 +61,16 @@ build-depends: base , Cabal - , sarsi == 0.0.2.0 + , sarsi == 0.0.3.0 hs-source-dirs: sarsi ghc-options: -Wall -threaded default-language: Haskell2010 - executable sarsi-hs main-is: Main.hs build-depends: base - , sarsi == 0.0.2.0 + , sarsi == 0.0.3.0 , machines , machines-io , machines-process @@ -93,7 +92,7 @@ -- NVIM.Info build-depends: base - , sarsi == 0.0.2.0 + , sarsi == 0.0.3.0 , machines , binary , bytestring @@ -116,12 +115,27 @@ other-modules: build-depends: base - , sarsi == 0.0.2.0 + , sarsi == 0.0.3.0 , machines , machines-io , machines-process , process , text hs-source-dirs: sarsi-sbt + ghc-options: -Wall -dynamic -threaded + default-language: Haskell2010 + +executable sarsi-vi + main-is: Main.hs + build-depends: + base + , sarsi == 0.0.3.0 + , directory + , filepath + , machines + , machines-io + , text + , vector + hs-source-dirs: sarsi-vi ghc-options: -Wall -dynamic -threaded default-language: Haskell2010 diff --git a/src/Codec/Sarsi.hs b/src/Codec/Sarsi.hs --- a/src/Codec/Sarsi.hs +++ b/src/Codec/Sarsi.hs @@ -18,8 +18,8 @@ show (Start lbl) = concat ["starting ", unpack lbl, " build"] show (Finish 0 0) = "build success" show (Finish 0 w) = concat ["build success with ", show w, " warning(s)"] - show (Finish e 0) = concat ["build fail with ", show e, " error(s)"] - show (Finish e w) = concat ["build fail with ", show e, " error(s) and ", show w, " warning(s)"] + show (Finish e 0) = concat ["build failure with ", show e, " error(s)"] + show (Finish e w) = concat ["build failure with ", show e, " error(s) and ", show w, " warning(s)"] show (Notify msg) = concat ["message=", show msg] getEvent :: Get Event diff --git a/src/Sarsi/Consumer.hs b/src/Sarsi/Consumer.hs --- a/src/Sarsi/Consumer.hs +++ b/src/Sarsi/Consumer.hs @@ -5,12 +5,12 @@ import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar) import Control.Exception (IOException, bracket, try) import Data.Binary.Machine (processGet) -import Data.Machine ((<~), auto, asParts, runT_) +import Data.Machine ((<~), auto, asParts) import Network.Socket (connect, socketToHandle) import Sarsi (Broker(..), Topic(..), createSocket, getSockAddr) import System.FSNotify (eventPath, watchDir, withManager) import System.IO (IOMode(ReadMode), hClose, hWaitForInput) -import System.IO.Machine (IOSink, IOSource, byChunkOf, sourceHandle) +import System.IO.Machine (IOSource, byChunkOf, sourceHandle) consumeOrWait :: Topic -> (Maybe s -> IOSource Event -> IO (Either s a)) -> IO a consumeOrWait topic@(Topic (Broker bp) tp) f = do @@ -24,10 +24,6 @@ stop consumeOrWait topic f pred' e = eventPath e == tp - -consumeOrWait_ :: Topic -> IOSink Event -> IO a -consumeOrWait_ topic@(Topic _ _) sink = - consumeOrWait topic f where f _ src = fmap (const $ Left ()) $ runT_ $ sink <~ src consume :: Topic -> (Maybe s -> IOSource Event -> IO (Either s a)) -> IO (Either IOException a) consume topic f = try $ consume' topic f