module Network.Riak.Value
(
IsContent(..)
, fromContent
, get
, getMany
, getByIndex
, addIndexes
, put
, putIndexed
, put_
, putMany
, putMany_
) where
import Control.Applicative
import Data.Aeson.Types (Parser, Result(..), parse)
import Data.Foldable (toList)
import Data.Monoid ((<>))
import Network.Riak.Connection.Internal
import Network.Riak.Protocol.Content (Content(..))
import Network.Riak.Protocol.GetResponse (GetResponse(..))
import Network.Riak.Protocol.IndexResponse (IndexResponse(..))
import Network.Riak.Protocol.PutResponse (PutResponse(..))
import Network.Riak.Resolvable (ResolvableMonoid(..))
import Network.Riak.Response (unescapeLinks)
import Network.Riak.Types.Internal hiding (MessageTag(..))
import qualified Network.Riak.Protocol.Pair as Pair
import qualified Data.Aeson.Parser as Aeson
import qualified Data.Aeson.Types as Aeson
import qualified Data.Attoparsec.Lazy as A
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as CL8
import qualified Data.Sequence as Seq
import qualified Network.Riak.Content as C
import qualified Network.Riak.Request as Req
fromContent :: IsContent c => Content -> Maybe c
fromContent c = case parse parseContent c of
Success a -> Just a
Error _ -> Nothing
class IsContent c where
parseContent :: Content -> Parser c
toContent :: c -> Content
instance IsContent Content where
parseContent = return
toContent v = v
instance IsContent () where
parseContent c | c == C.empty = pure ()
| otherwise = empty
toContent _ = C.empty
instance IsContent Aeson.Value where
parseContent c | content_type c == Just "application/json" =
case A.parse Aeson.json (value c) of
A.Done _ a -> return a
A.Fail _ _ err -> fail err
| otherwise = fail "non-JSON document"
toContent = C.json
deriving instance (IsContent a) => IsContent (ResolvableMonoid a)
addIndexes :: [IndexValue] -> Content -> Content
addIndexes ix c =
c { C.indexes = Seq.fromList . map toPair $ ix }
where
toPair (IndexInt k v) = Pair.Pair (k <> "_int")
(Just . CL8.pack . show $ v)
toPair (IndexBin k v) = Pair.Pair (k <> "_bin") (Just v)
put :: (IsContent c) => Connection -> Bucket -> Key -> Maybe VClock -> c
-> W -> DW -> IO ([c], VClock)
put conn bucket key mvclock val w dw =
putResp =<< exchange conn
(Req.put bucket key mvclock (toContent val) w dw True)
putIndexed :: (IsContent c) => Connection -> Bucket -> Key
-> [IndexValue]
-> Maybe VClock -> c
-> W -> DW -> IO ([c], VClock)
putIndexed conn b k inds mvclock val w dw =
putResp =<< exchange conn
(Req.put b k mvclock (addIndexes inds (toContent val))
w dw True)
putMany :: (IsContent c) => Connection -> Bucket -> [(Key, Maybe VClock, c)]
-> W -> DW -> IO [([c], VClock)]
putMany conn b puts w dw =
mapM putResp =<< pipeline conn (map (\(k,v,c) -> Req.put b k v (toContent c) w dw True) puts)
putResp :: (IsContent c) => PutResponse -> IO ([c], VClock)
putResp PutResponse{..} = do
case vclock of
Nothing -> return ([], VClock L.empty)
Just s -> do
c <- convert content
return (c, VClock s)
put_ :: (IsContent c) => Connection -> Bucket -> Key -> Maybe VClock -> c
-> W -> DW -> IO ()
put_ conn bucket key mvclock val w dw =
exchange_ conn (Req.put bucket key mvclock (toContent val) w dw False)
putMany_ :: (IsContent c) => Connection -> Bucket -> [(Key, Maybe VClock, c)]
-> W -> DW -> IO ()
putMany_ conn b puts w dw =
pipeline_ conn . map (\(k,v,c) -> Req.put b k v (toContent c) w dw False) $ puts
get :: (IsContent c) => Connection -> Bucket -> Key -> R
-> IO (Maybe ([c], VClock))
get conn bucket key r = getResp =<< exchangeMaybe conn (Req.get bucket key r)
getByIndex :: Connection -> Bucket -> IndexQuery
-> IO [Key]
getByIndex conn b indq =
getByIndexResp =<< exchangeMaybe conn (Req.getByIndex b indq)
getMany :: (IsContent c) => Connection -> Bucket -> [Key] -> R
-> IO [Maybe ([c], VClock)]
getMany conn b ks r =
mapM getResp =<< pipelineMaybe conn (map (\k -> Req.get b k r) ks)
getResp :: (IsContent c) => Maybe GetResponse -> IO (Maybe ([c], VClock))
getResp resp =
case resp of
Just (GetResponse content (Just s) _) -> do
c <- convert content
return $ Just (c, VClock s)
_ -> return Nothing
getByIndexResp :: Maybe IndexResponse -> IO [Key]
getByIndexResp resp =
case resp of
Just (IndexResponse keys _ _ _) -> return (toList keys)
Nothing -> return []
convert :: IsContent v => Seq.Seq Content -> IO [v]
convert = go [] [] . toList
where go cs vs (x:xs) = case fromContent y of
Just v -> go cs (v:vs) xs
_ -> go (y:cs) vs xs
where y = unescapeLinks x
go [] vs _ = return (reverse vs)
go cs _ _ = typeError "Network.Riak.Value" "convert" $
show (length cs) ++ " values failed conversion: " ++
show cs