greskell 1.2.0.2 → 2.0.3.5
raw patch · 29 files changed
Files
- ChangeLog.md +53/−0
- greskell.cabal +51/−54
- src/Data/Greskell.hs +22/−22
- src/Data/Greskell/AsLabel.hs +33/−33
- src/Data/Greskell/Binder.hs +38/−48
- src/Data/Greskell/Extra.hs +73/−79
- src/Data/Greskell/GTraversal.hs +1875/−1832
- src/Data/Greskell/GTraversal/Gen.hs +364/−0
- src/Data/Greskell/Graph.hs +160/−155
- src/Data/Greskell/Graph/PropertyMap.hs +59/−51
- src/Data/Greskell/Gremlin.hs +73/−58
- src/Data/Greskell/Logic.hs +31/−31
- src/Data/Greskell/NonEmptyLike.hs +7/−7
- src/Data/Greskell/PMap.hs +71/−64
- test/Data/Greskell/BinderSpec.hs +46/−30
- test/Data/Greskell/ExtraSpec.hs +19/−16
- test/Data/Greskell/GTraversalSpec.hs +25/−37
- test/Data/Greskell/Graph/PropertyMapSpec.hs +8/−7
- test/Data/Greskell/GraphSpec.hs +21/−23
- test/Data/Greskell/GremlinSpec.hs +9/−6
- test/Data/Greskell/LogicSpec.hs +11/−8
- test/Data/Greskell/PMapSpec.hs +10/−10
- test/DocTest.hs +0/−1
- test/ExamplesSpec.hs +25/−0
- test/HintTest.hs +0/−77
- test/ServerBehaviorTest.hs +20/−21
- test/ServerTest.hs +78/−73
- test/ServerTest/Common.hs +8/−8
- test/Typecheck.hs +54/−0
ChangeLog.md view
@@ -1,5 +1,58 @@ # Revision history for greskell +## 2.0.3.5 -- 2026-05-25++- Support aeson-2.3.++## 2.0.3.4 -- 2026-04-21++- Bump dependency version bounds.++## 2.0.3.3 -- 2025-01-30++* Binder: now `newBind` produces an expression like `((__v0))`, that is, a variable name wrapped with double parens.+ (see https://github.com/debug-ito/greskell/issues/18 )+ While this is basically backward-compatible, it can break a user code if it depends on the internal of the `Greskell` returned by `newBind`.+* Support ghc-9.12 (base-4.21).+ ++## 2.0.3.2 -- 2024-11-05++* Bump dependency version bounds.++## 2.0.3.1 -- 2024-09-12++* Update dependency version bounds with cabal-plan-bounds.+ This adds support for new packages, while drops support for old ones.++## 2.0.3.0 -- 2023-02-24++* Add `GTraversal.Gen` module (see https://github.com/debug-ito/greskell/issues/15 )++## 2.0.2.0 -- 2023-01-11++* Add `oDesc` and `oAsc` functions (`Gremlin` module) ( https://github.com/debug-ito/greskell/pull/14 )++## 2.0.1.0 -- 2022-11-24++* Confirm test with ghc-9.2.5, vector-0.13.0.0 and aeson-2.1.0.0.+* Remove doctests. This is because it's so difficult to maintain doctests with recent GHCs and cabals.+ * doctests have been moved to `examples` function defined in some modules.+ * @ners helped a lot in https://github.com/debug-ito/greskell/pull/12+* Add the following functions ( https://github.com/debug-ito/greskell/pull/13 )+ * `gElementMap` (`GTraversal` module)+ * `toGremlinKeys` (`Graph` module)+* Use stylish-haskell to format codes.++## 2.0.0.0 -- 2021-12-28++* **BREAKING CHANGE**: Now greskell uses `aeson-2.0`.+ As a result, now implementation of `Data.Aeson.Object` has been changed from `HashMap` to `KeyMap`.+ Some types in greskell (e.g. `Binding`) directly uses the `Object` type.+* Confirm test with `aeson-2.0.2.0`, `semigroups-0.20`, `hashable-1.4.0.1`, `doctest-0.19`, `doctest-0.20`.+* Add `showWalkType`, `showLift` and `showSplit` functions, but those are only for testing purposes.+* `hint-test-suite` is removed. Instead, `typecheck-test-suite` is added, which is more robust and lightweight.+ ## 1.2.0.2 -- 2021-11-08 * Confirm test with `base-4.15.0.0`.
greskell.cabal view
@@ -1,5 +1,5 @@ name: greskell-version: 1.2.0.2+version: 2.0.3.5 author: Toshio Ito <debug.ito@gmail.com> maintainer: Toshio Ito <debug.ito@gmail.com> license: BSD3@@ -12,7 +12,7 @@ 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+cabal-version: 2.0 build-type: Simple extra-source-files: README.md, ChangeLog.md, test/graphson/*.json@@ -33,22 +33,23 @@ Data.Greskell.Graph, Data.Greskell.Graph.PropertyMap, Data.Greskell.GTraversal,+ Data.Greskell.GTraversal.Gen, Data.Greskell.AsLabel, Data.Greskell.Extra, Data.Greskell.PMap, Data.Greskell.NonEmptyLike, Data.Greskell.Logic -- other-modules: - build-depends: base >=4.9.0.0 && <4.16,- greskell-core >=0.1.3.0 && <0.2,- text >=1.2.2.1 && <1.3,- transformers >=0.5.2 && <0.6,- aeson >=0.11.2.1 && <1.6,- unordered-containers >=0.2.7.1 && <0.3,- semigroups >=0.18.2 && <0.20,- vector >=0.12.0.1 && <0.13,- exceptions >=0.8.3 && <0.11,- hashable >=1.2.7.0 && <1.4+ build-depends: base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 || ^>=4.17.0 || ^>=4.18.0 || ^>=4.19.0 || ^>=4.20.0 || ^>=4.21.0 || ^>=4.22.0,+ greskell-core ^>=1.0.0,+ text ^>=1.2.3 || ^>=2.0.2 || ^>=2.1,+ transformers ^>=0.5.6 || ^>=0.6.1,+ aeson ^>=2.0.2 || ^>=2.1.0 || ^>=2.2.3 || ^>=2.3.0,+ unordered-containers ^>=0.2.15,+ semigroups ^>=0.20,+ vector ^>=0.12.3 || ^>=0.13.0,+ exceptions ^>=0.10.4,+ hashable ^>=1.4.0 || ^>=1.5.0 test-suite spec type: exitcode-stdio-1.0@@ -65,44 +66,28 @@ Data.Greskell.Graph.PropertyMapSpec, Data.Greskell.ExtraSpec, Data.Greskell.PMapSpec,- Data.Greskell.LogicSpec+ Data.Greskell.LogicSpec,+ ExamplesSpec build-tool-depends: hspec-discover:hspec-discover- build-depends: base, text, aeson, unordered-containers,- greskell, greskell-core,- hspec >=2.2.3,- bytestring >=0.10.8.1 && <0.11--test-suite doctest- type: exitcode-stdio-1.0- default-language: Haskell2010- hs-source-dirs: test- ghc-options: -Wall -fno-warn-unused-imports "-with-rtsopts=-M512m"- main-is: DocTest.hs- build-tool-depends: doctest-discover:doctest-discover- build-depends: base,- doctest >=0.11 && <0.19,- doctest-discover >=0.1.0.8 && <0.3---flag hint-test- description: Do tests that use Haskell interpreter (hint package).- These tests depend on the behavior of the hint package, so it may be unstable.- Disable the flag to skip the tests. Or, maybe you should disable concurrent build.- default: True- manual: True+ build-depends: base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 || ^>=4.17.0 || ^>=4.18.0 || ^>=4.19.0 || ^>=4.20.0 || ^>=4.21.0 || ^>=4.22.0,+ text ^>=1.2.3 || ^>=2.0.2 || ^>=2.1,+ aeson ^>=2.0.2 || ^>=2.1.0 || ^>=2.2.3 || ^>=2.3.0,+ unordered-containers ^>=0.2.15,+ greskell,+ greskell-core ^>=1.0.0,+ hspec ^>=2.9.1 || ^>=2.10.6 || ^>=2.11.9,+ bytestring ^>=0.10.9 || ^>=0.11.3 || ^>=0.12.0 -test-suite hint-test-suite- if !flag(hint-test)- buildable: False+test-suite typecheck-test-suite type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test ghc-options: -Wall -fno-warn-unused-imports "-with-rtsopts=-M512m"- main-is: HintTest.hs- build-depends: base, hspec,- greskell, - hint >=0.6 && <0.10-+ main-is: Typecheck.hs+ build-depends: base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 || ^>=4.17.0 || ^>=4.18.0 || ^>=4.19.0 || ^>=4.20.0 || ^>=4.21.0 || ^>=4.22.0,+ hspec ^>=2.9.1 || ^>=2.10.6 || ^>=2.11.9,+ greskell,+ should-not-typecheck ^>=2.1.0 flag server-test description: Do tests with Gremlin Server.@@ -119,11 +104,17 @@ other-modules: ServerTest.Common if flag(server-test) -- Explicitly remove dependency. See https://github.com/haskell/cabal/issues/1725- build-depends: base, aeson, hspec, text, unordered-containers, vector,- greskell, greskell-core,- scientific >=0.3.4.9 && <0.4,- greskell-websocket >=0.1.0.0 && <0.2,- safe-exceptions >=0.1.6 && <0.2+ build-depends: base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 || ^>=4.17.0 || ^>=4.18.0 || ^>=4.19.0 || ^>=4.20.0 || ^>=4.21.0 || ^>=4.22.0,+ aeson ^>=2.0.2 || ^>=2.1.0 || ^>=2.2.3 || ^>=2.3.0,+ hspec ^>=2.9.1 || ^>=2.10.6 || ^>=2.11.9,+ text ^>=1.2.3 || ^>=2.0.2 || ^>=2.1,+ unordered-containers ^>=0.2.15,+ vector ^>=0.12.3 || ^>=0.13.0,+ greskell,+ greskell-core ^>=1.0.0,+ scientific,+ greskell-websocket,+ safe-exceptions else buildable: False @@ -144,11 +135,17 @@ other-extensions: OverloadedStrings other-modules: ServerTest.Common if flag(server-behavior-test)- build-depends: base, aeson, hspec, text, unordered-containers, vector,- greskell, greskell-core,- scientific >=0.3.4.9 && <0.4,- greskell-websocket >=0.1.0.0 && <0.2,- safe-exceptions >=0.1.6 && <0.2+ build-depends: base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 || ^>=4.17.0 || ^>=4.18.0 || ^>=4.19.0 || ^>=4.20.0 || ^>=4.21.0 || ^>=4.22.0,+ aeson ^>=2.0.2 || ^>=2.1.0 || ^>=2.2.3 || ^>=2.3.0,+ hspec ^>=2.9.1 || ^>=2.10.6 || ^>=2.11.9,+ text ^>=1.2.3 || ^>=2.0.2 || ^>=2.1,+ unordered-containers ^>=0.2.15,+ vector ^>=0.12.3 || ^>=0.13.0,+ greskell,+ greskell-core ^>=1.0.0,+ scientific,+ greskell-websocket,+ safe-exceptions else buildable: False
src/Data/Greskell.hs view
@@ -14,27 +14,27 @@ -- class of non-empty containers. -- - "Data.Greskell.Logic": Logic type, which is a general-purpose logic tree data structure. -- - "Data.Greskell.Graph.PropertyMap": deprecated PropertyMap class.+-- - "Data.Greskell.GTraversal.Gen": an experimental module that has generalized versions of Gremlin traversals defined in "Data.Greskell.GTraversal". module Data.Greskell- (- module Data.Greskell.Greskell,- module Data.Greskell.Binder,- module Data.Greskell.GTraversal,- module Data.Greskell.Gremlin,- module Data.Greskell.Graph,- module Data.Greskell.GraphSON,- module Data.Greskell.GMap,- module Data.Greskell.AsIterator,- module Data.Greskell.AsLabel,- module Data.Greskell.PMap- ) where+ ( module Data.Greskell.Greskell+ , module Data.Greskell.Binder+ , module Data.Greskell.GTraversal+ , module Data.Greskell.Gremlin+ , module Data.Greskell.Graph+ , module Data.Greskell.GraphSON+ , module Data.Greskell.GMap+ , module Data.Greskell.AsIterator+ , module Data.Greskell.AsLabel+ , module Data.Greskell.PMap+ ) where -import Data.Greskell.Greskell-import Data.Greskell.Binder-import Data.Greskell.GTraversal-import Data.Greskell.Gremlin-import Data.Greskell.Graph-import Data.Greskell.GraphSON-import Data.Greskell.GMap-import Data.Greskell.AsIterator-import Data.Greskell.AsLabel-import Data.Greskell.PMap+import Data.Greskell.AsIterator+import Data.Greskell.AsLabel+import Data.Greskell.Binder+import Data.Greskell.GMap hiding (examples)+import Data.Greskell.Graph hiding (examples)+import Data.Greskell.GraphSON hiding (examples)+import Data.Greskell.Gremlin hiding (examples)+import Data.Greskell.Greskell hiding (examples)+import Data.Greskell.GTraversal hiding (examples)+import Data.Greskell.PMap
src/Data/Greskell/AsLabel.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeFamilies #-} -- | -- Module: Data.Greskell.AsLabel -- Description: Label string used in .as step@@ -6,45 +7,44 @@ -- -- @since 0.2.2.0 module Data.Greskell.AsLabel- ( -- * AsLabel- AsLabel(..),- SelectedMap,- unsafeCastAsLabel,- -- * Re-exports- lookup,- lookupM,- lookupAs,- lookupAsM,- PMapLookupException(..),- -- * LabeledP- LabeledP- ) where+ ( -- * AsLabel+ AsLabel (..)+ , SelectedMap+ , unsafeCastAsLabel+ -- * Re-exports+ , lookup+ , lookupM+ , lookupAs+ , lookupAsM+ , PMapLookupException (..)+ -- * LabeledP+ , LabeledP+ ) where -import Prelude hiding (lookup)+import Prelude hiding (lookup) -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)-import Data.Greskell.Greskell (ToGreskell(..))+import Control.Exception (Exception)+import Control.Monad.Catch (MonadThrow (..))+import Data.Foldable (Foldable)+import Data.Greskell.GraphSON (FromGraphSON (..), GValue, GraphSONTyped (..), parseEither)+import Data.Greskell.Greskell (ToGreskell (..)) import qualified Data.Greskell.Greskell as Greskell-import Data.String (IsString(..))-import Data.Text (Text)-import Data.Traversable (Traversable)+import Data.Hashable (Hashable)+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HM+import Data.String (IsString (..))+import Data.Text (Text)+import Data.Traversable (Traversable) -import Data.Greskell.Gremlin (PLike(..), P)-import Data.Greskell.PMap- ( PMap, PMapKey(..), Single,- lookup, lookupM, lookupAs, lookupAsM, PMapLookupException(..)- )+import Data.Greskell.Gremlin (P, PLike (..))+import Data.Greskell.PMap (PMap, PMapKey (..), PMapLookupException (..), Single,+ lookup, lookupAs, lookupAsM, lookupM) -- | '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,Hashable)+newtype AsLabel a+ = AsLabel { unAsLabel :: Text }+ deriving (Eq, Hashable, Ord, Show) -- | @since 1.0.0.0 instance IsString (AsLabel a) where
src/Data/Greskell/Binder.hs view
@@ -1,40 +1,42 @@-{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-} -- | -- Module: Data.Greskell.Binder -- Description: Binder monad to make binding between Gremlin variables and JSON values -- Maintainer: Toshio Ito <debug.ito@gmail.com> ----- +-- module Data.Greskell.Binder- ( -- * Types- Binder,- Binding,- -- * Actions- newBind,- newAsLabel,- -- * Runners- runBinder- ) where+ ( -- * Types+ Binder+ , Binding+ -- * Actions+ , newBind+ , newAsLabel+ -- * Runners+ , runBinder+ ) where -import Control.Monad.Trans.State (State)+import Control.Monad.Trans.State (State) import qualified Control.Monad.Trans.State as State-import Data.Aeson (Value, ToJSON(toJSON), Object)-import Data.Monoid ((<>))-import qualified Data.HashMap.Strict as HM-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL+import Data.Aeson (Object, ToJSON (toJSON), Value)+import qualified Data.Aeson.Key as Key+import qualified Data.Aeson.KeyMap as KM+import Data.Monoid ((<>))+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL -import Data.Greskell.AsLabel (AsLabel(..))-import Data.Greskell.Greskell (unsafeGreskellLazy, Greskell)+import Data.Greskell.AsLabel (AsLabel (..))+import Data.Greskell.Greskell (Greskell, unsafeGreskellLazy) -- | State in the 'Binder'.-data BinderS =- BinderS- { varIndex :: PlaceHolderIndex,- varBindings :: [Value],- asLabelIndex :: PlaceHolderIndex- }- deriving (Show,Eq)+data BinderS+ = BinderS+ { varIndex :: PlaceHolderIndex+ , varBindings :: [Value]+ , asLabelIndex :: PlaceHolderIndex+ }+ deriving (Eq, Show) initBinderS :: BinderS initBinderS =@@ -44,26 +46,10 @@ asLabelIndex = 0 } --- $setup------ >>> import Control.Applicative ((<$>), (<*>))--- >>> import Data.Greskell.Greskell (toGremlin)--- >>> import Data.List (sortBy)--- >>> import Data.Ord (comparing)--- >>> import qualified Data.HashMap.Strict as HashMap- -- | A Monad that manages binding variables and labels to values.------ >>> let binder = (,) <$> newBind (10 :: Int) <*> newBind "hoge"--- >>> let ((var_int, var_str), binding) = runBinder binder--- >>> toGremlin var_int--- "__v0"--- >>> toGremlin var_str--- "__v1"--- >>> sortBy (comparing fst) $ HashMap.toList binding--- [("__v0",Number 10.0),("__v1",String "hoge")]-newtype Binder a = Binder { unBinder :: State BinderS a }- deriving (Functor, Applicative, Monad)+newtype Binder a+ = Binder { unBinder :: State BinderS a }+ deriving (Applicative, Functor, Monad) -- | Binding between Gremlin variable names and JSON values. type Binding = Object@@ -91,8 +77,8 @@ where (ret, state) = State.runState (unBinder binder) initBinderS values = varBindings state- binding = HM.fromList $ zip (map toPlaceHolderVariableStrict [0 ..]) $ values- toPlaceHolderVariableStrict = TL.toStrict . toPlaceHolderVariable+ binding = KM.fromList $ zip (map toPlaceHolderVariableKey [0 ..]) $ values+ toPlaceHolderVariableKey = Key.fromText . TL.toStrict . toPlaceHolderVariable -- | __This type is only for internal use.__ type PlaceHolderIndex = Int@@ -102,7 +88,11 @@ -- Unsafely create a placeholder variable of arbitrary type with the -- given index. unsafePlaceHolder :: PlaceHolderIndex -> Greskell a-unsafePlaceHolder = unsafeGreskellLazy . toPlaceHolderVariable+unsafePlaceHolder = unsafeGreskellLazy . wrapWithParens . toPlaceHolderVariable+ where+ wrapWithParens v = "((" <> v <> "))"+ -- This is necessary to ensure the v is always treated as a varible name (NOT a type name) in Groovy script.+ -- See https://github.com/debug-ito/greskell/issues/18 -- | __This function is only for internal use.__ --
src/Data/Greskell/Extra.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-} -- | -- Module: Data.Greskell.Extra -- Description: Extra utility functions implemented by Greskell@@ -8,59 +9,45 @@ -- -- @since 0.2.3.0 module Data.Greskell.Extra- ( -- * Property readers- -- $readers- lookupAs,- lookupAs',- lookupListAs,- lookupListAs',- pMapToFail,- -- * Property writers- writeKeyValues,- (<=:>),- (<=?>),- writePropertyKeyValues,- writePMapProperties,- -- * Control idioms- gWhenEmptyInput- ) where+ ( -- * Property readers+ -- $readers+ lookupAs+ , lookupAs'+ , lookupListAs+ , lookupListAs'+ , pMapToFail+ -- * Property writers+ , writeKeyValues+ , (<=:>)+ , (<=?>)+ , writePropertyKeyValues+ , writePMapProperties+ -- * Control idioms+ , gWhenEmptyInput+ -- * Examples+ , examples+ ) 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, WalkType, SideEffect, Transform,- ToGTraversal(..), Split, Lift, liftWalk,- gProperty, gCoalesce, gUnfold, gFold- )-import Data.Greskell.PMap- ( PMap, pMapToList,- lookupAs,- lookupAs',- lookupListAs,- lookupListAs',- pMapToFail- )-import Data.Monoid (mconcat)-import Data.Text (Text)+import Control.Category ((<<<), (>>>))+import Data.Aeson (ToJSON)+import qualified Data.Aeson.KeyMap as KeyMap+import Data.Foldable (Foldable)+import Data.Function ((&))+import Data.Greskell.Binder (Binder, newBind, runBinder)+import Data.Greskell.Graph (AVertex, Element, Key, KeyValue (..), Property (..),+ (=:))+import qualified Data.Greskell.Graph as Graph+import Data.Greskell.Greskell (Greskell, toGremlin)+import Data.Greskell.GTraversal (GTraversal, Lift, SideEffect, Split, ToGTraversal (..),+ Transform, Walk, WalkType, gAddV, gCoalesce, gFold,+ gHas2, gProperty, gUnfold, liftWalk, sV', source, (&.))+import Data.Greskell.PMap (PMap, lookupAs, lookupAs', lookupListAs, lookupListAs',+ pMapToFail, pMapToList)+import Data.List (sortBy)+import Data.Monoid (mconcat)+import Data.Ord (comparing)+import Data.Text (Text, unpack) --- $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 -- $readers --@@ -72,13 +59,6 @@ -- pairs as properties. -- -- @since 0.2.3.0------ >>> let binder = (writePropertyKeyValues [("age", (21 :: Int))] :: Binder (Walk SideEffect AVertex AVertex))--- >>> let (walk, binding) = runBinder binder--- >>> toGremlin walk--- "__.property(\"age\",__v0).identity()"--- >>> sortBy (comparing fst) $ HashMap.toList binding--- [("__v0",Number 21.0)] writePropertyKeyValues :: (ToJSON v, Element e) => [(Text, v)] -> Binder (Walk SideEffect e e) writePropertyKeyValues pairs = fmap writeKeyValues $ mapM toKeyValue pairs where@@ -88,14 +68,6 @@ -- pairs as properties. Use '<=:>' and '<=?>' to make a 'KeyValue' -- within 'Binder'. ----- >>> let keyAge = ("age" :: Key AVertex Int)--- >>> let keyName = ("name" :: Key AVertex Text)--- >>> let (walk, binding) = runBinder $ writeKeyValues <$> sequence [keyAge <=:> 21, keyName <=:> "Josh"]--- >>> toGremlin walk--- "__.property(\"age\",__v0).property(\"name\",__v1).identity()"--- >>> sortBy (comparing fst) $ HashMap.toList binding--- [("__v0",Number 21.0),("__v1",String "Josh")]--- -- @since 1.0.0.0 writeKeyValues :: Element e => [KeyValue e] -> Walk SideEffect e e writeKeyValues pairs = mconcat $ toPropStep =<< pairs@@ -122,18 +94,10 @@ -- value is 'Just', it's equivalent to '<=:>'. If the value is -- 'Nothing', it returns 'KeyNoValue'. ----- >>> let keyNName = ("nickname" :: Key AVertex (Maybe Text))--- >>> let keyCompany = ("company" :: Key AVertex (Maybe Text))--- >>> let (walk, binding) = runBinder $ writeKeyValues <$> sequence [keyNName <=?> Nothing, keyCompany <=?> Just "foobar.com"]--- >>> toGremlin walk--- "__.property(\"company\",__v0).identity()"--- >>> sortBy (comparing fst) $ HashMap.toList binding--- [("__v0",String "foobar.com")]--- -- @since 1.0.0.0 (<=?>) :: ToJSON b => Key a (Maybe b) -> Maybe b -> Binder (KeyValue a) (<=?>) k v@(Just _) = k <=:> v-(<=?>) k Nothing = return $ KeyNoValue k+(<=?>) 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@@ -142,9 +106,6 @@ -- 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@@ -155,3 +116,36 @@ [ liftWalk $ toGTraversal gUnfold, toGTraversal body ] <<< liftWalk gFold++-- | Examples of using this module. See the source. The 'fst' of the output is the testee, while the+-- 'snd' is the expectation.+examples :: [(String, String)]+examples = for_writePropertyKeyValues ++ for_writeKeyValues ++ for_operators ++ for_gWhenEmptyInput+ where+ for_writePropertyKeyValues =+ let binder = (writePropertyKeyValues [("age", (21 :: Int))] :: Binder (Walk SideEffect AVertex AVertex))+ (walk, binding) = runBinder binder+ in [ (unpack $ toGremlin walk, "__.property(\"age\",((__v0))).identity()")+ , (show $ sortBy (comparing fst) $ KeyMap.toList binding, "[(\"__v0\",Number 21.0)]")+ ]+ for_writeKeyValues =+ let keyAge = ("age" :: Key AVertex Int)+ keyName = ("name" :: Key AVertex Text)+ (walk, binding) = runBinder $ writeKeyValues <$> sequence [keyAge <=:> 21, keyName <=:> "Josh"]+ in [ (unpack $ toGremlin walk, "__.property(\"age\",((__v0))).property(\"name\",((__v1))).identity()")+ , (show $ sortBy (comparing fst) $ KeyMap.toList binding, "[(\"__v0\",Number 21.0),(\"__v1\",String \"Josh\")]")+ ]+ for_operators =+ let keyNName = ("nickname" :: Key AVertex (Maybe Text))+ keyCompany = ("company" :: Key AVertex (Maybe Text))+ (walk, binding) = runBinder $ writeKeyValues <$> sequence [keyNName <=?> Nothing, keyCompany <=?> Just "foobar.com"]+ in [ (unpack $ toGremlin walk, "__.property(\"company\",((__v0))).identity()")+ , (show $ sortBy (comparing fst) $ KeyMap.toList binding, "[(\"__v0\",String \"foobar.com\")]")+ ]+ for_gWhenEmptyInput =+ let nameMarko = "marko" :: Greskell Text+ getMarko = (source "g" & sV' [] &. gHas2 "name" nameMarko :: GTraversal Transform () AVertex)+ upsertMarko = (liftWalk getMarko &. gWhenEmptyInput (gAddV "person" >>> gProperty "name" nameMarko) :: GTraversal SideEffect () AVertex)+ in [ (unpack $ toGremlin upsertMarko, "g.V().has(\"name\",\"marko\").fold().coalesce(__.unfold(),__.addV(\"person\").property(\"name\",\"marko\"))")+ ]+
src/Data/Greskell/GTraversal.hs view
@@ -1,1832 +1,1875 @@-{-# LANGUAGE OverloadedStrings, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses,- TypeFamilies, GADTs, GeneralizedNewtypeDeriving, StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}--- |--- Module: Data.Greskell.GTraversal--- Description: Gremlin traversal/step types.--- Maintainer: Toshio Ito <debug.ito@gmail.com>------ This module defines 'GTraversal', greskell counterpart of--- @GraphTraversal@ class object, and a DSL of composing graph--- traversal steps.-module Data.Greskell.GTraversal- ( -- * Types- -- ** GraphTraversal and others- GTraversal(..),- GraphTraversal,- ToGTraversal(..),- Walk,- GraphTraversalSource,- -- ** Walk types- WalkType,- Filter,- Transform,- SideEffect,- Lift,- Split,- -- * GraphTraversalSource- source,- sV,- sV',- sE,- sE',- sAddV,- sAddV',- -- * GTraversal- (&.),- ($.),- (<$.>),- (<*.>),- gIterate,- unsafeGTraversal,- -- * Walk/Steps-- -- |- -- Functions for TinkerPop graph traversal steps.- -- __For now greskell does not cover all graph traversal steps.__- -- If you want some steps added, just open an issue.- --- -- There may be multiple versions of Haskell functions for a- -- single step. This is because Gremlin steps are too- -- polymorphic for Haskell. greskell should be type-safe so- -- that incorrect combination of steps is detected in compile- -- time.-- -- ** Low-level functions- unsafeWalk,- modulateWith,- -- ** Filter steps- gIdentity,- gIdentity',- gFilter,- gCyclicPath,- gCyclicPath',- gSimplePath,- gSimplePath',- -- ** Is step- gIs,- gIs',- gIsP,- gIsP',- -- ** Has steps- gHas1,- gHas1',- gHas2,- gHas2',- gHas2P,- gHas2P',- gHasLabel,- gHasLabel',- gHasLabelP,- gHasLabelP',- gHasId,- gHasId',- gHasIdP,- gHasIdP',- gHasKey,- gHasKey',- gHasKeyP,- gHasKeyP',- gHasValue,- gHasValue',- gHasValueP,- gHasValueP',- -- ** Logic steps- gAnd,- gOr,- gNot,- -- ** Where step- gWhereP1,- gWhereP1',- gWhereP2,- gWhereP2',- -- ** Sorting steps- gOrder,- -- ** Paging steps- gRange,- gLimit,- gTail,- gSkip,- -- ** Repeat step- gRepeat,- gTimes,- gUntilHead,- gUntilTail,- gEmitHead,- gEmitTail,- gEmitHeadT,- gEmitTailT,- gLoops,- RepeatUntil(..),- RepeatEmit(..),- RepeatPos(..),- RepeatLabel(..),- -- ** Branching steps- gLocal,- gUnion,- gCoalesce,- gChoose3,- -- ** Barrier steps- gBarrier,- gDedup,- gDedupN,- -- ** Transformation steps- gFlatMap,- gFlatMap',- gV,- gV',- gConstant,- gProject,- -- ** As step- gAs,- -- ** Accessor steps- gValues,- gProperties,- gId,- gLabel,- gValueMap,- gSelect1,- gSelectN,- gSelectBy1,- gSelectByN,- gUnfold,- gPath,- gPathBy,- -- ** Summarizing steps- gFold,- gCount,- -- ** Graph traversal steps- gOut,- gOut',- gOutE,- gOutE',- gOutV,- gOutV',- gIn,- gIn',- gInE,- gInE',- gInV,- gInV',- -- ** Match step- gMatch,- MatchPattern(..),- mPattern,- MatchResult,- -- ** Side-effect steps- gSideEffect,- gSideEffect',- -- ** 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- -- always used in conjunction with other steps like 'gOrder'.- ByProjection(..),- ProjectionLike(..),- ByComparator(..),- LabeledByProjection(..),- gBy,- gBy1,- gBy2,- gByL- ) where--import Control.Applicative ((<$>), (<*>))-import Control.Category (Category, (>>>))--- (below) to import Category methods without conflict with Prelude-import qualified Control.Category as Category-import Data.Aeson (Value)-import Data.Bifunctor (Bifunctor(bimap))-import Data.Foldable (foldl')-import Data.List.NonEmpty (NonEmpty(..))-import Data.Monoid ((<>), mconcat, Monoid(..))-import Data.Semigroup (Semigroup, sconcat)-import qualified Data.Semigroup as Semigroup-import Data.String (IsString(..))-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL--import Data.Greskell.Graph- ( Element(..), Property(..), ElementID(..), Vertex, Edge,- AVertex, AEdge, AVertexProperty,- T, Key, Cardinality,- KeyValue(..), Keys(..), Path,- )-import qualified Data.Greskell.Greskell as Greskell-import Data.Greskell.GraphSON (GValue, FromGraphSON)-import Data.Greskell.Gremlin- ( Comparator(..),- P- )-import Data.Greskell.Greskell- ( Greskell, ToGreskell(..), unsafeGreskellLazy, unsafeGreskell, unsafeFunCall,- toGremlinLazy, toGremlin- )-import Data.Greskell.AsIterator (AsIterator(IteratorItem))-import Data.Greskell.AsLabel (AsLabel, SelectedMap, LabeledP)-import Data.Greskell.Logic (Logic)-import qualified Data.Greskell.Logic as Logic-import Data.Greskell.PMap (PMap, Single)---- $setup------ >>> :set -XOverloadedStrings--- >>> import Data.Function ((&))--- >>> import Data.Greskell.Greskell (gvalueInt)--- >>> import Data.Greskell.Gremlin (pBetween, pEq, pLte, oDecr, oIncr)--- >>> 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--- \"walk type\", a marker to describe the effect of the traversal.------ 'GTraversal' is NOT a 'Category'. Because a @GraphTraversal@ object--- keeps some context data, the starting (left-most) @GraphTraversal@--- object controls most of the behavior of entire composition of--- traversals and steps. This violates 'Category' law.-newtype GTraversal c s e = GTraversal { unGTraversal :: Greskell (GraphTraversal c s e) }- deriving (Show)---- | Unsafely convert output type.-instance Functor (GTraversal c s) where- fmap f (GTraversal g) = GTraversal $ fmap (fmap f) g---- | Unsafely convert input and output types.-instance Bifunctor (GTraversal c) where- bimap f1 f2 (GTraversal g) = GTraversal $ fmap (bimap f1 f2) g---- | Unwrap 'GTraversal' data constructor.-instance ToGreskell (GTraversal c s e) where- type GreskellReturn (GTraversal c s e) = GraphTraversal c s e- toGreskell = unGTraversal---- | Phantom type for @GraphTraversal@ class. In greskell, we usually--- 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---- | Unsafely convert input and output types.-instance Bifunctor (GraphTraversal c) where- bimap _ _ GraphTraversal = GraphTraversal---- | Types that can convert to 'GTraversal'.-class ToGTraversal g where- toGTraversal :: WalkType c => g c s e -> GTraversal c s e- liftWalk :: (WalkType from, WalkType to, Lift from to) => g from s e -> g to s e- -- ^ Lift 'WalkType' @from@ to @to@. Use this for type matching.- - unsafeCastStart :: WalkType c => g c s1 e -> g c s2 e- -- ^ Unsafely cast the start type @s1@ into @s2@.- --- -- It is recommended that @s2@ is coercible to @s1@ in terms of- -- 'FromGraphSON'. That is, if @s2@ can parse a 'GValue', @s1@- -- should also be able to parse that 'GValue'.- --- -- @since 1.0.0.0-- unsafeCastEnd :: WalkType c => g c s e1 -> g c s e2- -- ^ Unsafely cast the end type @e1@ into @e2@. See- -- 'unsafeCastStart'.- --- -- @since 1.0.0.0--instance ToGTraversal GTraversal where- toGTraversal = id- liftWalk (GTraversal g) = GTraversal $ unsafeGreskellLazy $ toGremlinLazy g- unsafeCastStart (GTraversal g) = GTraversal $ unsafeGreskellLazy $ toGremlinLazy g- unsafeCastEnd (GTraversal g) = GTraversal $ unsafeGreskellLazy $ toGremlinLazy g---- | A chain of one or more Gremlin steps. Like 'GTraversal', type @s@--- is the input, type @e@ is the output, and type @c@ is a marker to--- describe the step.------ 'Walk' represents a chain of method calls such as--- @.has(x).outE()@. Because this is not a Gremlin (Groovy)--- expression, we use bare 'Walk', not 'Greskell' 'Walk'.------ 'Walk' is a 'Category'. You can use functions from--- "Control.Category" to compose 'Walk's. This is equivalent to making--- a chain of method calls in Gremlin.------ 'Walk' is not an 'Eq', because it's difficult to define true--- equality between Gremlin method calls. If we define it naively, it--- might have conflict with 'Category' law.-newtype Walk c s e = Walk TL.Text- deriving (Show)---- | 'id' is 'gIdentity'.-instance WalkType c => Category (Walk c) where- id = gIdentity- (Walk bc) . (Walk ab) = Walk (ab <> bc)---- | Based on 'Category'. 'Semigroup.<>' is 'Category.>>>'.-instance WalkType c => Semigroup (Walk c s s) where- (<>) = (Category.>>>)---- | Based on 'Category' and 'Semigroup'. 'mempty' is 'Category.id'.-instance WalkType c => Monoid (Walk c s s) where- mempty = Category.id- mappend = (Semigroup.<>)---- | Unsafely convert output type-instance Functor (Walk c s) where- fmap _ (Walk t) = Walk t---- | Unsafely convert input and output types.-instance Bifunctor (Walk c) where- bimap _ _ (Walk t) = Walk t---- | To convert a 'Walk' to 'GTraversal', it calls its static method--- version on @__@ class.-instance ToGTraversal Walk where- toGTraversal (Walk t) = GTraversal $ unsafeGreskellLazy ("__" <> t)- liftWalk (Walk t) = Walk t- unsafeCastStart (Walk t) = Walk t- unsafeCastEnd (Walk t) = Walk t---- | The 'Walk' is first converted to 'GTraversal', and it's converted--- to 'Greskell'.-instance WalkType c => ToGreskell (Walk c s e) where- type GreskellReturn (Walk c s e) = GraphTraversal c s e- toGreskell = toGreskell . toGTraversal---- | Class of phantom type markers to describe the effect of the--- walk/traversals.-class WalkType t---- | WalkType for filtering steps.------ A filtering step is a step that does filtering only. It takes input--- and emits some of them without any modification, reordering,--- traversal actions, or side-effects. Filtering decision must be--- solely based on each element.------ A 'Walk' @w@ is 'Filter' type iff:------ > (gSideEffect w == gIdentity) AND (gFilter w == w)------ If 'Walk's @w1@ and @w2@ are 'Filter' type, then--- --- > gAnd [w1, w2] == w1 >>> w2 == w2 >>> w1-data Filter--instance WalkType Filter---- | WalkType for steps without any side-effects. This includes--- transformations, reordring, injections and graph traversal actions.------ A 'Walk' @w@ is 'Transform' type iff:------ > gSideEffect w == gIdentity------ Obviously, every 'Filter' type 'Walk's are also 'Transform' type.-data Transform--instance WalkType Transform---- | WalkType for steps that may have side-effects.------ A side-effect here means manipulation of the \"sideEffect\" in--- Gremlin context (i.e. the stash of data kept in a Traversal--- object), as well as interaction with the world outside the--- Traversal object.------ For example, the following steps (in Gremlin) all have--- side-effects.------ > .addE('label')--- > .aggregate('x')--- > .sideEffect(System.out.&println)--- > .map { some_variable += 1 }-data SideEffect--instance WalkType SideEffect---- | Relation of 'WalkType's where one includes the other. @from@ can--- be lifted to @to@, because @to@ is more powerful than @from@.-class Lift from to--instance (WalkType c) => Lift Filter c-instance Lift Transform Transform-instance Lift Transform SideEffect-instance Lift SideEffect SideEffect---- | Relation of 'WalkType's where the child walk @c@ is split from--- the parent walk @p@.------ When splitting, transformation effect done in the child walk is--- rolled back (canceled) in the parent walk.-class Split c p--instance (WalkType p) => Split Filter p-instance (WalkType p) => Split Transform p--- ^ 'Transform' effect in the child walk is rolled back in the parent--- walk.-instance Split SideEffect SideEffect--- ^ 'SideEffect' in the child walk remains in the parent walk.----- | @GraphTraversalSource@ class object of TinkerPop. It is a factory--- object of 'GraphTraversal's.-data GraphTraversalSource = GraphTraversalSource- deriving (Show)----- | Create 'GraphTraversalSource' from a varible name in Gremlin------ >>> toGremlin $ source "g"--- "g"-source :: Text -- ^ variable name of 'GraphTraversalSource'- -> Greskell GraphTraversalSource-source = unsafeGreskell--sourceMethod :: Text -> [Greskell a] -> Greskell GraphTraversalSource -> Greskell b-sourceMethod method_name args src =- unsafeGreskellLazy $ (toGremlinLazy src <> methodCallText method_name (map toGremlin args))---- | @.V()@ method on 'GraphTraversalSource'.-sV :: Vertex v- => [Greskell (ElementID v)] -- ^ vertex IDs- -> Greskell GraphTraversalSource- -> GTraversal Transform () v-sV ids src = GTraversal $ sourceMethod "V" ids src---- | Monomorphic version of 'sV'.------ >>> toGremlin (source "g" & sV' (map (fmap ElementID . gvalueInt) ([1,2,3] :: [Int])))--- "g.V(1,2,3)"-sV' :: [Greskell (ElementID AVertex)] -- ^ vertex IDs- -> Greskell GraphTraversalSource- -> GTraversal Transform () AVertex-sV' = sV---- | @.E()@ method on 'GraphTraversalSource'.-sE :: Edge e- => [Greskell (ElementID e)] -- ^ edge IDs- -> Greskell GraphTraversalSource- -> GTraversal Transform () e-sE ids src = GTraversal $ sourceMethod "E" ids src---- | Monomorphic version of 'sE'.------ >>> toGremlin (source "g" & sE' (map (fmap ElementID . gvalueInt) ([1] :: [Int])))--- "g.E(1)"-sE' :: [Greskell (ElementID AEdge)] -- ^ edge IDs- -> 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()"--- "g.V().count()"-unsafeGTraversal :: Text -> GTraversal c s e-unsafeGTraversal = GTraversal . unsafeGreskell--infixl 1 &.---- | Apply the 'Walk' to the 'GTraversal'. In Gremlin, this means--- calling a chain of methods on the Traversal object.------ >>> toGremlin (source "g" & sV' [] &. gValues ["age"])--- "g.V().values(\"age\")"-(&.) :: GTraversal c a b -> Walk c b d -> GTraversal c a d-(GTraversal gt) &. (Walk twalk) = GTraversal $ unsafeGreskellLazy (toGremlinLazy gt <> twalk)--infixr 0 $.---- | Same as '&.' with arguments flipped.------ >>> toGremlin (gValues ["age"] $. sV' [] $ source "g")--- "g.V().values(\"age\")"-($.) :: Walk c b d -> GTraversal c a b -> GTraversal c a d-gs $. gt = gt &. gs--infixr 0 <$.>---- | Similar to '<$>', but for '$.'.------ @since 0.2.1.0-(<$.>) :: Functor f => Walk c b d -> f (GTraversal c a b) -> f (GTraversal c a d)-gs <$.> gt = ($.) gs <$> gt--infixr 0 <*.>---- | Similar to '<*>', but for '$.'.------ @since 0.2.1.0-(<*.>) :: 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--- ----methodCallText :: Text -- ^ method name- -> [Text] -- ^ args- -> TL.Text-methodCallText name args = ("." <>) $ toGremlinLazy $ unsafeFunCall name args---- | Unsafely create a 'Walk' that represents a single method call on--- a @GraphTraversal@.------ >>> toGremlin (source "g" & sV' [] &. unsafeWalk "valueMap" ["'foo'", "'bar'"])--- "g.V().valueMap('foo','bar')"-unsafeWalk :: WalkType c- => Text -- ^ step method name (e.g. "outE")- -> [Text] -- ^ step method arguments- -> Walk c s e-unsafeWalk name args = Walk $ methodCallText name args---- | Optionally modulate the main 'Walk' with some modulating 'Walk's.------ >>> toGremlin (source "g" & sV' [] &. modulateWith (unsafeWalk "path" []) [unsafeWalk "by" ["'name'"], unsafeWalk "by" ["'age'"]])--- "g.V().path().by('name').by('age')"-modulateWith :: (WalkType c)- => Walk c s e -- ^ the main 'Walk'- -> [Walk c e e] -- ^ the modulating 'Walk's- -> Walk c s e-modulateWith w [] = w-modulateWith w (m:rest) = w >>> sconcat (m :| rest)---- | @.identity@ step.-gIdentity :: WalkType c => Walk c s s-gIdentity = liftWalk $ gIdentity'---- | Monomorphic version of 'gIdentity'.-gIdentity' :: Walk Filter s s-gIdentity' = unsafeWalk "identity" []--travToG :: (ToGTraversal g, WalkType c) => g c s e -> Text-travToG = toGremlin . unGTraversal . toGTraversal---- | @.filter@ step that takes a traversal.------ >>> toGremlin (source "g" & sV' [] &. gFilter (gOut' ["knows"]))--- "g.V().filter(__.out(\"knows\"))"-gFilter :: (ToGTraversal g, WalkType c, WalkType p, Split c p) => g c s e -> Walk p s s-gFilter walk = unsafeWalk "filter" [travToG walk]---- | @.cyclicPath@ step.------ @since 1.0.1.0-gCyclicPath :: (WalkType c) => Walk c a a-gCyclicPath = liftWalk gCyclicPath'---- | Monomorphic version of 'gCyclicPath'.------ @since 1.0.1.0-gCyclicPath' :: Walk Filter a a-gCyclicPath' = unsafeWalk "cyclicPath" []---- | @.simplePath@ step.------ @since 1.0.1.0-gSimplePath :: (WalkType c) => Walk c a a-gSimplePath = liftWalk gSimplePath'---- | Monomorphic version of 'gSimplePath'.------ @since 1.0.1.0-gSimplePath' :: Walk Filter a a-gSimplePath' = unsafeWalk "simplePath" []--gWherePGeneric :: Maybe (AsLabel a)- -> Greskell (LabeledP a)- -> Maybe (ByProjection a b)- -> Walk Filter x x-gWherePGeneric mstart p mby = modulateWith wh mods- where- wh = unsafeWalk "where" $ start_args ++ [toGremlin p]- start_args = maybe [] (return . toGremlin) mstart- mods = maybe [] (return . byStep) mby---- | @.where@ step with @P@ argument only.------ >>> let la = ("a" :: AsLabel AVertex)--- >>> let age = ("age" :: Key AVertex Int)--- >>> toGremlin (source "g" & sV' [] &. gAs la &. gOut' [] &. gWhereP1 (pEq la) (Just $ gBy age))--- "g.V().as(\"a\").out().where(P.eq(\"a\")).by(\"age\")"------ If the 'ByProjection' argument is 'Nothing', comparison is--- performed on the type @a@. You have to ensure that the comparator--- included in the 'LabeledP' argument can handle the type--- @a@. Usually this means the type @a@ should implement Java's--- @Comparable@ interface (this is true for most Java classes).------ If the 'ByProjection' argument is given, comparison is performed on--- the projected values of type @b@. So, the type @b@ should implement--- Java's @Comparable@ interface.------ @since 1.2.0.0-gWhereP1 :: WalkType c- => Greskell (LabeledP a) -- ^ the @P@ argument for @.where@ step.- -> Maybe (ByProjection a b) -- ^ optional @.by@ modulation following the @.where@ step.- -> Walk c a a-gWhereP1 p mby = liftWalk $ gWhereP1' p mby---- | Monomorphic version of 'gWhereP1'.------ @since 1.2.0.0-gWhereP1' :: Greskell (LabeledP a) -> Maybe (ByProjection a b) -> Walk Filter a a-gWhereP1' p mby = gWherePGeneric Nothing p mby---- | @.where@ step with the starting label and @P@ arguments. See also--- 'gWhereP1'.------ >>> let la = ("a" :: AsLabel AVertex)--- >>> let lb = ("b" :: AsLabel AVertex)--- >>> let age = ("age" :: Key AVertex Int)--- >>> toGremlin (source "g" & sV' [] &. gAs la &. gOut' [] &. gAs lb &. gValues [age] &. gWhereP2 la (pEq lb) Nothing)--- "g.V().as(\"a\").out().as(\"b\").values(\"age\").where(\"a\",P.eq(\"b\"))"------ @since 1.2.0.0-gWhereP2 :: WalkType c- => AsLabel a -- ^ the starting label of @.where@.- -> Greskell (LabeledP a) -- ^ the @P@ argument for @.where@ step.- -> Maybe (ByProjection a b) -- ^ optional @.by@ modulation following the @.where@ step.- -> Walk c x x-gWhereP2 s p b = liftWalk $ gWhereP2' s p b---- | Monomorphic version of 'gWhereP2'.------ @since 1.2.0.0-gWhereP2' :: AsLabel a -> Greskell (LabeledP a) -> Maybe (ByProjection a b) -> Walk Filter x x-gWhereP2' start p mby = gWherePGeneric (Just start) p mby---- Developer note: the @.where@ step with a traversal argument is not--- implemented yet, because @.match@ basically covers the same--- capability. If we are to implement it, consider the following.------ - The @.where@ step with a traversal argument doesn't take @.by@--- modulation.------ - The traversal argument is a logic tree (zero or more combination--- of @__.and()@, @__.or()@ and @__.not()@ methods) of filtering--- traversals.------ - If a filtering traversal starts with @__.as()@ step,--- it has a special meaning. The @__.as()@ step works just like--- @__.select()@, fetching a value specified by the label from the--- path history. In this case, the input value passed to the--- @.where@ step is discarded.------ - If a filtering traversal ends with @.as()@ step, it works like a--- predicate step. If fetches a value specified by the label from--- the path history, and checks if it's equal to the input--- value. This behavior is like the one in @.match@ step, but--- without variable binding.------ - If a filtering traversal doesn't have @.as()@ step at the--- beginning or end, it works just like it's in @.filter@ step.----- | Result of @.match@ step.------ @since 1.2.0.0-data MatchResult---- | A pattern for @.match@ step.------ @since 1.2.0.0-data MatchPattern where- -- | A pattern with the starting @.as@ label followed by traversal steps.- MatchPattern :: AsLabel a -> Walk Transform a b -> MatchPattern---- | Make a 'GTraversal' from the 'MatchPattern'. This function is--- unsafe because it discards the types of input and output--- traversers.-unsafePatternT :: MatchPattern -> GTraversal Transform () ()-unsafePatternT (MatchPattern l w) = unsafeCastEnd $ unsafeCastStart $ toGTraversal (gAs l >>> w)---- | A convenient function to make a 'MatchPattern' wrapped by--- 'Logic.Leaf'.------ @since 1.2.0.0-mPattern :: (WalkType c, Lift c Transform) => AsLabel a -> Walk c a b -> Logic MatchPattern-mPattern l w = Logic.Leaf $ MatchPattern l (liftWalk w)---- | @.match@ step.------ If the top-level 'Logic' of the argument is 'Logic.And', the--- patterns are directly passed to the @.match@ step arguments.------ The result of @.match@ step, 'MatchResult', is an opaque--- type. Basically you should not use it. Instead, you should use--- 'gSelectN' etc to access the path history labels inside the--- 'MatchPattern'.------ See also: https://groups.google.com/g/gremlin-users/c/HVtldzV0Xk8------ >>> :{--- let--- label_a = ("a" :: AsLabel AVertex)--- label_b = "b"--- key_age = ("age" :: Key AVertex Int)--- patterns = Logic.And--- ( mPattern label_a (gOut' [] >>> gAs label_b) )--- [ mPattern label_b (gHas2' key_age 25)--- ]--- in toGremlin (source "g" & sV' [] &. gMatch patterns &. gSelectN label_a label_b [])--- :}--- "g.V().match(__.as(\"a\").out().as(\"b\"),__.as(\"b\").has(\"age\",25)).select(\"a\",\"b\")"------ @since 1.2.0.0-gMatch :: Logic MatchPattern -> Walk Transform a MatchResult-gMatch patterns = unsafeWalk "match" args- where- args =- case patterns of- Logic.And p rest -> map (toGremlin . toTraversal) (p : rest)- _ -> [toGremlin $ toTraversal patterns]- toTraversal l =- case l of- Logic.Leaf p -> unsafePatternT p- Logic.And p rest -> toGTraversal $ gAnd $ map toTraversal (p : rest)- Logic.Or p rest -> toGTraversal $ gOr $ map toTraversal (p : rest)- Logic.Not p -> toGTraversal $ gNot $ toTraversal p---- | @.is@ step of simple equality.------ >>> toGremlin (source "g" & sV' [] &. gValues ["age" :: Key AVertex Int] &. gIs 30)--- "g.V().values(\"age\").is(30)"------ @since 1.0.1.0-gIs :: (WalkType c) => Greskell v -> Walk c v v-gIs = liftWalk . gIs'---- | Monomorphic version of 'gIs'.------ @since 1.0.1.0-gIs' :: Greskell v -> Walk Filter v v-gIs' v = unsafeWalk "is" [toGremlin v]---- | @.is@ step with predicate 'P'.------ >>> toGremlin (source "g" & sV' [] &. gValues ["age" :: Key AVertex Int] &. gIsP (pLte 30))--- "g.V().values(\"age\").is(P.lte(30))"------ @since 1.0.1.0-gIsP :: (WalkType c) => Greskell (P v) -> Walk c v v-gIsP = liftWalk . gIsP'---- | Monomorphic version of 'gIsP'.------ @since 1.0.1.0-gIsP' :: Greskell (P v) -> Walk Filter v v-gIsP' p = unsafeWalk "is" [toGremlin p]---- | @.has@ step with one argument.------ >>> toGremlin (source "g" & sV' [] &. gHas1 "age")--- "g.V().has(\"age\")"-gHas1 :: (WalkType c, Element s)- => Key s v -- ^ property key- -> Walk c s s-gHas1 = liftWalk . gHas1'---- | Monomorphic version of 'gHas1'.-gHas1' :: (Element s) => Key s v -> Walk Filter s s-gHas1' key = unsafeWalk "has" [toGremlin key]---- | @.has@ step with two arguments.------ >>> toGremlin (source "g" & sV' [] &. gHas2 "age" (31 :: Greskell Int))--- "g.V().has(\"age\",31)"-gHas2 :: (WalkType c, Element s) => Key s v -> Greskell v -> Walk c s s-gHas2 k v = liftWalk $ gHas2' k v---- | Monomorphic verson of 'gHas2'.-gHas2' :: (Element s) => Key s v -> Greskell v -> Walk Filter s s-gHas2' k v = unsafeWalk "has" [toGremlin k, toGremlin v]---- | @.has@ step with two arguments and 'P' type.------ >>> toGremlin (source "g" & sV' [] &. gHas2P "age" (pBetween (30 :: Greskell Int) 40))--- "g.V().has(\"age\",P.between(30,40))"-gHas2P :: (WalkType c, Element s)- => Key s v -- ^ property key- -> Greskell (P v) -- ^ predicate on the property value- -> Walk c s s-gHas2P k p = liftWalk $ gHas2P' k p---- | Monomorphic version of 'gHas2P'.-gHas2P' :: (Element s) => Key s v -> Greskell (P v) -> Walk Filter s s-gHas2P' key p = unsafeWalk "has" [toGremlin key, toGremlin p]---- TODO: has(Key,Traversal), has(Label,Key,P)---- | @.hasLabel@ step.------ >>> toGremlin (source "g" & sV' [] &. gHasLabel "person")--- "g.V().hasLabel(\"person\")"-gHasLabel :: (Element s, WalkType c) => Greskell Text -> Walk c s s-gHasLabel = liftWalk . gHasLabel'---- | Monomorphic version of 'gHasLabel'.-gHasLabel' :: (Element s) => Greskell Text -> Walk Filter s s-gHasLabel' l = unsafeWalk "hasLabel" [toGremlin l]---- | @.hasLabel@ step with 'P' type. Supported since TinkerPop 3.2.7.------ >>> toGremlin (source "g" & sV' [] &. gHasLabelP (pEq "person"))--- "g.V().hasLabel(P.eq(\"person\"))"-gHasLabelP :: (Element s, WalkType c)- => Greskell (P Text) -- ^ predicate on Element label.- -> Walk c s s-gHasLabelP = liftWalk . gHasLabelP'---- | Monomorphic version of 'gHasLabelP'.-gHasLabelP' :: Element s- => Greskell (P Text)- -> Walk Filter s s-gHasLabelP' p = unsafeWalk "hasLabel" [toGremlin p]---- | @.hasId@ step.------ >>> toGremlin (source "g" & sV' [] &. gHasId (fmap ElementID $ gvalueInt $ (7 :: Int)))--- "g.V().hasId(7)"-gHasId :: (Element s, WalkType c) => Greskell (ElementID s) -> Walk c s s-gHasId = liftWalk . gHasId'---- | Monomorphic version of 'gHasId'.-gHasId' :: Element s => Greskell (ElementID s) -> Walk Filter s s-gHasId' i = unsafeWalk "hasId" [toGremlin i]---- | @.hasId@ step with 'P' type. Supported since TinkerPop 3.2.7.------ >>> toGremlin (source "g" & sV' [] &. gHasIdP (pLte $ fmap ElementID $ gvalueInt (100 :: Int)))--- "g.V().hasId(P.lte(100))"-gHasIdP :: (Element s, WalkType c)- => Greskell (P (ElementID s))- -> Walk c s s-gHasIdP = liftWalk . gHasIdP'---- | Monomorphic version of 'gHasIdP'.-gHasIdP' :: Element s- => Greskell (P (ElementID s))- -> Walk Filter s s-gHasIdP' p = unsafeWalk "hasId" [toGremlin p]---- | @.hasKey@ step. The input type should be a VertexProperty.------ >>> toGremlin (source "g" & sV' [] &. gProperties [] &. gHasKey "age")--- "g.V().properties().hasKey(\"age\")"-gHasKey :: (Element (p v), Property p, WalkType c) => Greskell Text -> Walk c (p v) (p v)-gHasKey = liftWalk . gHasKey'---- | Monomorphic version of 'gHasKey'.-gHasKey' :: (Element (p v), Property p) => Greskell Text -> Walk Filter (p v) (p v)-gHasKey' k = unsafeWalk "hasKey" [toGremlin k]---- | @.hasKey@ step with 'P' type. Supported since TinkerPop 3.2.7.-gHasKeyP :: (Element (p v), Property p, WalkType c)- => Greskell (P Text) -- ^ predicate on the VertexProperty's key.- -> Walk c (p v) (p v)-gHasKeyP = liftWalk . gHasKeyP'---- | Monomorphic version of 'gHasKeyP'.-gHasKeyP' :: (Element (p v), Property p) => Greskell (P Text) -> Walk Filter (p v) (p v)-gHasKeyP' p = unsafeWalk "hasKey" [toGremlin p]---- | @.hasValue@ step. The input type should be a VertexProperty.------ >>> toGremlin (source "g" & sV' [] &. gProperties ["age"] &. gHasValue (32 :: Greskell Int))--- "g.V().properties(\"age\").hasValue(32)"-gHasValue :: (Element (p v), Property p, WalkType c) => Greskell v -> Walk c (p v) (p v)-gHasValue = liftWalk . gHasValue'---- | Monomorphic version of 'gHasValue'.-gHasValue' :: (Element (p v), Property p) => Greskell v -> Walk Filter (p v) (p v)-gHasValue' v = unsafeWalk "hasValue" [toGremlin v]---- | @.hasValue@ step with 'P' type. Supported since TinkerPop 3.2.7.------ >>> toGremlin (source "g" & sV' [] &. gProperties ["age"] &. gHasValueP (pBetween (30 :: Greskell Int) 40))--- "g.V().properties(\"age\").hasValue(P.between(30,40))"-gHasValueP :: (Element (p v), Property p, WalkType c)- => Greskell (P v) -- ^ predicate on the VertexProperty's value- -> Walk c (p v) (p v)-gHasValueP = liftWalk . gHasValueP'---- | Monomorphic version of 'gHasValueP'.-gHasValueP' :: (Element (p v), Property p) => Greskell (P v) -> Walk Filter (p v) (p v)-gHasValueP' p = unsafeWalk "hasValue" [toGremlin p]--multiLogic :: (ToGTraversal g, WalkType c, WalkType p, Split c p)- => Text -- ^ method name- -> [g c s e]- -> Walk p s s-multiLogic method_name = unsafeWalk method_name . map travToG---- | @.and@ step.------ >>> toGremlin (source "g" & sV' [] &. gAnd [gOut' ["knows"], gHas1 "age"])--- "g.V().and(__.out(\"knows\"),__.has(\"age\"))"-gAnd :: (ToGTraversal g, WalkType c, WalkType p, Split c p) => [g c s e] -> Walk p s s-gAnd = multiLogic "and"---- | @.or@ step.------ >>> toGremlin (source "g" & sV' [] &. gOr [gOut' ["knows"], gHas1 "age"])--- "g.V().or(__.out(\"knows\"),__.has(\"age\"))"-gOr :: (ToGTraversal g, WalkType c, WalkType p, Split c p) => [g c s e] -> Walk p s s-gOr = multiLogic "or"---- | @.not@ step.------ >>> toGremlin (source "g" & sV' [] &. gNot (gOut' ["knows"]))--- "g.V().not(__.out(\"knows\"))"-gNot :: (ToGTraversal g, WalkType c, WalkType p, Split c p) => g c s e -> Walk p s s-gNot cond = unsafeWalk "not" [travToG cond]---- | @.range@ step. This step is not a 'Filter', because the filtering--- decision by this step is based on position of each element, not the--- element itself. This violates 'Filter' law.------ >>> toGremlin (source "g" & sV' [] &. gRange 0 100)--- "g.V().range(0,100)"-gRange :: Greskell Int- -- ^ min- -> Greskell Int- -- ^ max- -> Walk Transform s s-gRange min_g max_g = unsafeWalk "range" $ map toGremlin [min_g, max_g]---- | @.limit@ step.------ @since 0.2.1.0-gLimit :: Greskell Int -> Walk Transform s s-gLimit num = unsafeWalk "limit" [toGremlin num]---- | @.tail@ step.------ @since 0.2.1.0-gTail :: Greskell Int -> Walk Transform s s-gTail num = unsafeWalk "tail" [toGremlin num]---- | @.skip@ step.------ @since 0.2.1.0-gSkip :: Greskell Int -> Walk Transform s s-gSkip num = unsafeWalk "skip" [toGremlin num]---- | A label that points to a loop created by @.repeat@ step. It can--- be used by @.loops@ step to specify the loop.------ @since 1.0.1.0-newtype RepeatLabel =- RepeatLabel { unRepeatLabel :: Text }- deriving (Show,Eq,Ord,IsString)---- | Return Gremlin String literal.-instance ToGreskell RepeatLabel where- type GreskellReturn RepeatLabel = Text- toGreskell (RepeatLabel t) = Greskell.string t---- | Position of a step modulator relative to @.repeat@ step.------ @since 1.0.1.0-data RepeatPos = RepeatHead -- ^ Modulator before the @.repeat@ step.- | RepeatTail -- ^ Modulator after the @.repeat@ step.- deriving (Show,Eq,Ord,Enum,Bounded)---- | @.until@ or @.times@ modulator step.------ Type @c@ is the 'WalkType' of the parent @.repeat@ step. Type @s@--- is the start (and end) type of the @.repeat@ step.------ @since 1.0.1.0-data RepeatUntil c s where- -- | @.times@ modulator.- RepeatTimes :: Greskell Int -> RepeatUntil c s- -- | @.until@ modulator with a sub-traversal as the predicate to- -- decide if the repetition should stop.- RepeatUntilT :: (WalkType cc, WalkType c, Split cc c) => GTraversal cc s e -> RepeatUntil c s--deriving instance Show (RepeatUntil c s)--makeUntilWalk :: WalkType c => RepeatUntil c s -> Walk c s s-makeUntilWalk (RepeatTimes count) = unsafeWalk "times" [toGremlin count]-makeUntilWalk (RepeatUntilT trav) = unsafeWalk "until" [toGremlin trav]---- | @.emit@ modulator step.------ Type @c@ is the 'WalkType' of the parent @.repeat@ step. Type @s@--- is the start (and end) type of the @.repeat@ step.------ @since 1.0.1.0-data RepeatEmit c s where- -- | @.emit@ modulator without argument. It always emits the input- -- traverser of type @s@.- RepeatEmit :: RepeatEmit c s- -- | @.emit@ modulator with a sub-traversal as the predicate to- -- decide if it emits the traverser.- RepeatEmitT :: (WalkType cc, WalkType c, Split cc c) => GTraversal cc s e -> RepeatEmit c s--deriving instance Show (RepeatEmit c s)--makeEmitWalk :: WalkType c => RepeatEmit c s -> Walk c s s-makeEmitWalk (RepeatEmit) = unsafeWalk "emit" []-makeEmitWalk (RepeatEmitT trav) = unsafeWalk "emit" [toGremlin trav]------ | Zero or more Gremlin steps.------ @since 1.0.1.0-newtype MWalk c s e = MWalk (Maybe (Walk c s e))- deriving (Show)--deriving instance WalkType c => Semigroup (MWalk c s s)-deriving instance WalkType c => Monoid (MWalk c s s)--toMWalk :: Walk c s e -> MWalk c s e-toMWalk = MWalk . Just---- | @MWalk Nothing@ is coverted to identity step.-fromMWalk :: WalkType c => MWalk c s s -> Walk c s s-fromMWalk (MWalk Nothing) = mempty-fromMWalk (MWalk (Just w)) = w------ | @.repeat@ step.------ @since 1.0.1.0-gRepeat :: (ToGTraversal g, WalkType c)- => Maybe RepeatLabel -- ^ Label for the loop.- -> Maybe (RepeatPos, RepeatUntil c s)- -- ^ @.until@ or @.times@ modulator. You can use 'gTimes',- -- 'gUntilHead', 'gUntilTail' to make this argument.- -> Maybe (RepeatPos, RepeatEmit c s)- -- ^ @.emit@ modulator. You can use 'gEmitHead', 'gEmitTail',- -- 'gEmitHeadT', 'gEmitTailT' to make this argument.- -> g c s s -- ^ Repeated traversal- -> 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 ++ [travToG repeated_trav])- label_args = maybe [] (\l -> [toGremlin l]) mlabel- head_walk = head_until <> head_emit- tail_walk = tail_until <> tail_emit- (head_until, tail_until) =- case muntil of- Nothing -> (mempty, mempty)- Just (pos, u) ->- case pos of- RepeatHead -> (toMWalk $ makeUntilWalk u, mempty)- RepeatTail -> (mempty, toMWalk $ makeUntilWalk u)- (head_emit, tail_emit) =- case memit of- Nothing -> (mempty, mempty)- Just (pos, e) ->- case pos of- RepeatHead -> (toMWalk $ makeEmitWalk e, mempty)- RepeatTail -> (mempty, toMWalk $ makeEmitWalk e)---- | @.times@ modulator before the @.repeat@ step. It always returns--- 'Just'.------ >>> toGremlin (source "g" & sV' [] &. gRepeat Nothing (gTimes 3) Nothing (gOut' []))--- "g.V().times(3).repeat(__.out())"------ @since 1.0.1.0-gTimes :: Greskell Int- -- ^ Repeat count. If it's less than or equal to 0, the- -- repeated traversal is never executed.- -> Maybe (RepeatPos, RepeatUntil c s)-gTimes c = Just (RepeatHead, RepeatTimes c)---- | @.until@ modulator before the @.repeat@ step. It always returns--- 'Just'.------ >>> toGremlin (source "g" & sV' [] &. gRepeat Nothing (gUntilHead $ gHasLabel' "person") Nothing (gOut' []))--- "g.V().until(__.hasLabel(\"person\")).repeat(__.out())"------ @since 1.0.1.0-gUntilHead :: (ToGTraversal g, WalkType c, WalkType cc, Split cc c) => g cc s e -> Maybe (RepeatPos, RepeatUntil c s)-gUntilHead trav = Just (RepeatHead, RepeatUntilT $ toGTraversal trav)---- | @.until@ modulator after the @.repeat@ step. It always returns--- 'Just'.------ >>> toGremlin (source "g" & sV' [] &. gRepeat Nothing (gUntilTail $ gHasLabel' "person") Nothing (gOut' []))--- "g.V().repeat(__.out()).until(__.hasLabel(\"person\"))"------ @since 1.0.1.0-gUntilTail :: (ToGTraversal g, WalkType c, WalkType cc, Split cc c) => g cc s e -> Maybe (RepeatPos, RepeatUntil c s)-gUntilTail trav = Just (RepeatTail, RepeatUntilT $ toGTraversal trav)---- | @.emit@ modulator without argument before the @.repeat@ step. It--- always returns 'Just'.------ >>> toGremlin (source "g" & sV' [] &. gRepeat Nothing Nothing gEmitHead (gOut' []))--- "g.V().emit().repeat(__.out())"------ @since 1.0.1.0-gEmitHead :: Maybe (RepeatPos, RepeatEmit c s)-gEmitHead = Just (RepeatHead, RepeatEmit)---- | @.emit@ modulator without argument after the @.repeat@ step. It--- always returns 'Just'.------ >>> toGremlin (source "g" & sV' [] &. gRepeat Nothing Nothing gEmitTail (gOut' []))--- "g.V().repeat(__.out()).emit()"------ @since 1.0.1.0-gEmitTail :: Maybe (RepeatPos, RepeatEmit c s)-gEmitTail = Just (RepeatTail, RepeatEmit)---- | @.emit@ modulator with a sub-traversal argument before the--- @.repeat@ step. It always returns 'Just'.------ >>> toGremlin (source "g" & sV' [] &. gRepeat Nothing Nothing (gEmitHeadT $ gHasLabel' "person") (gOut' []))--- "g.V().emit(__.hasLabel(\"person\")).repeat(__.out())"------ @since 1.0.1.0-gEmitHeadT :: (ToGTraversal g, WalkType c, WalkType cc, Split cc c) => g cc s e -> Maybe (RepeatPos, RepeatEmit c s)-gEmitHeadT trav = Just (RepeatHead, RepeatEmitT $ toGTraversal trav)---- | @.emit@ modulator with a sub-traversal argument after the--- @.repeat@ step. It always returns 'Just'.------ >>> toGremlin (source "g" & sV' [] &. gRepeat Nothing Nothing (gEmitTailT $ gHasLabel' "person") (gOut' []))--- "g.V().repeat(__.out()).emit(__.hasLabel(\"person\"))"------ @since 1.0.1.0-gEmitTailT :: (ToGTraversal g, WalkType c, WalkType cc, Split cc c) => g cc s e -> Maybe (RepeatPos, RepeatEmit c s)-gEmitTailT trav = Just (RepeatTail, RepeatEmitT $ toGTraversal trav)---- | @.loops@ step.------ >>> let loop_label = Just "the_loop"--- >>> toGremlin (source "g" & sV' [] &. gRepeat loop_label (gUntilTail $ gLoops loop_label >>> gIs 3) Nothing (gOut' []))--- "g.V().repeat(\"the_loop\",__.out()).until(__.loops(\"the_loop\").is(3))"------ @since 1.0.1.0-gLoops :: Maybe RepeatLabel -> Walk Transform s Int-gLoops mlabel = unsafeWalk "loops" $ maybe [] (\l -> [toGremlin l]) mlabel---- | @.local@ step.------ >>> toGremlin (source "g" & sV' [] &. gLocal ( gOut' [] >>> gLimit 3 ))--- "g.V().local(__.out().limit(3))"------ @since 1.0.1.0-gLocal :: (ToGTraversal g, WalkType c) => g c s e -> Walk c s e-gLocal t = unsafeWalk "local" [travToG t]---- | @.union@ step.------ >>> let key_age = ("age" :: Key AVertex Int)--- >>> let key_birth_year = ("birth_year" :: Key AVertex Int)--- >>> toGremlin (source "g" & sV' [] &. gUnion [gValues [key_age], gValues [key_birth_year]])--- "g.V().union(__.values(\"age\"),__.values(\"birth_year\"))"------ @since 1.0.1.0-gUnion :: (ToGTraversal g, WalkType c) => [g c s e] -> Walk c s e-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)--- >>> toGremlin (source "g" & sV' [] &. gChoose3 (gHas2' key_age 30) (gIn' []) (gOut' []))--- "g.V().choose(__.has(\"age\",30),__.in(),__.out())"------ @since 1.0.1.0-gChoose3 :: (ToGTraversal g, Split cc c, WalkType cc, WalkType c)- => g cc s ep -- ^ the predicate traversal.- -> g c s e -- ^ The traversal executed if the predicate traversal outputs something.- -> g c s e -- ^ The traversal executed if the predicate traversal outputs nothing.- -> Walk c s e-gChoose3 pt tt ft = unsafeWalk "choose"- [ travToG pt,- travToG tt,- travToG ft- ]---- | @.barrier@ step.------ @since 1.0.1.0-gBarrier :: WalkType c- => Maybe (Greskell Int)- -- ^ Max number of traversers kept at this barrier.- -> Walk c s s-gBarrier mmax = unsafeWalk "barrier" $ maybe [] (\m -> [toGremlin m]) mmax---- | @.dedup@ step without argument.------ @.dedup@ step is 'Transform' because the filtering decision depends--- on the sequence (order) of input elements.------ >>> toGremlin (source "g" & sV' [] &. gDedup Nothing)--- "g.V().dedup()"--- >>> let key_age = ("age" :: Key AVertex Int)--- >>> toGremlin (source "g" & sV' [] &. gDedup (Just $ gBy key_age))--- "g.V().dedup().by(\"age\")"------ @since 1.0.1.0-gDedup :: Maybe (ByProjection s e)- -- ^ @.by@ modulator. If specified, the result of type @e@ is- -- used as the criterion of deduplication.- -> Walk Transform s s-gDedup mp = gDedupGeneric [] mp---- | @.dedup@ step with at least one argument. The tuple specified by--- the 'AsLabel's is used as the criterion of deduplication.------ >>> let label_a = ("a" :: AsLabel AVertex)--- >>> let label_b = ("b" :: AsLabel AVertex)--- >>> toGremlin (source "g" & sV' [] &. gAs label_a &. gOut' [] &. gAs label_b &. gDedupN label_a [label_b] Nothing)--- "g.V().as(\"a\").out().as(\"b\").dedup(\"a\",\"b\")"------ @since 1.0.1.0-gDedupN :: AsLabel a -> [AsLabel a] -> Maybe (ByProjection a e) -> Walk Transform s s-gDedupN l ls mp = gDedupGeneric (map toGremlin (l : ls)) mp--gDedupGeneric :: [Text] -> Maybe (ByProjection a b) -> Walk Transform s s-gDedupGeneric args mp = - case mp of- Nothing -> main_walk- Just (ByProjection g) -> modulateWith main_walk [unsafeWalk "by" [toGremlin g]]- where- main_walk = unsafeWalk "dedup" args----- | Data types that mean a projection from one type to another.-class ProjectionLike p where- type ProjectionLikeStart p- -- ^ The start type of the projection.- type ProjectionLikeEnd p- -- ^ The end type of the projection.--instance ProjectionLike (Walk Filter s e) where- type ProjectionLikeStart (Walk Filter s e) = s- type ProjectionLikeEnd (Walk Filter s e) = e--instance ProjectionLike (GTraversal Filter s e) where- type ProjectionLikeStart (GTraversal Filter s e) = s- type ProjectionLikeEnd (GTraversal Filter s e) = e--instance ProjectionLike (Greskell (GraphTraversal Filter s e)) where- type ProjectionLikeStart (Greskell (GraphTraversal Filter s e)) = s- type ProjectionLikeEnd (Greskell (GraphTraversal Filter s e)) = e--instance ProjectionLike (Walk Transform s e) where- type ProjectionLikeStart (Walk Transform s e) = s- type ProjectionLikeEnd (Walk Transform s e) = e--instance ProjectionLike (GTraversal Transform s e) where- type ProjectionLikeStart (GTraversal Transform s e) = s- type ProjectionLikeEnd (GTraversal Transform s e) = e--instance ProjectionLike (Greskell (GraphTraversal Transform s e)) where- type ProjectionLikeStart (Greskell (GraphTraversal Transform s e)) = s- type ProjectionLikeEnd (Greskell (GraphTraversal Transform s e)) = e--instance ProjectionLike (Key s e) where- type ProjectionLikeStart (Key s e) = s- type ProjectionLikeEnd (Key s e) = e--instance ProjectionLike (Greskell (T s e)) where- type ProjectionLikeStart (Greskell (T s e)) = s- type ProjectionLikeEnd (Greskell (T s e)) = e--instance ProjectionLike (Greskell (s -> e)) where- type ProjectionLikeStart (Greskell (s -> e)) = s- type ProjectionLikeEnd (Greskell (s -> e)) = e--instance ProjectionLike (ByProjection s e) where- type ProjectionLikeStart (ByProjection s e) = s- type ProjectionLikeEnd (ByProjection s e) = e---- | Projection from type @s@ to type @e@ used in @.by@ step. You can--- also use 'gBy' to construct 'ByProjection'.-data ByProjection s e where- ByProjection :: (ProjectionLike p, ToGreskell p) => p -> ByProjection (ProjectionLikeStart p) (ProjectionLikeEnd p)---- | Projection by literal property key.-instance IsString (ByProjection s e) where- fromString = ByProjection . toKey- where- toKey :: String -> Key s e- toKey = fromString---- | @.by@ step with 1 argument, used for projection.-gBy :: (ProjectionLike p, ToGreskell p) => p -> ByProjection (ProjectionLikeStart p) (ProjectionLikeEnd p)-gBy = ByProjection ---- | Comparison of type @s@ used in @.by@ step. You can also use--- 'gBy1' and 'gBy2' to construct 'ByComparator'.-data ByComparator s where- -- | Type @s@ is projected to type @e@, and compared by the natural- -- comparator of type @e@.- ByComparatorProj :: ByProjection s e -> ByComparator s- - -- | Type @s@ is compared by the 'Comparator' @comp@.- ByComparatorComp :: Comparator comp => Greskell comp -> ByComparator (CompareArg comp)- - -- | Type @s@ is projected to type @CompareArg comp@, and compared- -- by the 'Comparator' @comp@.- ByComparatorProjComp :: Comparator comp => ByProjection s (CompareArg comp) -> Greskell comp -> ByComparator s---- | 'ByComparatorProj' by literal property key.-instance IsString (ByComparator s) where- fromString = ByComparatorProj . fromString---- | @.by@ step with 1 argument, used for comparison.-gBy1 :: (ProjectionLike p, ToGreskell p) => p -> ByComparator (ProjectionLikeStart p)-gBy1 = ByComparatorProj . gBy---- | @.by@ step with 2 arguments, used for comparison.-gBy2 :: (ProjectionLike p, ToGreskell p, Comparator comp, ProjectionLikeEnd p ~ CompareArg comp)- => p- -> Greskell comp- -> ByComparator (ProjectionLikeStart p)-gBy2 p c = ByComparatorProjComp (gBy p) c---- | @.order@ step.------ >>> let key_age = ("age" :: Key AVertex Int)--- >>> toGremlin (source "g" & sV' [] &. gOrder [gBy1 key_age])--- "g.V().order().by(\"age\")"--- >>> toGremlin (source "g" & sV' [] &. gOrder [gBy2 key_age oDecr, gBy1 tId])--- "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- where- order_step = unsafeWalk "order" []- by_steps = map (unsafeWalk "by" . toByArgs) bys- toByArgs :: ByComparator s -> [Text]- toByArgs bc = case bc of- ByComparatorProj (ByProjection p) -> [toGremlin p]- ByComparatorComp comp -> [toGremlin comp]- ByComparatorProjComp (ByProjection p) comp -> [toGremlin p, toGremlin comp]---- | A 'ByProjection' associated with an 'AsLabel'. You can construct--- it by 'gByL'.------ @since 1.0.0.0-data LabeledByProjection s where- LabeledByProjection :: AsLabel a -> ByProjection s a -> LabeledByProjection s---- | @.by@ step associated with an 'AsLabel'.------ @since 1.0.0.0-gByL :: (ProjectionLike p, ToGreskell p) => AsLabel (ProjectionLikeEnd p) -> p -> LabeledByProjection (ProjectionLikeStart p)-gByL l p = LabeledByProjection l $ gBy p---- | @.flatMap@ step.------ @.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\"))"------ @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]---- | 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.------ 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 (ElementID AVertex)] -> Walk Transform s AVertex-gV' = gV---- | @.constant@ step.------ >>> toGremlin (source "g" & sV' [] &. gConstant (10 :: Greskell Int))--- "g.V().constant(10)"------ @since 1.0.1.0-gConstant :: Greskell a -> Walk Transform s a-gConstant v = unsafeWalk "constant" [toGremlin v]---- | @.unfold@ step.------ Note that we use 'AsIterator' here because basically the @.unfold@--- step does the same thing as @IteratorUtils.asIterator@ function in--- Tinkerpop. However, Tinkerpop's implementation of @.unfold@ step--- doesn't necessarily use @asIterator@, so there may be some corner--- cases where @asIterator@ and @.unfold@ step behave differently.------ >>> toGremlin (source "g" & sV' [] &. gFold &. gUnfold)--- "g.V().fold().unfold()"------ @since 1.0.1.0-gUnfold :: AsIterator a => Walk Transform a (IteratorItem a)-gUnfold = unsafeWalk "unfold" []---- | @.as@ step.------ @.as@ step is 'Transform' because it adds the label to the--- traverser.------ @since 0.2.2.0-gAs :: AsLabel a -> Walk Transform a a-gAs l = unsafeWalk "as" [toGremlin l]---- | @.values@ step.------ >>> toGremlin (source "g" & sV' [] &. gValues ["name", "age"])--- "g.V().values(\"name\",\"age\")"-gValues :: Element s- => [Key s e]- -- ^ property keys- -> Walk Transform s e-gValues = unsafeWalk "values" . map toGremlin---- | @.properties@ step.------ >>> toGremlin (source "g" & sV' [] &. gProperties ["age"])--- "g.V().properties(\"age\")"-gProperties :: (Element s, Property p, ElementProperty s ~ p)- => [Key s v]- -> Walk Transform s (p v)-gProperties = unsafeWalk "properties" . map toGremlin---- | @.id@ step.------ @since 0.2.1.0-gId :: Element s => Walk Transform s (ElementID s)-gId = unsafeWalk "id" []---- | @.label@ step.------ @since 0.2.1.0-gLabel :: Element s => Walk Transform s Text-gLabel = unsafeWalk "label" []---- | @.valueMap@ step.------ >>> toGremlin (source "g" & sV' [] &. gValueMap KeysNil)--- "g.V().valueMap()"--- >>> toGremlin (source "g" & sV' [] &. gValueMap ("name" -: "age" -: KeysNil))--- "g.V().valueMap(\"name\",\"age\")"------ @since 1.0.0.0-gValueMap :: Element s- => Keys s- -> Walk Transform s (PMap (ElementPropertyContainer s) GValue)-gValueMap keys = unsafeWalk "valueMap" $ toGremlinKeys keys- where- toGremlinKeys KeysNil = []- toGremlinKeys (KeysCons k rest) = toGremlin k : toGremlinKeys rest---- | @.select@ step with one argument.------ @since 0.2.2.0-gSelect1 :: AsLabel a -> Walk Transform s a-gSelect1 l = unsafeWalk "select" [toGremlin l]---- | @.select@ step with more than one arguments.------ @since 0.2.2.0-gSelectN :: AsLabel a -> AsLabel b -> [AsLabel c] -> Walk Transform s (SelectedMap GValue)-gSelectN l1 l2 ls = unsafeWalk "select" ([toGremlin l1, toGremlin l2] ++ map toGremlin ls)--unsafeChangeEnd :: Walk c a b -> Walk c a b'-unsafeChangeEnd (Walk t) = Walk t--byStep :: WalkType t => ByProjection a b -> Walk t c c-byStep (ByProjection p) = unsafeWalk "by" [toGremlin p]---- | @.select@ step with one argument followed by @.by@ step.------ @since 0.2.2.0-gSelectBy1 :: AsLabel a -> ByProjection a b -> Walk Transform s b-gSelectBy1 l bp = modulateWith (unsafeChangeEnd $ gSelect1 l) [byStep bp]---- | @.select@ step with more than one arguments followed by @.by@--- step.------ @since 0.2.2.0-gSelectByN :: AsLabel a -> AsLabel a -> [AsLabel a] -> ByProjection a b -> Walk Transform s (SelectedMap b)-gSelectByN l1 l2 ls bp = modulateWith (unsafeChangeEnd $ gSelectN l1 l2 ls) [byStep bp]---- | @.project@ step.------ >>> let name_label = ("a" :: AsLabel Text)--- >>> let name_key = ("name" :: Key AVertex Text)--- >>> let count_label = ("b" :: AsLabel Int)--- >>> toGremlin (source "g" & sV' [] &. gProject (gByL name_label name_key) [gByL count_label (gOut' [] >>> gCount), gByL "c" tId])--- "g.V().project(\"a\",\"b\",\"c\").by(\"name\").by(__.out().count()).by(T.id)"------ @since 1.0.0.0-gProject :: LabeledByProjection s -> [LabeledByProjection s] -> Walk Transform s (PMap Single GValue)-gProject lp_head lps = foldl' f (unsafeWalk "project" labels) (lp_head : lps)- where- labels = map toLabelGremlin (lp_head : lps)- toLabelGremlin (LabeledByProjection l _) = toGremlin l- 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]-gFold = unsafeWalk "fold" []---- | @.count@ step.-gCount :: Walk Transform a Int-gCount = unsafeWalk "count" []--genericTraversalWalk :: Vertex v => Text -> [Greskell Text] -> Walk Transform v e-genericTraversalWalk method_name = unsafeWalk method_name . map toGremlin---- | @.out@ step-gOut :: (Vertex v1, Vertex v2)- => [Greskell Text] -- ^ edge labels- -> Walk Transform v1 v2-gOut = genericTraversalWalk "out"---- | Monomorphic version of 'gOut'.------ >>> toGremlin (source "g" & sV' [fmap ElementID $ gvalueInt (8 :: Int)] &. gOut' ["knows"])--- "g.V(8).out(\"knows\")"-gOut' :: (Vertex v)- => [Greskell Text] -- ^ edge labels- -> Walk Transform v AVertex-gOut' = gOut---- | @.outE@ step-gOutE :: (Vertex v, Edge e)- => [Greskell Text] -- ^ edge labels- -> Walk Transform v e-gOutE = genericTraversalWalk "outE"---- | Monomorphic version of 'gOutE'.-gOutE' :: (Vertex v)- => [Greskell Text]- -> Walk Transform v AEdge-gOutE' = gOutE---- | @.outV@ step.------ @since 0.2.2.0-gOutV :: (Edge e, Vertex v) => Walk Transform e v-gOutV = unsafeWalk "outV" []---- | Monomorphic version of 'gOutV'.------ @since 0.2.2.0-gOutV' :: Edge e => Walk Transform e AVertex-gOutV' = gOutV---- | @.in@ step-gIn :: (Vertex v1, Vertex v2)- => [Greskell Text] -- ^ edge labels- -> Walk Transform v1 v2-gIn = genericTraversalWalk "in"---- | Monomorphic version of 'gIn'.-gIn' :: (Vertex v)- => [Greskell Text]- -> Walk Transform v AVertex-gIn' = gIn---- | @.inE@ step.-gInE :: (Vertex v, Edge e)- => [Greskell Text] -- ^ edge labels- -> Walk Transform v e-gInE = genericTraversalWalk "inE"---- | Monomorphic version of 'gInE'.-gInE' :: (Vertex v)- => [Greskell Text] -- ^ edge labels- -> Walk Transform v AEdge-gInE' = gInE---- | @.inV@ step.------ @since 0.2.2.0-gInV :: (Edge e, Vertex v) => Walk Transform e v-gInV = unsafeWalk "inV" []---- | Monomorphic version of 'gInV'.------ @since 0.2.2.0-gInV' :: Edge e => Walk Transform e AVertex-gInV' = gInV---- | @.sideEffect@ step that takes a traversal.-gSideEffect :: (ToGTraversal g, WalkType c, WalkType p, Split c p) => g c s e -> Walk p s s-gSideEffect walk = unsafeWalk "sideEffect" [travToG walk]---- | Monomorphic version of 'gSideEffect'. The result walk is always--- 'SideEffect' type.------ >>> toGremlin (source "g" & sV' [] & liftWalk &. gHas2 "name" "marko" &. gSideEffect' (gAddV' "toshio"))--- "g.V().has(\"name\",\"marko\").sideEffect(__.addV(\"toshio\"))"-gSideEffect' :: (ToGTraversal g, WalkType c, Split c SideEffect) => g c s e -> Walk SideEffect s s-gSideEffect' w = gSideEffect w---- | @.addV@ step with a label.-gAddV :: Vertex v => Greskell Text -> Walk SideEffect a v-gAddV label = unsafeWalk "addV" [toGremlin label]---- | Monomorphic version of 'gAddV'.-gAddV' :: Greskell Text -> Walk SideEffect a AVertex-gAddV' = gAddV---- | @.drop@ step on 'Element'.--- --- >>> toGremlin (source "g" & sV' [] &. gHas2 "name" "marko" & liftWalk &. gDrop)--- "g.V().has(\"name\",\"marko\").drop()"-gDrop :: Element e => Walk SideEffect e e-gDrop = unsafeWalk "drop" []---- | @.drop@ step on 'Property'.------ >>> toGremlin (source "g" & sE' [] &. gProperties ["weight"] & liftWalk &. gDropP)--- "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]- expand (KeyNoValue _) = []---- | 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-+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}+-- |+-- Module: Data.Greskell.GTraversal+-- Description: Gremlin traversal/step types.+-- Maintainer: Toshio Ito <debug.ito@gmail.com>+--+-- This module defines 'GTraversal', greskell counterpart of+-- @GraphTraversal@ class object, and a DSL of composing graph+-- traversal steps.+module Data.Greskell.GTraversal+ ( -- * Types+ -- ** GraphTraversal and others+ GTraversal (..)+ , GraphTraversal+ , ToGTraversal (..)+ , Walk+ , GraphTraversalSource+ -- ** Walk types+ , WalkType+ , Filter+ , Transform+ , SideEffect+ , Lift+ , Split+ -- * GraphTraversalSource+ , source+ , sV+ , sV'+ , sE+ , sE'+ , sAddV+ , sAddV'+ -- * GTraversal+ , (&.)+ , ($.)+ , (<$.>)+ , (<*.>)+ , gIterate+ , unsafeGTraversal+ -- * Walk/Steps+ --+ -- | Functions for TinkerPop graph traversal steps.+ -- __For now greskell does not cover all graph traversal steps.__+ -- If you want some steps added, just open an issue.+ --+ -- There may be multiple versions of Haskell functions for a single step. This is because Gremlin+ -- steps are too polymorphic for Haskell. greskell should be type-safe so that incorrect combination+ -- of steps is detected in compile time.+ -- Functions for TinkerPop graph traversal steps.+ , unsafeWalk+ , modulateWith+ -- ** Filter steps+ , gIdentity+ , gIdentity'+ , gFilter+ , gCyclicPath+ , gCyclicPath'+ , gSimplePath+ , gSimplePath'+ -- ** Is step+ , gIs+ , gIs'+ , gIsP+ , gIsP'+ -- ** Has steps+ , gHas1+ , gHas1'+ , gHas2+ , gHas2'+ , gHas2P+ , gHas2P'+ , gHasLabel+ , gHasLabel'+ , gHasLabelP+ , gHasLabelP'+ , gHasId+ , gHasId'+ , gHasIdP+ , gHasIdP'+ , gHasKey+ , gHasKey'+ , gHasKeyP+ , gHasKeyP'+ , gHasValue+ , gHasValue'+ , gHasValueP+ , gHasValueP'+ -- ** Logic steps+ , gAnd+ , gOr+ , gNot+ -- ** Where step+ , gWhereP1+ , gWhereP1'+ , gWhereP2+ , gWhereP2'+ -- ** Sorting steps+ , gOrder+ -- ** Paging steps+ , gRange+ , gLimit+ , gTail+ , gSkip+ -- ** Repeat step+ , gRepeat+ , gTimes+ , gUntilHead+ , gUntilTail+ , gEmitHead+ , gEmitTail+ , gEmitHeadT+ , gEmitTailT+ , gLoops+ , RepeatUntil (..)+ , RepeatEmit (..)+ , RepeatPos (..)+ , RepeatLabel (..)+ -- ** Branching steps+ , gLocal+ , gUnion+ , gCoalesce+ , gChoose3+ -- ** Barrier steps+ , gBarrier+ , gDedup+ , gDedupN+ -- ** Transformation steps+ , gFlatMap+ , gFlatMap'+ , gV+ , gV'+ , gConstant+ , gProject+ -- ** As step+ , gAs+ -- ** Accessor steps+ , gValues+ , gProperties+ , gId+ , gLabel+ , gValueMap+ , gElementMap+ , gSelect1+ , gSelectN+ , gSelectBy1+ , gSelectByN+ , gUnfold+ , gPath+ , gPathBy+ -- ** Summarizing steps+ , gFold+ , gCount+ -- ** Graph traversal steps+ , gOut+ , gOut'+ , gOutE+ , gOutE'+ , gOutV+ , gOutV'+ , gIn+ , gIn'+ , gInE+ , gInE'+ , gInV+ , gInV'+ -- ** Match step+ , gMatch+ , MatchPattern (..)+ , mPattern+ , MatchResult+ -- ** Side-effect steps+ , gSideEffect+ , gSideEffect'+ -- ** 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 always used in conjunction with+ -- other steps like 'gOrder'.+ , ByProjection (..)+ , ProjectionLike (..)+ , ByComparator (..)+ , LabeledByProjection (..)+ , gBy+ , gBy1+ , gBy2+ , gByL+ -- * Examples+ , examples+ -- * Only for tests+ , showWalkType+ , showLift+ , showSplit+ ) where++import Control.Applicative ((<$>), (<*>))+import Control.Category (Category, (>>>))+-- (below) to import Category methods without conflict with Prelude+import qualified Control.Category as Category+import Data.Aeson (Value)+import Data.Bifunctor (Bifunctor (bimap))+import Data.Foldable (foldl')+import Data.Function ((&))+import Data.List.NonEmpty (NonEmpty (..))+import Data.Monoid (Monoid (..), mconcat, (<>))+import Data.Proxy (Proxy)+import Data.Semigroup (Semigroup, sconcat)+import qualified Data.Semigroup as Semigroup+import Data.String (IsString (..))+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL++import Data.Greskell.AsIterator (AsIterator (IteratorItem))+import Data.Greskell.AsLabel (AsLabel, LabeledP, SelectedMap)+import Data.Greskell.Graph (AEdge, AVertex, AVertexProperty, Cardinality, Edge,+ Element (..), ElementID (..), Key, KeyValue (..),+ Keys (..), Path, Property (..), T, Vertex, cList, tId,+ toGremlinKeys, (-:), (=:))+import Data.Greskell.GraphSON (FromGraphSON, GValue)+import Data.Greskell.Gremlin (Comparator (..), P, oDecr, oIncr, pBetween, pEq, pLte)+import Data.Greskell.Greskell (Greskell, ToGreskell (..), gvalueInt, toGremlin,+ toGremlinLazy, unsafeFunCall, unsafeGreskell,+ unsafeGreskellLazy)+import qualified Data.Greskell.Greskell as Greskell+import Data.Greskell.Logic (Logic)+import qualified Data.Greskell.Logic as Logic+import Data.Greskell.PMap (PMap, Single)++-- | @GraphTraversal@ class object of TinkerPop. It takes data @s@+-- from upstream and emits data @e@ to downstream. Type @c@ is called+-- \"walk type\", a marker to describe the effect of the traversal.+--+-- 'GTraversal' is NOT a 'Category'. Because a @GraphTraversal@ object+-- keeps some context data, the starting (left-most) @GraphTraversal@+-- object controls most of the behavior of entire composition of+-- traversals and steps. This violates 'Category' law.+newtype GTraversal c s e+ = GTraversal { unGTraversal :: Greskell (GraphTraversal c s e) }+ deriving (Show)++-- | Unsafely convert output type.+instance Functor (GTraversal c s) where+ fmap f (GTraversal g) = GTraversal $ fmap (fmap f) g++-- | Unsafely convert input and output types.+instance Bifunctor (GTraversal c) where+ bimap f1 f2 (GTraversal g) = GTraversal $ fmap (bimap f1 f2) g++-- | Unwrap 'GTraversal' data constructor.+instance ToGreskell (GTraversal c s e) where+ type GreskellReturn (GTraversal c s e) = GraphTraversal c s e+ toGreskell = unGTraversal++-- | Phantom type for @GraphTraversal@ class. In greskell, we usually+-- 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++-- | Unsafely convert input and output types.+instance Bifunctor (GraphTraversal c) where+ bimap _ _ GraphTraversal = GraphTraversal++-- | Types that can convert to 'GTraversal'.+class ToGTraversal g where+ toGTraversal :: WalkType c => g c s e -> GTraversal c s e+ liftWalk :: (WalkType from, WalkType to, Lift from to) => g from s e -> g to s e+ -- ^ Lift 'WalkType' @from@ to @to@. Use this for type matching.++ unsafeCastStart :: WalkType c => g c s1 e -> g c s2 e+ -- ^ Unsafely cast the start type @s1@ into @s2@.+ --+ -- It is recommended that @s2@ is coercible to @s1@ in terms of+ -- 'FromGraphSON'. That is, if @s2@ can parse a 'GValue', @s1@+ -- should also be able to parse that 'GValue'.+ --+ -- @since 1.0.0.0++ unsafeCastEnd :: WalkType c => g c s e1 -> g c s e2+ -- ^ Unsafely cast the end type @e1@ into @e2@. See+ -- 'unsafeCastStart'.+ --+ -- @since 1.0.0.0++instance ToGTraversal GTraversal where+ toGTraversal = id+ liftWalk (GTraversal g) = GTraversal $ unsafeGreskellLazy $ toGremlinLazy g+ unsafeCastStart (GTraversal g) = GTraversal $ unsafeGreskellLazy $ toGremlinLazy g+ unsafeCastEnd (GTraversal g) = GTraversal $ unsafeGreskellLazy $ toGremlinLazy g++-- | A chain of one or more Gremlin steps. Like 'GTraversal', type @s@+-- is the input, type @e@ is the output, and type @c@ is a marker to+-- describe the step.+--+-- 'Walk' represents a chain of method calls such as+-- @.has(x).outE()@. Because this is not a Gremlin (Groovy)+-- expression, we use bare 'Walk', not 'Greskell' 'Walk'.+--+-- 'Walk' is a 'Category'. You can use functions from+-- "Control.Category" to compose 'Walk's. This is equivalent to making+-- a chain of method calls in Gremlin.+--+-- 'Walk' is not an 'Eq', because it's difficult to define true+-- equality between Gremlin method calls. If we define it naively, it+-- might have conflict with 'Category' law.+newtype Walk c s e+ = Walk TL.Text+ deriving (Show)++-- | 'id' is 'gIdentity'.+instance WalkType c => Category (Walk c) where+ id = gIdentity+ (Walk bc) . (Walk ab) = Walk (ab <> bc)++-- | Based on 'Category'. 'Semigroup.<>' is 'Category.>>>'.+instance WalkType c => Semigroup (Walk c s s) where+ (<>) = (Category.>>>)++-- | Based on 'Category' and 'Semigroup'. 'mempty' is 'Category.id'.+instance WalkType c => Monoid (Walk c s s) where+ mempty = Category.id+ mappend = (Semigroup.<>)++-- | Unsafely convert output type+instance Functor (Walk c s) where+ fmap _ (Walk t) = Walk t++-- | Unsafely convert input and output types.+instance Bifunctor (Walk c) where+ bimap _ _ (Walk t) = Walk t++-- | To convert a 'Walk' to 'GTraversal', it calls its static method+-- version on @__@ class.+instance ToGTraversal Walk where+ toGTraversal (Walk t) = GTraversal $ unsafeGreskellLazy ("__" <> t)+ liftWalk (Walk t) = Walk t+ unsafeCastStart (Walk t) = Walk t+ unsafeCastEnd (Walk t) = Walk t++-- | The 'Walk' is first converted to 'GTraversal', and it's converted+-- to 'Greskell'.+instance WalkType c => ToGreskell (Walk c s e) where+ type GreskellReturn (Walk c s e) = GraphTraversal c s e+ toGreskell = toGreskell . toGTraversal++-- | Class of phantom type markers to describe the effect of the+-- walk/traversals.+class WalkType t where+ -- | Only for tests.+ showWalkType :: Proxy t -> String++-- | WalkType for filtering steps.+--+-- A filtering step is a step that does filtering only. It takes input+-- and emits some of them without any modification, reordering,+-- traversal actions, or side-effects. Filtering decision must be+-- solely based on each element.+--+-- A 'Walk' @w@ is 'Filter' type iff:+--+-- > (gSideEffect w == gIdentity) AND (gFilter w == w)+--+-- If 'Walk's @w1@ and @w2@ are 'Filter' type, then+--+-- > gAnd [w1, w2] == w1 >>> w2 == w2 >>> w1+data Filter++instance WalkType Filter where+ showWalkType _ = "Filter"++-- | WalkType for steps without any side-effects. This includes+-- transformations, reordring, injections and graph traversal actions.+--+-- A 'Walk' @w@ is 'Transform' type iff:+--+-- > gSideEffect w == gIdentity+--+-- Obviously, every 'Filter' type 'Walk's are also 'Transform' type.+data Transform++instance WalkType Transform where+ showWalkType _ = "Transform"++-- | WalkType for steps that may have side-effects.+--+-- A side-effect here means manipulation of the \"sideEffect\" in+-- Gremlin context (i.e. the stash of data kept in a Traversal+-- object), as well as interaction with the world outside the+-- Traversal object.+--+-- For example, the following steps (in Gremlin) all have+-- side-effects.+--+-- > .addE('label')+-- > .aggregate('x')+-- > .sideEffect(System.out.&println)+-- > .map { some_variable += 1 }+data SideEffect++instance WalkType SideEffect where+ showWalkType _ = "SideEffect"++-- | Relation of 'WalkType's where one includes the other. @from@ can+-- be lifted to @to@, because @to@ is more powerful than @from@.+class Lift from to where+ -- | Only for tests.+ showLift :: Proxy from -> Proxy to -> String++genericShowLift :: (WalkType from, WalkType to) => Proxy from -> Proxy to -> String+genericShowLift f t = "Lift " <> showWalkType f <> " " <> showWalkType t++instance (WalkType c) => Lift Filter c where+ showLift = genericShowLift+instance Lift Transform Transform where+ showLift = genericShowLift+instance Lift Transform SideEffect where+ showLift = genericShowLift+instance Lift SideEffect SideEffect where+ showLift = genericShowLift++-- | Relation of 'WalkType's where the child walk @c@ is split from+-- the parent walk @p@.+--+-- When splitting, transformation effect done in the child walk is+-- rolled back (canceled) in the parent walk.+class Split c p where+ -- | Only for tests.+ showSplit :: Proxy c -> Proxy p -> String++genericShowSplit :: (WalkType c, WalkType p) => Proxy c -> Proxy p -> String+genericShowSplit c p = "Split " <> showWalkType c <> " " <> showWalkType p++instance (WalkType p) => Split Filter p where+ showSplit = genericShowSplit++-- | 'Transform' effect in the child walk is rolled back in the parent+-- walk.+instance (WalkType p) => Split Transform p where+ showSplit = genericShowSplit++-- | 'SideEffect' in the child walk remains in the parent walk.+instance Split SideEffect SideEffect where+ showSplit = genericShowSplit+++-- | @GraphTraversalSource@ class object of TinkerPop. It is a factory+-- object of 'GraphTraversal's.+data GraphTraversalSource = GraphTraversalSource deriving (Show)+++-- | Create 'GraphTraversalSource' from a varible name in Gremlin+source :: Text -- ^ variable name of 'GraphTraversalSource'+ -> Greskell GraphTraversalSource+source = unsafeGreskell++sourceMethod :: Text -> [Greskell a] -> Greskell GraphTraversalSource -> Greskell b+sourceMethod method_name args src =+ unsafeGreskellLazy $ (toGremlinLazy src <> methodCallText method_name (map toGremlin args))++-- | @.V()@ method on 'GraphTraversalSource'.+sV :: Vertex v+ => [Greskell (ElementID v)] -- ^ vertex IDs+ -> Greskell GraphTraversalSource+ -> GTraversal Transform () v+sV ids src = GTraversal $ sourceMethod "V" ids src++-- | Monomorphic version of 'sV'.+sV' :: [Greskell (ElementID AVertex)] -- ^ vertex IDs+ -> Greskell GraphTraversalSource+ -> GTraversal Transform () AVertex+sV' = sV++-- | @.E()@ method on 'GraphTraversalSource'.+sE :: Edge e+ => [Greskell (ElementID e)] -- ^ edge IDs+ -> Greskell GraphTraversalSource+ -> GTraversal Transform () e+sE ids src = GTraversal $ sourceMethod "E" ids src++-- | Monomorphic version of 'sE'.+sE' :: [Greskell (ElementID AEdge)] -- ^ edge IDs+ -> 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'.+--+-- @since 0.2.0.0+sAddV' :: Greskell Text -> Greskell GraphTraversalSource -> GTraversal SideEffect () AVertex+sAddV' = sAddV++-- | Unsafely create 'GTraversal' from the given raw Gremlin script.+unsafeGTraversal :: Text -> GTraversal c s e+unsafeGTraversal = GTraversal . unsafeGreskell++infixl 1 &.++-- | Apply the 'Walk' to the 'GTraversal'. In Gremlin, this means+-- calling a chain of methods on the Traversal object.+(&.) :: GTraversal c a b -> Walk c b d -> GTraversal c a d+(GTraversal gt) &. (Walk twalk) = GTraversal $ unsafeGreskellLazy (toGremlinLazy gt <> twalk)++infixr 0 $.++-- | Same as '&.' with arguments flipped.+($.) :: Walk c b d -> GTraversal c a b -> GTraversal c a d+gs $. gt = gt &. gs++infixr 0 <$.>++-- | Similar to '<$>', but for '$.'.+--+-- @since 0.2.1.0+(<$.>) :: Functor f => Walk c b d -> f (GTraversal c a b) -> f (GTraversal c a d)+gs <$.> gt = ($.) gs <$> gt++infixr 0 <*.>++-- | Similar to '<*>', but for '$.'.+--+-- @since 0.2.1.0+(<*.>) :: 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 '()'.+--+-- @since 1.1.0.0+gIterate :: WalkType c => GTraversal c s e -> GTraversal c s ()+gIterate gt = unsafeWalk "iterate" [] $. gt++-- -- $walk-steps+-- --++methodCallText :: Text -- ^ method name+ -> [Text] -- ^ args+ -> TL.Text+methodCallText name args = ("." <>) $ toGremlinLazy $ unsafeFunCall name args++-- | Unsafely create a 'Walk' that represents a single method call on+-- a @GraphTraversal@.+unsafeWalk :: WalkType c+ => Text -- ^ step method name (e.g. "outE")+ -> [Text] -- ^ step method arguments+ -> Walk c s e+unsafeWalk name args = Walk $ methodCallText name args++-- | Optionally modulate the main 'Walk' with some modulating 'Walk's.+modulateWith :: (WalkType c)+ => Walk c s e -- ^ the main 'Walk'+ -> [Walk c e e] -- ^ the modulating 'Walk's+ -> Walk c s e+modulateWith w [] = w+modulateWith w (m:rest) = w >>> sconcat (m :| rest)++-- | @.identity@ step.+gIdentity :: WalkType c => Walk c s s+gIdentity = liftWalk $ gIdentity'++-- | Monomorphic version of 'gIdentity'.+gIdentity' :: Walk Filter s s+gIdentity' = unsafeWalk "identity" []++travToG :: (ToGTraversal g, WalkType c) => g c s e -> Text+travToG = toGremlin . unGTraversal . toGTraversal++-- | @.filter@ step that takes a traversal.+gFilter :: (ToGTraversal g, WalkType c, WalkType p, Split c p) => g c s e -> Walk p s s+gFilter walk = unsafeWalk "filter" [travToG walk]++-- | @.cyclicPath@ step.+--+-- @since 1.0.1.0+gCyclicPath :: (WalkType c) => Walk c a a+gCyclicPath = liftWalk gCyclicPath'++-- | Monomorphic version of 'gCyclicPath'.+--+-- @since 1.0.1.0+gCyclicPath' :: Walk Filter a a+gCyclicPath' = unsafeWalk "cyclicPath" []++-- | @.simplePath@ step.+--+-- @since 1.0.1.0+gSimplePath :: (WalkType c) => Walk c a a+gSimplePath = liftWalk gSimplePath'++-- | Monomorphic version of 'gSimplePath'.+--+-- @since 1.0.1.0+gSimplePath' :: Walk Filter a a+gSimplePath' = unsafeWalk "simplePath" []++gWherePGeneric :: Maybe (AsLabel a)+ -> Greskell (LabeledP a)+ -> Maybe (ByProjection a b)+ -> Walk Filter x x+gWherePGeneric mstart p mby = modulateWith wh mods+ where+ wh = unsafeWalk "where" $ start_args ++ [toGremlin p]+ start_args = maybe [] (return . toGremlin) mstart+ mods = maybe [] (return . byStep) mby++-- | @.where@ step with @P@ argument only.+--+-- If the 'ByProjection' argument is 'Nothing', comparison is+-- performed on the type @a@. You have to ensure that the comparator+-- included in the 'LabeledP' argument can handle the type+-- @a@. Usually this means the type @a@ should implement Java's+-- @Comparable@ interface (this is true for most Java classes).+--+-- If the 'ByProjection' argument is given, comparison is performed on+-- the projected values of type @b@. So, the type @b@ should implement+-- Java's @Comparable@ interface.+--+-- @since 1.2.0.0+gWhereP1 :: WalkType c+ => Greskell (LabeledP a) -- ^ the @P@ argument for @.where@ step.+ -> Maybe (ByProjection a b) -- ^ optional @.by@ modulation following the @.where@ step.+ -> Walk c a a+gWhereP1 p mby = liftWalk $ gWhereP1' p mby++-- | Monomorphic version of 'gWhereP1'.+--+-- @since 1.2.0.0+gWhereP1' :: Greskell (LabeledP a) -> Maybe (ByProjection a b) -> Walk Filter a a+gWhereP1' p mby = gWherePGeneric Nothing p mby++-- | @.where@ step with the starting label and @P@ arguments. See also+-- 'gWhereP1'.+--+-- @since 1.2.0.0+gWhereP2 :: WalkType c+ => AsLabel a -- ^ the starting label of @.where@.+ -> Greskell (LabeledP a) -- ^ the @P@ argument for @.where@ step.+ -> Maybe (ByProjection a b) -- ^ optional @.by@ modulation following the @.where@ step.+ -> Walk c x x+gWhereP2 s p b = liftWalk $ gWhereP2' s p b++-- | Monomorphic version of 'gWhereP2'.+--+-- @since 1.2.0.0+gWhereP2' :: AsLabel a -> Greskell (LabeledP a) -> Maybe (ByProjection a b) -> Walk Filter x x+gWhereP2' start p mby = gWherePGeneric (Just start) p mby++-- Developer note: the @.where@ step with a traversal argument is not+-- implemented yet, because @.match@ basically covers the same+-- capability. If we are to implement it, consider the following.+--+-- - The @.where@ step with a traversal argument doesn't take @.by@+-- modulation.+--+-- - The traversal argument is a logic tree (zero or more combination+-- of @__.and()@, @__.or()@ and @__.not()@ methods) of filtering+-- traversals.+--+-- - If a filtering traversal starts with @__.as()@ step,+-- it has a special meaning. The @__.as()@ step works just like+-- @__.select()@, fetching a value specified by the label from the+-- path history. In this case, the input value passed to the+-- @.where@ step is discarded.+--+-- - If a filtering traversal ends with @.as()@ step, it works like a+-- predicate step. If fetches a value specified by the label from+-- the path history, and checks if it's equal to the input+-- value. This behavior is like the one in @.match@ step, but+-- without variable binding.+--+-- - If a filtering traversal doesn't have @.as()@ step at the+-- beginning or end, it works just like it's in @.filter@ step.+++-- | Result of @.match@ step.+--+-- @since 1.2.0.0+data MatchResult++-- | A pattern for @.match@ step.+--+-- @since 1.2.0.0+data MatchPattern where+ -- | A pattern with the starting @.as@ label followed by traversal steps.+ MatchPattern :: AsLabel a -> Walk Transform a b -> MatchPattern++-- | Make a 'GTraversal' from the 'MatchPattern'. This function is+-- unsafe because it discards the types of input and output+-- traversers.+unsafePatternT :: MatchPattern -> GTraversal Transform () ()+unsafePatternT (MatchPattern l w) = unsafeCastEnd $ unsafeCastStart $ toGTraversal (gAs l >>> w)++-- | A convenient function to make a 'MatchPattern' wrapped by+-- 'Logic.Leaf'.+--+-- @since 1.2.0.0+mPattern :: (WalkType c, Lift c Transform) => AsLabel a -> Walk c a b -> Logic MatchPattern+mPattern l w = Logic.Leaf $ MatchPattern l (liftWalk w)++-- | @.match@ step.+--+-- If the top-level 'Logic' of the argument is 'Logic.And', the+-- patterns are directly passed to the @.match@ step arguments.+--+-- The result of @.match@ step, 'MatchResult', is an opaque+-- type. Basically you should not use it. Instead, you should use+-- 'gSelectN' etc to access the path history labels inside the+-- 'MatchPattern'.+--+-- See also: https://groups.google.com/g/gremlin-users/c/HVtldzV0Xk8+--+-- @since 1.2.0.0+gMatch :: Logic MatchPattern -> Walk Transform a MatchResult+gMatch patterns = unsafeWalk "match" args+ where+ args =+ case patterns of+ Logic.And p rest -> map (toGremlin . toTraversal) (p : rest)+ _ -> [toGremlin $ toTraversal patterns]+ toTraversal l =+ case l of+ Logic.Leaf p -> unsafePatternT p+ Logic.And p rest -> toGTraversal $ gAnd $ map toTraversal (p : rest)+ Logic.Or p rest -> toGTraversal $ gOr $ map toTraversal (p : rest)+ Logic.Not p -> toGTraversal $ gNot $ toTraversal p++-- | @.is@ step of simple equality.+--+-- @since 1.0.1.0+gIs :: (WalkType c) => Greskell v -> Walk c v v+gIs = liftWalk . gIs'++-- | Monomorphic version of 'gIs'.+--+-- @since 1.0.1.0+gIs' :: Greskell v -> Walk Filter v v+gIs' v = unsafeWalk "is" [toGremlin v]++-- | @.is@ step with predicate 'P'.+--+-- @since 1.0.1.0+gIsP :: (WalkType c) => Greskell (P v) -> Walk c v v+gIsP = liftWalk . gIsP'++-- | Monomorphic version of 'gIsP'.+--+-- @since 1.0.1.0+gIsP' :: Greskell (P v) -> Walk Filter v v+gIsP' p = unsafeWalk "is" [toGremlin p]++-- | @.has@ step with one argument.+gHas1 :: (WalkType c, Element s)+ => Key s v -- ^ property key+ -> Walk c s s+gHas1 = liftWalk . gHas1'++-- | Monomorphic version of 'gHas1'.+gHas1' :: (Element s) => Key s v -> Walk Filter s s+gHas1' key = unsafeWalk "has" [toGremlin key]++-- | @.has@ step with two arguments.+gHas2 :: (WalkType c, Element s) => Key s v -> Greskell v -> Walk c s s+gHas2 k v = liftWalk $ gHas2' k v++-- | Monomorphic verson of 'gHas2'.+gHas2' :: (Element s) => Key s v -> Greskell v -> Walk Filter s s+gHas2' k v = unsafeWalk "has" [toGremlin k, toGremlin v]++-- | @.has@ step with two arguments and 'P' type.+gHas2P :: (WalkType c, Element s)+ => Key s v -- ^ property key+ -> Greskell (P v) -- ^ predicate on the property value+ -> Walk c s s+gHas2P k p = liftWalk $ gHas2P' k p++-- | Monomorphic version of 'gHas2P'.+gHas2P' :: (Element s) => Key s v -> Greskell (P v) -> Walk Filter s s+gHas2P' key p = unsafeWalk "has" [toGremlin key, toGremlin p]++-- TODO: has(Key,Traversal), has(Label,Key,P)++-- | @.hasLabel@ step.+gHasLabel :: (Element s, WalkType c) => Greskell Text -> Walk c s s+gHasLabel = liftWalk . gHasLabel'++-- | Monomorphic version of 'gHasLabel'.+gHasLabel' :: (Element s) => Greskell Text -> Walk Filter s s+gHasLabel' l = unsafeWalk "hasLabel" [toGremlin l]++-- | @.hasLabel@ step with 'P' type. Supported since TinkerPop 3.2.7.+gHasLabelP :: (Element s, WalkType c)+ => Greskell (P Text) -- ^ predicate on Element label.+ -> Walk c s s+gHasLabelP = liftWalk . gHasLabelP'++-- | Monomorphic version of 'gHasLabelP'.+gHasLabelP' :: Element s+ => Greskell (P Text)+ -> Walk Filter s s+gHasLabelP' p = unsafeWalk "hasLabel" [toGremlin p]++-- | @.hasId@ step.+gHasId :: (Element s, WalkType c) => Greskell (ElementID s) -> Walk c s s+gHasId = liftWalk . gHasId'++-- | Monomorphic version of 'gHasId'.+gHasId' :: Element s => Greskell (ElementID s) -> Walk Filter s s+gHasId' i = unsafeWalk "hasId" [toGremlin i]++-- | @.hasId@ step with 'P' type. Supported since TinkerPop 3.2.7.+gHasIdP :: (Element s, WalkType c)+ => Greskell (P (ElementID s))+ -> Walk c s s+gHasIdP = liftWalk . gHasIdP'++-- | Monomorphic version of 'gHasIdP'.+gHasIdP' :: Element s+ => Greskell (P (ElementID s))+ -> Walk Filter s s+gHasIdP' p = unsafeWalk "hasId" [toGremlin p]++-- | @.hasKey@ step. The input type should be a VertexProperty.+gHasKey :: (Element (p v), Property p, WalkType c) => Greskell Text -> Walk c (p v) (p v)+gHasKey = liftWalk . gHasKey'++-- | Monomorphic version of 'gHasKey'.+gHasKey' :: (Element (p v), Property p) => Greskell Text -> Walk Filter (p v) (p v)+gHasKey' k = unsafeWalk "hasKey" [toGremlin k]++-- | @.hasKey@ step with 'P' type. Supported since TinkerPop 3.2.7.+gHasKeyP :: (Element (p v), Property p, WalkType c)+ => Greskell (P Text) -- ^ predicate on the VertexProperty's key.+ -> Walk c (p v) (p v)+gHasKeyP = liftWalk . gHasKeyP'++-- | Monomorphic version of 'gHasKeyP'.+gHasKeyP' :: (Element (p v), Property p) => Greskell (P Text) -> Walk Filter (p v) (p v)+gHasKeyP' p = unsafeWalk "hasKey" [toGremlin p]++-- | @.hasValue@ step. The input type should be a VertexProperty.+gHasValue :: (Element (p v), Property p, WalkType c) => Greskell v -> Walk c (p v) (p v)+gHasValue = liftWalk . gHasValue'++-- | Monomorphic version of 'gHasValue'.+gHasValue' :: (Element (p v), Property p) => Greskell v -> Walk Filter (p v) (p v)+gHasValue' v = unsafeWalk "hasValue" [toGremlin v]++-- | @.hasValue@ step with 'P' type. Supported since TinkerPop 3.2.7.+gHasValueP :: (Element (p v), Property p, WalkType c)+ => Greskell (P v) -- ^ predicate on the VertexProperty's value+ -> Walk c (p v) (p v)+gHasValueP = liftWalk . gHasValueP'++-- | Monomorphic version of 'gHasValueP'.+gHasValueP' :: (Element (p v), Property p) => Greskell (P v) -> Walk Filter (p v) (p v)+gHasValueP' p = unsafeWalk "hasValue" [toGremlin p]++multiLogic :: (ToGTraversal g, WalkType c, WalkType p, Split c p)+ => Text -- ^ method name+ -> [g c s e]+ -> Walk p s s+multiLogic method_name = unsafeWalk method_name . map travToG++-- | @.and@ step.+gAnd :: (ToGTraversal g, WalkType c, WalkType p, Split c p) => [g c s e] -> Walk p s s+gAnd = multiLogic "and"++-- | @.or@ step.+gOr :: (ToGTraversal g, WalkType c, WalkType p, Split c p) => [g c s e] -> Walk p s s+gOr = multiLogic "or"++-- | @.not@ step.+gNot :: (ToGTraversal g, WalkType c, WalkType p, Split c p) => g c s e -> Walk p s s+gNot cond = unsafeWalk "not" [travToG cond]++-- | @.range@ step. This step is not a 'Filter', because the filtering+-- decision by this step is based on position of each element, not the+-- element itself. This violates 'Filter' law.+gRange :: Greskell Int+ -- ^ min+ -> Greskell Int+ -- ^ max+ -> Walk Transform s s+gRange min_g max_g = unsafeWalk "range" $ map toGremlin [min_g, max_g]++-- | @.limit@ step.+--+-- @since 0.2.1.0+gLimit :: Greskell Int -> Walk Transform s s+gLimit num = unsafeWalk "limit" [toGremlin num]++-- | @.tail@ step.+--+-- @since 0.2.1.0+gTail :: Greskell Int -> Walk Transform s s+gTail num = unsafeWalk "tail" [toGremlin num]++-- | @.skip@ step.+--+-- @since 0.2.1.0+gSkip :: Greskell Int -> Walk Transform s s+gSkip num = unsafeWalk "skip" [toGremlin num]++-- | A label that points to a loop created by @.repeat@ step. It can+-- be used by @.loops@ step to specify the loop.+--+-- @since 1.0.1.0+newtype RepeatLabel+ = RepeatLabel { unRepeatLabel :: Text }+ deriving (Eq, IsString, Ord, Show)++-- | Return Gremlin String literal.+instance ToGreskell RepeatLabel where+ type GreskellReturn RepeatLabel = Text+ toGreskell (RepeatLabel t) = Greskell.string t++-- | Position of a step modulator relative to @.repeat@ step.+--+-- @since 1.0.1.0+data RepeatPos+ = RepeatHead -- ^ Modulator before the @.repeat@ step.+ | RepeatTail -- ^ Modulator after the @.repeat@ step.+ deriving (Bounded, Enum, Eq, Ord, Show)++-- | @.until@ or @.times@ modulator step.+--+-- Type @c@ is the 'WalkType' of the parent @.repeat@ step. Type @s@+-- is the start (and end) type of the @.repeat@ step.+--+-- @since 1.0.1.0+data RepeatUntil c s where+ -- | @.times@ modulator.+ RepeatTimes :: Greskell Int -> RepeatUntil c s+ -- | @.until@ modulator with a sub-traversal as the predicate to+ -- decide if the repetition should stop.+ RepeatUntilT :: (WalkType cc, WalkType c, Split cc c) => GTraversal cc s e -> RepeatUntil c s++deriving instance Show (RepeatUntil c s)++makeUntilWalk :: WalkType c => RepeatUntil c s -> Walk c s s+makeUntilWalk (RepeatTimes count) = unsafeWalk "times" [toGremlin count]+makeUntilWalk (RepeatUntilT trav) = unsafeWalk "until" [toGremlin trav]++-- | @.emit@ modulator step.+--+-- Type @c@ is the 'WalkType' of the parent @.repeat@ step. Type @s@+-- is the start (and end) type of the @.repeat@ step.+--+-- @since 1.0.1.0+data RepeatEmit c s where+ -- | @.emit@ modulator without argument. It always emits the input+ -- traverser of type @s@.+ RepeatEmit :: RepeatEmit c s+ -- | @.emit@ modulator with a sub-traversal as the predicate to+ -- decide if it emits the traverser.+ RepeatEmitT :: (WalkType cc, WalkType c, Split cc c) => GTraversal cc s e -> RepeatEmit c s++deriving instance Show (RepeatEmit c s)++makeEmitWalk :: WalkType c => RepeatEmit c s -> Walk c s s+makeEmitWalk (RepeatEmit) = unsafeWalk "emit" []+makeEmitWalk (RepeatEmitT trav) = unsafeWalk "emit" [toGremlin trav]++++-- | Zero or more Gremlin steps.+--+-- @since 1.0.1.0+newtype MWalk c s e+ = MWalk (Maybe (Walk c s e))+ deriving (Show)++deriving instance WalkType c => Semigroup (MWalk c s s)+deriving instance WalkType c => Monoid (MWalk c s s)++toMWalk :: Walk c s e -> MWalk c s e+toMWalk = MWalk . Just++-- | @MWalk Nothing@ is coverted to identity step.+fromMWalk :: WalkType c => MWalk c s s -> Walk c s s+fromMWalk (MWalk Nothing) = mempty+fromMWalk (MWalk (Just w)) = w++++-- | @.repeat@ step.+--+-- @since 1.0.1.0+gRepeat :: (ToGTraversal g, WalkType c)+ => Maybe RepeatLabel -- ^ Label for the loop.+ -> Maybe (RepeatPos, RepeatUntil c s)+ -- ^ @.until@ or @.times@ modulator. You can use 'gTimes',+ -- 'gUntilHead', 'gUntilTail' to make this argument.+ -> Maybe (RepeatPos, RepeatEmit c s)+ -- ^ @.emit@ modulator. You can use 'gEmitHead', 'gEmitTail',+ -- 'gEmitHeadT', 'gEmitTailT' to make this argument.+ -> g c s s -- ^ Repeated traversal+ -> 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 ++ [travToG repeated_trav])+ label_args = maybe [] (\l -> [toGremlin l]) mlabel+ head_walk = head_until <> head_emit+ tail_walk = tail_until <> tail_emit+ (head_until, tail_until) =+ case muntil of+ Nothing -> (mempty, mempty)+ Just (pos, u) ->+ case pos of+ RepeatHead -> (toMWalk $ makeUntilWalk u, mempty)+ RepeatTail -> (mempty, toMWalk $ makeUntilWalk u)+ (head_emit, tail_emit) =+ case memit of+ Nothing -> (mempty, mempty)+ Just (pos, e) ->+ case pos of+ RepeatHead -> (toMWalk $ makeEmitWalk e, mempty)+ RepeatTail -> (mempty, toMWalk $ makeEmitWalk e)++-- | @.times@ modulator before the @.repeat@ step. It always returns+-- 'Just'.+--+-- @since 1.0.1.0+gTimes :: Greskell Int+ -- ^ Repeat count. If it's less than or equal to 0, the+ -- repeated traversal is never executed.+ -> Maybe (RepeatPos, RepeatUntil c s)+gTimes c = Just (RepeatHead, RepeatTimes c)++-- | @.until@ modulator before the @.repeat@ step. It always returns+-- 'Just'.+--+-- @since 1.0.1.0+gUntilHead :: (ToGTraversal g, WalkType c, WalkType cc, Split cc c) => g cc s e -> Maybe (RepeatPos, RepeatUntil c s)+gUntilHead trav = Just (RepeatHead, RepeatUntilT $ toGTraversal trav)++-- | @.until@ modulator after the @.repeat@ step. It always returns+-- 'Just'.+--+-- @since 1.0.1.0+gUntilTail :: (ToGTraversal g, WalkType c, WalkType cc, Split cc c) => g cc s e -> Maybe (RepeatPos, RepeatUntil c s)+gUntilTail trav = Just (RepeatTail, RepeatUntilT $ toGTraversal trav)++-- | @.emit@ modulator without argument before the @.repeat@ step. It+-- always returns 'Just'.+--+-- @since 1.0.1.0+gEmitHead :: Maybe (RepeatPos, RepeatEmit c s)+gEmitHead = Just (RepeatHead, RepeatEmit)++-- | @.emit@ modulator without argument after the @.repeat@ step. It+-- always returns 'Just'.+--+-- @since 1.0.1.0+gEmitTail :: Maybe (RepeatPos, RepeatEmit c s)+gEmitTail = Just (RepeatTail, RepeatEmit)++-- | @.emit@ modulator with a sub-traversal argument before the+-- @.repeat@ step. It always returns 'Just'.+--+-- @since 1.0.1.0+gEmitHeadT :: (ToGTraversal g, WalkType c, WalkType cc, Split cc c) => g cc s e -> Maybe (RepeatPos, RepeatEmit c s)+gEmitHeadT trav = Just (RepeatHead, RepeatEmitT $ toGTraversal trav)++-- | @.emit@ modulator with a sub-traversal argument after the+-- @.repeat@ step. It always returns 'Just'.+--+-- @since 1.0.1.0+gEmitTailT :: (ToGTraversal g, WalkType c, WalkType cc, Split cc c) => g cc s e -> Maybe (RepeatPos, RepeatEmit c s)+gEmitTailT trav = Just (RepeatTail, RepeatEmitT $ toGTraversal trav)++-- | @.loops@ step.+--+-- @since 1.0.1.0+gLoops :: Maybe RepeatLabel -> Walk Transform s Int+gLoops mlabel = unsafeWalk "loops" $ maybe [] (\l -> [toGremlin l]) mlabel++-- | @.local@ step.+--+-- @since 1.0.1.0+gLocal :: (ToGTraversal g, WalkType c) => g c s e -> Walk c s e+gLocal t = unsafeWalk "local" [travToG t]++-- | @.union@ step.+--+-- @since 1.0.1.0+gUnion :: (ToGTraversal g, WalkType c) => [g c s e] -> Walk c s e+gUnion ts = unsafeWalk "union" $ map travToG ts++-- | @.coalesce@ step.+--+-- Like 'gFlatMap', 'gCoalesce' always modifies path history.+--+-- @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.+--+-- @since 1.0.1.0+gChoose3 :: (ToGTraversal g, Split cc c, WalkType cc, WalkType c)+ => g cc s ep -- ^ the predicate traversal.+ -> g c s e -- ^ The traversal executed if the predicate traversal outputs something.+ -> g c s e -- ^ The traversal executed if the predicate traversal outputs nothing.+ -> Walk c s e+gChoose3 pt tt ft = unsafeWalk "choose"+ [ travToG pt,+ travToG tt,+ travToG ft+ ]++-- | @.barrier@ step.+--+-- @since 1.0.1.0+gBarrier :: WalkType c+ => Maybe (Greskell Int)+ -- ^ Max number of traversers kept at this barrier.+ -> Walk c s s+gBarrier mmax = unsafeWalk "barrier" $ maybe [] (\m -> [toGremlin m]) mmax++-- | @.dedup@ step without argument.+--+-- @.dedup@ step is 'Transform' because the filtering decision depends+-- on the sequence (order) of input elements.+--+-- @since 1.0.1.0+gDedup :: Maybe (ByProjection s e)+ -- ^ @.by@ modulator. If specified, the result of type @e@ is+ -- used as the criterion of deduplication.+ -> Walk Transform s s+gDedup mp = gDedupGeneric [] mp++-- | @.dedup@ step with at least one argument. The tuple specified by+-- the 'AsLabel's is used as the criterion of deduplication.+--+-- @since 1.0.1.0+gDedupN :: AsLabel a -> [AsLabel a] -> Maybe (ByProjection a e) -> Walk Transform s s+gDedupN l ls mp = gDedupGeneric (map toGremlin (l : ls)) mp++gDedupGeneric :: [Text] -> Maybe (ByProjection a b) -> Walk Transform s s+gDedupGeneric args mp =+ case mp of+ Nothing -> main_walk+ Just (ByProjection g) -> modulateWith main_walk [unsafeWalk "by" [toGremlin g]]+ where+ main_walk = unsafeWalk "dedup" args+++-- | Data types that mean a projection from one type to another.+class ProjectionLike p where+ type ProjectionLikeStart p+ -- ^ The start type of the projection.+ type ProjectionLikeEnd p+ -- ^ The end type of the projection.++instance ProjectionLike (Walk Filter s e) where+ type ProjectionLikeStart (Walk Filter s e) = s+ type ProjectionLikeEnd (Walk Filter s e) = e++instance ProjectionLike (GTraversal Filter s e) where+ type ProjectionLikeStart (GTraversal Filter s e) = s+ type ProjectionLikeEnd (GTraversal Filter s e) = e++instance ProjectionLike (Greskell (GraphTraversal Filter s e)) where+ type ProjectionLikeStart (Greskell (GraphTraversal Filter s e)) = s+ type ProjectionLikeEnd (Greskell (GraphTraversal Filter s e)) = e++instance ProjectionLike (Walk Transform s e) where+ type ProjectionLikeStart (Walk Transform s e) = s+ type ProjectionLikeEnd (Walk Transform s e) = e++instance ProjectionLike (GTraversal Transform s e) where+ type ProjectionLikeStart (GTraversal Transform s e) = s+ type ProjectionLikeEnd (GTraversal Transform s e) = e++instance ProjectionLike (Greskell (GraphTraversal Transform s e)) where+ type ProjectionLikeStart (Greskell (GraphTraversal Transform s e)) = s+ type ProjectionLikeEnd (Greskell (GraphTraversal Transform s e)) = e++instance ProjectionLike (Key s e) where+ type ProjectionLikeStart (Key s e) = s+ type ProjectionLikeEnd (Key s e) = e++instance ProjectionLike (Greskell (T s e)) where+ type ProjectionLikeStart (Greskell (T s e)) = s+ type ProjectionLikeEnd (Greskell (T s e)) = e++instance ProjectionLike (Greskell (s -> e)) where+ type ProjectionLikeStart (Greskell (s -> e)) = s+ type ProjectionLikeEnd (Greskell (s -> e)) = e++instance ProjectionLike (ByProjection s e) where+ type ProjectionLikeStart (ByProjection s e) = s+ type ProjectionLikeEnd (ByProjection s e) = e+++-- | Projection from type @s@ to type @e@ used in @.by@ step. You can+-- also use 'gBy' to construct 'ByProjection'.+data ByProjection s e where+ ByProjection :: (ProjectionLike p, ToGreskell p) => p -> ByProjection (ProjectionLikeStart p) (ProjectionLikeEnd p)++-- | Projection by literal property key.+instance IsString (ByProjection s e) where+ fromString = ByProjection . toKey+ where+ toKey :: String -> Key s e+ toKey = fromString++-- | @.by@ step with 1 argument, used for projection.+gBy :: (ProjectionLike p, ToGreskell p) => p -> ByProjection (ProjectionLikeStart p) (ProjectionLikeEnd p)+gBy = ByProjection++-- | Comparison of type @s@ used in @.by@ step. You can also use+-- 'gBy1' and 'gBy2' to construct 'ByComparator'.+data ByComparator s where+ -- | Type @s@ is projected to type @e@, and compared by the natural+ -- comparator of type @e@.+ ByComparatorProj :: ByProjection s e -> ByComparator s+ -- | Type @s@ is compared by the 'Comparator' @comp@.+ ByComparatorComp :: Comparator comp => Greskell comp -> ByComparator (CompareArg comp)+ -- | Type @s@ is projected to type @CompareArg comp@, and compared+ -- by the 'Comparator' @comp@.+ ByComparatorProjComp :: Comparator comp => ByProjection s (CompareArg comp) -> Greskell comp -> ByComparator s++-- | 'ByComparatorProj' by literal property key.+instance IsString (ByComparator s) where+ fromString = ByComparatorProj . fromString++-- | @.by@ step with 1 argument, used for comparison.+gBy1 :: (ProjectionLike p, ToGreskell p) => p -> ByComparator (ProjectionLikeStart p)+gBy1 = ByComparatorProj . gBy++-- | @.by@ step with 2 arguments, used for comparison.+gBy2 :: (ProjectionLike p, ToGreskell p, Comparator comp, ProjectionLikeEnd p ~ CompareArg comp)+ => p+ -> Greskell comp+ -> ByComparator (ProjectionLikeStart p)+gBy2 p c = ByComparatorProjComp (gBy p) c++-- | @.order@ step.+--+-- 'ByComparator' is an 'IsString', meaning projection by the given+-- key.+gOrder :: [ByComparator s] -- ^ following @.by@ steps.+ -> Walk Transform s s+gOrder bys = modulateWith order_step by_steps+ where+ order_step = unsafeWalk "order" []+ by_steps = map (unsafeWalk "by" . toByArgs) bys+ toByArgs :: ByComparator s -> [Text]+ toByArgs bc = case bc of+ ByComparatorProj (ByProjection p) -> [toGremlin p]+ ByComparatorComp comp -> [toGremlin comp]+ ByComparatorProjComp (ByProjection p) comp -> [toGremlin p, toGremlin comp]++-- | A 'ByProjection' associated with an 'AsLabel'. You can construct+-- it by 'gByL'.+--+-- @since 1.0.0.0+data LabeledByProjection s where+ LabeledByProjection :: AsLabel a -> ByProjection s a -> LabeledByProjection s++-- | @.by@ step associated with an 'AsLabel'.+--+-- @since 1.0.0.0+gByL :: (ProjectionLike p, ToGreskell p) => AsLabel (ProjectionLikeEnd p) -> p -> LabeledByProjection (ProjectionLikeStart p)+gByL l p = LabeledByProjection l $ gBy p++-- | @.flatMap@ step.+--+-- @.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.+--+-- @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]++-- | 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.+--+-- 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 (ElementID AVertex)] -> Walk Transform s AVertex+gV' = gV++-- | @.constant@ step.+--+-- @since 1.0.1.0+gConstant :: Greskell a -> Walk Transform s a+gConstant v = unsafeWalk "constant" [toGremlin v]++-- | @.unfold@ step.+--+-- Note that we use 'AsIterator' here because basically the @.unfold@+-- step does the same thing as @IteratorUtils.asIterator@ function in+-- Tinkerpop. However, Tinkerpop's implementation of @.unfold@ step+-- doesn't necessarily use @asIterator@, so there may be some corner+-- cases where @asIterator@ and @.unfold@ step behave differently.+--+-- @since 1.0.1.0+gUnfold :: AsIterator a => Walk Transform a (IteratorItem a)+gUnfold = unsafeWalk "unfold" []++-- | @.as@ step.+--+-- @.as@ step is 'Transform' because it adds the label to the+-- traverser.+--+-- @since 0.2.2.0+gAs :: AsLabel a -> Walk Transform a a+gAs l = unsafeWalk "as" [toGremlin l]++-- | @.values@ step.+--+gValues :: Element s+ => [Key s e]+ -- ^ property keys+ -> Walk Transform s e+gValues = unsafeWalk "values" . map toGremlin++-- | @.properties@ step.+gProperties :: (Element s, Property p, ElementProperty s ~ p)+ => [Key s v]+ -> Walk Transform s (p v)+gProperties = unsafeWalk "properties" . map toGremlin++-- | @.id@ step.+--+-- @since 0.2.1.0+gId :: Element s => Walk Transform s (ElementID s)+gId = unsafeWalk "id" []++-- | @.label@ step.+--+-- @since 0.2.1.0+gLabel :: Element s => Walk Transform s Text+gLabel = unsafeWalk "label" []++-- | @.valueMap@ step.+--+-- @since 1.0.0.0+gValueMap :: Element s+ => Keys s+ -> Walk Transform s (PMap (ElementPropertyContainer s) GValue)+gValueMap keys = unsafeWalk "valueMap" $ toGremlinKeys keys++-- | @.elementMap@ step.+--+-- @since 2.0.1.0+gElementMap :: Element s+ => Keys s+ -> Walk Transform s (PMap Single GValue)+gElementMap keys = unsafeWalk "elementMap" $ toGremlinKeys keys++-- | @.select@ step with one argument.+--+-- @since 0.2.2.0+gSelect1 :: AsLabel a -> Walk Transform s a+gSelect1 l = unsafeWalk "select" [toGremlin l]++-- | @.select@ step with more than one arguments.+--+-- @since 0.2.2.0+gSelectN :: AsLabel a -> AsLabel b -> [AsLabel c] -> Walk Transform s (SelectedMap GValue)+gSelectN l1 l2 ls = unsafeWalk "select" ([toGremlin l1, toGremlin l2] ++ map toGremlin ls)++unsafeChangeEnd :: Walk c a b -> Walk c a b'+unsafeChangeEnd (Walk t) = Walk t++byStep :: WalkType t => ByProjection a b -> Walk t c c+byStep (ByProjection p) = unsafeWalk "by" [toGremlin p]++-- | @.select@ step with one argument followed by @.by@ step.+--+-- @since 0.2.2.0+gSelectBy1 :: AsLabel a -> ByProjection a b -> Walk Transform s b+gSelectBy1 l bp = modulateWith (unsafeChangeEnd $ gSelect1 l) [byStep bp]++-- | @.select@ step with more than one arguments followed by @.by@+-- step.+--+-- @since 0.2.2.0+gSelectByN :: AsLabel a -> AsLabel a -> [AsLabel a] -> ByProjection a b -> Walk Transform s (SelectedMap b)+gSelectByN l1 l2 ls bp = modulateWith (unsafeChangeEnd $ gSelectN l1 l2 ls) [byStep bp]++-- | @.project@ step.+--+-- @since 1.0.0.0+gProject :: LabeledByProjection s -> [LabeledByProjection s] -> Walk Transform s (PMap Single GValue)+gProject lp_head lps = foldl' f (unsafeWalk "project" labels) (lp_head : lps)+ where+ labels = map toLabelGremlin (lp_head : lps)+ toLabelGremlin (LabeledByProjection l _) = toGremlin l+ 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.+--+-- @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]+gFold = unsafeWalk "fold" []++-- | @.count@ step.+gCount :: Walk Transform a Int+gCount = unsafeWalk "count" []++genericTraversalWalk :: Vertex v => Text -> [Greskell Text] -> Walk Transform v e+genericTraversalWalk method_name = unsafeWalk method_name . map toGremlin++-- | @.out@ step+gOut :: (Vertex v1, Vertex v2)+ => [Greskell Text] -- ^ edge labels+ -> Walk Transform v1 v2+gOut = genericTraversalWalk "out"++-- | Monomorphic version of 'gOut'.+gOut' :: (Vertex v)+ => [Greskell Text] -- ^ edge labels+ -> Walk Transform v AVertex+gOut' = gOut++-- | @.outE@ step+gOutE :: (Vertex v, Edge e)+ => [Greskell Text] -- ^ edge labels+ -> Walk Transform v e+gOutE = genericTraversalWalk "outE"++-- | Monomorphic version of 'gOutE'.+gOutE' :: (Vertex v)+ => [Greskell Text]+ -> Walk Transform v AEdge+gOutE' = gOutE++-- | @.outV@ step.+--+-- @since 0.2.2.0+gOutV :: (Edge e, Vertex v) => Walk Transform e v+gOutV = unsafeWalk "outV" []++-- | Monomorphic version of 'gOutV'.+--+-- @since 0.2.2.0+gOutV' :: Edge e => Walk Transform e AVertex+gOutV' = gOutV++-- | @.in@ step+gIn :: (Vertex v1, Vertex v2)+ => [Greskell Text] -- ^ edge labels+ -> Walk Transform v1 v2+gIn = genericTraversalWalk "in"++-- | Monomorphic version of 'gIn'.+gIn' :: (Vertex v)+ => [Greskell Text]+ -> Walk Transform v AVertex+gIn' = gIn++-- | @.inE@ step.+gInE :: (Vertex v, Edge e)+ => [Greskell Text] -- ^ edge labels+ -> Walk Transform v e+gInE = genericTraversalWalk "inE"++-- | Monomorphic version of 'gInE'.+gInE' :: (Vertex v)+ => [Greskell Text] -- ^ edge labels+ -> Walk Transform v AEdge+gInE' = gInE++-- | @.inV@ step.+--+-- @since 0.2.2.0+gInV :: (Edge e, Vertex v) => Walk Transform e v+gInV = unsafeWalk "inV" []++-- | Monomorphic version of 'gInV'.+--+-- @since 0.2.2.0+gInV' :: Edge e => Walk Transform e AVertex+gInV' = gInV++-- | @.sideEffect@ step that takes a traversal.+gSideEffect :: (ToGTraversal g, WalkType c, WalkType p, Split c p) => g c s e -> Walk p s s+gSideEffect walk = unsafeWalk "sideEffect" [travToG walk]++-- | Monomorphic version of 'gSideEffect'. The result walk is always+-- 'SideEffect' type.+gSideEffect' :: (ToGTraversal g, WalkType c, Split c SideEffect) => g c s e -> Walk SideEffect s s+gSideEffect' w = gSideEffect w++-- | @.addV@ step with a label.+gAddV :: Vertex v => Greskell Text -> Walk SideEffect a v+gAddV label = unsafeWalk "addV" [toGremlin label]++-- | Monomorphic version of 'gAddV'.+gAddV' :: Greskell Text -> Walk SideEffect a AVertex+gAddV' = gAddV++-- | @.drop@ step on 'Element'.+gDrop :: Element e => Walk SideEffect e e+gDrop = unsafeWalk "drop" []++-- | @.drop@ step on 'Property'.+gDropP :: Property p => Walk SideEffect (p a) (p a)+gDropP = unsafeWalk "drop" []++-- | Simple @.property@ step. It adds a value to the property.+--+-- @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'.+--+-- @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]+ expand (KeyNoValue _) = []++-- | 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.+--+-- @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++-- | Examples of using this module. See the source. The 'fst' of the output is the testee, while the+-- 'snd' is the expectation.+examples :: [(Text, Text)]+examples =+ [ ( toGremlin $ source "g"+ , "g"+ )+ , ( toGremlin (source "g" & sV' (map (fmap ElementID . gvalueInt) ([1,2,3] :: [Int])))+ , "g.V(1,2,3)"+ )+ , ( toGremlin (source "g" & sE' (map (fmap ElementID . gvalueInt) ([1] :: [Int])))+ , "g.E(1)"+ )+ , ( toGremlin (source "g" & sAddV' "person")+ , "g.addV(\"person\")"+ )+ , ( toGremlin $ unsafeGTraversal "g.V().count()"+ , "g.V().count()"+ )+ , ( toGremlin (source "g" & sV' [] &. gValues ["age"])+ , "g.V().values(\"age\")"+ )+ , ( toGremlin (gValues ["age"] $. sV' [] $ source "g")+ , "g.V().values(\"age\")"+ )+ , ( toGremlin (source "g" & sAddV' "person" &. gProperty "name" ("marko" :: Greskell Text) & gIterate)+ , "g.addV(\"person\").property(\"name\",\"marko\").iterate()"+ )+ , ( toGremlin (source "g" & sV' [] &. unsafeWalk "valueMap" ["'foo'", "'bar'"])+ , "g.V().valueMap('foo','bar')"+ )+ , ( toGremlin (source "g" & sV' [] &. modulateWith (unsafeWalk "path" []) [unsafeWalk "by" ["'name'"], unsafeWalk "by" ["'age'"]])+ , "g.V().path().by('name').by('age')"+ )+ , ( toGremlin (source "g" & sV' [] &. gFilter (gOut' ["knows"]))+ , "g.V().filter(__.out(\"knows\"))"+ )+ , ( let la = "a" :: AsLabel AVertex+ age = "age" :: Key AVertex Int+ in toGremlin (source "g" & sV' [] &. gAs la &. gOut' [] &. gWhereP1 (pEq la) (Just $ gBy age))+ , "g.V().as(\"a\").out().where(P.eq(\"a\")).by(\"age\")"+ )+ , ( let la = "a" :: AsLabel AVertex+ lb = "b" :: AsLabel AVertex+ age = "age" :: Key AVertex Int+ in toGremlin (source "g" & sV' [] &. gAs la &. gOut' [] &. gAs lb &. gValues [age] &. gWhereP2 la (pEq lb) Nothing)+ , "g.V().as(\"a\").out().as(\"b\").values(\"age\").where(\"a\",P.eq(\"b\"))"+ )+ , ( let label_a = "a" :: AsLabel AVertex+ label_b = "b"+ key_age = "age" :: Key AVertex Int+ patterns =+ Logic.And+ ( mPattern label_a (gOut' [] >>> gAs label_b) )+ [ mPattern label_b (gHas2' key_age 25) ]+ in toGremlin (source "g" & sV' [] &. gMatch patterns &. gSelectN label_a label_b [])+ , "g.V().match(__.as(\"a\").out().as(\"b\"),__.as(\"b\").has(\"age\",25)).select(\"a\",\"b\")"+ )+ , ( toGremlin (source "g" & sV' [] &. gValues ["age" :: Key AVertex Int] &. gIs 30)+ , "g.V().values(\"age\").is(30)"+ )+ , ( toGremlin (source "g" & sV' [] &. gValues ["age" :: Key AVertex Int] &. gIsP (pLte 30))+ , "g.V().values(\"age\").is(P.lte(30))"+ )+ , ( toGremlin (source "g" & sV' [] &. gHas1 "age")+ , "g.V().has(\"age\")"+ )+ , ( toGremlin (source "g" & sV' [] &. gHas2 "age" (31 :: Greskell Int))+ , "g.V().has(\"age\",31)"+ )+ , ( toGremlin (source "g" & sV' [] &. gHas2P "age" (pBetween (30 :: Greskell Int) 40))+ , "g.V().has(\"age\",P.between(30,40))"+ )+ , ( toGremlin (source "g" & sV' [] &. gHasLabel "person")+ , "g.V().hasLabel(\"person\")"+ )+ , ( toGremlin (source "g" & sV' [] &. gHasLabelP (pEq "person"))+ , "g.V().hasLabel(P.eq(\"person\"))"+ )+ , ( toGremlin (source "g" & sV' [] &. gHasId (fmap ElementID $ gvalueInt $ (7 :: Int)))+ , "g.V().hasId(7)"+ )+ , ( toGremlin (source "g" & sV' [] &. gHasIdP (pLte $ fmap ElementID $ gvalueInt (100 :: Int)))+ , "g.V().hasId(P.lte(100))"+ )+ , ( toGremlin (source "g" & sV' [] &. gProperties [] &. gHasKey "age")+ , "g.V().properties().hasKey(\"age\")"+ )+ , ( toGremlin (source "g" & sV' [] &. gProperties ["age"] &. gHasValue (32 :: Greskell Int))+ , "g.V().properties(\"age\").hasValue(32)"+ )+ , ( toGremlin (source "g" & sV' [] &. gProperties ["age"] &. gHasValueP (pBetween (30 :: Greskell Int) 40))+ , "g.V().properties(\"age\").hasValue(P.between(30,40))"+ )+ , ( toGremlin (source "g" & sV' [] &. gAnd [gOut' ["knows"], gHas1 "age"])+ , "g.V().and(__.out(\"knows\"),__.has(\"age\"))"+ )+ , ( toGremlin (source "g" & sV' [] &. gOr [gOut' ["knows"], gHas1 "age"])+ , "g.V().or(__.out(\"knows\"),__.has(\"age\"))"+ )+ , ( toGremlin (source "g" & sV' [] &. gNot (gOut' ["knows"]))+ , "g.V().not(__.out(\"knows\"))"+ )+ , ( toGremlin (source "g" & sV' [] &. gRange 0 100)+ , "g.V().range(0,100)"+ )+ , ( toGremlin (source "g" & sV' [] &. gRepeat Nothing (gTimes 3) Nothing (gOut' []))+ , "g.V().times(3).repeat(__.out())"+ )+ , ( toGremlin (source "g" & sV' [] &. gRepeat Nothing (gUntilHead $ gHasLabel' "person") Nothing (gOut' []))+ , "g.V().until(__.hasLabel(\"person\")).repeat(__.out())"+ )+ , ( toGremlin (source "g" & sV' [] &. gRepeat Nothing (gUntilTail $ gHasLabel' "person") Nothing (gOut' []))+ , "g.V().repeat(__.out()).until(__.hasLabel(\"person\"))"+ )+ , ( toGremlin (source "g" & sV' [] &. gRepeat Nothing Nothing gEmitHead (gOut' []))+ , "g.V().emit().repeat(__.out())"+ )+ , ( toGremlin (source "g" & sV' [] &. gRepeat Nothing Nothing gEmitTail (gOut' []))+ , "g.V().repeat(__.out()).emit()"+ )+ , ( toGremlin (source "g" & sV' [] &. gRepeat Nothing Nothing (gEmitHeadT $ gHasLabel' "person") (gOut' []))+ , "g.V().emit(__.hasLabel(\"person\")).repeat(__.out())"+ )+ , ( toGremlin (source "g" & sV' [] &. gRepeat Nothing Nothing (gEmitTailT $ gHasLabel' "person") (gOut' []))+ , "g.V().repeat(__.out()).emit(__.hasLabel(\"person\"))"+ )+ , ( let loop_label = Just "the_loop"+ in toGremlin (source "g" & sV' [] &. gRepeat loop_label (gUntilTail $ gLoops loop_label >>> gIs 3) Nothing (gOut' []))+ , "g.V().repeat(\"the_loop\",__.out()).until(__.loops(\"the_loop\").is(3))"+ )+ , ( toGremlin (source "g" & sV' [] &. gLocal ( gOut' [] >>> gLimit 3 ))+ , "g.V().local(__.out().limit(3))"+ )+ , ( let key_age = "age" :: Key AVertex Int+ key_birth_year = ("birth_year" :: Key AVertex Int)+ in toGremlin (source "g" & sV' [] &. gUnion [gValues [key_age], gValues [key_birth_year]])+ , "g.V().union(__.values(\"age\"),__.values(\"birth_year\"))"+ )+ , ( toGremlin (source "g" & sV' [] &. gCoalesce [gOut' [], gIn' []])+ , "g.V().coalesce(__.out(),__.in())"+ )+ , ( let key_age = "age" :: Key AVertex Int+ in toGremlin (source "g" & sV' [] &. gChoose3 (gHas2' key_age 30) (gIn' []) (gOut' []))+ , "g.V().choose(__.has(\"age\",30),__.in(),__.out())"+ )+ , ( toGremlin (source "g" & sV' [] &. gDedup Nothing)+ , "g.V().dedup()"+ )+ , ( let key_age = "age" :: Key AVertex Int+ in toGremlin (source "g" & sV' [] &. gDedup (Just $ gBy key_age))+ , "g.V().dedup().by(\"age\")"+ )+ , ( let label_a = "a" :: AsLabel AVertex+ label_b = "b" :: AsLabel AVertex+ in toGremlin (source "g" & sV' [] &. gAs label_a &. gOut' [] &. gAs label_b &. gDedupN label_a [label_b] Nothing)+ , "g.V().as(\"a\").out().as(\"b\").dedup(\"a\",\"b\")"+ )+ , ( let key_age = "age" :: Key AVertex Int+ in toGremlin (source "g" & sV' [] &. gOrder [gBy1 key_age])+ , "g.V().order().by(\"age\")"+ )+ , ( let key_age = "age" :: Key AVertex Int+ in toGremlin (source "g" & sV' [] &. gOrder [gBy2 key_age oDecr, gBy1 tId])+ , "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)"+ )+ , ( toGremlin (source "g" & sV' [] &. gOrder ["age"])+ , "g.V().order().by(\"age\")"+ )+ , ( toGremlin (source "g" & sV' [] &. gFlatMap (gOut' ["knows"] >>> gOut' ["created"]))+ , "g.V().flatMap(__.out(\"knows\").out(\"created\"))"+ )+ , ( toGremlin (source "g" & sV' [] &. gConstant (10 :: Greskell Int))+ , "g.V().constant(10)"+ )+ , ( toGremlin (source "g" & sV' [] &. gFold &. gUnfold)+ , "g.V().fold().unfold()"+ )+ , ( toGremlin (source "g" & sV' [] &. gValues ["name", "age"])+ , "g.V().values(\"name\",\"age\")"+ )+ , ( toGremlin (source "g" & sV' [] &. gProperties ["age"])+ , "g.V().properties(\"age\")"+ )+ , ( toGremlin (source "g" & sV' [] &. gValueMap KeysNil)+ , "g.V().valueMap()"+ )+ , ( toGremlin (source "g" & sV' [] &. gValueMap ("name" -: "age" -: KeysNil))+ , "g.V().valueMap(\"name\",\"age\")"+ )+ , ( toGremlin (source "g" & sV' [] &. gElementMap KeysNil)+ , "g.V().elementMap()"+ )+ , ( toGremlin (source "g" & sV' [] &. gElementMap ("name" -: "age" -: KeysNil))+ , "g.V().elementMap(\"name\",\"age\")"+ )+ , ( let name_label = "a" :: AsLabel Text+ name_key = "name" :: Key AVertex Text+ count_label = "b" :: AsLabel Int+ in toGremlin (source "g" & sV' [] &. gProject (gByL name_label name_key) [gByL count_label (gOut' [] >>> gCount), gByL "c" tId])+ , "g.V().project(\"a\",\"b\",\"c\").by(\"name\").by(__.out().count()).by(T.id)"+ )+ , ( let inE = gInE' [] :: Walk Transform AVertex AEdge+ in toGremlin (source "g" & sV' [] &. gOut' [] &. gPathBy "name" [gBy $ inE >>> gValues ["relation"]])+ , "g.V().out().path().by(\"name\").by(__.inE().values(\"relation\"))"+ )+ , ( toGremlin (source "g" & sV' [fmap ElementID $ gvalueInt (8 :: Int)] &. gOut' ["knows"])+ , "g.V(8).out(\"knows\")"+ )+ , ( toGremlin (source "g" & sV' [] & liftWalk &. gHas2 "name" ("marko" :: Greskell Text) &. gSideEffect' (gAddV' "toshio"))+ , "g.V().has(\"name\",\"marko\").sideEffect(__.addV(\"toshio\"))"+ )+ , ( toGremlin (source "g" & sV' [] &. gHas2 "name" ("marko" :: Greskell Text) & liftWalk &. gDrop)+ , "g.V().has(\"name\",\"marko\").drop()"+ )+ , ( toGremlin (source "g" & sE' [] &. gProperties ["weight"] & liftWalk &. gDropP)+ , "g.E().properties(\"weight\").drop()"+ )+ , ( toGremlin (source "g" & sV' [] & liftWalk &. gProperty "age" (20 :: Greskell Int))+ , "g.V().property(\"age\",20)"+ )+ , ( let key_location = "location" :: Key AVertex Text+ key_since = "since" :: Key (AVertexProperty Text) Text+ key_score = "score" :: Key (AVertexProperty Text) Int+ in 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)"+ )+ , ( let key_name = "name" :: Key AVertex Text+ in toGremlin (source "g" & sV' [] & liftWalk &. gAddE' "knows" (gFrom $ gV' [] >>> gHas2 key_name "marko"))+ , "g.V().addE(\"knows\").from(__.V().has(\"name\",\"marko\"))"+ )+ , ( let key_name = "name" :: Key AVertex Text+ in toGremlin (source "g" & sV' [] &. gHas2 key_name "marko" & liftWalk &. gAddE' "knows" (gTo $ gV' []))+ , "g.V().has(\"name\",\"marko\").addE(\"knows\").to(__.V())"+ )+ ]
+ src/Data/Greskell/GTraversal/Gen.hs view
@@ -0,0 +1,364 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+-- | __This module is experimental. It may have breaking changes in future.__+--+-- This module has Gremlin traversals defined in 'Data.Greskell.GTraversal' generalized on the+-- walk type. It may save you from calling 'liftWalk' manually.+--+-- @since 2.0.3.0+module Data.Greskell.GTraversal.Gen+ ( -- * Types+ -- ** GraphTraversal and others+ GTraversal (..)+ , GraphTraversal+ , ToGTraversal (..)+ , Walk+ , GraphTraversalSource+ -- ** Walk types+ , WalkType+ , Filter+ , Transform+ , SideEffect+ , Lift+ , Split+ -- * GraphTraversalSource+ , source+ , sV+ , sV'+ , sE+ , sE'+ , sAddV+ , sAddV'+ -- * GTraversal+ , (&.)+ , ($.)+ , (<$.>)+ , (<*.>)+ , gIterate+ , unsafeGTraversal+ -- * Walk/Steps+ , unsafeWalk+ , modulateWith+ -- ** Filter steps+ , gIdentity+ , gFilter+ , gCyclicPath+ , gSimplePath+ -- ** Is step+ , gIs+ , gIsP+ -- ** Has steps+ , gHas1+ , gHas2+ , gHas2P+ , gHasLabel+ , gHasLabelP+ , gHasId+ , gHasIdP+ , gHasKey+ , gHasKeyP+ , gHasValue+ , gHasValueP+ -- ** Logic steps+ , gAnd+ , gOr+ , gNot+ -- ** Where step+ , gWhereP1+ , gWhereP2+ -- ** Sorting steps+ , gOrder+ -- ** Paging steps+ , gRange+ , gLimit+ , gTail+ , gSkip+ -- ** Repeat step+ , gRepeat+ , gTimes+ , gUntilHead+ , gUntilTail+ , gEmitHead+ , gEmitTail+ , gEmitHeadT+ , gEmitTailT+ , gLoops+ , RepeatUntil (..)+ , RepeatEmit (..)+ , RepeatPos (..)+ , RepeatLabel (..)+ -- ** Branching steps+ , gLocal+ , gUnion+ , gCoalesce+ , gChoose3+ -- ** Barrier steps+ , gBarrier+ , gDedup+ , gDedupN+ -- ** Transformation steps+ , gFlatMap+ , gV+ , gV'+ , gConstant+ , gProject+ -- ** As step+ , gAs+ -- ** Accessor steps+ , gValues+ , gProperties+ , gId+ , gLabel+ , gValueMap+ , gElementMap+ , gSelect1+ , gSelectN+ , gSelectBy1+ , gSelectByN+ , gUnfold+ , gPath+ , gPathBy+ -- ** Summarizing steps+ , gFold+ , gCount+ -- ** Graph traversal steps+ , gOut+ , gOut'+ , gOutE+ , gOutE'+ , gOutV+ , gOutV'+ , gIn+ , gIn'+ , gInE+ , gInE'+ , gInV+ , gInV'+ -- ** Match step+ , gMatch+ , MatchPattern (..)+ , mPattern+ , MatchResult+ -- ** Side-effect steps+ , gSideEffect+ -- ** Graph manipulation steps+ , gAddV+ , gAddV'+ , gAddE+ , gAddE'+ , AddAnchor+ , gFrom+ , gTo+ , gDrop+ , gDropP+ , gProperty+ , gPropertyV+ -- ** @.by@ steps+ , ByProjection (..)+ , ProjectionLike (..)+ , ByComparator (..)+ , LabeledByProjection (..)+ , gBy+ , gBy1+ , gBy2+ , gByL+ ) where++import Data.Text (Text)++import Data.Greskell.AsIterator (AsIterator (IteratorItem))+import Data.Greskell.AsLabel (AsLabel, LabeledP, SelectedMap)+import Data.Greskell.Graph (AEdge, AVertex, Cardinality, Edge, Element (..),+ ElementID, Key, KeyValue, Keys, Path, Property, Vertex)+import Data.Greskell.GraphSON (GValue)+import Data.Greskell.Greskell (Greskell)+import Data.Greskell.GTraversal (AddAnchor, ByComparator (..), ByProjection (..), Filter,+ GTraversal (..), GraphTraversal, GraphTraversalSource,+ LabeledByProjection (..), Lift, MatchPattern (..),+ MatchResult, ProjectionLike (..), RepeatEmit (..),+ RepeatLabel (..), RepeatPos (..), RepeatUntil (..),+ SideEffect, Split, ToGTraversal (..), Transform, Walk,+ WalkType, gAnd, gBarrier, gBy, gBy1, gBy2, gByL,+ gChoose3, gCoalesce, gCyclicPath, gEmitHead, gEmitHeadT,+ gEmitTail, gEmitTailT, gFilter, gFlatMap, gHas1, gHas2,+ gHas2P, gHasId, gHasIdP, gHasKey, gHasKeyP, gHasLabel,+ gHasLabelP, gHasValue, gHasValueP, gIdentity, gIs, gIsP,+ gIterate, gLocal, gNot, gOr, gRepeat, gSideEffect,+ gSimplePath, gTimes, gUnion, gUntilHead, gUntilTail,+ gWhereP1, gWhereP2, mPattern, modulateWith, source,+ unsafeGTraversal, unsafeWalk, ($.), (&.), (<$.>), (<*.>))+import qualified Data.Greskell.GTraversal as G+import Data.Greskell.Logic (Logic)+import Data.Greskell.PMap (PMap, Single)++sV :: (Vertex v, WalkType c, Lift Transform c) => [Greskell (ElementID v)] -> Greskell GraphTraversalSource -> GTraversal c () v+sV a b = liftWalk $ G.sV a b++sV' :: (WalkType c, Lift Transform c) => [Greskell (ElementID AVertex)] -> Greskell GraphTraversalSource -> GTraversal c () AVertex+sV' = sV++sE :: (Edge e, WalkType c, Lift Transform c) => [Greskell (ElementID e)] -> Greskell GraphTraversalSource -> GTraversal c () e+sE a b = liftWalk $ G.sE a b++sE' :: (WalkType c, Lift Transform c) => [Greskell (ElementID AEdge)] -> Greskell GraphTraversalSource -> GTraversal c () AEdge+sE' = sE++sAddV :: (Vertex v, WalkType c, Lift SideEffect c) => Greskell Text -> Greskell GraphTraversalSource -> GTraversal c () v+sAddV a b = liftWalk $ G.sAddV a b++sAddV' :: (WalkType c, Lift SideEffect c) => Greskell Text -> Greskell GraphTraversalSource -> GTraversal c () AVertex+sAddV' = sAddV++gOrder :: (WalkType c, Lift Transform c) => [ByComparator s] -> Walk c s s+gOrder b = liftWalk $ G.gOrder b++gRange :: (WalkType c, Lift Transform c) => Greskell Int -> Greskell Int -> Walk c s s+gRange a b = liftWalk $ G.gRange a b++gLimit :: (WalkType c, Lift Transform c) => Greskell Int -> Walk c s s+gLimit a = liftWalk $ G.gLimit a++gTail :: (WalkType c, Lift Transform c) => Greskell Int -> Walk c s s+gTail a = liftWalk $ G.gTail a++gSkip :: (WalkType c, Lift Transform c) => Greskell Int -> Walk c s s+gSkip a = liftWalk $ G.gSkip a++gLoops :: (WalkType c, Lift Transform c) => Maybe RepeatLabel -> Walk c s Int+gLoops a = liftWalk $ G.gLoops a++gDedup :: (WalkType c, Lift Transform c) => Maybe (ByProjection s e) -> Walk c s s+gDedup a = liftWalk $ G.gDedup a++gDedupN :: (WalkType c, Lift Transform c) => AsLabel a -> [AsLabel a] -> Maybe (ByProjection a e) -> Walk c s s+gDedupN a b c = liftWalk $ G.gDedupN a b c++gV :: (Vertex v, WalkType c, Lift Transform c) => [Greskell (ElementID v)] -> Walk c s v+gV a = liftWalk $ G.gV a++gV' :: (WalkType c, Lift Transform c) => [Greskell (ElementID AVertex)] -> Walk c s AVertex+gV' = gV++gConstant :: (WalkType c, Lift Transform c) => Greskell a -> Walk c s a+gConstant a = liftWalk $ G.gConstant a++gProject :: (WalkType c, Lift Transform c) => LabeledByProjection s -> [LabeledByProjection s] -> Walk c s (PMap Single GValue)+gProject a b = liftWalk $ G.gProject a b++gAs :: (WalkType c, Lift Transform c) => AsLabel a -> Walk c a a+gAs a = liftWalk $ G.gAs a++gValues :: (Element s, WalkType c, Lift Transform c) => [Key s e] -> Walk c s e+gValues a = liftWalk $ G.gValues a++gProperties :: (Element s, Property p, ElementProperty s ~ p, WalkType c, Lift Transform c) => [Key s v] -> Walk c s (p v)+gProperties a = liftWalk $ G.gProperties a++gId :: (Element s, WalkType c, Lift Transform c) => Walk c s (ElementID s)+gId = liftWalk G.gId++gLabel :: (Element s, WalkType c, Lift Transform c) => Walk c s Text+gLabel = liftWalk G.gLabel++gValueMap :: (Element s, WalkType c, Lift Transform c) => Keys s -> Walk c s (PMap (ElementPropertyContainer s) GValue)+gValueMap a = liftWalk $ G.gValueMap a++gElementMap :: (Element s, WalkType c, Lift Transform c) => Keys s -> Walk c s (PMap Single GValue)+gElementMap a = liftWalk $ G.gElementMap a++gSelect1 :: (WalkType c, Lift Transform c) => AsLabel a -> Walk c s a+gSelect1 a = liftWalk $ G.gSelect1 a++gSelectN :: (WalkType c, Lift Transform c) => AsLabel a -> AsLabel b -> [AsLabel c] -> Walk c s (SelectedMap GValue)+gSelectN a b c = liftWalk $ G.gSelectN a b c++gSelectBy1 :: (WalkType c, Lift Transform c) => AsLabel a -> ByProjection a b -> Walk c s b+gSelectBy1 a b = liftWalk $ G.gSelectBy1 a b++gSelectByN :: (WalkType c, Lift Transform c) => AsLabel a -> AsLabel a -> [AsLabel a] -> ByProjection a b -> Walk c s (SelectedMap b)+gSelectByN a b c d = liftWalk $ G.gSelectByN a b c d++gUnfold :: (AsIterator a, WalkType c, Lift Transform c) => Walk c a (IteratorItem a)+gUnfold = liftWalk $ G.gUnfold++gPath :: (WalkType c, Lift Transform c) => Walk c s (Path GValue)+gPath = liftWalk $ G.gPath++gPathBy :: (WalkType c, Lift Transform c) => ByProjection a b -> [ByProjection a b] -> Walk c s (Path b)+gPathBy a b = liftWalk $ G.gPathBy a b++gFold :: (WalkType c, Lift Transform c) => Walk c a [a]+gFold = liftWalk $ G.gFold++gCount :: (WalkType c, Lift Transform c) => Walk c a Int+gCount = liftWalk $ G.gCount++gOut :: (Vertex v1, Vertex v2, WalkType c, Lift Transform c) => [Greskell Text] -> Walk c v1 v2+gOut a = liftWalk $ G.gOut a++gOut' :: (Vertex v, WalkType c, Lift Transform c) => [Greskell Text] -> Walk c v AVertex+gOut' = gOut++gOutE :: (Vertex v, Edge e, WalkType c, Lift Transform c) => [Greskell Text] -> Walk c v e+gOutE a = liftWalk $ G.gOutE a++gOutE' :: (Vertex v, WalkType c, Lift Transform c) => [Greskell Text] -> Walk c v AEdge+gOutE' = gOutE++gOutV :: (Edge e, Vertex v, WalkType c, Lift Transform c) => Walk c e v+gOutV = liftWalk $ G.gOutV++gOutV' :: (Edge e, WalkType c, Lift Transform c) => Walk c e AVertex+gOutV' = gOutV++gIn :: (Vertex v1, Vertex v2, WalkType c, Lift Transform c) => [Greskell Text] -> Walk c v1 v2+gIn a = liftWalk $ G.gIn a++gIn' :: (Vertex v, WalkType c, Lift Transform c) => [Greskell Text] -> Walk c v AVertex+gIn' = gIn++gInE :: (Vertex v, Edge e, WalkType c, Lift Transform c) => [Greskell Text] -> Walk c v e+gInE a = liftWalk $ G.gInE a++gInE' :: (Vertex v, WalkType c, Lift Transform c) => [Greskell Text] -> Walk c v AEdge+gInE' = gInE++gInV :: (Edge e, Vertex v, WalkType c, Lift Transform c) => Walk c e v+gInV = liftWalk $ G.gInV++gInV' :: (Edge e, WalkType c, Lift Transform c) => Walk c e AVertex+gInV' = gInV++gMatch :: (WalkType c, Lift Transform c) => Logic MatchPattern -> Walk c a MatchResult+gMatch a = liftWalk $ G.gMatch a++gAddV :: (Vertex v, WalkType c, Lift SideEffect c) => Greskell Text -> Walk c a v+gAddV a = liftWalk $ G.gAddV a++gAddV' :: (WalkType c, Lift SideEffect c) => Greskell Text -> Walk c a AVertex+gAddV' = gAddV++gAddE :: (Vertex vs, Vertex ve, Edge e, WalkType c, Lift SideEffect c) => Greskell Text -> AddAnchor vs ve -> Walk c vs e+gAddE a b = liftWalk $ G.gAddE a b++gAddE' :: (WalkType c, Lift SideEffect c) => Greskell Text -> AddAnchor AVertex AVertex -> Walk c AVertex AEdge+gAddE' = gAddE++gFrom :: (ToGTraversal g, WalkType c, Lift c Transform) => g c s e -> AddAnchor s e+gFrom a = G.gFrom $ liftWalk a++gTo :: (ToGTraversal g, WalkType c, Lift c Transform) => g c s e -> AddAnchor s e+gTo a = G.gTo $ liftWalk a++gDrop :: (Element e, WalkType c, Lift SideEffect c) => Walk c e e+gDrop = liftWalk G.gDrop++gDropP :: (Property p, WalkType c, Lift SideEffect c) => Walk c (p a) (p a)+gDropP = liftWalk G.gDropP++gProperty :: (Element e, WalkType c, Lift SideEffect c) => Key e v -> Greskell v -> Walk c e e+gProperty a b = liftWalk $ G.gProperty a b++gPropertyV :: (Vertex e, vp ~ ElementProperty e, Property vp, Element (vp v), WalkType c, Lift SideEffect c)+ => Maybe (Greskell Cardinality) -> Key e v -> Greskell v -> [KeyValue (vp v)] -> Walk c e e+gPropertyV a b c d = liftWalk $ G.gPropertyV a b c d
src/Data/Greskell/Graph.hs view
@@ -1,4 +1,10 @@-{-# LANGUAGE TypeFamilies, OverloadedStrings, FlexibleInstances, GeneralizedNewtypeDeriving, DeriveTraversable, GADTs, DeriveGeneric #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} -- | -- Module: Data.Greskell.Graph@@ -8,109 +14,99 @@ -- This module defines types and functions about TinkerPop graph -- structure API. module Data.Greskell.Graph- ( -- * Element- Element(..),- ElementData(..),- ElementID(..),- unsafeCastElementID,- Vertex,- Edge,- -- * Property- Property(..),- -- * T Enum- T,- tId,- tKey,- tLabel,- tValue,- -- * Cardinality Enum- Cardinality,- cList,- cSet,- cSingle,-- -- * Typed Key (accessor of a Property)- Key(..),- key,- unsafeCastKey,- -- ** Key-value pair- KeyValue(..),- (=:),- -- ** Heterogeneous list of keys- Keys(..),- singletonKeys,- (-:),-- -- * Path- Path(..),- PathEntry(..),- pathToPMap,- makePathEntry,-- -- * Concrete data types- -- $concrete_types- - -- ** Vertex- AVertex(..),- -- ** Edge- AEdge(..),- -- ** VertexProperty- AVertexProperty(..),- -- ** Property- AProperty(..)- ) 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-import Data.Maybe (listToMaybe)-import Data.Monoid (Monoid(..))-import Data.Semigroup ((<>), Semigroup)-import qualified Data.Semigroup as Semigroup-import Data.String (IsString(..))-import Data.Text (Text, unpack)-import Data.Traversable (Traversable(traverse))-import Data.Vector (Vector)-import GHC.Generics (Generic)+ ( -- * Element+ Element (..)+ , ElementData (..)+ , ElementID (..)+ , unsafeCastElementID+ , Vertex+ , Edge+ -- * Property+ , Property (..)+ -- * T Enum+ , T+ , tId+ , tKey+ , tLabel+ , tValue+ -- * Cardinality Enum+ , Cardinality+ , cList+ , cSet+ , cSingle+ -- * Typed Key (accessor of a Property)+ , Key (..)+ , key+ , unsafeCastKey+ -- ** Key-value pair+ , KeyValue (..)+ , (=:)+ -- ** Heterogeneous list of keys+ , Keys (..)+ , singletonKeys+ , toGremlinKeys+ , (-:)+ -- * Path+ , Path (..)+ , PathEntry (..)+ , pathToPMap+ , makePathEntry+ -- * Concrete data types+ -- $concrete_types+ -- ** Vertex+ , AVertex (..)+ -- ** Edge+ , AEdge (..)+ -- ** VertexProperty+ , AVertexProperty (..)+ -- ** Property+ , AProperty (..)+ -- * Examples+ , examples+ ) where -import Data.Greskell.AsIterator (AsIterator(..))-import Data.Greskell.AsLabel (AsLabel(..), unsafeCastAsLabel)-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(..)- )-import Data.Greskell.NonEmptyLike (NonEmptyLike)-import Data.Greskell.PMap (PMapKey(..), Single, Multi, PMap, pMapInsert)+import Control.Applicative (empty, (<$>), (<*>), (<|>))+import Control.Monad (when)+import Data.Aeson (FromJSON (..), ToJSON (..), Value (..))+import Data.Aeson.Types (Parser)+import Data.Foldable (Foldable (foldr), foldlM, toList)+import Data.Hashable (Hashable)+import qualified Data.HashMap.Strict as HM+import Data.HashSet (HashSet)+import qualified Data.HashSet as HS+import Data.Kind (Type)+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NL+import Data.Maybe (listToMaybe)+import Data.Monoid (Monoid (..))+import Data.Semigroup (Semigroup, (<>))+import qualified Data.Semigroup as Semigroup+import Data.String (IsString (..))+import Data.Text (Text)+import Data.Traversable (Traversable (traverse))+import Data.Vector (Vector)+import GHC.Generics (Generic) --- $setup------ >>> import Data.Greskell.Greskell (toGremlin)+import Data.Greskell.AsIterator (AsIterator (..))+import Data.Greskell.AsLabel (AsLabel (..), unsafeCastAsLabel)+import Data.Greskell.GraphSON (FromGraphSON (..), GValue, GValueBody (..),+ GraphSON (..), GraphSONTyped (..),+ parseJSONViaGValue, (.:))+import Data.Greskell.GraphSON.GValue (gValueBody, gValueType)+import Data.Greskell.Greskell (Greskell, ToGreskell (..), string, toGremlin,+ unsafeGreskellLazy)+import Data.Greskell.NonEmptyLike (NonEmptyLike)+import Data.Greskell.PMap (Multi, PMap, PMapKey (..), Single, pMapInsert) -- | ID of a graph element @e@ (vertex, edge and vertex property). --+-- Although the internal of 'ElementID' is exposed, you should treat it as an opaque value. That's+-- because it depends on graph implementation.+-- -- @since 1.0.0.0-newtype ElementID e =- ElementID- { unElementID :: GValue- -- ^ Although it's exposed, it is recommended NOT to rely on the- -- internal of 'ElementID'. That's because it depends on graph- -- implementation.- }- deriving (Show,Eq,Generic, ToJSON, FromJSON, FromGraphSON, Hashable)+newtype ElementID e+ = ElementID { unElementID :: GValue }+ deriving (Eq, FromGraphSON, FromJSON, Generic, Hashable, Show, ToJSON) -- | Unsafely convert the element type. instance Functor ElementID where@@ -139,13 +135,13 @@ class ElementData e => Element e where -- | Property type of the 'Element'. It should be of 'Property' -- class.- type ElementProperty e :: * -> *+ type ElementProperty e :: Type -> Type -- | Container type of the properties of the 'Element'. It should be -- of 'NonEmptyLike' class. -- -- @since 1.0.0.0- type ElementPropertyContainer e :: * -> *+ type ElementPropertyContainer e :: Type -> Type -- | @org.apache.tinkerpop.gremlin.structure.Vertex@ interface in a -- TinkerPop graph.@@ -206,9 +202,6 @@ -- | @list@ Cardinality. ----- >>> toGremlin cList--- "list"--- -- @since 0.2.0.0 cList :: Greskell Cardinality cList = unsafeGreskellLazy "list"@@ -228,17 +221,11 @@ -- | A property key accessing value @b@ in an Element @a@. In Gremlin, -- it's just a String type. ----- >>> toGremlin ("age" :: Key AVertex Int)--- "\"age\""--- >>> toGremlin (key "created_at" :: Key AEdge Text)--- "\"created_at\""--- >>> keyText ("name" :: Key AVertex Text)--- "name"--- -- Since greskell-1.0.0.0, 'Key' is newtype of 'Text'. Before that, it -- was newtype of 'Greskell' 'Text'.-newtype Key a b = Key { unKey :: Text }- deriving (Show,Eq)+newtype Key a b+ = Key { unKey :: Text }+ deriving (Eq, Show) -- | Unsafely convert the value type @b@. instance Functor (Key a) where@@ -302,7 +289,7 @@ instance Semigroup (Keys a) where a <> b = case a of- KeysNil -> b+ KeysNil -> b KeysCons x rest -> KeysCons x (rest <> b) instance Monoid (Keys a) where@@ -315,6 +302,13 @@ singletonKeys :: Key a b -> Keys a singletonKeys k = KeysCons k KeysNil +-- | Convert 'Keys' to a list of Gremlin scripts.+--+-- @since 2.0.1.0+toGremlinKeys :: Keys a -> [Text]+toGremlinKeys KeysNil = []+toGremlinKeys (KeysCons k rest) = toGremlin k : toGremlinKeys rest+ -- | Prepend a 'Key' to 'Keys'. -- -- @since 1.0.0.0@@ -341,14 +335,14 @@ -- GraphSON. -- | General vertex type you can use for 'Vertex' class.-data AVertex =- AVertex- { avId :: ElementID AVertex,- -- ^ ID of this vertex- avLabel :: Text- -- ^ Label of this vertex- }- deriving (Show,Eq)+data AVertex+ = AVertex+ { avId :: ElementID AVertex+ -- ^ ID of this vertex+ , avLabel :: Text+ -- ^ Label of this vertex+ }+ deriving (Eq, Show) -- | @since 1.0.0.0 instance ElementData AVertex where@@ -375,14 +369,14 @@ _ -> empty -- | General edge type you can use for 'Edge' class.-data AEdge =- AEdge- { aeId :: ElementID AEdge,- -- ^ ID of this edge.- aeLabel :: Text- -- ^ Label of this edge.- }- deriving (Show,Eq)+data AEdge+ = AEdge+ { aeId :: ElementID AEdge+ -- ^ ID of this edge.+ , aeLabel :: Text+ -- ^ Label of this edge.+ }+ deriving (Eq, Show) -- | @since 1.0.0.0 instance ElementData AEdge where@@ -411,12 +405,12 @@ -- | 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,- apValue :: v- }- deriving (Show,Eq,Ord)+data AProperty v+ = AProperty+ { apKey :: Text+ , apValue :: v+ }+ deriving (Eq, Ord, Show) -- | Parse Property of GraphSON 1.0. --@@ -429,7 +423,7 @@ instance FromGraphSON v => FromGraphSON (AProperty v) where parseGraphSON gv = case gValueBody gv of GObject o -> AProperty <$> (o .: "key") <*> (o .: "value")- _ -> empty+ _ -> empty instance Property AProperty where propertyKey = apKey@@ -450,16 +444,16 @@ -- | General vertex property type you can use for VertexProperty. -- -- If you are not sure about the type @v@, just use 'GValue'.-data AVertexProperty v =- AVertexProperty- { avpId :: ElementID (AVertexProperty v),- -- ^ ID of this vertex property.- avpLabel :: Text,- -- ^ Label and key of this vertex property.- avpValue :: v- -- ^ Value of this vertex property.- }- deriving (Show,Eq)+data AVertexProperty v+ = AVertexProperty+ { avpId :: ElementID (AVertexProperty v)+ -- ^ ID of this vertex property.+ , avpLabel :: Text+ -- ^ Label and key of this vertex property.+ , avpValue :: v+ -- ^ Value of this vertex property.+ }+ deriving (Eq, Show) -- | In version 0.1.1.0 and before, the constraint was @FromJSON v@. -- This has changed.@@ -509,8 +503,9 @@ -- | @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)+newtype Path a+ = Path { unPath :: [PathEntry a] }+ deriving (Eq, Foldable, Functor, Monoid, Ord, Semigroup, Show, Traversable) instance GraphSONTyped (Path a) where gsonTypeFor _ = "g:Path"@@ -526,7 +521,7 @@ parseGraphSON gv = case gValueBody gv of GObject o -> parseObj o- _ -> empty+ _ -> empty where parseObj o = do labels <- o .: "labels"@@ -543,12 +538,12 @@ -- | An entry in a 'Path'. -- -- @since 1.1.0.0-data PathEntry a =- PathEntry- { peLabels :: HashSet (AsLabel a),- peObject :: a- }- deriving (Show,Eq,Ord)+data PathEntry a+ = PathEntry+ { peLabels :: HashSet (AsLabel a)+ , peObject :: a+ }+ deriving (Eq, Ord, Show) instance Functor PathEntry where fmap f pe = PathEntry { peLabels = HS.map (fmap f) $ peLabels pe,@@ -587,3 +582,13 @@ -> a -- ^ object -> PathEntry a makePathEntry ls obj = PathEntry (HS.fromList ls) obj++-- | Examples of using this module. See the source. The 'fst' of the output is the testee, while the+-- 'snd' is the expectation.+examples :: [(Text, Text)]+examples =+ [ (toGremlin cList, "list")+ , (toGremlin ("age" :: Key AVertex Int), "\"age\"")+ , (toGremlin (key "created_at" :: Key AEdge Text), "\"created_at\"")+ , (keyText ("name" :: Key AVertex Text), "name")+ ]
src/Data/Greskell/Graph/PropertyMap.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveTraversable, OverloadedStrings #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-} -- | -- Module: Data.Greskell.Graph.PropertyMap -- Description: [Deprecated] PropertyMap class and types@@ -6,46 +8,49 @@ -- -- 'PropertyMap' was used in greskell prior than 1.0.0.0, but is now -- deprecated. Use "Data.Greskell.PMap" instead.-module Data.Greskell.Graph.PropertyMap {-# DEPRECATED "Use PMap instead" #-}- ( -- ** PropertyMap- PropertyMap(..),- PropertyMapSingle,- PropertyMapList,- lookupOneValue,- lookupListValues,- parseOneValue,- parseListValues,- parseNonEmptyValues,- fromProperties,- -- * Internal use- FromGraphSONWithKey,- -- * Re-exports- AProperty(..),- AVertexProperty(..)- ) where+module Data.Greskell.Graph.PropertyMap+ ( -- ** PropertyMap+ PropertyMap (..)+ , PropertyMapSingle+ , PropertyMapList+ , lookupOneValue+ , lookupListValues+ , parseOneValue+ , parseListValues+ , parseNonEmptyValues+ , fromProperties+ -- * Internal use+ , FromGraphSONWithKey+ -- * Re-exports+ , AProperty (..)+ , AVertexProperty (..)+ ) where -import Control.Applicative (empty, (<|>))-import Data.Aeson (FromJSON(..))-import Data.Aeson.Types (Parser)-import Data.Foldable (Foldable(..), foldlM)-import Data.Greskell.GraphSON- ( FromGraphSON(..), GValue, GraphSONTyped(..), (.:),- parseJSONViaGValue- )-import Data.Greskell.GraphSON.GValue (gValueBody, gValueType, GValueBody(..))-import qualified Data.HashMap.Strict as HM-import Data.List.NonEmpty (NonEmpty(..))-import qualified Data.List.NonEmpty as NL-import Data.Maybe (listToMaybe)-import Data.Monoid (Monoid(..))-import Data.Semigroup (Semigroup((<>)))-import qualified Data.Semigroup as Semigroup-import Data.Text (Text, unpack)-import Data.Traversable (Traversable(..))-import Data.Vector (Vector)+import Control.Applicative (empty, (<|>))+import Data.Aeson (FromJSON (..))+import qualified Data.Aeson.Key as Key+import qualified Data.Aeson.KeyMap as KM+import Data.Aeson.Types (Parser)+import Data.Foldable (Foldable (..), foldlM)+import Data.Greskell.GraphSON (FromGraphSON (..), GValue, GraphSONTyped (..),+ parseJSONViaGValue, (.:))+import Data.Greskell.GraphSON.GValue (GValueBody (..), gValueBody, gValueType)+import qualified Data.HashMap.Strict as HM+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NL+import Data.Maybe (listToMaybe)+import Data.Monoid (Monoid (..))+import Data.Semigroup (Semigroup ((<>)))+import qualified Data.Semigroup as Semigroup+import Data.Text (Text, unpack)+import Data.Traversable (Traversable (..))+import Data.Vector (Vector) -import Data.Greskell.Graph (Property(..), AProperty(..), AVertexProperty(..))+import Data.Greskell.Graph (AProperty (..), AVertexProperty (..), Property (..)) ++{-# DEPRECATED PropertyMap "PropertyMap and its instances are deprecated. Use PMap instead." #-}+ -- | Common basic operations supported by maps of properties. class PropertyMap m where lookupOne :: Text -> m p v -> Maybe (p v)@@ -72,7 +77,7 @@ notExistErrorMsg k = "Property '" ++ unpack k ++ "' does not exist." -- | 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@@ -82,7 +87,7 @@ -- | Lookup a list of property values from a 'PropertyMap' by the -- given key, and parse them.--- +-- -- 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]@@ -96,7 +101,7 @@ 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+ toNonEmpty [] = fail $ notExistErrorMsg k toNonEmpty (x : rest) = return (x :| rest) -- | Create a 'PropertyMap' from list of 'Property's.@@ -108,8 +113,9 @@ -- | Generic implementation of 'PropertyMap'. @t@ is the type of -- cardinality, @p@ is the type of 'Property' class and @v@ is the -- type of the property value.-newtype PropertyMapGeneric t p v = PropertyMapGeneric (HM.HashMap Text (t (p v)))- deriving (Show,Eq)+newtype PropertyMapGeneric t p v+ = PropertyMapGeneric (HM.HashMap Text (t (p v)))+ deriving (Eq, Show) instance Semigroup (t (p v)) => Semigroup (PropertyMapGeneric t p v) where (PropertyMapGeneric a) <> (PropertyMapGeneric b) = PropertyMapGeneric $ HM.unionWith (<>) a b@@ -145,11 +151,11 @@ -> GValue -> Parser (m p v) parsePropertiesGeneric normalizeCardinality gv = case gValueBody gv of- GObject obj -> foldlM folder mempty $ HM.toList obj- _ -> empty+ GObject obj -> foldlM folder mempty $ KM.toList obj+ _ -> empty where folder pm (k, value) = fmap (foldr putProperty pm) $ traverse (parseProperty k) =<< normalizeCardinality value- parseProperty k value = parseTypedGValue value <|> parseGraphSONWithKey k value+ parseProperty k value = parseTypedGValue value <|> parseGraphSONWithKey (Key.toText k) value -- parhaps we might as well place it in GraphSON module and let it export. parseTypedGValue :: (GraphSONTyped v, FromGraphSON v) => GValue -> Parser v@@ -164,7 +170,7 @@ expectAesonArray :: GValue -> Parser (Vector GValue) expectAesonArray gv = case gValueBody gv of GArray a -> return a- _ -> empty+ _ -> empty -- | A 'PropertyMap' that has a single value per key. --@@ -173,8 +179,9 @@ -- '<>' returns the union of the two given property maps. If the two -- property maps share some same keys, the value from the left map -- wins.-newtype PropertyMapSingle p v = PropertyMapSingle (PropertyMapGeneric Semigroup.First p v)- deriving (Show,Eq,Semigroup,Monoid,Functor,Foldable,Traversable)+newtype PropertyMapSingle p v+ = PropertyMapSingle (PropertyMapGeneric Semigroup.First p v)+ deriving (Eq, Foldable, Functor, Monoid, Semigroup, Show, Traversable) instance PropertyMap PropertyMapSingle where lookupOne k (PropertyMapSingle (PropertyMapGeneric hm)) = fmap Semigroup.getFirst $ HM.lookup k hm@@ -203,8 +210,9 @@ -- '<>' returns the union of the two given property maps. If the two -- property maps share some same keys, those property lists are -- concatenated.-newtype PropertyMapList p v = PropertyMapList (PropertyMapGeneric NonEmpty p v)- deriving (Show,Eq,Semigroup,Monoid,Functor,Foldable,Traversable)+newtype PropertyMapList p v+ = PropertyMapList (PropertyMapGeneric NonEmpty p v)+ deriving (Eq, Foldable, Functor, Monoid, Semigroup, Show, Traversable) instance PropertyMap PropertyMapList where lookupList k (PropertyMapList (PropertyMapGeneric hm)) = maybe [] NL.toList $ HM.lookup k hm
src/Data/Greskell/Gremlin.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE OverloadedStrings, TypeFamilies, FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-} -- | -- Module: Data.Greskell.Gremlin -- Description: Gremlin (Groovy/Java) utility classes@@ -7,48 +9,44 @@ -- This modules defines types and functions for utility classes in -- Gremlin. module Data.Greskell.Gremlin- ( -- * Predicate- Predicate(..),- PredicateA(..),- -- ** P class- P,- PLike(..),- pNot,- pEq,- pNeq,- pLt,- pLte,- pGt,- pGte,- pInside,- pOutside,- pBetween,- pWithin,- pWithout,- -- * Comparator- Comparator(..),- ComparatorA(..),- -- ** Order enum- Order,- oDecr,- oIncr,- oShuffle,- ) where--import Data.Aeson (Value)-import Data.Monoid ((<>))-import Data.Greskell.GraphSON (GraphSONTyped(..))-import Data.Greskell.Greskell- ( Greskell, unsafeGreskellLazy,- toGremlin, toGremlinLazy, unsafeMethodCall, unsafeFunCall,- ToGreskell- )+ ( -- * Predicate+ Predicate (..)+ , PredicateA (..)+ -- ** P class+ , P+ , PLike (..)+ , pNot+ , pEq+ , pNeq+ , pLt+ , pLte+ , pGt+ , pGte+ , pInside+ , pOutside+ , pBetween+ , pWithin+ , pWithout+ -- * Comparator+ , Comparator (..)+ , ComparatorA (..)+ -- ** Order enum+ , Order+ , oDesc+ , oAsc+ , oDecr+ , oIncr+ , oShuffle+ -- * Examples+ , examples+ ) where --- $setup------ >>> :set -XOverloadedStrings--- >>> import Data.Text (Text)--- >>> import Data.Greskell.Greskell (number, string)+import Data.Aeson (Value)+import Data.Greskell.GraphSON (GraphSONTyped (..))+import Data.Greskell.Greskell (Greskell, ToGreskell, string, toGremlin, toGremlinLazy,+ unsafeFunCall, unsafeGreskellLazy, unsafeMethodCall)+import Data.Monoid ((<>))+import Data.Text (Text) -- | @java.util.function.Predicate@ interface. --@@ -70,7 +68,8 @@ pNegate p = unsafeMethodCall p "negate" [] -- | Type for anonymous class of @Predicate@ interface.-newtype PredicateA a = PredicateA { unPredicateA :: a -> Bool }+newtype PredicateA a+ = PredicateA { unPredicateA :: a -> Bool } instance Predicate (PredicateA a) where type PredicateArg (PredicateA a) = a@@ -103,16 +102,10 @@ type PParameter (P a) = Greskell a -- | @P.not@ static method.------ >>> toGremlin (pNot $ pEq $ 10 :: Greskell (P Int))--- "P.not(P.eq(10))" pNot :: PLike p => Greskell p -> Greskell p pNot a = unsafeFunCall "P.not" [toGremlin a] -- | @P.eq@ static method.------ >>> toGremlin (pEq $ string "hoge" :: Greskell (P Text))--- "P.eq(\"hoge\")" pEq :: PLike p => PParameter p -> Greskell p pEq arg = unsafeFunCall "P.eq" [toGremlin arg] @@ -137,9 +130,6 @@ pGte arg = unsafeFunCall "P.gte" [toGremlin arg] -- | @P.inside@ static method.------ >>> toGremlin (pInside 10 20 :: Greskell (P Int))--- "P.inside(10,20)" pInside :: PLike p => PParameter p -> PParameter p -> Greskell p pInside a b = unsafeFunCall "P.inside" $ map toGremlin [a, b] @@ -152,9 +142,6 @@ pBetween a b = unsafeFunCall "P.between" $ map toGremlin [a, b] -- | @P.within@ static method.------ >>> toGremlin (pWithin ["foo", "bar", "hoge"] :: Greskell (P Text))--- "P.within(\"foo\",\"bar\",\"hoge\")" pWithin :: PLike p => [PParameter p] -> Greskell p pWithin = unsafeFunCall "P.within" . map toGremlin @@ -178,7 +165,8 @@ cThenComparing cmp1 cmp2 = unsafeMethodCall cmp1 "thenComparing" [toGremlin cmp2] -- | Type for anonymous class of @Comparator@ interface.-newtype ComparatorA a = ComparatorA { unComparatorA :: a -> a -> Int }+newtype ComparatorA a+ = ComparatorA { unComparatorA :: a -> a -> Int } instance Comparator (ComparatorA a) where type CompareArg (ComparatorA a) = a@@ -193,17 +181,44 @@ instance GraphSONTyped (Order a) where gsonTypeFor _ = "g:Order" +-- | @desc@ order.+--+-- @since 2.0.2.0+oDesc :: Greskell (Order a)+oDesc = unsafeGreskellLazy "Order.desc"++-- | @asc@ order.+--+-- @since 2.0.2.0+oAsc :: Greskell (Order a)+oAsc = unsafeGreskellLazy "Order.asc"+ -- | @decr@ order. ----- >>> toGremlin oDecr--- "Order.decr"+-- Note that @decr@ was removed in TinkerPop 3.5.0. Use 'oDesc' instead. oDecr :: Greskell (Order a) oDecr = unsafeGreskellLazy "Order.decr" -- | @incr@ order.+--+-- Note that @incr@ was removed in TinkerPop 3.5.0. Use 'oAsc' instead. oIncr :: Greskell (Order a) oIncr = unsafeGreskellLazy "Order.incr" -- | @shuffle@ order. oShuffle :: Greskell (Order a) oShuffle = unsafeGreskellLazy "Order.shuffle"++-- | Examples of using this module. See the source. The 'fst' of the output is the testee, while the+-- 'snd' is the expectation.+examples :: [(Text, Text)]+examples =+ [ (toGremlin (pNot $ pEq $ 10 :: Greskell (P Int)), "P.not(P.eq(10))")+ , (toGremlin (pEq $ string "hoge" :: Greskell (P Text)), "P.eq(\"hoge\")")+ , (toGremlin (pInside 10 20 :: Greskell (P Int)), "P.inside(10,20)")+ , (toGremlin (pWithin ["foo", "bar", "hoge"] :: Greskell (P Text)), "P.within(\"foo\",\"bar\",\"hoge\")")+ , (toGremlin oDesc, "Order.desc")+ , (toGremlin oAsc, "Order.asc")+ , (toGremlin oDecr, "Order.decr")+ , (toGremlin oIncr, "Order.incr")+ ]
src/Data/Greskell/Logic.hs view
@@ -26,35 +26,35 @@ -- - http://hackage.haskell.org/package/dual-tree -- - http://hackage.haskell.org/package/fingertree ----- @since 1.2.0.0 +-- @since 1.2.0.0 module Data.Greskell.Logic- ( Logic(..),- runBool- ) where+ ( Logic (..)+ , runBool+ ) where -import Control.Applicative (Applicative(pure, (<*>)), (<$>))-import Control.Monad (Monad(return,(>>=)))-import Data.Foldable (Foldable(foldMap, toList))-import Data.Traversable (Traversable)-import Data.Monoid ((<>), All(..), Any(..))-import GHC.Generics (Generic)+import Control.Applicative (Applicative (pure, (<*>)), (<$>))+import Control.Monad (Monad (return, (>>=)))+import Data.Foldable (Foldable (foldMap, toList))+import Data.Monoid (All (..), Any (..), (<>))+import Data.Traversable (Traversable)+import GHC.Generics (Generic) -- | A general-purpose logic tree structure. Only the leaf nodes have -- values of type @a@. The tree is lazy both in value and spine (structure).-data Logic a =- Leaf a -- ^ Leaf node with value+data Logic a+ = Leaf a -- ^ Leaf node with value | And (Logic a) [Logic a] -- ^ \"and\" logic operator- | Or (Logic a) [Logic a] -- ^ \"or\" logic operator+ | Or (Logic a) [Logic a] -- ^ \"or\" logic operator | Not (Logic a) -- ^ \"not\" logic operator- deriving (Show,Eq,Ord,Generic)+ deriving (Eq, Generic, Ord, Show) instance Functor Logic where fmap f l = case l of- Leaf a -> Leaf (f a)+ Leaf a -> Leaf (f a) And ll rls -> And (fmap f ll) (map (fmap f) rls)- Or ll rls -> Or (fmap f ll) (map (fmap f) rls)- Not nl -> Not (fmap f nl)+ Or ll rls -> Or (fmap f ll) (map (fmap f) rls)+ Not nl -> Not (fmap f nl) -- | 'pure' is 'Leaf'. @fl@ '<*>' @rl@ appends the @rl@ to the leaves -- of @fl@.@@ -62,41 +62,41 @@ pure a = Leaf a fl <*> rl = case fl of- Leaf f -> fmap f rl+ Leaf f -> fmap f rl And lfl rfls -> And (lfl <*> rl) (map (<*> rl) rfls)- Or lfl rfls -> Or (lfl <*> rl) (map (<*> rl) rfls)- Not nfl -> Not (nfl <*> rl)+ Or lfl rfls -> Or (lfl <*> rl) (map (<*> rl) rfls)+ Not nfl -> Not (nfl <*> rl) instance Monad Logic where return = pure l >>= f = case l of- Leaf a -> f a+ Leaf a -> f a And ll rls -> And (ll >>= f) (map (>>= f) rls)- Or ll rls -> Or (ll >>= f) (map (>>= f) rls)- Not nl -> Not (nl >>= f)+ Or ll rls -> Or (ll >>= f) (map (>>= f) rls)+ Not nl -> Not (nl >>= f) instance Foldable Logic where foldMap f l = case l of- Leaf a -> f a+ Leaf a -> f a And ll rls -> foldMap f ll <> foldMap (foldMap f) rls- Or ll rls -> foldMap f ll <> foldMap (foldMap f) rls- Not nl -> foldMap f nl+ Or ll rls -> foldMap f ll <> foldMap (foldMap f) rls+ Not nl -> foldMap f nl instance Traversable Logic where traverse f l = case l of- Leaf a -> Leaf <$> f a+ Leaf a -> Leaf <$> f a And ll rls -> And <$> traverse f ll <*> traverse (traverse f) rls- Or ll rls -> Or <$> traverse f ll <*> traverse (traverse f) rls- Not nl -> Not <$> traverse f nl+ Or ll rls -> Or <$> traverse f ll <*> traverse (traverse f) rls+ Not nl -> Not <$> traverse f nl -- | Run the logic tree of 'Bool' values to get the result. runBool :: Logic Bool -> Bool runBool l = case l of- Leaf b -> b+ Leaf b -> b And ll rls -> getAll $ mconcat $ (All $ runBool ll) : map (All . runBool) rls Or ll rls -> getAny $ mconcat $ (Any $ runBool ll) : map (Any . runBool) rls- Not nl -> not $ runBool nl+ Not nl -> not $ runBool nl
src/Data/Greskell/NonEmptyLike.hs view
@@ -5,13 +5,13 @@ -- -- @since 1.0.0.0 module Data.Greskell.NonEmptyLike- ( NonEmptyLike(..)- ) where+ ( NonEmptyLike (..)+ ) where -import qualified Data.Foldable as F-import Data.List.NonEmpty (NonEmpty(..))-import Data.Semigroup (Semigroup, (<>))-import qualified Data.Semigroup as S+import qualified Data.Foldable as F+import Data.List.NonEmpty (NonEmpty (..))+import Data.Semigroup (Semigroup, (<>))+import qualified Data.Semigroup as S -- | Non-empty containers. Its cardinality is one or more. --@@ -29,7 +29,7 @@ singleton a = a :| [] append = (<>) toNonEmpty = id- + -- | 'append' is '<>' from 'Semigroup'. instance NonEmptyLike S.First where singleton = S.First
src/Data/Greskell/PMap.hs view
@@ -1,65 +1,70 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveTraversable, TypeFamilies, OverloadedStrings #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-} -- | -- Module: Data.Greskell.PMap -- Description: Property map, a map with Text keys and cardinality options -- Maintainer: Toshio Ito <debug.ito@gmail.com> -- -- This module defines 'PMap', a map with 'Text' keys and cardinality--- options. +-- options. -- -- @since 1.0.0.0 module Data.Greskell.PMap- ( -- * PMap- PMap,- -- ** Single lookup- lookup,- lookupM,- lookupAs,- lookupAs',- lookupAsM,- -- ** List lookup- lookupList,- lookupListAs,- lookupListAs',- -- ** Others- pMapInsert,- pMapDelete,- pMapLookup,- pMapToList,- pMapFromList,- -- * Cardinality- Single,- Multi,- -- * PMapKey- PMapKey(..),- -- * Errors- PMapLookupException(..),- pMapDecribeError,- pMapToThrow,- pMapToFail- ) where+ ( -- * PMap+ PMap+ -- ** Single lookup+ , lookup+ , lookupM+ , lookupAs+ , lookupAs'+ , lookupAsM+ -- ** List lookup+ , lookupList+ , lookupListAs+ , lookupListAs'+ -- ** Others+ , pMapInsert+ , pMapDelete+ , pMapLookup+ , pMapToList+ , pMapFromList+ -- * Cardinality+ , Single+ , Multi+ -- * PMapKey+ , PMapKey (..)+ -- * Errors+ , PMapLookupException (..)+ , pMapDecribeError+ , pMapToThrow+ , pMapToFail+ ) where -import Prelude hiding (lookup)+import Prelude hiding (lookup) -import Control.Exception (Exception)-import Control.Monad.Catch (MonadThrow(..), MonadCatch(..))-import Control.Monad.Fail (MonadFail)-import Data.Aeson.Types (Parser)-import qualified Data.Foldable as F-import Data.Functor.Identity (Identity)-import Data.Greskell.AsIterator (AsIterator(..))-import Data.Greskell.GMap (GMapEntry)-import Data.Greskell.GraphSON (GValue, GraphSONTyped(..), FromGraphSON(..), parseEither)-import qualified Data.HashMap.Strict as HM-import Data.List.NonEmpty (NonEmpty((:|)))-import Data.Maybe (listToMaybe)-import Data.Monoid (Monoid(..))-import Data.Semigroup (Semigroup((<>)))-import qualified Data.Semigroup as S-import Data.Traversable (Traversable(traverse))-import Data.Text (Text, unpack)+import Control.Exception (Exception)+import Control.Monad.Catch (MonadCatch (..), MonadThrow (..))+import Control.Monad.Fail (MonadFail)+import Data.Aeson.Types (Parser)+import qualified Data.Foldable as F+import Data.Functor.Identity (Identity)+import Data.Greskell.AsIterator (AsIterator (..))+import Data.Greskell.GMap (GMapEntry)+import Data.Greskell.GraphSON (FromGraphSON (..), GValue, GraphSONTyped (..),+ parseEither)+import qualified Data.HashMap.Strict as HM+import Data.Kind (Type)+import Data.List.NonEmpty (NonEmpty ((:|)))+import Data.Maybe (listToMaybe)+import Data.Monoid (Monoid (..))+import Data.Semigroup (Semigroup ((<>)))+import qualified Data.Semigroup as S+import Data.Text (Text, unpack)+import Data.Traversable (Traversable (traverse)) -import Data.Greskell.NonEmptyLike (NonEmptyLike)+import Data.Greskell.NonEmptyLike (NonEmptyLike) import qualified Data.Greskell.NonEmptyLike as NEL -- | A property map, which has text keys and @v@ values. @c@ specifies@@ -70,8 +75,9 @@ -- class. -- -- @since 1.0.0.0-newtype PMap c v = PMap (HM.HashMap Text (c v))- deriving (Show,Eq,Functor,Foldable,Traversable)+newtype PMap c v+ = PMap (HM.HashMap Text (c v))+ deriving (Eq, Foldable, Functor, Show, Traversable) instance GraphSONTyped (PMap c v) where gsonTypeFor _ = "g:Map"@@ -148,7 +154,7 @@ lookupAs' k pm = either fromError Right $ lookupAs k pm where fromError (PMapNoSuchKey _) = Right Nothing- fromError e = Left e+ fromError e = Left e -- | 'MonadThrow' version of 'lookupAs'. lookupAsM :: (PMapKey k, NonEmptyLike c, PMapValue k ~ a, FromGraphSON a, MonadThrow m)@@ -165,7 +171,7 @@ => k -> PMap c GValue -> Either PMapLookupException (NonEmpty a) lookupListAs k pm = case lookupList k pm of- [] -> Left $ PMapNoSuchKey kt+ [] -> Left $ PMapNoSuchKey kt (x : rest) -> either (Left . PMapParseError kt) Right $ traverse parseEither (x :| rest) where kt = keyText k@@ -181,7 +187,7 @@ lookupListAs' k pm = either fromError (Right . F.toList) $ lookupListAs k pm where fromError (PMapNoSuchKey _) = Right []- fromError e = Left e+ fromError e = Left e -- | The single cardinality for 'PMap'. 'pMapInsert' method replaces -- the old value. '<>' on 'PMap' prefers the items from the left@@ -196,15 +202,16 @@ -- the order of the items for each key. -- -- @since 1.0.0.0-newtype Multi a = Multi (NonEmpty a)- deriving (Show,Eq,Ord,Functor,Semigroup,Foldable,Traversable,NonEmptyLike,FromGraphSON)+newtype Multi a+ = Multi (NonEmpty a)+ deriving (Eq, Foldable, FromGraphSON, Functor, NonEmptyLike, Ord, Semigroup, Show, Traversable) -- | A typed key for 'PMap'. -- -- @since 1.0.0.0 class PMapKey k where -- | Type of the value associated with the key.- type PMapValue k :: *+ type PMapValue k :: Type -- | 'Text' representation of the key. keyText :: k -> Text@@ -217,30 +224,30 @@ -- | An 'Exception' raised when looking up values from 'PMap'. -- -- @since 1.0.0.0-data PMapLookupException =- PMapNoSuchKey Text+data PMapLookupException+ = PMapNoSuchKey Text -- ^ The 'PMap' doesn't have the given key. | PMapParseError Text String -- ^ Failed to parse the value into the type that the 'PMapKey' -- indicates. The 'Text' is the key, and the 'String' is the error -- message.- deriving (Show,Eq,Ord)+ deriving (Eq, Ord, Show) instance Exception PMapLookupException -- | Make a human-readable description on 'PMapLookupException'. pMapDecribeError :: PMapLookupException -> String-pMapDecribeError (PMapNoSuchKey k) = "Property '" ++ unpack k ++ "' does not exist."+pMapDecribeError (PMapNoSuchKey k) = "Property '" ++ unpack k ++ "' does not exist." pMapDecribeError (PMapParseError k pe) = "Parse error of property '" ++ unpack k ++ "': " ++ pe -- | Convert the lookup result into a 'MonadThrow'. It throws -- 'PMapLookupException'. pMapToThrow :: MonadThrow m => Either PMapLookupException a -> m a-pMapToThrow (Left e) = throwM e+pMapToThrow (Left e) = throwM e pMapToThrow (Right a) = return a -- | Convert the lookup result into a 'MonadFail'. It fails with the -- description returned by 'pMapDecribeError'. pMapToFail :: MonadFail m => Either PMapLookupException a -> m a-pMapToFail (Left e) = fail $ pMapDecribeError e+pMapToFail (Left e) = fail $ pMapDecribeError e pMapToFail (Right a) = return a
test/Data/Greskell/BinderSpec.hs view
@@ -1,27 +1,43 @@-module Data.Greskell.BinderSpec (main,spec) where+{-# LANGUAGE OverloadedStrings #-}+module Data.Greskell.BinderSpec+ ( main+ , spec+ ) where -import Control.Applicative ((<$>), (<*>))-import Control.Monad (forM_)-import Data.Aeson (toJSON)-import qualified Data.HashMap.Strict as HM-import Data.Text (unpack)-import Test.Hspec+import Control.Applicative ((<$>), (<*>))+import Control.Monad (forM_)+import Data.Aeson (toJSON)+import qualified Data.Aeson.Key as Key+import qualified Data.Aeson.KeyMap as KM+import Data.Text (Text)+import qualified Data.Text as T+import Test.Hspec -import Data.Greskell.AsLabel (AsLabel)-import Data.Greskell.Greskell (toGremlin, unsafeGreskell, Greskell)-import Data.Greskell.Binder (Binder, newBind, runBinder, newAsLabel)+import Data.Greskell.AsLabel (AsLabel)+import Data.Greskell.Binder (Binder, newAsLabel, newBind, runBinder)+import Data.Greskell.Greskell (Greskell, toGremlin, unsafeGreskell) main :: IO () main = hspec spec -shouldBeVariable :: Greskell a -> IO ()-shouldBeVariable got_greskell =- case unpack $ toGremlin got_greskell of- [] -> expectationFailure "Expect a Gremlin variable, but got empty script."- (h : rest) -> do- h `shouldSatisfy` (`elem` variableHeads)- forM_ rest (`shouldSatisfy` (`elem` variableRests))+extractVarName :: Greskell a -> IO Text+extractVarName got_greskell = checkVarName =<< (stripParens $ toGremlin got_greskell) where+ stripParens v =+ case T.stripPrefix "((" =<< T.stripSuffix "))" v of+ Nothing -> do+ expectationFailure "Binder should produce an expression of a variable wrapped with double parens"+ return ""+ Just a -> return a+ checkVarName v =+ case T.unpack v of+ [] -> do+ expectationFailure "Expect a Gremlin variable, but got empty script."+ return ""+ (h : rest) -> do+ h `shouldSatisfy` (`elem` variableHeads)+ forM_ rest (`shouldSatisfy` (`elem` variableRests))+ return v variableHeads = '_' : (['a' .. 'z'] ++ ['A' .. 'Z']) variableRests = variableHeads ++ ['0' .. '9'] @@ -30,31 +46,31 @@ it "should keep bound values" $ do let b = do v1 <- newBind (100 :: Int)- v2 <- newBind "hogehoge"+ v2 <- newBind ("hogehoge" :: Text) return (v1, v2) ((got_v1, got_v2), got_bind) = runBinder b toGremlin got_v1 `shouldNotBe` toGremlin got_v2- shouldBeVariable got_v1- shouldBeVariable got_v2- got_bind `shouldBe` HM.fromList [ (toGremlin got_v1, toJSON (100 :: Int)),- (toGremlin got_v2, toJSON "hogehoge")+ v1Name <- extractVarName got_v1+ v2Name <- extractVarName got_v2+ got_bind `shouldBe` KM.fromList [ (Key.fromText v1Name, toJSON (100 :: Int)),+ (Key.fromText v2Name, toJSON ("hogehoge" :: Text)) ] it "should compose and produce new variables" $ do- let b = newBind "foobar"+ let b = newBind ("foobar" :: Text) ((got_v1, got_v2), got_bind) = runBinder $ ((,) <$> b <*> b) toGremlin got_v1 `shouldNotBe` toGremlin got_v2- shouldBeVariable got_v1- shouldBeVariable got_v2- got_bind `shouldBe` HM.fromList [ (toGremlin got_v1, toJSON "foobar"),- (toGremlin got_v2, toJSON "foobar")+ v1Name <- extractVarName got_v1+ v2Name <- extractVarName got_v2+ got_bind `shouldBe` KM.fromList [ (Key.fromText v1Name, toJSON ("foobar" :: Text)),+ (Key.fromText v2Name, toJSON ("foobar" :: Text)) ] it "should also be able to produce AsLabels" $ do let newIntLabel :: Binder (AsLabel Int) newIntLabel = newAsLabel- newVar = newBind "foobar"+ newVar = newBind ("foobar" :: Text) ((got_v1, got_l1, got_v2, got_l2), _) = runBinder $ ((,,,) <$> newVar <*> newIntLabel <*> newVar <*> newIntLabel)- shouldBeVariable got_v1- shouldBeVariable got_v2+ _ <- extractVarName got_v1+ _ <- extractVarName got_v2 toGremlin got_v1 `shouldNotBe` toGremlin got_v2 got_l1 `shouldNotBe` got_l2
test/Data/Greskell/ExtraSpec.hs view
@@ -1,17 +1,20 @@ {-# LANGUAGE OverloadedStrings #-}-module Data.Greskell.ExtraSpec (main,spec) where+module Data.Greskell.ExtraSpec+ ( main+ , spec+ ) where -import Data.Monoid (mempty, (<>))-import Data.Text (Text)-import Test.Hspec+import qualified Data.Aeson.KeyMap as KM+import Data.Monoid (mempty, (<>))+import Data.Text (Text)+import Test.Hspec -import Data.Aeson (Value(..))-import Data.Greskell.Binder (Binder, Binding, runBinder)-import Data.Greskell.Extra (writePropertyKeyValues, writeKeyValues)-import Data.Greskell.Graph (AVertex, (=:), Key, KeyValue)-import Data.Greskell.Greskell (toGremlin)-import Data.Greskell.GTraversal (Walk, WalkType)-import qualified Data.HashMap.Strict as HM+import Data.Aeson (Value (..))+import Data.Greskell.Binder (Binder, Binding, runBinder)+import Data.Greskell.Extra (writeKeyValues, writePropertyKeyValues)+import Data.Greskell.Graph (AVertex, Key, KeyValue, (=:))+import Data.Greskell.Greskell (toGremlin)+import Data.Greskell.GTraversal (Walk, WalkType) main :: IO () main = hspec spec@@ -32,16 +35,16 @@ let input :: [(Text, Int)] input = [("age", 24)] (runBoundWalk $ writePropertyKeyValues input)- `shouldBe` ( "__.property(\"age\",__v0).identity()",- HM.fromList [("__v0", Number 24)]+ `shouldBe` ( "__.property(\"age\",((__v0))).identity()",+ KM.fromList [("__v0", Number 24)] ) specify "multiple props" $ do let input :: [(Text, Value)] input = [("age", Number 24), ("name", String "Toshio"), ("foo", String "bar")] (runBoundWalk $ writePropertyKeyValues input)- `shouldBe` ( "__.property(\"age\",__v0).property(\"name\",__v1)"- <> ".property(\"foo\",__v2).identity()",- HM.fromList [ ("__v0", Number 24),+ `shouldBe` ( "__.property(\"age\",((__v0))).property(\"name\",((__v1)))"+ <> ".property(\"foo\",((__v2))).identity()",+ KM.fromList [ ("__v0", Number 24), ("__v1", String "Toshio"), ("__v2", String "bar") ]
test/Data/Greskell/GTraversalSpec.hs view
@@ -1,42 +1,32 @@ {-# LANGUAGE OverloadedStrings #-}-module Data.Greskell.GTraversalSpec (main,spec) where+module Data.Greskell.GTraversalSpec+ ( main+ , spec+ ) where -import Control.Category ((>>>), (<<<))-import Data.Aeson (ToJSON(..), Value(Number))-import Data.Function ((&))-import Data.Text (Text)-import System.IO (stderr, hPutStrLn)+import Control.Category ((<<<), (>>>))+import Control.Monad (forM_)+import Data.Aeson (ToJSON (..), Value (Number))+import Data.Function ((&))+import Data.Text (Text, unpack)+import System.IO (hPutStrLn, stderr) -import Test.Hspec+import Test.Hspec -import Data.Greskell.AsLabel (AsLabel)-import Data.Greskell.Gremlin- ( oIncr, oDecr, oShuffle,- pEq, pNeq, pInside, pGte- )-import Data.Greskell.Graph- ( Element, ElementID(..), AVertex,- Key, key,- tLabel, tId- )-import Data.Greskell.GraphSON (nonTypedGValue, GValueBody(..))-import Data.Greskell.Greskell- ( toGremlin, Greskell, gvalueInt)-import Data.Greskell.GTraversal- ( Walk, Transform, Filter,- source, (&.), ($.), sV', sE',- gHas1, gHas2, gHas2', gHas2P, gHasLabelP, gHasIdP, gIs, gIs',- gOut', gRange, gValues, gNot, gIn',- gOrder,- gProperties, gHasKeyP, gHasValueP,- ByComparator(..), gBy2, gBy1, gBy,- gRepeat, gTimes, gUntilHead, gUntilTail,- gEmitHead, gEmitTail, gEmitHeadT, gEmitTailT,- gLoops,- gWhereP1, gAs, gLabel, gWhereP2,- gMatch, mPattern- )-import Data.Greskell.Logic (Logic(..))+import Data.Greskell.AsLabel (AsLabel)+import Data.Greskell.Graph (AVertex, Element, ElementID (..), Key, key, tId, tLabel)+import Data.Greskell.GraphSON (GValueBody (..), nonTypedGValue)+import Data.Greskell.Gremlin (oDecr, oIncr, oShuffle, pEq, pGte, pInside, pNeq)+import Data.Greskell.Greskell (Greskell, gvalueInt, toGremlin)+import Data.Greskell.GTraversal (ByComparator (..), Filter, Transform, Walk, gAs, gBy,+ gBy1, gBy2, gEmitHead, gEmitHeadT, gEmitTail, gEmitTailT,+ gHas1, gHas2, gHas2', gHas2P, gHasIdP, gHasKeyP,+ gHasLabelP, gHasValueP, gIn', gIs, gIs', gLabel, gLoops,+ gMatch, gNot, gOrder, gOut', gProperties, gRange,+ gRepeat, gTimes, gUntilHead, gUntilTail, gValues,+ gWhereP1, gWhereP2, mPattern, sE', sV', source, ($.),+ (&.))+import Data.Greskell.Logic (Logic (..)) main :: IO ()@@ -52,7 +42,6 @@ spec_where spec_match - spec_GraphTraversalSource :: Spec spec_GraphTraversalSource = describe "GraphTraversalSource" $ do specify "g.V()" $ do@@ -261,4 +250,3 @@ the_key = ("k" :: Key AVertex Text) toGremlin (source "g" & sV' [] &. gAs ext_label &. gOut' [] &. gMatch pat) `shouldBe` "g.V().as(\"e\").out().match(__.as(\"e\").in().has(\"k\",\"foo\"))"-
test/Data/Greskell/Graph/PropertyMapSpec.hs view
@@ -1,13 +1,14 @@ {-# LANGUAGE OverloadedStrings #-}-module Data.Greskell.Graph.PropertyMapSpec (main,spec) where+module Data.Greskell.Graph.PropertyMapSpec+ ( main+ , spec+ ) where -import Data.Monoid (mempty, (<>))-import Test.Hspec+import Data.Monoid (mempty, (<>))+import Test.Hspec -import Data.Greskell.Graph.PropertyMap- ( PropertyMapSingle, PropertyMapList, AProperty(..),- PropertyMap(..)- )+import Data.Greskell.Graph.PropertyMap (AProperty (..), PropertyMap (..), PropertyMapList,+ PropertyMapSingle) main :: IO () main = hspec spec
test/Data/Greskell/GraphSpec.hs view
@@ -1,28 +1,26 @@ {-# LANGUAGE OverloadedStrings #-}-module Data.Greskell.GraphSpec (main,spec) where+module Data.Greskell.GraphSpec+ ( main+ , spec+ ) where -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 Control.Monad (forM_)+import Data.Aeson (FromJSON, toJSON)+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, unpack)+import Test.Hspec -import Data.Greskell.AsLabel (AsLabel(..))-import Data.Greskell.Graph- ( AProperty(..),- -- PropertyMapSingle, PropertyMapList,- AEdge(..), AVertexProperty(..), AVertex(..),- ElementID(..),- Path(..), PathEntry(..), pathToPMap- )-import Data.Greskell.GraphSON- ( nonTypedGraphSON, typedGraphSON, typedGraphSON',- nonTypedGValue, typedGValue', GValueBody(..)- )-import Data.Greskell.PMap (pMapFromList, lookupList)+import Data.Greskell.AsLabel (AsLabel (..))+import Data.Greskell.Graph (AEdge (..), AProperty (..), AVertex (..),+ AVertexProperty (..), ElementID (..), Path (..),+ PathEntry (..), pathToPMap)+import Data.Greskell.GraphSON (GValueBody (..), nonTypedGValue, nonTypedGraphSON,+ typedGValue', typedGraphSON, typedGraphSON')+import Data.Greskell.PMap (lookupList, pMapFromList) main :: IO () main = hspec spec@@ -120,7 +118,7 @@ mkEID mtype vb = case mtype of Nothing -> ElementID $ nonTypedGValue vb- Just t -> ElementID $ typedGValue' t vb+ Just t -> ElementID $ typedGValue' t vb mkLabels :: [Text] -> HashSet (AsLabel a) mkLabels = HS.fromList . map AsLabel
test/Data/Greskell/GremlinSpec.hs view
@@ -1,12 +1,15 @@ {-# LANGUAGE OverloadedStrings #-}-module Data.Greskell.GremlinSpec (main,spec) where+module Data.Greskell.GremlinSpec+ ( main+ , spec+ ) where -import Test.Hspec+import Test.Hspec -import Data.Greskell.Gremlin- ( pBetween, pAnd, pOr, pNegate, pWithin, pGte, pTest, P- )-import Data.Greskell.Greskell (toGremlin, Greskell)+import Control.Monad (forM_)+import Data.Greskell.Gremlin (P, pAnd, pBetween, pGte, pNegate, pOr, pTest, pWithin)+import Data.Greskell.Greskell (Greskell, toGremlin)+import Data.Text (unpack) main :: IO () main = hspec spec
test/Data/Greskell/LogicSpec.hs view
@@ -1,13 +1,16 @@-module Data.Greskell.LogicSpec (main,spec) where+module Data.Greskell.LogicSpec+ ( main+ , spec+ ) where -import Control.Applicative ((<$>), (<*>))-import Control.Monad (forM_)-import Data.Foldable (toList)-import Data.Monoid ((<>))-import Data.Traversable (traverse)-import Test.Hspec+import Control.Applicative ((<$>), (<*>))+import Control.Monad (forM_)+import Data.Foldable (toList)+import Data.Monoid ((<>))+import Data.Traversable (traverse)+import Test.Hspec -import Data.Greskell.Logic (Logic(..), runBool)+import Data.Greskell.Logic (Logic (..), runBool) main :: IO () main = hspec spec
test/Data/Greskell/PMapSpec.hs view
@@ -1,16 +1,16 @@ {-# LANGUAGE OverloadedStrings #-}-module Data.Greskell.PMapSpec (main,spec) where+module Data.Greskell.PMapSpec+ ( main+ , spec+ ) where -import Prelude hiding (lookup)+import Prelude hiding (lookup) -import Data.Text (Text)-import Test.Hspec+import Data.Text (Text)+import Test.Hspec -import Data.Greskell.PMap- ( PMap, Single, Multi,- pMapFromList, pMapToList, pMapInsert, pMapDelete,- lookup, lookupList- )+import Data.Greskell.PMap (Multi, PMap, Single, lookup, lookupList, pMapDelete,+ pMapFromList, pMapInsert, pMapToList) main :: IO () main = hspec spec@@ -124,4 +124,4 @@ ("buzz", 600), ("foo", 700) ]- +
− test/DocTest.hs
@@ -1,1 +0,0 @@-{-# OPTIONS_GHC -F -pgmF doctest-discover #-}
+ test/ExamplesSpec.hs view
@@ -0,0 +1,25 @@+module ExamplesSpec+ ( main+ , spec+ ) where++import qualified Data.Greskell.Extra as Extra+import qualified Data.Greskell.Graph as Graph+import qualified Data.Greskell.Gremlin as Gremlin+import qualified Data.Greskell.GTraversal as GTraversal++import Control.Monad (forM_)+import Test.Hspec++main :: IO ()+main = hspec spec++spec :: Spec+spec = describe "examples" $ do+ makeSpec "Graph" Graph.examples+ makeSpec "Gremlin" Gremlin.examples+ makeSpec "GTraversal" GTraversal.examples+ makeSpec "Extra" Extra.examples++makeSpec :: (Show a) => String -> [(a, a)] -> Spec+makeSpec label exs = describe label $ forM_ exs $ \(got, expected) -> specify (show expected) $ show got `shouldBe` show expected
− test/HintTest.hs
@@ -1,77 +0,0 @@-module Main (main,spec) where--import Data.Either (isRight)-import Language.Haskell.Interpreter- ( loadModules, OptionVal((:=)), set, searchPath,- setTopLevelModules, runInterpreter, InterpreterError,- typeOf- )-import System.IO (hPutStrLn, stderr)-import Test.Hspec--main :: IO ()-main = hspec spec--spec :: Spec-spec = spec_WalkType_classes--spec_WalkType_classes :: Spec-spec_WalkType_classes = do- describe "Split typeclass" $ do- let c = checkSplitCompatible- c "Filter" "Filter" True- c "Filter" "Transform" True- c "Filter" "SideEffect" True- c "Transform" "Filter" True- c "Transform" "Transform" True- c "Transform" "SideEffect" True- c "SideEffect" "Filter" False- c "SideEffect" "Transform" False- c "SideEffect" "SideEffect" True- describe "Lift typeclass" $ do- let c = checkLiftCompatible- c "Filter" "Filter" True- c "Filter" "Transform" True- c "Filter" "SideEffect" True- c "Transform" "Filter" False- c "Transform" "Transform" True- c "Transform" "SideEffect" True- c "SideEffect" "Filter" False- c "SideEffect" "Transform" False- c "SideEffect" "SideEffect" True- -toErrString :: Either InterpreterError a -> Either String a-toErrString (Right a) = Right a-toErrString (Left e) = Left $ show e--checkWalkTypeRelation :: (String -> String -> String) -> String -> String -> Bool -> Spec-checkWalkTypeRelation makeCode child parent expect_ok = specify label $ doCheck- where- label = child ++ " -> " ++ parent- doCheck = do- result <- fmap toErrString $ runInterpreter compiledParent- -- hPutStrLn stderr ("## " ++ label ++ ": " ++ show result)- isRight result `shouldBe` expect_ok- compiledParent = do- set [searchPath := ["src"]]- loadModules ["src/Data/Greskell/GTraversal.hs"]- setTopLevelModules ["Data.Greskell.GTraversal"]- typeOf $ makeCode child parent--checkSplitCompatible :: String -> String -> Bool -> Spec-checkSplitCompatible = checkWalkTypeRelation makeCode- where- makeCode child parent =- "let f :: Walk " ++ child ++ " s s -> Walk " ++ parent ++ " s s; "- ++ "f = gFilter; "- ++ "child :: Walk " ++ child ++ " s s; "- ++ "child = undefined; "- ++ "in f child"--checkLiftCompatible :: String -> String -> Bool -> Spec-checkLiftCompatible = checkWalkTypeRelation makeCode- where- makeCode child parent =- "let f :: Walk " ++ child ++ " s e -> Walk " ++ parent ++ " s e; "- ++ "f = liftWalk; "- ++ "in f"
test/ServerBehaviorTest.hs view
@@ -1,28 +1,27 @@ {-# LANGUAGE OverloadedStrings #-}-module Main (main,spec) where+module Main+ ( main+ , spec+ ) where -import qualified Data.Vector as V+import qualified Data.Vector as V import qualified Network.Greskell.WebSocket.Client as WS-import System.IO (hPutStrLn, stderr)-import Test.Hspec+import System.IO (hPutStrLn, stderr)+import Test.Hspec -import Control.Category ((<<<))-import Control.Monad (void)-import Data.Text (Text)-import Data.Greskell.Binder (newBind, runBinder)-import Data.Greskell.Graph- ( AVertex(..), Key, AEdge, Property(propertyKey, propertyValue),- AVertexProperty(..)- )-import Data.Greskell.GraphSON (parseEither)-import Data.Greskell.GTraversal- ( Walk, GTraversal, SideEffect,- source, sV', sE', sAddV', gProperty, gId, gValues, gHasId, gHasLabel, gHas2,- ($.), liftWalk,- gAddE', gTo, gV', gProperties- )+import Control.Category ((<<<))+import Control.Monad (void)+import Data.Greskell.Binder (newBind, runBinder)+import Data.Greskell.Graph (AEdge, AVertex (..), AVertexProperty (..), Key,+ Property (propertyKey, propertyValue))+import Data.Greskell.GraphSON (parseEither)+import Data.Greskell.GTraversal (GTraversal, SideEffect, Walk, gAddE', gHas2,+ gHasId, gHasLabel, gId, gProperties, gProperty,+ gTo, gV', gValues, liftWalk, sAddV', sE', sV',+ source, ($.))+import Data.Text (Text) -import ServerTest.Common (withEnv, withClient)+import ServerTest.Common (withClient, withEnv) main :: IO () main = hspec spec@@ -100,7 +99,7 @@ return $ gValues [ename_key] $. (sE' [eid] $ source "g") got_vals <- fmap V.toList $ WS.slurpResults =<< WS.submit client q (Just qbind) got_vals `shouldBe` ["e_test"]- + spec_vertex_with_props :: SpecWith (String, Int) spec_vertex_with_props = do let prop_key :: Key AVertex Int
test/ServerTest.hs view
@@ -1,69 +1,58 @@-{-# LANGUAGE OverloadedStrings, TypeFamilies #-}-module Main (main,spec) where+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}+module Main+ ( main+ , spec+ ) where -import Control.Category ((<<<), (>>>))-import qualified Data.Aeson as Aeson-import Data.Either (isRight)-import Data.Foldable (toList)-import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as HM-import Data.List (sort)-import Data.Monoid (mempty, (<>))-import Data.Scientific (Scientific)-import Data.Text (unpack, Text)-import Data.Traversable (traverse)-import qualified Data.Vector as V+import Control.Category ((<<<), (>>>))+import qualified Data.Aeson as Aeson+import Data.Either (isRight)+import Data.Foldable (toList)+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HM+import Data.List (sort)+import Data.Monoid (mempty, (<>))+import Data.Scientific (Scientific)+import Data.Text (Text, unpack)+import Data.Traversable (traverse)+import qualified Data.Vector as V import qualified Network.Greskell.WebSocket.Client as WS-import Test.Hspec+import Test.Hspec -import Data.Greskell.AsLabel (AsLabel(..), lookupAsM)-import qualified Data.Greskell.AsLabel as As-import Data.Greskell.AsIterator- ( 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,- Predicate(..), pLt, pAnd, pGte, pNot, pEq, pTest, P- )-import Data.Greskell.Greskell- ( toGremlin, Greskell, toGreskell, ToGreskell(..),- true, false, list, value, single, number, gvalueInt,- unsafeMethodCall, unsafeGreskell- )-import Data.Greskell.Graph- ( AVertex(..), AEdge(..), AProperty(..), AVertexProperty(..),- Key, Keys(..), (-:), singletonKeys,- T, tId, tLabel, tKey, tValue, cList, (=:),- ElementID(..),- Path(..), makePathEntry- )-import Data.Greskell.GraphSON- ( FromGraphSON, nonTypedGValue, GValue,- parseEither- )-import Data.Greskell.GTraversal- ( Walk, GTraversal, SideEffect,- source, sV', sE', gV', sAddV', gAddE', gTo,- ($.), gOrder, gBy1, gBy, gByL,- Transform, unsafeWalk, unsafeGTraversal,- gProperties, gProperty, gPropertyV, liftWalk, gValues,- gAs, gSelect1, gSelectN, gSelectBy1, gSelectByN,- gFilter, gOut', gOutV, gOutV', gInV, gInV', gId, gLabel, gProject,- gValueMap,- gProject, gByL,- gRepeat, gTimes, gEmitHead, gUntilTail, gLoops, gIsP, gIsP',- gHasLabel, gHas2, gAddV, gIterate,- gPath, gPathBy,- gWhereP1, gChoose3, gIdentity, gWhereP2,- gMatch, mPattern- )-import Data.Greskell.Logic (Logic(..))-import Data.Greskell.PMap (lookupAsM, lookupListAs, pMapToThrow)+import Data.Greskell.AsIterator (AsIterator (IteratorItem))+import Data.Greskell.AsLabel (AsLabel (..), lookupAsM)+import qualified Data.Greskell.AsLabel as As+import Data.Greskell.Binder (Binder, newBind, runBinder)+import Data.Greskell.Extra (gWhenEmptyInput)+import Data.Greskell.GMap (GMapEntry, unGMapEntry)+import Data.Greskell.Graph (AEdge (..), AProperty (..), AVertex (..),+ AVertexProperty (..), ElementID (..), Key,+ Keys (..), Path (..), T, cList, makePathEntry,+ singletonKeys, tId, tKey, tLabel, tValue, (-:),+ (=:))+import Data.Greskell.GraphSON (FromGraphSON, GValue, nonTypedGValue,+ parseEither)+import Data.Greskell.Gremlin (Order, P, Predicate (..), cCompare, oAsc, oDesc,+ pAnd, pEq, pGte, pLt, pNot, pTest)+import Data.Greskell.Greskell (Greskell, ToGreskell (..), false, gvalueInt,+ list, number, single, toGremlin, toGreskell,+ true, unsafeGreskell, unsafeMethodCall, value)+import Data.Greskell.GTraversal (GTraversal, SideEffect, Transform, Walk, gAddE',+ gAddV, gAs, gBy, gBy1, gByL, gChoose3,+ gEmitHead, gFilter, gHas2, gHasLabel, gId,+ gIdentity, gInV, gInV', gIsP, gIsP', gIterate,+ gLabel, gLoops, gMatch, gOrder, gOut', gOutV,+ gOutV', gPath, gPathBy, gProject, gProperties,+ gProperty, gPropertyV, gRepeat, gSelect1,+ gSelectBy1, gSelectByN, gSelectN, gTimes, gTo,+ gUntilTail, gV', gValueMap, gValues, gWhereP1,+ gWhereP2, liftWalk, mPattern, sAddV', sE', sV',+ source, unsafeGTraversal, unsafeWalk, ($.))+import Data.Greskell.Logic (Logic (..))+import Data.Greskell.PMap (lookupAsM, lookupListAs, pMapToThrow) -import ServerTest.Common (withEnv, withClient)+import ServerTest.Common (withClient, withEnv) main :: IO () main = hspec spec@@ -71,6 +60,7 @@ spec :: Spec spec = withEnv $ do spec_basics+ spec_binder spec_comparator spec_predicate spec_T@@ -166,19 +156,34 @@ => Greskell a -> b -> SpecWith (String, Int) checkOne input expected = checkRaw input [expected] +checkBinder :: (AsIterator a, b ~ IteratorItem a, FromGraphSON b, Eq b, Show b)+ => [b] -> Binder (Greskell a) -> SpecWith (String, Int)+checkBinder expected binder = specify label $ withClient $ \client -> do+ got <- WS.slurpResults =<< WS.submit client script (Just binding)+ got `shouldBe` V.fromList expected+ where+ (script, binding) = runBinder binder+ label = (unpack $ toGremlin script) ++ " with " ++ show binding +spec_binder :: SpecWith (String, Int)+spec_binder = describe "server and Binder" $ do+ checkBinder [100 :: Int] $ newBind (100 :: Int)+ checkBinder [110 :: Int] $ do+ b <- newBind (100 :: Int)+ return $ b + (10 :: Greskell Int)+ spec_comparator :: SpecWith (String,Int) spec_comparator = do- let oIncr' :: Greskell (Order Int)- oIncr' = oIncr- oDecr' :: Greskell (Order Int)- oDecr' = oDecr- checkOne (cCompare oIncr' 20 20) 0- checkOne (cCompare oIncr' 10 20) (-1)- checkOne (cCompare oIncr' 20 10) 1- checkOne (cCompare oDecr' 20 20) 0- checkOne (cCompare oDecr' 10 20) 1- checkOne (cCompare oDecr' 20 10) (-1)+ let oAsc' :: Greskell (Order Int)+ oAsc' = oAsc+ oDesc' :: Greskell (Order Int)+ oDesc' = oDesc+ checkOne (cCompare oAsc' 20 20) 0+ checkOne (cCompare oAsc' 10 20) (-1)+ checkOne (cCompare oAsc' 20 10) 1+ checkOne (cCompare oDesc' 20 20) 0+ checkOne (cCompare oDesc' 10 20) 1+ checkOne (cCompare oDesc' 20 10) (-1) spec_predicate :: SpecWith (String,Int) spec_predicate = do@@ -205,7 +210,7 @@ prefixedTraversal :: Walk Transform AVertex a -> GTraversal Transform () a prefixedTraversal mapper = unsafeGTraversal (prelude <> body) where- prelude = + prelude = ( "graph = org.apache.tinkerpop.gremlin.tinkergraph.structure.TinkerGraph.open(); " <> "g = graph.traversal(); " <> "graph.addVertex(id, 10, label, \"VLABEL\"); "
test/ServerTest/Common.hs view
@@ -1,18 +1,18 @@ -- | -- Module: ServerTest.Common--- Description: +-- Description: -- Maintainer: Toshio Ito <debug.ito@gmail.com> ----- +-- module ServerTest.Common- ( withEnv,- withClient- ) where+ ( withEnv+ , withClient+ ) where -import Control.Exception.Safe (bracket)+import Control.Exception.Safe (bracket) import qualified Network.Greskell.WebSocket.Client as WS-import System.Environment (lookupEnv)-import Test.Hspec+import System.Environment (lookupEnv)+import Test.Hspec requireEnv :: String -> IO String requireEnv env_key = maybe bail return =<< lookupEnv env_key
+ test/Typecheck.hs view
@@ -0,0 +1,54 @@+{-# OPTIONS_GHC -fdefer-type-errors -Wno-deferred-type-errors #-}+module Main+ ( main+ , spec+ ) where++import Data.Proxy (Proxy (..))+import Test.Hspec+import Test.ShouldNotTypecheck (shouldNotTypecheck)++import Data.Greskell.GTraversal (Filter, SideEffect, Split, Transform, Walk, WalkType,+ showLift, showSplit, showWalkType)++main :: IO ()+main = hspec spec++pF :: Proxy Filter+pF = Proxy++pT :: Proxy Transform+pT = Proxy++pS :: Proxy SideEffect+pS = Proxy++spec :: Spec+spec = do+ describe "Split typeclass" $ do+ specify (label pF pF) $ shouldTypecheck (showSplit pF pF)+ specify (label pF pT) $ shouldTypecheck (showSplit pF pT)+ specify (label pF pS) $ shouldTypecheck (showSplit pF pS)+ specify (label pT pF) $ shouldTypecheck (showSplit pT pF)+ specify (label pT pT) $ shouldTypecheck (showSplit pT pT)+ specify (label pT pS) $ shouldTypecheck (showSplit pT pS)+ specify (label pS pF) $ shouldNotTypecheck (showSplit pS pF)+ specify (label pS pT) $ shouldNotTypecheck (showSplit pS pT)+ specify (label pS pS) $ shouldTypecheck (showSplit pS pS)+ describe "Lift typeclass" $ do+ specify (label pF pF) $ shouldTypecheck (showLift pF pF)+ specify (label pF pT) $ shouldTypecheck (showLift pF pT)+ specify (label pF pS) $ shouldTypecheck (showLift pF pS)+ specify (label pT pF) $ shouldNotTypecheck (showLift pT pF)+ specify (label pT pT) $ shouldTypecheck (showLift pT pT)+ specify (label pT pS) $ shouldTypecheck (showLift pT pS)+ specify (label pS pF) $ shouldNotTypecheck (showLift pS pF)+ specify (label pS pT) $ shouldNotTypecheck (showLift pS pT)+ specify (label pS pS) $ shouldTypecheck (showLift pS pS)+++label :: (WalkType a, WalkType b) => Proxy a -> Proxy b -> String+label a b = showWalkType a ++ " -> " ++ showWalkType b++shouldTypecheck :: String -> Expectation+shouldTypecheck s = length s `shouldSatisfy` (> 0)