ron 0.10 → 0.11
raw patch · 9 files changed
+137/−123 lines, 9 filesdep ~base
Dependency ranges changed: base
Files
- CHANGELOG.md +4/−0
- LICENSE +1/−1
- lib/RON/Binary/Serialize.hs +0/−1
- lib/RON/Event.hs +2/−3
- lib/RON/Text/Parse.hs +0/−1
- lib/RON/Text/Serialize.hs +0/−1
- lib/RON/Text/Serialize/UUID.hs +16/−20
- lib/RON/Types.hs +111/−93
- ron.cabal +3/−3
CHANGELOG.md view
@@ -7,6 +7,10 @@ ## [Unreleased] +## [0.11] - 2020-06-14+### Added+- Support for GHC 8.8.+ ## [0.10] - 2019-10-07 ### Added - Instances of `Generic` and `Hashable` for `ObjectRef`
LICENSE view
@@ -1,6 +1,6 @@ BSD 3-Clause License -Copyright (c) 2018, Yuriy Syrovetskiy+Copyright (c) 2018-2019, Yuriy Syrovetskiy All rights reserved. Redistribution and use in source and binary forms, with or without
lib/RON/Binary/Serialize.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}
lib/RON/Event.hs view
@@ -38,9 +38,8 @@ import Data.Time (fromGregorianValid, makeTimeOfDayValid) import RON.Util.Word (pattern B00, pattern B01, pattern B10,- pattern B11, Word12, Word16, Word2, Word24,- Word32, Word6, Word60, Word64, Word8,- leastSignificant12, leastSignificant2,+ pattern B11, Word12, Word2, Word24, Word6,+ Word60, leastSignificant12, leastSignificant2, leastSignificant24, leastSignificant4, leastSignificant6, ls12, ls24, ls6, ls60, safeCast)
lib/RON/Text/Parse.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE BinaryLiterals #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}
lib/RON/Text/Serialize.hs view
@@ -2,7 +2,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} -- | RON-Text serialization
lib/RON/Text/Serialize/UUID.hs view
@@ -43,18 +43,11 @@ -> ByteStringL serializeUuidKey prevKey prev this = BSL.fromStrict $ case uuidVariant thisFields of- B00 -> minimumByLength- $ unzipped thisFields- : [ z- | uuidVariant (split prevKey) == B00- , Just z <- [zipUuid (split prevKey) thisFields]- ]- ++ [ "`" <> z- | prev /= zero- , uuidVariant (split prev) == B00- , Just z <- [zipUuid (split prev) thisFields]- ]- _ -> serializeUuidGeneric this+ B00 -> minimumByLength $+ unzipped thisFields+ : zipIfDefaultVariant prevKey this+ ++ ["`" <> z | prev /= zero, z <- zipIfDefaultVariant prev this]+ _ -> serializeUuidGeneric this where thisFields = split this @@ -65,16 +58,19 @@ -> ByteStringL serializeUuidAtom prev this = BSL.fromStrict $ case uuidVariant thisFields of- B00 -> minimumByLength- $ unzipped thisFields- : [ z- | prev /= zero- , uuidVariant (split prev) == B00- , Just z <- [zipUuid (split prev) thisFields]- ]- _ -> serializeUuidGeneric this+ B00 -> minimumByLength $+ unzipped thisFields+ : (guard (prev /= zero) *> zipIfDefaultVariant prev this)+ _ -> serializeUuidGeneric this where thisFields = split this++zipIfDefaultVariant :: UUID -> UUID -> [ByteString]+zipIfDefaultVariant prev this =+ [ z+ | uuidVariant (split prev) == B00+ , Just z <- [zipUuid (split prev) (split this)]+ ] unzipped :: UuidFields -> ByteString unzipped UuidFields{..} = x' <> y'
lib/RON/Types.hs view
@@ -11,8 +11,8 @@ {-# LANGUAGE TypeApplications #-} -- | RON model types-module RON.Types (- Atom (..),+module RON.Types+ ( Atom (..), ClosedOp (..), ObjectRef (..), ObjectFrame (..),@@ -26,6 +26,7 @@ WireFrame, WireReducedChunk (..), WireStateChunk (..),+ -- * Op patterns OpPattern (..), opPattern,@@ -36,86 +37,91 @@ pattern DeleteP, pattern RegularP, pattern UndeleteP,-) where--import RON.Prelude--import Data.Typeable (typeRep)-import Text.Show (showParen, showString, showsPrec)-import qualified Text.Show+ )+where -import RON.Util.Word (pattern B00, pattern B10, pattern B11, Word2)-import RON.UUID (UUID (UUID), uuidVersion)+import Data.Typeable (typeRep)+import RON.Prelude+import RON.UUID (UUID (UUID), uuidVersion) import qualified RON.UUID as UUID+import RON.Util.Word (Word2, pattern B00, pattern B10, pattern B11)+import Text.Show (showParen, showString, showsPrec)+import qualified Text.Show -- | Atom — a payload element data Atom = AFloat Double | AInteger Int64 | AString Text | AUuid UUID- deriving (Data, Eq, Generic, Hashable, Show)+ deriving (Data, Eq, Generic, Hashable, Show) -- | Closed op-data ClosedOp = ClosedOp- { reducerId :: UUID- -- ^ type- , objectId :: UUID- -- ^ object id- , op :: Op- -- ^ other keys and payload, that are common with reduced op- }- deriving (Data, Eq, Generic)+data ClosedOp+ = ClosedOp+ { -- | type+ reducerId :: UUID,+ -- | object id+ objectId :: UUID,+ -- | other keys and payload, that are common with reduced op+ op :: Op+ }+ deriving (Data, Eq, Generic) type Payload = [Atom] -- | Open op (operation)-data Op = Op- { opId :: UUID- -- ^ event id (usually timestamp)- , refId :: UUID- -- ^ reference to other op; actual semantics depends on the type- , payload :: Payload- -- ^ payload- }- deriving (Data, Eq, Generic, Hashable, Show)+data Op+ = Op+ { -- | event id (usually timestamp)+ opId :: UUID,+ -- | reference to other op; actual semantics depends on the type+ refId :: UUID,+ -- | payload+ payload :: Payload+ }+ deriving (Data, Eq, Generic, Hashable, Show) instance Show ClosedOp where- show ClosedOp{reducerId, objectId, op = Op{opId, refId, payload}} =- unwords- [ "ClosedOp"- , insert '*' $ show reducerId- , insert '#' $ show objectId- , insert '@' $ show opId- , insert ':' $ show refId- , show payload- ]- where- insert k = \case- [] -> [k]- c:cs -> c:k:cs+ show ClosedOp {reducerId, objectId, op = Op {opId, refId, payload}} =+ unwords+ [ "ClosedOp",+ insert '*' $ show reducerId,+ insert '#' $ show objectId,+ insert '@' $ show opId,+ insert ':' $ show refId,+ show payload+ ]+ where+ insert k = \case+ [] -> [k]+ c : cs -> c : k : cs -- | Common reduced chunk-data WireReducedChunk = WireReducedChunk- { wrcHeader :: ClosedOp- , wrcBody :: [Op]- }- deriving (Data, Eq, Generic, Show)+data WireReducedChunk+ = WireReducedChunk+ { wrcHeader :: ClosedOp,+ wrcBody :: [Op]+ }+ deriving (Data, Eq, Generic, Show) -- | Common chunk-data WireChunk =- Closed ClosedOp | Value WireReducedChunk | Query WireReducedChunk- deriving (Data, Eq, Generic, Show)+data WireChunk+ = Closed ClosedOp+ | Value WireReducedChunk+ | Query WireReducedChunk+ deriving (Data, Eq, Generic, Show) -- | Common frame type WireFrame = [WireChunk] -- | Op terminator data OpTerm = TClosed | TReduced | THeader | TQuery- deriving (Eq, Show)+ deriving (Eq, Show) -- | Reduced chunk representing an object state (i. e. high-level value)-data WireStateChunk = WireStateChunk- { stateType :: UUID- , stateBody :: [Op]- }- deriving (Eq, Show)+data WireStateChunk+ = WireStateChunk+ { stateType :: UUID,+ stateBody :: [Op]+ }+ deriving (Eq, Show) -- | Type-tagged version of 'WireStateChunk' newtype StateChunk a = StateChunk [Op]@@ -127,50 +133,62 @@ -- | Reference to an object newtype ObjectRef a = ObjectRef UUID- deriving newtype (Eq, Hashable)- deriving stock (Generic)+ deriving newtype (Eq, Hashable)+ deriving stock (Generic) instance Typeable a => Show (ObjectRef a) where- showsPrec a (ObjectRef b) =- showParen (a >= 11)- $ showString "ObjectRef @"- . showsPrec 11 (typeRep $ Proxy @a)- . showString " "- . showsPrec 11 b+ showsPrec a (ObjectRef b) =+ showParen (a >= 11) $+ showString "ObjectRef @"+ . showsPrec 11 (typeRep $ Proxy @a)+ . showString " "+ . showsPrec 11 b -- | Object reference accompanied with a frame-data ObjectFrame a = ObjectFrame{uuid :: UUID, frame :: StateFrame}- deriving (Eq, Show)+data ObjectFrame a = ObjectFrame {uuid :: UUID, frame :: StateFrame}+ deriving (Eq, Show) -data OpPattern =- Regular | Delete | Undelete | Create | Ack | Annotation | AnnotationDerived+data OpPattern+ = Regular+ | Delete+ | Undelete+ | Create+ | Ack+ | Annotation+ | AnnotationDerived -pattern AnnotationP :: (Word2, Word2)-pattern AnnotationP = (B00, B10)-pattern AnnotationDerivedP :: (Word2, Word2)-pattern AnnotationDerivedP = (B00, B11)-pattern CreateP :: (Word2, Word2)-pattern CreateP = (B10, B00)-pattern RegularP :: (Word2, Word2)-pattern RegularP = (B10, B10)-pattern AckP :: (Word2, Word2)-pattern AckP = (B10, B11)-pattern DeleteP :: (Word2, Word2)-pattern DeleteP = (B11, B10)-pattern UndeleteP :: (Word2, Word2)-pattern UndeleteP = (B11, B11)+pattern AnnotationP :: (Word2, Word2)+pattern AnnotationP = (B00, B10) +pattern AnnotationDerivedP :: (Word2, Word2)+pattern AnnotationDerivedP = (B00, B11)++pattern CreateP :: (Word2, Word2)+pattern CreateP = (B10, B00)++pattern RegularP :: (Word2, Word2)+pattern RegularP = (B10, B10)++pattern AckP :: (Word2, Word2)+pattern AckP = (B10, B11)++pattern DeleteP :: (Word2, Word2)+pattern DeleteP = (B11, B10)++pattern UndeleteP :: (Word2, Word2)+pattern UndeleteP = (B11, B11)+ opPattern :: Op -> Maybe OpPattern-opPattern Op{opId, refId} =- case mapBoth (uuidVersion . UUID.split) (opId, refId) of- AnnotationP -> Just Annotation- AnnotationDerivedP -> Just AnnotationDerived- CreateP -> Just Create- RegularP -> Just Regular- AckP -> Just Ack- DeleteP -> Just Delete- UndeleteP -> Just Undelete- _ -> Nothing+opPattern Op {opId, refId} =+ case mapBoth (uuidVersion . UUID.split) (opId, refId) of+ AnnotationP -> Just Annotation+ AnnotationDerivedP -> Just AnnotationDerived+ CreateP -> Just Create+ RegularP -> Just Regular+ AckP -> Just Ack+ DeleteP -> Just Delete+ UndeleteP -> Just Undelete+ _ -> Nothing mapBoth :: (a -> b) -> (a, a) -> (b, b) mapBoth f (x, y) = (f x, f y)
ron.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.2 name: ron-version: 0.10+version: 0.11 bug-reports: https://github.com/ff-notes/ron/issues category: Distributed Systems, Protocol, Database@@ -23,8 +23,8 @@ CHANGELOG.md common language- build-depends: base >= 4.10 && < 4.13, integer-gmp- default-extensions: MonadFailDesugaring NoImplicitPrelude StrictData+ build-depends: base >= 4.10 && < 4.15, integer-gmp+ default-extensions: NoImplicitPrelude StrictData default-language: Haskell2010 library