net-spider 0.3.3.0 → 0.4.0.0

raw patch · 7 files changed

+284/−175 lines, 7 filesdep ~greskellPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: greskell

API changes (from Hackage documentation)

Files

• ChangeLog.md +21/−0
• net-spider.cabal +6/−3
• src/NetSpider/Graph/Internal.hs +185/−99
• src/NetSpider/GraphML/Writer.hs +1/−8
• src/NetSpider/Spider.hs +25/−14
• src/NetSpider/Spider/Internal/Graph.hs +20/−38
• test/ServerTest/Common.hs +26/−13

@@ -1,5 +1,26 @@ # Revision history for net-spider +## 0.4.0.0  -- 2019-12-28++* Use `greskell-1.0.0.0`.++### Graph module++* [BREAKING CHANGE] Change signatures of `parseNodeAttributes` and+  `parseLinkAttributes` functions, because now `PropertMapList` and+  `PropertyMapSingle` are deprecated.+* [BREAKING CHANGE] Remove `ToAttributes` instance from types of+  `PropertyMap` class, because `PropertyMap` is now deprecated.+* [BREAKING CHANGE] Now `EID` is alias for `ElementID`. It's kind is+  now `* -> *`. This fixes #5.+* [BREAKING CHANGE] Kind of `VFoundNode` and `EFinds` is now `*` (was+  `* -> *`).+* [BREAKING CHANGE] Remove `NodeAttributes PropertyMapList` instance+  and `LinkAttributes PropertyMapSingle` instance, because+  PropertyMaps are deprecated.+* Add `NodeAttributes` and `LinkAttributes` instances to `PMap`.++ ## 0.3.3.0  -- 2019-10-13  ### Interval module

@@ -1,5 +1,5 @@ name:                   net-spider-version:                0.3.3.0+version:                0.4.0.0 author:                 Toshio Ito <debug.ito@gmail.com> maintainer:             Toshio Ito <debug.ito@gmail.com> license:                BSD3@@ -23,7 +23,10 @@                         TypeFamilies,                         FlexibleInstances,                         DeriveGeneric,-                        TypeSynonymInstances+                        TypeSynonymInstances,+                        UndecidableInstances,+                        NoMonomorphismRestriction,+                        FlexibleContexts   exposed-modules:      NetSpider,                         NetSpider.Input,                         NetSpider.Output,@@ -50,7 +53,7 @@                         time >=1.8.0.2 && <1.10,                         vector >=0.12.0.1 && <0.13,                         greskell-websocket >=0.1.1 && <0.2,-                        greskell >=0.2.3 && <0.3,+                        greskell >=1.0.0 && <1.1,                         aeson >=1.2.4 && <1.5,                         safe-exceptions >=0.1.6 && <0.2,                         text >=1.2.2.2 && <1.3,

