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

3
import Data.Maybe (Maybe(..))
4 5
import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
6
import Effect (Effect)
7
import Effect.Aff (launchAff_)
8
import Reactix as R
9
import Reactix.DOM.HTML as H
10
import Record as Record
11
------------------------------------------------------------------------
12
import Gargantext.AsyncTasks as GAT
13
import Gargantext.Components.Forest as Forest
14
import Gargantext.Components.NgramsTable.Loader (clearCache)
15
import Gargantext.Components.Node (NodePoly(..))
16 17 18
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild)
import Gargantext.Components.Nodes.Corpus.Types (getCorpusInfo, CorpusInfo(..), Hyperdata(..))
import Gargantext.Components.Nodes.Lists.Tabs as Tabs
19
import Gargantext.Components.Nodes.Lists.Types
20
import Gargantext.Components.Table as Table
21
import Gargantext.Hooks.Loader (useLoader)
22
import Gargantext.Prelude
23
import Gargantext.Sessions (Session, sessionId, getCacheState, setCacheState)
24
import Gargantext.Types as GT
25 26
import Gargantext.Utils.Reactix as R2

27
thisModule :: String
28
thisModule = "Gargantext.Components.Nodes.Lists"
29
------------------------------------------------------------------------
30 31 32 33
type ListsWithForest = (
    forestProps :: Record Forest.ForestLayoutProps
  , listsProps  :: Record CommonProps
  )
34

35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
listsWithForest :: R2.Component ListsWithForest
listsWithForest = R.createElement listsWithForestCpt

listsWithForestCpt :: R.Component ListsWithForest
listsWithForestCpt = R.hooksComponentWithModule thisModule "listsWithForest" cpt
  where
    cpt { forestProps
        , listsProps: listsProps@{ session } } _ = do
      controls <- initialControls

      pure $ Forest.forestLayoutWithTopBar forestProps [
        topBar { controls } []
      , listsLayout (Record.merge listsProps { controls }) []
      , H.div { className: "side-panel" } [
          sidePanel { controls, session } []
        ]
      ]
--------------------------------------------------------

type TopBarProps = (
  controls :: Record ListsLayoutControls
  )

topBar :: R2.Component TopBarProps
topBar = R.createElement topBarCpt

topBarCpt :: R.Component TopBarProps
topBarCpt = R.hooksComponentWithModule thisModule "topBar" cpt
  where
    cpt { controls } _ = do
      -- empty for now because the button is moved to the side panel
      pure $ H.div {} []
        -- H.ul { className: "nav navbar-nav" } [
        --   H.li {} [
        --      sidePanelToggleButton { state: controls.showSidePanel } []
        --      ]
        --   ]  -- head (goes to top bar)
--------------------------------------------------------

type CommonProps = (
75
    appReload     :: GT.ReloadS
76
  , asyncTasksRef :: R.Ref (Maybe GAT.Reductor)
77 78
  , nodeId        :: Int
  , session       :: Session
79
  , sessionUpdate :: Session -> Effect Unit
80
  , treeReloadRef :: R.Ref (Maybe GT.ReloadS)
81
  )
82

83 84 85 86 87
type Props = (
  controls :: Record ListsLayoutControls
  | CommonProps
  )

88 89 90 91 92
type WithTreeProps = (
    handed :: GT.Handed
  | Props
  )

93 94
listsLayout :: R2.Component Props
listsLayout = R.createElement listsLayoutCpt
95 96

listsLayoutCpt :: R.Component Props
97
listsLayoutCpt = R.hooksComponentWithModule thisModule "listsLayout" cpt
98
  where
99
    cpt path@{ nodeId, session } _ = do
100 101
      let sid = sessionId session

102
      pure $ listsLayoutWithKey $ Record.merge path { key: show sid <> "-" <> show nodeId }
103 104 105 106 107 108 109 110 111 112

type KeyProps = (
  key :: String
  | Props
  )

