{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module RON.Types (
Atom (..),
ClosedOp (..),
Object (..),
ObjectFrame (..),
Op (..),
OpTerm (..),
Payload,
StateChunk (..),
StateFrame,
UUID (..),
WireChunk (..),
WireFrame,
WireReducedChunk (..),
WireStateChunk (..),
OpPattern (..),
opPattern,
pattern AckP,
pattern AnnotationDerivedP,
pattern AnnotationP,
pattern CreateP,
pattern DeleteP,
pattern RegularP,
pattern UndeleteP,
) where
import RON.Prelude
import Data.Typeable (typeRep)
import Text.Show (showParen, showString, showsPrec)
import qualified Text.Show
import RON.Util.Word (pattern B00, pattern B10, pattern B11, Word2)
import RON.UUID (UUID (UUID), uuidVersion)
import qualified RON.UUID as UUID
data Atom = AFloat Double | AInteger Int64 | AString Text | AUuid UUID
deriving (Data, Eq, Generic, Hashable, Show)
data ClosedOp = ClosedOp
{ reducerId :: UUID
, objectId :: UUID
, op :: Op
}
deriving (Data, Eq, Generic)
type Payload = [Atom]
data Op = Op
{ opId :: UUID
, refId :: UUID
, 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
data WireReducedChunk = WireReducedChunk
{ wrcHeader :: ClosedOp
, wrcBody :: [Op]
}
deriving (Data, Eq, Generic, Show)
data WireChunk =
Closed ClosedOp | Value WireReducedChunk | Query WireReducedChunk
deriving (Data, Eq, Generic, Show)
type WireFrame = [WireChunk]
data OpTerm = TClosed | TReduced | THeader | TQuery
deriving (Eq, Show)
data WireStateChunk = WireStateChunk
{ stateType :: UUID
, stateBody :: [Op]
}
deriving (Eq, Show)
newtype StateChunk a = StateChunk [Op]
type StateFrame = Map UUID WireStateChunk
newtype Object a = Object UUID
deriving (Eq)
instance Typeable a => Show (Object a) where
showsPrec a (Object b) =
showParen (a >= 11)
$ showString "Object @"
. showsPrec 11 (typeRep $ Proxy @a)
. showString " "
. showsPrec 11 b
data ObjectFrame a = ObjectFrame{uuid :: UUID, frame :: StateFrame}
deriving (Eq, Show)
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)
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
mapBoth :: (a -> b) -> (a, a) -> (b, b)
mapBoth f (x, y) = (f x, f y)