{-# LANGUAGE OverloadedStrings, DeriveGeneric, TypeFamilies #-}
-- |
-- Module: Data.Greskell.GraphSON
-- Description: Encoding and decoding GraphSON
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- 
module Data.Greskell.GraphSON
       ( -- * GraphSON
         GraphSON(..),
         GraphSONTyped(..),
         -- ** constructors
         nonTypedGraphSON,
         typedGraphSON,
         typedGraphSON',
         -- ** parser support
         parseTypedGraphSON,
         -- * GValue
         GValue,
         GValueBody(..),
         -- ** constructors
         nonTypedGValue,
         typedGValue',
         -- * FromGraphSON
         FromGraphSON(..),
         -- ** parser support
         Parser,
         parseEither,
         parseUnwrapAll,
         parseUnwrapList,
         (.:),
         parseJSONViaGValue
       ) where

import Control.Applicative ((<$>), (<*>), (<|>))
import Control.Monad (when)
import Data.Aeson
  ( ToJSON(toJSON), FromJSON(parseJSON), FromJSONKey,
    object, (.=), Value(..)
  )
import qualified Data.Aeson as Aeson
import Data.Aeson.Types (Parser)
import qualified Data.Aeson.Types as Aeson (parseEither)
import Data.Foldable (Foldable(foldr))
import Data.Functor.Identity (Identity(..))
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import qualified Data.HashMap.Lazy as L (HashMap)
import Data.HashSet (HashSet)
import Data.Hashable (Hashable(..))
import Data.List.NonEmpty (NonEmpty(..))
import Data.Int (Int8, Int16, Int32, Int64)
import qualified Data.IntMap.Lazy as L (IntMap)
import qualified Data.IntMap.Lazy as LIntMap
import Data.IntSet (IntSet)
import qualified Data.Map.Lazy as L (Map)
import qualified Data.Map.Lazy as LMap
import Data.Monoid (mempty)
import qualified Data.Monoid as M
import Data.Ratio (Ratio)
import Data.Scientific (Scientific)
import qualified Data.Semigroup as S
import Data.Sequence (Seq)
import Data.Set (Set)
import Data.Text (Text, unpack)
import qualified Data.Text.Lazy as TL
import Data.Traversable (Traversable(traverse))
import Data.UUID (UUID)
import qualified Data.UUID as UUID
import Data.Vector (Vector)
import Data.Word (Word8, Word16, Word32, Word64)
import Numeric.Natural (Natural)
import GHC.Exts (IsList(Item))
import qualified GHC.Exts as List (fromList, toList)
import GHC.Generics (Generic)

import Data.Greskell.GMap
  ( GMap, GMapEntry, unGMap,
    FlattenedMap, parseToFlattenedMap, parseToGMap, parseToGMapEntry
  )


-- re-exports
import Data.Greskell.GraphSON.Core
import Data.Greskell.GraphSON.GraphSONTyped (GraphSONTyped(..))
import Data.Greskell.GraphSON.GValue


-- $
-- >>> :set -XOverloadedStrings

-- | Types that can be constructed from 'GValue'. This is analogous to
-- 'FromJSON' class.
--
-- Instances of basic types are implemented based on the following
-- rule.
--
-- - Simple scalar types (e.g. 'Int' and 'Text'): use 'parseUnwrapAll'.
-- - List-like types (e.g. @[]@, 'Vector' and 'Set'): use
--   'parseUnwrapList'.
-- - Map-like types (e.g. 'L.HashMap' and 'L.Map'): parse into 'GMap'
--   first, then unwrap the 'GMap' wrapper. That way, all versions of
--   GraphSON formats are handled properly.
-- - Trivial wrapper types (e.g. 'Identity'): just parse the item inside.
-- - Other types: see the individual instance documentation.
--
-- Note that 'Char' does not have 'FromGraphSON' instance. This is
-- intentional. As stated in the document of
-- 'Data.Greskell.AsIterator.AsIterator', using 'String' in greskell
-- is an error in most cases. To prevent you from using 'String',
-- 'Char' (and thus 'String') don't have 'FromGraphSON' instances.
--
-- @since 0.1.2.0
class FromGraphSON a where
  parseGraphSON :: GValue -> Parser a

-- | Unwrap the given 'GValue' with 'unwrapAll', and just parse the
-- result with 'parseJSON'.
--
-- Useful to implement 'FromGraphSON' instances for scalar types.
-- 
-- @since 0.1.2.0
parseUnwrapAll :: FromJSON a => GValue -> Parser a
parseUnwrapAll :: GValue -> Parser a
parseUnwrapAll GValue
gv = Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser a) -> Value -> Parser a
forall a b. (a -> b) -> a -> b
$ GValue -> Value
unwrapAll GValue
gv

