    {- |

    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