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