FacetsTable.purs 15.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 8
import Gargantext.Prelude

import Data.Either (Either(..))
9
import Data.Eq.Generic (genericEq)
10
import Data.Generic.Rep (class Generic)
11
import Data.Maybe (Maybe(..), fromMaybe)
12
import Data.Newtype (class Newtype)
13
import Data.Sequence (Seq)
14
import Data.Sequence as Seq
15 16
import Data.Set (Set)
import Data.Set as Set
17
import Data.Show.Generic (genericShow)
18
import Data.Tuple.Nested ((/\))
19
import Effect (Effect)
20
import Effect.Aff (Aff, launchAff_)
21 22
import Reactix as R
import Reactix.DOM.HTML as H
23
import Simple.JSON as JSON
24
import Toestand as T
25

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

41
here :: R2.Here
42
here = R2.here "Gargantext.Components.FacetsTable"
43 44

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

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

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

63
----------------------------------------------------------------------
64 65 66 67
newtype Pair =
  Pair { id    :: Int
       , label :: String
       }
68

69 70
derive instance Generic Pair _
instance Eq Pair where
71
  eq = genericEq
72
instance Show Pair where
73 74
  show = genericShow

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

92 93
derive instance Generic DocumentsView _
instance Eq DocumentsView where
94
  eq = genericEq
95
instance Show DocumentsView where
96 97
  show = genericShow

98 99 100 101 102 103 104 105 106
----------------------------------------------------------------------
newtype ContactsView =
  ContactsView
  { id         :: Int
  , hyperdata  :: HyperdataRowContact
  , score      :: Int
  , annuaireId :: Int
  , delete     :: Boolean
  }
107 108
derive instance Generic ContactsView _
instance Eq ContactsView where
109
  eq = genericEq
110
instance Show ContactsView where
111 112 113 114 115
  show = genericShow

----------------------------------------------------------------------
data Rows = Docs     { docs     :: Seq DocumentsView }
          | Contacts { contacts :: Seq ContactsView  }
116 117
derive instance Generic Rows _
instance Eq Rows where
118
  eq = genericEq
119 120 121

----------------------------------------------------------------------

122
-- | Main layout of the Documents Tab of a Corpus
123 124 125
docView :: Record Props -> R.Element
docView props = R.createElement docViewCpt props []
docViewCpt :: R.Component Props
126
docViewCpt = here.component "docView" cpt
127
  where
128
    cpt {frontends, session, nodeId, listId, query, totalRecords, chart, container} _ = do
129
      deletions <- T.useBox initialDeletions
130 131
      path <- T.useBox $ initialPagePath {nodeId, listId, query, session}
      path' <- T.useLive T.unequal path
132 133 134

      R.useEffect' $ do
        let ipp = initialPagePath {nodeId, listId, query, session}
135
        if path' == ipp then
136 137
          pure unit
        else
138
          void $ T.write ipp path
139

140
      pure $ H.div { className: "facets-doc-view container1" }
141
        [ R2.row
142
          [ chart
143
          , H.div { className: "col-md-12" }
144 145
            [ pageLayout { container, deletions, frontends, path, session, totalRecords } [] ]
    {-     , H.div { className: "col-md-12" }
146
            [ H.button { style: buttonStyle, on: { click: trashClick deletions } }
147
              [ H.i { className: "glyphitem fa fa-trash"
148
                    , style: { marginRight : "9px" }} []
149 150 151
            , H.text "Delete document!" ] 
            ] 
    -}      ] 
152 153 154 155 156 157
        ]

performDeletions :: Session -> Int -> T.Box Deletions -> Deletions -> Effect Unit
performDeletions session nodeId deletions deletions' = do
  launchAff_ $ deleteDocuments session nodeId (DeleteDocumentQuery q)
  T.modify_ del deletions
158
  where
