{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE CPP #-}

-- |
-- Module:      Network.Riak.JSON
-- Copyright:   (c) 2011 MailRank, Inc.
-- License:     Apache
-- Maintainer:  Mark Hibberd <mark@hibberd.id.au>, Nathan Hunter <nhunter@janrain.com>
-- Stability:   experimental
-- Portability: portable
--
-- This module allows storage and retrieval of JSON-encoded data.
--
-- The functions in this module do not perform any conflict resolution.

module Network.Riak.JSON
    (
      JSON
    , json
    , plain
    , get
    , getMany
    , put
    , putIndexed
    , put_
    , putMany
    , putMany_
    ) where

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
#endif
import Control.Arrow (first)
import Data.Aeson.Types (FromJSON(..), ToJSON(..))
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid (Monoid)
#endif
import Data.Semigroup (Semigroup)
import Data.Typeable (Typeable)
import Network.Riak.Types.Internal
import qualified Network.Riak.Value as V

newtype JSON a = J {
      JSON a -> a
plain :: a -- ^ Unwrap a 'JSON'-wrapped value.
    } deriving (JSON a -> JSON a -> Bool
(JSON a -> JSON a -> Bool)
-> (JSON a -> JSON a -> Bool) -> Eq (JSON a)
forall a. Eq a => JSON a -> JSON a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JSON a -> JSON a -> Bool
$c/= :: forall a. Eq a => JSON a -> JSON a -> Bool
== :: JSON a -> JSON a -> Bool
$c== :: forall a. Eq a => JSON a -> JSON a -> Bool
Eq, Eq (JSON a)
Eq (JSON a)
-> (JSON a -> JSON a -> Ordering)
-> (JSON a -> JSON a -> Bool)
-> (JSON a -> JSON a -> Bool)
-> (JSON a -> JSON a -> Bool)
-> (JSON a -> JSON a -> Bool)
-> (JSON a -> JSON a -> JSON a)
-> (JSON a -> JSON a -> JSON a)
-> Ord (JSON a)
JSON a -> JSON a -> Bool
JSON a -> JSON a -> Ordering
JSON a -> JSON a -> JSON a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (JSON a)
forall a. Ord a => JSON a -> JSON a -> Bool
forall a. Ord a => JSON a -> JSON a -> Ordering
forall a. Ord a => JSON a -> JSON a -> JSON a
min :: JSON a -> JSON a -> JSON a
$cmin :: forall a. Ord a => JSON a -> JSON a -> JSON a
max :: JSON a -> JSON a -> JSON a
$cmax :: forall a. Ord a => JSON a -> JSON a -> JSON a
>= :: JSON a -> JSON a -> Bool
$c>= :: forall a. Ord a => JSON a -> JSON a -> Bool
> :: JSON a -> JSON a -> Bool
$c> :: forall a. Ord a => JSON a -> JSON a -> Bool
<= :: JSON a -> JSON a -> Bool
$c<= :: forall a. Ord a => JSON a -> JSON a -> Bool
< :: JSON a -> JSON a -> Bool
$c< :: forall a. Ord a => JSON a -> JSON a -> Bool
compare :: JSON a -> JSON a -> Ordering
$ccompare :: forall a. Ord a => JSON a -> JSON a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (JSON a)
Ord, Int -> JSON a -> ShowS
[JSON a] -> ShowS
JSON a -> String
(Int -> JSON a -> ShowS)
-> (JSON a -> String) -> ([JSON a] -> ShowS) -> Show (JSON a)
forall a. Show a => Int -> JSON a -> ShowS
forall a. Show a => [JSON a] -> ShowS
forall a. Show a => JSON a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSON a] -> ShowS
$cshowList :: forall a. Show a => [JSON a] -> ShowS
show :: JSON a -> String
$cshow :: forall a. Show a => JSON a -> String
showsPrec :: Int -> JSON a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> JSON a -> ShowS
Show, ReadPrec [JSON a]
ReadPrec (JSON a)
Int -> ReadS (JSON a)
ReadS [JSON a]
(Int -> ReadS (JSON a))
-> ReadS [JSON a]
-> ReadPrec (JSON a)
-> ReadPrec [JSON a]
-> Read (JSON a)
forall a. Read a => ReadPrec [JSON a]
forall a. Read a => ReadPrec (JSON a)
forall a. Read a => Int -> ReadS (JSON a)
forall a. Read a => ReadS [JSON a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [JSON a]
$creadListPrec :: forall a. Read a => ReadPrec [JSON a]
readPrec :: ReadPrec (JSON a)
$creadPrec :: forall a. Read a => ReadPrec (JSON a)
readList :: ReadS [JSON a]
$creadList :: forall a. Read a => ReadS [JSON a]
readsPrec :: Int -> ReadS (JSON a)
$creadsPrec :: forall a. Read a => Int -> ReadS (JSON a)
Read, JSON a
JSON a -> JSON a -> Bounded (JSON a)
forall a. a -> a -> Bounded a
forall a. Bounded a => JSON a
maxBound :: JSON a
$cmaxBound :: forall a. Bounded a => JSON a
minBound :: JSON a
$cminBound :: forall a. Bounded a => JSON a
Bounded, Typeable, b -> JSON a -> JSON a
NonEmpty (JSON a) -> JSON a
JSON a -> JSON a -> JSON a
(JSON a -> JSON a -> JSON a)
-> (NonEmpty (JSON a) -> JSON a)
-> (forall b. Integral b => b -> JSON a -> JSON a)
-> Semigroup (JSON a)
forall b. Integral b => b -> JSON a -> JSON a
forall a. Semigroup a => NonEmpty (JSON a) -> JSON a
forall a. Semigroup a => JSON a -> JSON a -> JSON a
forall a b. (Semigroup a, Integral b) => b -> JSON a -> JSON a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> JSON a -> JSON a
$cstimes :: forall a b. (Semigroup a, Integral b) => b -> JSON a -> JSON a
sconcat :: NonEmpty (JSON a) -> JSON a
$csconcat :: forall a. Semigroup a => NonEmpty (JSON a) -> JSON a
<> :: JSON a -> JSON a -> JSON a
$c<> :: forall a. Semigroup a => JSON a -> JSON a -> JSON a
Semigroup, Semigroup (JSON a)
JSON a
Semigroup (JSON a)
-> JSON a
-> (JSON a -> JSON a -> JSON a)
-> ([JSON a] -> JSON a)
-> Monoid (JSON a)
[JSON a] -> JSON a
JSON a -> JSON a -> JSON a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. Monoid a => Semigroup (JSON a)
forall a. Monoid a => JSON a
forall a. Monoid a => [JSON a] -> JSON a
forall a. Monoid a => JSON a -> JSON a -> JSON a
mconcat :: [JSON a] -> JSON a
$cmconcat :: forall a. Monoid a => [JSON a] -> JSON a
mappend :: JSON a -> JSON a -> JSON a
$cmappend :: forall a. Monoid a => JSON a -> JSON a -> JSON a
mempty :: JSON a
$cmempty :: forall a. Monoid a => JSON a
$cp1Monoid :: forall a. Monoid a => Semigroup (JSON a)
Monoid)

-- | Wrap up a value so that it will be encoded and decoded as JSON
-- when converted to/from 'Content'.
json :: a -> JSON a
json :: a -> JSON a
json = a -> JSON a
forall a. a -> JSON a
J
{-# INLINE json #-}

instance Functor JSON where
    fmap :: (a -> b) -> JSON a -> JSON b
fmap a -> b
f (J a
a) = b -> JSON b
forall a. a -> JSON a
J (a -> b
f a
a)
    {-# INLINE fmap #-}

instance (FromJSON a, ToJSON a) => V.IsContent (JSON a) where
    parseContent :: RpbContent -> Parser (JSON a)
parseContent RpbContent
c = a -> JSON a
forall a. a -> JSON a
J (a -> JSON a) -> Parser a -> Parser (JSON a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (RpbContent -> Parser Value
forall c. IsContent c => RpbContent -> Parser c
V.parseContent RpbContent
c Parser Value -> (Value -> Parser a) -> Parser a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON)
    {-# INLINE parseContent #-}

    toContent :: JSON a -> RpbContent
toContent (J a
a) = Value -> RpbContent
forall c. IsContent c => c -> RpbContent
V.toContent (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a)
    {-# INLINE toContent #-}

-- | Retrieve a value.  This may return multiple conflicting siblings.
-- Choosing among them is your responsibility.
get :: (FromJSON c, ToJSON c) => Connection
    -> Maybe BucketType -> Bucket -> Key -> R
    -> IO (Maybe ([c], VClock))
get :: Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> R
-> IO (Maybe ([c], VClock))
get Connection
conn Maybe BucketType
btype BucketType
bucket' BucketType
key' R
r = (([JSON c], VClock) -> ([c], VClock))
-> Maybe ([JSON c], VClock) -> Maybe ([c], VClock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([JSON c], VClock) -> ([c], VClock)
forall a. ([JSON a], VClock) -> ([a], VClock)
convert (Maybe ([JSON c], VClock) -> Maybe ([c], VClock))
-> IO (Maybe ([JSON c], VClock)) -> IO (Maybe ([c], VClock))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> R
-> IO (Maybe ([JSON c], VClock))
forall c.
IsContent c =>
Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> R
-> IO (Maybe ([c], VClock))
V.get Connection
conn Maybe BucketType
btype BucketType
bucket' BucketType
key' R
r

getMany :: (FromJSON c, ToJSON c) => Connection
        -> Maybe BucketType -> Bucket -> [Key] -> R
        -> IO [Maybe ([c], VClock)]
getMany :: Connection
-> Maybe BucketType
-> BucketType
-> [BucketType]
-> R
-> IO [Maybe ([c], VClock)]
getMany Connection
conn Maybe BucketType
btype BucketType
bucket' [BucketType]
ks R
r = (Maybe ([JSON c], VClock) -> Maybe ([c], VClock))
-> [Maybe ([JSON c], VClock)] -> [Maybe ([c], VClock)]
forall a b. (a -> b) -> [a] -> [b]
map ((([JSON c], VClock) -> ([c], VClock))
-> Maybe ([JSON c], VClock) -> Maybe ([c], VClock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([JSON c], VClock) -> ([c], VClock)
forall a. ([JSON a], VClock) -> ([a], VClock)
convert) ([Maybe ([JSON c], VClock)] -> [Maybe ([c], VClock)])
-> IO [Maybe ([JSON c], VClock)] -> IO [Maybe ([c], VClock)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Maybe BucketType
-> BucketType
-> [BucketType]
-> R
-> IO [Maybe ([JSON c], VClock)]
forall c.
IsContent c =>
Connection
-> Maybe BucketType
-> BucketType
-> [BucketType]
-> R
-> IO [Maybe ([c], VClock)]
V.getMany Connection
conn Maybe BucketType
btype BucketType
bucket' [BucketType]
ks R
r

-- | Store a single value.  This may return multiple conflicting
-- siblings.  Choosing among them, and storing a new value, is your
-- responsibility.
--
-- You should /only/ supply 'Nothing' as a 'T.VClock' if you are sure
-- that the given type+bucket+key combination does not already exist.
-- If you omit a 'T.VClock' but the type+bucket+key /does/ exist, your
-- value will not be stored.
put :: (FromJSON c, ToJSON c) =>
       Connection -> Maybe BucketType -> Bucket -> Key -> Maybe VClock -> c
    -> W -> DW -> IO ([c], VClock)
put :: Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> Maybe VClock
-> c
-> R
-> R
-> IO ([c], VClock)
put Connection
conn Maybe BucketType
btype BucketType
bucket' BucketType
key' Maybe VClock
mvclock c
val R
w R
dw =
    ([JSON c], VClock) -> ([c], VClock)
forall a. ([JSON a], VClock) -> ([a], VClock)
convert (([JSON c], VClock) -> ([c], VClock))
-> IO ([JSON c], VClock) -> IO ([c], VClock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> Maybe VClock
-> JSON c
-> R
-> R
-> IO ([JSON c], VClock)
forall c.
IsContent c =>
Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> Maybe VClock
-> c
-> R
-> R
-> IO ([c], VClock)
V.put Connection
conn Maybe BucketType
btype BucketType
bucket' BucketType
key' Maybe VClock
mvclock (c -> JSON c
forall a. a -> JSON a
json c
val) R
w R
dw

-- | Store a single value indexed.
putIndexed :: (FromJSON c, ToJSON c)
           => Connection -> Maybe BucketType -> Bucket -> Key -> [IndexValue]
           -> Maybe VClock -> c
           -> W -> DW -> IO ([c], VClock)
putIndexed :: Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> [IndexValue]
-> Maybe VClock
-> c
-> R
-> R
-> IO ([c], VClock)
putIndexed Connection
conn Maybe BucketType
btype BucketType
bucket' BucketType
key' [IndexValue]
ixs Maybe VClock
mvclock c
val R
w R
dw =
    ([JSON c], VClock) -> ([c], VClock)
forall a. ([JSON a], VClock) -> ([a], VClock)
convert (([JSON c], VClock) -> ([c], VClock))
-> IO ([JSON c], VClock) -> IO ([c], VClock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> [IndexValue]
-> Maybe VClock
-> JSON c
-> R
-> R
-> IO ([JSON c], VClock)
forall c.
IsContent c =>
Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> [IndexValue]
-> Maybe VClock
-> c
-> R
-> R
-> IO ([c], VClock)
V.putIndexed Connection
conn Maybe BucketType
btype BucketType
bucket' BucketType
key' [IndexValue]
ixs Maybe VClock
mvclock (c -> JSON c
forall a. a -> JSON a
json c
val) R
w R
dw

-- | Store a single value, without the possibility of conflict
-- resolution.
--
-- You should /only/ supply 'Nothing' as a 'T.VClock' if you are sure
-- that the given type+bucket+key combination does not already exist.
-- If you omit a 'T.VClock' but the type+bucket+key /does/ exist, your
-- value will not be stored, and you will not be notified.
put_ :: (FromJSON c, ToJSON c) =>
       Connection -> Maybe BucketType -> Bucket -> Key -> Maybe VClock -> c
    -> W -> DW -> IO ()
put_ :: Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> Maybe VClock
-> c
-> R
-> R
-> IO ()
put_ Connection
conn Maybe BucketType
btype BucketType
bucket' BucketType
key' Maybe VClock
mvclock c
val R
w R
dw =
    Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> Maybe VClock
-> JSON c
-> R
-> R
-> IO ()
forall c.
IsContent c =>
Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> Maybe VClock
-> c
-> R
-> R
-> IO ()
V.put_ Connection
conn Maybe BucketType
btype BucketType
bucket' BucketType
key' Maybe VClock
mvclock (c -> JSON c
forall a. a -> JSON a
json c
val) R
w R
dw

-- | Store many values.  This may return multiple conflicting siblings
-- for each value stored.  Choosing among them, and storing a new
-- value in each case, is your responsibility.
--
-- You should /only/ supply 'Nothing' as a 'T.VClock' if you are sure
-- that the given type+bucket+key combination does not already exist.
-- If you omit a 'T.VClock' but the type+bucket+key /does/ exist, your
-- value will not be stored.
putMany :: (FromJSON c, ToJSON c) =>
           Connection -> Maybe BucketType -> Bucket -> [(Key, Maybe VClock, c)]
        -> W -> DW -> IO [([c], VClock)]
putMany :: Connection
-> Maybe BucketType
-> BucketType
-> [(BucketType, Maybe VClock, c)]
-> R
-> R
-> IO [([c], VClock)]
putMany Connection
conn Maybe BucketType
btype BucketType
bucket' [(BucketType, Maybe VClock, c)]
puts R
w R
dw =
    (([JSON c], VClock) -> ([c], VClock))
-> [([JSON c], VClock)] -> [([c], VClock)]
forall a b. (a -> b) -> [a] -> [b]
map ([JSON c], VClock) -> ([c], VClock)
forall a. ([JSON a], VClock) -> ([a], VClock)
convert ([([JSON c], VClock)] -> [([c], VClock)])
-> IO [([JSON c], VClock)] -> IO [([c], VClock)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Maybe BucketType
-> BucketType
-> [(BucketType, Maybe VClock, JSON c)]
-> R
-> R
-> IO [([JSON c], VClock)]
forall c.
IsContent c =>
Connection
-> Maybe BucketType
-> BucketType
-> [(BucketType, Maybe VClock, c)]
-> R
-> R
-> IO [([c], VClock)]
V.putMany Connection
conn Maybe BucketType
btype BucketType
bucket' (((BucketType, Maybe VClock, c)
 -> (BucketType, Maybe VClock, JSON c))
-> [(BucketType, Maybe VClock, c)]
-> [(BucketType, Maybe VClock, JSON c)]
forall a b. (a -> b) -> [a] -> [b]
map (BucketType, Maybe VClock, c) -> (BucketType, Maybe VClock, JSON c)
forall a b a. (a, b, a) -> (a, b, JSON a)
f [(BucketType, Maybe VClock, c)]
puts) R
w R
dw
  where f :: (a, b, a) -> (a, b, JSON a)
f (a
k,b
v,a
c) = (a
k,b
v,a -> JSON a
forall a. a -> JSON a
json a
c)

-- | Store many values, without the possibility of conflict
-- resolution.
--
-- You should /only/ supply 'Nothing' as a 'T.VClock' if you are sure
-- that the given type+bucket+key combination does not already exist.
-- If you omit a 'T.VClock' but the type+bucket+key /does/ exist, your
-- value will not be stored, and you will not be notified.
putMany_ :: (FromJSON c, ToJSON c) =>
            Connection -> Maybe BucketType -> Bucket -> [(Key, Maybe VClock, c)]
         -> W -> DW -> IO ()
putMany_ :: Connection
-> Maybe BucketType
-> BucketType
-> [(BucketType, Maybe VClock, c)]
-> R
-> R
-> IO ()
putMany_ Connection
conn Maybe BucketType
btype BucketType
bucket' [(BucketType, Maybe VClock, c)]
puts R
w R
dw = Connection
-> Maybe BucketType
-> BucketType
-> [(BucketType, Maybe VClock, JSON c)]
-> R
-> R
-> IO ()
forall c.
IsContent c =>
Connection
-> Maybe BucketType
-> BucketType
-> [(BucketType, Maybe VClock, c)]
-> R
-> R
-> IO ()
V.putMany_ Connection
conn Maybe BucketType
btype BucketType
bucket' (((BucketType, Maybe VClock, c)
 -> (BucketType, Maybe VClock, JSON c))
-> [(BucketType, Maybe VClock, c)]
-> [(BucketType, Maybe VClock, JSON c)]
forall a b. (a -> b) -> [a] -> [b]
map (BucketType, Maybe VClock, c) -> (BucketType, Maybe VClock, JSON c)
forall a b a. (a, b, a) -> (a, b, JSON a)
f [(BucketType, Maybe VClock, c)]
puts) R
w R
dw
  where f :: (a, b, a) -> (a, b, JSON a)
f (a
k,b
v,a
c) = (a
k,b
v,a -> JSON a
forall a. a -> JSON a
json a
c)

convert :: ([JSON a], VClock) -> ([a], VClock)
convert :: ([JSON a], VClock) -> ([a], VClock)
convert = ([JSON a] -> [a]) -> ([JSON a], VClock) -> ([a], VClock)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((JSON a -> a) -> [JSON a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map JSON a -> a
forall a. JSON a -> a
plain)