diff --git a/Neovim/Ghcid.hs b/Neovim/Ghcid.hs --- a/Neovim/Ghcid.hs +++ b/Neovim/Ghcid.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} + {- | Module : Neovim.Ghcid Description : Ghcid plugin @@ -8,10 +9,8 @@ Maintainer : woozletoff@gmail.com Stability : experimental Portability : GHC - -} -module Neovim.Ghcid - where +module Neovim.Ghcid where import Neovim import Neovim.API.String @@ -23,11 +22,12 @@ _ <- vim_command "sign define GhcidWarn text=>> texthl=Search" _ <- vim_command "sign define GhcidErr text=!! texthl=ErrorMsg" env <- initGhcidEnv - wrapPlugin Plugin - { environment = env - , exports = - [ $(command' 'ghcidStart) ["async", "!"] - , $(command' 'ghcidStop) ["async"] - , $(command' 'ghcidRestart) ["async"] - ] - } + wrapPlugin + Plugin + { 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 @@ -1,4 +1,5 @@ -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveGeneric #-} + {- | Module : Neovim.Ghcid.Plugin Description : Ghcid quickfix integration plugin @@ -8,235 +9,224 @@ Maintainer : woozletoff@gmail.com Stability : experimental Portability : GHC - -} -module Neovim.Ghcid.Plugin - where +module Neovim.Ghcid.Plugin where -import Data.Yaml -import GHC.Generics -import Neovim -import Neovim.API.String -import Neovim.BuildTool -import Neovim.Quickfix as Q -import Neovim.User.Choice (yesOrNo) -import Neovim.User.Input +import Data.Yaml +import GHC.Generics +import Neovim +import Neovim.API.String +import Neovim.BuildTool +import Neovim.Quickfix as Q +import Neovim.User.Choice (yesOrNo) +import Neovim.User.Input -import Language.Haskell.Ghcid as Ghcid +import Language.Haskell.Ghcid as Ghcid -import Control.Monad -import Control.Monad.IO.Class -import Control.Monad.Trans.Maybe +import Control.Monad +import Control.Monad.IO.Class +import Control.Monad.Trans.Maybe import qualified Control.Monad.Trans.Resource as Resource -import qualified Data.ByteString as BS -import Data.Either (rights) -import Data.List (groupBy, sort) -import Data.Map.Strict (Map) -import qualified Data.Map.Strict as Map -import Data.Maybe (mapMaybe) -import System.FilePath -import UnliftIO.Exception (SomeException (..), catch) -import UnliftIO.STM - +import qualified Data.ByteString as BS +import Data.Either (rights) +import Data.List (groupBy, sort) +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Maybe (mapMaybe) +import System.FilePath +import UnliftIO.Exception (SomeException (..), catch) +import UnliftIO.STM -- | Simple data type containing a few information on how to start ghcid. data ProjectSettings = ProjectSettings - { rootDir :: FilePath - -- ^ Project directory from which ghcid can be started successfully. - -- - , cmd :: String - -- ^ Command to start a ghci session (usually @cabal repl@ or - -- @stack ghci@). - } + { -- | Project directory from which ghcid can be started successfully. + rootDir :: FilePath + , -- | Command to start a ghci session (usually @cabal repl@ or + -- @stack ghci@). + cmd :: String + } deriving (Eq, Ord, Show, Generic) - instance ToJSON ProjectSettings - instance FromJSON ProjectSettings - 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 :: TVar [QuickfixListItem String] + { -- | 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. + startedSessions :: TVar (Map FilePath (Ghci, Neovim GhcidEnv ())) + , quickfixItems :: TVar [QuickfixListItem String] } - 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 :: + ( 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. --- | 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. + 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 GhcidEnv () ghcidStart copts = do currentBufferPath <- fromObjectUnsafe <$> vim_call_function "expand" [ObjectBinary "%:p:h"] liftIO (determineProjectSettings' currentBufferPath) >>= \case - Nothing -> void $ - yesOrNo "Could not determine project settings. This plugin needs a project with a .cabal file to work." + Nothing -> + void $ + yesOrNo "Could not determine project settings. This plugin needs a project with a .cabal file to work." Just s -> case bang copts of Just True -> startOrReload s - _ -> do - d <- askForDirectory + d <- + askForDirectory "Specify directory from which ghcid should be started." (Just (rootDir s)) - c <- askForString + c <- + askForString "Specify the command to execute (e.g. \"ghci\")." (Just (cmd s)) let s' = ProjectSettings d c - whenM (yesOrNo "Save settings to file?") . - liftIO . BS.writeFile (d "ghcid.yaml") $ encode s' + whenM (yesOrNo "Save settings to file?") + . liftIO + . BS.writeFile (d "ghcid.yaml") + $ encode s' startOrReload s - --- | Start a new ghcid session or reload the modules to update the quickfix --- list. +{- | Start a new ghcid session or reload the modules to update the quickfix + list. +-} 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 + (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" Sync def (startOrReload s) >>= \case - Nothing -> - return $ return () - - Just (Left a) -> - return a - - Just (Right rk) -> - return $ Resource.release rk - - modifyStartedSessions $ Map.insert d (g,ra >> liftIO (stopGhci g)) + addAutocmd "BufWritePost" Sync def (startOrReload s) + modifyStartedSessions $ Map.insert d (g, liftIO (stopGhci g)) Just (ghci, _) -> do applyQuickfixActions =<< loadToQuickfix <$> liftIO (reload ghci) void $ vim_command "cwindow" - applyQuickfixActions :: [QuickfixListItem String] -> Neovim GhcidEnv () applyQuickfixActions qs = do 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 + 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 env () -placeSigns qs = forM_ (zip [(1::Integer)..] qs) $ \(i, q) -> case (lnumOrPattern q, bufOrFile q) of +placeSigns qs = forM_ (zip [(1 :: Integer) ..] qs) $ \(i, q) -> case (lnumOrPattern q, bufOrFile q) of (Right _, _) -> -- Patterns not handled as they are not produced return () - (_, Left _) -> -- Buffer type not handled because i don't know how to pass that here -- and it is not produced. return () - (Left lnum, Right f) -> do let signType = case errorType q of - Q.Error -> "GhcidErr" + Q.Error -> "GhcidErr" Q.Warning -> "GhcidWarn" -- TODO What if the file name contains spaces? - void . vim_command $ unwords - [ "sign place", show i, "line=" <> show lnum - , "name=" <> signType, "file=" <> f - ] + void $ + vim_command $ + unwords + [ "sign place" + , show i + , "line=" <> show lnum + , "name=" <> signType + , "file=" <> f + ] -- | Stop a ghcid session associated to the currently active buffer. ghcidStop :: CommandArguments -> Neovim GhcidEnv () ghcidStop _ = do d <- fromObjectUnsafe <$> vim_call_function "expand" [ObjectBinary "%:p:h"] - sessions <- atomically .readTVar =<< asks startedSessions + sessions <- atomically . readTVar =<< asks startedSessions case Map.lookupLE d sessions of Nothing -> return () - Just (p,(_, releaseAction)) -> do + Just (p, (_, releaseAction)) -> do modifyStartedSessions $ Map.delete p releaseAction - -- | Same as @:GhcidStop@ followed by @:GhcidStart!@. Note the bang! ghcidRestart :: CommandArguments -> Neovim GhcidEnv () ghcidRestart _ = do ghcidStop def - ghcidStart def { bang = Just True } - + ghcidStart def{bang = Just True} loadToQuickfix :: [Load] -> [QuickfixListItem String] loadToQuickfix = dropWarningsIfErrorsArePresent . mapMaybe f where f m@Message{} = - Just $ (quickfixListItem - ((Right . loadFile) m) - ((Left . fst . loadFilePos) m)) - { col = VisualColumn . snd $ loadFilePos m - , Q.text = (unlines . loadMessage) m - , errorType = case loadSeverity m of - Ghcid.Warning -> Q.Warning - _ -> Q.Error - } + Just $ + ( quickfixListItem + ((Right . loadFile) m) + ((Left . fst . loadFilePos) m) + ) + { col = VisualColumn . snd $ loadFilePos m + , Q.text = (unlines . loadMessage) m + , errorType = case loadSeverity m of + Ghcid.Warning -> Q.Warning + _ -> Q.Error + } f _ = Nothing dropWarningsIfErrorsArePresent xs = case filter ((== Q.Error) . errorType) xs of - [] -> xs + [] -> xs xs' -> xs' - maybePluginConfig :: MonadIO io => Directory -> io (Maybe BuildTool) -maybePluginConfig d = fmap (const Custom) - <$> mkFile (Just d) "ghcid.yaml" +maybePluginConfig d = + fmap (const Custom) + <$> mkFile (Just d) "ghcid.yaml" --- | Determine project settings for a directory. --- --- This will traverse through all parent directories and search for a hint on --- how to start the ghcid background process. The following configurations will --- be tried in this order: --- --- * A @ghcid.yaml@ file which can be created with the @GhcidStart@ command --- * A @stack.yaml@ file --- * A @cabal.sandbox.config@ file --- * A @\*.cabal@ file --- --- Note that 'ghcidStart' prompts for confirmation unless you prepend a bang. --- So, if you want to use your preferred settings, simply save them to the --- @ghcid.yaml@ file and you're done. +{- | Determine project settings for a directory. + + This will traverse through all parent directories and search for a hint on + how to start the ghcid background process. The following configurations will + be tried in this order: + + * A @ghcid.yaml@ file which can be created with the @GhcidStart@ command + * A @stack.yaml@ file + * A @cabal.sandbox.config@ file + * A @\*.cabal@ file + + Note that 'ghcidStart' prompts for confirmation unless you prepend a bang. + So, if you want to use your preferred settings, simply save them to the + @ghcid.yaml@ file and you're done. +-} determineProjectSettings' :: FilePath -> IO (Maybe ProjectSettings) determineProjectSettings' dir = runMaybeT $ do ds <- MaybeT $ fmap thisAndParentDirectories <$> mkDirectory dir buildTool <- MaybeT $ determineProjectSettings (maybePluginConfig : defaultProjectIdentifiers) ds case buildTool of - (Stack, d) -> return $ ProjectSettings (getDirectory d) "stack ghci" - (Cabal _, d) -> return $ ProjectSettings (getDirectory d) "cabal repl" - (Custom, d) -> do - f <- MaybeT $ mkFile (Just d) "ghcid.yaml" - MaybeT $ decodeThrow <$> BS.readFile (getFile f) - _ -> MaybeT $ return Nothing - - + (Stack, d) -> return $ ProjectSettings (getDirectory d) "stack ghci" + (Cabal _, d) -> return $ ProjectSettings (getDirectory d) "cabal repl" + (Custom, d) -> do + f <- MaybeT $ mkFile (Just d) "ghcid.yaml" + MaybeT $ decodeThrow <$> BS.readFile (getFile f) + _ -> MaybeT $ return Nothing diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,22 +4,21 @@ This plugin fills the quickfix list with location of compiler errors and warnings. Warnings are only added to the quickfix list if no errors are present. -# Installation +# Disclaimer -Add the plugin to your `nvim-hs` config file. +I don't know if anyone uses this plugin, but I (saep) have not been using it for years. I usually compile it and test it shortly if it stops compiling on stackage, but that's about it. It can still be a useful template to write your own plugin as it is as complicated as it gets for a plugin. -Sample configuration file: +If you want to have a development environment to program haskell in, try [haskell-language-server](https://github.com/haskell/haskell-language-server) which handles different compiler versions and has far more features. -```haskell +# Installation -import Neovim +You need [stack](https://github.com/commercialhaskell/stack) for the automatic compilation and starting of the plugin to work. -import qualified Neovim.Ghcid as Ghcid +Then add the plugin and its dependency to your `neovim` config file (Example uses [vim-plug](https://github.com/junegunn/vim-plug)): -main :: IO () -main = neovim defaultConfig - { plugins = defaultPlugins defaultConfig ++ [ Ghcid.plugin ] - } +```viml +Plug 'neovimhaskell/nvim-hs.vim' +Plug 'saep/nvim-hs-ghcid' ``` # Usage diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,3 @@ import Distribution.Simple + main = defaultMain diff --git a/executable/Main.hs b/executable/Main.hs --- a/executable/Main.hs +++ b/executable/Main.hs @@ -1,7 +1,7 @@ module Main where -import Neovim +import Neovim import qualified Neovim.Ghcid as Ghcid main :: IO () -main = neovim defaultConfig { plugins = [ Ghcid.plugin ] } +main = neovim defaultConfig{plugins = [Ghcid.plugin]} 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: 2.0.0.0 +version: 2.0.1.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