FacetsTable.purs 14.4 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.List as L
12
import Data.Maybe (Maybe(..), fromMaybe)
13
import Data.Set (Set)
14
import Data.String as String
15
import Data.Set as Set
16
import Data.Tuple (fst, snd)
17
import Data.Tuple.Nested ((/\))
18
import Effect (Effect)
19
import Effect.Aff (Aff, launchAff_)
20 21 22 23
import Prelude
import Reactix as R
import Reactix.DOM.HTML as H

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

thisModule = "Gargantext.Components.FacetsTable"
38 39 40
------------------------------------------------------------------------

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

51 52
-- | Tracks the ids of documents to delete and that have been deleted
type Deletions = { pending :: Set Int, deleted :: Set Int }
53

54 55
initialDeletions :: Deletions
initialDeletions = { pending: mempty, deleted: mempty }
56

57 58 59 60
newtype Pair =
  Pair { id    :: Int
       , label :: String
       }
61 62 63 64 65 66

derive instance genericPair :: Generic Pair _

instance showPair :: Show Pair where
  show = genericShow

67 68 69 70 71 72
newtype DocumentsView =
  DocumentsView
  { id       :: Int
  , date     :: String
  , title    :: String
  , source   :: String
73
  , authors  :: String
74 75 76 77
  , score    :: Int
  , pairs    :: Array Pair
  , delete   :: Boolean
  , category :: Category
78 79 80
  , publication_year :: Int
  , publication_month :: Int
  , publication_day  :: Int
81
  }
82

83 84 85 86
publicationDate :: DocumentsView -> String
publicationDate (DocumentsView {publication_year, publication_month, publication_day}) =
  (zeroPad 2 publication_year) <> "-" <> (zeroPad 2 publication_month) <> "-" <> (zeroPad 2 publication_day)

87 88 89 90 91 92
derive instance genericDocumentsView :: Generic DocumentsView _

instance showDocumentsView :: Show DocumentsView where
  show = genericShow

-- | Main layout of the Documents Tab of a Corpus
93 94 95 96
docView :: Record Props -> R.Element
docView props = R.createElement docViewCpt props []

docViewCpt :: R.Component Props
97
docViewCpt = R2.hooksComponent thisModule "docView" cpt
98
  where
99
    cpt {frontends, session, nodeId, listId, query, totalRecords, chart, container} _ = do
100
      deletions <- R.useState' initialDeletions
101
      path <- R.useState' $ initialPagePath {nodeId, listId, query, session}
102 103 104 105 106 107 108 109

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

110
      pure $ H.div { className: "container1" }
111
        [ R2.row
112
          [ chart
113
          , H.div { className: "col-md-12" }
114
            [ pageLayout { deletions, frontends, totalRecords, container, session, path } ]
115 116 117 118 119 120 121 122 123
          , H.div { className: "col-md-12" }
            [ H.button { style: buttonStyle, on: { click: trashClick deletions } }
              [ H.i { className: "glyphitem glyphicon glyphicon-trash"
                    , style: { marginRight : "9px" }} []
              , H.text "Delete document!" ] ] ] ]
        where
          buttonStyle =
            { backgroundColor: "peru", padding: "9px", color: "white"
            , border: "white", float: "right" }
124
          trashClick deletions _ = performDeletions session nodeId deletions
125

126 127
performDeletions :: Session -> Int -> R.State Deletions -> Effect Unit
performDeletions session nodeId (deletions /\ setDeletions) =
128
  launchAff_ call *> setDeletions del
129
  where
130
    q = {documents: Set.toUnfoldable deletions.pending}
131
    call = deleteDocuments session nodeId (DeleteDocumentQuery q)
132 133
    del {pending, deleted} = {pending: mempty, deleted: deleted <> pending}

134 135
markCategory :: Session -> NodeID -> Category -> Array NodeID -> Effect Unit
markCategory session nodeId category nids =
136
  void $ launchAff_ $ putCategories session nodeId (CategoryQuery q)
137 138 139 140 141 142 143 144 145 146 147
  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
148
docViewGraphCpt = R2.hooksComponent thisModule "docViewGraph" cpt
149
  where
150
    cpt {frontends, session, nodeId, listId, query, totalRecords, chart, container} _ = do
151 152 153
      deletions <- R.useState' initialDeletions
      let buttonStyle = { backgroundColor: "peru", padding : "9px"
                        , color : "white", border : "white", float: "right"}
