greskell-core 0.1.1.0 → 0.1.2.0

raw patch · 11 files changed

+1656/−124 lines, 11 filesdep +bytestringdep +containersdep +hashabledep ~aesondep ~unordered-containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: bytestring, containers, hashable, uuid, vector

Dependency ranges changed: aeson, unordered-containers

API changes (from Hackage documentation)

Files

• ChangeLog.md +26/−0
• greskell-core.cabal +21/−9
• src/Data/Greskell/AsIterator.hs +133/−0
• src/Data/Greskell/GMap.hs +305/−0
• src/Data/Greskell/GraphSON.hs +249/−109
• src/Data/Greskell/GraphSON/Core.hs +153/−0
• src/Data/Greskell/GraphSON/GValue.hs +169/−0
• src/Data/Greskell/GraphSON/GraphSONTyped.hs +106/−0
• src/Data/Greskell/Greskell.hs +47/−6
• test/Data/Greskell/GMapSpec.hs +81/−0
• test/Data/Greskell/GraphSONSpec.hs +366/−0

@@ -1,5 +1,31 @@ # Revision history for greskell-core +## 0.1.2.0  -- 2018-06-21++* Add `GMap` module.+* Add `AsIterator` module.+* Add `GraphSON.GValue` module.+* Confirmed test with `aeson-1.4.0.0`.++### GraphSON module++* Change behavior of `instance FromJSON GraphSON`. Now {"@type": null}+  goes to failure. Before, "@type":null fell back to direct (bare)+  parsing. If it finds "@type" key, I think it should expect that the+  JSON object is a GraphSON wrapper. It's more or less a bug fix, so+  it doesn't bump major version.+* Add `Generic` and `Hashable` instances to `GraphSON`.+* Add `GValue` and `GValueBody` types and related functions.+* Add `FromGraphSON` class and related functions.+* Add `instance GraphSONTyped Either`.+* Add `instance GraphSONTyped` to types in `containers` package.+* Re-export Aeson's `Parser` type for convenience.++### Greskell module++* Add `valueInt`, `gvalue`, `gvalueInt` functions.++ ## 0.1.1.0  -- 2018-04-08  * Add Semigroup instance to Greskell.

@@ -1,5 +1,5 @@ name:                   greskell-core-version:                0.1.1.0+version:                0.1.2.0 author:                 Toshio Ito <debug.ito@gmail.com> maintainer:             Toshio Ito <debug.ito@gmail.com> license:                BSD3@@ -21,16 +21,25 @@   hs-source-dirs:       src   ghc-options:          -Wall -fno-warn-unused-imports   -- default-extensions:   -  other-extensions:     OverloadedStrings, TypeFamilies+  other-extensions:     OverloadedStrings, TypeFamilies, DeriveGeneric,+                        GeneralizedNewtypeDeriving, DeriveTraversable   exposed-modules:      Data.Greskell.Greskell,-                        Data.Greskell.GraphSON-  -- other-modules:        +                        Data.Greskell.GraphSON,+                        Data.Greskell.GraphSON.GValue,+                        Data.Greskell.GMap,+                        Data.Greskell.AsIterator+  other-modules:        Data.Greskell.GraphSON.GraphSONTyped,+                        Data.Greskell.GraphSON.Core   build-depends:        base >=4.9.0.0 && <4.12,-                        aeson >=0.11.2.1 && <1.4,+                        aeson >=1.0.2.1 && <1.5,                         unordered-containers >=0.2.7.1 && <0.3,+                        hashable >=1.2.6.1 && <1.3,                         scientific >=0.3.4.9 && <0.4,                         text >=1.2.2.1 && <1.3,-                        semigroups >=0.18.2 && <0.19+                        semigroups >=0.18.2 && <0.19,+                        vector >=0.12.0.1 && <0.13,+                        containers >=0.5.7.1 && <0.6,+                        uuid >=1.3.13 && <1.4  test-suite spec   type:                 exitcode-stdio-1.0@@ -39,13 +48,16 @@   ghc-options:          -Wall -fno-warn-unused-imports "-with-rtsopts=-M512m"   main-is:              Spec.hs   -- default-extensions:   -  other-extensions:     OverloadedStrings+  other-extensions:     OverloadedStrings, NoMonomorphismRestriction   other-modules:        Data.Greskell.GreskellSpec,+                        Data.Greskell.GraphSONSpec,+                        Data.Greskell.GMapSpec,                         Data.Greskell.Test.QuickCheck-  build-depends:        base, text, aeson,+  build-depends:        base, text, aeson, unordered-containers, vector,                         greskell-core,                         hspec >=2.2.3,-                        QuickCheck >=2.8.2 && <2.12+                        QuickCheck >=2.8.2 && <2.12,+                        bytestring >=0.10.8.1 && <0.11  test-suite doctest   type:                 exitcode-stdio-1.0

