-- |  'Hydra.API.Projection' module exposes the handle which is our implementation of
--    projections from the CQRS terminology.
--
--    Projections allow us to easily tailor the needs of different API clients
--    (related to our 'ServerOutput' messages) and enable us to more easily implement
--    future user needs.
--
--    This module provides abstract interface for serving different data from the API endpoints
--    and abstracts over the internal implementation (in this case a 'TVar').
--
--    What we serve from the API server is 'Hydra.API.ServerOutput.TimedServerOutputs' and 'Projection' allows us to
--    transform these outputs and add more (stateful) information (like the 'Hydra.API.ServerOutput.HeadStatus' model).
--
--    'Projection's always need to use a function in form of `(model -> event -> model)` where
--    depending on event we are currently dealing with we might want to alter our existing model.
module Hydra.API.Projection where

import Hydra.Prelude

import Control.Concurrent.Class.MonadSTM (modifyTVar', newTVar)

-- | 'Projection' type used to alter/project the API output to suit the client needs.
data Projection stm event model = Projection
  { forall (stm :: * -> *) event model.
Projection stm event model -> stm model
getLatest :: stm model
  , forall (stm :: * -> *) event model.
Projection stm event model -> event -> stm ()
update :: event -> stm ()
  }

-- | Create a 'Projection' handle that knows how to:
--
-- * get the latest model state
--
-- * update the model using a projection function
mkProjection ::
  MonadSTM m =>
  model ->
  [event] ->
  -- | Projection function
  (model -> event -> model) ->
  m (Projection (STM m) event model)
mkProjection :: forall (m :: * -> *) model event.
MonadSTM m =>
model
-> [event]
-> (model -> event -> model)
-> m (Projection (STM m) event model)
mkProjection model
startingModel [event]
events model -> event -> model
project =
  STM m (Projection (STM m) event model)
-> m (Projection (STM m) event model)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (Projection (STM m) event model)
 -> m (Projection (STM m) event model))
-> STM m (Projection (STM m) event model)
-> m (Projection (STM m) event model)
forall a b. (a -> b) -> a -> b
$ do
    TVar m model
tv <- model -> STM m (TVar m model)
forall a. a -> STM m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar model
startingModel
    (event -> STM m ()) -> [event] -> STM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (TVar m model -> event -> STM m ()
update TVar m model
tv) [event]
events
    Projection (STM m) event model
-> STM m (Projection (STM m) event model)
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      Projection
        { $sel:getLatest:Projection :: STM m model
getLatest = TVar m model -> STM m model
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m model
tv
        , $sel:update:Projection :: event -> STM m ()
update = TVar m model -> event -> STM m ()
update TVar m model
tv
        }
 where
  update :: TVar m model -> event -> STM m ()
update TVar m model
tv event
event =
    TVar m model -> (model -> model) -> STM m ()
forall a. TVar m a -> (a -> a) -> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
TVar m a -> (a -> a) -> STM m ()
modifyTVar' TVar m model
tv ((model -> model) -> STM m ()) -> (model -> model) -> STM m ()
forall a b. (a -> b) -> a -> b
$ \model
m ->
      model -> event -> model
project model
m event
event