diff --git a/sarsi-nvim/Main.hs b/sarsi-nvim/Main.hs --- a/sarsi-nvim/Main.hs +++ b/sarsi-nvim/Main.hs @@ -44,6 +44,15 @@ } deriving (Show) +locationLast :: PluginState -> Maybe Location +locationLast s = + if Vector.null $ buildErrors s + then + if Vector.null $ buildWarnings s + then Nothing + else Just . fst $ Vector.last (buildWarnings s) + else Just . fst $ Vector.last (buildErrors s) + echo :: String -> Command echo str = NvimCommand [ObjectStr . Text.pack $ concat ["echo \"", str, "\""]] @@ -61,8 +70,19 @@ openLogFile :: Topic -> IO Handle openLogFile (Topic _ fp) = IO.openFile (concat [fp, "-nvim.log"]) WriteMode -parseAction :: (Text, [Object]) -> PluginAction -parseAction (m, _) = read $ Text.unpack m +parseAction :: Maybe Handle -> (Text, [Object]) -> IO [PluginAction] +parseAction _ (m, params) | m == method = return $ cmd =<< unpack =<< params + where + cmd (ObjectStr c) | Text.isPrefixOf c (Text.pack "cfirst") = [Focus] + cmd (ObjectStr c) | Text.isPrefixOf c (Text.pack "cnext") = [Next] + cmd (ObjectStr c) | Text.isPrefixOf c (Text.pack "cprevious") = [Previous] + cmd _ = [] + method = Text.pack "CmdlineLeave" + unpack (ObjectArray xs) = Vector.toList xs + unpack _ = [] +parseAction hLog x = do + putLogLn hLog $ concat ["unsupported notification: ", show x] + return [] parseArgs :: [String] -> Either String Bool parseArgs [] = Right False @@ -76,12 +96,6 @@ 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 @@ -96,7 +110,6 @@ 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 @@ -140,7 +153,6 @@ 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 @@ -191,11 +203,16 @@ actionFocus :: Maybe Handle -> CommandQueue -> TVar PluginState -> Level -> Int -> IO () actionFocus hLog q s' lvl rank = do s <- readTVarIO s' + active <- fixingIsActive hLog q s let (loc, txts) = focusContent lvl rank s - _ <- traverse (nvim_ hLog q) $ jumpTo loc - bufferSetLines q s' txts - bufferShow q s' $ length txts - return () + if not active + then return () + else do + _ <- traverse (nvim_ hLog q) $ jumpTo loc + bufferSetLines q s' txts + bufferShow q s' $ length txts + nvim_ hLog q $ echo $ concat [show lvl, ": ", show (rank + 1), "/", show . length $ messagesSelect s lvl] + return () actionMove :: Maybe Handle -> CommandQueue -> TVar PluginState -> (PluginState -> PluginState) -> IO () actionMove hLog q s' f = do @@ -209,6 +226,16 @@ Nothing -> return () Just (lvl, rank) -> actionFocus hLog q s' lvl rank +fixingIsActive :: Maybe Handle -> CommandQueue -> PluginState -> IO Bool +fixingIsActive hLog q s = do + qfLast <- nvim hLog q $ NvimCommandOutput [ObjectStr . Text.pack $ "clist -1"] + case (qfLast, (locationString <$> (locationLast s))) of + (Just (ObjectStr ln), Just loc) -> return $ not (Text.null . snd $ Text.breakOn (Text.pack loc) ln) + _ -> return False + where + locationString :: Location -> String + locationString (Location fp c l) = concat [Text.unpack fp, ":", show l, " col ", show c] + focusContent :: Level -> Int -> PluginState -> (Location, [Text]) focusContent lvl rank s = Vector.unsafeIndex xs rank where @@ -229,16 +256,19 @@ 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 | rank < 0 = f (toggle lvl) ((length $ select lvl) + rank) + f lvl rank | rank >= (length $ select lvl) = f (toggle lvl) (rank - (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 + select = messagesSelect s +messagesSelect :: PluginState -> Level -> Vector (Location, [Text]) +messagesSelect s Warning = buildWarnings s +messagesSelect s 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 @@ -256,12 +286,12 @@ qCmds <- atomically $ newTBQueue 8 qNotifs <- atomically $ newTBQueue 8 connClose <- mkConnection IO.stdin IO.stdout qCmds qNotifs (errHandler hLog) + nvim_ hLog qCmds $ NvimCommand [ObjectStr . Text.pack $ "au CmdlineLeave * call rpcnotify(g:sarsi, 'CmdlineLeave', [getcmdline()])"] (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 + autoM (notify hLog qCmds state) <~ asParts <~ (autoM $ parseAction hLog) <~ (sourceIO . atomically $ readTBQueue qNotifs) putLogLn hLog "ready" _ <- consumeOrWait t (consumer hLog state qCmds) cancel notifier @@ -276,7 +306,7 @@ case focus s of Nothing -> case focusDefault s of - Nothing -> nvim_ hLog q $ echom "nothing to fix" + Nothing -> return () Just (lvl, rank) -> do atomically . modifyTVar' s' $ \x -> x {focus = Just (lvl, rank)} actionFocus hLog q s' lvl rank diff --git a/sarsi-nvim/NVIM/Command.hs b/sarsi-nvim/NVIM/Command.hs --- a/sarsi-nvim/NVIM/Command.hs +++ b/sarsi-nvim/NVIM/Command.hs @@ -11,6 +11,7 @@ data Command = NvimBufSetLines Object Int Int Bool [Text] | NvimCommand [Object] + | NvimCommandOutput [Object] | NvimCallFunction Text [Object] | NvimCreateBuf Bool Bool -- {listed} {scratch} | NvimOpenWin Object Bool Object @@ -24,6 +25,8 @@ 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 (NvimCommandOutput xs) = + Request msgId (Text.pack "nvim_command_output") xs mkRequest msgId (NvimCallFunction m xs) = Request msgId (Text.pack "nvim_call_function") [ObjectStr m, ObjectArray (Vector.fromList xs)] mkRequest msgId (NvimCreateBuf l s) = diff --git a/sarsi-nvim/NVIM/QuickFix.hs b/sarsi-nvim/NVIM/QuickFix.hs --- a/sarsi-nvim/NVIM/QuickFix.hs +++ b/sarsi-nvim/NVIM/QuickFix.hs @@ -20,7 +20,7 @@ (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) + (ObjectStr $ Text.pack "text", ObjectStr $ head txts) ] ) where diff --git a/sarsi.cabal b/sarsi.cabal --- a/sarsi.cabal +++ b/sarsi.cabal @@ -1,5 +1,5 @@ name: sarsi -version: 0.0.5.1 +version: 0.0.5.2 synopsis: A universal quickfix toolkit and his protocol. description: Usage overview can be found in the .