diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,13 @@ # Revision history for greskell +## 0.2.1.0 -- 2018-08-17 + +### GTraversal module + +* Add `(<$.>)`, `(<*.>)`, `gLimit`, `gTail`, `gSkip`, `gId`, `gLabel` + functions. + + ## 0.2.0.3 -- 2018-07-24 * Confirmed test with `doctest-discover-0.2.0.0`. @@ -24,11 +32,11 @@ ### Graph module -* [BREAKING CHANGE]: Now `AVertex`, `AEdge`, `AVertexProperty` are +* **BREAKING CHANGE**: Now `AVertex`, `AEdge`, `AVertexProperty` are based on `GValue` type, instead of `GraphSON Value`. This is for taking care of possibly nested GraphSON-encoded values in a generic way. -* [BREAKING CHANGE]: `parseOneValue`, `parseListValues`, +* **BREAKING CHANGE**: `parseOneValue`, `parseListValues`, `parseNonEmptyValues` functions now require `FromGraphSON` constraint, instead of `FromJSON`, because property types of `AVertex` etc have changed. diff --git a/greskell.cabal b/greskell.cabal --- a/greskell.cabal +++ b/greskell.cabal @@ -1,5 +1,5 @@ name: greskell -version: 0.2.0.3 +version: 0.2.1.0 author: Toshio Ito maintainer: Toshio Ito license: BSD3 @@ -102,9 +102,33 @@ main-is: ServerTest.hs -- default-extensions: other-extensions: OverloadedStrings, TypeFamilies - -- other-modules: + other-modules: ServerTest.Common if flag(server-test) -- Explicitly remove dependency. See https://github.com/haskell/cabal/issues/1725 + build-depends: base, aeson, hspec, text, unordered-containers, vector, + greskell, greskell-core, + scientific >=0.3.4.9 && <0.4, + greskell-websocket >=0.1.0.0 && <0.2, + safe-exceptions >=0.1.6 && <0.2 + else + buildable: False + + +flag server-behavior-test + description: Tests about the behavior of Gremlin Server, rather than greskell. + default: False + manual: True + +test-suite server-behavior-test-suite + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + ghc-options: -Wall -fno-warn-unused-imports "-with-rtsopts=-M512m" + main-is: ServerBehaviorTest.hs + -- default-extensions: + other-extensions: OverloadedStrings + other-modules: ServerTest.Common + if flag(server-behavior-test) build-depends: base, aeson, hspec, text, unordered-containers, vector, greskell, greskell-core, scientific >=0.3.4.9 && <0.4, 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 @@ -34,6 +34,8 @@ -- * GTraversal (&.), ($.), + (<$.>), + (<*.>), unsafeGTraversal, -- * Walk/Steps @@ -86,6 +88,9 @@ gOrder, -- ** Paging steps gRange, + gLimit, + gTail, + gSkip, -- ** Transformation steps gFlatMap, gV, @@ -93,6 +98,8 @@ -- ** Accessor steps gValues, gProperties, + gId, + gLabel, -- ** Summarizing steps gFold, gCount, @@ -132,6 +139,7 @@ gBy2 ) where +import Control.Applicative ((<$>), (<*>)) import Control.Category (Category, (>>>)) -- (below) to import Category methods without conflict with Prelude import qualified Control.Category as Category @@ -445,6 +453,22 @@ ($.) :: 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 + -- -- $walk-steps -- -- @@ -676,6 +700,25 @@ -> 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] + + -- | Data types that mean a projection from one type to another. class ProjectionLike p where type ProjectionLikeStart p @@ -846,6 +889,18 @@ => [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" [] -- | @.fold@ step. gFold :: Walk Transform a [a] diff --git a/test/ServerBehaviorTest.hs b/test/ServerBehaviorTest.hs new file mode 100644 --- /dev/null +++ b/test/ServerBehaviorTest.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main,spec) where + +import qualified Data.Vector as V +import qualified Network.Greskell.WebSocket.Client as WS +import Test.Hspec + +import Data.Greskell.Binder (newBind, runBinder) +import Data.Greskell.Graph + ( AVertex, Key, + ) +import Data.Greskell.GTraversal + ( Walk, GTraversal, SideEffect, + source, sV', sAddV', gProperty, gId, gValues, gHasId, gHasLabel, gHas2, + ($.), liftWalk + ) + +import ServerTest.Common (withEnv, withClient) + +main :: IO () +main = hspec spec + +spec :: Spec +spec = withEnv $ do + spec_values_type + +clearGraph :: WS.Client -> IO () +clearGraph client = WS.drainResults =<< WS.submitRaw client "g.V().drop()" Nothing + +spec_values_type :: SpecWith (String,Int) +spec_values_type = describe "return type of .values step" $ do + specify "input Int, get Int" $ withClient $ \client -> do + let prop_key :: Key AVertex Int + prop_key = "foobar" + searchProp = WS.drainResults =<< WS.submit client script (Just binding) + where + (script, binding) = runBinder $ do + input <- newBind (100 :: Int) + return $ gHas2 prop_key input $. sV' [] $ source "g" + putProp = WS.slurpResults =<< WS.submit client script (Just binding) + where + (script, binding) = runBinder $ do + input <- newBind (100 :: Int) + return $ liftWalk gId $. gProperty prop_key input $. sAddV' "hoge" $ source "g" + getProp vid = WS.slurpResults =<< WS.submit client script (Just binding) + where + (script, binding) = runBinder $ do + vid_var <- newBind vid + return $ gValues [prop_key] $. gHasId vid_var $. gHasLabel "hoge" $. sV' [] $ source "g" + clearGraph client + searchProp + got_ids <- putProp + got <- getProp (got_ids V.! 0) + V.toList got `shouldBe` [100] diff --git a/test/ServerTest.hs b/test/ServerTest.hs --- a/test/ServerTest.hs +++ b/test/ServerTest.hs @@ -2,7 +2,6 @@ module Main (main,spec) where import Control.Category ((<<<)) -import Control.Exception.Safe (bracket) import qualified Data.Aeson as Aeson import Data.Either (isRight) import Data.HashMap.Strict (HashMap) @@ -13,12 +12,12 @@ import Data.Text (unpack, Text) import qualified Data.Vector as V import qualified Network.Greskell.WebSocket.Client as WS -import System.Environment (lookupEnv) import Test.Hspec import Data.Greskell.AsIterator ( AsIterator(IteratorItem) ) +import Data.Greskell.Binder (newBind, runBinder) import Data.Greskell.GMap (GMapEntry, unGMapEntry) import Data.Greskell.Gremlin ( oIncr, oDecr, cCompare, Order, @@ -41,12 +40,14 @@ ) import Data.Greskell.GTraversal ( Walk, GTraversal, SideEffect, - source, sV', sE', gV', sAddV', gAddE', gTo, gHasValue, + source, sV', sE', gV', sAddV', gAddE', gTo, ($.), gOrder, gBy1, Transform, unsafeWalk, unsafeGTraversal, gProperties, gProperty, gPropertyV, liftWalk ) +import ServerTest.Common (withEnv, withClient) + main :: IO () main = hspec spec @@ -141,22 +142,7 @@ => Greskell a -> b -> SpecWith (String, Int) checkOne input expected = checkRaw input [expected] -requireEnv :: String -> IO String -requireEnv env_key = maybe bail return =<< lookupEnv env_key - where - bail = expectationFailure msg >> return "" - where - msg = "Set environment variable "++ env_key ++ " for Server test. " -withEnv :: SpecWith (String, Int) -> Spec -withEnv = before $ do - hostname <- requireEnv "GRESKELL_TEST_HOST" - port <- fmap read $ requireEnv "GRESKELL_TEST_PORT" - return (hostname, port) - -withClient :: (WS.Client -> IO ()) -> (String, Int) -> IO () -withClient act (host, port) = bracket (WS.connect host port) WS.close act - spec_comparator :: SpecWith (String,Int) spec_comparator = do let oIncr' :: Greskell (Order Int) @@ -217,6 +203,10 @@ test (number 10) `shouldReturn` V.fromList [False] test (number 15) `shouldReturn` V.fromList [True] +withPrelude :: (ToGreskell a) => Greskell () -> a -> Greskell (GreskellReturn a) +withPrelude prelude orig = unsafeGreskell (toGremlin prelude <> toGremlin orig) + + -- | This test is supported TinkerPop 3.1.0 and above, because it uses -- 'gAddE'' function. spec_graph :: SpecWith (String,Int) @@ -228,7 +218,7 @@ ">=1.2.2.1", ">=1.2.3" ] - got <- WS.slurpResults =<< WS.submit client (withPrelude trav) Nothing + got <- WS.slurpResults =<< WS.submit client (withPrelude' trav) Nothing (map (fmap parseEither) $ V.toList got) `shouldMatchList` expected specify "AProperty (vertex property meta-properties)" $ withClient $ \client -> do let trav = gProperties [] $. gProperties [] $. sV' [] $ source "g" @@ -239,7 +229,7 @@ "2017-12-27", "2017-12-23" ] - got <- WS.slurpResults =<< WS.submit client (withPrelude trav) Nothing + got <- WS.slurpResults =<< WS.submit client (withPrelude' trav) Nothing (map (fmap parseEither) $ V.toList got) `shouldMatchList` expected specify "AEdge" $ withClient $ \client -> do let trav = sE' [] $ source "g" @@ -255,7 +245,7 @@ expE 1 3 ">=1.2.2.1", expE 2 3 ">=1.2.3" ] - got <- WS.slurpResults =<< WS.submit client (withPrelude trav) Nothing + got <- WS.slurpResults =<< WS.submit client (withPrelude' trav) Nothing (map getE $ V.toList got) `shouldMatchList` expected let getVP vp = (avpLabel vp, parseEither $ avpValue vp, fmap parseEither $ avpProperties vp) specify "AVertexProperty" $ withClient $ \client -> do @@ -273,7 +263,7 @@ expVer "1.2.3.0" "2017-12-27", expVer "1.2.2.0" "2017-12-23" ] - got <- WS.slurpResults =<< WS.submit client (withPrelude trav) Nothing + got <- WS.slurpResults =<< WS.submit client (withPrelude' trav) Nothing (map getVP $ V.toList got) `shouldMatchList` expected specify "AVertex" $ withClient $ \client -> do let trav = sV' [] $ source "g" @@ -289,11 +279,11 @@ expV 2 "aeson" [("1.2.2.0", "2017-09-20"), ("1.3.1.1", "2018-05-10")], expV 3 "text" [("1.2.2.0", "2017-12-23"), ("1.2.3.0", "2017-12-27")] ] - got <- WS.slurpResults =<< WS.submit client (withPrelude trav) Nothing + got <- WS.slurpResults =<< WS.submit client (withPrelude' trav) Nothing (map getV $ V.toList got) `shouldMatchList` expected where - withPrelude :: (ToGreskell a) => a -> Greskell (GreskellReturn a) - withPrelude orig = unsafeGreskell (toGremlin prelude <> toGremlin orig) + withPrelude' :: (ToGreskell a) => a -> Greskell (GreskellReturn a) + withPrelude' = withPrelude prelude prelude :: Greskell () prelude = unsafeGreskell $ mconcat $ map (<> "; ") ( [ "graph = org.apache.tinkerpop.gremlin.tinkergraph.structure.TinkerGraph.open()", @@ -329,4 +319,4 @@ addVersion vid ver date = [ finalize $ gPropertyV (Just cList) "version" ver ["date" =: date] $. liftWalk $ sV' [num vid] $ source "g" ] - + diff --git a/test/ServerTest/Common.hs b/test/ServerTest/Common.hs new file mode 100644 --- /dev/null +++ b/test/ServerTest/Common.hs @@ -0,0 +1,33 @@ +-- | +-- Module: ServerTest.Common +-- Description: +-- Maintainer: Toshio Ito +-- +-- +module ServerTest.Common + ( withEnv, + withClient + ) where + +import Control.Exception.Safe (bracket) +import qualified Network.Greskell.WebSocket.Client as WS +import System.Environment (lookupEnv) +import Test.Hspec + +requireEnv :: String -> IO String +requireEnv env_key = maybe bail return =<< lookupEnv env_key + where + bail = expectationFailure msg >> return "" + where + msg = "Set environment variable "++ env_key ++ " for Server test. " + +withEnv :: SpecWith (String, Int) -> Spec +withEnv = before $ do + hostname <- requireEnv "GRESKELL_TEST_HOST" + port <- fmap read $ requireEnv "GRESKELL_TEST_PORT" + return (hostname, port) + +withClient :: (WS.Client -> IO ()) -> (String, Int) -> IO () +withClient act (host, port) = bracket (WS.connect host port) WS.close act + +