{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DeriveGeneric #-}
{- |
Module      :  Neovim.BuildTool
Description :  Utilities and types to manage build tool dependent things
Copyright   :  (c) Sebastian Witte
License     :  Apache-2.0

Maintainer  :  woozletoff@gmail.com
Stability   :  experimental
Portability :  GHC

-}
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 (Int -> BuildTool -> ShowS
[BuildTool] -> ShowS
BuildTool -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BuildTool] -> ShowS
$cshowList :: [BuildTool] -> ShowS
show :: BuildTool -> String
$cshow :: BuildTool -> String
showsPrec :: Int -> BuildTool -> ShowS
$cshowsPrec :: Int -> BuildTool -> ShowS
Show, ReadPrec [BuildTool]
ReadPrec BuildTool
Int -> ReadS BuildTool
ReadS [BuildTool]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BuildTool]
$creadListPrec :: ReadPrec [BuildTool]
readPrec :: ReadPrec BuildTool
$creadPrec :: ReadPrec BuildTool
readList :: ReadS [BuildTool]
$creadList :: ReadS [BuildTool]
readsPrec :: Int -> ReadS BuildTool
$creadsPrec :: Int -> ReadS BuildTool
Read, BuildTool -> BuildTool -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BuildTool -> BuildTool -> Bool
$c/= :: BuildTool -> BuildTool -> Bool
== :: BuildTool -> BuildTool -> Bool
$c== :: BuildTool -> BuildTool -> Bool
Eq, Eq BuildTool
BuildTool -> BuildTool -> Bool
BuildTool -> BuildTool -> Ordering
BuildTool -> BuildTool -> BuildTool
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 :: BuildTool -> BuildTool -> BuildTool
$cmin :: BuildTool -> BuildTool -> BuildTool
max :: BuildTool -> BuildTool -> BuildTool
$cmax :: BuildTool -> BuildTool -> BuildTool
>= :: BuildTool -> BuildTool -> Bool
$c>= :: BuildTool -> BuildTool -> Bool
> :: BuildTool -> BuildTool -> Bool
$c> :: BuildTool -> BuildTool -> Bool
<= :: BuildTool -> BuildTool -> Bool
$c<= :: BuildTool -> BuildTool -> Bool
< :: BuildTool -> BuildTool -> Bool
$c< :: BuildTool -> BuildTool -> Bool
compare :: BuildTool -> BuildTool -> Ordering
$ccompare :: BuildTool -> BuildTool -> Ordering
Ord, forall x. Rep BuildTool x -> BuildTool
forall x. BuildTool -> Rep BuildTool x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BuildTool x -> BuildTool
$cfrom :: forall x. BuildTool -> Rep BuildTool x
Generic)

instance ToJSON BuildTool
instance FromJSON BuildTool

