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

3
import Data.Array as A
4
import Data.Maybe (Maybe(..))
5
import Data.Sequence as Seq
6
import Effect (Effect)
7 8
import Reactix as R
import Reactix.DOM.HTML as H
9
import Toestand as T
10

11 12
import Gargantext.Prelude

13
import Gargantext.Components.FolderView as FV
14
import Gargantext.Components.Table.Types (ColumnName, OrderBy, OrderByDirection(..), Params, Props, TableContainerProps, columnName)
15
import Gargantext.Components.Nodes.Lists.Types as NT
16
import Gargantext.Components.Search (SearchType(..))
17
import Gargantext.Utils.Reactix as R2
18
import Gargantext.Utils.Reactix (effectLink)
Nicolas Pouillard's avatar
Nicolas Pouillard committed
19

20 21
here :: R2.Here
here = R2.here "Gargantext.Components.Table"
22

23 24
type Page = Int

Nicolas Pouillard's avatar
Nicolas Pouillard committed
25
type State =
26
  { page       :: Page
27 28
  , pageSize   :: PageSizes
  , orderBy    :: OrderBy
29
  , searchType :: SearchType
Nicolas Pouillard's avatar
Nicolas Pouillard committed
30 31
  }

32
paramsState :: Params -> State
33
paramsState {offset, limit, orderBy, searchType} = {pageSize, page, orderBy, searchType}
34 35 36 37
  where
    pageSize = int2PageSizes limit
    page = offset / limit + 1

38
stateParams :: State -> Params
39
stateParams {pageSize, page, orderBy, searchType} = {offset, limit, orderBy, searchType}
40 41 42 43
  where
    limit = pageSizes2Int pageSize
    offset = limit * (page - 1)

44
type TableHeaderLayoutProps = (
45
    cacheState :: T.Box NT.CacheState
46
  , date  :: String
47
  , desc  :: String
48
  , key   :: String
49
  , query :: String
50
  , title :: String
51 52
  , user  :: String
  )
Nicolas Pouillard's avatar
Nicolas Pouillard committed
53

54
initialParams :: Params
55
initialParams = stateParams {page: 1, pageSize: PS10, orderBy: Nothing, searchType: SearchDoc}
56 57
-- TODO: Not sure this is the right place for this

58 59
tableHeaderLayout :: R2.Component TableHeaderLayoutProps
tableHeaderLayout = R.createElement tableHeaderLayoutCpt
60
tableHeaderLayoutCpt :: R.Component TableHeaderLayoutProps
61
tableHeaderLayoutCpt = here.component "tableHeaderLayout" cpt
62
  where
63 64 65
    cpt { cacheState, date, desc, query, title, user } _ = do
      cacheState' <- T.useLive T.unequal cacheState

66
      pure $ R.fragment
67
        [ R2.row [FV.backButton {} []]
68 69
        ,
          R2.row
70 71 72
          [ H.div {className: "col-md-3"} [ H.h3 {} [H.text title] ]
          , H.div {className: "col-md-9"}
            [ H.hr {style: {height: "2px", backgroundColor: "black"}} ]
73
          ]
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
          , R2.row
            [ H.div {className: "col-md-8 content"}
              [ H.p {}
                [ H.span {className: "fa fa-globe"} []
                , H.text $ " " <> desc
                ]
              , H.p {}
                [ H.span {className: "fa fa-search-plus"} []
                , H.text $ " " <> query
                ]
              , H.p { className: "cache-toggle"
                    , on: { click: cacheClick cacheState } }
                [ H.span { className: "fa " <> (cacheToggle cacheState') } []
                , H.text $ cacheText cacheState'
                ]
              ]
            , H.div {className: "col-md-4 content"}
              [ H.p {}
                [ H.span {className: "fa fa-calendar"} []
                , H.text $ " " <> date
                ]
              , H.p {}
                [ H.span {className: "fa fa-user"} []
                , H.text $ " " <> user
                ]
              ]
100 101
            ]
          ]
102

103 104
    cacheToggle NT.CacheOn = "fa-toggle-on"
    cacheToggle NT.CacheOff = "fa-toggle-off"
105

106 107
    cacheText NT.CacheOn = "Cache On"
    cacheText NT.CacheOff = "Cache Off"
108

109 110
    cacheClick cacheState _ = do
      T.modify cacheStateToggle cacheState
111 112 113

    cacheStateToggle NT.CacheOn = NT.CacheOff
    cacheStateToggle NT.CacheOff = NT.CacheOn
114

115
table :: R2.Leaf Props
116
table = R2.leafComponent tableCpt
117
tableCpt :: R.Component Props
118
tableCpt = here.component "table" cpt
Nicolas Pouillard's avatar
Nicolas Pouillard committed
119
  where
120 121 122 123 124 125 126 127 128
    cpt { colNames
        , container
        , params
        , rows
        , syncResetButton
        , totalRecords
        , wrapColElts } _ = do
      params' <- T.useLive T.unequal params

129
      let
130
        state = paramsState params'
131
        ps = pageSizes2Int state.pageSize
132 133 134 135
        totalPages = (totalRecords / ps) + min 1 (totalRecords `mod` ps)
        colHeader :: ColumnName -> R.Element
        colHeader c = H.th {scope: "col"} [ H.b {} cs ]
          where
136
            lnk mc = effectLink $ void $ T.modify (_ { orderBy = mc }) params
137 138
            cs :: Array R.Element
            cs =
139
              wrapColElts c $
140
              case state.orderBy of
141 142
                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)]
