where
import Control.Lens
+import Data.Text (Text)
import Data.Time (UTCTime)
-import Protolude
-import Servant
-import qualified Data.Map as Map
-
+import Data.Vector (Vector)
import Gargantext.API.HashedResponse
-import Gargantext.API.Ngrams
-import Gargantext.API.Ngrams.NTree
+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 qualified Gargantext.Database.Action.Metrics as Metrics
-import Gargantext.Database.Admin.Types.Hyperdata (HyperdataList(..))
+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.Prelude
import Gargantext.Database.Schema.Node (node_hyperdata)
-import Gargantext.Text.Metrics (Scored(..))
-import Gargantext.Viz.Chart
-import Gargantext.Viz.Types
+import Gargantext.Prelude
+import Servant
+import qualified Data.HashMap.Strict as HashMap
+import qualified Gargantext.Database.Action.Metrics as Metrics
-------------------------------------------------------------
-- | Scatter metrics API
:> QueryParamR "ngramsType" TabType
:> QueryParam "limit" Int
:> Post '[JSON] ()
- :<|> "md5" :>
- Summary "Scatter MD5"
- :> QueryParam "list" ListId
- :> QueryParamR "ngramsType" TabType
- :> Get '[JSON] Text
+ :<|> "hash" :> Summary "Scatter Hash"
+ :> QueryParam "list" ListId
+ :> QueryParamR "ngramsType" TabType
+ :> Get '[JSON] Text
scatterApi :: NodeId -> GargServer ScatterAPI
scatterApi id' = getScatter id'
:<|> updateScatter id'
- :<|> getScatterMD5 id'
+ :<|> getScatterHash id'
getScatter :: FlowCmdM env err m =>
CorpusId
Just lid -> pure lid
Nothing -> defaultList cId
node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
- let HyperdataList { _hl_scatter = mChart } = node ^. node_hyperdata
+ let HyperdataList { _hl_scatter = scatterMap } = node ^. node_hyperdata
+ mChart = HashMap.lookup tabType scatterMap
chart <- case mChart of
Just chart -> pure chart
-> Maybe Limit
-> m ()
updateScatter cId maybeListId tabType maybeLimit = do
+ printDebug "[updateScatter] cId" cId
+ printDebug "[updateScatter] maybeListId" maybeListId
+ printDebug "[updateScatter] tabType" tabType
+ printDebug "[updateScatter] maybeLimit" maybeLimit
_ <- updateScatter' cId maybeListId tabType maybeLimit
pure ()
(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
+ 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
Just lid -> pure lid
Nothing -> defaultList cId
node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
- let HyperdataList { _hl_chart = hdc
- , _hl_list = hdl
- , _hl_pie = hdp
- , _hl_tree = hdt } = node ^. node_hyperdata
- _ <- updateHyperdata listId $ HyperdataList hdc hdl hdp (Just $ Metrics metrics) hdt
+ let hl = node ^. node_hyperdata
+ scatterMap = hl ^. hl_scatter
+ _ <- updateHyperdata listId $ hl { _hl_scatter = HashMap.insert tabType (Metrics metrics) scatterMap }
pure $ Metrics metrics
-getScatterMD5 :: FlowCmdM env err m =>
+getScatterHash :: FlowCmdM env err m =>
CorpusId
-> Maybe ListId
-> TabType
-> m Text
-getScatterMD5 cId maybeListId tabType = do
- HashedResponse { md5 = md5' } <- getScatter cId maybeListId tabType Nothing
- pure md5'
+getScatterHash cId maybeListId tabType = do
+ hash <$> getScatter cId maybeListId tabType Nothing
-------------------------------------------------------------
:> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType
:> Get '[JSON] (HashedResponse (ChartMetrics Histo))
- :<|> Summary "Chart update"
- :> QueryParam "list" ListId
- :> QueryParamR "ngramsType" TabType
- :> QueryParam "limit" Int
- :> Post '[JSON] ()
- :<|> "md5" :>
- Summary "Chart MD5"
- :> QueryParam "list" ListId
- :> QueryParamR "ngramsType" TabType
- :> Get '[JSON] Text
+ :<|> Summary "Chart update"
+ :> QueryParam "list" ListId
+ :> QueryParamR "ngramsType" TabType
+ :> QueryParam "limit" Int
+ :> Post '[JSON] ()
+ :<|> "hash" :> Summary "Chart Hash"
+ :> QueryParam "list" ListId
+ :> QueryParamR "ngramsType" TabType
+ :> Get '[JSON] Text
chartApi :: NodeId -> GargServer ChartApi
chartApi id' = getChart id'
:<|> updateChart id'
- :<|> getChartMD5 id'
-
+ :<|> getChartHash id'
+
-- TODO add start / end
getChart :: FlowCmdM env err m =>
CorpusId
Just lid -> pure lid
Nothing -> defaultList cId
node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
- let HyperdataList { _hl_chart = mChart } = node ^. node_hyperdata
+ let chartMap = node ^. node_hyperdata ^. hl_chart
+ mChart = HashMap.lookup tabType chartMap
chart <- case mChart of
Just chart -> pure chart
-> Maybe Limit
-> Cmd err ()
updateChart cId maybeListId tabType maybeLimit = do
+ printDebug "[updateChart] cId" cId
+ printDebug "[updateChart] maybeListId" maybeListId
+ printDebug "[updateChart] tabType" tabType
+ printDebug "[updateChart] maybeLimit" maybeLimit
_ <- updateChart' cId maybeListId tabType maybeLimit
pure ()
-> TabType
-> Maybe Limit
-> Cmd err (ChartMetrics Histo)
-updateChart' cId maybeListId _tabType _maybeLimit = do
+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 { _hl_list = hdl
- , _hl_pie = hdp
- , _hl_scatter = hds
- , _hl_tree = hdt } = node ^. node_hyperdata
+ let hl = node ^. node_hyperdata
+ chartMap = hl ^. hl_chart
h <- histoData cId
- _ <- updateHyperdata listId $ HyperdataList (Just $ ChartMetrics h) hdl hdp hds hdt
+ _ <- updateHyperdata listId $ hl { _hl_chart = HashMap.insert tabType (ChartMetrics h) chartMap }
pure $ ChartMetrics h
-getChartMD5 :: FlowCmdM env err m =>
+getChartHash :: FlowCmdM env err m =>
CorpusId
-> Maybe ListId
-> TabType
-> m Text
-getChartMD5 cId maybeListId tabType = do
- HashedResponse { md5 = md5' } <- getChart cId Nothing Nothing maybeListId tabType
- pure md5'
+getChartHash cId maybeListId tabType = do
+ hash <$> getChart cId Nothing Nothing maybeListId tabType
+
-------------------------------------------------------------
-- | Pie metrics API
type PieApi = Summary "Pie Chart"
:> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType
:> Get '[JSON] (HashedResponse (ChartMetrics Histo))
- :<|> Summary "Pie Chart update"
- :> QueryParam "list" ListId
- :> QueryParamR "ngramsType" TabType
- :> QueryParam "limit" Int
- :> Post '[JSON] ()
- :<|> "md5" :>
- Summary "Pie MD5"
- :> QueryParam "list" ListId
- :> QueryParamR "ngramsType" TabType
- :> Get '[JSON] Text
+ :<|> Summary "Pie Chart update"
+ :> QueryParam "list" ListId
+ :> QueryParamR "ngramsType" TabType
+ :> QueryParam "limit" Int
+ :> Post '[JSON] ()
+ :<|> "hash" :> Summary "Pie Hash"
+ :> QueryParam "list" ListId
+ :> QueryParamR "ngramsType" TabType
+ :> Get '[JSON] Text
pieApi :: NodeId -> GargServer PieApi
pieApi id' = getPie id'
:<|> updatePie id'
- :<|> getPieMD5 id'
+ :<|> getPieHash id'
getPie :: FlowCmdM env err m
=> CorpusId
Just lid -> pure lid
Nothing -> defaultList cId
node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
- let HyperdataList { _hl_pie = mChart } = node ^. node_hyperdata
+ let pieMap = node ^. node_hyperdata ^. hl_pie
+ mChart = HashMap.lookup tabType pieMap
chart <- case mChart of
Just chart -> pure chart
-> Maybe Limit
-> m ()
updatePie cId maybeListId tabType maybeLimit = do
+ printDebug "[updatePie] cId" cId
+ printDebug "[updatePie] maybeListId" maybeListId
+ printDebug "[updatePie] tabType" tabType
+ printDebug "[updatePie] maybeLimit" maybeLimit
_ <- updatePie' cId maybeListId tabType maybeLimit
pure ()
updatePie' :: FlowCmdM env err m =>
- CorpusId
+ CorpusId
-> Maybe ListId
-> TabType
-> Maybe Limit
Just lid -> pure lid
Nothing -> defaultList cId
node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
- let HyperdataList { _hl_chart = hdc
- , _hl_list = hdl
- , _hl_scatter = hds
- , _hl_tree = hdt } = node ^. node_hyperdata
+ let hl = node ^. node_hyperdata
+ pieMap = hl ^. hl_pie
- p <- pieData cId (ngramsTypeFromTabType tabType) MapTerm
- _ <- updateHyperdata listId $ HyperdataList hdc hdl (Just $ ChartMetrics p) hds hdt
+ p <- chartData cId (ngramsTypeFromTabType tabType) MapTerm
+ _ <- updateHyperdata listId $ hl { _hl_pie = HashMap.insert tabType (ChartMetrics p) pieMap }
pure $ ChartMetrics p
-getPieMD5 :: FlowCmdM env err m =>
+getPieHash :: FlowCmdM env err m =>
CorpusId
-> Maybe ListId
-> TabType
-> m Text
-getPieMD5 cId maybeListId tabType = do
- HashedResponse { md5 = md5' } <- getPie cId Nothing Nothing maybeListId tabType
- pure md5'
+getPieHash cId maybeListId tabType = do
+ hash <$> getPie cId Nothing Nothing maybeListId tabType
+
-------------------------------------------------------------
-- | Tree metrics API
:> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType
:> QueryParamR "listType" ListType
- :> Get '[JSON] (HashedResponse (ChartMetrics [MyTree]))
+ :> Get '[JSON] (HashedResponse (ChartMetrics (Vector NgramsTree)))
:<|> Summary "Tree Chart update"
:> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType
:> QueryParamR "listType" ListType
:> Post '[JSON] ()
- :<|> "md5" :>
- Summary "Tree MD5"
+ :<|> "hash" :>
+ Summary "Tree Hash"
:> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType
:> QueryParamR "listType" ListType
:> Get '[JSON] Text
-
- -- Depending on the Type of the Node, we could post
- -- New documents for a corpus
- -- New map list terms
- -- :<|> "process" :> MultipartForm MultipartData :> Post '[JSON] Text
-
treeApi :: NodeId -> GargServer TreeApi
treeApi id' = getTree id'
:<|> updateTree id'
- :<|> getTreeMD5 id'
+ :<|> getTreeHash id'
getTree :: FlowCmdM env err m
=> CorpusId
-> Maybe ListId
-> TabType
-> ListType
- -> m (HashedResponse (ChartMetrics [MyTree]))
+ -> 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 HyperdataList { _hl_tree = mChart } = node ^. node_hyperdata
+ let treeMap = node ^. node_hyperdata ^. hl_tree
+ mChart = HashMap.lookup tabType treeMap
chart <- case mChart of
Just chart -> pure chart
-> ListType
-> m ()
updateTree cId maybeListId tabType listType = do
+ printDebug "[updateTree] cId" cId
+ printDebug "[updateTree] maybeListId" maybeListId
+ printDebug "[updateTree] tabType" tabType
+ printDebug "[updateTree] listType" listType
_ <- updateTree' cId maybeListId tabType listType
pure ()
-> Maybe ListId
-> TabType
-> ListType
- -> m (ChartMetrics [MyTree])
+ -> 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 HyperdataList { _hl_chart = hdc
- , _hl_list = hdl
- , _hl_scatter = hds
- , _hl_pie = hdp } = node ^. node_hyperdata
+ let hl = node ^. node_hyperdata
+ treeMap = hl ^. hl_tree
t <- treeData cId (ngramsTypeFromTabType tabType) listType
- _ <- updateHyperdata listId $ HyperdataList hdc hdl hdp hds (Just $ ChartMetrics t)
+ _ <- updateHyperdata listId $ hl { _hl_tree = HashMap.insert tabType (ChartMetrics t) treeMap }
pure $ ChartMetrics t
-getTreeMD5 :: FlowCmdM env err m =>
+getTreeHash :: FlowCmdM env err m =>
CorpusId
-> Maybe ListId
-> TabType
-> ListType
-> m Text
-getTreeMD5 cId maybeListId tabType listType = do
- HashedResponse { md5 = md5' } <- getTree cId Nothing Nothing maybeListId tabType listType
- pure md5'
+getTreeHash cId maybeListId tabType listType = do
+ hash <$> getTree cId Nothing Nothing maybeListId tabType listType