Adjust to changes in nvim-hs 1.0.0.0

Author: saep

Neovim/Ghcid.hs

@@ -17,23 +17,17 @@ module Neovim.Ghcid
 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"]
             ]
         }

Neovim/Ghcid/Plugin.hs

@@ -36,6 +36,8 @@ import           Data.Map                     (Map)
 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 ToJSON ProjectSettings
 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,41 +109,45 @@ ghcidStart copts = do
 
 -- | 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
   where
     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 @@ placeSigns qs = forM_ (zip [(1::Integer)..] qs) $ \(i, q) -> case (lnumOrPattern
             ]
 
 -- | 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 @@ ghcidStop _ = do
 
 
 -- | 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 }

nvim-hs-ghcid.cabal

@@ -1,5 +1,5 @@
 name:                nvim-hs-ghcid
-version:             0.2.1
+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 @@ library
   -- 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 @@ library
                      , directory
                      , filepath
                      , transformers
+                     , unliftio
   -- hs-source-dirs:
   default-language:    Haskell2010