{-# LANGUAGE DataKinds #-} {-# LANGUAGE TemplateHaskell #-} module System.XDG.FileSystem where import qualified Control.Exception as IO import qualified Data.ByteString.Lazy as BS import qualified Data.Map as M import Path import Polysemy import Polysemy.Error import Polysemy.State ( State, evalState, get, modify, ) import qualified System.IO.Error as IO import System.XDG.Error data ReadFile f m a where ReadFile :: Path Abs File -> ReadFile f m f data WriteFile f m a where WriteFile :: Path Abs File -> f -> WriteFile f m () makeSem ''ReadFile makeSem ''WriteFile type FileList a = [(Path Abs File, a)] type FileMap a = M.Map (Path Abs File) a runReadWriteFileList :: Member (Error XDGError) r => FileList a -> Sem (ReadFile a ': WriteFile a ': State (FileMap a) ': r) b -> Sem r b runReadWriteFileList :: forall (r :: EffectRow) a b. Member (Error XDGError) r => FileList a -> Sem (ReadFile a : WriteFile a : State (FileMap a) : r) b -> Sem r b runReadWriteFileList FileList a files = forall s (r :: EffectRow) a. s -> Sem (State s : r) a -> Sem r a evalState (forall k a. Ord k => [(k, a)] -> Map k a M.fromList FileList a files) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (e :: Effect) (r :: EffectRow) a. FirstOrder e "interpret" => (forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x) -> Sem (e : r) a -> Sem r a interpret (\(WriteFile Path Abs File path a content) -> forall s (r :: EffectRow). Member (State s) r => (s -> s) -> Sem r () modify (forall k a. Ord k => k -> a -> Map k a -> Map k a M.insert Path Abs File path a content)) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (e :: Effect) (r :: EffectRow) a. FirstOrder e "interpret" => (forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x) -> Sem (e : r) a -> Sem r a interpret ( \(ReadFile Path Abs File path) -> do Map (Path Abs File) x fileMap <- forall s (r :: EffectRow). Member (State s) r => Sem r s get forall b a. b -> (a -> b) -> Maybe a -> b maybe (forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a throw forall a b. (a -> b) -> a -> b $ Path Abs File -> XDGError FileNotFound Path Abs File path) forall (f :: * -> *) a. Applicative f => a -> f a pure forall a b. (a -> b) -> a -> b $ forall k a. Ord k => k -> Map k a -> Maybe a M.lookup Path Abs File path Map (Path Abs File) x fileMap ) runReadWriteFileIO :: Members '[Embed IO, Error XDGError] r => Sem (ReadFile BS.ByteString ': WriteFile BS.ByteString ': r) a -> Sem r a runReadWriteFileIO :: forall (r :: EffectRow) a. Members '[Embed IO, Error XDGError] r => Sem (ReadFile ByteString : WriteFile ByteString : r) a -> Sem r a runReadWriteFileIO = forall (e :: Effect) (r :: EffectRow) a. FirstOrder e "interpret" => (forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x) -> Sem (e : r) a -> Sem r a interpret ( \(WriteFile Path Abs File path ByteString content) -> do Either XDGError () result <- forall (m :: * -> *) (r :: EffectRow) a. Member (Embed m) r => m a -> Sem r a embed forall a b. (a -> b) -> a -> b $ forall e b a. Exception e => (e -> Maybe b) -> IO a -> IO (Either b a) IO.tryJust (Path Abs File -> IOException -> Maybe XDGError notFound Path Abs File path) forall a b. (a -> b) -> a -> b $ FilePath -> ByteString -> IO () BS.writeFile (forall b t. Path b t -> FilePath toFilePath Path Abs File path) ByteString content forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a throw forall (f :: * -> *) a. Applicative f => a -> f a pure Either XDGError () result ) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (e :: Effect) (r :: EffectRow) a. FirstOrder e "interpret" => (forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x) -> Sem (e : r) a -> Sem r a interpret ( \(ReadFile Path Abs File path) -> do Either XDGError ByteString result <- forall (m :: * -> *) (r :: EffectRow) a. Member (Embed m) r => m a -> Sem r a embed forall a b. (a -> b) -> a -> b $ forall e b a. Exception e => (e -> Maybe b) -> IO a -> IO (Either b a) IO.tryJust (Path Abs File -> IOException -> Maybe XDGError notFound Path Abs File path) forall a b. (a -> b) -> a -> b $ FilePath -> IO ByteString BS.readFile forall a b. (a -> b) -> a -> b $ forall b t. Path b t -> FilePath toFilePath Path Abs File path forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a throw forall (f :: * -> *) a. Applicative f => a -> f a pure Either XDGError ByteString result ) where notFound :: Path Abs File -> IO.IOException -> Maybe XDGError notFound :: Path Abs File -> IOException -> Maybe XDGError notFound Path Abs File path IOException e = if IOException -> Bool IO.isDoesNotExistError IOException e then forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b $ Path Abs File -> XDGError FileNotFound Path Abs File path else forall a. Maybe a Nothing