-- |
-- Module:      Network.Riak.CRDT.Types
-- Copyright:   (c) 2016 Sentenai
-- Author:      Antonio Nikishaev <me@lelf.lu>
-- License:     Apache
-- Maintainer:  Tim McGilchrist <timmcgil@gmail.com>, Mark Hibberd <mark@hibberd.id.au>
-- Stability:   experimental
-- Portability: portable
--
-- Haskell-side view of CRDT
--
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveGeneric #-}

module Network.Riak.CRDT.Types (
    -- * Types
    DataType(..)
    -- ** Counters
  , Counter(..), Count
    -- *** Modification
  , CounterOp(..)
    -- ** Sets
  , Set(..)
    -- *** Modification
  , SetOp(..)
    -- ** Maps
  , Map(..), MapContent
  , MapField(..)
  , MapEntry(..)
    -- *** Inspection
  , xlookup
    -- *** Modification
  , MapOp(..), MapPath(..), MapValueOp(..), mapUpdate, (-/)
    -- ** Registers
  , Register(..)
    -- *** Modification
  , RegisterOp(..)
    -- ** Flags
  , Flag(..)
    -- *** Modification
  , FlagOp(..)
    -- * Misc
  , NonEmpty(..), mapEntryTag, setFromList, MapEntryTag(..)
  ) where

import           Control.DeepSeq (NFData)
import           Data.ByteString (ByteString)
import           Data.Default.Class
import           Data.Int (Int64)
import           Data.List.NonEmpty
import qualified Data.Map.Strict as M
import           Data.Semigroup
import qualified Data.Set as S
import           Data.String (IsString(..))
import           GHC.Generics (Generic)


-- | CRDT Map is indexed by MapField, which is a name tagged by a type
-- (there may be different entries with the same name, but different
-- types)
data MapField = MapField MapEntryTag ByteString deriving (MapField -> MapField -> Bool
(MapField -> MapField -> Bool)
-> (MapField -> MapField -> Bool) -> Eq MapField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MapField -> MapField -> Bool
$c/= :: MapField -> MapField -> Bool
== :: MapField -> MapField -> Bool
$c== :: MapField -> MapField -> Bool
Eq,Eq MapField
Eq MapField
-> (MapField -> MapField -> Ordering)
-> (MapField -> MapField -> Bool)
-> (MapField -> MapField -> Bool)
-> (MapField -> MapField -> Bool)
-> (MapField -> MapField -> Bool)
-> (MapField -> MapField -> MapField)
-> (MapField -> MapField -> MapField)
-> Ord MapField
MapField -> MapField -> Bool
MapField -> MapField -> Ordering
MapField -> MapField -> MapField
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MapField -> MapField -> MapField
$cmin :: MapField -> MapField -> MapField
max :: MapField -> MapField -> MapField
$cmax :: MapField -> MapField -> MapField
>= :: MapField -> MapField -> Bool
$c>= :: MapField -> MapField -> Bool
> :: MapField -> MapField -> Bool
$c> :: MapField -> MapField -> Bool
<= :: MapField -> MapField -> Bool
$c<= :: MapField -> MapField -> Bool
< :: MapField -> MapField -> Bool
$c< :: MapField -> MapField -> Bool
compare :: MapField -> MapField -> Ordering
$ccompare :: MapField -> MapField -> Ordering
$cp1Ord :: Eq MapField
Ord,Int -> MapField -> ShowS
[MapField] -> ShowS
MapField -> String
(Int -> MapField -> ShowS)
-> (MapField -> String) -> ([MapField] -> ShowS) -> Show MapField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MapField] -> ShowS
$cshowList :: [MapField] -> ShowS
show :: MapField -> String
$cshow :: MapField -> String
showsPrec :: Int -> MapField -> ShowS
$cshowsPrec :: Int -> MapField -> ShowS
Show,(forall x. MapField -> Rep MapField x)
-> (forall x. Rep MapField x -> MapField) -> Generic MapField
forall x. Rep MapField x -> MapField
forall x. MapField -> Rep MapField x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MapField x -> MapField
$cfrom :: forall x. MapField -> Rep MapField x
Generic)

instance NFData MapField

-- | CRDT Map is a Data.Map indexed by 'MapField' and holding
-- 'MapEntry'.
--
-- Maps are specials in a way that they can additionally
-- hold 'Flag's, 'Register's, and most importantly, other 'Map's.
newtype Map = Map MapContent deriving (Map -> Map -> Bool
(Map -> Map -> Bool) -> (Map -> Map -> Bool) -> Eq Map
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Map -> Map -> Bool
$c/= :: Map -> Map -> Bool
== :: Map -> Map -> Bool
$c== :: Map -> Map -> Bool
Eq,Int -> Map -> ShowS
[Map] -> ShowS
Map -> String
(Int -> Map -> ShowS)
-> (Map -> String) -> ([Map] -> ShowS) -> Show Map
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Map] -> ShowS
$cshowList :: [Map] -> ShowS
show :: Map -> String
$cshow :: Map -> String
showsPrec :: Int -> Map -> ShowS
$cshowsPrec :: Int -> Map -> ShowS
Show,(forall x. Map -> Rep Map x)
-> (forall x. Rep Map x -> Map) -> Generic Map
forall x. Rep Map x -> Map
forall x. Map -> Rep Map x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Map x -> Map
$cfrom :: forall x. Map -> Rep Map x
Generic)

