Commit bf037a03 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[charts] charts refactoring

listId, limit are required params for all charts.
(corpusId, listId) is the required pair for chart generation, see
#180 (comment 2466)
parent d5c0d7a3
...@@ -13,7 +13,7 @@ import Data.Lens.Record (prop) ...@@ -13,7 +13,7 @@ import Data.Lens.Record (prop)
import Data.List as L import Data.List as L
import Data.Map (Map) import Data.Map (Map)
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Data.Set (Set) import Data.Set (Set)
import Data.Set as Set import Data.Set as Set
import Data.Symbol (SProxy(..)) import Data.Symbol (SProxy(..))
...@@ -409,7 +409,7 @@ pageCpt = R.memo' $ R.hooksComponent "G.C.DocsTable.pageCpt" cpt where ...@@ -409,7 +409,7 @@ pageCpt = R.memo' $ R.hooksComponent "G.C.DocsTable.pageCpt" cpt where
| otherwise = Routes.Document sid listId | otherwise = Routes.Document sid listId
colNames = T.ColumnName <$> [ "Tag", "Date", "Title", "Source"] colNames = T.ColumnName <$> [ "Tag", "Date", "Title", "Source"]
wrapColElts = const identity wrapColElts = const identity
getCategory (localCategories /\ _) {_id, category} = maybe category identity (localCategories ^. at _id) getCategory (localCategories /\ _) {_id, category} = fromMaybe category (localCategories ^. at _id)
rows localCategories = row <$> documents rows localCategories = row <$> documents
where where
row (DocumentsView r) = row (DocumentsView r) =
......
...@@ -2,7 +2,7 @@ module Gargantext.Components.Forest.Tree.Node.Box where ...@@ -2,7 +2,7 @@ module Gargantext.Components.Forest.Tree.Node.Box where
import Data.Array as A import Data.Array as A
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Data.Nullable (Nullable, null) import Data.Nullable (Nullable, null)
import Data.Tuple (fst, Tuple(..)) import Data.Tuple (fst, Tuple(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
...@@ -60,7 +60,7 @@ type Tasks = ...@@ -60,7 +60,7 @@ type Tasks =
tasksStruct :: Int -> R.State GAT.Storage -> R.State Reload -> Record Tasks tasksStruct :: Int -> R.State GAT.Storage -> R.State Reload -> Record Tasks
tasksStruct id (asyncTasks /\ setAsyncTasks) (_ /\ setReload) = { onTaskAdd, onTaskFinish, tasks } tasksStruct id (asyncTasks /\ setAsyncTasks) (_ /\ setReload) = { onTaskAdd, onTaskFinish, tasks }
where where
tasks = maybe [] identity $ Map.lookup id asyncTasks tasks = fromMaybe [] $ Map.lookup id asyncTasks
onTaskAdd t = do onTaskAdd t = do
setReload (_ + 1) setReload (_ + 1)
setAsyncTasks $ Map.alter (maybe (Just [t]) $ (\ts -> Just $ A.cons t ts)) id setAsyncTasks $ Map.alter (maybe (Just [t]) $ (\ts -> Just $ A.cons t ts)) id
......
...@@ -78,7 +78,7 @@ import Data.Lens.Record (prop) ...@@ -78,7 +78,7 @@ import Data.Lens.Record (prop)
import Data.List ((:), List(Nil)) import Data.List ((:), List(Nil))
import Data.Map (Map) import Data.Map (Map)
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Data.Set (Set) import Data.Set (Set)
import Data.Set as Set import Data.Set as Set
...@@ -582,7 +582,7 @@ reParent :: Maybe RootParent -> ReParent NgramsTerm ...@@ -582,7 +582,7 @@ reParent :: Maybe RootParent -> ReParent NgramsTerm
reParent mrp child = do reParent mrp child = do
at child <<< _Just <<< _NgramsElement %= ((_parent .~ (view _parent <$> mrp)) <<< at child <<< _Just <<< _NgramsElement %= ((_parent .~ (view _parent <$> mrp)) <<<
(_root .~ (view _root <$> mrp))) (_root .~ (view _root <$> mrp)))
reRootChildren (maybe child identity (mrp ^? _Just <<< _root)) child reRootChildren (fromMaybe child (mrp ^? _Just <<< _root)) child
-- reParentNgramsPatch :: NgramsTerm -> ReParent NgramsPatch -- reParentNgramsPatch :: NgramsTerm -> ReParent NgramsPatch
-- ^ GHC would have accepted this type. Here reParentNgramsPatch checks but -- ^ GHC would have accepted this type. Here reParentNgramsPatch checks but
...@@ -594,7 +594,7 @@ reParentNgramsPatch parent (NgramsPatch {patch_children: PatchSet {rem, add}}) = ...@@ -594,7 +594,7 @@ reParentNgramsPatch parent (NgramsPatch {patch_children: PatchSet {rem, add}}) =
-- ^ TODO this does not type checks, we do the following two lines instead: -- ^ TODO this does not type checks, we do the following two lines instead:
s <- use (at parent) s <- use (at parent)
let root_of_parent = s ^? (_Just <<< _NgramsElement <<< _root <<< _Just) let root_of_parent = s ^? (_Just <<< _NgramsElement <<< _root <<< _Just)
let rp = { root: maybe parent identity root_of_parent, parent } let rp = { root: fromMaybe parent root_of_parent, parent }
traverse_ (reParent Nothing) rem traverse_ (reParent Nothing) rem
traverse_ (reParent $ Just rp) add traverse_ (reParent $ Just rp) add
......
...@@ -4,7 +4,7 @@ import Prelude (bind, const, identity, pure, ($), (<$>), (<>)) ...@@ -4,7 +4,7 @@ import Prelude (bind, const, identity, pure, ($), (<$>), (<>))
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?)) import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
import Data.Array as A import Data.Array as A
import Data.List as L import Data.List as L
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Data.Tuple (fst, snd) import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
...@@ -152,7 +152,7 @@ contactCellsCpt = R.hooksComponent "G.C.N.A.contactCells" cpt ...@@ -152,7 +152,7 @@ contactCellsCpt = R.hooksComponent "G.C.N.A.contactCells" cpt
pure $ T.makeRow [ pure $ T.makeRow [
H.text "" H.text ""
, H.span {} [ H.text "name" ] , H.span {} [ H.text "name" ]
--, H.a { href, target: "blank" } [ H.text $ maybe "name" identity contact.title ] --, H.a { href, target: "blank" } [ H.text $ fromMaybe "name" contact.title ]
, H.text "No ContactWhere" , H.text "No ContactWhere"
, H.text "No ContactWhereDept" , H.text "No ContactWhereDept"
, H.div {className: "nooverflow"} , H.div {className: "nooverflow"}
...@@ -165,8 +165,8 @@ contactCellsCpt = R.hooksComponent "G.C.N.A.contactCells" cpt ...@@ -165,8 +165,8 @@ contactCellsCpt = R.hooksComponent "G.C.N.A.contactCells" cpt
, session } _ = , session } _ =
pure $ T.makeRow [ pure $ T.makeRow [
H.text "" H.text ""
, H.a { href } [ H.text $ maybe "name" identity contact.title ] , H.a { href } [ H.text $ fromMaybe "name" contact.title ]
--, H.a { href, target: "blank" } [ H.text $ maybe "name" identity contact.title ] --, H.a { href, target: "blank" } [ H.text $ fromMaybe "name" contact.title ]
, H.text $ maybe "No ContactWhere" contactWhereOrg (A.head $ ou) , H.text $ maybe "No ContactWhere" contactWhereOrg (A.head $ ou)
, H.text $ maybe "No ContactWhereDept" contactWhereDept (A.head $ ou) , H.text $ maybe "No ContactWhereDept" contactWhereDept (A.head $ ou)
, H.div {className: "nooverflow"} [ , H.div {className: "nooverflow"} [
...@@ -180,10 +180,10 @@ contactCellsCpt = R.hooksComponent "G.C.N.A.contactCells" cpt ...@@ -180,10 +180,10 @@ contactCellsCpt = R.hooksComponent "G.C.N.A.contactCells" cpt
contactWhereOrg (CT.ContactWhere { organization: [] }) = "No Organization" contactWhereOrg (CT.ContactWhere { organization: [] }) = "No Organization"
contactWhereOrg (CT.ContactWhere { organization: orga }) = contactWhereOrg (CT.ContactWhere { organization: orga }) =
maybe "No orga (list)" identity (A.head orga) fromMaybe "No orga (list)" (A.head orga)
contactWhereDept (CT.ContactWhere { labTeamDepts : [] }) = "Empty Dept" contactWhereDept (CT.ContactWhere { labTeamDepts : [] }) = "Empty Dept"
contactWhereDept (CT.ContactWhere { labTeamDepts : dept }) = contactWhereDept (CT.ContactWhere { labTeamDepts : dept }) =
maybe "No Dept (list)" identity (A.head dept) fromMaybe "No Dept (list)" (A.head dept)
contactWhereRole (CT.ContactWhere { role: Nothing }) = "Empty Role" contactWhereRole (CT.ContactWhere { role: Nothing }) = "Empty Role"
contactWhereRole (CT.ContactWhere { role: Just role }) = role contactWhereRole (CT.ContactWhere { role: Just role }) = role
......
module Gargantext.Components.Nodes.Corpus.Chart where module Gargantext.Components.Nodes.Corpus.Chart where
import Data.Maybe (Maybe(..))
import Reactix as R import Reactix as R
import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo) import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo)
import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics) import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie, bar) import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie, bar)
import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree) import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree)
import Gargantext.Components.Nodes.Corpus.Chart.Types (Path, ListPath, Props) import Gargantext.Components.Nodes.Corpus.Chart.Types (Path, Props)
import Gargantext.Types (ChartType(..)) import Gargantext.Types (ChartType(..))
getChartFunction :: ChartType -> Maybe (Record (Props Path) -> R.Element) getChartFunction :: ChartType -> (Record Props -> R.Element)
getChartFunction Histo = Just histo getChartFunction Histo = histo
getChartFunction ChartBar = Just bar getChartFunction ChartBar = bar
getChartFunction ChartPie = Just pie getChartFunction ChartPie = pie
getChartFunction _ = Nothing getChartFunction Scatter = metrics
getChartFunction ChartTree = tree
getChartFunctionWithList :: ChartType -> Maybe (Record (Props ListPath) -> R.Element)
getChartFunctionWithList Scatter = Just metrics
getChartFunctionWithList ChartTree = Just tree
getChartFunctionWithList _ = Nothing
module Gargantext.Components.Nodes.Corpus.Chart.Common where
import Effect.Aff (Aff)
import Reactix as R
import Gargantext.Prelude
import Gargantext.Components.Nodes.Corpus.Chart.Types (Path, Props, MetricsProps)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Sessions (Session)
type MetricsLoadViewProps a = (
getMetrics :: Session -> Record Path -> Aff a
, loaded :: R.State Int -> a -> R.Element
| MetricsProps
)
metricsLoadView :: forall a. Record (MetricsLoadViewProps a) -> R.Element
metricsLoadView p = R.createElement metricsLoadViewCpt p []
metricsLoadViewCpt :: forall a. R.Component (MetricsLoadViewProps a)
metricsLoadViewCpt = R.hooksComponent "G.C.N.C.C.metricsLoadView" cpt
where
cpt {getMetrics, loaded, path, reload, session} _ = do
useLoader path (getMetrics session) $ \l ->
loaded reload l
...@@ -11,8 +11,8 @@ import Gargantext.Components.Charts.Options.Series (seriesBarD1) ...@@ -11,8 +11,8 @@ import Gargantext.Components.Charts.Options.Series (seriesBarD1)
import Gargantext.Components.Charts.Options.Color (grey) import Gargantext.Components.Charts.Options.Color (grey)
import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter) import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter)
import Gargantext.Components.Charts.Options.Data (dataSerie) import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types (Path, Props) import Gargantext.Components.Nodes.Corpus.Chart.Types (Path, Props)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get)
...@@ -49,28 +49,21 @@ chartOptions (HistoMetrics { dates: dates', count: count'}) = Options ...@@ -49,28 +49,21 @@ chartOptions (HistoMetrics { dates: dates', count: count'}) = Options
map (\n -> dataSerie {value: n, itemStyle : itemStyle {color:grey}}) count'] } map (\n -> dataSerie {value: n, itemStyle : itemStyle {color:grey}}) count'] }
getMetrics :: Session -> Record Path -> Aff HistoMetrics getMetrics :: Session -> Record Path -> Aff HistoMetrics
getMetrics session {corpusId, tabType} = do getMetrics session {corpusId, limit, listId, tabType} = do
ChartMetrics ms <- get session chart ChartMetrics ms <- get session chart
pure ms."data" pure ms."data"
where chart = Chart {chartType: Histo, tabType: tabType} (Just corpusId) where
chart = Chart {chartType: Histo, listId, tabType, limit} (Just corpusId)
histo :: Record (Props Path) -> R.Element histo :: Record Props -> R.Element
histo props = R.createElement histoCpt props [] histo props = R.createElement histoCpt props []
histoCpt :: R.Component (Props Path) histoCpt :: R.Component Props
histoCpt = R.hooksComponent "LoadedMetricsHisto" cpt histoCpt = R.hooksComponent "G.C.N.C.C.H.histo" cpt
where
cpt {session,path} _ = do
setReload <- R.useState' 0
pure $ metricsLoadView session setReload path
metricsLoadView :: Session -> R.State Int -> Record Path -> R.Element
metricsLoadView s setReload p = R.createElement el {session: s, path: p} []
where where
el = R.hooksComponent "MetricsLoadedHistoView" cpt cpt {path, session} _ = do
cpt {path,session} _ = do reload <- R.useState' 0
useLoader path (getMetrics session) $ \loaded -> pure $ metricsLoadView {getMetrics, loaded, path, reload, session}
loadedMetricsView setReload loaded
loadedMetricsView :: R.State Int -> HistoMetrics -> R.Element loaded :: R.State Int -> HistoMetrics -> R.Element
loadedMetricsView setReload loaded = U.reloadButtonWrap setReload $ chart $ chartOptions loaded loaded setReload loaded = U.reloadButtonWrap setReload $ chart $ chartOptions loaded
...@@ -15,8 +15,8 @@ import Gargantext.Components.Charts.Options.Series (Series, seriesScatterD2) ...@@ -15,8 +15,8 @@ import Gargantext.Components.Charts.Options.Series (Series, seriesScatterD2)
import Gargantext.Components.Charts.Options.Color (green, grey, red) import Gargantext.Components.Charts.Options.Color (green, grey, red)
import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter) import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter)
import Gargantext.Components.Charts.Options.Data (dataSerie) import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Components.Nodes.Corpus.Chart.Types (ListPath, Props) import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Components.Nodes.Corpus.Chart.Types (Path, Props)
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get)
...@@ -84,29 +84,22 @@ scatterOptions metrics' = Options ...@@ -84,29 +84,22 @@ scatterOptions metrics' = Options
} }
--} --}
getMetrics :: Session -> Record ListPath -> Aff Loaded getMetrics :: Session -> Record Path -> Aff Loaded
getMetrics session {corpusId, listId, limit, tabType} = do getMetrics session {corpusId, limit, listId, tabType} = do
Metrics ms <- get session metrics' Metrics ms <- get session metrics'
pure ms."data" pure ms."data"
where metrics' = CorpusMetrics {listId, tabType, limit} (Just corpusId) where
metrics' = CorpusMetrics {limit, listId, tabType} (Just corpusId)
metrics :: Record (Props ListPath) -> R.Element metrics :: Record Props -> R.Element
metrics props = R.createElement metricsCpt props [] metrics props = R.createElement metricsCpt props []
metricsCpt :: R.Component (Props ListPath) metricsCpt :: R.Component Props
metricsCpt = R.hooksComponent "LoadedMetrics" cpt metricsCpt = R.hooksComponent "G.C.N.C.C.M.metrics" cpt
where where
cpt {path, session} _ = do cpt {path, session} _ = do
setReload <- R.useState' 0 reload <- R.useState' 0
pure $ metricsLoadView session setReload path pure $ metricsLoadView {getMetrics, loaded, path, reload, session}
metricsLoadView :: Session -> R.State Int -> Record ListPath -> R.Element
metricsLoadView s setReload p = R.createElement el {session: s, path: p} []
where
el = R.hooksComponent "MetricsLoadedView" cpt
cpt {session, path} _ = do
useLoader path (getMetrics session) $ \loaded ->
loadedMetricsView setReload loaded
loadedMetricsView :: R.State Int -> Loaded -> R.Element loaded :: R.State Int -> Loaded -> R.Element
loadedMetricsView setReload loaded = U.reloadButtonWrap setReload $ chart $ scatterOptions loaded loaded setReload loaded = U.reloadButtonWrap setReload $ chart $ scatterOptions loaded
...@@ -15,8 +15,8 @@ import Gargantext.Components.Charts.Options.Series (seriesBarD1, seriesPieD1) ...@@ -15,8 +15,8 @@ import Gargantext.Components.Charts.Options.Series (seriesBarD1, seriesPieD1)
import Gargantext.Components.Charts.Options.Color (blue) import Gargantext.Components.Charts.Options.Color (blue)
import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter) import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter)
import Gargantext.Components.Charts.Options.Data (dataSerie) import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types (Path, Props) import Gargantext.Components.Nodes.Corpus.Chart.Types (Path, Props)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get)
...@@ -71,51 +71,34 @@ chartOptionsPie (HistoMetrics { dates: dates', count: count'}) = Options ...@@ -71,51 +71,34 @@ chartOptionsPie (HistoMetrics { dates: dates', count: count'}) = Options
getMetrics :: Session -> Record Path -> Aff HistoMetrics getMetrics :: Session -> Record Path -> Aff HistoMetrics
getMetrics session {corpusId, tabType:tabType} = do getMetrics session {corpusId, limit, listId, tabType} = do
ChartMetrics ms <- get session chart ChartMetrics ms <- get session chart
pure ms."data" pure ms."data"
where chart = Chart {chartType: ChartPie, tabType: tabType} (Just corpusId) where chart = Chart {chartType: ChartPie, limit, listId, tabType} (Just corpusId)
pie :: Record (Props Path) -> R.Element pie :: Record Props -> R.Element
pie props = R.createElement pieCpt props [] pie props = R.createElement pieCpt props []
pieCpt :: R.Component (Props Path) pieCpt :: R.Component Props
pieCpt = R.hooksComponent "LoadedMetricsPie" cpt pieCpt = R.hooksComponent "G.C.N.C.C.P.pie" cpt
where where
cpt {path,session} _ = do cpt {path,session} _ = do
setReload <- R.useState' 0 reload <- R.useState' 0
pure $ metricsLoadPieView session setReload path pure $ metricsLoadView {getMetrics, loaded: loadedPie, path, reload, session}
metricsLoadPieView :: Session -> R.State Int -> Record Path -> R.Element loadedPie :: R.State Int -> HistoMetrics -> R.Element
metricsLoadPieView s setReload p = R.createElement el {session: s,path: p} [] loadedPie setReload loaded = U.reloadButtonWrap setReload $ chart $ chartOptionsPie loaded
where
el = R.hooksComponent "MetricsLoadedPieView" cpt
cpt {session,path} _ = do
useLoader path (getMetrics session) $ \loaded ->
loadedMetricsPieView setReload loaded
loadedMetricsPieView :: R.State Int -> HistoMetrics -> R.Element
loadedMetricsPieView setReload loaded = U.reloadButtonWrap setReload $ chart $ chartOptionsPie loaded
bar :: Record (Props Path) -> R.Element bar :: Record Props -> R.Element
bar props = R.createElement barCpt props [] bar props = R.createElement barCpt props []
barCpt :: R.Component (Props Path) barCpt :: R.Component Props
barCpt = R.hooksComponent "LoadedMetricsBar" cpt barCpt = R.hooksComponent "LoadedMetricsBar" cpt
where where
cpt {path, session} _ = do cpt {path, session} _ = do
setReload <- R.useState' 0 reload <- R.useState' 0
pure $ metricsLoadBarView session setReload path pure $ metricsLoadView {getMetrics, loaded: loadedBar, path, reload, session}
metricsLoadBarView :: Session -> R.State Int -> Record Path -> R.Element
metricsLoadBarView s setReload p = R.createElement el {path: p, session: s} []
where
el = R.hooksComponent "MetricsLoadedBarView" cpt
cpt {path, session} _ = do
useLoader path (getMetrics session) $ \loaded ->
loadedMetricsBarView setReload loaded
loadedMetricsBarView :: R.State Int -> Loaded -> R.Element loadedBar :: R.State Int -> Loaded -> R.Element
loadedMetricsBarView setReload loaded = U.reloadButtonWrap setReload $ chart $ chartOptionsBar loaded loadedBar setReload loaded = U.reloadButtonWrap setReload $ chart $ chartOptionsBar loaded
...@@ -5,7 +5,7 @@ import Data.Generic.Rep (class Generic) ...@@ -5,7 +5,7 @@ import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Ord (genericCompare) import Data.Generic.Rep.Ord (genericCompare)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe, fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Reactix as R import Reactix as R
import Gargantext.Prelude import Gargantext.Prelude
...@@ -63,14 +63,18 @@ type Params = ...@@ -63,14 +63,18 @@ type Params =
render :: PredefinedChart -> Record Params -> R.Element render :: PredefinedChart -> Record Params -> R.Element
render CDocsHistogram { corpusId, session } = histo { path, session } render CDocsHistogram { corpusId, listId, session } = histo { path, session }
where where
path = { corpusId path = { corpusId
, listId: fromMaybe 0 listId
, limit: Nothing
, tabType: TabCorpus TabDocs , tabType: TabCorpus TabDocs
} }
render CAuthorsPie { corpusId, session } = pie { path, session } render CAuthorsPie { corpusId, listId, session } = pie { path, session }
where where
path = { corpusId path = { corpusId
, listId: fromMaybe 0 listId
, limit: Nothing
, tabType: TabCorpus (TabNgramType $ modeTabType Authors) , tabType: TabCorpus (TabNgramType $ modeTabType Authors)
} }
render CInstitutesTree { corpusId, limit, listId, session } = tree { path, session } render CInstitutesTree { corpusId, limit, listId, session } = tree { path, session }
......
module Gargantext.Components.Nodes.Corpus.Chart.Tree where module Gargantext.Components.Nodes.Corpus.Chart.Tree where
import Prelude (bind, pure, ($))
import Data.Argonaut (class DecodeJson, decodeJson, (.:)) import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis') import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis')
import Gargantext.Components.Charts.Options.Series (TreeNode, Trees(..), mkTree) import Gargantext.Components.Charts.Options.Series (TreeNode, Trees(..), mkTree)
import Gargantext.Components.Charts.Options.Font (mkTooltip, templateFormatter) import Gargantext.Components.Charts.Options.Font (mkTooltip, templateFormatter)
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Components.Nodes.Corpus.Chart.Types (ListPath, Props) import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Components.Nodes.Corpus.Chart.Types (Path, Props)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType) import Gargantext.Types (ChartType(..), TabType)
...@@ -43,33 +44,25 @@ scatterOptions nodes = Options ...@@ -43,33 +44,25 @@ scatterOptions nodes = Options
} }
getMetrics :: Session -> Record ListPath -> Aff Loaded getMetrics :: Session -> Record Path -> Aff Loaded
getMetrics session {corpusId, listId, limit, tabType} = do getMetrics session {corpusId, limit, listId, tabType} = do
Metrics ms <- get session chart Metrics ms <- get session chart
pure ms."data" pure ms."data"
where where
chart = Chart {chartType : ChartTree, tabType: tabType} (Just corpusId) chart = Chart {chartType : ChartTree, limit, listId, tabType} (Just corpusId)
tree :: Record (Props ListPath) -> R.Element tree :: Record Props -> R.Element
tree props = R.createElement treeCpt props [] tree props = R.createElement treeCpt props []
treeCpt :: R.Component (Props ListPath) treeCpt :: R.Component Props
treeCpt = R.hooksComponent "LoadedMetrics" cpt treeCpt = R.hooksComponent "G.C.N.C.C.T.tree" cpt
where where
cpt {path, session} _ = do cpt {path, session} _ = do
setReload <- R.useState' 0 reload <- R.useState' 0
pure $ metricsLoadView session setReload path pure $ metricsLoadView {getMetrics, loaded, path, reload, session}
metricsLoadView :: Session -> R.State Int -> Record ListPath -> R.Element
metricsLoadView session setReload path = R.createElement el path []
where
el = R.hooksComponent "MetricsLoadView" cpt
cpt p _ = do
useLoader p (getMetrics session) $ \loaded ->
loadedMetricsView setReload loaded
loadedMetricsView :: R.State Int -> Loaded -> R.Element loaded :: R.State Int -> Loaded -> R.Element
loadedMetricsView setReload loaded = loaded setReload loaded =
H.div {} H.div {}
[ U.reloadButton setReload [ U.reloadButton setReload
, chart (scatterOptions loaded) ] , chart (scatterOptions loaded) ]
module Gargantext.Components.Nodes.Corpus.Chart.Types where module Gargantext.Components.Nodes.Corpus.Chart.Types where
import Data.Maybe (Maybe) import Data.Maybe (Maybe)
import Reactix as R
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (TabType) import Gargantext.Types (TabType)
type Path = ( type Path = (
corpusId :: Int corpusId :: Int
, limit :: Maybe Int
, listId :: Int
, tabType :: TabType , tabType :: TabType
) )
type ListPath = (
limit :: Maybe Int
, listId :: Int
| Path
)
type Props a = ( path :: Record a, session :: Session ) type Props = (
path :: Record Path
, session :: Session
)
type MetricsProps = (
reload :: R.State Int
| Props
)
...@@ -4,7 +4,7 @@ import Prelude (class Show, bind, identity, mempty, pure, ($), (<>)) ...@@ -4,7 +4,7 @@ import Prelude (class Show, bind, identity, mempty, pure, ($), (<>))
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?)) import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import React (ReactClass, Children) import React (ReactClass, Children)
import React.DOM (div, h4, li, p, span, text, ul) import React.DOM (div, h4, li, p, span, text, ul)
...@@ -352,7 +352,7 @@ docViewSpec = simpleSpec performAction render ...@@ -352,7 +352,7 @@ docViewSpec = simpleSpec performAction render
setTermList ngram (Just oldList) newList = dispatch $ SetTermListItem ngram (replace oldList newList) setTermList ngram (Just oldList) newList = dispatch $ SetTermListItem ngram (replace oldList newList)
annotate text = R2.scuff $ AnnotatedField.annotatedField { ngrams: ngramsTable, setTermList, text } annotate text = R2.scuff $ AnnotatedField.annotatedField { ngrams: ngramsTable, setTermList, text }
li' = li [className "list-group-item justify-content-between"] li' = li [className "list-group-item justify-content-between"]
text' x = text $ maybe "Nothing" identity x text' x = text $ fromMaybe "Nothing" x
badge s = span [className "badge badge-default badge-pill"] [text s] badge s = span [className "badge badge-default badge-pill"] [text s]
NodePoly {hyperdata : Document doc} = document NodePoly {hyperdata : Document doc} = document
......
module Gargantext.Components.Nodes.Lists.Tabs where module Gargantext.Components.Nodes.Lists.Tabs where
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
...@@ -13,7 +13,7 @@ import Gargantext.Components.Nodes.Corpus.Types (CorpusData) ...@@ -13,7 +13,7 @@ import Gargantext.Components.Nodes.Corpus.Types (CorpusData)
import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics) import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie, bar) import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie, bar)
import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree) import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree)
import Gargantext.Components.Nodes.Corpus.Chart (getChartFunctionWithList) import Gargantext.Components.Nodes.Corpus.Chart (getChartFunction)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (ChartType(..), CTabNgramType(..), Mode(..), TabSubType(..), TabType(..), chartTypeFromString, modeTabType) import Gargantext.Types (ChartType(..), CTabNgramType(..), Mode(..), TabSubType(..), TabType(..), chartTypeFromString, modeTabType)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -61,12 +61,11 @@ ngramsViewCpt = R.hooksComponent "G.C.N.L.T.ngramsView" cpt ...@@ -61,12 +61,11 @@ ngramsViewCpt = R.hooksComponent "G.C.N.L.T.ngramsView" cpt
tabNgramType = modeTabType mode tabNgramType = modeTabType mode
tabType = TabCorpus (TabNgramType tabNgramType) tabType = TabCorpus (TabNgramType tabNgramType)
listId = 0 -- TODO! listId = 0 -- TODO!
path = {corpusId, tabType} path = {corpusId, listId, tabType, limit: (Just 1000)}
path2 = {corpusId, listId, tabType, limit: (Just 1000)} -- todo
charts CTabTerms (chartType /\ setChartType) = [ charts CTabTerms (chartType /\ setChartType) = [
maybe metrics identity (getChartFunctionWithList chartType) $ { session, path: path2 } getChartFunction chartType $ { session, path }
, R2.select { on: { change: \e -> setChartType $ const $ maybe Scatter identity $ chartTypeFromString $ R2.unsafeEventValue e } , R2.select { on: { change: \e -> setChartType $ const $ fromMaybe Scatter $ chartTypeFromString $ R2.unsafeEventValue e }
, defaultValue: show chartType } [ , defaultValue: show chartType } [
H.option { value: show Scatter } [ H.text $ show Scatter ] H.option { value: show Scatter } [ H.text $ show Scatter ]
, H.option { value: show ChartTree } [ H.text $ show ChartTree ] , H.option { value: show ChartTree } [ H.text $ show ChartTree ]
...@@ -74,7 +73,7 @@ ngramsViewCpt = R.hooksComponent "G.C.N.L.T.ngramsView" cpt ...@@ -74,7 +73,7 @@ ngramsViewCpt = R.hooksComponent "G.C.N.L.T.ngramsView" cpt
] ]
charts _ _ = [ chart mode ] charts _ _ = [ chart mode ]
chart Authors = pie {session, path} chart Authors = pie { session, path }
chart Sources = bar {session, path} chart Sources = bar { session, path }
chart Institutes = tree {session, path: path2} chart Institutes = tree { session, path }
chart Terms = metrics {session, path: path2} chart Terms = metrics { session, path }
...@@ -71,7 +71,7 @@ tabsCpt = R.hooksComponent "G.C.Nodes.Texts.tabs" cpt ...@@ -71,7 +71,7 @@ tabsCpt = R.hooksComponent "G.C.Nodes.Texts.tabs" cpt
docView' tabType = docView { frontends, session, corpusId, corpusData, tabType } docView' tabType = docView { frontends, session, corpusId, corpusData, tabType }
docs = R.fragment [ docsHisto, docView' TabDocs ] docs = R.fragment [ docsHisto, docView' TabDocs ]
docsHisto = histo { path, session } docsHisto = histo { path, session }
where path = { corpusId, tabType: TabCorpus TabDocs } where path = { corpusId, listId: 0, limit: Nothing, tabType: TabCorpus TabDocs }
moreLikeFav = docView' TabMoreLikeFav moreLikeFav = docView' TabMoreLikeFav
moreLikeTrash = docView' TabMoreLikeTrash moreLikeTrash = docView' TabMoreLikeTrash
trash = docView' TabTrash trash = docView' TabTrash
......
...@@ -7,7 +7,7 @@ import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, (:=), (~>) ...@@ -7,7 +7,7 @@ import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, (:=), (~>)
import Data.Foldable (foldMap) import Data.Foldable (foldMap)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Eq (genericEq)
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Gargantext.Routes as R import Gargantext.Routes as R
import Gargantext.Types (ApiVersion, Limit, NodePath, NodeType(..), Offset, TabType(..), TermSize(..), nodePath, nodeTypePath, showTabType') import Gargantext.Types (ApiVersion, Limit, NodePath, NodeType(..), Offset, TabType(..), TermSize(..), nodePath, nodeTypePath, showTabType')
import Prelude (class Eq, class Show, identity, show, ($), (<>), bind, pure, (<<<), (==)) import Prelude (class Eq, class Show, identity, show, ($), (<>), bind, pure, (<<<), (==))
...@@ -116,7 +116,7 @@ staticUrl (Frontends {static}) = frontendUrl static ...@@ -116,7 +116,7 @@ staticUrl (Frontends {static}) = frontendUrl static
sessionPath :: R.SessionRoute -> String sessionPath :: R.SessionRoute -> String
sessionPath (R.Tab t i) = sessionPath (R.NodeAPI Node i (showTabType' t)) sessionPath (R.Tab t i) = sessionPath (R.NodeAPI Node i (showTabType' t))
sessionPath (R.Children n o l s i) = sessionPath (R.NodeAPI Node i ("children?type=" <> show n <> offsetUrl o <> limitUrl l <> orderUrl s)) sessionPath (R.Children n o l s i) = sessionPath (R.NodeAPI Node i ("children?type=" <> show n <> offsetUrl o <> limitUrl l <> orderUrl s))
sessionPath (R.NodeAPI Phylo pId p) = "phyloscape?nodeId=" <> (show $ maybe 0 identity pId) <> p sessionPath (R.NodeAPI Phylo pId p) = "phyloscape?nodeId=" <> (show $ fromMaybe 0 pId) <> p
sessionPath (R.RecomputeNgrams nt nId lId) = "node/" <> (show nId) <> "/ngrams/recompute?list=" <> (show lId) <> "&ngramsType=" <> (show nt) sessionPath (R.RecomputeNgrams nt nId lId) = "node/" <> (show nId) <> "/ngrams/recompute?list=" <> (show lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.GraphAPI gId p) = "graph/" <> (show gId) <> "/" <> p sessionPath (R.GraphAPI gId p) = "graph/" <> (show gId) <> "/" <> p
sessionPath (R.GetNgrams opts i) = sessionPath (R.GetNgrams opts i) =
...@@ -145,7 +145,7 @@ sessionPath (R.GetNgramsTableAll opts i) = ...@@ -145,7 +145,7 @@ sessionPath (R.GetNgramsTableAll opts i) =
<> foldMap (\x -> "&list=" <> show x) opts.listIds <> foldMap (\x -> "&list=" <> show x) opts.listIds
<> limitUrl 100000 <> limitUrl 100000
sessionPath (R.ListDocument lId dId) = sessionPath (R.ListDocument lId dId) =
sessionPath $ R.NodeAPI NodeList lId ("document/" <> (show $ maybe 0 identity dId)) sessionPath $ R.NodeAPI NodeList lId ("document/" <> (show $ fromMaybe 0 dId))
sessionPath (R.ListsRoute lId) = "lists/" <> show lId sessionPath (R.ListsRoute lId) = "lists/" <> show lId
sessionPath (R.PutNgrams t listId termList i) = sessionPath (R.PutNgrams t listId termList i) =
sessionPath $ R.NodeAPI Node i sessionPath $ R.NodeAPI Node i
...@@ -180,11 +180,16 @@ sessionPath (R.CorpusMetrics {tabType, listId, limit} i) = ...@@ -180,11 +180,16 @@ sessionPath (R.CorpusMetrics {tabType, listId, limit} i) =
<> "&ngramsType=" <> showTabType' tabType <> "&ngramsType=" <> showTabType' tabType
<> maybe "" limitUrl limit <> maybe "" limitUrl limit
-- TODO fix this url path -- TODO fix this url path
sessionPath (R.Chart {chartType, tabType} i) = sessionPath (R.Chart {chartType, listId, limit, tabType} i) =
sessionPath $ R.NodeAPI Corpus i sessionPath $ R.NodeAPI Corpus i
$ show chartType $ show chartType
<> "?ngramsType=" <> showTabType' tabType <> "?ngramsType=" <> showTabType' tabType
<> "&listType=GraphTerm" -- <> show listId <> "&listType=GraphTerm" -- <> show listId
<> "&listId=" <> show listId
where
limitPath = case limit of
Just li -> "&limit=" <> show li
Nothing -> ""
-- <> maybe "" limitUrl limit -- <> maybe "" limitUrl limit
-- sessionPath (R.NodeAPI (NodeContact s a i) i) = sessionPath $ "annuaire/" <> show a <> "/contact/" <> show i -- sessionPath (R.NodeAPI (NodeContact s a i) i) = sessionPath $ "annuaire/" <> show a <> "/contact/" <> show i
......
...@@ -329,9 +329,9 @@ type CorpusMetricOpts = ...@@ -329,9 +329,9 @@ type CorpusMetricOpts =
type ChartOpts = type ChartOpts =
{ chartType :: ChartType { chartType :: ChartType
, listId :: ListId
, limit :: Maybe Limit
, tabType :: TabType , tabType :: TabType
-- , listId :: ListId
-- , limit :: Maybe Limit
} }
data NodePath = NodePath SessionId NodeType (Maybe Id) data NodePath = NodePath SessionId NodeType (Maybe Id)
......
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