[API] metrics refactoring of 'update' methods

src/Gargantext/API/Metrics.hs

@@ -16,7 +16,9 @@ Metrics API
 module Gargantext.API.Metrics
     where
 
+import Control.Lens ((%~))
 import Control.Lens.Getter (Getting)
+import Control.Lens.Setter (ASetter)
 import Data.HashMap.Strict qualified as HashMap
 import Data.Vector (Vector)
 import Gargantext.API.HashedResponse (HashedResponse, constructHashedResponse, hash)
@@ -42,6 +44,7 @@ import Gargantext.Database.Schema.Node (node_hyperdata)
 import Gargantext.Prelude hiding (hash)
 import Servant.Server.Generic (AsServerT)
 
+
 -------------------------------------------------------------
 scatterApi :: IsGargServer err env m => NodeId -> Named.ScatterAPI (AsServerT m)
 scatterApi id' = Named.ScatterAPI
@@ -64,10 +67,8 @@ updateScatter :: HasNodeStory env err m
               -> TabType
               -> Maybe Limit
               -> m ()
-updateScatter cId maybeListId tabType maybeLimit = do
-  listId <- case maybeListId of
-    Just lid -> pure lid
-    Nothing  -> defaultList cId
+updateScatter cId mListId tabType maybeLimit = do
+  listId <- getListOrDefault cId mListId
   -- printDebug "[updateScatter] cId" cId
   -- printDebug "[updateScatter] maybeListId" maybeListId
   -- printDebug "[updateScatter] tabType" tabType
@@ -93,12 +94,7 @@ updateScatter' cId listId tabType maybeLimit = do
     listType t m = maybe (panicTrace errorMsg) fst $ HashMap.lookup t m
     errorMsg     = "API.Node.metrics: key absent"
 
-  node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
-  let hl = node ^. node_hyperdata
-      scatterMap = hl ^. hl_scatter
-  _ <- updateHyperdata listId $ hl { _hl_scatter = HashMap.insert tabType (Metrics metrics) scatterMap }
-
-  pure $ Metrics metrics
+  updateNodeMetrics listId tabType hl_scatter (Metrics metrics)
 
 getScatterHash :: HasNodeStory env err m
                => CorpusId
@@ -131,10 +127,8 @@ updateChart :: HasNodeError err
             -> Maybe ListId
             -> TabType
             -> DBCmd err ()
-updateChart cId maybeListId tabType = do
-  listId <- case maybeListId of
-    Just lid -> pure lid
-    Nothing  -> defaultList cId
+updateChart cId mListId tabType = do
+  listId <- getListOrDefault cId mListId
   printDebug "[updateChart] cId" cId
   printDebug "[updateChart] listId" listId
   printDebug "[updateChart] tabType" tabType
@@ -147,13 +141,8 @@ updateChart' :: HasNodeError err
              -> TabType
              -> DBCmd err (ChartMetrics Histo)
 updateChart' cId listId tabType = do
-  node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
-  let hl = node ^. node_hyperdata
-      chartMap = hl ^. hl_chart
-  h <- histoData cId
-  _ <- updateHyperdata listId $ hl { _hl_chart = HashMap.insert tabType (ChartMetrics h) chartMap }
-
-  pure $ ChartMetrics h
+  metrics <- histoData cId
+  updateNodeMetrics listId tabType hl_chart (ChartMetrics metrics)
 
 
 getChartHash :: HasNodeStory env err m
@@ -186,12 +175,10 @@ updatePie :: HasNodeStory env err m
           -> Maybe ListId
           -> TabType
           -> m ()
-updatePie cId maybeListId tabType = do
-  listId <- case maybeListId of
-    Just lid -> pure lid
-    Nothing  -> defaultList cId
+updatePie cId mListId tabType = do
+  listId <- getListOrDefault cId mListId
   printDebug "[updatePie] cId" cId
-  printDebug "[updatePie] maybeListId" maybeListId
+  printDebug "[updatePie] mListId" mListId
   printDebug "[updatePie] tabType" tabType
   _ <- updatePie' cId listId tabType
   pure ()
@@ -202,14 +189,8 @@ updatePie' :: (HasNodeStory env err m)
            -> TabType
            -> m (ChartMetrics Histo)
 updatePie' cId listId tabType = do