instance NFData Map

type MapContent = M.Map MapField MapEntry

instance Default Map where
    def :: Map
def = MapContent -> Map
Map MapContent
forall k a. Map k a
M.empty

data MapEntryTag = MapCounterTag
                 | MapSetTag
                 | MapRegisterTag
                 | MapFlagTag
                 | MapMapTag
                   deriving (MapEntryTag -> MapEntryTag -> Bool
(MapEntryTag -> MapEntryTag -> Bool)
-> (MapEntryTag -> MapEntryTag -> Bool) -> Eq MapEntryTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MapEntryTag -> MapEntryTag -> Bool
$c/= :: MapEntryTag -> MapEntryTag -> Bool
== :: MapEntryTag -> MapEntryTag -> Bool
$c== :: MapEntryTag -> MapEntryTag -> Bool
Eq,Eq MapEntryTag
Eq MapEntryTag
-> (MapEntryTag -> MapEntryTag -> Ordering)
-> (MapEntryTag -> MapEntryTag -> Bool)
-> (MapEntryTag -> MapEntryTag -> Bool)
-> (MapEntryTag -> MapEntryTag -> Bool)
-> (MapEntryTag -> MapEntryTag -> Bool)
-> (MapEntryTag -> MapEntryTag -> MapEntryTag)
-> (MapEntryTag -> MapEntryTag -> MapEntryTag)
-> Ord MapEntryTag
MapEntryTag -> MapEntryTag -> Bool
MapEntryTag -> MapEntryTag -> Ordering
MapEntryTag -> MapEntryTag -> MapEntryTag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MapEntryTag -> MapEntryTag -> MapEntryTag
$cmin :: MapEntryTag -> MapEntryTag -> MapEntryTag
max :: MapEntryTag -> MapEntryTag -> MapEntryTag
$cmax :: MapEntryTag -> MapEntryTag -> MapEntryTag
>= :: MapEntryTag -> MapEntryTag -> Bool
$c>= :: MapEntryTag -> MapEntryTag -> Bool
> :: MapEntryTag -> MapEntryTag -> Bool
$c> :: MapEntryTag -> MapEntryTag -> Bool
<= :: MapEntryTag -> MapEntryTag -> Bool
$c<= :: MapEntryTag -> MapEntryTag -> Bool
< :: MapEntryTag -> MapEntryTag -> Bool
$c< :: MapEntryTag -> MapEntryTag -> Bool
compare :: MapEntryTag -> MapEntryTag -> Ordering
$ccompare :: MapEntryTag -> MapEntryTag -> Ordering
$cp1Ord :: Eq MapEntryTag
Ord,Int -> MapEntryTag -> ShowS
[MapEntryTag] -> ShowS
MapEntryTag -> String
(Int -> MapEntryTag -> ShowS)
-> (MapEntryTag -> String)
-> ([MapEntryTag] -> ShowS)
-> Show MapEntryTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MapEntryTag] -> ShowS
$cshowList :: [MapEntryTag] -> ShowS
show :: MapEntryTag -> String
$cshow :: MapEntryTag -> String
showsPrec :: Int -> MapEntryTag -> ShowS
$cshowsPrec :: Int -> MapEntryTag -> ShowS
Show,(forall x. MapEntryTag -> Rep MapEntryTag x)
-> (forall x. Rep MapEntryTag x -> MapEntryTag)
-> Generic MapEntryTag
forall x. Rep MapEntryTag x -> MapEntryTag
forall x. MapEntryTag -> Rep MapEntryTag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MapEntryTag x -> MapEntryTag
$cfrom :: forall x. MapEntryTag -> Rep MapEntryTag x
Generic)

instance NFData MapEntryTag

