{-# 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
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. 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, Int -> GValue -> ShowS
[GValue] -> ShowS
GValue -> String
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)

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
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. 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, Int -> GValueBody -> ShowS
[GValueBody] -> ShowS
GValueBody -> String
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)

instance Hashable GValueBody where
-- See Data.Aeson.Types.Internal
  hashWithSalt :: Int -> GValueBody -> Int
hashWithSalt Int
s (GObject KeyMap GValue
o)   = Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
0::Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` KeyMap GValue
o
  hashWithSalt Int
s (GArray Vector GValue
a)    = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Hashable a => Int -> a -> Int
hashWithSalt (Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
1::Int)) Vector GValue
a
  hashWithSalt Int
s (GString Text
str) = Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
2::Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Text
str
  hashWithSalt Int
s (GNumber Scientific
n)   = Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
3::Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Scientific
n
  hashWithSalt Int
s (GBool Bool
b)     = Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
4::Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Bool
b
  hashWithSalt Int
s GValueBody
GNull         = Int
s 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 <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
input
    GValueBody
recursed_value <- Value -> Parser GValueBody
recurse forall a b. (a -> b) -> a -> b
$ forall v. GraphSON v -> v
gsonValue GraphSON Value
gv
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ GraphSON GValueBody -> GValue
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) = KeyMap GValue -> GValueBody
GObject forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. FromJSON a => Value -> Parser a
parseJSON Object
o
      recurse (Array Array
a)  = Vector GValue -> GValueBody
GArray forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. FromJSON a => Value -> Parser a
parseJSON Array
a
      recurse (String Text
s) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> GValueBody
GString Text
s
      recurse (Number Scientific
n) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Scientific -> GValueBody
GNumber Scientific
n
      recurse (Bool Bool
b)   = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> GValueBody
GBool Bool
b
      recurse Value
Null       = 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) = forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToJSON a => a -> Value
toJSON GraphSON GValueBody
gson_body

instance ToJSON GValueBody where
  toJSON :: GValueBody -> Value
toJSON (GObject KeyMap GValue
o) = forall a. ToJSON a => a -> Value
toJSON KeyMap GValue
o
  toJSON (GArray Vector GValue
a)  = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a b. (a -> b) -> a -> b
$ 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 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 forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> 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 forall a b. (a -> b) -> a -> 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 = forall v. GraphSON v -> v
gsonValue 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 = forall v. GraphSON v -> Maybe Text
gsonType forall b c a. (b -> c) -> (a -> b) -> a -> c
. GValue -> GraphSON GValueBody
unGValue