ForceAtlas2.purs 1.8 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
module Gargantext.Hooks.Sigmax.ForceAtlas2 where

-- FFI for force atlas2: https://graphology.github.io/standard-library/layout-forceatlas2.html

import Prelude

import Data.Array as A
import Data.Sequence as Seq
import Data.Set as Set
import Data.Traversable (traverse)
import Effect (Effect)
import Effect.Timer (setTimeout)
import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn3, EffectFn4, runEffectFn1, runEffectFn2, runEffectFn3, runEffectFn4)
import FFI.Simple ((..), (...), (.=))
import Gargantext.Hooks.Sigmax.Graphology as Graphology
import Gargantext.Hooks.Sigmax.Types as Types
import Record as Record

-- | Type representing the web worker.
foreign import data FA2Layout :: Type

22 23 24
graph :: FA2Layout -> Graphology.Graph
graph s = s .. "graph" :: Graphology.Graph

25 26
-- TODO inferSettings
-- TODO init with settings
27
foreign import _init :: forall settings. EffectFn2 Graphology.Graph settings FA2Layout
28 29 30 31 32
foreign import _start :: EffectFn1 FA2Layout Unit
foreign import _stop :: EffectFn1 FA2Layout Unit
foreign import _kill :: EffectFn1 FA2Layout Unit
foreign import _isRunning :: EffectFn1 FA2Layout Boolean

33 34
init :: forall settings. Graphology.Graph -> settings -> Effect FA2Layout
init = runEffectFn2 _init
35 36 37 38 39 40 41 42 43 44 45 46 47 48 49

start :: FA2Layout -> Effect Unit
start = runEffectFn1 _start

stop :: FA2Layout -> Effect Unit
stop = runEffectFn1 _stop

kill :: FA2Layout -> Effect Unit
kill = runEffectFn1 _kill

isRunning :: FA2Layout -> Effect Boolean
isRunning = runEffectFn1 _isRunning

-- TODO?
restart :: FA2Layout -> Effect Unit
50 51 52 53 54
restart fa2 = do
  stop fa2
  _ <- setTimeout 100 $ do
    start fa2
  pure unit
55 56 57 58 59 60 61 62 63 64 65 66

refresh :: FA2Layout -> Effect Unit
refresh f = do
  isRunning' <- isRunning f
  if isRunning' then
    pure unit
  else do
    _ <- setTimeout 100 $ do
      restart f
      _ <- setTimeout 100 $ stop f
      pure unit
    pure unit