-- |
-- Module:      Network.Riak.CRDT.Response
-- 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
--

{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}
module Network.Riak.CRDT.Response (get) where

#if __GLASGOW_HASKELL__ <= 708
import           Control.Applicative ((<$>))
import           Data.Traversable
#endif
import qualified Data.Map as Map
import           Data.Maybe (catMaybes)
import qualified Data.Riak.Proto as Proto

import           Network.Riak.CRDT.Types as CRDT
import           Network.Riak.Lens

get :: Proto.DtFetchResp -> Maybe CRDT.DataType
get :: DtFetchResp -> Maybe DataType
get DtFetchResp
resp = case DtFetchResp
resp DtFetchResp
-> Lens DtFetchResp DtFetchResp'DataType -> DtFetchResp'DataType
forall s a. s -> Lens s a -> a
^. Lens DtFetchResp DtFetchResp'DataType
forall (f :: * -> *) s a.
(Functor f, HasField s "type'" a) =>
LensLike' f s a
Proto.type' of
             DtFetchResp'DataType
Proto.DtFetchResp'COUNTER ->
                 Counter -> DataType
DTCounter (Counter -> DataType) -> (Count -> Counter) -> Count -> DataType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Count -> Counter
Counter (Count -> DataType) -> Maybe Count -> Maybe DataType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((DtValue -> Lens DtValue (Maybe Count) -> Maybe Count
forall s a. s -> Lens s a -> a
^. Lens DtValue (Maybe Count)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'counterValue" a) =>
LensLike' f s a
Proto.maybe'counterValue) (DtValue -> Maybe Count) -> Maybe DtValue -> Maybe Count
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (DtFetchResp
resp DtFetchResp -> Lens DtFetchResp (Maybe DtValue) -> Maybe DtValue
forall s a. s -> Lens s a -> a
^. Lens DtFetchResp (Maybe DtValue)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'value" a) =>
LensLike' f s a
Proto.maybe'value))
             DtFetchResp'DataType
Proto.DtFetchResp'SET ->
                 Set -> DataType
DTSet (Set -> DataType) -> (DtValue -> Set) -> DtValue -> DataType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Set
setFromList ([ByteString] -> Set)
-> (DtValue -> [ByteString]) -> DtValue -> Set
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DtValue -> Lens DtValue [ByteString] -> [ByteString]
forall s a. s -> Lens s a -> a
^. Lens DtValue [ByteString]
forall (f :: * -> *) s a.
(Functor f, HasField s "setValue" a) =>
LensLike' f s a
Proto.setValue) (DtValue -> DataType) -> Maybe DtValue -> Maybe DataType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DtFetchResp
resp DtFetchResp -> Lens DtFetchResp (Maybe DtValue) -> Maybe DtValue
forall s a. s -> Lens s a -> a
^. Lens DtFetchResp (Maybe DtValue)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'value" a) =>
LensLike' f s a
Proto.maybe'value)
             DtFetchResp'DataType
Proto.DtFetchResp'MAP ->
                 Map -> DataType
DTMap (Map -> DataType) -> (DtValue -> Map) -> DtValue -> DataType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MapEntry] -> Map
deconstructMap ([MapEntry] -> Map) -> (DtValue -> [MapEntry]) -> DtValue -> Map
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DtValue -> Lens DtValue [MapEntry] -> [MapEntry]
forall s a. s -> Lens s a -> a
^. Lens DtValue [MapEntry]
forall (f :: * -> *) s a.
(Functor f, HasField s "mapValue" a) =>
LensLike' f s a
Proto.mapValue) (DtValue -> DataType) -> Maybe DtValue -> Maybe DataType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DtFetchResp
resp DtFetchResp -> Lens DtFetchResp (Maybe DtValue) -> Maybe DtValue
forall s a. s -> Lens s a -> a
^. Lens DtFetchResp (Maybe DtValue)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'value" a) =>
LensLike' f s a
Proto.maybe'value)

             -- We don't support hll or gset yet
             DtFetchResp'DataType
Proto.DtFetchResp'HLL -> Maybe DataType
forall a. Maybe a
Nothing
             DtFetchResp'DataType
Proto.DtFetchResp'GSET -> Maybe DataType
forall a. Maybe a
Nothing

deconstructMap :: [Proto.MapEntry] -> Map
deconstructMap :: [MapEntry] -> Map
deconstructMap = MapContent -> Map
Map (MapContent -> Map)
-> ([MapEntry] -> MapContent) -> [MapEntry] -> Map
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(MapField, MapEntry)] -> MapContent
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(MapField, MapEntry)] -> MapContent)
-> ([MapEntry] -> [(MapField, MapEntry)])
-> [MapEntry]
-> MapContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (MapField, MapEntry)] -> [(MapField, MapEntry)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (MapField, MapEntry)] -> [(MapField, MapEntry)])
-> ([MapEntry] -> [Maybe (MapField, MapEntry)])
-> [MapEntry]
-> [(MapField, MapEntry)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MapEntry -> Maybe (MapField, MapEntry))
-> [MapEntry] -> [Maybe (MapField, MapEntry)]
forall a b. (a -> b) -> [a] -> [b]
map MapEntry -> Maybe (MapField, MapEntry)
f

f :: Proto.MapEntry -> Maybe (MapField, MapEntry)
f :: MapEntry -> Maybe (MapField, MapEntry)
f MapEntry
entry = (MapField, Maybe MapEntry) -> Maybe (MapField, MapEntry)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (MapEntryTag -> ByteString -> MapField
MapField MapEntryTag
t (MapField
field MapField -> Lens MapField ByteString -> ByteString
forall s a. s -> Lens s a -> a
^. Lens MapField ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "name" a) =>
LensLike' f s a
Proto.name), Maybe MapEntry
v)
    where field :: Proto.MapField
          field :: MapField
field = MapEntry
entry MapEntry -> Lens MapEntry MapField -> MapField
forall s a. s -> Lens s a -> a
^. Lens MapEntry MapField
forall (f :: * -> *) s a.
(Functor f, HasField s "field" a) =>
LensLike' f s a
Proto.field
          type' :: Proto.MapField'MapFieldType
          type' :: MapField'MapFieldType
type' = MapField
field MapField
-> Lens MapField MapField'MapFieldType -> MapField'MapFieldType
forall s a. s -> Lens s a -> a
^. Lens MapField MapField'MapFieldType
forall (f :: * -> *) s a.
(Functor f, HasField s "type'" a) =>
LensLike' f s a
Proto.type'
          t :: MapEntryTag
          t :: MapEntryTag
t = MapField'MapFieldType -> MapEntryTag
typeToTag MapField'MapFieldType
type'
          v :: Maybe MapEntry
          v :: Maybe MapEntry
v = case MapField'MapFieldType
type' of
                MapField'MapFieldType
Proto.MapField'COUNTER  -> Counter -> MapEntry
MapCounter (Counter -> MapEntry) -> (Count -> Counter) -> Count -> MapEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Count -> Counter
Counter (Count -> MapEntry) -> Maybe Count -> Maybe MapEntry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MapEntry
entry MapEntry -> Lens MapEntry (Maybe Count) -> Maybe Count
forall s a. s -> Lens s a -> a
^. Lens MapEntry (Maybe Count)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'counterValue" a) =>
LensLike' f s a
Proto.maybe'counterValue)
                MapField'MapFieldType
Proto.MapField'SET      -> MapEntry -> Maybe MapEntry
forall a. a -> Maybe a
Just (MapEntry -> Maybe MapEntry)
-> ([ByteString] -> MapEntry) -> [ByteString] -> Maybe MapEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set -> MapEntry
MapSet (Set -> MapEntry)
-> ([ByteString] -> Set) -> [ByteString] -> MapEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Set
setFromList ([ByteString] -> Maybe MapEntry) -> [ByteString] -> Maybe MapEntry
forall a b. (a -> b) -> a -> b
$ (MapEntry
entry MapEntry -> Lens MapEntry [ByteString] -> [ByteString]
forall s a. s -> Lens s a -> a
^. Lens MapEntry [ByteString]
forall (f :: * -> *) s a.
(Functor f, HasField s "setValue" a) =>
LensLike' f s a
Proto.setValue)
                MapField'MapFieldType
Proto.MapField'REGISTER -> Register -> MapEntry
MapRegister (Register -> MapEntry)
-> (ByteString -> Register) -> ByteString -> MapEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Register
Register (ByteString -> MapEntry) -> Maybe ByteString -> Maybe MapEntry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MapEntry
entry MapEntry -> Lens MapEntry (Maybe ByteString) -> Maybe ByteString
forall s a. s -> Lens s a -> a
^. Lens MapEntry (Maybe ByteString)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'registerValue" a) =>
LensLike' f s a
Proto.maybe'registerValue)
                MapField'MapFieldType
Proto.MapField'FLAG     -> Flag -> MapEntry
MapFlag (Flag -> MapEntry) -> (Bool -> Flag) -> Bool -> MapEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Flag
Flag (Bool -> MapEntry) -> Maybe Bool -> Maybe MapEntry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MapEntry
entry MapEntry -> Lens MapEntry (Maybe Bool) -> Maybe Bool
forall s a. s -> Lens s a -> a
^. Lens MapEntry (Maybe Bool)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'flagValue" a) =>
LensLike' f s a
Proto.maybe'flagValue)
                MapField'MapFieldType
Proto.MapField'MAP      -> MapEntry -> Maybe MapEntry
forall a. a -> Maybe a
Just (MapEntry -> Maybe MapEntry)
-> ([MapEntry] -> MapEntry) -> [MapEntry] -> Maybe MapEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map -> MapEntry
MapMap (Map -> MapEntry) -> ([MapEntry] -> Map) -> [MapEntry] -> MapEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MapEntry] -> Map
deconstructMap ([MapEntry] -> Maybe MapEntry) -> [MapEntry] -> Maybe MapEntry
forall a b. (a -> b) -> a -> b
$ (MapEntry
entry MapEntry -> Lens MapEntry [MapEntry] -> [MapEntry]
forall s a. s -> Lens s a -> a
^. Lens MapEntry [MapEntry]
forall (f :: * -> *) s a.
(Functor f, HasField s "mapValue" a) =>
LensLike' f s a
Proto.mapValue)

typeToTag :: Proto.MapField'MapFieldType -> MapEntryTag
typeToTag :: MapField'MapFieldType -> MapEntryTag
typeToTag MapField'MapFieldType
Proto.MapField'COUNTER  = MapEntryTag
MapCounterTag
typeToTag MapField'MapFieldType
Proto.MapField'SET      = MapEntryTag
MapSetTag
typeToTag MapField'MapFieldType
Proto.MapField'REGISTER = MapEntryTag
MapRegisterTag
typeToTag MapField'MapFieldType
Proto.MapField'FLAG     = MapEntryTag
MapFlagTag
typeToTag MapField'MapFieldType
Proto.MapField'MAP      = MapEntryTag
MapMapTag