data CabalType
    = Plain
    | Sandbox
    | NewBuild
    deriving (Int -> CabalType -> ShowS
[CabalType] -> ShowS
CabalType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CabalType] -> ShowS
$cshowList :: [CabalType] -> ShowS
show :: CabalType -> String
$cshow :: CabalType -> String
showsPrec :: Int -> CabalType -> ShowS
$cshowsPrec :: Int -> CabalType -> ShowS
Show, ReadPrec [CabalType]
ReadPrec CabalType
Int -> ReadS CabalType
ReadS [CabalType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CabalType]
$creadListPrec :: ReadPrec [CabalType]
readPrec :: ReadPrec CabalType
$creadPrec :: ReadPrec CabalType
readList :: ReadS [CabalType]
$creadList :: ReadS [CabalType]
readsPrec :: Int -> ReadS CabalType
$creadsPrec :: Int -> ReadS CabalType
Read, CabalType -> CabalType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CabalType -> CabalType -> Bool
$c/= :: CabalType -> CabalType -> Bool
== :: CabalType -> CabalType -> Bool
$c== :: CabalType -> CabalType -> Bool
Eq, Eq CabalType
CabalType -> CabalType -> Bool
CabalType -> CabalType -> Ordering
CabalType -> CabalType -> CabalType
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 :: CabalType -> CabalType -> CabalType
$cmin :: CabalType -> CabalType -> CabalType
max :: CabalType -> CabalType -> CabalType
$cmax :: CabalType -> CabalType -> CabalType
>= :: CabalType -> CabalType -> Bool
$c>= :: CabalType -> CabalType -> Bool
> :: CabalType -> CabalType -> Bool
$c> :: CabalType -> CabalType -> Bool
<= :: CabalType -> CabalType -> Bool
$c<= :: CabalType -> CabalType -> Bool
< :: CabalType -> CabalType -> Bool
$c< :: CabalType -> CabalType -> Bool
compare :: CabalType -> CabalType -> Ordering
$ccompare :: CabalType -> CabalType -> Ordering
Ord, Int -> CabalType
CabalType -> Int
CabalType -> [CabalType]
CabalType -> CabalType
CabalType -> CabalType -> [CabalType]
CabalType -> CabalType -> CabalType -> [CabalType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CabalType -> CabalType -> CabalType -> [CabalType]
$cenumFromThenTo :: CabalType -> CabalType -> CabalType -> [CabalType]
enumFromTo :: CabalType -> CabalType -> [CabalType]
$cenumFromTo :: CabalType -> CabalType -> [CabalType]
enumFromThen :: CabalType -> CabalType -> [CabalType]
$cenumFromThen :: CabalType -> CabalType -> [CabalType]
enumFrom :: CabalType -> [CabalType]
$cenumFrom :: CabalType -> [CabalType]
fromEnum :: CabalType -> Int
$cfromEnum :: CabalType -> Int
toEnum :: Int -> CabalType
$ctoEnum :: Int -> CabalType
pred :: CabalType -> CabalType
$cpred :: CabalType -> CabalType
succ :: CabalType -> CabalType
$csucc :: CabalType -> CabalType
Enum, forall x. Rep CabalType x -> CabalType
forall x. CabalType -> Rep CabalType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CabalType x -> CabalType
$cfrom :: forall x. CabalType -> Rep CabalType x
Generic)

instance ToJSON CabalType
instance FromJSON CabalType

newtype Directory = Directory { Directory -> String
getDirectory :: FilePath }
    deriving (Int -> Directory -> ShowS
[Directory] -> ShowS
Directory -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Directory] -> ShowS
$cshowList :: [Directory] -> ShowS
show :: Directory -> String
$cshow :: Directory -> String
showsPrec :: Int -> Directory -> ShowS
$cshowsPrec :: Int -> Directory -> ShowS
Show, Directory -> Directory -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Directory -> Directory -> Bool
$c/= :: Directory -> Directory -> Bool
== :: Directory -> Directory -> Bool
$c== :: Directory -> Directory -> Bool
Eq, Eq Directory
Directory -> Directory -> Bool
Directory -> Directory -> Ordering
Directory -> Directory -> Directory
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 :: Directory -> Directory -> Directory
$cmin :: Directory -> Directory -> Directory
max :: Directory -> Directory -> Directory
$cmax :: Directory -> Directory -> Directory
>= :: Directory -> Directory -> Bool
$c>= :: Directory -> Directory -> Bool
> :: Directory -> Directory -> Bool
$c> :: Directory -> Directory -> Bool
<= :: Directory -> Directory -> Bool
$c<= :: Directory -> Directory -> Bool
< :: Directory -> Directory -> Bool
$c< :: Directory -> Directory -> Bool
compare :: Directory -> Directory -> Ordering
$ccompare :: Directory -> Directory -> Ordering
Ord)


-- | If the monadic boolean predicate returns true, wrap the given object in a
-- 'Just' constructor, otherwise return 'Nothing'.
partialM :: Monad m => (a -> m Bool) -> a -> m (Maybe a)
partialM :: forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> a -> m (Maybe a)
partialM a -> m Bool
fp a
a = a -> m Bool
fp a
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
a)
    Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- | Create 'Just' a 'Directory' value if the given filepath exists and
-- otherwise return 'Nothing'. This method does not create an actual directory
-- on your file system.
mkDirectory :: MonadIO io => FilePath -> io (Maybe Directory)
mkDirectory :: forall (io :: * -> *). MonadIO io => String -> io (Maybe Directory)
mkDirectory String
mdir =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Directory
Directory forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> a -> m (Maybe a)
partialM (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Bool
doesDirectoryExist) String
mdir

