module Polysemy.Db.Interpreter.Query where

import Conc (interpretAtomic)
import qualified Data.Map.Strict as Map
import Lens.Micro.Extras (view)
import qualified Sqel.Data.Uid as Uid
import Sqel.Data.Uid (Uid (Uid))

import qualified Polysemy.Db.Data.DbError as DbError
import Polysemy.Db.Data.DbError (DbError)
import Polysemy.Db.Effect.Query (Query (..))
import qualified Polysemy.Db.Effect.Store as Store
import Polysemy.Db.Effect.Store (Store)
import Polysemy.Db.Interpreter.Store (PureStore (PureStore), interpretStoreConc)

class QueryCheckResult f where
  queryCheckResult :: [a] -> Either DbError (f a)

instance QueryCheckResult Maybe where
  queryCheckResult :: forall a. [a] -> Either DbError (Maybe a)
queryCheckResult = \case
    [] -> forall a b. b -> Either a b
Right forall a. Maybe a
Nothing
    [Item [a]
a] -> forall a b. b -> Either a b
Right (forall a. a -> Maybe a
Just Item [a]
a)
    [a]
_ -> forall a b. a -> Either a b
Left (Text -> DbError
DbError.Query Text
"Multiple matches for single-result query")

instance QueryCheckResult [] where
  queryCheckResult :: forall a. [a] -> Either DbError [a]
queryCheckResult = forall a b. b -> Either a b
Right

interpretQueryConst ::
  Ord q =>
  QueryCheckResult f =>
  Map q [d] ->
  InterpreterFor (Query q (f d) !! DbError) r
interpretQueryConst :: forall q (f :: * -> *) d (r :: [Effect]).
(Ord q, QueryCheckResult f) =>
Map q [d] -> InterpreterFor (Query q (f d) !! DbError) r
interpretQueryConst Map q [d]
store =
  forall err (eff :: Effect) (r :: [Effect]).
FirstOrder eff "interpretResumable" =>
(forall x (r0 :: [Effect]). eff (Sem r0) x -> Sem (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
interpretResumable \case
    Query q
params ->
      forall err (r :: [Effect]) a.
Member (Stop err) r =>
Either err a -> Sem r a
stopEither (forall (f :: * -> *) a.
QueryCheckResult f =>
[a] -> Either DbError (f a)
queryCheckResult (forall a. a -> Maybe a -> a
fromMaybe [] (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup q
params Map q [d]
store)))

interpretQueryAtomicState ::
  ∀ i a d q f r .
  Member (AtomicState (PureStore i a)) r =>
  QueryCheckResult f =>
  (q -> Uid i a -> Maybe d) ->
  InterpreterFor (Query q (f d) !! DbError) r
interpretQueryAtomicState :: forall i a d q (f :: * -> *) (r :: [Effect]).
(Member (AtomicState (PureStore i a)) r, QueryCheckResult f) =>
(q -> Uid i a -> Maybe d)
-> InterpreterFor (Query q (f d) !! DbError) r
interpretQueryAtomicState q -> Uid i a -> Maybe d
match =
  forall err (eff :: Effect) (r :: [Effect]).
FirstOrder eff "interpretResumable" =>
(forall x (r0 :: [Effect]). eff (Sem r0) x -> Sem (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
interpretResumable \case
    Query q
q ->
      forall err (r :: [Effect]) 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 s' (r :: [Effect]).
Member (AtomicState s) r =>
(s -> s') -> Sem r s'
atomicGets (forall (f :: * -> *) a.
QueryCheckResult f =>
[a] -> Either DbError (f a)
queryCheckResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (q -> Uid i a -> Maybe d
match q
q) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s. Getting a s a -> s -> a
view forall a. IsLabel "records" a => a
#records)

interpretQueryConc ::
  Ord i =>
  QueryCheckResult f =>
  Member (Embed IO) r =>
  (q -> Uid i a -> Maybe d) ->
  [Uid i a] ->
  InterpreterFor (Query q (f d) !! DbError) r
interpretQueryConc :: forall i (f :: * -> *) (r :: [Effect]) q a d.
(Ord i, QueryCheckResult f, Member (Embed IO) r) =>
(q -> Uid i a -> Maybe d)
-> [Uid i a] -> InterpreterFor (Query q (f d) !! DbError) r
interpretQueryConc q -> Uid i a -> Maybe d
match [Uid i a]
initial =
  forall a (r :: [Effect]).
Member (Embed IO) r =>
a -> InterpreterFor (AtomicState a) r
interpretAtomic (forall i a. Map i (Uid i a) -> PureStore i a
PureStore (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Uid i a]
initial forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ a :: Uid i a
a@(Uid i
i a
_) -> (i
i, Uid i a
a)))) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall i a d q (f :: * -> *) (r :: [Effect]).
(Member (AtomicState (PureStore i a)) r, QueryCheckResult f) =>
(q -> Uid i a -> Maybe d)
-> InterpreterFor (Query q (f d) !! DbError) r
interpretQueryAtomicState q -> Uid i a -> Maybe d
match forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall (e2 :: Effect) (e1 :: Effect) (r :: [Effect]) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder

interpretQueryStoreConc ::
  Ord i =>
  Show i =>
  QueryCheckResult f =>
  Member (Embed IO) r =>
  (q -> Uid i a -> Maybe d) ->
  [Uid i a] ->
  InterpretersFor [Query q (f d) !! DbError, Store i a !! DbError, AtomicState (PureStore i a)] r
interpretQueryStoreConc :: forall i (f :: * -> *) (r :: [Effect]) q a d.
(Ord i, Show i, QueryCheckResult f, Member (Embed IO) r) =>
(q -> Uid i a -> Maybe d)
-> [Uid i a]
-> InterpretersFor
     '[Query q (f d) !! DbError, Store i a !! DbError,
       AtomicState (PureStore i a)]
     r
interpretQueryStoreConc q -> Uid i a -> Maybe d
match [Uid i a]
initial =
  forall i a (r :: [Effect]).
(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. Map i (Uid i a) -> PureStore i a
PureStore (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Uid i a]
initial forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ a :: Uid i a
a@(Uid i
i a
_) -> (i
i, Uid i a
a)))) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall i a d q (f :: * -> *) (r :: [Effect]).
(Member (AtomicState (PureStore i a)) r, QueryCheckResult f) =>
(q -> Uid i a -> Maybe d)
-> InterpreterFor (Query q (f d) !! DbError) r
interpretQueryAtomicState q -> Uid i a -> Maybe d
match

interpretQueryStoreAny ::
  ∀ q d i e r .
  Member (Store i d !! e) r =>
  (q -> d -> Bool) ->
  InterpreterFor (Query q Bool !! e) r
interpretQueryStoreAny :: forall q d i e (r :: [Effect]).
Member (Store i d !! e) r =>
(q -> d -> Bool) -> InterpreterFor (Query q Bool !! e) r
interpretQueryStoreAny q -> d -> Bool
match =
  forall err (eff :: Effect) (r :: [Effect]).
FirstOrder eff "interpretResumable" =>
(forall x (r0 :: [Effect]). eff (Sem r0) x -> Sem (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
interpretResumable \case
    Query q
q ->
      forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (q -> d -> Bool
match q
q forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i a. Uid i a -> a
Uid.payload) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall err (eff :: Effect) (r :: [Effect]).
Members '[Resumable err eff, Stop err] r =>
InterpreterFor eff r
restop forall (f :: * -> *) i d (r :: [Effect]).
Member (QStore f i d) r =>
Sem r [d]
Store.fetchAll