{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | RON model types
module RON.Types
  ( Atom (..),
    ClosedOp (..),
    ObjectRef (..),
    ObjectFrame (..),
    Op (..),
    OpenFrame,
    OpTerm (..),
    Payload,
    StateChunk (..),
    StateFrame,
    UUID (..),
    WireChunk (..),
    WireFrame,
    WireReducedChunk (..),
    WireStateChunk (..),

    -- * Op patterns
    OpPattern (..),
    opPattern,
    pattern AckP,
    pattern AnnotationDerivedP,
    pattern AnnotationP,
    pattern CreateP,
    pattern DeleteP,
    pattern RegularP,
    pattern UndeleteP,
  )
where

import           RON.Prelude

import           Data.String (IsString, fromString)
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

-- | Atom — a payload element
data Atom = AFloat Double | AInteger Int64 | AString Text | AUuid UUID
  deriving (Typeable Atom
DataType
Constr
Typeable Atom
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Atom -> c Atom)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Atom)
-> (Atom -> Constr)
-> (Atom -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Atom))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Atom))
-> ((forall b. Data b => b -> b) -> Atom -> Atom)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Atom -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Atom -> r)
-> (forall u. (forall d. Data d => d -> u) -> Atom -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Atom -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Atom -> m Atom)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Atom -> m Atom)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Atom -> m Atom)
-> Data Atom
Atom -> DataType
Atom -> Constr
(forall b. Data b => b -> b) -> Atom -> Atom
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Atom -> c Atom
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Atom
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Atom -> u
forall u. (forall d. Data d => d -> u) -> Atom -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Atom -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Atom -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Atom -> m Atom
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Atom -> m Atom
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Atom
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Atom -> c Atom
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Atom)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Atom)
$cAUuid :: Constr
$cAString :: Constr
$cAInteger :: Constr
$cAFloat :: Constr
$tAtom :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Atom -> m Atom
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Atom -> m Atom
gmapMp :: (forall d. Data d => d -> m d) -> Atom -> m Atom
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Atom -> m Atom
gmapM :: (forall d. Data d => d -> m d) -> Atom -> m Atom
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Atom -> m Atom
gmapQi :: Int -> (forall d. Data d => d -> u) -> Atom -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Atom -> u
gmapQ :: (forall d. Data d => d -> u) -> Atom -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Atom -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Atom -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Atom -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Atom -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Atom -> r
gmapT :: (forall b. Data b => b -> b) -> Atom -> Atom
$cgmapT :: (forall b. Data b => b -> b) -> Atom -> Atom
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Atom)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Atom)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Atom)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Atom)
dataTypeOf :: Atom -> DataType
$cdataTypeOf :: Atom -> DataType
toConstr :: Atom -> Constr
$ctoConstr :: Atom -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Atom
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Atom
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Atom -> c Atom
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Atom -> c Atom
$cp1Data :: Typeable Atom
Data, Atom -> Atom -> Bool
(Atom -> Atom -> Bool) -> (Atom -> Atom -> Bool) -> Eq Atom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Atom -> Atom -> Bool
$c/= :: Atom -> Atom -> Bool
== :: Atom -> Atom -> Bool
$c== :: Atom -> Atom -> Bool
Eq, (forall x. Atom -> Rep Atom x)
-> (forall x. Rep Atom x -> Atom) -> Generic Atom
forall x. Rep Atom x -> Atom
forall x. Atom -> Rep Atom x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Atom x -> Atom
$cfrom :: forall x. Atom -> Rep Atom x
Generic, Int -> Atom -> Int
Atom -> Int
(Int -> Atom -> Int) -> (Atom -> Int) -> Hashable Atom
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Atom -> Int
$chash :: Atom -> Int
hashWithSalt :: Int -> Atom -> Int
$chashWithSalt :: Int -> Atom -> Int
Hashable, Int -> Atom -> ShowS
[Atom] -> ShowS
Atom -> String
(Int -> Atom -> ShowS)
-> (Atom -> String) -> ([Atom] -> ShowS) -> Show Atom
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Atom] -> ShowS
$cshowList :: [Atom] -> ShowS
show :: Atom -> String
$cshow :: Atom -> String
showsPrec :: Int -> Atom -> ShowS
$cshowsPrec :: Int -> Atom -> ShowS
Show)

instance IsString Atom where
  fromString :: String -> Atom
fromString = Text -> Atom
AString (Text -> Atom) -> (String -> Text) -> String -> Atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

-- | Closed op
data ClosedOp = ClosedOp {
  -- | type
  ClosedOp -> UUID
reducerId :: UUID,
  -- | object id
  ClosedOp -> UUID
objectId :: UUID,
  -- | other keys and payload, that are common with reduced op
  ClosedOp -> Op
op :: Op
  }
  deriving (Typeable ClosedOp
DataType
Constr
Typeable ClosedOp
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ClosedOp -> c ClosedOp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ClosedOp)
-> (ClosedOp -> Constr)
-> (ClosedOp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ClosedOp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ClosedOp))
-> ((forall b. Data b => b -> b) -> ClosedOp -> ClosedOp)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ClosedOp -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ClosedOp -> r)
-> (forall u. (forall d. Data d => d -> u) -> ClosedOp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> ClosedOp -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ClosedOp -> m ClosedOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ClosedOp -> m ClosedOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ClosedOp -> m ClosedOp)
-> Data ClosedOp
ClosedOp -> DataType
ClosedOp -> Constr
(forall b. Data b => b -> b) -> ClosedOp -> ClosedOp
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ClosedOp -> c ClosedOp
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ClosedOp
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ClosedOp -> u
forall u. (forall d. Data d => d -> u) -> ClosedOp -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ClosedOp -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ClosedOp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ClosedOp -> m ClosedOp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ClosedOp -> m ClosedOp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ClosedOp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ClosedOp -> c ClosedOp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ClosedOp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ClosedOp)
$cClosedOp :: Constr
$tClosedOp :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ClosedOp -> m ClosedOp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ClosedOp -> m ClosedOp
gmapMp :: (forall d. Data d => d -> m d) -> ClosedOp -> m ClosedOp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ClosedOp -> m ClosedOp
gmapM :: (forall d. Data d => d -> m d) -> ClosedOp -> m ClosedOp
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ClosedOp -> m ClosedOp
gmapQi :: Int -> (forall d. Data d => d -> u) -> ClosedOp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ClosedOp -> u
gmapQ :: (forall d. Data d => d -> u) -> ClosedOp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ClosedOp -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ClosedOp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ClosedOp -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ClosedOp -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ClosedOp -> r
gmapT :: (forall b. Data b => b -> b) -> ClosedOp -> ClosedOp
$cgmapT :: (forall b. Data b => b -> b) -> ClosedOp -> ClosedOp
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ClosedOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ClosedOp)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ClosedOp)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ClosedOp)
dataTypeOf :: ClosedOp -> DataType
$cdataTypeOf :: ClosedOp -> DataType
toConstr :: ClosedOp -> Constr
$ctoConstr :: ClosedOp -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ClosedOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ClosedOp
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ClosedOp -> c ClosedOp
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ClosedOp -> c ClosedOp
$cp1Data :: Typeable ClosedOp
Data, ClosedOp -> ClosedOp -> Bool
(ClosedOp -> ClosedOp -> Bool)
-> (ClosedOp -> ClosedOp -> Bool) -> Eq ClosedOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClosedOp -> ClosedOp -> Bool
$c/= :: ClosedOp -> ClosedOp -> Bool
== :: ClosedOp -> ClosedOp -> Bool
$c== :: ClosedOp -> ClosedOp -> Bool
Eq, (forall x. ClosedOp -> Rep ClosedOp x)
-> (forall x. Rep ClosedOp x -> ClosedOp) -> Generic ClosedOp
forall x. Rep ClosedOp x -> ClosedOp
forall x. ClosedOp -> Rep ClosedOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClosedOp x -> ClosedOp
$cfrom :: forall x. ClosedOp -> Rep ClosedOp x
Generic)

type Payload = [Atom]

