-- | Manage lambdabot's state files. There are three relevant directories:
--
-- * local: @./State/@ (configurable, see `outputDir`)
-- * home:  @~/.lambdabot/State/@
-- * data:  relative to the data directory of the @lambdabot@ package.
--
-- Files are stored locally if the directory exists; otherwise, in the home
-- directory. When reading a state file, and the file exists in the data
-- directory but nowhere else, then it is picked up from the data directory.

module Lambdabot.File
    ( stateDir
    , findLBFileForReading
    , findLBFileForWriting
    , findOrCreateLBFile
    , findLBFile -- deprecated
    , outputDir
    ) where

import Lambdabot.Config
import Lambdabot.Config.Core
import Lambdabot.Monad
import Lambdabot.Util

import Control.Applicative
import Control.Monad
import System.Directory
import System.FilePath

lambdabot :: FilePath
lambdabot :: FilePath
lambdabot = FilePath
".lambdabot"

-- | Locate state directory. Returns the local directory if it exists,
-- and the home directory otherwise.
stateDir :: LB FilePath
stateDir :: LB FilePath
stateDir = do
    -- look locally
    FilePath
output <- Config FilePath -> LB FilePath
forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig Config FilePath
outputDir
    Bool
b <- IO Bool -> LB Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO Bool -> LB Bool) -> IO Bool -> LB Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
output
    if Bool
b then FilePath -> LB FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
output else LB FilePath
homeDir

homeDir :: LB FilePath
homeDir :: LB FilePath
homeDir = do
    FilePath
output <- Config FilePath -> LB FilePath
forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig Config FilePath
outputDir
    FilePath
home <- IO FilePath -> LB FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO FilePath
getHomeDirectory
    FilePath -> LB FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> LB FilePath) -> FilePath -> LB FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
home FilePath -> FilePath -> FilePath
</> FilePath
lambdabot FilePath -> FilePath -> FilePath
</> FilePath
output

-- | Look for the file in the local, home, and data directories.
findLBFileForReading :: FilePath -> LB (Maybe FilePath)
findLBFileForReading :: FilePath -> LB (Maybe FilePath)
findLBFileForReading FilePath
f = do
    FilePath
state <- LB FilePath
stateDir
    FilePath
home  <- LB FilePath
homeDir
    FilePath
output <- Config FilePath -> LB FilePath
forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig Config FilePath
outputDir
    FilePath
rodir <- Config FilePath -> LB FilePath
forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig Config FilePath
dataDir
    [FilePath] -> LB (Maybe FilePath)
findFirstFile [FilePath
state FilePath -> FilePath -> FilePath
</> FilePath
f, FilePath
home FilePath -> FilePath -> FilePath
</> FilePath
f, FilePath
rodir FilePath -> FilePath -> FilePath
</> FilePath
output FilePath -> FilePath -> FilePath
</> FilePath
f]

-- | Return file name for writing state. The file will reside in the
-- state directory (`stateDir`), and `findLBFileForWriting` ensures that
-- the state directory exists.
findLBFileForWriting :: FilePath -> LB FilePath
findLBFileForWriting :: FilePath -> LB FilePath
findLBFileForWriting FilePath
f = do
    FilePath
state <- LB FilePath
stateDir
    -- ensure that the directory exists
    IO () -> LB ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> LB ()) -> IO () -> LB ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
state
    Bool
success <- IO Bool -> LB Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO Bool -> LB Bool) -> IO Bool -> LB Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
state
    Bool -> LB () -> LB ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
success) (LB () -> LB ()) -> LB () -> LB ()
forall a b. (a -> b) -> a -> b
$ FilePath -> LB ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> LB ()) -> FilePath -> LB ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [FilePath
"Unable to create directory ", FilePath
state]
    FilePath -> LB FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> LB FilePath) -> FilePath -> LB FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
state FilePath -> FilePath -> FilePath
</> FilePath
f

findFirstFile :: [FilePath] -> LB (Maybe FilePath)
findFirstFile :: [FilePath] -> LB (Maybe FilePath)
findFirstFile [] = Maybe FilePath -> LB (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
findFirstFile (FilePath
path:[FilePath]
ps) = do
    Bool
b <- IO Bool -> LB Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO Bool -> LB Bool) -> IO Bool -> LB Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
path
    if Bool
b then Maybe FilePath -> LB (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path) else [FilePath] -> LB (Maybe FilePath)
findFirstFile [FilePath]
ps

{-# DEPRECATED findLBFile
 "Use `findLBFileForReading` or `findLBFileForWriting` instead" #-}
-- | Try to find a pre-existing file, searching first in the local or home
-- directory (but not in the data directory)
findLBFile :: FilePath -> LB (Maybe String)
findLBFile :: FilePath -> LB (Maybe FilePath)
findLBFile FilePath
f = do
    FilePath
state <- LB FilePath
stateDir
    FilePath
home  <- LB FilePath
homeDir
    [FilePath] -> LB (Maybe FilePath)
findFirstFile [FilePath
state FilePath -> FilePath -> FilePath
</> FilePath
f, FilePath
home FilePath -> FilePath -> FilePath
</> FilePath
f]

-- | This returns the same file name as `findLBFileForWriting`.
-- If the file does not exist, it is either copied from the data (or home)
-- directory, if a copy is found there; otherwise, an empty file is
-- created instead.
findOrCreateLBFile :: FilePath -> LB String
findOrCreateLBFile :: FilePath -> LB FilePath
findOrCreateLBFile FilePath
f = do
    FilePath
outFile <- FilePath -> LB FilePath
findLBFileForWriting FilePath
f
    Bool
b <- IO Bool -> LB Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO Bool -> LB Bool) -> IO Bool -> LB Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
outFile
    Bool -> LB () -> LB ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
b) (LB () -> LB ()) -> LB () -> LB ()
forall a b. (a -> b) -> a -> b
$ do
        -- the file does not exist; populate it from home or data directory
        Maybe FilePath
b <- FilePath -> LB (Maybe FilePath)
findLBFileForReading FilePath
f
        case Maybe FilePath
b of
            Maybe FilePath
Nothing      -> IO () -> LB ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> LB ()) -> IO () -> LB ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
writeFile FilePath
outFile FilePath
""
            Just FilePath
roFile  -> IO () -> LB ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> LB ()) -> IO () -> LB ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
copyFile FilePath
roFile FilePath
outFile
    FilePath -> LB FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
outFile