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

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

import Gargantext.Prelude

14
import Gargantext.Components.NgramsTable as NT
15
import Gargantext.Components.Nodes.Corpus.Types (CorpusData)
16 17 18
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)
19
import Gargantext.Components.Nodes.Corpus.Chart (getChartFunction)
20
import Gargantext.Components.Nodes.Corpus.Chart.Utils (mNgramsTypeFromTabType)
21 22
import Gargantext.Components.Nodes.Lists.Types as NTypes
import Gargantext.Components.Tab as Tab
23
import Gargantext.Sessions (Session)
24 25
import Gargantext.Types (ChartType(..), CTabNgramType(..), Mode(..), TabSubType(..), TabType(..), chartTypeFromString, modeTabType)
import Gargantext.Utils.Reactix as R2
26

27
thisModule :: String
28 29
thisModule = "Gargantext.Components.Nodes.Lists.Tabs"

30 31
type Props = ( cacheState :: R.State NTypes.CacheState
             , corpusData :: CorpusData
32
             , corpusId   :: Int
33
             , session    :: Session
34
             )
35

36 37 38 39 40 41
type PropsWithKey = (
  key        :: String
  | Props
  )

tabs :: Record PropsWithKey -> R.Element
42 43
tabs props = R.createElement tabsCpt props []

44
tabsCpt :: R.Component PropsWithKey
45
tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt
46
  where
47
    cpt { cacheState, corpusData: corpusData@{ defaultListId }, corpusId, session } _ = do
48
      (selected /\ setSelected) <- R.useState' 0
49

50
      pure $ Tab.tabs { selected, tabs: tabs' }
51
      where
52
        tabs' = [ "Authors"    /\ view Authors
53
                , "Institutes" /\ view Institutes
54
                , "Sources"    /\ view Sources
55
                , "Terms"      /\ view Terms ]
56
        view mode = ngramsView { cacheState, corpusData, corpusId, mode, session }
57 58 59 60 61 62 63

type NgramsViewProps = ( mode :: Mode | Props )

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

ngramsViewCpt :: R.Component NgramsViewProps
64
ngramsViewCpt = R.hooksComponentWithModule thisModule "ngramsView" cpt
65
  where
66 67
    cpt { cacheState
        , corpusData: { defaultListId }
68 69 70
        , corpusId
        , mode
        , session } _ = do
71

72
      chartType <- R.useState' Histo
73
      chartsReload <- R.useState' 0
74 75

      pure $ R.fragment
76
        ( charts tabNgramType chartType chartsReload
77
        <> [ NT.mainNgramsTable { afterSync: afterSync chartsReload
78
                                , cacheState
79
                                , defaultListId
80
                                , nodeId: corpusId
81
                                , session
82
                                , tabNgramType
83
                                , tabType
84 85 86
                                , withAutoUpdate: false
                                }
           ]
87
        )
88
      where
89
        afterSync (_ /\ setChartsReload) _ = do
90 91
          case mNgramsType of
            Just ngramsType -> do
92 93 94 95
              -- 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
96
              liftEffect $ setChartsReload $ (+) 1
97 98
            Nothing         -> pure unit

99
        tabNgramType = modeTabType mode
100
        tabType      = TabCorpus (TabNgramType tabNgramType)
101
        mNgramsType = mNgramsTypeFromTabType tabType
102
        listId       = defaultListId
103
        path         = { corpusId
104
                       , limit: Just 1000
105 106 107
                       , listId
                       , tabType
                       }
108

109
        charts CTabTerms (chartType /\ setChartType) _ = [
110
          H.div { className: "row chart-type-selector" } [
111 112
            H.div { className: "col-md-3" } [
              R2.select { className: "form-control"
113 114 115 116
                        ,  on: { change: \e -> setChartType
                                             $ const
                                             $ fromMaybe Histo
                                             $ chartTypeFromString
117
                                             $ R.unsafeEventValue e
118
                               }
119
                        , defaultValue: show chartType } [
120 121 122
                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  ]
123
              , H.option { value: show ChartPie  } [ H.text $ show ChartPie  ]
124 125 126
              , H.option { value: show ChartTree } [ H.text $ show ChartTree ]
              ]
            ]
127
          ]
128
        , getChartFunction chartType $ { session, path }
129
        ]
130
        charts _ _ _       = [ chart mode ]
131

132 133 134 135
        chart Authors    = pie     { path, session }
        chart Institutes = tree    { path, session }
        chart Sources    = bar     { path, session }
        chart Terms      = metrics { path, session }