{-# LANGUAGE DeriveGeneric #-} -- | -- Module: Data.Greskell.GraphSON.GValue -- Description: Aeson Value with GraphSON wrappers -- Maintainer: Toshio Ito -- -- __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 { unGValue :: GraphSON GValueBody } deriving (Eq, Generic, 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 (Eq, Generic, Show) instance Hashable GValueBody where -- See Data.Aeson.Types.Internal hashWithSalt s (GObject o) = s `hashWithSalt` (0::Int) `hashWithSalt` o hashWithSalt s (GArray a) = foldl' hashWithSalt (s `hashWithSalt` (1::Int)) a hashWithSalt s (GString str) = s `hashWithSalt` (2::Int) `hashWithSalt` str hashWithSalt s (GNumber n) = s `hashWithSalt` (3::Int) `hashWithSalt` n hashWithSalt s (GBool b) = s `hashWithSalt` (4::Int) `hashWithSalt` b hashWithSalt s GNull = s `hashWithSalt` (5::Int) -- | Parse 'GraphSON' wrappers recursively in 'Value', making it into -- 'GValue'. instance FromJSON GValue where parseJSON input = do gv <- parseJSON input recursed_value <- recurse $ gsonValue gv return $ GValue $ gv { gsonValue = recursed_value } where recurse :: Value -> Parser GValueBody recurse (Object o) = GObject <$> traverse parseJSON o recurse (Array a) = GArray <$> traverse parseJSON a recurse (String s) = return $ GString s recurse (Number n) = return $ GNumber n recurse (Bool b) = return $ GBool b recurse Null = return GNull -- | Reconstruct 'Value' from 'GValue'. It preserves all GraphSON -- wrappers. instance ToJSON GValue where toJSON (GValue gson_body) = toJSON $ fmap toJSON gson_body instance ToJSON GValueBody where toJSON (GObject o) = toJSON o toJSON (GArray a) = toJSON a toJSON (GString s) = String s toJSON (GNumber n) = Number n toJSON (GBool b) = Bool b toJSON GNull = Null -- | Create a 'GValue' without \"@type\" field. -- -- @since 0.1.2.0 nonTypedGValue :: GValueBody -> GValue nonTypedGValue = GValue . nonTypedGraphSON -- | Create a 'GValue' with the given \"@type\" field. -- -- @since 0.1.2.0 typedGValue' :: Text -- ^ \"@type\" field. -> GValueBody -> GValue typedGValue' t b = GValue $ typedGraphSON' t 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 -- (), you may use -- these descructors. -- -- | Remove all 'GraphSON' wrappers recursively from 'GValue'. -- -- @since 0.1.2.0 unwrapAll :: GValue -> Value unwrapAll = unwrapBase 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 = unwrapBase toJSON unwrapBase :: (GValue -> Value) -> GValue -> Value unwrapBase mapChild (GValue gson_body) = unwrapBody $ gsonValue gson_body where unwrapBody GNull = Null unwrapBody (GBool b) = Bool b unwrapBody (GNumber n) = Number n unwrapBody (GString s) = String s unwrapBody (GArray a) = Array $ fmap mapChild a unwrapBody (GObject o) = Object $ fmap mapChild o -- | Get the 'GValueBody' from 'GValue'. -- -- @since 0.1.2.0 gValueBody :: GValue -> GValueBody gValueBody = gsonValue . unGValue -- | Get the 'gsonType' field from 'GValue'. -- -- @since 0.1.2.0 gValueType :: GValue -> Maybe Text gValueType = gsonType . unGValue