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

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

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

51 52
initialDeletions :: Deletions
initialDeletions = { pending: mempty, deleted: mempty }
53

54 55 56 57
newtype Pair =
  Pair { id    :: Int
       , label :: String
       }
58 59 60 61 62 63

derive instance genericPair :: Generic Pair _

instance showPair :: Show Pair where
  show = genericShow

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

80 81 82 83
publicationDate :: DocumentsView -> String
publicationDate (DocumentsView {publication_year, publication_month, publication_day}) =
  (zeroPad 2 publication_year) <> "-" <> (zeroPad 2 publication_month) <> "-" <> (zeroPad 2 publication_day)

84 85 86 87 88 89
derive instance genericDocumentsView :: Generic DocumentsView _

instance showDocumentsView :: Show DocumentsView where
  show = genericShow

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

docViewCpt :: R.Component Props
docViewCpt = R.hooksComponent "G.C.FacetsTable.DocView" cpt
95
  where
96
    cpt {frontends, session, nodeId, listId, query, totalRecords, chart, container} _ = do
97
      deletions <- R.useState' initialDeletions
98
      path <- R.useState' $ initialPagePath {nodeId, listId, query, session}
99 100 101 102 103 104 105 106

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

107
      pure $ H.div { className: "container1" }
108
        [ R2.row
109
          [ chart
110
          , H.div { className: "col-md-12" }
111
            [ pageLayout { deletions, frontends, totalRecords, container, session, path } ]
112 113 114 115 116 117 118 119 120
          , 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" }
121
          trashClick deletions _ = performDeletions session nodeId deletions
122

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

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

type PagePath = { nodeId :: Int
                , listId :: Int
174
                , query   :: SearchQuery
175
                , params  :: T.Params
176 177
                , session :: Session
                }
178

179
initialPagePath :: {session :: Session, nodeId :: Int, listId :: Int, query :: SearchQuery} -> PagePath
180
initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, query, params: T.initialParams}
181 182

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

195
  --SearchResult {result} <- post session p $ SearchQuery {query: concat query, expected:searchType}
196 197
  SearchResult {result} <- post session p query
  -- $ SearchQuery {query: concat query, expected: SearchDoc}
198 199 200 201 202 203 204
  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
205 206
  where
    toView :: Document -> DocumentsView
207
    toView ( Document { id
208
                     , created: date
209
                     , hyperdata:  HyperdataRowDocument { authors
210 211 212 213 214 215
                                                    , title
                                                    , source
                                                    , publication_year
                                                    , publication_month
                                                    , publication_day
                                                    }
216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231
                     , 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
                              }
232
contacts2view contacts = map toView contacts
233 234
  where
    toView :: Contact -> DocumentsView
235 236 237 238 239
    toView (Contact { c_id
                     , c_created: date
                     , c_hyperdata: HyperdataRowContact { firstname
                                                   , lastname
                                                   , labs
240
                                                   }
241
                     , c_score
242
                     }
243
            ) = DocumentsView { id: c_id
244
                              , date
245 246 247 248
                              , title : firstname <> lastname
                              , source: labs
                              , score: c_score
                              , authors: labs
249 250 251 252 253 254 255 256
                              , category: decodeCategory 1
                              , pairs: []
                              , delete: false
                              , publication_year: 2020
                              , publication_month: 10
                              , publication_day: 1
                              }

257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272
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
                 }
   ]

273 274


275

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

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

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

pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = R.hooksComponent "G.C.FacetsTable.PageLayout" cpt
  where
294
    cpt {frontends, totalRecords, deletions, container, session, path} _ = do
295
      useLoader (fst path) loadPage $ \documents ->
296
        page {frontends, totalRecords, deletions, container, session, path, documents}
297 298 299 300 301

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

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

344
---------------------------------------------------------
345

346
newtype DeleteDocumentQuery = DeleteDocumentQuery { documents :: Array Int }
347 348

instance encodeJsonDDQuery :: EncodeJson DeleteDocumentQuery where
349 350
  encodeJson (DeleteDocumentQuery {documents}) =
    "documents" := documents ~> jsonEmptyObject
351

352 353
deleteDocuments :: Session -> Int -> DeleteDocumentQuery -> Aff (Array Int)
deleteDocuments session nodeId =
354
  deleteWithBody session $ NodeAPI Node (Just nodeId) "documents"
355