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

3 4
import Gargantext.Prelude

5
import Data.Maybe (Maybe(..), fromMaybe, maybe)
6
import Effect (Effect)
7
import Effect.Aff (launchAff_)
arturo's avatar
arturo committed
8
import Gargantext.Components.App.Store (Boxes)
Fabien Manière's avatar
Fabien Manière committed
9
import Gargantext.Components.Bootstrap as B
arturo's avatar
arturo committed
10
import Gargantext.Components.Corpus.CodeSection (loadCorpusWithChild)
11 12
import Gargantext.Components.GraphQL.Context as GQLCTX
import Gargantext.Components.GraphQL.Endpoints (getContextsForNgrams)
13
import Gargantext.Components.NgramsTable.Loader (clearCache)
14
import Gargantext.Components.Node (NodePoly(..))
15
import Gargantext.Components.Nodes.Lists.SidePanel (SidePanel)
16
import Gargantext.Components.Nodes.Lists.Tabs as Tabs
17
import Gargantext.Components.Nodes.Lists.Types (CacheState(..))
18
import Gargantext.Components.Table as Table
19
import Gargantext.Config (defaultFrontends)
20 21
import Gargantext.Config.REST (logRESTError, AffRESTError)
import Gargantext.Core.NgramsTable.Types (NgramsTerm(..))
22
import Gargantext.Ends (url)
23
import Gargantext.Hooks.Loader (useLoader)
24
import Gargantext.Routes as Routes
25
import Gargantext.Sessions (WithSession, WithSessionContext, Session, sessionId, getCacheState, setCacheState)
26
import Gargantext.Types as GT
27
import Gargantext.Utils.Reactix as R2
28 29 30 31
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
32

33 34
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Lists"
35 36
--------------------------------------------------------

37
type CommonPropsNoSession =
38 39 40
  ( boxes         :: Boxes
  , nodeId        :: Int
  , sessionUpdate :: Session -> Effect Unit
41
  , sidePanel     :: T.Box (Maybe (Record SidePanel))
42
  )
43

44
type Props = WithSession CommonPropsNoSession
45 46 47

type CommonPropsSessionContext = WithSessionContext CommonPropsNoSession

48
type WithTreeProps = ( handed :: GT.Handed | Props )
49

50 51
listsLayout :: R2.Component Props
listsLayout = R.createElement listsLayoutCpt
52
listsLayoutCpt :: R.Component Props
53
listsLayoutCpt = here.component "listsLayout" cpt where
54
  cpt props@{ nodeId, session } _ = do
55
    let sid = sessionId session
56
    pure $ listsLayoutWithKey (Record.merge props { key: show sid <> "-" <> show nodeId }) []
57

arturo's avatar
arturo committed
58
listsLayoutWithKey :: R2.Component ( key :: String | Props )
59
listsLayoutWithKey = R.createElement listsLayoutWithKeyCpt
arturo's avatar
arturo committed
60
listsLayoutWithKeyCpt :: R.Component ( key :: String | Props )
61
listsLayoutWithKeyCpt = here.component "listsLayoutWithKey" cpt where
Karen Konou's avatar
Karen Konou committed
62
  cpt { boxes
63
      , nodeId
64
      , session
65 66
      , sessionUpdate
      , sidePanel } _ = do
67 68
    activeTab <- T.useBox 0

69 70
    let path = { nodeId, session }

71
    cacheState <- T.useBox $ getCacheState CacheOff session nodeId
72 73 74 75 76
    cacheState' <- T.useLive T.unequal cacheState

    R.useEffectOnce' $ do
      T.listen (\{ new } -> afterCacheStateChange new) cacheState

