{-# LANGUAGE NamedFieldPuns, RecordWildCards, CPP, OverloadedStrings #-}

-- |
-- Module:      Network.Riak.Request
-- Copyright:   (c) 2011 MailRank, Inc.
-- License:     Apache
-- Maintainer:  Mark Hibberd <mark@hibberd.id.au>, Nathan Hunter <nhunter@janrain.com>
-- Stability:   experimental
-- Portability: portable
--
-- Smart deconstructors for Riak types.  These functions correctly
-- URL-unescape bucket, key, and link names.  You should thus use them
-- in preference to direct pattern matching against raw data
-- constructors.

module Network.Riak.Response
    (
    -- * Connection management
      getClientID
    -- * Data management
    , get
    , put
    -- * Metadata
    , listBuckets
    , getBucket
    , unescapeLinks
    , search
    , getIndex
    ) where

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
import Data.Semigroup
import Control.Arrow ((&&&))
import Control.Monad (join)
#endif
import qualified Data.Riak.Proto as Proto
import Network.Riak.Escape (unescape)
import Network.Riak.Lens
import Network.Riak.Types.Internal hiding (MessageTag(..))

import Data.ByteString (ByteString)
import Data.Foldable (toList)

getClientID :: Proto.RpbGetClientIdResp -> ClientID
getClientID :: RpbGetClientIdResp -> ClientID
getClientID = (RpbGetClientIdResp -> Lens RpbGetClientIdResp ClientID -> ClientID
forall s a. s -> Lens s a -> a
^. Lens RpbGetClientIdResp ClientID
forall (f :: * -> *) s a.
(Functor f, HasField s "clientId" a) =>
LensLike' f s a
Proto.clientId)
{-# INLINE getClientID #-}

-- | Construct a get response.  Bucket and key names in links are
-- URL-unescaped.
get :: Maybe Proto.RpbGetResp -> Maybe ([Proto.RpbContent], VClock)
get :: Maybe RpbGetResp -> Maybe ([RpbContent], VClock)
get Maybe RpbGetResp
mresponse = do
  RpbGetResp
response <- Maybe RpbGetResp
mresponse
  let content :: [RpbContent]
content = RpbGetResp
response RpbGetResp -> Lens RpbGetResp [RpbContent] -> [RpbContent]
forall s a. s -> Lens s a -> a
^. Lens RpbGetResp [RpbContent]
forall (f :: * -> *) s a.
(Functor f, HasField s "content" a) =>
LensLike' f s a
Proto.content
  ClientID
vclock <- RpbGetResp
response RpbGetResp -> Lens RpbGetResp (Maybe ClientID) -> Maybe ClientID
forall s a. s -> Lens s a -> a
^. Lens RpbGetResp (Maybe ClientID)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'vclock" a) =>
LensLike' f s a
Proto.maybe'vclock
  ([RpbContent], VClock) -> Maybe ([RpbContent], VClock)
forall a. a -> Maybe a
Just (RpbContent -> RpbContent
unescapeLinks (RpbContent -> RpbContent) -> [RpbContent] -> [RpbContent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RpbContent]
content, ClientID -> VClock
VClock ClientID
vclock)
{-# INLINE get #-}

-- | Construct a put response.  Bucket and key names in links are
-- URL-unescaped.
put :: Proto.RpbPutResp -> ([Proto.RpbContent], VClock)
put :: RpbPutResp -> ([RpbContent], VClock)
put RpbPutResp
response =
  ( RpbContent -> RpbContent
unescapeLinks (RpbContent -> RpbContent) -> [RpbContent] -> [RpbContent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RpbPutResp
response RpbPutResp -> Lens RpbPutResp [RpbContent] -> [RpbContent]
forall s a. s -> Lens s a -> a
^. Lens RpbPutResp [RpbContent]
forall (f :: * -> *) s a.
(Functor f, HasField s "content" a) =>
LensLike' f s a
Proto.content)
  , ClientID -> VClock
VClock (RpbPutResp
response RpbPutResp -> Lens RpbPutResp ClientID -> ClientID
forall s a. s -> Lens s a -> a
^. Lens RpbPutResp ClientID
forall (f :: * -> *) s a.
(Functor f, HasField s "vclock" a) =>
LensLike' f s a
Proto.vclock)
  )
{-# INLINE put #-}

-- | Construct a list-buckets response.  Bucket names are unescaped.
listBuckets :: Proto.RpbListBucketsResp -> [Bucket]
listBuckets :: RpbListBucketsResp -> [ClientID]
listBuckets = (ClientID -> ClientID) -> [ClientID] -> [ClientID]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ClientID -> ClientID
forall e. Escape e => ClientID -> e
unescape ([ClientID] -> [ClientID])
-> (RpbListBucketsResp -> [ClientID])
-> RpbListBucketsResp
-> [ClientID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RpbListBucketsResp
-> Lens RpbListBucketsResp [ClientID] -> [ClientID]
forall s a. s -> Lens s a -> a
^. Lens RpbListBucketsResp [ClientID]
forall (f :: * -> *) s a.
(Functor f, HasField s "buckets" a) =>
LensLike' f s a
Proto.buckets)
{-# INLINE listBuckets #-}

getBucket :: Proto.RpbGetBucketResp -> Proto.RpbBucketProps
getBucket :: RpbGetBucketResp -> RpbBucketProps
getBucket = (RpbGetBucketResp
-> Lens RpbGetBucketResp RpbBucketProps -> RpbBucketProps
forall s a. s -> Lens s a -> a
^. Lens RpbGetBucketResp RpbBucketProps
forall (f :: * -> *) s a.
(Functor f, HasField s "props" a) =>
LensLike' f s a
Proto.props)
{-# INLINE getBucket #-}

-- | URL-unescape the names of keys and buckets in the links of a
-- 'Content' value.
unescapeLinks :: Proto.RpbContent -> Proto.RpbContent
unescapeLinks :: RpbContent -> RpbContent
unescapeLinks = LensLike' Identity RpbContent [RpbLink]
forall (f :: * -> *) s a.
(Functor f, HasField s "links" a) =>
LensLike' f s a
Proto.links LensLike' Identity RpbContent [RpbLink]
-> ((RpbLink -> Identity RpbLink)
    -> [RpbLink] -> Identity [RpbLink])
-> (RpbLink -> Identity RpbLink)
-> RpbContent
-> Identity RpbContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RpbLink -> Identity RpbLink) -> [RpbLink] -> Identity [RpbLink]
forall (f :: * -> *) a. Functor f => Setter (f a) a
mapped ((RpbLink -> Identity RpbLink)
 -> RpbContent -> Identity RpbContent)
-> (RpbLink -> RpbLink) -> RpbContent -> RpbContent
forall s a. Setter s a -> (a -> a) -> s -> s
%~ RpbLink -> RpbLink
go
  where go :: Proto.RpbLink -> Proto.RpbLink
        go :: RpbLink -> RpbLink
go RpbLink
l = RpbLink
l RpbLink -> (RpbLink -> RpbLink) -> RpbLink
forall a b. a -> (a -> b) -> b
& LensLike' Identity RpbLink ClientID
forall (f :: * -> *) s a.
(Functor f, HasField s "bucket" a) =>
LensLike' f s a
Proto.bucket LensLike' Identity RpbLink ClientID
-> (ClientID -> ClientID) -> RpbLink -> RpbLink
forall s a. Setter s a -> (a -> a) -> s -> s
%~ ClientID -> ClientID
forall e. Escape e => ClientID -> e
unescape
                 RpbLink -> (RpbLink -> RpbLink) -> RpbLink
forall a b. a -> (a -> b) -> b
& LensLike' Identity RpbLink ClientID
forall (f :: * -> *) s a.
(Functor f, HasField s "key" a) =>
LensLike' f s a
Proto.key LensLike' Identity RpbLink ClientID
-> (ClientID -> ClientID) -> RpbLink -> RpbLink
forall s a. Setter s a -> (a -> a) -> s -> s
%~ ClientID -> ClientID
forall e. Escape e => ClientID -> e
unescape

search :: Proto.RpbSearchQueryResp -> SearchResult
search :: RpbSearchQueryResp -> SearchResult
search RpbSearchQueryResp
resp =
  SearchResult :: [[(ClientID, Maybe ClientID)]]
-> Maybe Float -> Maybe Word32 -> SearchResult
SearchResult
    { docs :: [[(ClientID, Maybe ClientID)]]
docs     = (RpbSearchDoc -> [(ClientID, Maybe ClientID)])
-> [RpbSearchDoc] -> [[(ClientID, Maybe ClientID)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((RpbPair -> (ClientID, Maybe ClientID))
-> [RpbPair] -> [(ClientID, Maybe ClientID)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RpbPair -> (ClientID, Maybe ClientID)
unpair ([RpbPair] -> [(ClientID, Maybe ClientID)])
-> (RpbSearchDoc -> [RpbPair])
-> RpbSearchDoc
-> [(ClientID, Maybe ClientID)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RpbSearchDoc -> Lens RpbSearchDoc [RpbPair] -> [RpbPair]
forall s a. s -> Lens s a -> a
^. Lens RpbSearchDoc [RpbPair]
forall (f :: * -> *) s a.
(Functor f, HasField s "fields" a) =>
LensLike' f s a
Proto.fields)) (RpbSearchQueryResp
resp RpbSearchQueryResp
-> Lens RpbSearchQueryResp [RpbSearchDoc] -> [RpbSearchDoc]
forall s a. s -> Lens s a -> a
^. Lens RpbSearchQueryResp [RpbSearchDoc]
forall (f :: * -> *) s a.
(Functor f, HasField s "docs" a) =>
LensLike' f s a
Proto.docs)
    , maxScore :: Maybe Float
maxScore = RpbSearchQueryResp
resp RpbSearchQueryResp
-> Lens RpbSearchQueryResp (Maybe Float) -> Maybe Float
forall s a. s -> Lens s a -> a
^. Lens RpbSearchQueryResp (Maybe Float)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'maxScore" a) =>
LensLike' f s a
Proto.maybe'maxScore
    , numFound :: Maybe Word32
numFound = RpbSearchQueryResp
resp RpbSearchQueryResp
-> Lens RpbSearchQueryResp (Maybe Word32) -> Maybe Word32
forall s a. s -> Lens s a -> a
^. Lens RpbSearchQueryResp (Maybe Word32)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'numFound" a) =>
LensLike' f s a
Proto.maybe'numFound
    }
  where
    unpair :: Proto.RpbPair -> (ByteString, Maybe ByteString)
    unpair :: RpbPair -> (ClientID, Maybe ClientID)
unpair RpbPair
pair = (RpbPair
pair RpbPair -> Lens RpbPair ClientID -> ClientID
forall s a. s -> Lens s a -> a
^. Lens RpbPair ClientID
forall (f :: * -> *) s a.
(Functor f, HasField s "key" a) =>
LensLike' f s a
Proto.key, RpbPair
pair RpbPair -> Lens RpbPair (Maybe ClientID) -> Maybe ClientID
forall s a. s -> Lens s a -> a
^. Lens RpbPair (Maybe ClientID)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'value" a) =>
LensLike' f s a
Proto.maybe'value)

getIndex :: Proto.RpbYokozunaIndexGetResp -> [IndexInfo]
getIndex :: RpbYokozunaIndexGetResp -> [IndexInfo]
getIndex = [IndexInfo] -> [IndexInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([IndexInfo] -> [IndexInfo])
-> (RpbYokozunaIndexGetResp -> [IndexInfo])
-> RpbYokozunaIndexGetResp
-> [IndexInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RpbYokozunaIndexGetResp
-> Lens RpbYokozunaIndexGetResp [IndexInfo] -> [IndexInfo]
forall s a. s -> Lens s a -> a
^. Lens RpbYokozunaIndexGetResp [IndexInfo]
forall (f :: * -> *) s a.
(Functor f, HasField s "index" a) =>
LensLike' f s a
Proto.index)