FacetsTable.purs 14.5 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.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(..), NodePath(..), NodeID)
35
import Gargantext.Utils (toggleSet, zeroPad)
36
import Gargantext.Utils.DecodeMaybe ((.|))
37
import Gargantext.Utils.Reactix as R2
38 39

thisModule = "Gargantext.Components.FacetsTable"
40 41 42
------------------------------------------------------------------------

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

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

58 59
initialDeletions :: Deletions
initialDeletions = { pending: mempty, deleted: mempty }
60

61 62 63 64
newtype Pair =
  Pair { id    :: Int
       , label :: String
       }
65 66 67 68 69 70

derive instance genericPair :: Generic Pair _

instance showPair :: Show Pair where
  show = genericShow

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

87 88 89 90
publicationDate :: DocumentsView -> String
publicationDate (DocumentsView {publication_year, publication_month, publication_day}) =
  (zeroPad 2 publication_year) <> "-" <> (zeroPad 2 publication_month) <> "-" <> (zeroPad 2 publication_day)

91 92 93 94 95 96
derive instance genericDocumentsView :: Generic DocumentsView _

instance showDocumentsView :: Show DocumentsView where
  show = genericShow

-- | Main layout of the Documents Tab of a Corpus
97 98 99 100
docView :: Record Props -> R.Element
docView props = R.createElement docViewCpt props []

docViewCpt :: R.Component Props
101
docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt
102
  where
103
    cpt {frontends, session, nodeId, listId, query, totalRecords, chart, container} _ = do
104
      deletions <- R.useState' initialDeletions
105
      path <- R.useState' $ initialPagePath {nodeId, listId, query, session}
106 107 108 109 110 111 112 113

      R.useEffect' $ do
        let ipp = initialPagePath {nodeId, listId, query, session}
        if fst path == ipp then
          pure unit
        else
          snd path $ const ipp

114
      pure $ H.div { className: "facets-doc-view container1" }
115
        [ R2.row
116
          [ chart
117
          , H.div { className: "col-md-12" }
118
            [ pageLayout { deletions, frontends, totalRecords, container, session, path } ]
119 120 121 122 123 124 125 126 127
          , 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" }
128
          trashClick deletions _ = performDeletions session nodeId deletions
129

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

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

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

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

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

202
  --SearchResult {result} <- post session p $ SearchQuery {query: concat query, expected:searchType}
203 204
  SearchResult {result} <- post session p query
  -- $ SearchQuery {query: concat query, expected: SearchDoc}
205 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
  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
243
                                                    }
244 245 246 247 248 249 250 251 252 253 254 255 256 257 258
                      , 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
                          }
259

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

275 276


277

278
type PageLayoutProps =
279
  ( frontends    :: Frontends
280
  , totalRecords :: Int
281 282 283 284
  , deletions    :: R.State Deletions
  , container    :: Record T.TableContainerProps -> R.Element
  , session      :: Session
  , path         :: R.State PagePath
285 286
  )

287
type PageProps = ( documents :: Seq DocumentsView | PageLayoutProps )
288

289 290 291 292 293
-- | Loads and renders a page
pageLayout :: Record PageLayoutProps -> R.Element
pageLayout props = R.createElement pageLayoutCpt props []

pageLayoutCpt :: R.Component PageLayoutProps
294
pageLayoutCpt = R.hooksComponentWithModule thisModule "pageLayout" cpt
295
  where
296
    cpt {frontends, totalRecords, deletions, container, session, path} _ = do
297
      useLoader (fst path) loadPage $ \documents ->
298
        page {frontends, totalRecords, deletions, container, session, path, documents}
299 300 301 302 303

page :: Record PageProps -> R.Element
page props = R.createElement pageCpt props []

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

349
---------------------------------------------------------
350

351
newtype DeleteDocumentQuery = DeleteDocumentQuery { documents :: Array Int }
352 353

instance encodeJsonDDQuery :: EncodeJson DeleteDocumentQuery where
354 355
  encodeJson (DeleteDocumentQuery {documents}) =
    "documents" := documents ~> jsonEmptyObject
356

357 358
deleteDocuments :: Session -> Int -> DeleteDocumentQuery -> Aff (Array Int)
deleteDocuments session nodeId =
359
  deleteWithBody session $ NodeAPI Node (Just nodeId) "documents"
360