Commit 9c39f34c authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[Sigma] refactoring of sigma FFI, documentation added

parent db513bb3
......@@ -7,6 +7,7 @@
"build": "pulp --psc-package browserify -t dist/bundle.js",
"sass": "sass dist/styles/",
"dev": "webpack-dev-server --env dev --mode development",
"docs": "pulp docs -- --format html",
"repl": "pulp --psc-package repl",
"clean": "rm -Rf output",
"test": "pulp test"
......
......@@ -162,7 +162,7 @@ tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
, placeholder: "Search"
, type: "value"
, value: searchQuery
, on: {input: \e -> setSearchQuery (R2.unsafeEventValue e)}}
, on: {input: setSearchQuery <<< R2.unsafeEventValue}}
, H.div {} (
if A.null props.tableBody && searchQuery /= "" then [
H.button { className: "btn btn-primary"
......@@ -175,14 +175,14 @@ tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
[ R2.select { id: "picklistmenu"
, className: "form-control custom-select"
, value: (maybe "" show termListFilter)
, on: {change: (\e -> setTermListFilter $ readTermList $ R2.unsafeEventValue e)}}
, on: {change: setTermListFilter <<< readTermList <<< R2.unsafeEventValue}}
(map optps1 termLists)]]
, H.div {className: "col-md-2", style: {marginTop : "6px"}}
[ H.li {className: "list-group-item"}
[ R2.select {id: "picktermtype"
, className: "form-control custom-select"
, value: (maybe "" show termSizeFilter)
, on: {change: (\e -> setTermSizeFilter $ readTermSize $ R2.unsafeEventValue e)}}
, on: {change: setTermSizeFilter <<< readTermSize <<< R2.unsafeEventValue}}
(map optps1 termSizes)]]
, H.div {className: "col-md-4", style: {marginTop : "6px", marginBottom : "1px"}}
[ H.li {className: " list-group-item"}
......
......@@ -74,11 +74,12 @@ cleanupSigma sigma context = traverse_ kill (readSigma sigma)
refreshData :: forall n e. Sigma.Sigma -> Sigma.Graph n e -> Effect Unit
refreshData sigma graph
= log clearingMsg
*> Sigma.clear sigma
*> Sigma.clear sigmaGraph
*> log readingMsg
*> Sigma.graphRead sigma graph
*> Sigma.graphRead sigmaGraph graph
>>= either (log2 errorMsg) refresh
where
sigmaGraph = Sigma.graph sigma
refresh _ = log refreshingMsg *> Sigma.refresh sigma
clearingMsg = "[refreshData] Clearing existing graph data"
readingMsg = "[refreshData] Reading graph data"
......@@ -116,7 +117,7 @@ handleForceAtlas2Pause sigmaRef (toggled /\ setToggled) mFAPauseRef = do
dependOnSigma sigma "[handleForceAtlas2Pause] sigma: Nothing" $ \s -> do
--log2 "[handleForceAtlas2Pause] mSigma: Just " s
--log2 "[handleForceAtlas2Pause] toggled: " toggled
isFARunning <- Sigma.isForceAtlas2Running s
let isFARunning = Sigma.isForceAtlas2Running s
--log2 "[handleForceAtlas2Pause] isFARunning: " isFARunning
case Tuple toggled isFARunning of
Tuple ST.InitialRunning false -> do
......@@ -145,7 +146,7 @@ setEdges sigma val = do
updateEdges :: Sigma.Sigma -> ST.EdgesMap -> Effect Unit
updateEdges sigma edgesMap = do
Sigma.forEachEdge sigma \e -> do
Sigma.forEachEdge (Sigma.graph sigma) \e -> do
let mTEdge = Map.lookup e.id edgesMap
case mTEdge of
Nothing -> error $ "Edge id " <> e.id <> " not found in edgesMap"
......@@ -158,7 +159,7 @@ updateEdges sigma edgesMap = do
updateNodes :: Sigma.Sigma -> ST.NodesMap -> Effect Unit
updateNodes sigma nodesMap = do
Sigma.forEachNode sigma \n -> do
Sigma.forEachNode (Sigma.graph sigma) \n -> do
let mTNode = Map.lookup n.id nodesMap
case mTNode of
Nothing -> error $ "Node id " <> n.id <> " not found in nodesMap"
......@@ -166,7 +167,7 @@ updateNodes sigma nodesMap = do
, color: tColor
, equilateral: tEquilateral
, hidden: tHidden
, type: tType}) -> do
, type: tType }) -> do
_ <- pure $ (n .= "borderColor") tBorderColor
_ <- pure $ (n .= "color") tColor
_ <- pure $ (n .= "equilateral") tEquilateral
......@@ -213,24 +214,25 @@ selectorWithSize sigma size = do
performDiff :: Sigma.Sigma -> ST.SGraph -> Effect Unit
performDiff sigma g = do
sigmaEdgeIds <- Sigma.sigmaEdgeIds sigma
sigmaNodeIds <- Sigma.sigmaNodeIds sigma
let {add: Tuple addEdges addNodes, remove: Tuple removeEdges removeNodes} = ST.sigmaDiff sigmaEdgeIds sigmaNodeIds g
traverse_ (Sigma.addNode sigma) addNodes
traverse_ (Sigma.addEdge sigma) addEdges
traverse_ (Sigma.removeEdge sigma) removeEdges
traverse_ (Sigma.removeNode sigma) removeNodes
if (Seq.null addEdges) && (Seq.null addNodes) && (Set.isEmpty removeEdges) && (Set.isEmpty removeNodes) then
pure unit
else do
traverse_ (Sigma.addNode sigmaGraph) addNodes
traverse_ (Sigma.addEdge sigmaGraph) addEdges
traverse_ (Sigma.removeEdge sigmaGraph) removeEdges
traverse_ (Sigma.removeNode sigmaGraph) removeNodes
Sigma.refresh sigma
Sigma.killForceAtlas2 sigma
where
sigmaGraph = Sigma.graph sigma
sigmaEdgeIds = Sigma.sigmaEdgeIds sigmaGraph
sigmaNodeIds = Sigma.sigmaNodeIds sigmaGraph
{add: Tuple addEdges addNodes, remove: Tuple removeEdges removeNodes} = ST.sigmaDiff sigmaEdgeIds sigmaNodeIds g
-- DEPRECATED
markSelectedEdges :: Sigma.Sigma -> ST.SelectedEdgeIds -> ST.EdgesMap -> Effect Unit
markSelectedEdges sigma selectedEdgeIds graphEdges = do
Sigma.forEachEdge sigma \e -> do
Sigma.forEachEdge (Sigma.graph sigma) \e -> do
case Map.lookup e.id graphEdges of
Nothing -> error $ "Edge id " <> e.id <> " not found in graphEdges map"
Just {color} -> do
......@@ -245,7 +247,7 @@ markSelectedEdges sigma selectedEdgeIds graphEdges = do
markSelectedNodes :: Sigma.Sigma -> ST.SelectedNodeIds -> ST.NodesMap -> Effect Unit
markSelectedNodes sigma selectedNodeIds graphNodes = do
Sigma.forEachNode sigma \n -> do
Sigma.forEachNode (Sigma.graph sigma) \n -> do
case Map.lookup n.id graphNodes of
Nothing -> error $ "Node id " <> n.id <> " not found in graphNodes map"
Just {color} -> do
......
......@@ -148,14 +148,6 @@ function _sigma(left, right, opts) {
}
}
function graphRead(left, right, sigma, data) {
try {
return right(sigma.graph.read(data));
} catch(e) {
return left(e);
}
}
function refresh(sigma) { sigma.refresh(); }
function addRenderer(left, right, sigma, renderer) {
try {
return right(sigma.addRenderer(renderer));
......@@ -171,78 +163,9 @@ function bindMouseSelectorPlugin(left, right, sig) {
return left(e);
}
}
function killRenderer(left, right, sigma, renderer) {
try {
sigma.killRenderer(renderer);
return right(sigma)
} catch(e) {
return left(e);
}
}
function getRendererContainer(sigma) {
return sigma.renderers[0].container;
}
function setRendererContainer(sigma, el) {
sigma.renderers[0].container = el;
}
function killSigma(left, right, sigma) {
try {
sigma.kill()
return right(null)
} catch(e) {
return left(e);
}
}
function clear(sigma) { sigma.graph.clear(); }
function bind(sigma, event, handler) { sigma.bind(event, handler); }
function unbind(sigma, event) { sigma.unbind(event); }
function forEachNode(sigma, handler) { sigma.graph.nodes().forEach(handler); }
function forEachEdge(sigma, handler) { sigma.graph.edges().forEach(handler); }
function setSettings(sigma, settings) { sigma.settings(settings); }
function startForceAtlas2(sigma, settings) { sigma.startForceAtlas2(settings); }
function stopForceAtlas2(sigma) { sigma.stopForceAtlas2(); }
function killForceAtlas2(sigma) { sigma.killForceAtlas2(); }
function isForceAtlas2Running(sigma) { return sigma.isForceAtlas2Running(); }
function edgeIds(sigma) { return sigma.graph.edges().map(function(e) { return e.id; }); }
function nodeIds(sigma) { return sigma.graph.nodes().map(function(n) { return n.id; }); }
function addEdge(sigma, e) { return sigma.graph.addEdge(e); }
function removeEdge(sigma, e) { return sigma.graph.dropEdge(e); }
function addNode(sigma, n) { return sigma.graph.addNode(n); }
function removeNode(sigma, n) { return sigma.graph.dropNode(n); }
function getCameras(sigma) {
// For some reason, sigma.cameras is an object with integer keys
return Object.values(sigma.cameras);
};
function goTo(cam, props) {
return cam.goTo(props);
};
exports._sigma = _sigma;
exports._graphRead = graphRead;
exports._refresh = refresh;
exports._addRenderer = addRenderer;
exports._bindMouseSelectorPlugin = bindMouseSelectorPlugin;
exports._killRenderer = killRenderer;
exports._getRendererContainer = getRendererContainer;
exports._setRendererContainer = setRendererContainer;
exports._killSigma = killSigma
exports._clear = clear;
exports._bind = bind;
exports._unbind = unbind;
exports._forEachNode = forEachNode;
exports._forEachEdge = forEachEdge;
exports._setSettings = setSettings;
exports._startForceAtlas2 = startForceAtlas2;
exports._stopForceAtlas2 = stopForceAtlas2;
exports._killForceAtlas2 = killForceAtlas2;
exports._isForceAtlas2Running = isForceAtlas2Running;
exports._getCameras = getCameras;
exports._goTo = goTo;
exports._edgeIds = edgeIds;
exports._nodeIds = nodeIds;
exports._addEdge = addEdge;
exports._removeEdge = removeEdge;
exports._addNode = addNode;
exports._removeNode = removeNode;
module Gargantext.Hooks.Sigmax.Sigma where
import Prelude
import DOM.Simple.Types (Element)
import Data.Array as A
import Data.Either (Either(..))
import Data.Nullable (notNull, null, Nullable)
import Data.Maybe (Maybe)
import Data.Nullable (null)
import Data.Sequence as Seq
import Data.Set as Set
import DOM.Simple.Console (log2)
import DOM.Simple.Types (Element)
import FFI.Simple ((..))
import Effect (Effect, foreachE)
import Data.Traversable (traverse_)
import Effect (Effect)
import Effect.Exception as EEx
import Effect.Timer (setTimeout)
import Effect.Uncurried (EffectFn1, mkEffectFn1, runEffectFn1, EffectFn2, runEffectFn2, EffectFn3, runEffectFn3, EffectFn4, runEffectFn4)
import Type.Row (class Union)
import Reactix as R
import Effect.Uncurried (EffectFn1, EffectFn3, EffectFn4, mkEffectFn1, runEffectFn3, runEffectFn4)
import FFI.Simple ((..), (...), (.=))
import Foreign.Object as Object
import Gargantext.Hooks.Sigmax.Types as Types
import Type.Row (class Union)
-- | Type representing a sigmajs instance
foreign import data Sigma :: Type
-- | Type representing `sigma.graph`
foreign import data SigmaGraph :: Type
type NodeRequiredProps = ( id :: String )
type EdgeRequiredProps = ( id :: String, source :: String, target :: String )
type NodeRequiredProps = ( id :: Types.NodeId )
type EdgeRequiredProps = ( id :: Types.EdgeId, source :: Types.NodeId, target :: Types.NodeId )
class NodeProps (all :: #Type) (extra :: #Type) | all -> extra
class EdgeProps (all :: #Type) (extra :: #Type) | all -> extra
......@@ -30,196 +37,206 @@ instance nodeProps
instance edgeProps
:: Union EdgeRequiredProps extra all
=> EdgeProps all extra
type Graph n e = { nodes :: Array {|n}, edges :: Array {|e} }
type SigmaOpts s = { settings :: s }
foreign import _sigma ::
forall a b opts err.
EffectFn3 (a -> Either a b)
(b -> Either a b)
(SigmaOpts opts)
(Either err Sigma)
-- | Initialize sigmajs.
sigma :: forall opts err. SigmaOpts opts -> Effect (Either err Sigma)
sigma = runEffectFn3 _sigma Left Right
foreign import _graphRead ::
forall a b data_ err.
EffectFn4 (a -> Either a b)
(b -> Either a b)
Sigma
data_
(Either err Unit)
graphRead :: forall node edge err. Sigma -> Graph node edge -> Effect (Either err Unit)
graphRead = runEffectFn4 _graphRead Left Right
foreign import _refresh :: EffectFn1 Sigma Unit
-- | Call the `refresh()` method on a sigmajs instance.
refresh :: Sigma -> Effect Unit
refresh = runEffectFn1 _refresh
foreign import _addRenderer
:: forall a b r err.
EffectFn4 (a -> Either a b)
(b -> Either a b)
Sigma
r
(Either err Unit)
refresh s = pure $ s ... "refresh" $ []
-- | Type representing a sigmajs renderer.
foreign import data Renderer :: Type
type RendererType = String
--makeRenderer :: forall props. RendererType -> Element -> props -> Renderer
--makeRenderer type_ container props =
-- {
-- "type": type_
-- , container
-- | props
-- }
-- | Call the `addRenderer` method on a sigmajs instance.
--addRenderer :: forall err. Sigma -> Renderer -> Effect (Either err Unit)
addRenderer :: forall r err. Sigma -> r -> Effect (Either err Unit)
addRenderer = runEffectFn4 _addRenderer Left Right
foreign import _bindMouseSelectorPlugin
:: forall a b err.
EffectFn3 (a -> Either a b)
(b -> Either a b)
Sigma
(Either err Unit)
-- | Initialize the mouse selector plugin. This allows for custom bindings to mouse events.
bindMouseSelectorPlugin :: forall err. Sigma -> Effect (Either err Unit)
bindMouseSelectorPlugin = runEffectFn3 _bindMouseSelectorPlugin Left Right
foreign import _killRenderer
:: forall a b r err.
EffectFn4 (a -> Either a b)
(b -> Either a b)
Sigma
r
(Either err Unit)
killRenderer :: forall r err. Sigma -> r -> Effect (Either err Unit)
killRenderer = runEffectFn4 _killRenderer Left Right
foreign import _getRendererContainer
:: EffectFn1 Sigma Element
getRendererContainer :: Sigma -> Effect Element
getRendererContainer = runEffectFn1 _getRendererContainer
swapRendererContainer :: R.Ref (Nullable Element) -> Sigma -> Effect Unit
swapRendererContainer ref s = do
el <- getRendererContainer s
log2 "[swapRendererContainer] el" el
R.setRef ref $ notNull el
foreign import _setRendererContainer
:: EffectFn2 Sigma Element Unit
setRendererContainer :: Sigma -> Element -> Effect Unit
setRendererContainer = runEffectFn2 _setRendererContainer
foreign import _killSigma
:: forall a b err.
EffectFn3 (a -> Either a b)
(b -> Either a b)
Sigma
(Either err Unit)
killSigma :: forall err. Sigma -> Effect (Either err Unit)
killSigma = runEffectFn3 _killSigma Left Right
-- | Call `killRenderer` on a sigmajs instance.
killRenderer :: forall r. Sigma -> r -> Effect (Either EEx.Error Unit)
killRenderer s r = EEx.try $ pure $ s ... "killRenderer" $ [ r ]
foreign import _clear :: EffectFn1 Sigma Unit
clear :: Sigma -> Effect Unit
clear = runEffectFn1 _clear
-- | Get `renderers` of a sigmajs instance.
renderers :: Sigma -> Array Renderer
renderers s = s .. "renderers" :: Array Renderer
foreign import _bind :: forall e. EffectFn3 Sigma String (EffectFn1 e Unit) Unit
-- | Get the `container` of a sigmajs renderer.
rendererContainer :: Renderer -> Element
rendererContainer r = r .. "container"
-- | Return the container of first renderer in sigmajs instance's `renderers` list.
getRendererContainer :: Sigma -> Maybe Element
getRendererContainer s = rendererContainer <$> mContainer
where
mContainer = A.head $ renderers s
-- | Set the container of first renderer in sigmajs instance's `renderers` list.
setRendererContainer :: Renderer -> Element -> Effect Unit
setRendererContainer r el = do
_ <- pure $ (r .= "container") el
pure unit
-- | Call the `kill()` method on a sigmajs instance.
killSigma :: Sigma -> Effect (Either EEx.Error Unit)
killSigma s = EEx.try $ pure $ s ... "kill" $ []
-- | Get the `.graph` object from a sigmajs instance.
graph :: Sigma -> SigmaGraph
graph s = s .. "graph" :: SigmaGraph
-- | Read graph into a sigmajs 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 ]
-- | Clear a sigmajs graph.
clear :: SigmaGraph -> Effect Unit
clear sg = pure $ sg ... "clear" $ []
-- | Call `sigma.bind(event, handler)` on a sigmajs instance.
bind_ :: forall e. Sigma -> String -> (e -> Effect Unit) -> Effect Unit
bind_ s e h = runEffectFn3 _bind s e (mkEffectFn1 h)
foreign import _unbind :: EffectFn2 Sigma String Unit
unbind_ :: Sigma -> String -> Effect Unit
unbind_ s e = runEffectFn2 _unbind s e
foreign import _edgeIds :: EffectFn1 Sigma (Array String)
sigmaEdgeIds :: Sigma -> Effect Types.SelectedEdgeIds
sigmaEdgeIds s = do
edgeIds <- runEffectFn1 _edgeIds s
pure $ Set.fromFoldable edgeIds
foreign import _nodeIds :: EffectFn1 Sigma (Array String)
sigmaNodeIds :: Sigma -> Effect Types.SelectedNodeIds
sigmaNodeIds s = do
nodeIds <- runEffectFn1 _nodeIds s
pure $ Set.fromFoldable nodeIds
foreign import _addEdge :: EffectFn2 Sigma (Record Types.Edge) Unit
addEdge :: Sigma -> Record Types.Edge -> Effect Unit
addEdge s e = runEffectFn2 _addEdge s e
foreign import _removeEdge :: EffectFn2 Sigma String Unit
removeEdge :: Sigma -> String -> Effect Unit
removeEdge s eId = runEffectFn2 _removeEdge s eId
foreign import _addNode :: EffectFn2 Sigma (Record Types.Node) Unit
addNode :: Sigma -> Record Types.Node -> Effect Unit
addNode s n = runEffectFn2 _addNode s n
foreign import _removeNode :: EffectFn2 Sigma String Unit
removeNode :: Sigma -> String -> Effect Unit
removeNode s nId = runEffectFn2 _removeNode s nId
foreign import _forEachNode :: EffectFn2 Sigma (EffectFn1 (Record Types.Node) Unit) Unit
forEachNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit
forEachNode s f = runEffectFn2 _forEachNode s (mkEffectFn1 f)
foreign import _forEachEdge :: EffectFn2 Sigma (EffectFn1 (Record Types.Edge) Unit) Unit
forEachEdge :: Sigma -> (Record Types.Edge -> Effect Unit) -> Effect Unit
forEachEdge s f = runEffectFn2 _forEachEdge s (mkEffectFn1 f)
bindClickNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit
bindClickNode s f = bind_ s "clickNode" $ \e -> do
-- | Generic function to bind a sigmajs event for edges.
bindEdgeEvent :: Sigma -> String -> (Record Types.Edge -> Effect Unit) -> Effect Unit
bindEdgeEvent s ev f = bind_ s ev $ \e -> do
let edge = e .. "data" .. "edge" :: Record Types.Edge
f edge
-- | Generic function to bind a sigmajs event for nodes.
bindNodeEvent :: Sigma -> String -> (Record Types.Node -> Effect Unit) -> Effect Unit
bindNodeEvent s ev f = bind_ s ev $ \e -> do
let node = e .. "data" .. "node" :: Record Types.Node
f node
-- | Call `sigma.unbind(event)` on a sigmajs instance.
unbind_ :: Sigma -> String -> Effect Unit
unbind_ s e = pure $ s ... "unbind" $ [e]
edges_ :: SigmaGraph -> Array (Record Types.Edge)
edges_ sg = sg ... "edges" $ [] :: Array (Record Types.Edge)
nodes_ :: SigmaGraph -> Array (Record Types.Node)
nodes_ sg = sg ... "nodes" $ [] :: Array (Record Types.Node)
-- | Call `sigmaGraph.edges()` on a sigmajs graph instance.
edges :: SigmaGraph -> Seq.Seq (Record Types.Edge)
edges = Seq.fromFoldable <<< edges_
-- | Call `sigmaGraph.nodes()` on a sigmajs graph instance.
nodes :: SigmaGraph -> Seq.Seq (Record Types.Node)
nodes = Seq.fromFoldable <<< nodes_
-- | Fetch ids of graph edges in a sigmajs instance.
sigmaEdgeIds :: SigmaGraph -> Types.SelectedEdgeIds
sigmaEdgeIds sg = Set.fromFoldable edgeIds
where
edgeIds = _.id <$> edges sg
-- | Fetch ids of graph nodes in a sigmajs instance.
sigmaNodeIds :: SigmaGraph -> Types.SelectedNodeIds
sigmaNodeIds sg = Set.fromFoldable nodeIds
where
nodeIds = _.id <$> nodes sg
-- | Call `addEdge` on a sigmajs graph.
addEdge :: SigmaGraph -> Record Types.Edge -> Effect Unit
addEdge sg e = pure $ sg ... "addEdge" $ [e]
-- | Call `removeEdge` on a sigmajs graph.
removeEdge :: SigmaGraph -> String -> Effect Unit
removeEdge sg eId = pure $ sg ... "dropEdge" $ [eId]
--removeEdge = runEffectFn2 _removeEdge
-- | Call `addNode` on a sigmajs graph.
addNode :: SigmaGraph -> Record Types.Node -> Effect Unit
addNode sg n = pure $ sg ... "addNode" $ [n]
-- | Call `removeNode` on a sigmajs graph.
removeNode :: SigmaGraph -> String -> Effect Unit
removeNode sg nId = pure $ sg ... "dropNode" $ [nId]
-- | Iterate over all edges in a sigmajs graph.
forEachEdge :: SigmaGraph -> (Record Types.Edge -> Effect Unit) -> Effect Unit
forEachEdge sg f = traverse_ f (edges sg)
-- | Iterate over all nodes in a sigmajs graph.
forEachNode :: SigmaGraph -> (Record Types.Node -> Effect Unit) -> Effect Unit
forEachNode sg f = traverse_ f (nodes sg)
-- | Bind a `clickNode` event.
bindClickNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit
bindClickNode s f = bindNodeEvent s "clickNode" f
-- | Unbind a `clickNode` event.
unbindClickNode :: Sigma -> Effect Unit
unbindClickNode s = unbind_ s "clickNode"
-- | Bind a `clickNodes` event.
bindClickNodes :: Sigma -> (Array (Record Types.Node) -> Effect Unit) -> Effect Unit
bindClickNodes s f = bind_ s "clickNodes" $ \e -> do
let nodes = e .. "data" .. "node" :: Array (Record Types.Node)
f nodes
let ns = e .. "data" .. "node" :: Array (Record Types.Node)
f ns
-- | Unbind a `clickNodes` event.
unbindClickNodes :: Sigma -> Effect Unit
unbindClickNodes s = unbind_ s "clickNodes"
-- | Bind a `overNode` event.
bindOverNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit
bindOverNode s f = bind_ s "overNode" $ \e -> do
let node = e .. "data" .. "node" :: Record Types.Node
f node
bindOverNode s f = bindNodeEvent s "overNode" f
-- | Bind a `clickEdge` event.
bindClickEdge :: Sigma -> (Record Types.Edge -> Effect Unit) -> Effect Unit
bindClickEdge s f = bind_ s "clickEdge" $ \e -> do
let edge = e .. "data" .. "edge" :: Record Types.Edge
f edge
bindClickEdge s f = bindEdgeEvent s "clickEdge" f
-- | Unbind a `clickEdge` event.
unbindClickEdge :: Sigma -> Effect Unit
unbindClickEdge s = unbind_ s "clickEdge"
-- | Bind a `overEdge` event.
bindOverEdge :: Sigma -> (Record Types.Edge -> Effect Unit) -> Effect Unit
bindOverEdge s f = bind_ s "overEdge" $ \e -> do
let edge = e .. "data" .. "edge" :: Record Types.Edge
f edge
bindOverEdge s f = bindEdgeEvent s "overEdge" f
foreign import _setSettings :: forall settings. EffectFn2 Sigma settings Unit
-- | Call `settings(s)` on a sigmajs instance.
setSettings :: forall settings. Sigma -> settings -> Effect Unit
setSettings s settings = do
runEffectFn2 _setSettings s settings
_ <- pure $ s ... "settings" $ [ settings ]
refresh s
-- | Start forceAtlas2 on a sigmajs instance.
startForceAtlas2 :: forall settings. Sigma -> settings -> Effect Unit
startForceAtlas2 = runEffectFn2 _startForceAtlas2
startForceAtlas2 s settings = pure $ s ... "startForceAtlas2" $ [ settings ]
-- | Restart forceAtlas2 on a sigmajs instance.
restartForceAtlas2 :: Sigma -> Effect Unit
restartForceAtlas2 s = runEffectFn2 _startForceAtlas2 s null
restartForceAtlas2 s = startForceAtlas2 s null
-- | Stop forceAtlas2 on a sigmajs instance.
stopForceAtlas2 :: Sigma -> Effect Unit
stopForceAtlas2 = runEffectFn1 _stopForceAtlas2
stopForceAtlas2 s = pure $ s ... "stopForceAtlas2" $ []
-- | Kill forceAtlas2 on a sigmajs instance.
killForceAtlas2 :: Sigma -> Effect Unit
killForceAtlas2 = runEffectFn1 _killForceAtlas2
isForceAtlas2Running :: Sigma -> Effect Boolean
isForceAtlas2Running = runEffectFn1 _isForceAtlas2Running
killForceAtlas2 s = pure $ s ... "killForceAtlas2" $ []
foreign import _startForceAtlas2 :: forall s. EffectFn2 Sigma s Unit
foreign import _stopForceAtlas2 :: EffectFn1 Sigma Unit
foreign import _killForceAtlas2 :: EffectFn1 Sigma Unit
foreign import _isForceAtlas2Running :: EffectFn1 Sigma Boolean
-- | Return whether forceAtlas2 is running on a sigmajs instance.
isForceAtlas2Running :: Sigma -> Boolean
isForceAtlas2Running s = s ... "isForceAtlas2Running" $ [] :: Boolean
-- | Refresh forceAtlas2 (with a `setTimeout` hack as it seems it doesn't work
-- | otherwise).
refreshForceAtlas :: Sigma -> Effect Unit
refreshForceAtlas s = do
isRunning <- isForceAtlas2Running s
let isRunning = isForceAtlas2Running s
if isRunning then
pure unit
else do
......@@ -232,14 +249,15 @@ refreshForceAtlas s = do
newtype SigmaEasing = SigmaEasing String
sigmaEasing :: { linear :: SigmaEasing
, quadraticIn :: SigmaEasing
, quadraticOut :: SigmaEasing
, quadraticInOut :: SigmaEasing
, cubicIn :: SigmaEasing
, cubicOut :: SigmaEasing
, cubicInOut :: SigmaEasing
}
sigmaEasing ::
{ linear :: SigmaEasing
, quadraticIn :: SigmaEasing
, quadraticOut :: SigmaEasing
, quadraticInOut :: SigmaEasing
, cubicIn :: SigmaEasing
, cubicOut :: SigmaEasing
, cubicInOut :: SigmaEasing
}
sigmaEasing =
{ linear : SigmaEasing "linear"
, quadraticIn : SigmaEasing "quadraticIn"
......@@ -260,18 +278,37 @@ type CameraProps =
foreign import data CameraInstance' :: # Type
type CameraInstance = { | CameraInstance' }
cameras :: Sigma -> Effect (Array CameraInstance)
cameras = runEffectFn1 _getCameras
foreign import _getCameras :: EffectFn1 Sigma (Array CameraInstance)
-- | Get an array of a sigma instance's `cameras`.
cameras :: Sigma -> Array CameraInstance
cameras s = Object.values cs
where
-- For some reason, `sigma.cameras` is an object with integer keys.
cs = s .. "cameras" :: Object.Object CameraInstance
goTo :: Record CameraProps -> CameraInstance -> Effect Unit
goTo props cam = do
runEffectFn2 _goTo cam props
foreign import _goTo :: EffectFn2 CameraInstance (Record CameraProps) Unit
goTo props cam = pure $ cam ... "goTo" $ [props]
goToAllCameras :: Sigma -> Record CameraProps -> Effect Unit
goToAllCameras s props = do
cs <- cameras s
foreachE cs (goTo props)
goToAllCameras s props = traverse_ (goTo props) $ cameras s
-- | FFI
foreign import _sigma ::
forall a b opts err.
EffectFn3 (a -> Either a b)
(b -> Either a b)
(SigmaOpts opts)
(Either err Sigma)
foreign import _addRenderer
:: forall a b r err.
EffectFn4 (a -> Either a b)
(b -> Either a b)
Sigma
r
(Either err Unit)
foreign import _bindMouseSelectorPlugin
:: forall a b err.
EffectFn3 (a -> Either a b)
(b -> Either a b)
Sigma
(Either err Unit)
foreign import _bind :: forall e. EffectFn3 Sigma String (EffectFn1 e Unit) Unit
......@@ -26,6 +26,8 @@ newtype Graph n e = Graph { edges :: Seq.Seq {|e}, nodes :: Seq.Seq {|n} }
type Renderer = { "type" :: String, container :: Element }
type NodeId = String
type EdgeId = String
type Node =
( borderColor :: String
......@@ -33,7 +35,7 @@ type Node =
, equilateral :: { numPoints :: Int }
, gargType :: GT.Mode
, hidden :: Boolean
, id :: String
, id :: NodeId
, label :: String
, size :: Number
, type :: String -- available types: circle, cross, def, diamond, equilateral, pacman, square, star
......@@ -44,17 +46,17 @@ type Node =
type Edge =
( color :: String
, confluence :: Number
, id :: String
, id :: EdgeId
, hidden :: Boolean
, size :: Number
, source :: String
, source :: NodeId
, sourceNode :: Record Node
, target :: String
, target :: NodeId
, targetNode :: Record Node
, weight :: Number )
type SelectedNodeIds = Set.Set String
type SelectedEdgeIds = Set.Set String
type SelectedNodeIds = Set.Set NodeId
type SelectedEdgeIds = Set.Set EdgeId
type EdgesMap = Map.Map String (Record Edge)
type NodesMap = Map.Map String (Record Node)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment