Mini refactoring of recomputeGraph

General cleanup in preparation of bug fixing.

gargantext.cabal

@@ -568,6 +568,7 @@ library
     , rake ^>= 0.0.1
     , random ^>= 1.2.1
     , rdf4h ^>= 3.1.1
+    , recover-rtti >= 0.4 && < 0.5
     , regex-compat ^>= 0.95.2.1
     , regex-tdfa ^>= 1.3.1.2
     , replace-attoparsec ^>= 1.4.5.0

src/Gargantext/Core/Viz/Graph/API.hs

@@ -13,15 +13,17 @@ Portability : POSIX
 
 {-# LANGUAGE BangPatterns      #-}
 {-# LANGUAGE OverloadedLists   #-}   -- allows to write Map and HashMap as lists
+{-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE TypeOperators     #-}
 
 module Gargantext.Core.Viz.Graph.API
   where
 
-import Control.Lens (set, (^.), _Just, (^?), at)
+import Control.Lens (set, (^.), _Just, (^?), at, Getting)
 import Data.Aeson ( ToJSON, FromJSON )
 import Data.HashMap.Strict qualified as HashMap
 import Data.Swagger ( ToSchema )
+import Data.Text qualified as T
 import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
 import Gargantext.API.Admin.Orchestrator.Types ( JobLog )
 import Gargantext.API.Errors.Types ( BackendInternalError )
@@ -37,7 +39,7 @@ import Gargantext.Core.Viz.Graph.Types
 import Gargantext.Database.Action.Metrics.NgramsByContext (getContextsByNgramsOnlyUser)
 import Gargantext.Database.Action.Node (mkNodeWithParent)
 import Gargantext.Database.Admin.Config ( userMaster )
-import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Admin.Types.Node hiding (DEBUG)
 import Gargantext.Database.Prelude (DBCmd)
 import Gargantext.Database.Query.Table.Node ( getOrMkList, getNodeWith, defaultList, getClosestParentIdByType )
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
@@ -45,6 +47,7 @@ import Gargantext.Database.Query.Table.Node.Select ( selectNodesWithUsername )
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Schema.Node (node_hyperdata, node_name)
 import Gargantext.Prelude
+import Gargantext.System.Logging
 import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
 import Servant
 import Servant.Job.Async (AsyncJobsAPI)
@@ -118,38 +121,31 @@ getGraph nId = do
 
 
 --recomputeGraph :: UserId -> NodeId -> Maybe GraphMetric -> GargNoServer Graph
-recomputeGraph :: HasNodeStory env err m
+recomputeGraph :: (MonadLogger m, HasNodeStory env err m)
                => NodeId
                -> PartitionMethod
                -> BridgenessMethod
                -> Maybe GraphMetric
+               -- ^ If 'Just', overrides the default 'GraphMetric' associated with the graph metadata.
                -> Maybe Strength
+               -- ^ If 'Just', overrides the default 'Strength' associated with the graph metadata.
                -> NgramsType
                -> NgramsType
                -> Bool
                -> m Graph
-recomputeGraph nId partitionMethod bridgeMethod maybeSimilarity maybeStrength nt1 nt2 force' = do
+recomputeGraph nId partitionMethod bridgeMethod metricOverride strengthOverride nt1 nt2 force' = do
   nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
   let
-    graph  = nodeGraph ^. node_hyperdata . hyperdataGraph
-    camera = nodeGraph ^. node_hyperdata . hyperdataCamera
-    graphMetadata = graph ^? _Just . graph_metadata . _Just
-    listVersion   = graph ^? _Just . graph_metadata . _Just . gm_list . lfg_version
-    graphMetric   = case maybeSimilarity of
-                      Nothing -> graph ^? _Just . graph_metadata . _Just . gm_metric
-                      Just _  -> maybeSimilarity
-    similarity = case graphMetric of
-                   Nothing -> withMetric Order1
-                   Just m  -> withMetric m
-
-    strength = case maybeStrength of
-                   Nothing -> case graph ^? _Just . graph_metadata . _Just . gm_edgesStrength of
-                        Nothing  -> Strong
-                        Just  mr -> fromMaybe Strong mr
-                   Just r  -> r
+    graph          = nodeGraph ^. node_hyperdata . hyperdataGraph
+    camera         = nodeGraph ^. node_hyperdata . hyperdataCamera
+    graphMetadata  = graph ^? _GraphMeta
+    listVersion    = graph ^? _GraphMeta . gm_list . lfg_version
+    graphMetric    = fromMaybe Order1 $ metricOverride <|> (graph ^? _GraphMeta . gm_metric)
+    similarity     = withMetric graphMetric
+    strength       = fromMaybe Strong $ strengthOverride <|> (join $ graph ^? _GraphMeta . gm_edgesStrength)
 
   mcId <- getClosestParentIdByType nId NodeCorpus
-  let cId = maybe (panic "[G.V.G.API] Node has no parent") identity mcId
+  let cId = maybe (panicTrace "[G.V.G.API] Node has no parent") identity mcId
 
   listId  <- defaultList cId
   repo <- getRepo [listId]
@@ -163,14 +159,19 @@ recomputeGraph nId partitionMethod bridgeMethod maybeSimilarity maybeStrength nt
 
   case graph of
     Nothing     -> do
-      mt     <- defaultGraphMetadata cId listId "Title" repo (fromMaybe Order1 maybeSimilarity) strength
-      g <- computeG $ Just mt
-      pure $ trace ("[G.V.G.API.recomputeGraph] Graph empty, computed" :: Text) g
+      $(logLocM) DEBUG $ T.pack "Graph empty, computed"
+      mt <- defaultGraphMetadata cId listId "Title" repo graphMetric strength
+      g  <- computeG $ Just mt
+      pure g
     Just graph' -> if (listVersion == Just v) && (not force')
                      then pure graph'
                      else do
+                       $(logLocM) DEBUG $ T.pack "Graph exists, recomputing"
                        g <- computeG graphMetadata
-                       pure $ trace ("[G.V.G.API] Graph exists, recomputing" :: Text) g
+                       pure g
+  where
+    _GraphMeta :: Getting (First a) (Maybe Graph) GraphMetadata
+    _GraphMeta = _Just . graph_metadata . _Just
 
 
 -- TODO remove repo
@@ -259,7 +260,7 @@ graphAsync n =
 --               -> (JobLog -> GargNoServer ())
 --               -> GargNoServer JobLog
 -- TODO get Graph Metadata to recompute
-graphRecompute ::  (HasNodeStory env err m, MonadJobStatus m)
+graphRecompute ::  (HasNodeStory env err m, MonadJobStatus m, MonadLogger m)
                => NodeId
                -> JobHandle m
                -> m ()
@@ -308,7 +309,7 @@ graphVersions u nId = do
   pure $ GraphVersions { gv_graph = listVersion
                        , gv_repo = v }
 
-recomputeVersions :: HasNodeStory env err m
+recomputeVersions :: (MonadLogger m, HasNodeStory env err m)
                   => NodeId
                   -> m Graph
 recomputeVersions nId = recomputeGraph nId Spinglass BridgenessMethod_Basic Nothing Nothing NgramsTerms NgramsTerms False