-- | Open op (operation)
data Op = Op
  { Op -> UUID
opId :: UUID
    -- ^ event id (usually timestamp)
  , Op -> UUID
refId :: UUID
    -- ^ reference to other op; actual semantics depends on the type
  , Op -> [Atom]
payload :: Payload
  }
  deriving (Typeable Op
DataType
Constr
Typeable Op
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Op -> c Op)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Op)
-> (Op -> Constr)
-> (Op -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Op))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Op))
-> ((forall b. Data b => b -> b) -> Op -> Op)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Op -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Op -> r)
-> (forall u. (forall d. Data d => d -> u) -> Op -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Op -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Op -> m Op)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Op -> m Op)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Op -> m Op)
-> Data Op
Op -> DataType
Op -> Constr
(forall b. Data b => b -> b) -> Op -> Op
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Op -> c Op
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Op
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Op -> u
forall u. (forall d. Data d => d -> u) -> Op -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Op -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Op -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Op -> m Op
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Op -> m Op
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Op
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Op -> c Op
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Op)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Op)
$cOp :: Constr
$tOp :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Op -> m Op
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Op -> m Op
gmapMp :: (forall d. Data d => d -> m d) -> Op -> m Op
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Op -> m Op
gmapM :: (forall d. Data d => d -> m d) -> Op -> m Op
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Op -> m Op
gmapQi :: Int -> (forall d. Data d => d -> u) -> Op -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Op -> u
gmapQ :: (forall d. Data d => d -> u) -> Op -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Op -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Op -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Op -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Op -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Op -> r
gmapT :: (forall b. Data b => b -> b) -> Op -> Op
$cgmapT :: (forall b. Data b => b -> b) -> Op -> Op
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Op)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Op)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Op)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Op)
dataTypeOf :: Op -> DataType
$cdataTypeOf :: Op -> DataType
toConstr :: Op -> Constr
$ctoConstr :: Op -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Op
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Op
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Op -> c Op
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Op -> c Op
$cp1Data :: Typeable Op
Data, Op -> Op -> Bool
(Op -> Op -> Bool) -> (Op -> Op -> Bool) -> Eq Op
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Op -> Op -> Bool
$c/= :: Op -> Op -> Bool
== :: Op -> Op -> Bool
$c== :: Op -> Op -> Bool
Eq, (forall x. Op -> Rep Op x)
-> (forall x. Rep Op x -> Op) -> Generic Op
forall x. Rep Op x -> Op
forall x. Op -> Rep Op x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Op x -> Op
$cfrom :: forall x. Op -> Rep Op x
Generic, Int -> Op -> Int
Op -> Int
(Int -> Op -> Int) -> (Op -> Int) -> Hashable Op
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Op -> Int
$chash :: Op -> Int
hashWithSalt :: Int -> Op -> Int
$chashWithSalt :: Int -> Op -> Int
Hashable, Int -> Op -> ShowS
[Op] -> ShowS
Op -> String
(Int -> Op -> ShowS)
-> (Op -> String) -> ([Op] -> ShowS) -> Show Op
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Op] -> ShowS
$cshowList :: [Op] -> ShowS
show :: Op -> String
$cshow :: Op -> String
showsPrec :: Int -> Op -> ShowS
$cshowsPrec :: Int -> Op -> ShowS
Show)

instance Show ClosedOp where
  show :: ClosedOp -> String
show ClosedOp {UUID
reducerId :: UUID
$sel:reducerId:ClosedOp :: ClosedOp -> UUID
reducerId, UUID
objectId :: UUID
$sel:objectId:ClosedOp :: ClosedOp -> UUID
objectId, $sel:op:ClosedOp :: ClosedOp -> Op
op = Op {UUID
opId :: UUID
$sel:opId:Op :: Op -> UUID
opId, UUID
refId :: UUID
$sel:refId:Op :: Op -> UUID
refId, [Atom]
payload :: [Atom]
$sel:payload:Op :: Op -> [Atom]
payload}} =
    [String] -> String
unwords
      [ String
"ClosedOp",
        Char -> ShowS
forall a. a -> [a] -> [a]
insert Char
'*' ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ UUID -> String
forall a s. (Show a, IsString s) => a -> s
show UUID
reducerId,
        Char -> ShowS
forall a. a -> [a] -> [a]
insert Char
'#' ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ UUID -> String
forall a s. (Show a, IsString s) => a -> s
show UUID
objectId,
        Char -> ShowS
forall a. a -> [a] -> [a]
insert Char
'@' ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ UUID -> String
forall a s. (Show a, IsString s) => a -> s
show UUID
opId,
        Char -> ShowS
forall a. a -> [a] -> [a]
insert Char
':' ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ UUID -> String
forall a s. (Show a, IsString s) => a -> s
show UUID
refId,
        [Atom] -> String
forall a s. (Show a, IsString s) => a -> s
show [Atom]
payload
      ]
    where
      insert :: a -> [a] -> [a]
insert a
k = \case
        [] -> [a
k]
        a
c : [a]
cs -> a
c a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
k a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
cs

-- | Common reduced chunk
data WireReducedChunk = WireReducedChunk
  { WireReducedChunk -> ClosedOp
wrcHeader :: ClosedOp
  , WireReducedChunk -> [Op]
wrcBody   :: [Op]
  }
  deriving (Typeable WireReducedChunk
DataType
Constr
Typeable WireReducedChunk
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> WireReducedChunk -> c WireReducedChunk)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c WireReducedChunk)
-> (WireReducedChunk -> Constr)
-> (WireReducedChunk -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c WireReducedChunk))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c WireReducedChunk))
-> ((forall b. Data b => b -> b)
    -> WireReducedChunk -> WireReducedChunk)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> WireReducedChunk -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> WireReducedChunk -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> WireReducedChunk -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> WireReducedChunk -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> WireReducedChunk -> m WireReducedChunk)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> WireReducedChunk -> m WireReducedChunk)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> WireReducedChunk -> m WireReducedChunk)
-> Data WireReducedChunk
WireReducedChunk -> DataType
WireReducedChunk -> Constr
(forall b. Data b => b -> b)
-> WireReducedChunk -> WireReducedChunk
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WireReducedChunk -> c WireReducedChunk
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WireReducedChunk
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> WireReducedChunk -> u
forall u. (forall d. Data d => d -> u) -> WireReducedChunk -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WireReducedChunk -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WireReducedChunk -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> WireReducedChunk -> m WireReducedChunk
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> WireReducedChunk -> m WireReducedChunk
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WireReducedChunk
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WireReducedChunk -> c WireReducedChunk
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WireReducedChunk)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WireReducedChunk)
$cWireReducedChunk :: Constr
$tWireReducedChunk :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> WireReducedChunk -> m WireReducedChunk
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> WireReducedChunk -> m WireReducedChunk
gmapMp :: (forall d. Data d => d -> m d)
-> WireReducedChunk -> m WireReducedChunk
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> WireReducedChunk -> m WireReducedChunk
gmapM :: (forall d. Data d => d -> m d)
-> WireReducedChunk -> m WireReducedChunk
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> WireReducedChunk -> m WireReducedChunk
gmapQi :: Int -> (forall d. Data d => d -> u) -> WireReducedChunk -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> WireReducedChunk -> u
gmapQ :: (forall d. Data d => d -> u) -> WireReducedChunk -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> WireReducedChunk -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WireReducedChunk -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WireReducedChunk -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WireReducedChunk -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WireReducedChunk -> r
gmapT :: (forall b. Data b => b -> b)
-> WireReducedChunk -> WireReducedChunk
$cgmapT :: (forall b. Data b => b -> b)
-> WireReducedChunk -> WireReducedChunk
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WireReducedChunk)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WireReducedChunk)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c WireReducedChunk)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WireReducedChunk)
dataTypeOf :: WireReducedChunk -> DataType
$cdataTypeOf :: WireReducedChunk -> DataType
toConstr :: WireReducedChunk -> Constr
$ctoConstr :: WireReducedChunk -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WireReducedChunk
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WireReducedChunk
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WireReducedChunk -> c WireReducedChunk
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WireReducedChunk -> c WireReducedChunk
$cp1Data :: Typeable WireReducedChunk
Data, WireReducedChunk -> WireReducedChunk -> Bool
(WireReducedChunk -> WireReducedChunk -> Bool)
-> (WireReducedChunk -> WireReducedChunk -> Bool)
-> Eq WireReducedChunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WireReducedChunk -> WireReducedChunk -> Bool
$c/= :: WireReducedChunk -> WireReducedChunk -> Bool
== :: WireReducedChunk -> WireReducedChunk -> Bool
$c== :: WireReducedChunk -> WireReducedChunk -> Bool
Eq, (forall x. WireReducedChunk -> Rep WireReducedChunk x)
-> (forall x. Rep WireReducedChunk x -> WireReducedChunk)
-> Generic WireReducedChunk
forall x. Rep WireReducedChunk x -> WireReducedChunk
forall x. WireReducedChunk -> Rep WireReducedChunk x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WireReducedChunk x -> WireReducedChunk
$cfrom :: forall x. WireReducedChunk -> Rep WireReducedChunk x
Generic, Int -> WireReducedChunk -> ShowS
[WireReducedChunk] -> ShowS
WireReducedChunk -> String
(Int -> WireReducedChunk -> ShowS)
-> (WireReducedChunk -> String)
-> ([WireReducedChunk] -> ShowS)
-> Show WireReducedChunk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WireReducedChunk] -> ShowS
$cshowList :: [WireReducedChunk] -> ShowS
show :: WireReducedChunk -> String
$cshow :: WireReducedChunk -> String
showsPrec :: Int -> WireReducedChunk -> ShowS
$cshowsPrec :: Int -> WireReducedChunk -> ShowS
Show)

-- | Common chunk
data WireChunk
  = Closed ClosedOp
  | Value WireReducedChunk
  | Query WireReducedChunk
  deriving (Typeable WireChunk
DataType
Constr
Typeable WireChunk
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> WireChunk -> c WireChunk)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c WireChunk)
-> (WireChunk -> Constr)
-> (WireChunk -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c WireChunk))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WireChunk))
-> ((forall b. Data b => b -> b) -> WireChunk -> WireChunk)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> WireChunk -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> WireChunk -> r)
-> (forall u. (forall d. Data d => d -> u) -> WireChunk -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> WireChunk -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> WireChunk -> m WireChunk)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> WireChunk -> m WireChunk)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> WireChunk -> m WireChunk)
-> Data WireChunk
WireChunk -> DataType
WireChunk -> Constr
(forall b. Data b => b -> b) -> WireChunk -> WireChunk
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WireChunk -> c WireChunk
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WireChunk
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> WireChunk -> u
forall u. (forall d. Data d => d -> u) -> WireChunk -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WireChunk -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WireChunk -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WireChunk -> m WireChunk
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WireChunk -> m WireChunk
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WireChunk
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WireChunk -> c WireChunk
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WireChunk)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WireChunk)
$cQuery :: Constr
$cValue :: Constr
$cClosed :: Constr
$tWireChunk :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> WireChunk -> m WireChunk
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WireChunk -> m WireChunk
gmapMp :: (forall d. Data d => d -> m d) -> WireChunk -> m WireChunk
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WireChunk -> m WireChunk
gmapM :: (forall d. Data d => d -> m d) -> WireChunk -> m WireChunk
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WireChunk -> m WireChunk
gmapQi :: Int -> (forall d. Data d => d -> u) -> WireChunk -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> WireChunk -> u
gmapQ :: (forall d. Data d => d -> u) -> WireChunk -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> WireChunk -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WireChunk -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WireChunk -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WireChunk -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WireChunk -> r
gmapT :: (forall b. Data b => b -> b) -> WireChunk -> WireChunk
$cgmapT :: (forall b. Data b => b -> b) -> WireChunk -> WireChunk
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WireChunk)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WireChunk)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c WireChunk)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WireChunk)
dataTypeOf :: WireChunk -> DataType
$cdataTypeOf :: WireChunk -> DataType
toConstr :: WireChunk -> Constr
$ctoConstr :: WireChunk -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WireChunk
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WireChunk
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WireChunk -> c WireChunk
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WireChunk -> c WireChunk
$cp1Data :: Typeable WireChunk
Data, WireChunk -> WireChunk -> Bool
(WireChunk -> WireChunk -> Bool)
-> (WireChunk -> WireChunk -> Bool) -> Eq WireChunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WireChunk -> WireChunk -> Bool
$c/= :: WireChunk -> WireChunk -> Bool
== :: WireChunk -> WireChunk -> Bool
$c== :: WireChunk -> WireChunk -> Bool
Eq, (forall x. WireChunk -> Rep WireChunk x)
-> (forall x. Rep WireChunk x -> WireChunk) -> Generic WireChunk
forall x. Rep WireChunk x -> WireChunk
forall x. WireChunk -> Rep WireChunk x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WireChunk x -> WireChunk
$cfrom :: forall x. WireChunk -> Rep WireChunk x
Generic, Int -> WireChunk -> ShowS
[WireChunk] -> ShowS
WireChunk -> String
(Int -> WireChunk -> ShowS)
-> (WireChunk -> String)
-> ([WireChunk] -> ShowS)
-> Show WireChunk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WireChunk] -> ShowS
$cshowList :: [WireChunk] -> ShowS
show :: WireChunk -> String
$cshow :: WireChunk -> String
showsPrec :: Int -> WireChunk -> ShowS
$cshowsPrec :: Int -> WireChunk -> ShowS
Show)

