{-# LANGUAGE CPP                    #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE OverloadedStrings      #-}
{-# LANGUAGE PatternGuards          #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE TypeFamilies           #-}

{- | module:    Network.Riak.CRDT
     copyright: (c) 2016 Sentenai
     author:    Antonio Nikishaev <me@lelf.lu>
     license:   Apache

CRDT operations

* Haskell-side

    * Haskell values: 'Counter', 'Set' etc

    * ADT for operations: 'CounterOp', 'SetOp' etc

    * 'modify' to locally modify a value (matching riak-side behaviour)

* Riak-side

    * 'get' to get a current value

    * 'sendModify' to ask Riak to apply modifications

TL;DR example

>>> let c = Counter 41
>>> let op = CounterInc 1
>>> modify op c
Counter 42
>>> get conn "counters" "bucket" "key"
Just (DTCounter (Counter 41))
>>> sendModify conn "counters" "bucket" "key" [op] >> get conn "counters" "bucket" "key"
Just (DTCounter (Counter 42))

-}

module Network.Riak.CRDT (
    module X
  , get
  , CRDT(..)
  ) where

import           Data.Default.Class
import qualified Data.Map                as M
import           Data.Proxy
#if __GLASGOW_HASKELL__ < 804
import           Data.Semigroup
#endif
import qualified Data.Set                as S
import           Network.Riak.CRDT.Ops
import           Network.Riak.CRDT.Riak
import           Network.Riak.CRDT.Types as X
import           Network.Riak.Types

-- | Modify a counter by applying operations ops
modifyCounter :: CounterOp -> Counter -> Counter
modifyCounter :: CounterOp -> Counter -> Counter
modifyCounter CounterOp
op Counter
c = Counter
c Counter -> Counter -> Counter
forall a. Semigroup a => a -> a -> a
<> Count -> Counter
Counter Count
i
    where CounterInc Count
i = CounterOp
op

-- | Modify a set by applying operations ops
modifySet :: SetOp -> Set -> Set
modifySet :: SetOp -> Set -> Set
modifySet SetOp
op (Set Set ByteString
c) = Set ByteString -> Set
Set (Set ByteString
c Set ByteString -> Set ByteString -> Set ByteString
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set ByteString
adds Set ByteString -> Set ByteString -> Set ByteString
forall a. Ord a => Set a -> Set a -> Set a
S.\\ Set ByteString
rems)
    where SetOpsComb Set ByteString
adds Set ByteString
rems = SetOp -> SetOpsComb
toOpsComb SetOp
op

modifyMap :: MapOp -> Map -> Map
modifyMap :: MapOp -> Map -> Map
modifyMap (MapRemove MapField
field) (Map MapContent
mc) = MapContent -> Map
Map (MapContent -> Map) -> MapContent -> Map
forall a b. (a -> b) -> a -> b
$ MapField -> MapContent -> MapContent
forall k a. Ord k => k -> Map k a -> Map k a
M.delete MapField
field MapContent
mc
modifyMap (MapUpdate MapPath
path MapValueOp
op) Map
m      = MapPath -> MapValueOp -> Map -> Map
modifyMap1 MapPath
path MapValueOp
op Map
m

modifyMap1 :: MapPath -> MapValueOp -> Map -> Map
modifyMap1 :: MapPath -> MapValueOp -> Map -> Map
modifyMap1 (MapPath (ByteString
e :| [])) MapValueOp
op Map
m = MapField -> MapValueOp -> Map -> Map
modMap MapField
mf MapValueOp
op Map
m
    where mf :: MapField
mf = MapEntryTag -> ByteString -> MapField
MapField (MapValueOp -> MapEntryTag
mapEntryTag MapValueOp
op) ByteString
e
modifyMap1 (MapPath (ByteString
e :| (ByteString
r:[ByteString]
rs))) MapValueOp
op (Map MapContent
m')
    = MapContent -> Map
Map (MapContent -> Map) -> MapContent -> Map
forall a b. (a -> b) -> a -> b
$ (Maybe MapEntry -> Maybe MapEntry)
-> MapField -> MapContent -> MapContent
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (MapEntry -> Maybe MapEntry
forall a. a -> Maybe a
Just (MapEntry -> Maybe MapEntry)
-> (Maybe MapEntry -> MapEntry) -> Maybe MapEntry -> Maybe MapEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe MapEntry -> MapEntry
f) (MapEntryTag -> ByteString -> MapField
MapField MapEntryTag
MapMapTag ByteString
e) MapContent
m'
      where f :: Maybe MapEntry -> MapEntry
            f :: Maybe MapEntry -> MapEntry
f Maybe MapEntry
Nothing = Maybe MapEntry -> MapEntry
f (MapEntry -> Maybe MapEntry
forall a. a -> Maybe a
Just (MapEntry -> Maybe MapEntry) -> MapEntry -> Maybe MapEntry
forall a b. (a -> b) -> a -> b
$ Map -> MapEntry
MapMap Map
forall a. Default a => a
def)
            f (Just (MapMap Map
m)) = Map -> MapEntry
MapMap (Map -> MapEntry) -> (Map -> Map) -> Map -> MapEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MapPath -> MapValueOp -> Map -> Map
modifyMap1 (NonEmpty ByteString -> MapPath
MapPath (ByteString
r ByteString -> [ByteString] -> NonEmpty ByteString
forall a. a -> [a] -> NonEmpty a
:| [ByteString]
rs)) MapValueOp
op (Map -> MapEntry) -> Map -> MapEntry
forall a b. (a -> b) -> a -> b
$ Map
m
            f (Just MapEntry
z) = MapEntry
z

modMap :: MapField -> MapValueOp -> Map -> Map
modMap :: MapField -> MapValueOp -> Map -> Map
modMap MapField
ix MapValueOp
op (Map MapContent
m) = MapContent -> Map
Map (MapContent -> Map) -> MapContent -> Map
forall a b. (a -> b) -> a -> b
$ (Maybe MapEntry -> Maybe MapEntry)
-> MapField -> MapContent -> MapContent
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (MapEntry -> Maybe MapEntry
forall a. a -> Maybe a
Just (MapEntry -> Maybe MapEntry)
-> (Maybe MapEntry -> MapEntry) -> Maybe MapEntry -> Maybe MapEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MapValueOp -> Maybe MapEntry -> MapEntry
modifyMapValue MapValueOp
op) MapField
ix MapContent
m

modifyMapValue :: MapValueOp -> Maybe MapEntry -> MapEntry
modifyMapValue :: MapValueOp -> Maybe MapEntry -> MapEntry
modifyMapValue (MapSetOp SetOp
op)      = Proxy Set -> MapOperation_ Set -> Maybe MapEntry -> MapEntry
forall a.
MapCRDT a =>
Proxy a -> MapOperation_ a -> Maybe MapEntry -> MapEntry
modifyEntry (Proxy Set
forall k (t :: k). Proxy t
Proxy :: Proxy Set) SetOp
MapOperation_ Set
op
modifyMapValue (MapCounterOp CounterOp
op)  = Proxy Counter
-> MapOperation_ Counter -> Maybe MapEntry -> MapEntry
forall a.
MapCRDT a =>
Proxy a -> MapOperation_ a -> Maybe MapEntry -> MapEntry
modifyEntry (Proxy Counter
forall k (t :: k). Proxy t
Proxy :: Proxy Counter) CounterOp
MapOperation_ Counter
op
modifyMapValue (MapMapOp MapOp
op)      = Proxy Map -> MapOperation_ Map -> Maybe MapEntry -> MapEntry
forall a.
MapCRDT a =>
Proxy a -> MapOperation_ a -> Maybe MapEntry -> MapEntry
modifyEntry (Proxy Map
forall k (t :: k). Proxy t
Proxy :: Proxy Map) MapOp
MapOperation_ Map
op
modifyMapValue (MapFlagOp FlagOp
op)     = Proxy Flag -> MapOperation_ Flag -> Maybe MapEntry -> MapEntry
forall a.
MapCRDT a =>
Proxy a -> MapOperation_ a -> Maybe MapEntry -> MapEntry
modifyEntry (Proxy Flag
forall k (t :: k). Proxy t
Proxy :: Proxy Flag) FlagOp
MapOperation_ Flag
op
modifyMapValue (MapRegisterOp RegisterOp
op) = Proxy Register
-> MapOperation_ Register -> Maybe MapEntry -> MapEntry
forall a.
MapCRDT a =>
Proxy a -> MapOperation_ a -> Maybe MapEntry -> MapEntry
modifyEntry (Proxy Register
forall k (t :: k). Proxy t
Proxy :: Proxy Register) RegisterOp
MapOperation_ Register
op

modifyFlag :: FlagOp -> Flag -> Flag
modifyFlag :: FlagOp -> Flag -> Flag
modifyFlag (FlagSet Bool
x) = Flag -> Flag -> Flag
forall a b. a -> b -> a
const (Bool -> Flag
Flag Bool
x)

modifyRegister :: RegisterOp -> Register -> Register
modifyRegister :: RegisterOp -> Register -> Register
modifyRegister (RegisterSet ByteString
x) = Register -> Register -> Register
forall a b. a -> b -> a
const (ByteString -> Register
Register ByteString
x)

-- | Types that can be held inside 'Map'
class Default a => MapCRDT a where
    type MapOperation_ a :: *
    mapModify :: MapOperation_ a -> a -> a

    -- | modify a maybe-absent 'MapEntry'
    modifyEntry :: Proxy a -> MapOperation_ a -> Maybe MapEntry -> MapEntry
    modifyEntry Proxy a
_ MapOperation_ a
op Maybe MapEntry
Nothing = a -> MapEntry
forall a. MapCRDT a => a -> MapEntry
toEntry (a -> MapEntry) -> (a -> a) -> a -> MapEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MapOperation_ a -> a -> a
forall a. MapCRDT a => MapOperation_ a -> a -> a
mapModify MapOperation_ a
op (a -> MapEntry) -> a -> MapEntry
forall a b. (a -> b) -> a -> b
$ (a
forall a. Default a => a
def :: a)
    modifyEntry Proxy a
_ MapOperation_ a
op (Just MapEntry
e) | Just a
v <- MapEntry -> Maybe a
forall a. MapCRDT a => MapEntry -> Maybe a
fromEntry MapEntry
e = a -> MapEntry
forall a. MapCRDT a => a -> MapEntry
toEntry (a -> MapEntry) -> (a -> a) -> a -> MapEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MapOperation_ a -> a -> a
forall a. MapCRDT a => MapOperation_ a -> a -> a
mapModify MapOperation_ a
op (a -> MapEntry) -> a -> MapEntry
forall a b. (a -> b) -> a -> b
$ (a
v :: a)
                              | Bool
otherwise             = MapEntry
e
    toEntry :: a -> MapEntry
    fromEntry :: MapEntry -> Maybe a


instance MapCRDT Flag where
    type MapOperation_ Flag = FlagOp
    mapModify :: MapOperation_ Flag -> Flag -> Flag
mapModify = FlagOp -> Flag -> Flag
MapOperation_ Flag -> Flag -> Flag
modifyFlag
    fromEntry :: MapEntry -> Maybe Flag
fromEntry (MapFlag Flag
f) = Flag -> Maybe Flag
forall a. a -> Maybe a
Just Flag
f
    fromEntry MapEntry
_           = Maybe Flag
forall a. Maybe a
Nothing
    toEntry :: Flag -> MapEntry
toEntry = Flag -> MapEntry
MapFlag

instance MapCRDT Set where
    type MapOperation_ Set = SetOp
    mapModify :: MapOperation_ Set -> Set -> Set
mapModify = MapOperation_ Set -> Set -> Set
forall a op. CRDT a op => op -> a -> a
modify
    fromEntry :: MapEntry -> Maybe Set
fromEntry (MapSet Set
s) = Set -> Maybe Set
forall a. a -> Maybe a
Just Set
s
    fromEntry MapEntry
_          = Maybe Set
forall a. Maybe a
Nothing
    toEntry :: Set -> MapEntry
toEntry = Set -> MapEntry
MapSet

instance MapCRDT Counter where
    type MapOperation_ Counter = CounterOp
    mapModify :: MapOperation_ Counter -> Counter -> Counter
mapModify = MapOperation_ Counter -> Counter -> Counter
forall a op. CRDT a op => op -> a -> a
modify
    fromEntry :: MapEntry -> Maybe Counter
fromEntry (MapCounter Counter
s) = Counter -> Maybe Counter
forall a. a -> Maybe a
Just Counter
s
    fromEntry MapEntry
_              = Maybe Counter
forall a. Maybe a
Nothing
    toEntry :: Counter -> MapEntry
toEntry = Counter -> MapEntry
MapCounter

instance MapCRDT Register where
    type MapOperation_ Register = RegisterOp
    mapModify :: MapOperation_ Register -> Register -> Register
mapModify = RegisterOp -> Register -> Register
MapOperation_ Register -> Register -> Register
modifyRegister
    fromEntry :: MapEntry -> Maybe Register
fromEntry (MapRegister Register
s) = Register -> Maybe Register
forall a. a -> Maybe a
Just Register
s
    fromEntry MapEntry
_               = Maybe Register
forall a. Maybe a
Nothing
    toEntry :: Register -> MapEntry
toEntry = Register -> MapEntry
MapRegister

instance MapCRDT Map where
    type MapOperation_ Map = MapOp
    mapModify :: MapOperation_ Map -> Map -> Map
mapModify = MapOperation_ Map -> Map -> Map
forall a op. CRDT a op => op -> a -> a
modify
    fromEntry :: MapEntry -> Maybe Map
fromEntry (MapMap Map
s) = Map -> Maybe Map
forall a. a -> Maybe a
Just Map
s
    fromEntry MapEntry
_          = Maybe Map
forall a. Maybe a
Nothing
    toEntry :: Map -> MapEntry
toEntry = Map -> MapEntry
MapMap

-- | CRDT types
class MapCRDT a => CRDT a op | a -> op, op -> a where
    -- | Modify a value by applying an operation
    modify :: op -> a -> a

    -- | Request riak a modification
    sendModify :: Connection
               -> BucketType -> Bucket -> Key
               -> [op] -> IO ()

instance CRDT Counter CounterOp where
    modify :: CounterOp -> Counter -> Counter
modify = CounterOp -> Counter -> Counter
modifyCounter
    sendModify :: Connection
-> ByteString -> ByteString -> ByteString -> [CounterOp] -> IO ()
sendModify = Connection
-> ByteString -> ByteString -> ByteString -> [CounterOp] -> IO ()
counterSendUpdate

instance CRDT Set SetOp where
    modify :: SetOp -> Set -> Set
modify = SetOp -> Set -> Set
modifySet
    sendModify :: Connection
-> ByteString -> ByteString -> ByteString -> [SetOp] -> IO ()
sendModify = Connection
-> ByteString -> ByteString -> ByteString -> [SetOp] -> IO ()
setSendUpdate

instance CRDT Map MapOp where
    modify :: MapOp -> Map -> Map
modify = MapOp -> Map -> Map
modifyMap
    sendModify :: Connection
-> ByteString -> ByteString -> ByteString -> [MapOp] -> IO ()
sendModify = Connection
-> ByteString -> ByteString -> ByteString -> [MapOp] -> IO ()
mapSendUpdate