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.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 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
-------------------------------------------------------------
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
(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 (unNgramsTerm t) s1 s2 (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
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
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
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
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
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
:> 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] ()
:<|> "hash" :>
- Summary "Tree 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'
-> 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
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
-> 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 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