-- | Common frame
type WireFrame = [WireChunk]

-- | Op terminator
data OpTerm = TClosed | TReduced | THeader | TQuery
  deriving (OpTerm -> OpTerm -> Bool
(OpTerm -> OpTerm -> Bool)
-> (OpTerm -> OpTerm -> Bool) -> Eq OpTerm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpTerm -> OpTerm -> Bool
$c/= :: OpTerm -> OpTerm -> Bool
== :: OpTerm -> OpTerm -> Bool
$c== :: OpTerm -> OpTerm -> Bool
Eq, Int -> OpTerm -> ShowS
[OpTerm] -> ShowS
OpTerm -> String
(Int -> OpTerm -> ShowS)
-> (OpTerm -> String) -> ([OpTerm] -> ShowS) -> Show OpTerm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpTerm] -> ShowS
$cshowList :: [OpTerm] -> ShowS
show :: OpTerm -> String
$cshow :: OpTerm -> String
showsPrec :: Int -> OpTerm -> ShowS
$cshowsPrec :: Int -> OpTerm -> ShowS
Show)

-- | Reduced chunk representing an object state (i. e. high-level value)
data WireStateChunk = WireStateChunk
  { WireStateChunk -> UUID
stateType :: UUID
  , WireStateChunk -> [Op]
stateBody :: [Op]
  }
  deriving (WireStateChunk -> WireStateChunk -> Bool
(WireStateChunk -> WireStateChunk -> Bool)
-> (WireStateChunk -> WireStateChunk -> Bool) -> Eq WireStateChunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WireStateChunk -> WireStateChunk -> Bool
$c/= :: WireStateChunk -> WireStateChunk -> Bool
== :: WireStateChunk -> WireStateChunk -> Bool
$c== :: WireStateChunk -> WireStateChunk -> Bool
Eq, Int -> WireStateChunk -> ShowS
[WireStateChunk] -> ShowS
WireStateChunk -> String
(Int -> WireStateChunk -> ShowS)
-> (WireStateChunk -> String)
-> ([WireStateChunk] -> ShowS)
-> Show WireStateChunk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WireStateChunk] -> ShowS
$cshowList :: [WireStateChunk] -> ShowS
show :: WireStateChunk -> String
$cshow :: WireStateChunk -> String
showsPrec :: Int -> WireStateChunk -> ShowS
$cshowsPrec :: Int -> WireStateChunk -> ShowS
Show)

-- | Type-tagged version of 'WireStateChunk'
newtype StateChunk a = StateChunk [Op]

