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 +33/−0
- greskell.cabal +1/−1
- src/Data/Greskell/AsLabel.hs +9/−2
- src/Data/Greskell/Extra.hs +34/−3
- src/Data/Greskell/GTraversal.hs +66/−19
- src/Data/Greskell/Graph.hs +94/−1
- test/Data/Greskell/GraphSpec.hs +98/−1
- test/ServerTest.hs +112/−4
- test/graphson/path_v1.json +62/−0
- test/graphson/path_v2.json +68/−0
- test/graphson/path_v3.json +49/−0
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"+ }+ } ]+ }+ }+}