Tabs.purs 6.71 KB
Newer Older
1
module Gargantext.Components.Nodes.Lists.Tabs where
2

3
import Data.Array as A
4
import Data.Maybe (Maybe(..), fromMaybe)
5
import Data.Tuple (fst)
6
import Data.Tuple.Nested ((/\))
7
import Effect.Class (liftEffect)
8
import Reactix as R
9
import Reactix.DOM.HTML as H
10
import Record as Record
11 12 13

import Gargantext.Prelude

14
import Gargantext.AsyncTasks as GAT
15
import Gargantext.Components.NgramsTable as NT
16
import Gargantext.Components.NgramsTable.Core as NTC
17
import Gargantext.Components.Nodes.Corpus.Types (CorpusData)
18 19 20
import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
import Gargantext.Components.Nodes.Corpus.Chart.Pie  (pie, bar)
import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree)
21
import Gargantext.Components.Nodes.Corpus.Chart (getChartFunction)
22
import Gargantext.Components.Nodes.Corpus.Chart.Utils (mNgramsTypeFromTabType)
23
import Gargantext.Components.Nodes.Lists.Types
24
import Gargantext.Components.Tab as Tab
25
import Gargantext.Sessions (Session)
26
import Gargantext.Types (ChartType(..), CTabNgramType(..), Mode(..), ReloadS, TabSubType(..), TabType(..), chartTypeFromString, modeTabType)
27
import Gargantext.Utils.Reactix as R2
28

29
thisModule :: String
30 31
thisModule = "Gargantext.Components.Nodes.Lists.Tabs"

32
type Props = (
33 34 35 36 37 38 39 40
    appReload         :: ReloadS
  , asyncTasksRef     :: R.Ref (Maybe GAT.Reductor)
  , cacheState        :: R.State CacheState
  , corpusData        :: CorpusData
  , corpusId          :: Int
  , session           :: Session
  , sidePanelTriggers :: Record SidePanelTriggers
  , treeReloadRef     :: R.Ref (Maybe ReloadS)
41
  )
42

43 44 45 46 47 48
type PropsWithKey = (
  key        :: String
  | Props
  )

tabs :: Record PropsWithKey -> R.Element
49 50
tabs props = R.createElement tabsCpt props []

51
tabsCpt :: R.Component PropsWithKey
52
tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt
53
  where
54 55 56 57 58 59 60 61
    cpt { appReload
        , asyncTasksRef
        , cacheState
        , corpusData
        , corpusId
        , session
        , sidePanelTriggers
        , treeReloadRef } _ = do
62
      (selected /\ setSelected) <- R.useState' 0
63

64
      pure $ Tab.tabs { selected, tabs: tabs' }
65
      where
66
        tabs' = [ "Authors"    /\ view Authors
67
                , "Institutes" /\ view Institutes
68
                , "Sources"    /\ view Sources
69
                , "Terms"      /\ view Terms ]
70 71 72 73 74 75 76 77 78
        view mode = ngramsView { appReload
                               , asyncTasksRef
                               , cacheState
                               , corpusData
                               , corpusId
                               , mode
                               , session
                               , sidePanelTriggers
                               , treeReloadRef }
79 80 81 82 83 84 85

type NgramsViewProps = ( mode :: Mode | Props )

ngramsView :: Record NgramsViewProps -> R.Element
ngramsView props = R.createElement ngramsViewCpt props []

ngramsViewCpt :: R.Component NgramsViewProps
86
ngramsViewCpt = R.hooksComponentWithModule thisModule "ngramsView" cpt
87
  where
88 89
    cpt { appReload
        , asyncTasksRef
90
        , cacheState
91
        , corpusData: { defaultListId }
92 93
        , corpusId
        , mode
94
        , session
95
        , sidePanelTriggers
96 97
        , treeReloadRef
        } _ = do
98

99
      chartType <- R.useState' Histo
100
      chartsReload <- R.useState' 0
101 102 103 104 105 106 107 108 109 110 111 112 113 114
      pathS <- R.useState' $ NTC.initialPageParams session initialPath.corpusId [initialPath.listId] initialPath.tabType
      let listId' = fromMaybe defaultListId $ A.head (fst pathS).listIds
      let path = {
          corpusId: (fst pathS).nodeId
        , limit: (fst pathS).params.limit
        , listId: listId'
        , tabType: (fst pathS).tabType
        }
      let chartParams = {
          corpusId: path.corpusId
        , limit: Just path.limit
        , listId: path.listId
        , tabType: path.tabType
        }
115 116

      pure $ R.fragment
117
        ( charts chartParams tabNgramType chartType chartsReload
118
        <> [ NT.mainNgramsTable { afterSync: afterSync chartsReload
119
                                , appReload
120
                                , asyncTasksRef
121
                                , cacheState
122
                                , defaultListId
123
                                , nodeId: corpusId
124
                                , pathS
125
                                , session
126
                                , sidePanelTriggers
127
                                , tabNgramType
128
                                , tabType
129
                                , treeReloadRef
130 131 132
                                , withAutoUpdate: false
                                }
           ]
133
        )
134
      where
135
        afterSync (_ /\ setChartsReload) _ = do
136 137
          case mNgramsType of
            Just ngramsType -> do
138 139 140 141
              -- NOTE: No need to recompute chart, after ngrams are sync this
              -- should be recomputed already
              -- We just refresh it
              -- _ <- recomputeChart session chartType ngramsType corpusId listId
142
              liftEffect $ setChartsReload $ (+) 1
143 144
            Nothing         -> pure unit

145
        tabNgramType = modeTabType mode
146
        tabType      = TabCorpus (TabNgramType tabNgramType)
147
        mNgramsType  = mNgramsTypeFromTabType tabType
148
        listId       = defaultListId
149 150
        initialPath  = { corpusId
                       -- , limit: Just 1000
151 152 153
                       , listId
                       , tabType
                       }
154

155
        charts params CTabTerms (chartType /\ setChartType) _ = [
156
          H.div { className: "row chart-type-selector" } [
157 158
            H.div { className: "col-md-3" } [
              R2.select { className: "form-control"
159 160
                        , defaultValue: show chartType
                        , on: { change: \e -> setChartType
161 162 163
                                             $ const
                                             $ fromMaybe Histo
                                             $ chartTypeFromString
164
                                             $ R.unsafeEventValue e
165 166
                              }
                        } [
167 168 169
                H.option { value: show Histo     } [ H.text $ show Histo     ]
              , H.option { value: show Scatter   } [ H.text $ show Scatter   ]
              , H.option { value: show ChartBar  } [ H.text $ show ChartBar  ]
170
              , H.option { value: show ChartPie  } [ H.text $ show ChartPie  ]
171 172 173
              , H.option { value: show ChartTree } [ H.text $ show ChartTree ]
              ]
            ]
174
          ]
175
        , getChartFunction chartType $ { path: params, session }
176
        ]
177
        charts params _ _ _         = [ chart params mode ]
178

179 180 181 182
        chart path Authors    = pie     { path, session }
        chart path Institutes = tree    { path, session }
        chart path Sources    = bar     { path, session }
        chart path Terms      = metrics { path, session }