@@ -1,4 +1,5 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, OverloadedStrings, FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, OverloadedStrings,+    FlexibleInstances, UndecidableInstances, NoMonomorphismRestriction, FlexibleContexts #-} -- | -- Module: NetSpider.Graph.Internal -- Description: @@ -11,134 +12,220 @@          -- * VNode          VNode,          -- * VFoundNode-         VFoundNode(..),+         VFoundNode,+         VFoundNodeData(..),          NodeAttributes(..),+         keyTimestamp,+         gSetTimestamp,+         gVFoundNodeData,          -- * EFinds-         EFinds(..),-         LinkAttributes(..)+         EFinds,+         EFindsData(..),+         LinkAttributes(..),+         gSetLinkState,+         gFindsTarget,+         gEFindsData        ) where +import Control.Category ((<<<)) import Data.Aeson (ToJSON(..), FromJSON(..), Value(..))+import Data.Foldable (Foldable) import Data.Greskell-  ( FromGraphSON(..), parseOneValue, lookupOne, lookupOneValue,-    Element(..), Vertex, Edge(..),-    AVertexProperty(..), AVertex(..), AProperty, AEdge(..),-    Walk, SideEffect,-    Binder, Parser, PropertyMapList, PropertyMapSingle, GValue,-    gIdentity, gProperty,-    newBind, allProperties, propertyKey, propertyValue+  ( FromGraphSON(..),+    ElementData(..), Element(..), Vertex, Edge,+    ElementID,+    AVertexProperty, AVertex, AEdge,+    Walk, SideEffect, Transform, unsafeCastEnd,+    Binder, Parser, GValue,+    gIdentity, gProperty, gPropertyV, (=:), gProperties, gInV,+    newBind,+    Key, AsLabel, unKey,+    PMap, Multi, Single, lookupAs, PMapLookupException,+    pMapFromList, pMapToList, pMapToFail,+    gProject, gValueMap, gByL, gId, Keys(..)   )-import qualified Data.Greskell as Greskell-import Data.Greskell.Extra (writeAllProperties)-import Data.Text (Text, unpack)+import Data.Greskell.NonEmptyLike (NonEmptyLike)+import Data.Greskell.Extra (writePMapProperties)+import Data.Int (Int64)+import Data.Text (Text, unpack, pack) import Data.Time.LocalTime (TimeZone(..))  import NetSpider.Timestamp (Timestamp(..))-import NetSpider.Found (LinkState)+import NetSpider.Found (LinkState, linkStateToText, linkStateFromText)  -- | Generic element ID used in the graph DB.-newtype EID = EID (Either Int Text)-            deriving (Show,Eq,Ord,FromGraphSON)+type EID = ElementID -instance ToJSON EID where-  toJSON (EID e) = either toJSON toJSON e -instance FromJSON EID where-  parseJSON (String s) = return $ EID $ Right s-  parseJSON v = fmap (EID . Left) $ parseJSON v+-- | The \"node\" vertex.+newtype VNode = VNode AVertex+              deriving (Show,Eq,ElementData,Element,Vertex,FromGraphSON) +type TsEpoch = Int64 --- | The \"node\" vertex.-data VNode+keyTimestamp :: Key VFoundNode TsEpoch+keyTimestamp = "@timestamp" -instance Element VNode where-  type ElementID VNode = EID-  type ElementProperty VNode = AVertexProperty+keyTzOffset :: Key (AVertexProperty TsEpoch) Int+keyTzOffset = "@tz_offset_min" -instance Vertex VNode+keyTzSummerOnly :: Key (AVertexProperty TsEpoch) Bool+keyTzSummerOnly = "@tz_summer_only" +keyTzName :: Key (AVertexProperty TsEpoch) Text+keyTzName = "@tz_name"+  +gSetTimestamp :: Timestamp -> Binder (Walk SideEffect VFoundNode VFoundNode)+gSetTimestamp ts = do+  var_epoch <- newBind $ epochTime ts+  meta_props <- makeMetaProps $ timeZone ts+  return $ gPropertyV Nothing keyTimestamp var_epoch meta_props+  where+    makeMetaProps Nothing = return []+    makeMetaProps (Just tz) = do+      offset <- newBind $ timeZoneMinutes tz+      summer <- newBind $ timeZoneSummerOnly tz+      name <- newBind $ pack $ timeZoneName tz+      return $ [ keyTzOffset =: offset,+                 keyTzSummerOnly =: summer,+                 keyTzName =: name+               ]+ -- | The \"found_node\" vertex.-data VFoundNode na =-  VFoundNode-  { vfnId :: EID,+newtype VFoundNode = VFoundNode AVertex+                   deriving (Show,Eq,ElementData,Element,Vertex,FromGraphSON)++-- | Properties of the \"found_node\" vertex.+data VFoundNodeData na =+  VFoundNodeData+  { vfnId :: EID VFoundNode,     vfnTimestamp :: Timestamp,     vfnAttributes :: na   }   deriving (Show) -instance Element (VFoundNode na) where-  type ElementID (VFoundNode na) = EID-  type ElementProperty (VFoundNode na) = AVertexProperty+labelVProps :: AsLabel (PMap Multi GValue)+labelVProps = "props" -instance Vertex (VFoundNode na)+labelVFoundNodeID :: AsLabel (ElementID VFoundNode)+labelVFoundNodeID = "vid" -instance NodeAttributes na => FromGraphSON (VFoundNode na) where-  parseGraphSON gv = fromAVertex =<< parseGraphSON gv+labelMetaProps :: AsLabel (PMap Single GValue)+labelMetaProps = "mprops"++gVFoundNodeData :: Walk Transform VFoundNode (VFoundNodeData na)+gVFoundNodeData = unsafeCastEnd $ gProject+                  ( gByL labelVFoundNodeID gId)+                  [ gByL labelVProps $ gValueMap KeysNil,+                    gByL labelMetaProps (gValueMap KeysNil <<< gProperties [keyTimestamp])+                  ]++instance NodeAttributes na => FromGraphSON (VFoundNodeData na) where+  parseGraphSON gv = fromPMap =<< parseGraphSON gv     where-      fromAVertex av = do-        eid <- parseGraphSON $ avId av-        ts_prop <- case lookupOne "@timestamp" $ avProperties av of-          Nothing -> fail ("Cannot find property named @timestamp")-          Just p -> return p-        epoch_ts <- parseGraphSON $ avpValue ts_prop-        mtz <- parseTimeZone ts_prop-        attrs <- parseNodeAttributes $ avProperties av-        return $ VFoundNode { vfnId = eid,-                              vfnTimestamp = Timestamp { epochTime = epoch_ts,-                                                         timeZone = mtz-                                                       },-                              vfnAttributes = attrs-                            }-      parseTimeZone ts_prop =-        case (get "@tz_offset_min", get "@tz_summer_only", get "@tz_name") of-         (Left _, Left _, Left _) -> return Nothing-         (eo, es, en) -> do-           offset <- parseE eo-           is_summer_only <- parseE es-           name <- parseE en-           return $ Just $ TimeZone { timeZoneMinutes = offset,-                                      timeZoneSummerOnly = is_summer_only,-                                      timeZoneName = unpack name-                                    }-        where-          get k = maybe (Left ("Cannot find property " ++ unpack k)) Right $ lookupOneValue k $ avpProperties ts_prop-          parseE :: (FromGraphSON a) => Either String GValue -> Parser a-          parseE = either fail parseGraphSON+      lookupAsF k pm = pMapToFail $ lookupAs k pm+      fromPMap :: NodeAttributes na => PMap Single GValue -> Parser (VFoundNodeData na)+      fromPMap pm = do+        eid <- lookupAsF labelVFoundNodeID pm+        props <- lookupAsF labelVProps pm+        mprops <- lookupAsF labelMetaProps pm+        attrs <- parseNodeAttributes props+        epoch_ts <- lookupAsF keyTimestamp props+        mtz <- parseTimeZone mprops+        return $+          VFoundNodeData+          { vfnId = eid,+            vfnTimestamp = Timestamp { epochTime = epoch_ts,+                                       timeZone = mtz+                                     },+            vfnAttributes = attrs+          }+      parseTimeZone ts_prop = do+        case (get keyTzOffset, get keyTzSummerOnly, get keyTzName) of+          (Left _, Left _, Left _) -> return Nothing+          (eo, es, en) -> do+            offset <- eToP eo+            is_summer_only <- eToP es+            name <- eToP en+            return $ Just $ TimeZone { timeZoneMinutes = offset,+                                       timeZoneSummerOnly = is_summer_only,+                                       timeZoneName = unpack name+                                     }+          where+            get :: FromGraphSON b => Key a b -> Either PMapLookupException b+            get k = lookupAs k ts_prop+            eToP = either (fail . show) return  -- | \"finds\" edge.-data EFinds la =-  EFinds-  { efId :: EID,-    efTargetId :: EID,+newtype EFinds = EFinds AEdge+               deriving (Show,Eq,ElementData,Element,Edge,FromGraphSON)++-- | Properties of \"finds\" edge.+data EFindsData la =+  EFindsData+  { efId :: EID EFinds,+    efTargetId :: EID VNode,     efLinkState :: LinkState,     efLinkAttributes :: la   }   deriving (Show) -instance Element (EFinds la) where-  type ElementID (EFinds la) = EID-  type ElementProperty (EFinds la) = AProperty+keyLinkState :: Key EFinds Text+keyLinkState = "@link_state" -instance Edge (EFinds la) where-  type EdgeVertexID (EFinds la) = EID+gSetLinkState :: LinkState -> Binder (Walk SideEffect EFinds EFinds)+gSetLinkState ls = do+  var_ls <- newBind $ linkStateToText $ ls+  return $ gProperty keyLinkState var_ls -instance LinkAttributes la => FromGraphSON (EFinds la) where-  parseGraphSON gv = fromAEdge =<< parseGraphSON gv+gFindsTarget :: Walk Transform EFinds VNode+gFindsTarget = gInV++labelEProps :: AsLabel (PMap Single GValue)+labelEProps = "eprops"++labelEFindsID :: AsLabel (ElementID EFinds)+labelEFindsID = "eid"++labelEFindsTarget :: AsLabel (ElementID VNode)+labelEFindsTarget = "vnode"++gEFindsData :: Walk Transform EFinds (EFindsData la)+gEFindsData = unsafeCastEnd $ gProject+              ( gByL labelEProps $ gValueMap KeysNil )+              [ gByL labelEFindsID $ gId,+                gByL labelEFindsTarget (gId <<< gFindsTarget)+              ]++instance LinkAttributes la => FromGraphSON (EFindsData la) where+  parseGraphSON gv = fromPMap =<< parseGraphSON gv     where-      fromAEdge ae = EFinds -                     <$> (parseGraphSON $ aeId ae)-                     <*> (parseGraphSON $ aeInV ae)-                     <*> (parseOneValue "@link_state" ps)-                     <*> (parseLinkAttributes ps)-        where-          ps = aeProperties ae+      lookupAsF k pm = pMapToFail $ lookupAs k pm+      fromPMap :: LinkAttributes la => PMap Single GValue -> Parser (EFindsData la)+      fromPMap pm = do+        props <- lookupAsF labelEProps pm+        eid <- lookupAsF labelEFindsID pm+        target <- lookupAsF labelEFindsTarget pm+        ls <- parseLinkState =<< lookupAsF keyLinkState props+        attrs <- parseLinkAttributes props+        return $+          EFindsData+          { efId = eid,+            efTargetId = target,+            efLinkState = ls,+            efLinkAttributes = attrs+          }+      parseLinkState t =+        case linkStateFromText t of+          Nothing -> fail ("Failed to parse " ++ (unpack $ unKey $ keyLinkState) ++ " field.")+          Just a -> return a  -- | Class of user-defined types for node attributes. Its content is -- stored in the NetSpider database. class NodeAttributes ps where-  writeNodeAttributes :: ps -> Binder (Walk SideEffect (VFoundNode ps) (VFoundNode ps))+  writeNodeAttributes :: ps -> Binder (Walk SideEffect VFoundNode VFoundNode)   -- ^ Return 'Walk' to write the attributes to the 'VFoundNode'.-  parseNodeAttributes :: PropertyMapList AVertexProperty GValue -> Parser ps+  parseNodeAttributes :: PMap Multi GValue -> Parser ps   -- ^ Parse the vertex proprerties into the attributes.  -- | No attributes.@@ -146,20 +233,19 @@   writeNodeAttributes _ = return gIdentity   parseNodeAttributes _ = return () --- | Straightforward implementation. Note that 'writeNodeAttributes'--- does not write meta-properties of the 'AVertexProperty'.+-- | Straightforward implementation. ----- @since 0.3.0.0-instance (FromGraphSON v, ToJSON v) => NodeAttributes (PropertyMapList AVertexProperty v) where-  writeNodeAttributes = writeAllProperties-  parseNodeAttributes = traverse parseGraphSON+-- @since 0.4.0.0+instance (FromGraphSON v, ToJSON v, Foldable c, Traversable c, NonEmptyLike c) => NodeAttributes (PMap c v) where+  writeNodeAttributes = writePMapProperties+  parseNodeAttributes = traverse parseGraphSON . pMapFromList . pMapToList  -- | Class of user-defined types for link attributes. Its content is -- stored in the NetSpider database. class LinkAttributes ps where-  writeLinkAttributes :: ps -> Binder (Walk SideEffect (EFinds ps) (EFinds ps))+  writeLinkAttributes :: ps -> Binder (Walk SideEffect EFinds EFinds)   -- ^ Return 'Walk' to write the attributes to the 'EFinds'.-  parseLinkAttributes :: PropertyMapSingle AProperty GValue -> Parser ps+  parseLinkAttributes :: PMap Single GValue -> Parser ps   -- ^ Parse the edge proprerties into the attributes.  -- | No attributes.@@ -167,10 +253,10 @@   writeLinkAttributes _ = return gIdentity   parseLinkAttributes _ = return () --- | Straightforward implementation+-- | Straightforward implementation. ----- @since 0.3.0.0-instance (FromGraphSON v, ToJSON v) => LinkAttributes (PropertyMapSingle AProperty v) where-  writeLinkAttributes = writeAllProperties-  parseLinkAttributes = traverse parseGraphSON+-- @since 0.4.0.0+instance (FromGraphSON v, ToJSON v, Foldable c, Traversable c, NonEmptyLike c) => LinkAttributes (PMap c v) where+  writeLinkAttributes = writePMapProperties+  parseLinkAttributes = traverse parseGraphSON . pMapFromList . pMapToList   

