FacetsTable.purs 17.3 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 (launchAff_)
21 22
import Gargantext.Components.Category (CategoryQuery(..), putCategories)
import Gargantext.Components.Category.Types (Category(..), decodeCategory, favCategory)
23
import Gargantext.Components.DocsTable.Types (showSource)
24 25
import Gargantext.Components.GraphQL.Context as GQLCTX
import Gargantext.Components.GraphQL.Endpoints as GQLE
26
import Gargantext.Components.Search (Contact(..), Document(..), HyperdataRowContact(..), HyperdataRowDocument(..), SearchQuery, SearchResult(..), SearchResultTypes(..))
27
import Gargantext.Components.Table as T
28
import Gargantext.Components.Table.Types as T
29
import Gargantext.Config.REST (RESTError(..), AffRESTError)
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(..), NodeID)
36
import Gargantext.Utils (toggleSet, zeroPad)
37
import Gargantext.Utils.Reactix as R2
38 39 40 41
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
42

43
here :: R2.Here
44
here = R2.here "Gargantext.Components.FacetsTable"
45 46

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

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

62 63
initialDeletions :: Deletions
initialDeletions = { pending: mempty, deleted: mempty }
64

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

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

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 :: Maybe Int
  , publication_month :: Maybe Int
  , publication_day  :: Maybe Int
90
  }
91

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

96 97 98 99 100 101 102 103 104 105 106 107 108 109 110
gqlContextToDocumentsView :: GQLCTX.Context -> DocumentsView
gqlContextToDocumentsView ctx@{ c_hyperdata: h } =
  DocumentsView { id: ctx.c_id
                , date: ctx.c_date
                , title: ctx.c_name
                , source: showSource (_.hrd_source <$> h)
                , score: fromMaybe 0 ctx.c_score
                , authors: fromMaybe "Authors" (_.hrd_authors <$> h)
                , category: decodeCategory $ fromMaybe 0 ctx.c_category
                , pairs: []
                , delete: false
                , publication_year: _.hrd_publication_year <$> h
                , publication_month: _.hrd_publication_month <$> h
                , publication_day: _.hrd_publication_day <$> h }

111 112 113 114 115 116 117 118 119
----------------------------------------------------------------------
newtype ContactsView =
  ContactsView
  { id         :: Int
  , hyperdata  :: HyperdataRowContact
  , score      :: Int
  , annuaireId :: Int
  , delete     :: Boolean
  }
120
derive instance Generic ContactsView _
121 122
instance Eq ContactsView where eq = genericEq
instance Show ContactsView where show = genericShow
123 124 125 126

----------------------------------------------------------------------
data Rows = Docs     { docs     :: Seq DocumentsView }
          | Contacts { contacts :: Seq ContactsView  }
127
derive instance Generic Rows _
128
instance Eq Rows where eq = genericEq
129 130 131

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

132
-- | Main layout of the Documents Tab of a Corpus
133 134 135
docView :: Record Props -> R.Element
docView props = R.createElement docViewCpt props []
docViewCpt :: R.Component Props
136
docViewCpt = here.component "docView" cpt
137
  where
138
    cpt {frontends, session, nodeId, listId, query, totalRecords, chart, container} _ = do
139
      deletions <- T.useBox initialDeletions
140 141
      path <- T.useBox $ initialPagePath {nodeId, listId, query, session}
      path' <- T.useLive T.unequal path
142 143 144

      R.useEffect' $ do
        let ipp = initialPagePath {nodeId, listId, query, session}
145
        if path' == ipp then
146 147
          pure unit
        else
148
          void $ T.write ipp path
149

arturo's avatar
arturo committed
150
      pure $ H.div { className: "facets-doc-view" }
151
        [ R2.row
152
          [ chart
153
          , H.div { className: "col-md-12" }
154 155
            [ pageLayout { container, deletions, frontends, path, session, totalRecords } [] ]
    {-     , H.div { className: "col-md-12" }
156
            [ H.button { style: buttonStyle, on: { click: trashClick deletions } }
157
              [ H.i { className: "glyphitem fa fa-trash"
158
                    , style: { marginRight : "9px" }} []
arturo's avatar
arturo committed
159 160 161
            , H.text "Delete document!" ]
            ]
    -}      ]
162 163 164 165
        ]

performDeletions :: Session -> Int -> T.Box Deletions -> Deletions -> Effect Unit
performDeletions session nodeId deletions deletions' = do
166 167 168
  launchAff_ $ do
    _ <- deleteDocuments session nodeId (DeleteDocumentQuery q)
    pure unit
169
  T.modify_ del deletions
170
  where
