Commit e21d93ed authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FEAT][Chart][TreeMap]

parent 6fb2db8d
Pipeline #365 failed with stage
......@@ -90,11 +90,6 @@ instance Arbitrary Histo
]
deriveJSON (unPrefix "histo_") ''Histo
instance ToSchema (TreeChartMetrics)
instance Arbitrary (TreeChartMetrics)
where
arbitrary = TreeChartMetrics <$> arbitrary
instance ToSchema MyTree
instance Arbitrary MyTree
......@@ -116,7 +111,7 @@ getPie cId _start _end tt = do
p <- pieData cId (ngramsTypeFromTabType tt) GraphTerm
pure (ChartMetrics p)
getTree :: FlowCmdM env err m => CorpusId -> Maybe UTCTime -> Maybe UTCTime -> TabType -> ListType -> m (ChartMetrics TreeChartMetrics)
getTree :: FlowCmdM env err m => CorpusId -> Maybe UTCTime -> Maybe UTCTime -> TabType -> ListType -> m (ChartMetrics [MyTree])
getTree cId _start _end tt lt = do
p <- treeData cId (ngramsTypeFromTabType tt) lt
pure (ChartMetrics p)
......
......@@ -61,6 +61,7 @@ import Gargantext.Prelude
import Gargantext.Text.Metrics (Scored(..))
import Gargantext.Viz.Phylo.API (PhyloAPI, phyloAPI)
import Gargantext.Viz.Chart
import Gargantext.API.Ngrams.NTree (MyTree)
import Servant
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
......@@ -280,7 +281,7 @@ type TreeApi = Summary " Tree API"
:> QueryParam "to" UTCTime
:> QueryParamR "ngramsType" TabType
:> QueryParamR "listType" ListType
:> Get '[JSON] (ChartMetrics TreeChartMetrics)
:> Get '[JSON] (ChartMetrics [MyTree])
......
......@@ -22,10 +22,8 @@ module Gargantext.Viz.Chart
import Data.Text (Text)
import Data.List (unzip, sortOn)
import Data.Map (toList)
import Data.Aeson.TH (deriveJSON)
import GHC.Generics (Generic)
import Gargantext.Prelude
import Gargantext.Core.Utils.Prefix (unPrefix)
import Gargantext.Database.Schema.NodeNode (selectDocsDates)
import Gargantext.Database.Utils
import Gargantext.Database.Types.Node (CorpusId)
......@@ -85,16 +83,11 @@ pieData cId nt lt = do
pure (Histo dates (map round count))
data TreeChartMetrics = TreeChartMetrics { _tcm_data :: [MyTree]
}
deriving (Generic, Show)
deriveJSON (unPrefix "_tcm_") ''TreeChartMetrics
treeData :: FlowCmdM env err m
=> CorpusId -> NgramsType -> ListType
-> m TreeChartMetrics
-> m [MyTree]
treeData cId nt lt = do
ls <- map (_node_id) <$> getListsWithParentId cId
ts <- mapTermListRoot ls nt
......@@ -106,12 +99,12 @@ treeData cId nt lt = do
cs' <- getNodesByNgramsOnlyUser cId nt terms
m <- getListNgrams ls nt
pure $ TreeChartMetrics $ toTree lt cs' m
pure $ toTree lt cs' m
treeData' :: FlowCmdM env ServantErr m
=> CorpusId -> NgramsType -> ListType
-> m TreeChartMetrics
-> m [MyTree]
treeData' cId nt lt = do
ls <- map (_node_id) <$> getListsWithParentId cId
ts <- mapTermListRoot ls nt
......@@ -123,7 +116,7 @@ treeData' cId nt lt = do
cs' <- getNodesByNgramsOnlyUser cId nt terms
m <- getListNgrams ls nt
pure $ TreeChartMetrics $ toTree lt cs' m
pure $ toTree lt cs' m
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment