Commit 7b97b8dc authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[documents] Refactor Documents view to reactix

parent ccaf9251
...@@ -5,9 +5,13 @@ import Data.Traversable (traverse_) ...@@ -5,9 +5,13 @@ import Data.Traversable (traverse_)
import React as React import React as React
import React (ReactClass, ReactElement, Children) import React (ReactClass, ReactElement, Children)
import React.DOM (div') import React.DOM (div')
import Gargantext.Prelude
import Effect (Effect) import Effect (Effect)
import Effect.Timer (IntervalId, setInterval, clearInterval) import Effect.Timer (IntervalId, TimeoutId, setInterval, clearInterval, setTimeout, clearTimeout)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
data Action = Update data Action = Update
...@@ -27,7 +31,7 @@ autoUpdateClass = ...@@ -27,7 +31,7 @@ autoUpdateClass =
pure { state: {intervalId: Nothing} pure { state: {intervalId: Nothing}
, render: pure $ div' [] , render: pure $ div' []
, componentDidMount: do , componentDidMount: do
{duration,effect} <- React.getProps this {duration, effect} <- React.getProps this
intervalId <- setInterval duration effect intervalId <- setInterval duration effect
React.setState this {intervalId: Just intervalId} React.setState this {intervalId: Just intervalId}
, componentWillUnmount: do , componentWillUnmount: do
...@@ -37,3 +41,25 @@ autoUpdateClass = ...@@ -37,3 +41,25 @@ autoUpdateClass =
autoUpdateElt :: Props -> ReactElement autoUpdateElt :: Props -> ReactElement
autoUpdateElt props = React.createElement autoUpdateClass props [] autoUpdateElt props = React.createElement autoUpdateClass props []
autoUpdate :: Record PropsRow -> R.Element
autoUpdate props = R.createElement autoUpdateCpt props []
autoUpdateCpt :: R.Component PropsRow
autoUpdateCpt = R.hooksComponent "G.C.AU.autoUpdate" cpt
where
cpt { duration, effect } _ = do
intervalRef <- R.useRef Nothing
R.useEffect' $ do
let mInterval = R.readRef intervalRef
case mInterval of
Nothing -> do
intervalId <- setInterval duration effect
R.setRef intervalRef $ Just intervalId
Just intervalId -> do
clearInterval intervalId
intervalId <- setInterval duration effect
R.setRef intervalRef $ Just intervalId
pure $ H.div {} []
...@@ -68,6 +68,10 @@ import Data.Either (Either(..)) ...@@ -68,6 +68,10 @@ import Data.Either (Either(..))
import Data.Foldable (class Foldable, foldMap, foldl, foldr) import Data.Foldable (class Foldable, foldMap, foldl, foldr)
import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlWithIndex, foldrWithIndex) import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlWithIndex, foldrWithIndex)
import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex) import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Ord (genericCompare)
import Data.Generic.Rep.Show (genericShow)
import Data.Lens (Iso', Lens', use, view, (%=), (.~), (?=), (^?)) import Data.Lens (Iso', Lens', use, view, (%=), (.~), (?=), (^?))
import Data.Lens.At (class At, at) import Data.Lens.At (class At, at)
import Data.Lens.Common (_Just) import Data.Lens.Common (_Just)
...@@ -143,8 +147,13 @@ initialPageParams session nodeId listIds tabType = ...@@ -143,8 +147,13 @@ initialPageParams session nodeId listIds tabType =
newtype NgramsTerm = NormNgramsTerm String newtype NgramsTerm = NormNgramsTerm String
derive instance eqNgramsTerm :: Eq NgramsTerm derive instance genericNgramsTerm :: Generic NgramsTerm _
derive instance ordNgramsTerm :: Ord NgramsTerm instance eqNgramsTerm :: Eq NgramsTerm where
eq = genericEq
instance ordNgramsTerm :: Ord NgramsTerm where
compare = genericCompare
instance showNgramsTerm :: Show NgramsTerm where
show = genericShow
instance encodeJsonNgramsTerm :: EncodeJson NgramsTerm where instance encodeJsonNgramsTerm :: EncodeJson NgramsTerm where
encodeJson (NormNgramsTerm s) = encodeJson s encodeJson (NormNgramsTerm s) = encodeJson s
...@@ -692,11 +701,11 @@ syncPatches props { ngramsLocalPatch: ngramsLocalPatch@{ngramsNewElems, ngramsPa ...@@ -692,11 +701,11 @@ syncPatches props { ngramsLocalPatch: ngramsLocalPatch@{ngramsNewElems, ngramsPa
} }
syncPatchesR :: forall p s. CoreParams p -> R.State (CoreState s) -> Effect Unit syncPatchesR :: forall p s. CoreParams p -> R.State (CoreState s) -> Effect Unit
syncPatchesR props ({ ngramsLocalPatch: ngramsLocalPatch@{ngramsNewElems, ngramsPatches} syncPatchesR props ({ ngramsLocalPatch: ngramsLocalPatch@{ ngramsNewElems, ngramsPatches }
, ngramsStagePatch , ngramsStagePatch
, ngramsValidPatch , ngramsValidPatch
, ngramsVersion , ngramsVersion
} /\ setState) = do } /\ setState) = do
when (isEmptyNgramsTablePatch ngramsStagePatch) $ do when (isEmptyNgramsTablePatch ngramsStagePatch) $ do
setState $ \s -> setState $ \s ->
s { ngramsLocalPatch = fromNgramsPatches mempty s { ngramsLocalPatch = fromNgramsPatches mempty
......
module Gargantext.Components.Nodes.Corpus.Document where module Gargantext.Components.Nodes.Corpus.Document where
import Prelude (class Show, bind, mempty, pure, ($), (<>))
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?)) import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import React (ReactClass, Children)
import React.DOM (div, h4, li, p, span, text, ul)
import React.DOM.Props (className)
import Reactix as R import Reactix as R
import Thermite (PerformAction, Render, Spec, simpleSpec, createClass) import Reactix.DOM.HTML as H
import Gargantext.Components.AutoUpdate (autoUpdateElt) import Gargantext.Prelude
import Gargantext.Components.AutoUpdate ( autoUpdate)
import Gargantext.Components.Node (NodePoly(..)) import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.NgramsTable.Core import Gargantext.Components.NgramsTable.Core
( CoreState, NgramsPatch(..), NgramsTerm, Replace, Versioned(..) ( CoreState, NgramsPatch(..), NgramsTerm, Replace, Versioned(..)
, VersionedNgramsTable, addNewNgram, applyNgramsTablePatch, commitPatch , VersionedNgramsTable, addNewNgram, applyNgramsTablePatch, commitPatchR
, loadNgramsTable, replace, singletonNgramsTablePatch, syncPatches ) , loadNgramsTable, replace, singletonNgramsTablePatch, syncPatchesR )
import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
...@@ -27,11 +28,13 @@ import Gargantext.Utils as U ...@@ -27,11 +28,13 @@ import Gargantext.Utils as U
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
type DocPath = type DocPath =
{ nodeId :: Int {
corpusId :: Maybe Int
, listIds :: Array Int , listIds :: Array Int
, corpusId :: Maybe Int , nodeId :: Int
, session :: Session
, tabType :: TabType , tabType :: TabType
, session :: Session } }
type NodeDocument = NodePoly Document type NodeDocument = NodePoly Document
...@@ -40,10 +43,10 @@ type LoadedData = ...@@ -40,10 +43,10 @@ type LoadedData =
, ngramsTable :: VersionedNgramsTable , ngramsTable :: VersionedNgramsTable
} }
type Props = type Props = (
{ loaded :: LoadedData loaded :: LoadedData
, path :: DocPath , path :: DocPath
} )
-- This is a subpart of NgramsTable.State. -- This is a subpart of NgramsTable.State.
type State = CoreState () type State = CoreState ()
...@@ -294,88 +297,104 @@ instance decodeDocument :: DecodeJson Document ...@@ -294,88 +297,104 @@ instance decodeDocument :: DecodeJson Document
--, text --, text
} }
docViewSpec :: Spec State Props Action docViewWrapper :: Record Props -> R.Element
docViewSpec = simpleSpec performAction render docViewWrapper props = R.createElement docViewWrapperCpt props []
docViewWrapperCpt :: R.Component Props
docViewWrapperCpt = R.hooksComponent "G.C.N.C.D.docViewWrapper" cpt
where where
performAction :: PerformAction State Props Action cpt { loaded, path } _ = do
performAction Synchronize {path} state = do state <- R.useState' $ initialState { loaded }
syncPatches path state
performAction (SetTermListItem n pl) _ {ngramsVersion} = pure $ docView { loaded, path, state }
commitPatch (Versioned {version: ngramsVersion, data: pt})
where type DocViewProps = (
pe = NgramsPatch { patch_list: pl, patch_children: mempty } state :: R.State State
pt = singletonNgramsTablePatch n pe | Props
performAction (AddNewNgram ngram termList) _ {ngramsVersion} = )
commitPatch (Versioned {version: ngramsVersion, data: pt})
where docView :: Record DocViewProps -> R.Element
pt = addNewNgram ngram termList docView props = R.createElement docViewCpt props []
render :: Render State Props Action docViewCpt :: R.Component DocViewProps
render dispatch { loaded: { ngramsTable: Versioned { data: initTable }, document } } docViewCpt = R.hooksComponent "G.C.N.C.D.docView" cpt
{ ngramsLocalPatch where
, ngramsValidPatch cpt props@{ loaded: loaded@{ ngramsTable: Versioned { data: initTable }, document }, state } _ = do
} pure $ H.div {} [
_reactChildren = autoUpdate { duration: 3000, effect: dispatch Synchronize }
[ autoUpdateElt { duration: 3000 , H.div { className: "container1" }
, effect: dispatch Synchronize
}
, div [className "container1"]
[ [
div [className "row"] R2.row
[ [
div [className "col-md-8"] R2.col 8
[ h4 [] [annotate doc.title] [ H.h4 {} [ annotate state doc.title ]
, ul [className "list-group"] , H.ul { className: "list-group" }
[ li' [ span [] [text' doc.source] [ li' [ H.span {} [ text' doc.source ]
, badge "source" , badge "source"
] ]
-- TODO add href to /author/ if author present in -- TODO add href to /author/ if author present in
, li' [ span [] [text' doc.authors] , li' [ H.span {} [ text' doc.authors ]
, badge "authors" , badge "authors"
] ]
, li' [ span [] [text $ publicationDate $ Document doc] , li' [ H.span {} [ H.text $ publicationDate $ Document doc ]
, badge "date" , badge "date"
] ]
] ]
, badge "abstract" , badge "abstract"
, annotate doc.abstract , annotate state doc.abstract
, div [className "jumbotron"] , H.div { className: "jumbotron" }
[ p [] [text "Empty Full Text"] [ H.p {} [ H.text "Empty Full Text" ]
] ]
] ]
] ]
] ]
] ]
where where
ngramsTable = applyNgramsTablePatch (ngramsLocalPatch <> ngramsValidPatch) initTable dispatch :: Action -> Effect Unit
setTermList ngram Nothing newList = dispatch $ AddNewNgram ngram newList dispatch (AddNewNgram ngram termList) = do
setTermList ngram (Just oldList) newList = dispatch $ SetTermListItem ngram (replace oldList newList) commitPatchR (Versioned {version, data: pt}) state
annotate text = R2.scuff $ AnnotatedField.annotatedField { ngrams: ngramsTable, setTermList, text } where
li' = li [className "list-group-item justify-content-between"] ({ ngramsVersion: version } /\ _) = state
text' x = text $ fromMaybe "Nothing" x pt = addNewNgram ngram termList
badge s = span [className "badge badge-default badge-pill"] [text s] dispatch (SetTermListItem ngram termList) = do
commitPatchR (Versioned {version, data: pt}) state
where
({ ngramsVersion: version } /\ _) = state
pe = NgramsPatch { patch_list: termList, patch_children: mempty }
pt = singletonNgramsTablePatch ngram pe
dispatch Synchronize = do
syncPatchesR props.path props.state
annotate state text = AnnotatedField.annotatedField { ngrams: ngramsTable state
, setTermList: setTermList state
, text }
badge s = H.span { className: "badge badge-default badge-pill" } [ H.text s ]
li' = H.li { className: "list-group-item justify-content-between" }
ngramsTable ({ ngramsLocalPatch, ngramsValidPatch } /\ _) = applyNgramsTablePatch (ngramsLocalPatch <> ngramsValidPatch) initTable
setTermList state ngram Nothing newList = dispatch (AddNewNgram ngram newList)
setTermList state ngram (Just oldList) newList = dispatch (SetTermListItem ngram (replace oldList newList))
text' x = H.text $ fromMaybe "Nothing" x
NodePoly {hyperdata : Document doc} = document NodePoly {hyperdata : Document doc} = document
docViewClass :: ReactClass { children :: Children type LayoutProps = (
, loaded :: LoadedData corpusId :: Maybe Int
, path :: DocPath , listId :: Int
} , nodeId :: Int
docViewClass = createClass "DocumentView" docViewSpec initialState , session :: Session
)
type LayoutProps = ( session :: Session, nodeId :: Int, listId :: Int, corpusId :: Maybe Int )
documentLayout :: Record LayoutProps -> R.Element documentLayout :: Record LayoutProps -> R.Element
documentLayout props = R.createElement documentLayoutCpt props [] documentLayout props = R.createElement documentLayoutCpt props []
documentLayoutCpt :: R.Component LayoutProps documentLayoutCpt :: R.Component LayoutProps
documentLayoutCpt = R.hooksComponent "G.P.Corpus.Document.documentLayout" cpt documentLayoutCpt = R.hooksComponent "G.C.N.C.D.documentLayout" cpt
where where
cpt {session, nodeId, listId, corpusId} _ = do cpt {session, nodeId, listId, corpusId} _ = do
useLoader path loadData $ \loaded -> useLoader path loadData $ \loaded ->
R2.createElement' docViewClass {path, loaded} [] docViewWrapper {path, loaded}
where where
tabType = TabDocument (TabNgramType CTabTerms) tabType = TabDocument (TabNgramType CTabTerms)
path = {session, nodeId, listIds: [listId], corpusId, tabType} path = { corpusId, listIds: [listId], nodeId, session, tabType }
------------------------------------------------------------------------ ------------------------------------------------------------------------
......
...@@ -253,7 +253,7 @@ row :: Array R.Element -> R.Element ...@@ -253,7 +253,7 @@ row :: Array R.Element -> R.Element
row children = H.div { className: "row" } children row children = H.div { className: "row" } children
col :: Int -> Array R.Element -> R.Element col :: Int -> Array R.Element -> R.Element
col n children = H.div { className : "col-md" <> show n } children col n children = H.div { className : "col-md-" <> show n } children
innerText :: DOM.Element -> String innerText :: DOM.Element -> String
innerText e = e .. "innerText" innerText e = e .. "innerText"
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment