Table.purs 10.8 KB
Newer Older
Nicolas Pouillard's avatar
Nicolas Pouillard committed
1 2
module Gargantext.Components.Table where

3
import Prelude
4
import Data.Array as A
5 6
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
7
import Data.Maybe (Maybe(..))
8
import Data.Sequence as Seq
9
import Data.Tuple (fst, snd)
10
import Data.Tuple.Nested ((/\))
11
import DOM.Simple.Console (log2)
12
import Effect (Effect)
13 14
import Reactix as R
import Reactix.DOM.HTML as H
15 16 17

import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Search
18
import Gargantext.Utils.Reactix as R2
19
import Gargantext.Utils.Reactix (effectLink)
Nicolas Pouillard's avatar
Nicolas Pouillard committed
20

21 22
thisModule = "Gargantext.Components.Table"

23
type TableContainerProps =
24 25 26 27 28 29
  ( pageSizeControl     :: R.Element
  , pageSizeDescription :: R.Element
  , paginationLinks     :: R.Element
  , tableHead           :: R.Element
  , tableBody           :: Array R.Element
  )
30

31
type Row = { row :: R.Element, delete :: Boolean }
32
type Rows = Seq.Seq Row
Nicolas Pouillard's avatar
Nicolas Pouillard committed
33

34 35
type OrderBy = Maybe (OrderByDirection ColumnName)

36 37 38 39 40
type Params = { offset :: Int
              , limit  :: Int
              , orderBy :: OrderBy
              , searchType :: SearchType
              }
41 42 43

newtype ColumnName = ColumnName String

44 45 46 47 48
derive instance genericColumnName :: Generic ColumnName _

instance showColumnName :: Show ColumnName where
  show = genericShow

49 50 51 52 53 54
derive instance eqColumnName :: Eq ColumnName

columnName :: ColumnName -> String
columnName (ColumnName c) = c

data OrderByDirection a = ASC a | DESC a
Nicolas Pouillard's avatar
Nicolas Pouillard committed
55

56 57 58 59 60
derive instance genericOrderByDirection :: Generic (OrderByDirection a) _

instance showOrderByDirection :: Show a => Show (OrderByDirection a) where
  show = genericShow

61 62
derive instance eqOrderByDirection :: Eq a => Eq (OrderByDirection a)

63
type Props =
64
  ( colNames     :: Array ColumnName
65 66
  , wrapColElts  :: ColumnName -> Array R.Element -> Array R.Element
                 -- ^ Use `const identity` as a default behavior.
Nicolas Pouillard's avatar
Nicolas Pouillard committed
67
  , totalRecords :: Int
68
  , params       :: R.State Params
69
  , rows         :: Rows
70
  , container    :: Record TableContainerProps -> R.Element
Nicolas Pouillard's avatar
Nicolas Pouillard committed
71 72 73
  )

type State =
74 75 76
  { page     :: Int
  , pageSize :: PageSizes
  , orderBy  :: OrderBy
77
  , searchType :: SearchType
Nicolas Pouillard's avatar
Nicolas Pouillard committed
78 79
  }

80
paramsState :: Params -> State
81
paramsState {offset, limit, orderBy, searchType} = {pageSize, page, orderBy, searchType}
82 83 84 85
  where
    pageSize = int2PageSizes limit
    page = offset / limit + 1

86
stateParams :: State -> Params
87
stateParams {pageSize, page, orderBy, searchType} = {offset, limit, orderBy, searchType}
88 89 90 91 92
  where
    limit = pageSizes2Int pageSize
    offset = limit * (page - 1)

type TableHeaderLayoutProps =
93 94 95
  ( afterCacheStateChange :: Unit -> Effect Unit
  , cacheState :: R.State NT.CacheState
  , date  :: String
96 97
  , desc  :: String
  , query :: String
98
  , title :: String
99 100
  , user  :: String
  )
