[API] metrics: fix logging

parent 7984f6ef
Pipeline #7569 passed with stages
in 45 minutes and 57 seconds
...@@ -11,7 +11,8 @@ Metrics API ...@@ -11,7 +11,8 @@ Metrics API
-} -}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
module Gargantext.API.Metrics module Gargantext.API.Metrics
where where
...@@ -42,6 +43,7 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError) ...@@ -42,6 +43,7 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata) import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
import Gargantext.Database.Schema.Node (node_hyperdata) import Gargantext.Database.Schema.Node (node_hyperdata)
import Gargantext.Prelude hiding (hash) import Gargantext.Prelude hiding (hash)
import Gargantext.System.Logging (logLocM, LogLevel(DEBUG), MonadLogger)
import Servant.Server.Generic (AsServerT) import Servant.Server.Generic (AsServerT)
...@@ -122,16 +124,16 @@ getChart :: HasNodeStory env err m ...@@ -122,16 +124,16 @@ getChart :: HasNodeStory env err m
getChart cId maybeListId tabType = do getChart cId maybeListId tabType = do
metricsGetter cId maybeListId tabType hl_chart updateChart' metricsGetter cId maybeListId tabType hl_chart updateChart'
updateChart :: HasNodeError err updateChart :: (HasNodeStory env err m, MonadLogger m)
=> CorpusId => CorpusId
-> Maybe ListId -> Maybe ListId
-> TabType -> TabType
-> DBCmd err () -> m ()
updateChart cId mListId tabType = do updateChart cId mListId tabType = do
listId <- getListOrDefault cId mListId listId <- getListOrDefault cId mListId
printDebug "[updateChart] cId" cId $(logLocM) DEBUG $ "[updateChart] cId: " <> show cId
printDebug "[updateChart] listId" listId $(logLocM) DEBUG $ "[updateChart] listId: " <> show listId
printDebug "[updateChart] tabType" tabType $(logLocM) DEBUG $ "[updateChart] tabType: " <> show tabType
_ <- updateChart' cId listId tabType _ <- updateChart' cId listId tabType
pure () pure ()
...@@ -145,7 +147,7 @@ updateChart' cId listId tabType = do ...@@ -145,7 +147,7 @@ updateChart' cId listId tabType = do
updateNodeMetrics listId tabType hl_chart (ChartMetrics metrics) updateNodeMetrics listId tabType hl_chart (ChartMetrics metrics)
getChartHash :: HasNodeStory env err m getChartHash :: (HasNodeStory env err m, MonadLogger m)
=> CorpusId => CorpusId
-> Maybe ListId -> Maybe ListId
-> TabType -> TabType
...@@ -170,16 +172,16 @@ getPie :: HasNodeStory env err m ...@@ -170,16 +172,16 @@ getPie :: HasNodeStory env err m
getPie cId maybeListId tabType = do getPie cId maybeListId tabType = do
metricsGetter cId maybeListId tabType hl_pie updatePie' metricsGetter cId maybeListId tabType hl_pie updatePie'
updatePie :: HasNodeStory env err m updatePie :: (HasNodeStory env err m, MonadLogger m)
=> CorpusId => CorpusId
-> Maybe ListId -> Maybe ListId
-> TabType -> TabType
-> m () -> m ()
updatePie cId mListId tabType = do updatePie cId mListId tabType = do
listId <- getListOrDefault cId mListId listId <- getListOrDefault cId mListId
printDebug "[updatePie] cId" cId $(logLocM) DEBUG $ "[updatePie] cId: " <> show cId
printDebug "[updatePie] mListId" mListId $(logLocM) DEBUG $ "[updatePie] mListId: " <> show mListId
printDebug "[updatePie] tabType" tabType $(logLocM) DEBUG $ "[updatePie] tabType: " <> show tabType
_ <- updatePie' cId listId tabType _ <- updatePie' cId listId tabType
pure () pure ()
...@@ -218,7 +220,7 @@ getTree :: HasNodeStory env err m ...@@ -218,7 +220,7 @@ getTree :: HasNodeStory env err m
getTree cId maybeListId tabType listType = do getTree cId maybeListId tabType listType = do
metricsGetter cId maybeListId tabType hl_tree (\cId' l tt -> updateTree' cId' l tt listType) metricsGetter cId maybeListId tabType hl_tree (\cId' l tt -> updateTree' cId' l tt listType)
updateTree :: HasNodeStory env err m updateTree :: (HasNodeStory env err m, MonadLogger m)
=> CorpusId => CorpusId
-> Maybe ListId -> Maybe ListId
-> TabType -> TabType
...@@ -226,10 +228,10 @@ updateTree :: HasNodeStory env err m ...@@ -226,10 +228,10 @@ updateTree :: HasNodeStory env err m
-> m () -> m ()
updateTree cId mListId tabType listType = do updateTree cId mListId tabType listType = do
listId <- getListOrDefault cId mListId listId <- getListOrDefault cId mListId
printDebug "[updateTree] cId" cId $(logLocM) DEBUG $ "[updateTree] cId: " <> show cId
printDebug "[updateTree] mListId" mListId $(logLocM) DEBUG $ "[updateTree] mListId: " <> show mListId
printDebug "[updateTree] tabType" tabType $(logLocM) DEBUG $ "[updateTree] tabType: " <> show tabType
printDebug "[updateTree] listType" listType $(logLocM) DEBUG $ "[updateTree] listType: " <> show listType
_ <- updateTree' cId listId tabType listType _ <- updateTree' cId listId tabType listType
pure () pure ()
......
...@@ -75,7 +75,8 @@ apiNgramsAsync nId = ...@@ -75,7 +75,8 @@ apiNgramsAsync nId =
} }
tableNgramsPostChartsAsync :: ( HasNodeStory env err m tableNgramsPostChartsAsync :: ( HasNodeStory env err m
, MonadJobStatus m ) , MonadJobStatus m
, MonadLogger m )
=> UpdateTableNgramsCharts => UpdateTableNgramsCharts
-> JobHandle m -> JobHandle m
-> m () -> m ()
......
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