From 60fa4d44e41c9263177ded4e543ee467aa7cbc4d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Przemys=C5=82aw=20Kaminski?= <pk@intrepidus.pl>
Date: Wed, 7 May 2025 13:05:33 +0200
Subject: [PATCH] [API] metrics GET methods were all the same, basically,
refactored
---
src/Gargantext/API/Metrics.hs | 98 ++++++++--------------
src/Gargantext/API/Routes/Named/Contact.hs | 2 +-
2 files changed, 38 insertions(+), 62 deletions(-)
diff --git a/src/Gargantext/API/Metrics.hs b/src/Gargantext/API/Metrics.hs
index f5987e53..1fffb1c2 100644
--- a/src/Gargantext/API/Metrics.hs
+++ b/src/Gargantext/API/Metrics.hs
@@ -16,6 +16,7 @@ Metrics API
module Gargantext.API.Metrics
where
+import Control.Lens.Getter (Getting)
import Data.HashMap.Strict qualified as HashMap
import Data.Time (UTCTime)
import Data.Vector (Vector)
@@ -58,19 +59,7 @@ getScatter :: HasNodeStory env err m
-> Maybe Limit
-> m (HashedResponse Metrics)
getScatter cId maybeListId tabType _maybeLimit = do
- listId <- case maybeListId of
- Just lid -> pure lid
- Nothing -> defaultList cId
- node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
- let HyperdataList { _hl_scatter = scatterMap } = node ^. node_hyperdata
- mChart = HashMap.lookup tabType scatterMap
-
- chart <- case mChart of
- Just chart -> pure chart
- Nothing -> do
- updateScatter' cId listId tabType Nothing
-
- pure $ constructHashedResponse chart
+ metricsGetter cId maybeListId tabType hl_scatter updateScatter'
updateScatter :: HasNodeStory env err m
=> CorpusId
@@ -140,20 +129,8 @@ getChart :: HasNodeStory env err m
-> TabType
-> m (HashedResponse (ChartMetrics Histo))
getChart cId _start _end maybeListId tabType = do
- listId <- case maybeListId of
- Just lid -> pure lid
- Nothing -> defaultList cId
- node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
- let chartMap = node ^. node_hyperdata ^. hl_chart
- mChart = HashMap.lookup tabType chartMap
-
- chart <- case mChart of
- Just chart -> pure chart
- Nothing -> do
- updateChart' cId listId tabType Nothing
-
- pure $ constructHashedResponse chart
-
+ metricsGetter cId maybeListId tabType hl_chart updateChart'
+
updateChart :: HasNodeError err
=> CorpusId
-> Maybe ListId
@@ -228,19 +205,7 @@ getPie :: HasNodeStory env err m
-> TabType
-> m (HashedResponse (ChartMetrics Histo))
getPie cId _start _end maybeListId tabType = do
- listId <- case maybeListId of
- Just lid -> pure lid
- Nothing -> defaultList cId
- node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
- let pieMap = node ^. node_hyperdata ^. hl_pie
- mChart = HashMap.lookup tabType pieMap
-
- chart <- case mChart of
- Just chart -> pure chart
- Nothing -> do
- updatePie' cId listId tabType Nothing
-
- pure $ constructHashedResponse chart
+ metricsGetter cId maybeListId tabType hl_pie updatePie'
updatePie :: HasNodeStory env err m
=> CorpusId
@@ -301,20 +266,7 @@ getTree :: HasNodeStory env err m
-> ListType
-> m (HashedResponse (ChartMetrics (Vector NgramsTree)))
getTree cId _start _end maybeListId tabType listType = do
- listId <- case maybeListId of
- Just lid -> pure lid
- Nothing -> defaultList cId
-
- node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
- let treeMap = node ^. node_hyperdata ^. hl_tree
- mChart = HashMap.lookup tabType treeMap
-
- chart <- case mChart of
- Just chart -> pure chart
- Nothing -> do
- updateTree' cId maybeListId tabType listType
-
- pure $ constructHashedResponse chart
+ metricsGetter cId maybeListId tabType hl_tree (\cId' l tt _mLimit -> updateTree' cId' l tt listType)
updateTree :: HasNodeStory env err m
=> CorpusId
@@ -323,24 +275,23 @@ updateTree :: HasNodeStory env err m
-> ListType
-> m ()
updateTree cId maybeListId tabType listType = do
+ listId <- case maybeListId of
+ Just lid -> pure lid
+ Nothing -> defaultList cId
printDebug "[updateTree] cId" cId
printDebug "[updateTree] maybeListId" maybeListId
printDebug "[updateTree] tabType" tabType
printDebug "[updateTree] listType" listType
- _ <- updateTree' cId maybeListId tabType listType
+ _ <- updateTree' cId listId tabType listType
pure ()
updateTree' :: HasNodeStory env err m
=> CorpusId
- -> Maybe ListId
+ -> ListId
-> TabType
-> ListType
-> m (ChartMetrics (Vector NgramsTree))
-updateTree' cId maybeListId tabType listType = do
- listId <- case maybeListId of
- Just lid -> pure lid
- Nothing -> defaultList cId
-
+updateTree' cId listId tabType listType = do
node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
let hl = node ^. node_hyperdata
treeMap = hl ^. hl_tree
@@ -357,3 +308,28 @@ getTreeHash :: HasNodeStory env err m
-> m Text
getTreeHash cId maybeListId tabType listType = do
hash <$> getTree cId Nothing Nothing maybeListId tabType listType
+
+
+--------
+
+metricsGetter :: (HasNodeStory env err m, ToJSON a)
+ => CorpusId
+ -> Maybe ListId
+ -> TabType
+ -> Getting (HashMap.HashMap TabType a) HyperdataList (HashMap.HashMap TabType a)
+ -> (CorpusId -> ListId -> TabType -> Maybe Limit -> m a)
+ -> m (HashedResponse a)
+metricsGetter cId mListId tabType l up = do
+ listId <- case mListId of
+ Just lid -> pure lid
+ Nothing -> defaultList cId
+ node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
+ let metricsMap = node ^. node_hyperdata ^. l
+ mMetrics = HashMap.lookup tabType metricsMap
+
+ metrics <- case mMetrics of
+ Just m -> pure m
+ Nothing -> do
+ up cId listId tabType Nothing
+
+ pure $ constructHashedResponse metrics
diff --git a/src/Gargantext/API/Routes/Named/Contact.hs b/src/Gargantext/API/Routes/Named/Contact.hs
index 5e33a44b..c70322d9 100644
--- a/src/Gargantext/API/Routes/Named/Contact.hs
+++ b/src/Gargantext/API/Routes/Named/Contact.hs
@@ -10,12 +10,12 @@ module Gargantext.API.Routes.Named.Contact (
) where
-import GHC.Generics (Generic)
import Gargantext.API.Node.Contact.Types (AddContactParams(..))
import Gargantext.API.Routes.Named.Node (NodeNodeAPI(..))
import Gargantext.API.Worker (WorkerAPI)
import Gargantext.Database.Admin.Types.Hyperdata.Contact (HyperdataContact)
import Gargantext.Database.Admin.Types.Node (NodeId)
+import GHC.Generics (Generic)
import Servant
--
2.21.0