diff --git a/exe/srs.hs b/exe/srs.hs
new file mode 100644
--- /dev/null
+++ b/exe/srs.hs
@@ -0,0 +1,48 @@
+module Main where
+
+import Control.Concurrent.Async (async, wait)
+import qualified Data.ByteString as ByteString
+import qualified Data.List as List
+import Data.Machine (Y (Z), auto, autoM, awaits, repeatedly, runT_, wye, yield, (<~))
+import Sarsi.Processor (processAny)
+import Sarsi.Tools.Pipe (pipeFrom)
+import System.Environment (getArgs)
+import System.Exit (exitWith)
+import System.IO (stderr, stdout)
+import System.IO.Machine (byLine, sinkHandleWith, sourceHandle, sourceHandleWith)
+import System.Process
+
+main :: IO ()
+main = do
+  args <- getArgs
+  (dispatchErrRead, dispatchErrWrite) <- createPipe
+  (dispatchOutRead, dispatchOutWrite) <- createPipe
+  (Nothing, Just hout, Just herr, hprocess) <- createProcess $ cp (concat $ List.intersperse " " args)
+  conveyorErr <- conveyorRun stderr herr dispatchErrWrite
+  conveyorOut <- conveyorRun stdout hout dispatchOutWrite
+  let sourceErr = sourceHandle byLine dispatchErrRead
+  let sourceOut = sourceHandle byLine dispatchOutRead
+  let process = processAny
+  worker <- async $ pipeFrom "any" process $ (auto merge) <~ wye sourceErr sourceOut slurp
+  wait conveyorErr
+  wait conveyorOut
+  wait worker
+  ec <- waitForProcess hprocess
+  exitWith ec
+  where
+    cp cmd =
+      (proc "script" ["-qec", cmd, "/dev/null"])
+        { delegate_ctlc = True,
+          std_in = Inherit,
+          std_out = CreatePipe,
+          std_err = CreatePipe
+        }
+    conveyorRun hOutput hInput hDispatchWrite =
+      async . runT_ $
+        (sinkHandleWith ByteString.hPut hOutput) <~ autoM (\xs -> ByteString.hPut hDispatchWrite xs >> return xs)
+          <~ (sourceHandleWith (\h -> ByteString.hGetNonBlocking h 1) hInput)
+    merge (Right x) = x
+    merge (Left x) = x
+    slurp = repeatedly $ do
+      res <- awaits Z
+      yield res
diff --git a/sarsi-hs/Main.hs b/sarsi-hs/Main.hs
deleted file mode 100644
--- a/sarsi-hs/Main.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-{-# LANGUAGE Rank2Types #-}
-module Main where
-
-import Codec.GHC.Log (messageParser)
-import Codec.Sarsi.GHC (fromGHCLog)
-import Data.Attoparsec.Text.Machine (streamParser)
-import Data.Machine ((<~), asParts, auto)
-import Sarsi.Tools.Shell (mainShell)
-
-main :: IO ()
-main = mainShell "haskell" (asParts <~ auto unpack <~ streamParser messageParser)
-  where
-    unpack (Right msg) = [fromGHCLog msg]
-    unpack (Left _)    = []
diff --git a/sarsi-nvim/Data/MessagePack/RPC.hs b/sarsi-nvim/Data/MessagePack/RPC.hs
--- a/sarsi-nvim/Data/MessagePack/RPC.hs
+++ b/sarsi-nvim/Data/MessagePack/RPC.hs
@@ -1,28 +1,28 @@
 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 qualified Data.MessagePack as MP
+import qualified Data.Vector as Vector
 
 data Answer = Success Object | Error Object
   deriving Show
 
 data Request = Request
-  { requestMessageID  :: Int64
+  { requestMessageID  :: Int
   , requestMethod     :: Text
   , requestParams     :: [Object] }
   deriving Show
 
 putRequest :: Request -> Put
 putRequest (Request msgID method params) =
-  MP.putArray id [MP.putInt 0, MP.putInt msgID, MP.putStr method, MP.putArray put params]
+  MP.putArray id $ Vector.fromList [MP.putInt 0, MP.putInt msgID, MP.putStr method, MP.putArray put $ Vector.fromList params]
 
 data Message
   = Response
-    { responseMessageID :: Int64
+    { responseMessageID :: Int
     , responseAnswer    :: Answer }
   | Notification
     { notificationMethod :: Text
@@ -45,5 +45,5 @@
     2 -> do
       method <- MP.getStr
       (ObjectArray params) <- get
-      return $ Notification method params
+      return $ Notification method (Vector.toList params)
     _ -> fail "unsupported message type"
diff --git a/sarsi-nvim/Main.hs b/sarsi-nvim/Main.hs
--- a/sarsi-nvim/Main.hs
+++ b/sarsi-nvim/Main.hs
@@ -1,62 +1,297 @@
 module Main where
 
-import Codec.Sarsi (Event(..), Level(..), Location(..), Message(..))
-import Data.Machine (ProcessT, (<~), asParts, final, scan, sinkPart_, runT)
-import Data.MessagePack.Object (Object(..))
-import NVIM.Client (Command(..), runCommand)
-import Sarsi (getBroker, getTopic, title)
+import Codec.Sarsi (Event (..), Level (..), Location (..), Message (..))
+import Control.Concurrent.Async (async, cancel)
+import Control.Concurrent.STM (atomically)
+import Control.Concurrent.STM.TBQueue (newTBQueue, readTBQueue)
+import Control.Concurrent.STM.TVar (TVar, modifyTVar', newTVar, readTVar, readTVarIO, stateTVar, writeTVar)
+import Control.Monad (when)
+import Data.Machine (ProcessT, asParts, auto, autoM, final, runT, runT_, scan, sinkPart_, (<~))
+import Data.Machine.Fanout (fanout)
+import Data.MessagePack (Object (..))
+import qualified Data.MessagePack.RPC as RPC
+import Data.Text (Text)
+import qualified Data.Text as Text
+import Data.Vector (Vector)
+import qualified Data.Vector as Vector
+import NVIM.Client (CommandQueue, ask', mkConnection, send)
+import NVIM.Command (Command (..))
+import NVIM.QuickFix (toQuickFix)
+import Sarsi (Topic (..), getBroker, getTopic, title)
 import Sarsi.Consumer (consumeOrWait)
-import System.IO (BufferMode(NoBuffering), hSetBuffering, stdin, stdout)
-import System.IO.Machine (sinkIO)
+import System.Environment (getArgs)
+import System.Exit (ExitCode (..), exitWith)
+import System.IO (Handle, IOMode (WriteMode))
+import qualified System.IO as IO
+import System.IO.Machine (sinkIO, sourceIO)
 
-import qualified Data.Text as Text
+data BuildStatus = Starting | Building | Done
+  deriving (Show, Eq)
 
+data PluginAction = Focus | Next | Previous
+  deriving (Bounded, Show, Enum, Eq, Ord, Read)
+
+pluginActions :: [PluginAction]
+pluginActions = [minBound ..]
+
+data PluginState = PluginState
+  { buildStatus :: BuildStatus,
+    buildErrors :: Vector (Location, [Text]),
+    buildWarnings :: Vector (Location, [Text]),
+    focus :: Maybe (Level, Int),
+    buffer :: Object,
+    window :: Maybe Object
+  }
+  deriving (Show)
+
 echo :: String -> Command
-echo str = VimCommand [ObjectStr . Text.pack $ concat ["echo \"", str, "\""]]
+echo str = NvimCommand [ObjectStr . Text.pack $ concat ["echo \"", str, "\""]]
 
 echom :: String -> Command
-echom str = VimCommand [ObjectStr . Text.pack $ concat ["echom \"", title, ": ", str, "\""]]
+echom str = NvimCommand [ObjectStr . Text.pack $ concat ["echom \"", title, ": ", str, "\""]]
 
-setqflist :: String -> [Object] -> Command
-setqflist action items = VimCallFunction (Text.pack "setqflist") [ObjectArray items, ObjectStr $ Text.pack action]
+jumpTo :: Location -> [Command]
+jumpTo loc =
+  (\x -> NvimCommand [ObjectStr . Text.pack $ x])
+    <$> [ concat ["drop +", show $ line loc, " ", Text.unpack $ filePath loc],
+          concat ["call cursor(", show $ line loc, ", ", show $ column loc, ")"],
+          "normal zz"
+        ]
 
-setqflistEmpty :: Command
-setqflistEmpty = setqflist "r" []
+openLogFile :: Topic -> IO Handle
+openLogFile (Topic _ fp) = IO.openFile (concat [fp, "-nvim.log"]) WriteMode
 
--- TODO Sanitize text description by escaping special characters
-mkQuickFix :: Message -> Object
-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"
+parseAction :: (Text, [Object]) -> PluginAction
+parseAction (m, _) = read $ Text.unpack m
 
-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 i == 0 then "r" else "a") [mkQuickFix msg]
-    , echo $ concat [show loc, " ", show lvl] ]
+parseArgs :: [String] -> Either String Bool
+parseArgs [] = Right False
+parseArgs ["--log"] = Right True
+parseArgs _ = Left "usage: [--log]"
 
+pluginStateInit :: Object -> PluginState
+pluginStateInit b = PluginState Done Vector.empty Vector.empty Nothing b Nothing
+
+putLogLn :: Maybe Handle -> String -> IO ()
+putLogLn Nothing _ = return ()
+putLogLn (Just h) s = IO.hPutStrLn h s >> IO.hFlush h
+
+registerActions :: [Command]
+registerActions =
+  (\x -> NvimCommand [ObjectStr . Text.pack $ concat ["command! Sarsi", x, " call rpcnotify(g:sarsi, '", x, "')"]])
+    <$> show
+    <$> pluginActions
+
+update :: Monoid a => Maybe Handle -> CommandQueue -> TVar PluginState -> Event -> IO a
+update h q s' e = do
+  display e
+  case e of
+    (Start _) -> updateState (\s -> s {buildStatus = Starting})
+    (Finish _ _) -> do
+      emptyErrors <-
+        atomically $
+          stateTVar
+            s'
+            ( \s -> case buildStatus s of
+                Building -> (Vector.null $ buildErrors s, s {buildStatus = Done})
+                _ -> (True, s {buildStatus = Done, buildErrors = Vector.empty, buildWarnings = Vector.empty})
+            )
+      -- TODO Do auto-focus (only if users did not focus since Building)
+      when emptyErrors $ windowClose q s'
+    (Notify msg) ->
+      updateState
+        ( \s ->
+            if buildStatus s /= Building
+              then s {buildStatus = Building, focus = Nothing, buildErrors = Vector.empty, buildWarnings = Vector.empty}
+              else s
+        )
+        >> updateMsg msg
+  trace h
+  return mempty
+  where
+    display (Start _) = nvim_ h q $ echom $ show e
+    display (Finish _ _) = nvim_ h q $ echom $ show e
+    display (Notify (Message loc lvl _)) = nvim_ h q $ echo $ concat [show loc, " ", show lvl]
+    trace Nothing = return ()
+    trace _ = do
+      s <- readTVarIO s'
+      putLogLn h $ show s
+    updateMsg msg = atomically $ modifyTVar' s' (f msg)
+      where
+        f x s = g x
+          where
+            g (Message loc Error txts) = s {buildErrors = Vector.snoc es (loc, txts)}
+            g (Message loc Warning txts) = s {buildWarnings = Vector.snoc ws (loc, txts)}
+            (es, ws) = case buildStatus s of
+              Starting -> (Vector.empty, Vector.empty)
+              _ -> (buildErrors s, buildWarnings s)
+    updateState f = atomically $ modifyTVar' s' f
+
+-- TODO Wrap this in an appropriate transformer
+nvim :: Maybe Handle -> CommandQueue -> Command -> IO (Maybe Object)
+nvim hLog q cmd = do
+  r <- ask' q cmd
+  case r of
+    RPC.Success a -> return $ Just a
+    RPC.Error err -> do
+      putLogLn hLog $ show err
+      return Nothing
+
+nvim_ :: Maybe Handle -> CommandQueue -> Command -> IO ()
+nvim_ h q c = nvim h q c >> return ()
+
+-- TODO NEW STUFF, move above
+-- TODO Important: could they all be into STM? how to avoid unnecessary readTVarIO?
+-- There must be a useful `Async + STM` atomic layer
+
+bufferSetLines :: CommandQueue -> TVar PluginState -> [Text] -> IO ()
+bufferSetLines q s' txts = do
+  s <- readTVarIO s'
+  let b = buffer s
+  (RPC.Success _) <- ask' q $ NvimBufSetLines b 0 64 False txts
+  return ()
+
+windowClose :: CommandQueue -> TVar PluginState -> IO ()
+windowClose q s' = do
+  s <- readTVarIO s'
+  case window s of
+    Nothing -> return ()
+    Just w -> do
+      -- Tolerate failure if window was closed manually by user
+      _ <- ask' q $ NvimWinClose w False
+      atomically . modifyTVar' s' $ \x -> x {window = Nothing}
+      return ()
+
+bufferShow :: CommandQueue -> TVar PluginState -> Int -> IO ()
+bufferShow q s' height = do
+  windowClose q s'
+  (RPC.Success (ObjectInt rows)) <- ask' q (NvimWinGetHeight $ ObjectInt 0)
+  (RPC.Success (ObjectInt cols)) <- ask' q (NvimWinGetWidth $ ObjectInt 0)
+  s <- readTVarIO s'
+  (RPC.Success w) <- ask' q $ openWin (buffer s) rows cols
+  atomically . modifyTVar' s' $ \x -> x {window = Just w}
+  return ()
+  where
+    openWin b rows cols =
+      NvimOpenWin
+        b
+        False
+        ( ObjectMap $
+            ( Vector.fromList
+                [ (ObjectStr $ Text.pack "style", ObjectStr $ Text.pack "minimal"),
+                  (ObjectStr $ Text.pack "relative", ObjectStr $ Text.pack "win"),
+                  (ObjectStr $ Text.pack "row", ObjectInt $ rows - height),
+                  (ObjectStr $ Text.pack "col", ObjectInt 0),
+                  (ObjectStr $ Text.pack "width", ObjectInt cols),
+                  (ObjectStr $ Text.pack "height", ObjectInt height)
+                ]
+            )
+        )
+
+actionFocus :: Maybe Handle -> CommandQueue -> TVar PluginState -> Level -> Int -> IO ()
+actionFocus hLog q s' lvl rank = do
+  s <- readTVarIO s'
+  let (loc, txts) = focusContent lvl rank s
+  _ <- traverse (nvim_ hLog q) $ jumpTo loc
+  bufferSetLines q s' txts
+  bufferShow q s' $ length txts
+  return ()
+
+actionMove :: Maybe Handle -> CommandQueue -> TVar PluginState -> (PluginState -> PluginState) -> IO ()
+actionMove hLog q s' f = do
+  fcs <-
+    atomically $ do
+      s <- readTVar s'
+      let s'' = f s
+      writeTVar s' s''
+      return $ focus s''
+  case fcs of
+    Nothing -> return ()
+    Just (lvl, rank) -> actionFocus hLog q s' lvl rank
+
+focusContent :: Level -> Int -> PluginState -> (Location, [Text])
+focusContent lvl rank s = Vector.unsafeIndex xs rank
+  where
+    xs = case lvl of
+      Warning -> buildWarnings s
+      Error -> buildErrors s
+
+focusDefault :: PluginState -> Maybe (Level, Int)
+focusDefault s = select (Vector.null $ buildErrors s) (Vector.null $ buildWarnings s)
+  where
+    select False _ = Just (Error, 0)
+    select True False = Just (Warning, 0)
+    select True True = Nothing
+
+focusMove :: Int -> PluginState -> PluginState
+focusMove i s =
+  case focus s of
+    Nothing -> s {focus = focusDefault s}
+    Just (lvl, rank) -> s {focus = Just $ f lvl (rank + i)}
+  where
+    f lvl rank | rank < 0 = f (toggle lvl) ((Vector.length $ select lvl) + rank)
+    f lvl rank | rank >= (Vector.length $ select lvl) = f (toggle lvl) (rank - (Vector.length $ select lvl))
+    f lvl rank = (lvl, rank)
+    toggle lvl | Vector.null $ select (toggle' lvl) = lvl
+    toggle lvl = toggle' lvl
+    toggle' Warning = Error
+    toggle' Error = Warning
+    select Warning = buildWarnings s
+    select Error = buildErrors s
+
+-- TODO How to make it shudown gracefully? currently it's probably killed by nvim while blocking in `consumerOrWait`
 main :: IO ()
 main = do
-  hSetBuffering stdin NoBuffering
-  hSetBuffering stdout NoBuffering
-  b     <- getBroker
-  t     <- getTopic b "."
-  consumeOrWait t consumer
-    where
-      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 ()
+  args <- getArgs
+  case parseArgs args of
+    Left err -> do
+      putStrLn err
+      exitWith $ ExitFailure 1
+    Right logging -> do
+      IO.hSetBuffering IO.stdin IO.NoBuffering
+      IO.hSetBuffering IO.stdout IO.NoBuffering
+      b <- getBroker
+      t <- getTopic b "."
+      hLog <- if logging then Just <$> (openLogFile t) else return Nothing
+      qCmds <- atomically $ newTBQueue 8
+      qNotifs <- atomically $ newTBQueue 8
+      connClose <- mkConnection IO.stdin IO.stdout qCmds qNotifs (errHandler hLog)
+      (Just buf) <- nvim hLog qCmds $ NvimCreateBuf False True
+      state <- atomically $ newTVar $ pluginStateInit buf
+      notifier <-
+        async . runT_ $
+          autoM (notify hLog qCmds state) <~ (auto parseAction) <~ (sourceIO . atomically $ readTBQueue qNotifs)
+      _ <- traverse (nvim_ hLog qCmds) registerActions
+      putLogLn hLog "ready"
+      _ <- consumeOrWait t (consumer hLog state qCmds)
+      cancel notifier
+      connClose
+      _ <- traverse IO.hClose hLog
+      return ()
+  where
+    errHandler hLog err = do
+      putLogLn hLog $ show err
+    notify hLog q s' Focus = do
+      s <- readTVarIO s'
+      case focus s of
+        Nothing ->
+          case focusDefault s of
+            Nothing -> nvim_ hLog q $ echom "nothing to fix"
+            Just (lvl, rank) -> do
+              atomically . modifyTVar' s' $ \x -> x {focus = Just (lvl, rank)}
+              actionFocus hLog q s' lvl rank
+        Just (lvl, rank) -> actionFocus hLog q s' lvl rank
+    notify hLog q s' Next = actionMove hLog q s' (focusMove 1)
+    notify hLog q s' Previous = actionMove hLog q s' (focusMove (-1))
+    consumer h s q Nothing src = consumer h s q (Just 0) src
+    consumer h s q (Just i) src = do
+      i' <- runT $ final <~ asParts <~ fanout [quickFixes, pluginUpdate] <~ src
+      return (Left $ head i')
+      where
+        quickFixes = auto (\x -> [x]) <~ sinkPart_ id (sinkIO (send q) <~ asParts) <~ toQuickFixes i
+        pluginUpdate = autoM (update h q s)
+
+    toQuickFixes :: Int -> ProcessT IO Event (Int, [Command])
+    toQuickFixes acc = scan f (acc, [])
+      where
+        f (i, _) event = toQuickFix i event
diff --git a/sarsi-nvim/NVIM/Client.hs b/sarsi-nvim/NVIM/Client.hs
--- a/sarsi-nvim/NVIM/Client.hs
+++ b/sarsi-nvim/NVIM/Client.hs
@@ -1,35 +1,81 @@
 module NVIM.Client where
 
--- | A primitive NVIM RPC synchronous client.
-
-import Data.Binary.Machine (streamGet)
+import Control.Concurrent.Async (Async, async, wait)
+import Control.Concurrent.STM (STM, atomically)
+import Control.Concurrent.STM.TBQueue (TBQueue, readTBQueue, writeTBQueue)
+import Control.Concurrent.STM.TMVar (newEmptyTMVarIO, putTMVar, takeTMVar)
+import Control.Concurrent.STM.TVar (modifyTVar', newTVar, stateTVar)
+import Data.Binary.Machine (DecodingError (..), processPut, streamGet)
 import Data.Binary.Put (runPut)
 import Data.ByteString (hGetSome, hPut)
 import Data.ByteString.Lazy (toStrict)
-import Data.Machine ((<~), asParts, auto, final, run, source)
-import Data.MessagePack.Object (Object(..))
-import Data.MessagePack.RPC (Answer(..), Request(..), Message(..), getMessage, putRequest)
+import Data.Machine (autoM, final, run, runT_, source, (<~))
+import qualified Data.Map as Map
+import Data.MessagePack (Object (..))
+import Data.MessagePack.RPC (Answer (..), Message (..), getMessage, putRequest)
 import Data.Text (Text)
-import System.IO (Handle, stdin, stdout)
 import qualified Data.Text as Text
+import NVIM.Command (Command (..), mkRequest)
+import System.IO (Handle, stdin, stdout)
+import System.IO.Machine (byChunk, sinkHandle, sourceHandle, sourceIO)
 
-data Command = VimCommand [Object] | VimCallFunction Text [Object]
+-- TODO Extract a generic asynchronous RPC client
+-- need to write a proper scheduler first to support timeout on transaction
+-- type JobQueue a = TBQueue (IO a, Maybe a -> STM (), UTCTime)
+-- type CommandQueue = TBQueue (Command, Maybe Answer -> STM (), Duration)
 
+-- Asynchronous client
+type CommandQueue = TBQueue (Command, Answer -> STM ())
+
+ask :: CommandQueue -> Command -> IO (Async Answer)
+ask q cmd = do
+  answer <- newEmptyTMVarIO
+  atomically $ writeTBQueue q (cmd, putTMVar answer)
+  async $ atomically $ takeTMVar answer
+
+ask' :: CommandQueue -> Command -> IO Answer
+ask' q c = wait =<< ask q c
+
+send :: CommandQueue -> Command -> IO ()
+send q c = atomically $ writeTBQueue q (c, \_ -> return ())
+
+mkConnection :: Handle -> Handle -> CommandQueue -> TBQueue (Text, [Object]) -> (DecodingError -> IO ()) -> IO (IO ())
+mkConnection hIn hOut qCommands qNotifs errHandler = do
+  nonce <- atomically $ newTVar 0
+  runnings <- atomically $ newTVar Map.empty
+  sender <- async . runT_ $ outbound nonce qCommands runnings
+  receiver <- async . runT_ $ inbound runnings
+  return $ wait sender >> wait receiver
+  where
+    outbound nonce q rs =
+      sinkHandle byChunk hOut <~ processPut putRequest
+        <~ autoM (publish rs nonce)
+        <~ (sourceIO . atomically $ readTBQueue q)
+    inbound rs = autoM (dispatch rs) <~ streamGet getMessage <~ sourceHandle byChunk hIn
+    dispatch rs (Right (Response msgId a)) = do
+      cb <- atomically $ stateTVar rs (\rs' -> (Map.lookup msgId rs', Map.delete msgId rs'))
+      case cb of
+        Just cb' -> atomically $ cb' a
+        Nothing -> return ()
+    dispatch _ (Right ((Notification m ps))) = do
+      atomically $ writeTBQueue qNotifs (m, ps)
+    dispatch _ (Left err) = errHandler err
+    publish rs nonce (cmd, callback) = do
+      msgId <- atomically $ stateTVar nonce (\n -> (n, n + 1))
+      atomically $ modifyTVar' rs (\rs' -> Map.insert msgId callback rs')
+      return $ mkRequest msgId cmd
+
+-- Helpers to run a command synchronously
 runCommand :: Command -> IO Answer
 runCommand = runCommandWith stdin stdout
 
 runCommandWith :: Handle -> Handle -> Command -> IO Answer
 runCommandWith hIn hOut cmd = do
-  hPut hOut $ toStrict $ runPut $ putRequest $ mkRequest cmd
+  hPut hOut $ toStrict $ runPut $ putRequest $ mkRequest 0 cmd
   xs <- hGetSome hIn 1024
-  let ys = run $ final <~ asParts <~ auto unpack <~ streamGet getMessage <~ source [xs]
+  let ys = run $ final <~ streamGet getMessage <~ source [xs]
   return $ mkAnswer $ ys
-    where
-      mkAnswer [a] = a
-      mkAnswer _   = Error $ ObjectStr $ Text.pack "No RPC answer received."
-      mkRequest (VimCommand xs) =
-        Request 0 (Text.pack "vim_command") xs
-      mkRequest (VimCallFunction m xs) =
-        Request 0 (Text.pack "vim_call_function") [ ObjectStr m, ObjectArray xs ]
-      unpack (Right (Response _ a)) = [a]
-      unpack _                      = []
+  where
+    mkAnswer [(Right (Response _ a))] = a
+    mkAnswer [(Left (DecodingError _ err))] = Error . ObjectStr $ Text.pack err
+    mkAnswer _ = Error $ ObjectStr $ Text.pack "No RPC answer received."
diff --git a/sarsi-nvim/NVIM/Command.hs b/sarsi-nvim/NVIM/Command.hs
new file mode 100644
--- /dev/null
+++ b/sarsi-nvim/NVIM/Command.hs
@@ -0,0 +1,40 @@
+module NVIM.Command where
+
+import Data.MessagePack (Object (..))
+import Data.MessagePack.RPC (Request (..))
+import Data.Text (Text)
+import qualified Data.Text as Text
+import qualified Data.Vector as Vector
+
+-- TODO Support special types (with newtype over Object) for Buffer, Window, Tabpage (EXT 0, 1, 2)
+-- see https://neovim.io/doc/user/api.html
+data Command
+  = NvimBufSetLines Object Int Int Bool [Text]
+  | NvimCommand [Object]
+  | NvimCallFunction Text [Object]
+  | NvimCreateBuf Bool Bool -- {listed} {scratch}
+  | NvimOpenWin Object Bool Object
+  | NvimWinClose Object Bool
+  | NvimWinGetBuf Object
+  | NvimWinGetHeight Object
+  | NvimWinGetWidth Object
+
+mkRequest :: Int -> Command -> Request
+mkRequest msgId (NvimBufSetLines b s e strict xs) =
+  Request msgId (Text.pack "nvim_buf_set_lines") [b, ObjectInt s, ObjectInt e, ObjectBool strict, ObjectArray (Vector.fromList (ObjectStr <$> xs))]
+mkRequest msgId (NvimCommand xs) =
+  Request msgId (Text.pack "nvim_command") xs
+mkRequest msgId (NvimCallFunction m xs) =
+  Request msgId (Text.pack "nvim_call_function") [ObjectStr m, ObjectArray (Vector.fromList xs)]
+mkRequest msgId (NvimCreateBuf l s) =
+  Request msgId (Text.pack "nvim_create_buf") [ObjectBool l, ObjectBool s]
+mkRequest msgId (NvimOpenWin b e cfg) =
+  Request msgId (Text.pack "nvim_open_win") [b, ObjectBool e, cfg]
+mkRequest msgId (NvimWinClose w force) =
+  Request msgId (Text.pack "nvim_win_close") [w, ObjectBool force]
+mkRequest msgId (NvimWinGetBuf w) =
+  Request msgId (Text.pack "nvim_win_get_buf") [w]
+mkRequest msgId (NvimWinGetHeight w) =
+  Request msgId (Text.pack "nvim_win_get_height") [w]
+mkRequest msgId (NvimWinGetWidth w) =
+  Request msgId (Text.pack "nvim_win_get_width") [w]
diff --git a/sarsi-nvim/NVIM/QuickFix.hs b/sarsi-nvim/NVIM/QuickFix.hs
new file mode 100644
--- /dev/null
+++ b/sarsi-nvim/NVIM/QuickFix.hs
@@ -0,0 +1,39 @@
+module NVIM.QuickFix where
+
+import Codec.Sarsi (Event (..), Level (..), Location (..), Message (..))
+import Data.MessagePack (Object (..))
+import qualified Data.Text as Text
+import qualified Data.Vector as Vector
+import NVIM.Command (Command (NvimCallFunction))
+
+toQuickFix :: Int -> Event -> (Int, [Command])
+toQuickFix _ (Start _) = (0, [])
+toQuickFix i (Finish _ _) = (0, (if i == 0 then [setqflistEmpty] else []))
+toQuickFix i (Notify msg@(Message _ _ _)) = (i + 1, [setqflist (if i == 0 then "r" else "a") [mkQuickFix msg]])
+
+-- TODO Sanitize text description by escaping special characters
+mkQuickFix :: Message -> Object
+mkQuickFix (Message (Location fp col ln) lvl txts) =
+  ObjectMap $
+    ( Vector.fromList
+        [ (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"
+
+setqflist :: String -> [Object] -> Command
+setqflist action items =
+  NvimCallFunction
+    (Text.pack "setqflist")
+    [ ObjectArray (Vector.fromList items),
+      ObjectStr $ Text.pack action
+    ]
+
+setqflistEmpty :: Command
+setqflistEmpty = setqflist "r" []
diff --git a/sarsi-rs/Main.hs b/sarsi-rs/Main.hs
deleted file mode 100644
--- a/sarsi-rs/Main.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-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 _)    = []
diff --git a/sarsi-sbt/Main.hs b/sarsi-sbt/Main.hs
--- a/sarsi-sbt/Main.hs
+++ b/sarsi-sbt/Main.hs
@@ -1,45 +1,45 @@
 {-# LANGUAGE Rank2Types #-}
+
 module Main where
 
 import Codec.Sarsi (Event)
 import Codec.Sarsi.SBT.Machine (eventProcess)
-import Data.Machine (ProcessT, (<~), autoM, runT_)
+import qualified Data.List as List
+import Data.Machine (ProcessT, autoM, runT_, (<~))
+import qualified Data.Text.IO as TextIO
 import Sarsi (getBroker, getTopic)
+import qualified Sarsi as Sarsi
 import Sarsi.Producer (produce)
 import System.Environment (getArgs)
 import System.Exit (ExitCode, exitWith)
-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 (BufferMode (NoBuffering), hSetBuffering, stdin, stdout)
 import System.IO.Machine (byChunk)
-
-import qualified Data.List as List
-import qualified Data.Text.IO as TextIO
-import qualified Sarsi as Sarsi
+import System.Process (StdStream (..), shell, std_in, std_out)
+import System.Process.Machine (ProcessMachines, callProcessMachines)
 
 title :: String
 title = concat [Sarsi.title, "-sbt"]
 
 -- TODO Contribute to machines-process
 mStdOut_ :: ProcessT IO a b -> ProcessMachines a a0 k0 -> IO ()
-mStdOut_ mp (_, Just stdOut, _)  = runT_ $ mp <~ stdOut
-mStdOut_ _  _                    = return ()
+mStdOut_ mp (_, Just stdOut, _) = runT_ $ mp <~ stdOut
+mStdOut_ _ _ = return ()
 
 producer :: String -> ProcessT IO Event Event -> IO (ExitCode)
 producer cmd sink = do
   (ec, _) <- callProcessMachines byChunk createProc (mStdOut_ pipeline)
   return ec
-    where
-      pipeline = sink <~ eventProcess <~ echoText stdout
-      echoText h = autoM $ (\txt -> TextIO.hPutStr h txt >> return txt)
-      createProc  = (shell cmd) { std_in = Inherit, std_out = CreatePipe }
+  where
+    pipeline = sink <~ eventProcess <~ echoText stdout
+    echoText h = autoM $ (\txt -> TextIO.hPutStr h txt >> return txt)
+    createProc = (shell cmd) {std_in = Inherit, std_out = CreatePipe}
 
 main :: IO ()
 main = do
   hSetBuffering stdin NoBuffering
   hSetBuffering stdout NoBuffering
-  args  <- getArgs
-  b     <- getBroker
-  t     <- getTopic b "."
-  ec    <- produce t $ producer $ concat $ List.intersperse " " ("sbt":args)
+  args <- getArgs
+  b <- getBroker
+  t <- getTopic b "."
+  ec <- produce t $ producer $ concat $ List.intersperse " " ("sbt" : "-Dsbt.color=always" : args)
   exitWith ec
diff --git a/sarsi-vi/Main.hs b/sarsi-vi/Main.hs
--- a/sarsi-vi/Main.hs
+++ b/sarsi-vi/Main.hs
@@ -1,19 +1,18 @@
 module Main where
 
-import Data.Machine (ProcessT, (<~), asParts, final, scan, sinkPart_, runT)
-import Codec.Sarsi (Event(..), Message(..), Level(..), Location(..))
+import Codec.Sarsi (Event (..), Level (..), Location (..), Message (..))
 import Control.Concurrent.MVar (MVar, newMVar, readMVar, swapMVar)
+import qualified Data.List as List
+import Data.Machine (ProcessT, asParts, final, runT, scan, sinkPart_, (<~))
 import Data.Text (Text, pack)
+import qualified Data.Text as Text
 import Data.Text.IO (hPutStrLn)
-import Sarsi (Topic(..), getBroker, getTopic)
+import Sarsi (Topic (..), getBroker, getTopic)
+import qualified Sarsi as Sarsi
 import Sarsi.Consumer (consumeOrWait)
-import System.IO (Handle, IOMode(WriteMode), hClose, hFlush, openFile)
+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 Sarsi as Sarsi
-
 -- TODO Remove the MVar by impl. scanM ((a -> b -> m a) -> a -> ProcessT m (k b) a) in machines
 
 title :: String
@@ -23,47 +22,49 @@
 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 " ") txts
+    header = Text.concat $ List.intersperse (pack ":") [fp, pack $ show ln, pack $ show col, tpe lvl]
+    body = Text.concat $ List.intersperse (pack " ") txts
     tpe Error = pack "e"
     tpe Warning = pack "w"
 
-data Action = Append | Replace deriving Show
-data LogEvent = LogEvent Action Text deriving Show
+data Action = Append | Replace deriving (Show)
 
-data Command = Throw LogEvent | Echo String
+data LogEvent = LogEvent Action Text deriving (Show)
 
+data Command = Throw LogEvent | Echo String deriving (Show)
+
 convert :: Bool -> Event -> (Bool, [Command])
-convert first (Notify msg@(Message loc lvl _))  = (False, [Throw e, Echo $ concat [show loc, " ", show lvl]])
+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])
+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)
+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'
+  h <- readMVar var
+  h' <- dump fp h c
+  _ <- swapMVar var h'
   return ()
-    where fp = tp ++ ".vi"
+  where
+    fp = tp ++ ".vi"
 
 main :: IO ()
 main = do
-  b     <- getBroker
-  t     <- getTopic b "."
-  var   <- newMVar Nothing
+  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
+  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,10 +1,8 @@
 name:                sarsi
-version:             0.0.4.0
+version:             0.0.5.1
 synopsis:            A universal quickfix toolkit and his protocol.
- 
 description:
   Usage overview can be found in the <http://github.com/aloiscochard/sarsi#sarsi README>.
-
 homepage:            http://github.com/aloiscochard/sarsi
 license:             Apache-2.0
 license-file:        LICENSE
@@ -20,64 +18,60 @@
   ghc-options:          -Wall
   exposed-modules:
     Codec.Sarsi
+    Codec.Sarsi.Curses
     Codec.Sarsi.GHC
+    -- TODO Extract in rosetta
     Codec.Sarsi.Rust
     Codec.Sarsi.SBT
     Codec.Sarsi.SBT.Machine
+    Rosetta
     Sarsi
     Sarsi.Consumer
+    Sarsi.Processor
     Sarsi.Producer
-    Sarsi.Tools.Shell
+    Sarsi.Tools.Pipe
     Sarsi.Tools.Trace
-    -- TODO Extract in a `codec-ghc-log` module
+    -- TODO Extract in a `codec-ghc-log` module or in rosetta
     Codec.GHC.Log
     -- TODO Extract in a `machines-attoparsec` module
     Data.Attoparsec.Machine
     Data.Attoparsec.Text.Machine
   build-depends:
       base                  >= 4.6.0.1    && < 5
-    , async                 >= 2.1        && < 2.2
+    , ansi-terminal         >= 0.10       && < 0.12
+    , async                 >= 2.1        && < 2.3
     , attoparsec            >= 0.12       && < 0.14
     , binary                >= 0.7        && < 0.9
     , bytestring            >= 0.10       && < 0.11
-    , containers            >= 0.5        && < 0.6
-    , cryptonite            >= 0.10       && < 0.21
-    , data-msgpack          >= 0.0.3      && < 0.1
-    , directory             >= 1.2        && < 1.3
+    , containers            >= 0.5        && < 0.7
+    , cryptonite            >= 0.10       && < 0.29
+    , msgpack               >= 1.0        && < 1.1
+    , directory             >= 1.2        && < 1.4
     , filepath              >= 1.4        && < 1.5
-    , fsnotify              >= 0.2        && < 0.3
-    , machines              >= 0.6        && < 0.7
-    , machines-binary       >= 0.3.0.2    && < 0.4
-    , machines-process      >= 0.2.0.6    && < 0.3
-    , machines-io           >= 0.2.0.12   && < 0.3
-    , network               >= 2.6        && < 2.7
-    , process               >= 1.1        && < 1.5
-    , stm                   >= 2.4        && < 2.5
+    , fsnotify              >= 0.2        && < 0.4
+    , machines              >= 0.7        && < 0.8
+    , machines-binary       >= 7.0        && < 7.1
+    , machines-process      >= 7.0.0.2    && < 7.1
+    , machines-io           >= 7.0        && < 7.1
+    , network               >= 3.1        && < 3.2
+    , process               >= 1.1        && < 1.7
+    , stm                   >= 2.4        && < 2.6
     , text                  >= 1.2        && < 1.3
-    , vector                >= 0.10       && < 0.12
+    , vector                >= 0.10       && < 0.13
 
 executable sarsi 
   main-is:              Main.hs
   other-modules:
     Paths_sarsi
-  build-depends:       
+  build-depends:
       base
+    , sarsi
     , Cabal
-    , sarsi                 == 0.0.4.0
+    , containers
   hs-source-dirs:       sarsi
   ghc-options:          -Wall -threaded
   default-language:     Haskell2010
 
-executable sarsi-hs
-  main-is:              Main.hs
-  build-depends:       
-      base
-    , sarsi                 == 0.0.4.0
-    , machines
-  hs-source-dirs:       sarsi-hs
-  ghc-options:          -Wall -dynamic -threaded
-  default-language:     Haskell2010
-
 executable sarsi-nvim
   main-is:              Main.hs
   other-modules:
@@ -86,10 +80,12 @@
     Data.MessagePack.RPC
     -- TODO Extract in a lightweight nvim client.
     NVIM.Client
-    -- NVIM.Info
-  build-depends:       
+    NVIM.Command
+    NVIM.QuickFix
+  build-depends:
       base
-    , sarsi                 == 0.0.4.0
+    , sarsi
+    , async
     , machines
     , binary
     , bytestring
@@ -97,32 +93,23 @@
     , machines
     , machines-binary
     , machines-io
-    , data-msgpack
+    , msgpack
     , network
     , process
     , text
+    , stm
     , vector
     , unordered-containers  >= 0.2        && < 0.3
   hs-source-dirs:       sarsi-nvim
   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:       
+  build-depends:
       base
-    , sarsi                 == 0.0.4.0
+    , sarsi
     , machines
     , machines-io
     , machines-process
@@ -134,9 +121,9 @@
 
 executable sarsi-vi
   main-is:              Main.hs
-  build-depends:       
+  build-depends:
       base
-    , sarsi                 == 0.0.4.0
+    , sarsi
     , directory
     , filepath
     , machines
@@ -144,5 +131,20 @@
     , text
     , vector
   hs-source-dirs:       sarsi-vi
+  ghc-options:          -Wall -dynamic -threaded
+  default-language:     Haskell2010
+
+executable srs
+  main-is:              srs.hs
+  build-depends:
+      base
+    , sarsi
+    , async
+    , bytestring
+    , machines
+    , machines-io
+    , machines-process
+    , process
+  hs-source-dirs:       exe
   ghc-options:          -Wall -dynamic -threaded
   default-language:     Haskell2010
diff --git a/sarsi/Main.hs b/sarsi/Main.hs
--- a/sarsi/Main.hs
+++ b/sarsi/Main.hs
@@ -1,20 +1,42 @@
 module Main where
 
-import Distribution.Text
+import qualified Data.List as List
+import qualified Data.Set as Set
+import Data.Version (showVersion)
+import Paths_sarsi (version)
+import qualified Rosetta as Rosetta
 import Sarsi (getBroker, getSockAddr, getTopic, title)
-import Sarsi.Tools.Trace (traceHS, traceRS, traceSBT)
-import System.IO (stdin)
+import Sarsi.Processor (languageProcess, processAll, processAny)
+import Sarsi.Tools.Pipe (pipe)
+import Sarsi.Tools.Trace (traceCleanCurses, traceHS, traceRS, traceSBT, traceSBTCurses)
 import System.Environment (getArgs)
-
-import Paths_sarsi (version)
+import System.IO (stdin)
 
 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
-    b     <- getBroker
-    t     <- getTopic b "."
-    print $ getSockAddr t
+main = getArgs >>= run
+  where
+    run ["--trace", "clean-curses"] = traceCleanCurses stdin
+    run ["--trace", "hs"] = traceHS stdin
+    run ["--trace", "rs"] = traceRS stdin
+    run ["--trace", "sbt"] = traceSBT stdin
+    run ["--trace", "sbt-curses"] = traceSBTCurses stdin
+    run ["--topic"] = do
+      b <- getBroker
+      t <- getTopic b "."
+      print $ getSockAddr t
+    run ["--version"] = putStrLn $ concat [title, "-", showVersion version]
+    run [] = pipe "any" processAny
+    run exts = case Set.fromList <$> traverse parseExt exts of
+      Right languageTags -> do
+        ps <- traverse fetchProcess $ Set.toList languageTags
+        pipe (concat $ List.intersperse "+" (Rosetta.languageLabel <$> (Set.toList languageTags))) (processAll $ ps >>= id)
+      Left err -> putStrLn $ concat [title, ": ", err]
+    fetchProcess lt = case languageProcess lt of
+      Just process -> return [process]
+      Nothing -> do
+        putStrLn $ concat [title, ": ", "unsupported language '", Rosetta.languageLabel lt, "'"]
+        return []
+    parseExt ext =
+      case Rosetta.fromExtension ext of
+        Just lt -> Right lt
+        Nothing -> Left (concat ["invalid extension '", ext, "'."])
diff --git a/src/Codec/Sarsi.hs b/src/Codec/Sarsi.hs
--- a/src/Codec/Sarsi.hs
+++ b/src/Codec/Sarsi.hs
@@ -1,17 +1,16 @@
 module Codec.Sarsi where
 
-import Data.Int (Int64)
-import Data.Text (Text, unpack)
 import Data.Binary (Get, Put)
-
 import qualified Data.MessagePack.Get as Get
 import qualified Data.MessagePack.Put as Put
+import Data.Text (Text, unpack)
 import qualified Data.Text as Text
+import qualified Data.Vector as Vector
 
 data Event
-  = Start { label :: Text }
-  | Finish { errors :: Int64, warnings :: Int64 }
-  | Notify { message :: Message }
+  = Start {label :: Text}
+  | Finish {errors :: Int, warnings :: Int}
+  | Notify {message :: Message}
 
 instance Show Event where
   show (Start lbl) = concat ["starting ", unpack lbl, " build"]
@@ -37,17 +36,21 @@
 
 data Message = Message Location Level [Text]
 
+-- TODO Remove me
+messageTest :: Message
+messageTest = Message (Location {filePath = Text.pack "foo", column = 42, line = 42}) Error []
+
 instance Show Message where
   show (Message loc lvl txts) =
     (concat [show loc, " ", show lvl, "\n"]) ++ (unlines $ Text.unpack <$> txts)
 
 getMessage :: Get Message
-getMessage = Message <$> getLocation <*> getLevel <*> Get.getArray Get.getStr
+getMessage = Message <$> getLocation <*> getLevel <*> (Vector.toList <$> Get.getArray Get.getStr)
 
 putMessage :: Message -> Put
-putMessage (Message loc lvl txt) = putLocation loc *> putLevel lvl *> Put.putArray Put.putStr txt
+putMessage (Message loc lvl txt) = putLocation loc *> putLevel lvl *> Put.putArray Put.putStr (Vector.fromList txt)
 
-data Location = Location { filePath :: Text, column :: Int64, line :: Int64 }
+data Location = Location {filePath :: Text, column :: Int, line :: Int}
 
 instance Show Location where
   show (Location fp c l) = concat [Text.unpack fp, "@", show l, ":", show c]
@@ -66,4 +69,3 @@
 
 putLevel :: Level -> Put
 putLevel = Put.putInt . fromIntegral . fromEnum
-
diff --git a/src/Codec/Sarsi/Curses.hs b/src/Codec/Sarsi/Curses.hs
new file mode 100644
--- /dev/null
+++ b/src/Codec/Sarsi/Curses.hs
@@ -0,0 +1,85 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Codec.Sarsi.Curses where
+
+import Data.Attoparsec.Text
+import qualified Data.Attoparsec.Text as AttoText
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import qualified Data.Text as Text
+
+-- note: expect a line that does NOT ends with a LF
+cleanLine :: Text -> Text
+cleanLine txt | Text.null txt = txt
+cleanLine txt | Text.last txt == '\r' = fromMaybe Text.empty $ (f . fst) <$> Text.unsnoc txt
+  where
+    f x = case Text.breakOnAll "\r" x of
+      [] -> x
+      xs -> Text.tail $ (snd . last) xs
+cleanLine txt = txt
+
+-- Note: this parser remove CSI codes and do a best effort
+-- at removing "clear line" instructions while keeping
+-- all information exposed without any mangling.
+cleaningCurses :: Parser Text
+cleaningCurses = choice [multiples, single, none]
+  where
+    multiples = do
+      before <- ln
+      middle <- choice [silenceClearLines, silenceCSI]
+      after <- choice [multiples, single]
+      return $ Text.concat [before, "\n", middle, after]
+      where
+        ln = do
+          before <- AttoText.takeWhile (breakAt . fromEnum)
+          after <- choice [lineFinish, lineContinue]
+          return (Text.concat [before, after])
+          where
+            breakAt 10 = False -- LF
+            breakAt 27 = False -- ESC
+            breakAt _ = True
+        lineFinish = char '\n' >> (return $ Text.pack "\n")
+        lineContinue = csi >> ln
+        silenceClearLines = do
+          _ <- AttoText.takeWhile (not . isEsc . fromEnum)
+          _ <- choice [AttoText.many1 (cl <* "\n"), AttoText.many1 cl]
+          return Text.empty
+    single = do
+      befores <- many1 $ choice [clearLine, silenceCSI]
+      str <- AttoText.many1 anyChar
+      _ <- endOfInput
+      return (Text.concat [Text.concat befores, Text.pack str])
+      where
+        clearLine = do
+          _ <- AttoText.takeWhile (not . isEsc . fromEnum)
+          _ <- AttoText.many1 cl
+          return Text.empty
+    none = do
+      ln <- (AttoText.takeWhile $ \w -> w /= '\n')
+      _ <- "\n"
+      return $ Text.concat [ln, "\n"]
+    cl = csiHeader >> string "2K" >> return ()
+    silenceCSI = do
+      txt <- AttoText.takeWhile (not . isEsc . fromEnum)
+      _ <- AttoText.many1 csi
+      return txt
+
+-- CSI (Control Sequence Introducer) sequences
+csi :: Parser Text
+csi = do
+  _ <- csiHeader
+  param <- takeWhileInRange 0x30 0x3F
+  inter <- takeWhileInRange 0x20 0x2F
+  final <- satisfy ((inRange 0x40 0x7E) . fromEnum)
+  return $ Text.concat [param, inter, Text.singleton final]
+  where
+    takeWhileInRange l u = AttoText.takeWhile (inRange l u . fromEnum)
+    inRange l u i | i >= l && i <= u = True
+    inRange _ _ _ = False
+
+csiHeader :: Parser ()
+csiHeader = (satisfy (isEsc . fromEnum) <* char '[') >> return ()
+
+isEsc :: Int -> Bool
+isEsc 27 = True
+isEsc _ = False
diff --git a/src/Codec/Sarsi/Rust.hs b/src/Codec/Sarsi/Rust.hs
--- a/src/Codec/Sarsi/Rust.hs
+++ b/src/Codec/Sarsi/Rust.hs
@@ -1,37 +1,27 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Codec.Sarsi.Rust where
 
-import Codec.Sarsi (Level(..), Location(..), Message(..))
+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 /= ' '
+messageParser = do
+  l <-
+    choice
+      [ string "warning" *> untilSep0 *> string ": " *> return Warning,
+        string "error" *> untilSep0 *> string ": " *> return Error
+      ]
+  body <- untilLineBreak <* "\n"
+  fp <- many1 space *> "--> " *> untilSep <* char sepChar
+  n <- decimal <* char sepChar
+  c <- decimal <* "\n"
+  comments <- many' (untilLineBreak <* "\n")
+  _ <- end
+  return $ Message (Location fp c n) l (body : comments)
+  where
+    untilSep = takeWhile1 $ \w -> w /= sepChar
+    untilSep0 = Data.Attoparsec.Text.takeWhile $ \w -> w /= ':'
     end = choice [const () <$> "\n", endOfInput, return ()]
     sepChar = ':'
-    untilLineBreak = takeWhile1 $ \w -> w /= '\n' && w /= '\r'
+    untilLineBreak = takeWhile1 $ \w -> w /= '\n'
diff --git a/src/Codec/Sarsi/SBT.hs b/src/Codec/Sarsi/SBT.hs
--- a/src/Codec/Sarsi/SBT.hs
+++ b/src/Codec/Sarsi/SBT.hs
@@ -1,67 +1,63 @@
 {-# LANGUAGE OverloadedStrings #-}
+
 module Codec.Sarsi.SBT where
 
-import Codec.Sarsi (Level(..), Location(..), Message(..))
+import Codec.Sarsi (Level (..), Location (..), Message (..))
 import Data.Attoparsec.Combinator (lookAhead)
 import Data.Attoparsec.Text
-import Data.Text (Text)
-
 import qualified Data.Attoparsec.Text as AttoText
+import Data.Text (Text)
 import qualified Data.Text as Text
 
 data SBTEvent = CompileStart Text | TaskFinish Bool Text | Throw Message
-  deriving Show
+  deriving (Show)
 
+cleaningCursesSBT :: Parser Text
+cleaningCursesSBT = choice [silent, empty, keep]
+  where
+    silent = "  | =>" >> untilLineBreak >> "\n" >> return Text.empty
+    empty = do
+      _ <- AttoText.takeWhile1 $ \w -> w == '\n'
+      return Text.empty
+    keep = do
+      content <- (AttoText.takeWhile1 $ \w -> w /= '\n') <* end
+      return $ content `Text.snoc` '\n'
+
 eventParser :: Parser SBTEvent
 eventParser = choice [compile, finish, Throw <$> messageParser]
   where
     compile = do
-      txt <- string "[info] Compiling " *> untilLineBreak <* end
+      txt <- string "[info] " *> choice ["Build triggered", "Compiling"] *> untilLineBreak <* end
       return $ CompileStart txt
     finish = do
       res <- status <* space
       txt <- string "Total time: " *> untilLineBreak <* end
-      _   <- end
+      _ <- end
       return $ TaskFinish res txt
-        where
-          status = choice [string "[success]" *> return True, string "[error]" *> return False]
+      where
+        status = choice [string "[success]" *> return True, string "[error]" *> return False]
 
 messageParser :: Parser Message
 messageParser = do
   lvl <- lineStart
-  fp  <- takeWhile1 (\c -> c /= sepChar && c /= '\n' && c /= '\r') <* char sepChar
-  ln  <- decimal <* char sepChar
-  t   <- space *> (untilLineBreak <* "\n")
-  ts  <- manyTill' (lineStart *> (untilLineBreak <* "\n")) (lookAhead $ column')
-  col <- column'
-  _   <- end
-  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 [] = [t]
-      formatTxts t ts = t : init ts
-      column' = level *> ((length <$> many1 space) <* "^\n")
-
-cleanEC :: Parser Text
-cleanEC = choice [noEC, withEC]
+  fp <- takeWhile1 (\c -> c /= sepChar && c /= '\n') <* char sepChar
+  ln <- decimal <* char sepChar
+  col <- decimal <* char sepChar
+  t <- space *> (untilLineBreak <* "\n")
+  ts <- manyTill' (lineStart *> (untilLineBreak <* "\n")) (lookAhead $ column')
+  _ <- column' -- ignored as it was parsed above
+  _ <- end
+  return $ Message (Location fp col ln) lvl $ formatTxts t ts
   where
-    noEC    = takeStart <* endOfInput
-    withEC  = do
-      before <- takeStart <* anyChar
-      _      <- takeEnd   <* anyChar
-      after  <- cleanEC
-      return (Text.concat [before, after])
-    takeStart = AttoText.takeWhile (not . isEscStart . fromEnum)
-    takeEnd   = AttoText.takeWhile (not . isEscEnd . fromEnum)
-    isEscStart 27 = True
-    isEscStart _  = False
-    isEscEnd 109 = True
-    isEscEnd _ = False
+    level = choice [string "[error]" *> return Error, string "[warn]" *> return Warning]
+    lineStart = level <* space
+    sepChar = ':'
+    formatTxts t [] = [t]
+    formatTxts t ts = t : init ts
+    column' = level *> ((length <$> many1 space) <* "^\n")
 
 untilLineBreak :: Parser Text
-untilLineBreak = takeWhile1 $ \w -> w /= '\n' && w /= '\r'
+untilLineBreak = takeWhile1 $ \w -> w /= '\n'
 
 end :: Parser ()
 end = choice [const () <$> "\n", endOfInput, return ()]
diff --git a/src/Codec/Sarsi/SBT/Machine.hs b/src/Codec/Sarsi/SBT/Machine.hs
--- a/src/Codec/Sarsi/SBT/Machine.hs
+++ b/src/Codec/Sarsi/SBT/Machine.hs
@@ -1,12 +1,11 @@
 module Codec.Sarsi.SBT.Machine where
 
-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 Codec.Sarsi (Event (..), Level (..), Message (..))
+import Codec.Sarsi.Curses (cleaningCurses)
+import Codec.Sarsi.SBT (SBTEvent (..), cleaningCursesSBT, eventParser)
+import Data.Attoparsec.Text.Machine (asLines, processParser, streamParser)
+import Data.Machine (ProcessT, asParts, auto, filtered, scan, (<~))
 import Data.Text (Text)
-
 import qualified Data.Text as Text
 
 eventProcess :: Monad m => ProcessT m Text Event
@@ -14,34 +13,33 @@
   where
     f (session, _) event = runSession session event
     unpack (_, Just e) = [e]
-    unpack _           = []
+    unpack _ = []
 
 eventProcess' :: Monad m => ProcessT m Text SBTEvent
 eventProcess' = asParts <~ auto unpackEvent <~ streamParser eventParser <~ preprocessing
   where
-    preprocessing =
-      asParts <~ auto unpackEC <~ processParser cleanEC <~ asParts <~ auto unpackLine <~ streamParser byLine
-        where byLine = untilLineBreak <* end
-    unpackEvent (Right e)  = [e]
-    unpackEvent (Left _)  = []
-    unpackEC (Left _)     = []
-    unpackEC (Right (_, txt))  = [txt]
-    unpackLine (Right txt)  = [txt `Text.snoc` '\n']
-    unpackLine (Left _)     = []
-
+    preprocessing = filtered (not . Text.null) <~ parsing cleaningCursesSBT <~ parsing cleaningCurses <~ input
+      where
+        input = auto (\txt -> Text.snoc txt '\n') <~ asLines
+        parsing p = asParts <~ auto f <~ processParser p
+          where
+            f (Left _) = []
+            f (Right (_, txt)) = [txt]
+    unpackEvent (Right e) = [e]
+    unpackEvent (Left _) = []
 
-data Session = Session { isBuilding :: Bool, counts :: (Int64, Int64) }
-  deriving Show
+data Session = Session {isBuilding :: Bool, counts :: (Int, Int)}
+  deriving (Show)
 
 emptySession :: Session
 emptySession = Session False (0, 0)
 
 runSession :: Session -> SBTEvent -> (Session, Maybe Event)
-runSession (Session False f)     (CompileStart _)  = (Session True   f,            Just $ Start $ Text.pack "scala")
-runSession (Session False f)     _                 = (Session False  f,            Nothing)
-runSession (Session True f)      (CompileStart _)  = (Session True   f,            Nothing)
-runSession (Session True (e,w))  (TaskFinish _ _)  = (Session False  (0, 0),       Just $ Finish e w)
-runSession (Session True f)      (Throw msg)       = (Session True   (inc msg f),  Just $ Notify msg)
+runSession (Session False f) (CompileStart _) = (Session True f, Just $ Start $ Text.pack "scala")
+runSession (Session False f) _ = (Session False f, Nothing)
+runSession (Session True f) (CompileStart _) = (Session True f, Nothing)
+runSession (Session True (e, w)) (TaskFinish _ _) = (Session False (0, 0), Just $ Finish e w)
+runSession (Session True f) (Throw msg) = (Session True (inc msg f), Just $ Notify msg)
   where
     inc (Message _ Warning _) (e, w) = (e, w + 1)
-    inc (Message _ Error _)   (e, w) = (e + 1, w)
+    inc (Message _ Error _) (e, w) = (e + 1, w)
diff --git a/src/Data/Attoparsec/Machine.hs b/src/Data/Attoparsec/Machine.hs
--- a/src/Data/Attoparsec/Machine.hs
+++ b/src/Data/Attoparsec/Machine.hs
@@ -1,20 +1,23 @@
 {-# LANGUAGE Rank2Types #-}
+
 module Data.Attoparsec.Machine where
 
-import Data.Attoparsec.Internal.Types (IResult(..))
-import Data.Machine (MachineT(..), ProcessT, Step(Await, Yield), Is(Refl), stopped)
+import Data.Attoparsec.Internal.Types (IResult (..))
+import Data.Machine (Is (Refl), MachineT (..), ProcessT, Step (Await, Yield), stopped)
 
 streamParserWith :: (Monoid i, Monad m) => (i -> IResult i a) -> ProcessT m i (Either String a)
-streamParserWith runParser = start where
-  start = MachineT . return $ Await parse Refl stopped
-  parse i = MachineT . return . f $ runParser i
-  f (Fail _ _ e)  = Yield (Left e) start
-  f (Partial c)   = Await (MachineT . return . f . c) Refl $ (MachineT . return . f $ c mempty)
-  f (Done i r)    = Yield (Right r) (parse i)
+streamParserWith runParser = start
+  where
+    start = MachineT . return $ Await parse Refl stopped
+    parse i = MachineT . return . f $ runParser i
+    f (Fail _ _ e) = Yield (Left e) start
+    f (Partial c) = Await (MachineT . return . f . c) Refl $ (MachineT . return . f $ c mempty)
+    f (Done i r) = Yield (Right r) (parse i)
 
 processParserWith :: (Monoid i, Monad m) => (i -> IResult i a) -> ProcessT m i (Either String (i, a))
-processParserWith runParser = MachineT . return $ Await parse Refl stopped where
-  parse i = MachineT . return . f $ runParser i
-  f (Fail _ _ e)  = Yield (Left e) (processParserWith runParser)
-  f (Partial c)   = f $ c mempty
-  f (Done i a)    = Yield (Right (i, a)) (processParserWith runParser)
+processParserWith runParser = MachineT . return $ Await parse Refl stopped
+  where
+    parse i = MachineT . return . f $ runParser i
+    f (Fail _ _ e) = Yield (Left e) (processParserWith runParser)
+    f (Partial c) = f $ c mempty
+    f (Done i a) = Yield (Right (i, a)) (processParserWith runParser)
diff --git a/src/Data/Attoparsec/Text/Machine.hs b/src/Data/Attoparsec/Text/Machine.hs
--- a/src/Data/Attoparsec/Text/Machine.hs
+++ b/src/Data/Attoparsec/Text/Machine.hs
@@ -1,13 +1,20 @@
-module Data.Attoparsec.Text.Machine where
+{-# LANGUAGE OverloadedStrings #-}
 
-import Data.Attoparsec.Text (Parser, parse)
-import Data.Text (Text)
-import Data.Machine (ProcessT)
+module Data.Attoparsec.Text.Machine where
 
 import Data.Attoparsec.Machine (processParserWith, streamParserWith)
+import Data.Attoparsec.Text (Parser, parse, takeWhile)
+import Data.Machine (ProcessT, asParts, auto, (<~))
+import Data.Text (Text)
 
-streamParser :: Monad m => Parser a -> ProcessT m Text (Either String a)
-streamParser p = streamParserWith $ parse p
+asLines :: Monad m => ProcessT m Text Text
+asLines = asParts <~ auto unpackLine <~ streamParser ((Data.Attoparsec.Text.takeWhile $ \w -> w /= '\n') <* "\n")
+  where
+    unpackLine (Right txt) = [txt]
+    unpackLine (Left _) = []
 
 processParser :: Monad m => Parser a -> ProcessT m Text (Either String (Text, a))
 processParser p = processParserWith $ parse p
+
+streamParser :: Monad m => Parser a -> ProcessT m Text (Either String a)
+streamParser p = streamParserWith $ parse p
diff --git a/src/Rosetta.hs b/src/Rosetta.hs
new file mode 100644
--- /dev/null
+++ b/src/Rosetta.hs
@@ -0,0 +1,60 @@
+module Rosetta where
+
+import Data.List (find)
+
+fromExtension :: String -> Maybe LanguageTag
+fromExtension ext = find (\t -> languageExtension t == ext) languageTags
+
+fromTool :: String -> Maybe ProjectTag
+fromTool tool = find (\t -> projectTool t == tool) projectTags
+
+data LanguageTag = CS | FS | HS | JV | NX | RS | SC
+  deriving (Bounded, Enum, Eq, Ord)
+
+languageExtension :: LanguageTag -> String
+languageExtension CS = "cs"
+languageExtension FS = "fs"
+languageExtension HS = "hs"
+languageExtension JV = "java"
+languageExtension NX = "nix"
+languageExtension RS = "rs"
+languageExtension SC = "scala"
+
+languageTags :: [LanguageTag]
+languageTags = [minBound ..]
+
+languageLabel :: LanguageTag -> String
+languageLabel CS = "csharp"
+languageLabel FS = "fsharp"
+languageLabel HS = "haskell"
+languageLabel JV = "java"
+languageLabel NX = "nix"
+languageLabel RS = "rust"
+languageLabel SC = "scala"
+
+data ProjectTag = CABAL | CARGO | DOTNET | NIX | SBT | STACK
+  deriving (Bounded, Enum, Eq, Ord)
+
+projectTags :: [ProjectTag]
+projectTags = [minBound ..]
+
+projectLanguages :: ProjectTag -> [LanguageTag]
+projectLanguages CABAL = [HS]
+projectLanguages CARGO = [RS]
+projectLanguages DOTNET = [CS, FS]
+projectLanguages NIX = [NX]
+projectLanguages SBT = [JV, SC]
+projectLanguages STACK = [HS]
+
+projectTool :: ProjectTag -> String
+projectTool CABAL = "cabal"
+projectTool CARGO = "cargo"
+projectTool DOTNET = "dotnet"
+projectTool NIX = "nix-shell"
+projectTool SBT = "sbt"
+projectTool STACK = "stack"
+
+projectToolBuildArgs :: ProjectTag -> [String]
+projectToolBuildArgs NIX = ["."]
+projectToolBuildArgs SBT = ["compile"]
+projectToolBuildArgs _ = ["build"]
diff --git a/src/Sarsi.hs b/src/Sarsi.hs
--- a/src/Sarsi.hs
+++ b/src/Sarsi.hs
@@ -2,11 +2,10 @@
 
 import Crypto.Hash (Digest, hash)
 import Crypto.Hash.Algorithms (MD5)
-import Network.Socket (Family(AF_UNIX), SockAddr(SockAddrUnix), Socket, SocketType(Stream), defaultProtocol, socket)
-import System.Directory (getTemporaryDirectory, createDirectory, doesDirectoryExist, doesFileExist, makeAbsolute, removeFile)
-import System.FilePath ((</>))
-
 import qualified Data.ByteString.Char8 as BSC8
+import Network.Socket (Family (AF_UNIX), SockAddr (SockAddrUnix), Socket, SocketType (Stream), defaultProtocol, socket)
+import System.Directory (XdgDirectory (XdgCache), createDirectory, doesDirectoryExist, doesFileExist, getXdgDirectory, makeAbsolute, removeFile)
+import System.FilePath ((</>))
 
 title :: String
 title = "sarsi"
@@ -17,15 +16,14 @@
 
 getBroker :: IO Broker
 getBroker = do
-  tmp <- getTemporaryDirectory
-  let bp = tmp </> title
+  bp <- getXdgDirectory XdgCache title
   let broker = Broker bp
   exists <- doesDirectoryExist bp
   if exists then return broker else createDirectory bp >> return broker
 
 getTopic :: Broker -> FilePath -> IO Topic
 getTopic b@(Broker bp) fp' = do
-  fp    <- makeAbsolute fp'
+  fp <- makeAbsolute fp'
   return $ Topic b $ bp </> (show $ (hash $ BSC8.pack fp :: Digest MD5))
 
 removeTopic :: Topic -> IO ()
diff --git a/src/Sarsi/Consumer.hs b/src/Sarsi/Consumer.hs
--- a/src/Sarsi/Consumer.hs
+++ b/src/Sarsi/Consumer.hs
@@ -1,29 +1,30 @@
 {-# LANGUAGE Rank2Types #-}
+
 module Sarsi.Consumer where
 
 import Codec.Sarsi (Event, getEvent)
-import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar)
+import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
 import Control.Exception (IOException, bracket, try)
-import Data.Binary.Machine (processGet)
-import Data.Machine ((<~), auto, asParts)
+import Data.Binary.Machine (streamGet)
+import Data.Machine (asParts, auto, (<~))
 import Network.Socket (connect, socketToHandle)
-import Sarsi (Broker(..), Topic(..), createSocket, getSockAddr)
+import Sarsi (Broker (..), Topic (..), createSocket, getSockAddr)
 import System.FSNotify (eventPath, watchDir, withManager)
-import System.IO (IOMode(ReadMode), hClose, hWaitForInput)
+import System.IO (IOMode (ReadMode), hClose, hWaitForInput)
 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
   res <- consume topic f
   either (const $ withManager waitAndRetry) return res
-    where
-      waitAndRetry mng = do
-        lck <- newEmptyMVar
-        stop <- watchDir mng bp pred' $ const $ putMVar lck ()
-        takeMVar lck
-        stop
-        consumeOrWait topic f
-      pred' e = eventPath e == tp
+  where
+    waitAndRetry mng = do
+      lck <- newEmptyMVar
+      stop <- watchDir mng bp pred' $ const $ putMVar lck ()
+      takeMVar lck
+      stop
+      consumeOrWait topic f
+    pred' e = eventPath e == tp
 
 consume :: Topic -> (Maybe s -> IOSource Event -> IO (Either s a)) -> IO (Either IOException a)
 consume topic f = try $ consume' topic f
@@ -32,13 +33,14 @@
 consume' topic f = bracket createHandle hClose (process Nothing)
   where
     createHandle = do
-      sock  <- createSocket
+      sock <- createSocket
       connect sock $ getSockAddr topic
       socketToHandle sock ReadMode
     process s h = do
-      sa  <- f s $ asParts <~ auto unpack <~ processGet getEvent <~ sourceHandle (byChunkOf 1) h
-      _   <- hWaitForInput h (-1)
+      sa <- f s $ asParts <~ auto unpack <~ streamGet getEvent <~ sourceHandle (byChunkOf 1) h
+      _ <- hWaitForInput h (-1)
       either (continue h) return sa
-        where continue h' s' = process (Just s') h'
+      where
+        continue h' s' = process (Just s') h'
     unpack (Right e) = [e]
     unpack (Left _) = []
diff --git a/src/Sarsi/Processor.hs b/src/Sarsi/Processor.hs
new file mode 100644
--- /dev/null
+++ b/src/Sarsi/Processor.hs
@@ -0,0 +1,52 @@
+module Sarsi.Processor where
+
+import qualified Codec.GHC.Log as GHC
+import Codec.Sarsi (Message)
+import Codec.Sarsi.GHC (fromGHCLog)
+import qualified Codec.Sarsi.Rust as Rust
+import Data.Attoparsec.Text.Machine (streamParser)
+import Data.Machine (ProcessT, asParts, auto, flattened, (<~))
+import Data.Machine.Fanout (fanout)
+import Data.Set (Set)
+import qualified Data.Set as Set
+import Data.Text (Text)
+import Rosetta (LanguageTag (..), ProjectTag, projectLanguages)
+
+data Processor = Processor {language :: LanguageTag, process :: ProcessT IO Text Message}
+
+instance Eq Processor where
+  a == b = (language a) == (language b)
+
+instance Ord Processor where
+  compare a b = compare (language a) (language b)
+
+projectProcessors :: ProjectTag -> Set Processor
+-- projectProcessors DOTNET = processDotnet
+projectProcessors project = Set.fromList $ g =<< f <$> projectLanguages project
+  where
+    f l = (\p -> (l, p)) <$> languageProcess l
+    g (Just (l, p)) = [Processor {language = l, process = p}]
+    g Nothing = []
+
+languageProcess :: LanguageTag -> Maybe (ProcessT IO Text Message)
+languageProcess HS = Just processHaskell
+languageProcess RS = Just processRust
+languageProcess _ = Nothing
+
+processAll :: [ProcessT IO Text Message] -> ProcessT IO Text Message
+processAll xs = flattened <~ (fanout $ (\p -> (auto (\x -> [x])) <~ p) <$> xs)
+
+processAny :: ProcessT IO Text Message
+processAny = processAll [processHaskell, processRust]
+
+processHaskell :: ProcessT IO Text Message
+processHaskell = asParts <~ auto unpack <~ streamParser GHC.messageParser
+  where
+    unpack (Right msg) = [fromGHCLog msg]
+    unpack (Left _) = []
+
+processRust :: ProcessT IO Text Message
+processRust = asParts <~ auto unpack <~ streamParser Rust.messageParser
+  where
+    unpack (Right msg) = [msg]
+    unpack (Left _) = []
diff --git a/src/Sarsi/Producer.hs b/src/Sarsi/Producer.hs
--- a/src/Sarsi/Producer.hs
+++ b/src/Sarsi/Producer.hs
@@ -1,67 +1,97 @@
 {-# LANGUAGE Rank2Types #-}
+
 module Sarsi.Producer where
 
-import Codec.Sarsi (Event(Start), putEvent)
-import Control.Exception (IOException, bracket, tryJust)
+import Codec.Sarsi (Event (..), Level (..), Message (..), putEvent)
 import Control.Concurrent.Async (async, cancel, wait)
 import Control.Concurrent.Chan (dupChan, newChan, readChan, writeChan)
 import Control.Concurrent.MVar (modifyMVar_, newMVar, readMVar)
 import Control.Concurrent.STM (atomically)
 import Control.Concurrent.STM.TQueue (newTQueue, tryReadTQueue, writeTQueue)
+import Control.Exception (IOException, bracket, tryJust)
 import Data.Binary.Machine (processPut)
-import Data.Machine (ProcessT, (<~), runT_, sinkPart_, prepended)
+import Data.List (foldl')
+import Data.Machine (ProcessT, prepended, runT_, (<~))
+import Data.Machine.Process (takingJusts)
 import Network.Socket (Socket, accept, bind, close, listen, socketToHandle)
-import Sarsi (Topic, createSocket, createSockAddr, removeTopic)
-import System.IO (IOMode(WriteMode), Handle, hClose)
-import System.IO.Machine (byChunk, sinkIO, sinkHandle, sourceIO)
+import Sarsi (Topic, createSockAddr, createSocket, removeTopic, title)
+import System.Console.ANSI
+import System.IO (Handle, IOMode (WriteMode), hClose)
+import System.IO.Machine (byChunk, sinkHandle, sinkIO, sourceIO)
 
+finishPrint :: Int -> Int -> IO ()
+finishPrint e w = do
+  setSGR (sgr e w)
+  putStr $ title
+  setSGR [Reset]
+  putStr $ ": "
+  putStrLn $ show event
+  where
+    sgr 0 0 = [SetColor Foreground Dull Green]
+    sgr 0 _ = [SetColor Foreground Dull Yellow]
+    sgr _ _ = [SetColor Foreground Vivid Red]
+    event = Finish e w
+
+finishCreate :: [Event] -> (Int, Int)
+finishCreate xs = foldl' f empty xs
+  where
+    empty = (0, 0)
+    f (e, w) (Notify (Message _ Warning _)) = (e, (w + 1))
+    f (e, w) (Notify (Message _ Error _)) = ((e + 1), w)
+    f finish _ = finish
+
 produce :: Topic -> (ProcessT IO Event Event -> IO a) -> IO a
 produce t f = do
-  conns   <- atomically $ newTQueue
-  chan    <- newChan
-  state   <- newMVar []
-  server  <- async $ bracket bindSock close (serve (process conns chan state))
-  feeder  <- async $ f $ sinkPart_ (\x -> (x, x)) (sinkIO $ feed chan state)
-  a       <- wait feeder
+  conns <- atomically $ newTQueue
+  chan <- newChan
+  state <- newMVar []
+  server <- async $ bracket bindSock close (serve (process conns chan state))
+  feeder <- async $ f (sinkIO $ feed chan state)
+  a <- wait feeder
+  es <- readMVar state
+  let (errs, warns) = finishCreate es
+  writeChan chan $ Just $ Finish errs warns
+  writeChan chan $ Nothing
+  finishPrint errs warns
   waitFinish conns
   cancel server
   removeTopic t
   return a
-    where
-      bindSock = do
-        sock  <- createSocket
-        addr  <- createSockAddr t
-        bind sock addr
-        listen sock 1
-        return sock
-      process conns chan' state h = do
-        chan <- dupChan chan'
-        es   <- readMVar state
-        conn <- async $ do
-          runT_ $ sinkHandle byChunk h <~ processPut putEvent <~ (prepended $ reverse es) <~ (sourceIO $ readChan chan)
-          hClose h
-        atomically $ writeTQueue conns conn
-        return Nothing
-      feed chan state e = do
-        modifyMVar_ state $ case e of
-          (Start _) -> const $ return [e]
-          _         -> return . (:) e
-        writeChan chan e
-      waitFinish conns = do
-        conn <- atomically $ tryReadTQueue conns
-        _    <- tryJust io $ maybe (return ()) wait conn
-        return ()
-          where
-            io :: IOException -> Maybe ()
-            io _ = Just ()
+  where
+    bindSock = do
+      sock <- createSocket
+      addr <- createSockAddr t
+      bind sock addr
+      listen sock 1
+      return sock
+    process conns chan' state h = do
+      chan <- dupChan chan'
+      es <- readMVar state
+      conn <- async $ do
+        runT_ $ sinkHandle byChunk h <~ processPut putEvent <~ (prepended $ reverse es) <~ takingJusts <~ (sourceIO $ readChan chan)
+        hClose h
+      atomically $ writeTQueue conns conn
+      return Nothing
+    feed chan state e = do
+      modifyMVar_ state $ case e of
+        (Start _) -> const $ return [e]
+        _ -> return . (:) e
+      writeChan chan $ Just e
+    waitFinish conns = do
+      conn <- atomically $ tryReadTQueue conns
+      _ <- tryJust io $ maybe (return ()) wait conn
+      return ()
+      where
+        io :: IOException -> Maybe ()
+        io _ = Just ()
 
 serve :: (Handle -> IO (Maybe a)) -> Socket -> IO a
 serve f sock = bracket acceptHandle hClose process
   where
     acceptHandle = do
       (conn, _) <- accept sock
-      h         <- socketToHandle conn WriteMode
+      h <- socketToHandle conn WriteMode
       return h
     process h = do
-      a         <- f h
+      a <- f h
       maybe (serve f sock) return a
diff --git a/src/Sarsi/Tools/Pipe.hs b/src/Sarsi/Tools/Pipe.hs
new file mode 100644
--- /dev/null
+++ b/src/Sarsi/Tools/Pipe.hs
@@ -0,0 +1,40 @@
+module Sarsi.Tools.Pipe where
+
+import Codec.Sarsi (Event (..), Message (..))
+import Codec.Sarsi.Curses (cleanLine, cleaningCurses)
+import Data.Attoparsec.Text.Machine (processParser)
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Char8 as ByteString
+import Data.Machine (MachineT, ProcessT, asParts, auto, autoM, prepended, runT_, (<~))
+import Data.Text (Text)
+import qualified Data.Text as Text
+import Data.Text.Encoding (decodeUtf8)
+import Sarsi (getBroker, getTopic)
+import Sarsi.Producer (produce)
+import System.Exit (ExitCode (ExitSuccess), exitWith)
+import System.IO (stdin, stdout)
+import System.IO.Machine (byLine, sourceHandle)
+
+pipe :: String -> ProcessT IO Text Message -> IO ()
+pipe lbl process =
+  pipeFrom lbl process $
+    autoM echo <~ (sourceHandle byLine stdin)
+  where
+    echo xs = ByteString.hPutStrLn stdout xs >> return xs
+
+pipeFrom :: String -> ProcessT IO Text Message -> MachineT IO k ByteString -> IO ()
+pipeFrom lbl process source = do
+  b <- getBroker
+  t <- getTopic b "."
+  produce t $ producer lbl process source
+  exitWith ExitSuccess
+
+producer :: String -> ProcessT IO Text Message -> MachineT IO k ByteString -> ProcessT IO Event Event -> IO ()
+producer lbl process source sink = do
+  runT_ $ pipeline <~ process <~ cleaning <~ auto decodeUtf8 <~ source
+  where
+    pipeline = sink <~ prepended [Start $ Text.pack lbl] <~ auto Notify
+    cleaning = asParts <~ auto unpack <~ processParser cleaningCurses <~ auto (\txt -> (cleanLine txt) `Text.snoc` '\n')
+      where
+        unpack (Right (_, txt)) = [txt]
+        unpack (Left _) = []
diff --git a/src/Sarsi/Tools/Shell.hs b/src/Sarsi/Tools/Shell.hs
deleted file mode 100644
--- a/src/Sarsi/Tools/Shell.hs
+++ /dev/null
@@ -1,61 +0,0 @@
-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
diff --git a/src/Sarsi/Tools/Trace.hs b/src/Sarsi/Tools/Trace.hs
--- a/src/Sarsi/Tools/Trace.hs
+++ b/src/Sarsi/Tools/Trace.hs
@@ -1,15 +1,29 @@
 module Sarsi.Tools.Trace where
 
-import Data.Machine ((<~), auto, runT_)
+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)
 
-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
+traceCleanCurses :: Handle -> IO ()
+traceCleanCurses h = runT_ $ autoM printing <~ preprocessing <~ appendLF <~ sourceHandle byLine h
+  where
+    printing (Right s) = TextIO.putStrLn s
+    printing e = putStrLn $ show e
+    preprocessing = streamParser cleaningCurses <~ asParts <~ auto unpackLine <~ asLines
+      where
+        asLines = streamParser $ SBT.untilLineBreak <* SBT.end
+    unpackLine (Right txt) = [(cleanLine txt) `Text.snoc` '\n']
+    unpackLine (Left _) = []
 
 traceHS :: Handle -> IO ()
 traceHS = traceParser GHC.messageParser
@@ -20,10 +34,12 @@
 traceSBT :: Handle -> IO ()
 traceSBT = traceParser SBT.eventParser
 
+traceSBTCurses :: Handle -> IO ()
+traceSBTCurses h = runT_ $ printer <~ SBTM.eventProcess' <~ appendLF <~ sourceHandle byLine h
+
 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')
-
+  runT_ $ printer <~ streamParser parser <~ appendLF <~ sourceHandle byLine h
 
+appendLF :: ProcessT IO Text Text
+appendLF = auto $ (`Text.snoc` '\n')