-- | Frame containing only state chunks.
-- Must contain one main object and any number of other objects that are part of
-- the main one.
type StateFrame = Map UUID WireStateChunk

-- | Reference to an object
-- TODO hide data constructor in Internal module
newtype ObjectRef a = ObjectRef UUID
  deriving newtype (ObjectRef a -> ObjectRef a -> Bool
(ObjectRef a -> ObjectRef a -> Bool)
-> (ObjectRef a -> ObjectRef a -> Bool) -> Eq (ObjectRef a)
forall a. ObjectRef a -> ObjectRef a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ObjectRef a -> ObjectRef a -> Bool
$c/= :: forall a. ObjectRef a -> ObjectRef a -> Bool
== :: ObjectRef a -> ObjectRef a -> Bool
$c== :: forall a. ObjectRef a -> ObjectRef a -> Bool
Eq, Int -> ObjectRef a -> Int
ObjectRef a -> Int
(Int -> ObjectRef a -> Int)
-> (ObjectRef a -> Int) -> Hashable (ObjectRef a)
forall a. Int -> ObjectRef a -> Int
forall a. ObjectRef a -> Int
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ObjectRef a -> Int
$chash :: forall a. ObjectRef a -> Int
hashWithSalt :: Int -> ObjectRef a -> Int
$chashWithSalt :: forall a. Int -> ObjectRef a -> Int
Hashable)
  deriving stock ((forall x. ObjectRef a -> Rep (ObjectRef a) x)
-> (forall x. Rep (ObjectRef a) x -> ObjectRef a)
-> Generic (ObjectRef a)
forall x. Rep (ObjectRef a) x -> ObjectRef a
forall x. ObjectRef a -> Rep (ObjectRef a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ObjectRef a) x -> ObjectRef a
forall a x. ObjectRef a -> Rep (ObjectRef a) x
$cto :: forall a x. Rep (ObjectRef a) x -> ObjectRef a
$cfrom :: forall a x. ObjectRef a -> Rep (ObjectRef a) x
Generic)

instance Typeable a => Show (ObjectRef a) where
  showsPrec :: Int -> ObjectRef a -> ShowS
showsPrec Int
a (ObjectRef UUID
b) =
    Bool -> ShowS -> ShowS
showParen (Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString String
"ObjectRef @"
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TypeRep -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
forall a b. (a -> b) -> a -> b
$ Proxy a
forall k (t :: k). Proxy t
Proxy @a)
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> UUID -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 UUID
b

-- | Object reference accompanied with a frame
data ObjectFrame a = ObjectFrame {ObjectFrame a -> UUID
uuid :: UUID, ObjectFrame a -> StateFrame
frame :: StateFrame}
  deriving (ObjectFrame a -> ObjectFrame a -> Bool
(ObjectFrame a -> ObjectFrame a -> Bool)
-> (ObjectFrame a -> ObjectFrame a -> Bool) -> Eq (ObjectFrame a)
forall a. ObjectFrame a -> ObjectFrame a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ObjectFrame a -> ObjectFrame a -> Bool
$c/= :: forall a. ObjectFrame a -> ObjectFrame a -> Bool
== :: ObjectFrame a -> ObjectFrame a -> Bool
$c== :: forall a. ObjectFrame a -> ObjectFrame a -> Bool
Eq, Int -> ObjectFrame a -> ShowS
[ObjectFrame a] -> ShowS
ObjectFrame a -> String
(Int -> ObjectFrame a -> ShowS)
-> (ObjectFrame a -> String)
-> ([ObjectFrame a] -> ShowS)
-> Show (ObjectFrame a)
forall a. Int -> ObjectFrame a -> ShowS
forall a. [ObjectFrame a] -> ShowS
forall a. ObjectFrame a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ObjectFrame a] -> ShowS
$cshowList :: forall a. [ObjectFrame a] -> ShowS
show :: ObjectFrame a -> String
$cshow :: forall a. ObjectFrame a -> String
showsPrec :: Int -> ObjectFrame a -> ShowS
$cshowsPrec :: forall a. Int -> ObjectFrame a -> ShowS
Show)

