FacetsTable.purs 12.6 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)
24
import Gargantext.Hooks.Loader (useLoader)
25
import Gargantext.Components.Search.Types (Category(..), CategoryQuery(..), favCategory, decodeCategory, putCategories)
26
import Gargantext.Components.Table as T
27
import Gargantext.Routes (SessionRoute(Search,NodeAPI))
28
import Gargantext.Sessions (Session, sessionId, post, deleteWithBody)
29
import Gargantext.Types (NodeType(..), OrderBy(..), NodePath(..))
30
import Gargantext.Utils (toggleSet)
31 32 33 34 35 36
import Gargantext.Utils.DecodeMaybe ((.|))
------------------------------------------------------------------------

type NodeID = Int
type TotalRecords = Int

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

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

instance encodeJsonSearchQuery :: EncodeJson SearchQuery where
45 46
  encodeJson (SearchQuery {query})
     = "query"     := query !! 0 -- TODO anoe
47 48 49 50 51 52 53
    ~> jsonEmptyObject

newtype SearchResults = SearchResults { results :: Array Response }

instance decodeSearchResults :: DecodeJson SearchResults where
  decodeJson json = do
    obj     <- decodeJson json
54
    results <- obj .: "results"
55 56 57
    pure $ SearchResults {results}

type Props =
58
  ( nodeId :: Int
59
  , listId :: Int
60
  , query :: TextQuery
61
  , totalRecords :: Int
62 63
  , chart :: R.Element
  , container :: Record T.TableContainerProps -> R.Element
64
  , session :: Session
65
  )
66

67 68
-- | Tracks the ids of documents to delete and that have been deleted
type Deletions = { pending :: Set Int, deleted :: Set Int }
69

70 71
initialDeletions :: Deletions
initialDeletions = { pending: mempty, deleted: mempty }
72

73
newtype Pair = Pair { id :: Int, label :: String }
74 75 76 77 78 79

derive instance genericPair :: Generic Pair _

instance showPair :: Show Pair where
  show = genericShow

80 81 82 83 84 85 86 87 88 89 90
newtype DocumentsView =
  DocumentsView
  { id       :: Int
  , date     :: String
  , title    :: String
  , source   :: String
  , score    :: Int
  , pairs    :: Array Pair
  , delete   :: Boolean
  , category :: Category
  }
91 92 93 94 95 96 97

derive instance genericDocumentsView :: Generic DocumentsView _

instance showDocumentsView :: Show DocumentsView where
  show = genericShow

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

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

--instance decodeHyperdata :: DecodeJson Hyperdata where
--  decodeJson json = do
--    obj    <- decodeJson json
116 117
--    title  <- obj .: "title"
--    source <- obj .: "source"
118 119 120 121 122
--    pure $ Hyperdata { title,source }

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

instance decodeHyperdata :: DecodeJson Hyperdata where
  decodeJson json = do
    obj    <- decodeJson json
    title  <- obj .| "title"
    source <- obj .| "source"
    pure $ Hyperdata { title,source }

134
{-
135 136 137
instance decodeResponse :: DecodeJson Response where
  decodeJson json = do
    obj       <- decodeJson json
138 139
    id        <- obj .: "id"
    -- date      <- obj .: "date" -- TODO
140
    date      <- pure "2018"
141 142 143
    score     <- obj .: "score"
    hyperdata <- obj .: "hyperdata"
    pairs     <- obj .: "pairs"
144
    pure $ Response { id, date, score, hyperdata, pairs }
145
-}
146

147 148 149
instance decodeResponse :: DecodeJson Response where
  decodeJson json = do
    obj        <- decodeJson json
150 151 152 153 154
    id         <- obj .: "id"
    created    <- obj .: "created"
    hyperdata  <- obj .: "hyperdata"
    favorite   <- obj .: "favorite"
    --ngramCount <- obj .: "ngramCount"
155 156
    let ngramCount = 1
    pure $ Response { id, created, hyperdata, category: decodeCategory favorite, ngramCount}
157 158

-- | Main layout of the Documents Tab of a Corpus
159 160 161 162 163
docView :: Record Props -> R.Element
docView props = R.createElement docViewCpt props []

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

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

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

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

230 231
initialPagePath :: {session :: Session, nodeId :: Int, listId :: Int, query :: TextQuery} -> PagePath
initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, query, params: T.initialParams}
232 233

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

252 253 254 255
type PageLayoutProps =
  ( totalRecords :: Int
  , deletions :: R.State Deletions
  , container :: Record T.TableContainerProps -> R.Element
256
  , session :: Session
257 258 259 260
  , path :: R.State PagePath
  )

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

262 263 264 265 266 267 268
-- | 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
269
    cpt {totalRecords, deletions, container, session, path} _ = do
270
      useLoader (fst path) loadPage $ \documents ->
271
        page {totalRecords, deletions, container, session, path, documents}
272 273 274 275 276 277

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

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

316
---------------------------------------------------------
317

318
newtype DeleteDocumentQuery = DeleteDocumentQuery { documents :: Array Int }
319 320

instance encodeJsonDDQuery :: EncodeJson DeleteDocumentQuery where
321 322
  encodeJson (DeleteDocumentQuery {documents}) =
    "documents" := documents ~> jsonEmptyObject
323

324 325
deleteDocuments :: Session -> Int -> DeleteDocumentQuery -> Aff (Array Int)
deleteDocuments session nodeId =
326
  deleteWithBody session $ NodeAPI Node (Just nodeId) "documents"
327