FacetsTable.purs 14.7 KB
Newer Older
1
-- TODO: this module should replace DocsTable
2
--      However the fix for favorites in commit 91cb6bd9906e128b3129b1db01ef6ef5ae13f7f8
3
--       has not been ported to this module yet.
4 5
module Gargantext.Components.FacetsTable where

6
------------------------------------------------------------------------
7
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
8
import Data.Array (concat, filter)
9 10
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
11
import Data.Maybe (Maybe(..), fromMaybe)
12
import Data.Sequence (Seq)
13
import Data.Sequence as Seq
14 15
import Data.Set (Set)
import Data.Set as Set
16
import Data.String as String
17
import Data.Tuple (fst, snd)
18
import Data.Tuple.Nested ((/\))
19
import Effect (Effect)
20
import Effect.Aff (Aff, launchAff_)
21 22 23 24
import Prelude
import Reactix as R
import Reactix.DOM.HTML as H

25 26
import Gargantext.Components.Category (CategoryQuery(..), putCategories)
import Gargantext.Components.Category.Types (Category(..), decodeCategory, favCategory)
27 28
import Gargantext.Components.Search
import Gargantext.Components.Table as T
29
import Gargantext.Components.Table.Types as T
30
import Gargantext.Ends (url, Frontends)
31
import Gargantext.Hooks.Loader (useLoader)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
32
import Gargantext.Routes (SessionRoute(Search, NodeAPI))
33
import Gargantext.Routes as Routes
34
import Gargantext.Sessions (Session, sessionId, post, deleteWithBody)
35
import Gargantext.Types (NodeType(..), OrderBy(..), NodePath(..), NodeID)
36
import Gargantext.Utils (toggleSet, zeroPad)
37
import Gargantext.Utils.DecodeMaybe ((.|))
38
import Gargantext.Utils.Reactix as R2
39 40

thisModule = "Gargantext.Components.FacetsTable"
41 42 43
------------------------------------------------------------------------

type Props =
44 45 46 47 48 49 50
  ( chart        :: R.Element
  , container    :: Record T.TableContainerProps -> R.Element
  , frontends    :: Frontends
  , listId       :: Int
  , nodeId       :: Int
  , query        :: SearchQuery
  , session      :: Session
51
  , totalRecords :: Int
52
  )
53

54
-- | Tracks the ids of documents to delete and that have been deleted
55 56 57
type Deletions = { pending :: Set Int
                 , deleted :: Set Int
                 }
58

59 60
initialDeletions :: Deletions
initialDeletions = { pending: mempty, deleted: mempty }
61

62 63 64 65
newtype Pair =
  Pair { id    :: Int
       , label :: String
       }
66 67 68 69 70 71

derive instance genericPair :: Generic Pair _

instance showPair :: Show Pair where
  show = genericShow

72 73 74 75 76 77
newtype DocumentsView =
  DocumentsView
  { id       :: Int
  , date     :: String
  , title    :: String
  , source   :: String
78
  , authors  :: String
79 80 81 82
  , score    :: Int
  , pairs    :: Array Pair
  , delete   :: Boolean
  , category :: Category
83 84 85
  , publication_year :: Int
  , publication_month :: Int
  , publication_day  :: Int
86
  }
87

88 89 90 91
publicationDate :: DocumentsView -> String
publicationDate (DocumentsView {publication_year, publication_month, publication_day}) =
  (zeroPad 2 publication_year) <> "-" <> (zeroPad 2 publication_month) <> "-" <> (zeroPad 2 publication_day)

92 93 94 95 96 97
derive instance genericDocumentsView :: Generic DocumentsView _

instance showDocumentsView :: Show DocumentsView where
  show = genericShow

-- | Main layout of the Documents Tab of a Corpus
98 99 100 101
docView :: Record Props -> R.Element
docView props = R.createElement docViewCpt props []

docViewCpt :: R.Component Props
102
docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt
103
  where
