[API] more Metrics API refactoring (remove unused params)

nix/pkgs.nix

@@ -19,6 +19,7 @@ rec {
     ghc966
     cabal_install
     pkgs.haskellPackages.alex
+    pkgs.haskellPackages.ghcid
     pkgs.haskellPackages.happy
     pkgs.haskellPackages.pretty-show
   ];

src/Gargantext/API/Metrics.hs

@@ -18,11 +18,10 @@ module Gargantext.API.Metrics
 
 import Control.Lens.Getter (Getting)
 import Data.HashMap.Strict qualified as HashMap
-import Data.Time (UTCTime)
 import Data.Vector (Vector)
 import Gargantext.API.HashedResponse (HashedResponse, constructHashedResponse, hash)
 import Gargantext.API.Ngrams.NgramsTree (NgramsTree)
-import Gargantext.API.Ngrams.Types (QueryParamR, TabType, ngramsTypeFromTabType, unNgramsTerm)
+import Gargantext.API.Ngrams.Types (TabType, ngramsTypeFromTabType, unNgramsTerm)
 import Gargantext.API.Prelude (IsGargServer)
 import Gargantext.API.Routes.Named.Metrics qualified as Named
 import Gargantext.Core.NodeStory (HasNodeStory)
@@ -41,7 +40,6 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Schema.Node (node_hyperdata)
 import Gargantext.Prelude hiding (hash)
-import Servant
 import Servant.Server.Generic (AsServerT)
 
 -------------------------------------------------------------
@@ -56,10 +54,9 @@ getScatter :: HasNodeStory env err m
            => CorpusId
            -> Maybe ListId
            -> TabType
-           -> Maybe Limit
            -> m (HashedResponse Metrics)
