greskell 0.1.1.0 → 0.2.0.0

raw patch · 8 files changed

+704/−223 lines, 8 filesdep +greskell-websocketdep +safe-exceptionsdep +vectordep −gremlin-haskelldep ~aesondep ~greskell-coredep ~hintPVP ok

version bump matches the API change (PVP)

Dependencies added: greskell-websocket, safe-exceptions, vector

Dependencies removed: gremlin-haskell

Dependency ranges changed: aeson, greskell-core, hint, unordered-containers

API changes (from Hackage documentation)

Files

• ChangeLog.md +30/−0
• greskell.cabal +12/−9
• src/Data/Greskell.hs +5/−1
• src/Data/Greskell/GTraversal.hs +156/−18
• src/Data/Greskell/Graph.hs +224/−86
• test/Data/Greskell/GTraversalSpec.hs +8/−7
• test/Data/Greskell/GraphSpec.hs +63/−54
• test/ServerTest.hs +206/−48

@@ -1,5 +1,35 @@ # Revision history for greskell +## 0.2.0.0  -- 2018-06-21++* Confirmed test with `aeson-1.4.0.0` and `hint-0.8.0`.++### Graph module++* [BREAKING CHANGE]: Now `AVertex`, `AEdge`, `AVertexProperty` are+  based on `GValue` type, instead of `GraphSON Value`. This is for+  taking care of possibly nested GraphSON-encoded values in a generic+  way.+* [BREAKING CHANGE]: `parseOneValue`, `parseListValues`,+  `parseNonEmptyValues` functions now require `FromGraphSON`+  constraint, instead of `FromJSON`, because property types of+  `AVertex` etc have changed.+* Add `Cardinality` type and its enum instances.+* Add `KeyValue` type and `(=:)` operator.++* (internal change): `PropertyMapGeneric` is now based on+  `HashMap.Strict`.++### The top Data.Greskell module++* Re-export `GMap` and `AsIterator` modules.++### GTraversal module++* Add `gV`, `gV'`, `gAddE`, `gAddE'`, `gFrom`, `gTo`, `gProperty`,+  `gPropertyV`, `sAddV`, `sAddV'`.++ ## 0.1.1.0  -- 2018-04-08  * Add Semigroup instance to PropertyMapSingle and PropertyMapList.

@@ -1,5 +1,5 @@ name:                   greskell-version:                0.1.1.0+version:                0.2.0.0 author:                 Toshio Ito <debug.ito@gmail.com> maintainer:             Toshio Ito <debug.ito@gmail.com> license:                BSD3@@ -8,7 +8,8 @@ description:            Haskell binding for [Gremlin graph query language](http://tinkerpop.apache.org/gremlin.html).                         See [README.md](https://github.com/debug-ito/greskell/blob/master/README.md) for detail.                         .-                        This package is the main entry point of greskell family. It re-exports @greskell-core@ package,+                        This package is the main entry point of greskell family.+                        It re-exports [greskell-core](http://hackage.haskell.org/package/greskell-core) package,                         and adds some useful functions to it. category:               Data cabal-version:          >= 1.10@@ -33,12 +34,13 @@                         Data.Greskell.GTraversal   -- other-modules:           build-depends:        base >=4.9.0.0 && <4.12,-                        greskell-core >=0.1.0.0 && <0.2,+                        greskell-core >=0.1.2.0 && <0.2,                         text >=1.2.2.1 && <1.3,                         transformers >=0.5.2 && <0.6,-                        aeson >=0.11.2.1 && <1.4,+                        aeson >=0.11.2.1 && <1.5,                         unordered-containers >=0.2.7.1 && <0.3,-                        semigroups >=0.18.2 && <0.19+                        semigroups >=0.18.2 && <0.19,+                        vector >=0.12.0.1 && <0.13  test-suite spec   type:                 exitcode-stdio-1.0@@ -82,7 +84,7 @@   main-is:              HintTest.hs   build-depends:        base, hspec,                         greskell, -                        hint >=0.6 && <0.8+                        hint >=0.6 && <0.9   flag server-test@@ -96,14 +98,15 @@   ghc-options:          -Wall -fno-warn-unused-imports "-with-rtsopts=-M512m"   main-is:              ServerTest.hs   -- default-extensions:   -  other-extensions:     OverloadedStrings+  other-extensions:     OverloadedStrings, TypeFamilies   -- other-modules:   if flag(server-test)     -- Explicitly remove dependency. See https://github.com/haskell/cabal/issues/1725-    build-depends:        base, aeson, hspec, text,+    build-depends:        base, aeson, hspec, text, unordered-containers, vector,                           greskell, greskell-core,                           scientific >=0.3.4.9 && <0.4,-                          gremlin-haskell >=0.1.0.2 && <0.2+                          greskell-websocket >=0.1.0.0 && <0.2,+                          safe-exceptions >=0.1.6 && <0.2   else     buildable: False 

@@ -12,7 +12,9 @@          module Data.Greskell.GTraversal,          module Data.Greskell.Gremlin,          module Data.Greskell.Graph,-         module Data.Greskell.GraphSON+         module Data.Greskell.GraphSON,+         module Data.Greskell.GMap,+         module Data.Greskell.AsIterator        ) where  import Data.Greskell.Greskell@@ -21,3 +23,5 @@ import Data.Greskell.Gremlin import Data.Greskell.Graph import Data.Greskell.GraphSON+import Data.Greskell.GMap+import Data.Greskell.AsIterator

@@ -29,6 +29,8 @@          sV',          sE,          sE',+         sAddV,+         sAddV',          -- * GTraversal          (&.),          ($.),@@ -86,6 +88,8 @@          gRange,          -- ** Transformation steps          gFlatMap,+         gV,+         gV',          -- ** Accessor steps          gValues,          gProperties,@@ -107,8 +111,15 @@          -- ** Graph manipulation steps          gAddV,          gAddV',+         gAddE,+         gAddE',+         AddAnchor,+         gFrom,+         gTo,          gDrop,          gDropP,+         gProperty,+         gPropertyV,          -- ** @.by@ steps                    -- | @.by@ steps are not 'Walk' on their own because they are@@ -137,8 +148,10 @@ import Data.Greskell.Graph   ( Element(..), Vertex, Edge, Property(..),     AVertex, AEdge,-    T, Key+    T, Key, Cardinality,+    KeyValue(..)   )+import Data.Greskell.GraphSON (GValue) import Data.Greskell.Gremlin   ( Comparator(..),     P@@ -147,15 +160,16 @@   ( Greskell, ToGreskell(..), unsafeGreskellLazy, unsafeGreskell, unsafeFunCall,     toGremlinLazy, toGremlin   )+import Data.Greskell.AsIterator (AsIterator(IteratorItem))  -- $setup -- -- >>> :set -XOverloadedStrings -- >>> import Data.Function ((&))--- >>> import qualified Data.Aeson as Aeson--- >>> import Data.Greskell.Greskell (value)+-- >>> import Data.Greskell.Greskell (gvalueInt) -- >>> import Data.Greskell.Gremlin (pBetween, pEq, pLte, oDecr, oIncr)--- >>> import Data.Greskell.Graph (tId)+-- >>> import Data.Greskell.Graph (tId, cList, (=:), AVertex, AVertexProperty)+-- >>> import Data.Greskell.GraphSON (GValueBody(..))  -- | @GraphTraversal@ class object of TinkerPop. It takes data @s@ -- from upstream and emits data @e@ to downstream. Type @c@ is called@@ -185,7 +199,11 @@ -- use 'GTraversal' instead of 'Greskell' 'GraphTraversal'. data GraphTraversal c s e = GraphTraversal                           deriving (Show)-                                  ++-- | 'GraphTraversal' is an Iterator.+instance AsIterator (GraphTraversal c s e) where+  type IteratorItem (GraphTraversal c s e) = e+ -- | Unsafely convert output type. instance Functor (GraphTraversal c s) where   fmap _ GraphTraversal = GraphTraversal@@ -360,9 +378,9 @@  -- | Monomorphic version of 'sV'. ----- >>> toGremlin (source "g" & sV' (map (value . Aeson.Number) [1,2,3]))--- "g.V(1.0,2.0,3.0)"-sV' :: [Greskell Value]+-- >>> toGremlin (source "g" & sV' (map gvalueInt ([1,2,3] :: [Int])))+-- "g.V(1,2,3)"+sV' :: [Greskell GValue]     -> Greskell GraphTraversalSource     -> GTraversal Transform () AVertex sV' = sV@@ -376,13 +394,31 @@  -- | Monomorphic version of 'sE'. ----- >>> toGremlin (source "g" & sE' (map (value . Aeson.Number) [1]))--- "g.E(1.0)"-sE' :: [Greskell Value]+-- >>> toGremlin (source "g" & sE' (map gvalueInt ([1] :: [Int])))+-- "g.E(1)"+sE' :: [Greskell GValue]        -> Greskell GraphTraversalSource        -> GTraversal Transform () AEdge sE' = sE +-- | @.addV()@ method on 'GraphTraversalSource'.+--+-- @since 0.2.0.0+sAddV :: Vertex v+      => Greskell Text -- ^ vertex label+      -> Greskell GraphTraversalSource+      -> GTraversal SideEffect () v+sAddV label src = GTraversal $ sourceMethod "addV" [label] src++-- | Monomorphic version of 'sAddV'.+--+-- >>> toGremlin (source "g" & sAddV' "person")+-- "g.addV(\"person\")"+--+-- @since 0.2.0.0+sAddV' :: Greskell Text -> Greskell GraphTraversalSource -> GTraversal SideEffect () AVertex+sAddV' = sAddV+ -- | Unsafely create 'GTraversal' from the given raw Gremlin script. -- -- >>> toGremlin $ unsafeGTraversal "g.V().count()"@@ -531,8 +567,8 @@  -- | @.hasId@ step. ----- >>> toGremlin (source "g" & sV' [] &. gHasId (value $ Aeson.Number 7))--- "g.V().hasId(7.0)"+-- >>> toGremlin (source "g" & sV' [] &. gHasId (gvalueInt $ (7 :: Int)))+-- "g.V().hasId(7)" gHasId :: (Element s, WalkType c) => Greskell (ElementID s) -> Walk c s s gHasId = liftWalk . gHasId' @@ -542,8 +578,8 @@  -- | @.hasId@ step with 'P' type. Supported since TinkerPop 3.2.7. ----- >>> toGremlin (source "g" & sV' [] &. gHasIdP (pLte $ value $ Aeson.Number 100))--- "g.V().hasId(P.lte(100.0))"+-- >>> toGremlin (source "g" & sV' [] &. gHasIdP (pLte $ gvalueInt (100 :: Int)))+-- "g.V().hasId(P.lte(100))" gHasIdP :: (Element s, WalkType c)         => Greskell (P (ElementID s))         -> Walk c s s@@ -721,7 +757,7 @@ instance IsString (ByComparator s) where   fromString = ByComparatorProj . fromString --- | @.by@ step with 1 argumernt, used for comparison.+-- | @.by@ step with 1 argument, used for comparison. gBy1 :: (ProjectionLike p, ToGreskell p) => p -> ByComparator (ProjectionLikeStart p) gBy1 = ByComparatorProj . gBy @@ -741,6 +777,12 @@ -- "g.V().order().by(\"age\",Order.decr).by(T.id)" -- >>> toGremlin (source "g" & sV' [] &. gOrder [gBy2 (gOut' ["knows"] >>> gCount) oIncr, gBy2 tId oIncr]) -- "g.V().order().by(__.out(\"knows\").count(),Order.incr).by(T.id,Order.incr)"+--+-- 'ByComparator' is an 'IsString', meaning projection by the given+-- key.+--+-- >>> toGremlin (source "g" & sV' [] &. gOrder ["age"])+-- "g.V().order().by(\"age\")" gOrder :: [ByComparator s] -- ^ following @.by@ steps.        -> Walk Transform s s gOrder bys = modulateWith order_step by_steps@@ -771,7 +813,21 @@ -- gFlatMap' :: (ToGTraversal g, Split c m, Lift Transform p, Lift m p) => g c s e -> Walk p s e -- gFlatMap = undefined +-- | @.V@ step.+--+-- For each input item, @.V@ step emits vertices selected by the+-- argument (or all vertices if the empty list is passed.)+--+-- @since 0.2.0.0+gV :: Vertex v => [Greskell (ElementID v)] -> Walk Transform s v+gV ids = unsafeWalk "V" $ map toGremlin ids +-- | Monomorphic version of 'gV'.+--+-- @since 0.2.0.0+gV' :: [Greskell GValue] -> Walk Transform s AVertex+gV' = gV+ -- | @.values@ step. -- -- >>> toGremlin (source "g" & sV' [] &. gValues ["name", "age"])@@ -810,8 +866,8 @@  -- | Monomorphic version of 'gOut'. ----- >>> toGremlin (source "g" & sV' ["person"] &. gOut' ["knows"])--- "g.V(\"person\").out(\"knows\")"+-- >>> toGremlin (source "g" & sV' [gvalueInt (8 :: Int)] &. gOut' ["knows"])+-- "g.V(8).out(\"knows\")" gOut' :: (Vertex v)       => [Greskell Text]       -> Walk Transform v AVertex@@ -892,3 +948,85 @@ -- "g.E().properties(\"weight\").drop()" gDropP :: Property p => Walk SideEffect (p a) (p a) gDropP = unsafeWalk "drop" []++-- | simple @.property@ step. It adds a value to the property.+--+-- >>> toGremlin (source "g" & sV' [] & liftWalk &. gProperty "age" (20 :: Greskell Int))+-- "g.V().property(\"age\",20)"+--+-- @since 0.2.0.0+gProperty :: Element e+          => Key e v -- ^ key of the property+          -> Greskell v -- ^ value of the property+          -> Walk SideEffect e e+gProperty key val = unsafeWalk "property" [toGremlin key, toGremlin val]++-- | @.property@ step for 'Vertex'.+--+-- >>> let key_location = "location" :: Key AVertex Text+-- >>> let key_since = "since" :: Key (AVertexProperty Text) Text+-- >>> let key_score = "score" :: Key (AVertexProperty Text) Int+-- >>> toGremlin (source "g" & sV' [] & liftWalk &. gPropertyV (Just cList) key_location "New York" [key_since =: "2012-09-23", key_score =: 8])+-- "g.V().property(list,\"location\",\"New York\",\"since\",\"2012-09-23\",\"score\",8)"+--+-- @since 0.2.0.0+gPropertyV :: (Vertex e, vp ~ ElementProperty e, Property vp, Element (vp v))+           => Maybe (Greskell Cardinality) -- ^ optional cardinality of the vertex property.+           -> Key e v -- ^ key of the vertex property+           -> Greskell v -- ^ value of the vertex property+           -> [KeyValue (vp v)] -- ^ optional meta-properties for the vertex property.+           -> Walk SideEffect e e+gPropertyV mcard key val metaprops = unsafeWalk "property" (arg_card ++ arg_keyval ++ arg_metaprops)+  where+    arg_card = maybe [] (\card -> [toGremlin card]) mcard+    arg_keyval = [toGremlin key, toGremlin val]+    arg_metaprops = expand =<< metaprops+      where+        expand (KeyValue meta_key meta_val) = [toGremlin meta_key, toGremlin meta_val]++-- | Vertex anchor for 'gAddE'. It corresponds to @.from@ or @.to@+-- step following an @.addE@ step.+--+-- Type @s@ is the input Vertex for the @.addE@ step. Type @e@ is the+-- type of the anchor Vertex that the 'AddAnchor' yields. So, @.addE@+-- step creates an edge between @s@ and @e@.+--+-- @since 0.2.0.0+data AddAnchor s e = AddAnchor Text (GTraversal Transform s e)++anchorStep :: WalkType c => AddAnchor s e -> Walk c edge edge+anchorStep (AddAnchor step_name subtraversal) = unsafeWalk step_name [toGremlin subtraversal]++-- | @.from@ step with a traversal.+-- +-- @since 0.2.0.0+gFrom :: (ToGTraversal g) => g Transform s e -> AddAnchor s e+gFrom = AddAnchor "from" . toGTraversal++-- | @.to@ step with a traversal.+--+-- @since 0.2.0.0+gTo :: (ToGTraversal g) => g Transform s e -> AddAnchor s e+gTo = AddAnchor "to" . toGTraversal++-- | @.addE@ step. Supported since TinkerPop 3.1.0.+--+-- >>> let key_name = "name" :: Key AVertex Text+-- >>> toGremlin (source "g" & sV' [] & liftWalk &. gAddE' "knows" (gFrom $ gV' [] >>> gHas2 key_name "marko"))+-- "g.V().addE(\"knows\").from(__.V().has(\"name\",\"marko\"))"+-- >>> toGremlin (source "g" & sV' [] &. gHas2 key_name "marko" & liftWalk &. gAddE' "knows" (gTo $ gV' []))+-- "g.V().has(\"name\",\"marko\").addE(\"knows\").to(__.V())"+-- +-- @since 0.2.0.0+gAddE :: (Vertex vs, Vertex ve, Edge e)+      => Greskell Text+      -> AddAnchor vs ve+      -> Walk SideEffect vs e+gAddE label anch = (unsafeWalk "addE" [toGremlin label]) >>> anchorStep anch++-- | Monomorphic version of 'gAddE'+-- +-- @since 0.2.0.0+gAddE' :: Greskell Text -> AddAnchor AVertex AVertex -> Walk SideEffect AVertex AEdge+gAddE' = gAddE+

@@ -1,4 +1,4 @@-{-# LANGUAGE TypeFamilies, OverloadedStrings, FlexibleInstances, GeneralizedNewtypeDeriving, DeriveTraversable #-}+{-# LANGUAGE TypeFamilies, OverloadedStrings, FlexibleInstances, GeneralizedNewtypeDeriving, DeriveTraversable, GADTs #-} {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} -- | -- Module: Data.Greskell.Graph@@ -19,13 +19,20 @@          tKey,          tLabel,          tValue,+         -- * Cardinality Enum+         Cardinality,+         cList,+         cSet,+         cSingle,          -- * Typed Key (accessor of a Property)          Key(..),          key,+         -- ** key-value pair+         KeyValue(..),+         (=:),          -- * Concrete data types-         --          -- $concrete_types-         --+                   -- ** Vertex          AVertex(..),          -- ** Edge@@ -45,14 +52,14 @@          parseNonEmptyValues,          fromProperties,          -- * Internal use-         FromJSONWithKey+         FromGraphSONWithKey        ) where  import Control.Applicative (empty, (<$>), (<*>), (<|>))-import Data.Aeson (Value(..), FromJSON(..), (.:), (.:?), Object)+import Data.Aeson (Value(..), FromJSON(..)) import Data.Aeson.Types (Parser) import Data.Foldable (toList, Foldable(foldr), foldlM)-import qualified Data.HashMap.Lazy as HM+import qualified Data.HashMap.Strict as HM import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NL import Data.Maybe (listToMaybe)@@ -62,13 +69,24 @@ import Data.String (IsString(..)) import Data.Text (Text, unpack) import Data.Traversable (Traversable(traverse))+import Data.Vector (Vector) -import Data.Greskell.GraphSON (GraphSON(..), GraphSONTyped(..), parseTypedGraphSON)+import Data.Greskell.GraphSON+  ( GraphSON(..), GraphSONTyped(..), FromGraphSON(..),+    (.:), GValue, GValueBody(..),+    parseJSONViaGValue+  )+import Data.Greskell.GraphSON.GValue (gValueBody, gValueType) import Data.Greskell.Greskell   ( Greskell, unsafeGreskellLazy, string,     ToGreskell(..)   ) +-- $setup+--+-- >>> import Data.Greskell.Greskell (toGremlin)++ -- | @org.apache.tinkerpop.gremlin.structure.Element@ interface in a -- TinkerPop graph. class Element e where@@ -125,7 +143,43 @@ tValue :: (Element (p v), Property p) => Greskell (T (p v) v) tValue = unsafeGreskellLazy "T.value" +-- | @org.apache.tinkerpop.gremlin.structure.VertexProperty.Cardinality@ enum.+--+-- @since 0.2.0.0+data Cardinality +-- Developer note: while 'tId' creates a Greskell of "T.id", 'cList'+-- creates just "list", not "VertexProperty.Cardinality.list". This is+-- because Neptune (Amazon's cloud-based graph database) happens to+-- support "list" but not "VertexProperty.Cardinality.list" (it+-- supports "T.id", though.)+-- See https://docs.aws.amazon.com/neptune/latest/userguide/access-graph-gremlin-differences.html+--+-- Future versions of greskell may support some configuration+-- mechanism to control how to format Gremlin symbols such as those in+-- Cardinality, T, Order, P, Direction etc.++-- | @list@ Cardinality.+--+-- >>> toGremlin cList+-- "list"+--+-- @since 0.2.0.0+cList :: Greskell Cardinality+cList = unsafeGreskellLazy "list"++-- | @set@ Cardinality.+--+-- @since 0.2.0.0+cSet :: Greskell Cardinality+cSet = unsafeGreskellLazy "set"++-- | @single@ Cardinality.+--+-- @since 0.2.0.0+cSingle :: Greskell Cardinality+cSingle = unsafeGreskellLazy "single"+ -- | A property key accessing value @b@ in an Element @a@. In Gremlin, -- it's just a String type. newtype Key a b = Key { unKey :: Greskell Text }@@ -148,38 +202,59 @@ key :: Text -> Key a b key = Key . string --- $concrete_types++-- | Pair of 'Key' and its value. ----- Concrete data types based on aeson 'Value's.+-- Type @a@ is the type of 'Element' that keeps the 'KeyValue'+-- pair. It drops the type of the value, so that you can construct a+-- heterogeneous list of key-value pairs for a given 'Element'. ----- Element IDs and property values are all 'Value', because they are--- highly polymorphic. They are wrapped with 'GraphSON', so that you--- can inspect 'gsonType' field if present. 'ElementID' and--- 'EdgeVertexID' are bare 'Value' type for convenience.+-- @since 0.2.0.0+data KeyValue a where+  KeyValue :: Key a b -> Greskell b -> KeyValue a++-- | Constructor operator of 'KeyValue'. --+-- @since 0.2.0.0+(=:) :: Key a b -> Greskell b -> KeyValue a+(=:) = KeyValue++-- $concrete_types+-- Concrete data types based on Aeson data types.+--+-- Element IDs and property values are all 'GValue', because they are+-- highly polymorphic. 'ElementID' and 'EdgeVertexID' are 'GValue',+-- too.+-- -- As for properties, you can use 'PropertyMap' and other type-classes -- to manipulate them. -- -- If you want to define your own graph structure types, see -- [README.md](https://github.com/debug-ito/greskell#make-your-own-graph-structure-types)--- for detail.+-- for detail. Basically you can use 'FromGraphSON' instances of these+-- concrete data types to implement parsers for your own types.+--+-- NOTE: In version 0.1.1.0 and before, these conrete data types were+-- based on @GraphSON Value@. In version 0.2.0.0, this was changed to+-- 'GValue', so that it can parse nested data structures encoded in+-- GraphSON.   -- | General vertex type you can use for 'Vertex' class, based on--- aeson data types.+-- Aeson data types. data AVertex =   AVertex-  { avId :: GraphSON Value,+  { avId :: GValue,     -- ^ ID of this vertex     avLabel :: Text,     -- ^ Label of this vertex-    avProperties :: PropertyMapList AVertexProperty (GraphSON Value)+    avProperties :: PropertyMapList AVertexProperty GValue     -- ^ Properties of this vertex.   }   deriving (Show,Eq)  instance Element AVertex where-  type ElementID AVertex = Value+  type ElementID AVertex = GValue   type ElementProperty AVertex = AVertexProperty  instance Vertex AVertex@@ -188,17 +263,21 @@   gsonTypeFor _ = "g:Vertex"  instance FromJSON AVertex where-  parseJSON (Object o) = AVertex-                         <$> (o .: "id")-                         <*> (o .: "label")-                         <*> (o `optionalMonoid` "properties")-  parseJSON _ = empty+  parseJSON = parseJSONViaGValue --- | General edge type you can use for 'Edge' class, based on aeson+instance FromGraphSON AVertex where+  parseGraphSON gv = case gValueBody gv of+    GObject o -> AVertex+                 <$> (o .: "id")+                 <*> (o .: "label")+                 <*> (o `optionalMonoid` "properties")+    _ -> empty++-- | General edge type you can use for 'Edge' class, based on Aeson -- data types. data AEdge =   AEdge-  { aeId :: GraphSON Value,+  { aeId :: GValue,     -- ^ ID of this edge.     aeLabel :: Text,     -- ^ Label of this edge.@@ -206,48 +285,59 @@     -- ^ Label of this edge's destination vertex.     aeOutVLabel :: Text,     -- ^ Label of this edge's source vertex.-    aeInV :: GraphSON Value,+    aeInV :: GValue,     -- ^ ID of this edge's destination vertex.-    aeOutV :: GraphSON Value,+    aeOutV :: GValue,     -- ^ ID of this edge's source vertex.-    aeProperties :: PropertyMapSingle AProperty (GraphSON Value)+    aeProperties :: PropertyMapSingle AProperty GValue     -- ^ Properties of this edge.   }   deriving (Show,Eq)  instance Element AEdge where-  type ElementID AEdge = Value+  type ElementID AEdge = GValue   type ElementProperty AEdge = AProperty  instance Edge AEdge where-  type EdgeVertexID AEdge = Value+  type EdgeVertexID AEdge = GValue  instance GraphSONTyped AEdge where   gsonTypeFor _ = "g:Edge"  instance FromJSON AEdge where-  parseJSON (Object o) =-    AEdge-    <$> (o .: "id")-    <*> (o .: "label")-    <*> (o .: "inVLabel")-    <*> (o .: "outVLabel")-    <*> (o .: "inV")-    <*> (o .: "outV")-    <*> (o `optionalMonoid` "properties")-  parseJSON _ = empty+  parseJSON = parseJSONViaGValue -optionalMonoid :: (Monoid m, FromJSON m) => Object -> Text -> Parser m-optionalMonoid obj field_name = fmap (maybe mempty id) (obj .:? field_name)+instance FromGraphSON AEdge where+  parseGraphSON gv = case gValueBody gv of+    GObject o -> AEdge+                 <$> (o .: "id")+                 <*> (o .: "label")+                 <*> (o .: "inVLabel")+                 <*> (o .: "outVLabel")+                 <*> (o .: "inV")+                 <*> (o .: "outV")+                 <*> (o `optionalMonoid` "properties")+    _ -> empty +optionalMonoid :: (Monoid m, FromGraphSON m) => HM.HashMap Text GValue -> Text -> Parser m+optionalMonoid obj field_name = maybe (return mempty) parseGraphSON $ nullToNothing =<< HM.lookup field_name obj+  where+    nullToNothing gv = case gValueBody gv of+      GNull -> Nothing+      _ -> Just gv+ -- | __This typeclass is for internal use.__ ----- JSON parser with a property key given from outside.-class FromJSONWithKey a where-  parseJSONWithKey :: Text -> Value -> Parser a+-- GraphSON parser with a property key given from outside.+--+-- @since 0.2.0.0+class FromGraphSONWithKey a where+  parseGraphSONWithKey :: Text -> GValue -> Parser a   -- | General simple property type you can use for 'Property' class.+--+-- If you are not sure about the type @v@, just use 'GValue'. data AProperty v =   AProperty   { apKey :: Text,@@ -256,14 +346,21 @@   deriving (Show,Eq,Ord)  -- | Parse Property of GraphSON 1.0.-instance FromJSON v => FromJSON (AProperty v) where-  parseJSON (Object o) =-    AProperty <$> (o .: "key") <*> (o .: "value")-  parseJSON _ = empty+--+-- In version 0.1.1.0 and before, the constraint was @FromJSON v@.+-- This has changed.+instance FromGraphSON v => FromJSON (AProperty v) where+  parseJSON = parseJSONViaGValue -instance FromJSON v => FromJSONWithKey (AProperty v) where-  parseJSONWithKey k v = AProperty k <$> parseJSON v+-- | Parse Property of GraphSON 1.0.+instance FromGraphSON v => FromGraphSON (AProperty v) where+  parseGraphSON gv = case gValueBody gv of+    GObject o -> AProperty <$> (o .: "key") <*> (o .: "value")+    _ -> empty +instance FromGraphSON v => FromGraphSONWithKey (AProperty v) where+  parseGraphSONWithKey k v = AProperty k <$> parseGraphSON v+ instance Property AProperty where   propertyKey = apKey   propertyValue = apValue@@ -281,40 +378,48 @@   traverse f sp = fmap (\v -> sp { apValue = v } ) $ f $ apValue sp  -- | General vertex property type you can use for VertexProperty,--- based on aeson data types.+-- based on Aeson data types.+--+-- If you are not sure about the type @v@, just use 'GValue'. data AVertexProperty v =   AVertexProperty-  { avpId :: GraphSON Value,+  { avpId :: GValue,     -- ^ ID of this vertex property.     avpLabel :: Text,     -- ^ Label and key of this vertex property.     avpValue :: v,     -- ^ Value of this vertex property.-    avpProperties :: PropertyMapSingle AProperty (GraphSON Value)+    avpProperties :: PropertyMapSingle AProperty GValue     -- ^ (meta)properties of this vertex property.   }   deriving (Show,Eq) -instance FromJSON v => FromJSON (AVertexProperty v) where-  parseJSON v@(Object o) = do-    label <- o .: "label"-    parseJSONWithKey label v-  parseJSON _ = empty+-- | In version 0.1.1.0 and before, the constraint was @FromJSON v@.+-- This has changed.+instance FromGraphSON v => FromJSON (AVertexProperty v) where+  parseJSON = parseJSONViaGValue -instance FromJSON v => FromJSONWithKey (AVertexProperty v) where-  parseJSONWithKey k (Object o) = AVertexProperty-                                    <$> (o .: "id")-                                    <*> pure k-                                    <*> (o .: "value")-                                    <*> (o `optionalMonoid` "properties")-  parseJSONWithKey _ _ = empty+instance FromGraphSON v => FromGraphSON (AVertexProperty v) where+  parseGraphSON gv = case gValueBody gv of+    GObject o -> do+      label <- o .: "label"+      parseGraphSONWithKey label gv+    _ -> empty +instance FromGraphSON v => FromGraphSONWithKey (AVertexProperty v) where+  parseGraphSONWithKey k gv = case gValueBody gv of+    GObject o -> AVertexProperty+                 <$> (o .: "id")+                 <*> pure k+                 <*> (o .: "value")+                 <*> (o `optionalMonoid` "properties")+    _ -> empty  instance GraphSONTyped (AVertexProperty v) where   gsonTypeFor _ = "g:VertexProperty"  instance Element (AVertexProperty v) where-  type ElementID (AVertexProperty v) = Value+  type ElementID (AVertexProperty v) = GValue   type ElementProperty (AVertexProperty v) = AProperty  instance Property AVertexProperty where@@ -362,20 +467,29 @@ notExistErrorMsg :: Text -> String notExistErrorMsg k = "Property '" ++ unpack k ++ "' does not exist." --- | Lookup a property 'Value' by the given key, and parse it.-parseOneValue :: (PropertyMap m, Property p, FromJSON v) => Text -> m p (GraphSON Value) -> Parser v-parseOneValue k pm = maybe (fail err_msg) (parseJSON . gsonValue) $ lookupOneValue k pm+-- | Lookup a property 'GValue' by the given key, and parse it.+-- +-- In version 0.1.1.0 and before, this function took an argument @m p (GraphSON Value)@.+-- This has changed, because property types for 'AVertex' etc have changed.+parseOneValue :: (PropertyMap m, Property p, FromGraphSON v) => Text -> m p GValue -> Parser v+parseOneValue k pm = maybe (fail err_msg) parseGraphSON $ lookupOneValue k pm   where     err_msg = notExistErrorMsg k  -- | Lookup a list of property values from a 'PropertyMap' by the -- given key, and parse them.-parseListValues :: (PropertyMap m, Property p, FromJSON v) => Text -> m p (GraphSON Value) -> Parser [v]-parseListValues k pm = mapM (parseJSON . gsonValue) $ lookupListValues k pm+-- +-- In version 0.1.1.0 and before, this function took an argument @m p (GraphSON Value)@.+-- This has changed, because property types for 'AVertex' etc have changed.+parseListValues :: (PropertyMap m, Property p, FromGraphSON v) => Text -> m p GValue -> Parser [v]+parseListValues k pm = mapM parseGraphSON $ lookupListValues k pm  -- | Like 'parseListValues', but this function 'fail's when there is -- no property with the given key.-parseNonEmptyValues :: (PropertyMap m, Property p, FromJSON v) => Text -> m p (GraphSON Value) -> Parser (NonEmpty v)+--+-- In version 0.1.1.0 and before, this function took an argument @m p (GraphSON Value)@.+-- This has changed, because property types for 'AVertex' etc have changed.+parseNonEmptyValues :: (PropertyMap m, Property p, FromGraphSON v) => Text -> m p GValue -> Parser (NonEmpty v) parseNonEmptyValues k pm = toNonEmpty =<< parseListValues k pm   where     toNonEmpty [] = fail $ notExistErrorMsg k@@ -422,20 +536,32 @@ allPropertiesGeneric :: Foldable t => PropertyMapGeneric t p v -> [p v] allPropertiesGeneric (PropertyMapGeneric hm) = concat $ map toList $ HM.elems hm -parsePropertiesGeneric :: (Property p, PropertyMap m, Monoid (m p v), GraphSONTyped (p v), FromJSON (p v), FromJSONWithKey (p v))-                       => (Value -> Parser [Value])-                       -> Value+parsePropertiesGeneric :: (Property p, PropertyMap m, Monoid (m p v), GraphSONTyped (p v), FromGraphSON (p v), FromGraphSONWithKey (p v))+                       => (GValue -> Parser (Vector GValue))+                       -> GValue                        -> Parser (m p v)-parsePropertiesGeneric normalizeCardinality (Object obj) = foldlM folder mempty $ HM.toList obj+parsePropertiesGeneric normalizeCardinality gv = case gValueBody gv of+  GObject obj -> foldlM folder mempty $ HM.toList obj+  _ -> empty   where     folder pm (k, value) = fmap (foldr putProperty pm) $ traverse (parseProperty k) =<< normalizeCardinality value-    parseProperty k value = (fmap gsonValue $ parseTypedGraphSON value) <|> parseJSONWithKey k value-parsePropertiesGeneric _ _ = empty+    parseProperty k value = parseTypedGValue value <|> parseGraphSONWithKey k value -expectAesonArray :: Value -> Parser [Value]-expectAesonArray (Array a) = return $ toList a-expectAesonArray _ = empty+-- parhaps we might as well place it in GraphSON module and let it export.+parseTypedGValue :: (GraphSONTyped v, FromGraphSON v) => GValue -> Parser v+parseTypedGValue  gv = do+  prop <- parseGraphSON gv+  let exp_type = gsonTypeFor prop+      mgot_type = gValueType gv+  if mgot_type /= Just exp_type+    then fail ("Expected @type field of " ++ unpack exp_type ++ ", but got " ++ show mgot_type)+    else return prop +expectAesonArray :: GValue -> Parser (Vector GValue)+expectAesonArray gv = case gValueBody gv of+  GArray a -> return a+  _ -> empty+ -- | A 'PropertyMap' that has a single value per key. -- -- 'putProperty' replaces the old property by the given property.@@ -453,10 +579,16 @@   removeProperty t (PropertyMapSingle pg) = PropertyMapSingle $ removePropertyGeneric t pg   allProperties (PropertyMapSingle pg) = allPropertiesGeneric pg -instance (Property p, GraphSONTyped (p v), FromJSON (p v), FromJSONWithKey (p v))+-- | In version 0.1.1.0 and before, the constraint was @FromJSON v@.+-- This has changed.+instance (Property p, GraphSONTyped (p v), FromGraphSON (p v), FromGraphSONWithKey (p v))          => FromJSON (PropertyMapSingle p v) where-  parseJSON = parsePropertiesGeneric (return . return)+  parseJSON = parseJSONViaGValue +instance (Property p, GraphSONTyped (p v), FromGraphSON (p v), FromGraphSONWithKey (p v))+         => FromGraphSON (PropertyMapSingle p v) where+  parseGraphSON = parsePropertiesGeneric (return . return)+ -- | A 'PropertyMap' that can keep more than one values per key. -- -- 'lookupOne' returns the first property associated with the given@@ -476,7 +608,13 @@   removeProperty t (PropertyMapList pg) = PropertyMapList $ removePropertyGeneric t pg   allProperties (PropertyMapList pg) = allPropertiesGeneric pg -instance (Property p, GraphSONTyped (p v), FromJSON (p v), FromJSONWithKey (p v))+-- | In version 0.1.1.0 and before, the constraint was @FromJSON v@.+-- This has changed.+instance (Property p, GraphSONTyped (p v), FromGraphSON (p v), FromGraphSONWithKey (p v))          => FromJSON (PropertyMapList p v) where-  parseJSON v = parsePropertiesGeneric expectAesonArray v+  parseJSON = parseJSONViaGValue++instance (Property p, GraphSONTyped (p v), FromGraphSON (p v), FromGraphSONWithKey (p v))+         => FromGraphSON (PropertyMapList p v) where+  parseGraphSON v = parsePropertiesGeneric expectAesonArray v 

@@ -18,8 +18,9 @@     Key, key,     tLabel, tId   )+import Data.Greskell.GraphSON (nonTypedGValue, GValueBody(..)) import Data.Greskell.Greskell-  ( toGremlin, Greskell, value)+  ( toGremlin, Greskell, gvalueInt) import Data.Greskell.GTraversal   ( Walk, Transform,     source, (&.), ($.), sV', sE',@@ -47,8 +48,8 @@   specify "g.V()" $ do     (toGremlin $ sV' [] $ source "g") `shouldBe` ("g.V()")   specify "g.V(1,2,3)" $ do-    let ids = [1,2,3] :: [Greskell Int]-    (toGremlin $ sV' (map (fmap toJSON) ids) $ source "g") `shouldBe` ("g.V(1,2,3)")+    let ids = map gvalueInt $ ([1,2,3] :: [Int])+    (toGremlin $ sV' ids $ source "g") `shouldBe` ("g.V(1,2,3)")  spec_order_by :: Spec spec_order_by = describe "gOrder" $ do@@ -88,8 +89,8 @@     let gt = source "g" & sV' [] &. gHas2P ("x" :: Key e Int) (pEq 100) &. gOut' [] &. gRange 0 100     toGremlin gt `shouldBe` "g.V().has(\"x\",P.eq(100)).out().range(0,100)"   specify "(&) and (&.) and (>>>)" $ do-    let gt = source "g" & sV' [value $ Number 200] &. (gOut' [] >>> gOut' ["friends_to"] >>> gValues ["name"])-    toGremlin gt `shouldBe` "g.V(200.0).out().out(\"friends_to\").values(\"name\")"+    let gt = source "g" & sV' [gvalueInt (200 :: Int)] &. (gOut' [] >>> gOut' ["friends_to"] >>> gValues ["name"])+    toGremlin gt `shouldBe` "g.V(200).out().out(\"friends_to\").values(\"name\")"   specify "($) and ($.)" $ do     let gt = gRange 20 30 $. gNot (gOut' ["friends_to"]) $. sV' [] $ source "g"     toGremlin gt `shouldBe` "g.V().not(__.out(\"friends_to\")).range(20,30)"@@ -116,8 +117,8 @@         `shouldBe` "g.E().hasLabel(P.neq(\"friends_to\"))"   describe "gHasIdP" $ do     specify "P" $ do-      toGremlin (source "g" & sV' [] &. gHasIdP (pInside (value $ Number 10) (value $ Number 20)))-        `shouldBe` "g.V().hasId(P.inside(10.0,20.0))"+      toGremlin (source "g" & sV' [] &. gHasIdP (pInside (gvalueInt (10 :: Int)) (gvalueInt (20 :: Int))))+        `shouldBe` "g.V().hasId(P.inside(10,20))"   describe "gHasKeyP, gProperties" $ do     specify "P" $ do       toGremlin (source "g" & sV' [] &. gProperties [] &. gHasKeyP (pEq "hoge"))

@@ -14,7 +14,8 @@     AEdge(..), AVertexProperty(..), AVertex(..)   ) import Data.Greskell.GraphSON-  ( nonTypedGraphSON, typedGraphSON, typedGraphSON'+  ( nonTypedGraphSON, typedGraphSON, typedGraphSON',+    nonTypedGValue, typedGValue', GValueBody(..)   )  main :: IO ()@@ -123,27 +124,27 @@   it "should parse GraphSON v1" $ do     let expected = nonTypedGraphSON                    $ AEdge-                   { aeId = nonTypedGraphSON $ toJSON (13 :: Int),+                   { aeId = nonTypedGValue $ GNumber 13,                      aeLabel = "develops",                      aeInVLabel = "software",                      aeOutVLabel = "person",-                     aeInV = nonTypedGraphSON $ toJSON (10 :: Int),-                     aeOutV = nonTypedGraphSON $ toJSON (1 :: Int),+                     aeInV = nonTypedGValue $ GNumber 10,+                     aeOutV = nonTypedGValue $ GNumber 1,                      aeProperties = putProperty-                                    (AProperty "since" $ nonTypedGraphSON $ toJSON (2009 :: Int))+                                    (AProperty "since" $ nonTypedGValue $ GNumber 2009)                                     $ mempty                    }     loadGraphSON "edge_v1.json" `shouldReturn` Right expected   let expected_v23 = typedGraphSON                      $ AEdge-                     { aeId = typedGraphSON' "g:Int32" $ toJSON (13 :: Int),+                     { aeId = typedGValue' "g:Int32" $ GNumber 13,                        aeLabel = "develops",                        aeInVLabel = "software",                        aeOutVLabel = "person",-                       aeInV = typedGraphSON' "g:Int32" $ toJSON (10 :: Int),-                       aeOutV = typedGraphSON' "g:Int32" $ toJSON (1 :: Int),+                       aeInV = typedGValue' "g:Int32" $ GNumber 10,+                       aeOutV = typedGValue' "g:Int32" $ GNumber 1,                        aeProperties = putProperty-                                      (AProperty "since" $ typedGraphSON' "g:Int32" $ toJSON (2009 :: Int))+                                      (AProperty "since" $ typedGValue' "g:Int32" $ GNumber 2009)                                       $ mempty                      }   it "should parse GraphSON v2" $ do@@ -153,31 +154,39 @@  spec_AProperty :: Spec spec_AProperty = describe "AProperty" $ do-  it "should parse GraphSON v1" $ do-    let ex = nonTypedGraphSON $ AProperty "since" $ nonTypedGraphSON (2009 :: Int)+  it "should parse GraphSON v1 (GValue)" $ do+    let ex = nonTypedGraphSON $ AProperty "since" $ nonTypedGValue $ GNumber 2009     loadGraphSON "property_v1.json" `shouldReturn` Right ex-  let ex23 = typedGraphSON $ AProperty "since" $ typedGraphSON' "g:Int32" (2009 :: Int)-  it "should parse GraphSON v2" $ do+  it "should parse GraphSON v1 (bare Int)" $ do+    let ex = nonTypedGraphSON $ AProperty "since" $ (2009 :: Int)+    loadGraphSON "property_v1.json" `shouldReturn` Right ex+  let ex23 = typedGraphSON $ AProperty "since" $ typedGValue' "g:Int32" $ GNumber 2009+      ex23_nowrap = typedGraphSON $ AProperty "since" $ (2009 :: Int)+  it "should parse GraphSON v2 (GValue)" $ do     loadGraphSON "property_v2.json" `shouldReturn` Right ex23-  it "should parse GraphSON v3" $ do+  it "should parse GraphSON v2 (bare Int)" $ do+    loadGraphSON "property_v2.json" `shouldReturn` Right ex23_nowrap+  it "should parse GraphSON v3 (GValue)" $ do     loadGraphSON "property_v3.json" `shouldReturn` Right ex23+  it "should parse GraphSON v3 (bare Int)" $ do+    loadGraphSON "property_v3.json" `shouldReturn` Right ex23_nowrap  spec_AVertexProperty :: Spec spec_AVertexProperty = describe "AVertexProperty" $ do   it "should parse GraphSON v1" $ do     let ex = nonTypedGraphSON $              AVertexProperty-             { avpId = nonTypedGraphSON $ toJSON (0 :: Int),+             { avpId = nonTypedGValue $ GNumber 0,                avpLabel = "name",-               avpValue = nonTypedGraphSON $ toJSON ("marko" :: Text),+               avpValue = nonTypedGValue $ GString "marko",                avpProperties = mempty              }     loadGraphSON "vertex_property_v1.json" `shouldReturn` Right ex   let ex23 = typedGraphSON $              AVertexProperty-             { avpId = typedGraphSON' "g:Int64" $ toJSON (0 :: Int),+             { avpId = typedGValue' "g:Int64" $ GNumber 0,                avpLabel = "name",-               avpValue = nonTypedGraphSON $ toJSON ("marko" :: Text),+               avpValue = nonTypedGValue $ GString "marko",                avpProperties = mempty              }   it "should parse GraphSON v2" $ do@@ -190,48 +199,48 @@   it "should parse GraphSON v1" $ do     let ex = nonTypedGraphSON $              AVertex-             { avId = nonTypedGraphSON $ toJSON (1 :: Int),+             { avId = nonTypedGValue $ GNumber 1,                avLabel = "person",                avProperties = foldr putProperty mempty                               [ AVertexProperty-                                { avpId = nonTypedGraphSON $ toJSON (0 :: Int),+                                { avpId = nonTypedGValue $ GNumber 0,                                   avpLabel = "name",-                                  avpValue = nonTypedGraphSON $ toJSON ("marko" :: Text),+                                  avpValue = nonTypedGValue $ GString "marko",                                   avpProperties = mempty                                 },                                 AVertexProperty-                                { avpId = nonTypedGraphSON $ toJSON (6 :: Int),+                                { avpId = nonTypedGValue $ GNumber 6,                                   avpLabel = "location",-                                  avpValue = nonTypedGraphSON $ toJSON ("san diego" :: Text),+                                  avpValue = nonTypedGValue $ GString "san diego",                                   avpProperties = foldr putProperty mempty-                                                  [ AProperty "startTime" $ nonTypedGraphSON $ toJSON (1997 :: Int),-                                                    AProperty "endTime" $ nonTypedGraphSON $ toJSON (2001 :: Int)+                                                  [ AProperty "startTime" $ nonTypedGValue $ GNumber 1997,+                                                    AProperty "endTime" $ nonTypedGValue $ GNumber 2001                                                   ]                                 },                                 AVertexProperty-                                { avpId = nonTypedGraphSON $ toJSON (7 :: Int),+                                { avpId = nonTypedGValue $ GNumber 7,                                   avpLabel = "location",-                                  avpValue = nonTypedGraphSON $ toJSON ("santa cruz" :: Text),+                                  avpValue = nonTypedGValue $ GString "santa cruz",                                   avpProperties = foldr putProperty mempty-                                                  [ AProperty "startTime" $ nonTypedGraphSON $ toJSON (2001 :: Int),-                                                    AProperty "endTime" $ nonTypedGraphSON $ toJSON (2004 :: Int)+                                                  [ AProperty "startTime" $ nonTypedGValue $ GNumber 2001,+                                                    AProperty "endTime" $ nonTypedGValue $ GNumber 2004                                                   ]                                 },                                 AVertexProperty-                                { avpId = nonTypedGraphSON $ toJSON (8 :: Int),+                                { avpId = nonTypedGValue $ GNumber 8,                                   avpLabel = "location",-                                  avpValue = nonTypedGraphSON $ toJSON ("brussels" :: Text),+                                  avpValue = nonTypedGValue $ GString "brussels",                                   avpProperties = foldr putProperty mempty-                                                  [ AProperty "startTime" $ nonTypedGraphSON $ toJSON (2004 :: Int),-                                                    AProperty "endTime" $ nonTypedGraphSON $ toJSON (2005 :: Int)+                                                  [ AProperty "startTime" $ nonTypedGValue $ GNumber 2004,+                                                    AProperty "endTime" $ nonTypedGValue $ GNumber 2005                                                   ]                                 },                                 AVertexProperty-                                { avpId = nonTypedGraphSON $ toJSON (9 :: Int),+                                { avpId = nonTypedGValue $ GNumber 9,                                   avpLabel = "location",-                                  avpValue = nonTypedGraphSON $ toJSON ("santa fe" :: Text),+                                  avpValue = nonTypedGValue $ GString "santa fe",                                   avpProperties = foldr putProperty mempty-                                                  [ AProperty "startTime" $ nonTypedGraphSON $ toJSON (2005 :: Int)+                                                  [ AProperty "startTime" $ nonTypedGValue $ GNumber 2005                                                   ]                                 }                               ]@@ -239,48 +248,48 @@     loadGraphSON "vertex_v1.json" `shouldReturn` Right ex   let ex23 = typedGraphSON $              AVertex-             { avId = typedGraphSON' "g:Int32" $ toJSON (1 :: Int),+             { avId = typedGValue' "g:Int32" $ GNumber 1,                avLabel = "person",                avProperties = foldr putProperty mempty                               [ AVertexProperty-                                { avpId = typedGraphSON' "g:Int64" $ toJSON (0 :: Int),+                                { avpId = typedGValue' "g:Int64" $ GNumber 0,                                   avpLabel = "name",-                                  avpValue = nonTypedGraphSON $ toJSON ("marko" :: Text),+                                  avpValue = nonTypedGValue $ GString "marko",                                   avpProperties = mempty                                 },                                 AVertexProperty-                                { avpId = typedGraphSON' "g:Int64" $ toJSON (6 :: Int),+                                { avpId = typedGValue' "g:Int64" $ GNumber 6,                                   avpLabel = "location",-                                  avpValue = nonTypedGraphSON $ toJSON ("san diego" :: Text),+                                  avpValue = nonTypedGValue $ GString "san diego",                                   avpProperties = foldr putProperty mempty-                                                  [ AProperty "startTime" $ typedGraphSON' "g:Int32" $ toJSON (1997 :: Int),-                                                    AProperty "endTime" $ typedGraphSON' "g:Int32" $ toJSON (2001 :: Int)+                                                  [ AProperty "startTime" $ typedGValue' "g:Int32" $ GNumber 1997,+                                                    AProperty "endTime" $ typedGValue' "g:Int32" $ GNumber 2001                                                   ]                                 },                                 AVertexProperty-                                { avpId = typedGraphSON' "g:Int64" $ toJSON (7 :: Int),+                                { avpId = typedGValue' "g:Int64" $ GNumber 7,                                   avpLabel = "location",-                                  avpValue = nonTypedGraphSON $ toJSON ("santa cruz" :: Text),+                                  avpValue = nonTypedGValue $ GString "santa cruz",                                   avpProperties = foldr putProperty mempty-                                                  [ AProperty "startTime" $ typedGraphSON' "g:Int32" $ toJSON (2001 :: Int),-                                                    AProperty "endTime" $ typedGraphSON' "g:Int32" $ toJSON (2004 :: Int)+                                                  [ AProperty "startTime" $ typedGValue' "g:Int32" $ GNumber 2001,+                                                    AProperty "endTime" $ typedGValue' "g:Int32" $ GNumber 2004                                                   ]                                 },                                 AVertexProperty-                                { avpId = typedGraphSON' "g:Int64" $ toJSON (8 :: Int),+                                { avpId = typedGValue' "g:Int64" $ GNumber 8,                                   avpLabel = "location",-                                  avpValue = nonTypedGraphSON $ toJSON ("brussels" :: Text),+                                  avpValue = nonTypedGValue $ GString "brussels",                                   avpProperties = foldr putProperty mempty-                                                  [ AProperty "startTime" $ typedGraphSON' "g:Int32" $ toJSON (2004 :: Int),-                                                    AProperty "endTime" $ typedGraphSON' "g:Int32" $ toJSON (2005 :: Int)+                                                  [ AProperty "startTime" $ typedGValue' "g:Int32" $ GNumber 2004,+                                                    AProperty "endTime" $ typedGValue' "g:Int32" $ GNumber 2005                                                   ]                                 },                                 AVertexProperty-                                { avpId = typedGraphSON' "g:Int64" $ toJSON (9 :: Int),+                                { avpId = typedGValue' "g:Int64" $ GNumber 9,                                   avpLabel = "location",-                                  avpValue = nonTypedGraphSON $ toJSON ("santa fe" :: Text),+                                  avpValue = nonTypedGValue $ GString "santa fe",                                   avpProperties = foldr putProperty mempty-                                                  [ AProperty "startTime" $ typedGraphSON' "g:Int32" $ toJSON (2005 :: Int)+                                                  [ AProperty "startTime" $ typedGValue' "g:Int32" $ GNumber 2005                                                   ]                                 }                               ]

@@ -1,34 +1,50 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, TypeFamilies #-} module Main (main,spec) where  import Control.Category ((<<<))+import Control.Exception.Safe (bracket) import qualified Data.Aeson as Aeson import Data.Either (isRight)+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HM+import Data.List (sortBy) import Data.Monoid (mempty, (<>)) import Data.Scientific (Scientific) import Data.Text (unpack, Text)-import qualified Database.TinkerPop as TP-import qualified Database.TinkerPop.Types as TP (Connection)+import qualified Data.Vector as V+import qualified Network.Greskell.WebSocket.Client as WS import System.Environment (lookupEnv) import Test.Hspec +import Data.Greskell.AsIterator+  ( AsIterator(IteratorItem)+  )+import Data.Greskell.GMap (GMapEntry, unGMapEntry) import Data.Greskell.Gremlin   ( oIncr, oDecr, cCompare, Order,     Predicate(..), pLt, pAnd, pGte, pNot, pEq, pTest   ) import Data.Greskell.Greskell-  ( toGremlin, Greskell,-    true, false, list, value, single, number,-    unsafeMethodCall+  ( toGremlin, Greskell, toGreskell, ToGreskell(..),+    true, false, list, value, single, number, gvalueInt,+    unsafeMethodCall, unsafeGreskell   ) import Data.Greskell.Graph-  ( AVertex, T, tId, tLabel, tKey, tValue+  ( AVertex(..), AEdge(..), AProperty(..), AVertexProperty(..),+    PropertyMapSingle,+    T, tId, tLabel, tKey, tValue, cList, (=:),+    fromProperties, allProperties   )+import Data.Greskell.GraphSON+  ( FromGraphSON, nonTypedGValue, GValue,+    parseEither+  ) import Data.Greskell.GTraversal-  ( Walk, GTraversal,-    source, sV', ($.), gOrder, gBy1,+  ( Walk, GTraversal, SideEffect,+    source, sV', sE', gV', sAddV', gAddE', gTo, gHasValue,+    ($.), gOrder, gBy1,     Transform, unsafeWalk, unsafeGTraversal,-    gProperties+    gProperties, gProperty, gPropertyV, liftWalk   )  main :: IO ()@@ -41,12 +57,11 @@   spec_predicate   spec_T   spec_P+  spec_graph   spec_basics :: SpecWith (String,Int) spec_basics = do-  ---- Note: Currently these tests do not support GraphSON 2.0 or-  ---- later. Try them with GraphSON 1.0 serializer.   describe "Num" $ do     let checkInt :: Greskell Int -> Int -> SpecWith (String,Int)         checkInt = checkOne@@ -87,33 +102,49 @@     checkN (number 3.1415) (3.1415)     checkN (number 2.31e12) (2.31e12)     checkN (number (-434.23e-19)) (-434.23e-19)-  describe "value (object)" $ do-    let checkV :: Greskell Aeson.Value -> Aeson.Value -> SpecWith (String,Int)-        checkV i e = checkRaw (single i) [e]-    checkV (value $ Aeson.object []) (Aeson.object [])-    -    let simple_nonempty = Aeson.object [("foo", Aeson.String "hoge"), ("bar", Aeson.Number 20)]-    checkV (value simple_nonempty) simple_nonempty-    -    let array_in_obj = Aeson.object [("foo", Aeson.toJSON [(3 :: Int), 2, 1]), ("hoge", Aeson.toJSON [("a" :: Text), "b", "c"])]-    checkV (value array_in_obj) array_in_obj--shouldReturnA :: (Aeson.ToJSON a, Show e, Eq e) => IO (Either e [Aeson.Value]) -> [a] -> IO ()-shouldReturnA act expected = act `shouldReturn` Right (map Aeson.toJSON expected)+  describe "nested map" $ do+    let check :: Greskell (HashMap Int (HashMap Text Int)) -> [(Int, (HashMap Text Int))] -> SpecWith (String,Int)+        check = checkRawMapped unGMapEntry+    check (unsafeGreskell "[:]") []+    check (unsafeGreskell "[100: [\"foo\": 55], 200: [:], 300: [\"bar\": 60, \"buzz\": 65]]")+      [ (100, HM.fromList [("foo", 55)]),+        (200, mempty),+        (300, HM.fromList [("bar", 60), ("buzz", 65)])+      ]+  describe "array in map" $ do+    let check :: Greskell (HashMap Text [Int]) -> [(Text, [Int])] -> SpecWith (String,Int)+        check = checkRawMapped unGMapEntry+    check (unsafeGreskell "[:]") []+    check (unsafeGreskell "[\"foo\": [], \"bar\": [1,2,3]]")+      [ ("foo", []),+        ("bar", [1,2,3])+      ] -checkRaw :: Aeson.ToJSON b => Greskell a -> [b] -> SpecWith (String, Int)-checkRaw  input expected = specify label $ withConn $ \conn -> do-  TP.submit conn (toGremlin input) Nothing `shouldReturnA` expected+checkRawMapped :: (AsIterator a, b ~ IteratorItem a, FromGraphSON b, Eq c, Show c)+               => (b -> c)+               -> Greskell a+               -> [c]+               -> SpecWith (String, Int)+checkRawMapped mapResult input expected = specify label $ withClient $ \client -> do+  got <- WS.slurpResults =<< WS.submit client input Nothing+  fmap mapResult got `shouldBe` V.fromList expected   where     label = unpack $ toGremlin input -checkOne :: Aeson.ToJSON a => Greskell a -> a -> SpecWith (String, Int)+checkRaw :: (AsIterator a, b ~ IteratorItem a, FromGraphSON b, Eq b, Show b)+         => Greskell a+         -> [b]+         -> SpecWith (String, Int)+checkRaw = checkRawMapped id++checkOne :: (AsIterator a, b ~ IteratorItem a, FromGraphSON b, Eq b, Show b)+         => Greskell a -> b -> SpecWith (String, Int) checkOne input expected = checkRaw input [expected]  requireEnv :: String -> IO String requireEnv env_key = maybe bail return =<< lookupEnv env_key   where-    bail = pendingWith msg >> return ""+    bail = expectationFailure msg >> return ""       where         msg = "Set environment variable "++ env_key ++ " for Server test. " @@ -123,8 +154,8 @@   port <- fmap read $ requireEnv "GRESKELL_TEST_PORT"   return (hostname, port) -withConn :: (TP.Connection -> IO ()) -> (String, Int) -> IO ()-withConn act (host, port) = TP.run host port act+withClient :: (WS.Client -> IO ()) -> (String, Int) -> IO ()+withClient act (host, port) = bracket (WS.connect host port) WS.close act  spec_comparator :: SpecWith (String,Int) spec_comparator = do@@ -146,29 +177,156 @@   checkOne (pTest (pLt 20 `pAnd` pGte 10) (15 :: Greskell Int)) True   checkOne (pTest (pLt 20 `pAnd` pGte 10) (20 :: Greskell Int)) False +iterateTraversal :: GTraversal c s e -> Greskell ()+iterateTraversal gt = unsafeMethodCall (toGreskell gt) "iterate" []+ spec_T :: SpecWith (String,Int) spec_T = describe "T enum" $ do-  specFor "tId" (gMapT tId) [Aeson.Number 10]+  specFor' "tId" (gMapT tId) parseEither [(Right 10 :: Either String Int)]   specFor "tLabel" (gMapT tLabel) ["VLABEL"]   specFor "tKey" (gMapT tKey <<< gProperties ["vprop"]) ["vprop"]-  specFor "tValue" (gMapT tValue <<< gProperties ["vprop"]) [Aeson.Number 400]+  specFor' "tValue" (gMapT tValue <<< gProperties ["vprop"]) parseEither [(Right 400 :: Either String Int)]   where     gMapT :: Greskell (T a b) -> Walk Transform a b     gMapT t = unsafeWalk "map" ["{ " <> toGremlin (unsafeMethodCall t "apply" ["it.get()"]) <> " }"]-    specFor :: Aeson.ToJSON a => String -> Walk Transform AVertex a -> [a] -> SpecWith (String,Int)-    specFor desc mapper expected = specify desc $ withConn $ \conn -> do-      let prelude = -            ( "graph = org.apache.tinkerpop.gremlin.tinkergraph.structure.TinkerGraph.open(); "-              <> "v = graph.addVertex(id, 10, label, \"VLABEL\"); "-              <> "v.property(\"vprop\", 400, \"a\", \"A\", \"b\", \"B\"); "-              <> "g = graph.traversal(); "-            )-          body = toGremlin $ mapper $. sV' [] $ source "g"-      TP.submit conn (prelude <> body) Nothing `shouldReturnA` expected+    prefixedTraversal :: Walk Transform AVertex a -> GTraversal Transform () a+    prefixedTraversal mapper = unsafeGTraversal (prelude <> body)+      where+        prelude = +          ( "graph = org.apache.tinkerpop.gremlin.tinkergraph.structure.TinkerGraph.open(); "+            <> "g = graph.traversal(); "+            <> "graph.addVertex(id, 10, label, \"VLABEL\"); "+            <> ( toGremlin $ iterateTraversal+                 $ gPropertyV Nothing "vprop" (gvalueInt $ (400 :: Int))+                   ["a" =: ("A" :: Greskell Text), "b" =: ("B" :: Greskell Text)]+                 $. liftWalk $ sV' [] $ source "g"+               ) <> "; "+          )+        body = toGremlin $ mapper $. sV' [] $ source "g"+    specFor' :: (FromGraphSON a, Eq b, Show b) => String -> Walk Transform AVertex a -> (a -> b) -> [b] -> SpecWith (String,Int)+    specFor' desc mapper convResult expected = specify desc $ withClient $ \client -> do+      got <- WS.slurpResults =<< WS.submit client (prefixedTraversal mapper) Nothing+      (fmap convResult got) `shouldBe` V.fromList expected+    specFor :: (FromGraphSON a, Eq a, Show a) => String -> Walk Transform AVertex a -> [a] -> SpecWith (String,Int)+    specFor desc mapper expected = specFor' desc mapper id expected  spec_P :: SpecWith (String,Int)-spec_P = describe "P class" $ specify "pNot, pEq, pTest" $ withConn $ \conn -> do+spec_P = describe "P class" $ specify "pNot, pEq, pTest" $ withClient $ \client -> do   let p = pNot $ pEq $ number 10-      test v = toGremlin $ pTest p $ v-  TP.submit conn (test $ number 10) Nothing `shouldReturnA` [False]-  TP.submit conn (test $ number 15) Nothing `shouldReturnA` [True]+      test v = WS.slurpResults =<< WS.submit client (pTest p $ v) Nothing+  test (number 10) `shouldReturn` V.fromList [False]+  test (number 15) `shouldReturn` V.fromList [True]++-- | This test is supported TinkerPop 3.1.0 and above, because it uses+-- 'gAddE'' function.+spec_graph :: SpecWith (String,Int)+spec_graph = do+  specify "AProperty (edge properties)" $ withClient $ \client -> do+    let trav = gProperties [] $. sE' [] $ source "g"+        prop t = AProperty "condition" $ Right (t :: Text)+        expected = map prop [ ">=0.11.2.1",+                              ">=1.2.2.1",+                              ">=1.2.3"+                            ]+    got <- WS.slurpResults =<< WS.submit client (withPrelude trav) Nothing+    (map (fmap parseEither) $ V.toList got) `shouldMatchList` expected+  specify "AProperty (vertex property meta-properties)" $ withClient $ \client -> do+    let trav = gProperties [] $. gProperties [] $. sV' [] $ source "g"+        prop t = AProperty "date" $ Right (t :: Text)+        expected = map prop [ "2018-04-08",+                              "2018-05-10",+                              "2017-09-20",+                              "2017-12-27",+                              "2017-12-23"+                            ]+    got <- WS.slurpResults =<< WS.submit client (withPrelude trav) Nothing+    (map (fmap parseEither) $ V.toList got) `shouldMatchList` expected+  specify "AEdge" $ withClient $ \client -> do+    let trav = sE' [] $ source "g"+        expE :: Int -> Int -> Text -> (Text,Text,Text,Either String Int, Either String Int, PropertyMapSingle AProperty (Either String Text))+        expE outv inv cond = ("depends_on", "package", "package", Right outv, Right inv, props)+          where+            props = fromProperties [AProperty "condition" $ Right cond]+        getE e = ( aeLabel e, aeInVLabel e, aeOutVLabel e,+                   parseEither $ aeOutV e, parseEither $ aeInV e,+                   fmap parseEither $ aeProperties e+                 )+        expected = [ expE 1 2 ">=0.11.2.1",+                     expE 1 3 ">=1.2.2.1",+                     expE 2 3 ">=1.2.3"+                   ]+    got <- WS.slurpResults =<< WS.submit client (withPrelude trav) Nothing+    (map getE $ V.toList got) `shouldMatchList` expected+  let getVP vp = (avpLabel vp, parseEither $ avpValue vp, fmap parseEither $ avpProperties vp)+  specify "AVertexProperty" $ withClient $ \client -> do+    let trav = gProperties [] $. sV' [] $ source "g"+        expName :: Text -> (Text,Either String Text, PropertyMapSingle AProperty (Either String Text))+        expName val = ("name", Right val, mempty)+        expVer :: Text -> Text -> (Text,Either String Text, PropertyMapSingle AProperty (Either String Text))+        expVer val date = ("version", Right val, fromProperties [AProperty "date" $ Right date])+        expected = [ expName "greskell",+                     expName "aeson",+                     expName "text",+                     expVer "0.1.1.0" "2018-04-08",+                     expVer "1.3.1.1" "2018-05-10",+                     expVer "1.2.2.0" "2017-09-20",+                     expVer "1.2.3.0" "2017-12-27",+                     expVer "1.2.2.0" "2017-12-23"+                   ]+    got <- WS.slurpResults =<< WS.submit client (withPrelude trav) Nothing+    (map getVP $ V.toList got) `shouldMatchList` expected+  specify "AVertex" $ withClient $ \client -> do+    let trav = sV' [] $ source "g"+        getV v = ( parseEither $ avId v,+                   avLabel v,+                   sort' $ map getVP $ allProperties $ avProperties v+                 )+        sort' = sortBy $ \(k1, v1, _) (k2, v2, _) -> compare (show k1,show v1) (show k2,show v2)+        expV :: Int -> Text -> [(Text, Text)] -> (Either String Int,Text,[(Text,Either String Text,PropertyMapSingle AProperty (Either String Text))])+        expV vid name ver_dates = (Right vid, "package", ("name", Right name, mempty) : map toVP ver_dates)+        toVP (ver, date) = ("version", Right ver, fromProperties [AProperty "date" $ Right date])+        expected = [ expV 1 "greskell" [("0.1.1.0", "2018-04-08")],+                     expV 2 "aeson" [("1.2.2.0", "2017-09-20"), ("1.3.1.1", "2018-05-10")],+                     expV 3 "text" [("1.2.2.0", "2017-12-23"), ("1.2.3.0", "2017-12-27")]+                   ]+    got <- WS.slurpResults =<< WS.submit client (withPrelude trav) Nothing+    (map getV $ V.toList got) `shouldMatchList` expected+  where+    withPrelude :: (ToGreskell a) => a -> Greskell (GreskellReturn a)+    withPrelude orig = unsafeGreskell (toGremlin prelude <> toGremlin orig)+    prelude :: Greskell ()+    prelude = unsafeGreskell $ mconcat $ map (<> "; ")+              ( [ "graph = org.apache.tinkerpop.gremlin.tinkergraph.structure.TinkerGraph.open()",+                  "g = graph.traversal()",+                  "graph.addVertex(id, 1, label, 'package')",+                  "graph.addVertex(id, 2, label, 'package')",+                  "graph.addVertex(id, 3, label, 'package')",+                  finalize $ setName 1 "greskell",+                  finalize $ setName 2 "aeson",+                  finalize $ setName 3 "text",+                  finalize $ dependsOn 1 2 ">=0.11.2.1",+                  finalize $ dependsOn 1 3 ">=1.2.2.1",+                  finalize $ dependsOn 2 3 ">=1.2.3"+                ]+                ++ addVersion 1 "0.1.1.0" "2018-04-08"+                ++ addVersion 2 "1.3.1.1" "2018-05-10"+                ++ addVersion 2 "1.2.2.0" "2017-09-20"+                ++ addVersion 3 "1.2.3.0" "2017-12-27"+                ++ addVersion 3 "1.2.2.0" "2017-12-23"+              )+    finalize :: GTraversal c s e -> Text+    finalize gt = toGremlin $ iterateTraversal gt+    num :: Integer -> Greskell GValue+    num = gvalueInt+    setName :: Integer -> Greskell Text -> GTraversal SideEffect () AVertex+    setName vid name = gProperty "name" name $. liftWalk $ sV' [num vid] $ source "g"+    dependsOn :: Integer -> Integer -> Greskell Text -> GTraversal SideEffect () AEdge+    dependsOn from_id to_id version_cond =+      gProperty "condition" version_cond+      $. (gAddE' "depends_on" $ gTo (gV' [num to_id]))+      $. liftWalk $ sV' [num from_id] $ source "g"+    addVersion :: Integer -> Greskell Text -> Greskell Text -> [Text]+    addVersion vid ver date =+      [ finalize $ gPropertyV (Just cList) "version" ver ["date" =: date] $. liftWalk $ sV' [num vid] $ source "g"+      ]+