module Config.Dyre.Paths where
import Control.Monad ( filterM )
import Data.List ( isSuffixOf )
import System.Info (os, arch)
import System.FilePath
( (</>), (<.>), takeExtension, splitExtension )
import System.Directory
( doesDirectoryExist
, doesFileExist
, getCurrentDirectory
, getDirectoryContents
, getModificationTime
)
import System.Environment.XDG.BaseDir (getUserCacheDir, getUserConfigDir)
import System.Environment.Executable (getExecutablePath)
import Data.Time
import Config.Dyre.Params
import Config.Dyre.Options
data PathsConfig = PathsConfig
{ PathsConfig -> FilePath
runningExecutable :: FilePath
, PathsConfig -> FilePath
customExecutable :: FilePath
, PathsConfig -> FilePath
configFile :: FilePath
, PathsConfig -> FilePath
libsDirectory :: FilePath
, PathsConfig -> FilePath
cacheDirectory :: FilePath
}
outputExecutable :: FilePath -> FilePath
outputExecutable :: FilePath -> FilePath
outputExecutable FilePath
path =
let (FilePath
base, FilePath
ext) = FilePath -> (FilePath, FilePath)
splitExtension FilePath
path
in FilePath
base FilePath -> FilePath -> FilePath
<.> FilePath
"tmp" FilePath -> FilePath -> FilePath
<.> FilePath
ext
getPaths :: Params c r -> IO (FilePath, FilePath, FilePath, FilePath, FilePath)
getPaths :: Params c r -> IO (FilePath, FilePath, FilePath, FilePath, FilePath)
getPaths params :: Params c r
params@Params{projectName :: forall cfgType a. Params cfgType a -> FilePath
projectName = FilePath
pName} = do
FilePath
thisBinary <- IO FilePath
getExecutablePath
Bool
debugMode <- IO Bool
getDebug
FilePath
cwd <- IO FilePath
getCurrentDirectory
FilePath
cacheDir' <- case (Bool
debugMode, Params c r -> Maybe (IO FilePath)
forall cfgType a. Params cfgType a -> Maybe (IO FilePath)
cacheDir Params c r
params) of
(Bool
True, Maybe (IO FilePath)
_ ) -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
cwd FilePath -> FilePath -> FilePath
</> FilePath
"cache"
(Bool
False, Maybe (IO FilePath)
Nothing) -> FilePath -> IO FilePath
getUserCacheDir FilePath
pName
(Bool
False, Just IO FilePath
cd) -> IO FilePath
cd
FilePath
confDir <- case (Bool
debugMode, Params c r -> Maybe (IO FilePath)
forall cfgType a. Params cfgType a -> Maybe (IO FilePath)
configDir Params c r
params) of
(Bool
True, Maybe (IO FilePath)
_ ) -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
cwd
(Bool
False, Maybe (IO FilePath)
Nothing) -> FilePath -> IO FilePath
getUserConfigDir FilePath
pName
(Bool
False, Just IO FilePath
cd) -> IO FilePath
cd
let
tempBinary :: FilePath
tempBinary =
FilePath
cacheDir' FilePath -> FilePath -> FilePath
</> FilePath
pName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
os FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
arch FilePath -> FilePath -> FilePath
<.> FilePath -> FilePath
takeExtension FilePath
thisBinary
configFile' :: FilePath
configFile' = FilePath
confDir FilePath -> FilePath -> FilePath
</> FilePath
pName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".hs"
libsDir :: FilePath
libsDir = FilePath
confDir FilePath -> FilePath -> FilePath
</> FilePath
"lib"
(FilePath, FilePath, FilePath, FilePath, FilePath)
-> IO (FilePath, FilePath, FilePath, FilePath, FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
thisBinary, FilePath
tempBinary, FilePath
configFile', FilePath
cacheDir', FilePath
libsDir)
getPathsConfig :: Params cfg a -> IO PathsConfig
getPathsConfig :: Params cfg a -> IO PathsConfig
getPathsConfig Params cfg a
params = do
(FilePath
cur, FilePath
custom, FilePath
conf, FilePath
cache, FilePath
libs) <- Params cfg a
-> IO (FilePath, FilePath, FilePath, FilePath, FilePath)
forall c r.
Params c r -> IO (FilePath, FilePath, FilePath, FilePath, FilePath)
getPaths Params cfg a
params
PathsConfig -> IO PathsConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PathsConfig -> IO PathsConfig) -> PathsConfig -> IO PathsConfig
forall a b. (a -> b) -> a -> b
$ FilePath
-> FilePath -> FilePath -> FilePath -> FilePath -> PathsConfig
PathsConfig FilePath
cur FilePath
custom FilePath
conf FilePath
libs FilePath
cache
maybeModTime :: FilePath -> IO (Maybe UTCTime)
maybeModTime :: FilePath -> IO (Maybe UTCTime)
maybeModTime FilePath
path = do
Bool
fileExists <- FilePath -> IO Bool
doesFileExist FilePath
path
if Bool
fileExists
then UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just (UTCTime -> Maybe UTCTime) -> IO UTCTime -> IO (Maybe UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO UTCTime
getModificationTime FilePath
path
else Maybe UTCTime -> IO (Maybe UTCTime)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe UTCTime
forall a. Maybe a
Nothing
checkFilesModified :: PathsConfig -> IO Bool
checkFilesModified :: PathsConfig -> IO Bool
checkFilesModified PathsConfig
paths = do
Maybe UTCTime
confTime <- FilePath -> IO (Maybe UTCTime)
maybeModTime (PathsConfig -> FilePath
configFile PathsConfig
paths)
[FilePath]
libFiles <- FilePath -> IO [FilePath]
findHaskellFiles (PathsConfig -> FilePath
libsDirectory PathsConfig
paths)
[Maybe UTCTime]
libTimes <- (FilePath -> IO (Maybe UTCTime))
-> [FilePath] -> IO [Maybe UTCTime]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> IO (Maybe UTCTime)
maybeModTime [FilePath]
libFiles
Maybe UTCTime
thisTime <- FilePath -> IO (Maybe UTCTime)
maybeModTime (PathsConfig -> FilePath
runningExecutable PathsConfig
paths)
Maybe UTCTime
tempTime <- FilePath -> IO (Maybe UTCTime)
maybeModTime (PathsConfig -> FilePath
customExecutable PathsConfig
paths)
Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$
Maybe UTCTime
tempTime Maybe UTCTime -> Maybe UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< Maybe UTCTime
confTime
Bool -> Bool -> Bool
|| Maybe UTCTime
tempTime Maybe UTCTime -> Maybe UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< Maybe UTCTime
thisTime
Bool -> Bool -> Bool
|| (Maybe UTCTime -> Bool) -> [Maybe UTCTime] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe UTCTime
tempTime Maybe UTCTime -> Maybe UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<) [Maybe UTCTime]
libTimes
findHaskellFiles :: FilePath -> IO [FilePath]
findHaskellFiles :: FilePath -> IO [FilePath]
findHaskellFiles FilePath
d = do
Bool
exists <- FilePath -> IO Bool
doesDirectoryExist FilePath
d
if Bool
exists
then do
[FilePath]
nodes <- FilePath -> IO [FilePath]
getDirectoryContents FilePath
d
let nodes' :: [FilePath]
nodes' = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
d FilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath
".", FilePath
".."]) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
nodes
[FilePath]
files <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
isHaskellFile [FilePath]
nodes'
[FilePath]
dirs <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesDirectoryExist [FilePath]
nodes'
[FilePath]
subfiles <- [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> IO [FilePath]
findHaskellFiles [FilePath]
dirs
[FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
files [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
subfiles
else [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
where
isHaskellFile :: FilePath -> IO Bool
isHaskellFile FilePath
f
| (FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
f) [FilePath
".hs", FilePath
".lhs"] = FilePath -> IO Bool
doesFileExist FilePath
f
| Bool
otherwise = Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False