content: -- |
  -- 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 (Eq,Ord,Show,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 (Eq,Show,Generic)
  
  instance NFData Map
  
  type MapContent = M.Map MapField MapEntry
  
  instance Default Map where
      def = Map M.empty
  
  data MapEntryTag = MapCounterTag
                   | MapSetTag
                   | MapRegisterTag
                   | MapFlagTag
                   | MapMapTag
                     deriving (Eq,Ord,Show,Generic)
  
  instance NFData MapEntryTag
  
  -- | CRDT Map holds values of type 'MapEntry'
  data MapEntry = MapCounter !Counter
                | MapSet !Set
                | MapRegister !Register
                | MapFlag !Flag
                | MapMap !Map
                  deriving (Eq,Show,Generic)
  
  instance NFData MapEntry
  
  
  mapEntryTag :: MapValueOp -> MapEntryTag
  mapEntryTag MapCounterOp{}  = MapCounterTag
  mapEntryTag MapSetOp{}      = MapSetTag
  mapEntryTag MapRegisterOp{} = MapRegisterTag
  mapEntryTag MapFlagOp{}     = MapFlagTag
  mapEntryTag MapMapOp{}      = MapMapTag
  
  
  -- | Selector (“xpath”) inside 'Map'
  newtype MapPath = MapPath (NonEmpty ByteString) deriving (Eq,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 (Eq,Show)
  
  
  -- | Polymprhic version of MapOp for nicer syntax
  data MapOp_ op = MapRemove_ MapField
                 | MapUpdate_ MapPath op
      deriving Show
  
  
  instance IsString MapPath where
      fromString s = MapPath (fromString s :| [])
  
  (-/) :: ByteString -> MapPath -> MapPath
  e -/ (MapPath p) = MapPath (e <| p)
  
  infixr 6 -/
  
  class IsMapOp op where toValueOp :: op -> MapValueOp
  instance IsMapOp CounterOp  where toValueOp = MapCounterOp
  instance IsMapOp FlagOp     where toValueOp = MapFlagOp
  instance IsMapOp RegisterOp where toValueOp = MapRegisterOp
  instance IsMapOp SetOp      where toValueOp = MapSetOp
  
  
  mapUpdate :: IsMapOp o => MapPath -> o -> MapOp
  p `mapUpdate` op = MapUpdate p (toValueOp 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 (e :| [])) tag (Map m) = M.lookup (MapField tag e) m
  xlookup (MapPath (e :| (r:rs))) tag (Map m)
      | Just (MapMap m') <- inner = xlookup (MapPath (r :| rs)) tag m'
      | otherwise                 = Nothing
      where inner = M.lookup (MapField MapMapTag e) m
  
  
  
  
  -- | Registers can be set to a value
  --
  -- >>> RegisterSet "foo"
  data RegisterOp = RegisterSet !ByteString deriving (Eq,Show)
  
  -- | Flags can be enabled / disabled
  --
  -- >>> FlagSet True
  data FlagOp = FlagSet !Bool deriving (Eq,Show)
  
  -- | Flags can only be held as a 'Map' element.
  --
  -- Flag can be set or unset
  --
  -- >>> Flag False
  newtype Flag = Flag Bool deriving (Eq,Ord,Show,Generic)
  
  instance NFData Flag
  
  -- | Last-wins monoid for 'Flag'
  instance Monoid Flag where
      mempty = Flag False
      mappend = (<>)
  
  -- | Last-wins semigroup for 'Flag'
  instance Semigroup Flag where
      a <> b = getLast (Last a <> Last b)
  
  instance Default Flag where
      def = mempty
  
  -- | Registers can only be held as a 'Map' element.
  --
  -- Register holds a 'ByteString'.
  newtype Register = Register ByteString deriving (Eq,Show,Generic)
  
  instance NFData Register
  
  -- | Last-wins monoid for 'Register'
  instance Monoid Register where
      mempty = Register ""
      mappend = (<>)
  
  instance Semigroup Register where
      a <> b = getLast (Last a <> Last b)
  
  instance Default Register where
      def = mempty
  
  
  
  -- | Operations on map values
  data MapValueOp = MapCounterOp !CounterOp
                  | MapSetOp !SetOp
                  | MapRegisterOp !RegisterOp
                  | MapFlagOp !FlagOp
                  | MapMapOp !MapOp
                    deriving (Eq,Show)
  
  
  -- | CRDT ADT.
  --
  -- 'Network.Riak.CRDT.Riak.get' operations return value of this type
  data DataType = DTCounter Counter
                | DTSet Set
                | DTMap Map
                  deriving (Eq,Show,Generic)
  
  instance NFData DataType
  
  -- | CRDT Set is a Data.Set
  --
  -- >>> Set (Data.Set.fromList ["foo","bar"])
  newtype Set = Set (S.Set ByteString) deriving (Eq,Ord,Show,Generic,Monoid)
  
  instance NFData Set
  
  instance Semigroup Set where
      Set a <> Set b = Set (a <> b)
  
  instance Default Set where
      def = Set 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 (Eq,Show)
  
  setFromList :: [ByteString] -> Set
  setFromList = Set . S.fromList
  
  -- | CRDT Counter hold a integer 'Count'
  --
  -- >>> Counter 42
  newtype Counter = Counter Count deriving (Eq,Ord,Num,Show,Generic)
  type Count = Int64
  
  instance NFData Counter
  
  instance Semigroup Counter where
      Counter a <> Counter b = Counter . getSum $ Sum a <> Sum b
  
  instance Monoid Counter where
      mempty = Counter 0
      mappend = (<>)
  
  instance Default Counter where
      def = mempty
  
  -- | Counters can be incremented/decremented
  --
  -- >>> CounterInc 1
  data CounterOp = CounterInc !Count deriving (Eq,Show)
  
  instance Semigroup CounterOp where
      CounterInc x <> CounterInc y = CounterInc . getSum $ Sum x <> Sum y
  
  instance Monoid CounterOp where
      mempty = CounterInc 0
      CounterInc x `mappend` CounterInc y = CounterInc . getSum $ Sum x <> Sum y
  