{-# LANGUAGE DeriveGeneric #-}

{- |
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.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 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

-- | Simple data type containing a few information on how to start ghcid.
data ProjectSettings = ProjectSettings
    { -- | Project directory from which ghcid can be started successfully.
      ProjectSettings -> FilePath
rootDir :: FilePath
    , -- | Command to start a ghci session (usually @cabal repl@ or
      -- @stack ghci@).
      ProjectSettings -> FilePath
cmd :: String
    }
    deriving (ProjectSettings -> ProjectSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectSettings -> ProjectSettings -> Bool
$c/= :: ProjectSettings -> ProjectSettings -> Bool
== :: ProjectSettings -> ProjectSettings -> Bool
$c== :: ProjectSettings -> ProjectSettings -> Bool
Eq, Eq ProjectSettings
ProjectSettings -> ProjectSettings -> Bool
ProjectSettings -> ProjectSettings -> Ordering
ProjectSettings -> ProjectSettings -> ProjectSettings
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ProjectSettings -> ProjectSettings -> ProjectSettings
$cmin :: ProjectSettings -> ProjectSettings -> ProjectSettings
max :: ProjectSettings -> ProjectSettings -> ProjectSettings
$cmax :: ProjectSettings -> ProjectSettings -> ProjectSettings
>= :: ProjectSettings -> ProjectSettings -> Bool
$c>= :: ProjectSettings -> ProjectSettings -> Bool
> :: ProjectSettings -> ProjectSettings -> Bool
$c> :: ProjectSettings -> ProjectSettings -> Bool
<= :: ProjectSettings -> ProjectSettings -> Bool
$c<= :: ProjectSettings -> ProjectSettings -> Bool
< :: ProjectSettings -> ProjectSettings -> Bool
$c< :: ProjectSettings -> ProjectSettings -> Bool
compare :: ProjectSettings -> ProjectSettings -> Ordering
$ccompare :: ProjectSettings -> ProjectSettings -> Ordering
Ord, Int -> ProjectSettings -> ShowS
[ProjectSettings] -> ShowS
ProjectSettings -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProjectSettings] -> ShowS
$cshowList :: [ProjectSettings] -> ShowS
show :: ProjectSettings -> FilePath
$cshow :: ProjectSettings -> FilePath
showsPrec :: Int -> ProjectSettings -> ShowS
$cshowsPrec :: Int -> ProjectSettings -> ShowS
Show, forall x. Rep ProjectSettings x -> ProjectSettings
forall x. ProjectSettings -> Rep ProjectSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProjectSettings x -> ProjectSettings
$cfrom :: forall x. ProjectSettings -> Rep ProjectSettings x
Generic)

instance ToJSON ProjectSettings

instance FromJSON ProjectSettings

data GhcidEnv = 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.
      GhcidEnv -> TVar (Map FilePath (Ghci, Neovim GhcidEnv ()))
startedSessions :: TVar (Map FilePath (Ghci, Neovim GhcidEnv ()))
    , GhcidEnv -> TVar [QuickfixListItem FilePath]
quickfixItems :: TVar [QuickfixListItem String]
    }

initGhcidEnv :: MonadIO m => m GhcidEnv
initGhcidEnv :: forall (m :: * -> *). MonadIO m => m GhcidEnv
initGhcidEnv = TVar (Map FilePath (Ghci, Neovim GhcidEnv ()))
-> TVar [QuickfixListItem FilePath] -> GhcidEnv
GhcidEnv forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO forall a. Monoid a => a
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 Map FilePath (Ghci, Neovim GhcidEnv ())
-> Map FilePath (Ghci, Neovim GhcidEnv ())
f = do
    forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' Map FilePath (Ghci, Neovim GhcidEnv ())
-> Map FilePath (Ghci, Neovim GhcidEnv ())
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks GhcidEnv -> TVar (Map FilePath (Ghci, Neovim GhcidEnv ()))
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 GhcidEnv ()
ghcidStart :: CommandArguments -> Neovim GhcidEnv ()
ghcidStart CommandArguments
copts = do
    FilePath
currentBufferPath <- forall o. NvimObject o => Object -> o
fromObjectUnsafe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [Object] -> forall env. Neovim env Object
vim_call_function FilePath
"expand" [ByteString -> Object
ObjectBinary ByteString
"%:p:h"]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO (Maybe ProjectSettings)
determineProjectSettings' FilePath
currentBufferPath) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe ProjectSettings
Nothing ->
            forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
                forall env. FilePath -> Neovim env Bool
yesOrNo FilePath
"Could not determine project settings. This plugin needs a project with a .cabal file to work."
        Just ProjectSettings
