Sigma.purs 11.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
import Effect.Uncurried (EffectFn1, EffectFn3, EffectFn4, mkEffectFn1, runEffectFn1, runEffectFn3, runEffectFn4)
17 18 19
import FFI.Simple ((..), (...), (.=))
import Foreign.Object as Object
import Type.Row (class Union)
20

21 22
import Gargantext.Hooks.Sigmax.Types as Types

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

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

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
41

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

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

49 50 51 52
-- | Kill a sigmajs instance.
kill :: Sigma -> Effect Unit
kill sigma = pure $ sigma ... "kill" $ []

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

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

78 79 80
-- | 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
81

82 83 84
-- | Get `renderers` of a sigmajs instance.
renderers :: Sigma -> Array Renderer
renderers s = s .. "renderers" :: Array Renderer
James Laver's avatar
James Laver committed
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 114 115 116 117 118
-- | 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.
119 120
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
121

122 123 124 125 126 127 128 129
-- | 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
130 131 132
  let node = e .. "data" .. "node" :: Record Types.Node
  f node

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

-- | Fetch ids of graph nodes in a sigmajs instance.
156
sigmaNodeIds :: SigmaGraph -> Types.NodeIds
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 182 183 184 185 186
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.
187
unbindClickNode :: Sigma -> Effect Unit
188
unbindClickNode s = unbind_ s "clickNode"
189

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

199
-- | Bind a `overNode` event.
200
bindOverNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit
201
bindOverNode s f = bindNodeEvent s "overNode" f
202

203
-- | Bind a `clickEdge` event.
204
bindClickEdge :: Sigma -> (Record Types.Edge -> Effect Unit) -> Effect Unit
205 206
bindClickEdge s f = bindEdgeEvent s "clickEdge" f
-- | Unbind a `clickEdge` event.
207 208 209
unbindClickEdge :: Sigma -> Effect Unit
unbindClickEdge s = unbind_ s "clickEdge"

210
-- | Bind a `overEdge` event.
211
bindOverEdge :: Sigma -> (Record Types.Edge -> Effect Unit) -> Effect Unit
212
bindOverEdge s f = bindEdgeEvent s "overEdge" f
213

214
-- | Call `settings(s)` on a sigmajs instance.
215
setSettings :: forall settings. Sigma -> settings -> Effect Unit
216
setSettings s settings = do
217
  _ <- pure $ s ... "settings" $ [ settings ]
218
  refresh s
219

220
-- | Start forceAtlas2 on a sigmajs instance.
James Laver's avatar
James Laver committed
221
startForceAtlas2 :: forall settings. Sigma -> settings -> Effect Unit
222
startForceAtlas2 s settings = pure $ s ... "startForceAtlas2" $ [ settings ]
James Laver's avatar
James Laver committed
223

224
-- | Restart forceAtlas2 on a sigmajs instance.
225
restartForceAtlas2 :: Sigma -> Effect Unit
226
restartForceAtlas2 s = startForceAtlas2 s null
227

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

232
-- | Kill forceAtlas2 on a sigmajs instance.
James Laver's avatar
James Laver committed
233
killForceAtlas2 :: Sigma -> Effect Unit
234
killForceAtlas2 s = pure $ s ... "killForceAtlas2" $ []
235

236 237 238
-- | Return whether forceAtlas2 is running on a sigmajs instance.
isForceAtlas2Running :: Sigma -> Boolean
isForceAtlas2Running s = s ... "isForceAtlas2Running" $ [] :: Boolean
James Laver's avatar
James Laver committed
239

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

James Laver's avatar
James Laver committed
255 256
newtype SigmaEasing = SigmaEasing String

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

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

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

286 287 288 289 290 291
-- | 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
292

293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308
toCamera :: CameraInstance -> Record CameraProps
toCamera c = { angle, ratio, x, y }
  where
    angle = c .. "angle" :: Number
    ratio = c .. "ratio" :: Number
    x = c .. "x" :: Number
    y = c .. "y" :: Number

updateCamera :: Sigma -> { ratio :: Number, x :: Number, y :: Number } -> Effect Unit
updateCamera sig { ratio, x, y } = do
  let camera = sig .. "camera"
  _ <- pure $ (camera .= "ratio") ratio
  _ <- pure $ (camera .= "x") x
  _ <- pure $ (camera .= "y") y
  pure unit

309
goTo :: Record CameraProps -> CameraInstance -> Effect Unit
310
goTo props cam = pure $ cam ... "goTo" $ [props]
311 312

goToAllCameras :: Sigma -> Record CameraProps -> Effect Unit
313 314
goToAllCameras s props = traverse_ (goTo props) $ cameras s

315 316 317
takeScreenshot :: Sigma -> Effect String
takeScreenshot = runEffectFn1 _takeScreenshot

318 319 320 321 322 323
getEdges :: Sigma -> Effect (Array (Record Types.Edge))
getEdges = runEffectFn1 _getEdges

getNodes :: Sigma -> Effect (Array (Record Types.Node))
getNodes = runEffectFn1 _getNodes

324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344
-- | 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
345
foreign import _takeScreenshot :: EffectFn1 Sigma String
346 347
foreign import _getEdges :: EffectFn1 Sigma (Array (Record Types.Edge))
foreign import _getNodes :: EffectFn1 Sigma (Array (Record Types.Node))