DocsTable.purs 16.3 KB
Newer Older
1
-- TODO: this module should be replaced by FacetsTable
2
module Gargantext.Components.DocsTable where
3 4 5 6 7 8 9

import Affjax (defaultRequest, request)
import Affjax.RequestBody (RequestBody(..))
import Affjax.ResponseFormat (printResponseFormatError)
import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.?), (:=), (~>))
10
import Data.Array (drop, take, (:), filter)
11 12 13 14
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.HTTP.Method (Method(..))
15 16 17 18
import Data.Lens
import Data.Lens.At (at)
import Data.Lens.Record (prop)
import Data.Map (Map)
19 20 21
import Data.Maybe (Maybe(..), maybe)
import Data.Set (Set)
import Data.Set as Set
22
import Data.Int (fromString)
23
import Data.Symbol (SProxy(..))
24 25 26 27 28 29 30 31
import Data.Tuple (Tuple(..))
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import React as React
import React (ReactClass, ReactElement, Children)
------------------------------------------------------------------------
import Gargantext.Prelude
32
import Gargantext.Config (End(..), NodeType(..), OrderBy(..), Path(..), TabType, toUrl, toLink)
33 34 35 36 37
import Gargantext.Config.REST (get, put, post, deleteWithBody)
import Gargantext.Components.Loader as Loader
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Table as T
import Gargantext.Utils.DecodeMaybe ((.|))
38
import Gargantext.Router as R
39
import React.DOM (a, br', button, div, i, input, p, text)
40
import React.DOM.Props (_type, className, href, onClick, placeholder, style, checked, target)
41 42
import Thermite (PerformAction, Render, Spec, defaultPerformAction, modifyState_, simpleSpec, hideState)
------------------------------------------------------------------------
43 44 45 46 47

type NodeID = Int
type TotalRecords = Int

type Props =
48
  { nodeId       :: Int
49
  , totalRecords :: Int
50 51
  , chart        :: ReactElement
  , tabType      :: TabType
52
  , listId       :: Int
53
  , corpusId     :: Maybe Int
54 55 56
  -- ^ tabType is not ideal here since it is too much entangled with tabs and
  -- ngramtable. Let's see how this evolves.
  }
57 58 59

type State =
  { documentIdsToDelete :: Set Int
60
  , documentIdsDeleted  :: Set Int
61
  , localFavorites      :: Map Int Boolean
62 63 64 65 66
  }

initialState :: State
initialState =
  { documentIdsToDelete: mempty
67
  , documentIdsDeleted:  mempty
68
  , localFavorites:      mempty
69 70
  }

71
_documentIdsToDelete = prop (SProxy :: SProxy "documentIdsToDelete")
72 73
_documentIdsDeleted  = prop (SProxy :: SProxy "documentIdsDeleted")
_localFavorites      = prop (SProxy :: SProxy "localFavorites")
74

75
data Action
76
  = MarkFavorites Int Boolean
77 78 79 80 81 82 83
  | ToggleDocumentToDelete Int
  | Trash

newtype DocumentsView
  = DocumentsView
    { _id    :: Int
    , url    :: String
84
    , date   :: Int
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
    , title  :: String
    , source :: String
    , fav    :: Boolean
    , ngramCount :: Int
    , delete :: Boolean
    }


derive instance genericDocumentsView :: Generic DocumentsView _

instance showDocumentsView :: Show DocumentsView where
  show = genericShow


newtype Response = Response
  { cid        :: Int
  , hyperdata  :: Hyperdata
  , favorite   :: Boolean
  , ngramCount :: Int
  }


newtype Hyperdata = Hyperdata
  { title  :: String
  , source :: String
110
  , pub_year   :: Int
111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132
  }

--instance decodeHyperdata :: DecodeJson Hyperdata where
--  decodeJson json = do
--    obj    <- decodeJson json
--    title  <- obj .? "title"
--    source <- obj .? "source"
--    pure $ Hyperdata { title,source }
--instance decodeResponse :: DecodeJson Response where
--  decodeJson json = do
--    obj        <- decodeJson json
--    cid        <- obj .? "id"
--    created    <- obj .? "created"
--    favorite   <- obj .? "favorite"
--    ngramCount <- obj .? "ngramCount"
--    hyperdata  <- obj .? "hyperdata"
--    pure $ Response { cid, created, favorite, ngramCount, hyperdata }


instance decodeHyperdata :: DecodeJson Hyperdata where
  decodeJson json = do
    obj    <- decodeJson json
133 134 135 136
    title  <- obj .? "title"
    source <- obj .? "source"
    pub_year <- obj .? "publication_year"
    pure $ Hyperdata { title,source, pub_year}
137 138 139 140 141

instance decodeResponse :: DecodeJson Response where
  decodeJson json = do
    obj        <- decodeJson json
    cid        <- obj .? "id"
142
    favorite   <- obj .? "favorite"
143 144
    ngramCount <- obj .? "id"
    hyperdata  <- obj .? "hyperdata"
145
    pure $ Response { cid, favorite, ngramCount, hyperdata }
146 147 148 149



-- | Filter
150
filterSpec :: forall state props action. Spec state props action
151 152
filterSpec = simpleSpec defaultPerformAction render
  where
153
    render d p s c = [] {-[div [ className "col-md-2", style {textAlign : "center", marginLeft : "0px", paddingLeft : "0px"}] [ text "    Filter "
Sudhir Kumar's avatar
Sudhir Kumar committed
154
                     , input [className "form-control", placeholder "Filter here"]
155
                     ]] -}
156 157 158 159

docViewSpec :: Spec {} Props Void
docViewSpec = hideState (const initialState) layoutDocview

160
-- | Main layout of the Documents Tab of a Corpus
161 162 163 164
layoutDocview :: Spec State Props Action
layoutDocview = simpleSpec performAction render
  where
    performAction :: PerformAction State Props Action
165 166 167 168 169
    performAction (MarkFavorites nid fav) {nodeId} _ = do
      modifyState_ $ _localFavorites <<< at nid ?~ fav
      void $ lift $ if fav
        then putFavorites    nodeId (FavoriteQuery {favorites: [nid]})
        else deleteFavorites nodeId (FavoriteQuery {favorites: [nid]})
170 171
    performAction (ToggleDocumentToDelete nid) _ _ =
      modifyState_ \state -> state {documentIdsToDelete = toggleSet nid state.documentIdsToDelete}
172
    performAction Trash {nodeId} {documentIdsToDelete} = do
173
      void $ lift $ deleteDocuments nodeId (DeleteDocumentQuery {documents: Set.toUnfoldable documentIdsToDelete})
174 175 176
      modifyState_ $
        (_documentIdsToDelete .~ mempty) >>>
        (_documentIdsDeleted <>~ documentIdsToDelete)
177 178

    render :: Render State Props Action
179
    render dispatch {nodeId, tabType, listId, corpusId, totalRecords, chart} deletionState _ =
180
      [ {- br'
Sudhir Kumar's avatar
Sudhir Kumar committed
181 182 183 184
      , div [ style {textAlign : "center"}] [ text "    Filter "
                     , input [className "form-control", style {width : "120px", display : "inline-block"}, placeholder "Filter here"]
                     ]
      , p [] [text ""]
185
      , br'
186 187
      -}
      div [className "container1"]
188
        [ div [className "row"]
189 190
          [ chart
          , div [className "col-md-12"]
191
            [ pageLoader
192
                { path: initialPageParams {nodeId, tabType, listId, corpusId}
193
                , listId
194
                , corpusId
195
                , totalRecords
196
                , deletionState
197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214
                , dispatch
                }
            ]
          , div [className "col-md-12"]
             [ button [ style {backgroundColor: "peru", padding : "9px", color : "white", border : "white", float: "right"}
                      , onClick $ (\_ -> dispatch Trash)
                      ]
               [  i [className "glyphitem glyphicon glyphicon-trash", style {marginRight : "9px"}] []
               ,  text "Trash it !"
               ]
             ]
          ]
        ]
      ]

mock :: Boolean
mock = false

215
type PageParams = {nodeId :: Int, listId :: Int, corpusId :: Maybe Int, tabType :: TabType, params :: T.Params}
216

217 218 219
initialPageParams :: {nodeId :: Int, listId :: Int, corpusId :: Maybe Int, tabType :: TabType} -> PageParams
initialPageParams {nodeId, listId, corpusId, tabType} =
  {nodeId, tabType, listId, corpusId, params: T.initialParams}
220 221

loadPage :: PageParams -> Aff (Array DocumentsView)
222
loadPage {nodeId, tabType, listId, corpusId, params: {limit, offset, orderBy}} = do
223
  logs "loading documents page: loadPage with Offset and limit"
224
  res <- get $ toUrl Back (Tab tabType offset limit (convOrderBy <$> orderBy)) (Just nodeId)
225 226 227 228 229 230 231 232 233 234 235
  let docs = res2corpus <$> res
  --_ <- logs "Ok: loading page documents"
  --_ <- logs $ map show docs
  pure $
    if mock then take limit $ drop offset sampleData else
    docs
  where
    res2corpus :: Response -> DocumentsView
    res2corpus (Response r) =
      DocumentsView { _id : r.cid
      , url    : ""
236
      , date   : (\(Hyperdata hr) -> hr.pub_year) r.hyperdata
237 238 239 240 241 242
      , title  : (\(Hyperdata hr) -> hr.title) r.hyperdata
      , source : (\(Hyperdata hr) -> hr.source) r.hyperdata
      , fav    : r.favorite
      , ngramCount : r.ngramCount
      , delete : false
     }
243 244
    convOrderBy (T.ASC  (T.ColumnName "Date"))  = DateAsc
    convOrderBy (T.DESC (T.ColumnName "Date"))  = DateDesc
245 246
    convOrderBy (T.ASC  (T.ColumnName "Title")) = TitleAsc
    convOrderBy (T.DESC (T.ColumnName "Title")) = TitleDesc
247 248
    convOrderBy (T.ASC  (T.ColumnName "Source")) = SourceAsc
    convOrderBy (T.DESC (T.ColumnName "Source")) = SourceDesc
249 250 251 252 253

    convOrderBy _ = DateAsc -- TODO

type PageLoaderProps row =
  { path :: PageParams
254
  , totalRecords :: Int
255
  , dispatch :: Action -> Effect Unit
256
  , deletionState :: State
257
  , listId :: Int
258
  , corpusId :: Maybe Int
259 260 261 262
  | row
  }

renderPage :: forall props path.
263
              Render (Loader.State {nodeId :: Int, listId :: Int, corpusId :: Maybe Int, tabType :: TabType | path} (Array DocumentsView))
264
                     { totalRecords :: Int
265
                     , dispatch :: Action -> Effect Unit
266
                     , deletionState :: State
267
                     , listId :: Int
268
                     , corpusId :: Maybe Int
269 270 271 272
                     | props
                     }
                     (Loader.Action PageParams)
renderPage _ _ {loaded: Nothing} _ = [] -- TODO loading spinner
273
renderPage loaderDispatch { totalRecords, dispatch, listId, corpusId
274
                          , deletionState: {documentIdsToDelete, documentIdsDeleted, localFavorites}}
275
                          {currentPath: {nodeId, tabType}, loaded: Just res} _ =
276 277
  [ T.tableElt
      { rows
278
      , setParams: \params -> liftEffect $ loaderDispatch (Loader.SetPath {nodeId, tabType, listId, corpusId, params})
279 280 281 282 283 284 285 286 287
      , container: T.defaultContainer { title: "Documents" }
      , colNames:
          T.ColumnName <$>
          [ ""
          , "Date"
          , "Title"
          , "Source"
          , "Delete"
          ]
288
      , totalRecords
289 290 291
      }
  ]
  where
292 293
    gi true  = "glyphicon glyphicon-star"
    gi false = "glyphicon glyphicon-star-empty"
294
    toDelete  (DocumentsView {_id}) = Set.member _id documentIdsToDelete
295
    isDeleted (DocumentsView {_id}) = Set.member _id documentIdsDeleted
296
    isFavorite {_id,fav} = maybe fav identity (localFavorites ^. at _id)
297 298
    corpusDocument (Just corpusId) = R.CorpusDocument corpusId
    corpusDocument _ = R.Document
299
    rows = (\(DocumentsView r) ->
300 301
                let isFav = isFavorite r
                    toDel = toDelete $ DocumentsView r in
302 303
                { row:
                    [ div []
304
                      [ a [ className $ gi isFav
305 306
                          , if toDel then style {textDecoration : "line-through"}
                                     else style {textDecoration : "none"}
307
                          , onClick $ (\_-> dispatch $ MarkFavorites r._id (not isFav))] []
308 309
                      ]
                    -- TODO show date: Year-Month-Day only
310
                    , if toDel then
311
                        div [ style {textDecoration : "line-through"}][text (show r.date)]
312
                      else
313
                        div [ ][text (show r.date)]
314 315
                    , if toDel then
                        a [ href (toLink $ (corpusDocument corpusId) listId r._id)
316 317
                          , style {textDecoration : "line-through"}
                          , target "_blank"
318
                        ] [ text r.title ]
319
                      else
320
                        a [ href (toLink $ (corpusDocument corpusId) listId r._id)
321
                        , target "_blank" ] [ text r.title ]
322
                    , if toDel then
323 324 325
                        div [style {textDecoration : "line-through"}] [ text r.source]
                      else
                        div [] [ text r.source]
326
                    , input [ _type "checkbox"
327
                            , checked toDel
328
                            , onClick $ (\_ -> dispatch $ ToggleDocumentToDelete r._id)]
329 330
                    ]
                , delete: true
331
                }) <$> filter (not <<< isDeleted) res
332 333 334 335 336 337 338 339 340

pageLoaderClass :: ReactClass (PageLoaderProps (children :: Children))
pageLoaderClass = Loader.createLoaderClass' "PageLoader" loadPage renderPage

pageLoader :: PageLoaderProps () -> ReactElement
pageLoader props = React.createElement pageLoaderClass props []

---------------------------------------------------------
sampleData' :: DocumentsView
341
sampleData' = DocumentsView {_id : 1, url : "", date : 2010, title : "title", source : "source", fav : false, ngramCount : 1, delete : false}
342 343 344

sampleData :: Array DocumentsView
--sampleData = replicate 10 sampleData'
345
sampleData = map (\(Tuple t s) -> DocumentsView {_id : 1, url : "", date : 2017, title: t, source: s, fav : false, ngramCount : 10, delete : false}) sampleDocuments
346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370

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
  {
    query :: Array String
  , parent_id :: Int
  }


instance encodeJsonSQuery :: EncodeJson SearchQuery where
  encodeJson (SearchQuery post)
     = "query" := post.query
    ~> "parent_id" := post.parent_id
    ~> jsonEmptyObject



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



371
newtype FavoriteQuery = FavoriteQuery
372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404
                        { favorites :: Array Int
                        }

instance encodeJsonFQuery :: EncodeJson FavoriteQuery where
  encodeJson (FavoriteQuery post)
     = "favorites" := post.favorites
       ~> jsonEmptyObject

newtype DeleteDocumentQuery = DeleteDocumentQuery
  {
    documents :: Array Int
  }


instance encodeJsonDDQuery :: EncodeJson DeleteDocumentQuery where
  encodeJson (DeleteDocumentQuery post)
     = "documents" := post.documents
       ~> jsonEmptyObject

putFavorites :: Int -> FavoriteQuery -> Aff (Array Int)
putFavorites nodeId = put (toUrl Back Node (Just nodeId) <> "/favorites")

deleteFavorites :: Int -> FavoriteQuery -> Aff (Array Int)
deleteFavorites nodeId = deleteWithBody (toUrl Back Node (Just nodeId) <> "/favorites")

deleteDocuments :: Int -> DeleteDocumentQuery -> Aff (Array Int)
deleteDocuments nodeId = deleteWithBody (toUrl Back Node (Just nodeId) <> "/documents")

-- 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