GraphExplorer.purs

module Gargantext.Components.GraphExplorer where

import Gargantext.Prelude hiding (max, min)

import Data.Array as A
import Data.Either (Either)
import Data.FoldableWithIndex (foldMapWithIndex)
import Data.Int (toNumber)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromJust, maybe)
import Data.Nullable (null, Nullable)
import Data.Sequence as Seq
import Data.Set as Set
import Data.Tuple (Tuple(..))
import DOM.Simple.Types (Element)
import Effect.Aff (Aff)
import Math as Math
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as RH
import Record as Record
import Record.Extra as RX
import Toestand as T

import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Graph as Graph
import Gargantext.Components.GraphExplorer.Controls as Controls
import Gargantext.Components.GraphExplorer.Sidebar.Types as GEST
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Config.REST (RESTError)
import Gargantext.Data.Louvain as Louvain
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Hooks.Sigmax.Types as SigmaxT
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, get)
import Gargantext.Types as Types
import Gargantext.Utils.Range as Range
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2

here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer"

type BaseProps =
  ( boxes          :: Boxes
  , graphId        :: GET.GraphId
  )

type LayoutProps =
  ( session      :: Session
  | BaseProps )

type Props =
  ( graph          :: SigmaxT.SGraph
  , hyperdataGraph :: GET.HyperdataGraph
  | LayoutProps
  )

type GraphWriteProps =
  ( mMetaData'     :: Maybe GET.MetaData
  | Props
  )