171 172
    q = { documents: Set.toUnfoldable deletions'.pending }
    del { deleted, pending } = { deleted: deleted <> pending, pending: mempty }
173

174 175
markCategory :: Session -> NodeID -> Category -> Array NodeID -> Effect Unit
markCategory session nodeId category nids =
176 177 178
  void $ launchAff_ $ do
    _ <- putCategories session nodeId (CategoryQuery q)
    pure unit
179 180 181 182 183 184 185 186 187 188
  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
189
docViewGraphCpt = here.component "docViewGraph" cpt
190
  where
191
    cpt {frontends, session, nodeId, listId, query, totalRecords, chart, container} _ = do
192 193
      deletions <- T.useBox initialDeletions
      deletions' <- T.useLive T.unequal deletions
194 195
      let buttonStyle = { backgroundColor: "peru", padding : "9px"
                        , color : "white", border : "white", float: "right"}
196
      let performClick = \_ -> performDeletions session nodeId deletions deletions'
197 198
      path <- T.useBox $ initialPagePath { nodeId, listId, query, session }

199 200
      pure $ R.fragment
        [ H.br {}
201
        , H.p  {} [ H.text "" ]
202 203
        , H.br {}
        , H.div { className: "container-fluid" }
204
          [ R2.row
205 206
            [ chart
            , H.div { className: "col-md-12" }
207
              [ pageLayout { container, deletions, frontends, path, session, totalRecords } []
208
              , H.button { style: buttonStyle, on: { click: performClick } }
209
                [ H.i { className: "glyphitem fa fa-trash"
210
                      , style: { marginRight : "9px" } } []
arturo's avatar
arturo committed
211
                , H.text "Delete document!"
212 213 214 215 216 217 218 219
                ]
              ]
            ]
          ]
        ]

type PagePath = { nodeId :: Int
                , listId :: Int
220
                , query   :: SearchQuery
221
                , params  :: T.Params
222 223
                , session :: Session
                }
224

225
initialPagePath :: {session :: Session, nodeId :: Int, listId :: Int, query :: SearchQuery} -> PagePath
226
initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, query, params: T.initialParams}
227

228
loadPage :: PagePath -> AffRESTError Rows
229
loadPage { session, nodeId, listId, query, params: {limit, offset, orderBy } } = do
230 231 232 233 234 235 236 237 238 239
  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)

240
  --SearchResult {result} <- post session p $ SearchQuery {query: concat query, expected:searchType}
241 242 243
  eSearchResult <- post session p query
  case eSearchResult of
    Left err -> pure $ Left err
244
    Right (SearchResult {result}) -> do
245
      --liftEffect $ here.log2 "[loadPage] result" result
246 247 248 249 250
      -- $ 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
251

252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273
type PageGQLParams =
   ( corpusId    :: Int
   , params      :: T.Params
   , ngramsTerms :: Array String
   , session     :: Session )

initialPageGQL :: { corpusId :: Int, ngramsTerms :: Array String, session :: Session }
               -> Record PageGQLParams
initialPageGQL { corpusId, ngramsTerms, session } =
  { corpusId, ngramsTerms, params: T.initialParams, session }


loadPageGQL :: Record PageGQLParams -> AffRESTError Rows
loadPageGQL { corpusId
            , params: { limit, offset, orderBy }
            , ngramsTerms
            , session } = do

  eResult <- GQLE.getContextsForNgrams session corpusId ngramsTerms

  pure $ (\res -> Docs { docs: gqlContextToDocumentsView <$> Seq.fromFoldable res }) <$> eResult

274 275 276 277
doc2view :: Document -> DocumentsView
doc2view ( Document { id
                    , created: date
                    , hyperdata:  HyperdataRowDocument { authors
278 279 280 281 282
                                                       , source
                                                       , publication_year
                                                       , publication_month
                                                       , publication_day
                                                       }
283 284
                    , category
                    , score
285
                    , title
286 287 288
                    }
        ) = DocumentsView { id
                          , date
289
                          , title
290
                          , source: showSource source
291 292 293 294 295
                          , score
                          , authors: fromMaybe "Authors" authors
                          , category: decodeCategory category
                          , pairs: []
                          , delete: false
296 297 298
                          , publication_year
                          , publication_month
                          , publication_day
299 300
                          }

301
contact2view :: Contact -> ContactsView
302
contact2view (Contact { c_id
303 304
                      , c_hyperdata
                      , c_annuaireId
305 306
                      , c_score
                      }
307 308 309 310 311 312
        ) = ContactsView { id: c_id
                         , hyperdata: c_hyperdata
                         , score: c_score
                         , annuaireId : c_annuaireId
                         , delete: false
                         }
313

314 315
err2view :: forall a. a -> DocumentsView
err2view _message =
316
  DocumentsView { id: 1
317
                , date: ""
318
                , title : "SearchNoResult"
319
                , source: ""
320
                , score: 1
321
                , authors: ""
322 323 324
                , category: decodeCategory 1
                , pairs: []
                , delete: false
325 326 327
                , publication_year: Just 2020
                , publication_month: Just 10
                , publication_day: Just 1
328
                }
329

330
type PageLayoutProps =
331
  ( frontends    :: Frontends
332
  , totalRecords :: Int
333
  , deletions    :: T.Box Deletions
334 335
  , container    :: Record T.TableContainerProps -> R.Element
  , session      :: Session
336
  , path         :: T.Box PagePath
337 338
  )

339
type PageProps = ( rowsLoaded :: Rows | PageLayoutProps )
340

341
-- | Loads and renders a page
342 343
pageLayout :: R2.Component PageLayoutProps
pageLayout = R.createElement pageLayoutCpt
344
pageLayoutCpt :: R.Component PageLayoutProps
345
pageLayoutCpt = here.component "pageLayout" cpt
346
  where
347
    cpt { container, deletions, frontends, path, session, totalRecords } _ = do
348 349
      path' <- T.useLive T.unequal path

350 351 352 353
      useLoader { errorHandler
                , loader: loadPage
                , path: path'
                , render: \rowsLoaded -> page { container, deletions, frontends, path, rowsLoaded, session, totalRecords } [] }
354
    errorHandler err = do
arturo's avatar
arturo committed
355
      here.warn2 "[pageLayout] RESTError" err
356
      case err of
arturo's avatar
arturo committed
357
        ReadJSONError err' -> here.warn2 "[pageLayout] ReadJSONError" $ show err'
358
        _ -> pure unit
359

360 361
page :: R2.Component PageProps
page = R.createElement pageCpt
362
pageCpt :: R.Component PageProps
363
pageCpt = here.component "page" cpt
364
  where
365
    cpt { container
366
        , deletions
367 368
        , frontends
        , path
369 370
        , rowsLoaded
        , session
371
        , totalRecords } _ = do
372
      path' <- T.useLive T.unequal path
373
      params <- T.useFocused (_.params) (\a b -> b { params = a }) path
374 375
      deletions' <- T.useLive T.unequal deletions

376
      let isDeleted (DocumentsView {id}) = Set.member id deletions'.deleted
377

378
          rows = case rowsLoaded of
379 380
            Docs     {docs}     -> docRow path'     <$> Seq.filter (not <<< isDeleted) docs
            Contacts {contacts} -> contactRow path' <$>  contacts
381 382 383 384

      pure $ T.table { colNames
                     , container
                     , params
385
                     , rows
386 387 388
                     , syncResetButton : [ H.div {} [] ]
                     , totalRecords
                     , wrapColElts
389
                     }
390
      where
391
        colNames = case rowsLoaded of
392 393
          Docs     _ -> T.ColumnName <$> [ "", "Date", "Title", "Journal", "", "" ]
          Contacts _ -> T.ColumnName <$> [ "", "Contact", "Organization", "", "", "" ]
394

395
        wrapColElts = const identity
396
        -- TODO: how to interprete other scores?
397
        gi Trash = "fa fa-star-empty"
398
        gi _ = "fa fa-star"
399

400 401 402 403
        documentUrl id { listId, nodeId } =
            url frontends $ Routes.CorpusDocument (sessionId session) nodeId listId id

        contactRow path' (ContactsView { id, hyperdata: HyperdataRowContact { firstname, lastname, labs }
404
                                       , annuaireId, delete
405
                               }) =
406
          { row:
407
            T.makeRow [ H.div {} [ H.a { className: gi Favorite, on: {click: markClick path'} } [] ]
408
                      , maybeStricken delete [ H.a { target: "_blank", href: contactUrl id }
409 410 411 412 413 414 415
                                                   [ H.text $ firstname <> " " <> lastname ]
                                             ]
                      , maybeStricken delete [ H.text labs ]
                      ]
          , delete: true
          }
          where
416
            markClick { nodeId }  _     = markCategory session nodeId Favorite [id]
417
            contactUrl id' = url frontends $ Routes.ContactPage (sessionId session) annuaireId id'
418

419
        docRow path' dv@(DocumentsView {id, title, source, delete, category}) =
420
          { row:
421
            T.makeRow [ H.div {} [ H.a { className: gi category, on: {click: markClick path'} } [] ]
422
                      , maybeStricken delete [ H.text $ publicationDate dv ]
423
                      , maybeStricken delete [ H.a {target: "_blank", href: documentUrl id path'} [ H.text title ] ]
424 425
                      , maybeStricken delete [ H.text source ]
                      ]
426
          , delete: true }
427
          where
428
            markClick { nodeId } _ = markCategory session nodeId category [id]
429 430
            -- comma = H.span {} [ H.text ", " ]

431
        maybeStricken delete
432
          | delete    = H.div { style: { textDecoration: "line-through" } }
433
          | otherwise = H.div {}
434

435
publicationDate :: DocumentsView -> String
436
publicationDate (DocumentsView { publication_year: Just publication_year, publication_month: Just publication_month }) =
437 438
  (zeroPad 2 publication_year) <> "-" <> (zeroPad 2 publication_month)
  -- <> "-" <> (zeroPad 2 publication_day)
439
publicationDate _ = "-"
440 441


442
---------------------------------------------------------
443

444
newtype DeleteDocumentQuery = DeleteDocumentQuery { documents :: Array Int }
445 446 447
derive instance Generic DeleteDocumentQuery _
derive instance Newtype DeleteDocumentQuery _
derive newtype instance JSON.WriteForeign DeleteDocumentQuery
448

449
deleteDocuments :: Session -> Int -> DeleteDocumentQuery -> AffRESTError (Array Int)
450
deleteDocuments session nodeId =
451
  deleteWithBody session $ NodeAPI Node (Just nodeId) "documents"