{-# 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 ( ToJSON(toJSON), FromJSON(parseJSON), 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 ( 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 { unGValue :: GraphSON GValueBody } deriving (Show,Eq,Generic) 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 (Show,Eq,Generic) 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