@@ -0,0 +1,133 @@+{-# LANGUAGE TypeFamilies #-}+-- |+-- Module: Data.Greskell.AsIterator+-- Description: Conversion from Object to Iterator in Gremlin+-- Maintainer: Toshio Ito <debug.ito@gmail.com>+--+-- @since 0.1.2.0+module Data.Greskell.AsIterator+       ( AsIterator(..)+       ) where++import qualified Data.HashMap.Lazy as L (HashMap)+import Data.HashSet (HashSet)+import Data.Int (Int8, Int16, Int32, Int64)+import qualified Data.IntMap.Lazy as L (IntMap)+import Data.IntSet (IntSet)+import qualified Data.Map.Lazy as L (Map)+import Data.Ratio (Ratio)+import Data.Scientific (Scientific)+import Data.Sequence (Seq)+import Data.Set (Set)+import Data.Text (Text)+import qualified Data.Text.Lazy as TL+import Data.Vector (Vector)+import Data.Word (Word8, Word16, Word32, Word64)+import Numeric.Natural (Natural)++import Data.Greskell.GMap (GMap, GMapEntry)++-- | Types that are converted to an iterator by+-- @org.apache.tinkerpop.gremlin.util.iterator.IteratorUtils.asIterator@+-- method. In fact, that method can convert any type to an iterator,+-- but greskell limits types to which the conversion is applicable.+--+-- Associated with this type-class is 'IteratorItem'. 'IteratorItem'+-- type family is association of type @a@ and the type of its item+-- when type @a@ is converted to an iterator.+--+-- 'IteratorItem' rule of thumb:+--+-- - @Iterator@ and @Iterable@ types like @List@, @Stream@ and+--   @GraphTraversal@ are converted to their element types.+-- - @Map@ type is converted to its @Map.Entry@. In greskell,+--   @Map.Entry@ is expressed as 'GMapEntry'.+-- - Other types are converted to themselves.+--+-- Caveat:+--+-- - Because Haskell's 'String' is @[Char]@, @IteratorItem String@+--   returns 'Char', which is incorrect. Use 'Text' if you want to+--   deal with @String@s in Gremlin.+class AsIterator a where+  type IteratorItem a++instance AsIterator () where+  type IteratorItem () = ()+instance AsIterator Int where+  type IteratorItem Int = Int+instance AsIterator Text where+  type IteratorItem Text = Text+instance AsIterator TL.Text where+  type IteratorItem TL.Text = TL.Text+instance AsIterator Bool where+  type IteratorItem Bool = Bool+instance AsIterator Char where+  type IteratorItem Char = Char+instance AsIterator Double where+  type IteratorItem Double = Double+instance AsIterator Float where+  type IteratorItem Float = Float+instance AsIterator Int8 where+  type IteratorItem Int8 = Int8+instance AsIterator Int16 where+  type IteratorItem Int16 = Int16+instance AsIterator Int32 where+  type IteratorItem Int32 = Int32+instance AsIterator Int64 where+  type IteratorItem Int64 = Int64+instance AsIterator Integer where+  type IteratorItem Integer = Integer+instance AsIterator Natural where+  type IteratorItem Natural = Natural+instance Integral a => AsIterator (Ratio a) where+  type IteratorItem (Ratio a) = Ratio a+instance AsIterator Word where+  type IteratorItem Word = Word+instance AsIterator Word8 where+  type IteratorItem Word8 = Word8+instance AsIterator Word16 where+  type IteratorItem Word16 = Word16+instance AsIterator Word32 where+  type IteratorItem Word32 = Word32+instance AsIterator Word64 where+  type IteratorItem Word64 = Word64+instance AsIterator Scientific where+  type IteratorItem Scientific = Scientific++instance AsIterator [a] where+  type IteratorItem [a] = a+instance AsIterator (Vector a) where+  type IteratorItem (Vector a) = a+instance AsIterator (HashSet a) where+  type IteratorItem (HashSet a) = a+instance AsIterator (Seq a) where+  type IteratorItem (Seq a) = a+instance AsIterator (Set a) where+  type IteratorItem (Set a) = a+instance AsIterator IntSet where+  type IteratorItem IntSet = Int++instance AsIterator (GMap c k v) where+  type IteratorItem (GMap c k v) = GMapEntry k v+instance AsIterator (GMapEntry k v) where+  type IteratorItem (GMapEntry k v) = GMapEntry k v+instance AsIterator (L.HashMap k v) where+  type IteratorItem (L.HashMap k v) = GMapEntry k v+instance AsIterator (L.Map k v) where+  type IteratorItem (L.Map k v) = GMapEntry k v+instance AsIterator (L.IntMap v) where+  type IteratorItem (L.IntMap v) = GMapEntry Int v++instance AsIterator a => AsIterator (Maybe a) where+  type IteratorItem (Maybe a) = Maybe (IteratorItem a)++-- About encoding of Map.Entry+--+-- It seems that GraphSON encodes a Map.Entry as if it were a+-- single-entry Map, but who is responsble for that? jackson?+--+-- Maybe these topics are related?+--+-- - https://github.com/fasterxml/jackson-databind/issues/565+-- - https://fasterxml.github.io/jackson-databind/javadoc/2.8/com/fasterxml/jackson/databind/ser/impl/MapEntrySerializer.html

@@ -0,0 +1,305 @@+{-# LANGUAGE TypeFamilies, OverloadedStrings, GeneralizedNewtypeDeriving, DeriveTraversable #-}+-- |+-- Module: Data.Greskell.GMap+-- Description: data type for g:Map+-- Maintainer: Toshio Ito <debug.ito@gmail.com>+--+-- @since 0.1.2.0+--+-- This module defines types for parsing a "g:Map" GraphSON+-- object. Usually users only have to use 'GMapEntry', because other+-- types are just used internally to implement GraphSON parsers.+module Data.Greskell.GMap+       ( -- * FlattenedMap+         FlattenedMap(..),+         parseToFlattenedMap,+         -- * GMap+         GMap(..),+         unGMap,+         singleton,+         toList,+         parseToGMap,+         -- * GMapEntry+         GMapEntry(..),+         unGMapEntry,+         parseToGMapEntry+       ) where++import Control.Applicative ((<$>), (<*>), (<|>), empty)+import Data.Aeson+  ( FromJSON(..), ToJSON(..), Value(..),+    FromJSONKey, fromJSONKey, FromJSONKeyFunction(..), ToJSONKey+  )+import Data.Aeson.Types (Parser)+import Data.Foldable (length, Foldable)+import Data.Hashable (Hashable)+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HM+import qualified Data.Map as M+import Data.Text (Text, intercalate, unpack)+import Data.Traversable (Traversable, traverse)+import Data.Vector ((!), Vector)+import qualified Data.Vector as V+import GHC.Exts (IsList(Item))+import qualified GHC.Exts as List (IsList(fromList, toList))+import Unsafe.Coerce (unsafeCoerce)++import Data.Greskell.GraphSON.GraphSONTyped (GraphSONTyped(..))++-- $setup+-- >>> :set -XOverloadedStrings+-- >>> import qualified Data.Aeson as Aeson+-- >>> import Data.HashMap.Strict (HashMap)+-- >>> import qualified Data.HashMap.Strict as HashMap+-- >>> import Data.List (sort)+-- >>> import Data.Either (isLeft)++-- | JSON encoding of a map as an array of flattened key-value pairs.+-- +-- 'ToJSON' instance of this type encodes the internal map as an array+-- of keys and values. 'FromJSON' instance of this type parses that+-- flattened map.+--+-- - type @c@: container type for a map (e.g. 'Data.Map.Map' and+--   'Data.HashMap.Strict.HashMap').+-- - type @k@: key of the map.+-- - type @v@: value of the map.+--+-- >>> let decode s = Aeson.eitherDecode s :: Either String (FlattenedMap HashMap Int String)+-- >>> let toSortedList = sort . HashMap.toList . unFlattenedMap+-- >>> fmap toSortedList $ decode "[10, \"ten\", 11, \"eleven\"]"+-- Right [(10,"ten"),(11,"eleven")]+-- >>> fmap toSortedList $ decode "[]"+-- Right []+-- >>> let (Left err_msg) = decode "[10, \"ten\", 11]"+-- >>> err_msg+-- ...odd number of elements...+-- >>> Aeson.encode $ FlattenedMap $ (HashMap.fromList [(10, "ten")] :: HashMap Int String)+-- "[10,\"ten\"]"+newtype FlattenedMap c k v = FlattenedMap { unFlattenedMap :: c k v }+                   deriving (Show,Eq,Ord,Foldable,Traversable,Functor)++-- | Use 'parseToFlattenedMap'.+instance (FromJSON k, FromJSON v, IsList (c k v), Item (c k v) ~ (k,v)) => FromJSON (FlattenedMap c k v) where+  parseJSON (Array v) = parseToFlattenedMap parseJSON parseJSON v+  parseJSON v = fail ("Expects Array, but got " ++ show v)++-- | Parse a flattened key-values to an associative Vector.+parseToAVec :: (s -> Parser k) -> (s -> Parser v) -> Vector s -> Parser (Vector (k,v))+parseToAVec parseKey parseValue v = +  if odd vlen+  then fail "Fail to parse a list into an associative list because there are odd number of elements."+  else traverse parsePair pairVec+  where+    vlen = length v+    pairVec = fmap (\i -> (v ! (i * 2), v ! (i * 2 + 1))) $ V.fromList [0 .. ((vlen `div` 2) - 1)]+    parsePair (vk, vv) = (,) <$> parseKey vk <*> parseValue vv++-- | General parser for 'FlattenedMap'.+parseToFlattenedMap :: (IsList (c k v), Item (c k v) ~ (k,v))+                    => (s -> Parser k) -- ^ key parser+                    -> (s -> Parser v) -- ^ value parser+                    -> Vector s -- ^ input vector of flattened key-values.+                    -> Parser (FlattenedMap c k v)+parseToFlattenedMap parseKey parseValue v =+  fmap (FlattenedMap . List.fromList . V.toList) $ parseToAVec parseKey parseValue v++instance (ToJSON k, ToJSON v, IsList (c k v), Item (c k v) ~ (k,v)) => ToJSON (FlattenedMap c k v) where+  toJSON (FlattenedMap m) = toJSON $ flatten $ map toValuePair $ List.toList m+    where+      toValuePair (k, v) = (toJSON k, toJSON v)+      flatten pl = (\(k, v) -> [k, v]) =<< pl++-- | Map to \"g:Map\".+instance GraphSONTyped (FlattenedMap c k v) where+  gsonTypeFor _ = "g:Map"+++-- | Haskell representation of @g:Map@ type.+--+-- GraphSON v1 and v2 encode Java @Map@ type as a JSON Object, while+-- GraphSON v3 encodes it as an array of flattened keys and values+-- (like 'FlattenedMap'.)  'GMap' type handles both encoding schemes.+--+-- - type @c@: container type for a map (e.g. 'Data.Map.Map' and+--   'Data.HashMap.Strict.HashMap').+-- - type @k@: key of the map.+-- - type @v@: value of the map.+--+-- >>> Aeson.eitherDecode "{\"ten\": 10}" :: Either String (GMap HashMap Text Int)+-- Right (GMap {gmapFlat = False, gmapValue = fromList [("ten",10)]})+-- >>> Aeson.eitherDecode "[\"ten\", 10]" :: Either String (GMap HashMap Text Int)+-- Right (GMap {gmapFlat = True, gmapValue = fromList [("ten",10)]})+-- >>> Aeson.encode $ GMap False (HashMap.fromList [(9, "nine")] :: HashMap Int Text)+-- "{\"9\":\"nine\"}"+-- >>> Aeson.encode $ GMap True (HashMap.fromList [(9, "nine")] :: HashMap Int Text)+-- "[9,\"nine\"]"+data GMap c k v =+  GMap+  { gmapFlat :: !Bool,+    -- ^ If 'True', the map is encoded as an array. If 'False', it's+    -- encoded as a JSON Object.+    gmapValue :: !(c k v)+    -- ^ Map implementation.+  }+  deriving (Show,Eq,Foldable,Traversable,Functor)++-- | General parser for 'GMap'.+parseToGMap :: (IsList (c k v), Item (c k v) ~ (k,v))+            => (s -> Parser k) -- ^ key parser+            -> (s -> Parser v) -- ^ value parser+            -> (HashMap Text s -> Parser (c k v)) -- ^ object parser+            -> Either (HashMap Text s) (Vector s) -- ^ input object or flattened key-values.+            -> Parser (GMap c k v)+parseToGMap _ _ op (Left o) = fmap (GMap False) $ op o+parseToGMap kp vp _ (Right v) = fmap (GMap True . unFlattenedMap) $ parseToFlattenedMap kp vp v++-- | Use 'parseToGMap'.+instance (FromJSON k, FromJSON v, IsList (c k v), Item (c k v) ~ (k,v), FromJSON (c k v)) => FromJSON (GMap c k v) where+  parseJSON v = case v of+    Object o -> parse $ Left o+    Array a -> parse $ Right a+    other -> fail ("Expects Object or Array, but got " ++ show other)+    where+      parse = parseToGMap parseJSON parseJSON (parseJSON . Object)++instance (ToJSON k, ToJSON v, IsList (c k v), Item (c k v) ~ (k,v), ToJSON (c k v)) => ToJSON (GMap c k v) where+  toJSON gm = if gmapFlat gm+              then toJSON $ FlattenedMap $ unGMap gm+              else toJSON $ unGMap gm++-- | Map to \"g:Map\".+instance GraphSONTyped (GMap c k v) where+  gsonTypeFor _ = "g:Map"++-- | Get the map implementation from 'GMap'.+unGMap :: GMap c k v -> c k v+unGMap = gmapValue++-- | Haskell representation of @Map.Entry@ type.+--+-- Basically GraphSON encodes Java's @Map.Entry@ type as if it were a+-- @Map@ with a single entry. Thus its encoded form is either a JSON+-- object or a flattened key-values, as explained in 'GMap'.+--+-- >>> Aeson.eitherDecode "{\"1\": \"one\"}" :: Either String (GMapEntry Int Text)+-- Right (GMapEntry {gmapEntryFlat = False, gmapEntryKey = 1, gmapEntryValue = "one"})+-- >>> Aeson.eitherDecode "[1, \"one\"]" :: Either String (GMapEntry Int Text)+-- Right (GMapEntry {gmapEntryFlat = True, gmapEntryKey = 1, gmapEntryValue = "one"})+-- >>> Aeson.encode (GMapEntry False "one" 1 :: GMapEntry Text Int)+-- "{\"one\":1}"+-- >>> Aeson.encode (GMapEntry True "one" 1 :: GMapEntry Text Int)+-- "[\"one\",1]"+--+-- In old versions of TinkerPop, @Map.Entry@ is encoded as a JSON+-- object with \"key\" and \"value\" fields. 'FromJSON' instance of+-- 'GMapEntry' supports this format as well, but 'ToJSON' instance+-- doesn't support it.+--+-- >>> Aeson.eitherDecode "{\"key\":1, \"value\": \"one\"}" :: Either String (GMapEntry Int Text)+-- Right (GMapEntry {gmapEntryFlat = False, gmapEntryKey = 1, gmapEntryValue = "one"})+data GMapEntry k v =+  GMapEntry+  { gmapEntryFlat :: !Bool,+    gmapEntryKey :: !k,+    gmapEntryValue :: !v+  }+  deriving (Show,Eq,Ord,Foldable,Traversable,Functor)++parseKeyValueToEntry :: (s -> Parser k)+                     -> (s -> Parser v)+                     -> HashMap Text s+                     -> Parser (Maybe (GMapEntry k v))+parseKeyValueToEntry kp vp o =+  if length o /= 2+  then return Nothing+  else do+    mk <- parseIfPresent kp $ HM.lookup "key" o+    mv <- parseIfPresent vp $ HM.lookup "value" o+    return $ GMapEntry False <$> mk <*> mv+  where+    parseIfPresent :: (a -> Parser v) -> Maybe a -> Parser (Maybe v)+    parseIfPresent f = maybe (return Nothing) (fmap Just . f)++parseSingleEntryObjectToEntry :: FromJSONKey k+                              => (s -> Parser v)+                              -> HashMap Text s+                              -> Parser (Maybe (GMapEntry k v))+parseSingleEntryObjectToEntry vp o =+  case HM.toList o of+   [(raw_key, raw_val)] -> do+     key <- parseKey raw_key+     val <- vp raw_val+     return $ Just $ GMapEntry False key val+   _ -> return Nothing+  where+    parseKey k = do+      p <- getParser+      p k+    getParser = case fromJSONKey of+      FromJSONKeyText p -> return $ fmap return p+      FromJSONKeyTextParser p -> return p+      FromJSONKeyCoerce _ -> return $ fmap return unsafeCoerce+      FromJSONKeyValue _ -> fail ( "Unexpected FromJSONKeyValue."+                                   ++ " It expects that the entry key is parsed from the text key in JSON Object,"+                                   ++ " but the key type does not support it."+                                 )++orElseM :: Monad m => m (Maybe a) -> m (Maybe a) -> m (Maybe a)+orElseM act_a act_b = do+  ma <- act_a+  case ma of+   Just a -> return $ Just a+   Nothing -> act_b++-- | General parser for 'GMapEntry'.+parseToGMapEntry :: FromJSONKey k+                 => (s -> Parser k) -- ^ key parser+                 -> (s -> Parser v) -- ^ value parser+                 -> Either (HashMap Text s) (Vector s) -- ^ input object or flattened key-values+                 -> Parser (GMapEntry k v)+parseToGMapEntry kp vp (Right vec) = do+  avec <- parseToAVec kp vp vec+  case V.toList avec of+   [(key, val)] -> return $ GMapEntry True key val+   _ -> fail ("Expects a single entry of key-value pair, but got " ++ (show $ V.length avec) ++ " entries.")+parseToGMapEntry kp vp (Left o) = do+  m_ret <- parseKeyValueToEntry kp vp o `orElseM` parseSingleEntryObjectToEntry vp o+  case m_ret of+   Just ret -> return ret+   Nothing -> fail ("Unexpected structure of Object: got keys: " ++ (unpack $ intercalate ", " $ HM.keys o))++-- | Map to \"g:Map\".+instance GraphSONTyped (GMapEntry k v) where+  gsonTypeFor _ = "g:Map"++-- | Use 'parseToGMapEntry'.+instance (FromJSON k, FromJSONKey k, FromJSON v) => FromJSON (GMapEntry k v) where+  parseJSON val = case val of+    Object o -> parse $ Left o+    Array a -> parse $ Right a+    other -> fail ("Expects Object or Array, but got " ++ show other)+    where+      parse = parseToGMapEntry parseJSON parseJSON++instance (ToJSON k, ToJSONKey k, Ord k, ToJSON v) => ToJSON (GMapEntry k v) where+  toJSON e = toJSON $ singleton' e+    where+      singleton' :: (Ord k) => GMapEntry k v -> GMap M.Map k v+      singleton' = singleton+  +-- | Get the key-value pair from 'GMapEntry'.+unGMapEntry :: GMapEntry k v -> (k, v)+unGMapEntry e = (gmapEntryKey e, gmapEntryValue e)++-- | Create 'GMap' that has the single 'GMapEntry'.+singleton :: (IsList (c k v), Item (c k v) ~ (k,v)) => GMapEntry k v -> GMap c k v+singleton e = GMap { gmapFlat = gmapEntryFlat e,+                     gmapValue = List.fromList [(gmapEntryKey e, gmapEntryValue e)]+                   }++-- | Deconstruct 'GMap' into a list of 'GMapEntry's.+toList :: (IsList (c k v), Item (c k v) ~ (k,v)) => GMap c k v -> [GMapEntry k v]+toList gm = map toEntry $ List.toList $ gmapValue gm+  where+    toEntry (k, v) = GMapEntry (gmapFlat gm) k v

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, DeriveGeneric, TypeFamilies #-} -- | -- Module: Data.Greskell.GraphSON -- Description: Encoding and decoding GraphSON@@ -6,159 +6,299 @@ -- --  module Data.Greskell.GraphSON-       ( -- * Type+       ( -- * GraphSON          GraphSON(..),          GraphSONTyped(..),-         -- * Constructors+         -- ** constructors          nonTypedGraphSON,          typedGraphSON,          typedGraphSON',-         -- * Parser support-         parseTypedGraphSON+         -- ** parser support+         parseTypedGraphSON,+         -- * GValue+         GValue,+         GValueBody(..),+         -- ** constructors+         nonTypedGValue,+         typedGValue',+         -- * FromGraphSON+         FromGraphSON(..),+         -- ** parser support+         Parser,+         parseEither,+         parseUnwrapAll,+         parseUnwrapList,+         (.:),+         parseJSONViaGValue        ) where -import Control.Applicative ((<$>), (<*>))+import Control.Applicative ((<$>), (<*>), (<|>)) import Control.Monad (when)-import Data.Aeson (ToJSON(toJSON), FromJSON(parseJSON), object, (.=), Value(Object), (.:?))+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 qualified Data.HashMap.Lazy as HML+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.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 Data.Ratio (Ratio) import Data.Scientific (Scientific)-import Data.Text (Text)+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 --- | Wrapper for \"typed JSON object\" introduced in GraphSON version--- 2. See http://tinkerpop.apache.org/docs/current/dev/io/#graphson+-- | Types that can be constructed from 'GValue'. This is analogous to+-- 'FromJSON' class. ----- This data type is useful for encoding/decoding GraphSON text.+-- 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.+-- - 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. -- --- >>> Aeson.decode "1000" :: Maybe (GraphSON Int32)--- Just (GraphSON {gsonType = Nothing, gsonValue = 1000})--- >>> Aeson.decode "{\"@type\": \"g:Int32\", \"@value\": 1000}" :: Maybe (GraphSON Int32)--- Just (GraphSON {gsonType = Just "g:Int32", gsonValue = 1000})-data GraphSON v =-  GraphSON-  { gsonType :: Maybe Text,-    -- ^ Type ID, corresponding to @\@type@ field.-    gsonValue :: v-    -- ^ Value, correspoding to @\@value@ field.-  }-  deriving (Show,Eq,Ord)+-- @since 0.1.2.0+parseUnwrapAll :: FromJSON a => GValue -> Parser a+parseUnwrapAll gv = parseJSON $ unwrapAll gv -instance Functor GraphSON where-  fmap f gs = gs { gsonValue = f $ gsonValue gs }+---- Looks like we don't need this. -instance Foldable GraphSON where-  foldr f start gs = f (gsonValue gs) start+-- -- | 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) -instance Traversable GraphSON where-  traverse f gs = fmap (\v -> gs { gsonValue = v }) $ f $ gsonValue gs+-- | 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 (GraphSON _ (GArray v))) = fmap List.fromList $ traverse parseGraphSON $ List.toList v+parseUnwrapList (GValue (GraphSON _ body)) = fail ("Expects GArray, but got " ++ show body) --- | Create a 'GraphSON' without 'gsonType'.+-- | Parse 'GValue' into 'FromGraphSON'. ----- >>> nonTypedGraphSON (10 :: Int)--- GraphSON {gsonType = Nothing, gsonValue = 10}-nonTypedGraphSON :: v -> GraphSON v-nonTypedGraphSON = GraphSON Nothing+-- @since 0.1.2.0+parseEither :: FromGraphSON a => GValue -> Either String a+parseEither = Aeson.parseEither parseGraphSON --- | Create a 'GraphSON' with its type ID.+-- | Like Aeson's 'Aeson..:', but for 'FromGraphSON'. ----- >>> typedGraphSON (10 :: Int32)--- GraphSON {gsonType = Just "g:Int32", gsonValue = 10}-typedGraphSON :: GraphSONTyped v => v -> GraphSON v-typedGraphSON v = GraphSON (Just $ gsonTypeFor v) v+-- @since 0.1.2.0+(.:) :: FromGraphSON a => HashMap Text GValue -> Text -> Parser a+go .: label = maybe failure parseGraphSON $ HM.lookup label go+  where+    failure = fail ("Cannot find field " ++ unpack label) --- | Create a 'GraphSON' with the given type ID.+-- | Implementation of 'parseJSON' based on 'parseGraphSON'. The input+-- 'Value' is first converted to 'GValue', and it's parsed to the+-- output type. ----- >>> typedGraphSON' "g:Int32" (10 :: Int)--- GraphSON {gsonType = Just "g:Int32", gsonValue = 10}-typedGraphSON' :: Text -> v -> GraphSON v-typedGraphSON' t = GraphSON (Just t)+-- @since 0.1.2.0+parseJSONViaGValue :: FromGraphSON a => Value -> Parser a+parseJSONViaGValue v = parseGraphSON =<< parseJSON 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 gson = case gsonType gson of-    Nothing -> toJSON $ gsonValue gson-    Just t -> object [ "@type" .= t,-                       "@value" .= gsonValue gson-                     ]+---- Trivial instances --- | 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 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+instance FromGraphSON GValue where+  parseGraphSON = return+instance FromGraphSON Int where+  parseGraphSON = parseUnwrapAll+instance FromGraphSON Text where+  parseGraphSON = parseUnwrapAll+instance FromGraphSON TL.Text where+  parseGraphSON = parseUnwrapAll+instance FromGraphSON Bool where+  parseGraphSON = parseUnwrapAll+instance FromGraphSON Double where+  parseGraphSON = parseUnwrapAll+instance FromGraphSON Float where+  parseGraphSON = parseUnwrapAll+instance FromGraphSON Int8 where+  parseGraphSON = parseUnwrapAll+instance FromGraphSON Int16 where+  parseGraphSON = parseUnwrapAll+instance FromGraphSON Int32 where+  parseGraphSON = parseUnwrapAll+instance FromGraphSON Int64 where+  parseGraphSON = parseUnwrapAll+instance FromGraphSON Integer where+  parseGraphSON = parseUnwrapAll+instance FromGraphSON Natural where+  parseGraphSON = parseUnwrapAll+instance (FromJSON a, Integral a) => FromGraphSON (Ratio a) where+  parseGraphSON = parseUnwrapAll+instance FromGraphSON Word where+  parseGraphSON = parseUnwrapAll+instance FromGraphSON Word8 where+  parseGraphSON = parseUnwrapAll+instance FromGraphSON Word16 where+  parseGraphSON = parseUnwrapAll+instance FromGraphSON Word32 where+  parseGraphSON = parseUnwrapAll+instance FromGraphSON Word64 where+  parseGraphSON = parseUnwrapAll+instance FromGraphSON Scientific where+  parseGraphSON = parseUnwrapAll+instance FromGraphSON IntSet where+  parseGraphSON = parseUnwrapAll +---- List instances --- | Types that have an intrinsic type ID for 'gsonType' field.-class GraphSONTyped a where-  gsonTypeFor :: a -> Text-  -- ^ Type ID for 'gsonType'.+instance FromGraphSON a => FromGraphSON [a] where+  parseGraphSON = parseUnwrapList+instance FromGraphSON a => FromGraphSON (Vector a) where+  parseGraphSON = parseUnwrapList+instance FromGraphSON a => FromGraphSON (Seq a) where+  parseGraphSON = parseUnwrapList -instance GraphSONTyped Char where-  gsonTypeFor _ = "gx:Char"+---- Set instances --- | Map to \"gx:Byte\". Note that Java's Byte is signed.-instance GraphSONTyped Int8 where-  gsonTypeFor _ = "gx:Byte"+instance (FromGraphSON a, Ord a) => FromGraphSON (Set a) where+  parseGraphSON = parseUnwrapList+instance (FromGraphSON a, Eq a, Hashable a) => FromGraphSON (HashSet a) where+  parseGraphSON = parseUnwrapList -instance GraphSONTyped Int16 where-  gsonTypeFor _ = "gx:Int16" -instance GraphSONTyped Int32 where-  gsonTypeFor _ = "g:Int32"+---- GMap and others -instance GraphSONTyped Int64 where-  gsonTypeFor _ = "g:Int64"+-- | Use 'parseToFlattenedMap'.+instance (FromGraphSON k, FromGraphSON v, IsList (c k v), Item (c k v) ~ (k,v)) => FromGraphSON (FlattenedMap c k v) where+  parseGraphSON gv = case gValueBody gv of+    GArray a -> parseToFlattenedMap parseGraphSON parseGraphSON a+    b -> fail ("Expects GArray, but got " ++ show b) -instance GraphSONTyped Float where-  gsonTypeFor _ = "g:Float"+parseGObjectToTraversal :: (Traversable t, FromJSON (t GValue), FromGraphSON v)+                        => HashMap Text GValue+                        -> Parser (t v)+parseGObjectToTraversal o = traverse parseGraphSON =<< (parseJSON $ Object $ fmap toJSON o) -instance GraphSONTyped Double where-  gsonTypeFor _ = "g:Double"+-- | 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 gv = case gValueBody gv of+    GObject o -> parse $ Left o+    GArray a -> parse $ Right a+    other -> fail ("Expects GObject or GArray, but got " ++ show other)+    where+      parse = parseToGMap parseGraphSON parseGraphSON parseObject+      -- parseObject = parseUnwrapTraversable . GValue . nonTypedGraphSON . GObject  --- Too many wrapping and unwrappings!!!+      parseObject = parseGObjectToTraversal -instance GraphSONTyped [a] where-  gsonTypeFor _ = "g:List"+-- | Use 'parseToGMapEntry'.+instance (FromGraphSON k, FromGraphSON v, FromJSONKey k) => FromGraphSON (GMapEntry k v) where+  parseGraphSON val = case gValueBody val of+    GObject o -> parse $ Left o+    GArray a -> parse $ Right a+    other -> fail ("Expects GObject or GArray, but got " ++ show other)+    where+      parse = parseToGMapEntry parseGraphSON parseGraphSON --- | Map to \"g:Double\".-instance GraphSONTyped Scientific where-  gsonTypeFor _ = "g:Double" --- | Note that Lazy HashMap and Strict HashMap are the same data type.-instance GraphSONTyped (HML.HashMap k v) where-  gsonTypeFor _ = "g:Map"+---- Map instances -instance GraphSONTyped (HashSet a) where-  gsonTypeFor _ = "g:Set"+instance (FromGraphSON v, Eq k, Hashable k, FromJSONKey k, FromGraphSON k) => FromGraphSON (L.HashMap k v) where+  parseGraphSON = fmap unGMap . parseGraphSON+instance (FromGraphSON v, Ord k, FromJSONKey k, FromGraphSON k) => FromGraphSON (L.Map k v) where+  parseGraphSON = fmap unGMap . parseGraphSON+-- IntMap cannot be used with GMap directly..+instance FromGraphSON v => FromGraphSON (L.IntMap v) where+  parseGraphSON = fmap (mapToIntMap . unGMap) . parseGraphSON+    where+      mapToIntMap :: L.Map Int v -> L.IntMap v+      mapToIntMap = LMap.foldrWithKey LIntMap.insert mempty +---- Maybe and Either --- | 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 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+-- | Parse 'GNull' into 'Nothing'.+instance FromGraphSON a => FromGraphSON (Maybe a) where+  parseGraphSON (GValue (GraphSON _ GNull)) = return Nothing+  parseGraphSON gv = fmap Just $ parseGraphSON gv +-- | Try 'Left', then 'Right'.+instance (FromGraphSON a, FromGraphSON b) => FromGraphSON (Either a b) where+  parseGraphSON gv = (fmap Left $ parseGraphSON gv) <|> (fmap Right $ parseGraphSON gv)+++---- Others++-- | Call 'unwrapAll' to remove all GraphSON wrappers.+instance FromGraphSON Value where+  parseGraphSON = return . unwrapAll++instance FromGraphSON UUID where+  parseGraphSON gv = case gValueBody gv of+    GString t -> maybe failure return $ UUID.fromText t+      where+        failure = fail ("Failed to parse into UUID: " ++ unpack t)+    b -> fail ("Expected GString, but got " ++ show 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 _ = return ()

@@ -0,0 +1,153 @@+{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}+-- |+-- 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+  ( 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(..))++-- $setup+-- >>> :set -XOverloadedStrings+-- >>> import Data.Int (Int32)++-- | 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.+-- +-- >>> Aeson.decode "1000" :: Maybe (GraphSON Int32)+-- Just (GraphSON {gsonType = Nothing, gsonValue = 1000})+-- >>> Aeson.decode "{\"@type\": \"g:Int32\", \"@value\": 1000}" :: Maybe (GraphSON Int32)+-- Just (GraphSON {gsonType = Just "g:Int32", gsonValue = 1000})+--+-- 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+  { gsonType :: Maybe Text,+    -- ^ Type ID, corresponding to @\@type@ field.+    gsonValue :: v+    -- ^ Value, correspoding to @\@value@ field.+  }+  deriving (Show,Eq,Ord,Generic)++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++-- | @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 gson = case gsonType gson of+    Nothing -> toJSON $ gsonValue gson+    Just t -> object [ "@type" .= t,+                       "@value" .= gsonValue 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 v@(Object o) = do+    if length o /= 2+      then parseDirect v+      else do+      mtype <- o Aeson..:! "@type"+      mvalue <- o Aeson..:! "@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+++-- | Create a 'GraphSON' without 'gsonType'.+--+-- >>> nonTypedGraphSON (10 :: Int)+-- GraphSON {gsonType = Nothing, gsonValue = 10}+nonTypedGraphSON :: v -> GraphSON v+nonTypedGraphSON = GraphSON Nothing++-- | Create a 'GraphSON' with its type ID.+--+-- >>> typedGraphSON (10 :: Int32)+-- GraphSON {gsonType = Just "g:Int32", gsonValue = 10}+typedGraphSON :: GraphSONTyped v => v -> GraphSON v+typedGraphSON v = GraphSON (Just $ gsonTypeFor v) v++-- | Create a 'GraphSON' with the given type ID.+--+-- >>> typedGraphSON' "g:Int32" (10 :: Int)+-- GraphSON {gsonType = Just "g:Int32", gsonValue = 10}+typedGraphSON' :: Text -> v -> GraphSON v+typedGraphSON' t = GraphSON (Just 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 v = either fail return =<< parseTypedGraphSON' 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' v = do+  graphsonv <- parseGraphSONPlain v+  case gsonType graphsonv of+   Nothing -> return $ Left ("Not a valid typed JSON object.")+   Just got_type -> do+     goal <- parseJSON $ gsonValue graphsonv+     let exp_type = gsonTypeFor goal +     when (got_type /= exp_type) $ do+       fail ("Expected @type of " ++ show exp_type ++ ", but got " ++ show got_type)+     return $ Right $ graphsonv { gsonValue = goal }+  where+    parseGraphSONPlain :: Value -> Parser (GraphSON Value)+    parseGraphSONPlain = parseJSON

@@ -0,0 +1,169 @@+{-# LANGUAGE DeriveGeneric #-}+-- |+-- Module: Data.Greskell.GraphSON.GValue+-- Description: Aeson Value with GraphSON wrappers+-- Maintainer: Toshio Ito <debug.ito@gmail.com>+--+-- __This module is for advanced use. Most users should just use "Data.Greskell.GraphSON".__+--+-- This module defines 'GValue' and exposes its deconstructors.+--+-- @since 0.1.2.0+module Data.Greskell.GraphSON.GValue+       ( -- * GValue type+         GValue(..),+         GValueBody(..),+         -- ** constructors+         nonTypedGValue,+         typedGValue',+         -- ** deconstructors+         -- $caveat_decon+         unwrapAll,+         unwrapOne,+         gValueBody,+         gValueType+       ) where++import Control.Applicative ((<$>), (<*>))+import Data.Aeson+  ( ToJSON(toJSON), FromJSON(parseJSON), Value(..)+  )+import Data.Aeson.Types (Parser)+import Data.Foldable (foldl')+import Data.Hashable (Hashable(..))+import Data.HashMap.Strict (HashMap)+import Data.Scientific (Scientific)+import Data.Text (Text)+import Data.Vector (Vector)+import GHC.Generics (Generic)++import Data.Greskell.GraphSON.Core+  ( nonTypedGraphSON, typedGraphSON', GraphSON(..)+  )++-- | An Aeson 'Value' wrapped in 'GraphSON' wrapper type. Basically+-- this type is the Haskell representaiton of a GraphSON-encoded+-- document.+--+-- This type is used to parse GraphSON documents. See also+-- 'Data.Greskell.GraphSON.FromGraphSON' class.+-- +-- @since 0.1.2.0+newtype GValue = GValue { unGValue :: GraphSON GValueBody }+                 deriving (Show,Eq,Generic)++instance Hashable GValue++-- | 'GValue' without the top-level 'GraphSON' wrapper.+--+-- @since 0.1.2.0+data GValueBody =+    GObject !(HashMap Text GValue)+  | GArray !(Vector GValue)+  | GString !Text+  | GNumber !Scientific+  | GBool !Bool+  | GNull+  deriving (Show,Eq,Generic)++instance Hashable GValueBody where+-- See Data.Aeson.Types.Internal+  hashWithSalt s (GObject o) = s `hashWithSalt` (0::Int) `hashWithSalt` o+  hashWithSalt s (GArray a) = foldl' hashWithSalt (s `hashWithSalt` (1::Int)) a+  hashWithSalt s (GString str) = s `hashWithSalt` (2::Int) `hashWithSalt` str+  hashWithSalt s (GNumber n) = s `hashWithSalt` (3::Int) `hashWithSalt` n+  hashWithSalt s (GBool b) = s `hashWithSalt` (4::Int) `hashWithSalt` b+  hashWithSalt s GNull = s `hashWithSalt` (5::Int)++-- | Parse 'GraphSON' wrappers recursively in 'Value', making it into+-- 'GValue'.+instance FromJSON GValue where+  parseJSON input = do+    gv <- parseJSON input+    recursed_value <- recurse $ gsonValue gv+    return $ GValue $ gv { gsonValue = recursed_value }+    where+      recurse :: Value -> Parser GValueBody+      recurse (Object o) = GObject <$> traverse parseJSON o+      recurse (Array a) = GArray <$> traverse parseJSON a+      recurse (String s) = return $ GString s+      recurse (Number n) = return $ GNumber n+      recurse (Bool b) = return $ GBool b+      recurse Null = return GNull++-- | Reconstruct 'Value' from 'GValue'. It preserves all GraphSON+-- wrappers.+instance ToJSON GValue where+  toJSON (GValue gson_body) = toJSON $ fmap toJSON gson_body++instance ToJSON GValueBody where+  toJSON (GObject o) = toJSON o+  toJSON (GArray a) = toJSON a+  toJSON (GString s) = String s+  toJSON (GNumber n) = Number n+  toJSON (GBool b) = Bool b+  toJSON GNull = Null++-- | Create a 'GValue' without \"@type\" field.+-- +-- @since 0.1.2.0+nonTypedGValue :: GValueBody -> GValue+nonTypedGValue = GValue . nonTypedGraphSON++-- | Create a 'GValue' with the given \"@type\" field.+--+-- @since 0.1.2.0+typedGValue' :: Text -- ^ \"@type\" field.+             -> GValueBody -> GValue+typedGValue' t b = GValue $ typedGraphSON' t b+++-- $caveat_decon+--+-- __In most cases, you should not use these deconstructors.__ That is+-- because internal structure of 'GValue' may vary depending on the+-- Gremlin server instance and its serializer. You should instead use+-- parsers based on 'Data.Greskell.GraphSON.FromGraphSON' class, such+-- as 'Data.Greskell.GraphSON.parseEither'.+--+-- If you are implementing parsers for GraphSON objects described in+-- Gremlin IO Reference+-- (<http://tinkerpop.apache.org/docs/current/dev/io/>), you may use+-- these descructors.+--++-- | Remove all 'GraphSON' wrappers recursively from 'GValue'.+--+-- @since 0.1.2.0+unwrapAll :: GValue -> Value+unwrapAll = unwrapBase unwrapAll++-- | Remove the top-level 'GraphSON' wrapper, but leave other wrappers+-- as-is. The remaining wrappers are reconstructed by 'toJSON' to make+-- them into 'Value'.+--+-- @since 0.1.2.0+unwrapOne :: GValue -> Value+unwrapOne = unwrapBase toJSON++unwrapBase :: (GValue -> Value) -> GValue -> Value+unwrapBase mapChild (GValue gson_body) = unwrapBody $ gsonValue gson_body+  where+    unwrapBody GNull = Null+    unwrapBody (GBool b) = Bool b+    unwrapBody (GNumber n) = Number n+    unwrapBody (GString s) = String s+    unwrapBody (GArray a) = Array $ fmap mapChild a+    unwrapBody (GObject o) = Object $ fmap mapChild o++-- | Get the 'GValueBody' from 'GValue'.+--+-- @since 0.1.2.0+gValueBody :: GValue -> GValueBody+gValueBody = gsonValue . unGValue++-- | Get the 'gsonType' field from 'GValue'.+--+-- @since 0.1.2.0+gValueType :: GValue -> Maybe Text+gValueType = gsonType . unGValue

@@ -0,0 +1,106 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module: Data.Greskell.GraphSON.GraphSONTyped+-- Description: +-- Maintainer: Toshio Ito <debug.ito@gmail.com>+--+-- __Internal module.__ Just to resolve cyclic dependency between+-- GraphSON and GMap.+module Data.Greskell.GraphSON.GraphSONTyped+       ( GraphSONTyped(..)+       ) where++import Data.Text (Text)+import Data.Vector (Vector)+import qualified Data.HashMap.Lazy as L (HashMap)+import qualified Data.HashMap.Strict as S (HashMap)+import Data.HashSet (HashSet)+import Data.Int (Int8, Int16, Int32, Int64)+import qualified Data.IntMap.Lazy as L (IntMap)+import qualified Data.IntMap.Strict as S (IntMap)+import Data.IntSet (IntSet)+import qualified Data.Map.Lazy as L (Map)+import qualified Data.Map.Strict as S (Map)+import Data.Scientific (Scientific)+import Data.Sequence (Seq)+import Data.Set (Set)+++-- | Types that have an intrinsic type ID for 'gsonType' field.+class GraphSONTyped a where+  gsonTypeFor :: a -> Text+  -- ^ Type ID for 'gsonType'.++instance GraphSONTyped Char where+  gsonTypeFor _ = "gx:Char"++-- | Map to \"gx:Byte\". Note that Java's Byte is signed.+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"++-- | @since 0.1.2.0+instance GraphSONTyped (Vector a) where+  gsonTypeFor _ = "g:List"++-- | @since 0.1.2.0+instance GraphSONTyped (Seq a) where+  gsonTypeFor _ = "g:List"++-- | Map to \"g:Double\".+instance GraphSONTyped Scientific where+  gsonTypeFor _ = "g:Double"++instance GraphSONTyped (HashSet a) where+  gsonTypeFor _ = "g:Set"++-- | @since 0.1.2.0+instance GraphSONTyped IntSet where+  gsonTypeFor _ = "g:Set"++-- | @since 0.1.2.0+instance GraphSONTyped (Set a) where+  gsonTypeFor _ = "g:Set"++instance GraphSONTyped (L.HashMap k v) where+  gsonTypeFor _ = "g:Map"++-- | @since 0.1.2.0+instance GraphSONTyped (L.Map k v) where+  gsonTypeFor _= "g:Map"++-- | @since 0.1.2.0+instance GraphSONTyped (L.IntMap v) where+  gsonTypeFor _= "g:Map"++-- -- Implementation of Lazy and Strict types are the same.+-- +-- instance GraphSONTyped (S.HashMap k v) where+--   gsonTypeFor _ = "g:Map"+-- +-- instance GraphSONTyped (S.Map k v) where+--   gsonTypeFor _= "g:Map"+-- +-- instance GraphSONTyped (S.IntMap v) where+--   gsonTypeFor _= "g:Map"++-- | @since 0.1.2.0+instance (GraphSONTyped a, GraphSONTyped b) => GraphSONTyped (Either a b) where+  gsonTypeFor e = either gsonTypeFor gsonTypeFor e

@@ -23,6 +23,9 @@          single,          number,          value,+         valueInt,+         gvalue,+         gvalueInt,          -- * Unsafe constructors          unsafeGreskell,          unsafeGreskellLazy,@@ -44,6 +47,8 @@ import Data.Text (Text, pack, unpack) import qualified Data.Text.Lazy as TL +import Data.Greskell.GraphSON (GValue, GValueBody(..), nonTypedGValue)+ -- $ -- >>> :set -XOverloadedStrings @@ -84,7 +89,7 @@     where       scriptOf accessor = TL.pack $ show $ accessor rat --- | Semigroup operator '(<>)' on 'Greskell' assumes @String@+-- | Semigroup operator '<>' on 'Greskell' assumes @String@ -- concatenation on Gremlin. instance IsString a => Semigroup (Greskell a) where   (<>) = biOp "+"@@ -145,9 +150,9 @@  -- $literals ----- Functions to create literals in Gremlin script. Use 'fromInteger'--- to create integer literals. Use 'fromRational' or 'number' to--- create floating-point data literals.+-- Functions to create literals in Gremlin script. Use 'fromInteger',+-- 'valueInt' or 'gvalueInt' to create integer literals. Use+-- 'fromRational' or 'number' to create floating-point data literals.  -- | Create a String literal in Gremlin script. The content is -- automatically escaped.@@ -185,7 +190,7 @@ -- | Make a list with a single object. Useful to prevent the Gremlin -- Server from automatically iterating the result object. ----- >>> toGremlin $ single ("hoge" :: Greskell String)+-- >>> toGremlin $ single ("hoge" :: Greskell Text) -- "[\"hoge\"]" single :: Greskell a -> Greskell [a] single g = list [g]@@ -205,6 +210,11 @@ -- "[10.0,20.0,30.0]" -- >>> toGremlin $ value $ Aeson.Object mempty -- "[:]"+--+-- Note that 'Aeson.Number' does not distinguish integers from+-- floating-point numbers, so 'value' function may format an integer+-- as a floating-point number. To ensure formatting as integers, use+-- 'valueInt'. value :: Value -> Greskell Value value Aeson.Null = unsafeGreskellLazy "null" value (Aeson.Bool b) = unsafeToValue (if b then true else false)@@ -218,7 +228,38 @@     toGroovyMap pairs = "[" <> TL.intercalate "," (map toPairText pairs) <> "]"     toPairText (key, val) = (toGremlinLazy $ string key) <> ":" <> (toGremlinLazy $ value val) +-- | Integer literal as 'Value' type.+--+-- >>> toGremlin $ valueInt (100 :: Int)+-- "100"+--+-- @since 0.1.2.0+valueInt :: Integral a => a -> Greskell Value+valueInt n = fmap toValue $ fromIntegral n+  where+    toValue :: Integer -> Value+    toValue = const Aeson.Null +-- | 'Value' literal as 'GValue' type.+--+-- @since 0.1.2.0+gvalue :: Value -> Greskell GValue+gvalue = fmap phantomToGValue . value+  where+    phantomToGValue _ = nonTypedGValue $ GNull++-- | Integer literal as 'GValue' type.+--+-- >>> toGremlin $ gvalueInt (256 :: Int)+-- "256"+--+-- @since 0.1.2.0+gvalueInt :: Integral a => a -> Greskell GValue+gvalueInt n = fmap toGValue $ fromIntegral n+  where+    toGValue :: Integer -> GValue+    toGValue = const $ nonTypedGValue $ GNull+ unsafeToValue :: Greskell a -> Greskell Value unsafeToValue = fmap (const Aeson.Null) @@ -248,7 +289,7 @@ -- | Unsafely create a 'Greskell' that calls the given object method -- call with the given target and arguments. ----- >>> toGremlin $ unsafeMethodCall ("foobar" :: Greskell String) "length" []+-- >>> toGremlin $ unsafeMethodCall ("foobar" :: Greskell Text) "length" [] -- "(\"foobar\").length()" unsafeMethodCall :: Greskell a -- ^ target object                  -> Text -- ^ method name

@@ -0,0 +1,81 @@+{-# LANGUAGE OverloadedStrings #-}+module Data.Greskell.GMapSpec (main,spec) where++import Data.Aeson (eitherDecode, object, (.=), toJSON, Value(..))+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HM+import Data.List (isInfixOf)+import Data.Monoid (mempty)+import Data.Vector ((!), Vector)+import qualified Data.Vector as Vec+import Test.Hspec++import Data.Greskell.GraphSON (GraphSON(..), typedGraphSON, nonTypedGraphSON)+import Data.Greskell.GMap (GMap(..), GMapEntry(..))++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  spec_GMap+  spec_GMapEntry++spec_GMap :: Spec+spec_GMap = describe "GraphSON GMap" $ do+  describe "non-flat" $ do+    let val :: GraphSON (GMap HashMap String Int)+        val = nonTypedGraphSON $ GMap False $ HM.fromList [("foo", 3), ("bar", 5), ("a", 1)]+    specify "FromJSON" $ do+      let input = "{\"foo\":3, \"a\": 1, \"bar\": 5}"+      eitherDecode input `shouldBe` Right val+    specify "ToJSON" $ do+      let expected = object [ "foo" .= Number 3,+                              "bar" .= Number 5,+                              "a"   .= Number 1+                            ]+      toJSON val `shouldBe` expected+    specify "FromJSON empty" $ do+      let val_empty :: GraphSON (GMap HashMap String Int)+          val_empty = nonTypedGraphSON $ GMap False mempty+      eitherDecode "{}" `shouldBe` Right val_empty+  describe "flat" $ do+    let val :: GraphSON (GMap HashMap String Int)+        val = typedGraphSON $ GMap True $ HM.fromList [("foo", 3), ("bar", 5), ("a", 1)]+    specify "FromJSON" $ do+      let input = "{\"@type\": \"g:Map\", \"@value\": [\"a\", 1, \"bar\", 5, \"foo\", 3]}"+      eitherDecode input `shouldBe` Right val+    specify "ToJSON" $ do+      let exp_flat = Vec.fromList [ String "foo", Number 3,+                                    String "bar", Number 5,+                                    String "a",   Number 1+                                  ]+          (Object got) = toJSON val+      HM.lookup "@type" got `shouldBe` (Just $ String "g:Map")+      let (Just (Array got_flat)) = HM.lookup "@value" got+      pairList got_flat `shouldMatchList` pairList exp_flat+    specify "FromJSON empty" $ do+      let val_empty :: GraphSON (GMap HashMap String Int)+          val_empty = typedGraphSON $ GMap True mempty+      eitherDecode "{\"@type\": \"g:Map\", \"@value\": []}" `shouldBe` Right val_empty++pairList :: Vector Value -> [(Value,Value)]+pairList a = map toPair $ [0 .. imax]+  where+    imax = (Vec.length a `div` 2) - 1+    toPair i = (a ! (i*2), a ! (i*2 + 1))++expLeft :: Show a => Either String a -> (String -> Bool) -> IO ()+expLeft e@(Right _) _ = expectationFailure ("expects Left, but got " ++ show e)+expLeft (Left e)    p = e `shouldSatisfy` p++spec_GMapEntry :: Spec+spec_GMapEntry = describe "GMapEntry" $ do+  specify "zero entry" $ do+    let got :: Either String (GMapEntry String Int)+        got = eitherDecode "[]"+    got `expLeft` ("0 entries" `isInfixOf`)+  specify "two entries" $ do+    let got :: Either String (GMapEntry String Int)+        got = eitherDecode "{\"foo\": 10, \"bar\": 20}"+    got `expLeft` ("Unexpected structure" `isInfixOf`)

@@ -0,0 +1,366 @@+{-# LANGUAGE OverloadedStrings, NoMonomorphismRestriction #-}+module Data.Greskell.GraphSONSpec (main,spec) where++import Data.Aeson (object, (.=), ToJSON(..), FromJSON(..), Value(..))+import qualified Data.Aeson as Aeson+import Data.Aeson.Types (parseEither, Value(..), Parser)+import qualified Data.ByteString.Lazy as BSL+import Data.Either (isLeft)+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HM+import Data.List (isInfixOf)+import Data.Int (Int32)+import Data.Monoid ((<>))+import Data.Text (Text)+import qualified Data.Vector as V+import Test.Hspec++import Data.Greskell.GMap (GMapEntry(..), unGMapEntry)+import Data.Greskell.GraphSON+  ( GraphSON, parseTypedGraphSON,+    -- parseTypedGraphSON',+    typedGraphSON', nonTypedGraphSON,+    nonTypedGValue, typedGValue',+    GValue, GValueBody(..),+    FromGraphSON(..)+  )+import Data.Greskell.GraphSON.GValue (unwrapAll, unwrapOne)++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "GrpahSON" $ do+    fromJSON_spec+    parseTypedGraphSON_spec+    -- parseTypedGraphSON'_spec+  describe "GValue" $ do+    gvalue_spec+    fromGraphSON_spec++fromJSON_spec :: Spec+fromJSON_spec = describe "FromJSON (recursive)" $ do+  let parse :: Value -> Either String (GraphSON Value)+      parse = parseEither parseJSON+      isLeftG :: Either String (GraphSON Value) -> Bool+      isLeftG = isLeft+  specify "bare map (one entry)" $ do+    let input = object ["foo" .= String "bar"]+    parse input `shouldBe` Right (nonTypedGraphSON input)+  specify "bare map (two entries)" $ do+    let input = object ["foo" .= String "bar", "quux" .= String "hoge"]+    parse input `shouldBe` Right (nonTypedGraphSON input)+  specify "wrapped string" $ do+    let input = object ["@type" .= String "g:String", "@value" .= String "hogehoge"]+    parse input `shouldBe` Right (typedGraphSON' "g:String" $ String "hogehoge")+  specify "wrapped object" $ do+    let body = object ["foo" .= String "bar"]+        input = object ["@type" .= String "g:Map", "@value" .= body]+    parse input `shouldBe` Right (typedGraphSON' "g:Map" body)+  specify "wrong @type type" $ do+    let body = object ["foo" .= String "bar"]+        input = object ["@type" .= Number 10, "@value" .= body]+    parse input `shouldSatisfy` isLeftG+  specify "null @type" $ do+    let body = object ["foo" .= String "bar"]+        input = object ["@type" .= Null, "@value" .= body]+    parse input `shouldSatisfy` isLeftG+  specify "no @value field" $ do+    let input = object ["@type" .= String "g:String", "foo" .= Null]+    parse input `shouldBe` Right (nonTypedGraphSON input)+  specify "confusing bare map (three entries)" $ do+    let input = object [ "@type" .= String "g:String",+                         "@value" .= String "hoge",+                         "@other" .= String "foo"+                       ]+    parse input `shouldBe` Right (nonTypedGraphSON input)++parseTypedGraphSON_spec :: Spec+parseTypedGraphSON_spec = describe "parseTypedGraphSON" $ do+  let parse = parseEither parseTypedGraphSON+  describe "Int32" $ do+    specify "invalid bare value" $ do+      let (Left got) = parse (String "foo") :: Either String (GraphSON Int32)+      got `shouldSatisfy` (isInfixOf "Not a valid typed JSON")+    specify "valid bare value" $ do+      let (Left got) = parse (Number 255) :: Either String (GraphSON Int32)+      got `shouldSatisfy` (isInfixOf "Not a valid typed JSON")+    specify "typed JSON with invalid @type field" $ do+      let (Left got) = parse (object ["@type" .= String "g:Int64", "@value" .= Number 255]) :: Either String (GraphSON Int32)+      got `shouldSatisfy` (isInfixOf "Expected @type")+    specify "typed JSON with valid @type field and invalid @value" $ do+      let (Left got) = parse (object ["@type" .= String "g:Int32", "@value" .= String "hoge"]) :: Either String (GraphSON Int32)+      got `shouldSatisfy` (isInfixOf "expected Int32")+    specify "typed JSON with valid @type and @value" $ do+      let got = parse (object ["@type" .= String "g:Int32", "@value" .= Number 255]) :: Either String (GraphSON Int32)+      got `shouldBe` (Right $ typedGraphSON' "g:Int32" 255)+  describe "HashMap" $ do+    specify "invalid bare value" $ do+      let (Left got) = parse (String "quux") :: Either String (GraphSON (HashMap String String))+      got `shouldSatisfy` (isInfixOf "Not a valid typed JSON")+    specify "valid bare value" $ do+      let (Left got) = parse (object ["hoge" .= String "HOGE", "foo" .= String "FOO"]) :: Either String (GraphSON (HashMap String String))+      got `shouldSatisfy` (isInfixOf "Not a valid typed JSON")+    specify "typed JSON with invalid @type field" $ do+      let (Left got) = parse (object [ "@type" .= String "g:Array",+                                       "@value" .= object ["hoge" .= String "HOGE", "foo" .= String "FOO"]+                                     ]) :: Either String (GraphSON (HashMap String String))+      got `shouldSatisfy` (isInfixOf "Expected @type")+    specify "typed JSON with valid @type field and invalid @value field" $ do+      let (Left got) = parse (object [ "@type" .= String "g:Array",+                                       "@value" .= Number 100+                                     ]) :: Either String (GraphSON (HashMap String String))+      got `shouldSatisfy` (isInfixOf "expected HashMap")+    specify "typed JSON with valid @type and @value" $ do+      let got = parse (object [ "@type" .= String "g:Map",+                                "@value" .= object ["hoge" .= String "HOGE", "foo" .= String "FOO"]+                              ]) :: Either String (GraphSON (HashMap String String))+      got `shouldBe` (Right $ typedGraphSON' "g:Map" $ HM.fromList [("hoge", "HOGE"), ("foo", "FOO")])+++-- parseTypedGraphSON'_spec :: Spec+-- parseTypedGraphSON'_spec = describe "parseTypedGraphSON'" $ do+--   let parse = parseEither parseTypedGraphSON'+--   describe "Int32" $ do+--     specify "invalid bare value" $ do+--       let (Right (Left got)) = parse (String "foo") :: Either String (Either String (GraphSON Int32))+--       got `shouldSatisfy` (isInfixOf "Not a valid typed JSON")+--     specify "valid bare value" $ do+--       let (Right (Left got)) = parse (Number 255) :: Either String (Either String (GraphSON Int32))+--       got `shouldSatisfy` (isInfixOf "Not a valid typed JSON")+--     specify "typed JSON with invalid @type field" $ do+--       let (Left got) = parse (object ["@type" .= String "g:Int64", "@value" .= Number 255]) :: Either String (Either String (GraphSON Int32))+--       got `shouldSatisfy` (isInfixOf "Expected @type")+--     specify "typed JSON with valid @type field and invalid @value" $ do+--       let (Left got) = parse (object ["@type" .= String "g:Int32", "@value" .= String "hoge"]) :: Either String (Either String (GraphSON Int32))+--       got `shouldSatisfy` (isInfixOf "expected Int32")+--     specify "typed JSON with valid @type and @value" $ do+--       let got = parse (object ["@type" .= String "g:Int32", "@value" .= Number 255]) :: Either String (Either String (GraphSON Int32))+--       got `shouldBe` (Right $ Right $ typedGraphSON' "g:Int32" 255)+--   describe "HashMap" $ do+--     specify "invalid bare value" $ do+--       let (Right (Left got)) = parse (String "quux") :: Either String (Either String (GraphSON (HashMap String String)))+--       got `shouldSatisfy` (isInfixOf "Not a valid typed JSON")+--     specify "valid bare value" $ do+--       let (Right (Left got)) = parse (object ["hoge" .= String "HOGE", "foo" .= String "FOO"])+--                                :: Either String (Either String (GraphSON (HashMap String String)))+--       got `shouldSatisfy` (isInfixOf "Not a valid typed JSON")+--     specify "typed JSON with invalid @type field" $ do+--       let (Left got) = parse (object [ "@type" .= String "g:Array",+--                                        "@value" .= object ["hoge" .= String "HOGE", "foo" .= String "FOO"]+--                                      ]) :: Either String (Either String (GraphSON (HashMap String String)))+--       got `shouldSatisfy` (isInfixOf "Expected @type")+--     specify "typed JSON with valid @type field and invalid @value field" $ do+--       let (Left got) = parse (object [ "@type" .= String "g:Array",+--                                        "@value" .= Number 100+--                                      ]) :: Either String (Either String (GraphSON (HashMap String String)))+--       got `shouldSatisfy` (isInfixOf "expected HashMap")+--     specify "typed JSON with valid @type and @value" $ do+--       let got = parse (object [ "@type" .= String "g:Map",+--                                 "@value" .= object ["hoge" .= String "HOGE", "foo" .= String "FOO"]+--                               ]) :: Either String (Either String (GraphSON (HashMap String String)))+--       got `shouldBe` (Right $ Right $ typedGraphSON' "g:Map" $ HM.fromList [("hoge", "HOGE"), ("foo", "FOO")])+++gvalue_spec :: Spec+gvalue_spec = do+  describe "FromJSON and ToJSON" $ do+    fromToJSON "bare null" "null" (bare GNull)+    fromToJSON "wrapped null" (gson "g:Int" "null") (wrapped "g:Int" GNull)+    fromToJSON "bare number" "100" (bare $ GNumber 100)+    fromToJSON "wrapped number" (gson "g:Int" "100") (wrapped "g:Int" $ GNumber 100)+    fromToJSON "bare bool" "true" (bare $ GBool True)+    fromToJSON "wrapped bool" (gson "g:Boolean" "true") (wrapped "g:Boolean" $ GBool True)+    fromToJSON "bare str" "\"hoge\"" (bare $ GString "hoge")+    fromToJSON "wrapped str" (gson "g:String" "\"hoge\"") (wrapped "g:String" $ GString "hoge")+    fromToJSON "bare array" "[null, \"foo\", 100]"+      (bare $ GArray $ fmap bare $ V.fromList [GNull, GString "foo", GNumber 100])+    fromToJSON "wrapped array" (gson "g:List" "[null, \"foo\", 100]")+      (wrapped "g:List" $ GArray $ fmap bare $ V.fromList [GNull, GString "foo", GNumber 100])+    fromToJSON "bare object" "{\"foo\": \"bar\", \"hoge\": 99, \"quux\": null}"+      (bare $ GObject $ fmap bare $ HM.fromList [("foo", GString "bar"), ("hoge", GNumber 99), ("quux", GNull)])+    fromToJSON "wrapped object" (gson "g:Map" "{\"foo\": \"bar\", \"hoge\": 99, \"quux\": null}")+      (wrapped "g:Map" $ GObject $ fmap bare $ HM.fromList [("foo", GString "bar"), ("hoge", GNumber 99), ("quux", GNull)])+    nested_spec+    double_wrap_spec+    decode_error_spec+  unwrap_spec++nestedSample :: BSL.ByteString+nestedSample = gson "g:List" ("[100, " <> elem_a <> ", " <> elem_b <> "]")+  where+    elem_a = gson "g:Map" ("{\"foo\": 100, \"bar\":" <> (gson "g:Int" "200") <> "}")+    elem_b = gson "g:List" ("[null, " <> (gson "g:Object" "null") <> ", " <> elem_c <> ", " <> (gson "g:Boolean" "false") <> "]")+    elem_c = "{\"xxx\": " <> (gson "g:Int" "200") <> ", \"yyy\": true}"++nested_spec :: Spec+nested_spec = fromToJSON "mixed nested" nestedSample expected+  where+    expected = wrapped "g:List" $ GArray $ V.fromList [ bare $ GNumber 100, exp_a, exp_b ]+    exp_a = wrapped "g:Map" $ GObject $ HM.fromList+            [ ("foo", bare $ GNumber 100),+              ("bar", wrapped "g:Int" $ GNumber 200)+            ]+    exp_b = wrapped "g:List" $ GArray $ V.fromList+            [ bare GNull,+              wrapped "g:Object" GNull,+              exp_c,+              wrapped "g:Boolean" $ GBool False+            ]+    exp_c = bare $ GObject $ HM.fromList+            [ ("xxx", wrapped "g:Int" $ GNumber 200),+              ("yyy", bare $ GBool True)+            ]++-- Basically this case should not appear in GraphSON encoding, but+-- GValue can parse it. However, the parsed GValue has a GObject with+-- "@type" and "@value" keys explicitly.+double_wrap_spec :: Spec+double_wrap_spec = fromToJSON "double wrapped" input expected+  where+    input = gson "g:Object" $ gson "g:Int" "100"+    expected = wrapped "g:Object" $ GObject $ HM.fromList+               [ ("@type", bare $ GString "g:Int"),+                 ("@value", bare $ GNumber 100)+               ]++decode_error_spec :: Spec+decode_error_spec = do+  specify "wrong @type type" $ do+    let got :: Either String GValue+        got = Aeson.eitherDecode "{\"@type\": 200, \"@value\": 100}"+    got `shouldSatisfy` isLeft+    fromLeft' got `shouldSatisfy` (isInfixOf "@type")+  specify "null @type" $ do+    let got :: Either String GValue+        got = Aeson.eitherDecode "{\"@type\": null, \"@value\": 100}"+    got `shouldSatisfy` isLeft+    fromLeft' got `shouldSatisfy` (isInfixOf "@type")++forceDecode :: FromJSON a => BSL.ByteString -> a+forceDecode json = case Aeson.eitherDecode json of+  Left err -> error ("Unexpected decode failure: " <> err)+  Right a -> a++fromToJSON :: String -> BSL.ByteString -> GValue -> Spec+fromToJSON label input_json expected = specify label $ do+  decoded `shouldBe` expected+  encoded `shouldBe` exp_enc+  where+    decoded :: GValue+    decoded = forceDecode input_json+    encoded = Aeson.toJSON decoded+    exp_enc = forceDecode input_json+    +bare :: GValueBody -> GValue+bare = nonTypedGValue++wrapped :: Text -> GValueBody -> GValue+wrapped = typedGValue'++gson :: BSL.ByteString -> BSL.ByteString -> BSL.ByteString+gson ftype fvalue = "{\"@type\":\"" <> ftype <> "\",\"@value\":" <> fvalue <> "}"++fromLeft' :: (Show a, Show b) => Either a b -> a+fromLeft' (Left a) = a+fromLeft' e = error ("Expecting Left, but got " ++ show e)++unwrap_spec :: Spec+unwrap_spec = do+  specify "unwrapAll" $ do+    let expected = Array $ V.fromList [Number 100, exp_a, exp_b]+        exp_a = object ["foo" .= Number 100, "bar" .= Number 200]+        exp_b = Array $ V.fromList [Null, Null, exp_c, Bool False]+        exp_c = object ["xxx" .= Number 200, "yyy" .= Bool True]+    (unwrapAll $ forceDecode nestedSample) `shouldBe` expected+  specify "unwrapOne" $ do+    let expected = Array $ V.fromList [Number 100, exp_a, exp_b]+        exp_a = object [ "@type" .= String "g:Map",+                         "@value" .= object ["foo" .= Number 100,+                                             "bar" .= object [ "@type" .= String "g:Int",+                                                               "@value" .= Number 200+                                                             ]+                                            ]+                       ]+        exp_b = object+                [ "@type" .= String "g:List",+                  "@value" .= ( Array $ V.fromList [ Null,+                                                     object ["@type" .= String "g:Object", "@value" .= Null],+                                                     exp_c,+                                                     object ["@type" .= String "g:Boolean", "@value" .= Bool False]+                                                   ]+                              )+                ]+        exp_c = object [ "xxx" .= object ["@type" .= String "g:Int", "@value" .= Number 200],+                         "yyy" .= Bool True+                       ]+    (unwrapOne $ forceDecode nestedSample) `shouldBe` expected++decodeG :: FromGraphSON a => BSL.ByteString -> Either String a+decodeG = parseEither parseGraphSON . forceDecode++fromGraphSON_spec :: Spec+fromGraphSON_spec = describe "FromGraphSON" $ do+  let gint n = gson "g:Int" n+  specify "bare Int" $ do+    let got :: Either String Int+        got = decodeG "199"+    got `shouldBe` Right 199+  specify "wrapped Int" $ do+    let got :: Either String Int+        got = decodeG (gson "g:Int" "256")+    got `shouldBe` Right 256+  specify "bare list" $ do+    let got :: Either String [Int]+        got = decodeG "[1, 2, 3]"+    got `shouldBe` Right [1, 2, 3]+  specify "wrapped list" $ do+    let got :: Either String [Int]+        got = decodeG (gson "g:List" ("[" <> BSL.intercalate "," (map gint ["1","2","3"]) <> "]"))+    got `shouldBe` Right [1, 2, 3]+  specify "bare map" $ do+    let got :: Either String (HashMap Text Int)+        got = decodeG "{\"foo\": 100, \"bar\": 200}"+    got `shouldBe` Right (HM.fromList [("foo", 100), ("bar", 200)])+  specify "wrapped flattened map" $ do+    let got :: Either String (HashMap Text Int)+        got = decodeG (gson "g:Map" ("[\"foo\", " <> gint "100" <> ", \"bar\", " <> gint "200"  <> "]"))+    got `shouldBe` Right (HM.fromList [("foo", 100), ("bar", 200)])+  specify "wrapped flattend map (both keys and values are wrapped)" $ do+    let got :: Either String (HashMap Int Int)+        got = decodeG (gson "g:Map" ("[" <> BSL.intercalate "," (map gint ["1","10","2","20"]) <> "]"))+    got `shouldBe` Right (HM.fromList [(1, 10), (2, 20)])+  specify "bare GMapEntry" $ do+    let got :: Either String (GMapEntry Int Text)+        got = decodeG "{\"123\": \"hoge\"}"+    got `shouldBe` Right (GMapEntry False 123 "hoge")+  specify "wrapped GMapEntry" $ do+    let got :: Either String (GMapEntry Int Text)+        got = decodeG (gson "g:Map" ("[" <> gint "123" <> ", \"hoge\"]"))+    got `shouldBe` Right (GMapEntry True 123 "hoge")+  specify "bare key-value object for GMapEntry" $ do+    let got :: Either String (GMapEntry Int Text)+        got = decodeG "{\"key\": 123, \"value\": \"hoge\"}"+    got `shouldBe` Right (GMapEntry False 123 "hoge")+  specify "bare Maybe" $ do+    let got :: Either String (Maybe Int)+        got = decodeG "null"+    got `shouldBe` Right Nothing+  specify "wrapped Maybe" $ do+    let got :: Either String (Maybe Int)+        got = decodeG (gson "g:Int" "null")+    got `shouldBe` Right Nothing+  specify "bare nested" $ do+    let got :: Either String (HashMap Int [Int])+        got = decodeG "{\"99\": [], \"33\": [1, 2, 3]}"+    got `shouldBe` Right (HM.fromList [(99, []), (33, [1,2,3])])+  specify "wrapped nested" $ do+    let got :: Either String (HashMap [Int] [Int])+        got = decodeG input+        input = gson "g:Map" $ "[" <> key_a <> "," <> val_a <> ", " <> key_b <> ", " <> val_b <> "]"+        key_a = gson "g:List" $ "[" <> gint "1" <> "," <> gint "2" <> "]"+        val_a = gson "g:List" $ "[]"+        key_b = gson "g:List" $ "[" <> gint "3" <> "," <> gint "4" <> ", " <> gint "5" <> "]"+        val_b = gson "g:List" $ "[" <> gint "6" <> "]"+    got `shouldBe` Right (HM.fromList [ ([1,2], []), ([3,4,5], [6])])