-  node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
-  let hl = node ^. node_hyperdata
-      pieMap = hl ^. hl_pie
-
-  p <- chartData cId (ngramsTypeFromTabType tabType) MapTerm
-  _ <- updateHyperdata listId $ hl { _hl_pie = HashMap.insert tabType (ChartMetrics p) pieMap }
-
-  pure $ ChartMetrics p
+  metrics <- chartData cId (ngramsTypeFromTabType tabType) MapTerm
+  updateNodeMetrics listId tabType hl_pie (ChartMetrics metrics)
 
 getPieHash :: HasNodeStory env err m
            => CorpusId
@@ -243,12 +224,10 @@ updateTree :: HasNodeStory env err m
            -> TabType
            -> ListType
            -> m ()
-updateTree cId maybeListId tabType listType = do
-  listId <- case maybeListId of
-    Just lid -> pure lid
-    Nothing  -> defaultList cId
+updateTree cId mListId tabType listType = do
+  listId <- getListOrDefault cId mListId
   printDebug "[updateTree] cId" cId
-  printDebug "[updateTree] maybeListId" maybeListId
+  printDebug "[updateTree] mListId" mListId
   printDebug "[updateTree] tabType" tabType
   printDebug "[updateTree] listType" listType
   _ <- updateTree' cId listId tabType listType
@@ -261,13 +240,8 @@ updateTree' :: HasNodeStory env err m
             -> ListType
             -> m (ChartMetrics (Vector NgramsTree))
 updateTree' cId listId tabType listType = do
-  node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
-  let hl      = node ^. node_hyperdata
-      treeMap = hl  ^. hl_tree
-  t <- treeData cId (ngramsTypeFromTabType tabType) listType
-  _ <- updateHyperdata listId $ hl { _hl_tree = HashMap.insert tabType (ChartMetrics t) treeMap }
-
-  pure $ ChartMetrics t
+  metrics <- treeData cId (ngramsTypeFromTabType tabType) listType
+  updateNodeMetrics listId tabType hl_tree (ChartMetrics metrics)
 
 getTreeHash :: HasNodeStory env err m
             => CorpusId
@@ -289,9 +263,7 @@ metricsGetter :: (HasNodeStory env err m, ToJSON a)
               -> (CorpusId -> ListId -> TabType -> m a)
               -> m (HashedResponse a)
 metricsGetter cId mListId tabType l up = do
-  listId <- case mListId of
-    Just lid -> pure lid
-    Nothing  -> defaultList cId
+  listId <- getListOrDefault cId mListId
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let metricsMap = node ^. node_hyperdata ^. l
       mMetrics = HashMap.lookup tabType metricsMap
@@ -302,3 +274,24 @@ metricsGetter cId mListId tabType l up = do
       up cId listId tabType
 
   pure $ constructHashedResponse metrics
+
+getListOrDefault :: HasNodeError err => CorpusId -> Maybe ListId -> DBCmd err ListId
+getListOrDefault cId mListId = case mListId of
+    Just lid -> pure lid
+    Nothing  -> defaultList cId
+
+
+
+updateNodeMetrics :: (HasNodeError err)
+                  => ListId
+                  -> TabType
+                  -- -> _Lens
+                  -> ASetter HyperdataList HyperdataList (HashMap.HashMap TabType a) (HashMap.HashMap TabType a)
+                  -> a
+                  -> DBCmd err a
+updateNodeMetrics listId tabType setter metrics = do
+  node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
+  let hl = node ^. node_hyperdata
+  _ <- updateHyperdata listId (setter %~ (HashMap.insert tabType metrics) $ hl)
+
+  pure metrics

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

@@ -446,11 +446,11 @@ getOrMkList pId uId =
       mkList' pId' uId' = insertDefaultNode NodeList pId' uId'
 
 -- | TODO remove defaultList
-defaultList :: (HasNodeError err, HasDBid NodeType) => CorpusId -> DBCmd err ListId
+defaultList :: (HasNodeError err) => CorpusId -> DBCmd err ListId
 defaultList cId =
   maybe (nodeError (NoListFound cId)) (pure . view node_id) . headMay =<< getListsWithParentId cId
 
-getListsWithParentId :: HasDBid NodeType => NodeId -> DBCmd err [Node HyperdataList]
+getListsWithParentId :: NodeId -> DBCmd err [Node HyperdataList]
 getListsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeList)
 
 -- | Returns the /root/ public node for the input user. By root we mean that