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