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

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

James Laver's avatar
James Laver committed
28
import Gargantext.Hooks.Sigmax.Sigma as Sigma
29
import Gargantext.Hooks.Sigmax.Types as ST
30
import Gargantext.Utils.Reactix as R2
James Laver's avatar
James Laver committed
31 32 33

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

38
type Data n e = { graph :: R.Ref (ST.Graph n e) }
James Laver's avatar
James Laver committed
39

40 41 42 43 44 45
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
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
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
80
  *>  Sigma.clear sigmaGraph
James Laver's avatar
James Laver committed
81
  *>  log readingMsg
82
  *>  Sigma.graphRead sigmaGraph graph
James Laver's avatar
James Laver committed
83 84
  >>= either (log2 errorMsg) refresh
  where
85
    sigmaGraph = Sigma.graph sigma
James Laver's avatar
James Laver committed
86
    refresh _ = log refreshingMsg *> Sigma.refresh sigma
87 88 89 90
    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
91

92 93
sigmafy :: forall n e. ST.Graph n e -> Sigma.Graph n e
sigmafy (ST.Graph g) = {nodes,edges}
James Laver's avatar
James Laver committed
94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109
  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

110 111 112

-- Effectful versions of the above code

113 114 115
-- | 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.
116 117
handleForceAtlas2Pause :: forall settings. R.Ref Sigma -> T.Box ST.ForceAtlasState -> R.Ref (Maybe TimeoutId) -> settings -> Effect Unit
handleForceAtlas2Pause sigmaRef forceAtlasState mFAPauseRef settings = do
118
  let sigma = R.readRef sigmaRef
119
  toggled <- T.read forceAtlasState
120
  dependOnSigma sigma "[handleForceAtlas2Pause] sigma: Nothing" $ \s -> do
121
    let isFARunning = Sigma.isForceAtlas2Running s
122
    case Tuple toggled isFARunning of
123
      Tuple ST.InitialRunning false -> do
124
        Sigma.restartForceAtlas2 s settings
125
      Tuple ST.Running false -> do
126
        Sigma.restartForceAtlas2 s settings
127 128 129
        case R.readRef mFAPauseRef of
          Nothing -> pure unit
          Just timeoutId -> clearTimeout timeoutId
130
      Tuple ST.Paused true -> do
131
        Sigma.stopForceAtlas2 s
132
      _ -> pure unit
133 134 135 136 137 138 139 140

setEdges :: Sigma.Sigma -> Boolean -> Effect Unit
setEdges sigma val = do
  let settings = {
        drawEdges: val
      , drawEdgeLabels: val
      , hideEdgesOnMove: not val
    }
141 142
  Sigma.setSettings sigma settings

143

144
updateEdges :: Sigma.Sigma -> ST.EdgesMap -> Effect Unit
145
updateEdges sigma edgesMap = do
146
  Sigma.forEachEdge (Sigma.graph sigma) \e -> do
147 148 149
    let mTEdge = Map.lookup e.id edgesMap
    case mTEdge of
      Nothing -> error $ "Edge id " <> e.id <> " not found in edgesMap"
150
      (Just {color: tColor, hidden: tHidden}) -> do
151
        _ <- pure $ (e .= "color") tColor
152
        _ <- pure $ (e .= "hidden") tHidden
153
        pure unit
154
  --Sigma.refresh sigma
155 156


157
updateNodes :: Sigma.Sigma -> ST.NodesMap -> Effect Unit
158
updateNodes sigma nodesMap = do
159
  Sigma.forEachNode (Sigma.graph sigma) \n -> do
160 161 162
    let mTNode = Map.lookup n.id nodesMap
    case mTNode of
      Nothing -> error $ "Node id " <> n.id <> " not found in nodesMap"
163 164
      (Just { borderColor: tBorderColor
             , color: tColor
165
             , equilateral: tEquilateral
166
             , hidden: tHidden
167
             , type: tType }) -> do
168
        _ <- pure $ (n .= "borderColor") tBorderColor
169
        _ <- pure $ (n .= "color") tColor
170
        _ <- pure $ (n .= "equilateral") tEquilateral
