FacetsTable.purs 14.1 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 Prelude
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(..))
12 13
import Data.Set (Set)
import Data.Set as Set
14
import Data.Tuple (fst, snd)
15
import Data.Tuple.Nested ((/\))
16
import Effect (Effect)
17
import Effect.Aff (Aff, launchAff_)
18 19
import Reactix as R
import Reactix.DOM.HTML as H
20
------------------------------------------------------------------------
21
import Gargantext.Ends (url, Frontends)
22
import Gargantext.Hooks.Loader (useLoader)
23
import Gargantext.Components.DocsTable (Category(..), CategoryQuery(..), favCategory, decodeCategory, putCategories)
24
import Gargantext.Components.Table as T
Alexandre Delanoë's avatar
Alexandre Delanoë committed
25
import Gargantext.Routes (SessionRoute(Search, NodeAPI))
26
import Gargantext.Routes as Routes
27
import Gargantext.Sessions (Session, sessionId, post, deleteWithBody)
28
import Gargantext.Types (NodeType(..), OrderBy(..), NodePath(..))
29
import Gargantext.Utils (toggleSet, zeroPad)
30 31 32 33 34 35
import Gargantext.Utils.DecodeMaybe ((.|))
------------------------------------------------------------------------

type NodeID = Int
type TotalRecords = Int

36 37 38 39 40
-- Example:
--   [["machine","learning"],["artificial","intelligence"]]
-- This searches for documents with "machine learning" or "artificial intelligence"
type TextQuery = Array (Array String)

41
newtype SearchQuery = SearchQuery { query :: TextQuery }
42 43

instance encodeJsonSearchQuery :: EncodeJson SearchQuery where
44
  encodeJson (SearchQuery {query})
45 46
     -- = "query"     := query !! 0 -- TODO anoe
    = "query" := concat query
47 48 49 50 51 52 53
    ~> jsonEmptyObject

newtype SearchResults = SearchResults { results :: Array Response }

instance decodeSearchResults :: DecodeJson SearchResults where
  decodeJson json = do
    obj     <- decodeJson json
54
    results <- obj .: "results"
55 56 57
    pure $ SearchResults {results}

type Props =
58 59 60
  ( chart :: R.Element
  , container :: Record T.TableContainerProps -> R.Element
  , frontends :: Frontends
61
  , listId :: Int
62
  , nodeId :: Int
63
  , query :: TextQuery
64
  , session :: Session
65
  , totalRecords :: Int
66
  )
67

68 69
-- | Tracks the ids of documents to delete and that have been deleted
type Deletions = { pending :: Set Int, deleted :: Set Int }
70

71 72
initialDeletions :: Deletions
initialDeletions = { pending: mempty, deleted: mempty }
73

74
newtype Pair = Pair { id :: Int, label :: String }
75 76 77 78 79 80

derive instance genericPair :: Generic Pair _

instance showPair :: Show Pair where
  show = genericShow

81 82 83 84 85 86
newtype DocumentsView =
  DocumentsView
  { id       :: Int
  , date     :: String
  , title    :: String
  , source   :: String
87
  , authors  :: String
88 89 90 91
  , score    :: Int
  , pairs    :: Array Pair
  , delete   :: Boolean
  , category :: Category
92 93 94
  , publication_year :: Int
  , publication_month :: Int
  , publication_day  :: Int
95
  }
96

97 98 99 100
publicationDate :: DocumentsView -> String
publicationDate (DocumentsView {publication_year, publication_month, publication_day}) =
  (zeroPad 2 publication_year) <> "-" <> (zeroPad 2 publication_month) <> "-" <> (zeroPad 2 publication_day)

101 102 103 104 105 106
derive instance genericDocumentsView :: Generic DocumentsView _

instance showDocumentsView :: Show DocumentsView where
  show = genericShow

newtype Response = Response
107 108 109
  { id         :: Int
  , created    :: String
  , hyperdata  :: Hyperdata
110
  , category   :: Category
111 112 113 114
  , ngramCount :: Int
-- , date      :: String
-- , score     :: Int
-- , pairs     :: Array Pair
115 116 117
  }

newtype Hyperdata = Hyperdata
118 119 120
  { authors :: String
  , title   :: String
  , source  :: String
121 122 123
  , publication_year :: Int
  , publication_month :: Int
  , publication_day :: Int
124 125 126 127 128
  }

--instance decodeHyperdata :: DecodeJson Hyperdata where
--  decodeJson json = do
--    obj    <- decodeJson json
129 130
--    title  <- obj .: "title"
--    source <- obj .: "source"
131 132 133 134 135
--    pure $ Hyperdata { title,source }

instance decodePair :: DecodeJson Pair where
  decodeJson json = do
    obj   <- decodeJson json
136 137
    id    <- obj .: "id"
    label <- obj .: "label"
138 139 140 141 142
    pure $ Pair { id, label }

instance decodeHyperdata :: DecodeJson Hyperdata where
  decodeJson json = do
    obj    <- decodeJson json
143
    authors <- obj .| "authors"
144 145
    title  <- obj .| "title"
    source <- obj .| "source"
146 147 148 149
    publication_year <- obj .: "publication_year"
    publication_month <- obj .: "publication_month"
    publication_day <- obj .: "publication_day"
    pure $ Hyperdata { authors, title, source, publication_year, publication_month, publication_day }
150

151
{-
152 153 154
instance decodeResponse :: DecodeJson Response where
  decodeJson json = do
    obj       <- decodeJson json
155 156
    id        <- obj .: "id"
    -- date      <- obj .: "date" -- TODO
157
    date      <- pure "2018"
158 159 160
    score     <- obj .: "score"
    hyperdata <- obj .: "hyperdata"
    pairs     <- obj .: "pairs"
161
    pure $ Response { id, date, score, hyperdata, pairs }
162
-}
163

164 165 166
instance decodeResponse :: DecodeJson Response where
  decodeJson json = do
    obj        <- decodeJson json
167 168 169 170 171
    id         <- obj .: "id"
    created    <- obj .: "created"
    hyperdata  <- obj .: "hyperdata"
    favorite   <- obj .: "favorite"
    --ngramCount <- obj .: "ngramCount"
172 173
    let ngramCount = 1
    pure $ Response { id, created, hyperdata, category: decodeCategory favorite, ngramCount}
174 175

-- | Main layout of the Documents Tab of a Corpus
176 177 178 179 180
docView :: Record Props -> R.Element
docView props = R.createElement docViewCpt props []

docViewCpt :: R.Component Props
docViewCpt = R.hooksComponent "G.C.FacetsTable.DocView" cpt
181
  where
182
    cpt {frontends, session, nodeId, listId, query, totalRecords, chart, container} _ = do
183
      deletions <- R.useState' initialDeletions
184
      path <- R.useState' $ initialPagePath {nodeId, listId, query, session}
185 186 187 188 189 190 191 192

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

193 194
      pure $ H.div { className: "container1" }
        [ H.div { className: "row" }
195
          [ chart
196
          , H.div { className: "col-md-12" }
197
            [ pageLayout { deletions, frontends, totalRecords, container, session, path } ]
198 199 200 201 202 203 204 205 206
          , 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" }
207
          trashClick deletions _ = performDeletions session nodeId deletions
208

209 210
performDeletions :: Session -> Int -> R.State Deletions -> Effect Unit
performDeletions session nodeId (deletions /\ setDeletions) =
211
  launchAff_ call *> setDeletions del
212
  where
213
    q = {documents: Set.toUnfoldable deletions.pending}
214
    call = deleteDocuments session nodeId (DeleteDocumentQuery q)
215 216
    del {pending, deleted} = {pending: mempty, deleted: deleted <> pending}

217 218 219
markCategory :: Session -> NodeID -> Category -> Array NodeID -> Effect Unit
markCategory session nodeId category nids =
  void $ launchAff_ $putCategories session nodeId (CategoryQuery q)
220 221 222 223 224 225 226 227 228 229 230 231 232
  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
docViewGraphCpt = R.hooksComponent "FacetsDocViewGraph" cpt
  where
233
    cpt {frontends, session, nodeId, listId, query, totalRecords, chart, container} _ = do
234 235 236
      deletions <- R.useState' initialDeletions
      let buttonStyle = { backgroundColor: "peru", padding : "9px"
                        , color : "white", border : "white", float: "right"}
237 238
      let performClick = \_ -> performDeletions session nodeId deletions
      path <- R.useState' $ initialPagePath { nodeId, listId, query, session }
239 240 241 242 243 244 245 246
      pure $ R.fragment
        [ H.br {}
        , H.p {} [ H.text "" ]
        , H.br {}
        , H.div { className: "container-fluid" }
          [ H.div { className: "row" }
            [ chart
            , H.div { className: "col-md-12" }
247
              [ pageLayout { frontends, totalRecords, deletions, container, session, path }
248 249 250 251 252
              , H.button { style: buttonStyle, on: { click: performClick } }
                [ H.i { className: "glyphitem glyphicon glyphicon-trash"
                      , style: { marginRight : "9px" } } []
                , H.text "Delete document!" ] ] ] ] ]

253
type PagePath = {nodeId :: Int, listId :: Int, query :: TextQuery, params :: T.Params, session :: Session}
254

255 256
initialPagePath :: {session :: Session, nodeId :: Int, listId :: Int, query :: TextQuery} -> PagePath
initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, query, params: T.initialParams}
257 258

loadPage :: PagePath -> Aff (Array DocumentsView)
259
loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy}} = do
260 261
  let p = Search { listId, offset, limit, orderBy: convOrderBy <$> orderBy } (Just nodeId)
  SearchResults res <- post session p $ SearchQuery {query}
