Merge branch 'dev-graph-eff-rewrite' into dev-forest

src/Gargantext/Components/FacetsTable.purs

@@ -83,6 +83,7 @@ newtype DocumentsView =
   , date     :: String
   , title    :: String
   , source   :: String
+  , authors  :: String
   , score    :: Int
   , pairs    :: Array Pair
   , delete   :: Boolean
@@ -106,7 +107,8 @@ newtype Response = Response
   }
 
 newtype Hyperdata = Hyperdata
-  { title  :: String
+  { authors :: String
+  , title   :: String
   , source  :: String
   }
 
@@ -127,9 +129,10 @@ instance decodePair :: DecodeJson Pair where
 instance decodeHyperdata :: DecodeJson Hyperdata where
   decodeJson json = do
     obj    <- decodeJson json
+    authors <- obj .| "authors"
     title  <- obj .| "title"
     source <- obj .| "source"
-    pure $ Hyperdata { title,source }
+    pure $ Hyperdata { authors, title,source }
 
 {-
 instance decodeResponse :: DecodeJson Response where
@@ -239,8 +242,8 @@ loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy}} = do
   where
     res2corpus :: Response -> DocumentsView
     res2corpus (Response { id, created: date, ngramCount: score, category
-                         , hyperdata: Hyperdata {title, source} }) =
-      DocumentsView { id, date, title, source, score, category, pairs: [], delete: false }
+                         , hyperdata: Hyperdata {authors, title, source} }) =
+      DocumentsView { id, date, title, source, score, authors, category, pairs: [], delete: false }
     convOrderBy (T.ASC  (T.ColumnName "Date")) = DateAsc
     convOrderBy (T.DESC (T.ColumnName "Date")) = DateDesc
     convOrderBy (T.ASC  (T.ColumnName "Title")) = TitleAsc
@@ -294,23 +297,22 @@ pageCpt = R.staticComponent "G.C.FacetsTable.Page" cpt
           | otherwise = H.text label
         comma = H.span {} [ H.text ", " ]
         rows = row <$> filter (not <<< isDeleted) documents
-          where
-            row (DocumentsView {id,score,title,source,date,pairs,delete,category}) =
+        row dv@(DocumentsView {id,score,title,source,date, authors,pairs,delete,category}) =
           { row:
-                [ H.div {}
-                  [ H.a { className, on: {click: markClick} } []
+            [ H.a { className: gi category, on: {click: markClick} } []
               -- TODO show date: Year-Month-Day only
-                  , maybeStricken [ H.text date ]
-                  , maybeStricken [ H.text source ]
+            , maybeStricken delete [ H.text date ]
+            , maybeStricken delete [ H.text title ]
+            , maybeStricken delete [ H.text source ]
+            , maybeStricken delete [ H.text authors ]
               -- , maybeStricken $ intercalate [comma] (pairUrl <$> pairs)
             , H.input { type: "checkbox", checked: isChecked id, on: { click: toggleClick } }
-                  ] ]
+            ]
           , delete: true }
           where
             markClick _ = markCategory session nodeId category [id]
             toggleClick _ = togglePendingDeletion deletions id
-                className = gi category
-                maybeStricken
+        maybeStricken delete
           | delete = H.div { style: { textDecoration: "line-through" } }
           | otherwise = H.div {}
 

src/Gargantext/Components/Graph.purs

@@ -5,6 +5,7 @@ module Gargantext.Components.Graph
   -- )
   where
 import Prelude (bind, discard, pure, ($), unit, map)
+import Data.Either (Either(..))
 import Data.Map as Map
 import Data.Maybe (Maybe(..))
 import Data.Nullable (notNull, null, Nullable)
@@ -52,14 +53,32 @@ graphCpt = R.hooksComponent "Graph" cpt
           Sigmax.markSelectedNodes sigma (fst selectedNodeIds) nodesMap
 
       R.useEffectOnce $ do
-        let mSigma = Sigmax.readSigma $ R.readRef props.sigmaRef
+        let rSigma = R.readRef props.sigmaRef
 
-        Sigmax.startSigmaEff props.elRef props.sigmaRef props.sigmaSettings props.forceAtlas2Settings props.graph
+        case Sigmax.readSigma rSigma of
+          Nothing -> do
+            eSigma <- Sigma.sigma {settings: props.sigmaSettings}
+            case eSigma of
+              Left err -> log2 "[graphCpt] error creating sigma" err
+              Right sig -> do
+                Sigmax.writeSigma rSigma $ Just sig
+
+                Sigmax.dependOnContainer props.elRef "[graphCpt] container not found" $ \c -> do
+                  _ <- Sigma.addRenderer sig {
+                      "type": "canvas"
+                    , container: c
+                    }
+                  pure unit
+
+                Sigmax.refreshData sig $ Sigmax.sigmafy props.graph
+
+                Sigmax.setEdges sig false
+                Sigma.startForceAtlas2 sig props.forceAtlas2Settings
 
                 -- bind the click event only initially, when ref was empty
-        case mSigma of
-          Nothing -> Sigmax.bindSelectedNodesClick props.sigmaRef selectedNodeIds
-          Just _  -> pure unit
+                Sigmax.bindSelectedNodesClick props.sigmaRef selectedNodeIds
+          Just sig -> do
+            pure unit
 
         delay unit $ \_ -> do
           log "[GraphCpt] cleanup"

src/Gargantext/Hooks/Sigmax.purs

@@ -59,81 +59,6 @@ cleanupFirst :: Sigma -> Effect Unit -> Effect Unit
 cleanupFirst sigma =
   R.setRef sigma.cleanup <<< (flip Seq.cons) (R.readRef sigma.cleanup)
 
