module Polysemy.Db.Effect.Store where import Data.UUID (UUID) import qualified Sqel.Data.Uid as Uid import Sqel.Data.Uid (Uid) data QStore f q d :: Effect where Insert :: d -> QStore f i d m () Upsert :: d -> QStore f i d m () Delete :: i -> QStore f i d m (f d) DeleteAll :: QStore f i d m [d] Fetch :: i -> QStore f i d m (f d) FetchAll :: QStore f i d m [d] makeSem ''QStore type Store i d = QStore Maybe i (Uid i d) type UuidStore d = Store UUID d type family StoreEffects i e ds :: EffectRow where StoreEffects _ _ '[] = '[] StoreEffects i e (d : ds) = (Store i d !! e : StoreEffects i e ds) type family Stores i e ds r :: Constraint where Stores _ _ '[] _ = () Stores i e (d : ds) r = (Member (Store i d !! e) r, Stores i e ds r) elem :: ∀ i d r . Member (Store i d) r => i -> Sem r Bool elem :: forall i d (r :: EffectRow). Member (Store i d) r => i -> Sem r Bool elem i id' = forall a. Maybe a -> Bool isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (f :: * -> *) i d (r :: EffectRow). Member (QStore f i d) r => i -> Sem r (f d) fetch i id' fetchPayload :: ∀ i d r . Member (Store i d) r => i -> Sem r (Maybe d) fetchPayload :: forall i d (r :: EffectRow). Member (Store i d) r => i -> Sem r (Maybe d) fetchPayload i id' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall i a. Uid i a -> a Uid.payload forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (f :: * -> *) i d (r :: EffectRow). Member (QStore f i d) r => i -> Sem r (f d) fetch i id' alter :: ∀ i d r . Member (Store i d) r => i -> (d -> d) -> Sem r () alter :: forall i d (r :: EffectRow). Member (Store i d) r => i -> (d -> d) -> Sem r () alter i id' d -> d f = do Maybe (Uid i d) cur <- forall (f :: * -> *) i d (r :: EffectRow). Member (QStore f i d) r => i -> Sem r (f d) fetch i id' forall (t :: * -> *) (f :: * -> *) a b. (Foldable t, Applicative f) => (a -> f b) -> t a -> f () traverse_ (forall (f :: * -> *) i d (r :: EffectRow). Member (QStore f i d) r => d -> Sem r () upsert forall b c a. (b -> c) -> (a -> b) -> a -> c . (forall a. IsLabel "payload" a => a #payload forall s t a b. ASetter s t a b -> (a -> b) -> s -> t %~ d -> d f)) Maybe (Uid i d) cur