-- | CRDT Map holds values of type 'MapEntry'
data MapEntry = MapCounter !Counter
              | MapSet !Set
              | MapRegister !Register
              | MapFlag !Flag
              | MapMap !Map
                deriving (MapEntry -> MapEntry -> Bool
(MapEntry -> MapEntry -> Bool)
-> (MapEntry -> MapEntry -> Bool) -> Eq MapEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MapEntry -> MapEntry -> Bool
$c/= :: MapEntry -> MapEntry -> Bool
== :: MapEntry -> MapEntry -> Bool
$c== :: MapEntry -> MapEntry -> Bool
Eq,Int -> MapEntry -> ShowS
[MapEntry] -> ShowS
MapEntry -> String
(Int -> MapEntry -> ShowS)
-> (MapEntry -> String) -> ([MapEntry] -> ShowS) -> Show MapEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MapEntry] -> ShowS
$cshowList :: [MapEntry] -> ShowS
show :: MapEntry -> String
$cshow :: MapEntry -> String
showsPrec :: Int -> MapEntry -> ShowS
$cshowsPrec :: Int -> MapEntry -> ShowS
Show,(forall x. MapEntry -> Rep MapEntry x)
-> (forall x. Rep MapEntry x -> MapEntry) -> Generic MapEntry
forall x. Rep MapEntry x -> MapEntry
forall x. MapEntry -> Rep MapEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MapEntry x -> MapEntry
$cfrom :: forall x. MapEntry -> Rep MapEntry x
Generic)

instance NFData MapEntry


mapEntryTag :: MapValueOp -> MapEntryTag
mapEntryTag :: MapValueOp -> MapEntryTag
mapEntryTag MapCounterOp{}  = MapEntryTag
MapCounterTag
mapEntryTag MapSetOp{}      = MapEntryTag
MapSetTag
mapEntryTag MapRegisterOp{} = MapEntryTag
MapRegisterTag
mapEntryTag MapFlagOp{}     = MapEntryTag
MapFlagTag
mapEntryTag MapMapOp{}      = MapEntryTag
MapMapTag


-- | Selector (“xpath”) inside 'Map'
newtype MapPath = MapPath (NonEmpty ByteString) deriving (MapPath -> MapPath -> Bool
(MapPath -> MapPath -> Bool)
-> (MapPath -> MapPath -> Bool) -> Eq MapPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MapPath -> MapPath -> Bool
$c/= :: MapPath -> MapPath -> Bool
== :: MapPath -> MapPath -> Bool
$c== :: MapPath -> MapPath -> Bool
Eq,Int -> MapPath -> ShowS
[MapPath] -> ShowS
MapPath -> String
(Int -> MapPath -> ShowS)
-> (MapPath -> String) -> ([MapPath] -> ShowS) -> Show MapPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MapPath] -> ShowS
$cshowList :: [MapPath] -> ShowS
show :: MapPath -> String
$cshow :: MapPath -> String
showsPrec :: Int -> MapPath -> ShowS
$cshowsPrec :: Int -> MapPath -> ShowS
Show)


-- | map operations
-- It's easier to use 'mapUpdate':
--
-- >>> "x" -/ "y" -/ "z" `mapUpdate` SetAdd "elem"
-- MapUpdate (MapPath ("x" :| ["y","z"])) (MapCounterOp (CounterInc 1))
data MapOp = MapRemove MapField           -- ^ remove value in map
           | MapUpdate MapPath MapValueOp -- ^ update value on path by operation
    deriving (MapOp -> MapOp -> Bool
(MapOp -> MapOp -> Bool) -> (MapOp -> MapOp -> Bool) -> Eq MapOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MapOp -> MapOp -> Bool
$c/= :: MapOp -> MapOp -> Bool
== :: MapOp -> MapOp -> Bool
$c== :: MapOp -> MapOp -> Bool
Eq,Int -> MapOp -> ShowS
[MapOp] -> ShowS
MapOp -> String
(Int -> MapOp -> ShowS)
-> (MapOp -> String) -> ([MapOp] -> ShowS) -> Show MapOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MapOp] -> ShowS
$cshowList :: [MapOp] -> ShowS
show :: MapOp -> String
$cshow :: MapOp -> String
showsPrec :: Int -> MapOp -> ShowS
$cshowsPrec :: Int -> MapOp -> ShowS
Show)


-- | Polymprhic version of MapOp for nicer syntax
data MapOp_ op = MapRemove_ MapField
               | MapUpdate_ MapPath op
    deriving Int -> MapOp_ op -> ShowS
[MapOp_ op] -> ShowS
MapOp_ op -> String
(Int -> MapOp_ op -> ShowS)
-> (MapOp_ op -> String)
-> ([MapOp_ op] -> ShowS)
-> Show (MapOp_ op)
forall op. Show op => Int -> MapOp_ op -> ShowS
forall op. Show op => [MapOp_ op] -> ShowS
forall op. Show op => MapOp_ op -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MapOp_ op] -> ShowS
$cshowList :: forall op. Show op => [MapOp_ op] -> ShowS
show :: MapOp_ op -> String
$cshow :: forall op. Show op => MapOp_ op -> String
showsPrec :: Int -> MapOp_ op -> ShowS
$cshowsPrec :: forall op. Show op => Int -> MapOp_ op -> ShowS
Show


instance IsString MapPath where
    fromString :: String -> MapPath
fromString String
s = NonEmpty ByteString -> MapPath
MapPath (String -> ByteString
forall a. IsString a => String -> a
fromString String
s ByteString -> [ByteString] -> NonEmpty ByteString
forall a. a -> [a] -> NonEmpty a
:| [])

