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

import Data.Array as A
5
import Data.Either (either)
James Laver's avatar
James Laver committed
6
import Data.Foldable (sequence_)
7
import Data.Map as Map
8 9
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable)
James Laver's avatar
James Laver committed
10
import Data.Sequence (Seq)
11
import Data.Sequence as Seq
12
import Data.Set as Set
13
import Data.Traversable (traverse_)
14
import Data.Tuple (Tuple(..))
15
import Data.Tuple.Nested((/\))
16 17
import DOM.Simple.Console (log, log2)
import DOM.Simple.Types (Element)
James Laver's avatar
James Laver committed
18
import Effect (Effect)
19
import Effect.Class.Console (error)
20
import Effect.Timer (TimeoutId, clearTimeout)
21
import FFI.Simple ((.=))
James Laver's avatar
James Laver committed
22
import Gargantext.Hooks.Sigmax.Sigma as Sigma
23
import Gargantext.Hooks.Sigmax.Types (Graph(..), EdgesMap, NodesMap, SelectedNodeIds, SelectedEdgeIds)
24
import Gargantext.Utils.Reactix as R2
25
import Prelude (Unit, bind, discard, flip, pure, unit, ($), (*>), (<<<), (<>), (>>=), not)
26
import Reactix as R
James Laver's avatar
James Laver committed
27 28 29

type Sigma =
  { sigma :: R.Ref (Maybe Sigma.Sigma)
30
    -- TODO is Seq in cleanup really necessary?
James Laver's avatar
James Laver committed
31 32 33 34 35
  , cleanup :: R.Ref (Seq (Effect Unit))
  }

type Data n e = { graph :: R.Ref (Graph n e) }

36 37 38 39 40 41
initSigma :: R.Hooks Sigma
initSigma = do
    s <- R2.nothingRef
    c <- R.useRef Seq.empty
    pure { sigma: s, cleanup: c }

James Laver's avatar
James Laver committed
42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81
readSigma :: Sigma -> Maybe Sigma.Sigma
readSigma sigma = R.readRef sigma.sigma

writeSigma :: Sigma -> Maybe Sigma.Sigma -> Effect Unit
writeSigma sigma = R.setRef sigma.sigma

-- | Pushes to the back of the cleanup sequence. Cleanup happens
-- | *before* sigma is destroyed
cleanupLast :: Sigma -> Effect Unit -> Effect Unit
cleanupLast sigma = R.setRef sigma.cleanup <<< Seq.snoc existing
  where existing = R.readRef sigma.cleanup

-- | Pushes to the front of the cleanup sequence. Cleanup happens
-- | *before* sigma is destroyed
cleanupFirst :: Sigma -> Effect Unit -> Effect Unit
cleanupFirst sigma =
  R.setRef sigma.cleanup <<< (flip Seq.cons) (R.readRef sigma.cleanup)

cleanupSigma :: Sigma -> String -> Effect Unit
cleanupSigma sigma context = traverse_ kill (readSigma sigma)
  where
    kill sig = runCleanups *> killSigma *> emptyOut
      where -- close over sig
        killSigma = Sigma.killSigma sig >>= report
    runCleanups = sequence_ (R.readRef sigma.cleanup)
    emptyOut = writeSigma sigma Nothing *> R.setRef sigma.cleanup Seq.empty
    report = either (log2 errorMsg) (\_ -> log successMsg)
    prefix = "[" <> context <> "] "
    errorMsg = prefix <> "Error killing sigma:"
    successMsg = prefix <> "Killed sigma"

refreshData :: forall n e. Sigma.Sigma -> Sigma.Graph n e -> Effect Unit
refreshData sigma graph
  =   log clearingMsg
  *>  Sigma.clear sigma
  *>  log readingMsg
  *>  Sigma.graphRead sigma graph
  >>= either (log2 errorMsg) refresh
  where
    refresh _ = log refreshingMsg *> Sigma.refresh sigma
82 83 84 85
    clearingMsg = "[refreshData] Clearing existing graph data"
    readingMsg = "[refreshData] Reading graph data"
    refreshingMsg = "[refreshData] Refreshing graph"
    errorMsg = "[refreshData] Error reading graph data:"
James Laver's avatar
James Laver committed
86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104

sigmafy :: forall n e. Graph n e -> Sigma.Graph n e
sigmafy (Graph g) = {nodes,edges}
  where
    nodes = A.fromFoldable g.nodes
    edges = A.fromFoldable g.edges

dependOnSigma :: Sigma -> String -> (Sigma.Sigma -> Effect Unit) -> Effect Unit
dependOnSigma sigma notFoundMsg f = do
  case readSigma sigma of
    Nothing -> log notFoundMsg
    Just sig -> f sig

dependOnContainer :: R.Ref (Nullable Element) -> String -> (Element -> Effect Unit) -> Effect Unit
dependOnContainer container notFoundMsg f = do
  case R.readNullableRef container of
    Nothing -> log notFoundMsg
    Just c -> f c

105 106 107

-- Effectful versions of the above code