104
    cpt {frontends, session, nodeId, listId, query, totalRecords, chart, container} _ = do
105
      deletions <- R.useState' initialDeletions
106
      path <- R.useState' $ initialPagePath {nodeId, listId, query, session}
107 108 109 110 111 112 113 114

      R.useEffect' $ do
        let ipp = initialPagePath {nodeId, listId, query, session}
        if fst path == ipp then
          pure unit
        else
          snd path $ const ipp

115
      pure $ H.div { className: "facets-doc-view container1" }
116
        [ R2.row
117
          [ chart
118
          , H.div { className: "col-md-12" }
119
            [ pageLayout { deletions, frontends, totalRecords, container, session, path } ]
120
   {-     , H.div { className: "col-md-12" }
121
            [ H.button { style: buttonStyle, on: { click: trashClick deletions } }
122
              [ H.i { className: "glyphitem fa fa-trash"
123
                    , style: { marginRight : "9px" }} []
124 125 126 127
            , H.text "Delete document!" ] 
            ] 
    -}      ] 
       ]
128 129 130 131
        where
          buttonStyle =
            { backgroundColor: "peru", padding: "9px", color: "white"
            , border: "white", float: "right" }
132
          trashClick deletions _ = performDeletions session nodeId deletions
133

134 135
performDeletions :: Session -> Int -> R.State Deletions -> Effect Unit
performDeletions session nodeId (deletions /\ setDeletions) =
136
  launchAff_ call *> setDeletions del
137
  where
138
    q = {documents: Set.toUnfoldable deletions.pending}
139
    call = deleteDocuments session nodeId (DeleteDocumentQuery q)
140 141
    del {pending, deleted} = {pending: mempty, deleted: deleted <> pending}

142 143
markCategory :: Session -> NodeID -> Category -> Array NodeID -> Effect Unit
markCategory session nodeId category nids =
144
  void $ launchAff_ $ putCategories session nodeId (CategoryQuery q)
145 146 147 148 149 150 151 152 153 154 155
  where -- TODO add array of delete rows here
    q = {nodeIds: nids, category: favCategory category}

togglePendingDeletion :: R.State Deletions -> NodeID -> Effect Unit
togglePendingDeletion (_ /\ setDeletions) nid = setDeletions setter
  where setter deletions@{pending} = deletions { pending = toggleSet nid pending }

docViewGraph :: Record Props -> R.Element
docViewGraph props = R.createElement docViewCpt props []

docViewGraphCpt :: R.Component Props
156
docViewGraphCpt = R.hooksComponentWithModule thisModule "docViewGraph" cpt
157
  where
158
    cpt {frontends, session, nodeId, listId, query, totalRecords, chart, container} _ = do
159 160 161
      deletions <- R.useState' initialDeletions
      let buttonStyle = { backgroundColor: "peru", padding : "9px"
                        , color : "white", border : "white", float: "right"}
162 163
      let performClick = \_ -> performDeletions session nodeId deletions
      path <- R.useState' $ initialPagePath { nodeId, listId, query, session }
164 165 166 167 168
      pure $ R.fragment
        [ H.br {}
        , H.p {} [ H.text "" ]
        , H.br {}
        , H.div { className: "container-fluid" }
169
          [ R2.row
170 171
            [ chart
            , H.div { className: "col-md-12" }
172
              [ pageLayout { frontends, totalRecords, deletions, container, session, path }
173
              , H.button { style: buttonStyle, on: { click: performClick } }
174
                [ H.i { className: "glyphitem fa fa-trash"
175
                      , style: { marginRight : "9px" } } []
176 177 178 179 180 181 182 183 184
                , H.text "Delete document!" 
                ]
              ]
            ]
          ]
        ]

type PagePath = { nodeId :: Int
                , listId :: Int
185
                , query   :: SearchQuery
186
                , params  :: T.Params
187 188
                , session :: Session
                }
189

190
initialPagePath :: {session :: Session, nodeId :: Int, listId :: Int, query :: SearchQuery} -> PagePath
191
initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, query, params: T.initialParams}
192

