FacetsTable.purs 15.8 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
import Gargantext.Components.Search (Contact(..), Document(..), HyperdataRowContact(..), HyperdataRowDocument(..), SearchQuery, SearchResult(..), SearchResultTypes(..))
25
import Gargantext.Components.Table as T
26
import Gargantext.Components.Table.Types as T
27
import Gargantext.Config.REST (RESTError(..), AffRESTError)
28
import Gargantext.Ends (url, Frontends)
29
import Gargantext.Hooks.Loader (useLoader)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
30
import Gargantext.Routes (SessionRoute(Search, NodeAPI))
31
import Gargantext.Routes as Routes
32
import Gargantext.Sessions (Session, sessionId, post, deleteWithBody)
33
import Gargantext.Types (NodeType(..), OrderBy(..), NodeID)
34
import Gargantext.Utils (toggleSet, zeroPad)
35
import Gargantext.Utils.Reactix as R2
36 37 38 39
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
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
derive instance Generic Pair _
70 71
instance Eq Pair where eq = genericEq
instance Show Pair where show = genericShow
72

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

90
derive instance Generic DocumentsView _
91 92
instance Eq DocumentsView where eq = genericEq
instance Show DocumentsView where show = genericShow
93

94 95 96 97 98 99 100 101 102
----------------------------------------------------------------------
newtype ContactsView =
  ContactsView
  { id         :: Int
  , hyperdata  :: HyperdataRowContact
  , score      :: Int
  , annuaireId :: Int
  , delete     :: Boolean
  }
103
derive instance Generic ContactsView _
104 105
instance Eq ContactsView where eq = genericEq
instance Show ContactsView where show = genericShow
106 107 108 109

----------------------------------------------------------------------
data Rows = Docs     { docs     :: Seq DocumentsView }
          | Contacts { contacts :: Seq ContactsView  }
110
derive instance Generic Rows _
111
instance Eq Rows where eq = genericEq
112 113 114

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

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

      R.useEffect' $ do
        let ipp = initialPagePath {nodeId, listId, query, session}
128
        if path' == ipp then
129 130
          pure unit
        else
131
          void $ T.write ipp path
132

arturo's avatar
arturo committed
133
      pure $ H.div { className: "facets-doc-view" }
134
        [ R2.row
135
          [ chart
136
          , H.div { className: "col-md-12" }
137 138
            [ pageLayout { container, deletions, frontends, path, session, totalRecords } [] ]
    {-     , H.div { className: "col-md-12" }
139
            [ H.button { style: buttonStyle, on: { click: trashClick deletions } }
140
              [ H.i { className: "glyphitem fa fa-trash"
141
                    , style: { marginRight : "9px" }} []
arturo's avatar
arturo committed
142 143 144
            , H.text "Delete document!" ]
            ]
    -}      ]
145 146 147 148
        ]

performDeletions :: Session -> Int -> T.Box Deletions -> Deletions -> Effect Unit
performDeletions session nodeId deletions deletions' = do
149 150 151
  launchAff_ $ do
    _ <- deleteDocuments session nodeId (DeleteDocumentQuery q)
    pure unit
152
  T.modify_ del deletions
153
  where
154 155
    q = { documents: Set.toUnfoldable deletions'.pending }
    del { deleted, pending } = { deleted: deleted <> pending, pending: mempty }
156

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

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

type PagePath = { nodeId :: Int
                , listId :: Int
203
                , query   :: SearchQuery
204
                , params  :: T.Params
205 206
                , session :: Session
                }
207

208
initialPagePath :: {session :: Session, nodeId :: Int, listId :: Int, query :: SearchQuery} -> PagePath
209
initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, query, params: T.initialParams}
210

211
loadPage :: PagePath -> AffRESTError Rows
212
loadPage { session, nodeId, listId, query, params: {limit, offset, orderBy } } = do
213 214 215 216 217 218 219 220 221 222 223
  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)

224
  --SearchResult {result} <- post session p $ SearchQuery {query: concat query, expected:searchType}
225 226 227
  eSearchResult <- post session p query
  case eSearchResult of
    Left err -> pure $ Left err
228
    Right (SearchResult {result}) -> do
229
      --liftEffect $ here.log2 "[loadPage] result" result
230 231 232 233 234
      -- $ 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
235 236 237 238 239

doc2view :: Document -> DocumentsView
doc2view ( Document { id
                    , created: date
                    , hyperdata:  HyperdataRowDocument { authors
240 241 242 243 244
                                                       , source
                                                       , publication_year
                                                       , publication_month
                                                       , publication_day
                                                       }
245 246
                    , category
                    , score
247
                    , title
248 249 250
                    }
        ) = DocumentsView { id
                          , date
251
                          , title
252
                          , source: showSource source
253 254 255 256 257
                          , score
                          , authors: fromMaybe "Authors" authors
                          , category: decodeCategory category
                          , pairs: []
                          , delete: false
258 259 260
                          , publication_year
                          , publication_month
                          , publication_day
261 262
                          }

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

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

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

301
type PageProps = ( rowsLoaded :: Rows | PageLayoutProps )
302

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

312 313 314 315
      useLoader { errorHandler
                , loader: loadPage
                , path: path'
                , render: \rowsLoaded -> page { container, deletions, frontends, path, rowsLoaded, session, totalRecords } [] }
316
    errorHandler err = do
arturo's avatar
arturo committed
317
      here.warn2 "[pageLayout] RESTError" err
318
      case err of
arturo's avatar
arturo committed
319
        ReadJSONError err' -> here.warn2 "[pageLayout] ReadJSONError" $ show err'
320
        _ -> pure unit
321

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

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

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

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

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

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

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

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

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

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


404
---------------------------------------------------------
405

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

411
deleteDocuments :: Session -> Int -> DeleteDocumentQuery -> AffRESTError (Array Int)
412
deleteDocuments session nodeId =
413
  deleteWithBody session $ NodeAPI Node (Just nodeId) "documents"