crdt-event-fold 1.2.1.1 → 1.3.0.0

raw patch · 3 files changed

+77/−24 lines, 3 filesdep +aesondep +monad-loggerPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, monad-logger

API changes (from Hackage documentation)

Files

• crdt-event-fold.cabal +3/−1
• src/Data/CRDT/EventFold.hs +45/−17
• src/Data/CRDT/EventFold/Monad.hs +29/−6

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                crdt-event-fold-version:             1.2.1.1+version:             1.3.0.0 synopsis:            Garbage collected event folding CRDT. description:         Garbage collected event folding CRDT. Consistently                      apply arbitrary operations to replicated data.@@ -24,11 +24,13 @@   -- other-modules:          -- other-extensions:       build-depends:+    aeson              >= 1.4.7.1 && < 1.5,     base               >= 4.13    && < 4.14,     binary             >= 0.8.7.0 && < 0.9,     containers         >= 0.6.2.1 && < 0.7,     data-default-class >= 0.1.2.0 && < 0.2,     data-dword         >= 0.3.2   && < 0.4,+    monad-logger       >= 0.3.35  && < 0.4,     mtl                >= 2.2.2   && < 2.3,     transformers       >= 0.5.6.2 && < 0.6   hs-source-dirs:      src

@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-}@@ -9,6 +10,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wmissing-deriving-strategies #-}+{-# OPTIONS_GHC -Wmissing-import-lists #-}  {- | Description: Garbage collected event folding CRDT. -} module Data.CRDT.EventFold (@@ -164,16 +166,17 @@ ) where  +import Data.Aeson (FromJSON(parseJSON), ToJSON(toEncoding, toJSON),+  FromJSONKey, ToJSONKey) import Data.Bifunctor (first) import Data.Binary (Binary(get, put)) import Data.Default.Class (Default(def))-import Data.DoubleWord (Word128(Word128), Word256(Word256)) import Data.Functor.Identity (Identity(Identity), runIdentity) import Data.Map (Map, keys, toAscList, toDescList, unionWith) import Data.Maybe (catMaybes) import Data.Set ((\\), Set, member, union)-import Data.Word (Word64) import GHC.Generics (Generic)+import qualified Data.DoubleWord as DW import qualified Data.Map as Map import qualified Data.Map.Merge.Lazy as Map.Merge import qualified Data.Set as Set@@ -183,7 +186,10 @@      psOrigin :: o,     psInfimum :: Infimum (State e) p,      psEvents :: Map (EventId p) (f (Delta p e), Set p)-  } deriving stock (Generic)+  }+  deriving stock (Generic)+deriving anyclass instance (ToJSON o, ToJSON p, ToJSON (State e), ToJSON (f (Delta p e))) => ToJSON (EventFoldF o p e f)+deriving anyclass instance (Ord p, FromJSON o, FromJSON p, FromJSON (f (Delta p e)), FromJSON (State e)) => FromJSON (EventFoldF o p e f) deriving stock instance     ( Eq (f (Delta p e))     , Eq (Output e)@@ -239,6 +245,8 @@   difficult to detect) behavior. -} newtype EventFold o p e = EventFold { unEventFold :: EventFoldF o p e Identity}+deriving newtype instance (ToJSON o, ToJSON p, ToJSON e, ToJSON (Output e), ToJSON (State e)) => ToJSON (EventFold o p e)+deriving newtype instance (Ord p, FromJSON o, FromJSON p, FromJSON e, FromJSON (Output e), FromJSON (State e)) => FromJSON (EventFold o p e) deriving stock instance     (Show o, Show p, Show e, Show (Output e), Show (State e))   =>@@ -261,7 +269,9 @@          eventId :: EventId p,     participants :: Set p,       stateValue :: s-  } deriving stock (Generic, Show)+  }+  deriving stock (Generic, Show)+  deriving anyclass (ToJSON, FromJSON) instance (Binary s, Binary p) => Binary (Infimum s p) instance (Eq p) => Eq (Infimum s p) where   Infimum s1 _ _ == Infimum s2 _ _ = s1 == s2@@ -278,23 +288,34 @@   = BottomEid   | Eid Word256 p   deriving stock (Generic, Eq, Ord, Show)-instance (Binary p) => Binary (EventId p) where-  put = put . toMaybe-    where-      toMaybe :: EventId p -> Maybe (Word64, Word64, Word64, Word64, p)-      toMaybe BottomEid =-        Nothing-      toMaybe (Eid (Word256 (Word128 a b) (Word128 c d)) p) =-        Just (a, b, c, d, p)-  get = do-    theThing <- get-    return $ case theThing of-      Nothing -> BottomEid-      Just (a, b, c, d, p) -> Eid (Word256 (Word128 a b) (Word128 c d)) p+  deriving anyclass (ToJSON, FromJSON, ToJSONKey, FromJSONKey, Binary) instance Default (EventId p) where   def = BottomEid  +{- | Newtype around 'DW.Word256' to supply typeclass instances. -}+newtype Word256 = Word256 {+    unWord256 :: DW.Word256+  }+  deriving stock (Generic)+  deriving newtype (Eq, Ord, Show, Enum, Num)+instance FromJSON Word256 where+  parseJSON v = do+    (a, b, c, d) <- parseJSON v+    pure (Word256 (DW.Word256 (DW.Word128 a b) (DW.Word128 c d)))+instance ToJSON Word256 where+  toJSON (Word256 (DW.Word256 (DW.Word128 a b) (DW.Word128 c d))) =+    toJSON (a, b, c, d)+  toEncoding (Word256 (DW.Word256 (DW.Word128 a b) (DW.Word128 c d))) =+    toEncoding (a, b, c, d)+instance Binary Word256 where+  put (Word256 (DW.Word256 (DW.Word128 a b) (DW.Word128 c d))) =+    put (a, b, c, d)+  get = do+    (a, b, c, d) <- get+    pure (Word256 (DW.Word256 (DW.Word128 a b) (DW.Word128 c d)))++ {- |   This is the exception type for illegal merges. These errors indicate   serious programming bugs.@@ -324,6 +345,9 @@       or else some other participant erroneously acknowledged some events       on our behalf.     -}+  deriving stock (Generic)+deriving anyclass instance (Ord p, FromJSON o, FromJSON p, FromJSON e, FromJSON (State e), FromJSON (Output e)) => FromJSON (MergeError o p e)+deriving anyclass instance (ToJSON o, ToJSON p, ToJSON e, ToJSON (Output e), ToJSON (State e)) => ToJSON (MergeError o p e) deriving stock instance     ( Show (Output e)     , Show o@@ -342,6 +366,8 @@   | Event e   | Error (Output e) (Set p)   deriving stock (Generic)+deriving anyclass instance (ToJSON p, ToJSON e, ToJSON (Output e)) => ToJSON (Delta p e)+deriving anyclass instance (Ord p, FromJSON p, FromJSON e, FromJSON (Output e)) => (FromJSON (Delta p e)) deriving stock instance (Eq p, Eq e, Eq (Output e)) => Eq (Delta p e) deriving stock instance (Show p, Show e, Show (Output e)) => Show (Delta p e) instance (Binary p, Binary e, Binary (Output e)) => Binary (Delta p e)@@ -485,6 +511,8 @@     diffInfimum :: EventId p   }   deriving stock (Generic)+deriving anyclass instance (ToJSON o, ToJSON p, ToJSON e, ToJSON (Output e)) => ToJSON (Diff o p e)+deriving anyclass instance (Ord p, FromJSON o, FromJSON p, FromJSON e, FromJSON (Output e)) => FromJSON (Diff o p e) deriving stock instance (     Show o, Show p, Show e, Show (Output e)   ) =>

