Document.purs 13.1 KB
Newer Older
1
module Gargantext.Pages.Corpus.Document where
2

3

4
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
5
import Data.Generic.Rep (class Generic)
6
import Data.Lens (Lens', lens, (?~))
7
import Data.Generic.Rep.Show (genericShow)
8 9 10
import Data.Map as Map
import Data.Set as Set
import Data.Tuple (Tuple(..))
11 12
import Data.Maybe (Maybe(..), maybe)
import Effect.Aff (Aff)
13
import React (ReactElement)
14 15
import React.DOM (div, h4, li, option, p, span, text, ul)
import React.DOM.Props (className, value)
Sudhir Kumar's avatar
Sudhir Kumar committed
16
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
17
import Unsafe.Coerce (unsafeCoerce)
18 19 20
import Control.Monad.Trans.Class (lift)

import Gargantext.Prelude
21
import Gargantext.Config          (toUrl, NodeType(..), End(..), TabSubType(..), TabType(..), CTabNgramType(..))
22 23
import Gargantext.Config.REST     (get)
import Gargantext.Components.Node (NodePoly(..))
24
import Gargantext.Components.NgramsTable.Core (NgramsTable(..), NgramsElement(..), loadNgramsTable, Versioned(..))
James Laver's avatar
James Laver committed
25
import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField
26
import Gargantext.Types (TermList(..))
James Laver's avatar
James Laver committed
27
import Gargantext.Utils.Reactix ( scuff )
28 29 30 31

nge :: String -> Tuple String NgramsElement
nge word = Tuple word elem where
  elem = NgramsElement
James Laver's avatar
James Laver committed
32
    { ngrams: word, list: StopTerm
33 34 35 36 37 38
    , occurrences: 1, parent: Nothing
    , root: Nothing, children: Set.empty }

testTable :: NgramsTable
testTable = NgramsTable $ Map.fromFoldable $ nge <$> words
  where words = [ "the", "quick", "brown", "fox", "jumped", "over", "lazy", "dog" ]
39

40
type State =
41 42 43
  { document    :: Maybe (NodePoly Document)
  , ngramsTable :: Maybe NgramsTable
  , inputValue  :: String
44
  }
45

46 47
initialState :: {} -> State
initialState {} =
48
  { document: Nothing
49
  , ngramsTable: (Just testTable)
50
  , inputValue: ""
51
  }
52

53
data Action
54
  = Load Int Int
55
  | ChangeString String
56
  | SetInput String
57

58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 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
newtype Status = Status { failed    :: Int
                        , succeeded :: Int
                        , remaining :: Int
                        }

newtype DocumentV3 =
  DocumentV3 { abstract           :: Maybe String
             , authors            :: Maybe String
             --, error              :: Maybe String
             , language_iso2      :: Maybe String
             , language_iso3      :: Maybe String
             , language_name      :: Maybe String
             , publication_date   :: Maybe String
             , publication_day    :: Maybe Int
             , publication_hour   :: Maybe Int
             , publication_minute :: Maybe Int
             , publication_month  :: Maybe Int
             , publication_second :: Maybe Int
             , publication_year   :: Maybe Int
             , realdate_full_     :: Maybe String
             , source             :: Maybe String
             , statuses           :: Maybe (Array Status)
             , title              :: Maybe String
             }

defaultNodeDocumentV3 :: NodePoly DocumentV3
defaultNodeDocumentV3 =
  NodePoly { id : 0
           , typename : 0
           , userId   : 0
           , parentId : 0
           , name     : "Default name"
           , date     : "Default date"
           , hyperdata : defaultDocumentV3
         }

defaultDocumentV3 :: DocumentV3
defaultDocumentV3 =
  DocumentV3 { abstract           : Nothing
             , authors            : Nothing
             --, error              : Nothing
             , language_iso2      : Nothing
             , language_iso3      : Nothing
             , language_name      : Nothing
             , publication_date   : Nothing
             , publication_day    : Nothing
             , publication_hour   : Nothing
             , publication_minute : Nothing
             , publication_month  : Nothing
             , publication_second : Nothing
             , publication_year   : Nothing
             , realdate_full_     : Nothing
             , source             : Nothing
             , statuses           : Nothing
             , title              : Nothing
             }

115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137
data Document
  = Document
    { abstract           :: Maybe String
    , authors            :: Maybe String
    , bdd                :: Maybe String
    , doi                :: Maybe String
    , language_iso2      :: Maybe String
    -- , page               :: Maybe Int
    , publication_date   :: Maybe String
    --, publication_second :: Maybe Int
    --, publication_minute :: Maybe Int
    --, publication_hour   :: Maybe Int
    , publication_day    :: Maybe Int
    , publication_month  :: Maybe Int
    , publication_year   :: Maybe Int
    , source             :: Maybe String
    , institutes         :: Maybe String
    , title              :: Maybe String
    , uniqId             :: Maybe String
    --, url                :: Maybe String
    --, text               :: Maybe String
    }

138 139 140 141 142 143 144 145 146 147 148
defaultNodeDocument :: NodePoly Document
defaultNodeDocument =
  NodePoly { id : 0
           , typename : 0
           , userId   : 0
           , parentId : 0
           , name     : "Default name"
           , date     : "Default date"
           , hyperdata : defaultDocument
         }

149
-- TODO: BUG if DOI does not exist, page is not shown
150 151 152 153 154 155 156
defaultDocument :: Document
defaultDocument =
  Document { abstract           : Nothing
           , authors            : Nothing
           , bdd                : Nothing
           , doi                : Nothing
           , language_iso2      : Nothing
157
           --, page               : Nothing
158
           , publication_date   : Nothing
159 160 161
           --, publication_second : Nothing
           --, publication_minute : Nothing
           --, publication_hour   : Nothing
162 163 164 165
           , publication_day    : Nothing
           , publication_month  : Nothing
           , publication_year   : Nothing
           , source             : Nothing
166
           , institutes         : Nothing
167 168
           , title              : Nothing
           , uniqId             : Nothing
169 170
           --, url                : Nothing
           --, text               : Nothing
171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189
           }

derive instance genericDocument   :: Generic Document   _
derive instance genericDocumentV3 :: Generic DocumentV3 _
derive instance genericStatus     :: Generic Status     _

instance showDocument :: Show Document where
  show = genericShow

instance showDocumentV3 :: Show DocumentV3 where
  show = genericShow

instance showStatus :: Show Status where
  show = genericShow

instance decodeStatus :: DecodeJson Status
  where
    decodeJson json = do
      obj <- decodeJson json
190 191 192
      failed <- obj .: "failed"
      succeeded <- obj .: "succeeded"
      remaining <- obj .: "remaining"
193 194 195 196 197 198 199
      pure $ Status {failed, succeeded, remaining}


instance decodeDocumentV3 :: DecodeJson DocumentV3
  where
    decodeJson json = do
      obj <- decodeJson json
200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216
      abstract <- obj .:? "abstract"
      authors  <- obj .: "authors"
      --error    <- obj .: "error"
      language_iso2 <- obj .: "language_iso2"
      language_iso3 <- obj .: "language_iso3"
      language_name <- obj .: "language_name"
      publication_date   <- obj .: "publication_date"
      publication_day    <- obj .: "publication_day"
      publication_hour   <- obj .: "publication_hour"
      publication_minute <- obj .: "publication_minute"
      publication_month  <- obj .: "publication_month"
      publication_second <- obj .: "publication_second"
      publication_year   <- obj .: "publication_year"
      realdate_full_     <- obj .: "realdate_full_"
      source   <- obj .: "source"
      statuses <- obj .: "statuses"
      title    <- obj .: "title"
217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
      pure $ DocumentV3 { abstract
                        , authors
                        --, error
                        , language_iso2
                        , language_iso3
                        , language_name
                        , publication_date
                        , publication_day
                        , publication_hour
                        , publication_minute
                        , publication_month
                        , publication_second
                        , publication_year
                        , realdate_full_
                        , source
                        , statuses
                        , title
                        }

instance decodeDocument :: DecodeJson Document
  where
    decodeJson json = do
      obj <- decodeJson json
240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258
      abstract <- obj .:? "abstract"
      authors  <- obj .:? "authors"
      bdd      <- obj .:? "bdd"
      doi      <- obj .:? "doi"
      language_iso2 <- obj .:? "language_iso2"
      -- page          <- obj .:? "page"
      publication_date   <- obj .:? "publication_date"
      --publication_second <- obj .:? "publication_second"
      --publication_minute <- obj .:? "publication_minute"
      --publication_hour   <- obj .:? "publication_hour"
      publication_day    <- obj .:? "publication_day"
      publication_month  <- obj .:? "publication_month"
      publication_year   <- obj .:? "publication_year"
      source             <- obj .:? "sources"
      institutes         <- obj .:? "institutes"
      title              <- obj .:? "title"
      uniqId             <- obj .:? "uniqId"
      --url                <- obj .: "url"
      --text               <- obj .: "text"
259 260 261 262 263
      pure $ Document { abstract
                      , authors
                      , bdd
                      , doi
                      , language_iso2
264
                      -- , page
265
                      , publication_date
266 267 268
                      --, publication_second
                      --, publication_minute
                      --, publication_hour
269 270 271 272
                      , publication_day
                      , publication_month
                      , publication_year
                      , source
273
                      , institutes
274 275
                      , title
                      , uniqId
276 277
                      --, url
                      --, text
278 279 280
                      }

------------------------------------------------------------------------
281
performAction :: PerformAction State {} Action
282
performAction (Load lId nId) _ _ = do
283
  node <- lift $ getNode (Just nId)
284
  (Versioned {version:_version, data:table}) <- lift $ loadNgramsTable {nodeId : nId
285
                                  , listIds : [lId]
286 287 288 289 290 291 292 293 294
                                  , params : { offset : 0, limit : 100, orderBy: Nothing}
                                  , tabType : (TabDocument (TabNgramType CTabTerms))
                                  , searchQuery : ""
                                  , termListFilter : Nothing
                                  , termSizeFilter : Nothing
                                   }
  
  void $ modifyState $ _document    ?~ node
  void $ modifyState $ _ngramsTable ?~ table
295
  logs $ "Node Document " <> show nId <> " fetched."
296
performAction (ChangeString ps) _ _ = pure unit
297
performAction (SetInput ps) _ _ = void <$> modifyState $ _ { inputValue = ps }
298

299

300
getNode :: Maybe Int -> Aff (NodePoly Document)
301
getNode = get <<< toUrl Back Node
302

303
_document :: Lens' State (Maybe (NodePoly Document))
304
_document = lens (\s -> s.document) (\s ss -> s{document = ss})
305 306 307 308 309

_ngramsTable :: Lens' State (Maybe NgramsTable)
_ngramsTable = lens (\s -> s.ngramsTable) (\s ss -> s{ngramsTable = ss})


310
------------------------------------------------------------------------
311

312
docview :: Spec State {} Action
313 314
docview = simpleSpec performAction render
  where
315
    render :: Render State {} Action
316
    render dispatch _ state _ =
317
      [
Abinaya Sudhir's avatar
Abinaya Sudhir committed
318
          div [className "container1"]
319 320 321
          [
            div [className "row"]
            [
322
              div [className "col-md-8"]
James Laver's avatar
James Laver committed
323
              [ h4 [] [annotate document.title]
324
              , ul [className "list-group"]
325 326 327 328 329 330 331 332 333 334 335 336
                [ li' [ span [] [text' document.source]
                      , badge "source"
                      ]
                
                -- TODO add href to /author/ if author present in
                , li' [ span [] [text' document.authors]
                      , badge "authors"
                      ]
                
                , li' [ span [] [text' document.publication_date]
                      , badge "date"
                      ]
337
                ]
338
              , badge "abstract"
James Laver's avatar
James Laver committed
339
              , annotate document.abstract
340 341 342
              , div [className "jumbotron"]
                [ p [] [text "Empty Full Text"]
                ]
343
              ]
344 345 346
            ]
          ]
      ]
347
        where
348
          annotate t = scuff $ AnnotatedField.annotatedField { ngrams: maybe (NgramsTable Map.empty) identity state.ngramsTable, text: t }
349 350 351
          li' = li [className "list-group-item justify-content-between"]
          text' x = text $ maybe "Nothing" identity x
          badge s = span [className "badge badge-default badge-pill"] [text s]
352 353
          NodePoly {hyperdata : Document document} = 
            maybe defaultNodeDocument identity state.document
354

355 356 357 358 359
findInDocument :: (Document -> Maybe String) -> State -> Maybe String
findInDocument f state =
  do (NodePoly d) <- state.document
     f d.hyperdata

360
aryPS :: Array String
361
aryPS = ["Map", "Main", "Stop"]
362 363 364 365 366 367 368 369

aryPS1 :: Array String
aryPS1 = ["Nothing Selected","STOPLIST", "MAINLIST", "MAPLIST"]


optps :: String -> ReactElement
optps val = option [ value  val ] [text  val]

370 371
unsafeEventValue :: forall event. event -> String
unsafeEventValue e = (unsafeCoerce e).target.value