143
                _ -> [lnk (Just (ASC c)) (columnName c)]
144
      pure $ container
145
        { pageSizeControl: sizeDD { params }
146
        , pageSizeDescription: textDescription state.page state.pageSize totalRecords
147
        , paginationLinks: pagination { params, totalPages }
148
        , syncResetButton
149
        , tableBody: map _.row $ A.fromFoldable rows
150
        , tableHead: H.tr {} (colHeader <$> colNames)
151
        }
Nicolas Pouillard's avatar
Nicolas Pouillard committed
152

153 154 155
makeRow :: Array R.Element -> R.Element
makeRow els = H.tr {} $ (\c -> H.td {} [c]) <$> els

156 157 158 159 160 161

type FilterRowsParams =
  (
    params :: Params
  )

162
filterRows :: forall a. Record FilterRowsParams -> Seq.Seq a -> Seq.Seq a
163
filterRows { params: { limit, offset } } rs = newRs
164
  where
165
    newRs = Seq.take limit $ Seq.drop offset $ rs
166

167 168
defaultContainer :: Record TableContainerProps -> R.Element
defaultContainer props = R.fragment $ props.syncResetButton <> controls
169 170 171 172 173 174
  where
    controls = [ R2.row
                 [ H.div {className: "col-md-4"} [ props.pageSizeDescription ]
                 , H.div {className: "col-md-4"} [ props.paginationLinks ]
                 , H.div {className: "col-md-4"} [ props.pageSizeControl ]
                 ]
175 176
               , R2.row [
                   H.table {className: "col-md-12 table"}
177
                   [ H.thead {className: ""} [ props.tableHead ]
178 179
                   , H.tbody {} props.tableBody
                   ]
180 181
                 ]
               ]
Nicolas Pouillard's avatar
Nicolas Pouillard committed
182

183
-- TODO: this needs to be in Gargantext.Pages.Corpus.Graph.Tabs
184 185
graphContainer :: Record TableContainerProps -> R.Element
graphContainer props =
186 187
  -- TODO title in tabs name (above)
  H.table {className: "table"}
188
  [ H.thead {className: ""} [ props.tableHead ]
189 190
  , H.tbody {} props.tableBody
  ]
191 192 193 194
   -- TODO better rendering of the paginationLinks
   -- , props.pageSizeControl
   -- , props.pageSizeDescription
   -- , props.paginationLinks
195

196 197
type SizeDDProps =
  (
198
    params :: T.Box Params
199 200 201 202
  )

sizeDD :: Record SizeDDProps -> R.Element
sizeDD p = R.createElement sizeDDCpt p []
203
sizeDDCpt :: R.Component SizeDDProps
204
sizeDDCpt = here.component "sizeDD" cpt
205
  where
206 207 208 209
    cpt { params } _ = do
      params' <- T.useLive T.unequal params
      let { pageSize } = paramsState params'

