greskell 1.1.0.3 → 1.2.0.0

raw patch · 11 files changed

+678/−55 lines, 11 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +55/−15
• greskell.cabal +5/−3
• src/Data/Greskell.hs +1/−0
• src/Data/Greskell/AsLabel.hs +20/−1
• src/Data/Greskell/GTraversal.hs +169/−2
• src/Data/Greskell/Gremlin.hs +38/−21
• src/Data/Greskell/Logic.hs +102/−0
• test/Data/Greskell/GTraversalSpec.hs +100/−2
• test/Data/Greskell/GremlinSpec.hs +4/−2
• test/Data/Greskell/LogicSpec.hs +86/−0
• test/ServerTest.hs +98/−9

@@ -1,5 +1,45 @@ # Revision history for greskell +## 1.2.0.0  -- 2020-12/29++* Add `Logic` module.++### Gremlin module++* Add `PLike` class.+* **BREAKING CHANGE** Generalize signatures of the following functions+  using `PLike`. You may encounter compile errors if the compiler+  fails to infer the type.+  * `pEq`+  * `pNeq`+  * `pLt`+  * `pLte`+  * `pGt`+  * `pGte`+  * `pInside`+  * `pOutside`+  * `pBetween`+  * `pWithin`+  * `pWithout`+++### GTraversal module++* Add the following functions. (Fix for #10)+  * `gWhereP1`+  * `gWhereP1'`+  * `gWhereP2`+  * `gWhereP2'`+  * `gMatch`+  * `mPattern`+* Add the following types.+  * `MatchPattern`+  * `MatchResult`++### Gremlin module++* Add `LabeledP` type.+ ## 1.1.0.3  -- 2020-06-21  * Confirm test with `base-4.14.0.0`.@@ -16,7 +56,7 @@  ### GTraversal module -* [BREAKING CHANGE] `gFlatMap` is now polymorphic about the+* **BREAKING CHANGE** `gFlatMap` is now polymorphic about the   WalkTypes. Use `gFlatMap'`For monomorphic version. * Add the following functions.   * `gFlatMap'`@@ -96,12 +136,12 @@  ### Graph module - Element class and ElementID -* [BREAKING CHANGE] Now `ElementID` is a newtype for `GValue`. It was+* **BREAKING CHANGE** Now `ElementID` is a newtype for `GValue`. It was   an associated type family in `Element` class. However, I think there   was no point to make it polymorphic.-* [BREAKING CHANGE] Remove `EdgeVertexID` type family from `Edge` class.-* [BREAKING CHANGE] Add `ElementData` class, and set it as a super class of `Element`.-* [BREAKING CHANGE] Type of the ID field for `AVertex`, `AEdge` and+* **BREAKING CHANGE** Remove `EdgeVertexID` type family from `Edge` class.+* **BREAKING CHANGE** Add `ElementData` class, and set it as a super class of `Element`.+* **BREAKING CHANGE** Type of the ID field for `AVertex`, `AEdge` and   `AVertexProperty` is now `ElementID`, not `GValue`. * Add `unsafeCastElementID` function. * Add `ElementPropertyContainer` type family to `Element` class. It's@@ -114,27 +154,27 @@ because some graph implementation of TinkerPop don't return properties when it returns graph elements. See #6. -* [BREAKING CHANGE] Remove `avProperties` field from `AVertex`.-* [BREAKING CHANGE] Remove `aeInVLabel`, `aeOutVLabel`, `aeInV`,+* **BREAKING CHANGE** Remove `avProperties` field from `AVertex`.+* **BREAKING CHANGE** Remove `aeInVLabel`, `aeOutVLabel`, `aeInV`,   `aeOutV` and `aeProperties` fields from `AEdge`.-* [BREAKING CHANGE] Remove `avpProperties` field from `AVertexProperty`.-* [BREAKING CHANGE] Move `PropertyMap` class, `FromGraphSONWithKey`+* **BREAKING CHANGE** Remove `avpProperties` field from `AVertexProperty`.+* **BREAKING CHANGE** Move `PropertyMap` class, `FromGraphSONWithKey`   class, `PropertyMapSingle` type, `PropertyMapList` types and related   functions to `Graph.PropertyMap` module. They are now all   deprecated. Use `PMap` module instead.  ### Graph module - Key for element property -* [BREAKING CHANGE] Internal of `Key` is modified from `Greskell Text`+* **BREAKING CHANGE** Internal of `Key` is modified from `Greskell Text`   to `Text`, so that it can be an instance of `PMapKey` class.-* [BREAKING CHANGE] Add `KeyNoValue` data constructor for `KeyValue`+* **BREAKING CHANGE** Add `KeyNoValue` data constructor for `KeyValue`   type. * Add `unsafeCastKey` function. * Add `Keys` type and related functions.  ### GTraversal module -* [BREAKING CHANGE] Change the signature of the following functions+* **BREAKING CHANGE** Change the signature of the following functions   because now `ElementID` is a newtype, not a type alias.     * `sV'`     * `gV'`@@ -145,7 +185,7 @@  ### Extra module -* [BREAKING CHANGE] Remove `writeAllProperties` because `PropertyMap`+* **BREAKING CHANGE** Remove `writeAllProperties` because `PropertyMap`   is deprecated. * Add `writeKeyValues` function. * Add `writePMapProperties` function.@@ -155,11 +195,11 @@ ### AsLabel module  * Now `SelectedMap` is a specialized type alias for `PMap`.-* [BREAKING CHANGE] `lookup`, `lookupM`, `lookupAs` and `lookupAsM`+* **BREAKING CHANGE** `lookup`, `lookupM`, `lookupAs` and `lookupAsM`   are now re-exports from `PMap` module, whose signature is more   polymorphic than the original ones and have a different exception   type.-* [BREAKING CHANGE] `AsLookupException` is removed. Use+* **BREAKING CHANGE** `AsLookupException` is removed. Use   `PMapLookupException` instead. * Make `AsLabel` an instance of `PMapKey`. * Add `IsString` instance to `AsLabel`.

