{-# LANGUAGE FlexibleContexts #-}

{- | Pure lifecycle and observation effects for the shipping Koios provider.
The shared recorded transport can run directly in the same State monad.
-}
module Singular.Provider.Koios.State
    ( ProviderState (..)
    , initialProviderState
    , stateRuntime
    , stateRuntimeIn
    ) where

import Control.Monad.State.Strict (MonadState, gets, modify')
import Data.Set qualified as Set
import Data.Text qualified as Text
import Singular.Provider.Koios.Provider
    ( ProviderEvent
    , ProviderRuntime (..)
    )
import Singular.Registry.Evidence (SessionId (..))

data ProviderState = ProviderState
    { ProviderState -> Integer
nextSessionNumber :: Integer
    , ProviderState -> Set SessionId
openSessions :: Set.Set SessionId
    , ProviderState -> [ProviderEvent]
providerEvents :: [ProviderEvent]
    }

initialProviderState :: ProviderState
initialProviderState :: ProviderState
initialProviderState = Integer -> Set SessionId -> [ProviderEvent] -> ProviderState
ProviderState Integer
0 Set SessionId
forall a. Set a
Set.empty []

{- | Every acquisition allocates a fresh identity, then releases it before
returning. No IORef, external clock or process state is involved.
-}
stateRuntime :: (MonadState ProviderState m) => ProviderRuntime m
stateRuntime :: forall (m :: * -> *).
MonadState ProviderState m =>
ProviderRuntime m
stateRuntime = (ProviderState -> ProviderState)
-> (ProviderState -> ProviderState -> ProviderState)
-> ProviderRuntime m
forall s (m :: * -> *).
MonadState s m =>
(s -> ProviderState)
-> (ProviderState -> s -> s) -> ProviderRuntime m
stateRuntimeIn ProviderState -> ProviderState
forall a. a -> a
id ProviderState -> ProviderState -> ProviderState
forall a b. a -> b -> a
const

{- | Compose the same pure lifecycle into a caller's larger State value, such
as a logical clock or wallet model, without hiding external effects.
-}
stateRuntimeIn
    :: (MonadState s m)
    => (s -> ProviderState)
    -> (ProviderState -> s -> s)
    -> ProviderRuntime m
stateRuntimeIn :: forall s (m :: * -> *).
MonadState s m =>
(s -> ProviderState)
-> (ProviderState -> s -> s) -> ProviderRuntime m
stateRuntimeIn s -> ProviderState
select ProviderState -> s -> s
replace =
    ProviderRuntime
        { scopedSession :: forall a. (SessionId -> m a) -> (SessionId -> m ()) -> m a
scopedSession = \SessionId -> m a
action SessionId -> m ()
release -> do
            number <- (s -> Integer) -> m Integer
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (ProviderState -> Integer
nextSessionNumber (ProviderState -> Integer) -> (s -> ProviderState) -> s -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ProviderState
select)
            let identity = Text -> SessionId
SessionId (Text
"koios-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Integer -> String
forall a. Show a => a -> String
show Integer
number))
            update
                ( \ProviderState
state ->
                    ProviderState
state
                        { nextSessionNumber = number + 1
                        , openSessions = Set.insert identity (openSessions state)
                        }
                )
            result <- action identity
            release identity
            update
                ( \ProviderState
state -> ProviderState
state{openSessions = Set.delete identity (openSessions state)}
                )
            pure result
        , sessionOpen :: SessionId -> m Bool
sessionOpen = \SessionId
identity -> (s -> Bool) -> m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (SessionId -> Set SessionId -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member SessionId
identity (Set SessionId -> Bool) -> (s -> Set SessionId) -> s -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProviderState -> Set SessionId
openSessions (ProviderState -> Set SessionId)
-> (s -> ProviderState) -> s -> Set SessionId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ProviderState
select)
        , recordEvent :: ProviderEvent -> m ()
recordEvent = \ProviderEvent
event ->
            (ProviderState -> ProviderState) -> m ()
forall {m :: * -> *}.
MonadState s m =>
(ProviderState -> ProviderState) -> m ()
update
                (\ProviderState
state -> ProviderState
state{providerEvents = providerEvents state <> [event]})
        , measureRead :: forall a. SessionId -> Text -> (a -> ProviderEvent) -> m a -> m a
measureRead = \SessionId
_ Text
_ a -> ProviderEvent
event m a
action -> do
            result <- m a
action
            update
                ( \ProviderState
state -> ProviderState
state{providerEvents = providerEvents state <> [event result]}
                )
            pure result
        }
  where
    update :: (ProviderState -> ProviderState) -> m ()
update ProviderState -> ProviderState
change = (s -> s) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\s
whole -> ProviderState -> s -> s
replace (ProviderState -> ProviderState
change (s -> ProviderState
select s
whole)) s
whole)