{-# LANGUAGE DeriveGeneric #-}
module Data.Greskell.GraphSON.GValue
(
GValue(..),
GValueBody(..),
nonTypedGValue,
typedGValue',
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(..)
)
newtype GValue = GValue { unGValue :: GraphSON GValueBody }
deriving (Show,Eq,Generic)
instance Hashable GValue
data GValueBody =
GObject !(HashMap Text GValue)
| GArray !(Vector GValue)
| GString !Text
| GNumber !Scientific
| GBool !Bool
| GNull
deriving (Show,Eq,Generic)
instance Hashable GValueBody where
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)
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
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
nonTypedGValue :: GValueBody -> GValue
nonTypedGValue = GValue . nonTypedGraphSON
typedGValue' :: Text
-> GValueBody -> GValue
typedGValue' t b = GValue $ typedGraphSON' t b
unwrapAll :: GValue -> Value
unwrapAll = unwrapBase unwrapAll
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
gValueBody :: GValue -> GValueBody
gValueBody = gsonValue . unGValue
gValueType :: GValue -> Maybe Text
gValueType = gsonType . unGValue