s -> case CommandArguments -> Maybe Bool
bang CommandArguments
copts of
            Just Bool
True ->
                ProjectSettings -> Neovim GhcidEnv ()
startOrReload ProjectSettings
s
            Maybe Bool
_ -> do
                FilePath
d <-
                    forall env. FilePath -> Maybe FilePath -> Neovim env FilePath
askForDirectory
                        FilePath
"Specify directory from which ghcid should be started."
                        (forall a. a -> Maybe a
Just (ProjectSettings -> FilePath
rootDir ProjectSettings
s))
                FilePath
c <-
                    forall env. FilePath -> Maybe FilePath -> Neovim env FilePath
askForString
                        FilePath
"Specify the command to execute (e.g. \"ghci\")."
                        (forall a. a -> Maybe a
Just (ProjectSettings -> FilePath
cmd ProjectSettings
s))

                let s' :: ProjectSettings
s' = FilePath -> FilePath -> ProjectSettings
ProjectSettings FilePath
d FilePath
c
                forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (forall env. FilePath -> Neovim env Bool
yesOrNo FilePath
"Save settings to file?")
                    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
                    forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString -> IO ()
BS.writeFile (FilePath
d FilePath -> ShowS
</> FilePath
"ghcid.yaml")
                    forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode ProjectSettings
s'
                ProjectSettings -> Neovim GhcidEnv ()
startOrReload ProjectSettings
s

{- | Start a new ghcid session or reload the modules to update the quickfix
 list.
-}
startOrReload :: ProjectSettings -> Neovim GhcidEnv ()
startOrReload :: ProjectSettings -> Neovim GhcidEnv ()
startOrReload s :: ProjectSettings
s@(ProjectSettings FilePath
d FilePath
c) = do
    Map FilePath (Ghci, Neovim GhcidEnv ())
sessions <- forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TVar a -> STM a
readTVar forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks GhcidEnv -> TVar (Map FilePath (Ghci, Neovim GhcidEnv ()))
startedSessions
    case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FilePath
d Map FilePath (Ghci, Neovim GhcidEnv ())
sessions of
        Maybe (Ghci, Neovim GhcidEnv ())
Nothing -> do
            (Ghci
g, [Load]
ls) <-
                forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath
-> Maybe FilePath
-> (Stream -> FilePath -> IO ())
-> IO (Ghci, [Load])
startGhci FilePath
c (forall a. a -> Maybe a
Just FilePath
d) (\Stream
_ FilePath
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()))
                    forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \(SomeException e
e) -> forall env a. Doc AnsiStyle -> Neovim env a
err forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ FilePath
"Failed to start ghcid session: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show e
e
            [QuickfixListItem FilePath] -> Neovim GhcidEnv ()
applyQuickfixActions forall a b. (a -> b) -> a -> b
$ [Load] -> [QuickfixListItem FilePath]
loadToQuickfix [Load]
ls
            forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ FilePath -> forall env. Neovim env ()
vim_command FilePath
"cwindow"
            forall env.
Text
-> Synchronous
-> AutocmdOptions
-> Neovim env ()
-> Neovim env (Either (Doc AnsiStyle) FunctionMapEntry)
addAutocmd Text
"BufWritePost" Synchronous
Sync forall a. Default a => a
def (ProjectSettings -> Neovim GhcidEnv ()
startOrReload ProjectSettings
s) 

            (Map FilePath (Ghci, Neovim GhcidEnv ())
 -> Map FilePath (Ghci, Neovim GhcidEnv ()))
-> Neovim GhcidEnv ()
modifyStartedSessions forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FilePath
d (Ghci
g, forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ghci -> IO ()
stopGhci Ghci
g))
        Just (Ghci
ghci, Neovim GhcidEnv ()
_) -> do
            [QuickfixListItem FilePath] -> Neovim GhcidEnv ()
applyQuickfixActions forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Load] -> [QuickfixListItem FilePath]
loadToQuickfix forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ghci -> IO [Load]
reload Ghci
ghci)
            forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ FilePath -> forall env. Neovim env ()
vim_command FilePath
"cwindow"

applyQuickfixActions :: [QuickfixListItem String] -> Neovim GhcidEnv ()
applyQuickfixActions :: [QuickfixListItem FilePath] -> Neovim GhcidEnv ()
applyQuickfixActions [QuickfixListItem FilePath]
qs = do
    TVar [QuickfixListItem FilePath]
qfItems <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks GhcidEnv -> TVar [QuickfixListItem FilePath]
quickfixItems
    [FilePath]
