greskell 0.2.1.1 → 0.2.2.0

raw patch · 8 files changed

+301/−16 lines, 8 filesdep +exceptionsdep ~hintPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: exceptions

Dependency ranges changed: hint

API changes (from Hackage documentation)

Files

• ChangeLog.md +15/−0
• greskell.cabal +6/−4
• src/Data/Greskell.hs +3/−1
• src/Data/Greskell/AsLabel.hs +86/−0
• src/Data/Greskell/Binder.hs +45/−6
• src/Data/Greskell/GTraversal.hs +76/−0
• test/Data/Greskell/BinderSpec.hs +12/−2
• test/ServerTest.hs +58/−3

@@ -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`

@@ -1,5 +1,5 @@ name:                   greskell-version:                0.2.1.1+version:                0.2.2.0 author:                 Toshio Ito <debug.ito@gmail.com> maintainer:             Toshio Ito <debug.ito@gmail.com> 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

@@ -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

@@ -0,0 +1,86 @@+{-# LANGUAGE OverloadedStrings, TypeFamilies, GeneralizedNewtypeDeriving, DeriveTraversable #-}+-- |+-- Module: Data.Greskell.AsLabel+-- Description: Label string used in .as step+-- Maintainer: Toshio Ito <debug.ito@gmail.com>+--+-- @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

@@ -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

@@ -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

@@ -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

@@ -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]