{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

module Yi.Paths ( getEvaluatorContextFilename
                , getConfigFilename
                , getConfigModules
                , getPersistentStateFilename
                , getConfigDir
                , getConfigPath
                , getCustomConfigPath
                , getDataPath
                ) where

import           Control.Monad.Base             (MonadBase, liftBase)
import           System.Directory               (createDirectoryIfMissing,
                                                 doesDirectoryExist,
                                                 getAppUserDataDirectory)
import qualified System.Environment.XDG.BaseDir as XDG (getUserConfigDir, getUserDataDir)
import           System.FilePath                ((</>))

appUserDataCond ::(MonadBase IO m) => (String -> IO FilePath) -> m FilePath
appUserDataCond :: (String -> IO String) -> m String
appUserDataCond String -> IO String
dirQuery = IO String -> m String
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$
  do String
oldDir <- String -> IO String
getAppUserDataDirectory String
"yi"
     String
newDir <- String -> IO String
dirQuery String
"yi"
     Bool
oldDirExists <- String -> IO Bool
doesDirectoryExist String
oldDir
     Bool
newDirExists <- String -> IO Bool
doesDirectoryExist String
newDir
     if Bool
newDirExists -- overrides old-style
        then String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
newDir
        else if Bool
oldDirExists -- old-style exists, use it
               then String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
oldDir
               else do Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
newDir -- none exists, use new style, but create it
                       String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
newDir

getConfigDir ::(MonadBase IO m) => m FilePath
getConfigDir :: m String
getConfigDir = (String -> IO String) -> m String
forall (m :: * -> *).
MonadBase IO m =>
(String -> IO String) -> m String
appUserDataCond String -> IO String
XDG.getUserConfigDir

getDataDir ::(MonadBase IO m) => m FilePath
getDataDir :: m String
getDataDir = (String -> IO String) -> m String
forall (m :: * -> *).
MonadBase IO m =>
(String -> IO String) -> m String
appUserDataCond String -> IO String
XDG.getUserDataDir

-- | Given a path relative to application data directory,
--   this function finds a path to a given data file.
getDataPath :: (MonadBase IO m) => FilePath -> m FilePath
getDataPath :: String -> m String
getDataPath String
fp = (String -> String) -> m String -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> String
</> String
fp) m String
forall (m :: * -> *). MonadBase IO m => m String
getDataDir

-- | Given a path relative to application configuration directory,
--   this function finds a path to a given configuration file.
getConfigPath :: MonadBase IO m => FilePath -> m FilePath
getConfigPath :: String -> m String
getConfigPath = m String -> String -> m String
forall (m :: * -> *).
MonadBase IO m =>
m String -> String -> m String
getCustomConfigPath m String
forall (m :: * -> *). MonadBase IO m => m String
getConfigDir

-- | Given an action that retrieves config path, and a path relative to it,
-- this function joins the two together to create a config file path.
getCustomConfigPath :: MonadBase IO m => m FilePath -> FilePath -> m FilePath
getCustomConfigPath :: m String -> String -> m String
getCustomConfigPath m String
cd String
fp = (String -> String -> String
</> String
fp) (String -> String) -> m String -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` m String
cd

-- Note: Dyre also uses XDG cache dir - that would be:
--getCachePath = getPathHelper XDG.getUserCacheDirectory

-- Below are all points that are used in Yi code (to keep it clean.)
getEvaluatorContextFilename, getConfigFilename, getConfigModules,
    getPersistentStateFilename :: (MonadBase IO m) => m FilePath

-- | Get Yi master configuration script.
getConfigFilename :: m String
getConfigFilename = String -> m String
forall (m :: * -> *). MonadBase IO m => String -> m String
getConfigPath String
"yi.hs"

getConfigModules :: m String
getConfigModules = String -> m String
forall (m :: * -> *). MonadBase IO m => String -> m String
getConfigPath String
"modules"

-- | Get path to Yi history that stores state between runs.
getPersistentStateFilename :: m String
getPersistentStateFilename = String -> m String
forall (m :: * -> *). MonadBase IO m => String -> m String
getDataPath String
"history"

-- | Get path to environment file that defines namespace used by Yi
--   command evaluator.
getEvaluatorContextFilename :: m String
getEvaluatorContextFilename = String -> m String
forall (m :: * -> *). MonadBase IO m => String -> m String
getConfigPath (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String
"local" String -> String -> String
</> String
"Env.hs"