listsLayoutWithKey :: Record KeyProps -> R.Element
listsLayoutWithKey props = R.createElement listsLayoutWithKeyCpt props []

listsLayoutWithKeyCpt :: R.Component KeyProps
113
listsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "listsLayoutWithKey" cpt
114
  where
115 116 117 118 119 120 121
    cpt { appReload
        , asyncTasksRef
        , controls
        , nodeId
        , session
        , sessionUpdate
        , treeReloadRef } _ = do
122 123
      let path = { nodeId, session }

124
      cacheState <- R.useState' $ getCacheState CacheOn session nodeId
125

126
      useLoader path loadCorpusWithChild $
127
        \corpusData@{ corpusId, corpusNode: NodePoly poly, defaultListId } ->
128 129 130
          let { date, hyperdata : Hyperdata h, name } = poly
              CorpusInfo { authors, desc, query } = getCorpusInfo h.fields
          in
131 132
          R.fragment [
            Table.tableHeaderLayout {
133
                afterCacheStateChange
134 135 136
              , cacheState
              , date
              , desc
137
              , key: "listsLayoutWithKey-header-" <> (show $ fst cacheState)
138 139 140 141
              , query
              , title: "Corpus " <> name
              , user: authors }
          , Tabs.tabs {
142 143
               appReload
             , asyncTasksRef
144
             , cacheState
145 146
             , corpusData
             , corpusId
147
             , key: "listsLayoutWithKey-tabs-" <> (show $ fst cacheState)
148
             , session
149
             , sidePanelTriggers: controls.triggers
150 151
             , treeReloadRef
             }
152
          ]
153 154 155 156
      where
        afterCacheStateChange cacheState = do
          launchAff_ $ clearCache unit
          sessionUpdate $ setCacheState session nodeId cacheState
157
------------------------------------------------------------------------
158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216

type SidePanelProps = (
    controls :: Record ListsLayoutControls
  , session  :: Session
  )

sidePanel :: R2.Component SidePanelProps
sidePanel = R.createElement sidePanelCpt

sidePanelCpt :: R.Component SidePanelProps
sidePanelCpt = R.hooksComponentWithModule thisModule "sidePanel" cpt
  where
    cpt { controls: { triggers: { toggleSidePanel
                                , triggerSidePanel
                                } }
        , session } _ = do

      showSidePanel <- R.useState' InitialClosed

      R.useEffect' $ do
        let toggleSidePanel' _  = snd showSidePanel toggleSidePanelState
            triggerSidePanel' _ = snd showSidePanel $ const Opened
        R2.setTrigger toggleSidePanel  toggleSidePanel'
        R2.setTrigger triggerSidePanel triggerSidePanel'

      (mCorpusId /\ setMCorpusId) <- R.useState' Nothing
      (mListId /\ setMListId) <- R.useState' Nothing
      (mNodeId /\ setMNodeId) <- R.useState' Nothing

      let mainStyle = case fst showSidePanel of
            Opened -> { display: "block" }
            _      -> { display: "none" }

      let closeSidePanel _ = do
            snd showSidePanel $ const Closed

      pure $ H.div { style: mainStyle } [
        H.div { className: "header" } [
          H.span { className: "btn btn-danger"
                 , on: { click: closeSidePanel } } [
            H.span { className: "fa fa-times" } []
          ]
        ]
      , sidePanelDocView { session } []
      ]

type SidePanelDocView = (
    session   :: Session
  )

sidePanelDocView :: R2.Component SidePanelDocView
sidePanelDocView = R.createElement sidePanelDocViewCpt

sidePanelDocViewCpt :: R.Component SidePanelDocView
sidePanelDocViewCpt = R.hooksComponentWithModule thisModule "sidePanelDocView" cpt
  where
    cpt { session } _ = do
      -- pure $ H.h4 {} [ H.text txt ]
      pure $ H.div {} [ H.text "Hello ngrams" ]