module Polysemy.Db.Interpreter.Store where

import Conc (interpretAtomic)
import qualified Data.Map.Strict as Map
import Exon (exon)
import Sqel.Data.Uid (Uid (Uid))

import qualified Polysemy.Db.Data.DbError as DbError
import Polysemy.Db.Data.DbError (DbError)
import Polysemy.Db.Effect.Store (QStore (..), Store)

newtype PureStore i a =
  PureStore { forall i a. PureStore i a -> Map i (Uid i a)
records :: Map i (Uid i a) }
  deriving stock (PureStore i a -> PureStore i a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall i a. (Eq i, Eq a) => PureStore i a -> PureStore i a -> Bool
/= :: PureStore i a -> PureStore i a -> Bool
$c/= :: forall i a. (Eq i, Eq a) => PureStore i a -> PureStore i a -> Bool
== :: PureStore i a -> PureStore i a -> Bool
$c== :: forall i a. (Eq i, Eq a) => PureStore i a -> PureStore i a -> Bool
Eq, Int -> PureStore i a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall i a. (Show i, Show a) => Int -> PureStore i a -> ShowS
forall i a. (Show i, Show a) => [PureStore i a] -> ShowS
forall i a. (Show i, Show a) => PureStore i a -> String
showList :: [PureStore i a] -> ShowS
$cshowList :: forall i a. (Show i, Show a) => [PureStore i a] -> ShowS
show :: PureStore i a -> String
$cshow :: forall i a. (Show i, Show a) => PureStore i a -> String
showsPrec :: Int -> PureStore i a -> ShowS
$cshowsPrec :: forall i a. (Show i, Show a) => Int -> PureStore i a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i a x. Rep (PureStore i a) x -> PureStore i a
forall i a x. PureStore i a -> Rep (PureStore i a) x
$cto :: forall i a x. Rep (PureStore i a) x -> PureStore i a
$cfrom :: forall i a x. PureStore i a -> Rep (PureStore i a) x
Generic)
  deriving newtype (PureStore i a
forall a. a -> Default a
forall i a. PureStore i a
def :: PureStore i a
$cdef :: forall i a. PureStore i a
Default, NonEmpty (PureStore i a) -> PureStore i a
PureStore i a -> PureStore i a -> PureStore i a
forall b. Integral b => b -> PureStore i a -> PureStore i a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall i a. Ord i => NonEmpty (PureStore i a) -> PureStore i a
forall i a.
Ord i =>
PureStore i a -> PureStore i a -> PureStore i a
forall i a b.
(Ord i, Integral b) =>
b -> PureStore i a -> PureStore i a
stimes :: forall b. Integral b => b -> PureStore i a -> PureStore i a
$cstimes :: forall i a b.
(Ord i, Integral b) =>
b -> PureStore i a -> PureStore i a
sconcat :: NonEmpty (PureStore i a) -> PureStore i a
$csconcat :: forall i a. Ord i => NonEmpty (PureStore i a) -> PureStore i a
<> :: PureStore i a -> PureStore i a -> PureStore i a
$c<> :: forall i a.
Ord i =>
PureStore i a -> PureStore i a -> PureStore i a
Semigroup, PureStore i a
[PureStore i a] -> PureStore i a
PureStore i a -> PureStore i a -> PureStore i a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall i a. Ord i => Semigroup (PureStore i a)
forall i a. Ord i => PureStore i a
forall i a. Ord i => [PureStore i a] -> PureStore i a
forall i a.
Ord i =>
PureStore i a -> PureStore i a -> PureStore i a
mconcat :: [PureStore i a] -> PureStore i a
$cmconcat :: forall i a. Ord i => [PureStore i a] -> PureStore i a
mappend :: PureStore i a -> PureStore i a -> PureStore i a
$cmappend :: forall i a.
Ord i =>
PureStore i a -> PureStore i a -> PureStore i a
mempty :: PureStore i a
$cmempty :: forall i a. Ord i => PureStore i a
Monoid)

pureStore ::
  Ord i =>
  [Uid i a] ->
  PureStore i a
pureStore :: forall i a. Ord i => [Uid i a] -> PureStore i a
pureStore =
  forall i a. Map i (Uid i a) -> PureStore i a
PureStore forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \ a :: Uid i a
a@(Uid i
i a
_) -> (i
i, Uid i a
a)

interpretStoreAtomicState ::
  ∀ i a r .
  Ord i =>
  Show i =>
  Member (AtomicState (PureStore i a)) r =>
  InterpreterFor (Store i a !! DbError) r
interpretStoreAtomicState :: forall i a (r :: EffectRow).
(Ord i, Show i, Member (AtomicState (PureStore i a)) r) =>
InterpreterFor (Store i a !! DbError) r
interpretStoreAtomicState =
  forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
