{-# LANGUAGE AllowAmbiguousTypes #-}

-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at https://mozilla.org/MPL/2.0/.

{- |
Copyright   :  (c) 2024 Yamada Ryo
License     :  MPL-2.0 (see the file LICENSE)
Maintainer  :  ymdfield@outlook.jp
Stability   :  experimental
Portability :  portable

This module provides the t`KVStore` effect, comes
from [@Polysemy.KVStore@](https://hackage.haskell.org/package/polysemy-kvstore-0.1.3.0/docs/Polysemy-KVStore.html)
in the @polysemy-kvstore@ package.
-}
module Data.Effect.KVStore where

import Data.Effect.Except (Throw, throw)
import Data.Maybe (isJust)

data KVStore k v a where
    LookupKV :: k -> KVStore k v (Maybe v)
    UpdateKV :: k -> Maybe v -> KVStore k v ()

makeEffectF [''KVStore]

lookupOrThrowKV :: (KVStore k v <: m, Throw e <: m, Monad m) => (k -> e) -> k -> m v
lookupOrThrowKV :: forall k v (m :: * -> *) e.
(KVStore k v <: m, Throw e <: m, Monad m) =>
(k -> e) -> k -> m v
lookupOrThrowKV k -> e
err k
k =
    forall k v (f :: * -> *).
SendIns (KVStore k v) f =>
k -> f (Maybe v)
lookupKV k
k forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e a (f :: * -> *). SendIns (Throw e) f => e -> f a
throw forall a b. (a -> b) -> a -> b
$ k -> e
err k
k) forall (f :: * -> *) a. Applicative f => a -> f a
pure

existsKV :: forall v k f. (KVStore k v <: f, Functor f) => k -> f Bool
existsKV :: forall v k (f :: * -> *).
(KVStore k v <: f, Functor f) =>
k -> f Bool
existsKV = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v (f :: * -> *).
SendIns (KVStore k v) f =>
k -> f (Maybe v)
lookupKV @k @v
{-# INLINE existsKV #-}

writeKV :: KVStore k v <: f => k -> v -> f ()
writeKV :: forall k v (f :: * -> *). (KVStore k v <: f) => k -> v -> f ()
writeKV k
k v
v = forall k v (f :: * -> *).
SendIns (KVStore k v) f =>
k -> Maybe v -> f ()
updateKV k
k (forall a. a -> Maybe a
Just v
v)
{-# INLINE writeKV #-}

deleteKV :: forall v k f. KVStore k v <: f => k -> f ()
deleteKV :: forall v k (f :: * -> *). (KVStore k v <: f) => k -> f ()
deleteKV k
k = forall k v (f :: * -> *).
SendIns (KVStore k v) f =>
k -> Maybe v -> f ()
updateKV @k @v k
k forall a. Maybe a
Nothing
{-# INLINE deleteKV #-}

modifyKV :: (KVStore k v <: m, Monad m) => v -> (v -> v) -> k -> m ()
modifyKV :: forall k v (m :: * -> *).
(KVStore k v <: m, Monad m) =>
v -> (v -> v) -> k -> m ()
modifyKV v
vDefault v -> v
f k
k = do
    Maybe v
v <- forall k v (f :: * -> *).
SendIns (KVStore k v) f =>
k -> f (Maybe v)
lookupKV k
k
    forall k v (f :: * -> *).
SendIns (KVStore k v) f =>
k -> Maybe v -> f ()
updateKV k
k (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe v
vDefault v -> v
f Maybe v
v)