diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,20 @@ # Revision history for greskell +## 0.2.2.0 -- 2018-11-23 + +* Add new `AsLabel` module. + +### GTraversal module + +* Add `gAs`, `gSelect1`, `gSelectN`, `gSelectBy1`, `gSelectByN`, + `gOutV`, `gOutV'`, `gInV`, `gInV'` functions. + +### Binder module + +* Add `newAsLabel` function. + + + ## 0.2.1.1 -- 2018-10-03 * Confirm test with `base-4.12.0.0` diff --git a/greskell.cabal b/greskell.cabal --- a/greskell.cabal +++ b/greskell.cabal @@ -1,5 +1,5 @@ name: greskell -version: 0.2.1.1 +version: 0.2.2.0 author: Toshio Ito maintainer: Toshio Ito license: BSD3 @@ -31,7 +31,8 @@ Data.Greskell.Gremlin, Data.Greskell.Binder, Data.Greskell.Graph, - Data.Greskell.GTraversal + Data.Greskell.GTraversal, + Data.Greskell.AsLabel -- other-modules: build-depends: base >=4.9.0.0 && <4.13, greskell-core >=0.1.2.0 && <0.2, @@ -40,7 +41,8 @@ aeson >=0.11.2.1 && <1.5, unordered-containers >=0.2.7.1 && <0.3, semigroups >=0.18.2 && <0.19, - vector >=0.12.0.1 && <0.13 + vector >=0.12.0.1 && <0.13, + exceptions >=0.8.3 && <0.11 test-suite spec type: exitcode-stdio-1.0 @@ -87,7 +89,7 @@ main-is: HintTest.hs build-depends: base, hspec, greskell, - hint >=0.6 && <0.9 + hint >=0.6 && <0.10 flag server-test diff --git a/src/Data/Greskell.hs b/src/Data/Greskell.hs --- a/src/Data/Greskell.hs +++ b/src/Data/Greskell.hs @@ -14,7 +14,8 @@ module Data.Greskell.Graph, module Data.Greskell.GraphSON, module Data.Greskell.GMap, - module Data.Greskell.AsIterator + module Data.Greskell.AsIterator, + module Data.Greskell.AsLabel ) where import Data.Greskell.Greskell @@ -25,3 +26,4 @@ import Data.Greskell.GraphSON import Data.Greskell.GMap import Data.Greskell.AsIterator +import Data.Greskell.AsLabel diff --git a/src/Data/Greskell/AsLabel.hs b/src/Data/Greskell/AsLabel.hs new file mode 100644 --- /dev/null +++ b/src/Data/Greskell/AsLabel.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE OverloadedStrings, TypeFamilies, GeneralizedNewtypeDeriving, DeriveTraversable #-} +-- | +-- Module: Data.Greskell.AsLabel +-- Description: Label string used in .as step +-- Maintainer: Toshio Ito +-- +-- @since 0.2.2.0 +module Data.Greskell.AsLabel + ( AsLabel(..), + SelectedMap, + lookup, + lookupM, + lookupAs, + lookupAsM, + AsLookupException(..) + ) where + +import Prelude hiding (lookup) + +import Control.Exception (Exception) +import Control.Monad.Catch (MonadThrow(..)) +import Data.Foldable (Foldable) +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 qualified Data.Greskell.Greskell as Greskell +import Data.Text (Text) +import Data.Traversable (Traversable) + +-- | '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) + +-- | Returns the 'Text' as a Gremlin string. +instance ToGreskell (AsLabel a) where + type GreskellReturn (AsLabel a) = Text + toGreskell (AsLabel t) = Greskell.string t + +-- | Unsafely convert the phantom type. +instance Functor AsLabel where + fmap _ (AsLabel t) = AsLabel t + +-- | A map keyed with 'AsLabel'. Obtained from @.select@ step, for +-- example. +newtype SelectedMap a = SelectedMap (HashMap Text a) + deriving (Show,Eq,Functor,Foldable,Traversable) + +instance GraphSONTyped (SelectedMap a) where + gsonTypeFor _ = "g:Map" + +instance FromGraphSON a => FromGraphSON (SelectedMap a) where + parseGraphSON gv = fmap SelectedMap $ parseGraphSON gv + +-- | An 'Exception' raised by 'lookupM' and 'lookupAsM'. +data AsLookupException = NoSuchAsLabel + -- ^ The 'SelectedMap' does not have the + -- given 'AsLabel' as the key. + | ParseError String + -- ^ Failed to parse the value into the type + -- that the 'AsLabel' indicates. The 'String' + -- is the error message. + deriving (Show,Eq,Ord) + +instance Exception AsLookupException + +-- | Get value from 'SelectedMap'. +lookup :: AsLabel a -> SelectedMap b -> Maybe b +lookup (AsLabel l) (SelectedMap m) = HM.lookup l m + +-- | 'MonadThrow' version of 'lookup'. If there is no value for the +-- 'AsLabel', it throws 'NoSuchAsLabel'. +lookupM :: MonadThrow m => AsLabel a -> SelectedMap b -> m b +lookupM l m = maybe (throwM NoSuchAsLabel) return $ lookup l m + +-- | Get value from 'SelectedMap' and parse the value into @a@. +lookupAs :: FromGraphSON a => AsLabel a -> SelectedMap GValue -> Either AsLookupException a +lookupAs l m = + case lookup l m of + Nothing -> Left NoSuchAsLabel + Just gv -> either (Left . ParseError) Right $ parseEither gv + +-- | 'MonadThrow' version of 'lookupAs'. +lookupAsM :: (MonadThrow m, FromGraphSON a) => AsLabel a -> SelectedMap GValue -> m a +lookupAsM l m = either throwM return $ lookupAs l m 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 @@ -11,6 +11,7 @@ Binding, -- * Actions newBind, + newAsLabel, -- * Runners runBinder ) where @@ -20,10 +21,29 @@ import Data.Aeson (Value, ToJSON(toJSON), Object) import Data.Monoid ((<>)) import qualified Data.HashMap.Strict as HM +import qualified Data.Text as T import qualified Data.Text.Lazy as TL +import Data.Greskell.AsLabel (AsLabel(..)) import Data.Greskell.Greskell (unsafeGreskellLazy, Greskell) +-- | State in the 'Binder'. +data BinderS = + BinderS + { varIndex :: PlaceHolderIndex, + varBindings :: [Value], + asLabelIndex :: PlaceHolderIndex + } + deriving (Show,Eq) + +initBinderS :: BinderS +initBinderS = + BinderS + { varIndex = 0, + varBindings = [], + asLabelIndex = 0 + } + -- $setup -- -- >>> import Control.Applicative ((<$>), (<*>)) @@ -32,7 +52,7 @@ -- >>> import Data.Ord (comparing) -- >>> import qualified Data.HashMap.Strict as HashMap --- | A Monad that manages binding variables to values. +-- | 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 @@ -42,7 +62,7 @@ -- "__v1" -- >>> sortBy (comparing fst) $ HashMap.toList binding -- [("__v0",Number 10.0),("__v1",String "hoge")] -newtype Binder a = Binder { unBinder :: State (PlaceHolderIndex, [Value]) a } +newtype Binder a = Binder { unBinder :: State BinderS a } deriving (Functor, Applicative, Monad) -- | Binding between Gremlin variable names and JSON values. @@ -57,15 +77,20 @@ => v -- ^ bound value -> Binder (Greskell v) -- ^ variable newBind val = Binder $ do - (next_index, values) <- State.get - State.put (succ next_index, values ++ [toJSON val]) + state <- State.get + let next_index = varIndex state + values = varBindings state + State.put $ state { varIndex = succ next_index, + varBindings = values ++ [toJSON val] + } return $ unsafePlaceHolder next_index -- | Execute the given 'Binder' monad to obtain 'Binding'. runBinder :: Binder a -> (a, Binding) runBinder binder = (ret, binding) where - (ret, (_, values)) = State.runState (unBinder binder) (0, []) + (ret, state) = State.runState (unBinder binder) initBinderS + values = varBindings state binding = HM.fromList $ zip (map toPlaceHolderVariableStrict [0 ..]) $ values toPlaceHolderVariableStrict = TL.toStrict . toPlaceHolderVariable @@ -83,4 +108,18 @@ -- -- Create placeholder variable string from the index. toPlaceHolderVariable :: PlaceHolderIndex -> TL.Text -toPlaceHolderVariable i = TL.pack ("__v" ++ show i) +toPlaceHolderVariable i = TL.pack ("__v" ++ show i) + +-- | Create a new 'AsLabel'. +-- +-- The returned 'AsLabel' is guaranteed to be unique in the current +-- monadic context. +-- +-- @since 0.2.2.0 +newAsLabel :: Binder (AsLabel a) +newAsLabel = Binder $ do + state <- State.get + let label_index = asLabelIndex state + label = "__a" ++ show label_index + State.put $ state { asLabelIndex = succ label_index } + return $ AsLabel $ T.pack label 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 @@ -95,11 +95,17 @@ gFlatMap, gV, gV', + -- ** As step + gAs, -- ** Accessor steps gValues, gProperties, gId, gLabel, + gSelect1, + gSelectN, + gSelectBy1, + gSelectByN, -- ** Summarizing steps gFold, gCount, @@ -108,10 +114,14 @@ gOut', gOutE, gOutE', + gOutV, + gOutV', gIn, gIn', gInE, gInE', + gInV, + gInV', -- ** Side-effect steps gSideEffect, gSideEffect', @@ -153,6 +163,7 @@ import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL + import Data.Greskell.Graph ( Element(..), Vertex, Edge, Property(..), AVertex, AEdge, @@ -169,6 +180,7 @@ toGremlinLazy, toGremlin ) import Data.Greskell.AsIterator (AsIterator(IteratorItem)) +import Data.Greskell.AsLabel (AsLabel, SelectedMap) -- $setup -- @@ -871,6 +883,15 @@ gV' :: [Greskell GValue] -> Walk Transform s AVertex gV' = gV +-- | @.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"]) @@ -902,6 +923,37 @@ gLabel :: Element s => Walk Transform s Text gLabel = unsafeWalk "label" [] +-- | @.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 :: ByProjection a b -> Walk Transform 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] + -- | @.fold@ step. gFold :: Walk Transform a [a] gFold = unsafeWalk "fold" [] @@ -940,6 +992,18 @@ -> 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 @@ -963,6 +1027,18 @@ => [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 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 @@ -7,8 +7,9 @@ import Data.Text (unpack) import Test.Hspec +import Data.Greskell.AsLabel (AsLabel) import Data.Greskell.Greskell (toGremlin, unsafeGreskell, Greskell) -import Data.Greskell.Binder (newBind, runBinder) +import Data.Greskell.Binder (Binder, newBind, runBinder, newAsLabel) main :: IO () main = hspec spec @@ -24,7 +25,6 @@ variableHeads = '_' : (['a' .. 'z'] ++ ['A' .. 'Z']) variableRests = variableHeads ++ ['0' .. '9'] - spec :: Spec spec = describe "Binder" $ do it "should keep bound values" $ do @@ -48,3 +48,13 @@ got_bind `shouldBe` HM.fromList [ (toGremlin got_v1, toJSON "foobar"), (toGremlin got_v2, toJSON "foobar") ] + it "should also be able to produce AsLabels" $ do + let newIntLabel :: Binder (AsLabel Int) + newIntLabel = newAsLabel + newVar = newBind "foobar" + ((got_v1, got_l1, got_v2, got_l2), _) = + runBinder $ ((,,,) <$> newVar <*> newIntLabel <*> newVar <*> newIntLabel) + shouldBeVariable got_v1 + shouldBeVariable got_v2 + toGremlin got_v1 `shouldNotBe` toGremlin got_v2 + got_l1 `shouldNotBe` got_l2 diff --git a/test/ServerTest.hs b/test/ServerTest.hs --- a/test/ServerTest.hs +++ b/test/ServerTest.hs @@ -14,6 +14,8 @@ import qualified Network.Greskell.WebSocket.Client as WS import Test.Hspec +import Data.Greskell.AsLabel (AsLabel(..), lookupAsM) +import qualified Data.Greskell.AsLabel as As import Data.Greskell.AsIterator ( AsIterator(IteratorItem) ) @@ -30,7 +32,7 @@ ) import Data.Greskell.Graph ( AVertex(..), AEdge(..), AProperty(..), AVertexProperty(..), - PropertyMapSingle, + PropertyMapSingle, Key, T, tId, tLabel, tKey, tValue, cList, (=:), fromProperties, allProperties ) @@ -41,9 +43,11 @@ import Data.Greskell.GTraversal ( Walk, GTraversal, SideEffect, source, sV', sE', gV', sAddV', gAddE', gTo, - ($.), gOrder, gBy1, + ($.), gOrder, gBy1, gBy, Transform, unsafeWalk, unsafeGTraversal, - gProperties, gProperty, gPropertyV, liftWalk + gProperties, gProperty, gPropertyV, liftWalk, + gAs, gSelect1, gSelectN, gSelectBy1, gSelectByN, + gFilter, gOut' ) import ServerTest.Common (withEnv, withClient) @@ -59,6 +63,8 @@ spec_T spec_P spec_graph + spec_as + spec_selectBy spec_basics :: SpecWith (String,Int) @@ -320,3 +326,52 @@ [ finalize $ gPropertyV (Just cList) "version" ver ["date" =: date] $. liftWalk $ sV' [num vid] $ source "g" ] + +spec_as :: SpecWith (String,Int) +spec_as = do + let start :: GTraversal Transform () Int + start = unsafeGTraversal "__(1,2,3)" + mult :: Greskell Int -> Walk Transform Int Int + mult factor = unsafeWalk "map" ["{ it.get() * " <> toGremlin factor <> " }"] + specify "gAs and gSelect1" $ withClient $ \client -> do + let label :: AsLabel Int + label = AsLabel "a" + got <- WS.slurpResults =<< WS.submit client (gSelect1 label $. mult 100 $. gAs label $. start) Nothing + V.toList got `shouldBe` [1,2,3] + specify "gAs and gSelectN" $ withClient $ \client -> do + let lorig, lmul :: AsLabel Int + lorig = AsLabel "a" + lmul = AsLabel "b" + gt = gSelectN lorig lmul [] $. mult 5 $. gAs lmul $. mult 100 $. gAs lorig $. start + got <- fmap V.toList $ WS.slurpResults =<< WS.submit client gt Nothing + mapM (lookupAsM lorig) got `shouldReturn` [1,2,3] + mapM (lookupAsM lmul) got `shouldReturn` [100,200,300] + +spec_selectBy :: SpecWith (String,Int) +spec_selectBy = do + let prelude :: Greskell () + prelude = unsafeGreskell $ mconcat $ map (<> "; ") + [ "graph = org.apache.tinkerpop.gremlin.tinkergraph.structure.TinkerGraph.open()", + "g = graph.traversal()", + "graph.addVertex(id, 1, label, 'person')", + "graph.addVertex(id, 2, label, 'person')", + "g.V(1).property('name', 'ito').property('age', 23).iterate()", + "g.V(2).property('name', 'tanaka').property('age', 18).iterate()", + "g.V(1).addE('knows').to(V(2)).iterate()" + ] + specify "gAs and gSelectBy1" $ withClient $ \client -> do + let src :: AsLabel AVertex + src = AsLabel "s" + gt = gSelectBy1 src (gBy ("name" :: Key AVertex Text)) $. gAs src $. gFilter (gOut' ["knows"]) $. sV' [] $ source "g" + got <- fmap V.toList $ WS.slurpResults =<< WS.submit client (withPrelude prelude gt) Nothing + got `shouldBe` ["ito"] + specify "gAs and gSelectByN" $ withClient $ \client -> do + let src, dest :: AsLabel AVertex + src = AsLabel "s" + dest = AsLabel "d" + gt = gSelectByN src dest [] (gBy ("age" :: Key AVertex Int)) + $. gAs dest $. gOut' ["knows"] + $. gAs src $. gFilter (gOut' ["knows"]) $. sV' [] $ source "g" + got <- fmap V.toList $ WS.slurpResults =<< WS.submit client (withPrelude prelude gt) Nothing + map (As.lookup src) got `shouldBe` [Just 23] + map (As.lookup dest) got `shouldBe` [Just 18]