Commit 6c22e2af authored by Alfredo Di Napoli's avatar Alfredo Di Napoli

Tighten log emissions via txLogLocM

parent 673d3d45
Pipeline #7845 passed with stages
in 59 minutes and 59 seconds
...@@ -22,7 +22,8 @@ add get ...@@ -22,7 +22,8 @@ add get
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.API.Ngrams module Gargantext.API.Ngrams
...@@ -118,6 +119,7 @@ import Gargantext.Database.Action.Metrics.NgramsByContext (getOccByNgramsOnlyFas ...@@ -118,6 +119,7 @@ import Gargantext.Database.Action.Metrics.NgramsByContext (getOccByNgramsOnlyFas
import Gargantext.Database.Prelude import Gargantext.Database.Prelude
import Gargantext.Database.Query.Table.Ngrams ( text2ngrams, insertNgrams ) import Gargantext.Database.Query.Table.Ngrams ( text2ngrams, insertNgrams )
import Gargantext.Prelude hiding (log, to, toLower, (%), isInfixOf) import Gargantext.Prelude hiding (log, to, toLower, (%), isInfixOf)
import Gargantext.System.Logging.Types (LogLevel(DEBUG))
import Text.Collate qualified as Unicode import Text.Collate qualified as Unicode
...@@ -627,6 +629,7 @@ getNgramsTable' env nId listId ngramsType = do ...@@ -627,6 +629,7 @@ getNgramsTable' env nId listId ngramsType = do
-- | Helper function to set scores on an `NgramsTable`. -- | Helper function to set scores on an `NgramsTable`.
setNgramsTableScores :: forall err t x. setNgramsTableScores :: forall err t x.
( Each t t NgramsElement NgramsElement ( Each t t NgramsElement NgramsElement
, Show t
) )
=> NodeId => NodeId
-> ListId -> ListId
...@@ -637,21 +640,18 @@ setNgramsTableScores nId listId ngramsType table = do ...@@ -637,21 +640,18 @@ setNgramsTableScores nId listId ngramsType table = do
-- FIXME(adn) RESTORE these! -- FIXME(adn) RESTORE these!
--t1 <- getTime --t1 <- getTime
occurrences <- getOccByNgramsOnlyFast nId listId ngramsType occurrences <- getOccByNgramsOnlyFast nId listId ngramsType
--printDebug "[setNgramsTableScores] occurrences" occurrences $(txLogLocM) DEBUG $ "occurrences: " <> T.pack (show occurrences)
--t2 <- getTime --t2 <- getTime
-- let ngrams_terms = table ^.. each . ne_ngrams let ngrams_terms = table ^.. each . ne_ngrams
-- $(logLocM) DEBUG $ "ngrams_terms: " <> show ngrams_terms $(txLogLocM) DEBUG $ "ngrams_terms: " <> show ngrams_terms
-- $(logLocM) DEBUG $ sformat ("getTableNgrams/setScores #ngrams=" % int % " time=" % hasTime % "\n") (length ngrams_terms) t1 t2 -- $(txLogLocM) DEBUG $ sformat ("getTableNgrams/setScores #ngrams=" % int % " time=" % hasTime % "\n") (length ngrams_terms) t1 t2
let let setOcc ne = ne & ne_occurrences .~ Set.fromList (msumOf (ix (ne ^. ne_ngrams)) occurrences)
setOcc ne = ne & ne_occurrences .~ Set.fromList (msumOf (ix (ne ^. ne_ngrams)) occurrences)
--printDebug "[setNgramsTableScores] with occurences" $ table & each %~ setOcc $(txLogLocM) DEBUG $ "with occurences: " <> T.pack (show $ table & each %~ setOcc)
pure $ table & each %~ setOcc pure $ table & each %~ setOcc
-- APIs -- APIs
-- TODO: find a better place for the code above, All APIs stay here -- TODO: find a better place for the code above, All APIs stay here
......
...@@ -163,15 +163,15 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q ...@@ -163,15 +163,15 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q
, _wq_datafield = datafield , _wq_datafield = datafield
, _wq_lang = l , _wq_lang = l
, _wq_flowListWith = flw }) maybeLimit jobHandle = do , _wq_flowListWith = flw }) maybeLimit jobHandle = do
-- TODO ... runDBTx $ do
$(logLocM) DEBUG $ "[addToCorpusWithQuery] cid " <> show cid $(txLogLocM) DEBUG $ "[addToCorpusWithQuery] cid " <> show cid
$(logLocM) DEBUG $ "[addToCorpusWithQuery] datafield " <> show datafield $(txLogLocM) DEBUG $ "[addToCorpusWithQuery] datafield " <> show datafield
$(logLocM) DEBUG $ "[addToCorpusWithQuery] flowListWith " <> show flw $(txLogLocM) DEBUG $ "[addToCorpusWithQuery] flowListWith " <> show flw
$(txLogLocM) DEBUG $ "[addToCorpusWithQuery] addLanguageToCorpus " <> show cid <> ", " <> show l
addLanguageToCorpus cid l
$(txLogLocM) DEBUG "[addToCorpusWithQuery] after addLanguageToCorpus"
$(logLocM) DEBUG $ "[addToCorpusWithQuery] addLanguageToCorpus " <> show cid <> ", " <> show l
runDBTx $ addLanguageToCorpus cid l
$(logLocM) DEBUG "[addToCorpusWithQuery] after addLanguageToCorpus"
case datafield of case datafield of
Web -> do Web -> do
$(logLocM) DEBUG $ "[addToCorpusWithQuery] processing web request " <> show datafield $(logLocM) DEBUG $ "[addToCorpusWithQuery] processing web request " <> show datafield
......
...@@ -341,8 +341,8 @@ addDocumentsToHyperCorpus mb_hyper la corpusId docs = do ...@@ -341,8 +341,8 @@ addDocumentsToHyperCorpus mb_hyper la corpusId docs = do
-- logged, but in the future they could be returned upstream so that we can -- logged, but in the future they could be returned upstream so that we can
-- display a final result of how many were skipped, how many succeded etc. -- display a final result of how many were skipped, how many succeded etc.
uncommittedNgrams <- extractNgramsFromDocuments nlp la docs uncommittedNgrams <- extractNgramsFromDocuments nlp la docs
ids <- runDBTx $ insertMasterDocs cfg uncommittedNgrams mb_hyper docs
runDBTx $ do runDBTx $ do
ids <- insertMasterDocs cfg uncommittedNgrams mb_hyper docs
void $ Doc.add corpusId (map nodeId2ContextId ids) void $ Doc.add corpusId (map nodeId2ContextId ids)
pure ids pure ids
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment