Document.purs 7.36 KB
Newer Older
1
module Gargantext.Components.Nodes.Corpus.Document where
2

3 4
--import Data.Argonaut (encodeJson) -- DEBUG
--import Data.Argonaut.Core (stringifyWithIndent) -- DEBUG
5
import Data.Maybe (Maybe(..), fromMaybe)
6
import Data.Tuple (fst)
7
import Data.Tuple.Nested ((/\))
8
import Effect.Aff (Aff)
9
import Reactix as R
10
import Reactix.DOM.HTML as H
11
import Record as Record
12

13
import Gargantext.Prelude (bind, pure, show, unit, ($), (<>), (<<<))
14

15
import Gargantext.Components.AutoUpdate (autoUpdate)
16
import Gargantext.Components.Search (SearchType(..))
17
import Gargantext.Components.Node (NodePoly(..))
18
import Gargantext.Components.Nodes.Corpus.Document.Types (DocPath, Document(..), LoadedData, NodeDocument, Props, State, initialState)
19
import Gargantext.Components.NgramsTable.Core
20
  ( CoreAction(..), Versioned(..), addNewNgramA, applyNgramsPatches, coreDispatch, loadNgramsTable
21
  , replace, setTermListA, syncResetButtons, findNgramRoot )
James Laver's avatar
James Laver committed
22
import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField
23
import Gargantext.Hooks.Loader (useLoader)
24
import Gargantext.Routes (SessionRoute(..))
25
import Gargantext.Sessions (Session, get, sessionId)
26
import Gargantext.Types (CTabNgramType(..), ListId, NodeID, NodeType(..), TabSubType(..), TabType(..), ScoreType(..))
27
import Gargantext.Utils as U
28
import Gargantext.Utils.Reactix as R2
29

30
thisModule :: String
31 32
thisModule = "Gargantext.Components.Nodes.Corpus.Document"

33 34 35 36 37 38
publicationDate :: Document -> String
publicationDate (Document doc@{publication_year: Nothing}) = ""
publicationDate (Document doc@{publication_year: Just py, publication_month: Nothing}) = U.zeroPad 2 py
publicationDate (Document doc@{publication_year: Just py, publication_month: Just pm, publication_day: Nothing}) = (U.zeroPad 2 py) <> "-" <> (U.zeroPad 2 pm)
publicationDate (Document doc@{publication_year: Just py, publication_month: Just pm, publication_day: Just pd}) = (U.zeroPad 2 py) <> "-" <> (U.zeroPad 2 pm) <> "-" <> (U.zeroPad 2 pd)

39 40
docViewWrapper :: R2.Component Props
docViewWrapper = R.createElement docViewWrapperCpt
41 42

docViewWrapperCpt :: R.Component Props
43
docViewWrapperCpt = R.hooksComponentWithModule thisModule "docViewWrapper" cpt
44
  where
45
    cpt props@{ loaded } _ = do
46 47
      state <- R.useState' $ initialState { loaded }

48
      pure $ docView (Record.merge props { state }) []
49 50 51 52 53 54

type DocViewProps = (
  state :: R.State State
  | Props
  )

55 56
docView :: R2.Component DocViewProps
docView = R.createElement docViewCpt
57 58

docViewCpt :: R.Component DocViewProps
59
docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt
60
  where
61 62
    cpt { path
        , loaded: loaded@{ ngramsTable: Versioned { data: initTable }, document }
63
        , state: state@({ ngramsVersion: version, ngramsLocalPatch } /\ _)
64
        } _children = do
65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80

      let
        afterSync = \_ -> pure unit
        syncResetBtns = [syncResetButtons { afterSync, ngramsLocalPatch
                                          , performAction: dispatch
                                          }]
        withAutoUpdate = false
        autoUpd :: Array R.Element
        autoUpd = if withAutoUpdate then
                     [ autoUpdate { duration: 5000
                                  , effect: dispatch $ Synchronize { afterSync }
                                  }
                     ]
                  else []

      pure $ H.div {} $
81 82 83 84 85 86
        autoUpd <> syncResetBtns <>
        --DEBUG
        --[ H.pre { rows: 30 } [
        --    H.text (stringifyWithIndent 2 (encodeJson (fst state)))
        --  ] ] <>
        [
87
        H.div { className: "container1" }
88
        [
89
          R2.row
90
          [
91
            R2.col 12
92
            [ H.h4 {} [ annotate doc.title ]
93 94
            , H.ul { className: "list-group" }
              [ li' [ H.span {} [ text' doc.source ]
95 96 97
                    , badge "source"
                    ]
              -- TODO add href to /author/ if author present in
98
              , li' [ H.span {} [ text' doc.authors ]
99 100
                    , badge "authors"
                    ]
101
              , li' [ H.span {} [ H.text $ publicationDate $ Document doc ]
102 103 104 105
                    , badge "date"
                    ]
              ]
            , badge "abstract"
106
            , annotate doc.abstract
107 108
            , H.div { className: "jumbotron" }
              [ H.p {} [ H.text "Empty Full Text" ]
109
              ]
110 111
            ]
          ]
112
        ]
113
      ]
114
        where
115
          dispatch = coreDispatch path state
116 117 118 119
          ngrams = applyNgramsPatches (fst state) initTable
          annotate text = AnnotatedField.annotatedField { ngrams
                                                        , setTermList
                                                        , text }
120 121
          badge s = H.span { className: "badge badge-default badge-pill" } [ H.text s ]
          li' = H.li { className: "list-group-item justify-content-between" }
122 123 124 125
          setTermListOrAddA ngram Nothing        = addNewNgramA ngram
          setTermListOrAddA ngram (Just oldList) = setTermListA ngram <<< replace oldList
          setTermList ngram mOldList = dispatch <<< setTermListOrAddA (findNgramRoot ngrams ngram) mOldList
          -- Here the use of findNgramRoot makes that we always target the root of an ngram group.
126
          text' x = H.text $ fromMaybe "Nothing" x
127
          NodePoly {hyperdata: Document doc} = document
128

129
type LayoutProps = (
130 131 132 133
    listId         :: ListId
  , mCorpusId      :: Maybe NodeID
  , nodeId         :: NodeID
  , session        :: Session
134
  )
135

136 137 138 139 140 141 142 143 144 145 146 147 148
documentMainLayout :: R2.Component LayoutProps
documentMainLayout = R.createElement documentMainLayoutCpt

documentMainLayoutCpt :: R.Component LayoutProps
documentMainLayoutCpt = R.hooksComponentWithModule thisModule "documentMainLayout" cpt
  where
    cpt props _ = do
      pure $ R2.row [
        R2.col 10 [
           documentLayout props []
           ]
        ]

149 150
documentLayout :: R2.Component LayoutProps
documentLayout = R.createElement documentLayoutCpt
151 152

documentLayoutCpt :: R.Component LayoutProps
153
documentLayoutCpt = R.hooksComponentWithModule thisModule "documentLayout" cpt
154
  where
155
    cpt props@{ nodeId, session } _ = do
156 157
      let sid = sessionId session

158
      pure $ documentLayoutWithKey (Record.merge props { key: show sid <> "-" <> show nodeId }) []
159 160 161 162 163 164

type KeyLayoutProps = (
  key :: String
  | LayoutProps
  )

165 166
documentLayoutWithKey :: R2.Component KeyLayoutProps
documentLayoutWithKey = R.createElement documentLayoutWithKeyCpt
167 168

documentLayoutWithKeyCpt :: R.Component KeyLayoutProps
169
documentLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "documentLayoutWithKey" cpt
170
  where
171
    cpt { listId, mCorpusId, nodeId, session } _ = do
172
      useLoader path loadData $ \loaded ->
173
        docViewWrapper { loaded, path } []
174 175
      where
        tabType = TabDocument (TabNgramType CTabTerms)
176
        path = { listIds: [listId], mCorpusId, nodeId, session, tabType }
177 178 179

------------------------------------------------------------------------

180
loadDocument :: Session -> Int -> Aff NodeDocument
181
loadDocument session nodeId = get session $ NodeAPI Node (Just nodeId) ""
182

183 184
loadData :: DocPath -> Aff LoadedData
loadData {session, nodeId, listIds, tabType} = do
185
  document <- loadDocument session nodeId
186
  ngramsTable <- loadNgramsTable
187
    { listIds
188
    , nodeId
189
    , params: { offset : 0, limit : 100, orderBy: Nothing, searchType: SearchDoc}
190
    , scoreType: Occurrences
191
    , searchQuery: ""
192 193
    , session
    , tabType
194 195
    , termListFilter: Nothing
    , termSizeFilter: Nothing
196
    }
197
  pure { document, ngramsTable }