Sigma.purs 10.8 KB
Newer Older
James Laver's avatar
James Laver committed
1 2 3
module Gargantext.Hooks.Sigmax.Sigma where

import Prelude
4 5 6

import DOM.Simple.Types (Element)
import Data.Array as A
James Laver's avatar
James Laver committed
7
import Data.Either (Either(..))
8 9 10
import Data.Maybe (Maybe)
import Data.Nullable (null)
import Data.Sequence as Seq
11
import Data.Set as Set
12 13 14
import Data.Traversable (traverse_)
import Effect (Effect)
import Effect.Exception as EEx
15
import Effect.Timer (setTimeout)
16 17 18
import Effect.Uncurried (EffectFn1, EffectFn3, EffectFn4, mkEffectFn1, runEffectFn3, runEffectFn4)
import FFI.Simple ((..), (...), (.=))
import Foreign.Object as Object
19
import Gargantext.Hooks.Sigmax.Types as Types
20
import Type.Row (class Union)
21

22
-- | Type representing a sigmajs instance
James Laver's avatar
James Laver committed
23
foreign import data Sigma :: Type
24 25
-- | Type representing `sigma.graph`
foreign import data SigmaGraph :: Type
James Laver's avatar
James Laver committed
26

27 28
type NodeRequiredProps = ( id :: Types.NodeId )
type EdgeRequiredProps = ( id :: Types.EdgeId, source :: Types.NodeId, target :: Types.NodeId )
James Laver's avatar
James Laver committed
29 30 31 32 33 34 35 36 37 38 39

class NodeProps (all :: #Type) (extra :: #Type) | all -> extra
class EdgeProps (all :: #Type) (extra :: #Type) | all -> extra

instance nodeProps
  :: Union NodeRequiredProps extra all
  => NodeProps all extra

instance edgeProps
  :: Union EdgeRequiredProps extra all
  => EdgeProps all extra
40

James Laver's avatar
James Laver committed
41 42 43
type Graph n e = { nodes :: Array {|n}, edges :: Array {|e} }
type SigmaOpts s = { settings :: s }

44
-- | Initialize sigmajs.
45 46
sigma :: forall opts err. SigmaOpts opts -> Effect (Either err Sigma)
sigma = runEffectFn3 _sigma Left Right
James Laver's avatar
James Laver committed
47

48
-- | Call the `refresh()` method on a sigmajs instance.
James Laver's avatar
James Laver committed
49
refresh :: Sigma -> Effect Unit
50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65
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)
66 67
addRenderer :: forall r err. Sigma -> r -> Effect (Either err Unit)
addRenderer = runEffectFn4 _addRenderer Left Right
68

69
-- | Initialize the mouse selector plugin. This allows for custom bindings to mouse events.
70 71
bindMouseSelectorPlugin :: forall err. Sigma -> Effect (Either err Unit)
bindMouseSelectorPlugin = runEffectFn3 _bindMouseSelectorPlugin Left Right
James Laver's avatar
James Laver committed
72

73 74 75
-- | 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 ]
James Laver's avatar
James Laver committed
76

77 78 79
-- | Get `renderers` of a sigmajs instance.
renderers :: Sigma -> Array Renderer
renderers s = s .. "renderers" :: Array Renderer
James Laver's avatar
James Laver committed
80

81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113
-- | 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.
114 115
bind_ :: forall e. Sigma -> String -> (e -> Effect Unit) -> Effect Unit
bind_ s e h = runEffectFn3 _bind s e (mkEffectFn1 h)
James Laver's avatar
James Laver committed
116

117 118 119 120 121 122 123 124
-- | 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
125 126 127
  let node = e .. "data" .. "node" :: Record Types.Node
  f node

128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144
-- | 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.
145
sigmaEdgeIds :: SigmaGraph -> Types.EdgeIds
146 147 148 149 150
sigmaEdgeIds sg =  Set.fromFoldable edgeIds
  where
    edgeIds = _.id <$> edges sg

-- | Fetch ids of graph nodes in a sigmajs instance.
151
sigmaNodeIds :: SigmaGraph -> Types.NodeIds
152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181
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.
182
unbindClickNode :: Sigma -> Effect Unit
183
unbindClickNode s = unbind_ s "clickNode"
184

185
-- | Bind a `clickNodes` event.
186 187
bindClickNodes :: Sigma -> (Array (Record Types.Node) -> Effect Unit) -> Effect Unit
bindClickNodes s f = bind_ s "clickNodes" $ \e -> do
188 189 190
  let ns = e .. "data" .. "node" :: Array (Record Types.Node)
  f ns
-- | Unbind a `clickNodes` event.
191 192 193
unbindClickNodes :: Sigma -> Effect Unit
unbindClickNodes s = unbind_ s "clickNodes"

