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