packages feed

greskell 1.0.1.0 → 1.1.0.0

raw patch · 11 files changed

+626/−31 lines, 11 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

+ Data.Greskell.AsLabel: instance Data.Hashable.Class.Hashable (Data.Greskell.AsLabel.AsLabel a)
+ Data.Greskell.AsLabel: unsafeCastAsLabel :: AsLabel a -> AsLabel b
+ Data.Greskell.Extra: gWhenEmptyInput :: (ToGTraversal g, Split cc c, Lift Transform cc, Lift Transform c, WalkType c, WalkType cc) => g cc [s] s -> Walk c s s
+ Data.Greskell.GTraversal: gCoalesce :: (ToGTraversal g, Split cc c, Lift Transform c, WalkType c, WalkType cc) => [g cc s e] -> Walk c s e
+ Data.Greskell.GTraversal: gFlatMap' :: ToGTraversal g => g Transform s e -> Walk Transform s e
+ Data.Greskell.GTraversal: gIterate :: WalkType c => GTraversal c s e -> GTraversal c s ()
+ Data.Greskell.GTraversal: gPath :: Walk Transform s (Path GValue)
+ Data.Greskell.GTraversal: gPathBy :: ByProjection a b -> [ByProjection a b] -> Walk Transform s (Path b)
+ Data.Greskell.Graph: Path :: [PathEntry a] -> Path a
+ Data.Greskell.Graph: PathEntry :: HashSet (AsLabel a) -> a -> PathEntry a
+ Data.Greskell.Graph: [peLabels] :: PathEntry a -> HashSet (AsLabel a)
+ Data.Greskell.Graph: [peObject] :: PathEntry a -> a
+ Data.Greskell.Graph: [unPath] :: Path a -> [PathEntry a]
+ Data.Greskell.Graph: data PathEntry a
+ Data.Greskell.Graph: instance Data.Foldable.Foldable Data.Greskell.Graph.Path
+ Data.Greskell.Graph: instance Data.Foldable.Foldable Data.Greskell.Graph.PathEntry
+ Data.Greskell.Graph: instance Data.Greskell.AsIterator.AsIterator (Data.Greskell.Graph.Path a)
+ Data.Greskell.Graph: instance Data.Greskell.GraphSON.FromGraphSON a => Data.Aeson.Types.FromJSON.FromJSON (Data.Greskell.Graph.Path a)
+ Data.Greskell.Graph: instance Data.Greskell.GraphSON.FromGraphSON a => Data.Greskell.GraphSON.FromGraphSON (Data.Greskell.Graph.Path a)
+ Data.Greskell.Graph: instance Data.Greskell.GraphSON.GraphSONTyped.GraphSONTyped (Data.Greskell.Graph.Path a)
+ Data.Greskell.Graph: instance Data.Traversable.Traversable Data.Greskell.Graph.Path
+ Data.Greskell.Graph: instance Data.Traversable.Traversable Data.Greskell.Graph.PathEntry
+ Data.Greskell.Graph: instance GHC.Base.Functor Data.Greskell.Graph.Path
+ Data.Greskell.Graph: instance GHC.Base.Functor Data.Greskell.Graph.PathEntry
+ Data.Greskell.Graph: instance GHC.Base.Monoid (Data.Greskell.Graph.Path a)
+ Data.Greskell.Graph: instance GHC.Base.Semigroup (Data.Greskell.Graph.Path a)
+ Data.Greskell.Graph: instance GHC.Classes.Eq a => GHC.Classes.Eq (Data.Greskell.Graph.Path a)
+ Data.Greskell.Graph: instance GHC.Classes.Eq a => GHC.Classes.Eq (Data.Greskell.Graph.PathEntry a)
+ Data.Greskell.Graph: instance GHC.Classes.Ord a => GHC.Classes.Ord (Data.Greskell.Graph.Path a)
+ Data.Greskell.Graph: instance GHC.Classes.Ord a => GHC.Classes.Ord (Data.Greskell.Graph.PathEntry a)
+ Data.Greskell.Graph: instance GHC.Show.Show a => GHC.Show.Show (Data.Greskell.Graph.Path a)
+ Data.Greskell.Graph: instance GHC.Show.Show a => GHC.Show.Show (Data.Greskell.Graph.PathEntry a)
+ Data.Greskell.Graph: makePathEntry :: [AsLabel a] -> a -> PathEntry a
+ Data.Greskell.Graph: newtype Path a
+ Data.Greskell.Graph: pathToPMap :: Path a -> PMap Multi a
- Data.Greskell.GTraversal: gFlatMap :: ToGTraversal g => g Transform s e -> Walk Transform s e
+ Data.Greskell.GTraversal: gFlatMap :: (Lift Transform c, Split cc c, ToGTraversal g, WalkType c, WalkType cc) => g cc s e -> Walk c s e

Files

