{-# 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 Sayo Koyoneda
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 =
    k -> m (Maybe v)
forall k v (f :: * -> *).
SendFOE (KVStore k v) f =>
k -> f (Maybe v)
lookupKV k
k m (Maybe v) -> (Maybe v -> m v) -> m v
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m v -> (v -> m v) -> Maybe v -> m v
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> m v
forall e a (f :: * -> *). SendFOE (Throw e) f => e -> f a
throw (e -> m v) -> e -> m v
forall a b. (a -> b) -> a -> b
$ k -> e
err k
k) v -> m v
forall a. a -> m a
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 = (Maybe v -> Bool) -> f (Maybe v) -> f Bool
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe v -> Bool
forall a. Maybe a -> Bool
isJust (f (Maybe v) -> f Bool) -> (k -> f (Maybe v)) -> k -> f Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v (f :: * -> *).
SendFOE (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 = k -> Maybe v -> f ()
forall k v (f :: * -> *).
SendFOE (KVStore k v) f =>
k -> Maybe v -> f ()
updateKV k
k (v -> Maybe v
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 :: * -> *).
SendFOE (KVStore k v) f =>
k -> Maybe v -> f ()
updateKV @k @v k
k Maybe v
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 <- k -> m (Maybe v)
forall k v (f :: * -> *).
SendFOE (KVStore k v) f =>
k -> f (Maybe v)
lookupKV k
k
    k -> Maybe v -> m ()
forall k v (f :: * -> *).
SendFOE (KVStore k v) f =>
k -> Maybe v -> f ()
updateKV k
k (v -> Maybe v
forall a. a -> Maybe a
Just (v -> Maybe v) -> v -> Maybe v
forall a b. (a -> b) -> a -> b
$ v -> (v -> v) -> Maybe v -> v
forall b a. b -> (a -> b) -> Maybe a -> b
maybe v
vDefault v -> v
f Maybe v
v)