diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,13 @@ +Copyright 2015 Sebastian Witte + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. diff --git a/Neovim/Ghcid.hs b/Neovim/Ghcid.hs new file mode 100644 --- /dev/null +++ b/Neovim/Ghcid.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{- | +Module : Neovim.Ghcid +Description : Ghcid plugin +Copyright : (c) Sebastian Witte +License : Apache-2.0 + +Maintainer : woozletoff@gmail.com +Stability : experimental +Portability : GHC + +-} +module Neovim.Ghcid + where + +import Neovim + +import Neovim.Ghcid.Plugin +import qualified Data.Map as Map + +plugin :: Neovim (StartupConfig NeovimConfig) () NeovimPlugin +plugin = do + _ <- vim_command "sign define GhcidWarn text=>> texthl=Search" + _ <- vim_command "sign define GhcidErr text=!! texthl=ErrorMsg" + wrapPlugin Plugin + { exports = [] + , statefulExports = + [ ((), GhcidState Map.empty [], + [ $(command' 'ghcidStart) ["async", "!"] + , $(command' 'ghcidStop) ["async"] + , $(command' 'ghcidRestart) ["async"] + ]) + ] + } diff --git a/Neovim/Ghcid/Plugin.hs b/Neovim/Ghcid/Plugin.hs new file mode 100644 --- /dev/null +++ b/Neovim/Ghcid/Plugin.hs @@ -0,0 +1,249 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{- | +Module : Neovim.Ghcid.Plugin +Description : Ghcid quickfix integration plugin +Copyright : (c) Sebastian Witte +License : Apache-2.0 + +Maintainer : woozletoff@gmail.com +Stability : experimental +Portability : GHC + +-} +module Neovim.Ghcid.Plugin + where + +import Data.Yaml +import GHC.Generics +import Neovim +import Neovim.Quickfix as Q +import Neovim.User.Choice (yesOrNo) +import Neovim.User.Input + +import Language.Haskell.Ghcid as Ghcid + +import Control.Monad +import qualified Control.Monad.Trans.Resource as Resource +import qualified Data.ByteString as BS +import Data.Either (rights) +import Data.List (isSuffixOf, groupBy, sort) +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Maybe (mapMaybe) +import System.Directory +import System.FilePath + + +-- | 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@). + } + deriving (Eq, Ord, Show, Generic) + + +instance ToJSON ProjectSettings + + +instance FromJSON ProjectSettings + + +data GhcidState r = GhcidState + { startedSessions :: Map FilePath (Ghci, Neovim r (GhcidState r) ()) + -- ^ 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] + } + + +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) } + + +-- | 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 copts = do + currentBufferPath <- errOnInvalidResult $ 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." + Just s -> case bang copts of + Just True -> + startOrReload s + + _ -> do + d <- askForDirectory + "Specify directory from which ghcid should be started." + (Just (rootDir s)) + 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' + startOrReload s + + +-- | 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 () + + Just (Left a) -> + return a + + Just (Right rk) -> + return $ Resource.release rk + + modifyStartedSessions $ Map.insert d (g,ra >> liftIO (stopGhci g)) + + Just (ghci, _) -> do + applyQuickfixActions =<< loadToQuickfix <$> liftIO (reload ghci) + void $ vim_command "cwindow" + + +applyQuickfixActions :: [QuickfixListItem String] -> Neovim r (GhcidState r) () +applyQuickfixActions qs = do + fqs <- (nub' . rights . map bufOrFile) <$> gets quickfixItems + modify $ \s -> s { quickfixItems = 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 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.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 + ] + +-- | Stop a ghcid session associated to the currently active buffer. +ghcidStop :: CommandArguments -> Neovim r (GhcidState r) () +ghcidStop _ = do + d <- errOnInvalidResult $ vim_call_function "expand" [ObjectBinary "%:p:h"] + Map.lookupLE d <$> gets startedSessions >>= \case + Nothing -> + return () + Just (p,(_, releaseAction)) -> do + modifyStartedSessions $ Map.delete p + releaseAction + + +-- | Same as @:GhcidStop@ followed by @:GhcidStart!@. Note the bang! +ghcidRestart :: CommandArguments -> Neovim r (GhcidState r) () +ghcidRestart _ = do + ghcidStop def + 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 = Just $ ((snd . loadFilePos) m, True) + , 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' + + +-- | Calculate the list of all parent directories for the given directory. This +-- function also returns the initially specified directory. +allParentDirectories :: FilePath -> [FilePath] +allParentDirectories dir + | parentDir == dir = [dir] + | otherwise = dir : allParentDirectories parentDir + where + parentDir = takeDirectory dir + + +-- | 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 = do + msum <$> sequence [ customSettings, stack, plainCabal, cabalSandbox ] + where + searchDirectories = allParentDirectories dir + + cabalSandbox = fmap (\p -> (ProjectSettings (takeDirectory p) "cabal repl")) + <$> findFile searchDirectories "cabal.sandbox.config" + + stack = fmap (\p -> (ProjectSettings (takeDirectory p) "stack ghci")) + <$> findFile searchDirectories "stack.yaml" + + plainCabal = fmap msum <$> forM searchDirectories $ \d -> do + filter (".cabal" `isSuffixOf`) <$> getDirectoryContents d >>= \case + [x] -> do + isDir <- doesDirectoryExist (d x) -- ignore directoroies like /home/user/.cabal + return $ if isDir then Nothing else Just (ProjectSettings d "cabal repl") + _ -> + return Nothing + + customSettings = findFile searchDirectories "ghcid.yaml" >>= \case + Just cfg -> + decode <$> BS.readFile cfg + + Nothing -> + return Nothing + diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,36 @@ +# nvim-hs-ghcid + +Ghcid integration plugin for [`nvim-hs`](https://github.com/neovimhaskell/nvim-hs). + +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 + +Add the plugin to your `nvim-hs` config file. + +Sample configuration file: + +```haskell + +import Neovim + +import qualified Neovim.Ghcid as Ghcid + +main :: IO () +main = neovim defaultConfig + { plugins = defaultPlugins defaultConfig ++ [ Ghcid.plugin ] + } +``` +# Usage + +> :GhcidStart + +To initialize a Ghcid session which will fill the quickfix list on errors/warnings. If you add a bang, it will not ask you for the configuration and uses the last saved configuration for the project or guesses a configuration. + +> :GhcidStop + +Stop the Ghcid session for the project in which the current file resides. + +> :GhcidRestart + +Same as `:GhcidStop` followed by `:GhcidStart!`. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/nvim-hs-ghcid.cabal b/nvim-hs-ghcid.cabal new file mode 100644 --- /dev/null +++ b/nvim-hs-ghcid.cabal @@ -0,0 +1,52 @@ +name: nvim-hs-ghcid +version: 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 + warnings that ghcid determines. + . + The only limitation for this tool is that it needs a .cabal + file to work. + . + This plugin provides 3 commands: + . + @:GhcidStart@ will prompt you for the configuration you + want to use. It should guess a reasonable option based on + the files present in your project directory and so you will + just have to press enter all the time. If you provide a + bang, these questions will not be asked. + . + @:GhcidStop@ stops the current ghcid process. + . + @:GhcidRestart@ combines the two previous commands. + . + Simply import the @plugin@ definition from "Neovim.Ghcid" + and add it to your plugin list. + +homepage: https://github.com/saep/nvim-hs-ghcid +license: Apache-2.0 +license-file: LICENSE +author: Sebastian Witte +maintainer: woozletoff@gmail.com +copyright: Sebastian Witte +category: Editor +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + exposed-modules: Neovim.Ghcid, Neovim.Ghcid.Plugin + -- other-modules: + other-extensions: OverloadedStrings, TemplateHaskell, DeriveGeneric, LambdaCase + build-depends: base >=4.6 && <5 + , nvim-hs >=0.1.0 + , nvim-hs-contrib >=0.1.0 + , containers >=0.5 + , yaml + , ghcid >=0.6.1 + , resourcet + , bytestring + , directory + , filepath + -- hs-source-dirs: + default-language: Haskell2010