-- | Defines an IO interface for core recipes
module Achille.Internal.IO
    ( AchilleIO
    , readFile
    , readFileLazy
    , copyFile
    , writeFile
    , writeFileLazy
    , doesFileExist
    , doesDirExist
    , callCommand
    , log
    , glob
    , getModificationTime
    , fail
    ) where

import Prelude as Prelude hiding (log, readFile, writeFile)

import Data.Text          (Text)
import System.FilePath    (FilePath)
import Data.Time.Clock    (UTCTime)
import Control.Monad.Fail (MonadFail)

import qualified System.Directory     as Directory
import qualified System.FilePath      as FilePath
import qualified System.FilePath.Glob as Glob
import qualified System.Process       as Process
import qualified Data.Text            as Text
import qualified Data.Text.IO         as TextIO
import qualified Data.ByteString      as BS
import qualified Data.ByteString.Lazy as LBS


-- | Interface for IO actions used by core recipes.
class (Monad m, MonadFail m) => AchilleIO m where
    -- | Retrieve a file as a bytestring.
    readFile            :: FilePath -> m BS.ByteString
    -- | Retrieve a file as a /lazy/ bytestring.
    readFileLazy        :: FilePath -> m LBS.ByteString
    -- | Copy a file from one location to another.
    copyFile            :: FilePath -> FilePath       -> m ()
    -- | Write a bytestring to a file.
    writeFile           :: FilePath -> BS.ByteString  -> m ()
    -- | Write a /lazy/ bytestring to a file.
    writeFileLazy       :: FilePath -> LBS.ByteString -> m ()
    -- | Check whether a file exists.
    doesFileExist       :: FilePath -> m Bool
    -- | Check whether a directory exists.
    doesDirExist        :: FilePath -> m Bool
    -- | Run a shell command in a new process.
    callCommand         :: String   -> m ()
    -- | Log a string to stdout.
    log                 :: String   -> m ()
    -- | Find all paths matching a given globpattern, relative to a given directory.
    glob                :: FilePath -- ^ Path of the root directory.
                        -> Glob.Pattern   -> m [FilePath]
    -- | Get modification time of a file.
    getModificationTime :: FilePath -> m UTCTime


ensureDirExists :: FilePath -> IO ()
ensureDirExists :: FilePath -> IO ()
ensureDirExists =
    Bool -> FilePath -> IO ()
Directory.createDirectoryIfMissing Bool
True (FilePath -> IO ()) -> (FilePath -> FilePath) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
FilePath.takeDirectory


instance AchilleIO IO where
    readFile :: FilePath -> IO ByteString
readFile            = FilePath -> IO ByteString
BS.readFile
    readFileLazy :: FilePath -> IO ByteString
readFileLazy        = FilePath -> IO ByteString
LBS.readFile
    copyFile :: FilePath -> FilePath -> IO ()
copyFile from :: FilePath
from to :: FilePath
to    = FilePath -> IO ()
ensureDirExists FilePath
to IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> FilePath -> IO ()
Directory.copyFile FilePath
from FilePath
to
    writeFile :: FilePath -> ByteString -> IO ()
writeFile to :: FilePath
to x :: ByteString
x      = FilePath -> IO ()
ensureDirExists FilePath
to IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> ByteString -> IO ()
BS.writeFile FilePath
to ByteString
x
    writeFileLazy :: FilePath -> ByteString -> IO ()
writeFileLazy to :: FilePath
to x :: ByteString
x  = FilePath -> IO ()
ensureDirExists FilePath
to IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> ByteString -> IO ()
LBS.writeFile FilePath
to ByteString
x
    doesFileExist :: FilePath -> IO Bool
doesFileExist       = FilePath -> IO Bool
Directory.doesFileExist
    doesDirExist :: FilePath -> IO Bool
doesDirExist        = FilePath -> IO Bool
Directory.doesDirectoryExist
    callCommand :: FilePath -> IO ()
callCommand         = FilePath -> IO ()
Process.callCommand
    log :: FilePath -> IO ()
log                 = FilePath -> IO ()
Prelude.putStrLn
    glob :: FilePath -> Pattern -> IO [FilePath]
glob dir :: FilePath
dir pattern :: Pattern
pattern    =
        FilePath -> IO [FilePath] -> IO [FilePath]
forall a. FilePath -> IO a -> IO a
Directory.withCurrentDirectory FilePath
dir (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$
            Pattern -> FilePath -> IO [FilePath]
Glob.globDir1 Pattern
pattern ""
            IO [FilePath] -> ([FilePath] -> IO [FilePath]) -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> IO FilePath) -> [FilePath] -> IO [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO FilePath
Directory.makeRelativeToCurrentDirectory
    getModificationTime :: FilePath -> IO UTCTime
getModificationTime = FilePath -> IO UTCTime
Directory.getModificationTime