210 211 212 213 214 215
      pure $ H.span {} [
        R2.select { className, defaultValue: show pageSize, on: {change} } sizes
      ]
      where
        className = "form-control"
        change e = do
216
          let ps = string2PageSize $ R.unsafeEventValue e
217
          T.modify (\p -> stateParams $ (paramsState p) { pageSize = ps }) params
218 219 220
        sizes = map option pageSizes
        option size = H.option {value} [H.text value]
          where value = show size
Nicolas Pouillard's avatar
Nicolas Pouillard committed
221

222 223 224
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 ?
225
  where
226 227 228 229 230
    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

231 232 233 234 235 236 237 238 239
changePage :: Page -> T.Box Params -> Effect Unit
changePage page params =
  void $ T.modify (\p -> stateParams $ (paramsState p) { page = page }) params

type PaginationProps =
  ( params     :: T.Box Params
  , totalPages :: Int )

pagination :: R2.Leaf PaginationProps
240
pagination = R2.leafComponent paginationCpt
241 242 243 244 245 246 247 248
paginationCpt :: R.Component PaginationProps
paginationCpt = here.component "pagination" cpt
  where
    cpt { params, totalPages } _ = do
      params' <- T.useLive T.unequal params
      let { page } = paramsState params'
          prev = if page == 1 then
                  H.text " Prev. "
Nicolas Pouillard's avatar
Nicolas Pouillard committed
249
                else
250 251 252
                  changePageLink (page - 1) "Prev."
          next = if page == totalPages then
                  H.text " Next "
Nicolas Pouillard's avatar
Nicolas Pouillard committed
253
                else
254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292
                  changePageLink (page + 1) "Next"
          first = if page == 1 then
                    H.text ""
                  else
                    changePageLink' 1
          last = if page == totalPages then
                  H.text ""
                else
                  changePageLink' totalPages
          ldots = if page >= 5 then
                    H.text " ... "
                    else
                    H.text ""
          rdots = if page + 3 < totalPages then
                    H.text " ... "
                    else
                    H.text ""
          lnums = map changePageLink' $ A.filter (1  < _) [page - 2, page - 1]
          rnums = map changePageLink' $ A.filter (totalPages > _) [page + 1, page + 2]


      pure $ H.span {} $
        [ H.text " ", prev, first, ldots]
        <>
        lnums
        <>
        [H.b {} [H.text $ " " <> show page <> " "]]
        <>
        rnums
        <>
        [ rdots, last, next ]
        where
          changePageLink :: Int -> String -> R.Element
          changePageLink i s =
            H.span {}
              [ H.text " "
              , effectLink (changePage i params) s
              , H.text " "
              ]
293

294 295
          changePageLink' :: Int -> R.Element
          changePageLink' i = changePageLink i (show i)
Nicolas Pouillard's avatar
Nicolas Pouillard committed
296

297
data PageSizes = PS10 | PS20 | PS50 | PS100 | PS200
Nicolas Pouillard's avatar
Nicolas Pouillard committed
298

299
derive instance Eq PageSizes
Nicolas Pouillard's avatar
Nicolas Pouillard committed
300

301
instance Show PageSizes where
Nicolas Pouillard's avatar
Nicolas Pouillard committed
302 303 304 305
  show PS10  = "10"
  show PS20  = "20"
  show PS50  = "50"
  show PS100 = "100"
306
  show PS200 = "200"
Nicolas Pouillard's avatar
Nicolas Pouillard committed
307

308 309 310
int2PageSizes :: Int -> PageSizes
int2PageSizes i = string2PageSize $ show i

Nicolas Pouillard's avatar
Nicolas Pouillard committed
311 312 313 314 315
pageSizes2Int :: PageSizes -> Int
pageSizes2Int PS10  = 10
pageSizes2Int PS20  = 20
pageSizes2Int PS50  = 50
pageSizes2Int PS100 = 100
316
pageSizes2Int PS200 = 200
Nicolas Pouillard's avatar
Nicolas Pouillard committed
317

318 319
pageSizes :: Array PageSizes
pageSizes = [PS10, PS20, PS50, PS100, PS200]
Nicolas Pouillard's avatar
Nicolas Pouillard committed
320 321 322 323 324 325

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