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

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeOperators #-}

module Polysemy.FSKVStore
  ( FSKVStore,
    runFSKVStoreRelBS,
    runFSKVStoreAbsBS,
    runFSKVStoreRelUtf8,
    runFSKVStoreAbsUtf8,
  )
where

import Data.ByteString as BS
import Path
import Polysemy
import Polysemy.KVStore
import RIO (Text, readFileUtf8, writeFileUtf8)
import qualified UnliftIO.Path.Directory as U

-- | Type synonym for a KVStore indexed by files.
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 (FSKVStore Rel 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
{-# INLINE runFSKVStoreRelBS #-}

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