-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 settings sigmaRef
-  useCanvasRenderer ref sigma
-
-  if isNew then do
-    useData sigma graph
-    useForceAtlas2 sigma forceAtlas2Settings
-  else
-    pure unit
-
--- | Manages a sigma with the given settings
-useSigma :: forall settings. settings -> R.Ref (Maybe Sigma) -> R.Hooks {sigma :: Sigma, isNew :: Boolean}
-useSigma settings sigmaRef = do
-  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
-    delay unit $ handleSigma sigma (readSigma sigma)
-  pure $ {sigma, isNew}
-  where
-    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
-    handleSigma sigma Nothing _ = do
-      ret <- createSigma settings
-      traverse_ (writeSigma sigma <<< Just) ret
-      R.setRef sigmaRef $ Just sigma
-      --pure $ cleanupSigma sigma "useSigma"
-      pure $ R.nothing
-
-
--- | 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
-  log2 "[useSigma] Initializing sigma with settings" settings
-  ret <- Sigma.sigma {settings}
-  ret <$ logStatus ret
-  where
-    logStatus (Left err) = log2 "[useSigma] Error during sigma creation:" err
-    logStatus (Right x) = log2 "[useSigma] Initialised sigma successfully:" x
-
 cleanupSigma :: Sigma -> String -> Effect Unit
 cleanupSigma sigma context = traverse_ kill (readSigma sigma)
   where
@@ -147,23 +72,6 @@ cleanupSigma sigma context = traverse_ kill (readSigma sigma)
     errorMsg = prefix <> "Error killing sigma:"
     successMsg = prefix <> "Killed sigma"
 
-addRenderer :: forall r err. Sigma.Sigma -> r -> Effect (Either err Unit)
-addRenderer sigma renderer = do
-  ret <- Sigma.addRenderer sigma renderer
-  (const unit <$> ret) <$ report ret
-  where
-    report = either (log2 errorMsg) (\_ -> log successMsg)
-    errorMsg = "[addRenderer] Error adding renderer:"
-    successMsg = "[addRenderer] 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
@@ -173,10 +81,10 @@ refreshData 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:"
+    clearingMsg = "[refreshData] Clearing existing graph data"
+    readingMsg = "[refreshData] Reading graph data"
+    refreshingMsg = "[refreshData] Refreshing graph"
+    errorMsg = "[refreshData] Error reading graph data:"
 
 sigmafy :: forall n e. Graph n e -> Sigma.Graph n e
 sigmafy (Graph g) = {nodes,edges}
@@ -184,19 +92,6 @@ sigmafy (Graph g) = {nodes,edges}
     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
-      log sigma
-      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
@@ -212,76 +107,6 @@ dependOnContainer container notFoundMsg f = do
 
 -- Effectful versions of the above code
 
-startSigmaEff :: forall settings faSettings n e. R.Ref (Nullable Element) -> R.Ref Sigma -> settings -> faSettings -> Graph n e -> Effect Unit
-startSigmaEff ref sigmaRef settings forceAtlas2Settings graph = do
-  let rSigma = R.readRef sigmaRef
-  case readSigma rSigma of
-    Nothing -> do
-      sigma <- useSigmaEff settings sigmaRef
-      useCanvasRendererEff ref sigma
-
-      useDataEff sigma graph
-      useForceAtlas2Eff sigma forceAtlas2Settings
-    Just sig -> do
-      pure unit
-
-
-useSigmaEff :: forall settings. settings -> R.Ref Sigma -> Effect Sigma
-useSigmaEff settings sigmaRef = do
-  let sigma = R.readRef sigmaRef
-  handleSigma sigma (readSigma sigma)
-  pure sigma
-
-  where
-    handleSigma :: Sigma -> (Maybe Sigma.Sigma) -> Effect Unit
-    handleSigma sigma (Just _) = do
-      pure unit
-    handleSigma sigma Nothing = do
-      ret <- createSigma settings
-      traverse_ (writeSigma sigma <<< Just) ret
-      R.setRef sigmaRef sigma
-      pure unit
-
-useDataEff :: forall n e. Sigma -> Graph n e -> Effect Unit
-useDataEff sigma graph = dependOnSigma sigma sigmaNotFoundMsg withSigma
-  where
-    withSigma sig = refreshData sig (sigmafy graph)
-    sigmaNotFoundMsg = "[useDataEff] Sigma not found, not adding data"
-
-useCanvasRendererEff :: R.Ref (Nullable Element) -> Sigma -> Effect Unit
-useCanvasRendererEff container 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 _ = log "[useCanvasRendererEff] cleanup handle"
-            --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 = "[useCanvasRendererEff] Container not found, not adding renderer"
-    sigmaNotFoundMsg     = "[useCanvasRendererEff] Sigma not found, not adding renderer"
-    errorAddingMsg       = "[useCanvasRendererEff] Error adding canvas renderer: "
-    errorKillingMsg      = "[useCanvasRendererEff] Error killing renderer:"
-    killedMsg            = "[useCanvasRendererEff] Killed renderer"
-
-useForceAtlas2Eff :: forall settings. Sigma -> settings -> Effect Unit
-useForceAtlas2Eff sigma settings = effect
-  where
-    effect = dependOnSigma sigma sigmaNotFoundMsg withSigma
-    withSigma sig = do
-      --log2 startingMsg sigma
-      setEdges sig false
-      Sigma.startForceAtlas2 sig settings
-      --cleanupFirst sigma (Sigma.killForceAtlas2 sig)
-    startingMsg = "[useForceAtlas2Eff] Starting ForceAtlas2"
-    sigmaNotFoundMsg = "[useForceAtlas2Eff] Sigma not found, not initialising"
-
 -- | 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.