data OpPattern
  = Regular
  | Delete
  | Undelete
  | Create
  | Ack
  | Annotation
  | AnnotationDerived

pattern AnnotationP :: (Word2, Word2)
pattern $bAnnotationP :: (Word2, Word2)
$mAnnotationP :: forall r. (Word2, Word2) -> (Void# -> r) -> (Void# -> r) -> r
AnnotationP = (B00, B10)

pattern AnnotationDerivedP :: (Word2, Word2)
pattern $bAnnotationDerivedP :: (Word2, Word2)
$mAnnotationDerivedP :: forall r. (Word2, Word2) -> (Void# -> r) -> (Void# -> r) -> r
AnnotationDerivedP = (B00, B11)

pattern CreateP :: (Word2, Word2)
pattern $bCreateP :: (Word2, Word2)
$mCreateP :: forall r. (Word2, Word2) -> (Void# -> r) -> (Void# -> r) -> r
CreateP = (B10, B00)

pattern RegularP :: (Word2, Word2)
pattern $bRegularP :: (Word2, Word2)
$mRegularP :: forall r. (Word2, Word2) -> (Void# -> r) -> (Void# -> r) -> r
RegularP = (B10, B10)

pattern AckP :: (Word2, Word2)
pattern $bAckP :: (Word2, Word2)
$mAckP :: forall r. (Word2, Word2) -> (Void# -> r) -> (Void# -> r) -> r
AckP = (B10, B11)

pattern DeleteP :: (Word2, Word2)
pattern $bDeleteP :: (Word2, Word2)
$mDeleteP :: forall r. (Word2, Word2) -> (Void# -> r) -> (Void# -> r) -> r
DeleteP = (B11, B10)

pattern UndeleteP :: (Word2, Word2)
pattern $bUndeleteP :: (Word2, Word2)
$mUndeleteP :: forall r. (Word2, Word2) -> (Void# -> r) -> (Void# -> r) -> r
UndeleteP = (B11, B11)

opPattern :: Op -> Maybe OpPattern
opPattern :: Op -> Maybe OpPattern
opPattern Op {UUID
opId :: UUID
$sel:opId:Op :: Op -> UUID
opId, UUID
refId :: UUID
$sel:refId:Op :: Op -> UUID
refId} =
  case (UUID -> Word2) -> (UUID, UUID) -> (Word2, Word2)
forall a b. (a -> b) -> (a, a) -> (b, b)
mapBoth (UuidFields -> Word2
uuidVersion (UuidFields -> Word2) -> (UUID -> UuidFields) -> UUID -> Word2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> UuidFields
UUID.split) (UUID
opId, UUID
refId) of
    (Word2, Word2)
AnnotationP -> OpPattern -> Maybe OpPattern
forall a. a -> Maybe a
Just OpPattern
Annotation
    (Word2, Word2)
AnnotationDerivedP -> OpPattern -> Maybe OpPattern
forall a. a -> Maybe a
Just OpPattern
AnnotationDerived
    (Word2, Word2)
CreateP -> OpPattern -> Maybe OpPattern
forall a. a -> Maybe a
Just OpPattern
Create
    (Word2, Word2)
RegularP -> OpPattern -> Maybe OpPattern
forall a. a -> Maybe a
Just OpPattern
Regular
    (Word2, Word2)
AckP -> OpPattern -> Maybe OpPattern
forall a. a -> Maybe a
Just OpPattern
Ack
    (Word2, Word2)
DeleteP -> OpPattern -> Maybe OpPattern
forall a. a -> Maybe a
Just OpPattern
Delete
    (Word2, Word2)
UndeleteP -> OpPattern -> Maybe OpPattern
forall a. a -> Maybe a
Just OpPattern
Undelete
    (Word2, Word2)
_ -> Maybe OpPattern
forall a. Maybe a
Nothing

mapBoth :: (a -> b) -> (a, a) -> (b, b)
mapBoth :: (a -> b) -> (a, a) -> (b, b)
mapBoth a -> b
f (a
x, a
y) = (a -> b
f a
x, a -> b
f a
y)

type OpenFrame = [Op]