[FEAT] Nodes Scores connected (needs some tests still)

src/Gargantext/API/Node/Update.hs

@@ -18,7 +18,7 @@ module Gargantext.API.Node.Update
 
 import Control.Lens (view)
 import Data.Aeson
-import Data.Maybe (Maybe(..))
+import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Swagger
 import GHC.Generics (Generic)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
@@ -30,8 +30,9 @@ import Gargantext.API.Prelude (GargServer, simuLogs)
 import Gargantext.Core.Methods.Distances (GraphMetric(..))
 import Gargantext.Core.Types.Main (ListType(..))
 import Gargantext.Core.Viz.Graph.API (recomputeGraph)
-import Gargantext.Database.Action.Metrics (updateNgramsOccurrences)
+import Gargantext.Database.Action.Metrics (updateNgramsOccurrences, updateContextScore)
 import Gargantext.Database.Action.Flow.Pairing (pairing)
+import Gargantext.Database.Query.Table.Node (defaultList)
 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Query.Table.Node (getNode)
@@ -178,6 +179,39 @@ updateNode _uId lId (UpdateNodeParamsList _mode) logStatus = do
                , _scst_events    = Just []
                }
 
+updateNode _uId tId (UpdateNodeParamsTexts _mode) logStatus = do
+  logStatus JobLog { _scst_succeeded = Just 1
+                   , _scst_failed    = Just 0
+                   , _scst_remaining = Just 2
+                   , _scst_events    = Just []
+                   }
+  corpusId <- view node_parent_id <$> getNode tId
+  lId      <- defaultList $ fromMaybe (panic "[G.A.N.Update] updateNode/UpdateNodeParamsTexts: no defaultList") corpusId
+
+  logStatus JobLog { _scst_succeeded = Just 2
+                   , _scst_failed    = Just 0
+                   , _scst_remaining = Just 1
+                   , _scst_events    = Just []
+                   }
+
+  _ <- case corpusId of
+    Just cId -> do
+      _ <- reIndexWith cId lId NgramsTerms (Set.singleton MapTerm)
+      _ <- updateNgramsOccurrences cId (Just lId)
+      _ <- updateContextScore      cId (Just lId)
+      -- printDebug "updateContextsScore" (cId, lId, u)
+      pure ()
+    Nothing  -> pure ()
+
+  pure  JobLog { _scst_succeeded = Just 3
+               , _scst_failed    = Just 0
+               , _scst_remaining = Just 0
+               , _scst_events    = Just []
+               }
+
+
+
+
 
 updateNode _uId _nId _p logStatus = do
   simuLogs logStatus 10

src/Gargantext/Database/Action/Metrics.hs

@@ -126,6 +126,8 @@ updateNgramsOccurrences' cId maybeListId maybeLimit tabType = do
 
   map (\(Only a) -> a) <$> runPGSQuery queryInsert (Only $ Values fields toInsert)
 
+
+
 ------------------------------------------------------------------------
 -- Used for scores in Ngrams Table
 getNgramsOccurrences :: (FlowCmdM env err m)
@@ -150,6 +152,47 @@ getNgramsContexts cId lId tabType maybeLimit = do
 
 
 
+------------------------------------------------------------------------
+updateContextScore :: (FlowCmdM env err m)
+             => CorpusId -> Maybe ListId
+             -> m [Int]
+updateContextScore cId maybeListId = do
+
+  lId <- case maybeListId of
+    Nothing   -> defaultList cId
+    Just lId' -> pure lId'
+
+  result <- getContextsNgramsScore cId lId Terms MapTerm Nothing
+  
+  let
+    toInsert :: [[Action]]
+    toInsert =  map (\(contextId, score)
+                        -> [ toField cId
+                           , toField contextId
+                           , toField score
+                           ]
+                      )
+       $ Map.toList result
+
+    queryInsert :: Query
+    queryInsert = [sql|
+                  WITH input(node_id, context_id, score) AS (?)
+                    UPDATE nodes_contexts nc
+                    SET score = input.score
+                    FROM input
+                    WHERE nc.node_id = input.node_id
+                    AND nc.context_id = input.context_id
+                    RETURNING 1
+                  |]
+
+  let fields = map (\t-> QualifiedIdentifier Nothing t) 
+             $ map Text.pack ["int4", "int4","int4"]
+
+  map (\(Only a) -> a) <$> runPGSQuery queryInsert (Only $ Values fields toInsert)
+
+
+
+
 -- Used for scores in Doc Table
 getContextsNgramsScore :: (FlowCmdM env err m)
              => CorpusId -> ListId -> TabType -> ListType -> Maybe Limit
@@ -172,13 +215,16 @@ getContextsNgrams cId lId tabType listType maybeLimit = do
                                $ HM.keys
                                $ HM.filter (\v -> fst v == listType) ngs'
                                )
-
+  -- printDebug "getCoocByNgrams" result
   pure $ Map.fromListWith (<>)
        $ List.concat
        $ map (\(ng, contexts) -> List.zip (Set.toList contexts) (List.cycle [Set.singleton ng]))
        $ HM.toList result
 
 
+------------------------------------------------------------------------
+------------------------------------------------------------------------
+
 
 getNgrams :: (HasMail env, HasNodeStory env err m)
             => ListId -> TabType

src/Gargantext/Database/Query/Table/Node/Document/Add.hs

@@ -48,14 +48,14 @@ add_debug pId ns = formatPGSQuery queryAdd (Only $ Values fields inputData)
 
 -- | Input Tables: types of the tables
 inputSqlTypes :: [Text]
-inputSqlTypes = ["int4","int4","int4"]
+inputSqlTypes = ["int4","int4","int4","int4"]
 
 -- | SQL query to add documents
 -- TODO return id of added documents only
 queryAdd :: Query
 queryAdd = [sql|
-       WITH input_rows(node_id,context_id,category) AS (?)
-       INSERT INTO nodes_contexts (node_id, context_id,category)
+       WITH input_rows(node_id,context_id,score,category) AS (?)
+       INSERT INTO nodes_contexts (node_id, context_id,score,category)
        SELECT * FROM input_rows
        ON CONFLICT (node_id, context_id) DO NOTHING -- on unique index
        RETURNING 1
@@ -75,6 +75,7 @@ data InputData = InputData { inNode_id    :: NodeId
 instance ToRow InputData where
   toRow inputData = [ toField (inNode_id    inputData)
                     , toField (inContext_id inputData)
+                    , toField (0 :: Int)
                     , toField (1 :: Int)
                     ]