{-# LANGUAGE TemplateHaskell #-}

module Polysemy.SetStore where

import           Data.Foldable
import qualified Data.Set as S
import           Polysemy
import           Polysemy.KVStore



data SetStore k v m a where
  AddS :: k -> v -> SetStore k v m ()
  DelS :: k -> v -> SetStore k v m ()
  MemberS :: k -> v -> SetStore k v m Bool

makeSem ''SetStore


runSetStoreAsKVStore
    :: ( Member (KVStore k (S.Set v)) r
       , Ord v
       )
    => Sem (SetStore k v ': r) x -> Sem r x
runSetStoreAsKVStore :: Sem (SetStore k v : r) x -> Sem r x
runSetStoreAsKVStore = (forall (rInitial :: EffectRow) x.
 SetStore k v (Sem rInitial) x -> Sem r x)
-> Sem (SetStore k v : r) x -> Sem r x
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 ((forall (rInitial :: EffectRow) x.
  SetStore k v (Sem rInitial) x -> Sem r x)
 -> Sem (SetStore k v : r) x -> Sem r x)
-> (forall (rInitial :: EffectRow) x.
    SetStore k v (Sem rInitial) x -> Sem r x)
-> Sem (SetStore k v : r) x
-> Sem r x
forall a b. (a -> b) -> a -> b
$ \case
  AddS k v ->
    k -> Sem r (Maybe (Set v))
forall k v (r :: EffectRow).
Member (KVStore k v) r =>
k -> Sem r (Maybe v)
lookupKV k
k Sem r (Maybe (Set v)) -> (Maybe (Set v) -> Sem r ()) -> Sem r ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just Set v
s  -> k -> Set v -> Sem r ()
forall k v (r :: EffectRow).
Member (KVStore k v) r =>
k -> v -> Sem r ()
writeKV k
k (Set v -> Sem r ()) -> Set v -> Sem r ()
forall a b. (a -> b) -> a -> b
$ v -> Set v -> Set v
forall a. Ord a => a -> Set a -> Set a
S.insert v
v Set v
s
      Maybe (Set v)
Nothing -> k -> Set v -> Sem r ()
forall k v (r :: EffectRow).
Member (KVStore k v) r =>
k -> v -> Sem r ()
writeKV k
k (Set v -> Sem r ()) -> Set v -> Sem r ()
forall a b. (a -> b) -> a -> b
$ v -> Set v
forall a. a -> Set a
S.singleton v
v
  DelS k v -> do
    Maybe (Set v)
ms <- k -> Sem r (Maybe (Set v))
forall k v (r :: EffectRow).
Member (KVStore k v) r =>
k -> Sem r (Maybe v)
lookupKV k
k
    Maybe (Set v) -> (Set v -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe (Set v)
ms ((Set v -> Sem r ()) -> Sem r ())
-> (Set v -> Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ k -> Set v -> Sem r ()
forall k v (r :: EffectRow).
Member (KVStore k v) r =>
k -> v -> Sem r ()
writeKV k
k (Set v -> Sem r ()) -> (Set v -> Set v) -> Set v -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Set v -> Set v
forall a. Ord a => a -> Set a -> Set a
S.delete v
v
  MemberS k v ->
    Bool -> Sem r Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Sem r Bool)
-> (Maybe (Set v) -> Bool) -> Maybe (Set v) -> Sem r Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> (Set v -> Bool) -> Maybe (Set v) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (v -> Set v -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member v
v) (Maybe (Set v) -> Sem r Bool)
-> Sem r (Maybe (Set v)) -> Sem r Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< k -> Sem r (Maybe (Set v))
forall k v (r :: EffectRow).
Member (KVStore k v) r =>
k -> Sem r (Maybe v)
lookupKV k
k
{-# INLINE runSetStoreAsKVStore #-}