module Polysemy.Db.Interpreter.Id where

import Conc (interpretAtomic)
import qualified Data.UUID as UUID
import Data.UUID (UUID)

import Polysemy.Db.Effect.Id (Id (NewId))
import Polysemy.Db.Effect.Random (Random, random)
import Polysemy.Db.Interpreter.Random (interpretRandom)

interpretIdUuid ::
  Member (Random UUID) r =>
  InterpreterFor (Id UUID) r
interpretIdUuid :: forall (r :: EffectRow).
Member (Random UUID) r =>
InterpreterFor (Id UUID) r
interpretIdUuid =
  forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \ Id UUID (Sem rInitial) x
NewId -> forall a (r :: EffectRow). Member (Random a) r => Sem r a
random

interpretIdUuidIO ::
  Member (Embed IO) r =>
  InterpreterFor (Id UUID) r
interpretIdUuidIO :: forall (r :: EffectRow).
Member (Embed IO) r =>
InterpreterFor (Id UUID) r
interpretIdUuidIO =
  forall a (r :: EffectRow).
(Random a, Member (Embed IO) r) =>
InterpreterFor (Random a) r
interpretRandom forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: EffectRow).
Member (Random UUID) r =>
InterpreterFor (Id UUID) r
interpretIdUuid 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

interpretIdUuidZero ::
  InterpreterFor (Id UUID) r
interpretIdUuidZero :: forall (r :: EffectRow). InterpreterFor (Id UUID) r
interpretIdUuidZero =
  forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \ Id UUID (Sem rInitial) x
NewId -> forall (f :: * -> *) a. Applicative f => a -> f a
pure UUID
UUID.nil

interpretIdAtomicState ::
  ∀ i r .
  Members [AtomicState [i], Error Text] r =>
  InterpreterFor (Id i) r
interpretIdAtomicState :: forall i (r :: EffectRow).
Members '[AtomicState [i], Error Text] r =>
InterpreterFor (Id i) r
interpretIdAtomicState =
  forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
    Id i (Sem rInitial) x
NewId -> do
      Maybe x
i <- forall s a (r :: EffectRow).
Member (AtomicState s) r =>
(s -> (s, a)) -> Sem r a
atomicState' \case
        x
u : [x]
rest -> ([x]
rest, forall a. a -> Maybe a
Just x
u)
        [] -> ([], forall a. Maybe a
Nothing)
      forall (m :: * -> *) a. Applicative m => m a -> Maybe a -> m a
fromMaybeA (forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw Text
"Id pool exhausted") Maybe x
i

interpretIdList ::
  ∀ i r .
  Members [Error Text, Embed IO] r =>
  [i] ->
  InterpreterFor (Id i) r
interpretIdList :: forall i (r :: EffectRow).
Members '[Error Text, Embed IO] r =>
[i] -> InterpreterFor (Id i) r
interpretIdList [i]
pool =
  forall a (r :: EffectRow).
Member (Embed IO) r =>
a -> InterpreterFor (AtomicState a) r
interpretAtomic [i]
pool forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall i (r :: EffectRow).
Members '[AtomicState [i], Error Text] r =>
InterpreterFor (Id i) r
interpretIdAtomicState 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

interpretIdNumFrom ::
  ∀ i r .
  Member (Embed IO) r =>
  Num i =>
  i ->
  InterpreterFor (Id i) r
interpretIdNumFrom :: forall i (r :: EffectRow).
(Member (Embed IO) r, Num i) =>
i -> InterpreterFor (Id i) r
interpretIdNumFrom i
start =
  forall a (r :: EffectRow).
Member (Embed IO) r =>
a -> InterpreterFor (AtomicState a) r
interpretAtomic @i i
start forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (r :: EffectRow) a.
FirstOrder e1 "reinterpret" =>
(forall (rInitial :: EffectRow) x.
 e1 (Sem rInitial) x -> Sem (e2 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : r) a
reinterpret \ Id i (Sem rInitial) x
NewId ->
    forall s a (r :: EffectRow).
Member (AtomicState s) r =>
(s -> (s, a)) -> Sem r a
atomicState' \ x
i -> ((x
i forall a. Num a => a -> a -> a
+ x
1), x
i)

interpretIdNum ::
  ∀ i r .
  Member (Embed IO) r =>
  Num i =>
  InterpreterFor (Id i) r
interpretIdNum :: forall i (r :: EffectRow).
(Member (Embed IO) r, Num i) =>
InterpreterFor (Id i) r
interpretIdNum =
  forall i (r :: EffectRow).
(Member (Embed IO) r, Num i) =>
i -> InterpreterFor (Id i) r
interpretIdNumFrom i
1

interpretIdNumLocal ::
  ∀ i r .
  Num i =>
  InterpreterFor (Id i) r
interpretIdNumLocal :: forall i (r :: EffectRow). Num i => InterpreterFor (Id i) r
interpretIdNumLocal =
  forall s (r :: EffectRow) a. s -> Sem (State s : r) a -> Sem r a
evalState @i i
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (r :: EffectRow) a.
FirstOrder e1 "reinterpret" =>
(forall (rInitial :: EffectRow) x.
 e1 (Sem rInitial) x -> Sem (e2 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : r) a
reinterpret \ Id i (Sem rInitial) x
NewId ->
    forall s (r :: EffectRow). Member (State s) r => Sem r s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ x
i -> x
i forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (r :: EffectRow). Member (State s) r => s -> Sem r ()
put (x
i forall a. Num a => a -> a -> a
+ x
1)

interpretIdConst ::
  ∀ i r .
  i ->
  InterpreterFor (Id i) r
interpretIdConst :: forall i (r :: EffectRow). i -> InterpreterFor (Id i) r
interpretIdConst i
i =
  forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \ Id i (Sem rInitial) x
NewId -> forall (f :: * -> *) a. Applicative f => a -> f a
pure i
i