newtype File = File { File -> String
getFile :: FilePath }
    deriving (Int -> File -> ShowS
[File] -> ShowS
File -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [File] -> ShowS
$cshowList :: [File] -> ShowS
show :: File -> String
$cshow :: File -> String
showsPrec :: Int -> File -> ShowS
$cshowsPrec :: Int -> File -> ShowS
Show, File -> File -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: File -> File -> Bool
$c/= :: File -> File -> Bool
== :: File -> File -> Bool
$c== :: File -> File -> Bool
Eq, Eq File
File -> File -> Bool
File -> File -> Ordering
File -> File -> File
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 :: File -> File -> File
$cmin :: File -> File -> File
max :: File -> File -> File
$cmax :: File -> File -> File
>= :: File -> File -> Bool
$c>= :: File -> File -> Bool
> :: File -> File -> Bool
$c> :: File -> File -> Bool
<= :: File -> File -> Bool
$c<= :: File -> File -> Bool
< :: File -> File -> Bool
$c< :: File -> File -> Bool
compare :: File -> File -> Ordering
$ccompare :: File -> File -> Ordering
Ord)

-- | Create 'Just' a 'File' value if the given file exists and is not a
-- directory. Otherwise return 'Nothing'. This function does not alter your
-- filesystem.
mkFile :: MonadIO io => Maybe Directory -> FilePath -> io (Maybe File)
mkFile :: forall (io :: * -> *).
MonadIO io =>
Maybe Directory -> String -> io (Maybe File)
mkFile Maybe Directory
mdir String
mfile =
    let f :: String
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
mfile (\Directory
d -> Directory -> String
getDirectory Directory
d String -> ShowS
</> String
mfile) Maybe Directory
mdir
    in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> File
File forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> a -> m (Maybe a)
partialM (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Bool
doesFileExist) String
f

-- | Calculate the list of all parent directories for the given directory. This
-- function also returns the initially specified directory.
thisAndParentDirectories :: Directory -> [Directory]
thisAndParentDirectories :: Directory -> [Directory]
thisAndParentDirectories Directory
dir
    | Directory
parentDir forall a. Eq a => a -> a -> Bool
== Directory
dir = [Directory
dir]
    | Bool
otherwise = Directory
dir forall a. a -> [a] -> [a]
: Directory -> [Directory]
thisAndParentDirectories Directory
parentDir
  where
    parentDir :: Directory
parentDir = String -> Directory
Directory forall b c a. (b -> c) -> (a -> b) -> a -> c
.  ShowS
takeDirectory forall a b. (a -> b) -> a -> b
$ Directory -> String
getDirectory Directory
dir


-- | Given a list of build tool identifier functions, apply these to all the
-- given directories and return the value of the first function that returns a
-- 'BuildTool' value or 'Nothing' if no function ever returns a 'BuildTool'.
-- The identifier functions and directories are tried in the order as supplied
-- to this function.
determineProjectSettings
    :: MonadIO io
    => [Directory -> io (Maybe BuildTool)]
    -> [Directory]
    -> io (Maybe (BuildTool, Directory))
determineProjectSettings :: forall (io :: * -> *).
MonadIO io =>
[Directory -> io (Maybe BuildTool)]
-> [Directory] -> io (Maybe (BuildTool, Directory))
determineProjectSettings [Directory -> io (Maybe BuildTool)]
identifiers = [Directory -> io (Maybe BuildTool)]
-> [Directory] -> io (Maybe (BuildTool, Directory))
go [Directory -> io (Maybe BuildTool)]
identifiers
  where
    go :: [Directory -> io (Maybe BuildTool)]
-> [Directory] -> io (Maybe (BuildTool, Directory))
go [Directory -> io (Maybe BuildTool)]
_ []             = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    go [] (Directory
_:[Directory]
ps)        = [Directory -> io (Maybe BuildTool)]
-> [Directory] -> io (Maybe (BuildTool, Directory))
go [Directory -> io (Maybe BuildTool)]
identifiers [Directory]
ps
    go (Directory -> io (Maybe BuildTool)
i:[Directory -> io (Maybe BuildTool)]
is) pps :: [Directory]
pps@(Directory
p:[Directory]
_) = Directory -> io (Maybe BuildTool)
i Directory
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                        Just BuildTool
buildTool -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (BuildTool
buildTool, Directory
p))
                        Maybe BuildTool
