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 -> 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