module Polysemy.Db.Interpreter.Reader where

import Polysemy.Internal.Tactics (liftT)
import Polysemy.Reader (Reader (Ask, Local))

import qualified Polysemy.Db.Effect.Store as Store
import Polysemy.Db.Effect.Store (QStore)

insertValue ::
  ∀ d e r .
  Members [QStore Maybe () d !! e, Stop e] r =>
  Sem r d ->
  Sem r d
insertValue :: forall d e (r :: EffectRow).
Members '[QStore Maybe () d !! e, Stop e] r =>
Sem r d -> Sem r d
insertValue Sem r d
initial =
  Sem r d
initial forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Functor m => (a -> m ()) -> a -> m a
tap \ d
d ->
    forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
Members '[Resumable err eff, Stop err] r =>
InterpreterFor eff r
restop (forall (f :: * -> *) i d (r :: EffectRow).
Member (QStore f i d) r =>
Sem r [d]
Store.deleteAll forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) i d (r :: EffectRow).
Member (QStore f i d) r =>
d -> Sem r ()
Store.insert d
d)

readValue ::
  ∀ d e r .
  Members [QStore Maybe () d !! e, Stop e] r =>
  Sem r d ->
  Sem r d
readValue :: forall d e (r :: EffectRow).
Members '[QStore Maybe () d !! e, Stop e] r =>
Sem r d -> Sem r d
readValue Sem r d
initial = do
  Maybe d
stored <- forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
Members '[Resumable err eff, Stop err] r =>
InterpreterFor eff r
restop (forall (f :: * -> *) i d (r :: EffectRow).
Member (QStore f i d) r =>
i -> Sem r (f d)
Store.fetch ())
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall d e (r :: EffectRow).
Members '[QStore Maybe () d !! e, Stop e] r =>
Sem r d -> Sem r d
insertValue @d @e Sem r d
initial) forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe d
stored

-- |Interpret 'Reader' as a singleton table.
--
-- Given an initial value, every action reads the value from the database, potentially writing it on first access.
interpretReaderStore ::
  ∀ d e r .
  Member (QStore Maybe () d !! e) r =>
  Sem r d ->
  InterpreterFor (Reader d !! e) r
interpretReaderStore :: forall d e (r :: EffectRow).
Member (QStore Maybe () d !! e) r =>
Sem r d -> InterpreterFor (Reader d !! e) r
interpretReaderStore Sem r d
initial =
  forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
(forall x (r0 :: EffectRow).
 eff (Sem r0) x
 -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
interpretResumableH \case
    Reader d (Sem r0) x
Ask -> do
      forall (m :: * -> *) (f :: * -> *) (r :: EffectRow)
       (e :: (* -> *) -> * -> *) a.
Functor f =>
Sem r a -> Sem (WithTactics e f m r) (f a)
liftT (forall d e (r :: EffectRow).
Members '[QStore Maybe () d !! e, Stop e] r =>
Sem r d -> Sem r d
readValue @d @e (forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
raise Sem r d
initial))
    Local d -> d
f Sem r0 x
ma ->
      forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
raise forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d e (r :: EffectRow).
Member (QStore Maybe () d !! e) r =>
Sem r d -> InterpreterFor (Reader d !! e) r
interpretReaderStore (d -> d
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
raise Sem r d
initial) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a (e :: (* -> *) -> * -> *) (f :: * -> *)
       (r :: EffectRow).
m a -> Sem (WithTactics e f m r) (Sem (e : r) (f a))
runT Sem r0 x
ma

interpretReaderStoreAs ::
  ∀ d e r .
  Member (QStore Maybe () d !! e) r =>
  d ->
  InterpreterFor (Reader d !! e) r
interpretReaderStoreAs :: forall d e (r :: EffectRow).
Member (QStore Maybe () d !! e) r =>
d -> InterpreterFor (Reader d !! e) r
interpretReaderStoreAs d
initial =
  forall d e (r :: EffectRow).
Member (QStore Maybe () d !! e) r =>
Sem r d -> InterpreterFor (Reader d !! e) r
interpretReaderStore (forall (f :: * -> *) a. Applicative f => a -> f a
pure d
initial)