154 155
      let performClick = \_ -> performDeletions session nodeId deletions
      path <- R.useState' $ initialPagePath { nodeId, listId, query, session }
156 157 158 159 160
      pure $ R.fragment
        [ H.br {}
        , H.p {} [ H.text "" ]
        , H.br {}
        , H.div { className: "container-fluid" }
161
          [ R2.row
162 163
            [ chart
            , H.div { className: "col-md-12" }
164
              [ pageLayout { frontends, totalRecords, deletions, container, session, path }
165 166 167
              , H.button { style: buttonStyle, on: { click: performClick } }
                [ H.i { className: "glyphitem glyphicon glyphicon-trash"
                      , style: { marginRight : "9px" } } []
168 169 170 171 172 173 174 175 176
                , H.text "Delete document!" 
                ]
              ]
            ]
          ]
        ]

type PagePath = { nodeId :: Int
                , listId :: Int
177
                , query   :: SearchQuery
178
                , params  :: T.Params
179 180
                , session :: Session
                }
181

182
initialPagePath :: {session :: Session, nodeId :: Int, listId :: Int, query :: SearchQuery} -> PagePath
183
initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, query, params: T.initialParams}
184 185

loadPage :: PagePath -> Aff (Array DocumentsView)
186
loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy, searchType}} = do
187 188 189 190 191 192 193 194 195 196 197
  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)

198
  --SearchResult {result} <- post session p $ SearchQuery {query: concat query, expected:searchType}
199 200
  SearchResult {result} <- post session p query
  -- $ SearchQuery {query: concat query, expected: SearchDoc}
201 202 203 204 205 206 207
  pure $ case result of
              SearchResultDoc     {docs}     -> docs2view docs
              SearchResultContact {contacts} -> contacts2view contacts
              errMessage                     -> err2view errMessage

docs2view :: Array Document -> Array DocumentsView
docs2view docs = map toView docs
208 209
  where
    toView :: Document -> DocumentsView
210
    toView ( Document { id
211
                     , created: date
212
                     , hyperdata:  HyperdataRowDocument { authors
213 214 215 216 217 218
                                                    , title
                                                    , source
                                                    , publication_year
                                                    , publication_month
                                                    , publication_day
                                                    }
219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234
                     , 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
                              }
235
contacts2view contacts = map toView contacts
236 237
  where
    toView :: Contact -> DocumentsView
238 239 240 241 242
    toView (Contact { c_id
                     , c_created: date
                     , c_hyperdata: HyperdataRowContact { firstname
                                                   , lastname
                                                   , labs
243
                                                   }
244
                     , c_score
245
                     }
246
            ) = DocumentsView { id: c_id
247
                              , date
248 249 250 251
                              , title : firstname <> lastname
                              , source: labs
                              , score: c_score
                              , authors: labs
252 253 254 255 256 257 258 259
                              , category: decodeCategory 1
                              , pairs: []
                              , delete: false
                              , publication_year: 2020
                              , publication_month: 10
                              , publication_day: 1
                              }

260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275
err2view message =
  [DocumentsView { id: 1
                 , date: "2020-01-01"
                 , title : "SearchNoResult"
                 , source: "Source"
                 , score: 1
                 , authors: "Authors"
                 , category: decodeCategory 1
                 , pairs: []
                 , delete: false
                 , publication_year: 2020
                 , publication_month: 10
                 , publication_day: 1
                 }
   ]

276 277


278

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

type PageProps = ( documents :: Array DocumentsView | PageLayoutProps )
289

290 291 292 293 294
-- | Loads and renders a page
pageLayout :: Record PageLayoutProps -> R.Element
pageLayout props = R.createElement pageLayoutCpt props []

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

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

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

347
---------------------------------------------------------
348

349
newtype DeleteDocumentQuery = DeleteDocumentQuery { documents :: Array Int }
350 351

instance encodeJsonDDQuery :: EncodeJson DeleteDocumentQuery where
352 353
  encodeJson (DeleteDocumentQuery {documents}) =
    "documents" := documents ~> jsonEmptyObject
354

355 356
deleteDocuments :: Session -> Int -> DeleteDocumentQuery -> Aff (Array Int)
deleteDocuments session nodeId =
357
  deleteWithBody session $ NodeAPI Node (Just nodeId) "documents"
358