194
-- | Bind a `overNode` event.
195
bindOverNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit
196
bindOverNode s f = bindNodeEvent s "overNode" f
197

198
-- | Bind a `clickEdge` event.
199
bindClickEdge :: Sigma -> (Record Types.Edge -> Effect Unit) -> Effect Unit
200 201
bindClickEdge s f = bindEdgeEvent s "clickEdge" f
-- | Unbind a `clickEdge` event.
202 203 204
unbindClickEdge :: Sigma -> Effect Unit
unbindClickEdge s = unbind_ s "clickEdge"

205
-- | Bind a `overEdge` event.
206
bindOverEdge :: Sigma -> (Record Types.Edge -> Effect Unit) -> Effect Unit
207
bindOverEdge s f = bindEdgeEvent s "overEdge" f
208

209
-- | Call `settings(s)` on a sigmajs instance.
210
setSettings :: forall settings. Sigma -> settings -> Effect Unit
211
setSettings s settings = do
212
  _ <- pure $ s ... "settings" $ [ settings ]
213
  refresh s
214

215
-- | Start forceAtlas2 on a sigmajs instance.
James Laver's avatar
James Laver committed
216
startForceAtlas2 :: forall settings. Sigma -> settings -> Effect Unit
217
startForceAtlas2 s settings = pure $ s ... "startForceAtlas2" $ [ settings ]
James Laver's avatar
James Laver committed
218

219
-- | Restart forceAtlas2 on a sigmajs instance.
220
restartForceAtlas2 :: Sigma -> Effect Unit
221
restartForceAtlas2 s = startForceAtlas2 s null
222

223
-- | Stop forceAtlas2 on a sigmajs instance.
James Laver's avatar
James Laver committed
224
stopForceAtlas2 :: Sigma -> Effect Unit
225
stopForceAtlas2 s = pure $ s ... "stopForceAtlas2" $ []
James Laver's avatar
James Laver committed
226

227
-- | Kill forceAtlas2 on a sigmajs instance.
James Laver's avatar
James Laver committed
228
killForceAtlas2 :: Sigma -> Effect Unit
229
killForceAtlas2 s = pure $ s ... "killForceAtlas2" $ []
230

231 232 233
-- | Return whether forceAtlas2 is running on a sigmajs instance.
isForceAtlas2Running :: Sigma -> Boolean
isForceAtlas2Running s = s ... "isForceAtlas2Running" $ [] :: Boolean
James Laver's avatar
James Laver committed
234

235 236
-- | Refresh forceAtlas2 (with a `setTimeout` hack as it seems it doesn't work
-- | otherwise).
237
refreshForceAtlas :: Sigma -> Effect Unit
238
refreshForceAtlas s = do
239
  let isRunning = isForceAtlas2Running s
240 241 242 243
  if isRunning then
    pure unit
  else do
    _ <- setTimeout 100 $ do
244
      restartForceAtlas2 s
245
      _ <- setTimeout 100 $
246
        stopForceAtlas2 s
247 248 249
      pure unit
    pure unit

James Laver's avatar
James Laver committed
250 251
newtype SigmaEasing = SigmaEasing String

252 253 254 255 256 257 258 259 260
sigmaEasing ::
  { linear :: SigmaEasing
  , quadraticIn :: SigmaEasing
  , quadraticOut :: SigmaEasing
  , quadraticInOut :: SigmaEasing
  , cubicIn :: SigmaEasing
  , cubicOut :: SigmaEasing
  , cubicInOut :: SigmaEasing
  }
James Laver's avatar
James Laver committed
261 262 263 264 265 266 267 268 269
sigmaEasing =
  { linear : SigmaEasing "linear"
  , quadraticIn : SigmaEasing "quadraticIn"
  , quadraticOut : SigmaEasing "quadraticOut"
  , quadraticInOut : SigmaEasing "quadraticInOut"
  , cubicIn : SigmaEasing "cubicIn"
  , cubicOut : SigmaEasing "cubicOut"
  , cubicInOut : SigmaEasing "cubicInOut"
  }
270 271 272 273 274 275 276 277 278 279 280

type CameraProps =
  ( x :: Number
  , y :: Number
  , ratio :: Number
  , angle :: Number
  )

foreign import data CameraInstance' :: # Type
type CameraInstance = { | CameraInstance' }

281 282 283 284 285 286
-- | 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
287 288

goTo :: Record CameraProps -> CameraInstance -> Effect Unit
289
goTo props cam = pure $ cam ... "goTo" $ [props]
290 291

goToAllCameras :: Sigma -> Record CameraProps -> Effect Unit
292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314
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