module Network.AWS.Wolf.File
( findRegularFiles
, touchDirectory
, 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 hiding (find)
import System.Directory
import System.FilePath
import System.FilePath.Find
import System.IO hiding (readFile, writeFile)
findRegularFiles :: MonadIO m => FilePath -> m [FilePath]
findRegularFiles =
liftIO . find always (fileType ==? RegularFile)
touchDirectory :: MonadIO m => FilePath -> m ()
touchDirectory =
liftIO . createDirectoryIfMissing True . takeDirectory
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 -> m FilePath
getWorkDirectory uid =
liftIO $ do
td <- getTemporaryDirectory
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 -> (FilePath -> m a) -> m a
withWorkDirectory uid =
bracket (getWorkDirectory uid) (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 -> (FilePath -> m a) -> m a
withCurrentWorkDirectory uid nocopy action =
withWorkDirectory uid $ \wd ->
withCurrentDirectory' wd $ \cd -> do
unless nocopy $
copyDirectoryRecursive cd wd
action wd