diff --git a/Neovim/Ghcid.hs b/Neovim/Ghcid.hs --- a/Neovim/Ghcid.hs +++ b/Neovim/Ghcid.hs @@ -17,23 +17,17 @@ import Neovim import Neovim.Ghcid.Plugin -import qualified Data.Map as Map -plugin :: Neovim (StartupConfig NeovimConfig) () NeovimPlugin +plugin :: Neovim (StartupConfig NeovimConfig) NeovimPlugin plugin = do _ <- vim_command "sign define GhcidWarn text=>> texthl=Search" _ <- vim_command "sign define GhcidErr text=!! texthl=ErrorMsg" + env <- initGhcidEnv wrapPlugin Plugin - { exports = [] - , statefulExports = - [ StatefulFunctionality - { readOnly = () - , writable = GhcidState Map.empty [] - , functionalities = - [ $(command' 'ghcidStart) ["async", "!"] - , $(command' 'ghcidStop) ["async"] - , $(command' 'ghcidRestart) ["async"] - ] - } + { environment = env + , exports = + [ $(command' 'ghcidStart) ["async", "!"] + , $(command' 'ghcidStop) ["async"] + , $(command' 'ghcidRestart) ["async"] ] } diff --git a/Neovim/Ghcid/Plugin.hs b/Neovim/Ghcid/Plugin.hs --- a/Neovim/Ghcid/Plugin.hs +++ b/Neovim/Ghcid/Plugin.hs @@ -36,6 +36,8 @@ import qualified Data.Map as Map import Data.Maybe (mapMaybe) import System.FilePath +import UnliftIO.STM +import UnliftIO.Exception (SomeException(..), catch) -- | Simple data type containing a few information on how to start ghcid. @@ -56,28 +58,32 @@ instance FromJSON ProjectSettings -data GhcidState r = GhcidState - { startedSessions :: Map FilePath (Ghci, Neovim r (GhcidState r) ()) +data GhcidEnv = GhcidEnv + { startedSessions :: TVar (Map FilePath (Ghci, Neovim GhcidEnv ())) -- ^ A map from the root directory (see 'rootDir') to a 'Ghci' session and a -- release function which unregisters some autocmds and stops the ghci -- session. - , quickfixItems :: [QuickfixListItem String] + , quickfixItems :: TVar [QuickfixListItem String] } -modifyStartedSessions :: (Map FilePath (Ghci, Neovim r (GhcidState r) ()) - -> Map FilePath (Ghci, Neovim r (GhcidState r) ())) - -> Neovim r (GhcidState r) () -modifyStartedSessions f = modify $ \s -> s { startedSessions = f (startedSessions s) } +initGhcidEnv :: MonadIO m => m GhcidEnv +initGhcidEnv = GhcidEnv <$> newTVarIO mempty <*> newTVarIO mempty +modifyStartedSessions :: (Map FilePath (Ghci, Neovim GhcidEnv ()) + -> Map FilePath (Ghci, Neovim GhcidEnv ())) + -> Neovim GhcidEnv () +modifyStartedSessions f = do + atomically . flip modifyTVar' f =<< asks startedSessions + -- | Start or update a ghcid session. -- -- This will call 'determineProjectSettings' and ask you to confirm or overwrite -- its proposed settings. If you prepend a bang, it acts as if you have -- confirmed all settings. -ghcidStart :: CommandArguments -> Neovim r (GhcidState r) () +ghcidStart :: CommandArguments -> Neovim GhcidEnv () ghcidStart copts = do currentBufferPath <- errOnInvalidResult $ vim_call_function "expand" [ObjectBinary "%:p:h"] liftIO (determineProjectSettings' currentBufferPath) >>= \case @@ -103,33 +109,37 @@ -- | Start a new ghcid session or reload the modules to update the quickfix -- list. -startOrReload :: ProjectSettings -> Neovim r (GhcidState r) () -startOrReload s@(ProjectSettings d c) = Map.lookup d <$> gets startedSessions >>= \case - Nothing -> do - (g, ls) <- liftIO $ startGhci c (Just d) (\_ _ -> return ()) - applyQuickfixActions $ loadToQuickfix ls - void $ vim_command "cwindow" - ra <- addAutocmd "BufWritePost" def (startOrReload s) >>= \case - Nothing -> - return $ return () +startOrReload :: ProjectSettings -> Neovim GhcidEnv () +startOrReload s@(ProjectSettings d c) = do + sessions <- atomically . readTVar =<< asks startedSessions + case Map.lookup d sessions of + Nothing -> do + (g, ls) <- liftIO (startGhci c (Just d) (\_ _ -> return ())) + `catch` \(SomeException e) -> err . pretty $ "Failed to start ghcid session: " <> show e + applyQuickfixActions $ loadToQuickfix ls + void $ vim_command "cwindow" + ra <- addAutocmd "BufWritePost" def (startOrReload s) >>= \case + Nothing -> + return $ return () - Just (Left a) -> - return a + Just (Left a) -> + return a - Just (Right rk) -> - return $ Resource.release rk + Just (Right rk) -> + return $ Resource.release rk - modifyStartedSessions $ Map.insert d (g,ra >> liftIO (stopGhci g)) + modifyStartedSessions $ Map.insert d (g,ra >> liftIO (stopGhci g)) - Just (ghci, _) -> do - applyQuickfixActions =<< loadToQuickfix <$> liftIO (reload ghci) - void $ vim_command "cwindow" + Just (ghci, _) -> do + applyQuickfixActions =<< loadToQuickfix <$> liftIO (reload ghci) + void $ vim_command "cwindow" -applyQuickfixActions :: [QuickfixListItem String] -> Neovim r (GhcidState r) () +applyQuickfixActions :: [QuickfixListItem String] -> Neovim GhcidEnv () applyQuickfixActions qs = do - fqs <- (nub' . rights . map bufOrFile) <$> gets quickfixItems - modify $ \s -> s { quickfixItems = qs } + qfItems <- asks quickfixItems + fqs <- (nub' . rights . map bufOrFile) <$> atomically (readTVar qfItems) + atomically $ modifyTVar' qfItems (const qs) forM_ fqs $ \f -> void . vim_command $ "sign unplace * file=" <> f setqflist qs Replace placeSigns qs @@ -137,7 +147,7 @@ nub' = map head . groupBy (==) . sort -placeSigns :: [QuickfixListItem String] -> Neovim r st () +placeSigns :: [QuickfixListItem String] -> Neovim env () placeSigns qs = forM_ (zip [(1::Integer)..] qs) $ \(i, q) -> case (lnumOrPattern q, bufOrFile q) of (Right _, _) -> -- Patterns not handled as they are not produced @@ -160,10 +170,11 @@ ] -- | Stop a ghcid session associated to the currently active buffer. -ghcidStop :: CommandArguments -> Neovim r (GhcidState r) () +ghcidStop :: CommandArguments -> Neovim GhcidEnv () ghcidStop _ = do d <- errOnInvalidResult $ vim_call_function "expand" [ObjectBinary "%:p:h"] - Map.lookupLE d <$> gets startedSessions >>= \case + sessions <- atomically .readTVar =<< asks startedSessions + case Map.lookupLE d sessions of Nothing -> return () Just (p,(_, releaseAction)) -> do @@ -172,7 +183,7 @@ -- | Same as @:GhcidStop@ followed by @:GhcidStart!@. Note the bang! -ghcidRestart :: CommandArguments -> Neovim r (GhcidState r) () +ghcidRestart :: CommandArguments -> Neovim GhcidEnv () ghcidRestart _ = do ghcidStop def ghcidStart def { bang = Just True } @@ -185,7 +196,7 @@ Just $ (quickfixListItem ((Right . loadFile) m) ((Left . fst . loadFilePos) m)) - { col = Just $ ((snd . loadFilePos) m, True) + { col = VisualColumn . snd $ loadFilePos m , Q.text = (unlines . loadMessage) m , errorType = case loadSeverity m of Ghcid.Warning -> Q.Warning diff --git a/nvim-hs-ghcid.cabal b/nvim-hs-ghcid.cabal --- a/nvim-hs-ghcid.cabal +++ b/nvim-hs-ghcid.cabal @@ -1,5 +1,5 @@ name: nvim-hs-ghcid -version: 0.2.0 +version: 1.0.0.0 synopsis: Neovim plugin that runs ghcid to update the quickfix list description: This plugin uses the nvim-hs plugin backend for neovim and fills the quickfix list on file-saves with the errors and @@ -39,8 +39,8 @@ -- other-modules: other-extensions: OverloadedStrings, TemplateHaskell, DeriveGeneric, LambdaCase build-depends: base >=4.6 && <5 - , nvim-hs >=0.2.0 - , nvim-hs-contrib >=0.2.0 + , nvim-hs >=1.0 && <2 + , nvim-hs-contrib >=1.0 && <2 , containers >=0.5 , yaml , ghcid >=0.6.1 @@ -49,5 +49,6 @@ , directory , filepath , transformers + , unliftio -- hs-source-dirs: default-language: Haskell2010