[graph] add proper error reporting when graph can't be created due to lack of terms

src/Gargantext/API/Errors.hs

@@ -183,6 +183,8 @@ nodeErrorToFrontendError ne = case ne of
     -> mkFrontendErrShow $ FE_node_move_error sourceId targetId reason
   NodeNotExportable nodeId reason
     -> mkFrontendErrShow $ FE_node_export_error nodeId reason
+  NodeGraphCreationError nodeId reason
+    -> mkFrontendErrShow $ FE_node_graph_creation_error nodeId reason
 
   -- backward-compatibility shims, to remove eventually.
   DoesNotExist nid

src/Gargantext/API/Errors/Types.hs

@@ -291,6 +291,10 @@ data instance ToFrontendErrorData 'EC_403__node_export_error =
   FE_node_export_error { nee_node_id :: !NodeId, nee_reason :: !T.Text }
   deriving (Show, Eq, Generic)
 
+data instance ToFrontendErrorData 'EC_403__node_graph_creation_error =
+  FE_node_graph_creation_error { ngce_node_id :: !NodeId, ngce_reason :: !T.Text }
+  deriving (Show, Eq, Generic)
+
 --
 -- validation errors
 --
@@ -536,6 +540,15 @@ instance FromJSON (ToFrontendErrorData 'EC_403__node_export_error) where
     nee_reason  <- o .: "reason"
     pure FE_node_export_error{..}
 
+instance ToJSON (ToFrontendErrorData 'EC_403__node_graph_creation_error) where
+  toJSON FE_node_graph_creation_error{..} =
+    object [ "node_id" .= toJSON ngce_node_id, "reason" .= toJSON ngce_reason ]
+instance FromJSON (ToFrontendErrorData 'EC_403__node_graph_creation_error) where
+  parseJSON = withObject "FE_node_graph_creation_error" $ \o -> do
+    ngce_node_id <- o .: "node_id"
+    ngce_reason  <- o .: "reason"
+    pure FE_node_graph_creation_error{..}
+
 --
 -- validation errors
 --
@@ -753,6 +766,9 @@ instance FromJSON FrontendError where
       EC_403__node_export_error -> do
         (fe_data :: ToFrontendErrorData 'EC_403__node_export_error) <- o .: "data"
         pure FrontendError{..}
+      EC_403__node_graph_creation_error -> do
+        (fe_data :: ToFrontendErrorData 'EC_403__node_graph_creation_error) <- o .: "data"
+        pure FrontendError{..}
 
       -- validation error
       EC_400__validation_error -> do

src/Gargantext/API/Errors/Types/Backend.hs

@@ -36,6 +36,7 @@ data BackendErrorCode
   | EC_403__node_is_read_only
   | EC_403__node_move_error
   | EC_403__node_export_error
+  | EC_403__node_graph_creation_error
   -- validation errors
   | EC_400__validation_error
   -- policy check errors

src/Gargantext/API/Node/Update.hs

@@ -17,7 +17,7 @@ module Gargantext.API.Node.Update
 import Control.Lens (view, (^?), _Just)
 import Data.Set qualified as Set
 import Gargantext.API.Admin.EnvTypes (Env)
-import Gargantext.API.Errors.Types ( BackendInternalError )
+import Gargantext.API.Errors.Types ( BackendInternalError, HasBackendInternalError )
 import Gargantext.API.Metrics qualified as Metrics
 import Gargantext.API.Ngrams.Types qualified as NgramsTypes
 import Gargantext.API.Node.Update.Types (Method(..), UpdateNodeParams(..), UpdateNodeConfigGraph(..))
@@ -56,7 +56,8 @@ api nId =
  }
 
 -- TODO(adn) Make DB-transactional.
-updateNode :: (HasNodeStory env err m
+updateNode :: ( HasBackendInternalError err
+              , HasNodeStory env err m
               , MonadJobStatus m
               , MonadLogger m
               )

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

@@ -17,10 +17,10 @@ Portability : POSIX
 module Gargantext.Core.Viz.Graph.API
   where
 
-import Control.Lens (set, _Just, (^?), at, view)
+import Control.Lens (set, _Just, (^?), (#), at, view)
 import Data.HashMap.Strict qualified as HashMap
 import Gargantext.API.Admin.EnvTypes (Env)
-import Gargantext.API.Errors.Types ( BackendInternalError )
+import Gargantext.API.Errors.Types ( BackendInternalError(..), HasBackendInternalError(..) )
 import Gargantext.API.Ngrams.Tools
 import Gargantext.API.Prelude (GargM)
 import Gargantext.API.Routes.Named.Viz qualified as Named
@@ -39,7 +39,7 @@ import Gargantext.Database.Admin.Config ( userMaster )
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude
 import Gargantext.Database.Query.Table.Node ( getOrMkList, getNodeWith, defaultList, getClosestParentIdByType )
-import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError, NodeError(..))
 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)
@@ -52,7 +52,7 @@ import Gargantext.Core.Config (GargConfig)
 ------------------------------------------------------------------------
 --getGraph :: UserId -> NodeId -> GargServer HyperdataGraphAPI
 -- TODO(adn) DB-transactional
-getGraph :: (HasNodeStoryEnv env err, HasNodeError err, IsDBCmd env err m)
+getGraph :: (HasBackendInternalError err, HasNodeStoryEnv env err, HasNodeError err, IsDBCmd env err m)
          => NodeId
          -> m HyperdataGraphAPI
 getGraph nId = do
@@ -76,7 +76,10 @@ getGraph nId = do
         let defaultMetric          = Order1
         let defaultEdgesStrength   = Strong
         let defaultBridgenessMethod = BridgenessBasic
-        graph' <- computeGraph cId defaultBridgenessMethod (withMetric defaultMetric) defaultEdgesStrength (NgramsTerms, NgramsTerms) repo
+        eGraph <- computeGraph cId defaultBridgenessMethod (withMetric defaultMetric) defaultEdgesStrength (NgramsTerms, NgramsTerms) repo
+        graph' <- case eGraph of
+          Left err -> throwError $ _BackendInternalError # (InternalNodeError $ NodeGraphCreationError nId err)
+          Right g -> pure g
         mt     <- defaultGraphMetadata cId listId "Title" repo defaultMetric defaultEdgesStrength defaultBridgenessMethod
         let mt' = set gm_legend (generateLegend graph') mt
         let
@@ -92,7 +95,7 @@ getGraph nId = do
 
 --recomputeGraph :: UserId -> NodeId -> Maybe GraphMetric -> GargNoServer Graph
 -- TODO(adn) make db-transactional.
-recomputeGraph :: (HasNodeStoryEnv env err, IsDBCmd env err m, HasNodeError err)
+recomputeGraph :: (HasBackendInternalError err, HasNodeStoryEnv env err, IsDBCmd env err m, HasNodeError err)
                => NodeId
                -> BridgenessMethod
                -> Maybe GraphMetric
@@ -130,7 +133,10 @@ recomputeGraph nId bridgeMethod maybeSimilarity maybeStrength nt1 nt2 force' = d
   let v   = repo ^. unNodeStory . at listId . _Just . a_version
 
   let computeG mt = do
-        !g <- computeGraph cId bridgeMethod similarity strength (nt1,nt2) repo
+        !eg <- computeGraph cId bridgeMethod similarity strength (nt1,nt2) repo
+        g <- case eg of
+          Left err -> throwError $ _BackendInternalError # (InternalNodeError $ NodeGraphCreationError nId err)
+          Right g -> pure g
         let mt' = set gm_legend (generateLegend g) mt
         let g' = set graph_metadata (Just mt') g
         _nentries <- runDBTx $ updateHyperdata nId (HyperdataGraph (Just g') camera)
@@ -163,7 +169,7 @@ computeGraph :: HasNodeError err
              -> Strength
              -> (NgramsType, NgramsType)
              -> NodeListStory
-             -> DBCmd err Graph
+             -> DBCmd err (Either Text Graph)
 computeGraph corpusId bridgeMethod similarity strength (nt1,nt2) repo = do
   -- Getting the Node parameters
   (lId, lIds)  <- runDBQuery $ ((,) <$> defaultList corpusId <*> selectNodesWithUsername NodeList userMaster)
@@ -237,7 +243,7 @@ graphAsync nId =
 --               -> (JobLog -> GargNoServer ())
 --               -> GargNoServer JobLog
 -- TODO get Graph Metadata to recompute
-graphRecompute ::  (HasNodeStory env err m, MonadJobStatus m)
+graphRecompute ::  (HasBackendInternalError err, HasNodeStory env err m, MonadJobStatus m)
                => NodeId
                -> JobHandle m
                -> m ()
@@ -276,7 +282,7 @@ graphVersions env u nId = do
   pure $ GraphVersions { gv_graph = listVersion
                        , gv_repo = v }
 
-recomputeVersions :: HasNodeStory env err m
+recomputeVersions :: (HasBackendInternalError err, HasNodeStory env err m)
                   => NodeId
                   -> m Graph
 recomputeVersions nId = recomputeGraph nId BridgenessBasic Nothing Nothing NgramsTerms NgramsTerms False
@@ -307,7 +313,7 @@ graphClone cfg userId pId (HyperdataGraphAPI { _hyperdataAPIGraph = graph
 --getGraphGexf :: UserId
 --             -> NodeId
 --             -> GargNoServer (Headers '[Servant.Header "Content-Disposition" Text] Graph)
-getGraphGexf :: HasNodeStory env err m
+getGraphGexf :: (HasBackendInternalError err, HasNodeStory env err m)
               => NodeId
              -> m (Headers '[Servant.Header "Content-Disposition" Text] Graph)
 getGraphGexf nId = do

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

@@ -70,31 +70,36 @@ cooc2graphWith :: BridgenessMethod
                -> Threshold
                -> Strength
                -> HashMap (NgramsTerm, NgramsTerm) Int
-               -> IO Graph
+               -> IO (Either Text Graph)
 cooc2graphWith bridgenessMethod multi similarity threshold strength myCooc = do
   let (distanceMap, diag, ti) = doSimilarityMap similarity threshold strength myCooc
   distanceMap `seq` diag `seq` ti `seq` pure ()
 
-  partitions <- if Map.size distanceMap > 0
-      then spinglass 1 distanceMap
-      else panic $ Text.unwords [ "I can not compute the graph you request"
-                                , "because either the quantity of documents"
-                                , "or the quantity of terms"
-                                , "are lacking."
-                                , "Solution: add more either Documents or Map Terms to your analysis."
-                                , "Follow the available tutorials on the Training EcoSystems."
-                                , "Ask your co-users of GarganText how to have access to it."
-                                ]
-  length partitions `seq` pure ()
-
-  let
-    !confluence' = BAC.computeConfluences 3 (Map.keys distanceMap) True
-    !bridgeness' = bridgeness (partitionsToClusterNodes partitions)
-                              bridgenessMethod
-                              1.0
-                              distanceMap
-
-  pure $ data2graph multi ti diag bridgeness' confluence' (setNodes2clusterNodes partitions)
+  if Map.size distanceMap > 0
+    then do
+      partitions <- spinglass 1 distanceMap
+      length partitions `seq` pure ()
+      let
+        !confluence' = BAC.computeConfluences 3 (Map.keys distanceMap) True
+        !bridgeness' = bridgeness (partitionsToClusterNodes partitions)
+                                  bridgenessMethod
+                                  1.0
+                                  distanceMap
+    
+      pure $ Right $
+        data2graph multi ti diag bridgeness'
+                                 confluence'
+                                 (setNodes2clusterNodes partitions)
+      
+    else pure $ Left $ Text.unwords [ "I can not compute the graph you request"
+                                      , "because either the quantity of documents"
+                                      , "or the quantity of terms"
+                                      , "are lacking."
+                                      , "Solution: add more either Documents or Map Terms to your analysis."
+                                      , "Follow the available tutorials on the Training EcoSystems."
+                                      , "Ask your co-users of GarganText how to have access to it."
+                                      ]
+
 
 -- | Given a list of sets, each identifying the nodes in a cluster, returns
 -- a list of 'ClusterNode' where each node has been uniquely labeled

src/Gargantext/Database/Query/Table/Node/Error.hs

@@ -89,6 +89,7 @@ data NodeError = NoListFound ListId
                | NodeIsReadOnly NodeId T.Text
                | MoveError NodeId NodeId T.Text
                | NodeNotExportable NodeId T.Text
+               | NodeGraphCreationError NodeId T.Text
 
 instance HasNodeError NodeError where
   _NodeError = L.prism' Prelude.id Just
@@ -109,6 +110,7 @@ instance Prelude.Show NodeError
     show (NodeIsReadOnly n reason) = "Node " <> show n <> " is read only, edits not allowed. Reason: " <> T.unpack reason
     show (MoveError s t reason) = "Moving " <> show s <> " to " <> show t <> " failed: " <> T.unpack reason
     show (NodeNotExportable nid reason) = "Node " <> show nid <> " is not exportable: " <> show reason
+    show (NodeGraphCreationError nId reason) = "Graph creation error (" <> show nId <> "): " <> T.unpack reason
 
 instance Exception NodeError
 

test/Test/Instances.hs

@@ -516,6 +516,9 @@ genFrontendErr be = do
     Errors.EC_403__node_export_error
       -> do nId <- arbitrary
             pure $ Errors.mkFrontendErr' txt $ Errors.FE_node_export_error nId "generic reason"
+    Errors.EC_403__node_graph_creation_error
+      -> do nId <- arbitrary
+            pure $ Errors.mkFrontendErr' txt $ Errors.FE_node_graph_creation_error nId "generic reason"
 
     -- validation error
     Errors.EC_400__validation_error