159 160
    q = { documents: Set.toUnfoldable deletions'.pending }
    del { deleted, pending } = { deleted: deleted <> pending, pending: mempty }
161

162 163
markCategory :: Session -> NodeID -> Category -> Array NodeID -> Effect Unit
markCategory session nodeId category nids =
164
  void $ launchAff_ $ putCategories session nodeId (CategoryQuery q)
165 166 167 168 169 170 171 172 173 174
  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
175
docViewGraphCpt = here.component "docViewGraph" cpt
176
  where
177
    cpt {frontends, session, nodeId, listId, query, totalRecords, chart, container} _ = do
178 179
      deletions <- T.useBox initialDeletions
      deletions' <- T.useLive T.unequal deletions
180 181
      let buttonStyle = { backgroundColor: "peru", padding : "9px"
                        , color : "white", border : "white", float: "right"}
182
      let performClick = \_ -> performDeletions session nodeId deletions deletions'
183 184
      path <- T.useBox $ initialPagePath { nodeId, listId, query, session }

185 186
      pure $ R.fragment
        [ H.br {}
187
        , H.p  {} [ H.text "" ]
188 189
        , H.br {}
        , H.div { className: "container-fluid" }
190
          [ R2.row
191 192
            [ chart
            , H.div { className: "col-md-12" }
193
              [ pageLayout { container, deletions, frontends, path, session, totalRecords } []
194
              , H.button { style: buttonStyle, on: { click: performClick } }
195
                [ H.i { className: "glyphitem fa fa-trash"
196
                      , style: { marginRight : "9px" } } []
197 198 199 200 201 202 203 204 205
                , H.text "Delete document!" 
                ]
              ]
            ]
          ]
        ]

type PagePath = { nodeId :: Int
                , listId :: Int
206
                , query   :: SearchQuery
207
                , params  :: T.Params
208 209
                , session :: Session
                }
210

211
initialPagePath :: {session :: Session, nodeId :: Int, listId :: Int, query :: SearchQuery} -> PagePath
212
initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, query, params: T.initialParams}
213

214 215
loadPage :: PagePath -> Aff (Either RESTError Rows)
loadPage { session, nodeId, listId, query, params: {limit, offset, orderBy }} = do
216 217 218 219 220 221 222 223 224 225 226
  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)

227
  --SearchResult {result} <- post session p $ SearchQuery {query: concat query, expected:searchType}
228 229 230 231 232 233 234 235 236
  eSearchResult <- post session p query
  case eSearchResult of
    Left err -> pure $ Left err
    Right (SearchResult {result}) ->
      -- $ SearchQuery {query: concat query, expected: SearchDoc}
      pure $ Right $ case result of
              SearchResultDoc     {docs}     -> Docs     {docs: doc2view     <$> Seq.fromFoldable docs}
              SearchResultContact {contacts} -> Contacts {contacts: contact2view <$> Seq.fromFoldable contacts}
              errMessage                     -> Docs     {docs: Seq.fromFoldable [err2view errMessage]} -- TODO better error view
237 238 239 240 241