Nicolas Pouillard's avatar
Nicolas Pouillard committed
101

102
initialParams :: Params
103
initialParams = stateParams {page: 1, pageSize: PS10, orderBy: Nothing, searchType: SearchDoc}
104 105 106 107 108 109
-- TODO: Not sure this is the right place for this

tableHeaderLayout :: Record TableHeaderLayoutProps -> R.Element
tableHeaderLayout props = R.createElement tableHeaderLayoutCpt props []

tableHeaderLayoutCpt :: R.Component TableHeaderLayoutProps
110
tableHeaderLayoutCpt = R.hooksComponentWithModule thisModule "tableHeaderLayout" cpt
111
  where
112
    cpt { afterCacheStateChange, cacheState, date, desc, query, title, user } _ =
113
      pure $ R.fragment
114
      [ R2.row
115 116 117 118
        [ H.div {className: "col-md-3"} [ H.h3 {} [H.text title] ]
        , H.div {className: "col-md-9"}
          [ H.hr {style: {height: "2px", backgroundColor: "black"}} ]
        ]
119
      , R2.row
120 121 122
        [ H.div {className: "jumbotron1", style: {padding: "12px 0px 20px 12px"}}
          [ H.div {className: "col-md-8 content"}
            [ H.p {}
123
              [ H.i {className: "fa fa-globe"} []
124
              , H.text $ " " <> desc
125
              ]
126
            , H.p {}
127
              [ H.i {className: "fa fa-search-plus"} []
128
              , H.text $ " " <> query
129
              ]
130 131 132 133 134
            , H.p { className: "cache-toggle"
                  , on: { click: cacheClick cacheState afterCacheStateChange } }
              [ H.i {className: "fa " <> (cacheToggle cacheState)} []
              , H.text $ cacheText cacheState
              ]
135 136 137
            ]
          , H.div {className: "col-md-4 content"}
            [ H.p {}
138
              [ H.i {className: "fa fa-calendar"} []
139
              , H.text $ " " <> date
140
              ]
141
            , H.p {}
142
              [ H.i {className: "fa fa-user"} []
143 144 145 146
              , H.text $ " " <> user
              ]
            ]
          ]
147
        ]
148
      ]
149 150 151 152 153 154 155 156 157 158 159 160 161

    cacheToggle (NT.CacheOn /\ _) = "fa-toggle-on"
    cacheToggle (NT.CacheOff /\ _) = "fa-toggle-off"

    cacheText (NT.CacheOn /\ _) = "Cache On"
    cacheText (NT.CacheOff /\ _) = "Cache Off"

    cacheClick (_ /\ setCacheState) after _ = do
      setCacheState cacheStateToggle
      after unit

    cacheStateToggle NT.CacheOn = NT.CacheOff
    cacheStateToggle NT.CacheOff = NT.CacheOn
162 163 164
  
table :: Record Props -> R.Element
table props = R.createElement tableCpt props []
165

166
tableCpt :: R.Component Props
167
tableCpt = R.hooksComponentWithModule thisModule "table" cpt
Nicolas Pouillard's avatar
Nicolas Pouillard committed
168
  where
169
    cpt {container, colNames, wrapColElts, totalRecords, rows, params} _ = do
170
      let
171 172
        state = paramsState $ fst params
        ps = pageSizes2Int state.pageSize
173 174 175 176
        totalPages = (totalRecords / ps) + min 1 (totalRecords `mod` ps)
        colHeader :: ColumnName -> R.Element
        colHeader c = H.th {scope: "col"} [ H.b {} cs ]
          where
177
            lnk mc = effectLink $ snd params $ _ { orderBy = mc }
178 179
            cs :: Array R.Element
            cs =
180
              wrapColElts c $
181
              case state.orderBy of
182 183
                Just (ASC d)  | c == d -> [lnk (Just (DESC c)) "ASC ", lnk Nothing (columnName c)]
                Just (DESC d) | c == d -> [lnk (Just (ASC  c)) "DESC ",  lnk Nothing (columnName c)]
