module Neovim.BuildTool
where
import Neovim
import Data.List (isSuffixOf)
import Control.Monad.IO.Class
import GHC.Generics
import Data.Yaml
import System.Directory
import System.FilePath (takeDirectory, (</>))
data BuildTool
= Stack
| Cabal CabalType
| Shake
| Make
| Cmake
| Ninja
| Scons
| Custom
deriving (Show, Read, Eq, Ord, Generic)
instance ToJSON BuildTool
instance FromJSON BuildTool
data CabalType
= Plain
| Sandbox
| NewBuild
deriving (Show, Read, Eq, Ord, Enum, Generic)
instance ToJSON CabalType
instance FromJSON CabalType
newtype Directory = Directory { getDirectory :: FilePath }
deriving (Show, Eq, Ord)
partialM :: Monad m => (a -> m Bool) -> a -> m (Maybe a)
partialM fp a = fp a >>= \case
True -> return (Just a)
False -> return Nothing
mkDirectory :: MonadIO io => FilePath -> io (Maybe Directory)
mkDirectory mdir =
fmap Directory <$> partialM (liftIO . doesDirectoryExist) mdir
newtype File = File { getFile :: FilePath }
deriving (Show, Eq, Ord)
mkFile :: MonadIO io => Maybe Directory -> FilePath -> io (Maybe File)
mkFile mdir mfile =
let f = maybe mfile (\d -> getDirectory d </> mfile) mdir
in fmap File <$> partialM (liftIO . doesFileExist) f
thisAndParentDirectories :: Directory -> [Directory]
thisAndParentDirectories dir
| parentDir == dir = [dir]
| otherwise = dir : thisAndParentDirectories parentDir
where
parentDir = Directory . takeDirectory $ getDirectory dir
determineProjectSettings
:: MonadIO io
=> [Directory -> io (Maybe BuildTool)]
-> [Directory]
-> io (Maybe (BuildTool, Directory))
determineProjectSettings identifiers = go identifiers
where
go _ [] = return Nothing
go [] (_:ps) = go identifiers ps
go (i:is) pps@(p:_) = i p >>= \case
Just buildTool -> return (Just (buildTool, p))
Nothing -> go is pps
defaultProjectIdentifiers :: MonadIO io => [Directory -> io (Maybe BuildTool)]
defaultProjectIdentifiers =
[ maybeCabalSandbox, maybeStack, maybeCabal ]
guessProjectSettings :: MonadIO io
=> [Directory]
-> io (Maybe (BuildTool, Directory))
guessProjectSettings = determineProjectSettings defaultProjectIdentifiers
maybeStack :: MonadIO io => Directory -> io (Maybe BuildTool)
maybeStack d = fmap (const Stack) <$> mkFile (Just d) "stack.yaml"
maybeCabalSandbox :: MonadIO io => Directory -> io (Maybe BuildTool)
maybeCabalSandbox d = fmap (const (Cabal Sandbox))
<$> mkFile (Just d) "cabal.sandbox.config"
maybeCabal :: MonadIO io => Directory -> io (Maybe BuildTool)
maybeCabal d = do
ls <- liftIO . getDirectoryContents $ getDirectory d
go $ filter (".cabal" `isSuffixOf`)ls
where
go [] = return Nothing
go (f:fs) = mkFile (Just d) f >>= \case
Nothing -> go fs
Just _ ->
return $ Just (Cabal Plain)