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