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

type TotalRecords = Int

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

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

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

newtype SearchResults = SearchResults { results :: Array Response }

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

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

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

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

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

derive instance genericPair :: Generic Pair _

instance showPair :: Show Pair where
  show = genericShow

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

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

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

instance showDocumentsView :: Show DocumentsView where
  show = genericShow

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

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

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

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

instance decodeHyperdata :: DecodeJson Hyperdata where
  decodeJson json = do
    obj    <- decodeJson json
144
    authors <- obj .| "authors"
145 146
    title  <- obj .| "title"
    source <- obj .| "source"
147 148 149 150
    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 }
151

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

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

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

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

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

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

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

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

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

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

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

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

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

300 301 302 303 304 305 306
-- | 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
307
    cpt {frontends, totalRecords, deletions, container, session, path} _ = do
308
      useLoader (fst path) loadPage $ \documents ->
309
        page {frontends, totalRecords, deletions, container, session, path, documents}
310 311 312 313 314

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

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

357
---------------------------------------------------------
358

359
newtype DeleteDocumentQuery = DeleteDocumentQuery { documents :: Array Int }
360 361

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

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