fqs <- ([FilePath] -> [FilePath]
nub' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [Either a b] -> [b]
rights forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall strType. QuickfixListItem strType -> Either Int strType
bufOrFile) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (forall a. TVar a -> STM a
readTVar TVar [QuickfixListItem FilePath]
qfItems)
    forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar [QuickfixListItem FilePath]
qfItems (forall a b. a -> b -> a
const [QuickfixListItem FilePath]
qs)
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
fqs forall a b. (a -> b) -> a -> b
$ \FilePath
f -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ FilePath -> forall env. Neovim env ()
vim_command forall a b. (a -> b) -> a -> b
$ FilePath
"sign unplace * file=" forall a. Semigroup a => a -> a -> a
<> FilePath
f
    forall strType env.
(Monoid strType, NvimObject strType) =>
[QuickfixListItem strType] -> QuickfixAction -> Neovim env ()
setqflist [QuickfixListItem FilePath]
qs QuickfixAction
Replace
    forall env. [QuickfixListItem FilePath] -> Neovim env ()
placeSigns [QuickfixListItem FilePath]
qs
  where
    nub' :: [FilePath] -> [FilePath]
nub' = forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort

placeSigns :: [QuickfixListItem String] -> Neovim env ()
placeSigns :: forall env. [QuickfixListItem FilePath] -> Neovim env ()
placeSigns [QuickfixListItem FilePath]
qs = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [(Integer
1 :: Integer) ..] [QuickfixListItem FilePath]
qs) forall a b. (a -> b) -> a -> b
$ \(Integer
i, QuickfixListItem FilePath
q) -> case (forall strType. QuickfixListItem strType -> Either Int strType
lnumOrPattern QuickfixListItem FilePath
q, forall strType. QuickfixListItem strType -> Either Int strType
bufOrFile QuickfixListItem FilePath
q) of
    (Right FilePath
_, Either Int FilePath
_) ->
        -- Patterns not handled as they are not produced
        forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (Either Int FilePath
_, Left Int
_) ->
        -- Buffer type not handled because i don't know how to pass that here
        -- and it is not produced.
        forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (Left Int
lnum, Right FilePath
f) -> do
        let signType :: FilePath
signType = case forall strType. QuickfixListItem strType -> QuickfixErrorType
errorType QuickfixListItem FilePath
q of
                QuickfixErrorType
Q.Error -> FilePath
"GhcidErr"
                QuickfixErrorType
Q.Warning -> FilePath
"GhcidWarn"

        -- TODO What if the file name contains spaces?
        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
            FilePath -> forall env. Neovim env ()
vim_command forall a b. (a -> b) -> a -> b
$
                [FilePath] -> FilePath
unwords
                    [ FilePath
"sign place"
                    , forall a. Show a => a -> FilePath
show Integer
i
                    , FilePath
"line=" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Int
lnum
                    , FilePath
"name=" forall a. Semigroup a => a -> a -> a
<> FilePath
signType
                    , FilePath
"file=" forall a. Semigroup a => a -> a -> a
<> FilePath
f
                    ]

-- | Stop a ghcid session associated to the currently active buffer.
ghcidStop :: CommandArguments -> Neovim GhcidEnv ()
ghcidStop :: CommandArguments -> Neovim GhcidEnv ()
ghcidStop CommandArguments
_ = do
    FilePath
d <- forall o. NvimObject o => Object -> o
fromObjectUnsafe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [Object] -> forall env. Neovim env Object
vim_call_function FilePath
"expand" [ByteString -> Object
ObjectBinary ByteString
"%:p:h"]
    Map FilePath (Ghci, Neovim GhcidEnv ())
sessions <- forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TVar a -> STM a
readTVar forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks GhcidEnv -> TVar (Map FilePath (Ghci, Neovim GhcidEnv ()))
startedSessions
    case forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupLE FilePath
d Map FilePath (Ghci, Neovim GhcidEnv ())
sessions of
        Maybe (FilePath, (Ghci, Neovim GhcidEnv ()))
Nothing ->
            forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just (FilePath
p, (Ghci
_, Neovim GhcidEnv ()
releaseAction)) -> do
            (Map FilePath (Ghci, Neovim GhcidEnv ())
 -> Map FilePath (Ghci, Neovim GhcidEnv ()))
-> Neovim GhcidEnv ()
modifyStartedSessions forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Map k a
Map.delete FilePath
p
            Neovim GhcidEnv ()
releaseAction

-- | Same as @:GhcidStop@ followed by @:GhcidStart!@. Note the bang!
ghcidRestart :: CommandArguments -> Neovim GhcidEnv ()
ghcidRestart :: CommandArguments -> Neovim GhcidEnv ()
ghcidRestart CommandArguments
_ = do
    CommandArguments -> Neovim GhcidEnv ()