ChangeLog.md view
@@ -1,5 +1,38 @@ # Revision history for greskell +## 1.1.0.0  -- 2020-04-26++### GTraversal module++* [BREAKING CHANGE] `gFlatMap` is now polymorphic about the+  WalkTypes. Use `gFlatMap'`For monomorphic version.+* Add the following functions.+  * `gFlatMap'`+  * `gCoalesce`+  * `gIterate`+  * `gPath`+  * `gPathBy`+* Document change: Now `gProject` is a "Transformation step", and+  `gUnfold` is an "Accessor step".++### Graph module++* Add the following types.+  * `Path`+  * `PathEntry`+* Add the following functions.+  * `pathToPMap`+  * `makePathEntry`++### Extra module++* Add `gWhenEmptyInput` function.++### AsLabel module++* Derive `Hashable` instance for `AsLabel`.+* Add `unsafeCastAsLabel` function.+ ## 1.0.1.0  -- 2020-04-24  ### GTraversal module
greskell.cabal view
@@ -1,5 +1,5 @@ name:                   greskell-version:                1.0.1.0+version:                1.1.0.0 author:                 Toshio Ito <debug.ito@gmail.com> maintainer:             Toshio Ito <debug.ito@gmail.com> license:                BSD3
src/Data/Greskell/AsLabel.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-} -- | -- Module: Data.Greskell.AsLabel -- Description: Label string used in .as step@@ -9,6 +9,7 @@        ( -- * AsLabel          AsLabel(..),          SelectedMap,+         unsafeCastAsLabel,          -- * Re-exports          lookup,          lookupM,@@ -22,6 +23,7 @@ import Control.Exception (Exception) import Control.Monad.Catch (MonadThrow(..)) import Data.Foldable (Foldable)+import Data.Hashable (Hashable) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM import Data.Greskell.GraphSON (GValue, GraphSONTyped(..), FromGraphSON(..), parseEither)@@ -39,7 +41,7 @@ -- | 'AsLabel' @a@ represents a label string used in @.as@ step -- pointing to the data of type @a@. newtype AsLabel a = AsLabel { unAsLabel :: Text }-               deriving (Show,Eq,Ord)+               deriving (Show,Eq,Ord,Hashable)  -- | @since 1.0.0.0 instance IsString (AsLabel a) where@@ -63,3 +65,8 @@ -- example. type SelectedMap = PMap Single +-- | Unsafely cast the phantom type of the 'AsLabel'.+--+-- @since 1.1.0.0+unsafeCastAsLabel :: AsLabel a -> AsLabel b+unsafeCastAsLabel = AsLabel . unAsLabel
src/Data/Greskell/Extra.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, FlexibleContexts #-} -- | -- Module: Data.Greskell.Extra -- Description: Extra utility functions implemented by Greskell@@ -20,17 +20,24 @@     (<=:>),     (<=?>),     writePropertyKeyValues,-    writePMapProperties+    writePMapProperties,+    -- * Control idioms+    gWhenEmptyInput   ) where  import Data.Aeson (ToJSON)+import Control.Category ((<<<)) import Data.Foldable (Foldable) import Data.Greskell.Binder (Binder, newBind) import Data.Greskell.Graph   ( Property(..), Element, KeyValue(..), (=:), Key   ) import qualified Data.Greskell.Graph as Graph-import Data.Greskell.GTraversal (Walk, SideEffect, gProperty)+import Data.Greskell.GTraversal+  ( Walk, WalkType, SideEffect, Transform,+    ToGTraversal(..), Split, Lift, liftWalk,+    gProperty, gCoalesce, gUnfold, gFold+  ) import Data.Greskell.PMap   ( PMap, pMapToList,     lookupAs,@@ -45,9 +52,12 @@ -- $setup -- -- >>> :set -XOverloadedStrings+-- >>> import Control.Category ((>>>))+-- >>> import Data.Function ((&)) -- >>> import Data.Greskell.Binder (runBinder) -- >>> import Data.Greskell.Greskell (toGremlin) -- >>> import Data.Greskell.Graph (AVertex)+-- >>> import Data.Greskell.GTraversal (GTraversal, source, sV', gHas2, (&.), gAddV) -- >>> import Data.List (sortBy) -- >>> import Data.Ord (comparing) -- >>> import qualified Data.HashMap.Strict as HashMap@@ -124,3 +134,24 @@ (<=?>) :: ToJSON b => Key a (Maybe b) -> Maybe b -> Binder (KeyValue a) (<=?>) k v@(Just _) = k <=:> v (<=?>) k Nothing = return $ KeyNoValue k++-- | The result 'Walk' emits the input elements as-is when there is at+-- least one input element. If there is no input element, it runs the+-- body traversal once and outputs its result.+--+-- You can use this function to implement \"upsert\" a vertex+-- (i.e. add a vertex if not exist).+--+-- >>> let getMarko = (source "g" & sV' [] &. gHas2 "name" "marko" :: GTraversal Transform () AVertex)+-- >>> let upsertMarko = (liftWalk getMarko &. gWhenEmptyInput (gAddV "person" >>> gProperty "name" "marko") :: GTraversal SideEffect () AVertex)+--+-- See also: https://stackoverflow.com/questions/46027444/+--+-- @since 1.1.0.0+gWhenEmptyInput :: (ToGTraversal g, Split cc c, Lift Transform cc, Lift Transform c, WalkType c, WalkType cc)+                => g cc [s] s -- ^ the body traversal+                -> Walk c s s -- ^ the result walk+gWhenEmptyInput body = gCoalesce+                       [ liftWalk $ toGTraversal gUnfold,+                         toGTraversal body+                       ] <<< liftWalk gFold
src/Data/Greskell/GTraversal.hs view
@@ -37,6 +37,7 @@          ($.),          (<$.>),          (<*.>),+         gIterate,          unsafeGTraversal,          -- * Walk/Steps @@ -118,6 +119,7 @@          -- ** Branching steps          gLocal,          gUnion,+         gCoalesce,          gChoose3,          -- ** Barrier steps          gBarrier,@@ -125,10 +127,11 @@          gDedupN,          -- ** Transformation steps          gFlatMap,+         gFlatMap',          gV,          gV',          gConstant,-         gUnfold,+         gProject,          -- ** As step          gAs,          -- ** Accessor steps@@ -141,7 +144,9 @@          gSelectN,          gSelectBy1,          gSelectByN,-         gProject,+         gUnfold,+         gPath,+         gPathBy,          -- ** Summarizing steps          gFold,          gCount,@@ -207,7 +212,7 @@   ( Element(..), Property(..), ElementID(..), Vertex, Edge,     AVertex, AEdge, AVertexProperty,     T, Key, Cardinality,-    KeyValue(..), Keys(..)+    KeyValue(..), Keys(..), Path,   ) import qualified Data.Greskell.Greskell as Greskell import Data.Greskell.GraphSON (GValue, FromGraphSON)@@ -540,6 +545,19 @@ (<*.>) :: Applicative f => f (Walk c b d) -> f (GTraversal c a b) -> f (GTraversal c a d) gs <*.> gt = ($.) <$> gs <*> gt +-- | @.iterate@ method on @GraphTraversal@.+--+-- 'gIterate' is not a 'Walk' because it's usually used to terminate+-- the method chain of Gremlin steps. The returned 'GTraversal'+-- outputs nothing, thus its end type is '()'.+--+-- >>> toGremlin (source "g" & sAddV' "person" &. gProperty "name" "marko" & gIterate)+-- "g.addV(\"person\").property(\"name\",\"marko\").iterate()"+--+-- @since 1.1.0.0+gIterate :: WalkType c => GTraversal c s e -> GTraversal c s ()+gIterate gt = unsafeWalk "iterate" [] $. gt+ -- -- $walk-steps -- -- @@ -932,7 +950,7 @@         -> Walk c s s gRepeat mlabel muntil memit repeated_trav = fromMWalk (head_walk <> toMWalk repeat_body <> tail_walk)   where-    repeat_body = unsafeWalk "repeat" (label_args ++ [toGremlin $ toGTraversal repeated_trav])+    repeat_body = unsafeWalk "repeat" (label_args ++ [travToG repeated_trav])     label_args = maybe [] (\l -> [toGremlin l]) mlabel     head_walk = head_until <> head_emit     tail_walk = tail_until <> tail_emit@@ -1041,7 +1059,7 @@ -- -- @since 1.0.1.0 gLocal :: (ToGTraversal g, WalkType c) => g c s e -> Walk c s e-gLocal t = unsafeWalk "local" [toGremlin $ toGTraversal t]+gLocal t = unsafeWalk "local" [travToG t]  -- | @.union@ step. --@@ -1052,8 +1070,20 @@ -- -- @since 1.0.1.0 gUnion :: (ToGTraversal g, WalkType c) => [g c s e] -> Walk c s e-gUnion ts = unsafeWalk "union" $ map (toGremlin . toGTraversal) ts+gUnion ts = unsafeWalk "union" $ map travToG ts +-- | @.coalesce@ step.+--+-- Like 'gFlatMap', 'gCoalesce' always modifies path history.+--+-- >>> toGremlin (source "g" & sV' [] &. gCoalesce [gOut' [], gIn' []])+-- "g.V().coalesce(__.out(),__.in())"+--+-- @since 1.1.0.0+gCoalesce :: (ToGTraversal g, Split cc c, Lift Transform c, WalkType c, WalkType cc)+          => [g cc s e] -> Walk c s e+gCoalesce ts = unsafeWalk "coalesce" $ map travToG ts+ -- | @.choose@ step with if-then-else style. -- -- >>> let key_age = ("age" :: Key AVertex Int)@@ -1067,9 +1097,9 @@          -> g c s e -- ^ The traversal executed if the predicate traversal outputs nothing.          -> Walk c s e gChoose3 pt tt ft = unsafeWalk "choose"-                    [ toGremlin $ toGTraversal pt,-                      toGremlin $ toGTraversal tt,-                      toGremlin $ toGTraversal ft+                    [ travToG pt,+                      travToG tt,+                      travToG ft                     ]  -- | @.barrier@ step.@@ -1254,21 +1284,22 @@  -- | @.flatMap@ step. ----- @.flatMap@ step is a 'Transform' step even if the child walk is--- 'Filter' type. This is because @.flatMap@ step always modifies the--- path of the Traverser.+-- @.flatMap@ step is at least as powerful as 'Transform', even if the+-- child walk is 'Filter' type. This is because @.flatMap@ step always+-- modifies the path of the Traverser. -- -- >>> toGremlin (source "g" & sV' [] &. gFlatMap (gOut' ["knows"] >>> gOut' ["created"])) -- "g.V().flatMap(__.out(\"knows\").out(\"created\"))"-gFlatMap :: (ToGTraversal g) => g Transform s e -> Walk Transform s e+--+-- @since 1.1.0.0+gFlatMap :: (Lift Transform c, Split cc c, ToGTraversal g, WalkType c, WalkType cc) => g cc s e -> Walk c s e gFlatMap gt = unsafeWalk "flatMap" [travToG gt] --- -- | Polymorphic version of 'gFlatMap'. The following constraint is--- -- accurate and semantic, but it's not allowed even if--- -- FlexibleContexts is enabled. Probably it's because the type @m@ is--- -- left ambiguous.--- gFlatMap' :: (ToGTraversal g, Split c m, Lift Transform p, Lift m p) => g c s e -> Walk p s e--- gFlatMap = undefined+-- | Monomorphic version of 'gFlatMap'.+--+-- @since 1.1.0.0+gFlatMap' :: ToGTraversal g => g Transform s e -> Walk Transform s e+gFlatMap' gt = gFlatMap gt  -- | @.V@ step. --@@ -1413,6 +1444,22 @@     f acc lp = acc >>> toByStep lp     toByStep :: LabeledByProjection s -> Walk Transform a a     toByStep (LabeledByProjection _ (ByProjection p)) = unsafeWalk "by" [toGremlin p]++-- | @.path@ step without modulation.+--+-- @since 1.1.0.0+gPath :: Walk Transform s (Path GValue)+gPath = unsafeWalk "path" []++-- | @.path@ step with one or more @.by@ modulations.+--+-- >>> let inE = (gInE' [] :: Walk Transform AVertex AEdge)+-- >>> toGremlin (source "g" & sV' [] &. gOut' [] &. gPathBy "name" [gBy $ inE >>> gValues ["relation"]])+-- "g.V().out().path().by(\"name\").by(__.inE().values(\"relation\"))"+--+-- @since 1.1.0.0+gPathBy :: ByProjection a b -> [ByProjection a b] -> Walk Transform s (Path b)+gPathBy b1 bn = modulateWith (unsafeWalk "path" []) $ map byStep $ b1 : bn  -- | @.fold@ step. gFold :: Walk Transform a [a]
src/Data/Greskell/Graph.hs view
@@ -41,6 +41,12 @@          singletonKeys,          (-:), +         -- * Path+         Path(..),+         PathEntry(..),+         pathToPMap,+         makePathEntry,+          -- * Concrete data types          -- $concrete_types          @@ -55,10 +61,13 @@        ) where  import Control.Applicative (empty, (<$>), (<*>), (<|>))+import Control.Monad (when) import Data.Aeson (Value(..), FromJSON(..), ToJSON(..)) import Data.Aeson.Types (Parser) import Data.Foldable (toList, Foldable(foldr), foldlM) import Data.Hashable (Hashable)+import Data.HashSet (HashSet)+import qualified Data.HashSet as HS import qualified Data.HashMap.Strict as HM import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NL@@ -72,6 +81,8 @@ import Data.Vector (Vector) import GHC.Generics (Generic) +import Data.Greskell.AsIterator (AsIterator(..))+import Data.Greskell.AsLabel (AsLabel(..), unsafeCastAsLabel) import Data.Greskell.GraphSON   ( GraphSON(..), GraphSONTyped(..), FromGraphSON(..),     (.:), GValue, GValueBody(..),@@ -83,7 +94,7 @@     ToGreskell(..)   ) import Data.Greskell.NonEmptyLike (NonEmptyLike)-import Data.Greskell.PMap (PMapKey(..), Single, Multi)+import Data.Greskell.PMap (PMapKey(..), Single, Multi, PMap, pMapInsert)  -- $setup --@@ -494,3 +505,85 @@     where       setValue v = vp { avpValue = v, avpId = unsafeCastElementID $ avpId vp } ++-- | @org.apache.tinkerpop.gremlin.process.traversal.Path@ interface.+--+-- @since 1.1.0.0+newtype Path a = Path { unPath :: [PathEntry a] }+            deriving (Show,Eq,Ord,Functor,Foldable,Traversable,Semigroup,Monoid)++instance GraphSONTyped (Path a) where+  gsonTypeFor _ = "g:Path"++-- | @Path@ is an @Iterable@ that emits its objects of type @a@.+instance AsIterator (Path a) where+  type IteratorItem (Path a) = a++instance FromGraphSON a => FromJSON (Path a) where+  parseJSON = parseJSONViaGValue++instance FromGraphSON a => FromGraphSON (Path a) where+  parseGraphSON gv =+    case gValueBody gv of+      GObject o -> parseObj o+      _ -> empty+    where+      parseObj o = do+        labels <- o .: "labels"+        objects <- o .: "objects"+        let nlabels = length labels+            nobjects = length objects+        when (nlabels /= nobjects) $ do+          fail ( "Different number of labels and objects: "+                 <> show nlabels <> " labels, "+                 <> show nobjects <> " objects."+               )+        return $ Path $ map (uncurry PathEntry) $ zip (map (HS.map AsLabel) labels) objects++-- | An entry in a 'Path'.+--+-- @since 1.1.0.0+data PathEntry a =+  PathEntry+  { peLabels :: HashSet (AsLabel a),+    peObject :: a+  }+  deriving (Show,Eq,Ord)++instance Functor PathEntry where+  fmap f pe = PathEntry { peLabels = HS.map (fmap f) $ peLabels pe,+                          peObject = f $ peObject pe+                        }++instance Foldable PathEntry where+  foldr f acc pe = f (peObject pe) acc++instance Traversable PathEntry where+  traverse f pe = fmap mkPE $ f $ peObject pe+    where+      mkPE obj =+        PathEntry { peLabels = HS.map unsafeCastAsLabel $ peLabels pe,+                    peObject = obj+                  }++-- | Convert a 'Path' into 'PMap'.+--+-- In the result 'PMap', the keys are the labels in the 'Path', and+-- the values are the objects associated with the labels. The values+-- are stored in the same order in the 'Path'. Objects without any+-- label are discarded.+--+-- @since 1.1.0.0+pathToPMap :: Path a -> PMap Multi a+pathToPMap (Path entries) = foldr fentry mempty entries+  where+    fentry entry pm = foldr (flabel $ peObject entry) pm $ peLabels entry+    flabel obj label pm = pMapInsert (unAsLabel label) obj pm++-- | Make a 'PathEntry'.+--+-- @since 1.1.0.0+makePathEntry :: [AsLabel a] -- ^ labels+              -> a -- ^ object+              -> PathEntry a+makePathEntry ls obj = PathEntry (HS.fromList ls) obj
test/Data/Greskell/GraphSpec.hs view
@@ -4,20 +4,25 @@ import Data.Aeson (toJSON, FromJSON) import qualified Data.Aeson as Aeson import qualified Data.ByteString.Lazy as BSL+import Data.HashSet (HashSet)+import qualified Data.HashSet as HS import Data.Monoid (Monoid(..), (<>)) import Data.Text (Text) import Test.Hspec +import Data.Greskell.AsLabel (AsLabel(..)) import Data.Greskell.Graph   ( AProperty(..),     -- PropertyMapSingle, PropertyMapList,     AEdge(..), AVertexProperty(..), AVertex(..),-    ElementID(..)+    ElementID(..),+    Path(..), PathEntry(..), pathToPMap   ) import Data.Greskell.GraphSON   ( nonTypedGraphSON, typedGraphSON, typedGraphSON',     nonTypedGValue, typedGValue', GValueBody(..)   )+import Data.Greskell.PMap (pMapFromList, lookupList)  main :: IO () main = hspec spec@@ -28,6 +33,7 @@   spec_AProperty   spec_AVertexProperty   spec_AVertex+  spec_Path  loadGraphSON :: FromJSON a => FilePath -> IO (Either String a) loadGraphSON filename = fmap Aeson.eitherDecode $ BSL.readFile ("test/graphson/" ++ filename)@@ -109,3 +115,94 @@     loadGraphSON "vertex_v2.json" `shouldReturn` Right ex23   it "should parse GraphSON v3" $ do     loadGraphSON "vertex_v3.json" `shouldReturn` Right ex23++mkEID :: Maybe Text -> GValueBody -> ElementID a+mkEID mtype vb =+  case mtype of+    Nothing -> ElementID $ nonTypedGValue vb+    Just t -> ElementID $ typedGValue' t vb++mkLabels :: [Text] -> HashSet (AsLabel a)+mkLabels = HS.fromList . map AsLabel++mkPE :: [Text] -> a -> PathEntry a+mkPE labels obj = PathEntry (mkLabels labels) obj++spec_Path :: Spec+spec_Path = describe "Path" $ do+  let exp_path_v1 =+        Path+        [ PathEntry (HS.fromList ["a"]) $ AVertex (mkEID Nothing $ GNumber 1) "person",+          PathEntry (HS.fromList ["b", "c"]) $ AVertex (mkEID Nothing $ GNumber 10) "software",+          PathEntry HS.empty $ AVertex (mkEID Nothing $ GNumber 11) "software"+        ]+      exp_path_v2 =+        Path+        [ PathEntry (HS.fromList ["a"]) $ AVertex (mkEID (Just "g:Int32") $ GNumber 1) "person",+          PathEntry (HS.fromList ["b", "c"]) $ AVertex (mkEID (Just "g:Int32") $ GNumber 10) "software",+          PathEntry HS.empty $ AVertex (mkEID (Just "g:Int32") $ GNumber 11) "software"+        ]+      exp_path_v3 = exp_path_v2+  it "should parse GraphSON v1" $ do+    loadGraphSON "path_v1.json" `shouldReturn` Right exp_path_v1+  it "should parse GraphSON v2" $ do+    loadGraphSON "path_v2.json" `shouldReturn` Right exp_path_v2+  it "should parse GraphSON v3" $ do+    loadGraphSON "path_v3.json" `shouldReturn` Right exp_path_v3+  describe "pathToPMap" $ do+    specify "empty path" $ do+      let p :: Path Int+          p = mempty+      (pathToPMap p) `shouldBe` mempty+    specify "objects without labels" $ do+      let p :: Path Int+          p = Path [ PathEntry mempty 10,+                     PathEntry mempty 20,+                     PathEntry mempty 30+                   ]+      (pathToPMap p) `shouldBe` mempty+    specify "objects with unique single label" $ do+      let p :: Path Int+          p = Path+              [ mkPE ["a"] 10,+                mkPE ["b"] 20,+                mkPE [] 30,+                mkPE ["c"] 40+              ]+          expected = pMapFromList+                     [ ("a", 10), ("b", 20), ("c", 40)+                     ]+      (pathToPMap p) `shouldBe` expected+    specify "object with multiple labels" $ do+      let p :: Path Int+          p = Path+              [ mkPE ["a", "b", "c"] 10,+                mkPE ["d", "e"] 20,+                mkPE [] 30+              ]+          expected = pMapFromList+                     [ ("a", 10), ("b", 10), ("c", 10), ("d", 20), ("e", 20)+                     ]+      (pathToPMap p) `shouldBe` expected+    specify "object with shared labels" $ do+      let p :: Path Int+          p = Path+              [ mkPE ["a", "b", "c"] 10,+                mkPE ["b", "c", "d"] 20,+                mkPE ["d"] 30,+                mkPE [] 40,+                mkPE ["b"] 50+              ]+          got = pathToPMap p+          expected = pMapFromList+                     [ ("a", 10), ("b", 10), ("c", 10),+                       ("b", 20), ("c", 20), ("d", 20),+                       ("d", 30),+                       ("b", 50)+                     ]+      got `shouldBe` expected+      (lookupList ("a" :: AsLabel Int) got) `shouldBe` [10]+      (lookupList ("b" :: AsLabel Int) got) `shouldBe` [10, 20, 50]+      (lookupList ("c" :: AsLabel Int) got) `shouldBe` [10, 20]+      (lookupList ("d" :: AsLabel Int) got) `shouldBe` [20, 30]+      (lookupList ("e" :: AsLabel Int) got) `shouldBe` []
test/ServerTest.hs view
@@ -21,6 +21,7 @@   ( AsIterator(IteratorItem)   ) import Data.Greskell.Binder (newBind, runBinder)+import Data.Greskell.Extra (gWhenEmptyInput) import Data.Greskell.GMap (GMapEntry, unGMapEntry) import Data.Greskell.Gremlin   ( oIncr, oDecr, cCompare, Order,@@ -35,7 +36,8 @@   ( AVertex(..), AEdge(..), AProperty(..), AVertexProperty(..),     Key, Keys(..), (-:), singletonKeys,     T, tId, tLabel, tKey, tValue, cList, (=:),-    ElementID(..)+    ElementID(..),+    Path(..), makePathEntry   ) import Data.Greskell.GraphSON   ( FromGraphSON, nonTypedGValue, GValue,@@ -51,7 +53,9 @@     gFilter, gOut', gOutV, gOutV', gInV, gInV', gId, gLabel, gProject,     gValueMap,     gProject, gByL,-    gRepeat, gTimes, gEmitHead, gUntilTail, gLoops, gIsP+    gRepeat, gTimes, gEmitHead, gUntilTail, gLoops, gIsP,+    gHasLabel, gHas2, gAddV, gIterate,+    gPath, gPathBy   ) import Data.Greskell.PMap (lookupAsM, lookupListAs, pMapToThrow) @@ -72,6 +76,8 @@   spec_selectBy   spec_project   spec_repeat+  spec_upsert+  spec_path  spec_basics :: SpecWith (String,Int) spec_basics = do@@ -218,6 +224,8 @@ withPrelude :: (ToGreskell a) => Greskell () -> a -> Greskell (GreskellReturn a) withPrelude prelude orig = unsafeGreskell (toGremlin prelude <> toGremlin orig) +statements :: [Text] -> Greskell ()+statements = unsafeGreskell . mconcat . map (<> "; ")  -- | This test is supported TinkerPop 3.1.0 and above, because it uses -- 'gAddE'' function.@@ -329,7 +337,7 @@     withPrelude' :: (ToGreskell a) => a -> Greskell (GreskellReturn a)     withPrelude' = withPrelude prelude     prelude :: Greskell ()-    prelude = unsafeGreskell $ mconcat $ map (<> "; ")+    prelude = statements               ( [ "graph = org.apache.tinkerpop.gremlin.tinkergraph.structure.TinkerGraph.open()",                   "g = graph.traversal()",                   "graph.addVertex(id, 1, label, 'package')",@@ -389,7 +397,7 @@ spec_selectBy :: SpecWith (String,Int) spec_selectBy = do   let prelude :: Greskell ()-      prelude = unsafeGreskell $ mconcat $ map (<> "; ")+      prelude = statements                 [ "graph = org.apache.tinkerpop.gremlin.tinkergraph.structure.TinkerGraph.open()",                   "g = graph.traversal()",                   "graph.addVertex(id, 1, label, 'person')",@@ -477,3 +485,103 @@         trav = gRepeat Nothing (gUntilTail $ gIsP (pGte 4) <<< gLoops Nothing) Nothing (multiplyWalk 2) $. start     got <- fmap V.toList $ WS.slurpResults =<< WS.submit client trav Nothing     sort got `shouldBe` [16, 160, 1600]++spec_upsert :: SpecWith (String,Int)+spec_upsert = do+  describe "upsert vertex" $ do+    specify "upsert outputs the vertex" $ withClient $ \client -> do+      let body = liftWalk getName $. upsert "foo"+          pre = statements prelude+      got <- WS.slurpResults =<< WS.submit client (withPrelude pre body) Nothing+      V.toList got `shouldBe` ["foo"]+    specify "upsert adds a vertex" $ withClient $ \client -> do+      let pre = statements $ prelude +++                [ toGremlin (gIterate $ upsert "foo")+                ]+          body = getName $. getAllPersons+      got <- WS.slurpResults =<< WS.submit client (withPrelude pre body) Nothing+      V.toList got `shouldBe` ["foo"]+    specify "upsert adds different vertices" $ withClient $ \client -> do+      let pre = statements $ prelude +++                [ toGremlin (gIterate $ upsert "foo"),+                  toGremlin (gIterate $ upsert "bar"),+                  toGremlin (gIterate $ upsert "foo"),+                  toGremlin (gIterate $ upsert "buzz"),+                  toGremlin (gIterate $ upsert "bar")+                ]+          body = getName $. getAllPersons+      got <- WS.slurpResults =<< WS.submit client (withPrelude pre body) Nothing+      V.toList got `shouldMatchList` ["foo", "bar", "buzz"]+    specify "upsert returns existing vertex" $ withClient $ \client -> do+      let pre = statements $ prelude +++                [ toGremlin (gIterate $ upsert "foo"),+                  toGremlin (gIterate $ upsert "foo")+                ]+          body = liftWalk getName $. upsert "foo"+      got <- WS.slurpResults =<< WS.submit client (withPrelude pre body) Nothing+      V.toList got `shouldBe` ["foo"]+  where+    prelude :: [Text]+    prelude =+      [ "graph = org.apache.tinkerpop.gremlin.tinkergraph.structure.TinkerGraph.open()",+        "g = graph.traversal()"+      ]+    getAllPersons :: GTraversal Transform () AVertex+    getAllPersons = gHasLabel "person" $. sV' [] $ source "g"+    getPerson :: Greskell Text -> GTraversal Transform () AVertex+    getPerson name = gHas2 "name" name $. getAllPersons+    insert :: Greskell Text -> Walk SideEffect a AVertex+    insert name = gProperty "name" name <<< gAddV "person"+    upsert :: Greskell Text -> GTraversal SideEffect () AVertex+    upsert name = gWhenEmptyInput (insert name) $. liftWalk $ getPerson name+    getName :: Walk Transform AVertex Text+    getName = gValues ["name"]++spec_path :: SpecWith (String,Int)+spec_path = do+  let start :: GTraversal Transform () Int+      start = unsafeGTraversal "__(1,2,3)"+      mult = multiplyWalk+  specify "gPath" $ withClient $ \client -> do+    let g = gPath $. gAs "c" $. mult 10 $. mult 10 $. gAs "b" $. gAs "a" $. start+    got <- fmap V.toList $ WS.slurpResults =<< WS.submit client g Nothing+    let parsed = traverse (traverse parseEither) got+        expected :: [Path Int]+        expected = [ Path+                     [ makePathEntry ["a", "b"] 1,+                       makePathEntry [] 10,+                       makePathEntry ["c"] 100+                     ],+                     Path+                     [ makePathEntry ["a", "b"] 2,+                       makePathEntry [] 20,+                       makePathEntry ["c"] 200+                     ],+                     Path+                     [ makePathEntry ["a", "b"] 3,+                       makePathEntry [] 30,+                       makePathEntry ["c"] 300+                     ]+                   ]+    parsed `shouldBe` Right expected+  specify "gPathBy" $ withClient $ \client -> do+    let g = gPathBy (gBy $ mult 50) [gBy $ mult 800] $. mult 10 $. gAs "b" $. mult 10 $. gAs "a" $. start+    got <- fmap V.toList $ WS.slurpResults =<< WS.submit client g Nothing+    let expected :: [Path Int]+        expected = [ Path+                     [ makePathEntry ["a"] 50,+                       makePathEntry ["b"] 8000,+                       makePathEntry []    5000+                     ],+                     Path+                     [ makePathEntry ["a"] 100,+                       makePathEntry ["b"] 16000,+                       makePathEntry []    10000+                     ],+                     Path+                     [ makePathEntry ["a"] 150,+                       makePathEntry ["b"] 24000,+                       makePathEntry []    15000+                     ]+                   ]+    got `shouldBe` expected
+ test/graphson/path_v1.json view
@@ -0,0 +1,62 @@+{+  "labels" : [ ["a"], ["b", "c"], [ ] ],+  "objects" : [ {+    "id" : 1,+    "label" : "person",+    "type" : "vertex",+    "properties" : {+      "name" : [ {+        "id" : 0,+        "value" : "marko"+      } ],+      "location" : [ {+        "id" : 6,+        "value" : "san diego",+        "properties" : {+          "startTime" : 1997,+          "endTime" : 2001+        }+      }, {+        "id" : 7,+        "value" : "santa cruz",+        "properties" : {+          "startTime" : 2001,+          "endTime" : 2004+        }+      }, {+        "id" : 8,+        "value" : "brussels",+        "properties" : {+          "startTime" : 2004,+          "endTime" : 2005+        }+      }, {+        "id" : 9,+        "value" : "santa fe",+        "properties" : {+          "startTime" : 2005+        }+      } ]+    }+  }, {+    "id" : 10,+    "label" : "software",+    "type" : "vertex",+    "properties" : {+      "name" : [ {+        "id" : 4,+        "value" : "gremlin"+      } ]+    }+  }, {+    "id" : 11,+    "label" : "software",+    "type" : "vertex",+    "properties" : {+      "name" : [ {+        "id" : 5,+        "value" : "tinkergraph"+      } ]+    }+  } ]+}
+ test/graphson/path_v2.json view
@@ -0,0 +1,68 @@+{+  "@type" : "g:Path",+  "@value" : {+    "labels" : [ ["a"], ["b", "c"], [ ] ],+    "objects" : [ {+      "@type" : "g:Vertex",+      "@value" : {+        "id" : {+          "@type" : "g:Int32",+          "@value" : 1+        },+        "label" : "person"+      }+    }, {+      "@type" : "g:Vertex",+      "@value" : {+        "id" : {+          "@type" : "g:Int32",+          "@value" : 10+        },+        "label" : "software",+        "properties" : {+          "name" : [ {+            "@type" : "g:VertexProperty",+            "@value" : {+              "id" : {+                "@type" : "g:Int64",+                "@value" : 4+              },+              "value" : "gremlin",+              "vertex" : {+                "@type" : "g:Int32",+                "@value" : 10+              },+              "label" : "name"+            }+          } ]+        }+      }+    }, {+      "@type" : "g:Vertex",+      "@value" : {+        "id" : {+          "@type" : "g:Int32",+          "@value" : 11+        },+        "label" : "software",+        "properties" : {+          "name" : [ {+            "@type" : "g:VertexProperty",+            "@value" : {+              "id" : {+                "@type" : "g:Int64",+                "@value" : 5+              },+              "value" : "tinkergraph",+              "vertex" : {+                "@type" : "g:Int32",+                "@value" : 11+              },+              "label" : "name"+            }+          } ]+        }+      }+    } ]+  }+}
+ test/graphson/path_v3.json view
@@ -0,0 +1,49 @@+{+  "@type" : "g:Path",+  "@value" : {+    "labels" : {+      "@type" : "g:List",+      "@value" : [ {+        "@type" : "g:Set",+        "@value" : ["a"]+      }, {+        "@type" : "g:Set",+        "@value" : ["b", "c"]+      }, {+        "@type" : "g:Set",+        "@value" : [ ]+      } ]+    },+    "objects" : {+      "@type" : "g:List",+      "@value" : [ {+        "@type" : "g:Vertex",+        "@value" : {+          "id" : {+            "@type" : "g:Int32",+            "@value" : 1+          },+          "label" : "person"+        }+      }, {+        "@type" : "g:Vertex",+        "@value" : {+          "id" : {+            "@type" : "g:Int32",+            "@value" : 10+          },+          "label" : "software"+        }+      }, {+        "@type" : "g:Vertex",+        "@value" : {+          "id" : {+            "@type" : "g:Int32",+            "@value" : 11+          },+          "label" : "software"+        }+      } ]+    }+  }+}