Sigma.purs

module Gargantext.Hooks.Sigmax.Sigma where

import Prelude

import DOM.Simple.Types (Element, Window)
import Data.Array as A
import Data.Either (Either(..))
import Data.Maybe (Maybe)
import Data.Sequence as Seq
import Data.Set as Set
import Data.Traversable (traverse_)
import Effect (Effect)
import Effect.Exception as EEx
import Effect.Timer (setTimeout)
import Effect.Uncurried (EffectFn1, EffectFn3, EffectFn4, mkEffectFn1, runEffectFn1, runEffectFn3, runEffectFn4)
import FFI.Simple ((..), (...), (.=))
import Foreign.Object as Object
import Gargantext.Hooks.Sigmax.Types as Types
import Type.Row (class Union)

-- | Type representing a sigmajs instance
foreign import data Sigma :: Type
-- | Type representing `sigma.graph`
foreign import data SigmaGraph :: Type

type NodeRequiredProps = ( id :: Types.NodeId )
type EdgeRequiredProps = ( id :: Types.EdgeId, source :: Types.NodeId, target :: Types.NodeId )

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

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

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

type Graph n e = { nodes :: Array {|n}, edges :: Array {|e} }
type SigmaOpts s = { settings :: s }

-- | Initialize sigmajs.
sigma :: forall opts err. SigmaOpts opts -> Effect (Either err Sigma)
sigma = runEffectFn3 _sigma Left Right

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

-- | Call the `refresh()` method on a sigmajs instance.
refresh :: Sigma -> Effect Unit
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)
addRenderer :: forall r err. Sigma -> r -> Effect (Either err Unit)
addRenderer = runEffectFn4 _addRenderer Left Right

-- | Initialize the mouse selector plugin. This allows for custom bindings to mouse events.
bindMouseSelectorPlugin :: forall err. Sigma -> Effect (Either err Unit)
bindMouseSelectorPlugin = runEffectFn3 _bindMouseSelectorPlugin Left Right

-- | 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 ]

-- | Get `renderers` of a sigmajs instance.
renderers :: Sigma -> Array Renderer
renderers s = s .. "renderers" :: Array Renderer

-- | 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_ s e h = runEffectFn3 _bind s e (mkEffectFn1 h)

-- | 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
  let node = e .. "data" .. "node" :: Record Types.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.EdgeIds
sigmaEdgeIds sg =  Set.fromFoldable edgeIds
  where
    edgeIds = _.id <$> edges sg

-- | Fetch ids of graph nodes in a sigmajs instance.
sigmaNodeIds :: SigmaGraph -> Types.NodeIds
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 s = unbind_ s "clickNode"

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

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

-- | Bind a `clickEdge` event.
bindClickEdge :: Sigma -> (Record Types.Edge -> Effect Unit) -> Effect Unit
bindClickEdge s f = bindEdgeEvent s "clickEdge" f
-- | Unbind a `clickEdge` event.
unbindClickEdge :: Sigma -> Effect Unit
unbindClickEdge s = unbind_ s "clickEdge"

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

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

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

-- | Start forceAtlas2 on a sigmajs instance.
startForceAtlas2 :: forall settings. Sigma -> settings -> Effect Unit
startForceAtlas2 s settings = pure $ s ... "startForceAtlas2" $ [ settings ]

-- | Restart forceAtlas2 on a sigmajs instance.
restartForceAtlas2 :: forall settings. Sigma -> settings -> Effect Unit
restartForceAtlas2 s settings = startForceAtlas2 s settings

-- | Stop forceAtlas2 on a sigmajs instance.
stopForceAtlas2 :: Sigma -> Effect Unit
stopForceAtlas2 s = pure $ s ... "stopForceAtlas2" $ []

-- | Kill forceAtlas2 on a sigmajs instance.
killForceAtlas2 :: Sigma -> Effect Unit
killForceAtlas2 s = pure $ s ... "killForceAtlas2" $ []

-- | Return whether forceAtlas2 is running on a sigmajs instance.
isForceAtlas2Running :: Sigma -> Boolean
isForceAtlas2Running s = s ... "isForceAtlas2Running" $ [] :: Boolean

-- | Refresh forceAtlas2 (with a `setTimeout` hack as it seems it doesn't work
-- | otherwise).
refreshForceAtlas :: forall settings. Sigma -> settings -> Effect Unit
refreshForceAtlas s settings = do
  let isRunning = isForceAtlas2Running s
  if isRunning then
    pure unit
  else do
    _ <- setTimeout 100 $ do
      restartForceAtlas2 s settings
      _ <- setTimeout 100 $
        stopForceAtlas2 s
      pure unit
    pure unit

newtype SigmaEasing = SigmaEasing String

sigmaEasing ::
  { linear :: SigmaEasing
  , quadraticIn :: SigmaEasing
  , quadraticOut :: SigmaEasing
  , quadraticInOut :: SigmaEasing
  , cubicIn :: SigmaEasing
  , cubicOut :: SigmaEasing
  , cubicInOut :: SigmaEasing
  }
sigmaEasing =
  { linear : SigmaEasing "linear"
  , quadraticIn : SigmaEasing "quadraticIn"
  , quadraticOut : SigmaEasing "quadraticOut"
  , quadraticInOut : SigmaEasing "quadraticInOut"
  , cubicIn : SigmaEasing "cubicIn"
  , cubicOut : SigmaEasing "cubicOut"
  , cubicInOut : SigmaEasing "cubicInOut"
  }

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

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

-- | 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

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

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

takeScreenshot :: Sigma -> Effect String
takeScreenshot =  runEffectFn1 _takeScreenshot

getEdges :: Sigma -> Effect (Array (Record Types.Edge))
getEdges = runEffectFn1 _getEdges

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

-- | 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
foreign import _takeScreenshot :: EffectFn1 Sigma String
foreign import _getEdges :: EffectFn1 Sigma (Array (Record Types.Edge))
foreign import _getNodes :: EffectFn1 Sigma (Array (Record Types.Node))
foreign import _proxySetSettings
  :: forall settings.
  EffectFn3 Window
            Sigma
            settings
            Unit