@@ -1,5 +1,5 @@ name:                   greskell-version:                1.1.0.3+version:                1.2.0.0 author:                 Toshio Ito <debug.ito@gmail.com> maintainer:             Toshio Ito <debug.ito@gmail.com> license:                BSD3@@ -36,7 +36,8 @@                         Data.Greskell.AsLabel,                         Data.Greskell.Extra,                         Data.Greskell.PMap,-                        Data.Greskell.NonEmptyLike+                        Data.Greskell.NonEmptyLike,+                        Data.Greskell.Logic   -- other-modules:           build-depends:        base >=4.9.0.0 && <4.15,                         greskell-core >=0.1.3.0 && <0.2,@@ -63,7 +64,8 @@                         Data.Greskell.GraphSpec,                         Data.Greskell.Graph.PropertyMapSpec,                         Data.Greskell.ExtraSpec,-                        Data.Greskell.PMapSpec+                        Data.Greskell.PMapSpec,+                        Data.Greskell.LogicSpec   build-depends:        base, text, aeson,  unordered-containers,                         greskell, greskell-core,                         hspec >=2.2.3,

@@ -12,6 +12,7 @@ -- - "Data.Greskell.Extra": extra utility functions. -- - "Data.Greskell.NonEmptyLike": NonEmptyLike class, which is a --   class of non-empty containers.+-- - "Data.Greskell.Logic": Logic type, which is a general-purpose logic tree data structure. -- - "Data.Greskell.Graph.PropertyMap": deprecated PropertyMap class. module Data.Greskell        (

@@ -15,7 +15,9 @@          lookupM,          lookupAs,          lookupAsM,-         PMapLookupException(..)+         PMapLookupException(..),+         -- * LabeledP+         LabeledP        ) where  import Prelude hiding (lookup)@@ -33,6 +35,7 @@ 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(..)@@ -70,3 +73,19 @@ -- @since 1.1.0.0 unsafeCastAsLabel :: AsLabel a -> AsLabel b unsafeCastAsLabel = AsLabel . unAsLabel+++-- | 'LabeledP' is just like 'P', a Haskell representation of+-- TinkerPop's @P@ class. Unlike 'P', however, 'LabeledP' keeps a+-- label ('AsLabel') inside. It is used in @.where@ step.+--+-- @since 1.2.0.0+data LabeledP a++-- Design note: neo4j-gremlin has `LabelP` class, which has nothing to+-- do with the 'LabeledP' type above.+++-- | You can construct @Greskell (LabeledP a)@ from @AsLabel a@.+instance PLike (LabeledP a) where+  type PParameter (LabeledP a) = AsLabel a

@@ -95,6 +95,11 @@          gAnd,          gOr,          gNot,+         -- ** Where step+         gWhereP1,+         gWhereP1',+         gWhereP2,+         gWhereP2',          -- ** Sorting steps          gOrder,          -- ** Paging steps@@ -163,6 +168,11 @@          gInE',          gInV,          gInV',+         -- ** Match step+         gMatch,+         MatchPattern(..),+         mPattern,+         MatchResult,          -- ** Side-effect steps          gSideEffect,          gSideEffect',@@ -225,7 +235,9 @@     toGremlinLazy, toGremlin   ) import Data.Greskell.AsIterator (AsIterator(IteratorItem))-import Data.Greskell.AsLabel (AsLabel, SelectedMap)+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@@ -630,6 +642,161 @@ 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)@@ -1411,7 +1578,7 @@ unsafeChangeEnd :: Walk c a b -> Walk c a b' unsafeChangeEnd (Walk t) = Walk t -byStep :: ByProjection a b -> Walk Transform c c+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.

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, TypeFamilies #-}+{-# LANGUAGE OverloadedStrings, TypeFamilies, FlexibleContexts #-} -- | -- Module: Data.Greskell.Gremlin -- Description: Gremlin (Groovy/Java) utility classes@@ -12,6 +12,7 @@          PredicateA(..),          -- ** P class          P,+         PLike(..),          pNot,          pEq,          pNeq,@@ -39,12 +40,14 @@ import Data.Greskell.GraphSON (GraphSONTyped(..)) import Data.Greskell.Greskell   ( Greskell, unsafeGreskellLazy,-    toGremlin, toGremlinLazy, unsafeMethodCall, unsafeFunCall+    toGremlin, toGremlinLazy, unsafeMethodCall, unsafeFunCall,+    ToGreskell   )  -- $setup -- -- >>> :set -XOverloadedStrings+-- >>> import Data.Text (Text) -- >>> import Data.Greskell.Greskell (number, string)  -- | @java.util.function.Predicate@ interface.@@ -84,65 +87,79 @@ instance GraphSONTyped (P a) where   gsonTypeFor _ = "g:P" +-- | Type that is compatible with 'P'. You can construct a value of+-- type @Greskell p@ using values of @PParameter p@.+--+-- Note that the type of constuctor arguments (i.e. @GreskellReturn (PParameter p)@)+-- should implement Java's @Comparable@ interface. This is true for most types,+-- so greskell doesn't have any explicit constraint about it.+--+-- @since 1.2.0.0+class (ToGreskell (PParameter p)) => PLike p where+  type PParameter p +-- | You can construct @Greskell (P a)@ from @Greskell a@.+instance PLike (P a) where+  type PParameter (P a) = Greskell a+ -- | @P.not@ static method. ----- >>> toGremlin $ pNot $ pEq $ number 10--- "P.not(P.eq(10.0))"-pNot :: Greskell (P a) -> Greskell (P a)+-- >>> 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"+-- >>> toGremlin (pEq $ string "hoge" :: Greskell (P Text)) -- "P.eq(\"hoge\")"-pEq :: Greskell a -> Greskell (P a)+pEq :: PLike p => PParameter p -> Greskell p pEq arg = unsafeFunCall "P.eq" [toGremlin arg]  -- | @P.neq@ static method.-pNeq :: Greskell a -> Greskell (P a)+pNeq :: PLike p => PParameter p -> Greskell p pNeq arg = unsafeFunCall "P.neq" [toGremlin arg]  -- | @P.lt@ static method.-pLt :: Greskell a -> Greskell (P a)+pLt :: PLike p => PParameter p -> Greskell p pLt arg = unsafeFunCall "P.lt" [toGremlin arg]  -- | @P.lte@ static method.-pLte :: Greskell a -> Greskell (P a)+pLte :: PLike p => PParameter p -> Greskell p pLte arg = unsafeFunCall "P.lte" [toGremlin arg]  -- | @P.gt@ static method.-pGt :: Greskell a -> Greskell (P a)+pGt :: PLike p => PParameter p -> Greskell p pGt arg = unsafeFunCall "P.gt" [toGremlin arg]  -- | @P.gte@ static method.-pGte :: Greskell a -> Greskell (P a)+pGte :: PLike p => PParameter p -> Greskell p pGte arg = unsafeFunCall "P.gte" [toGremlin arg]  -- | @P.inside@ static method. ----- >>> toGremlin $ pInside (number 10) (number 20)--- "P.inside(10.0,20.0)"-pInside :: Greskell a -> Greskell a -> Greskell (P a)+-- >>> 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]  -- | @P.outside@ static method.-pOutside :: Greskell a -> Greskell a -> Greskell (P a)+pOutside :: PLike p => PParameter p -> PParameter p -> Greskell p pOutside a b = unsafeFunCall "P.outside" $ map toGremlin [a, b]  -- | @P.between@ static method.-pBetween :: Greskell a -> Greskell a -> Greskell (P a)+pBetween :: PLike p => PParameter p -> PParameter p -> Greskell p pBetween a b = unsafeFunCall "P.between" $ map toGremlin [a, b]  -- | @P.within@ static method. ----- >>> toGremlin $ pWithin (["foo", "bar", "hoge"] :: [Greskell String])+-- >>> toGremlin (pWithin ["foo", "bar", "hoge"] :: Greskell (P Text)) -- "P.within(\"foo\",\"bar\",\"hoge\")"-pWithin :: [Greskell a] -> Greskell (P a)+pWithin :: PLike p => [PParameter p] -> Greskell p pWithin = unsafeFunCall "P.within" . map toGremlin  -- | @P.without@ static method.-pWithout :: [Greskell a] -> Greskell (P a)+pWithout :: PLike p => [PParameter p] -> Greskell p pWithout = unsafeFunCall "P.without" . map toGremlin  -- | @java.util.Comparator@ interface.@@ -153,7 +170,7 @@   -- | @.compare@ method.   cCompare :: Greskell c -> Greskell (CompareArg c) -> Greskell (CompareArg c) -> Greskell Int   cCompare cmp a b = unsafeMethodCall cmp "compare" $ map toGremlin [a, b]-  -- | @.reverse@ method.+  -- | @.reversed@ method.   cReversed :: Greskell c -> Greskell c   cReversed cmp = unsafeMethodCall cmp "reversed" []   -- | @.thenComparing@ method.

