DocsTable.purs 16.1 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 43 44 45 46
import Thermite (PerformAction, Render, Spec, defaultPerformAction, modifyState_, simpleSpec, hideState)
------------------------------------------------------------------------
-- TODO: Search is pending
-- TODO: Fav is pending
-- TODO: Sort is Pending
-- TODO: Filter is Pending
47 48 49 50 51

type NodeID = Int
type TotalRecords = Int

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

type State =
  { documentIdsToDelete :: Set Int
63
  , documentIdsDeleted  :: Set Int
64
  , localFavorites      :: Map Int Boolean
65 66 67 68 69
  }

initialState :: State
initialState =
  { documentIdsToDelete: mempty
70
  , documentIdsDeleted:  mempty
71
  , localFavorites:      mempty
72 73
  }

74
_documentIdsToDelete = prop (SProxy :: SProxy "documentIdsToDelete")
75 76
_documentIdsDeleted  = prop (SProxy :: SProxy "documentIdsDeleted")
_localFavorites      = prop (SProxy :: SProxy "localFavorites")
77

78
data Action
79
  = MarkFavorites Int Boolean
80 81 82 83 84 85 86
  | ToggleDocumentToDelete Int
  | Trash

newtype DocumentsView
  = DocumentsView
    { _id    :: Int
    , url    :: String
87
    , date   :: Int
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
    , 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
113
  , pub_year   :: Int
114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135
  }

--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
136 137 138 139
    title  <- obj .? "title"
    source <- obj .? "source"
    pub_year <- obj .? "publication_year"
    pure $ Hyperdata { title,source, pub_year}
140 141 142 143 144

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



-- | Filter
153
filterSpec :: forall state props action. Spec state props action
154 155
filterSpec = simpleSpec defaultPerformAction render
  where
156
    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
157
                     , input [className "form-control", placeholder "Filter here"]
158
                     ]] -}
159 160 161 162

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

163
-- | Main layout of the Documents Tab of a Corpus
164 165 166 167
layoutDocview :: Spec State Props Action
layoutDocview = simpleSpec performAction render
  where
    performAction :: PerformAction State Props Action
168 169 170 171 172
    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]})
173 174
    performAction (ToggleDocumentToDelete nid) _ _ =
      modifyState_ \state -> state {documentIdsToDelete = toggleSet nid state.documentIdsToDelete}
175
    performAction Trash {nodeId} {documentIdsToDelete} = do
176
      void $ lift $ deleteDocuments nodeId (DeleteDocumentQuery {documents: Set.toUnfoldable documentIdsToDelete})
177 178 179
      modifyState_ $
        (_documentIdsToDelete .~ mempty) >>>
        (_documentIdsDeleted <>~ documentIdsToDelete)
180 181

    render :: Render State Props Action
182
    render dispatch {nodeId, tabType, listId, totalRecords, chart} deletionState _ =
183
      [ {- br'
Sudhir Kumar's avatar
Sudhir Kumar committed
184 185 186 187
      , div [ style {textAlign : "center"}] [ text "    Filter "
                     , input [className "form-control", style {width : "120px", display : "inline-block"}, placeholder "Filter here"]
                     ]
      , p [] [text ""]
188
      , br'
189 190
      -}
      div [className "container1"]
191
        [ div [className "row"]
192 193
          [ chart
          , div [className "col-md-12"]
194
            [ pageLoader
195 196
                { path: initialPageParams {nodeId, tabType, listId}
                , listId
197
                , totalRecords
198
                , deletionState
199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216
                , 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

217
type PageParams = {nodeId :: Int, listId :: Int, tabType :: TabType, params :: T.Params}
218

219 220 221
initialPageParams :: {nodeId :: Int, listId :: Int, tabType :: TabType} -> PageParams
initialPageParams {nodeId, listId, tabType} =
  {nodeId, tabType, listId, params: T.initialParams}
222 223

loadPage :: PageParams -> Aff (Array DocumentsView)
224
loadPage {nodeId, tabType, listId, params: {limit, offset, orderBy}} = do
225
  logs "loading documents page: loadPage with Offset and limit"
226
  res <- get $ toUrl Back (Tab tabType offset limit (convOrderBy <$> orderBy)) (Just nodeId)
227 228 229 230 231 232 233 234 235 236 237
  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    : ""
238
      , date   : (\(Hyperdata hr) -> hr.pub_year) r.hyperdata
239 240 241 242 243 244
      , title  : (\(Hyperdata hr) -> hr.title) r.hyperdata
      , source : (\(Hyperdata hr) -> hr.source) r.hyperdata
      , fav    : r.favorite
      , ngramCount : r.ngramCount
      , delete : false
     }
245 246
    convOrderBy (T.ASC  (T.ColumnName "Date"))  = DateAsc
    convOrderBy (T.DESC (T.ColumnName "Date"))  = DateDesc
247 248
    convOrderBy (T.ASC  (T.ColumnName "Title")) = TitleAsc
    convOrderBy (T.DESC (T.ColumnName "Title")) = TitleDesc
249 250
    convOrderBy (T.ASC  (T.ColumnName "Source")) = SourceAsc
    convOrderBy (T.DESC (T.ColumnName "Source")) = SourceDesc
251 252 253 254 255

    convOrderBy _ = DateAsc -- TODO

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

renderPage :: forall props path.
264
              Render (Loader.State {nodeId :: Int, listId :: Int, tabType :: TabType | path} (Array DocumentsView))
265
                     { totalRecords :: Int
266
                     , dispatch :: Action -> Effect Unit
267
                     , deletionState :: State
268
                     , listId :: Int
269 270 271 272
                     | props
                     }
                     (Loader.Action PageParams)
renderPage _ _ {loaded: Nothing} _ = [] -- TODO loading spinner
273
renderPage loaderDispatch { totalRecords, dispatch, listId
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, 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 292 293
      }
  ]
  where
    fa true  = "fas "
    fa false = "far "
294
    isChecked _id = Set.member _id documentIdsToDelete
295
    toDelete  (DocumentsView {_id}) = Set.member _id documentIdsToDelete
296
    isDeleted (DocumentsView {_id}) = Set.member _id documentIdsDeleted
297
    isFavorite {_id,fav} = maybe fav identity (localFavorites ^. at _id)
298
    rows = (\(DocumentsView r) ->
299
                let isFav = isFavorite r in
300 301
                { row:
                    [ div []
302 303
                      [ a [ className $ fa isFav <> "fa-star"
                          , if (toDelete $ DocumentsView r) then style {textDecoration : "line-through"}
304
                                                            else style {textDecoration : "none"}
305
                          , onClick $ (\_-> dispatch $ MarkFavorites r._id (not isFav))] []
306 307
                      ]
                    -- TODO show date: Year-Month-Day only
308
                    , if (toDelete $ DocumentsView r) then
309
                        div [ style {textDecoration : "line-through"}][text (show r.date)]
310
                      else
311
                        div [ ][text (show r.date)]
312
                    , if (toDelete $ DocumentsView r) then
313
                        a [ href (toLink $ R.Document listId r._id)
314 315
                          , style {textDecoration : "line-through"}
                          , target "_blank"
316
                        ] [ text r.title ]
317
                      else
318
                        a [ href (toLink $  R.Document listId r._id)
319
                        , target "_blank" ] [ text r.title ]
320
                    , if (toDelete $ DocumentsView r) then
321 322 323
                        div [style {textDecoration : "line-through"}] [ text r.source]
                      else
                        div [] [ text r.source]
324 325 326
                    , input [ _type "checkbox"
                            , checked (isChecked r._id)
                            , onClick $ (\_ -> dispatch $ ToggleDocumentToDelete r._id)]
327 328
                    ]
                , delete: true
329
                }) <$> filter (not <<< isDeleted) res
330 331 332 333 334 335 336 337 338

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

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

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

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

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



369
newtype FavoriteQuery = FavoriteQuery
370 371 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
                        { 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