(-/) :: ByteString -> MapPath -> MapPath
ByteString
e -/ :: ByteString -> MapPath -> MapPath
-/ (MapPath NonEmpty ByteString
p) = NonEmpty ByteString -> MapPath
MapPath (ByteString
e ByteString -> NonEmpty ByteString -> NonEmpty ByteString
forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty ByteString
p)

infixr 6 -/

class IsMapOp op where toValueOp :: op -> MapValueOp
instance IsMapOp CounterOp  where toValueOp :: CounterOp -> MapValueOp
toValueOp = CounterOp -> MapValueOp
MapCounterOp
instance IsMapOp FlagOp     where toValueOp :: FlagOp -> MapValueOp
toValueOp = FlagOp -> MapValueOp
MapFlagOp
instance IsMapOp RegisterOp where toValueOp :: RegisterOp -> MapValueOp
toValueOp = RegisterOp -> MapValueOp
MapRegisterOp
instance IsMapOp SetOp      where toValueOp :: SetOp -> MapValueOp
toValueOp = SetOp -> MapValueOp
MapSetOp


mapUpdate :: IsMapOp o => MapPath -> o -> MapOp
MapPath
p mapUpdate :: MapPath -> o -> MapOp
`mapUpdate` o
op = MapPath -> MapValueOp -> MapOp
MapUpdate MapPath
p (o -> MapValueOp
forall op. IsMapOp op => op -> MapValueOp
toValueOp o
op)

infixr 5 `mapUpdate`



-- | Lookup a value of a given 'MapEntryTag' type on a given 'MapPath'
-- inside a map
--
-- >>> lookup ("a" -/ "b") MapFlagTag $ { "a"/Map: { "b"/Flag: Flag False } } -- pseudo
-- Just (MapFlag (Flag False))
xlookup :: MapPath -> MapEntryTag -> Map -> Maybe MapEntry
xlookup :: MapPath -> MapEntryTag -> Map -> Maybe MapEntry
xlookup (MapPath (ByteString
e :| [])) MapEntryTag
tag (Map MapContent
m) = MapField -> MapContent -> Maybe MapEntry
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (MapEntryTag -> ByteString -> MapField
MapField MapEntryTag
tag ByteString
e) MapContent
m
xlookup (MapPath (ByteString
e :| (ByteString
r:[ByteString]
rs))) MapEntryTag
tag (Map MapContent
m)
    | Just (MapMap Map
m') <- Maybe MapEntry
inner = MapPath -> MapEntryTag -> Map -> Maybe MapEntry
xlookup (NonEmpty ByteString -> MapPath
MapPath (ByteString
r ByteString -> [ByteString] -> NonEmpty ByteString
forall a. a -> [a] -> NonEmpty a
:| [ByteString]
rs)) MapEntryTag
tag Map
m'
    | Bool
otherwise                 = Maybe MapEntry
forall a. Maybe a
Nothing
    where inner :: Maybe MapEntry
inner = MapField -> MapContent -> Maybe MapEntry
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (MapEntryTag -> ByteString -> MapField
MapField MapEntryTag
MapMapTag ByteString
e) MapContent
m




-- | Registers can be set to a value
--
-- >>> RegisterSet "foo"
data RegisterOp = RegisterSet !ByteString deriving (RegisterOp -> RegisterOp -> Bool
(RegisterOp -> RegisterOp -> Bool)
-> (RegisterOp -> RegisterOp -> Bool) -> Eq RegisterOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterOp -> RegisterOp -> Bool
$c/= :: RegisterOp -> RegisterOp -> Bool
== :: RegisterOp -> RegisterOp -> Bool
$c== :: RegisterOp -> RegisterOp -> Bool
Eq,Int -> RegisterOp -> ShowS
[RegisterOp] -> ShowS
RegisterOp -> String
(Int -> RegisterOp -> ShowS)
-> (RegisterOp -> String)
-> ([RegisterOp] -> ShowS)
-> Show RegisterOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterOp] -> ShowS
$cshowList :: [RegisterOp] -> ShowS
show :: RegisterOp -> String
$cshow :: RegisterOp -> String
showsPrec :: Int -> RegisterOp -> ShowS
$cshowsPrec :: Int -> RegisterOp -> ShowS
Show)

-- | Flags can be enabled / disabled
--
-- >>> FlagSet True
data FlagOp = FlagSet !Bool deriving (FlagOp -> FlagOp -> Bool
(FlagOp -> FlagOp -> Bool)
-> (FlagOp -> FlagOp -> Bool) -> Eq FlagOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlagOp -> FlagOp -> Bool
$c/= :: FlagOp -> FlagOp -> Bool
== :: FlagOp -> FlagOp -> Bool
$c== :: FlagOp -> FlagOp -> Bool
Eq,Int -> FlagOp -> ShowS
[FlagOp] -> ShowS
FlagOp -> String
(Int -> FlagOp -> ShowS)
-> (FlagOp -> String) -> ([FlagOp] -> ShowS) -> Show FlagOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlagOp] -> ShowS
$cshowList :: [FlagOp] -> ShowS
show :: FlagOp -> String
$cshow :: FlagOp -> String
showsPrec :: Int -> FlagOp -> ShowS
$cshowsPrec :: Int -> FlagOp -> ShowS
Show)

