polysemy-fskvstore-0.1.2.0: src/Polysemy/FSKVStore.hs

{-# 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 d = interpret \case
  LookupKV k -> embed $ do
    z <- U.doesFileExist (d </> k)
    if z
      then fmap Just . BS.readFile $ toFilePath $ d </> k
      else return Nothing
  UpdateKV k v -> embed $ do
    U.createDirectoryIfMissing True (d </> parent k)
    case v of
      Nothing -> pure ()
      Just x  -> BS.writeFile (toFilePath (d </> k)) 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 = interpret \case
  LookupKV k -> embed $ do
    z <- U.doesFileExist k
    if z
      then fmap Just . BS.readFile $ toFilePath k
      else return Nothing
  UpdateKV k v -> embed $ do
    U.createDirectoryIfMissing True (parent k)
    case v of
      Nothing -> pure ()
      Just x  -> BS.writeFile (toFilePath k) 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 d = interpret \case
  LookupKV k -> do
    z <- U.doesFileExist (d </> k)
    if z
      then fmap Just . readFileUtf8 $ toFilePath $ d </> k
      else return Nothing
  UpdateKV k v -> do
    U.createDirectoryIfMissing True (d </> parent k)
    case v of
      Nothing -> pure ()
      Just x  -> writeFileUtf8 (toFilePath (d </> k)) 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 = interpret \case
  LookupKV k -> do
    z <- U.doesFileExist k
    if z
      then fmap Just . readFileUtf8 $ toFilePath k
      else return Nothing
  UpdateKV k v -> do
    U.createDirectoryIfMissing True (parent k)
    case v of
      Nothing -> pure ()
      Just x  -> writeFileUtf8 (toFilePath k) x
{-# INLINE runFSKVStoreAbsUtf8 #-}