Graphology.purs 7.14 KB
Newer Older
1 2 3 4 5 6 7 8 9 10
module Gargantext.Hooks.Sigmax.Graphology where

-- FFI for graphology: https://graphology.github.io/

-- serialized graph: https://graphology.github.io/serialization#format
-- to use with: Graph.from(data)

import Prelude

import Data.Array as A
11
import Data.Function.Uncurried (Fn2, runFn2)
12 13
import Data.Sequence as Seq
import Data.Set as Set
14
import Data.Traversable (traverse, traverse_)
15 16 17 18 19 20 21 22 23 24
import Effect (Effect)
import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn3, EffectFn4, runEffectFn1, runEffectFn2, runEffectFn3, runEffectFn4)
import FFI.Simple ((..), (...), (.=))
import Gargantext.Hooks.Sigmax.Types as Types
import Record as Record

-- | Type representing `graphology.graph`
foreign import data Graph :: Type

foreign import _newGraph :: EffectFn1 Unit Graph
25

26
foreign import _addNode :: EffectFn3 Graph String (Record Types.Node) String
27
foreign import _updateNode :: EffectFn3 Graph String (Record Types.Node -> Record Types.Node) Unit
28
foreign import _addEdge :: EffectFn4 Graph String String (Record Types.Edge) String
29
foreign import _mergeNodeAttributes :: forall a. EffectFn3 Graph String a Unit
30
foreign import _forEachNode :: EffectFn2 Graph (Record Types.Node -> Effect Unit) Unit
31
--foreign import _updateEdge :: EffectFn4 Graph String String (Record Types.Edge) String
32
foreign import _mapNodes :: forall a. Fn2 Graph (Record Types.Node -> a) (Array a)
33 34
foreign import _filterNodes :: Fn2 Graph (Record Types.Node -> Boolean) (Array Types.NodeId)

35
foreign import _forEachEdge :: EffectFn2 Graph (Record Types.Edge -> Effect Unit) Unit
36
foreign import _updateEachEdgeAttributes :: EffectFn2 Graph (Record Types.Edge -> Record Types.Edge) Unit
37
foreign import _mapEdges :: forall a. Fn2 Graph (Record Types.Edge -> a) (Array a)
38 39
foreign import _filterEdges :: Fn2 Graph (Record Types.Edge -> Boolean) (Array Types.EdgeId)

40 41
foreign import _copy :: EffectFn1 Graph Graph

42 43 44 45

newGraph :: Unit -> Effect Graph
newGraph = runEffectFn1 _newGraph

46 47
graphFromSigmaxGraph :: Types.SGraph -> Effect Graph
graphFromSigmaxGraph g = do
48
  graph <- newGraph unit
49 50
  _ <- traverse (addNode graph) $ Types.graphNodes g
  _ <- traverse (addEdge graph) $ Types.graphEdges g
51 52 53 54 55 56
  pure graph

addNode :: Graph -> Record Types.Node -> Effect String
addNode g node@{ id } = runEffectFn3 _addNode g id node
removeNode :: Graph -> String -> Effect Unit
removeNode g nId = pure $ g ... "dropNode" $ [nId]
57 58
updateNode :: Graph -> Record Types.Node -> Effect Unit
-- | See Types.compareNodes
59 60 61 62 63
updateNode g node@{ id, borderColor, color, equilateral, hidden, highlighted, type: t } =
  runEffectFn3 _updateNode g id (\n -> n { borderColor = borderColor
                                         , color = color
                                         , equilateral = equilateral
                                         , hidden = hidden
64
                                         , highlighted = highlighted })
65 66
mergeNodeAttributes :: forall a. Graph -> Types.NodeId -> a -> Effect Unit
mergeNodeAttributes = runEffectFn3 _mergeNodeAttributes
67
forEachNode :: Graph -> (Record Types.Node -> Effect Unit) -> Effect Unit
68
forEachNode = runEffectFn2 _forEachNode
69 70
mapNodes :: forall a. Graph -> (Record Types.Node -> a) -> Array a
mapNodes = runFn2 _mapNodes
71 72
filterNodes :: Graph -> (Record Types.Node -> Boolean) -> Array Types.NodeId
filterNodes = runFn2 _filterNodes
73 74 75 76 77