193
loadPage :: PagePath -> Aff (Seq DocumentsView)
194
loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy, searchType}} = do
195 196 197 198 199 200 201 202 203 204 205
  let
    convOrderBy (T.ASC  (T.ColumnName "Date")) = DateAsc
    convOrderBy (T.DESC (T.ColumnName "Date")) = DateDesc
    convOrderBy (T.ASC  (T.ColumnName "Title")) = TitleAsc
    convOrderBy (T.DESC (T.ColumnName "Title")) = TitleDesc
    convOrderBy (T.ASC  (T.ColumnName "Source")) = SourceAsc
    convOrderBy (T.DESC (T.ColumnName "Source")) = SourceDesc
    convOrderBy _ = DateAsc -- TODO

    p = Search { listId, offset, limit, orderBy: convOrderBy <$> orderBy } (Just nodeId)

206
  --SearchResult {result} <- post session p $ SearchQuery {query: concat query, expected:searchType}
207 208
  SearchResult {result} <- post session p query
  -- $ SearchQuery {query: concat query, expected: SearchDoc}
209 210 211 212 213 214 215 216 217
  pure case result of
          SearchResultDoc     {docs}     -> doc2view <$> Seq.fromFoldable docs
          SearchResultContact {contacts} -> contact2view <$> Seq.fromFoldable contacts
          errMessage                     -> pure $ err2view errMessage

doc2view :: Document -> DocumentsView
doc2view ( Document { id
                    , created: date
                    , hyperdata:  HyperdataRowDocument { authors
218 219 220 221 222 223
                                                       , title
                                                       , source
                                                       , publication_year
                                                       , publication_month
                                                       , publication_day
                                                       }
224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244
                    , category
                    , score
                    }
        ) = DocumentsView { id
                          , date
                          , title: fromMaybe "Title" title
                          , source: fromMaybe "Source" source
                          , score
                          , authors: fromMaybe "Authors" authors
                          , category: decodeCategory category
                          , pairs: []
                          , delete: false
                          , publication_year : fromMaybe 2020 publication_year
                          , publication_month: fromMaybe    1 publication_month
                          , publication_day  : fromMaybe    1 publication_day
                          }

contact2view :: Contact -> DocumentsView
contact2view (Contact { c_id
                      , c_created: date
                      , c_hyperdata: HyperdataRowContact { firstname
245 246 247
                                                         , lastname
                                                         , labs
                                                         }
248 249 250
                      , c_score
                      }
        ) = DocumentsView { id: c_id
251 252
                          , date: ""
                          , title : firstname <> " " <> lastname
253 254 255 256 257 258 259 260 261 262
                          , source: labs
                          , score: c_score
                          , authors: labs
                          , category: decodeCategory 1
                          , pairs: []
                          , delete: false
                          , publication_year: 2020
                          , publication_month: 10
                          , publication_day: 1
                          }
263

264
err2view message =
265
  DocumentsView { id: 1
266
                , date: ""
267
                , title : "SearchNoResult"
268
                , source: ""
269
                , score: 1
270
                , authors: ""
271 272 273 274 275 276 277
                , category: decodeCategory 1
                , pairs: []
                , delete: false
                , publication_year: 2020
                , publication_month: 10
                , publication_day: 1
                }
278

279 280


281

282
type PageLayoutProps =
283
  ( frontends    :: Frontends
284
  , totalRecords :: Int
285 286 287 288
  , deletions    :: R.State Deletions
  , container    :: Record T.TableContainerProps -> R.Element
  , session      :: Session
  , path         :: R.State PagePath
289 290
  )

291
type PageProps = ( documents :: Seq DocumentsView | PageLayoutProps )
292

293 294 295 296 297
-- | Loads and renders a page
pageLayout :: Record PageLayoutProps -> R.Element
pageLayout props = R.createElement pageLayoutCpt props []

pageLayoutCpt :: R.Component PageLayoutProps
298
pageLayoutCpt = R.hooksComponentWithModule thisModule "pageLayout" cpt
299
  where
300
    cpt {frontends, totalRecords, deletions, container, session, path} _ = do
301
      useLoader (fst path) loadPage $ \documents ->
302
        page {frontends, totalRecords, deletions, container, session, path, documents}
303 304 305 306 307

page :: Record PageProps -> R.Element
page props = R.createElement pageCpt props []

pageCpt :: R.Component PageProps
308
pageCpt = R.hooksComponentWithModule thisModule "page" cpt
309
  where
310
    cpt {frontends, totalRecords, container, deletions, documents, session, path: path@({nodeId, listId, query} /\ setPath)} _ = do
311 312 313 314
      pure $ T.table { syncResetButton : [ H.div {} [] ]
                     , rows, container, colNames
                     , totalRecords, params, wrapColElts
                     }
315
      where
316 317
        setParams f = setPath $ \p@{params: ps} -> p {params = f ps}
        params = (fst path).params /\ setParams
318 319
        -- colNames = T.ColumnName <$> [ "", "Date", "Title", "Source", "Authors", "Delete" ]
        colNames = T.ColumnName <$> [ "", "Search", "Result", "", "", "" ]
320
        wrapColElts = const identity
321
        -- TODO: how to interprete other scores?
322 323
        gi Favorite = "fa fa-star-empty"
        gi _ = "fa fa-star"
324 325 326 327
        isChecked id = Set.member id (fst deletions).pending
        isDeleted (DocumentsView {id}) = Set.member id (fst deletions).deleted
        pairUrl (Pair {id,label})
          | id > 1 = H.a { href, target: "blank" } [ H.text label ]
James Laver's avatar
James Laver committed
328
            where href = url session $ NodePath (sessionId session) NodeContact (Just id)
329
          | otherwise = H.text label
330 331
        documentUrl id =
            url frontends $ Routes.CorpusDocument (sessionId session) nodeId listId id
332
        comma = H.span {} [ H.text ", " ]
333
        rows = row <$> Seq.filter (not <<< isDeleted) documents
334
        row dv@(DocumentsView {id, score, title, source, authors, pairs, delete, category}) =
335
          { row:
336 337
            T.makeRow [
              H.div {} [ H.a { className: gi category, on: {click: markClick} } [] ]
338
              -- TODO show date: Year-Month-Day only
339
              -- , maybeStricken delete [ H.text $ publicationDate dv ]
340 341
              , maybeStricken delete [ H.a {target: "_blank", href: documentUrl id} [ H.text title ] ]
              , maybeStricken delete [ H.text source ]
342
              -- , maybeStricken delete [ H.text authors ]
343
                -- , maybeStricken $ intercalate [comma] (pairUrl <$> pairs)
344
              {-, H.input { defaultChecked: isChecked id
345 346 347
                        , on: { click: toggleClick }
                        , type: "checkbox"
                        }
348
              -}
349
              ]
350
          , delete: true }
351
          where
Alexandre Delanoë's avatar
Alexandre Delanoë committed
352
            markClick   _ = markCategory session nodeId category [id]
353 354 355 356
            toggleClick _ = togglePendingDeletion deletions id
        maybeStricken delete
          | delete = H.div { style: { textDecoration: "line-through" } }
          | otherwise = H.div {}
357

358
---------------------------------------------------------
359

360
newtype DeleteDocumentQuery = DeleteDocumentQuery { documents :: Array Int }
361 362

instance encodeJsonDDQuery :: EncodeJson DeleteDocumentQuery where
363 364
  encodeJson (DeleteDocumentQuery {documents}) =
    "documents" := documents ~> jsonEmptyObject
365

366 367
deleteDocuments :: Session -> Int -> DeleteDocumentQuery -> Aff (Array Int)
deleteDocuments session nodeId =
368
  deleteWithBody session $ NodeAPI Node (Just nodeId) "documents"
369