Store.hs

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 id' =
  isJust <$> fetch id'

fetchPayload ::
  ∀ i d r .
  Member (Store i d) r =>
  i ->
  Sem r (Maybe d)
fetchPayload id' =
  fmap Uid.payload <$> fetch id'

alter ::
  ∀ i d r .
  Member (Store i d) r =>
  i ->
  (d -> d) ->
  Sem r ()
alter id' f = do
  cur <- fetch id'
  traverse_ (upsert . (#payload %~ f)) cur