171
        _ <- pure $ (n .= "hidden") tHidden
172
        _ <- pure $ (n .= "type") tType
173
        pure unit
174
  --Sigma.refresh sigma
175 176


177
-- | Toggles item visibility in the selected set
178
multiSelectUpdate :: ST.NodeIds -> ST.NodeIds -> ST.NodeIds
179 180 181 182 183 184 185 186 187
multiSelectUpdate new selected = foldl fld selected new
  where
    fld selectedAcc item =
      if Set.member item selectedAcc then
        Set.delete item selectedAcc
      else
        Set.insert item selectedAcc


188
bindSelectedNodesClick :: Sigma.Sigma -> T.Box ST.NodeIds -> R.Ref Boolean -> Effect Unit
189
bindSelectedNodesClick sigma selectedNodeIds multiSelectEnabledRef =
190 191 192 193
  Sigma.bindClickNodes sigma $ \nodes -> do
    let multiSelectEnabled = R.readRef multiSelectEnabledRef
    let nodeIds = Set.fromFoldable $ map _.id nodes
    if multiSelectEnabled then
194
      T.modify_ (multiSelectUpdate nodeIds) selectedNodeIds
195
    else
196
      T.write_ nodeIds selectedNodeIds
197

198 199
bindSelectedEdgesClick :: R.Ref Sigma -> R.State ST.EdgeIds -> Effect Unit
bindSelectedEdgesClick sigmaRef (_ /\ setEdgeIds) =
200 201
  dependOnSigma (R.readRef sigmaRef) "[graphCpt] no sigma" $ \sigma -> do
    Sigma.bindClickEdge sigma $ \edge -> do
202
      setEdgeIds \eids ->
203 204 205 206
        if Set.member edge.id eids then
          Set.delete edge.id eids
        else
          Set.insert edge.id eids
207 208 209 210 211

selectorWithSize :: Sigma.Sigma -> Int -> Effect Unit
selectorWithSize sigma size = do
  pure unit

212 213 214 215 216
performDiff :: Sigma.Sigma -> ST.SGraph -> Effect Unit
performDiff sigma g = do
  if (Seq.null addEdges) && (Seq.null addNodes) && (Set.isEmpty removeEdges) && (Set.isEmpty removeNodes) then
    pure unit
  else do
217 218 219 220
    traverse_ (Sigma.addNode sigmaGraph) addNodes
    traverse_ (Sigma.addEdge sigmaGraph) addEdges
    traverse_ (Sigma.removeEdge sigmaGraph) removeEdges
    traverse_ (Sigma.removeNode sigmaGraph) removeNodes
221 222
    Sigma.refresh sigma
    Sigma.killForceAtlas2 sigma
223 224 225 226 227
  where
    sigmaGraph = Sigma.graph sigma
    sigmaEdgeIds = Sigma.sigmaEdgeIds sigmaGraph
    sigmaNodeIds = Sigma.sigmaNodeIds sigmaGraph
    {add: Tuple addEdges addNodes, remove: Tuple removeEdges removeNodes} = ST.sigmaDiff sigmaEdgeIds sigmaNodeIds g
228 229
-- DEPRECATED

230
markSelectedEdges :: Sigma.Sigma -> ST.EdgeIds -> ST.EdgesMap -> Effect Unit
231
markSelectedEdges sigma selectedEdgeIds graphEdges = do
232
  Sigma.forEachEdge (Sigma.graph sigma) \e -> do
233 234 235 236 237 238 239 240 241 242 243 244
    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

245
markSelectedNodes :: Sigma.Sigma -> ST.NodeIds -> ST.NodesMap -> Effect Unit
246
markSelectedNodes sigma selectedNodeIds graphNodes = do
247
  Sigma.forEachNode (Sigma.graph sigma) \n -> do
248 249 250 251 252 253 254 255 256 257 258
    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
259 260 261 262 263 264

getEdges :: Sigma.Sigma -> Effect (Array (Record ST.Edge))
getEdges sigma = Sigma.getEdges sigma

getNodes :: Sigma.Sigma -> Effect (Array (Record ST.Node))
getNodes sigma = Sigma.getNodes sigma