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'
return dir'
storeDirectory :: MonadIO m => FilePath -> m FilePath
storeDirectory dir = do
let dir' = dir </> "store"
liftIO $ createDirectoryIfMissing True dir'
return dir'
inputDirectory :: MonadIO m => FilePath -> m FilePath
inputDirectory dir = do
let dir' = dir </> "input"
liftIO $ createDirectoryIfMissing True dir'
return dir'
outputDirectory :: MonadIO m => FilePath -> m FilePath
outputDirectory dir = do
let dir' = dir </> "output"
liftIO $ createDirectoryIfMissing True dir'
return 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 return mempty else
return <$> 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
return 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 -> (FilePath -> m a) -> m a
withCurrentWorkDirectory uid action =
withWorkDirectory uid $ \wd ->
withCurrentDirectory' wd $ \cd -> do
copyDirectoryRecursive cd wd
action wd