{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeOperators #-}
module Polysemy.FSKVStore
( FSKVStore,
runFSKVStoreRelBS,
runFSKVStoreAbsBS,
runFSKVStoreRelUtf8,
runFSKVStoreAbsUtf8,
)
where
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS (readFile, writeFile)
import Data.Kind (Type)
import Path (Abs, Dir, File, Path, Rel, parent,
toFilePath, (</>))
import Polysemy (Embed, Members, Sem, embed, interpret)
import Polysemy.KVStore (KVStore (LookupKV, UpdateKV))
import RIO (Text, readFileUtf8, writeFileUtf8)
import qualified UnliftIO.Path.Directory as U
type FSKVStore :: Type -> Type -> (Type -> Type) -> Type -> Type
type FSKVStore b a = KVStore (Path b File) a
runFSKVStoreRelBS ::
Members '[Embed IO] r =>
Path b Dir ->
Sem (KVStore (Path Rel File) ByteString ': r) a ->
Sem r a
runFSKVStoreRelBS :: forall (r :: EffectRow) b a.
Members '[Embed IO] r =>
Path b Dir
-> Sem (KVStore (Path Rel File) ByteString : r) a -> Sem r a
runFSKVStoreRelBS Path b Dir
d = forall (e :: (* -> *) -> * -> *) (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 \case
LookupKV Path Rel File
k -> forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed forall a b. (a -> b) -> a -> b
$ do
Bool
z <- forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
U.doesFileExist (Path b Dir
d forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
k)
if Bool
z
then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ByteString
BS.readFile forall a b. (a -> b) -> a -> b
$ forall b t. Path b t -> FilePath
toFilePath forall a b. (a -> b) -> a -> b
$ Path b Dir
d forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
k
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
UpdateKV Path Rel File
k Maybe ByteString
v -> forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) b. MonadIO m => Bool -> Path b Dir -> m ()
U.createDirectoryIfMissing Bool
True (Path b Dir
d forall b t. Path b Dir -> Path Rel t -> Path b t
</> forall b t. Path b t -> Path b Dir
parent Path Rel File
k)
case Maybe ByteString
v of
Maybe ByteString
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just ByteString
x -> FilePath -> ByteString -> IO ()
BS.writeFile (forall b t. Path b t -> FilePath
toFilePath (Path b Dir
d forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
k)) ByteString
x
runFSKVStoreAbsBS ::
Members '[Embed IO] r =>
Sem (FSKVStore Abs ByteString ': r) a ->
Sem r a
runFSKVStoreAbsBS :: forall (r :: EffectRow) a.
Members '[Embed IO] r =>
Sem (FSKVStore Abs ByteString : r) a -> Sem r a
runFSKVStoreAbsBS = forall (e :: (* -> *) -> * -> *) (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 \case
LookupKV Path Abs File
k -> forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed forall a b. (a -> b) -> a -> b
$ do
Bool
z <- forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
U.doesFileExist Path Abs File
k
if Bool
z
then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ByteString
BS.readFile forall a b. (a -> b) -> a -> b
$ forall b t. Path b t -> FilePath
toFilePath Path Abs File
k
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
UpdateKV Path Abs File
k Maybe ByteString
v -> forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) b. MonadIO m => Bool -> Path b Dir -> m ()
U.createDirectoryIfMissing Bool
True (forall b t. Path b t -> Path b Dir
parent Path Abs File
k)
case Maybe ByteString
v of
Maybe ByteString
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just ByteString
x -> FilePath -> ByteString -> IO ()
BS.writeFile (forall b t. Path b t -> FilePath
toFilePath Path Abs File
k) ByteString
x
{-# INLINE runFSKVStoreAbsBS #-}
runFSKVStoreRelUtf8 ::
Members '[Embed IO] r =>
Path b Dir ->
Sem (FSKVStore Rel Text ': r) a ->
Sem r a
runFSKVStoreRelUtf8 :: forall (r :: EffectRow) b a.
Members '[Embed IO] r =>
Path b Dir -> Sem (FSKVStore Rel Text : r) a -> Sem r a
runFSKVStoreRelUtf8 Path b Dir
d = forall (e :: (* -> *) -> * -> *) (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 \case
LookupKV Path Rel File
k -> do
Bool
z <- forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
U.doesFileExist (Path b Dir
d forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
k)
if Bool
z
then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadIO m => FilePath -> m Text
readFileUtf8 forall a b. (a -> b) -> a -> b
$ forall b t. Path b t -> FilePath
toFilePath forall a b. (a -> b) -> a -> b
$ Path b Dir
d forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
k
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
UpdateKV Path Rel File
k Maybe Text
v -> do
forall (m :: * -> *) b. MonadIO m => Bool -> Path b Dir -> m ()
U.createDirectoryIfMissing Bool
True (Path b Dir
d forall b t. Path b Dir -> Path Rel t -> Path b t
</> forall b t. Path b t -> Path b Dir
parent Path Rel File
k)
case Maybe Text
v of
Maybe Text
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just Text
x -> forall (m :: * -> *). MonadIO m => FilePath -> Text -> m ()
writeFileUtf8 (forall b t. Path b t -> FilePath
toFilePath (Path b Dir
d forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
k)) Text
x
{-# INLINE runFSKVStoreRelUtf8 #-}
runFSKVStoreAbsUtf8 ::
Members '[Embed IO] r =>
Sem (FSKVStore Abs Text ': r) a ->
Sem r a
runFSKVStoreAbsUtf8 :: forall (r :: EffectRow) a.
Members '[Embed IO] r =>
Sem (FSKVStore Abs Text : r) a -> Sem r a
runFSKVStoreAbsUtf8 = forall (e :: (* -> *) -> * -> *) (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 \case
LookupKV Path Abs File
k -> do
Bool
z <- forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
U.doesFileExist Path Abs File
k
if Bool
z
then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadIO m => FilePath -> m Text
readFileUtf8 forall a b. (a -> b) -> a -> b
$ forall b t. Path b t -> FilePath
toFilePath Path Abs File
k
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
UpdateKV Path Abs File
k Maybe Text
v -> do
forall (m :: * -> *) b. MonadIO m => Bool -> Path b Dir -> m ()
U.createDirectoryIfMissing Bool
True (forall b t. Path b t -> Path b Dir
parent Path Abs File
k)
case Maybe Text
v of
Maybe Text
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just Text
x -> forall (m :: * -> *). MonadIO m => FilePath -> Text -> m ()
writeFileUtf8 (forall b t. Path b t -> FilePath
toFilePath Path Abs File
k) Text
x
{-# INLINE runFSKVStoreAbsUtf8 #-}