FacetsTable.purs 14.6 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 121 122 123 124 125 126 127 128
          , 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" }
129
          trashClick deletions _ = performDeletions session nodeId deletions
130

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

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

type PagePath = { nodeId :: Int
                , listId :: Int
182
                , query   :: SearchQuery
183
                , params  :: T.Params
184 185
                , session :: Session
                }
186

187
initialPagePath :: {session :: Session, nodeId :: Int, listId :: Int, query :: SearchQuery} -> PagePath
188
initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, query, params: T.initialParams}
189

190
loadPage :: PagePath -> Aff (Seq DocumentsView)
191
loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy, searchType}} = do
192 193 194 195 196 197 198 199 200 201 202
  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)

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

261
err2view message =
262 263 264 265 266 267 268 269 270 271 272 273 274
  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
                }
275

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

353
---------------------------------------------------------
354

355
newtype DeleteDocumentQuery = DeleteDocumentQuery { documents :: Array Int }
356 357

instance encodeJsonDDQuery :: EncodeJson DeleteDocumentQuery where
358 359
  encodeJson (DeleteDocumentQuery {documents}) =
    "documents" := documents ~> jsonEmptyObject
360

361 362
deleteDocuments :: Session -> Int -> DeleteDocumentQuery -> Aff (Array Int)
deleteDocuments session nodeId =
363
  deleteWithBody session $ NodeAPI Node (Just nodeId) "documents"
364