---- Looks like we don't need this.

-- -- | Unwrap the given 'GValue' with 'unwrapOne', parse the result to
-- -- @(t GValue)@, and recursively parse the children with
-- -- 'parseGraphSON'.
-- --
-- -- Useful to implement 'FromGraphSON' instances for 'Traversable'
-- -- types.
-- parseUnwrapTraversable :: (Traversable t, FromJSON (t GValue), FromGraphSON a)
--                        => GValue -> Parser (t a)
-- parseUnwrapTraversable gv = traverse parseGraphSON =<< (parseJSON $ unwrapOne gv)

-- | Extract 'GArray' from the given 'GValue', parse the items in the
-- array, and gather them by 'List.fromList'.
--
-- Useful to implement 'FromGraphSON' instances for 'IsList' types.
--
-- @since 0.1.2.0
parseUnwrapList :: (IsList a, i ~ Item a, FromGraphSON i) => GValue -> Parser a
parseUnwrapList :: GValue -> Parser a
parseUnwrapList (GValue (GraphSON Maybe Text
_ (GArray Vector GValue
v))) = ([i] -> a) -> Parser [i] -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [i] -> a
forall l. IsList l => [Item l] -> l
List.fromList (Parser [i] -> Parser a) -> Parser [i] -> Parser a
forall a b. (a -> b) -> a -> b
$ (GValue -> Parser i) -> [GValue] -> Parser [i]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse GValue -> Parser i
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON ([GValue] -> Parser [i]) -> [GValue] -> Parser [i]
forall a b. (a -> b) -> a -> b
$ Vector GValue -> [Item (Vector GValue)]
forall l. IsList l => l -> [Item l]
List.toList Vector GValue
v
parseUnwrapList (GValue (GraphSON Maybe Text
_ GValueBody
body)) = String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Expects GArray, but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ GValueBody -> String
forall a. Show a => a -> String
show GValueBody
body)

-- | Parse 'GValue' into 'FromGraphSON'.
--
-- @since 0.1.2.0
parseEither :: FromGraphSON a => GValue -> Either String a
parseEither :: GValue -> Either String a
parseEither = (GValue -> Parser a) -> GValue -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
Aeson.parseEither GValue -> Parser a
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON

-- | Like Aeson's 'Aeson..:', but for 'FromGraphSON'.
--
-- @since 0.1.2.0
(.:) :: FromGraphSON a => HashMap Text GValue -> Text -> Parser a
HashMap Text GValue
go .: :: HashMap Text GValue -> Text -> Parser a
.: Text
label = Parser a -> (GValue -> Parser a) -> Maybe GValue -> Parser a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser a
failure GValue -> Parser a
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON (Maybe GValue -> Parser a) -> Maybe GValue -> Parser a
forall a b. (a -> b) -> a -> b
$ Text -> HashMap Text GValue -> Maybe GValue
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
label HashMap Text GValue
go
  where
    failure :: Parser a
failure = String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Cannot find field " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
unpack Text
label)

-- | Implementation of 'parseJSON' based on 'parseGraphSON'. The input
-- 'Value' is first converted to 'GValue', and it's parsed to the
-- output type.
--
-- @since 0.1.2.0
parseJSONViaGValue :: FromGraphSON a => Value -> Parser a
parseJSONViaGValue :: Value -> Parser a
parseJSONViaGValue Value
v = GValue -> Parser a
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON (GValue -> Parser a) -> Parser GValue -> Parser a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser GValue
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

---- Trivial instances

instance FromGraphSON GValue where
  parseGraphSON :: GValue -> Parser GValue
parseGraphSON = GValue -> Parser GValue
forall (m :: * -> *) a. Monad m => a -> m a
return
instance FromGraphSON Int where
  parseGraphSON :: GValue -> Parser Int
