diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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` diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -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 diff --git a/lib/RON/Binary/Serialize.hs b/lib/RON/Binary/Serialize.hs --- a/lib/RON/Binary/Serialize.hs +++ b/lib/RON/Binary/Serialize.hs @@ -1,5 +1,4 @@ {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} diff --git a/lib/RON/Event.hs b/lib/RON/Event.hs --- a/lib/RON/Event.hs +++ b/lib/RON/Event.hs @@ -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) diff --git a/lib/RON/Text/Parse.hs b/lib/RON/Text/Parse.hs --- a/lib/RON/Text/Parse.hs +++ b/lib/RON/Text/Parse.hs @@ -1,7 +1,6 @@ {-# LANGUAGE BinaryLiterals #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} diff --git a/lib/RON/Text/Serialize.hs b/lib/RON/Text/Serialize.hs --- a/lib/RON/Text/Serialize.hs +++ b/lib/RON/Text/Serialize.hs @@ -2,7 +2,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} -- | RON-Text serialization diff --git a/lib/RON/Text/Serialize/UUID.hs b/lib/RON/Text/Serialize/UUID.hs --- a/lib/RON/Text/Serialize/UUID.hs +++ b/lib/RON/Text/Serialize/UUID.hs @@ -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' diff --git a/lib/RON/Types.hs b/lib/RON/Types.hs --- a/lib/RON/Types.hs +++ b/lib/RON/Types.hs @@ -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) diff --git a/ron.cabal b/ron.cabal --- a/ron.cabal +++ b/ron.cabal @@ -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