DocsTable.purs 15.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.Symbol (SProxy(..))
23 24 25 26 27 28 29 30
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
31
import Gargantext.Config (End(..), NodeType(..), OrderBy(..), Path(..), TabType, toUrl)
32 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 ((.|))
import React.DOM (a, br', button, div, i, input, p, text)
38
import React.DOM.Props (_type, className, href, onClick, placeholder, style, checked, target)
39 40 41 42 43 44
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
45 46 47 48 49 50 51 52 53 54 55 56

type NodeID = Int
type TotalRecords = Int

type Props =
  { nodeId :: Int
  , totalRecords :: Int
  , chart :: ReactElement
  , tabType :: TabType
  -- ^ 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 72 73 74
_documentIdsToDelete = prop (SProxy :: SProxy "documentIdsToDelete")
_documentIdsDeleted = prop (SProxy :: SProxy "documentIdsDeleted")
_localFavorites = prop (SProxy :: SProxy "localFavorites")

75
data Action
76
  = MarkFavorites Int Boolean
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
  | ToggleDocumentToDelete Int
  | Trash

newtype DocumentsView
  = DocumentsView
    { _id    :: Int
    , url    :: String
    , date   :: String
    , 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
  , created    :: String
  , hyperdata  :: Hyperdata
  , favorite   :: Boolean
  , ngramCount :: Int
  }


newtype Hyperdata = Hyperdata
  { title  :: String
  , source :: String
  }

--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
    title  <- obj .| "title"
    source <- obj .| "source"
    pure $ Hyperdata { title,source }

instance decodeResponse :: DecodeJson Response where
  decodeJson json = do
    obj        <- decodeJson json
    cid        <- obj .? "id"
Alexandre Delanoë's avatar
Alexandre Delanoë committed
141
    created    <- pure "2019"
142
    --created    <- obj .? "date"
143
    favorite   <- obj .? "favorite"
144 145 146 147 148 149 150
    ngramCount <- obj .? "id"
    hyperdata  <- obj .? "hyperdata"
    pure $ Response { cid, created, favorite, ngramCount, hyperdata }



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

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

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

    render :: Render State Props Action
181
    render dispatch {nodeId, tabType, totalRecords, chart} deletionState _ =
182
      [ {- br'
Sudhir Kumar's avatar
Sudhir Kumar committed
183 184 185 186
      , div [ style {textAlign : "center"}] [ text "    Filter "
                     , input [className "form-control", style {width : "120px", display : "inline-block"}, placeholder "Filter here"]
                     ]
      , p [] [text ""]
187
      , br'
188 189
      -}
      div [className "container1"]
190
        [ div [className "row"]
191 192
          [ chart
          , div [className "col-md-12"]
193
            [ pageLoader
194 195
                { path: initialPageParams {nodeId, tabType}
                , 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, tabType :: TabType, params :: T.Params}
216

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

loadPage :: PageParams -> Aff (Array DocumentsView)
221
loadPage {nodeId, tabType, params: {limit, offset, orderBy}} = do
222
  logs "loading documents page: loadPage with Offset and limit"
223
  res <- get $ toUrl Back (Tab tabType offset limit (convOrderBy <$> orderBy)) (Just nodeId)
224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250
  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    : ""
      , date   :  r.created
      , title  : (\(Hyperdata hr) -> hr.title) r.hyperdata
      , source : (\(Hyperdata hr) -> hr.source) r.hyperdata
      , fav    : r.favorite
      , ngramCount : r.ngramCount
      , delete : false
     }
    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

    convOrderBy _ = DateAsc -- TODO

type PageLoaderProps row =
  { path :: PageParams
251
  , totalRecords :: Int
252
  , dispatch :: Action -> Effect Unit
253
  , deletionState :: State
254 255 256 257
  | row
  }

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

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

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

---------------------------------------------------------
sampleData' :: DocumentsView
sampleData' = DocumentsView {_id : 1, url : "", date : "date3", title : "title", source : "source", fav : false, ngramCount : 1, delete : false}

sampleData :: Array DocumentsView
--sampleData = replicate 10 sampleData'
sampleData = map (\(Tuple t s) -> DocumentsView {_id : 1, url : "", date : "2017", title: t, source: s, fav : false, ngramCount : 10, delete : false}) sampleDocuments

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



356
newtype FavoriteQuery = FavoriteQuery
357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389
                        { 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