--------------------------------------------------------------
explorerLayout :: R2.Component LayoutProps
explorerLayout = R.createElement explorerLayoutCpt
explorerLayoutCpt :: R.Component LayoutProps
explorerLayoutCpt = here.component "explorerLayout" cpt where
  cpt props@{ boxes: { graphVersion }, graphId, session } _ = do
    graphVersion' <- T.useLive T.unequal graphVersion

    useLoader { errorHandler
              , loader: getNodes session graphVersion'
              , path: graphId
              , render: handler }
    where
      errorHandler err = here.log2 "[explorerLayout] RESTError" err
      handler loaded@(GET.HyperdataGraph { graph: hyperdataGraph }) =
        explorerWriteGraph (Record.merge props { graph, hyperdataGraph: loaded, mMetaData' }) []
        where
          Tuple mMetaData' graph = convert hyperdataGraph

explorerWriteGraph :: R2.Component GraphWriteProps
explorerWriteGraph = R.createElement explorerWriteGraphCpt
explorerWriteGraphCpt :: R.Component GraphWriteProps
explorerWriteGraphCpt = here.component "explorerWriteGraph" cpt where
  cpt props@{ boxes: { sidePanelGraph }
            , graph
            , mMetaData' } _ = do
      R.useEffectOnce' $ do
        T.write_ (Just { mGraph: Just graph
                       , mMetaData: mMetaData'
                       , multiSelectEnabled: false
                       , removedNodeIds: Set.empty
                       , selectedNodeIds: Set.empty
                       , showControls: false
                       , sideTab: GET.SideTabLegend }) sidePanelGraph

      pure $ explorer (RX.pick props :: Record Props) []

--------------------------------------------------------------
explorer :: R2.Component Props
explorer = R.createElement explorerCpt
explorerCpt :: R.Component Props
explorerCpt = here.component "explorer" cpt
  where
    cpt { boxes: { graphVersion, handed, reloadForest, showTree, sidePanelGraph, sidePanelState }
        , graph
        , graphId
        , hyperdataGraph
        , session
        } _ = do
      { mMetaData } <- GEST.focusedSidePanel sidePanelGraph
      _graphVersion' <- T.useLive T.unequal graphVersion
      handed' <- T.useLive T.unequal handed
      mMetaData' <- T.useLive T.unequal mMetaData

      let startForceAtlas = maybe true (\(GET.MetaData { startForceAtlas: sfa }) -> sfa) mMetaData'

      let forceAtlasS = if startForceAtlas
                          then SigmaxT.InitialRunning
                          else SigmaxT.InitialStopped

      _dataRef <- R.useRef graph
      graphRef <- R.useRef null
      controls <- Controls.useGraphControls { forceAtlasS
                                            , graph
                                            , graphId
                                            , hyperdataGraph
                                            , reloadForest
                                            , session
                                            , showTree
                                            , sidePanel: sidePanelGraph
                                            , sidePanelState }

      -- graphVersionRef <- R.useRef graphVersion'
      -- R.useEffect' $ do
      --   let readData = R.readRef dataRef
      --   let gv = R.readRef graphVersionRef
      --   if SigmaxT.eqGraph readData graph then
      --     pure unit
      --   else do
      --     -- Graph data changed, reinitialize sigma.
      --     let rSigma = R.readRef controls.sigmaRef
      --     Sigmax.cleanupSigma rSigma "explorerCpt"
      --     R.setRef dataRef graph
      --     R.setRef graphVersionRef graphVersion'
      --     -- Reinitialize bunch of state as well.
      --     T.write_ SigmaxT.emptyNodeIds controls.removedNodeIds
      --     T.write_ SigmaxT.emptyNodeIds controls.selectedNodeIds
      --     T.write_ SigmaxT.EShow controls.showEdges
      --     T.write_ forceAtlasS controls.forceAtlasState
      --     T.write_ Graph.Init controls.graphStage
      --     T.write_ Types.InitialClosed controls.sidePanelState

      pure $
        RH.div { className: "graph-meta-container" }
        [ RH.div { className: "graph-container" }
          [ RH.div { className: "container-fluid " <> hClass handed' }
            [ RH.div { id: "controls-container" } [ Controls.controls controls [] ]
            , RH.div { className: "row graph-row" }
              [ RH.div { ref: graphRef, id: "graph-view", className: "col-md-12" } []
              , graphView { controls
                          , elRef: graphRef
                          , graph
                          , hyperdataGraph
                          , mMetaData
                          } []
              ]
            ]
          ]
        ]

    hClass h = case h of
      Types.LeftHanded  -> "lefthanded"
      Types.RightHanded -> "righthanded"

type GraphProps = (
    controls       :: Record Controls.Controls
  , elRef          :: R.Ref (Nullable Element)
  , graph          :: SigmaxT.SGraph
  , hyperdataGraph :: GET.HyperdataGraph
  , mMetaData      :: T.Box (Maybe GET.MetaData)
)

graphView :: R2.Component GraphProps
graphView = R.createElement graphViewCpt
graphViewCpt :: R.Component GraphProps
graphViewCpt = here.component "graphView" cpt
  where
    cpt { controls
        , elRef
        , graph
        , hyperdataGraph: GET.HyperdataGraph { mCamera }
        , mMetaData } _children = do
      edgeConfluence' <- T.useLive T.unequal controls.edgeConfluence
      edgeWeight' <- T.useLive T.unequal controls.edgeWeight
      mMetaData' <- T.useLive T.unequal mMetaData
      multiSelectEnabled' <- T.useLive T.unequal controls.multiSelectEnabled
      nodeSize' <- T.useLive T.unequal controls.nodeSize
      removedNodeIds' <- T.useLive T.unequal controls.removedNodeIds
      selectedNodeIds' <- T.useLive T.unequal controls.selectedNodeIds
      showEdges' <- T.useLive T.unequal controls.showEdges
      showLouvain' <- T.useLive T.unequal controls.showLouvain

      multiSelectEnabledRef <- R.useRef multiSelectEnabled'

      -- TODO Cache this?
      let louvainGraph =
            if showLouvain' then
              let louvain = Louvain.louvain unit in
              let cluster = Louvain.init louvain (SigmaxT.louvainNodes graph) (SigmaxT.louvainEdges graph) in
              SigmaxT.louvainGraph graph cluster
            else
              graph
      let transformedGraph = transformGraph louvainGraph { edgeConfluence'
                                                         , edgeWeight'
                                                         , nodeSize'
                                                         , removedNodeIds'
                                                         , selectedNodeIds'
                                                         , showEdges' }
      let startForceAtlas = maybe true (\(GET.MetaData { startForceAtlas: sfa }) -> sfa) mMetaData'

      R.useEffect1' multiSelectEnabled' $ do
        R.setRef multiSelectEnabledRef multiSelectEnabled'

      pure $ Graph.graph { elRef
                         , forceAtlas2Settings: Graph.forceAtlas2Settings
                         , graph
                         , mCamera
                         , multiSelectEnabledRef
                         , selectedNodeIds: controls.selectedNodeIds
                         , showEdges: controls.showEdges
                         , sigmaRef: controls.sigmaRef
                         , sigmaSettings: Graph.sigmaSettings
                         , stage: controls.graphStage
                         , startForceAtlas
                         , transformedGraph
                         } []

convert :: GET.GraphData -> Tuple (Maybe GET.MetaData) SigmaxT.SGraph
convert (GET.GraphData r) = Tuple r.metaData $ SigmaxT.Graph {nodes, edges}
  where
    nodes = foldMapWithIndex nodeFn r.nodes
    nodeFn _i nn@(GET.Node n) =
      Seq.singleton {
          borderColor: color
        , color : color
        , equilateral: { numPoints: 3 }
        , gargType
        , hidden : false
        , id    : n.id_
        , label : n.label
        , size  : Math.log (toNumber n.size + 1.0)
        , type  : modeGraphType gargType
        , x     : n.x -- cos (toNumber i)
        , y     : n.y -- sin (toNumber i)
        , _original: nn
        }
      where
        cDef (GET.Cluster {clustDefault}) = clustDefault
        color = GET.intColor (cDef n.attributes)
        gargType =  unsafePartial $ fromJust $ Types.modeFromString n.type_
    nodesMap = SigmaxT.nodesMap nodes
    edges = foldMapWithIndex edgeFn $ A.sortWith (\(GET.Edge {weight}) -> weight) r.edges
    edgeFn i ee@(GET.Edge e) =
      Seq.singleton
        { id : e.id_
        , color
        , confluence : e.confluence
        , hidden : false
        , size: 1.0
        , source : e.source
        , sourceNode
        , target : e.target
        , targetNode
        , weight : e.weight
        , weightIdx: i
        , _original: ee
        }
      where
        sourceNode = unsafePartial $ fromJust $ Map.lookup e.source nodesMap
        targetNode = unsafePartial $ fromJust $ Map.lookup e.target nodesMap
        color = sourceNode.color

-- | See sigmajs/plugins/sigma.renderers.customShapes/shape-library.js
modeGraphType :: Types.Mode -> String
modeGraphType Types.Authors = "square"
modeGraphType Types.Institutes = "equilateral"
modeGraphType Types.Sources = "star"
modeGraphType Types.Terms = "def"


getNodes :: Session -> T2.Reload -> GET.GraphId -> Aff (Either RESTError GET.HyperdataGraph)
getNodes session graphVersion graphId =
  get session $ NodeAPI Types.Graph
                        (Just graphId)
                        ("?version=" <> (show graphVersion))

type LiveProps = (
    edgeConfluence'  :: Range.NumberRange
  , edgeWeight'      :: Range.NumberRange
  , nodeSize'        :: Range.NumberRange
  , removedNodeIds'  :: SigmaxT.NodeIds
  , selectedNodeIds' :: SigmaxT.NodeIds
  , showEdges'       :: SigmaxT.ShowEdgesState
  )

transformGraph :: SigmaxT.SGraph -> Record LiveProps -> SigmaxT.SGraph
transformGraph graph { edgeConfluence'
                     , edgeWeight'
                     , nodeSize'
                     , removedNodeIds'
                     , selectedNodeIds' } = SigmaxT.Graph {nodes: newNodes, edges: newEdges}
  where
    edges = SigmaxT.graphEdges graph
    nodes = SigmaxT.graphNodes graph
    selectedEdgeIds =
      Set.fromFoldable
        $ Seq.map _.id
        $ SigmaxT.neighbouringEdges graph selectedNodeIds'
    hasSelection = not $ Set.isEmpty selectedNodeIds'

    newEdges' = Seq.filter edgeFilter $ Seq.map (
      -- NOTE We don't use edgeShowFilter anymore because of
      -- https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/304
      -- edgeHideWeight <<< edgeHideConfluence <<< edgeShowFilter <<< edgeMarked
      edgeHideWeight <<< edgeHideConfluence <<< edgeMarked
      ) edges
    newNodes  = Seq.filter nodeFilter $ Seq.map (nodeMarked <<< nodeHideSize) nodes
    newEdges  = Seq.filter (edgeInGraph $ Set.fromFoldable $ Seq.map _.id newNodes) newEdges'

    edgeFilter _e = true
    nodeFilter n = nodeRemovedFilter n

    nodeRemovedFilter { id } = not $ Set.member id removedNodeIds'

    edgeHideConfluence :: Record SigmaxT.Edge -> Record SigmaxT.Edge
    edgeHideConfluence edge@{ confluence } =
      if Range.within edgeConfluence' confluence then
        edge
      else
        edge { hidden = true }

    edgeHideWeight :: Record SigmaxT.Edge -> Record SigmaxT.Edge
    edgeHideWeight edge@{ weightIdx } =
      if Range.within edgeWeight' $ toNumber weightIdx then
        edge
      else
        edge { hidden = true }

    edgeInGraph :: SigmaxT.NodeIds -> Record SigmaxT.Edge -> Boolean
    edgeInGraph nodeIds e = (Set.member e.source nodeIds) && (Set.member e.target nodeIds)

    edgeMarked :: Record SigmaxT.Edge -> Record SigmaxT.Edge
    edgeMarked edge@{ id, sourceNode } = do
      let isSelected = Set.member id selectedEdgeIds
      case Tuple hasSelection isSelected of
        Tuple false true  -> edge { color = "#ff0000" }
        Tuple true  true  -> edge { color = sourceNode.color }
        Tuple true false  -> edge { color = "rgba(221, 221, 221, 0.5)" }
        _                 -> edge

    nodeMarked :: Record SigmaxT.Node -> Record SigmaxT.Node
    nodeMarked node@{ id } =
      if Set.member id selectedNodeIds' then
        node { borderColor = "#000", type = "selected" }
      else
        node

    nodeHideSize :: Record SigmaxT.Node -> Record SigmaxT.Node
    nodeHideSize node@{ size } =
      if Range.within nodeSize' size then
        node
      else
        node { hidden = true }