{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoImplicitPrelude #-} -- | Files, directories, and encoding / decoding file functions. -- module Network.AWS.Wolf.File ( dataDirectory , storeDirectory , inputDirectory , outputDirectory , metaDirectory , writeText , readText , writeJson , writeYaml , 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) -- | Determine path to data directory and create it. -- dataDirectory :: MonadIO m => FilePath -> m FilePath dataDirectory dir = do let dir' = dir "data" liftIO $ createDirectoryIfMissing True dir' pure dir' -- | Determine path to store directory and create it. -- storeDirectory :: MonadIO m => FilePath -> m FilePath storeDirectory dir = do let dir' = dir "store" liftIO $ createDirectoryIfMissing True dir' pure dir' -- | Determine path to store input directory and create it. -- inputDirectory :: MonadIO m => FilePath -> m FilePath inputDirectory dir = do let dir' = dir "input" liftIO $ createDirectoryIfMissing True dir' pure dir' -- | Determine path to store output directory and create it. -- outputDirectory :: MonadIO m => FilePath -> m FilePath outputDirectory dir = do let dir' = dir "output" liftIO $ createDirectoryIfMissing True dir' pure dir' -- | Determine path to store input/output json files and create it. -- metaDirectory :: MonadIO m => FilePath -> m FilePath metaDirectory dir = do osd <- outputDirectory dir let dir' = osd "meta" liftIO $ createDirectoryIfMissing True dir' pure dir' -- | Maybe write text to a file. -- writeText :: MonadIO m => FilePath -> Maybe Text -> m () writeText file contents = liftIO $ void $ traverse (writeFile file) contents -- | Maybe read text from a file. -- readText :: MonadIO m => FilePath -> m (Maybe Text) readText file = liftIO $ do b <- doesFileExist file if not b then pure mempty else pure <$> readFile file -- | Encode from JSON and write file. -- writeJson :: (MonadIO m, ToJSON a) => FilePath -> a -> m () writeJson file item = liftIO $ withFile file WriteMode $ \h -> BS.hPut h $ LBS.toStrict $ encode item -- | Encode from YAML and write file. -- writeYaml :: (MonadIO m, ToJSON a) => FilePath -> a -> m () writeYaml file item = liftIO $ encodeFile file item -- | Read file and decode it from YAML. -- readYaml :: (MonadIO m, FromJSON a) => FilePath -> m a readYaml file = liftIO $ withFile file ReadMode $ \h -> do body <- BS.hGetContents h eitherThrowIO' $ decodeEither body -- | Get a temporary timestamped work directory. -- 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 -- | Copy directory contents recursively. -- 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 -- | Setup a temporary work directory. -- withWorkDirectory :: MonadControl m => Text -> Bool -> (FilePath -> m a) -> m a withWorkDirectory uid local = bracket (getWorkDirectory uid local) (liftIO . removeDirectoryRecursive) -- | Change to directory and then return to current directory. -- withCurrentDirectory' :: MonadControl m => FilePath -> (FilePath -> m a) -> m a withCurrentDirectory' wd action = bracket (liftIO getCurrentDirectory) (liftIO . setCurrentDirectory) $ \cd -> do liftIO $ setCurrentDirectory wd action cd -- | Setup a temporary work directory and copy current directory files to it. -- 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