Layout.purs 8.73 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.Maybe (Maybe(..), fromMaybe, isJust, maybe)
arturo's avatar
arturo committed
8 9
import Data.Ord (greaterThan)
import Data.String (length)
arturo's avatar
arturo committed
10 11 12
import Data.String as String
import Data.Tuple.Nested ((/\))
import Gargantext.Components.Annotation.Field as AnnotatedField
13
import Gargantext.Components.Annotation.Types as AFT
arturo's avatar
arturo committed
14 15
import Gargantext.Components.AutoUpdate (autoUpdate)
import Gargantext.Components.Bootstrap as B
arturo's avatar
arturo committed
16
import Gargantext.Components.Bootstrap.Types (ComponentStatus(..), SpinnerTheme(..))
arturo's avatar
arturo committed
17
import Gargantext.Components.Document.Types (DocPath, Document(..), LoadedData, initialState)
18
import Gargantext.Components.NgramsTable.AutoSync (useAutoSync)
arturo's avatar
arturo committed
19
import Gargantext.Components.Node (NodePoly(..))
20
import Gargantext.Core.NgramsTable.Functions (addNewNgramA, applyNgramsPatches, coreDispatch, findNgramRoot, setTermListA)
21
import Gargantext.Core.NgramsTable.Types (CoreAction(..), Versioned(..), replace)
arturo's avatar
arturo committed
22 23
import Gargantext.Hooks.FirstEffect (useFirstEffect')
import Gargantext.Utils ((?))
arturo's avatar
arturo committed
24 25 26 27
import Gargantext.Utils as U
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
28
import Toestand as T
arturo's avatar
arturo committed
29 30 31 32

type Props =
  ( loaded   :: LoadedData
  , path     :: DocPath
33
  | Options
arturo's avatar
arturo committed
34 35
  )

36 37 38 39 40 41 42 43 44
type Options =
  ( sideControlsSlot :: Maybe R.Element
  )

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

arturo's avatar
arturo committed
45 46 47
here :: R2.Here
here = R2.here "Gargantext.Components.Document.layout"

48 49
layout :: forall r. R2.OptLeaf Options Props r
layout = R2.optLeaf layoutCpt options
arturo's avatar
arturo committed
50 51 52 53 54 55 56 57 58 59 60 61

layoutCpt :: R.Component Props
layoutCpt = here.component "main" cpt where
  -- Component
  cpt { path
      , loaded:
          loaded@{ ngramsTable: Versioned
          { data: initTable }
          , document: NodePoly
            { hyperdata: Document doc
            }
          }
62
      , sideControlsSlot
arturo's avatar
arturo committed
63 64 65 66 67 68 69
      } _ = do
    -- | States
    -- |

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

arturo's avatar
arturo committed
70
    mode' /\ mode <- R2.useBox' AFT.AdditionMode
71

arturo's avatar
arturo committed
72
    forceAdditionMode' /\ forceAdditionMode <- R2.useBox' false
arturo's avatar
arturo committed
73

arturo's avatar
arturo committed
74
    let dispatch = coreDispatch path state
arturo's avatar
arturo committed
75 76 77 78 79 80 81 82
    { onPending, result } <- useAutoSync { state, action: dispatch }

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

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

arturo's avatar
arturo committed
84 85 86 87 88 89 90 91
      withAutoUpdate = false

      ngrams = applyNgramsPatches state' initTable

      annotate text = AnnotatedField.annotatedField
        { ngrams
        , setTermList
        , text
92
        , mode: mode'
arturo's avatar
arturo committed
93 94 95 96 97 98 99 100 101 102 103 104
        }

      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
105 106 107 108 109 110 111 112 113 114 115 116 117 118 119
    -- | Hooks
    -- |

    -- (?) Limit large document feature with empirical length value
    --     see #423
    useFirstEffect' do
      let len = maybe 0 (length) doc.abstract
      if (len `greaterThan` 4500)
      then
            T.write_ true forceAdditionMode
        *>  T.write_ AFT.AdditionMode mode
      else
            T.write_ false forceAdditionMode
        *>  T.write_ AFT.EditionMode mode

120 121 122 123 124
    -- | Behaviors
    -- |
    let
      onModeChange = read >>> fromMaybe AFT.EditionMode >>> flip T.write_ mode

arturo's avatar
arturo committed
125 126 127 128 129 130 131 132 133 134 135
    -- | Render
    -- |
    pure $

      H.div
      { className: "document-layout" }
      --DEBUG
      --[ H.pre { rows: 30 } [
      --    H.text (stringifyWithIndent 2 (encodeJson (fst state)))
      --  ] ] <>
      [
136
        -- Header
arturo's avatar
arturo committed
137
        H.div
138
        { className: "document-layout__header" }
arturo's avatar
arturo committed
139
        [
140 141
          H.div
          { className: "document-layout__main-controls" }
arturo's avatar
arturo committed
142
          [
143 144
            -- Viewing mode
            B.wad
arturo's avatar
arturo committed
145
            [ "d-flex", "align-items-center", "width-auto" ]
146 147 148 149 150 151 152 153 154 155 156 157
            [
              H.label
              { className: "mr-1"
              }
              [
                B.icon
                { name: "tags" }
              ]
            ,
              B.formSelect
              { value: show mode'
              , callback: onModeChange
arturo's avatar
arturo committed
158 159 160
              , status: forceAdditionMode' ?
                  Idled $
                  Enabled
161 162 163 164 165 166 167 168 169 170 171
              }
              [
                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
172 173 174 175 176 177 178 179
          ,
            R2.when forceAdditionMode' $

              B.wad
              [ "color-warning", "font-size-100", "mx-2", "inline-block" ]
              [
                H.text "limited term feature due to abstract length"
              ]
arturo's avatar
arturo committed
180
          ,
181 182 183 184 185 186 187 188 189 190 191 192 193 194
            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
195

arturo's avatar
arturo committed
196 197 198
          ]
        ,
          H.div
199
          { className: "document-layout__side-controls" }
arturo's avatar
arturo committed
200
          [
201
            -- Saving informations
arturo's avatar
arturo committed
202
            H.div
203
            { className: "document-layout__saving" }
arturo's avatar
arturo committed
204
            [
205 206 207 208 209 210 211 212 213
              R2.when' onPending'
              [
                B.spinner
                { theme: GrowTheme
                , className: "document-layout__saving__spinner"
                }
              ]
            ,
              R2.when (not onPending' && isJust result') $
arturo's avatar
arturo committed
214

215 216 217 218 219
                B.icon
                { name: "check"
                , className: "document-layout__saving__icon"
                }
            ]
arturo's avatar
arturo committed
220
          ,
221
            R2.fromMaybe sideControlsSlot identity
arturo's avatar
arturo committed
222
          ]
223
        ]
arturo's avatar
arturo committed
224
      ,
225 226 227 228 229 230 231 232
        -- Body
        H.div
        { className: "document-layout__body" }
        [
          B.div'
          { className: "document-layout__separator-label" }
          "Title"
        ,
arturo's avatar
arturo committed
233
          H.div
234
          { className: "document-layout__title" }
arturo's avatar
arturo committed
235
          [
236
            annotate doc.title
arturo's avatar
arturo committed
237
          ]
238 239
        ,
          R2.fromMaybe doc.authors \authors ->
arturo's avatar
arturo committed
240 241

            H.div
242
            { className: "document-layout__authors" }
arturo's avatar
arturo committed
243
            [
244 245 246 247 248 249 250 251 252 253
              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
254
            ]
255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 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 298 299 300
        ,
          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)
            ]
        ,
          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
301 302 303 304 305 306 307 308 309 310
      ]


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

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)