diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,16 @@ # Revision history for greskell +## 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`. diff --git a/greskell.cabal b/greskell.cabal --- a/greskell.cabal +++ b/greskell.cabal @@ -1,5 +1,5 @@ name: greskell -version: 2.0.0.0 +version: 2.0.1.0 author: Toshio Ito maintainer: Toshio Ito license: BSD3 @@ -39,14 +39,14 @@ Data.Greskell.NonEmptyLike, Data.Greskell.Logic -- other-modules: - build-depends: base >=4.9.0.0 && <4.16, + build-depends: base >=4.9.0.0 && <4.17, greskell-core >=0.1.3.0 && <1.1, text >=1.2.2.1 && <1.3, transformers >=0.5.2 && <0.6, - aeson >=2.0.2.0 && <2.1, + aeson >=2.0.2.0 && <2.2, unordered-containers >=0.2.7.1 && <0.3, semigroups >=0.18.2 && <0.21, - vector >=0.12.0.1 && <0.13, + vector >=0.12.0.1 && <0.14, exceptions >=0.8.3 && <0.11, hashable >=1.2.7.0 && <1.5 @@ -65,23 +65,13 @@ 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.21, - doctest-discover >=0.1.0.8 && <0.3 + bytestring >=0.10.8.1 && <0.12 test-suite typecheck-test-suite type: exitcode-stdio-1.0 diff --git a/src/Data/Greskell.hs b/src/Data/Greskell.hs --- a/src/Data/Greskell.hs +++ b/src/Data/Greskell.hs @@ -15,26 +15,25 @@ -- - "Data.Greskell.Logic": Logic type, which is a general-purpose logic tree data structure. -- - "Data.Greskell.Graph.PropertyMap": deprecated PropertyMap class. 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 diff --git a/src/Data/Greskell/AsLabel.hs b/src/Data/Greskell/AsLabel.hs --- a/src/Data/Greskell/AsLabel.hs +++ b/src/Data/Greskell/AsLabel.hs @@ -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 diff --git a/src/Data/Greskell/Binder.hs b/src/Data/Greskell/Binder.hs --- a/src/Data/Greskell/Binder.hs +++ b/src/Data/Greskell/Binder.hs @@ -1,41 +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 -- --- +-- 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 qualified Data.Aeson.KeyMap as KM -import qualified Data.Aeson.Key as Key -import Data.Monoid ((<>)) -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 = @@ -45,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.Aeson.KeyMap as KeyMap - -- | 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) $ KeyMap.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 diff --git a/src/Data/Greskell/Extra.hs b/src/Data/Greskell/Extra.hs --- a/src/Data/Greskell/Extra.hs +++ b/src/Data/Greskell/Extra.hs @@ -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.Aeson.KeyMap as KeyMap -- $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) $ KeyMap.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) $ KeyMap.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) $ KeyMap.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\"))") + ] + diff --git a/src/Data/Greskell/GTraversal.hs b/src/Data/Greskell/GTraversal.hs --- a/src/Data/Greskell/GTraversal.hs +++ b/src/Data/Greskell/GTraversal.hs @@ -1,1861 +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 --- --- 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, - -- * 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.List.NonEmpty (NonEmpty(..)) -import Data.Monoid ((<>), mconcat, Monoid(..)) -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.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 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 --- --- >>> 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 +-- +-- 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())" + ) + ] diff --git a/src/Data/Greskell/Graph.hs b/src/Data/Greskell/Graph.hs --- a/src/Data/Greskell/Graph.hs +++ b/src/Data/Greskell/Graph.hs @@ -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") + ] diff --git a/src/Data/Greskell/Graph/PropertyMap.hs b/src/Data/Greskell/Graph/PropertyMap.hs --- a/src/Data/Greskell/Graph/PropertyMap.hs +++ b/src/Data/Greskell/Graph/PropertyMap.hs @@ -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,48 +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 qualified Data.Aeson.KeyMap as KM -import qualified Data.Aeson.Key as Key -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) @@ -74,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 @@ -84,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] @@ -98,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. @@ -110,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 @@ -148,7 +152,7 @@ -> Parser (m p v) parsePropertiesGeneric normalizeCardinality gv = case gValueBody gv of GObject obj -> foldlM folder mempty $ KM.toList obj - _ -> empty + _ -> empty where folder pm (k, value) = fmap (foldr putProperty pm) $ traverse (parseProperty k) =<< normalizeCardinality value parseProperty k value = parseTypedGValue value <|> parseGraphSONWithKey (Key.toText k) value @@ -166,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. -- @@ -175,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 @@ -205,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 diff --git a/src/Data/Greskell/Gremlin.hs b/src/Data/Greskell/Gremlin.hs --- a/src/Data/Greskell/Gremlin.hs +++ b/src/Data/Greskell/Gremlin.hs @@ -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,42 @@ -- 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 + , 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 +66,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 +100,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 +128,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 +140,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 +163,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 @@ -194,9 +180,6 @@ gsonTypeFor _ = "g:Order" -- | @decr@ order. --- --- >>> toGremlin oDecr --- "Order.decr" oDecr :: Greskell (Order a) oDecr = unsafeGreskellLazy "Order.decr" @@ -207,3 +190,14 @@ -- | @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 oDecr, "Order.decr") + ] diff --git a/src/Data/Greskell/Logic.hs b/src/Data/Greskell/Logic.hs --- a/src/Data/Greskell/Logic.hs +++ b/src/Data/Greskell/Logic.hs @@ -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 diff --git a/src/Data/Greskell/NonEmptyLike.hs b/src/Data/Greskell/NonEmptyLike.hs --- a/src/Data/Greskell/NonEmptyLike.hs +++ b/src/Data/Greskell/NonEmptyLike.hs @@ -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 diff --git a/src/Data/Greskell/PMap.hs b/src/Data/Greskell/PMap.hs --- a/src/Data/Greskell/PMap.hs +++ b/src/Data/Greskell/PMap.hs @@ -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 -- -- 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 diff --git a/test/Data/Greskell/BinderSpec.hs b/test/Data/Greskell/BinderSpec.hs --- a/test/Data/Greskell/BinderSpec.hs +++ b/test/Data/Greskell/BinderSpec.hs @@ -1,16 +1,19 @@ -module Data.Greskell.BinderSpec (main,spec) where +module Data.Greskell.BinderSpec + ( main + , spec + ) where -import Control.Applicative ((<$>), (<*>)) -import Control.Monad (forM_) -import Data.Aeson (toJSON) -import qualified Data.Aeson.KeyMap as KM -import qualified Data.Aeson.Key as Key -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 (unpack) +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 diff --git a/test/Data/Greskell/ExtraSpec.hs b/test/Data/Greskell/ExtraSpec.hs --- a/test/Data/Greskell/ExtraSpec.hs +++ b/test/Data/Greskell/ExtraSpec.hs @@ -1,17 +1,20 @@ {-# LANGUAGE OverloadedStrings #-} -module Data.Greskell.ExtraSpec (main,spec) where +module Data.Greskell.ExtraSpec + ( main + , spec + ) where -import qualified Data.Aeson.KeyMap as KM -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 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 diff --git a/test/Data/Greskell/GTraversalSpec.hs b/test/Data/Greskell/GTraversalSpec.hs --- a/test/Data/Greskell/GTraversalSpec.hs +++ b/test/Data/Greskell/GTraversalSpec.hs @@ -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\"))" - diff --git a/test/Data/Greskell/Graph/PropertyMapSpec.hs b/test/Data/Greskell/Graph/PropertyMapSpec.hs --- a/test/Data/Greskell/Graph/PropertyMapSpec.hs +++ b/test/Data/Greskell/Graph/PropertyMapSpec.hs @@ -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 diff --git a/test/Data/Greskell/GraphSpec.hs b/test/Data/Greskell/GraphSpec.hs --- a/test/Data/Greskell/GraphSpec.hs +++ b/test/Data/Greskell/GraphSpec.hs @@ -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 diff --git a/test/Data/Greskell/GremlinSpec.hs b/test/Data/Greskell/GremlinSpec.hs --- a/test/Data/Greskell/GremlinSpec.hs +++ b/test/Data/Greskell/GremlinSpec.hs @@ -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 diff --git a/test/Data/Greskell/LogicSpec.hs b/test/Data/Greskell/LogicSpec.hs --- a/test/Data/Greskell/LogicSpec.hs +++ b/test/Data/Greskell/LogicSpec.hs @@ -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 diff --git a/test/Data/Greskell/PMapSpec.hs b/test/Data/Greskell/PMapSpec.hs --- a/test/Data/Greskell/PMapSpec.hs +++ b/test/Data/Greskell/PMapSpec.hs @@ -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) ] - + diff --git a/test/DocTest.hs b/test/DocTest.hs deleted file mode 100644 --- a/test/DocTest.hs +++ /dev/null @@ -1,1 +0,0 @@ -{-# OPTIONS_GHC -F -pgmF doctest-discover #-} diff --git a/test/ExamplesSpec.hs b/test/ExamplesSpec.hs new file mode 100644 --- /dev/null +++ b/test/ExamplesSpec.hs @@ -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 diff --git a/test/ServerBehaviorTest.hs b/test/ServerBehaviorTest.hs --- a/test/ServerBehaviorTest.hs +++ b/test/ServerBehaviorTest.hs @@ -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 diff --git a/test/ServerTest.hs b/test/ServerTest.hs --- a/test/ServerTest.hs +++ b/test/ServerTest.hs @@ -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 (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, oDecr, + oIncr, 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 @@ -205,7 +194,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\"); " diff --git a/test/ServerTest/Common.hs b/test/ServerTest/Common.hs --- a/test/ServerTest/Common.hs +++ b/test/ServerTest/Common.hs @@ -1,18 +1,18 @@ -- | -- Module: ServerTest.Common --- Description: +-- Description: -- Maintainer: Toshio Ito -- --- +-- 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 diff --git a/test/Typecheck.hs b/test/Typecheck.hs --- a/test/Typecheck.hs +++ b/test/Typecheck.hs @@ -1,14 +1,15 @@ {-# OPTIONS_GHC -fdefer-type-errors -Wno-deferred-type-errors #-} -module Main (main,spec) where +module Main + ( main + , spec + ) where -import Data.Proxy (Proxy(..)) -import Test.Hspec -import Test.ShouldNotTypecheck (shouldNotTypecheck) +import Data.Proxy (Proxy (..)) +import Test.Hspec +import Test.ShouldNotTypecheck (shouldNotTypecheck) -import Data.Greskell.GTraversal - ( Walk, WalkType, Filter, Transform, SideEffect, Split, - showSplit, showWalkType, showLift - ) +import Data.Greskell.GTraversal (Filter, SideEffect, Split, Transform, Walk, WalkType, + showLift, showSplit, showWalkType) main :: IO () main = hspec spec @@ -44,7 +45,7 @@ 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