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

import Prelude
4

5
import DOM.Simple.Types (Element, Window)
6
import Data.Array as A
James Laver's avatar
James Laver committed
7
import Data.Either (Either(..))
8
import Data.Function.Uncurried (Fn1, runFn1)
9 10 11 12
import Data.Maybe (Maybe)
import Data.Traversable (traverse_)
import Effect (Effect)
import Effect.Exception as EEx
13
import Effect.Timer (setTimeout)
14
import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn3, EffectFn4, mkEffectFn1, runEffectFn1, runEffectFn2, runEffectFn3, runEffectFn4)
15 16
import FFI.Simple ((..), (...), (.=))
import Foreign.Object as Object
17
import Gargantext.Hooks.Sigmax.Graphology as Graphology
18
import Gargantext.Hooks.Sigmax.Types as Types
19
import Type.Row (class Union)
20

21
-- | Type representing a sigmajs instance
James Laver's avatar
James Laver committed
22 23
foreign import data Sigma :: Type

24 25
type NodeRequiredProps = ( id :: Types.NodeId )
type EdgeRequiredProps = ( id :: Types.EdgeId, source :: Types.NodeId, target :: Types.NodeId )
James Laver's avatar
James Laver committed
26

27 28
class NodeProps (all :: Row Type) (extra :: Row Type) | all -> extra
class EdgeProps (all :: Row Type) (extra :: Row Type) | all -> extra
James Laver's avatar
James Laver committed
29 30 31 32 33 34 35 36

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

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

James Laver's avatar
James Laver committed
38 39
type SigmaOpts s = { settings :: s }

40
-- | Initialize sigmajs.
41 42
sigma :: forall opts err. Element -> SigmaOpts opts -> Effect (Either err Sigma)
sigma = runEffectFn4 _sigma Left Right
James Laver's avatar
James Laver committed
43

44 45
-- | Kill a sigmajs instance.
kill :: Sigma -> Effect Unit
46
kill s = pure $ s ... "kill" $ []
47

48
-- | Call the `refresh()` method on a sigmajs instance.
49 50
-- refresh :: Sigma -> Effect Unit
-- refresh = runEffectFn1 _refresh
51 52 53 54 55 56 57 58 59 60 61 62 63 64 65

-- | 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
-- | 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.
102
graph :: Sigma -> Graphology.Graph
103
graph s = s .. "graph" :: Graphology.Graph
104 105

-- | Call `sigma.bind(event, handler)` on a sigmajs instance.
106 107
on_ :: forall e. Sigma -> String -> (e -> Effect Unit) -> Effect Unit
on_ s e h = runEffectFn3 _on s e (mkEffectFn1 h)
James Laver's avatar
James Laver committed
108

109 110
-- | Generic function to bind a sigmajs event for edges.
bindEdgeEvent :: Sigma -> String -> (Record Types.Edge -> Effect Unit) -> Effect Unit
111
bindEdgeEvent s ev f = on_ s ev $ \e -> do
112 113 114 115
  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
116
bindNodeEvent s ev f = on_ s ev $ \e -> do
117 118 119
  let node = e .. "data" .. "node" :: Record Types.Node
  f node

120 121 122 123 124 125 126 127
-- | Call `sigma.unbind(event)` on a sigmajs instance.
unbind_ :: Sigma -> String -> Effect Unit
unbind_ s e = pure $ s ... "unbind" $ [e]

-- | Bind a `clickNode` event.
bindClickNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit
bindClickNode s f = bindNodeEvent s "clickNode" f
-- | Unbind a `clickNode` event.
128
unbindClickNode :: Sigma -> Effect Unit
129
unbindClickNode s = unbind_ s "clickNode"
130

131
-- | Bind a `clickNodes` event.
132
bindClickNodes :: Sigma -> (Array Types.NodeId -> Effect Unit) -> Effect Unit
133
bindClickNodes s f = on_ s "clickNodes" $ \e -> do
134
  let ns = e .. "nodeIds" :: Array Types.NodeId