262 263 264
  pure $ res2corpus <$> res.results
  where
    res2corpus :: Response -> DocumentsView
265
    res2corpus (Response { id, created: date, ngramCount: score, category
266 267 268 269 270 271 272 273 274 275 276 277 278 279
                         , hyperdata: Hyperdata {authors, title, source, publication_year, publication_month, publication_day} }) =
      DocumentsView { id
                    , date
                    , title
                    , source
                    , score
                    , authors
                    , category
                    , pairs: []
                    , delete: false
                    , publication_year
                    , publication_month
                    , publication_day
                    }
280 281 282 283
    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
284 285
    convOrderBy (T.ASC  (T.ColumnName "Source")) = SourceAsc
    convOrderBy (T.DESC (T.ColumnName "Source")) = SourceDesc
286 287
    convOrderBy _ = DateAsc -- TODO

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

type PageProps = ( documents :: Array DocumentsView | PageLayoutProps )
298

299 300 301 302 303 304 305
-- | Loads and renders a page
pageLayout :: Record PageLayoutProps -> R.Element
pageLayout props = R.createElement pageLayoutCpt props []

pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = R.hooksComponent "G.C.FacetsTable.PageLayout" cpt
  where
306
    cpt {frontends, totalRecords, deletions, container, session, path} _ = do
307
      useLoader (fst path) loadPage $ \documents ->
308
        page {frontends, totalRecords, deletions, container, session, path, documents}
309 310 311 312 313

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

pageCpt :: R.Component PageProps
314
pageCpt = R.hooksComponent "G.C.FacetsTable.Page" cpt
315
  where
316
    cpt {frontends, totalRecords, container, deletions, documents, session, path: path@({nodeId, listId, query} /\ setPath)} _ = do
317
      pure $ T.table { rows, container, colNames, totalRecords, params, wrapColElts }
318
      where
319 320
        setParams f = setPath $ \p@{params: ps} -> p {params = f ps}
        params = (fst path).params /\ setParams
321
        colNames = T.ColumnName <$> [ "", "Date", "Title", "Source", "Authors", "Delete" ]
322
        wrapColElts = const identity
323 324 325 326 327 328 329
        -- 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
330
            where href = url session $ NodePath (sessionId session) NodeContact (Just id)
331
          | otherwise = H.text label
332 333
        documentUrl id =
            url frontends $ Routes.CorpusDocument (sessionId session) nodeId listId id
334 335
        comma = H.span {} [ H.text ", " ]
        rows = row <$> filter (not <<< isDeleted) documents
336
        row dv@(DocumentsView {id, score, title, source, authors, pairs, delete, category}) =
337
          { row:
338
            [ H.div {} [ H.a { className: gi category, on: {click: markClick} } [] ]
339
              -- TODO show date: Year-Month-Day only
340
            , maybeStricken delete [ H.text $ publicationDate dv ]
341
            , maybeStricken delete [ H.a {target: "_blank", href: documentUrl id} [ H.text title ] ]
342 343 344 345 346 347
            , maybeStricken delete [ H.text source ]
            , maybeStricken delete [ H.text authors ]
              -- , maybeStricken $ intercalate [comma] (pairUrl <$> pairs)
            , H.input { type: "checkbox", checked: isChecked id, on: { click: toggleClick } }
            ]
          , delete: true }
348
          where
349 350 351 352 353
            markClick _ = markCategory session nodeId category [id]
            toggleClick _ = togglePendingDeletion deletions id
        maybeStricken delete
          | delete = H.div { style: { textDecoration: "line-through" } }
          | otherwise = H.div {}
354

355
---------------------------------------------------------
356

357
newtype DeleteDocumentQuery = DeleteDocumentQuery { documents :: Array Int }
358 359

instance encodeJsonDDQuery :: EncodeJson DeleteDocumentQuery where
360 361
  encodeJson (DeleteDocumentQuery {documents}) =
    "documents" := documents ~> jsonEmptyObject
362

363 364
deleteDocuments :: Session -> Int -> DeleteDocumentQuery -> Aff (Array Int)
deleteDocuments session nodeId =
365
  deleteWithBody session $ NodeAPI Node (Just nodeId) "documents"
366