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
import Effect.Class (liftEffect)
22 23
import Gargantext.Components.Category (CategoryQuery(..), putCategories)
import Gargantext.Components.Category.Types (Category(..), decodeCategory, favCategory)
24
import Gargantext.Components.DocsTable.Types (showSource)
25
import Gargantext.Components.Search (Contact(..), Document(..), HyperdataRowContact(..), HyperdataRowDocument(..), SearchQuery, SearchResult(..), SearchResultTypes(..))
26
import Gargantext.Components.Table as T
27
import Gargantext.Components.Table.Types as T
28
import Gargantext.Config.REST (RESTError(..), AffRESTError)
29
import Gargantext.Ends (url, Frontends)
30
import Gargantext.Hooks.Loader (useLoader)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
31
import Gargantext.Routes (SessionRoute(Search, NodeAPI))
32
import Gargantext.Routes as Routes
33
import Gargantext.Sessions (Session, sessionId, post, deleteWithBody)
34
import Gargantext.Types (NodeType(..), OrderBy(..), NodeID)
35
import Gargantext.Utils (toggleSet, zeroPad)
36
import Gargantext.Utils.Reactix as R2
37 38 39 40
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
41

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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
152
  where
153 154
    q = { documents: Set.toUnfoldable deletions'.pending }
    del { deleted, pending } = { deleted: deleted <> pending, pending: mempty }
155

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

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

type PagePath = { nodeId :: Int
                , listId :: Int
200
                , query   :: SearchQuery
201
                , params  :: T.Params
202 203
                , session :: Session
                }
204

205
initialPagePath :: {session :: Session, nodeId :: Int, listId :: Int, query :: SearchQuery} -> PagePath
206
initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, query, params: T.initialParams}
207

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

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

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

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

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

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

298
type PageProps = ( rowsLoaded :: Rows | PageLayoutProps )
299

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

309 310 311 312
      useLoader { errorHandler
                , loader: loadPage
                , path: path'
                , render: \rowsLoaded -> page { container, deletions, frontends, path, rowsLoaded, session, totalRecords } [] }
313 314 315 316 317
    errorHandler err = do
      here.log2 "[pageLayout] RESTError" err
      case err of
        ReadJSONError err' -> here.log2 "[pageLayout] ReadJSONError" $ show err'
        _ -> pure unit
318

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

335
      let isDeleted (DocumentsView {id}) = Set.member id deletions'.deleted
336

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

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

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

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

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

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

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

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


401
---------------------------------------------------------
402

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

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