184
                _ -> [lnk (Just (ASC c)) (columnName c)]
185
      pure $ container
186
        { pageSizeControl: sizeDD { params }
187 188
        , pageSizeDescription: textDescription state.page state.pageSize totalRecords
        , paginationLinks: pagination params totalPages
189
        , tableBody: map _.row $ A.fromFoldable rows
190
        , tableHead: H.tr {} (colHeader <$> colNames)
191
        }
Nicolas Pouillard's avatar
Nicolas Pouillard committed
192

193 194 195
makeRow :: Array R.Element -> R.Element
makeRow els = H.tr {} $ (\c -> H.td {} [c]) <$> els

196 197 198 199 200 201

type FilterRowsParams =
  (
    params :: Params
  )

202
filterRows :: forall a. Record FilterRowsParams -> Seq.Seq a -> Seq.Seq a
203 204
filterRows { params: { limit, offset, orderBy } } rs = newRs
  where
205
    newRs = Seq.take limit $ Seq.drop offset $ rs
206

207 208
defaultContainer :: {title :: String} -> Record TableContainerProps -> R.Element
defaultContainer {title} props = R.fragment
209
  [ R2.row
210 211 212
    [ H.div {className: "col-md-4"} [ props.pageSizeDescription ]
    , H.div {className: "col-md-4"} [ props.paginationLinks ]
    , H.div {className: "col-md-4"} [ props.pageSizeControl ]
213
    ]
214 215 216
  , H.table {className: "table"}
    [ H.thead {className: "thead-dark"} [ props.tableHead ]
    , H.tbody {} props.tableBody
217 218
    ]
  ]
Nicolas Pouillard's avatar
Nicolas Pouillard committed
219

220
-- TODO: this needs to be in Gargantext.Pages.Corpus.Graph.Tabs
221
graphContainer :: {title :: String} -> Record TableContainerProps -> R.Element
222
graphContainer {title} props =
223 224 225 226 227
  -- TODO title in tabs name (above)
  H.table {className: "table"}
  [ H.thead {className: "thead-dark"} [ props.tableHead ]
  , H.tbody {} props.tableBody
  ]
228 229 230 231
   -- TODO better rendering of the paginationLinks
   -- , props.pageSizeControl
   -- , props.pageSizeDescription
   -- , props.paginationLinks
232

233 234 235 236 237 238 239 240 241
type SizeDDProps =
  (
    params :: R.State Params
  )

sizeDD :: Record SizeDDProps -> R.Element
sizeDD p = R.createElement sizeDDCpt p []

sizeDDCpt :: R.Component SizeDDProps
242
sizeDDCpt = R.hooksComponentWithModule thisModule "sizeDD" cpt
243
  where
244 245 246 247 248 249 250 251
    cpt {params: params /\ setParams} _ = do
      pure $ H.span {} [
        R2.select { className, defaultValue: show pageSize, on: {change} } sizes
      ]
      where
        {pageSize} = paramsState params
        className = "form-control"
        change e = do
252
          let ps = string2PageSize $ R.unsafeEventValue e
253 254 255 256
          setParams $ \p -> stateParams $ (paramsState p) { pageSize = ps }
        sizes = map option pageSizes
        option size = H.option {value} [H.text value]
          where value = show size
Nicolas Pouillard's avatar
Nicolas Pouillard committed
257

258 259 260
textDescription :: Int -> PageSizes -> Int -> R.Element
textDescription currPage pageSize totalRecords =
  H.div {className: "row1"} [ H.div {className: ""} [ H.text msg ] ] -- TODO or col-md-6 ?
261
  where
262 263 264 265 266
    start = (currPage - 1) * pageSizes2Int pageSize + 1
    end' = currPage * pageSizes2Int pageSize
    end  = if end' > totalRecords then totalRecords else end'
    msg = "Showing " <> show start <> " to " <> show end <> " of " <> show totalRecords