parseGraphSON = GValue -> Parser Int
forall a. FromJSON a => GValue -> Parser a
parseUnwrapAll
instance FromGraphSON Text where
  parseGraphSON :: GValue -> Parser Text
parseGraphSON = GValue -> Parser Text
forall a. FromJSON a => GValue -> Parser a
parseUnwrapAll
instance FromGraphSON TL.Text where
  parseGraphSON :: GValue -> Parser Text
parseGraphSON = GValue -> Parser Text
forall a. FromJSON a => GValue -> Parser a
parseUnwrapAll
instance FromGraphSON Bool where
  parseGraphSON :: GValue -> Parser Bool
parseGraphSON = GValue -> Parser Bool
forall a. FromJSON a => GValue -> Parser a
parseUnwrapAll
instance FromGraphSON Double where
  parseGraphSON :: GValue -> Parser Double
parseGraphSON = GValue -> Parser Double
forall a. FromJSON a => GValue -> Parser a
parseUnwrapAll
instance FromGraphSON Float where
  parseGraphSON :: GValue -> Parser Float
parseGraphSON = GValue -> Parser Float
forall a. FromJSON a => GValue -> Parser a
parseUnwrapAll
instance FromGraphSON Int8 where
  parseGraphSON :: GValue -> Parser Int8
parseGraphSON = GValue -> Parser Int8
forall a. FromJSON a => GValue -> Parser a
parseUnwrapAll
instance FromGraphSON Int16 where
  parseGraphSON :: GValue -> Parser Int16
parseGraphSON = GValue -> Parser Int16
forall a. FromJSON a => GValue -> Parser a
parseUnwrapAll
instance FromGraphSON Int32 where
  parseGraphSON :: GValue -> Parser Int32
parseGraphSON = GValue -> Parser Int32
forall a. FromJSON a => GValue -> Parser a
parseUnwrapAll
instance FromGraphSON Int64 where
  parseGraphSON :: GValue -> Parser Int64
parseGraphSON = GValue -> Parser Int64
forall a. FromJSON a => GValue -> Parser a
parseUnwrapAll
instance FromGraphSON Integer where
  parseGraphSON :: GValue -> Parser Integer
parseGraphSON = GValue -> Parser Integer
forall a. FromJSON a => GValue -> Parser a
parseUnwrapAll
instance FromGraphSON Natural where
  parseGraphSON :: GValue -> Parser Natural
parseGraphSON = GValue -> Parser Natural
forall a. FromJSON a => GValue -> Parser a
parseUnwrapAll
instance (FromJSON a, Integral a) => FromGraphSON (Ratio a) where
  parseGraphSON :: GValue -> Parser (Ratio a)
parseGraphSON = GValue -> Parser (Ratio a)
forall a. FromJSON a => GValue -> Parser a
parseUnwrapAll
instance FromGraphSON Word where
  parseGraphSON :: GValue -> Parser Word
parseGraphSON = GValue -> Parser Word
forall a. FromJSON a => GValue -> Parser a
parseUnwrapAll
instance FromGraphSON Word8 where
  parseGraphSON :: GValue -> Parser Word8
parseGraphSON = GValue -> Parser Word8
forall a. FromJSON a => GValue -> Parser a
parseUnwrapAll
instance FromGraphSON Word16 where
  parseGraphSON :: GValue -> Parser Word16
parseGraphSON = GValue -> Parser Word16
forall a. FromJSON a => GValue -> Parser a
parseUnwrapAll
instance FromGraphSON Word32 where
  parseGraphSON :: GValue -> Parser Word32
parseGraphSON = GValue -> Parser Word32
forall a. FromJSON a => GValue -> Parser a
parseUnwrapAll
instance FromGraphSON Word64 where
  parseGraphSON :: GValue -> Parser Word64
parseGraphSON = GValue -> Parser Word64
forall a. FromJSON a => GValue -> Parser a
parseUnwrapAll
instance FromGraphSON Scientific where
  parseGraphSON :: GValue -> Parser Scientific
parseGraphSON = GValue -> Parser Scientific
forall a. FromJSON a => GValue -> Parser a
parseUnwrapAll
instance FromGraphSON IntSet where
  parseGraphSON :: GValue -> Parser IntSet