108 109 110
-- | Effect for handling pausing FA via state changes.  We need this because
-- | pausing can be done not only via buttons but also from the initial
-- | setTimer.
111
--handleForceAtlasPause sigmaRef (toggled /\ setToggled) mFAPauseRef = do
112 113
handleForceAtlas2Pause :: R.Ref Sigma -> R.State Boolean -> Boolean -> R.Ref (Maybe TimeoutId) -> Effect Unit
handleForceAtlas2Pause sigmaRef (toggled /\ setToggled) showEdges mFAPauseRef = do
114 115
  let sigma = R.readRef sigmaRef
  dependOnSigma sigma "[handleForceAtlas2Pause] sigma: Nothing" $ \s -> do
116 117
    --log2 "[handleForceAtlas2Pause] mSigma: Just " s
    --log2 "[handleForceAtlas2Pause] toggled: " toggled
118
    isFARunning <- Sigma.isForceAtlas2Running s
119
    --log2 "[handleForceAtlas2Pause] isFARunning: " isFARunning
120
    case Tuple toggled isFARunning of
121 122 123 124
      Tuple true false -> do
        -- hide edges during forceAtlas rendering, this prevents flickering
        Sigma.restartForceAtlas2 s
        setEdges s false
125 126 127
        case R.readRef mFAPauseRef of
          Nothing -> pure unit
          Just timeoutId -> clearTimeout timeoutId
128 129 130 131
      Tuple false true -> do
        -- restore edges state
        Sigma.stopForceAtlas2 s
        setEdges s showEdges
132
      _ -> pure unit
133 134 135 136 137 138
    -- handle case when user pressed pause/start fa button before timeout fired
    --case R.readRef mFAPauseRef of
    --  Nothing -> pure unit
    --  Just timeoutId -> do
    --    R.setRef mFAPauseRef Nothing
    --    clearTimeout timeoutId
139 140 141 142 143 144 145 146 147 148 149

setEdges :: Sigma.Sigma -> Boolean -> Effect Unit
setEdges sigma val = do
  let settings = {
        drawEdges: val
      , drawEdgeLabels: val
      , hideEdgesOnMove: not val
    }
  -- prevent showing edges (via show edges button) when FA is running (flickering)
  isFARunning <- Sigma.isForceAtlas2Running sigma
  case Tuple val isFARunning of
150
    Tuple false _ ->
151 152 153 154
      Sigma.setSettings sigma settings
    Tuple true false ->
      Sigma.setSettings sigma settings
    _ -> pure unit
155

156 157 158 159 160 161 162 163 164 165 166 167 168 169 170
markSelectedEdges :: Sigma.Sigma -> SelectedEdgeIds -> EdgesMap -> Effect Unit
markSelectedEdges sigma selectedEdgeIds graphEdges = do
  Sigma.forEachEdge sigma \e -> do
    case Map.lookup e.id graphEdges of
      Nothing -> error $ "Edge id " <> e.id <> " not found in graphEdges map"
      Just {color} -> do
        let newColor =
              if Set.member e.id selectedEdgeIds then
                "#ff0000"
              else
                color
        _ <- pure $ (e .= "color") newColor
        pure unit
  Sigma.refresh sigma

171
markSelectedNodes :: Sigma.Sigma -> SelectedNodeIds -> NodesMap -> Effect Unit
172 173 174 175 176 177 178 179 180 181 182 183 184
markSelectedNodes sigma selectedNodeIds graphNodes = do
  Sigma.forEachNode sigma \n -> do
    case Map.lookup n.id graphNodes of
      Nothing -> error $ "Node id " <> n.id <> " not found in graphNodes map"
      Just {color} -> do
        let newColor =
              if Set.member n.id selectedNodeIds then
                "#ff0000"
              else
                color
        _ <- pure $ (n .= "color") newColor
        pure unit
  Sigma.refresh sigma
185 186 187 188


bindSelectedNodesClick :: R.Ref Sigma -> R.State SelectedNodeIds -> Effect Unit
bindSelectedNodesClick sigmaRef (_ /\ setSelectedNodeIds) =
189
  dependOnSigma (R.readRef sigmaRef) "[graphCpt] no sigma" $ \sigma -> do
190 191 192 193 194 195
    Sigma.bindClickNode sigma $ \node -> do
      setSelectedNodeIds \nids ->
        if Set.member node.id nids then
          Set.delete node.id nids
        else
          Set.insert node.id nids
196 197 198 199 200 201 202 203 204 205 206

bindSelectedEdgesClick :: R.Ref Sigma -> R.State SelectedEdgeIds -> Effect Unit
bindSelectedEdgesClick sigmaRef (_ /\ setSelectedEdgeIds) =
  dependOnSigma (R.readRef sigmaRef) "[graphCpt] no sigma" $ \sigma -> do
    Sigma.bindClickEdge sigma $ \edge -> do
      log2 "[bindClickEdge] edge" edge
      setSelectedEdgeIds \eids ->
        if Set.member edge.id eids then
          Set.delete edge.id eids
        else
          Set.insert edge.id eids