ghcidStop forall a. Default a => a
def
    CommandArguments -> Neovim GhcidEnv ()
ghcidStart forall a. Default a => a
def{bang :: Maybe Bool
bang = forall a. a -> Maybe a
Just Bool
True}

loadToQuickfix :: [Load] -> [QuickfixListItem String]
loadToQuickfix :: [Load] -> [QuickfixListItem FilePath]
loadToQuickfix = forall {strType}.
[QuickfixListItem strType] -> [QuickfixListItem strType]
dropWarningsIfErrorsArePresent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Load -> Maybe (QuickfixListItem FilePath)
f
  where
    f :: Load -> Maybe (QuickfixListItem FilePath)
f m :: Load
m@Message{} =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
            ( forall strType.
Monoid strType =>
Either Int strType
-> Either Int strType -> QuickfixListItem strType
quickfixListItem
                ((forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Load -> FilePath
loadFile) Load
m)
                ((forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Load -> (Int, Int)
loadFilePos) Load
m)
            )
                { col :: ColumnNumber
col = Int -> ColumnNumber
VisualColumn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ Load -> (Int, Int)
loadFilePos Load
m
                , text :: FilePath
Q.text = ([FilePath] -> FilePath
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. Load -> [FilePath]
loadMessage) Load
m
                , errorType :: QuickfixErrorType
errorType = case Load -> Severity
loadSeverity Load
m of
                    Severity
Ghcid.Warning -> QuickfixErrorType
Q.Warning
                    Severity
_ -> QuickfixErrorType
Q.Error
                }
    f Load
_ = forall a. Maybe a
Nothing

    dropWarningsIfErrorsArePresent :: [QuickfixListItem strType] -> [QuickfixListItem strType]
dropWarningsIfErrorsArePresent [QuickfixListItem strType]
xs =
        case forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== QuickfixErrorType
Q.Error) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall strType. QuickfixListItem strType -> QuickfixErrorType
errorType) [QuickfixListItem strType]
xs of
            [] -> [QuickfixListItem strType]
xs
            [QuickfixListItem strType]
xs' -> [QuickfixListItem strType]
xs'

maybePluginConfig :: MonadIO io => Directory -> io (Maybe BuildTool)
maybePluginConfig :: forall (io :: * -> *).
MonadIO io =>
Directory -> io (Maybe BuildTool)
maybePluginConfig Directory
d =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const BuildTool
Custom)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (io :: * -> *).
MonadIO io =>
Maybe Directory -> FilePath -> io (Maybe File)
mkFile (forall a. a -> Maybe a
Just Directory
d) FilePath
"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.
-}
determineProjectSettings' :: FilePath -> IO (Maybe ProjectSettings)
determineProjectSettings' :: FilePath -> IO (Maybe ProjectSettings)
determineProjectSettings' FilePath
dir = forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
    [Directory]
ds <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Directory -> [Directory]
thisAndParentDirectories forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (io :: * -> *).
MonadIO io =>
FilePath -> io (Maybe Directory)
mkDirectory FilePath
dir
    (BuildTool, Directory)
buildTool <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (io :: * -> *).
MonadIO io =>
[Directory -> io (Maybe BuildTool)]
-> [Directory] -> io (Maybe (BuildTool, Directory))
determineProjectSettings (forall (io :: * -> *).
MonadIO io =>
Directory -> io (Maybe BuildTool)
maybePluginConfig forall a. a -> [a] -> [a]
: forall (io :: * -> *).
MonadIO io =>
[Directory -> io (Maybe BuildTool)]
defaultProjectIdentifiers) [Directory]
ds
    case (BuildTool, Directory)
buildTool of
        (BuildTool
Stack, Directory
d) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> ProjectSettings
ProjectSettings (Directory -> FilePath
getDirectory Directory
d) FilePath
"stack ghci"
        (Cabal CabalType
_, Directory
d) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> ProjectSettings
ProjectSettings (Directory -> FilePath
getDirectory Directory
d) FilePath
"cabal repl"
        (BuildTool
Custom, Directory
d) -> do
            File
f <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (io :: * -> *).
MonadIO io =>
Maybe Directory -> FilePath -> io (Maybe File)
mkFile (forall a. a -> Maybe a
Just Directory
d) FilePath
"ghcid.yaml"
            forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
ByteString -> m a
decodeThrow forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
BS.readFile (File -> FilePath
getFile File
f)
        (BuildTool, Directory)
_ -> forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing