{-# 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 synonym for a KVStore indexed by files.
type FSKVStore :: Type -> Type -> (Type -> Type) -> Type -> Type
type FSKVStore b a = KVStore (Path b File) a

-- | Run an `FSKVStore Rel ByteString` in the supplied directory in IO.
--
-- @since 0.1.0.0
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

-- | Run an `FSKVStore Abs ByteString` in IO.
--
-- @since 0.1.0.0
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 #-}

-- | Run an `FSKVStore Rel Text` in the supplied directory in IO as UTF8.
--
-- @since 0.1.0.0
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 #-}

-- | Run an `FSKVStore Abs Text` in IO as UTF8.
--
-- @since 0.1.0.0
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 #-}