{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Network.AWS.Wolf.File
( dataDirectory
, storeDirectory
, inputDirectory
, outputDirectory
, writeText
, readText
, writeJson
, readYaml
, withCurrentWorkDirectory
) where
import Data.Aeson
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Time
import Data.Yaml hiding (encode)
import Network.AWS.Wolf.Prelude
import System.Directory
import System.IO hiding (readFile, writeFile)
dataDirectory :: MonadIO m => FilePath -> m FilePath
dataDirectory dir = do
let dir' = dir </> "data"
liftIO $ createDirectoryIfMissing True dir'
pure dir'
storeDirectory :: MonadIO m => FilePath -> m FilePath
storeDirectory dir = do
let dir' = dir </> "store"
liftIO $ createDirectoryIfMissing True dir'
pure dir'
inputDirectory :: MonadIO m => FilePath -> m FilePath
inputDirectory dir = do
let dir' = dir </> "input"
liftIO $ createDirectoryIfMissing True dir'
pure dir'
outputDirectory :: MonadIO m => FilePath -> m FilePath
outputDirectory dir = do
let dir' = dir </> "output"
liftIO $ createDirectoryIfMissing True dir'
pure dir'
writeText :: MonadIO m => FilePath -> Maybe Text -> m ()
writeText file contents =
liftIO $ void $ traverse (writeFile file) contents
readText :: MonadIO m => FilePath -> m (Maybe Text)
readText file =
liftIO $ do
b <- doesFileExist file
if not b then pure mempty else
pure <$> readFile file
writeJson :: (MonadIO m, ToJSON a) => FilePath -> a -> m ()
writeJson file item =
liftIO $ withFile file WriteMode $ \h ->
BS.hPut h $ LBS.toStrict $ encode item
readYaml :: (MonadIO m, FromJSON a) => FilePath -> m a
readYaml file =
liftIO $ withFile file ReadMode $ \h -> do
body <- BS.hGetContents h
eitherThrowIO' $ decodeEither body
getWorkDirectory :: MonadIO m => Text -> Bool -> m FilePath
getWorkDirectory uid local =
liftIO $ do
td <- bool getTemporaryDirectory getCurrentDirectory local
time <- getCurrentTime
let dir = td </> formatTime defaultTimeLocale "%FT%T%z" time </> textToString uid
createDirectoryIfMissing True dir
pure dir
copyDirectoryRecursive :: MonadIO m => FilePath -> FilePath -> m ()
copyDirectoryRecursive fd td =
liftIO $ do
createDirectoryIfMissing True td
cs <- filter (`notElem` [".", ".."]) <$> getDirectoryContents fd
forM_ cs $ \c -> do
let fc = fd </> c
tc = td </> c
e <- doesDirectoryExist fc
bool (copyFile fc tc) (copyDirectoryRecursive fc tc) e
withWorkDirectory :: MonadControl m => Text -> Bool -> (FilePath -> m a) -> m a
withWorkDirectory uid local =
bracket (getWorkDirectory uid local) (liftIO . removeDirectoryRecursive)
withCurrentDirectory' :: MonadControl m => FilePath -> (FilePath -> m a) -> m a
withCurrentDirectory' wd action =
bracket (liftIO getCurrentDirectory) (liftIO . setCurrentDirectory) $ \cd -> do
liftIO $ setCurrentDirectory wd
action cd
withCurrentWorkDirectory :: MonadControl m => Text -> Bool -> Bool -> (FilePath -> m a) -> m a
withCurrentWorkDirectory uid nocopy local action =
withWorkDirectory uid local $ \wd ->
withCurrentDirectory' wd $ \cd -> do
unless (nocopy || local) $
copyDirectoryRecursive cd wd
action wd