addEdge :: Graph -> Record Types.Edge -> Effect String
addEdge g edge@{ source, target } = runEffectFn4 _addEdge g source target edge
removeEdge :: Graph -> String -> Effect Unit
removeEdge g eId = pure $ g ... "dropEdge" $ [eId]
78 79 80
updateEdge :: Graph -> Record Types.Edge -> Effect Unit
updateEdge _ _ = pure unit  -- TODO
--updateEdge g edge@{ source, target } = runEffectFn4 _updateEdge g source target edge
81
forEachEdge :: Graph -> (Record Types.Edge -> Effect Unit) -> Effect Unit
82 83 84 85
forEachEdge = runEffectFn2 _forEachEdge
--forEachEdge g fn = pure $ g ... "forEachEdge" $ [\_ e -> fn e]
mapEdges :: forall a. Graph -> (Record Types.Edge -> a) -> Array a
mapEdges = runFn2 _mapEdges
86 87
updateEachEdgeAttributes :: Graph -> (Record Types.Edge -> Record Types.Edge) -> Effect Unit
updateEachEdgeAttributes = runEffectFn2 _updateEachEdgeAttributes
88 89
filterEdges :: Graph -> (Record Types.Edge -> Boolean) -> Array Types.EdgeId
filterEdges = runFn2 _filterEdges
90

91 92 93
copy :: Graph -> Effect Graph
copy = runEffectFn1 _copy

94 95 96 97
-- TODO Maybe our use of this function (`updateWithGraph`) in code is
-- too much. We convert Types.Graph into Graphology.Graph and then
-- update Sigma.graph with this.

98 99
-- NOTE: See `sigmax.performDiff`

100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133
-- | Since we don't want to replace directly the sigma.graph, we call
-- update.  This "intelligently" scans the `target` graph and updates
-- so that in the end it is the same as `source`.
updateWithGraph :: Graph -> Graph -> Effect Graph
-- TODO Add updateEdgesFromGraph
updateWithGraph target source = updateNodesFromGraph target source

-- | Update `target` graph so that it's `.nodes` is the same as that
-- | of `source` (with attributes as well)
updateNodesFromGraph :: Graph -> Graph -> Effect Graph
-- TODO Fixme
updateNodesFromGraph source _target = pure source
-- updateNodesFromGraph target source =
--   forEachNode target $ node@{ id } -> do
--     if Set.member id sourceNodeIds then
--         -- update node
--   updateNodes (removeNodes (addNodes target missingNodes) newNodes) nodesToUpdate
--   where
--     sourceNodeIds = nodeIds source
--     sourceEdgeIds = edgeIds source
--     targetNodeIds = nodeIds target
--     targetEdgeIds = edgeIds target
--     newNodeIds = Set.difference sourceNodeIds targetNodeIds
--     missingNodeIds = Set.difference targetNodeIds sourceNodeIds

-- | Clear a graphology graph.
clear :: Graph -> Effect Unit
clear g = pure $ g ... "clear" $ []

edges_ :: Graph -> Array Types.EdgeId
edges_ g = g ... "edges" $ [] :: Array Types.EdgeId
nodes_ :: Graph -> Array Types.NodeId
nodes_ g = g ... "nodes" $ [] :: Array Types.NodeId

134 135 136 137 138 139
-- | `sigma.edges()` returns only edge keys, we need to map to get the full edge
edges :: Graph -> Seq.Seq (Record Types.Edge)
edges g = Seq.fromFoldable $ mapEdges g identity
-- | `sigma.nodes()` returns only node keys, we need to map to get the full node
nodes :: Graph -> Seq.Seq (Record Types.Node)
nodes g = Seq.fromFoldable $ mapNodes g identity
140 141 142

-- | Fetch ids of graph edges in a sigmajs instance.
edgeIds :: Graph -> Types.EdgeIds
143 144
-- auto-assigned edge ids are different from our edge ids
edgeIds g = Set.fromFoldable $ mapEdges g (\{ id } -> id) -- -<<< edges_
145 146 147 148 149 150

-- | Fetch ids of graph nodes in a sigmajs instance.
nodeIds :: Graph -> Types.NodeIds
nodeIds = Set.fromFoldable <<< nodes_


151 152 153 154 155 156 157 158
-- | Leave out only visible nodes/edges in a graph
updateGraphOnlyVisible :: Graph -> Effect Unit
updateGraphOnlyVisible g = do
  let hiddenNodeIds = filterNodes g (_.hidden)
  let hiddenEdgeIds = filterEdges g (_.hidden)
  traverse_ (removeEdge g) hiddenEdgeIds
  traverse_ (removeNode g) hiddenNodeIds

159 160 161 162 163 164 165 166
-- | Read graph into a graphology instance.
-- graphRead :: forall nodeExtra node edgeExtra edge.
--              NodeProps nodeExtra node => EdgeProps edgeExtra edge =>
--              SigmaGraph -> Graph node edge -> Effect (Either EEx.Error Unit)
-- graphRead sg g = EEx.try $ pure $ sg ... "read" $ [ g ]


--type Graph n e = { nodes :: Array {|n}, edges :: Array {|e} }