Layout.purs 9.94 KB
Newer Older
arturo's avatar
arturo committed
1 2 3 4 5 6
module Gargantext.Components.Document.Layout
  ( layout
  ) where

import Gargantext.Prelude

7
import Data.Array as A
8
import Data.Map as Map
9
import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe)
arturo's avatar
arturo committed
10
import Data.Ord (greaterThan)
11 12
import Data.Set (Set)
import Data.Set as Set
arturo's avatar
arturo committed
13
import Data.String (length)
arturo's avatar
arturo committed
14 15 16
import Data.String as String
import Data.Tuple.Nested ((/\))
import Gargantext.Components.Annotation.Field as AnnotatedField
17
import Gargantext.Components.Annotation.Types as AFT
arturo's avatar
arturo committed
18 19
import Gargantext.Components.AutoUpdate (autoUpdate)
import Gargantext.Components.Bootstrap as B
arturo's avatar
arturo committed
20
import Gargantext.Components.Bootstrap.Types (ComponentStatus(..), SpinnerTheme(..))
21
import Gargantext.Components.Category (ratingSimpleLoader)
arturo's avatar
arturo committed
22
import Gargantext.Components.Document.Types (DocPath, Document(..), LoadedData, initialState)
23
import Gargantext.Components.GraphQL.Endpoints (getContextNgrams)
24
import Gargantext.Components.NgramsTable.AutoSync (useAutoSync)
arturo's avatar
arturo committed
25
import Gargantext.Components.Node (NodePoly(..))
26
import Gargantext.Config.REST (logRESTError)
27
import Gargantext.Core.NgramsTable.Functions (addNewNgramA, applyNgramsPatches, coreDispatch, findNgramRoot, setTermListA, computeCache)
28
import Gargantext.Core.NgramsTable.Types (CoreAction(..), NgramsTable(..), NgramsTerm, Versioned(..), replace)
arturo's avatar
arturo committed
29
import Gargantext.Hooks.FirstEffect (useFirstEffect')
30 31
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Sessions (Session)
arturo's avatar
arturo committed
32
import Gargantext.Utils ((?))
arturo's avatar
arturo committed
33 34 35 36
import Gargantext.Utils as U
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
37
import Record as Record
38
import Toestand as T
arturo's avatar
arturo committed
39

40 41 42 43
-------------------------------------------------------------------------



arturo's avatar
arturo committed
44 45 46
type Props =
  ( loaded   :: LoadedData
  , path     :: DocPath
47
  , session  :: Session
48
  | Options
arturo's avatar
arturo committed
49 50
  )

51 52 53 54 55 56 57 58 59
type Options =
  ( sideControlsSlot :: Maybe R.Element
  )

options :: Record Options
options =
  { sideControlsSlot: Nothing
  }

arturo's avatar
arturo committed
60
here :: R2.Here
61
here = R2.here "Gargantext.Components.Document.Layout"
arturo's avatar
arturo committed
62

63 64
layout :: forall r. R2.OptLeaf Options Props r
layout = R2.optLeaf layoutCpt options
arturo's avatar
arturo committed
65
layoutCpt :: R.Component Props
66
layoutCpt = here.component "layout" cpt where
67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87
  cpt props@{ path: path@{ listIds
                         , nodeId }
            , session } _ = do
    case A.head listIds of
      Nothing -> pure $ H.div {} [ H.text "No list supplied!" ]
      Just listId ->
        useLoader { errorHandler
                  , loader: \p -> getContextNgrams session p.contextId p.listId
                  , path: { contextId: nodeId, listId }
                  , render: \contextNgrams -> layoutWithContextNgrams $ Record.merge props { contextNgrams } }
    where
      errorHandler = logRESTError here "[layout]"

type WithContextNgramsProps =
  ( contextNgrams :: Array NgramsTerm
  | Props )

layoutWithContextNgrams :: forall r. R2.OptLeaf Options WithContextNgramsProps r
layoutWithContextNgrams = R2.optLeaf layoutWithContextNgramsCpt options
layoutWithContextNgramsCpt :: R.Component WithContextNgramsProps
layoutWithContextNgramsCpt = here.component "layoutWithContextNgrams" cpt where
arturo's avatar
arturo committed
88
  -- Component
89 90
  cpt { contextNgrams
      , path
arturo's avatar
arturo committed
91 92 93 94 95 96 97
      , loaded:
          loaded@{ ngramsTable: Versioned
          { data: initTable }
          , document: NodePoly
            { hyperdata: Document doc
            }
          }
98
      , sideControlsSlot
arturo's avatar
arturo committed
99 100 101 102 103 104 105
      } _ = do
    -- | States
    -- |

    state'@{ ngramsLocalPatch } /\ state <-
      R2.useBox' $ initialState { loaded }

106
    mode' /\ mode <- R2.useBox' AFT.EditionMode
arturo's avatar
arturo committed
107

arturo's avatar
arturo committed
108
    let dispatch = coreDispatch path state
arturo's avatar
arturo committed
109 110 111 112 113 114 115 116
    { onPending, result } <- useAutoSync { state, action: dispatch }

    onPending' <- R2.useLive' onPending
    result'    <- R2.useLive' result

    -- | Computed
    -- |
    let
arturo's avatar
arturo committed
117

arturo's avatar
arturo committed
118 119 120 121
      withAutoUpdate = false

      ngrams = applyNgramsPatches state' initTable

122
      cache = computeCache ngrams $ Set.fromFoldable contextNgrams
123

arturo's avatar
arturo committed
124 125 126 127
      annotate text = AnnotatedField.annotatedField
        { ngrams
        , setTermList
        , text
128
        , mode: mode'
129
        , cache
arturo's avatar
arturo committed
130 131 132 133 134 135 136 137 138 139 140 141
        }

      setTermListOrAddA ngram Nothing        =
        addNewNgramA ngram
      setTermListOrAddA ngram (Just oldList) =
        setTermListA ngram <<< replace oldList

      setTermList ngram mOldList =
        dispatch <<< setTermListOrAddA (findNgramRoot ngrams ngram) mOldList

      hasAbstract =  maybe false (not String.null) doc.abstract

arturo's avatar
arturo committed
142 143 144
    -- | Hooks
    -- |

145 146 147 148 149
    -- R.useEffect' $ do
    --   let NgramsTable { ngrams_repo_elements } = ngrams
    --   here.log2 "[layout] length of ngrams" $ Map.size ngrams_repo_elements
    --   here.log2 "[layout] length of pats" $ A.length cache.pats
    --   here.log2 "[layout] contextNgrams" contextNgrams
arturo's avatar
arturo committed
150

151 152 153 154 155
    -- | Behaviors
    -- |
    let
      onModeChange = read >>> fromMaybe AFT.EditionMode >>> flip T.write_ mode

arturo's avatar
arturo committed
156 157 158 159 160 161 162 163 164 165 166
    -- | Render
    -- |
    pure $

      H.div
      { className: "document-layout" }
      --DEBUG
      --[ H.pre { rows: 30 } [
      --    H.text (stringifyWithIndent 2 (encodeJson (fst state)))
      --  ] ] <>
      [
167
        -- Header
arturo's avatar
arturo committed
168
        H.div
169
        { className: "document-layout__header" }
arturo's avatar
arturo committed
170
        [
171 172
          H.div
          { className: "document-layout__main-controls" }
arturo's avatar
arturo committed
173
          [
174 175
            -- Viewing mode
            B.wad
arturo's avatar
arturo committed
176
            [ "d-flex", "align-items-center", "width-auto" ]
177 178 179 180 181 182 183 184 185 186 187 188
            [
              H.label
              { className: "mr-1"
              }
              [
                B.icon
                { name: "tags" }
              ]
            ,
              B.formSelect
              { value: show mode'
              , callback: onModeChange
189
              , status: Enabled
190 191 192 193 194 195 196 197 198 199 200
              }
              [
                H.option
                { value: show AFT.AdditionMode }
                [ H.text "Add terms only" ]
              ,
                H.option
                { value: show AFT.EditionMode }
                [ H.text "Add and edit terms" ]
              ]
            ]
arturo's avatar
arturo committed
201
          ,
202 203 204 205 206 207 208 209 210 211 212 213 214 215
            R2.when withAutoUpdate $
              -- (?) purpose? would still working with current code?
              autoUpdate
              { duration: 5000
              , effect: dispatch $ Synchronize
                { afterSync: \_ -> pure unit
                }
              }
          -- @NOTE #386: revert manual for automatic sync
          --   syncResetButtons
          --   { afterSync
          --   , ngramsLocalPatch
          --   , performAction: dispatch
          --   }
arturo's avatar
arturo committed
216

arturo's avatar
arturo committed
217 218 219
          ]
        ,
          H.div
220
          { className: "document-layout__side-controls" }
arturo's avatar
arturo committed
221
          [
222
            -- Saving informations
arturo's avatar
arturo committed
223
            H.div
224
            { className: "document-layout__saving" }
arturo's avatar
arturo committed
225
            [
226 227 228 229 230 231 232 233 234
              R2.when' onPending'
              [
                B.spinner
                { theme: GrowTheme
                , className: "document-layout__saving__spinner"
                }
              ]
            ,
              R2.when (not onPending' && isJust result') $
arturo's avatar
arturo committed
235

236 237 238 239 240
                B.icon
                { name: "check"
                , className: "document-layout__saving__icon"
                }
            ]
arturo's avatar
arturo committed
241
          ,
242
            R2.fromMaybe sideControlsSlot identity
arturo's avatar
arturo committed
243
          ]
244
        ]
arturo's avatar
arturo committed
245
      ,
246 247 248 249
        -- Body
        H.div
        { className: "document-layout__body" }
        [
arturo's avatar
arturo committed
250
          H.div
251
          { className: "document-layout__title" }
arturo's avatar
arturo committed
252
          [
253
            annotate doc.title
arturo's avatar
arturo committed
254
          ]
255 256
        ,
          R2.fromMaybe doc.authors \authors ->
arturo's avatar
arturo committed
257 258

            H.div
259
            { className: "document-layout__authors" }
arturo's avatar
arturo committed
260
            [
261 262 263 264 265 266 267 268 269 270
              B.div'
              { className: "document-layout__authors__label" }
              "Authors"
            ,
              H.div
              { className: "document-layout__authors__content" }
              [
                -- @NOTE #386: annotate for "Authors" ngrams list
                annotate (Just authors)
              ]
arturo's avatar
arturo committed
271
            ]
272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297
        ,
          R2.fromMaybe doc.source \source ->

            H.div
            { className: "document-layout__source" }
            [
              B.div'
              { className: "document-layout__source__label" }
              "Source"
            ,
              B.div'
              { className: "document-layout__source__content" }
              source
            ]
        ,
            H.div
            { className: "document-layout__date" }
            [
              B.div'
              { className: "document-layout__date__label" }
              "Date"
            ,
              B.div'
              { className: "document-layout__date__content" }
              (publicationDate $ Document doc)
            ]
298 299 300 301 302
        , case path.mCorpusId of
            Nothing -> H.div {} []
            Just corpusId -> ratingSimpleLoader { docId: path.nodeId
                                                , corpusId
                                                , session: path.session  } []
303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322
        ,
          R2.when hasAbstract $

            H.div
            { className: "document-layout__abstract" }
            [
              B.div'
              { className: "document-layout__separator-label" }
              "Abstract"
            ,
              H.div
              { className: "document-layout__abstract__content" }
              [
                annotate doc.abstract
              ]
            ]
        -- (?) remove "Full text" block (unused feature for now,
        --     see #334)
        -- , H.div { className: "jumbotron" } [ H.p {} [ H.text "Empty Full Text" ] ]
        ]
arturo's avatar
arturo committed
323 324 325 326 327 328 329 330 331 332
      ]


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

publicationDate :: Document -> String
publicationDate (Document {publication_year: Nothing}) = ""
publicationDate (Document {publication_year: Just py, publication_month: Nothing}) = U.zeroPad 2 py
publicationDate (Document {publication_year: Just py, publication_month: Just pm, publication_day: Nothing}) = (U.zeroPad 2 py) <> "-" <> (U.zeroPad 2 pm)
publicationDate (Document {publication_year: Just py, publication_month: Just pm, publication_day: Just pd}) = (U.zeroPad 2 py) <> "-" <> (U.zeroPad 2 pm) <> "-" <> (U.zeroPad 2 pd)