{-# 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                  (FromJSON (parseJSON), ToJSON (toJSON), Value (..))
import           Data.Aeson.KeyMap           (KeyMap)
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 (GraphSON (..), nonTypedGraphSON, typedGraphSON')

-- | 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 (GValue -> GValue -> Bool
(GValue -> GValue -> Bool)
-> (GValue -> GValue -> Bool) -> Eq GValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GValue -> GValue -> Bool
== :: GValue -> GValue -> Bool
$c/= :: GValue -> GValue -> Bool
/= :: 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
$cfrom :: forall x. GValue -> Rep GValue x
from :: forall x. GValue -> Rep GValue x
$cto :: forall x. Rep GValue x -> GValue
to :: forall x. Rep GValue x -> GValue
Generic, 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
$cshowsPrec :: Int -> GValue -> ShowS
showsPrec :: Int -> GValue -> ShowS
$cshow :: GValue -> String
show :: GValue -> String
$cshowList :: [GValue] -> ShowS
showList :: [GValue] -> ShowS
Show)

instance Hashable GValue

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

instance Hashable GValueBody where
-- See Data.Aeson.Types.Internal
  hashWithSalt :: Int -> GValueBody -> Int
hashWithSalt Int
s (GObject KeyMap GValue
o)   = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
0::Int) Int -> KeyMap GValue -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` KeyMap GValue
o
  hashWithSalt Int
s (GArray Vector GValue
a)    = (Int -> GValue -> Int) -> Int -> Vector GValue -> Int
forall b a. (b -> a -> b) -> b -> Vector a -> b
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 a. a -> Parser a
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 = recursed_value }
    where
      recurse :: Value -> Parser GValueBody
      recurse :: Value -> Parser GValueBody
recurse (Object Object
o) = KeyMap GValue -> GValueBody
GObject (KeyMap GValue -> GValueBody)
-> Parser (KeyMap GValue) -> Parser GValueBody
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser GValue) -> Object -> Parser (KeyMap GValue)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> KeyMap a -> f (KeyMap 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Vector a -> f (Vector b)
traverse Value -> Parser GValue
forall a. FromJSON a => Value -> Parser a
parseJSON Array
a
      recurse (String Text
s) = GValueBody -> Parser GValueBody
forall a. a -> Parser a
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 a. a -> Parser a
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 a. a -> Parser a
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 a. a -> Parser a
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 a b. (a -> b) -> GraphSON a -> GraphSON b
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 KeyMap GValue
o) = KeyMap GValue -> Value
forall a. ToJSON a => a -> Value
toJSON KeyMap 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 a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GValue -> Value
mapChild Vector GValue
a
    unwrapBody (GObject KeyMap GValue
o) = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ (GValue -> Value) -> KeyMap GValue -> Object
forall a b. (a -> b) -> KeyMap a -> KeyMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GValue -> Value
mapChild KeyMap 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