{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} module Polysemy.FS where import Polysemy import qualified UnliftIO.Path.Directory as U import Data.Text (Text) import qualified System.IO.Temp as U import RIO import Path import qualified Data.ByteString as BS data FSExist m a where DoesFileExist :: Path b File -> FSExist m Bool DoesDirExist :: Path b Dir -> FSExist m Bool makeSem ''FSExist data FSRead m a where ReadFileBS :: Path b File -> FSRead m BS.ByteString ReadFileUtf8 :: Path b File -> FSRead m Text makeSem ''FSRead data FSWrite m a where WriteFileBS :: Path b File -> BS.ByteString -> FSWrite m () WriteFileUtf8 :: Path b File -> Text -> FSWrite m () makeSem ''FSWrite data FSCopy m a where CopyFile :: Path b File -> Path b' File -> FSCopy m () makeSem ''FSCopy data FSTemp m a where CreateTempDirectory :: FSTemp m (Path Abs Dir) makeSem ''FSTemp data FSDir m a where CreateDirectory :: Path b Dir -> FSDir m () RemoveDirectory :: Path b Dir -> FSDir m () makeSem ''FSDir runFSExist :: Member (Embed IO) r => Sem (FSExist ': r) a -> Sem r a runFSExist :: Sem (FSExist : r) a -> Sem r a runFSExist = (forall x (m :: * -> *). FSExist m x -> Sem r x) -> Sem (FSExist : r) a -> Sem r a forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a. FirstOrder e "interpret" => (forall x (m :: * -> *). e m x -> Sem r x) -> Sem (e : r) a -> Sem r a interpret \case DoesFileExist x -> Path b File -> Sem r Bool forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool U.doesFileExist Path b File x DoesDirExist x -> Path b Dir -> Sem r Bool forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool U.doesDirectoryExist Path b Dir x runFSRead :: Member (Embed IO) r => Sem (FSRead ': r) a -> Sem r a runFSRead :: Sem (FSRead : r) a -> Sem r a runFSRead = (forall x (m :: * -> *). FSRead m x -> Sem r x) -> Sem (FSRead : r) a -> Sem r a forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a. FirstOrder e "interpret" => (forall x (m :: * -> *). e m x -> Sem r x) -> Sem (e : r) a -> Sem r a interpret \case ReadFileBS x -> IO ByteString -> Sem r ByteString forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a. Member (Embed m) r => m a -> Sem r a embed (IO ByteString -> Sem r ByteString) -> IO ByteString -> Sem r ByteString forall a b. (a -> b) -> a -> b $ FilePath -> IO ByteString BS.readFile (Path b File -> FilePath forall b t. Path b t -> FilePath toFilePath Path b File x) ReadFileUtf8 x -> FilePath -> Sem r Text forall (m :: * -> *). MonadIO m => FilePath -> m Text RIO.readFileUtf8 (Path b File -> FilePath forall b t. Path b t -> FilePath toFilePath Path b File x) runFSWrite :: Member (Embed IO) r => Sem (FSWrite ': r) a -> Sem r a runFSWrite :: Sem (FSWrite : r) a -> Sem r a runFSWrite = (forall x (m :: * -> *). FSWrite m x -> Sem r x) -> Sem (FSWrite : r) a -> Sem r a forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a. FirstOrder e "interpret" => (forall x (m :: * -> *). e m x -> Sem r x) -> Sem (e : r) a -> Sem r a interpret \case WriteFileBS x y -> IO () -> Sem r () forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a. Member (Embed m) r => m a -> Sem r a embed (IO () -> Sem r ()) -> IO () -> Sem r () forall a b. (a -> b) -> a -> b $ FilePath -> ByteString -> IO () BS.writeFile (Path b File -> FilePath forall b t. Path b t -> FilePath toFilePath Path b File x) ByteString y WriteFileUtf8 x y -> FilePath -> Text -> Sem r () forall (m :: * -> *). MonadIO m => FilePath -> Text -> m () RIO.writeFileUtf8 (Path b File -> FilePath forall b t. Path b t -> FilePath toFilePath Path b File x) Text y runFSCopy :: Member (Embed IO) r => Sem (FSCopy ': r) a -> Sem r a runFSCopy :: Sem (FSCopy : r) a -> Sem r a runFSCopy = (forall x (m :: * -> *). FSCopy m x -> Sem r x) -> Sem (FSCopy : r) a -> Sem r a forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a. FirstOrder e "interpret" => (forall x (m :: * -> *). e m x -> Sem r x) -> Sem (e : r) a -> Sem r a interpret \case CopyFile x y -> Path b File -> Path b' File -> Sem r () forall (m :: * -> *) b b'. MonadIO m => Path b File -> Path b' File -> m () U.copyFile Path b File x Path b' File y runFSDir :: Member (Embed IO) r => Sem (FSDir ': r) a -> Sem r a runFSDir :: Sem (FSDir : r) a -> Sem r a runFSDir = (forall x (m :: * -> *). FSDir m x -> Sem r x) -> Sem (FSDir : r) a -> Sem r a forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a. FirstOrder e "interpret" => (forall x (m :: * -> *). e m x -> Sem r x) -> Sem (e : r) a -> Sem r a interpret \case CreateDirectory x -> Bool -> Path b Dir -> Sem r () forall (m :: * -> *) b. MonadIO m => Bool -> Path b Dir -> m () U.createDirectoryIfMissing Bool True Path b Dir x RemoveDirectory x -> Path b Dir -> Sem r () forall (m :: * -> *) b. MonadIO m => Path b Dir -> m () U.removeDirectoryRecursive Path b Dir x runFSTemp :: Member (Embed IO) r => Sem (FSTemp ': r) a -> Sem r a runFSTemp :: Sem (FSTemp : r) a -> Sem r a runFSTemp = (forall x (m :: * -> *). FSTemp m x -> Sem r x) -> Sem (FSTemp : r) a -> Sem r a forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a. FirstOrder e "interpret" => (forall x (m :: * -> *). e m x -> Sem r x) -> Sem (e : r) a -> Sem r a interpret \case FSTemp m x CreateTempDirectory -> do FilePath x <- IO FilePath -> Sem r FilePath forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a. Member (Embed m) r => m a -> Sem r a embed IO FilePath U.getCanonicalTemporaryDirectory IO (Path Abs Dir) -> Sem r (Path Abs Dir) forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a. Member (Embed m) r => m a -> Sem r a embed (IO (Path Abs Dir) -> Sem r (Path Abs Dir)) -> IO (Path Abs Dir) -> Sem r (Path Abs Dir) forall a b. (a -> b) -> a -> b $ FilePath -> FilePath -> IO FilePath U.createTempDirectory FilePath x FilePath "" IO FilePath -> (FilePath -> IO (Path Abs Dir)) -> IO (Path Abs Dir) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= FilePath -> IO (Path Abs Dir) forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs Dir) parseAbsDir