module Data.Greskell.GraphSON
(
GraphSON(..),
GraphSONTyped(..),
nonTypedGraphSON,
typedGraphSON,
typedGraphSON',
parseTypedGraphSON
) where
import Control.Applicative ((<$>), (<*>))
import Control.Monad (when)
import Data.Aeson (ToJSON(toJSON), FromJSON(parseJSON), object, (.=), Value(Object), (.:?))
import qualified Data.Aeson as Aeson
import Data.Aeson.Types (Parser)
import Data.Foldable (Foldable(foldr))
import qualified Data.HashMap.Lazy as HML
import Data.HashSet (HashSet)
import Data.Int (Int8, Int16, Int32, Int64)
import Data.Scientific (Scientific)
import Data.Text (Text)
import Data.Traversable (Traversable(traverse))
data GraphSON v =
GraphSON
{ gsonType :: Maybe Text,
gsonValue :: v
}
deriving (Show,Eq,Ord)
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
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)
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 .:? "@type"
mvalue <- o .:? "@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
class GraphSONTyped a where
gsonTypeFor :: a -> Text
instance GraphSONTyped Char where
gsonTypeFor _ = "gx:Char"
instance GraphSONTyped Int8 where
gsonTypeFor _ = "gx:Byte"
instance GraphSONTyped Int16 where
gsonTypeFor _ = "gx:Int16"
instance GraphSONTyped Int32 where
gsonTypeFor _ = "g:Int32"
instance GraphSONTyped Int64 where
gsonTypeFor _ = "g:Int64"
instance GraphSONTyped Float where
gsonTypeFor _ = "g:Float"
instance GraphSONTyped Double where
gsonTypeFor _ = "g:Double"
instance GraphSONTyped [a] where
gsonTypeFor _ = "g:List"
instance GraphSONTyped Scientific where
gsonTypeFor _ = "g:Double"
instance GraphSONTyped (HML.HashMap k v) where
gsonTypeFor _ = "g:Map"
instance GraphSONTyped (HashSet a) where
gsonTypeFor _ = "g:Set"
parseTypedGraphSON :: (GraphSONTyped v, FromJSON v) => Value -> Parser (GraphSON v)
parseTypedGraphSON v = checkType =<< parseJSON v
where
checkType gson = do
let exp_type = gsonTypeFor $ gsonValue gson
mgot_type = gsonType gson
when (mgot_type /= Just exp_type) $ do
fail ("Expected @type of " ++ show exp_type ++ ", but got " ++ show mgot_type)
return gson