Nothing -> [Directory -> io (Maybe BuildTool)]
-> [Directory] -> io (Maybe (BuildTool, Directory))
go [Directory -> io (Maybe BuildTool)]
is [Directory]
pps


-- | This list contains some build tool identifier functions for usual setups.
defaultProjectIdentifiers :: MonadIO io => [Directory -> io (Maybe BuildTool)]
defaultProjectIdentifiers :: forall (io :: * -> *).
MonadIO io =>
[Directory -> io (Maybe BuildTool)]
defaultProjectIdentifiers =
    [ forall (io :: * -> *).
MonadIO io =>
Directory -> io (Maybe BuildTool)
maybeCabalSandbox, forall (io :: * -> *).
MonadIO io =>
Directory -> io (Maybe BuildTool)
maybeStack, forall (io :: * -> *).
MonadIO io =>
Directory -> io (Maybe BuildTool)
maybeCabal ]

-- | Same as 'determineProjectSettings' 'defaultProjetIdentifiers'.
guessProjectSettings :: MonadIO io
                     => [Directory]
                     -> io (Maybe (BuildTool, Directory))
guessProjectSettings :: forall (io :: * -> *).
MonadIO io =>
[Directory] -> io (Maybe (BuildTool, Directory))
guessProjectSettings = forall (io :: * -> *).
MonadIO io =>
[Directory -> io (Maybe BuildTool)]
-> [Directory] -> io (Maybe (BuildTool, Directory))
determineProjectSettings forall (io :: * -> *).
MonadIO io =>
[Directory -> io (Maybe BuildTool)]
defaultProjectIdentifiers


-- | Check if directory contains a @stack.yaml@ file and return 'Just' 'Stack'
-- in this case.
maybeStack :: MonadIO io => Directory -> io (Maybe BuildTool)
maybeStack :: forall (io :: * -> *).
MonadIO io =>
Directory -> io (Maybe BuildTool)
maybeStack Directory
d = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const BuildTool
Stack) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (io :: * -> *).
MonadIO io =>
Maybe Directory -> String -> io (Maybe File)
mkFile (forall a. a -> Maybe a
Just Directory
d) String
"stack.yaml"


-- | Check if the directory contains a @cabal.sandbox.config@ file and return
-- 'Just' ('Cabal' 'Sandbox') in that case.
maybeCabalSandbox :: MonadIO io => Directory -> io (Maybe BuildTool)
maybeCabalSandbox :: forall (io :: * -> *).
MonadIO io =>
Directory -> io (Maybe BuildTool)
maybeCabalSandbox Directory
d = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const (CabalType -> BuildTool
Cabal CabalType
Sandbox))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (io :: * -> *).
MonadIO io =>
Maybe Directory -> String -> io (Maybe File)
mkFile (forall a. a -> Maybe a
Just Directory
d) String
"cabal.sandbox.config"


-- | Check if the directory contains a cabal file and return 'Just' ('Cabal'
-- 'Plain') if present.
maybeCabal :: MonadIO io => Directory -> io (Maybe BuildTool)
maybeCabal :: forall (io :: * -> *).
MonadIO io =>
Directory -> io (Maybe BuildTool)
maybeCabal Directory
d = do
    [String]
ls <-  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO [String]
getDirectoryContents forall a b. (a -> b) -> a -> b
$ Directory -> String
getDirectory Directory
d
    forall {m :: * -> *}. MonadIO m => [String] -> m (Maybe BuildTool)
go forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (String
".cabal" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`)[String]
ls
  where
      go :: [String] -> m (Maybe BuildTool)
go [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      go (String
f:[String]
fs) = forall (io :: * -> *).
MonadIO io =>
Maybe Directory -> String -> io (Maybe File)
mkFile (forall a. a -> Maybe a
Just Directory
d) String
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Maybe File
Nothing -> [String] -> m (Maybe BuildTool)
go [String]
fs
                    Just File
_ ->
                        -- TODO if cabal version >= 1.24(?), use NewBuild here?
                        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (CabalType -> BuildTool
Cabal CabalType
Plain)