@@ -32,9 +32,7 @@  import qualified Data.Aeson as Aeson import Data.Foldable (foldl')-import Data.Greskell.Graph-  ( PropertyMap, Property(..), allProperties-  )+import Data.Greskell.Graph (Property(..)) import Data.Hashable (Hashable(..)) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM@@ -141,11 +139,6 @@  instance ToAttributes [(AttributeKey, AttributeValue)] where   toAttributes = id--instance (PropertyMap m, Property p) => ToAttributes (m p AttributeValue) where-  toAttributes = toAttributes . map toPair . allProperties-    where-      toPair p = (propertyKey p, propertyValue p)  -- | 'Nothing' is mapped to empty attributes. instance ToAttributes a => ToAttributes (Maybe a) where

@@ -22,6 +22,7 @@          clearAll        ) where +import Control.Category ((<<<)) import Control.Exception.Safe (throwString, bracket) import Control.Monad (void, mapM_, mapM) import Data.Aeson (ToJSON)@@ -30,8 +31,9 @@ import Data.Greskell   ( runBinder, ($.), (<$.>), (<*.>),     Binder, ToGreskell(GreskellReturn), AsIterator(IteratorItem), FromGraphSON,-    liftWalk, gLimit, gIdentity, gSelectN, gAs,-    lookupAsM, newAsLabel+    liftWalk, gLimit, gIdentity, gSelect1, gAs, gProject, gByL, gIdentity,+    lookupAsM, newAsLabel,+    Transform, Walk   ) import Data.Hashable (Hashable) import Data.HashMap.Strict (HashMap)@@ -49,7 +51,11 @@ import qualified Network.Greskell.WebSocket as Gr  import NetSpider.Graph (EID, LinkAttributes, NodeAttributes)-import NetSpider.Graph.Internal (VFoundNode(..), EFinds(..))+import NetSpider.Graph.Internal+  ( VFoundNode, EFinds, VNode,+    VFoundNodeData(..), EFindsData(..),+    gVFoundNodeData, gEFindsData+  ) import NetSpider.Found (FoundNode(..), FoundLink(..), LinkState(..)) import NetSpider.Log (runWriterLoggingM, WriterLoggingM, logDebugW, LogLine, spack) import NetSpider.Pair (Pair)@@ -129,12 +135,12 @@ vToMaybe :: Vector a -> Maybe a vToMaybe v = v V.!? 0   -getNode :: (ToJSON n) => Spider n na fla -> n -> IO (Maybe EID)+getNode :: (ToJSON n) => Spider n na fla -> n -> IO (Maybe (EID VNode)) getNode spider nid = fmap vToMaybe $ Gr.slurpResults =<< submitB spider gt   where     gt = gNodeEID <$.> gHasNodeID spider nid <*.> pure gAllNodes -getOrMakeNode :: (ToJSON n) => Spider n na fla -> n -> IO EID+getOrMakeNode :: (ToJSON n) => Spider n na fla -> n -> IO (EID VNode) getOrMakeNode spider nid = do   mvid <- getNode spider nid   case mvid of@@ -193,8 +199,8 @@ traverseEFindsOneHop :: (FromGraphSON n, NodeAttributes na, LinkAttributes fla)                      => Spider n na fla                      -> Interval Timestamp-                     -> EID-                     -> IO (Maybe (VFoundNode na), [(VFoundNode na, EFinds fla, n)])+                     -> EID VNode+                     -> IO (Maybe (VFoundNodeData na), [(VFoundNodeData na, EFindsData fla, n)]) traverseEFindsOneHop spider time_interval visit_eid = (,) <$> getLatestVFoundNode <*> getTraversedEdges   where     foundNodeTraversal = fmap gSelectFoundNode (gFilterFoundNodeByTime time_interval)@@ -203,25 +209,30 @@     getLatestVFoundNode = fmap vToMaybe $ Gr.slurpResults =<< submitQuery       where         submitQuery = submitB spider binder-        binder = gLatestFoundNode <$.> foundNodeTraversal+        binder = gVFoundNodeData <$.> gLatestFoundNode <$.> foundNodeTraversal     getTraversedEdges = fmap V.toList $ traverse extractFromSMap =<< Gr.slurpResults =<< submitQuery       where         submitQuery = Gr.submit (spiderClient spider) query (Just bindings)         ((query, label_vfn, label_ef, label_target_nid), bindings) = runBinder $ do           lvfn <- newAsLabel+          lvfnd <- newAsLabel           lef <- newAsLabel+          lefd <- newAsLabel           ln <- newAsLabel-          gt <- gSelectN lvfn lef [ln]-                <$.> gAs ln <$.> gNodeID spider <$.> gFindsTarget+          gt <- gProject+                ( gByL lvfnd (gVFoundNodeData <<< gSelect1 lvfn) )+                [ gByL lefd (gEFindsData <<< gSelect1 lef),+                  gByL ln (gIdentity :: Walk Transform n n)+                ] <$.> gNodeID spider <$.> gFindsTarget                 <$.> gAs lef <$.> gFinds <$.> gAs lvfn <$.> foundNodeTraversal-          return (gt, lvfn, lef, ln)+          return (gt, lvfnd, lefd, ln)         extractFromSMap smap =           (,,)           <$> lookupAsM label_vfn smap            <*> lookupAsM label_ef smap            <*> lookupAsM label_target_nid smap  -makeLinkSample :: n -> VFoundNode na -> EFinds la -> n -> LinkSample n la+makeLinkSample :: n -> VFoundNodeData na -> EFindsData la -> n -> LinkSample n la makeLinkSample subject_nid vfn efinds target_nid =    LinkSample { lsSubjectNode = subject_nid,                lsTargetNode = target_nid,@@ -291,7 +302,7 @@ data SnapshotState n na fla =   SnapshotState   { ssUnvisitedNodes :: Queue n,-    ssVisitedNodes :: HashMap n (Maybe (VFoundNode na)),+    ssVisitedNodes :: HashMap n (Maybe (VFoundNodeData na)),     -- ^ If the visited node has no observation yet, its node     -- attributes 'Nothing'.     ssVisitedLinks :: HashMap (LinkSampleID n) [LinkSample n fla]@@ -321,7 +332,7 @@ initSnapshotState :: (Ord n, Hashable n) => [n] -> SnapshotState n na fla initSnapshotState init_unvisited_nodes = emptySnapshotState { ssUnvisitedNodes = newQueue init_unvisited_nodes } -addVisitedNode :: (Eq n, Hashable n) => n -> Maybe (VFoundNode na) -> SnapshotState n na fla -> SnapshotState n na fla+addVisitedNode :: (Eq n, Hashable n) => n -> Maybe (VFoundNodeData na) -> SnapshotState n na fla -> SnapshotState n na fla addVisitedNode nid mv state = state { ssVisitedNodes = HM.insert nid mv $ ssVisitedNodes state }  isAlreadyVisited :: (Eq n, Hashable n) => SnapshotState n na fla -> n -> Bool

@@ -52,6 +52,10 @@   ( EID, VNode, VFoundNode, EFinds,     LinkAttributes(..), NodeAttributes(..)   )+import NetSpider.Graph.Internal+  ( keyTimestamp, gSetTimestamp, gSetLinkState,+    gFindsTarget+  ) import NetSpider.Found (FoundLink(..), LinkState(..), FoundNode(..), linkStateToText) import NetSpider.Query (Interval, Extended(..)) import NetSpider.Timestamp (Timestamp(..))@@ -61,7 +65,7 @@ spiderNodeIdKey :: Spider n na fla -> Key VNode n spiderNodeIdKey = nodeIdKey . spiderConfig -gNodeEID :: Walk Transform VNode EID+gNodeEID :: Walk Transform VNode (EID VNode) gNodeEID = gId  gNodeID :: Spider n na fla -> Walk Transform VNode n@@ -75,7 +79,7 @@   var_nid <- newBind nid   return $ gHas2 (spiderNodeIdKey spider) var_nid -gHasNodeEID :: (WalkType c) => EID -> Binder (Walk c VNode VNode)+gHasNodeEID :: (WalkType c) => EID VNode -> Binder (Walk c VNode VNode) gHasNodeEID eid = do   var_eid <- newBind eid   return $ gHasId var_eid@@ -85,25 +89,25 @@   var_nid <- newBind nid   return $ gProperty (spiderNodeIdKey spider) var_nid $. sAddV "node" $ source "g" -gGetNodeByEID :: EID -> Binder (Walk Transform s VNode)+gGetNodeByEID :: EID VNode -> Binder (Walk Transform s VNode) gGetNodeByEID vid = do   f <- gHasNodeEID vid   return (f <<< gV [])  -gAllFoundNode :: GTraversal Transform () (VFoundNode na)+gAllFoundNode :: GTraversal Transform () VFoundNode gAllFoundNode = gHasLabel "found_node" $. sV [] $ source "g" -gHasFoundNodeEID :: WalkType c => EID -> Binder (Walk c (VFoundNode na) (VFoundNode na))+gHasFoundNodeEID :: WalkType c => EID VFoundNode -> Binder (Walk c VFoundNode VFoundNode) gHasFoundNodeEID eid = do   var_eid <- newBind eid   return $ gHasId var_eid  gMakeFoundNode :: (LinkAttributes la, NodeAttributes na)-               => EID -- ^ subject node EID-               -> [(FoundLink n la, EID)] -- ^ (link, target node EID)+               => EID VNode -- ^ subject node EID+               -> [(FoundLink n la, EID VNode)] -- ^ (link, target node EID)                -> FoundNode n na la-               -> Binder (GTraversal SideEffect () (VFoundNode na))+               -> Binder (GTraversal SideEffect () VFoundNode) gMakeFoundNode subject_vid link_pairs fnode =    mAddFindsEdges   <*.> writeNodeAttributes (nodeAttributes fnode)@@ -111,53 +115,34 @@   <*.> mAddObservedEdge   <*.> pure $ sAddV "found_node" $ source "g"   where-    mAddObservedEdge :: Binder (Walk SideEffect (VFoundNode na) (VFoundNode na))+    mAddObservedEdge :: Binder (Walk SideEffect VFoundNode VFoundNode)     mAddObservedEdge = do       v <- gGetNodeByEID subject_vid       return $ gSideEffect $ emitsAEdge $ gAddE "is_observed_as" $ gFrom v     mAddFindsEdges = fmap fold $ traverse mAddFindsEdgeFor link_pairs-    mAddFindsEdgeFor :: LinkAttributes la => (FoundLink n la, EID) -> Binder (Walk SideEffect (VFoundNode na) (VFoundNode na))+    mAddFindsEdgeFor :: LinkAttributes la => (FoundLink n la, EID VNode) -> Binder (Walk SideEffect VFoundNode VFoundNode)     mAddFindsEdgeFor (link, target_vid) = do       v <- gGetNodeByEID target_vid-      var_ls <- newBind $ linkStateToText $ linkState link+      g_set_link_state <- gSetLinkState $ linkState link       addAttrs <- writeLinkAttributes $ linkAttributes link       return $ gSideEffect ( addAttrs-                             <<< gProperty "@link_state" var_ls+                             <<< g_set_link_state                              <<< gAddE "finds" (gTo v)                            ) -keyTimestamp :: Key (VFoundNode na) Int64-keyTimestamp = "@timestamp"-  -gSetTimestamp :: Timestamp -> Binder (Walk SideEffect (VFoundNode na) (VFoundNode na))-gSetTimestamp ts = do-  var_epoch <- newBind $ epochTime ts-  meta_props <- makeMetaProps $ timeZone ts-  return $ gPropertyV Nothing keyTimestamp var_epoch meta_props-  where-    makeMetaProps Nothing = return []-    makeMetaProps (Just tz) = do-      offset <- newBind $ timeZoneMinutes tz-      summer <- newBind $ timeZoneSummerOnly tz-      name <- newBind $ pack $ timeZoneName tz-      return $ [ "@tz_offset_min" =: offset,-                 "@tz_summer_only" =: summer,-                 "@tz_name" =: name-               ]- emitsAEdge :: ToGTraversal g => g c s AEdge -> g c s AEdge emitsAEdge = id  gClearAll :: GTraversal SideEffect () () gClearAll = void $ gDrop $. liftWalk $ sV' [] $ source "g" -gSelectFoundNode :: Walk Filter (VFoundNode na) (VFoundNode na) -> Walk Transform VNode (VFoundNode na)+gSelectFoundNode :: Walk Filter VFoundNode VFoundNode -> Walk Transform VNode VFoundNode gSelectFoundNode filterFoundNode = liftWalk filterFoundNode <<< gOut ["is_observed_as"] -gLatestFoundNode :: Walk Transform (VFoundNode na) (VFoundNode na)+gLatestFoundNode :: Walk Transform VFoundNode VFoundNode gLatestFoundNode = gLimit 1 <<< gOrder [gBy2 keyTimestamp oDecr] -gFilterFoundNodeByTime :: Interval Timestamp -> Binder (Walk Filter (VFoundNode na) (VFoundNode na))+gFilterFoundNodeByTime :: Interval Timestamp -> Binder (Walk Filter VFoundNode VFoundNode) gFilterFoundNodeByTime interval = do   fl <- filterLower   fh <- filterUpper@@ -174,8 +159,5 @@       (Finite ts, False) -> fmap (gHas2P keyTimestamp) $ fmap pLt  $ newBind $ epochTime ts       (Finite ts, True)  -> fmap (gHas2P keyTimestamp) $ fmap pLte $ newBind $ epochTime ts -gFinds :: Walk Transform (VFoundNode na) (EFinds la)+gFinds :: Walk Transform VFoundNode EFinds gFinds = gOutE ["finds"]--gFindsTarget :: Walk Transform (EFinds la) VNode-gFindsTarget = gInV

@@ -14,7 +14,8 @@ import Control.Applicative ((<$>)) import Control.Category ((<<<)) import Control.Exception.Safe (bracket, withException)-import Data.Greskell (parseOneValue, gProperty, newBind)+import Data.Aeson.Types (Parser)+import Data.Greskell (gProperty, newBind, lookupAs, pMapToFail, Key) import Data.List (sort) import Data.Text (Text) import Data.Vector (Vector)@@ -65,24 +66,30 @@ newtype AText = AText Text               deriving (Show,Eq,Ord) +keyText :: Key e Text+keyText = "text"+ instance NodeAttributes AText where-  writeNodeAttributes (AText t) = gProperty "text" <$> newBind t-  parseNodeAttributes ps = AText <$> parseOneValue "text" ps+  writeNodeAttributes (AText t) = gProperty keyText <$> newBind t+  parseNodeAttributes ps = fmap AText $ pMapToFail $ lookupAs keyText ps  instance LinkAttributes AText where-  writeLinkAttributes (AText t) = gProperty "text" <$> newBind t-  parseLinkAttributes ps = AText <$> parseOneValue "text" ps+  writeLinkAttributes (AText t) = gProperty keyText <$> newBind t+  parseLinkAttributes ps = fmap AText $ pMapToFail $ lookupAs keyText ps  newtype AInt = AInt Int              deriving (Show,Eq,Ord) +keyInt :: Key e Int +keyInt = "integer"+ instance NodeAttributes AInt where-  writeNodeAttributes (AInt n) = gProperty "integer" <$> newBind n-  parseNodeAttributes ps = AInt <$> parseOneValue "integer" ps+  writeNodeAttributes (AInt n) = gProperty keyInt <$> newBind n+  parseNodeAttributes ps = fmap AInt $ pMapToFail $ lookupAs keyInt ps  instance LinkAttributes AInt where-  writeLinkAttributes (AInt n) = gProperty "integer" <$> newBind n-  parseLinkAttributes ps = AInt <$> parseOneValue "integer" ps+  writeLinkAttributes (AInt n) = gProperty keyInt <$> newBind n+  parseLinkAttributes ps = fmap AInt $ pMapToFail $ lookupAs keyInt ps   -- | Pair of ports.@@ -96,14 +103,20 @@   }   deriving (Show,Eq,Ord) +keySubjectPort :: Key e Text+keySubjectPort = "subject_port"++keyTargetPort :: Key e Text+keyTargetPort = "target_port"+ instance LinkAttributes APorts where   writeLinkAttributes ap = do-    writeSource <- gProperty "subject_port" <$> newBind (apFst ap)-    writeDest <- gProperty "target_port" <$> newBind (apSnd ap)+    writeSource <- gProperty keySubjectPort <$> newBind (apFst ap)+    writeDest <- gProperty keyTargetPort <$> newBind (apSnd ap)     return (writeDest <<< writeSource)   parseLinkAttributes ps = APorts-                           <$> parseOneValue "subject_port" ps-                           <*> parseOneValue "target_port" ps+                           <$> (pMapToFail $ lookupAs keySubjectPort ps)+                           <*> (pMapToFail $ lookupAs keyTargetPort ps)  swapAPorts :: APorts -> APorts swapAPorts ap = ap { apFst = apSnd ap,