Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
purescript-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
137
Issues
137
List
Board
Labels
Milestones
Merge Requests
4
Merge Requests
4
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
purescript-gargantext
Commits
9c39f34c
Commit
9c39f34c
authored
Jan 02, 2020
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[Sigma] refactoring of sigma FFI, documentation added
parent
db513bb3
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
235 additions
and
270 deletions
+235
-270
package.json
package.json
+1
-0
NgramsTable.purs
src/Gargantext/Components/NgramsTable.purs
+3
-3
Sigmax.purs
src/Gargantext/Hooks/Sigmax.purs
+18
-16
Sigma.js
src/Gargantext/Hooks/Sigmax/Sigma.js
+0
-77
Sigma.purs
src/Gargantext/Hooks/Sigmax/Sigma.purs
+205
-168
Types.purs
src/Gargantext/Hooks/Sigmax/Types.purs
+8
-6
No files found.
package.json
View file @
9c39f34c
...
@@ -7,6 +7,7 @@
...
@@ -7,6 +7,7 @@
"build"
:
"pulp --psc-package browserify -t dist/bundle.js"
,
"build"
:
"pulp --psc-package browserify -t dist/bundle.js"
,
"sass"
:
"sass dist/styles/"
,
"sass"
:
"sass dist/styles/"
,
"dev"
:
"webpack-dev-server --env dev --mode development"
,
"dev"
:
"webpack-dev-server --env dev --mode development"
,
"docs"
:
"pulp docs -- --format html"
,
"repl"
:
"pulp --psc-package repl"
,
"repl"
:
"pulp --psc-package repl"
,
"clean"
:
"rm -Rf output"
,
"clean"
:
"rm -Rf output"
,
"test"
:
"pulp test"
"test"
:
"pulp test"
...
...
src/Gargantext/Components/NgramsTable.purs
View file @
9c39f34c
...
@@ -162,7 +162,7 @@ tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
...
@@ -162,7 +162,7 @@ tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
, placeholder: "Search"
, placeholder: "Search"
, type: "value"
, type: "value"
, value: searchQuery
, value: searchQuery
, on: {input:
\e -> setSearchQuery (R2.unsafeEventValue e)
}}
, on: {input:
setSearchQuery <<< R2.unsafeEventValue
}}
, H.div {} (
, H.div {} (
if A.null props.tableBody && searchQuery /= "" then [
if A.null props.tableBody && searchQuery /= "" then [
H.button { className: "btn btn-primary"
H.button { className: "btn btn-primary"
...
@@ -175,14 +175,14 @@ tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
...
@@ -175,14 +175,14 @@ tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
[ R2.select { id: "picklistmenu"
[ R2.select { id: "picklistmenu"
, className: "form-control custom-select"
, className: "form-control custom-select"
, value: (maybe "" show termListFilter)
, value: (maybe "" show termListFilter)
, on: {change:
(\e -> setTermListFilter $ readTermList $ R2.unsafeEventValue e)
}}
, on: {change:
setTermListFilter <<< readTermList <<< R2.unsafeEventValue
}}
(map optps1 termLists)]]
(map optps1 termLists)]]
, H.div {className: "col-md-2", style: {marginTop : "6px"}}
, H.div {className: "col-md-2", style: {marginTop : "6px"}}
[ H.li {className: "list-group-item"}
[ H.li {className: "list-group-item"}
[ R2.select {id: "picktermtype"
[ R2.select {id: "picktermtype"
, className: "form-control custom-select"
, className: "form-control custom-select"
, value: (maybe "" show termSizeFilter)
, value: (maybe "" show termSizeFilter)
, on: {change:
(\e -> setTermSizeFilter $ readTermSize $ R2.unsafeEventValue e)
}}
, on: {change:
setTermSizeFilter <<< readTermSize <<< R2.unsafeEventValue
}}
(map optps1 termSizes)]]
(map optps1 termSizes)]]
, H.div {className: "col-md-4", style: {marginTop : "6px", marginBottom : "1px"}}
, H.div {className: "col-md-4", style: {marginTop : "6px", marginBottom : "1px"}}
[ H.li {className: " list-group-item"}
[ H.li {className: " list-group-item"}
...
...
src/Gargantext/Hooks/Sigmax.purs
View file @
9c39f34c
...
@@ -74,11 +74,12 @@ cleanupSigma sigma context = traverse_ kill (readSigma sigma)
...
@@ -74,11 +74,12 @@ cleanupSigma sigma context = traverse_ kill (readSigma sigma)
refreshData :: forall n e. Sigma.Sigma -> Sigma.Graph n e -> Effect Unit
refreshData :: forall n e. Sigma.Sigma -> Sigma.Graph n e -> Effect Unit
refreshData sigma graph
refreshData sigma graph
= log clearingMsg
= log clearingMsg
*> Sigma.clear sigma
*> Sigma.clear sigma
Graph
*> log readingMsg
*> log readingMsg
*> Sigma.graphRead sigma graph
*> Sigma.graphRead sigma
Graph
graph
>>= either (log2 errorMsg) refresh
>>= either (log2 errorMsg) refresh
where
where
sigmaGraph = Sigma.graph sigma
refresh _ = log refreshingMsg *> Sigma.refresh sigma
refresh _ = log refreshingMsg *> Sigma.refresh sigma
clearingMsg = "[refreshData] Clearing existing graph data"
clearingMsg = "[refreshData] Clearing existing graph data"
readingMsg = "[refreshData] Reading graph data"
readingMsg = "[refreshData] Reading graph data"
...
@@ -116,7 +117,7 @@ handleForceAtlas2Pause sigmaRef (toggled /\ setToggled) mFAPauseRef = do
...
@@ -116,7 +117,7 @@ handleForceAtlas2Pause sigmaRef (toggled /\ setToggled) mFAPauseRef = do
dependOnSigma sigma "[handleForceAtlas2Pause] sigma: Nothing" $ \s -> do
dependOnSigma sigma "[handleForceAtlas2Pause] sigma: Nothing" $ \s -> do
--log2 "[handleForceAtlas2Pause] mSigma: Just " s
--log2 "[handleForceAtlas2Pause] mSigma: Just " s
--log2 "[handleForceAtlas2Pause] toggled: " toggled
--log2 "[handleForceAtlas2Pause] toggled: " toggled
isFARunning <-
Sigma.isForceAtlas2Running s
let isFARunning =
Sigma.isForceAtlas2Running s
--log2 "[handleForceAtlas2Pause] isFARunning: " isFARunning
--log2 "[handleForceAtlas2Pause] isFARunning: " isFARunning
case Tuple toggled isFARunning of
case Tuple toggled isFARunning of
Tuple ST.InitialRunning false -> do
Tuple ST.InitialRunning false -> do
...
@@ -145,7 +146,7 @@ setEdges sigma val = do
...
@@ -145,7 +146,7 @@ setEdges sigma val = do
updateEdges :: Sigma.Sigma -> ST.EdgesMap -> Effect Unit
updateEdges :: Sigma.Sigma -> ST.EdgesMap -> Effect Unit
updateEdges sigma edgesMap = do
updateEdges sigma edgesMap = do
Sigma.forEachEdge
sigma
\e -> do
Sigma.forEachEdge
(Sigma.graph sigma)
\e -> do
let mTEdge = Map.lookup e.id edgesMap
let mTEdge = Map.lookup e.id edgesMap
case mTEdge of
case mTEdge of
Nothing -> error $ "Edge id " <> e.id <> " not found in edgesMap"
Nothing -> error $ "Edge id " <> e.id <> " not found in edgesMap"
...
@@ -158,7 +159,7 @@ updateEdges sigma edgesMap = do
...
@@ -158,7 +159,7 @@ updateEdges sigma edgesMap = do
updateNodes :: Sigma.Sigma -> ST.NodesMap -> Effect Unit
updateNodes :: Sigma.Sigma -> ST.NodesMap -> Effect Unit
updateNodes sigma nodesMap = do
updateNodes sigma nodesMap = do
Sigma.forEachNode
sigma
\n -> do
Sigma.forEachNode
(Sigma.graph sigma)
\n -> do
let mTNode = Map.lookup n.id nodesMap
let mTNode = Map.lookup n.id nodesMap
case mTNode of
case mTNode of
Nothing -> error $ "Node id " <> n.id <> " not found in nodesMap"
Nothing -> error $ "Node id " <> n.id <> " not found in nodesMap"
...
@@ -166,7 +167,7 @@ updateNodes sigma nodesMap = do
...
@@ -166,7 +167,7 @@ updateNodes sigma nodesMap = do
, color: tColor
, color: tColor
, equilateral: tEquilateral
, equilateral: tEquilateral
, hidden: tHidden
, hidden: tHidden
, type: tType}) -> do
, type: tType
}) -> do
_ <- pure $ (n .= "borderColor") tBorderColor
_ <- pure $ (n .= "borderColor") tBorderColor
_ <- pure $ (n .= "color") tColor
_ <- pure $ (n .= "color") tColor
_ <- pure $ (n .= "equilateral") tEquilateral
_ <- pure $ (n .= "equilateral") tEquilateral
...
@@ -213,24 +214,25 @@ selectorWithSize sigma size = do
...
@@ -213,24 +214,25 @@ selectorWithSize sigma size = do
performDiff :: Sigma.Sigma -> ST.SGraph -> Effect Unit
performDiff :: Sigma.Sigma -> ST.SGraph -> Effect Unit
performDiff sigma g = do
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
if (Seq.null addEdges) && (Seq.null addNodes) && (Set.isEmpty removeEdges) && (Set.isEmpty removeNodes) then
pure unit
pure unit
else do
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.refresh sigma
Sigma.killForceAtlas2 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
-- DEPRECATED
markSelectedEdges :: Sigma.Sigma -> ST.SelectedEdgeIds -> ST.EdgesMap -> Effect Unit
markSelectedEdges :: Sigma.Sigma -> ST.SelectedEdgeIds -> ST.EdgesMap -> Effect Unit
markSelectedEdges sigma selectedEdgeIds graphEdges = do
markSelectedEdges sigma selectedEdgeIds graphEdges = do
Sigma.forEachEdge
sigma
\e -> do
Sigma.forEachEdge
(Sigma.graph sigma)
\e -> do
case Map.lookup e.id graphEdges of
case Map.lookup e.id graphEdges of
Nothing -> error $ "Edge id " <> e.id <> " not found in graphEdges map"
Nothing -> error $ "Edge id " <> e.id <> " not found in graphEdges map"
Just {color} -> do
Just {color} -> do
...
@@ -245,7 +247,7 @@ markSelectedEdges sigma selectedEdgeIds graphEdges = do
...
@@ -245,7 +247,7 @@ markSelectedEdges sigma selectedEdgeIds graphEdges = do
markSelectedNodes :: Sigma.Sigma -> ST.SelectedNodeIds -> ST.NodesMap -> Effect Unit
markSelectedNodes :: Sigma.Sigma -> ST.SelectedNodeIds -> ST.NodesMap -> Effect Unit
markSelectedNodes sigma selectedNodeIds graphNodes = do
markSelectedNodes sigma selectedNodeIds graphNodes = do
Sigma.forEachNode
sigma
\n -> do
Sigma.forEachNode
(Sigma.graph sigma)
\n -> do
case Map.lookup n.id graphNodes of
case Map.lookup n.id graphNodes of
Nothing -> error $ "Node id " <> n.id <> " not found in graphNodes map"
Nothing -> error $ "Node id " <> n.id <> " not found in graphNodes map"
Just {color} -> do
Just {color} -> do
...
...
src/Gargantext/Hooks/Sigmax/Sigma.js
View file @
9c39f34c
...
@@ -148,14 +148,6 @@ function _sigma(left, right, opts) {
...
@@ -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
)
{
function
addRenderer
(
left
,
right
,
sigma
,
renderer
)
{
try
{
try
{
return
right
(
sigma
.
addRenderer
(
renderer
));
return
right
(
sigma
.
addRenderer
(
renderer
));
...
@@ -171,78 +163,9 @@ function bindMouseSelectorPlugin(left, right, sig) {
...
@@ -171,78 +163,9 @@ function bindMouseSelectorPlugin(left, right, sig) {
return
left
(
e
);
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
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
.
_sigma
=
_sigma
;
exports
.
_graphRead
=
graphRead
;
exports
.
_refresh
=
refresh
;
exports
.
_addRenderer
=
addRenderer
;
exports
.
_addRenderer
=
addRenderer
;
exports
.
_bindMouseSelectorPlugin
=
bindMouseSelectorPlugin
;
exports
.
_bindMouseSelectorPlugin
=
bindMouseSelectorPlugin
;
exports
.
_killRenderer
=
killRenderer
;
exports
.
_getRendererContainer
=
getRendererContainer
;
exports
.
_setRendererContainer
=
setRendererContainer
;
exports
.
_killSigma
=
killSigma
exports
.
_clear
=
clear
;
exports
.
_bind
=
bind
;
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
;
src/Gargantext/Hooks/Sigmax/Sigma.purs
View file @
9c39f34c
module Gargantext.Hooks.Sigmax.Sigma where
module Gargantext.Hooks.Sigmax.Sigma where
import Prelude
import Prelude
import DOM.Simple.Types (Element)
import Data.Array as A
import Data.Either (Either(..))
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 Data.Set as Set
import DOM.Simple.Console (log2)
import Data.Traversable (traverse_)
import DOM.Simple.Types (Element)
import Effect (Effect)
import FFI.Simple ((..))
import Effect.Exception as EEx
import Effect (Effect, foreachE)
import Effect.Timer (setTimeout)
import Effect.Timer (setTimeout)
import Effect.Uncurried (EffectFn1, mkEffectFn1, runEffectFn1, EffectFn2, runEffectFn2, EffectFn3, runEffectFn3, EffectFn4, runEffectFn4)
import Effect.Uncurried (EffectFn1, EffectFn3, EffectFn4, mkEffectFn1, runEffectFn3, runEffectFn4)
import Type.Row (class Union)
import FFI.Simple ((..), (...), (.=))
import Reactix as R
import Foreign.Object as Object
import Gargantext.Hooks.Sigmax.Types as Types
import Gargantext.Hooks.Sigmax.Types as Types
import Type.Row (class Union)
-- | Type representing a sigmajs instance
foreign import data Sigma :: Type
foreign import data Sigma :: Type
-- | Type representing `sigma.graph`
foreign import data SigmaGraph :: Type
type NodeRequiredProps = ( id ::
String
)
type NodeRequiredProps = ( id ::
Types.NodeId
)
type EdgeRequiredProps = ( id ::
String, source :: String, target :: String
)
type EdgeRequiredProps = ( id ::
Types.EdgeId, source :: Types.NodeId, target :: Types.NodeId
)
class NodeProps (all :: #Type) (extra :: #Type) | all -> extra
class NodeProps (all :: #Type) (extra :: #Type) | all -> extra
class EdgeProps (all :: #Type) (extra :: #Type) | all -> extra
class EdgeProps (all :: #Type) (extra :: #Type) | all -> extra
...
@@ -30,196 +37,206 @@ instance nodeProps
...
@@ -30,196 +37,206 @@ instance nodeProps
instance edgeProps
instance edgeProps
:: Union EdgeRequiredProps extra all
:: Union EdgeRequiredProps extra all
=> EdgeProps all extra
=> EdgeProps all extra
type Graph n e = { nodes :: Array {|n}, edges :: Array {|e} }
type Graph n e = { nodes :: Array {|n}, edges :: Array {|e} }
type SigmaOpts s = { settings :: s }
type SigmaOpts s = { settings :: s }
foreign import _sigma ::
-- | Initialize sigmajs.
forall a b opts err.
EffectFn3 (a -> Either a b)
(b -> Either a b)
(SigmaOpts opts)
(Either err Sigma)
sigma :: forall opts err. SigmaOpts opts -> Effect (Either err Sigma)
sigma :: forall opts err. SigmaOpts opts -> Effect (Either err Sigma)
sigma = runEffectFn3 _sigma Left Right
sigma = runEffectFn3 _sigma Left Right
foreign import _graphRead ::
-- | Call the `refresh()` method on a sigmajs instance.
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
refresh :: Sigma -> Effect Unit
refresh :: Sigma -> Effect Unit
refresh = runEffectFn1 _refresh
refresh s = pure $ s ... "refresh" $ []
foreign import _addRenderer
-- | Type representing a sigmajs renderer.
:: forall a b r err.
foreign import data Renderer :: Type
EffectFn4 (a -> Either a b)
type RendererType = String
(b -> Either a b)
Sigma
--makeRenderer :: forall props. RendererType -> Element -> props -> Renderer
r
--makeRenderer type_ container props =
(Either err Unit)
-- {
-- "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 :: forall r err. Sigma -> r -> Effect (Either err Unit)
addRenderer = runEffectFn4 _addRenderer Left Right
addRenderer = runEffectFn4 _addRenderer Left Right
foreign import _bindMouseSelectorPlugin
-- | Initialize the mouse selector plugin. This allows for custom bindings to mouse events.
:: forall a b err.
EffectFn3 (a -> Either a b)
(b -> Either a b)
Sigma
(Either err Unit)
bindMouseSelectorPlugin :: forall err. Sigma -> Effect (Either err Unit)
bindMouseSelectorPlugin :: forall err. Sigma -> Effect (Either err Unit)
bindMouseSelectorPlugin = runEffectFn3 _bindMouseSelectorPlugin Left Right
bindMouseSelectorPlugin = runEffectFn3 _bindMouseSelectorPlugin Left Right
foreign import _killRenderer
-- | Call `killRenderer` on a sigmajs instance.
:: forall a b r err.
killRenderer :: forall r. Sigma -> r -> Effect (Either EEx.Error Unit)
EffectFn4 (a -> Either a b)
killRenderer s r = EEx.try $ pure $ s ... "killRenderer" $ [ r ]
(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
foreign import _clear :: EffectFn1 Sigma Unit
-- | Get `renderers` of a sigmajs instance.
clear :: Sigma -> Effect Unit
renderers :: Sigma -> Array Renderer
clear = runEffectFn1 _clea
r
renderers s = s .. "renderers" :: Array Rendere
r
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_ :: forall e. Sigma -> String -> (e -> Effect Unit) -> Effect Unit
bind_ s e h = runEffectFn3 _bind s e (mkEffectFn1 h)
bind_ s e h = runEffectFn3 _bind s e (mkEffectFn1 h)
foreign import _unbind :: EffectFn2 Sigma String Unit
-- | Generic function to bind a sigmajs event for edges.
unbind_ :: Sigma -> String -> Effect Unit
bindEdgeEvent :: Sigma -> String -> (Record Types.Edge -> Effect Unit) -> Effect Unit
unbind_ s e = runEffectFn2 _unbind s e
bindEdgeEvent s ev f = bind_ s ev $ \e -> do
let edge = e .. "data" .. "edge" :: Record Types.Edge
foreign import _edgeIds :: EffectFn1 Sigma (Array String)
f edge
sigmaEdgeIds :: Sigma -> Effect Types.SelectedEdgeIds
-- | Generic function to bind a sigmajs event for nodes.
sigmaEdgeIds s = do
bindNodeEvent :: Sigma -> String -> (Record Types.Node -> Effect Unit) -> Effect Unit
edgeIds <- runEffectFn1 _edgeIds s
bindNodeEvent s ev f = bind_ s ev $ \e -> do
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
let node = e .. "data" .. "node" :: Record Types.Node
let node = e .. "data" .. "node" :: Record Types.Node
f 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 :: Sigma -> Effect Unit
unbindClickNode s = unbind_ s "clickNode"
unbindClickNode s = unbind_ s "clickNode"
-- | Bind a `clickNodes` event.
bindClickNodes :: Sigma -> (Array (Record Types.Node) -> Effect Unit) -> Effect Unit
bindClickNodes :: Sigma -> (Array (Record Types.Node) -> Effect Unit) -> Effect Unit
bindClickNodes s f = bind_ s "clickNodes" $ \e -> do
bindClickNodes s f = bind_ s "clickNodes" $ \e -> do
let n
ode
s = e .. "data" .. "node" :: Array (Record Types.Node)
let ns = e .. "data" .. "node" :: Array (Record Types.Node)
f n
ode
s
f ns
-- | Unbind a `clickNodes` event.
unbindClickNodes :: Sigma -> Effect Unit
unbindClickNodes :: Sigma -> Effect Unit
unbindClickNodes s = unbind_ s "clickNodes"
unbindClickNodes s = unbind_ s "clickNodes"
-- | Bind a `overNode` event.
bindOverNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit
bindOverNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit
bindOverNode s f = bind_ s "overNode" $ \e -> do
bindOverNode s f = bindNodeEvent s "overNode" f
let node = e .. "data" .. "node" :: Record Types.Node
f node
-- | Bind a `clickEdge` event.
bindClickEdge :: Sigma -> (Record Types.Edge -> Effect Unit) -> Effect Unit
bindClickEdge :: Sigma -> (Record Types.Edge -> Effect Unit) -> Effect Unit
bindClickEdge s f = bind_ s "clickEdge" $ \e -> do
bindClickEdge s f = bindEdgeEvent s "clickEdge" f
let edge = e .. "data" .. "edge" :: Record Types.Edge
-- | Unbind a `clickEdge` event.
f edge
unbindClickEdge :: Sigma -> Effect Unit
unbindClickEdge :: Sigma -> Effect Unit
unbindClickEdge s = unbind_ s "clickEdge"
unbindClickEdge s = unbind_ s "clickEdge"
-- | Bind a `overEdge` event.
bindOverEdge :: Sigma -> (Record Types.Edge -> Effect Unit) -> Effect Unit
bindOverEdge :: Sigma -> (Record Types.Edge -> Effect Unit) -> Effect Unit
bindOverEdge s f = bind_ s "overEdge" $ \e -> do
bindOverEdge s f = bindEdgeEvent s "overEdge" f
let edge = e .. "data" .. "edge" :: Record Types.Edge
f edge
foreign import _setSettings :: forall settings. EffectFn2 Sigma settings Unit
-- | Call `settings(s)` on a sigmajs instance.
setSettings :: forall settings. Sigma -> settings -> Effect Unit
setSettings :: forall settings. Sigma -> settings -> Effect Unit
setSettings s settings = do
setSettings s settings = do
runEffectFn2 _setSettings s settings
_ <- pure $ s ... "settings" $ [ settings ]
refresh s
refresh s
-- | Start forceAtlas2 on a sigmajs instance.
startForceAtlas2 :: forall settings. Sigma -> settings -> Effect Unit
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 :: 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 :: Sigma -> Effect Unit
stopForceAtlas2
= runEffectFn1 _stopForceAtlas2
stopForceAtlas2
s = pure $ s ... "stopForceAtlas2" $ []
-- | Kill forceAtlas2 on a sigmajs instance.
killForceAtlas2 :: Sigma -> Effect Unit
killForceAtlas2 :: Sigma -> Effect Unit
killForceAtlas2 = runEffectFn1 _killForceAtlas2
killForceAtlas2 s = pure $ s ... "killForceAtlas2" $ []
isForceAtlas2Running :: Sigma -> Effect Boolean
isForceAtlas2Running = runEffectFn1 _isForceAtlas2Running
foreign import _startForceAtlas2 :: forall s. EffectFn2 Sigma s Unit
-- | Return whether forceAtlas2 is running on a sigmajs instance.
foreign import _stopForceAtlas2 :: EffectFn1 Sigma Unit
isForceAtlas2Running :: Sigma -> Boolean
foreign import _killForceAtlas2 :: EffectFn1 Sigma Unit
isForceAtlas2Running s = s ... "isForceAtlas2Running" $ [] :: Boolean
foreign import _isForceAtlas2Running :: EffectFn1 Sigma Boolean
-- | Refresh forceAtlas2 (with a `setTimeout` hack as it seems it doesn't work
-- | otherwise).
refreshForceAtlas :: Sigma -> Effect Unit
refreshForceAtlas :: Sigma -> Effect Unit
refreshForceAtlas s = do
refreshForceAtlas s = do
isRunning <-
isForceAtlas2Running s
let isRunning =
isForceAtlas2Running s
if isRunning then
if isRunning then
pure unit
pure unit
else do
else do
...
@@ -232,14 +249,15 @@ refreshForceAtlas s = do
...
@@ -232,14 +249,15 @@ refreshForceAtlas s = do
newtype SigmaEasing = SigmaEasing String
newtype SigmaEasing = SigmaEasing String
sigmaEasing :: { linear :: SigmaEasing
sigmaEasing ::
, quadraticIn :: SigmaEasing
{ linear :: SigmaEasing
, quadraticOut :: SigmaEasing
, quadraticIn :: SigmaEasing
, quadraticInOut :: SigmaEasing
, quadraticOut :: SigmaEasing
, cubicIn :: SigmaEasing
, quadraticInOut :: SigmaEasing
, cubicOut :: SigmaEasing
, cubicIn :: SigmaEasing
, cubicInOut :: SigmaEasing
, cubicOut :: SigmaEasing
}
, cubicInOut :: SigmaEasing
}
sigmaEasing =
sigmaEasing =
{ linear : SigmaEasing "linear"
{ linear : SigmaEasing "linear"
, quadraticIn : SigmaEasing "quadraticIn"
, quadraticIn : SigmaEasing "quadraticIn"
...
@@ -260,18 +278,37 @@ type CameraProps =
...
@@ -260,18 +278,37 @@ type CameraProps =
foreign import data CameraInstance' :: # Type
foreign import data CameraInstance' :: # Type
type CameraInstance = { | CameraInstance' }
type CameraInstance = { | CameraInstance' }
cameras :: Sigma -> Effect (Array CameraInstance)
-- | Get an array of a sigma instance's `cameras`.
cameras = runEffectFn1 _getCameras
cameras :: Sigma -> Array CameraInstance
cameras s = Object.values cs
foreign import _getCameras :: EffectFn1 Sigma (Array CameraInstance)
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 :: Record CameraProps -> CameraInstance -> Effect Unit
goTo props cam = do
goTo props cam = pure $ cam ... "goTo" $ [props]
runEffectFn2 _goTo cam props
foreign import _goTo :: EffectFn2 CameraInstance (Record CameraProps) Unit
goToAllCameras :: Sigma -> Record CameraProps -> Effect Unit
goToAllCameras :: Sigma -> Record CameraProps -> Effect Unit
goToAllCameras s props = do
goToAllCameras s props = traverse_ (goTo props) $ cameras s
cs <- cameras s
foreachE cs (goTo props)
-- | 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
src/Gargantext/Hooks/Sigmax/Types.purs
View file @
9c39f34c
...
@@ -26,6 +26,8 @@ newtype Graph n e = Graph { edges :: Seq.Seq {|e}, nodes :: Seq.Seq {|n} }
...
@@ -26,6 +26,8 @@ newtype Graph n e = Graph { edges :: Seq.Seq {|e}, nodes :: Seq.Seq {|n} }
type Renderer = { "type" :: String, container :: Element }
type Renderer = { "type" :: String, container :: Element }
type NodeId = String
type EdgeId = String
type Node =
type Node =
( borderColor :: String
( borderColor :: String
...
@@ -33,7 +35,7 @@ type Node =
...
@@ -33,7 +35,7 @@ type Node =
, equilateral :: { numPoints :: Int }
, equilateral :: { numPoints :: Int }
, gargType :: GT.Mode
, gargType :: GT.Mode
, hidden :: Boolean
, hidden :: Boolean
, id ::
String
, id ::
NodeId
, label :: String
, label :: String
, size :: Number
, size :: Number
, type :: String -- available types: circle, cross, def, diamond, equilateral, pacman, square, star
, type :: String -- available types: circle, cross, def, diamond, equilateral, pacman, square, star
...
@@ -44,17 +46,17 @@ type Node =
...
@@ -44,17 +46,17 @@ type Node =
type Edge =
type Edge =
( color :: String
( color :: String
, confluence :: Number
, confluence :: Number
, id ::
String
, id ::
EdgeId
, hidden :: Boolean
, hidden :: Boolean
, size :: Number
, size :: Number
, source ::
String
, source ::
NodeId
, sourceNode :: Record Node
, sourceNode :: Record Node
, target ::
String
, target ::
NodeId
, targetNode :: Record Node
, targetNode :: Record Node
, weight :: Number )
, weight :: Number )
type SelectedNodeIds = Set.Set
String
type SelectedNodeIds = Set.Set
NodeId
type SelectedEdgeIds = Set.Set
String
type SelectedEdgeIds = Set.Set
EdgeId
type EdgesMap = Map.Map String (Record Edge)
type EdgesMap = Map.Map String (Record Edge)
type NodesMap = Map.Map String (Record Node)
type NodesMap = Map.Map String (Record Node)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment