{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module RON.Store.Test (emptyDB, runStoreSim) where import RON.Prelude import Control.Lens (at, non, (<>=)) import Data.Generics.Labels () import Data.Map.Strict ((!?)) import Data.Map.Strict qualified as Map import Data.Sequence qualified as Seq import RON.Data.VersionVector ((·≼)) import RON.Error (Error (..), liftMaybe) import RON.Event ( OriginVariety (ApplicationSpecific), Replica, ReplicaClock, mkReplica, ) import RON.Event.Simulation ( ReplicaSimT, runNetworkSimT, runReplicaSimT, ) import RON.Store (MonadStore (..)) import RON.Types (Op (..), UUID) import RON.Types.Experimental (Patch (..)) newtype Object = Object {logs :: Map Replica (Seq Op)} deriving (Eq, Generic, Show) type TestDB = Map UUID Object emptyDB :: TestDB emptyDB = Map.empty newtype StoreSim a = StoreSim (StateT TestDB (ReplicaSimT (Either Error)) a) deriving (Applicative, Functor, Monad, MonadError Error, ReplicaClock) runStoreSim :: TestDB -> StoreSim a -> Either Error (a, TestDB) runStoreSim db (StoreSim action) = runNetworkSimT $ runReplicaSimT thisReplicaId $ runStateT action db thisReplicaId :: Replica thisReplicaId = mkReplica ApplicationSpecific 2020 instance MonadStore StoreSim where listObjects = StoreSim $ gets Map.keys appendPatch Patch{object, log} = StoreSim $ atObject . #logs . atReplica <>= Seq.fromList (toList log) where atObject = at object . non emptyObject atReplica = at thisReplicaId . non Seq.empty loadWholeObjectLog objectId version = do db <- StoreSim get Object{logs} <- liftMaybe "object not found" $ db !? objectId pure $ fold [ filter (not . isKnown) $ toList @Seq replicaLog | replicaLog <- Map.elems logs ] where isKnown Op{opId} = opId ·≼ version emptyObject :: Object emptyObject = Object{logs = Map.empty}