{- |

File paths of interest to Dyre, and related values.

-}
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 type to make it harder to confuse which path is which.
data PathsConfig = PathsConfig
  { PathsConfig -> FilePath
runningExecutable :: FilePath
  , PathsConfig -> FilePath
customExecutable :: FilePath
  , PathsConfig -> FilePath
configFile :: FilePath
  -- ^ Where Dyre looks for the custom configuration file.
  , PathsConfig -> FilePath
libsDirectory :: FilePath
  -- ^ @<configDir>/libs@.  This directory gets added to the GHC
  -- include path during compilation, so use configurations can be
  -- split up into modules.  Changes to files under this directory
  -- trigger recompilation.
  , PathsConfig -> FilePath
cacheDirectory :: FilePath
  -- ^ Where the custom executable, object and interface files, errors
  -- file and other metadata get stored.
  }

-- | Determine a file name for the compiler to write to, based on
-- the 'customExecutable' path.
--
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

-- | Return a 'PathsConfig', which records the current binary, the custom
--   binary, the config file, and the cache directory.
getPaths :: Params c r -> IO (FilePath, FilePath, FilePath, FilePath, FilePath)
getPaths :: forall c r.
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
    thisBinary <- IO FilePath
getExecutablePath
    debugMode  <- getDebug
    cwd <- getCurrentDirectory
    cacheDir' <- case (debugMode, cacheDir params) of
                      (Bool
True,  Maybe (IO FilePath)
_      ) -> FilePath -> IO FilePath
forall a. a -> IO a
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
    confDir   <- case (debugMode, configDir params) of
                      (Bool
True,  Maybe (IO FilePath)
_      ) -> FilePath -> IO FilePath
forall a. a -> IO a
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
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
confDir FilePath -> FilePath -> FilePath
</> FilePath
pName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".hs"
      libsDir = FilePath
confDir FilePath -> FilePath -> FilePath
</> FilePath
"lib"
    pure (thisBinary, tempBinary, configFile', cacheDir', libsDir)

getPathsConfig :: Params cfg a -> IO PathsConfig
getPathsConfig :: forall cfg a. Params cfg a -> IO PathsConfig
getPathsConfig Params cfg a
params = do
  (cur, custom, conf, cache, 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
  pure $ PathsConfig cur custom conf libs cache

-- | Check if a file exists. If it exists, return Just the modification
--   time. If it doesn't exist, return Nothing.
maybeModTime :: FilePath -> IO (Maybe UTCTime)
maybeModTime :: FilePath -> IO (Maybe UTCTime)
maybeModTime FilePath
path = do
    fileExists <- FilePath -> IO Bool
doesFileExist FilePath
path
    if fileExists
       then Just <$> getModificationTime path
       else return Nothing

checkFilesModified :: PathsConfig -> IO Bool
checkFilesModified :: PathsConfig -> IO Bool
checkFilesModified PathsConfig
paths = do
  confTime <- FilePath -> IO (Maybe UTCTime)
maybeModTime (PathsConfig -> FilePath
configFile PathsConfig
paths)
  libFiles <- findHaskellFiles (libsDirectory paths)
  libTimes <- traverse maybeModTime libFiles
  thisTime <- maybeModTime (runningExecutable paths)
  tempTime <- maybeModTime (customExecutable paths)
  pure $
    tempTime < confTime     -- config newer than custom bin
    || tempTime < thisTime  -- main bin newer than custom bin
    || any (tempTime <) libTimes

-- | Recursively find Haskell files (@.hs@, @.lhs@) at the given
-- location.
findHaskellFiles :: FilePath -> IO [FilePath]
findHaskellFiles :: FilePath -> IO [FilePath]
findHaskellFiles FilePath
d = do
  exists <- FilePath -> IO Bool
doesDirectoryExist FilePath
d
  if exists
    then do
      nodes <- getDirectoryContents d
      let 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
      files <- filterM isHaskellFile nodes'
      dirs  <- filterM doesDirectoryExist nodes'
      subfiles <- concat <$> traverse findHaskellFiles dirs
      pure $ files ++ subfiles
    else 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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False