[list] more metrics update work

src/Gargantext/API/Metrics.hs

@@ -25,6 +25,7 @@ Metrics API
 module Gargantext.API.Metrics
     where
 
+import Control.Lens
 import Data.Time (UTCTime)
 import Servant
 import qualified Data.Map as Map
@@ -34,8 +35,12 @@ import Gargantext.API.Ngrams.NTree
 import Gargantext.Core.Types (CorpusId, Limit, ListId, ListType(..))
 import qualified Gargantext.Database.Action.Metrics as Metrics
 import Gargantext.Database.Action.Flow
+import Gargantext.Database.Admin.Types.Hyperdata (HyperdataList(..))
 import Gargantext.Database.Admin.Types.Metrics (ChartMetrics(..), Metric(..), Metrics(..))
+import Gargantext.Database.Query.Table.Node (defaultList, getNodeWith)
+import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Prelude
+import Gargantext.Database.Schema.Node (node_hyperdata)
 import Gargantext.Prelude
 import Gargantext.Text.Metrics (Scored(..))
 import Gargantext.Viz.Chart
@@ -48,11 +53,6 @@ type ScatterAPI = Summary "SepGen IncExc metrics"
                   :> QueryParamR "ngramsType" TabType
                   :> QueryParam  "limit"      Int
                   :> Get '[JSON] Metrics
-                :<|> Summary "SepGen IncExc metrics update"
-                  :> QueryParam  "list"       ListId
-                  :> QueryParamR "ngramsType" TabType
-                  :> QueryParam  "limit"      Int
-                  :> Post '[JSON] ()
 
 getScatter :: FlowCmdM env err m =>
   CorpusId
@@ -72,26 +72,6 @@ getScatter cId maybeListId tabType maybeLimit = do
   pure $ Metrics metrics
 
 
-updateScatter :: FlowCmdM env err m =>
-  CorpusId
-  -> Maybe ListId
-  -> TabType
-  -> Maybe Limit
-  -> m ()
-updateScatter cId maybeListId tabType maybeLimit = do
-  (_ngs', _scores) <- Metrics.getMetrics cId maybeListId tabType maybeLimit
-
-  let
-    -- metrics      = map (\(Scored t s1 s2) -> Metric t (log' 5 s1) (log' 2 s2) (listType t ngs')) scores
-    -- log' n x     = 1 + (if x <= 0 then 0 else (log $ (10^(n::Int)) * x))
-    -- listType t m = maybe (panic errorMsg) fst $ Map.lookup t m
-    -- errorMsg     = "API.Node.metrics: key absent"
-
-  --pure $ Metrics metrics
-  pure ()
-
-
-
 -- TODO add start / end
 getChart :: CorpusId -> Maybe UTCTime -> Maybe UTCTime -> Cmd err (ChartMetrics Histo)
 getChart cId _start _end = do
@@ -110,3 +90,23 @@ getTree cId _start _end tt lt = do
 
 
 
+updateChart :: FlowCmdM env err m =>
+  CorpusId
+  -> Maybe ListId
+  -> TabType
+  -> Maybe Limit
+  -> m ()
+updateChart cId maybeListId _tabType _maybeLimit = do
+  listId <- case maybeListId of
+    Just lid -> pure lid
+    Nothing  -> defaultList cId
+
+  node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
+
+  let (HyperdataList { hd_list = hdl }) = node ^. node_hyperdata
+
+  h <- histoData listId
+
+  _ <- updateHyperdata listId $ HyperdataList hdl $ Just $ ChartMetrics h
+
+  pure ()

src/Gargantext/API/Node.hs

@@ -215,7 +215,7 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
            :<|> searchPairs id'
 
            :<|> scatterApi id'
-           :<|> getChart   id'
+           :<|> chartApi   id'
            :<|> getPie     id'
            :<|> getTree    id'
            :<|> phyloAPI   id' uId
@@ -230,7 +230,10 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
 
 scatterApi :: NodeId -> GargServer ScatterAPI
 scatterApi id' =  getScatter id'
-             :<|> updateScatter id'
+
+chartApi :: NodeId -> GargServer ChartApi
+chartApi id' =  getChart id'
+           :<|> updateChart id'
 
 
 ------------------------------------------------------------------------
@@ -300,6 +303,11 @@ type ChartApi = Summary " Chart API"
               :> QueryParam "from" UTCTime
               :> QueryParam "to"   UTCTime
               :> Get '[JSON] (ChartMetrics Histo)
+        :<|> Summary "SepGen IncExc chart update"
+                :> QueryParam  "list"       ListId
+                :> QueryParamR "ngramsType" TabType
+                :> QueryParam  "limit"      Int
+                :> Post '[JSON] ()
 
 type PieApi = Summary " Chart API"
            :> QueryParam "from" UTCTime