-- | Flags can only be held as a 'Map' element.
--
-- Flag can be set or unset
--
-- >>> Flag False
newtype Flag = Flag Bool deriving (Flag -> Flag -> Bool
(Flag -> Flag -> Bool) -> (Flag -> Flag -> Bool) -> Eq Flag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Flag -> Flag -> Bool
$c/= :: Flag -> Flag -> Bool
== :: Flag -> Flag -> Bool
$c== :: Flag -> Flag -> Bool
Eq,Eq Flag
Eq Flag
-> (Flag -> Flag -> Ordering)
-> (Flag -> Flag -> Bool)
-> (Flag -> Flag -> Bool)
-> (Flag -> Flag -> Bool)
-> (Flag -> Flag -> Bool)
-> (Flag -> Flag -> Flag)
-> (Flag -> Flag -> Flag)
-> Ord Flag
Flag -> Flag -> Bool
Flag -> Flag -> Ordering
Flag -> Flag -> Flag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Flag -> Flag -> Flag
$cmin :: Flag -> Flag -> Flag
max :: Flag -> Flag -> Flag
$cmax :: Flag -> Flag -> Flag
>= :: Flag -> Flag -> Bool
$c>= :: Flag -> Flag -> Bool
> :: Flag -> Flag -> Bool
$c> :: Flag -> Flag -> Bool
<= :: Flag -> Flag -> Bool
$c<= :: Flag -> Flag -> Bool
< :: Flag -> Flag -> Bool
$c< :: Flag -> Flag -> Bool
compare :: Flag -> Flag -> Ordering
$ccompare :: Flag -> Flag -> Ordering
$cp1Ord :: Eq Flag
Ord,Int -> Flag -> ShowS
[Flag] -> ShowS
Flag -> String
(Int -> Flag -> ShowS)
-> (Flag -> String) -> ([Flag] -> ShowS) -> Show Flag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Flag] -> ShowS
$cshowList :: [Flag] -> ShowS
show :: Flag -> String
$cshow :: Flag -> String
showsPrec :: Int -> Flag -> ShowS
$cshowsPrec :: Int -> Flag -> ShowS
Show,(forall x. Flag -> Rep Flag x)
-> (forall x. Rep Flag x -> Flag) -> Generic Flag
forall x. Rep Flag x -> Flag
forall x. Flag -> Rep Flag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Flag x -> Flag
$cfrom :: forall x. Flag -> Rep Flag x
Generic)

instance NFData Flag

-- | Last-wins monoid for 'Flag'
instance Monoid Flag where
    mempty :: Flag
mempty = Bool -> Flag
Flag Bool
False
    mappend :: Flag -> Flag -> Flag
mappend = Flag -> Flag -> Flag
forall a. Semigroup a => a -> a -> a
(<>)

-- | Last-wins semigroup for 'Flag'
instance Semigroup Flag where
    Flag
a <> :: Flag -> Flag -> Flag
<> Flag
b = Last Flag -> Flag
forall a. Last a -> a
getLast (Flag -> Last Flag
forall a. a -> Last a
Last Flag
a Last Flag -> Last Flag -> Last Flag
forall a. Semigroup a => a -> a -> a
<> Flag -> Last Flag
forall a. a -> Last a
Last Flag
b)

instance Default Flag where
    def :: Flag
def = Flag
forall a. Monoid a => a
mempty

-- | Registers can only be held as a 'Map' element.
--
-- Register holds a 'ByteString'.
newtype Register = Register ByteString deriving (Register -> Register -> Bool
(Register -> Register -> Bool)
-> (Register -> Register -> Bool) -> Eq Register
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Register -> Register -> Bool
$c/= :: Register -> Register -> Bool
== :: Register -> Register -> Bool
$c== :: Register -> Register -> Bool
Eq,Int -> Register -> ShowS
[Register] -> ShowS
Register -> String
(Int -> Register -> ShowS)
-> (Register -> String) -> ([Register] -> ShowS) -> Show Register
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Register] -> ShowS
$cshowList :: [Register] -> ShowS
show :: Register -> String
$cshow :: Register -> String
showsPrec :: Int -> Register -> ShowS
$cshowsPrec :: Int -> Register -> ShowS
Show,(forall x. Register -> Rep Register x)
-> (forall x. Rep Register x -> Register) -> Generic Register
forall x. Rep Register x -> Register
forall x. Register -> Rep Register x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Register x -> Register
$cfrom :: forall x. Register -> Rep Register x
Generic)

instance NFData Register

-- | Last-wins monoid for 'Register'
instance Monoid Register where
    mempty :: Register