parseGraphSON = GValue -> Parser IntSet
forall a. FromJSON a => GValue -> Parser a
parseUnwrapAll

---- List instances

instance FromGraphSON a => FromGraphSON [a] where
  parseGraphSON :: GValue -> Parser [a]
parseGraphSON = GValue -> Parser [a]
forall a i.
(IsList a, i ~ Item a, FromGraphSON i) =>
GValue -> Parser a
parseUnwrapList
instance FromGraphSON a => FromGraphSON (Vector a) where
  parseGraphSON :: GValue -> Parser (Vector a)
parseGraphSON = GValue -> Parser (Vector a)
forall a i.
(IsList a, i ~ Item a, FromGraphSON i) =>
GValue -> Parser a
parseUnwrapList
instance FromGraphSON a => FromGraphSON (Seq a) where
  parseGraphSON :: GValue -> Parser (Seq a)
parseGraphSON = GValue -> Parser (Seq a)
forall a i.
(IsList a, i ~ Item a, FromGraphSON i) =>
GValue -> Parser a
parseUnwrapList
-- | @since 0.1.3.0
instance FromGraphSON a => FromGraphSON (NonEmpty a) where
  parseGraphSON :: GValue -> Parser (NonEmpty a)
parseGraphSON GValue
gv = do
    [a]
list <- GValue -> Parser [a]
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON GValue
gv
    case [a]
list of
      [] -> String -> Parser (NonEmpty a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Empty list.")
      (a
a : [a]
rest) -> NonEmpty a -> Parser (NonEmpty a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
rest)

---- Set instances

instance (FromGraphSON a, Ord a) => FromGraphSON (Set a) where
  parseGraphSON :: GValue -> Parser (Set a)
parseGraphSON = GValue -> Parser (Set a)
forall a i.
(IsList a, i ~ Item a, FromGraphSON i) =>
GValue -> Parser a
parseUnwrapList
instance (FromGraphSON a, Eq a, Hashable a) => FromGraphSON (HashSet a) where
  parseGraphSON :: GValue -> Parser (HashSet a)
parseGraphSON = GValue -> Parser (HashSet a)
forall a i.
(IsList a, i ~ Item a, FromGraphSON i) =>
GValue -> Parser a
parseUnwrapList

---- Trivial wrapper type instances

-- | @since 0.1.3.0
instance FromGraphSON a => FromGraphSON (Identity a) where
  parseGraphSON :: GValue -> Parser (Identity a)
parseGraphSON = (a -> Identity a) -> Parser a -> Parser (Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Identity a
forall a. a -> Identity a
Identity (Parser a -> Parser (Identity a))
-> (GValue -> Parser a) -> GValue -> Parser (Identity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GValue -> Parser a
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON
-- | @since 0.1.3.0
instance FromGraphSON a => FromGraphSON (S.Min a) where
  parseGraphSON :: GValue -> Parser (Min a)
parseGraphSON = (a -> Min a) -> Parser a -> Parser (Min a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Min a
forall a. a -> Min a
S.Min (Parser a -> Parser (Min a))
-> (GValue -> Parser a) -> GValue -> Parser (Min a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GValue -> Parser a
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON
-- | @since 0.1.3.0
instance FromGraphSON a => FromGraphSON (S.Max a) where
  parseGraphSON :: GValue -> Parser (Max a)
parseGraphSON = (a -> Max a) -> Parser a -> Parser (Max a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Max a
forall a. a -> Max a
S.Max (Parser a -> Parser (Max a))
-> (GValue -> Parser a) -> GValue -> Parser (Max a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GValue -> Parser a
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON
-- | @since 0.1.3.0
instance FromGraphSON a => FromGraphSON (S.First a) where
  parseGraphSON :: GValue -> Parser (First a)
parseGraphSON = (a -> First a) -> Parser a -> Parser (First a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> First a
forall a. a -> First a
S.First (Parser a -> Parser (First a))
-> (GValue -> Parser a) -> GValue -> Parser (First a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GValue -> Parser a
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON
-- | @since 0.1.3.0
instance FromGraphSON a => FromGraphSON (S.Last a) where
  parseGraphSON :: GValue -> Parser (Last a)
parseGraphSON = (a -> Last a) -> Parser a -> Parser (Last a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Last a
forall a. a -> Last a
S.Last (Parser a -> Parser (Last a))
-> (GValue -> Parser a) -> GValue -> Parser (Last a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GValue -> Parser a
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON
-- | @since 0.1.3.0
instance FromGraphSON a => FromGraphSON (S.WrappedMonoid a) where
  parseGraphSON :: GValue -> Parser (WrappedMonoid a)
parseGraphSON = (a -> WrappedMonoid a) -> Parser a -> Parser (WrappedMonoid a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> WrappedMonoid a
forall m. m -> WrappedMonoid m
S.WrapMonoid (Parser a -> Parser (WrappedMonoid a))
-> (GValue -> Parser a) -> GValue -> Parser (WrappedMonoid a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GValue -> Parser a
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON
-- | @since 0.1.3.0
instance FromGraphSON a => FromGraphSON (S.Dual a) where
  parseGraphSON :: GValue -> Parser (Dual a)
parseGraphSON = (a -> Dual a) -> Parser a -> Parser (Dual a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Dual a
forall a. a -> Dual a
S.Dual (Parser a -> Parser (Dual a))
-> (GValue -> Parser a) -> GValue -> Parser (Dual a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GValue -> Parser a
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON
-- | @since 0.1.3.0
instance FromGraphSON a => FromGraphSON (M.Sum a) where
  parseGraphSON :: GValue -> Parser (Sum a)
parseGraphSON = (a -> Sum a) -> Parser a -> Parser (Sum a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Sum a
forall a. a -> Sum a
M.Sum (Parser a -> Parser (Sum a))
-> (GValue -> Parser a) -> GValue -> Parser (Sum a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GValue -> Parser a
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON
-- | @since 0.1.3.0
instance FromGraphSON a => FromGraphSON (M.Product a) where
  parseGraphSON :: GValue -> Parser (Product a)
parseGraphSON = (a -> Product a) -> Parser a -> Parser (Product a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Product a
forall a. a -> Product a
M.Product (Parser a -> Parser (Product a))
-> (GValue -> Parser a) -> GValue -> Parser (Product a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GValue -> Parser a
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON

-- | @since 0.1.3.0
instance FromGraphSON M.All where
  parseGraphSON :: GValue -> Parser All
parseGraphSON = (Bool -> All) -> Parser Bool -> Parser All
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> All
M.All (Parser Bool -> Parser All)
-> (GValue -> Parser Bool) -> GValue -> Parser All
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GValue -> Parser Bool
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON
-- | @since 0.1.3.0
instance FromGraphSON M.Any where
  parseGraphSON :: GValue -> Parser Any
parseGraphSON = (Bool -> Any) -> Parser Bool -> Parser Any
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Any
M.Any (Parser Bool -> Parser Any)
-> (GValue -> Parser Bool) -> GValue -> Parser Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GValue -> Parser Bool
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON



---- GMap and others

-- | Use 'parseToFlattenedMap'.
instance (FromGraphSON k, FromGraphSON v, IsList (c k v), Item (c k v) ~ (k,v)) => FromGraphSON (FlattenedMap c k v) where
  parseGraphSON :: GValue -> Parser (FlattenedMap c k v)
parseGraphSON GValue
gv = case GValue -> GValueBody
gValueBody GValue
gv of
    GArray Vector GValue
a -> (GValue -> Parser k)
-> (GValue -> Parser v)
-> Vector GValue
-> Parser (FlattenedMap c k v)
forall (c :: * -> * -> *) k v s.
(IsList (c k v), Item (c k v) ~ (k, v)) =>
(s -> Parser k)
-> (s -> Parser v) -> Vector s -> Parser (FlattenedMap c k v)
parseToFlattenedMap GValue -> Parser k
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON GValue -> Parser v
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON Vector GValue
a
    GValueBody
b -> String -> Parser (FlattenedMap c k v)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Expects GArray, but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ GValueBody -> String
forall a. Show a => a -> String
show GValueBody
b)

parseGObjectToTraversal :: (Traversable t, FromJSON (t GValue), FromGraphSON v)
                        => HashMap Text GValue
                        -> Parser (t v)
parseGObjectToTraversal :: HashMap Text GValue -> Parser (t v)
parseGObjectToTraversal HashMap Text GValue
o = (GValue -> Parser v) -> t GValue -> Parser (t v)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse GValue -> Parser v
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON (t GValue -> Parser (t v)) -> Parser (t GValue) -> Parser (t v)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Value -> Parser (t GValue)
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser (t GValue)) -> Value -> Parser (t GValue)
forall a b. (a -> b) -> a -> b
$ Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ (GValue -> Value) -> HashMap Text GValue -> Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GValue -> Value
forall a. ToJSON a => a -> Value
toJSON HashMap Text GValue
o)

-- | Use 'parseToGMap'.
instance (FromGraphSON k, FromGraphSON v, IsList (c k v), Item (c k v) ~ (k,v), Traversable (c k), FromJSON (c k GValue))
         => FromGraphSON (GMap c k v) where
  parseGraphSON :: GValue -> Parser (GMap c k v)
parseGraphSON GValue
gv = case GValue -> GValueBody
gValueBody GValue
gv of
    GObject HashMap Text GValue
o -> Either (HashMap Text GValue) (Vector GValue) -> Parser (GMap c k v)
parse (Either (HashMap Text GValue) (Vector GValue)
 -> Parser (GMap c k v))
-> Either (HashMap Text GValue) (Vector GValue)
-> Parser (GMap c k v)
forall a b. (a -> b) -> a -> b
$ HashMap Text GValue -> Either (HashMap Text GValue) (Vector GValue)
forall a b. a -> Either a b
Left HashMap Text GValue
o
    GArray Vector GValue
a -> Either (HashMap Text GValue) (Vector GValue) -> Parser (GMap c k v)
parse (Either (HashMap Text GValue) (Vector GValue)
 -> Parser (GMap c k v))
-> Either (HashMap Text GValue) (Vector GValue)
-> Parser (GMap c k v)
forall a b. (a -> b) -> a -> b
$ Vector GValue -> Either (HashMap Text GValue) (Vector GValue)
forall a b. b -> Either a b
Right Vector GValue
a
    GValueBody
other -> String -> Parser (GMap c k v)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Expects GObject or GArray, but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ GValueBody -> String
forall a. Show a => a -> String
show GValueBody
other)
    where
      parse :: Either (HashMap Text GValue) (Vector GValue) -> Parser (GMap c k v)
parse = (GValue -> Parser k)
-> (GValue -> Parser v)
-> (HashMap Text GValue -> Parser (c k v))
-> Either (HashMap Text GValue) (Vector GValue)
-> Parser (GMap c k v)
forall (c :: * -> * -> *) k v s.
(IsList (c k v), Item (c k v) ~ (k, v)) =>
(s -> Parser k)
-> (s -> Parser v)
-> (HashMap Text s -> Parser (c k v))
-> Either (HashMap Text s) (Vector s)
-> Parser (GMap c k v)
parseToGMap GValue -> Parser k
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON GValue -> Parser v
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON HashMap Text GValue -> Parser (c k v)
parseObject
      -- parseObject = parseUnwrapTraversable . GValue . nonTypedGraphSON . GObject  --- Too many wrapping and unwrappings!!!
      parseObject :: HashMap Text GValue -> Parser (c k v)
parseObject = HashMap Text GValue -> Parser (c k v)
forall (t :: * -> *) v.
(Traversable t, FromJSON (t GValue), FromGraphSON v) =>
HashMap Text GValue -> Parser (t v)
parseGObjectToTraversal

-- | Use 'parseToGMapEntry'.
instance (FromGraphSON k, FromGraphSON v, FromJSONKey k) => FromGraphSON (GMapEntry k v) where
  parseGraphSON :: GValue -> Parser (GMapEntry k v)
parseGraphSON GValue
val = case GValue -> GValueBody
gValueBody GValue
val of
    GObject HashMap Text GValue
o -> Either (HashMap Text GValue) (Vector GValue)
-> Parser (GMapEntry k v)
parse (Either (HashMap Text GValue) (Vector GValue)
 -> Parser (GMapEntry k v))
-> Either (HashMap Text GValue) (Vector GValue)
-> Parser (GMapEntry k v)
forall a b. (a -> b) -> a -> b
$ HashMap Text GValue -> Either (HashMap Text GValue) (Vector GValue)
forall a b. a -> Either a b
Left HashMap Text GValue
o
    GArray Vector GValue
a -> Either (HashMap Text GValue) (Vector GValue)
-> Parser (GMapEntry k v)
parse (Either (HashMap Text GValue) (Vector GValue)
 -> Parser (GMapEntry k v))
-> Either (HashMap Text GValue) (Vector GValue)
-> Parser (GMapEntry k v)
forall a b. (a -> b) -> a -> b
$ Vector GValue -> Either (HashMap Text GValue) (Vector GValue)
forall a b. b -> Either a b
Right Vector GValue
a
    GValueBody
other -> String -> Parser (GMapEntry k v)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Expects GObject or GArray, but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ GValueBody -> String
forall a. Show a => a -> String
show GValueBody
other)
    where
      parse :: Either (HashMap Text GValue) (Vector GValue)
-> Parser (GMapEntry k v)
parse = (GValue -> Parser k)
-> (GValue -> Parser v)
-> Either (HashMap Text GValue) (Vector GValue)
-> Parser (GMapEntry k v)
forall k s v.
FromJSONKey k =>
(s -> Parser k)
-> (s -> Parser v)
-> Either (HashMap Text s) (Vector s)
-> Parser (GMapEntry k v)
parseToGMapEntry GValue -> Parser k
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON GValue -> Parser v
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON


---- Map instances

instance (FromGraphSON v, Eq k, Hashable k, FromJSONKey k, FromGraphSON k) => FromGraphSON (L.HashMap k v) where
  parseGraphSON :: GValue -> Parser (HashMap k v)
parseGraphSON = (GMap HashMap k v -> HashMap k v)
-> Parser (GMap HashMap k v) -> Parser (HashMap k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GMap HashMap k v -> HashMap k v
forall (c :: * -> * -> *) k v. GMap c k v -> c k v
unGMap (Parser (GMap HashMap k v) -> Parser (HashMap k v))
-> (GValue -> Parser (GMap HashMap k v))
-> GValue
-> Parser (HashMap k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GValue -> Parser (GMap HashMap k v)
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON
instance (FromGraphSON v, Ord k, FromJSONKey k, FromGraphSON k) => FromGraphSON (L.Map k v) where
  parseGraphSON :: GValue -> Parser (Map k v)
parseGraphSON = (GMap Map k v -> Map k v)
-> Parser (GMap Map k v) -> Parser (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GMap Map k v -> Map k v
forall (c :: * -> * -> *) k v. GMap c k v -> c k v
unGMap (Parser (GMap Map k v) -> Parser (Map k v))
-> (GValue -> Parser (GMap Map k v)) -> GValue -> Parser (Map k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GValue -> Parser (GMap Map k v)
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON
-- IntMap cannot be used with GMap directly..
instance FromGraphSON v => FromGraphSON (L.IntMap v) where
  parseGraphSON :: GValue -> Parser (IntMap v)
parseGraphSON = (GMap Map Int v -> IntMap v)
-> Parser (GMap Map Int v) -> Parser (IntMap v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map Int v -> IntMap v
forall v. Map Int v -> IntMap v
mapToIntMap (Map Int v -> IntMap v)
-> (GMap Map Int v -> Map Int v) -> GMap Map Int v -> IntMap v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GMap Map Int v -> Map Int v
forall (c :: * -> * -> *) k v. GMap c k v -> c k v
unGMap) (Parser (GMap Map Int v) -> Parser (IntMap v))
-> (GValue -> Parser (GMap Map Int v))
-> GValue
-> Parser (IntMap v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GValue -> Parser (GMap Map Int v)
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON
    where
      mapToIntMap :: L.Map Int v -> L.IntMap v
      mapToIntMap :: Map Int v -> IntMap v
mapToIntMap = (Int -> v -> IntMap v -> IntMap v)
-> IntMap v -> Map Int v -> IntMap v
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
LMap.foldrWithKey Int -> v -> IntMap v -> IntMap v
forall a. Int -> a -> IntMap a -> IntMap a
LIntMap.insert IntMap v
forall a. Monoid a => a
mempty

---- Maybe and Either

-- | Parse 'GNull' into 'Nothing'.
instance FromGraphSON a => FromGraphSON (Maybe a) where
  parseGraphSON :: GValue -> Parser (Maybe a)
parseGraphSON (GValue (GraphSON Maybe Text
_ GValueBody
GNull)) = Maybe a -> Parser (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
  parseGraphSON GValue
gv = (a -> Maybe a) -> Parser a -> Parser (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Parser a -> Parser (Maybe a)) -> Parser a -> Parser (Maybe a)
forall a b. (a -> b) -> a -> b
$ GValue -> Parser a
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON GValue
gv

-- | Try 'Left', then 'Right'.
instance (FromGraphSON a, FromGraphSON b) => FromGraphSON (Either a b) where
  parseGraphSON :: GValue -> Parser (Either a b)
parseGraphSON GValue
gv = ((a -> Either a b) -> Parser a -> Parser (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either a b
forall a b. a -> Either a b
Left (Parser a -> Parser (Either a b))
-> Parser a -> Parser (Either a b)
forall a b. (a -> b) -> a -> b
$ GValue -> Parser a
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON GValue
gv) Parser (Either a b) -> Parser (Either a b) -> Parser (Either a b)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((b -> Either a b) -> Parser b -> Parser (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either a b
forall a b. b -> Either a b
Right (Parser b -> Parser (Either a b))
-> Parser b -> Parser (Either a b)
forall a b. (a -> b) -> a -> b
$ GValue -> Parser b
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON GValue
gv)

---- Trivial wrapper for Maybe

-- | @since 0.1.3.0
instance FromGraphSON a => FromGraphSON (S.Option a) where
  parseGraphSON :: GValue -> Parser (Option a)
parseGraphSON = (Maybe a -> Option a) -> Parser (Maybe a) -> Parser (Option a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> Option a
forall a. Maybe a -> Option a
S.Option (Parser (Maybe a) -> Parser (Option a))
-> (GValue -> Parser (Maybe a)) -> GValue -> Parser (Option a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GValue -> Parser (Maybe a)
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON
-- | @since 0.1.3.0
instance FromGraphSON a => FromGraphSON (M.First a) where
  parseGraphSON :: GValue -> Parser (First a)
parseGraphSON = (Maybe a -> First a) -> Parser (Maybe a) -> Parser (First a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> First a
forall a. Maybe a -> First a
M.First (Parser (Maybe a) -> Parser (First a))
-> (GValue -> Parser (Maybe a)) -> GValue -> Parser (First a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GValue -> Parser (Maybe a)
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON
-- | @since 0.1.3.0
instance FromGraphSON a => FromGraphSON (M.Last a) where
  parseGraphSON :: GValue -> Parser (Last a)
parseGraphSON = (Maybe a -> Last a) -> Parser (Maybe a) -> Parser (Last a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> Last a
forall a. Maybe a -> Last a
M.Last (Parser (Maybe a) -> Parser (Last a))
-> (GValue -> Parser (Maybe a)) -> GValue -> Parser (Last a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GValue -> Parser (Maybe a)
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON


---- Others

-- | Call 'unwrapAll' to remove all GraphSON wrappers.
instance FromGraphSON Value where
  parseGraphSON :: GValue -> Parser Value
parseGraphSON = Value -> Parser Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Parser Value)
-> (GValue -> Value) -> GValue -> Parser Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GValue -> Value
unwrapAll

instance FromGraphSON UUID where
  parseGraphSON :: GValue -> Parser UUID
parseGraphSON GValue
gv = case GValue -> GValueBody
gValueBody GValue
gv of
    GString Text
t -> Parser UUID -> (UUID -> Parser UUID) -> Maybe UUID -> Parser UUID
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser UUID
failure UUID -> Parser UUID
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe UUID -> Parser UUID) -> Maybe UUID -> Parser UUID
forall a b. (a -> b) -> a -> b
$ Text -> Maybe UUID
UUID.fromText Text
t
      where
        failure :: Parser UUID
failure = String -> Parser UUID
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Failed to parse into UUID: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
unpack Text
t)
    GValueBody
b -> String -> Parser UUID
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Expected GString, but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ GValueBody -> String
forall a. Show a => a -> String
show GValueBody
b)

-- | For any input 'GValue', 'parseGraphSON' returns @()@. For
-- example, you can use it to ignore data you get from the Gremlin
-- server.
instance FromGraphSON () where
  parseGraphSON :: GValue -> Parser ()
parseGraphSON GValue
_ = () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()