{-# LANGUAGE DeriveGeneric #-}
-- |
-- Module: Data.Greskell.GraphSON.GValue
-- Description: Aeson Value with GraphSON wrappers
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- __This module is for advanced use. Most users should just use "Data.Greskell.GraphSON".__
--
-- This module defines 'GValue' and exposes its deconstructors.
--
-- @since 0.1.2.0
module Data.Greskell.GraphSON.GValue
       ( -- * GValue type
         GValue(..),
         GValueBody(..),
         -- ** constructors
         nonTypedGValue,
         typedGValue',
         -- ** deconstructors
         -- $caveat_decon
         unwrapAll,
         unwrapOne,
         gValueBody,
         gValueType
       ) where

import Control.Applicative ((<$>), (<*>))
import Data.Aeson
  ( ToJSON(toJSON), FromJSON(parseJSON), Value(..)
  )
import Data.Aeson.Types (Parser)
import Data.Foldable (foldl')
import Data.Hashable (Hashable(..))
import Data.HashMap.Strict (HashMap)
import Data.Scientific (Scientific)
import Data.Text (Text)
import Data.Vector (Vector)
import GHC.Generics (Generic)

import Data.Greskell.GraphSON.Core
  ( nonTypedGraphSON, typedGraphSON', GraphSON(..)
  )

-- | An Aeson 'Value' wrapped in 'GraphSON' wrapper type. Basically
-- this type is the Haskell representaiton of a GraphSON-encoded
-- document.
--
-- This type is used to parse GraphSON documents. See also
-- 'Data.Greskell.GraphSON.FromGraphSON' class.
-- 
-- @since 0.1.2.0
newtype GValue = GValue { GValue -> GraphSON GValueBody
unGValue :: GraphSON GValueBody }
                 deriving (Int -> GValue -> ShowS
[GValue] -> ShowS
GValue -> String
(Int -> GValue -> ShowS)
-> (GValue -> String) -> ([GValue] -> ShowS) -> Show GValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GValue] -> ShowS
$cshowList :: [GValue] -> ShowS
show :: GValue -> String
$cshow :: GValue -> String
showsPrec :: Int -> GValue -> ShowS
$cshowsPrec :: Int -> GValue -> ShowS
Show,GValue -> GValue -> Bool
(GValue -> GValue -> Bool)
-> (GValue -> GValue -> Bool) -> Eq GValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GValue -> GValue -> Bool
$c/= :: GValue -> GValue -> Bool
== :: GValue -> GValue -> Bool
$c== :: GValue -> GValue -> Bool
Eq,(forall x. GValue -> Rep GValue x)
-> (forall x. Rep GValue x -> GValue) -> Generic GValue
forall x. Rep GValue x -> GValue
forall x. GValue -> Rep GValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GValue x -> GValue
$cfrom :: forall x. GValue -> Rep GValue x
Generic)

instance Hashable GValue

-- | 'GValue' without the top-level 'GraphSON' wrapper.
--
-- @since 0.1.2.0
data GValueBody =
    GObject !(HashMap Text GValue)
  | GArray !(Vector GValue)
  | GString !Text
  | GNumber !Scientific
  | GBool !Bool
  | GNull
  deriving (Int -> GValueBody -> ShowS
[GValueBody] -> ShowS
GValueBody -> String
(Int -> GValueBody -> ShowS)
-> (GValueBody -> String)
-> ([GValueBody] -> ShowS)
-> Show GValueBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GValueBody] -> ShowS
$cshowList :: [GValueBody] -> ShowS
show :: GValueBody -> String
$cshow :: GValueBody -> String
showsPrec :: Int -> GValueBody -> ShowS
$cshowsPrec :: Int -> GValueBody -> ShowS
Show,GValueBody -> GValueBody -> Bool
(GValueBody -> GValueBody -> Bool)
-> (GValueBody -> GValueBody -> Bool) -> Eq GValueBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GValueBody -> GValueBody -> Bool
$c/= :: GValueBody -> GValueBody -> Bool
== :: GValueBody -> GValueBody -> Bool
$c== :: GValueBody -> GValueBody -> Bool
Eq,(forall x. GValueBody -> Rep GValueBody x)
-> (forall x. Rep GValueBody x -> GValueBody) -> Generic GValueBody
forall x. Rep GValueBody x -> GValueBody
forall x. GValueBody -> Rep GValueBody x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GValueBody x -> GValueBody
$cfrom :: forall x. GValueBody -> Rep GValueBody x
Generic)

instance Hashable GValueBody where
-- See Data.Aeson.Types.Internal
  hashWithSalt :: Int -> GValueBody -> Int
