Sigmax.purs 7.69 KB
Newer Older
James Laver's avatar
James Laver committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
module Gargantext.Hooks.Sigmax
  -- (
  -- )
  where

import Prelude
import Data.Array as A
import Data.Bitraversable (bitraverse)
import Data.Either (Either(..), either)
import Data.Foldable (sequence_)
import Data.Maybe (Maybe(..), maybe)
import Data.Nullable (Nullable, null)
import Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Traversable (for, for_, traverse, traverse_)
import DOM.Simple.Console (log, log2)
17
import DOM.Simple.Types (Element)
James Laver's avatar
James Laver committed
18 19 20 21 22 23 24 25 26 27 28 29
import Effect (Effect)
import FFI.Simple (delay)
import Reactix as R
import Reactix.DOM.HTML as RH
import Gargantext.Utils.Reactix as R2
import Gargantext.Types (class Optional)
import Gargantext.Hooks.Sigmax.Sigma (SigmaOpts)
import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Hooks.Sigmax.Types

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 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
  , cleanup :: R.Ref (Seq (Effect Unit))
  }

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

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)

54 55 56 57 58 59 60 61 62
startSigma :: forall settings faSettings n e. R.Ref (Nullable Element) -> R.Ref (Maybe Sigma) -> settings -> faSettings -> Graph n e -> R.Hooks Unit
startSigma ref sigmaRef settings forceAtlas2Settings graph = do
  {sigma, isNew} <- useSigma ref settings sigmaRef
  useCanvasRenderer ref sigma

  if isNew then do
    useData sigma graph
    useForceAtlas2 sigma forceAtlas2Settings
  else
63 64 65 66 67 68 69 70 71 72 73 74 75
    pure unit

  R.useEffect $ do
    delay unit $ handleRefresh sigma

  where
    handleRefresh sigma _ = do
      let rSigma = readSigma sigma
      _ <- case rSigma of
        Nothing -> log2 "[handleRefresh] can't refresh" sigma
        Just s -> do
          Sigma.refreshForceAtlas s
      pure $ pure unit
76

James Laver's avatar
James Laver committed
77
-- | Manages a sigma with the given settings
78
useSigma :: forall settings. R.Ref (Nullable Element) -> settings -> R.Ref (Maybe Sigma) -> R.Hooks {sigma :: Sigma, isNew :: Boolean}
79
useSigma container settings sigmaRef = do
80 81 82 83 84 85 86 87
  sigma <- newSigma sigmaRef
  let isNew = case (readSigma sigma) of
        Just _ -> false
        _      -> true
  R.useEffect1 isNew $ do
    log2 "isNew" isNew
    log2 "sigmaRef" $ R.readRef sigmaRef
    log2 "sigma" sigma
James Laver's avatar
James Laver committed
88
    delay unit $ handleSigma sigma (readSigma sigma)
89
  pure $ {sigma, isNew}
James Laver's avatar
James Laver committed
90
  where
91 92 93 94 95 96 97 98 99 100
    newSigma sigmaRef = do
      let mSigma = R.readRef sigmaRef
      case mSigma of
        Just sigma -> pure sigma
        Nothing    -> do
          s <- R2.nothingRef
          c <- R.useRef Seq.empty
          pure {sigma: s, cleanup: c}
    handleSigma sigma (Just _) _ = do
      pure R.nothing
James Laver's avatar
James Laver committed
101 102 103
    handleSigma sigma Nothing _ = do
      ret <- createSigma settings
      traverse_ (writeSigma sigma <<< Just) ret
104
      R.setRef sigmaRef $ Just sigma
105 106
      --pure $ cleanupSigma sigma "useSigma"
      pure $ R.nothing
James Laver's avatar
James Laver committed
107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132

-- | Manages a renderer for the sigma
useCanvasRenderer :: R.Ref (Nullable Element) -> Sigma -> R.Hooks Unit
useCanvasRenderer container sigma =
  R.useEffect2' container sigma.sigma $
    delay unit $ \_ ->
      dependOnContainer container containerNotFoundMsg withContainer
  where
    withContainer c = dependOnSigma sigma sigmaNotFoundMsg withSigma
      where -- close over c
        withSigma sig = addRenderer sig renderer >>= handle
          where -- close over sig
            renderer = { "type": "canvas", container: c }
            handle (Right _) = cleanupFirst sigma (Sigma.killRenderer sig renderer >>= logCleanup)
            handle (Left e) =
              log2 errorAddingMsg e *> cleanupSigma sigma "useCanvasRenderer"
    logCleanup (Left e) = log2 errorKillingMsg e
    logCleanup _ = log killedMsg
    containerNotFoundMsg = "[useCanvasRenderer] Container not found, not adding renderer"
    sigmaNotFoundMsg     = "[useCanvasRenderer] Sigma not found, not adding renderer"
    errorAddingMsg       = "[useCanvasRenderer] Error adding canvas renderer: "
    errorKillingMsg      = "[useCanvasRenderer] Error killing renderer:"
    killedMsg            = "[useCanvasRenderer] Killed renderer"

createSigma :: forall settings err. settings -> Effect (Either err Sigma.Sigma)
createSigma settings = do
133
  log2 "[useSigma] Initializing sigma with settings" settings
James Laver's avatar
James Laver committed
134 135 136 137
  ret <- Sigma.sigma {settings}
  ret <$ logStatus ret
  where
    logStatus (Left err) = log2 "[useSigma] Error during sigma creation:" err
138
    logStatus (Right x) = log2 "[useSigma] Initialised sigma successfully:" x
James Laver's avatar
James Laver committed
139 140 141 142 143 144 145 146 147 148 149 150 151 152

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"

153
addRenderer :: forall r err. Sigma.Sigma -> r -> Effect (Either err Unit)
James Laver's avatar
James Laver committed
154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196
addRenderer sigma renderer = do
  ret <- Sigma.addRenderer sigma renderer
  (const unit <$> ret) <$ report ret
  where
    report = either (log2 errorMsg) (\_ -> log successMsg)
    errorMsg = "[useRenderer] Error adding renderer:"
    successMsg = "[useRenderer] Added renderer successfully"

useData :: forall n e. Sigma -> Graph n e -> R.Hooks Unit
useData sigma graph =
  R.useEffect2' sigma.sigma graph $
    delay unit $ \_ -> dependOnSigma sigma sigmaNotFoundMsg withSigma
  where
    withSigma sig = refreshData sig (sigmafy graph)
    sigmaNotFoundMsg = "[useData] Sigma not found, not adding data"

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
    clearingMsg = "[useData] Clearing existing graph data"
    readingMsg = "[useData] Reading graph data"
    refreshingMsg = "[useData] Refreshing graph"
    errorMsg = "[useData] Error reading graph data:"

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

useForceAtlas2 :: forall settings. Sigma -> settings -> R.Hooks Unit
useForceAtlas2 sigma settings =
  R.useEffect1' sigma.sigma (delay unit effect)
  where
    effect _ = dependOnSigma sigma sigmaNotFoundMsg withSigma
    withSigma sig = do
      log startingMsg
James Laver's avatar
James Laver committed
197
      log sigma
James Laver's avatar
James Laver committed
198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214
      Sigma.startForceAtlas2 sig settings
      cleanupFirst sigma (Sigma.killForceAtlas2 sig)
    startingMsg = "[Graph] Starting ForceAtlas2"
    sigmaNotFoundMsg = "[Graph] Sigma not found, not initialising"

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