[API] metrics GET methods were all the same, basically, refactored

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

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