mempty = ByteString -> Register
Register ByteString
""
    mappend :: Register -> Register -> Register
mappend = Register -> Register -> Register
forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup Register where
    Register
a <> :: Register -> Register -> Register
<> Register
b = Last Register -> Register
forall a. Last a -> a
getLast (Register -> Last Register
forall a. a -> Last a
Last Register
a Last Register -> Last Register -> Last Register
forall a. Semigroup a => a -> a -> a
<> Register -> Last Register
forall a. a -> Last a
Last Register
b)

instance Default Register where
    def :: Register
def = Register
forall a. Monoid a => a
mempty



-- | Operations on map values
data MapValueOp = MapCounterOp !CounterOp
                | MapSetOp !SetOp
                | MapRegisterOp !RegisterOp
                | MapFlagOp !FlagOp
                | MapMapOp !MapOp
                  deriving (MapValueOp -> MapValueOp -> Bool
(MapValueOp -> MapValueOp -> Bool)
-> (MapValueOp -> MapValueOp -> Bool) -> Eq MapValueOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MapValueOp -> MapValueOp -> Bool
$c/= :: MapValueOp -> MapValueOp -> Bool
== :: MapValueOp -> MapValueOp -> Bool
$c== :: MapValueOp -> MapValueOp -> Bool
Eq,Int -> MapValueOp -> ShowS
[MapValueOp] -> ShowS
MapValueOp -> String
(Int -> MapValueOp -> ShowS)
-> (MapValueOp -> String)
-> ([MapValueOp] -> ShowS)
-> Show MapValueOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MapValueOp] -> ShowS
$cshowList :: [MapValueOp] -> ShowS
show :: MapValueOp -> String
$cshow :: MapValueOp -> String
showsPrec :: Int -> MapValueOp -> ShowS
$cshowsPrec :: Int -> MapValueOp -> ShowS
Show)


-- | CRDT ADT.
--
-- 'Network.Riak.CRDT.Riak.get' operations return value of this type
data DataType = DTCounter Counter
              | DTSet Set
              | DTMap Map
                deriving (DataType -> DataType -> Bool
(DataType -> DataType -> Bool)
-> (DataType -> DataType -> Bool) -> Eq DataType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataType -> DataType -> Bool
$c/= :: DataType -> DataType -> Bool
== :: DataType -> DataType -> Bool
$c== :: DataType -> DataType -> Bool
Eq,Int -> DataType -> ShowS
[DataType] -> ShowS
DataType -> String
(Int -> DataType -> ShowS)
-> (DataType -> String) -> ([DataType] -> ShowS) -> Show DataType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataType] -> ShowS
$cshowList :: [DataType] -> ShowS
show :: DataType -> String
$cshow :: DataType -> String
showsPrec :: Int -> DataType -> ShowS
$cshowsPrec :: Int -> DataType -> ShowS
Show,(forall x. DataType -> Rep DataType x)
-> (forall x. Rep DataType x -> DataType) -> Generic DataType
forall x. Rep DataType x -> DataType
forall x. DataType -> Rep DataType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DataType x -> DataType
$cfrom :: forall x. DataType -> Rep DataType x
Generic)

instance NFData DataType

-- | CRDT Set is a Data.Set
--
-- >>> Set (Data.Set.fromList ["foo","bar"])
newtype Set = Set (S.Set ByteString) deriving (Set -> Set -> Bool
(Set -> Set -> Bool) -> (Set -> Set -> Bool) -> Eq Set
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Set -> Set -> Bool
$c/= :: Set -> Set -> Bool
== :: Set -> Set -> Bool
$c== :: Set -> Set -> Bool
Eq,Eq Set
Eq Set
-> (Set -> Set -> Ordering)
-> (Set -> Set -> Bool)
-> (Set -> Set -> Bool)
-> (Set -> Set -> Bool)
-> (Set -> Set -> Bool)
-> (Set -> Set -> Set)
-> (Set -> Set -> Set)
-> Ord Set
Set -> Set -> Bool
Set -> Set -> Ordering
Set -> Set -> Set
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Set -> Set -> Set
$cmin :: Set -> Set -> Set
max :: Set -> Set -> Set
$cmax :: Set -> Set -> Set
>= :: Set -> Set -> Bool
$c>= :: Set -> Set -> Bool
> :: Set -> Set -> Bool
$c> :: Set -> Set -> Bool
<= :: Set -> Set -> Bool
$c<= :: Set -> Set -> Bool
< :: Set -> Set -> Bool
$c< :: Set -> Set -> Bool
compare :: Set -> Set -> Ordering
$ccompare :: Set -> Set -> Ordering
$cp1Ord :: Eq Set
Ord,Int -> Set -> ShowS
[Set] -> ShowS
Set -> String
(Int -> Set -> ShowS)
-> (Set -> String) -> ([Set] -> ShowS) -> Show Set
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Set] -> ShowS
$cshowList :: [Set] -> ShowS
show :: Set -> String
$cshow :: Set -> String
showsPrec :: Int -> Set -> ShowS
$cshowsPrec :: Int -> Set -> ShowS
Show,(forall x. Set -> Rep Set x)
-> (forall x. Rep Set x -> Set) -> Generic Set
forall x. Rep Set x -> Set
forall x. Set -> Rep Set x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Set x -> Set
$cfrom :: forall x. Set -> Rep Set x
Generic,Semigroup Set
Set
Semigroup Set
-> Set -> (Set -> Set -> Set) -> ([Set] -> Set) -> Monoid Set
[Set] -> Set
Set -> Set -> Set
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Set] -> Set
$cmconcat :: [Set] -> Set
mappend :: Set -> Set -> Set
$cmappend :: Set -> Set -> Set
mempty :: Set
$cmempty :: Set
$cp1Monoid :: Semigroup Set
Monoid)

