content: {-# 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 op c = c <> Counter i
      where CounterInc i = op
  
  -- | Modify a set by applying operations ops
  modifySet :: SetOp -> Set -> Set
  modifySet op (Set c) = Set (c `S.union` adds S.\\ rems)
      where SetOpsComb adds rems = toOpsComb op
  
  modifyMap :: MapOp -> Map -> Map
  modifyMap (MapRemove field) (Map mc) = Map $ M.delete field mc
  modifyMap (MapUpdate path op) m      = modifyMap1 path op m
  
  modifyMap1 :: MapPath -> MapValueOp -> Map -> Map
  modifyMap1 (MapPath (e :| [])) op m = modMap mf op m
      where mf = MapField (mapEntryTag op) e
  modifyMap1 (MapPath (e :| (r:rs))) op (Map m')
      = Map $ M.alter (Just . f) (MapField MapMapTag e) m'
        where f :: Maybe MapEntry -> MapEntry
              f Nothing = f (Just $ MapMap def)
              f (Just (MapMap m)) = MapMap . modifyMap1 (MapPath (r :| rs)) op $ m
              f (Just z) = z
  
  modMap :: MapField -> MapValueOp -> Map -> Map
  modMap ix op (Map m) = Map $ M.alter (Just . modifyMapValue op) ix m
  
  modifyMapValue :: MapValueOp -> Maybe MapEntry -> MapEntry
  modifyMapValue (MapSetOp op)      = modifyEntry (Proxy :: Proxy Set) op
  modifyMapValue (MapCounterOp op)  = modifyEntry (Proxy :: Proxy Counter) op
  modifyMapValue (MapMapOp op)      = modifyEntry (Proxy :: Proxy Map) op
  modifyMapValue (MapFlagOp op)     = modifyEntry (Proxy :: Proxy Flag) op
  modifyMapValue (MapRegisterOp op) = modifyEntry (Proxy :: Proxy Register) op
  
  modifyFlag :: FlagOp -> Flag -> Flag
  modifyFlag (FlagSet x) = const (Flag x)
  
  modifyRegister :: RegisterOp -> Register -> Register
  modifyRegister (RegisterSet x) = const (Register 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 _ op Nothing = toEntry . mapModify op $ (def :: a)
      modifyEntry _ op (Just e) | Just v <- fromEntry e = toEntry . mapModify op $ (v :: a)
                                | otherwise             = e
      toEntry :: a -> MapEntry
      fromEntry :: MapEntry -> Maybe a
  
  
  instance MapCRDT Flag where
      type MapOperation_ Flag = FlagOp
      mapModify = modifyFlag
      fromEntry (MapFlag f) = Just f
      fromEntry _           = Nothing
      toEntry = MapFlag
  
  instance MapCRDT Set where
      type MapOperation_ Set = SetOp
      mapModify = modify
      fromEntry (MapSet s) = Just s
      fromEntry _          = Nothing
      toEntry = MapSet
  
  instance MapCRDT Counter where
      type MapOperation_ Counter = CounterOp
      mapModify = modify
      fromEntry (MapCounter s) = Just s
      fromEntry _              = Nothing
      toEntry = MapCounter
  
  instance MapCRDT Register where
      type MapOperation_ Register = RegisterOp
      mapModify = modifyRegister
      fromEntry (MapRegister s) = Just s
      fromEntry _               = Nothing
      toEntry = MapRegister
  
  instance MapCRDT Map where
      type MapOperation_ Map = MapOp
      mapModify = modify
      fromEntry (MapMap s) = Just s
      fromEntry _          = Nothing
      toEntry = 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 = modifyCounter
      sendModify = counterSendUpdate
  
  instance CRDT Set SetOp where
      modify = modifySet
      sendModify = setSendUpdate
  
  instance CRDT Map MapOp where
      modify = modifyMap
      sendModify = mapSendUpdate
  