267 268
pagination :: R.State Params -> Int -> R.Element
pagination (params /\ setParams) tp =
269 270
  H.span {} $
    [ H.text " ", prev, first, ldots]
Nicolas Pouillard's avatar
Nicolas Pouillard committed
271 272 273
    <>
    lnums
    <>
274
    [H.b {} [H.text $ " " <> show page <> " "]]
Nicolas Pouillard's avatar
Nicolas Pouillard committed
275 276 277 278 279
    <>
    rnums
    <>
    [ rdots, last, next ]
    where
280 281 282
      {page} = paramsState params
      changePage page = setParams $ \p -> stateParams $ (paramsState p) { page = page }
      prev = if page == 1 then
283
               H.text " Prev. "
284
             else
285 286
               changePageLink (page - 1) "Prev."
      next = if page == tp then
287
               H.text " Next "
288
             else
289 290
               changePageLink (page + 1) "Next"
      first = if page == 1 then
291
                H.text ""
292 293
              else
                changePageLink' 1
294
      last = if page == tp then
295
               H.text ""
Nicolas Pouillard's avatar
Nicolas Pouillard committed
296
             else
297
               changePageLink' tp
298
      ldots = if page >= 5 then
299
                H.text " ... "
Nicolas Pouillard's avatar
Nicolas Pouillard committed
300
                else
301
                H.text ""
302
      rdots = if page + 3 < tp then
303
                H.text " ... "
Nicolas Pouillard's avatar
Nicolas Pouillard committed
304
                else
305
                H.text ""
306 307
      lnums = map changePageLink' $ A.filter (1  < _) [page - 2, page - 1]
      rnums = map changePageLink' $ A.filter (tp > _) [page + 1, page + 2]
Nicolas Pouillard's avatar
Nicolas Pouillard committed
308

309 310 311 312
      changePageLink :: Int -> String -> R.Element
      changePageLink i s =
        H.span {}
          [ H.text " "
313
          , effectLink (changePage i) s
314
          , H.text " "
315 316
          ]

317
      changePageLink' :: Int -> R.Element
318
      changePageLink' i = changePageLink i (show i)
Nicolas Pouillard's avatar
Nicolas Pouillard committed
319

320
data PageSizes = PS10 | PS20 | PS50 | PS100 | PS200
Nicolas Pouillard's avatar
Nicolas Pouillard committed
321 322 323 324 325 326 327 328

derive instance eqPageSizes :: Eq PageSizes

instance showPageSize :: Show PageSizes where
  show PS10  = "10"
  show PS20  = "20"
  show PS50  = "50"
  show PS100 = "100"
329
  show PS200 = "200"
Nicolas Pouillard's avatar
Nicolas Pouillard committed
330

331 332 333
int2PageSizes :: Int -> PageSizes
int2PageSizes i = string2PageSize $ show i

Nicolas Pouillard's avatar
Nicolas Pouillard committed
334 335 336 337 338
pageSizes2Int :: PageSizes -> Int
pageSizes2Int PS10  = 10
pageSizes2Int PS20  = 20
pageSizes2Int PS50  = 50
pageSizes2Int PS100 = 100
339
pageSizes2Int PS200 = 200
Nicolas Pouillard's avatar
Nicolas Pouillard committed
340

341 342
pageSizes :: Array PageSizes
pageSizes = [PS10, PS20, PS50, PS100, PS200]
Nicolas Pouillard's avatar
Nicolas Pouillard committed
343 344 345 346 347 348

string2PageSize :: String -> PageSizes
string2PageSize "10" = PS10
string2PageSize "20" = PS20
string2PageSize "50" = PS50
string2PageSize "100" = PS100
349
string2PageSize "200" = PS200
Nicolas Pouillard's avatar
Nicolas Pouillard committed
350
string2PageSize _    = PS10