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

arturo's avatar
arturo committed
3 4
import Gargantext.Components.Nodes.Lists.Types hiding (here)

5
import Data.Array as A
6
import Data.Maybe (Maybe(..), fromMaybe)
7
import Data.Tuple.Nested ((/\))
8
import Effect.Class (liftEffect)
9
import Gargantext.Components.App.Data (Boxes)
10
import Gargantext.Components.NgramsTable as NT
11
import Gargantext.Components.NgramsTable.Core as NTC
12
import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
13
import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie, bar)
14
import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree)
15
import Gargantext.Components.Nodes.Corpus.Chart.Utils (mNgramsTypeFromTabType)
16
import Gargantext.Components.Nodes.Corpus.Types (CorpusData)
17
import Gargantext.Components.Tab as Tab
arturo's avatar
arturo committed
18 19
import Gargantext.Components.Table.Types (Params)
import Gargantext.Prelude (bind, pure, unit, ($))
20
import Gargantext.Sessions (Session)
21
import Gargantext.Types (CTabNgramType(..), Mode(..), TabSubType(..), TabType(..), modeTabType)
22
import Gargantext.Utils.Reactix as R2
James Laver's avatar
James Laver committed
23
import Gargantext.Utils.Toestand as T2
24 25 26 27
import Reactix as R
import Record as Record
import Record.Extra as RX
import Toestand as T
28

James Laver's avatar
James Laver committed
29 30
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Lists.Tabs"
31

32
type Props = (
33 34 35 36 37 38
    activeTab  :: T.Box Int
  , boxes      :: Boxes
  , cacheState :: T.Box CacheState
  , corpusData :: CorpusData
  , corpusId   :: Int
  , session    :: Session
39
  )
40

James Laver's avatar
James Laver committed
41
type PropsWithKey = ( key :: String | Props )
42 43

tabs :: Record PropsWithKey -> R.Element
44
tabs props = R.createElement tabsCpt props []
45
tabsCpt :: R.Component PropsWithKey
James Laver's avatar
James Laver committed
46
tabsCpt = here.component "tabs" cpt where
47 48 49
  cpt props@{ activeTab } _ = do
    pure $ Tab.tabs { activeTab
                    , tabs: tabs' } where
50 51 52 53
      tabs' = [ "Terms"      /\ view Terms []
              , "Authors"    /\ view Authors []
              , "Institutes" /\ view Institutes []
              , "Sources"    /\ view Sources []
James Laver's avatar
James Laver committed
54 55
              ]
      common = RX.pick props :: Record Props
56
      view mode = ngramsView $ Record.merge common { mode }
57 58 59

type NgramsViewProps = ( mode :: Mode | Props )

60 61
ngramsView :: R2.Component NgramsViewProps
ngramsView = R.createElement ngramsViewCpt
62
ngramsViewCpt :: R.Component NgramsViewProps
James Laver's avatar
James Laver committed
63
ngramsViewCpt = here.component "ngramsView" cpt where
64 65
  cpt props@{ boxes
            , cacheState
66 67 68
            , corpusData: { defaultListId }
            , corpusId
            , mode
69
            , session } _ = do
70
      chartsReload <- T.useBox T2.newReload
71

72
      path <- T.useBox $ NTC.initialPageParams props.session initialPath.corpusId [initialPath.listId] initialPath.tabType
73
      { listIds, nodeId, params } <- T.useLive T.unequal path
arturo's avatar
arturo committed
74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99

      pure $
        R.fragment
        [
          ngramsView'
          { mode
          , boxes
          , session
          , params
          , listIds
          , nodeId
          , corpusData: props.corpusData
          } []
        ,
          NT.mainNgramsTable
          { afterSync: afterSync chartsReload
          , boxes
          , cacheState
          , defaultListId
          , path
          , session
          , tabNgramType
          , tabType
          , withAutoUpdate: false
          } []
        ]
100
      where
101
        afterSync chartsReload _ = do
102
          case mNgramsType of
103
            Just _ -> do
104 105 106 107
              -- 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
108
              liftEffect $ T2.reload chartsReload
109 110
            Nothing         -> pure unit

111
        tabNgramType = modeTabType mode
112
        tabType      = TabCorpus (TabNgramType tabNgramType)
113
        mNgramsType  = mNgramsTypeFromTabType tabType
114
        listId       = defaultListId
115 116
        initialPath  = { corpusId
                       -- , limit: Just 1000
117 118 119
                       , listId
                       , tabType
                       }
120

arturo's avatar
arturo committed
121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170


----------------


-- @XXX re-render issue -> clone component
type NgramsViewProps' =
  ( mode          :: Mode
  , boxes         :: Boxes
  , session       :: Session
  , listIds       :: Array Int
  , params        :: Params
  , nodeId        :: Int
  , corpusData    :: CorpusData
  )

ngramsView' :: R2.Component NgramsViewProps'
ngramsView' = R.createElement ngramsViewCpt'
ngramsViewCpt' :: R.Memo NgramsViewProps'
ngramsViewCpt' = R.memo' $ here.component "ngramsView_clone" cpt where
  cpt { mode
      , boxes
      , session
      , listIds
      , params
      , nodeId
      , corpusData: { defaultListId }
      } _ = do

    let path' = {
      corpusId: nodeId
    , limit: params.limit
    , listId: fromMaybe defaultListId $ A.head listIds
    , tabType: tabType
    }

    let chartParams = {
      corpusId: path'.corpusId
    , limit: Just path'.limit
    , listId: path'.listId
    , tabType: path'.tabType
    }

    pure $

      R.fragment $
      charts chartParams tabNgramType

    where
      charts _params CTabTerms = [
171
          {-
172
          H.div {className: "row"}
Alexandre Delanoë's avatar
Alexandre Delanoë committed
173
                [ H.div {className: "col-12 d-flex justify-content-center"}
174 175 176 177 178 179
                  [ H.img { src: "images/Gargantextuel-212x300.jpg"
                          , id: "funnyimg"
                        }
                  ]
                ]

180
              R2.select { className: "form-control"
181 182
                        , defaultValue: show chartType
                        , on: { change: \e -> setChartType
183 184 185
                                             $ const
                                             $ fromMaybe Histo
                                             $ chartTypeFromString
186
                                             $ R.unsafeEventValue e
187 188
                              }
                        } [
189 190 191
                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  ]
192
              , H.option { value: show ChartPie  } [ H.text $ show ChartPie  ]
193 194 195
              , H.option { value: show ChartTree } [ H.text $ show ChartTree ]
              ]
            ]
196
          ]
197
        , getChartFunction chartType $ { path: params, session }
198
        -}
arturo's avatar
arturo committed
199 200 201 202 203 204 205 206 207
      ]
      charts params' _        = [ chart params' mode ]

      chart path Authors    = pie     { boxes, path, session, onClick: Nothing, onInit: Nothing }
      chart path Institutes = tree    { boxes, path, session, onClick: Nothing, onInit: Nothing }
      chart path Sources    = bar     { boxes, path, session, onClick: Nothing, onInit: Nothing }
      chart path Terms      = metrics { boxes, path, session, onClick: Nothing, onInit: Nothing }

      tabType      = TabCorpus (TabNgramType tabNgramType)
208

arturo's avatar
arturo committed
209
      tabNgramType = modeTabType mode