content: {-# LANGUAGE BlockArguments #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE NamedFieldPuns #-}
  {-# LANGUAGE OverloadedRecordDot #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TypeApplications #-}
  
  module RON.Store (
      MonadStore (..),
      loadSubObjectLog,
      newObject,
      readObject,
  ) where
  
  import RON.Prelude
  
  import Data.List (stripPrefix)
  import RON.Data.VersionVector (VV)
  import RON.Error (MonadE, errorContext)
  import RON.Event (ReplicaClock, getEventUuid)
  import RON.Experimental.Data (
      ReplicatedObject,
      baseType,
      baseTypeId,
      decodeObject,
      encodeObject,
   )
  import RON.Store.Class (MonadStore (..))
  import RON.Types (Op (..))
  import RON.Types.Experimental (Patch (..), Ref (..))
  
  newObject ::
      forall a m.
      (MonadStore m, ReplicaClock m, ReplicatedObject a) =>
      a ->
      m (Ref a)
  newObject a = do
      objectId <- getEventUuid
      let typeId = baseTypeId $ baseType @a
      let initOp = Op{opId = objectId, refId = typeId, payload = []}
      appendPatch $ Patch objectId $ initOp :| []
      encodeObject objectId a
      pure $ Ref objectId []
  
  -- | Nothing if object doesn't exist in the replica.
  readObject ::
      (MonadE m, MonadStore m, ReplicatedObject a, Typeable a) =>
      Ref a ->
      m (Maybe a)
  readObject object@(Ref objectId _) =
      errorContext ("readObject " <> show object) do
          ops <- loadSubObjectLog object mempty
          case ops of
              [] -> pure Nothing
              _ : _ -> fmap Just $ decodeObject objectId $ sortOn (.opId) ops
  
  loadSubObjectLog ::
      (MonadE m, MonadStore m, Typeable a) => Ref a -> VV -> m [Op]
  loadSubObjectLog object@(Ref objectId path) version =
      errorContext ("loadSubObjectLog " <> show object) do
          ops <- loadWholeObjectLog objectId version
          pure
              [ op{payload = payload'}
              | op@Op{opId, payload} <- ops
              , opId /= objectId
              , Just payload' <- [stripPrefix path payload]
              ]
  