instance NFData Set

instance Semigroup Set where
    Set Set ByteString
a <> :: Set -> Set -> Set
<> Set Set ByteString
b = Set ByteString -> Set
Set (Set ByteString
a Set ByteString -> Set ByteString -> Set ByteString
forall a. Semigroup a => a -> a -> a
<> Set ByteString
b)

instance Default Set where
    def :: Set
def = Set ByteString -> Set
Set Set ByteString
forall a. Monoid a => a
mempty

-- | CRDT Set operations
data SetOp = SetAdd ByteString    -- ^ add element to the set
                                  --
                                  -- >>> SetAdd "foo"
           | SetRemove ByteString -- ^ remove element from the set
                                  --
                                  -- >>> SetRemove "bar"
             deriving (SetOp -> SetOp -> Bool
(SetOp -> SetOp -> Bool) -> (SetOp -> SetOp -> Bool) -> Eq SetOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetOp -> SetOp -> Bool
$c/= :: SetOp -> SetOp -> Bool
== :: SetOp -> SetOp -> Bool
$c== :: SetOp -> SetOp -> Bool
Eq,Int -> SetOp -> ShowS
[SetOp] -> ShowS
SetOp -> String
(Int -> SetOp -> ShowS)
-> (SetOp -> String) -> ([SetOp] -> ShowS) -> Show SetOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetOp] -> ShowS
$cshowList :: [SetOp] -> ShowS
show :: SetOp -> String
$cshow :: SetOp -> String
showsPrec :: Int -> SetOp -> ShowS
$cshowsPrec :: Int -> SetOp -> ShowS
Show)

setFromList :: [ByteString] -> Set
setFromList :: [ByteString] -> Set
setFromList = Set ByteString -> Set
Set (Set ByteString -> Set)
-> ([ByteString] -> Set ByteString) -> [ByteString] -> Set
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Set ByteString
forall a. Ord a => [a] -> Set a
S.fromList

-- | CRDT Counter hold a integer 'Count'
--
-- >>> Counter 42
newtype Counter = Counter Count deriving (Counter -> Counter -> Bool
(Counter -> Counter -> Bool)
-> (Counter -> Counter -> Bool) -> Eq Counter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Counter -> Counter -> Bool
$c/= :: Counter -> Counter -> Bool
== :: Counter -> Counter -> Bool
$c== :: Counter -> Counter -> Bool
Eq,Eq Counter
Eq Counter
-> (Counter -> Counter -> Ordering)
-> (Counter -> Counter -> Bool)
-> (Counter -> Counter -> Bool)
-> (Counter -> Counter -> Bool)
-> (Counter -> Counter -> Bool)
-> (Counter -> Counter -> Counter)
-> (Counter -> Counter -> Counter)
-> Ord Counter
Counter -> Counter -> Bool
Counter -> Counter -> Ordering
Counter -> Counter -> Counter
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Counter -> Counter -> Counter
$cmin :: Counter -> Counter -> Counter
max :: Counter -> Counter -> Counter
$cmax :: Counter -> Counter -> Counter
>= :: Counter -> Counter -> Bool
$c>= :: Counter -> Counter -> Bool
> :: Counter -> Counter -> Bool
$c> :: Counter -> Counter -> Bool
<= :: Counter -> Counter -> Bool
$c<= :: Counter -> Counter -> Bool
< :: Counter -> Counter -> Bool
$c< :: Counter -> Counter -> Bool
compare :: Counter -> Counter -> Ordering
$ccompare :: Counter -> Counter -> Ordering
$cp1Ord :: Eq Counter
Ord,Integer -> Counter
Counter -> Counter
Counter -> Counter -> Counter
(Counter -> Counter -> Counter)
-> (Counter -> Counter -> Counter)
-> (Counter -> Counter -> Counter)
-> (Counter -> Counter)
-> (Counter -> Counter)
-> (Counter -> Counter)
-> (Integer -> Counter)
-> Num Counter
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Counter
$cfromInteger :: Integer -> Counter
signum :: Counter -> Counter
$csignum :: Counter -> Counter
abs :: Counter -> Counter
$cabs :: Counter -> Counter
negate :: Counter -> Counter
$cnegate :: Counter -> Counter
* :: Counter -> Counter -> Counter
$c* :: Counter -> Counter -> Counter
- :: Counter -> Counter -> Counter
$c- :: Counter -> Counter -> Counter
+ :: Counter -> Counter -> Counter
$c+ :: Counter -> Counter -> Counter
Num,Int -> Counter -> ShowS
[Counter] -> ShowS
Counter -> String
(Int -> Counter -> ShowS)
-> (Counter -> String) -> ([Counter] -> ShowS) -> Show Counter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Counter] -> ShowS
$cshowList :: [Counter] -> ShowS
show :: Counter -> String
$cshow :: Counter -> String
showsPrec :: Int -> Counter -> ShowS
$cshowsPrec :: Int -> Counter -> ShowS
Show,(forall x. Counter -> Rep Counter x)
-> (forall x. Rep Counter x -> Counter) -> Generic Counter
forall x. Rep Counter x -> Counter
forall x. Counter -> Rep Counter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Counter x -> Counter
$cfrom :: forall x. Counter -> Rep Counter x
Generic)
type Count = Int64