@@ -12,17 +12,20 @@  {- | Description: Monadic interaction with an EventFold. -} module Data.CRDT.EventFold.Monad (-  MonadEventFold(..),+  MonadUpdateEF(..),+  MonadInspectEF(..),   EventFoldT,   runEventFoldT, ) where  +import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Logger (MonadLogger, MonadLoggerIO) import Control.Monad.Reader (MonadReader(ask), ReaderT(runReaderT))-import Control.Monad.State (MonadState(state), StateT, runStateT)+import Control.Monad.State (MonadState(state), StateT, gets, runStateT) import Control.Monad.Trans.Class (MonadTrans(lift)) import Data.CRDT.EventFold (Event(Output), UpdateResult(UpdateResult),-  Diff, EventFold, EventId, MergeError)+  Diff, EventFold, EventId, MergeError, urEventFold) import qualified Data.CRDT.EventFold as EF (diffMerge, disassociate,   event, fullMerge, participate) @@ -36,7 +39,7 @@   - The accumulated consistent outputs.   - Whether the 'EventFold' needs to be propagated to other participants. -}-class MonadEventFold o p e m | m -> o p e where+class MonadUpdateEF o p e m | m -> o p e where   {- | Apply an event. See 'EF.event'. -}   event :: e -> m (Output e, EventId p) @@ -56,7 +59,20 @@   {- | Remove a peer from participation. See 'EF.disassociate'. -}   disassociate :: p -> m (EventId p) -{- | A transformer providing 'MonadEventFold'. -}++{- |+  Interface for inspecting an Eventfold contained within the monadic+  context.+-}+class (Monad m) => MonadInspectEF o p e m | m -> o p e where+  efAsks :: (EventFold o p e -> a) -> m a+  efAsks f = f <$> efAsk++  efAsk :: m (EventFold o p e)+  efAsk = efAsks id+++{- | A transformer providing 'MonadUpdateEF' and 'MonadInspectEF'. -} newtype EventFoldT o p e m a = EventFoldT {     unEventFoldT ::       StateT (UpdateResult o p e) (@@ -67,10 +83,17 @@     ( Applicative     , Functor     , Monad+    , MonadIO+    , MonadLogger+    , MonadLoggerIO     ) instance MonadTrans (EventFoldT o p e) where   lift = EventFoldT . lift . lift +instance (Monad m) => MonadInspectEF o p e (EventFoldT o p e m) where+  efAsks f = EventFoldT $ gets (f . urEventFold)+  efAsk = EventFoldT $ gets urEventFold+ instance     ( Eq (Output e)     , Eq e@@ -80,7 +103,7 @@     , Ord p     )   =>-    MonadEventFold o p e (EventFoldT o p e m)+    MonadUpdateEF o p e (EventFoldT o p e m)   where     event e =       withEF