Commit 70eae499 authored by arturo's avatar arturo

[terms] resolve flickering issue on children terms

parent 1211215c
...@@ -3,7 +3,7 @@ module Gargantext.Components.NgramsTable ...@@ -3,7 +3,7 @@ module Gargantext.Components.NgramsTable
, CommonProps , CommonProps
, TreeEdit , TreeEdit
, NgramsTreeEditProps , NgramsTreeEditProps
, getNgramsChildrenAff , getNgramsChildrenAffRequest
, initialTreeEdit , initialTreeEdit
, mainNgramsTable , mainNgramsTable
) where ) where
...@@ -127,7 +127,8 @@ type PreConversionRows = Seq.Seq NgramsElement ...@@ -127,7 +127,8 @@ type PreConversionRows = Seq.Seq NgramsElement
type TableContainerProps = type TableContainerProps =
( addCallback :: String -> Effect Unit ( addCallback :: String -> Effect Unit
, dispatch :: Dispatch , dispatch :: Dispatch
, getNgramsChildren :: NgramsTerm -> Aff (Array NgramsTerm) , getNgramsChildrenAff :: Maybe (NgramsTerm -> Aff (Array NgramsTerm))
, getNgramsChildren :: Maybe (NgramsTerm -> Array NgramsTerm)
, ngramsSelection :: Set NgramsTerm , ngramsSelection :: Set NgramsTerm
, ngramsTable :: NgramsTable , ngramsTable :: NgramsTable
, path :: T.Box PageParams , path :: T.Box PageParams
...@@ -142,7 +143,6 @@ tableContainer p q = R.createElement (tableContainerCpt p) q [] ...@@ -142,7 +143,6 @@ tableContainer p q = R.createElement (tableContainerCpt p) q []
tableContainerCpt :: Record TableContainerProps -> R.Component TT.TableContainerProps tableContainerCpt :: Record TableContainerProps -> R.Component TT.TableContainerProps
tableContainerCpt { addCallback tableContainerCpt { addCallback
, dispatch , dispatch
, getNgramsChildren
, ngramsSelection , ngramsSelection
, ngramsTable: ngramsTableCache , ngramsTable: ngramsTableCache
, path , path
...@@ -506,7 +506,7 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where ...@@ -506,7 +506,7 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
, path , path
, state , state
, tabNgramType , tabNgramType
, treeEdit: treeEdit@{ getNgramsChildren } , treeEdit: treeEdit@{ getNgramsChildrenAff, getNgramsChildren }
, versioned: Versioned { data: initTable } , versioned: Versioned { data: initTable }
} _ = do } _ = do
treeEdit'@{ ngramsParent } <- T.useLive T.unequal treeEdit.box treeEdit'@{ ngramsParent } <- T.useLive T.unequal treeEdit.box
...@@ -566,6 +566,7 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where ...@@ -566,6 +566,7 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
convertRow ngramsElement = convertRow ngramsElement =
{ row: renderNgramsItem { dispatch: performAction { row: renderNgramsItem { dispatch: performAction
, getNgramsChildrenAff
, getNgramsChildren , getNgramsChildren
, isEditing , isEditing
, ngrams: ngramsElement ^. _NgramsElement <<< _ngrams , ngrams: ngramsElement ^. _NgramsElement <<< _ngrams
...@@ -633,6 +634,7 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where ...@@ -633,6 +634,7 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
, container: tableContainer , container: tableContainer
{ addCallback { addCallback
, dispatch: performAction , dispatch: performAction
, getNgramsChildrenAff
, getNgramsChildren , getNgramsChildren
, ngramsSelection , ngramsSelection
, ngramsTable , ngramsTable
...@@ -788,8 +790,8 @@ type MainNgramsTableProps = ( ...@@ -788,8 +790,8 @@ type MainNgramsTableProps = (
| CommonProps | CommonProps
) )
getNgramsChildrenAff :: Session -> NodeID -> Array ListId -> TabType -> NgramsTerm -> Aff (Array NgramsTerm) getNgramsChildrenAffRequest :: Session -> NodeID -> Array ListId -> TabType -> NgramsTerm -> Aff (Array NgramsTerm)
getNgramsChildrenAff session nodeId listIds tabType (NormNgramsTerm ngrams) = do getNgramsChildrenAffRequest session nodeId listIds tabType (NormNgramsTerm ngrams) = do
res :: Either RESTError ({ data :: Array { children :: Array String, ngrams :: String }}) <- get session $ Routes.GetNgrams params (Just nodeId) res :: Either RESTError ({ data :: Array { children :: Array String, ngrams :: String }}) <- get session $ Routes.GetNgrams params (Just nodeId)
case res of case res of
Left err -> pure [] Left err -> pure []
...@@ -846,7 +848,8 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt ...@@ -846,7 +848,8 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt
type NgramsTreeEditProps = type NgramsTreeEditProps =
( box :: T.Box TreeEdit ( box :: T.Box TreeEdit
, getNgramsChildren :: NgramsTerm -> Aff (Array NgramsTerm) , getNgramsChildrenAff :: Maybe (NgramsTerm -> Aff (Array NgramsTerm))
, getNgramsChildren :: Maybe (NgramsTerm -> Array NgramsTerm)
--, ngramsLocalPatch :: T.Box NgramsTablePatch --, ngramsLocalPatch :: T.Box NgramsTablePatch
, onCancelRef :: NgramsActionRef , onCancelRef :: NgramsActionRef
, onNgramsClickRef :: R.Ref (Maybe NgramsClick) , onNgramsClickRef :: R.Ref (Maybe NgramsClick)
...@@ -880,6 +883,7 @@ ngramsTreeEditReal = R2.leaf ngramsTreeEditRealCpt ...@@ -880,6 +883,7 @@ ngramsTreeEditReal = R2.leaf ngramsTreeEditRealCpt
ngramsTreeEditRealCpt :: R.Component NgramsTreeEditRealProps ngramsTreeEditRealCpt :: R.Component NgramsTreeEditRealProps
ngramsTreeEditRealCpt = here.component "ngramsTreeEditReal" cpt where ngramsTreeEditRealCpt = here.component "ngramsTreeEditReal" cpt where
cpt { box cpt { box
, getNgramsChildrenAff
, getNgramsChildren , getNgramsChildren
, ngramsParent' , ngramsParent'
, onCancelRef , onCancelRef
...@@ -938,7 +942,8 @@ ngramsTreeEditRealCpt = here.component "ngramsTreeEditReal" cpt where ...@@ -938,7 +942,8 @@ ngramsTreeEditRealCpt = here.component "ngramsTreeEditReal" cpt where
{ className: "card-body" } { className: "card-body" }
[ [
renderNgramsTree renderNgramsTree
{ getNgramsChildren: gnc { getNgramsChildrenAff: Just gnc
, getNgramsChildren: Nothing
, ngramsClick , ngramsClick
, ngramsDepth , ngramsDepth
, ngramsEdit , ngramsEdit
......
...@@ -3,7 +3,6 @@ module Gargantext.Components.NgramsTable.Tree where ...@@ -3,7 +3,6 @@ module Gargantext.Components.NgramsTable.Tree where
import Gargantext.Prelude import Gargantext.Prelude
import Data.Array as A import Data.Array as A
import Data.Either (Either(..))
import Data.Lens ((^..), (^.), view) import Data.Lens ((^..), (^.), view)
import Data.Lens.Fold (folded) import Data.Lens.Fold (folded)
import Data.Lens.Index (ix) import Data.Lens.Index (ix)
...@@ -12,16 +11,16 @@ import Data.List as L ...@@ -12,16 +11,16 @@ import Data.List as L
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe)
import Data.Set (Set) import Data.Set (Set)
import Data.Set as Set import Data.Set as Set
import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Gargantext.Components.Bootstrap as B import Gargantext.Components.Bootstrap as B
import Gargantext.Components.Bootstrap.Types (ComponentStatus(..), Variant(..)) import Gargantext.Components.Bootstrap.Types (Variant(..))
import Gargantext.Components.Table as Tbl import Gargantext.Components.Table as Tbl
import Gargantext.Config.REST (logRESTError)
import Gargantext.Core.NgramsTable.Functions (applyNgramsPatches, setTermListA, tablePatchHasNgrams) import Gargantext.Core.NgramsTable.Functions (applyNgramsPatches, setTermListA, tablePatchHasNgrams)
import Gargantext.Core.NgramsTable.Types (Action(..), NgramsClick, NgramsDepth, NgramsElement, NgramsTable, NgramsTablePatch, NgramsTerm, _NgramsElement, _NgramsRepoElement, _children, _list, _ngrams, _occurrences, ngramsTermText, replace) import Gargantext.Core.NgramsTable.Types (Action(..), NgramsClick, NgramsDepth, NgramsElement, NgramsTable, NgramsTablePatch, NgramsTerm, _NgramsElement, _NgramsRepoElement, _children, _list, _ngrams, _occurrences, ngramsTermText, replace)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.FirstEffect (useFirstEffect')
import Gargantext.Prelude (Unit, bind, const, map, mempty, not, otherwise, pure, show, unit, ($), (+), (<<<), (<>), (==), (>), (||))
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils ((?)) import Gargantext.Utils ((?))
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -38,7 +37,8 @@ here = R2.here "Gargantext.Components.NgramsTable.Tree" ...@@ -38,7 +37,8 @@ here = R2.here "Gargantext.Components.NgramsTable.Tree"
type RenderNgramsTree = type RenderNgramsTree =
( getNgramsChildren :: NgramsTerm -> Aff (Array NgramsTerm) ( getNgramsChildrenAff :: Maybe (NgramsTerm -> Aff (Array NgramsTerm))
, getNgramsChildren :: Maybe (NgramsTerm -> Array NgramsTerm)
--, ngramsChildren :: List NgramsTerm --, ngramsChildren :: List NgramsTerm
, ngramsClick :: NgramsClick , ngramsClick :: NgramsClick
, ngramsDepth :: NgramsDepth , ngramsDepth :: NgramsDepth
...@@ -53,13 +53,20 @@ renderNgramsTree p = R.createElement renderNgramsTreeCpt p [] ...@@ -53,13 +53,20 @@ renderNgramsTree p = R.createElement renderNgramsTreeCpt p []
renderNgramsTreeCpt :: R.Component RenderNgramsTree renderNgramsTreeCpt :: R.Component RenderNgramsTree
renderNgramsTreeCpt = here.component "renderNgramsTree" cpt renderNgramsTreeCpt = here.component "renderNgramsTree" cpt
where where
cpt { getNgramsChildren, ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle } _ = do cpt { getNgramsChildrenAff
, getNgramsChildren
, ngramsClick
, ngramsDepth
, ngramsEdit
, ngramsStyle
} _ = do
pure $ pure $
H.ul H.ul
{ className: "render-ngrams-tree" } { className: "render-ngrams-tree" }
[ H.span { className: "tree" } [ H.span { className: "tree" }
[ H.span { className: "righthanded" } [ H.span { className: "righthanded" }
[ tree { getNgramsChildren [ tree { getNgramsChildren
, getNgramsChildrenAff
--, ngramsChildren --, ngramsChildren
, ngramsClick , ngramsClick
, ngramsDepth , ngramsDepth
...@@ -88,28 +95,61 @@ tag tagProps = ...@@ -88,28 +95,61 @@ tag tagProps =
-} -}
type TreeProps = type TreeProps =
( getNgramsChildren :: NgramsTerm -> Aff (Array NgramsTerm) ( getNgramsChildrenAff :: Maybe (NgramsTerm -> Aff (Array NgramsTerm))
, getNgramsChildren :: Maybe (NgramsTerm -> Array NgramsTerm)
, ngramsEdit :: NgramsClick , ngramsEdit :: NgramsClick
--, ngramsTable :: NgramsTable --, ngramsTable :: NgramsTable
| TagProps | TagProps
) )
-- | /!\ Multiple issues to deal in this specific component:
-- | - stack of patch surgery: monolitic use of the <doctable> +
-- | design choice of rendering ngrams children on the fly +
-- | setting up a facade for the `getNgramsChildren` thunk ALWAYS as an
-- | `Aff` even if not necessary
-- | - ReactJS re-rendering flaw causing flickering UI effect
-- | - PureScript pattern matching recursive limitation
-- |
-- | ↳ workaround: employ a delegation pattern with the an input bearing
-- | both the `Aff` thunk and a pure one. Note that we could create a
-- | Typing way, due to the PureScript limitation (see above)
tree :: Record TreeProps -> R.Element tree :: Record TreeProps -> R.Element
tree p = R.createElement treeCpt p [] tree p = R.createElement treeCpt p []
treeCpt :: R.Component TreeProps treeCpt :: R.Component TreeProps
treeCpt = here.component "tree" cpt where treeCpt = here.component "tree" cpt where
cpt props@{ getNgramsChildren, ngramsDepth } _ = do cpt props@{ getNgramsChildrenAff
let loader p = do , getNgramsChildren
res <- getNgramsChildren p , ngramsDepth
pure $ Right res } _ = do
let render nc = treeLoaded (Record.merge props { ngramsChildren: L.fromFoldable nc }) -- | States
-- |
useLoader { errorHandler defaultNgramsChildren <- R.useMemo $ const $
, loader maybe
, path: ngramsDepth.ngrams (mempty :: List NgramsTerm)
, render } (\thunk -> L.fromFoldable $ thunk ngramsDepth.ngrams)
where getNgramsChildren
errorHandler = logRESTError here "[tree]"
ngramsChildren /\ ngramsChildren' <-
R2.useBox' (defaultNgramsChildren :: List NgramsTerm)
-- | Hooks
-- |
useFirstEffect' $ maybe
(R.nothing)
(\aff -> launchAff_ do
res <- aff ngramsDepth.ngrams
liftEffect $
flip T.write_ ngramsChildren' $ L.fromFoldable res
)
(getNgramsChildrenAff)
-- | Render
-- |
pure $
treeLoaded (Record.merge props { ngramsChildren })
type TreeLoaded = type TreeLoaded =
( ngramsChildren :: List NgramsTerm ( ngramsChildren :: List NgramsTerm
...@@ -184,7 +224,8 @@ treeLoadedCpt = here.component "treeLoaded" cpt where ...@@ -184,7 +224,8 @@ treeLoadedCpt = here.component "treeLoaded" cpt where
type RenderNgramsItem = type RenderNgramsItem =
( dispatch :: Action -> Effect Unit ( dispatch :: Action -> Effect Unit
, getNgramsChildren :: NgramsTerm -> Aff (Array NgramsTerm) , getNgramsChildrenAff :: Maybe (NgramsTerm -> Aff (Array NgramsTerm))
, getNgramsChildren :: Maybe (NgramsTerm -> Array NgramsTerm)
, isEditing :: T.Box Boolean , isEditing :: T.Box Boolean
, ngrams :: NgramsTerm , ngrams :: NgramsTerm
, ngramsElement :: NgramsElement , ngramsElement :: NgramsElement
...@@ -235,7 +276,8 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt ...@@ -235,7 +276,8 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt
else else
[ [
renderNgramsTree renderNgramsTree
{ getNgramsChildren: getNgramsChildren' { getNgramsChildrenAff: Nothing
, getNgramsChildren: Just $ getNgramsChildren'
, ngramsClick , ngramsClick
, ngramsDepth , ngramsDepth
, ngramsEdit , ngramsEdit
...@@ -261,8 +303,8 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt ...@@ -261,8 +303,8 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt
, ngramsStagePatch: mempty , ngramsStagePatch: mempty
, ngramsValidPatch: mempty , ngramsValidPatch: mempty
, ngramsVersion: 0 } ngramsTable , ngramsVersion: 0 } ngramsTable
getNgramsChildren' :: NgramsTerm -> Aff (Array NgramsTerm) getNgramsChildren' :: NgramsTerm -> Array NgramsTerm
getNgramsChildren' n = pure $ A.fromFoldable $ ngramsChildren n getNgramsChildren' n = A.fromFoldable $ ngramsChildren n
ngramsChildren n = tbl ^.. ix n <<< _NgramsRepoElement <<< _children <<< folded ngramsChildren n = tbl ^.. ix n <<< _NgramsRepoElement <<< _children <<< folded
ngramsClick = ngramsClick =
Just <<< dispatch <<< CoreAction <<< cycleTermListItem <<< view _ngrams Just <<< dispatch <<< CoreAction <<< cycleTermListItem <<< view _ngrams
......
...@@ -131,7 +131,8 @@ ngramsViewCpt = here.component "ngramsView" cpt where ...@@ -131,7 +131,8 @@ ngramsViewCpt = here.component "ngramsView" cpt where
, tabType: TabPairing (TabNgramType $ modeTabType mode) , tabType: TabPairing (TabNgramType $ modeTabType mode)
, tabNgramType: modeTabType' mode , tabNgramType: modeTabType' mode
, treeEdit: { box: treeEditBox , treeEdit: { box: treeEditBox
, getNgramsChildren: \_ -> pure [] , getNgramsChildrenAff: Nothing
, getNgramsChildren: Nothing
, onCancelRef , onCancelRef
, onNgramsClickRef , onNgramsClickRef
, onSaveRef } , onSaveRef }
......
...@@ -161,7 +161,8 @@ ngramsViewCpt = here.component "ngramsView" cpt ...@@ -161,7 +161,8 @@ ngramsViewCpt = here.component "ngramsView" cpt
, tabNgramType , tabNgramType
, tabType , tabType
, treeEdit: { box: treeEditBox , treeEdit: { box: treeEditBox
, getNgramsChildren: \_ -> pure [] , getNgramsChildrenAff: Nothing
, getNgramsChildren: Nothing
, onCancelRef , onCancelRef
, onNgramsClickRef , onNgramsClickRef
, onSaveRef } , onSaveRef }
......
...@@ -121,7 +121,8 @@ ngramsViewCpt = here.component "ngramsView" cpt where ...@@ -121,7 +121,8 @@ ngramsViewCpt = here.component "ngramsView" cpt where
, tabNgramType , tabNgramType
, tabType , tabType
, treeEdit: { box: treeEditBox , treeEdit: { box: treeEditBox
, getNgramsChildren: NT.getNgramsChildrenAff session nodeId listIds tabType , getNgramsChildrenAff: Just $ NT.getNgramsChildrenAffRequest session nodeId listIds tabType
, getNgramsChildren: Nothing
, onCancelRef , onCancelRef
, onNgramsClickRef , onNgramsClickRef
, onSaveRef } , onSaveRef }
......
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