135 136
  f ns
-- | Unbind a `clickNodes` event.
137 138 139
unbindClickNodes :: Sigma -> Effect Unit
unbindClickNodes s = unbind_ s "clickNodes"

140 141 142 143 144 145 146 147
-- | Shift + mousewheel changes selector size
bindShiftWheel :: Sigma -> (Number -> Effect Unit) -> Effect Unit
bindShiftWheel s f = on_ s "shiftWheel" $ \e -> do
  let delta = e .. "delta" :: Number
  f delta
unbindShiftWheel :: Sigma -> Effect Unit
unbindShiftWheel s = unbind_ s "shiftWheel"

148
-- | Bind a `overNode` event.
149
bindOverNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit
150
bindOverNode s f = bindNodeEvent s "overNode" f
151

152
-- | Bind a `clickEdge` event.
153
bindClickEdge :: Sigma -> (Record Types.Edge -> Effect Unit) -> Effect Unit
154 155
bindClickEdge s f = bindEdgeEvent s "clickEdge" f
-- | Unbind a `clickEdge` event.
156 157 158
unbindClickEdge :: Sigma -> Effect Unit
unbindClickEdge s = unbind_ s "clickEdge"

159
-- | Bind a `overEdge` event.
160
bindOverEdge :: Sigma -> (Record Types.Edge -> Effect Unit) -> Effect Unit
161
bindOverEdge s f = bindEdgeEvent s "overEdge" f
162

163
-- | Call `settings(s)` on a sigmajs instance.
164
setSettings :: forall settings. Sigma -> settings -> Effect Unit
165
setSettings = runEffectFn2 _setSettings
166

167 168 169 170 171
-- | Call `settins(s)` on the the main proxy `window.sigma`
proxySetSettings :: forall settings.
  Window -> Sigma -> settings -> Effect Unit
proxySetSettings = runEffectFn3 _proxySetSettings

James Laver's avatar
James Laver committed
172 173
newtype SigmaEasing = SigmaEasing String

174 175 176 177 178 179 180 181 182
sigmaEasing ::
  { linear :: SigmaEasing
  , quadraticIn :: SigmaEasing
  , quadraticOut :: SigmaEasing
  , quadraticInOut :: SigmaEasing
  , cubicIn :: SigmaEasing
  , cubicOut :: SigmaEasing
  , cubicInOut :: SigmaEasing
  }
James Laver's avatar
James Laver committed
183 184 185 186 187 188 189 190 191
sigmaEasing =
  { linear : SigmaEasing "linear"
  , quadraticIn : SigmaEasing "quadraticIn"
  , quadraticOut : SigmaEasing "quadraticOut"
  , quadraticInOut : SigmaEasing "quadraticInOut"
  , cubicIn : SigmaEasing "cubicIn"
  , cubicOut : SigmaEasing "cubicOut"
  , cubicInOut : SigmaEasing "cubicInOut"
  }
192

193 194 195 196 197 198 199 200 201 202 203 204 205
-- DEPRECATED
-- -- | 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 = pure $ cam ... "goTo" $ [props]

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

207
takeScreenshot :: Sigma -> Effect String
208
takeScreenshot =  runEffectFn1 _takeScreenshot
209

210 211 212
-- | FFI
foreign import _sigma ::
  forall a b opts err.
213
  EffectFn4 (a -> Either a b)
214
            (b -> Either a b)
215
            Element
216 217 218 219 220 221 222 223 224 225 226 227 228 229 230
            (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)
231
foreign import _on :: forall e. EffectFn3 Sigma String (EffectFn1 e Unit) Unit
232
foreign import _takeScreenshot :: EffectFn1 Sigma String
233 234 235 236 237 238
foreign import _proxySetSettings
  :: forall settings.
  EffectFn3 Window
            Sigma
            settings
            Unit
239
foreign import _setSettings :: forall settings. EffectFn2 Sigma settings Unit
240
foreign import _refresh :: EffectFn1 Sigma Unit