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

type NodeID = Int
type TotalRecords = Int

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

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

instance encodeJsonSearchQuery :: EncodeJson SearchQuery where
46 47
  encodeJson (SearchQuery {query})
     = "query"     := query !! 0 -- TODO anoe
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 93
  , score    :: Int
  , pairs    :: Array Pair
  , delete   :: Boolean
  , category :: Category
  }
94 95 96 97 98 99 100

derive instance genericDocumentsView :: Generic DocumentsView _

instance showDocumentsView :: Show DocumentsView where
  show = genericShow

newtype Response = Response
101 102 103
  { id         :: Int
  , created    :: String
  , hyperdata  :: Hyperdata
104
  , category   :: Category
105 106 107 108
  , ngramCount :: Int
-- , date      :: String
-- , score     :: Int
-- , pairs     :: Array Pair
109 110 111
  }

newtype Hyperdata = Hyperdata
112 113 114
  { authors :: String
  , title   :: String
  , source  :: String
115 116 117 118 119
  }

--instance decodeHyperdata :: DecodeJson Hyperdata where
--  decodeJson json = do
--    obj    <- decodeJson json
120 121
--    title  <- obj .: "title"
--    source <- obj .: "source"
122 123 124 125 126
--    pure $ Hyperdata { title,source }

instance decodePair :: DecodeJson Pair where
  decodeJson json = do
    obj   <- decodeJson json
127 128
    id    <- obj .: "id"
    label <- obj .: "label"
129 130 131 132 133
    pure $ Pair { id, label }

instance decodeHyperdata :: DecodeJson Hyperdata where
  decodeJson json = do
    obj    <- decodeJson json
134
    authors <- obj .| "authors"
135 136
    title  <- obj .| "title"
    source <- obj .| "source"
137
    pure $ Hyperdata { authors, title,source }
138

139
{-
140 141 142
instance decodeResponse :: DecodeJson Response where
  decodeJson json = do
    obj       <- decodeJson json
143 144
    id        <- obj .: "id"
    -- date      <- obj .: "date" -- TODO
145
    date      <- pure "2018"
146 147 148
    score     <- obj .: "score"
    hyperdata <- obj .: "hyperdata"
    pairs     <- obj .: "pairs"
149
    pure $ Response { id, date, score, hyperdata, pairs }
150
-}
151

152 153 154
instance decodeResponse :: DecodeJson Response where
  decodeJson json = do
    obj        <- decodeJson json
155 156 157 158 159
    id         <- obj .: "id"
    created    <- obj .: "created"
    hyperdata  <- obj .: "hyperdata"
    favorite   <- obj .: "favorite"
    --ngramCount <- obj .: "ngramCount"
160 161
    let ngramCount = 1
    pure $ Response { id, created, hyperdata, category: decodeCategory favorite, ngramCount}
162 163

-- | Main layout of the Documents Tab of a Corpus
164 165 166 167 168
docView :: Record Props -> R.Element
docView props = R.createElement docViewCpt props []

docViewCpt :: R.Component Props
docViewCpt = R.hooksComponent "G.C.FacetsTable.DocView" cpt
169
  where
170
    cpt {frontends, session, nodeId, listId, query, totalRecords, chart, container} _ = do
171
      deletions <- R.useState' initialDeletions
172
      path <- R.useState' $ initialPagePath {nodeId, listId, query, session}
173 174
      pure $ H.div { className: "container1" }
        [ H.div { className: "row" }
175
          [ chart
176
          , H.div { className: "col-md-12" }
177
            [ pageLayout { deletions, frontends, totalRecords, container, session, path } ]
178 179 180 181 182 183 184 185 186
          , 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" }
187
          trashClick deletions _ = performDeletions session nodeId deletions
188

189 190
performDeletions :: Session -> Int -> R.State Deletions -> Effect Unit
performDeletions session nodeId (deletions /\ setDeletions) =
191
  launchAff_ call *> setDeletions del
192
  where
193
    q = {documents: Set.toUnfoldable deletions.pending}
194
    call = deleteDocuments session nodeId (DeleteDocumentQuery q)
195 196
    del {pending, deleted} = {pending: mempty, deleted: deleted <> pending}

197 198 199
markCategory :: Session -> NodeID -> Category -> Array NodeID -> Effect Unit
markCategory session nodeId category nids =
  void $ launchAff_ $putCategories session nodeId (CategoryQuery q)
200 201 202 203 204 205 206 207 208 209 210 211 212
  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
213
    cpt {frontends, session, nodeId, listId, query, totalRecords, chart, container} _ = do
214 215 216
      deletions <- R.useState' initialDeletions
      let buttonStyle = { backgroundColor: "peru", padding : "9px"
                        , color : "white", border : "white", float: "right"}
217 218
      let performClick = \_ -> performDeletions session nodeId deletions
      path <- R.useState' $ initialPagePath { nodeId, listId, query, session }
219 220 221 222 223 224 225 226
      pure $ R.fragment
        [ H.br {}
        , H.p {} [ H.text "" ]
        , H.br {}
        , H.div { className: "container-fluid" }
          [ H.div { className: "row" }
            [ chart
            , H.div { className: "col-md-12" }
227
              [ pageLayout { frontends, totalRecords, deletions, container, session, path }
228 229 230 231 232
              , H.button { style: buttonStyle, on: { click: performClick } }
                [ H.i { className: "glyphitem glyphicon glyphicon-trash"
                      , style: { marginRight : "9px" } } []
                , H.text "Delete document!" ] ] ] ] ]

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

235 236
initialPagePath :: {session :: Session, nodeId :: Int, listId :: Int, query :: TextQuery} -> PagePath
initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, query, params: T.initialParams}
237 238

loadPage :: PagePath -> Aff (Array DocumentsView)
239 240
loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy}} = do
  liftEffect $ log "loading documents page: loadPage with Offset and limit"
241 242
  let p = Search { listId, offset, limit, orderBy: convOrderBy <$> orderBy } (Just nodeId)
  SearchResults res <- post session p $ SearchQuery {query}
243 244 245
  pure $ res2corpus <$> res.results
  where
    res2corpus :: Response -> DocumentsView
246
    res2corpus (Response { id, created: date, ngramCount: score, category
247 248
                         , hyperdata: Hyperdata {authors, title, source} }) =
      DocumentsView { id, date, title, source, score, authors, category, pairs: [], delete: false }
249 250 251 252
    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
253 254
    convOrderBy (T.ASC  (T.ColumnName "Source")) = SourceAsc
    convOrderBy (T.DESC (T.ColumnName "Source")) = SourceDesc
255 256
    convOrderBy _ = DateAsc -- TODO

257
type PageLayoutProps =
258 259
  ( frontends :: Frontends
  , totalRecords :: Int
260 261
  , deletions :: R.State Deletions
  , container :: Record T.TableContainerProps -> R.Element
262
  , session :: Session
263 264 265 266
  , path :: R.State PagePath
  )

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

268 269 270 271 272 273 274
-- | 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
275
    cpt {frontends, totalRecords, deletions, container, session, path} _ = do
276
      useLoader (fst path) loadPage $ \documents ->
277
        page {frontends, totalRecords, deletions, container, session, path, documents}
278 279 280 281 282 283

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

pageCpt :: R.Component PageProps
pageCpt = R.staticComponent "G.C.FacetsTable.Page" cpt
284
  where
285
    cpt {frontends, totalRecords, container, deletions, documents, session, path: path@({nodeId, listId, query} /\ setPath)} _ = do
286
      T.table { rows, container, colNames, totalRecords, params, wrapColElts}
287
      where
288 289
        setParams f = setPath $ \p@{params: ps} -> p {params = f ps}
        params = (fst path).params /\ setParams
290
        colNames = T.ColumnName <$> [ "", "Date", "Title", "Source", "Authors", "Delete" ]
291
        wrapColElts = const identity
292 293 294 295 296 297 298
        -- 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
299
            where href = url session $ NodePath (sessionId session) NodeContact (Just id)
300
          | otherwise = H.text label
301 302
        documentUrl id =
            url frontends $ Routes.CorpusDocument (sessionId session) nodeId listId id
303 304
        comma = H.span {} [ H.text ", " ]
        rows = row <$> filter (not <<< isDeleted) documents
305 306
        row dv@(DocumentsView {id,score,title,source,date, authors,pairs,delete,category}) =
          { row:
307
            [ H.div {} [ H.a { className: gi category, on: {click: markClick} } [] ]
308 309
              -- TODO show date: Year-Month-Day only
            , maybeStricken delete [ H.text date ]
310
            , maybeStricken delete [ H.a {target: "_blank", href: documentUrl id} [ H.text title ] ]
311 312 313 314 315 316
            , 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 } }
            ]
          , delete: true }
317
          where
318 319 320 321 322
            markClick _ = markCategory session nodeId category [id]
            toggleClick _ = togglePendingDeletion deletions id
        maybeStricken delete
          | delete = H.div { style: { textDecoration: "line-through" } }
          | otherwise = H.div {}
323

324
---------------------------------------------------------
325

326
newtype DeleteDocumentQuery = DeleteDocumentQuery { documents :: Array Int }
327 328

instance encodeJsonDDQuery :: EncodeJson DeleteDocumentQuery where
329 330
  encodeJson (DeleteDocumentQuery {documents}) =
    "documents" := documents ~> jsonEmptyObject
331

332 333
deleteDocuments :: Session -> Int -> DeleteDocumentQuery -> Aff (Array Int)
deleteDocuments session nodeId =
334
  deleteWithBody session $ NodeAPI Node (Just nodeId) "documents"
335