DocsTable.purs 18 KB
Newer Older
1
-- TODO: this module should be replaced by FacetsTable
2
module Gargantext.Components.DocsTable where
3

4
import Prelude
5
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>), encodeJson)
6
import Data.Array (drop, take)
7
import Data.Generic.Rep (class Generic)
8
import Data.Generic.Rep.Eq (genericEq)
9
import Data.Generic.Rep.Show (genericShow)
10
import Data.Lens ((^.))
11 12
import Data.Lens.At (at)
import Data.Lens.Record (prop)
13 14
import Data.Map (Map)
import Data.Map as Map
15 16 17
import Data.Maybe (Maybe(..), maybe)
import Data.Set (Set)
import Data.Set as Set
18
import Data.Symbol (SProxy(..))
19
import Data.Tuple (Tuple(..), fst, snd)
20
import Data.Tuple.Nested ((/\))
James Laver's avatar
James Laver committed
21
import DOM.Simple.Console (log, log3)
22
import DOM.Simple.Event as DE
23
import Effect (Effect)
24
import Effect.Aff (Aff, launchAff)
25
import Effect.Class (liftEffect)
26 27
import Reactix as R
import Reactix.DOM.HTML as H
28 29
------------------------------------------------------------------------
import Gargantext.Components.Table as T
James Laver's avatar
James Laver committed
30
import Gargantext.Components.Loader (loader)
31
import Gargantext.Components.Table as T
James Laver's avatar
James Laver committed
32
import Gargantext.Ends (Frontends, url)
33
import Gargantext.Utils.Reactix as R2
34
import Gargantext.Routes as Routes
35
import Gargantext.Routes (AppRoute, SessionRoute(NodeAPI))
36
import Gargantext.Sessions (Session, sessionId, post, delete, put)
37
import Gargantext.Types (NodeType(..), OrderBy(..), TabType, TabPostQuery(..))
38
------------------------------------------------------------------------
39

40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145
data Category = Trash | UnRead | Checked | Topic | Favorite

categories :: Array Category
categories = [Trash, UnRead, Checked, Topic, Favorite]

derive instance genericFavorite :: Generic Category _
instance showCategory :: Show Category where
  show = genericShow
instance eqCategory :: Eq Category where
  eq = genericEq
instance encodeJsonCategory :: EncodeJson Category where
  encodeJson cat    = encodeJson (cat2score cat)

favCategory :: Category -> Category
favCategory Favorite = Topic
favCategory _        = Favorite

trashCategory :: Category -> Category
trashCategory _     = Trash
trashCategory Trash = UnRead

decodeCategory :: Int -> Category
decodeCategory 0 = Trash
decodeCategory 1 = UnRead
decodeCategory 2 = Checked
decodeCategory 3 = Topic
decodeCategory 4 = Favorite
decodeCategory _ = UnRead

cat2score :: Category -> Int
cat2score Trash    = 0
cat2score UnRead   = 1
cat2score Checked  = 2
cat2score Topic    = 3
cat2score Favorite = 4

-- caroussel :: Category -> R.Element
caroussel session nodeId setLocalCategories r cat = H.div {} divs
  where
    divs = map (\c -> if cat == c
                        then
                          H.div { className : icon c (cat == c) } []

                        else
                          H.div { className : icon c (cat == c)
                            , on: { click: onClick nodeId setLocalCategories r c}
                             } []
                    ) (caroussel' cat)

    caroussel' :: Category -> Array Category
    caroussel' Trash = take 2 categories
    caroussel' cat   = take 3 $ drop (cat2score cat - 1 ) categories

    onClick nodeId setLocalCategories r cat = \_-> do
      setLocalCategories $ Map.insert r._id cat
      void $ launchAff $ putCategories session nodeId $ CategoryQuery {nodeIds: [r._id], category: cat}


icon :: Category -> Boolean -> String
icon cat b = btn b $ "glyphicon glyphicon-" <> (color $ size b $ icon' cat b)
  where
    icon' :: Category -> Boolean -> String
    icon' Trash   false = "remove"
    icon' Trash   true  = "remove-sign"

    icon' UnRead  true  = "question-sign"
    icon' UnRead  false = "question-sign"

    icon' Checked true  = "ok-sign"
    icon' Checked false = "ok"

    icon' Topic  true  = "star"
    icon' Topic  false = "star-empty"

    icon' Favorite true = "heart"
    icon' Favorite false = "heart-empty"

    size :: Boolean -> String -> String
    size true  s = s <> " btn-lg"
    size false s = s <> " btn-xs"

    color :: String -> String
    color x = x <> " text-primary"

    btn :: Boolean -> String -> String
    btn true s = s
    btn false s = "btn " <> s


newtype CategoryQuery = CategoryQuery {
    nodeIds :: Array Int
  , category :: Category
  }

instance encodeJsonCategoryQuery :: EncodeJson CategoryQuery where
  encodeJson (CategoryQuery post) =
    "ntc_nodesId" := post.nodeIds
    ~> "ntc_category" := encodeJson post.category
    ~> jsonEmptyObject

categoryRoute :: Int -> SessionRoute
categoryRoute nodeId = NodeAPI Node (Just nodeId) "category"

putCategories :: Session -> Int -> CategoryQuery -> Aff (Array Int)
putCategories session nodeId = put session $ categoryRoute nodeId

146 147 148
type NodeID = Int
type TotalRecords = Int

149
type LayoutProps =
150
  ( nodeId       :: Int
151
  , totalRecords :: Int
152
  , chart        :: R.Element
153
  , tabType      :: TabType
154
  , listId       :: Int
155
  , corpusId     :: Maybe Int
156
  , showSearch   :: Boolean
James Laver's avatar
James Laver committed
157
  , frontends    :: Frontends
158
  , session      :: Session )
159
  -- ^ tabType is not ideal here since it is too much entangled with tabs and
160
  -- ngramtable. Let's see how this evolves.  )
161

162
type PageLayoutProps =
163
  ( nodeId       :: Int
164 165 166 167
  , totalRecords :: Int
  , tabType      :: TabType
  , listId       :: Int
  , corpusId     :: Maybe Int
168
  , query        :: Query
169
  , session      :: Session
James Laver's avatar
James Laver committed
170
  , frontends    :: Frontends
171
  , params       :: R.State T.Params )
172

173
type LocalCategories = Map Int Category
174
type Query = String
175

176
_documentIdsDeleted  = prop (SProxy :: SProxy "documentIdsDeleted")
177
_localCategories     = prop (SProxy :: SProxy "localCategories")
178

179
data Action
180
  = MarkCategory Int Category
181

182 183 184 185 186

newtype DocumentsView
  = DocumentsView
    { _id    :: Int
    , url    :: String
187
    , date   :: Int
188 189
    , title  :: String
    , source :: String
190
    , category :: Category
191 192 193 194 195 196 197 198 199 200 201 202 203
    , ngramCount :: Int
    }


derive instance genericDocumentsView :: Generic DocumentsView _

instance showDocumentsView :: Show DocumentsView where
  show = genericShow


newtype Response = Response
  { cid        :: Int
  , hyperdata  :: Hyperdata
204
  , category   :: Category
205 206 207 208 209 210 211
  , ngramCount :: Int
  }


newtype Hyperdata = Hyperdata
  { title  :: String
  , source :: String
212
  , pub_year   :: Int
213 214 215 216 217 218
  }


instance decodeHyperdata :: DecodeJson Hyperdata where
  decodeJson json = do
    obj    <- decodeJson json
219 220 221
    title  <- obj .: "title"
    source <- obj .: "source"
    pub_year <- obj .: "publication_year"
222
    pure $ Hyperdata { title,source, pub_year}
223 224 225 226

instance decodeResponse :: DecodeJson Response where
  decodeJson json = do
    obj        <- decodeJson json
227 228 229 230
    cid        <- obj .: "id"
    favorite   <- obj .: "favorite"
    ngramCount <- obj .: "id"
    hyperdata  <- obj .: "hyperdata"
231
    pure $ Response { cid, category: decodeCategory favorite, ngramCount, hyperdata }
232 233


234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249
docViewLayout :: Record LayoutProps -> R.Element
docViewLayout props = R.createElement docViewLayoutCpt props []

docViewLayoutCpt :: R.Component LayoutProps
docViewLayoutCpt = R.hooksComponent "G.C.DocsTable.docViewLayout" cpt
  where
    cpt layout _children = do
      query <- R.useState' ""
      params <- R.useState' T.initialParams
      pure $ docView {query, params, layout}

type Props =
  ( query :: R.State Query
  , params :: R.State T.Params
  , layout :: Record LayoutProps )

250
docView :: Record Props -> R.Element
251
docView props = R.createElement docViewCpt props []
252 253

docViewCpt :: R.Component Props
254 255
docViewCpt = R.hooksComponent "G.C.DocsTable.docView" cpt where
  cpt { query, params
James Laver's avatar
James Laver committed
256
      , layout: { frontends, session, nodeId, tabType, listId
257
                , corpusId, totalRecords, chart, showSearch } } _ = do
258 259 260 261 262
    pure $ H.div {className: "container1"}
      [ H.div {className: "row"}
        [ chart
        , if showSearch then searchBar query else H.div {} []
        , H.div {className: "col-md-12"}
James Laver's avatar
James Laver committed
263
          [ pageLayout {frontends, session, nodeId, totalRecords, tabType, listId, corpusId, query: fst query, params} ] ] ]
264 265
    -- onClickTrashAll nodeId _ = do
    --   launchAff $ deleteAllDocuments p.session nodeId
266 267
          
          {-, H.div {className: "col-md-1 col-md-offset-11"}
268
            [ pageLayout p.session params {nodeId, totalRecords, tabType, listId, corpusId, query: fst query} ]
269
          , H.div {className: "col-md-1 col-md-offset-11"}
270 271
            [ H.button { className: "btn"
                       , style: {backgroundColor: "peru", color : "white", border : "white"}
272
                       , on: { click: onClickTrashAll nodeId } }
273 274 275
              [  H.i {className: "glyphitem glyphicon glyphicon-trash"} []
              ,  H.text "Trash all"
              ]
276
            ]
277
           -}
278

279 280 281 282 283 284 285 286
searchBar :: R.State Query -> R.Element
searchBar (query /\ setQuery) = R.createElement el {} []
  where
    el = R.hooksComponent "SearchBar" cpt
    cpt {} _children = do
      queryText <- R.useState' query

      pure $ H.div {className: "row"}
287
        [ H.div {className: "col col-md-3"} []
288
        , H.div {className: "col col-md-1"} [if query /= "" then clearButton else H.div {} []]
289
        , H.div {className: "col col-md-3 form-group"}
290 291
          [ H.input { type: "text"
                    , className: "form-control"
292
                    , on: {change: onSearchChange queryText, keyUp: onSearchKeyup queryText}
293 294
                    , placeholder: query
                    , defaultValue: query}
295
          ]
296
        , H.div {className: "col col-md-1"} [searchButton queryText]
297 298 299 300 301 302
        ]

    onSearchChange :: forall e. R.State Query -> e -> Effect Unit
    onSearchChange (_ /\ setQueryText) = \e ->
      setQueryText $ const $ R2.unsafeEventValue e

303 304 305 306 307 308 309
    onSearchKeyup :: R.State Query -> DE.KeyboardEvent -> Effect Unit
    onSearchKeyup (queryText /\ _) = \e ->
      if DE.key e == "Enter" then
        setQuery $ const queryText
      else
        pure $ unit

310 311 312 313 314 315 316 317 318 319
    searchButton (queryText /\ _) =
      H.button { type: "submit"
               , className: "btn btn-default"
               , on: {click: \e -> setQuery $ const queryText}}
      [ H.span {className: "glyphicon glyphicon-search"} [] ]

    clearButton =
      H.button { className: "btn btn-danger"
               , on: {click: \e -> setQuery $ const ""}}
      [ H.span {className: "glyphicon glyphicon-remove"} [] ]
320 321 322 323

mock :: Boolean
mock = false

324 325 326 327 328 329 330
type PageParams =
  { nodeId :: Int
  , listId :: Int
  , corpusId :: Maybe Int
  , tabType :: TabType
  , query   :: Query
  , params :: T.Params}
331

332 333
loadPage :: Session -> PageParams -> Aff (Array DocumentsView)
loadPage session {nodeId, tabType, query, listId, corpusId, params: {limit, offset, orderBy}} = do
James Laver's avatar
James Laver committed
334
  liftEffect $ log3 "loading documents page: loadPage with Offset and limit" offset limit
335
  -- res <- get $ toUrl endConfigStateful Back (Tab tabType offset limit (convOrderBy <$> orderBy)) (Just nodeId)
336 337
  let p = NodeAPI Node (Just nodeId) "table"
  res <- post session p $ TabPostQuery {
338 339
      offset
    , limit
340
    , orderBy: convOrderBy orderBy
341
    , tabType
342
    , query
343
    }
344 345 346 347 348 349 350 351 352
  let docs = res2corpus <$> res
  pure $
    if mock then take limit $ drop offset sampleData else
    docs
  where
    res2corpus :: Response -> DocumentsView
    res2corpus (Response r) =
      DocumentsView { _id : r.cid
      , url    : ""
353
      , date   : (\(Hyperdata hr) -> hr.pub_year) r.hyperdata
354 355
      , title  : (\(Hyperdata hr) -> hr.title) r.hyperdata
      , source : (\(Hyperdata hr) -> hr.source) r.hyperdata
356
      , category : r.category
357 358
      , ngramCount : r.ngramCount
     }
359 360 361 362 363 364
    convOrderBy (Just (T.ASC  (T.ColumnName "Date")))  = DateAsc
    convOrderBy (Just (T.DESC (T.ColumnName "Date")))  = DateDesc
    convOrderBy (Just (T.ASC  (T.ColumnName "Title"))) = TitleAsc
    convOrderBy (Just (T.DESC (T.ColumnName "Title"))) = TitleDesc
    convOrderBy (Just (T.ASC  (T.ColumnName "Source"))) = SourceAsc
    convOrderBy (Just (T.DESC (T.ColumnName "Source"))) = SourceDesc
365 366 367

    convOrderBy _ = DateAsc -- TODO

368 369 370 371
pageLayout :: Record PageLayoutProps -> R.Element
pageLayout props = R.createElement pageLayoutCpt props []

pageLayoutCpt :: R.Memo PageLayoutProps
James Laver's avatar
James Laver committed
372
pageLayoutCpt = R.memo' $ R.staticComponent "G.C.DocsTable.pageLayout" cpt where
James Laver's avatar
James Laver committed
373
  cpt props@{frontends, session, nodeId, listId, corpusId, tabType, query, params} _ =
James Laver's avatar
James Laver committed
374 375 376 377
    loader path (loadPage session) paint
    where
      path = {nodeId, listId, corpusId, tabType, query, params: fst params}
      paint loaded = page params props loaded
378 379 380 381 382 383 384 385 386

type PageProps =
  ( params :: R.State T.Params
  , layout :: Record PageLayoutProps
  , documents :: Array DocumentsView )

page ::  R.State T.Params -> Record PageLayoutProps -> Array DocumentsView -> R.Element
page params layout documents = R.createElement pageCpt {params, layout, documents} []

387 388
pageCpt :: R.Memo PageProps
pageCpt = R.memo' $ R.hooksComponent "G.C.DocsTable.pageCpt" cpt where
James Laver's avatar
James Laver committed
389
  cpt { layout: {frontends, session, nodeId, corpusId, listId, totalRecords}, documents, params } _ = do
390 391 392 393
    localCategories <- R.useState' (mempty :: LocalCategories)
    pure $ T.table
      { rows: rows localCategories
      , container: T.defaultContainer { title: "Documents" }
394
      , params, colNames, totalRecords }
395
      where
396 397 398 399 400
        sid = sessionId session
        gi Favorite  = "glyphicon glyphicon-star"
        gi _ = "glyphicon glyphicon-star-empty"
        trashStyle Trash = {textDecoration: "line-through"}
        trashStyle _ = {textDecoration: "none"}
401 402 403
        corpusDocument
          | Just cid <- corpusId = Routes.CorpusDocument sid cid listId
          | otherwise = Routes.Document sid listId
404
        colNames = T.ColumnName <$> [ "Tag", "Date", "Title", "Source"]
405
        getCategory (localCategories /\ _) {_id, category} = maybe category identity (localCategories ^. at _id)
406
        rows localCategories = row <$> documents
407 408 409
          where
            row (DocumentsView r) =
              { row:
410 411 412
                [ -- H.div {} [ H.a { className, style, on: {click: click Favorite} } [] ]
                 caroussel session nodeId setLocalCategories r cat
                --, H.input { type: "checkbox", defaultValue: checked, on: {click: click Trash} }
413 414
                -- TODO show date: Year-Month-Day only
                , H.div { style } [ R2.showText r.date ]
415
                , H.div { style }
James Laver's avatar
James Laver committed
416
                  [ H.a { href: url frontends $ corpusDocument r._id } [ H.text r.title ] ]
417
                , H.div { style } [ H.text $ if r.source == "" then "Source" else r.source ]
418
                ]
419 420
              , delete: true }
              where
421 422 423 424 425
                cat         = getCategory localCategories r
                (_ /\ setLocalCategories) = localCategories
                checked    = Trash == cat
                style      = trashStyle cat
                className  = gi cat
426

427 428
---------------------------------------------------------
sampleData' :: DocumentsView
429 430 431 432 433
sampleData' = DocumentsView { _id : 1
                            , url : ""
                            , date : 2010
                            , title : "title"
                            , source : "source"
434
                            , category : UnRead
435
                            , ngramCount : 1}
436 437 438

sampleData :: Array DocumentsView
--sampleData = replicate 10 sampleData'
439 440 441 442 443
sampleData = map (\(Tuple t s) -> DocumentsView { _id : 1
                                                , url : ""
                                                , date : 2017
                                                , title: t
                                                , source: s
444
                                                , category : UnRead
445
                                                , ngramCount : 10}) sampleDocuments
446 447 448 449 450

sampleDocuments :: Array (Tuple String String)
sampleDocuments = [Tuple "Macroscopic dynamics of the fusion process" "Journal de Physique Lettres",Tuple "Effects of static and cyclic fatigue at high temperature upon reaction bonded silicon nitride" "Journal de Physique Colloques",Tuple "Reliability of metal/glass-ceramic junctions made by solid state bonding" "Journal de Physique Colloques",Tuple "High temperature mechanical properties and intergranular structure of sialons" "Journal de Physique Colloques",Tuple "SOLUTIONS OF THE LANDAU-VLASOV EQUATION IN NUCLEAR PHYSICS" "Journal de Physique Colloques",Tuple "A STUDY ON THE FUSION REACTION 139La + 12C AT 50 MeV/u WITH THE VUU EQUATION" "Journal de Physique Colloques",Tuple "Atomic structure of \"vitreous\" interfacial films in sialon" "Journal de Physique Colloques",Tuple "MICROSTRUCTURAL AND ANALYTICAL CHARACTERIZATION OF Al2O3/Al-Mg COMPOSITE INTERFACES" "Journal de Physique Colloques",Tuple "Development of oxidation resistant high temperature NbTiAl alloys and intermetallics" "Journal de Physique IV Colloque",Tuple "Determination of brazed joint constitutive law by inverse method" "Journal de Physique IV Colloque",Tuple "Two dimensional estimates from ocean SAR images" "Nonlinear Processes in Geophysics",Tuple "Comparison Between New Carbon Nanostructures Produced by Plasma with Industrial Carbon Black Grades" "Journal de Physique III",Tuple "<i>Letter to the Editor:</i> SCIPION, a new flexible ionospheric sounder in Senegal" "Annales Geophysicae",Tuple "Is reducibility in nuclear multifragmentation related to thermal scaling?" "Physics Letters B",Tuple "Independence of fragment charge distributions of the size of heavy multifragmenting sources" "Physics Letters B",Tuple "Hard photons and neutral pions as probes of hot and dense nuclear matter" "Nuclear Physics A",Tuple "Surveying the nuclear caloric curve" "Physics Letters B",Tuple "A hot expanding source in 50 A MeV Xe+Sn central reactions" "Physics Letters B"]

newtype SearchQuery = SearchQuery
451
  { query :: Array String
452 453 454 455 456
  , parent_id :: Int
  }


instance encodeJsonSQuery :: EncodeJson SearchQuery where
457 458 459
  encodeJson (SearchQuery {query, parent_id})
     = "query" := query
    ~> "parent_id" := parent_id
460 461 462 463 464
    ~> jsonEmptyObject



searchResults :: SearchQuery -> Aff Int
465
searchResults squery = pure 42 -- TODO post "http://localhost:8008/count" unit
466

467 468
documentsRoute :: Int -> SessionRoute
documentsRoute nodeId = NodeAPI Node (Just nodeId) "documents"
469

470
deleteAllDocuments :: Session -> Int -> Aff (Array Int)
471
deleteAllDocuments session = delete session <<< documentsRoute
472 473 474 475 476 477

-- TODO: not optimal but Data.Set lacks some function (Set.alter)
toggleSet :: forall a. Ord a => a -> Set a -> Set a
toggleSet a s
  | Set.member a s = Set.delete a s
  | otherwise      = Set.insert a s