{-# 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
{ GraphSON v -> Maybe Text
gsonType :: Maybe Text,
GraphSON v -> v
gsonValue :: v
}
deriving (Int -> GraphSON v -> ShowS
[GraphSON v] -> ShowS
GraphSON v -> String
(Int -> GraphSON v -> ShowS)
-> (GraphSON v -> String)
-> ([GraphSON v] -> ShowS)
-> Show (GraphSON v)
forall v. Show v => Int -> GraphSON v -> ShowS
forall v. Show v => [GraphSON v] -> ShowS
forall v. Show v => GraphSON v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GraphSON v] -> ShowS
$cshowList :: forall v. Show v => [GraphSON v] -> ShowS
show :: GraphSON v -> String
$cshow :: forall v. Show v => GraphSON v -> String
showsPrec :: Int -> GraphSON v -> ShowS
$cshowsPrec :: forall v. Show v => Int -> GraphSON v -> ShowS
Show,GraphSON v -> GraphSON v -> Bool
(GraphSON v -> GraphSON v -> Bool)
-> (GraphSON v -> GraphSON v -> Bool) -> Eq (GraphSON v)
forall v. Eq v => GraphSON v -> GraphSON v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GraphSON v -> GraphSON v -> Bool
$c/= :: forall v. Eq v => GraphSON v -> GraphSON v -> Bool
== :: GraphSON v -> GraphSON v -> Bool
$c== :: forall v. Eq v => GraphSON v -> GraphSON v -> Bool
Eq,Eq (GraphSON v)
Eq (GraphSON v)
-> (GraphSON v -> GraphSON v -> Ordering)
-> (GraphSON v -> GraphSON v -> Bool)
-> (GraphSON v -> GraphSON v -> Bool)
-> (GraphSON v -> GraphSON v -> Bool)
-> (GraphSON v -> GraphSON v -> Bool)
-> (GraphSON v -> GraphSON v -> GraphSON v)
-> (GraphSON v -> GraphSON v -> GraphSON v)
-> Ord (GraphSON v)
GraphSON v -> GraphSON v -> Bool
GraphSON v -> GraphSON v -> Ordering
GraphSON v -> GraphSON v -> GraphSON v
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall v. Ord v => Eq (GraphSON v)
forall v. Ord v => GraphSON v -> GraphSON v -> Bool
forall v. Ord v => GraphSON v -> GraphSON v -> Ordering
forall v. Ord v => GraphSON v -> GraphSON v -> GraphSON v
min :: GraphSON v -> GraphSON v -> GraphSON v
$cmin :: forall v. Ord v => GraphSON v -> GraphSON v -> GraphSON v
max :: GraphSON v -> GraphSON v -> GraphSON v
$cmax :: forall v. Ord v => GraphSON v -> GraphSON v -> GraphSON v
>= :: GraphSON v -> GraphSON v -> Bool
$c>= :: forall v. Ord v => GraphSON v -> GraphSON v -> Bool
> :: GraphSON v -> GraphSON v -> Bool
$c> :: forall v. Ord v => GraphSON v -> GraphSON v -> Bool
<= :: GraphSON v -> GraphSON v -> Bool
$c<= :: forall v. Ord v => GraphSON v -> GraphSON v -> Bool
< :: GraphSON v -> GraphSON v -> Bool
$c< :: forall v. Ord v => GraphSON v -> GraphSON v -> Bool
compare :: GraphSON v -> GraphSON v -> Ordering
$ccompare :: forall v. Ord v => GraphSON v -> GraphSON v -> Ordering
$cp1Ord :: forall v. Ord v => Eq (GraphSON v)
Ord,(forall x. GraphSON v -> Rep (GraphSON v) x)
-> (forall x. Rep (GraphSON v) x -> GraphSON v)
-> Generic (GraphSON v)
forall x. Rep (GraphSON v) x -> GraphSON v
forall x. GraphSON v -> Rep (GraphSON v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v x. Rep (GraphSON v) x -> GraphSON v
forall v x. GraphSON v -> Rep (GraphSON v) x
$cto :: forall v x. Rep (GraphSON v) x -> GraphSON v
$cfrom :: forall v x. GraphSON v -> Rep (GraphSON v) x
Generic)
instance Functor GraphSON where
fmap :: (a -> b) -> GraphSON a -> GraphSON b
fmap a -> b
f GraphSON a
gs = GraphSON a
gs { gsonValue :: b
gsonValue = a -> b
f (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ GraphSON a -> a
forall v. GraphSON v -> v
gsonValue GraphSON a
gs }
instance Foldable GraphSON where
foldr :: (a -> b -> b) -> b -> GraphSON a -> b
foldr a -> b -> b
f b
start GraphSON a
gs = a -> b -> b
f (GraphSON a -> a
forall v. GraphSON v -> v
gsonValue GraphSON a
gs) b
start
instance Traversable GraphSON where
traverse :: (a -> f b) -> GraphSON a -> f (GraphSON b)
traverse a -> f b
f GraphSON a
gs = (b -> GraphSON b) -> f b -> f (GraphSON b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b
v -> GraphSON a
gs { gsonValue :: b
gsonValue = b
v }) (f b -> f (GraphSON b)) -> f b -> f (GraphSON b)
forall a b. (a -> b) -> a -> b
$ a -> f b
f (a -> f b) -> a -> f b
forall a b. (a -> b) -> a -> b
$ GraphSON a -> a
forall v. GraphSON v -> v
gsonValue GraphSON a
gs
instance Hashable v => Hashable (GraphSON v)
instance ToJSON v => ToJSON (GraphSON v) where
toJSON :: GraphSON v -> Value
toJSON GraphSON v
gson = case GraphSON v -> Maybe Text
forall v. GraphSON v -> Maybe Text
gsonType GraphSON v
gson of
Maybe Text
Nothing -> v -> Value
forall a. ToJSON a => a -> Value
toJSON (v -> Value) -> v -> Value
forall a b. (a -> b) -> a -> b
$ GraphSON v -> v
forall v. GraphSON v -> v
gsonValue GraphSON v
gson
Just Text
t -> [Pair] -> Value
object [ Text
"@type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
t,
Text
"@value" Text -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= GraphSON v -> v
forall v. GraphSON v -> v
gsonValue GraphSON v
gson
]
instance FromJSON v => FromJSON (GraphSON v) where
parseJSON :: Value -> Parser (GraphSON v)
parseJSON v :: Value
v@(Object Object
o) = do
if Object -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Object
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
2
then Value -> Parser (GraphSON v)
forall v. FromJSON v => Value -> Parser (GraphSON v)
parseDirect Value
v
else do
Maybe Text
mtype <- Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Aeson..:! Text
"@type"
Maybe v
mvalue <- Object
o Object -> Text -> Parser (Maybe v)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Aeson..:! Text
"@value"
Parser (GraphSON v)
-> (GraphSON v -> Parser (GraphSON v))
-> Maybe (GraphSON v)
-> Parser (GraphSON v)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Value -> Parser (GraphSON v)
forall v. FromJSON v => Value -> Parser (GraphSON v)
parseDirect Value
v) GraphSON v -> Parser (GraphSON v)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (GraphSON v) -> Parser (GraphSON v))
-> Maybe (GraphSON v) -> Parser (GraphSON v)
forall a b. (a -> b) -> a -> b
$ Text -> v -> GraphSON v
forall v. Text -> v -> GraphSON v
typedGraphSON' (Text -> v -> GraphSON v) -> Maybe Text -> Maybe (v -> GraphSON v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
mtype Maybe (v -> GraphSON v) -> Maybe v -> Maybe (GraphSON v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe v
mvalue
parseJSON Value
v = Value -> Parser (GraphSON v)
forall v. FromJSON v => Value -> Parser (GraphSON v)
parseDirect Value
v
parseDirect :: FromJSON v => Value -> Parser (GraphSON v)
parseDirect :: Value -> Parser (GraphSON v)
parseDirect Value
v = Maybe Text -> v -> GraphSON v
forall v. Maybe Text -> v -> GraphSON v
GraphSON Maybe Text
forall a. Maybe a
Nothing (v -> GraphSON v) -> Parser v -> Parser (GraphSON v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser v
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
nonTypedGraphSON :: v -> GraphSON v
nonTypedGraphSON :: v -> GraphSON v
nonTypedGraphSON = Maybe Text -> v -> GraphSON v
forall v. Maybe Text -> v -> GraphSON v
GraphSON Maybe Text
forall a. Maybe a
Nothing
typedGraphSON :: GraphSONTyped v => v -> GraphSON v
typedGraphSON :: v -> GraphSON v
typedGraphSON v
v = Maybe Text -> v -> GraphSON v
forall v. Maybe Text -> v -> GraphSON v
GraphSON (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ v -> Text
forall a. GraphSONTyped a => a -> Text
gsonTypeFor v
v) v
v
typedGraphSON' :: Text -> v -> GraphSON v
typedGraphSON' :: Text -> v -> GraphSON v
typedGraphSON' Text
t = Maybe Text -> v -> GraphSON v
forall v. Maybe Text -> v -> GraphSON v
GraphSON (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t)
parseTypedGraphSON :: (GraphSONTyped v, FromJSON v) => Value -> Parser (GraphSON v)
parseTypedGraphSON :: Value -> Parser (GraphSON v)
parseTypedGraphSON Value
v = (String -> Parser (GraphSON v))
-> (GraphSON v -> Parser (GraphSON v))
-> Either String (GraphSON v)
-> Parser (GraphSON v)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser (GraphSON v)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail GraphSON v -> Parser (GraphSON v)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (GraphSON v) -> Parser (GraphSON v))
-> Parser (Either String (GraphSON v)) -> Parser (GraphSON v)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser (Either String (GraphSON v))
forall v.
(GraphSONTyped v, FromJSON v) =>
Value -> Parser (Either String (GraphSON v))
parseTypedGraphSON' Value
v
parseTypedGraphSON' :: (GraphSONTyped v, FromJSON v) => Value -> Parser (Either String (GraphSON v))
parseTypedGraphSON' :: Value -> Parser (Either String (GraphSON v))
parseTypedGraphSON' Value
v = do
GraphSON Value
graphsonv <- Value -> Parser (GraphSON Value)
parseGraphSONPlain Value
v
case GraphSON Value -> Maybe Text
forall v. GraphSON v -> Maybe Text
gsonType GraphSON Value
graphsonv of
Maybe Text
Nothing -> Either String (GraphSON v) -> Parser (Either String (GraphSON v))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (GraphSON v) -> Parser (Either String (GraphSON v)))
-> Either String (GraphSON v)
-> Parser (Either String (GraphSON v))
forall a b. (a -> b) -> a -> b
$ String -> Either String (GraphSON v)
forall a b. a -> Either a b
Left (String
"Not a valid typed JSON object.")
Just Text
got_type -> do
v
goal <- Value -> Parser v
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser v) -> Value -> Parser v
forall a b. (a -> b) -> a -> b
$ GraphSON Value -> Value
forall v. GraphSON v -> v
gsonValue GraphSON Value
graphsonv
let exp_type :: Text
exp_type = v -> Text
forall a. GraphSONTyped a => a -> Text
gsonTypeFor v
goal
Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
got_type Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
exp_type) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Expected @type of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
exp_type String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", but got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
got_type)
Either String (GraphSON v) -> Parser (Either String (GraphSON v))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (GraphSON v) -> Parser (Either String (GraphSON v)))
-> Either String (GraphSON v)
-> Parser (Either String (GraphSON v))
forall a b. (a -> b) -> a -> b
$ GraphSON v -> Either String (GraphSON v)
forall a b. b -> Either a b
Right (GraphSON v -> Either String (GraphSON v))
-> GraphSON v -> Either String (GraphSON v)
forall a b. (a -> b) -> a -> b
$ GraphSON Value
graphsonv { gsonValue :: v
gsonValue = v
goal }
where
parseGraphSONPlain :: Value -> Parser (GraphSON Value)
parseGraphSONPlain :: Value -> Parser (GraphSON Value)
parseGraphSONPlain = Value -> Parser (GraphSON Value)
forall a. FromJSON a => Value -> Parser a
parseJSON