-getScatter cId maybeListId tabType _maybeLimit = do
-  metricsGetter cId maybeListId tabType hl_scatter updateScatter'
+getScatter cId maybeListId tabType = do
+  metricsGetter cId maybeListId tabType hl_scatter (\cId' ml tt -> updateScatter' cId' ml tt Nothing)
 
 updateScatter :: HasNodeStory env err m
               => CorpusId
@@ -109,7 +106,7 @@ getScatterHash :: HasNodeStory env err m
                -> TabType
                -> m Text
 getScatterHash cId maybeListId tabType = do
-  hash <$> getScatter cId maybeListId tabType Nothing
+  hash <$> getScatter cId maybeListId tabType
 
 
 -------------------------------------------------------------
@@ -123,38 +120,33 @@ chartApi id' = Named.ChartAPI
 -- TODO add start / end
 getChart :: HasNodeStory env err m
          => CorpusId
-         -> Maybe UTCTime
-         -> Maybe UTCTime
          -> Maybe ListId
          -> TabType
          -> m (HashedResponse (ChartMetrics Histo))
-getChart cId _start _end maybeListId tabType = do
+getChart cId maybeListId tabType = do
   metricsGetter cId maybeListId tabType hl_chart updateChart'
   
 updateChart :: HasNodeError err
             => CorpusId
             -> Maybe ListId
             -> TabType
-            -> Maybe Limit
             -> DBCmd err ()
-updateChart cId maybeListId tabType maybeLimit = do
+updateChart cId maybeListId tabType = do
   listId <- case maybeListId of
     Just lid -> pure lid
     Nothing  -> defaultList cId
   printDebug "[updateChart] cId" cId
   printDebug "[updateChart] listId" listId
   printDebug "[updateChart] tabType" tabType
-  printDebug "[updateChart] maybeLimit" maybeLimit
-  _ <- updateChart' cId listId tabType maybeLimit
+  _ <- updateChart' cId listId tabType
   pure ()
 
 updateChart' :: HasNodeError err
              => CorpusId
              -> ListId
              -> TabType
-             -> Maybe Limit
              -> DBCmd err (ChartMetrics Histo)
-updateChart' cId listId tabType _maybeLimit = do
+updateChart' cId listId tabType = do
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let hl = node ^. node_hyperdata
       chartMap = hl ^. hl_chart
@@ -170,25 +162,9 @@ getChartHash :: HasNodeStory env err m
              -> TabType
              -> m Text
 getChartHash cId maybeListId tabType = do
-  hash <$> getChart cId Nothing Nothing maybeListId tabType
+  hash <$> getChart cId maybeListId tabType
 
 -------------------------------------------------------------
--- | Pie metrics API
-type PieApi = Summary "Pie Chart"
-           :> QueryParam "from" UTCTime
-           :> QueryParam "to"   UTCTime
-           :> QueryParam  "list"       ListId
-           :> QueryParamR "ngramsType" TabType
-           :> Get '[JSON] (HashedResponse (ChartMetrics Histo))
-         :<|> Summary "Pie Chart update"
-             :> QueryParam  "list"       ListId
-             :> QueryParamR "ngramsType" TabType
-             :> QueryParam  "limit"      Limit
-             :> Post '[JSON] ()
-         :<|> "hash" :> Summary "Pie Hash"
-                     :> QueryParam  "list"       ListId
-                     :> QueryParamR "ngramsType" TabType
-                     :> Get '[JSON] Text
 
 pieApi :: IsGargServer err env m => NodeId -> Named.PieAPI (AsServerT m)
 pieApi id' = Named.PieAPI
@@ -199,38 +175,33 @@ pieApi id' = Named.PieAPI
 
 getPie :: HasNodeStory env err m
        => CorpusId
-       -> Maybe UTCTime
-       -> Maybe UTCTime
        -> Maybe ListId
        -> TabType
        -> m (HashedResponse (ChartMetrics Histo))
-getPie cId _start _end maybeListId tabType = do
+getPie cId maybeListId tabType = do
   metricsGetter cId maybeListId tabType hl_pie updatePie'
 
 updatePie :: HasNodeStory env err m
           => CorpusId
           -> Maybe ListId
           -> TabType
-          -> Maybe Limit
           -> m ()
-updatePie cId maybeListId tabType maybeLimit = do
+updatePie cId maybeListId tabType = do
   listId <- case maybeListId of
     Just lid -> pure lid
     Nothing  -> defaultList cId
   printDebug "[updatePie] cId" cId
   printDebug "[updatePie] maybeListId" maybeListId
   printDebug "[updatePie] tabType" tabType
-  printDebug "[updatePie] maybeLimit" maybeLimit
-  _ <- updatePie' cId listId tabType maybeLimit
+  _ <- updatePie' cId listId tabType
   pure ()
 
 updatePie' :: (HasNodeStory env err m)
            => CorpusId
            -> ListId
            -> TabType
-           -> Maybe Limit
            -> m (ChartMetrics Histo)
-updatePie' cId listId tabType _maybeLimit = do
+updatePie' cId listId tabType = do
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let hl = node ^. node_hyperdata
       pieMap = hl ^. hl_pie
@@ -246,7 +217,7 @@ getPieHash :: HasNodeStory env err m
            -> TabType
            -> m Text
 getPieHash cId maybeListId tabType = do
-  hash <$> getPie cId Nothing Nothing maybeListId tabType
+  hash <$> getPie cId maybeListId tabType
 
 -------------------------------------------------------------
 -- | Tree metrics API
@@ -259,14 +230,12 @@ treeApi id' = Named.TreeAPI
 
 getTree :: HasNodeStory env err m
         => CorpusId
-        -> Maybe UTCTime
-        -> Maybe UTCTime
         -> Maybe ListId
         -> TabType
         -> ListType
         -> m (HashedResponse (ChartMetrics (Vector NgramsTree)))
-getTree cId _start _end maybeListId tabType listType = do
-  metricsGetter cId maybeListId tabType hl_tree (\cId' l tt _mLimit -> updateTree' cId' l tt listType)
+getTree cId maybeListId tabType listType = do
+  metricsGetter cId maybeListId tabType hl_tree (\cId' l tt -> updateTree' cId' l tt listType)
 
 updateTree :: HasNodeStory env err m
            => CorpusId
@@ -307,7 +276,7 @@ getTreeHash :: HasNodeStory env err m
             -> ListType
             -> m Text
 getTreeHash cId maybeListId tabType listType = do
-  hash <$> getTree cId Nothing Nothing maybeListId tabType listType
+  hash <$> getTree cId maybeListId tabType listType
 
 
 --------
@@ -317,7 +286,7 @@ metricsGetter :: (HasNodeStory env err m, ToJSON a)
               -> Maybe ListId
               -> TabType
               -> Getting (HashMap.HashMap TabType a) HyperdataList (HashMap.HashMap TabType a)
-              -> (CorpusId -> ListId -> TabType -> Maybe Limit -> m a)
+              -> (CorpusId -> ListId -> TabType -> m a)
               -> m (HashedResponse a)
 metricsGetter cId mListId tabType l up = do
   listId <- case mListId of
@@ -330,6 +299,6 @@ metricsGetter cId mListId tabType l up = do
   metrics <- case mMetrics of
     Just m -> pure m
     Nothing    -> do
-      up cId listId tabType Nothing
+      up cId listId tabType
 
   pure $ constructHashedResponse metrics

src/Gargantext/API/Node.hs

@@ -133,7 +133,7 @@ catApi :: CorpusId -> GargServer CatApi
 catApi cId cs' = do
   ret <- nodeContextsCategory $ map (\n -> (cId, n, ntc_category cs')) (ntc_nodesId cs')
   lId <- defaultList cId
-  _ <- updateChart cId (Just lId) Docs Nothing
+  _ <- updateChart cId (Just lId) Docs
   pure ret
 
 ------------------------------------------------------------------------

src/Gargantext/API/Node/Update.hs

@@ -92,11 +92,11 @@ updateNode lId (UpdateNodeParamsList Advanced) jobHandle = do
 
   _ <- case corpusId of
     Just cId -> do
-      _ <- Metrics.updatePie cId (Just lId) NgramsTypes.Authors Nothing
+      _ <- Metrics.updatePie cId (Just lId) NgramsTypes.Authors
       markProgress 1 jobHandle
       _ <- Metrics.updateTree cId (Just lId) NgramsTypes.Institutes MapTerm
       markProgress 1 jobHandle
-      _ <- Metrics.updatePie cId (Just lId) NgramsTypes.Sources Nothing
+      _ <- Metrics.updatePie cId (Just lId) NgramsTypes.Sources
       pure ()
     Nothing  -> pure ()
 
@@ -197,7 +197,7 @@ updateDocs cId jobHandle = do
   markProgress 1 jobHandle
   _ <- updateContextScore      cId lId
   markProgress 1 jobHandle
-  _ <- Metrics.updateChart'    cId lId NgramsTypes.Docs Nothing
+  _ <- Metrics.updateChart'    cId lId NgramsTypes.Docs
   markProgress 1 jobHandle
   -- printDebug "updateContextsScore" (cId, lId, u)
   pure ()

src/Gargantext/API/Routes/Named/Metrics.hs

+{-|
+Module      : Gargantext.API.Routes.Named.Metrics
+Description : Server API
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+Metrics API routes
+
+-}
+
 {-# LANGUAGE TypeOperators #-}
 
 module Gargantext.API.Routes.Named.Metrics (
@@ -10,7 +23,6 @@ module Gargantext.API.Routes.Named.Metrics (
   ) where
 
 import Data.Text (Text)
-import Data.Time (UTCTime)
 import Data.Vector (Vector)
 import GHC.Generics (Generic)
 import Gargantext.API.HashedResponse (HashedResponse)
@@ -26,8 +38,6 @@ import Servant
 
 data TreeAPI mode = TreeAPI
   { treeChartEp       :: mode :- Summary " Tree API"
-                              :> QueryParam "from" UTCTime
-                              :> QueryParam "to"   UTCTime
                               :> QueryParam  "list"       ListId
                               :> QueryParamR "ngramsType" TabType
                               :> QueryParamR "listType"   ListType
@@ -50,7 +60,6 @@ data ScatterAPI mode = ScatterAPI
   { sepGenEp :: mode :- Summary "SepGen IncExc metrics"
                      :> QueryParam  "list"       ListId
                      :> QueryParamR "ngramsType" TabType
-                     :> QueryParam  "limit"      Limit
                      :> Get '[JSON] (HashedResponse Metrics)
   , scatterUpdateEp :: mode :- Summary "Scatter update"
                             :> QueryParam  "list"       ListId
@@ -67,15 +76,12 @@ data ScatterAPI mode = ScatterAPI
 
 data PieAPI mode = PieAPI
   { getPieChartEp :: mode :- Summary "Pie Chart"
-                          :> QueryParam "from" UTCTime
-                          :> QueryParam "to"   UTCTime
                           :> QueryParam  "list"       ListId
                           :> QueryParamR "ngramsType" TabType
                           :> Get '[JSON] (HashedResponse (ChartMetrics Histo))
   , pieChartUpdateEp :: mode :- Summary "Pie Chart update"
                              :> QueryParam  "list"       ListId
                              :> QueryParamR "ngramsType" TabType
-                             :> QueryParam  "limit"      Limit
                              :> Post '[JSON] ()
   , pieHashEp :: mode :- "hash"
                       :> Summary "Pie Hash"
@@ -87,15 +93,12 @@ data PieAPI mode = PieAPI
 
 data ChartAPI mode = ChartAPI
   { getChartEp :: mode :- Summary " Chart API"
-                       :> QueryParam "from" UTCTime
-                       :> QueryParam "to"   UTCTime
                        :> QueryParam  "list"       ListId
                        :> QueryParamR "ngramsType" TabType
                        :> Get '[JSON] (HashedResponse (ChartMetrics Histo))
   , updateChartEp :: mode :- Summary "Chart update"
                           :> QueryParam  "list"       ListId
                           :> QueryParamR "ngramsType" TabType
-                          :> QueryParam  "limit"      Limit
                           :> Post '[JSON] ()
   , chartHashEp :: mode :- "hash"
                         :> Summary "Chart Hash"

src/Gargantext/API/Server/Named/Ngrams.hs

@@ -101,7 +101,7 @@ tableNgramsPostChartsAsync utn jobHandle = do
             Authors -> do
               -- printDebug "[tableNgramsPostChartsAsync] Authors, updating Pie, cId" cId
               markStarted 1 jobHandle
-              _ <- Metrics.updatePie cId (Just listId) tabType Nothing
+              _ <- Metrics.updatePie cId (Just listId) tabType
               markComplete jobHandle
             Institutes -> do
               -- printDebug "[tableNgramsPostChartsAsync] Institutes, updating Tree, cId" cId
@@ -118,7 +118,7 @@ tableNgramsPostChartsAsync utn jobHandle = do
             Sources -> do
               -- printDebug "[tableNgramsPostChartsAsync] Sources, updating chart, cId" cId
               markStarted 1 jobHandle
-              _ <- Metrics.updatePie cId (Just listId) tabType Nothing
+              _ <- Metrics.updatePie cId (Just listId) tabType
               markComplete jobHandle
             Terms -> do
               -- printDebug "[tableNgramsPostChartsAsync] Terms, updating Metrics (Histo), cId" cId