@@ -0,0 +1,102 @@+{-# LANGUAGE DeriveGeneric #-}+-- |+-- Module: Data.Greskell.Logic+-- Description: Logic tree data structure+-- Maintainer: Toshio Ito <debug.ito@gmail.com>+--+-- Developer note: This module defines 'Logic', a data structure for+-- logic operation tree. There are already similar packages to this+-- module, but, none of them satisfy our requirements.+--+-- Boolean/logic tree data structures+--+-- - https://hackage.haskell.org/package/boolean-normal-forms+-- - https://hackage.haskell.org/package/logic-classes+-- - https://hackage.haskell.org/package/PropLogic+-- - https://hackage.haskell.org/package/Logic+-- - https://hackage.haskell.org/package/boolean-like+--+-- Typeclasses about boolean/logic operations+--+-- - https://hackage.haskell.org/package/Boolean+-- - https://hackage.haskell.org/package/cond+--+-- Trees that contain heterogeneous values+--+-- - http://hackage.haskell.org/package/dual-tree+-- - http://hackage.haskell.org/package/fingertree+--+-- @since 1.2.0.0 +module Data.Greskell.Logic+  ( 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)++-- | 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+  | And (Logic a) [Logic a] -- ^ \"and\" logic operator+  | Or  (Logic a) [Logic a] -- ^ \"or\" logic operator+  | Not (Logic a) -- ^ \"not\" logic operator+  deriving (Show,Eq,Ord,Generic)++instance Functor Logic where+  fmap f l =+    case l of+      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)++-- | 'pure' is 'Leaf'. @fl@ '<*>' @rl@ appends the @rl@ to the leaves+-- of @fl@.+instance Applicative Logic where+  pure a = Leaf a+  fl <*> rl =+    case fl of+      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)++instance Monad Logic where+  return = pure+  l >>= f =+    case l of+      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)++instance Foldable Logic where+  foldMap f l =+    case l of+      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++instance Traversable Logic where+  traverse f l =+    case l of+      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++-- | Run the logic tree of 'Bool' values to get the result.+runBool :: Logic Bool -> Bool+runBool l =+  case l of+    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

@@ -9,6 +9,7 @@  import Test.Hspec +import Data.Greskell.AsLabel (AsLabel) import Data.Greskell.Gremlin   ( oIncr, oDecr, oShuffle,     pEq, pNeq, pInside, pGte@@ -24,15 +25,18 @@ import Data.Greskell.GTraversal   ( Walk, Transform, Filter,     source, (&.), ($.), sV', sE',-    gHas1, gHas2, gHas2P, gHasLabelP, gHasIdP, gIs,+    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+    gLoops,+    gWhereP1, gAs, gLabel, gWhereP2,+    gMatch, mPattern   )+import Data.Greskell.Logic (Logic(..))   main :: IO ()@@ -45,6 +49,8 @@   spec_compose_steps   spec_has   spec_repeat+  spec_where+  spec_match   spec_GraphTraversalSource :: Spec@@ -164,3 +170,95 @@       let loop_label = "LP"       toGremlin (source "g" & sV' [] &. gRepeat (Just loop_label) (gUntilTail $ gLoops (Just loop_label) >>> gIs 5) Nothing (gOut' []))         `shouldBe` "g.V().repeat(\"LP\",__.out()).until(__.loops(\"LP\").is(5))"++spec_where :: Spec+spec_where = do+  describe "gWhereP1" $ do+    specify "no modulation" $ do+      let la :: AsLabel AVertex+          la = "a"+      toGremlin (source "g" & sV' [] &. gAs la &. gOut' [] &. gWhereP1 (pEq la) Nothing)+        `shouldBe` "g.V().as(\"a\").out().where(P.eq(\"a\"))"+    specify "with modulation (by traversal)" $ do+      let la :: AsLabel AVertex+          la = "a"+      toGremlin (source "g" & sV' [] &. gAs la &. gOut' [] &. gWhereP1 (pGte la) (Just $ gBy gLabel))+        `shouldBe` "g.V().as(\"a\").out().where(P.gte(\"a\")).by(__.label())"+  describe "gWhereP2" $ do+    specify "no modulation" $ do+      let la = ("a" :: AsLabel AVertex)+          lb = ("b" :: AsLabel AVertex)+          age = ("age" :: Key AVertex Int)+      toGremlin (source "g" & sV' [] &. gAs la &. gOut' [] &. gAs lb &. gValues [age] &. gWhereP2 la (pEq lb) Nothing)+        `shouldBe` "g.V().as(\"a\").out().as(\"b\").values(\"age\").where(\"a\",P.eq(\"b\"))"+    specify "with modulation" $ do+      let la = ("a" :: AsLabel AVertex)+          lb = ("b" :: AsLabel AVertex)+          age = ("age" :: Key AVertex Int)+          name = ("name" :: Key AVertex Text)+      toGremlin (source "g" & sV' [] &. gAs la &. gOut' [] &. gAs lb &. gValues [name] &. gWhereP2 la (pGte lb) (Just $ gBy age))+        `shouldBe` "g.V().as(\"a\").out().as(\"b\").values(\"name\").where(\"a\",P.gte(\"b\")).by(\"age\")"++spec_match :: Spec+spec_match = do+  describe "gMatch" $ do+    specify "top-level Leaf" $ do+      let pat = mPattern label (gOut' [])+          label = ("a" :: AsLabel AVertex)+      toGremlin (source "g" & sV' [] &. gMatch pat)+        `shouldBe` "g.V().match(__.as(\"a\").out())"+    specify "top-level And" $ do+      let pat = And+                ( mPattern label_a (gOut' [] >>> gAs label_b) )+                [ mPattern label_a (gHas2' the_key "foobar")+                ]+          label_a = ("a" :: AsLabel AVertex)+          label_b = "b"+          the_key = ("k" :: Key AVertex Text)+      toGremlin (source "g" & sV' [] &. gMatch pat)+        `shouldBe` "g.V().match(__.as(\"a\").out().as(\"b\"),__.as(\"a\").has(\"k\",\"foobar\"))"+    specify "top-level Or" $ do+      let pat = Or+                ( mPattern label (gHas2' key1 "foobar") )+                [ mPattern label (gHas2' key2 100)+                ]+          label = ("a" :: AsLabel AVertex)+          key1 = ("k1" :: Key AVertex Text)+          key2 = ("k2" :: Key AVertex Int)+      toGremlin (source "g" & sV' [] &. gMatch pat)+        `shouldBe` "g.V().match(__.or(__.as(\"a\").has(\"k1\",\"foobar\"),__.as(\"a\").has(\"k2\",100)))"+    specify "top-level Not" $ do+      let pat = Not ( mPattern label (gHas2' k "quux") )+          label = ("a" :: AsLabel AVertex)+          k = ("k" :: Key AVertex Text)+      toGremlin (source "g" & sV' [] &. gMatch pat)+        `shouldBe` "g.V().match(__.not(__.as(\"a\").has(\"k\",\"quux\")))"+    specify "heterogeneous patterns, nested And" $ do+      let pat = Or+                ( And+                  ( mPattern label_a (gOut' [] >>> gAs label_b) )+                  [ mPattern label_b (gValues [key_age] >>> gAs label_c),+                    mPattern label_c (gIs' 30)+                  ]+                )+                [ And+                  ( mPattern label_a (gValues [key_age] >>> gAs label_c) )+                  [ mPattern label_a (gValues [key_name] >>> gAs label_d),+                    Not ( mPattern label_d (gIs' "toshio") )+                  ]+                ]+          label_a = ("a" :: AsLabel AVertex)+          label_b = "b"+          label_c = "c"+          label_d = "d"+          key_age = ("age" :: Key AVertex Int)+          key_name = ("name" :: Key AVertex Text)+      toGremlin (source "g" & sV' [] &. gMatch pat)+        `shouldBe` "g.V().match(__.or(__.and(__.as(\"a\").out().as(\"b\"),__.as(\"b\").values(\"age\").as(\"c\"),__.as(\"c\").is(30)),__.and(__.as(\"a\").values(\"age\").as(\"c\"),__.as(\"a\").values(\"name\").as(\"d\"),__.not(__.as(\"d\").is(\"toshio\")))))"+    specify "history labels in pattern" $ do+      let pat = mPattern ext_label (gIn' [] >>> gHas2 the_key "foo")+          ext_label = "e"+          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\"))"+        

@@ -4,7 +4,7 @@ import Test.Hspec  import Data.Greskell.Gremlin-  ( pBetween, pAnd, pOr, pNegate, pWithin, pGte, pTest+  ( pBetween, pAnd, pOr, pNegate, pWithin, pGte, pTest, P   ) import Data.Greskell.Greskell (toGremlin, Greskell) @@ -15,6 +15,8 @@ spec = do   describe "P and Predicate" $ do     specify "P and Predicate methods" $ do-      let expr = (pBetween (10 :: Greskell Int) 50 `pAnd` ((pNegate (pWithin [5, 15, 25, 35])) `pOr` pGte 20)) `pTest` 50+      let pr :: Greskell (P Int)+          pr = pBetween 10 50 `pAnd` ((pNegate (pWithin [5, 15, 25, 35])) `pOr` pGte 20)+          expr = pr `pTest` 50       toGremlin expr `shouldBe`         "((P.between(10,50)).and(((P.within(5,15,25,35)).negate()).or(P.gte(20)))).test(50)"

@@ -0,0 +1,86 @@+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 Data.Greskell.Logic (Logic(..), runBool)++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  let tree_int :: Logic Int+      tree_int =+        ( And+          ( Or (Leaf 10) [Leaf 20, Not (Leaf 30)])+          [ Leaf 40,+            Not+            ( Or (Leaf 50) [And (Or (Leaf 60) []) [], Not (Leaf 70)]+            )+          ]+        )+  describe "Functor" $ do+    specify "fmap on tree" $ do+      fmap (\n -> 30 <= n && n <= 60) tree_int+        `shouldBe`+        ( And+          ( Or (Leaf False) [Leaf False, Not (Leaf True)])+          [ Leaf True,+            Not+            ( Or (Leaf True) [And (Or (Leaf True) []) [], Not (Leaf False)]+            )+          ]+        )+  describe "Applicative" $ do+    specify "<*> should append the right tree to the left tree" $ do+      let tree_right :: Logic Int+          tree_right = And (Leaf 5) [Leaf 3, Or (Leaf 2) [Leaf 4]]+          plusRight n = fmap (+ n) tree_right+      ((+) <$> tree_int <*> tree_right)+        `shouldBe`+        ( And+          ( Or (plusRight 10) [plusRight 20, Not (plusRight 30)])+          [ plusRight 40,+            Not+            ( Or (plusRight 50) [And (Or (plusRight 60) []) [], Not (plusRight 70)]+            )+          ]+        )+  describe "Foldable" $ do+    specify "toList should preserve the look of the structure" $ do+      toList tree_int+        `shouldBe`+        [10, 20, 30, 40, 50, 60, 70]+  describe "Traversable" $ do+    specify "traverse should preserve the structure" $ do+      traverse Just tree_int+        `shouldBe`+        Just tree_int+    specify "traverse should run the action of the applicative" $ do+      traverse (\n -> if n == 20 then Nothing else Just n) tree_int `shouldBe` Nothing+  describe "runBool" $ do+    specify "Leaf" $ do+      runBool (Leaf True) `shouldBe` True+      runBool (Leaf False) `shouldBe` False+    specify "Not" $ do+      runBool (Not $ Leaf True) `shouldBe` False+      runBool (Not $ Leaf False) `shouldBe` True+    describe "And" $ do+      forM_ [True, False] $ \b1 -> do+        specify ("single " <> show b1) $ do+          runBool (And (Leaf b1) []) `shouldBe` b1+        forM_ [True, False] $ \b2 -> do+          specify ("double " <> show (b1, b2)) $ do+            runBool (And (Leaf b1) [Leaf b2]) `shouldBe` b1 && b2+    describe "Or" $ do+      forM_ [True, False] $ \b1 -> do+        specify ("single " <> show b1) $ do+          runBool (Or (Leaf b1) []) `shouldBe` b1+        forM_ [True, False] $ \b2 -> do+          specify ("double " <> show (b1, b2)) $ do+            runBool (Or (Leaf b1) [Leaf b2]) `shouldBe` b1 || b2

@@ -11,11 +11,12 @@ import Data.Monoid (mempty, (<>)) import Data.Scientific (Scientific) import Data.Text (unpack, Text)+import Data.Traversable (traverse) import qualified Data.Vector as V import qualified Network.Greskell.WebSocket.Client as WS import Test.Hspec -import Data.Greskell.AsLabel (AsLabel(..))+import Data.Greskell.AsLabel (AsLabel(..), lookupAsM) import qualified Data.Greskell.AsLabel as As import Data.Greskell.AsIterator   ( AsIterator(IteratorItem)@@ -25,7 +26,7 @@ import Data.Greskell.GMap (GMapEntry, unGMapEntry) import Data.Greskell.Gremlin   ( oIncr, oDecr, cCompare, Order,-    Predicate(..), pLt, pAnd, pGte, pNot, pEq, pTest+    Predicate(..), pLt, pAnd, pGte, pNot, pEq, pTest, P   ) import Data.Greskell.Greskell   ( toGremlin, Greskell, toGreskell, ToGreskell(..),@@ -53,10 +54,13 @@     gFilter, gOut', gOutV, gOutV', gInV, gInV', gId, gLabel, gProject,     gValueMap,     gProject, gByL,-    gRepeat, gTimes, gEmitHead, gUntilTail, gLoops, gIsP,+    gRepeat, gTimes, gEmitHead, gUntilTail, gLoops, gIsP, gIsP',     gHasLabel, gHas2, gAddV, gIterate,-    gPath, gPathBy+    gPath, gPathBy,+    gWhereP1, gChoose3, gIdentity, gWhereP2,+    gMatch, mPattern   )+import Data.Greskell.Logic (Logic(..)) import Data.Greskell.PMap (lookupAsM, lookupListAs, pMapToThrow)  import ServerTest.Common (withEnv, withClient)@@ -78,6 +82,8 @@   spec_repeat   spec_upsert   spec_path+  spec_where+  spec_match  spec_basics :: SpecWith (String,Int) spec_basics = do@@ -176,10 +182,13 @@  spec_predicate :: SpecWith (String,Int) spec_predicate = do-  checkOne (pTest (pLt 20 `pAnd` pGte 10) (5 :: Greskell Int)) False-  checkOne (pTest (pLt 20 `pAnd` pGte 10) (10 :: Greskell Int)) True-  checkOne (pTest (pLt 20 `pAnd` pGte 10) (15 :: Greskell Int)) True-  checkOne (pTest (pLt 20 `pAnd` pGte 10) (20 :: Greskell Int)) False+  checkOne (pTest the_p 5)  False+  checkOne (pTest the_p 10) True+  checkOne (pTest the_p 15) True+  checkOne (pTest the_p 20) False+  where+    the_p :: Greskell (P Int)+    the_p = pLt 20 `pAnd` pGte 10  iterateTraversal :: GTraversal c s e -> Greskell () iterateTraversal gt = unsafeMethodCall (toGreskell gt) "iterate" []@@ -216,7 +225,8 @@  spec_P :: SpecWith (String,Int) spec_P = describe "P class" $ specify "pNot, pEq, pTest" $ withClient $ \client -> do-  let p = pNot $ pEq $ number 10+  let p :: Greskell (P Scientific)+      p = pNot $ pEq $ number 10       test v = WS.slurpResults =<< WS.submit client (pTest p $ v) Nothing   test (number 10) `shouldReturn` V.fromList [False]   test (number 15) `shouldReturn` V.fromList [True]@@ -375,6 +385,24 @@ multiplyWalk :: Greskell Int -> Walk Transform Int Int multiplyWalk factor = unsafeWalk "map" ["{ it.get() * " <> toGremlin factor <> " }"] +plusWalk :: Greskell Int -> Walk Transform Int Int+plusWalk n = unsafeWalk "map" ["{ it.get() + " <> toGremlin n <> " }"]++squareWalk :: Walk Transform Int Int+squareWalk = unsafeWalk "map" ["{ it.get() * it.get() }"]++appendWalk :: Greskell Text -> Walk Transform Text Text+appendWalk t = unsafeWalk "map" ["{ it.get() + " <> toGremlin t <> " }"]++-- toLowerWalk :: Walk Transform Text Text+-- toLowerWalk = unsafeWalk "map" ["{ it.get().toLowerCase() }"]++lengthWalk :: Walk Transform Text Int+lengthWalk = unsafeWalk "map" ["{ it.get().length() }"]++substrWalk :: Greskell Int -> Greskell Int -> Walk Transform Text Text+substrWalk s e = unsafeWalk "map" ["{ it.get().substring(" <> toGremlin s <> ", " <> toGremlin e <> ") }"]+ spec_as :: SpecWith (String,Int) spec_as = do   let start :: GTraversal Transform () Int@@ -585,3 +613,64 @@                      ]                    ]     got `shouldBe` expected++spec_where :: SpecWith (String,Int)+spec_where = do+  let start :: GTraversal Transform () Int+      start = unsafeGTraversal "__(1,2,3)"+  specify "gWhereP1 (without modulation)" $ withClient $ \client -> do+    let g = gWhereP1 (pEq label_s) Nothing $. squareWalk $. gAs label_s $. start+        label_s = "s"+    got <- fmap V.toList $ WS.slurpResults =<< WS.submit client g Nothing+    got `shouldBe` [1]+  specify "gWhereP1 (with modulation)" $ withClient $ \client -> do+    let g = gWhereP1 (pEq label_s) (Just $ gBy $ mapper) $. multiplyWalk 5 $. gAs label_s $. start+        label_s = "s"+        mapper = gChoose3 (gIsP' $ pGte 12)+                 (plusWalk (-12))+                 gIdentity+    got <- fmap V.toList $ WS.slurpResults =<< WS.submit client g Nothing+    got `shouldBe` [15]+  specify "gWhereP2 (without modulation)" $ withClient $ \client -> do+    let g = gWhereP2 label_s (pEq label_m) Nothing $. plusWalk 10 $. gAs label_m $. squareWalk $. gAs label_s $. start+        label_s = "s"+        label_m = "m"+    got <- fmap V.toList $ WS.slurpResults =<< WS.submit client g Nothing+    got `shouldBe` [11]+  specify "gWhereP2 (with modulation)" $ withClient $ \client -> do+    let start_str :: GTraversal Transform () Text+        start_str = unsafeGTraversal "__(\"foo\", \"bar\", \"quux\", \"hoge\")"+        g = gWhereP2 label_s (pEq label_a) (Just $ gBy $ mapper) $. gAs label_a $. appendWalk "FOO" $. gAs label_s $. start_str+        label_s = "s"+        label_a = "a"+        mapper = gChoose3 (gIsP (pGte 6) <<< lengthWalk)+                 (substrWalk 0 3)+                 gIdentity+    got <- fmap V.toList $ WS.slurpResults =<< WS.submit client g Nothing+    got `shouldBe` ["fooFOO", "barFOO"]++spec_match :: SpecWith (String,Int)+spec_match = do+  specify "gMatch" $ withClient $ \client -> do+    let start_str :: GTraversal Transform () Text+        start_str = unsafeGTraversal "__(\"foo\", \"hoge\", \"bar\", \"quux\")"+        g = gSelectN label_s label_ss [label_len, label_dlen] $. gMatch pat $. start_str+        pat = And+              ( mPattern label_s (gAs label_len <<< lengthWalk) )+              [ mPattern label_s (gAs label_ss <<< appendWalk "HOGE"),+                mPattern label_len (gAs label_dlen <<< squareWalk),+                mPattern label_ss (gWhereP1 (pLt label_dlen) Nothing <<< plusWalk 5 <<< lengthWalk)+              ]+        label_s = "s"+        label_ss = "ss"+        label_len = "len"+        label_dlen = "dlen"+        extract sm = (,,,)+                     <$> lookupAsM label_s sm+                     <*> lookupAsM label_ss sm+                     <*> lookupAsM label_len sm+                     <*> lookupAsM label_dlen sm+    got <- traverse extract =<< (fmap V.toList $ WS.slurpResults =<< WS.submit client g Nothing)+    got `shouldBe` [ ("hoge", "hogeHOGE", 4, 16),+                     ("quux", "quuxHOGE", 4, 16)+                   ]