{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module: Data.Greskell.GraphSON.Core
-- Description:
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- __Internal module.__ Definition of 'GraphSON' type.
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 (..))

-- | Wrapper for \"typed JSON object\" introduced in GraphSON version
-- 2. See http://tinkerpop.apache.org/docs/current/dev/io/#graphson
--
-- This data type is useful for encoding/decoding GraphSON text.
--
-- Note that encoding of the \"g:Map\" type is inconsistent between
-- GraphSON v1 and v2, v3. To handle the encoding, use
-- "Data.Greskell.GMap".
data GraphSON v
  = GraphSON
      { forall v. GraphSON v -> Maybe Text
gsonType  :: Maybe Text
        -- ^ Type ID, corresponding to @\@type@ field.
      , forall v. GraphSON v -> v
gsonValue :: v
        -- ^ Value, correspoding to @\@value@ field.
      }
  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

-- | @since 0.1.2.0
instance Hashable v => Hashable (GraphSON v)

-- | If 'gsonType' is 'Just', the 'GraphSON' is encoded as a typed
-- JSON object. If 'gsonType' is 'Nothing', the 'gsonValue' is
-- directly encoded.
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
                     ]

-- | If the given 'Value' is a typed JSON object, 'gsonType' field of
-- the result is 'Just'. Otherwise, the given 'Value' is directly
-- parsed into 'gsonValue', and 'gsonType' is 'Nothing'.
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


-- | Create a 'GraphSON' without 'gsonType'.
nonTypedGraphSON :: v -> GraphSON v
nonTypedGraphSON :: forall v. v -> GraphSON v
nonTypedGraphSON = forall v. Maybe Text -> v -> GraphSON v
GraphSON forall a. Maybe a
Nothing

-- | Create a 'GraphSON' with its type ID.
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

-- | Create a 'GraphSON' with the given type ID.
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)


-- | Parse @GraphSON v@, but it checks 'gsonType'. If 'gsonType' is
-- 'Nothing' or it's not equal to 'gsonTypeFor', the 'Parser' fails.
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

-- | Note: this function is not exported because I don't need it for
-- now. If you need this function, just open an issue.
--
-- Like 'parseTypedGraphSON', but this handles parse errors in a finer
-- granularity.
--
-- - If the given 'Value' is not a typed JSON object, it returns
--   'Left'.
-- - If the given 'Value' is a typed JSON object but it fails to parse
--   the \"\@value\" field, the 'Parser' fails.
-- - If the given 'Value' is a typed JSON object but the \"\@type\"
--   field is not equal to the 'gsonTypeFor' of type @v@, the 'Parser'
--   fails.
-- - Otherwise (if the given 'Value' is a typed JSON object with valid
--   \"\@type\" and \"\@value\" fields,) it returns 'Right'.
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