77 78 79 80
    useLoader { errorHandler
              , path
              , loader: loadCorpusWithChild
              , render: \corpusData@{ corpusId, corpusNode: NodePoly poly } ->
81
                          let { name, date, hyperdata } = poly
82 83
                          in
                            R.fragment [
84
                              Table.tableHeaderWithRenameLayout {
85
                                cacheState
86
                              , name
87
                              , date
88 89 90
                              , hyperdata
                              , nodeId: corpusId
                              , session
91
                              , key: "listsLayoutWithKey-header-" <> (show cacheState')
arturo's avatar
arturo committed
92
                                }
93 94
                            , Tabs.tabs {
                                activeTab
95
                              , boxes
96 97 98 99 100
                              , cacheState
                              , corpusData
                              , corpusId
                              , key: "listsLayoutWithKey-tabs-" <> (show cacheState')
                              , session
101
                              , sidePanel
102 103
                              }
                            ] }
104
    where
105
      errorHandler = logRESTError here "[listsLayoutWithKey]"
106 107 108
      afterCacheStateChange cacheState = do
        launchAff_ $ clearCache unit
        sessionUpdate $ setCacheState session nodeId cacheState
109

110
type SidePanelProps =
111 112
  ( session        :: Session
  , sidePanel      :: T.Box (Maybe (Record SidePanel))
113
  , sidePanelState :: T.Box GT.SidePanelState
114 115 116 117
  )

sidePanel :: R2.Component SidePanelProps
sidePanel = R.createElement sidePanelCpt
118
sidePanelCpt :: R.Component SidePanelProps
119
sidePanelCpt = here.component "sidePanel" cpt
120
  where
121
    cpt { session
122
        , sidePanel
123
        , sidePanelState } _ = do
124

125
      sidePanelState' <- T.useLive T.unequal sidePanelState
126

127 128 129
      let mainStyle = case sidePanelState' of
            GT.Opened -> { display: "block" }
            _         -> { display: "none" }
130

131
      let closeSidePanel _ = T.write_ GT.Closed sidePanelState
132 133

      pure $ H.div { style: mainStyle } [
Fabien Manière's avatar
Fabien Manière committed
134 135 136 137 138 139 140 141 142
        H.div
        { className: "lists-sidepanel__header" }
        [
          -- Close CTA
          B.iconButton
          { name: "times"
          , callback: closeSidePanel
          , className: "graph-sidebar__close"
          }
143
        ]
Fabien Manière's avatar
Fabien Manière committed
144 145 146 147 148
      , 
        H.div
        { className: "lists-sidepanel__body" }
        [
          sidePanelNgramsContextView { session
149
                                   , sidePanel } []
Fabien Manière's avatar
Fabien Manière committed
150
        ]
151 152
      ]

153
type SidePanelNgramsContextView =
154 155
 ( session        :: Session
 , sidePanel      :: T.Box (Maybe (Record SidePanel)) )
156

157 158 159 160
sidePanelNgramsContextView :: R2.Component SidePanelNgramsContextView
sidePanelNgramsContextView = R.createElement sidePanelNgramsContextViewCpt
sidePanelNgramsContextViewCpt :: R.Component SidePanelNgramsContextView
sidePanelNgramsContextViewCpt = here.component "sidePanelNgramsContextView" cpt where
161 162
  cpt { session
      , sidePanel } _ = do
163 164 165 166
    mSidePanel' <- T.useLive T.unequal sidePanel

    case mSidePanel' of
      Nothing -> pure $ H.div {} []
167 168 169
      Just sidePanel' -> do
        let ngrams = maybe "" (\(NormNgramsTerm n) -> n) sidePanel'.mCurrentNgrams

Fabien Manière's avatar
Fabien Manière committed
170 171 172 173 174 175 176 177 178 179 180 181
        pure $ H.div {} 
          [
            H.div { className: "list-group-item border-0" }
            [
              H.div 
              { className: "graph-selected-nodes__badge badge badge-info" } 
              [ 
                H.text ngrams 
              ]
            ]
          , 
            ngramsDocList { mCorpusId: sidePanel'.mCorpusId
182
                                        , mListId: sidePanel'.mListId
183
                                        , mNgrams: sidePanel'.mCurrentNgrams
Fabien Manière's avatar
Fabien Manière committed
184 185
                                        , session } [] 
          ]
186 187 188

type NgramsDocListProps =
  ( mCorpusId :: Maybe GT.CorpusId
189
  , mListId   :: Maybe GT.ListId
190 191 192 193 194 195 196 197 198
  , mNgrams   :: Maybe NgramsTerm
  , session   :: Session )

ngramsDocList :: R2.Component NgramsDocListProps
ngramsDocList = R.createElement ngramsDocListCpt
ngramsDocListCpt :: R.Component NgramsDocListProps
ngramsDocListCpt = here.component "ngramsDocList" cpt where
  cpt { mCorpusId: Nothing } _ = do
    pure $ H.div {} []
199 200
  cpt { mListId: Nothing } _ = do
    pure $ H.div {} []
201 202 203
  cpt { mNgrams: Nothing } _ = do
    pure $ H.div {} []
  cpt { mCorpusId: Just corpusId
204
      , mListId: Just listId
205 206 207 208 209 210 211
      , mNgrams: Just ngrams
      , session } _ = do
    useLoader { errorHandler
              , path: { corpusId, ngrams, session }
              , loader: loaderNgramsDocList
              , render: \ctx -> ngramsDocListLoaded { contexts: ctx
                                                    , corpusId
212
                                                    , listId
213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230
                                                    , ngrams
                                                    , session } []
              }
    where
      errorHandler = logRESTError here "[ngramsDocList]"

type NgramsDocLoadProps =
  ( corpusId :: GT.CorpusId
  , ngrams   :: NgramsTerm
  , session  :: Session )

loaderNgramsDocList :: Record NgramsDocLoadProps -> AffRESTError (Array GQLCTX.Context)
loaderNgramsDocList { corpusId, ngrams: NormNgramsTerm ngrams, session } =
  getContextsForNgrams session corpusId [ngrams]

type NgramsDocListLoadedProps =
  ( contexts :: Array GQLCTX.Context
  , corpusId :: GT.CorpusId
231
  , listId   :: GT.ListId
232 233 234 235 236 237 238 239 240
  , ngrams   :: NgramsTerm
  , session  :: Session )

ngramsDocListLoaded :: R2.Component NgramsDocListLoadedProps
ngramsDocListLoaded = R.createElement ngramsDocListLoadedCpt
ngramsDocListLoadedCpt :: R.Component NgramsDocListLoadedProps
ngramsDocListLoadedCpt = here.component "ngramsDocListLoaded" cpt where
  cpt { contexts
      , corpusId
241
      , listId
242 243
      , ngrams
      , session } _ = do
Fabien Manière's avatar
Fabien Manière committed
244
    pure $ H.div { className: "ngrams-doc-list p-2" }
245 246 247 248
      [ H.ul { className: "list-group" } ((\item -> contextItem { corpusId
                                                                , item
                                                                , listId
                                                                , session } [] ) <$> contexts)
249
      ]
250

251
type ContextItemProps =
252 253 254 255
  ( corpusId :: GT.CorpusId
  , item     :: GQLCTX.Context
  , listId   :: GT.ListId
  , session  :: Session )
256 257 258 259 260

contextItem :: R2.Component ContextItemProps
contextItem = R.createElement contextItemCpt
contextItemCpt :: R.Component ContextItemProps
contextItemCpt = here.component "contextItem" cpt where
261 262 263 264 265 266 267 268 269 270 271
  cpt { corpusId
      , item
      , listId
      , session } _ = do

    let route = Routes.CorpusDocument (sessionId session) corpusId listId item.c_id
        href = url defaultFrontends route

    pure $ H.a { className: "list-group-item text-decoration-none"
               , href
               , target: "_blank" }
272 273 274 275 276 277 278 279
      [ H.div { className: "context-item-title" }
          [ H.text $ maybe "" (_.hrd_title) item.c_hyperdata ]
      , H.div { className: "context-item-source"}
          [ H.text $ maybe "" (_.hrd_source) item.c_hyperdata ]
      , H.div { className: "context-item-date"}
          [ H.text $ (maybe "" (\h -> show h.hrd_publication_year) item.c_hyperdata) <>
                     "-" <>
                     (maybe "" (\h -> show h.hrd_publication_month) item.c_hyperdata) ] ]