doc2view :: Document -> DocumentsView
doc2view ( Document { id
                    , created: date
                    , hyperdata:  HyperdataRowDocument { authors
242 243 244 245 246 247
                                                       , title
                                                       , source
                                                       , publication_year
                                                       , publication_month
                                                       , publication_day
                                                       }
248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264
                    , 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
                          }

265
contact2view :: Contact -> ContactsView
266
contact2view (Contact { c_id
267 268
                      , c_hyperdata
                      , c_annuaireId
269 270
                      , c_score
                      }
271 272 273 274 275 276
        ) = ContactsView { id: c_id
                         , hyperdata: c_hyperdata
                         , score: c_score
                         , annuaireId : c_annuaireId
                         , delete: false
                         }
277

278 279
err2view :: forall a. a -> DocumentsView
err2view _message =
280
  DocumentsView { id: 1
281
                , date: ""
282
                , title : "SearchNoResult"
283
                , source: ""
284
                , score: 1
285
                , authors: ""
286 287 288 289 290 291 292
                , category: decodeCategory 1
                , pairs: []
                , delete: false
                , publication_year: 2020
                , publication_month: 10
                , publication_day: 1
                }
293

294
type PageLayoutProps =
295
  ( frontends    :: Frontends
296
  , totalRecords :: Int
297
  , deletions    :: T.Box Deletions
298 299
  , container    :: Record T.TableContainerProps -> R.Element
  , session      :: Session
300
  , path         :: T.Box PagePath
301 302
  )

303
type PageProps = ( rowsLoaded :: Rows | PageLayoutProps )
304

305
-- | Loads and renders a page
306 307
pageLayout :: R2.Component PageLayoutProps
pageLayout = R.createElement pageLayoutCpt
308
pageLayoutCpt :: R.Component PageLayoutProps
309
pageLayoutCpt = here.component "pageLayout" cpt
310
  where
311
    cpt { container, deletions, frontends, path, session, totalRecords } _ = do
312 313
      path' <- T.useLive T.unequal path

314 315 316 317 318
      useLoader { errorHandler
                , loader: loadPage
                , path: path'
                , render: \rowsLoaded -> page { container, deletions, frontends, path, rowsLoaded, session, totalRecords } [] }
    errorHandler err = here.log2 "[pageLayout] RESTError" err
319

320 321
page :: R2.Component PageProps
page = R.createElement pageCpt
322 323

pageCpt :: R.Component PageProps
324
pageCpt = here.component "page" cpt
325
  where
326
    cpt { container
327
        , deletions
328 329
        , frontends
        , path
330 331
        , rowsLoaded
        , session
332
        , totalRecords } _ = do
333
      path' <- T.useLive T.unequal path
334
      params <- T.useFocused (_.params) (\a b -> b { params = a }) path
335 336
      deletions' <- T.useLive T.unequal deletions

337
      let isDeleted (DocumentsView {id}) = Set.member id deletions'.deleted
338 339 340 341

          rows path' = case rowsLoaded of
            Docs     {docs}     -> docRow path'     <$> Seq.filter (not <<< isDeleted) docs
            Contacts {contacts} -> contactRow path' <$>  contacts
342 343 344 345 346 347 348 349

      pure $ T.table { colNames
                     , container
                     , params
                     , rows: rows path'
                     , syncResetButton : [ H.div {} [] ]
                     , totalRecords
                     , wrapColElts
350
                     }
351
      where
352 353 354 355
        colNames = case rowsLoaded of
            Docs     _ -> T.ColumnName <$> [ "", "Date", "Title", "Journal", "", "" ]
            Contacts _ -> T.ColumnName <$> [ "", "Contact", "Organization", "", "", "" ]

356
        wrapColElts = const identity
357
        -- TODO: how to interprete other scores?
358
        gi Trash = "fa fa-star-empty"
359
        gi _ = "fa fa-star"
360

361 362 363 364
        documentUrl id { listId, nodeId } =
            url frontends $ Routes.CorpusDocument (sessionId session) nodeId listId id

        contactRow path' (ContactsView { id, hyperdata: HyperdataRowContact { firstname, lastname, labs }
365
                                       , annuaireId, delete
366
                               }) =
367
          { row:
368
            T.makeRow [ H.div {} [ H.a { className: gi Favorite, on: {click: markClick path'} } [] ]
369
                      , maybeStricken delete [ H.a { target: "_blank", href: contactUrl id }
370 371 372 373 374 375 376
                                                   [ H.text $ firstname <> " " <> lastname ]
                                             ]
                      , maybeStricken delete [ H.text labs ]
                      ]
          , delete: true
          }
          where
377
            markClick { nodeId }  _     = markCategory session nodeId Favorite [id]
378
            contactUrl id' = url frontends $ Routes.ContactPage (sessionId session) annuaireId id'
379

380
        docRow path' dv@(DocumentsView {id, title, source, delete, category}) =
381
          { row:
382
            T.makeRow [ H.div {} [ H.a { className: gi category, on: {click: markClick path'} } [] ]
383
                      , maybeStricken delete [ H.text $ publicationDate dv ]
384
                      , maybeStricken delete [ H.a {target: "_blank", href: documentUrl id path'} [ H.text title ] ]
385 386
                      , maybeStricken delete [ H.text source ]
                      ]
387
          , delete: true }
388
          where
389
            markClick { nodeId } _ = markCategory session nodeId category [id]
390 391
            -- comma = H.span {} [ H.text ", " ]

392
        maybeStricken delete
393
          | delete    = H.div { style: { textDecoration: "line-through" } }
394
          | otherwise = H.div {}
395

396
publicationDate :: DocumentsView -> String
397
publicationDate (DocumentsView { publication_year, publication_month }) =
398 399 400 401
  (zeroPad 2 publication_year) <> "-" <> (zeroPad 2 publication_month)
  -- <> "-" <> (zeroPad 2 publication_day)


402
---------------------------------------------------------
403

404
newtype DeleteDocumentQuery = DeleteDocumentQuery { documents :: Array Int }
405 406 407
derive instance Generic DeleteDocumentQuery _
derive instance Newtype DeleteDocumentQuery _
derive newtype instance JSON.WriteForeign DeleteDocumentQuery
408

409
deleteDocuments :: Session -> Int -> DeleteDocumentQuery -> Aff (Either RESTError (Array Int))
410
deleteDocuments session nodeId =
411
  deleteWithBody session $ NodeAPI Node (Just nodeId) "documents"
412