hashWithSalt Int
s (GObject HashMap Text GValue
o) = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
0::Int) Int -> HashMap Text GValue -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` HashMap Text GValue
o
  hashWithSalt Int
s (GArray Vector GValue
a) = (Int -> GValue -> Int) -> Int -> Vector GValue -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> GValue -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt (Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
1::Int)) Vector GValue
a
  hashWithSalt Int
s (GString Text
str) = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
2::Int) Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Text
str
  hashWithSalt Int
s (GNumber Scientific
n) = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
3::Int) Int -> Scientific -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Scientific
n
  hashWithSalt Int
s (GBool Bool
b) = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
4::Int) Int -> Bool -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Bool
b
  hashWithSalt Int
s GValueBody
GNull = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
5::Int)

-- | Parse 'GraphSON' wrappers recursively in 'Value', making it into
-- 'GValue'.
instance FromJSON GValue where
  parseJSON :: Value -> Parser GValue
parseJSON Value
input = do
    GraphSON Value
gv <- Value -> Parser (GraphSON Value)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
input
    GValueBody
recursed_value <- Value -> Parser GValueBody
recurse (Value -> Parser GValueBody) -> Value -> Parser GValueBody
forall a b. (a -> b) -> a -> b
$ GraphSON Value -> Value
forall v. GraphSON v -> v
gsonValue GraphSON Value
gv
    GValue -> Parser GValue
forall (m :: * -> *) a. Monad m => a -> m a
return (GValue -> Parser GValue) -> GValue -> Parser GValue
forall a b. (a -> b) -> a -> b
$ GraphSON GValueBody -> GValue
GValue (GraphSON GValueBody -> GValue) -> GraphSON GValueBody -> GValue
forall a b. (a -> b) -> a -> b
$ GraphSON Value
gv { gsonValue :: GValueBody
gsonValue = GValueBody
recursed_value }
    where
      recurse :: Value -> Parser GValueBody
      recurse :: Value -> Parser GValueBody
recurse (Object Object
o) = HashMap Text GValue -> GValueBody
GObject (HashMap Text GValue -> GValueBody)
-> Parser (HashMap Text GValue) -> Parser GValueBody
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser GValue) -> Object -> Parser (HashMap Text GValue)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser GValue
forall a. FromJSON a => Value -> Parser a
parseJSON Object
o
      recurse (Array Array
a) = Vector GValue -> GValueBody
GArray (Vector GValue -> GValueBody)
-> Parser (Vector GValue) -> Parser GValueBody
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser GValue) -> Array -> Parser (Vector GValue)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser GValue
forall a. FromJSON a => Value -> Parser a
parseJSON Array
a
      recurse (String Text
s) = GValueBody -> Parser GValueBody
forall (m :: * -> *) a. Monad m => a -> m a
return (GValueBody -> Parser GValueBody)
-> GValueBody -> Parser GValueBody
forall a b. (a -> b) -> a -> b
$ Text -> GValueBody
GString Text
s
      recurse (Number Scientific
n) = GValueBody -> Parser GValueBody
forall (m :: * -> *) a. Monad m => a -> m a
return (GValueBody -> Parser GValueBody)
-> GValueBody -> Parser GValueBody
forall a b. (a -> b) -> a -> b
$ Scientific -> GValueBody
GNumber Scientific
n
      recurse (Bool Bool
b) = GValueBody -> Parser GValueBody
forall (m :: * -> *) a. Monad m => a -> m a
return (GValueBody -> Parser GValueBody)
-> GValueBody -> Parser GValueBody
forall a b. (a -> b) -> a -> b
$ Bool -> GValueBody
GBool Bool
b
      recurse Value
Null = GValueBody -> Parser GValueBody
forall (m :: * -> *) a. Monad m => a -> m a
return GValueBody
GNull

-- | Reconstruct 'Value' from 'GValue'. It preserves all GraphSON
-- wrappers.
instance ToJSON GValue where
  toJSON :: GValue -> Value
toJSON (GValue GraphSON GValueBody
gson_body) = GraphSON Value -> Value
forall a. ToJSON a => a -> Value
toJSON (GraphSON Value -> Value) -> GraphSON Value -> Value
forall a b. (a -> b) -> a -> b
$ (GValueBody -> Value) -> GraphSON GValueBody -> GraphSON Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GValueBody -> Value
forall a. ToJSON a => a -> Value
toJSON GraphSON GValueBody
gson_body

instance ToJSON GValueBody where
  toJSON :: GValueBody -> Value
toJSON (GObject HashMap Text GValue
o) = HashMap Text GValue -> Value
forall a. ToJSON a => a -> Value
toJSON HashMap Text GValue
o
  toJSON (GArray Vector GValue
a) = Vector GValue -> Value
forall a. ToJSON a => a -> Value
toJSON Vector GValue
a
  toJSON (GString Text
s) = Text -> Value
String Text
s
  toJSON (GNumber Scientific
n) = Scientific -> Value
Number Scientific
n
  toJSON (GBool Bool
b) = Bool -> Value
Bool Bool
b
  toJSON GValueBody
GNull = Value
Null

-- | Create a 'GValue' without \"@type\" field.
-- 
-- @since 0.1.2.0
nonTypedGValue :: GValueBody -> GValue
nonTypedGValue :: GValueBody -> GValue
nonTypedGValue = GraphSON GValueBody -> GValue
GValue (GraphSON GValueBody -> GValue)
-> (GValueBody -> GraphSON GValueBody) -> GValueBody -> GValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GValueBody -> GraphSON GValueBody
forall v. v -> GraphSON v
nonTypedGraphSON

-- | Create a 'GValue' with the given \"@type\" field.
--
-- @since 0.1.2.0
typedGValue' :: Text -- ^ \"@type\" field.
             -> GValueBody -> GValue
typedGValue' :: Text -> GValueBody -> GValue
typedGValue' Text
t GValueBody
b = GraphSON GValueBody -> GValue
GValue (GraphSON GValueBody -> GValue) -> GraphSON GValueBody -> GValue
forall a b. (a -> b) -> a -> b
$ Text -> GValueBody -> GraphSON GValueBody
forall v. Text -> v -> GraphSON v
typedGraphSON' Text
t GValueBody
b


-- $caveat_decon
--
-- __In most cases, you should not use these deconstructors.__ That is
-- because internal structure of 'GValue' may vary depending on the
-- Gremlin server instance and its serializer. You should instead use
-- parsers based on 'Data.Greskell.GraphSON.FromGraphSON' class, such
-- as 'Data.Greskell.GraphSON.parseEither'.
--
-- If you are implementing parsers for GraphSON objects described in
-- Gremlin IO Reference
-- (<http://tinkerpop.apache.org/docs/current/dev/io/>), you may use
-- these descructors.
--

-- | Remove all 'GraphSON' wrappers recursively from 'GValue'.
--
-- @since 0.1.2.0
unwrapAll :: GValue -> Value
unwrapAll :: GValue -> Value
unwrapAll = (GValue -> Value) -> GValue -> Value
unwrapBase GValue -> Value
unwrapAll

-- | Remove the top-level 'GraphSON' wrapper, but leave other wrappers
-- as-is. The remaining wrappers are reconstructed by 'toJSON' to make
-- them into 'Value'.
--
-- @since 0.1.2.0
unwrapOne :: GValue -> Value
unwrapOne :: GValue -> Value
unwrapOne = (GValue -> Value) -> GValue -> Value
unwrapBase GValue -> Value
forall a. ToJSON a => a -> Value
toJSON

unwrapBase :: (GValue -> Value) -> GValue -> Value
unwrapBase :: (GValue -> Value) -> GValue -> Value
unwrapBase GValue -> Value
mapChild (GValue GraphSON GValueBody
gson_body) = GValueBody -> Value
unwrapBody (GValueBody -> Value) -> GValueBody -> Value
forall a b. (a -> b) -> a -> b
$ GraphSON GValueBody -> GValueBody
forall v. GraphSON v -> v
gsonValue GraphSON GValueBody
gson_body
  where
    unwrapBody :: GValueBody -> Value
unwrapBody GValueBody
GNull = Value
Null
    unwrapBody (GBool Bool
b) = Bool -> Value
Bool Bool
b
    unwrapBody (GNumber Scientific
n) = Scientific -> Value
Number Scientific
n
    unwrapBody (GString Text
s) = Text -> Value
String Text
s
    unwrapBody (GArray Vector GValue
a) = Array -> Value
Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ (GValue -> Value) -> Vector GValue -> Array
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GValue -> Value
mapChild Vector GValue
a
    unwrapBody (GObject HashMap Text GValue
o) = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ (GValue -> Value) -> HashMap Text GValue -> Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GValue -> Value
mapChild HashMap Text GValue
o

-- | Get the 'GValueBody' from 'GValue'.
--
-- @since 0.1.2.0
gValueBody :: GValue -> GValueBody
gValueBody :: GValue -> GValueBody
gValueBody = GraphSON GValueBody -> GValueBody
forall v. GraphSON v -> v
gsonValue (GraphSON GValueBody -> GValueBody)
-> (GValue -> GraphSON GValueBody) -> GValue -> GValueBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GValue -> GraphSON GValueBody
unGValue

-- | Get the 'gsonType' field from 'GValue'.
--
-- @since 0.1.2.0
gValueType :: GValue -> Maybe Text
gValueType :: GValue -> Maybe Text
gValueType = GraphSON GValueBody -> Maybe Text
forall v. GraphSON v -> Maybe Text
gsonType (GraphSON GValueBody -> Maybe Text)
-> (GValue -> GraphSON GValueBody) -> GValue -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GValue -> GraphSON GValueBody
unGValue