instance NFData Counter

instance Semigroup Counter where
    Counter Count
a <> :: Counter -> Counter -> Counter
<> Counter Count
b = Count -> Counter
Counter (Count -> Counter) -> (Sum Count -> Count) -> Sum Count -> Counter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sum Count -> Count
forall a. Sum a -> a
getSum (Sum Count -> Counter) -> Sum Count -> Counter
forall a b. (a -> b) -> a -> b
$ Count -> Sum Count
forall a. a -> Sum a
Sum Count
a Sum Count -> Sum Count -> Sum Count
forall a. Semigroup a => a -> a -> a
<> Count -> Sum Count
forall a. a -> Sum a
Sum Count
b

instance Monoid Counter where
    mempty :: Counter
mempty = Count -> Counter
Counter Count
0
    mappend :: Counter -> Counter -> Counter
mappend = Counter -> Counter -> Counter
forall a. Semigroup a => a -> a -> a
(<>)

instance Default Counter where
    def :: Counter
def = Counter
forall a. Monoid a => a
mempty

-- | Counters can be incremented/decremented
--
-- >>> CounterInc 1
data CounterOp = CounterInc !Count deriving (CounterOp -> CounterOp -> Bool
(CounterOp -> CounterOp -> Bool)
-> (CounterOp -> CounterOp -> Bool) -> Eq CounterOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CounterOp -> CounterOp -> Bool
$c/= :: CounterOp -> CounterOp -> Bool
== :: CounterOp -> CounterOp -> Bool
$c== :: CounterOp -> CounterOp -> Bool
Eq,Int -> CounterOp -> ShowS
[CounterOp] -> ShowS
CounterOp -> String
(Int -> CounterOp -> ShowS)
-> (CounterOp -> String)
-> ([CounterOp] -> ShowS)
-> Show CounterOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CounterOp] -> ShowS
$cshowList :: [CounterOp] -> ShowS
show :: CounterOp -> String
$cshow :: CounterOp -> String
showsPrec :: Int -> CounterOp -> ShowS
$cshowsPrec :: Int -> CounterOp -> ShowS
Show)

instance Semigroup CounterOp where
    CounterInc Count
x <> :: CounterOp -> CounterOp -> CounterOp
<> CounterInc Count
y = Count -> CounterOp
CounterInc (Count -> CounterOp)
-> (Sum Count -> Count) -> Sum Count -> CounterOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sum Count -> Count
forall a. Sum a -> a
getSum (Sum Count -> CounterOp) -> Sum Count -> CounterOp
forall a b. (a -> b) -> a -> b
$ Count -> Sum Count
forall a. a -> Sum a
Sum Count
x Sum Count -> Sum Count -> Sum Count
forall a. Semigroup a => a -> a -> a
<> Count -> Sum Count
forall a. a -> Sum a
Sum Count
y

instance Monoid CounterOp where
    mempty :: CounterOp
mempty = Count -> CounterOp
CounterInc Count
0
    CounterInc Count
x mappend :: CounterOp -> CounterOp -> CounterOp
`mappend` CounterInc Count
y = Count -> CounterOp
CounterInc (Count -> CounterOp)
-> (Sum Count -> Count) -> Sum Count -> CounterOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sum Count -> Count
forall a. Sum a -> a
getSum (Sum Count -> CounterOp) -> Sum Count -> CounterOp
forall a b. (a -> b) -> a -> b
$ Count -> Sum Count
forall a. a -> Sum a
Sum Count
x Sum Count -> Sum Count -> Sum Count
forall a. Semigroup a => a -> a -> a
<> Count -> Sum Count
forall a. a -> Sum a
Sum Count
y