FirstOrder eff "interpretResumable" =>
(forall x (r0 :: EffectRow).
 eff (Sem r0) x -> Sem (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
interpretResumable \case
    Insert a :: Uid i a
a@(Uid i
i a
_) ->
      forall err (r :: EffectRow) a.
Member (Stop err) r =>
Either err a -> Sem r a
stopEither forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s a (r :: EffectRow).
Member (AtomicState s) r =>
(s -> (s, a)) -> Sem r a
atomicState' \ (PureStore Map i (Uid i a)
records) ->
        let
          update :: Maybe (Uid i a) -> (Either DbError (), Maybe (Uid i a))
update = \case
            Just Uid i a
x -> (forall a b. a -> Either a b
Left (Text -> DbError
DbError.Query [exon|'#{show i}' is already in the store|]), forall a. a -> Maybe a
Just Uid i a
x)
            Maybe (Uid i a)
Nothing -> (forall a b. b -> Either a b
Right (), forall a. a -> Maybe a
Just Uid i a
a)
        in forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall i a. Map i (Uid i a) -> PureStore i a
PureStore (forall a b. (a, b) -> (b, a)
swap (forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
Map.alterF Maybe (Uid i a) -> (Either DbError (), Maybe (Uid i a))
update i
i Map i (Uid i a)
records))
    Upsert a :: Uid i a
a@(Uid i
i a
_) ->
      forall s (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s) -> Sem r ()
atomicModify' (forall a. IsLabel "records" a => a
#records forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert i
i Uid i a
a)
    Delete i
i ->
      forall s a (r :: EffectRow).
Member (AtomicState s) r =>
(s -> (s, a)) -> Sem r a
atomicState' \ (PureStore Map i (Uid i a)
as) -> (forall i a. Map i (Uid i a) -> PureStore i a
PureStore (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete i
i Map i (Uid i a)
as), forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup i
i Map i (Uid i a)
as)
    Store i a (Sem r0) x
DeleteAll ->
      forall s a (r :: EffectRow).
Member (AtomicState s) r =>
(s -> (s, a)) -> Sem r a
atomicState' \ (PureStore Map i (Uid i a)
as) -> (forall a. Monoid a => a
mempty, forall k a. Map k a -> [a]
Map.elems Map i (Uid i a)
as)
    Fetch i
i ->
      forall s s' (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s') -> Sem r s'
atomicGets \ (PureStore Map i (Uid i a)
as) -> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup i
i Map i (Uid i a)
as
    Store i a (Sem r0) x
FetchAll ->
      forall s s' (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s') -> Sem r s'
atomicGets \ (PureStore Map i (Uid i a)
as) -> forall k a. Map k a -> [a]
Map.elems Map i (Uid i a)
as

interpretStoreConc ::
  ∀ i a r .
  Ord i =>
  Show i =>
  Member (Embed IO) r =>
  PureStore i a ->
  InterpretersFor [Store i a !! DbError, AtomicState (PureStore i a)] r
interpretStoreConc :: forall i a (r :: EffectRow).
(Ord i, Show i, Member (Embed IO) r) =>
PureStore i a
-> InterpretersFor
     '[Store i a !! DbError, AtomicState (PureStore i a)] r
interpretStoreConc PureStore i a
initial =
  forall a (r :: EffectRow).
Member (Embed IO) r =>
a -> InterpreterFor (AtomicState a) r
interpretAtomic PureStore i a
initial forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall i a (r :: EffectRow).
(Ord i, Show i, Member (AtomicState (PureStore i a)) r) =>
InterpreterFor (Store i a !! DbError) r
interpretStoreAtomicState

interpretStoreState ::
  ∀ i a r .
  Ord i =>
  Show i =>
  Member (State (PureStore i a)) r =>
  InterpreterFor (Store i a !! DbError) r
interpretStoreState :: forall i a (r :: EffectRow).
(Ord i, Show i, Member (State (PureStore i a)) r) =>
InterpreterFor (Store i a !! DbError) r
interpretStoreState =
  forall s (r :: EffectRow) a.
Member (State s) r =>
Sem (AtomicState s : r) a -> Sem r a
atomicStateToState forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall i a (r :: EffectRow).
(Ord i, Show i, Member (AtomicState (PureStore i a)) r) =>
InterpreterFor (Store i a !! DbError) r
interpretStoreAtomicState forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall (e2 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
       (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder

interpretStoreLocal ::
  ∀ i a r .
  Ord i =>
  Show i =>
  PureStore i a ->
  InterpretersFor [Store i a !! DbError, State (PureStore i a)] r
interpretStoreLocal :: forall i a (r :: EffectRow).
(Ord i, Show i) =>
PureStore i a
-> InterpretersFor '[Store i a !! DbError, State (PureStore i a)] r
interpretStoreLocal PureStore i a
initial =
  forall s (r :: EffectRow) a. s -> Sem (State s : r) a -> Sem r a
evalState PureStore i a
initial forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall i a (r :: EffectRow).
(Ord i, Show i, Member (State (PureStore i a)) r) =>
InterpreterFor (Store i a !! DbError) r
interpretStoreState

interpretStoreNull ::
  InterpreterFor (Store i a !! e) r
interpretStoreNull :: forall i a e (r :: EffectRow). InterpreterFor (Store i a !! e) r
interpretStoreNull =
  forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
FirstOrder eff "interpretResumable" =>
(forall x (r0 :: EffectRow).
 eff (Sem r0) x -> Sem (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
interpretResumable \case
    Insert Uid i a
_ ->
      forall (f :: * -> *). Applicative f => f ()
unit
    Upsert Uid i a
_ ->
      forall (f :: * -> *). Applicative f => f ()
unit
    Delete i
_ ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    Store i a (Sem r0) x
DeleteAll ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Fetch i
_ ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    Store i a (Sem r0) x
FetchAll ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure []