{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}
module Data.Greskell.GraphSON.Core
( GraphSON(..),
nonTypedGraphSON,
typedGraphSON,
typedGraphSON',
parseTypedGraphSON,
parseTypedGraphSON'
) where
import Control.Applicative ((<$>), (<*>))
import Control.Monad (when)
import Data.Aeson
( ToJSON(toJSON), FromJSON(parseJSON),
object, (.=), Value(..)
)
import qualified Data.Aeson as Aeson
import Data.Aeson.Types (Parser)
import Data.Foldable (Foldable(foldr))
import Data.Hashable (Hashable(..))
import Data.Text (Text)
import Data.Traversable (Traversable(traverse))
import GHC.Generics (Generic)
import Data.Greskell.GraphSON.GraphSONTyped (GraphSONTyped(..))
data GraphSON v =
GraphSON
{ gsonType :: Maybe Text,
gsonValue :: v
}
deriving (Show,Eq,Ord,Generic)
instance Functor GraphSON where
fmap f gs = gs { gsonValue = f $ gsonValue gs }
instance Foldable GraphSON where
foldr f start gs = f (gsonValue gs) start
instance Traversable GraphSON where
traverse f gs = fmap (\v -> gs { gsonValue = v }) $ f $ gsonValue gs
instance Hashable v => Hashable (GraphSON v)
instance ToJSON v => ToJSON (GraphSON v) where
toJSON gson = case gsonType gson of
Nothing -> toJSON $ gsonValue gson
Just t -> object [ "@type" .= t,
"@value" .= gsonValue gson
]
instance FromJSON v => FromJSON (GraphSON v) where
parseJSON v@(Object o) = do
if length o /= 2
then parseDirect v
else do
mtype <- o Aeson..:! "@type"
mvalue <- o Aeson..:! "@value"
maybe (parseDirect v) return $ typedGraphSON' <$> mtype <*> mvalue
parseJSON v = parseDirect v
parseDirect :: FromJSON v => Value -> Parser (GraphSON v)
parseDirect v = GraphSON Nothing <$> parseJSON v
nonTypedGraphSON :: v -> GraphSON v
nonTypedGraphSON = GraphSON Nothing
typedGraphSON :: GraphSONTyped v => v -> GraphSON v
typedGraphSON v = GraphSON (Just $ gsonTypeFor v) v
typedGraphSON' :: Text -> v -> GraphSON v
typedGraphSON' t = GraphSON (Just t)
parseTypedGraphSON :: (GraphSONTyped v, FromJSON v) => Value -> Parser (GraphSON v)
parseTypedGraphSON v = either fail return =<< parseTypedGraphSON' v
parseTypedGraphSON' :: (GraphSONTyped v, FromJSON v) => Value -> Parser (Either String (GraphSON v))
parseTypedGraphSON' v = do
graphsonv <- parseGraphSONPlain v
case gsonType graphsonv of
Nothing -> return $ Left ("Not a valid typed JSON object.")
Just got_type -> do
goal <- parseJSON $ gsonValue graphsonv
let exp_type = gsonTypeFor goal
when (got_type /= exp_type) $ do
fail ("Expected @type of " ++ show exp_type ++ ", but got " ++ show got_type)
return $ Right $ graphsonv { gsonValue = goal }
where
parseGraphSONPlain :: Value -> Parser (GraphSON Value)
parseGraphSONPlain = parseJSON