[nodeStory] comment about node story archive immediate saving
[gargantext.git] / src / Gargantext / API / Metrics.hs
index 07b6e5d28d95f02f34b960817999481b9e2038c0..357653740a71b71f45929c141e6f2c579a84f7c6 100644 (file)
@@ -19,29 +19,29 @@ module Gargantext.API.Metrics
     where
 
 import Control.Lens
-import qualified Data.Map as Map
 import Data.Text (Text)
 import Data.Time (UTCTime)
-import Servant
-
+import Data.Vector (Vector)
 import Gargantext.API.HashedResponse
 import Gargantext.API.Ngrams.NgramsTree
 import Gargantext.API.Ngrams.Types
 import Gargantext.API.Prelude (GargServer)
+import Gargantext.Core.Text.Metrics (Scored(..), {-normalizeGlobal,-} normalizeLocal)
 import Gargantext.Core.Types (CorpusId, Limit, ListId, ListType(..))
-import Gargantext.Database.Action.Flow
+import Gargantext.Core.Viz.Chart
+import Gargantext.Core.Viz.Types
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataList(..), hl_chart, hl_pie, hl_scatter, hl_tree)
 import Gargantext.Database.Admin.Types.Metrics (ChartMetrics(..), Metric(..), Metrics(..))
 import Gargantext.Database.Admin.Types.Node (NodeId)
+import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Prelude
 import Gargantext.Database.Query.Table.Node (defaultList, getNodeWith)
 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
-import Gargantext.Core.Text.Metrics (Scored(..), {-normalizeGlobal,-} normalizeLocal)
-import Gargantext.Core.Viz.Chart
-import Gargantext.Core.Viz.Types
+import Servant
+import qualified Data.HashMap.Strict                as HashMap
 import qualified Gargantext.Database.Action.Metrics as Metrics
 
 -------------------------------------------------------------
@@ -78,7 +78,7 @@ getScatter cId maybeListId tabType _maybeLimit = do
     Nothing  -> defaultList cId
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let HyperdataList { _hl_scatter = scatterMap } = node ^. node_hyperdata
-      mChart = Map.lookup tabType scatterMap
+      mChart = HashMap.lookup tabType scatterMap
 
   chart <- case mChart of
     Just chart -> pure chart
@@ -111,9 +111,12 @@ updateScatter' cId maybeListId tabType maybeLimit = do
   (ngs', scores) <- Metrics.getMetrics cId maybeListId tabType maybeLimit
 
   let
-    metrics      = map (\(Scored t s1 s2) -> Metric t s1 s2 (listType t ngs'))
-                 $ map normalizeLocal scores
-    listType t m = maybe (panic errorMsg) fst $ Map.lookup t m
+    metrics      = fmap (\(Scored t s1 s2) -> Metric { m_label = unNgramsTerm t
+                                                     , m_x = s1
+                                                     , m_y = s2
+                                                     , m_cat = listType t ngs' })
+                 $ fmap normalizeLocal scores
+    listType t m = maybe (panic errorMsg) fst $ HashMap.lookup t m
     errorMsg     = "API.Node.metrics: key absent"
 
   listId <- case maybeListId of
@@ -122,7 +125,7 @@ updateScatter' cId maybeListId tabType maybeLimit = do
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let hl = node ^. node_hyperdata
       scatterMap = hl ^. hl_scatter
-  _ <- updateHyperdata listId $ hl { _hl_scatter = Map.insert tabType (Metrics metrics) scatterMap }
+  _ <- updateHyperdata listId $ hl { _hl_scatter = HashMap.insert tabType (Metrics metrics) scatterMap }
 
   pure $ Metrics metrics
 
@@ -172,7 +175,7 @@ getChart cId _start _end maybeListId tabType = do
     Nothing  -> defaultList cId
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let chartMap = node ^. node_hyperdata ^. hl_chart
-      mChart = Map.lookup tabType chartMap
+      mChart = HashMap.lookup tabType chartMap
 
   chart <- case mChart of
     Just chart -> pure chart
@@ -209,7 +212,7 @@ updateChart' cId maybeListId tabType _maybeLimit = do
   let hl = node ^. node_hyperdata
       chartMap = hl ^. hl_chart
   h <- histoData cId
-  _ <- updateHyperdata listId $ hl { _hl_chart = Map.insert tabType (ChartMetrics h) chartMap }
+  _ <- updateHyperdata listId $ hl { _hl_chart = HashMap.insert tabType (ChartMetrics h) chartMap }
 
   pure $ ChartMetrics h
 
@@ -258,7 +261,7 @@ getPie cId _start _end maybeListId tabType = do
     Nothing  -> defaultList cId
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let pieMap = node ^. node_hyperdata ^. hl_pie
-      mChart = Map.lookup tabType pieMap
+      mChart = HashMap.lookup tabType pieMap
 
   chart <- case mChart of
     Just chart -> pure chart
@@ -282,7 +285,7 @@ updatePie cId maybeListId tabType maybeLimit = do
   pure ()
 
 updatePie' :: FlowCmdM env err m =>
-  CorpusId
+     CorpusId
   -> Maybe ListId
   -> TabType
   -> Maybe Limit
@@ -296,7 +299,7 @@ updatePie' cId maybeListId tabType _maybeLimit = do
       pieMap = hl ^. hl_pie
 
   p <- chartData cId (ngramsTypeFromTabType tabType) MapTerm
-  _ <- updateHyperdata listId $ hl { _hl_pie = Map.insert tabType (ChartMetrics p) pieMap }
+  _ <- updateHyperdata listId $ hl { _hl_pie = HashMap.insert tabType (ChartMetrics p) pieMap }
 
   pure $ ChartMetrics p
 
@@ -317,7 +320,7 @@ type TreeApi = Summary " Tree API"
            :> QueryParam  "list"       ListId
            :> QueryParamR "ngramsType" TabType
            :> QueryParamR "listType"   ListType
-           :> Get '[JSON] (HashedResponse (ChartMetrics [NgramsTree]))
+           :> Get '[JSON] (HashedResponse (ChartMetrics (Vector NgramsTree)))
         :<|> Summary "Tree Chart update"
                 :> QueryParam  "list"       ListId
                 :> QueryParamR "ngramsType" TabType
@@ -341,7 +344,7 @@ getTree :: FlowCmdM env err m
         -> Maybe ListId
         -> TabType
         -> ListType
-        -> m (HashedResponse (ChartMetrics [NgramsTree]))
+        -> m (HashedResponse (ChartMetrics (Vector NgramsTree)))
 getTree cId _start _end maybeListId tabType listType = do
   listId <- case maybeListId of
     Just lid -> pure lid
@@ -349,7 +352,7 @@ getTree cId _start _end maybeListId tabType listType = do
 
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let treeMap = node ^. node_hyperdata ^. hl_tree
-      mChart = Map.lookup tabType treeMap
+      mChart = HashMap.lookup tabType treeMap
 
   chart <- case mChart of
     Just chart -> pure chart
@@ -377,17 +380,17 @@ updateTree' :: FlowCmdM env err m =>
   -> Maybe ListId
   -> TabType
   -> ListType
-  -> m (ChartMetrics [NgramsTree])
+  -> m (ChartMetrics (Vector NgramsTree))
 updateTree' cId maybeListId tabType listType = do
   listId <- case maybeListId of
     Just lid -> pure lid
     Nothing  -> defaultList cId
 
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
-  let hl = node ^. node_hyperdata
-      treeMap = hl ^. hl_tree
+  let hl      = node ^. node_hyperdata
+      treeMap = hl  ^. hl_tree
   t <- treeData cId (ngramsTypeFromTabType tabType) listType
-  _ <- updateHyperdata listId $ hl { _hl_tree = Map.insert tabType (ChartMetrics t) treeMap }
+  _ <- updateHyperdata listId $ hl { _hl_tree = HashMap.insert tabType (ChartMetrics t) treeMap }
 
   pure $ ChartMetrics t