Commit 2785cff9 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[ngramsTable] WIP

parent 55f5754c
Pipeline #2906 failed with stage
...@@ -2,6 +2,7 @@ module Gargantext.Components.NgramsTable ...@@ -2,6 +2,7 @@ module Gargantext.Components.NgramsTable
( MainNgramsTableProps ( MainNgramsTableProps
, CommonProps , CommonProps
, TreeEdit , TreeEdit
, NgramsTreeEditProps
, initialTreeEdit , initialTreeEdit
, mainNgramsTable , mainNgramsTable
) where ) where
...@@ -9,6 +10,7 @@ module Gargantext.Components.NgramsTable ...@@ -9,6 +10,7 @@ module Gargantext.Components.NgramsTable
import Gargantext.Prelude import Gargantext.Prelude
import Data.Array as A import Data.Array as A
import Data.Either (Either(..))
import Data.FunctorWithIndex (mapWithIndex) import Data.FunctorWithIndex (mapWithIndex)
import Data.Lens (to, view, (%~), (.~), (^.), (^?), (^..)) import Data.Lens (to, view, (%~), (.~), (^.), (^?), (^..))
import Data.Lens.At (at) import Data.Lens.At (at)
...@@ -33,7 +35,7 @@ import Gargantext.Components.App.Store (Boxes) ...@@ -33,7 +35,7 @@ import Gargantext.Components.App.Store (Boxes)
import Gargantext.Components.Bootstrap as B import Gargantext.Components.Bootstrap as B
import Gargantext.Components.Bootstrap.Types (ButtonVariant(..), Variant(..)) import Gargantext.Components.Bootstrap.Types (ButtonVariant(..), Variant(..))
import Gargantext.Components.NgramsTable.Components as NTC import Gargantext.Components.NgramsTable.Components as NTC
import Gargantext.Components.NgramsTable.Core (Action(..), CoreAction(..), CoreState, Dispatch, NgramsClick, NgramsDepth, NgramsElement(..), NgramsPatch(..), NgramsTable, NgramsTerm, PageParams, PatchMap(..), Versioned(..), VersionedNgramsTable, VersionedWithCountNgramsTable, _NgramsElement, _NgramsRepoElement, _NgramsTable, _children, _list, _ngrams, _ngrams_repo_elements, _ngrams_scores, _occurrences, _root, addNewNgramA, applyNgramsPatches, applyPatchSet, chartsAfterSync, commitPatch, convOrderBy, coreDispatch, filterTermSize, fromNgramsPatches, ngramsRepoElementToNgramsElement, ngramsTermText, normNgram, patchSetFromMap, replace, setTermListA, singletonNgramsTablePatch, syncResetButtons, toVersioned) import Gargantext.Components.NgramsTable.Core (Action(..), CoreAction(..), CoreState, Dispatch, NgramsActionRef, NgramsClick, NgramsDepth, NgramsElement(..), NgramsPatch(..), NgramsTable, NgramsTerm, PageParams, PatchMap(..), Versioned(..), VersionedNgramsTable, VersionedWithCountNgramsTable, _NgramsElement, _NgramsRepoElement, _NgramsTable, _children, _list, _ngrams, _ngrams_repo_elements, _ngrams_scores, _occurrences, _root, addNewNgramA, applyNgramsPatches, applyPatchSet, chartsAfterSync, commitPatch, convOrderBy, coreDispatch, filterTermSize, fromNgramsPatches, ngramsRepoElementToNgramsElement, ngramsTermText, normNgram, patchSetFromMap, replace, setTermListA, singletonNgramsTablePatch, syncResetButtons, toVersioned)
import Gargantext.Components.NgramsTable.Loader (useLoaderWithCacheAPI) import Gargantext.Components.NgramsTable.Loader (useLoaderWithCacheAPI)
import Gargantext.Components.Nodes.Lists.Types as NT import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Table as TT import Gargantext.Components.Table as TT
...@@ -42,7 +44,7 @@ import Gargantext.Config.REST (AffRESTError, logRESTError) ...@@ -42,7 +44,7 @@ import Gargantext.Config.REST (AffRESTError, logRESTError)
import Gargantext.Hooks.Loader (useLoaderBox) import Gargantext.Hooks.Loader (useLoaderBox)
import Gargantext.Routes (SessionRoute(..)) as R import Gargantext.Routes (SessionRoute(..)) as R
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get)
import Gargantext.Types (CTabNgramType, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes) import Gargantext.Types (CTabNgramType, NodeID, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes)
import Gargantext.Utils (queryExactMatchesLabel, queryMatchesLabel, toggleSet, sortWith) import Gargantext.Utils (queryExactMatchesLabel, queryMatchesLabel, toggleSet, sortWith)
import Gargantext.Utils.CacheAPI as GUC import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -50,6 +52,7 @@ import Gargantext.Utils.Seq as Seq ...@@ -50,6 +52,7 @@ import Gargantext.Utils.Seq as Seq
import Gargantext.Utils.Toestand as T2 import Gargantext.Utils.Toestand as T2
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T import Toestand as T
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
...@@ -110,30 +113,32 @@ setTermListSetA ngramsTable ns new_list = ...@@ -110,30 +113,32 @@ setTermListSetA ngramsTable ns new_list =
type PreConversionRows = Seq.Seq NgramsElement type PreConversionRows = Seq.Seq NgramsElement
type TableContainerProps = type TableContainerProps =
( dispatch :: Dispatch ( addCallback :: String -> Effect Unit
, dispatch :: Dispatch
, getNgramsChildren :: NgramsTerm -> Aff (Array NgramsTerm)
, ngramsSelection :: Set NgramsTerm , ngramsSelection :: Set NgramsTerm
, ngramsTable :: NgramsTable , ngramsTable :: NgramsTable
, queryExactMatches :: Boolean
, path :: T.Box PageParams , path :: T.Box PageParams
, queryExactMatches :: Boolean
, syncResetButton :: Array R.Element
, tabNgramType :: CTabNgramType , tabNgramType :: CTabNgramType
, treeEdit :: TreeEdit , treeEdit :: TreeEdit
, syncResetButton :: Array R.Element
, addCallback :: String -> Effect Unit
) )
tableContainer :: Record TableContainerProps -> Record TT.TableContainerProps -> R.Element tableContainer :: Record TableContainerProps -> Record TT.TableContainerProps -> R.Element
tableContainer p q = R.createElement (tableContainerCpt p) q [] tableContainer p q = R.createElement (tableContainerCpt p) q []
tableContainerCpt :: Record TableContainerProps -> R.Component TT.TableContainerProps tableContainerCpt :: Record TableContainerProps -> R.Component TT.TableContainerProps
tableContainerCpt { dispatch tableContainerCpt { addCallback
, dispatch
, getNgramsChildren
, ngramsSelection , ngramsSelection
, ngramsTable: ngramsTableCache , ngramsTable: ngramsTableCache
, path , path
, queryExactMatches , queryExactMatches
, syncResetButton
, tabNgramType , tabNgramType
, treeEdit: { ngramsChildrenDiff , treeEdit: { ngramsChildrenDiff
, ngramsParent } , ngramsParent }
, syncResetButton
, addCallback
} = here.component "tableContainer" cpt } = here.component "tableContainer" cpt
where where
cpt props _ = do cpt props _ = do
...@@ -224,7 +229,8 @@ tableContainerCpt { dispatch ...@@ -224,7 +229,8 @@ tableContainerCpt { dispatch
editor = H.div {} $ maybe [] edit ngramsParent editor = H.div {} $ maybe [] edit ngramsParent
where where
edit ngrams = [ H.p {} [H.text $ "Editing " <> ngramsTermText ngrams] edit ngrams = [ H.p {} [H.text $ "Editing " <> ngramsTermText ngrams]
, NTC.renderNgramsTree { ngramsChildren , NTC.renderNgramsTree { getNgramsChildren
, ngramsChildren
, ngramsClick , ngramsClick
, ngramsDepth , ngramsDepth
, ngramsEdit , ngramsEdit
...@@ -269,19 +275,19 @@ tableContainerCpt { dispatch ...@@ -269,19 +275,19 @@ tableContainerCpt { dispatch
-- NEXT -- NEXT
type CommonProps = type CommonProps =
( afterSync :: Unit -> Aff Unit ( afterSync :: Unit -> Aff Unit
, boxes :: Boxes , boxes :: Boxes
, tabNgramType :: CTabNgramType , tabNgramType :: CTabNgramType
, withAutoUpdate :: Boolean -- (?) not used , withAutoUpdate :: Boolean -- (?) not used
) )
type PropsNoReload = type PropsNoReload =
( cacheState :: NT.CacheState ( cacheState :: NT.CacheState
, mTotalRows :: Maybe Int , mTotalRows :: Maybe Int
, path :: T.Box PageParams , path :: T.Box PageParams
, state :: T.Box State , state :: T.Box State
, treeEdit :: T.Box TreeEdit , treeEdit :: Record NgramsTreeEditProps
, versioned :: VersionedNgramsTable , versioned :: VersionedNgramsTable
| CommonProps | CommonProps
) )
...@@ -318,10 +324,10 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where ...@@ -318,10 +324,10 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
, path , path
, state , state
, tabNgramType , tabNgramType
, treeEdit , treeEdit: treeEdit@{ getNgramsChildren }
, versioned: Versioned { data: initTable } , versioned: Versioned { data: initTable }
} _ = do } _ = do
treeEdit'@{ ngramsParent } <- T.useLive T.unequal treeEdit treeEdit'@{ ngramsParent } <- T.useLive T.unequal treeEdit.box
state'@{ ngramsLocalPatch, ngramsSelection } <- T.useLive T.unequal state state'@{ ngramsLocalPatch, ngramsSelection } <- T.useLive T.unequal state
path'@{ scoreType, termListFilter, termSizeFilter } <- T.useLive T.unequal path path'@{ scoreType, termListFilter, termSizeFilter } <- T.useLive T.unequal path
params <- T.useFocused (_.params) (\a b -> b { params = a }) path params <- T.useFocused (_.params) (\a b -> b { params = a }) path
...@@ -377,6 +383,7 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where ...@@ -377,6 +383,7 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
convertRow ngramsElement = convertRow ngramsElement =
{ row: NTC.renderNgramsItem { dispatch: performAction { row: NTC.renderNgramsItem { dispatch: performAction
, getNgramsChildren
, ngrams: ngramsElement ^. _NgramsElement <<< _ngrams , ngrams: ngramsElement ^. _NgramsElement <<< _ngrams
, ngramsElement , ngramsElement
, ngramsLocalPatch , ngramsLocalPatch
...@@ -428,11 +435,20 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where ...@@ -428,11 +435,20 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
<<< _Just <<< _Just
) =<< ngramsParent ) =<< ngramsParent
R.useEffect' $ do
R.setRef treeEdit.onCancelRef $ Just $ const $ performAction ClearTreeEdit
R.setRef treeEdit.onSaveRef $ Just $ const $ performAction AddTermChildren
let ngramsClick { depth: 1, ngrams: child } = Just $ performAction $ ToggleChild false child
ngramsClick _ = Nothing
R.setRef treeEdit.onNgramsClickRef $ Just ngramsClick
pure $ R.fragment pure $ R.fragment
[ TT.table [ TT.table
{ colNames { colNames
, container: tableContainer , container: tableContainer
{ dispatch: performAction { addCallback
, dispatch: performAction
, getNgramsChildren
, ngramsSelection , ngramsSelection
, ngramsTable , ngramsTable
, path , path
...@@ -440,7 +456,6 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where ...@@ -440,7 +456,6 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
, syncResetButton: [ syncResetButton ] , syncResetButton: [ syncResetButton ]
, tabNgramType , tabNgramType
, treeEdit: treeEdit' , treeEdit: treeEdit'
, addCallback
} }
, params , params
, rows: filteredConvertedRows , rows: filteredConvertedRows
...@@ -471,7 +486,7 @@ type MkDispatchProps = ( ...@@ -471,7 +486,7 @@ type MkDispatchProps = (
filteredRows :: PreConversionRows filteredRows :: PreConversionRows
, path :: PageParams , path :: PageParams
, state :: T.Box State , state :: T.Box State
, treeEdit :: T.Box TreeEdit , treeEdit :: Record NgramsTreeEditProps
) )
mkDispatch :: Record MkDispatchProps -> (Action -> Effect Unit) mkDispatch :: Record MkDispatchProps -> (Action -> Effect Unit)
...@@ -481,14 +496,14 @@ mkDispatch { filteredRows ...@@ -481,14 +496,14 @@ mkDispatch { filteredRows
, treeEdit } = performAction , treeEdit } = performAction
where where
performAction :: Action -> Effect Unit performAction :: Action -> Effect Unit
performAction ClearTreeEdit = performAction ClearTreeEdit = do
T.write_ initialTreeEdit treeEdit T.write_ initialTreeEdit treeEdit.box
performAction (SetParentResetChildren p c) = performAction (SetParentResetChildren p c) = do
T.write_ { ngramsChildren: c T.write_ { ngramsChildren: c
, ngramsChildrenDiff: Map.empty , ngramsChildrenDiff: Map.empty
, ngramsParent: p } treeEdit , ngramsParent: p } treeEdit.box
performAction (ToggleChild b c) = performAction (ToggleChild b c) =
T.modify_ (\g@{ ngramsChildrenDiff: nc } -> g { ngramsChildrenDiff = newNC nc }) treeEdit T.modify_ (\g@{ ngramsChildrenDiff: nc } -> g { ngramsChildrenDiff = newNC nc }) treeEdit.box
where where
newNC nc = Map.alter (maybe (Just b) (const Nothing)) c nc newNC nc = Map.alter (maybe (Just b) (const Nothing)) c nc
performAction (ToggleSelect c) = performAction (ToggleSelect c) =
...@@ -503,7 +518,7 @@ mkDispatch { filteredRows ...@@ -503,7 +518,7 @@ mkDispatch { filteredRows
else else
s { ngramsSelection = selectNgramsOnFirstPage filteredRows } s { ngramsSelection = selectNgramsOnFirstPage filteredRows }
performAction AddTermChildren = do performAction AddTermChildren = do
{ ngramsChildren, ngramsChildrenDiff, ngramsParent } <- T.read treeEdit { ngramsChildren, ngramsChildrenDiff, ngramsParent } <- T.read treeEdit.box
case ngramsParent of case ngramsParent of
Nothing -> Nothing ->
-- impossible but harmless -- impossible but harmless
...@@ -580,23 +595,42 @@ type MainNgramsTableProps = ( ...@@ -580,23 +595,42 @@ type MainNgramsTableProps = (
, path :: T.Box PageParams , path :: T.Box PageParams
, session :: Session , session :: Session
, tabType :: TabType , tabType :: TabType
, treeEdit :: T.Box TreeEdit , treeEdit :: Record NgramsTreeEditProps
| CommonProps | CommonProps
) )
getNgramsChildrenAff :: Session -> NodeID -> TabType -> NgramsTerm -> Aff (Array NgramsTerm)
getNgramsChildrenAff session nodeId tabType ngrams = do
res <- get session $ R.GetNgrams params (Just nodeId)
case res of
Left err -> pure []
Right r -> pure r
where
params = { limit: 10
, listIds: []
, offset: Nothing
, orderBy: Nothing
, searchQuery: show ngrams
, tabType
, termListFilter: Nothing
, termSizeFilter: Nothing }
mainNgramsTable :: R2.Component MainNgramsTableProps mainNgramsTable :: R2.Component MainNgramsTableProps
mainNgramsTable = R.createElement mainNgramsTableCpt mainNgramsTable = R.createElement mainNgramsTableCpt
mainNgramsTableCpt :: R.Component MainNgramsTableProps mainNgramsTableCpt :: R.Component MainNgramsTableProps
mainNgramsTableCpt = here.component "mainNgramsTable" cpt mainNgramsTableCpt = here.component "mainNgramsTable" cpt
where where
cpt props@{ cacheState, path } _ = do cpt props@{ cacheState, path, session, tabType } _ = do
searchQuery <- T.useFocused (_.searchQuery) (\a b -> b { searchQuery = a }) path searchQuery <- T.useFocused (_.searchQuery) (\a b -> b { searchQuery = a }) path
cacheState' <- T.useLive T.unequal cacheState cacheState' <- T.useLive T.unequal cacheState
onCancelRef <- R.useRef Nothing onCancelRef <- R.useRef Nothing
onNgramsClickRef <- R.useRef Nothing onNgramsClickRef <- R.useRef Nothing
onSaveRef <- R.useRef Nothing onSaveRef <- R.useRef Nothing
treeEdit <- T.useBox initialTreeEdit treeEditBox <- T.useBox initialTreeEdit
nodeId <- T.useFocused (_.nodeId) (\a b -> b { nodeId = a }) path
nodeId' <- T.useLive T.unequal nodeId
-- let path = initialPageParams session nodeId [defaultListId] tabType -- let path = initialPageParams session nodeId [defaultListId] tabType
case cacheState' of case cacheState' of
...@@ -608,59 +642,71 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt ...@@ -608,59 +642,71 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt
NT.CacheOff -> pure $ R.fragment NT.CacheOff -> pure $ R.fragment
[ [
loadedNgramsTableHeader { searchQuery } [] loadedNgramsTableHeader { searchQuery } []
, ngramsTreeEdit { treeEdit } [] , ngramsTreeEdit { box: treeEditBox
, mainNgramsTableCacheOff (props { onCancelRef = onCancelRef , getNgramsChildren: getNgramsChildrenAff session nodeId' tabType
, onNgramsClickRef = onNgramsClickRef , onCancelRef
, onSaveRef = onSaveRef , onNgramsClickRef
, treeEdit = treeEdit }) [] , onSaveRef } []
, mainNgramsTableCacheOff (Record.merge props
{ treeEdit: { box: treeEditBox
, onCancelRef
, onNgramsClickRef
, onSaveRef
, getNgramsChildren: getNgramsChildrenAff session nodeId' tabType
}
}) []
] ]
type NgramsTreeEditProps = type NgramsTreeEditProps =
( onCancelRef :: R.Ref (Maybe (Unit -> Effect Unit)) ( box :: T.Box TreeEdit
, onNgramsClickRef :: R.Ref (Maybe NgramsClick) , getNgramsChildren :: NgramsTerm -> Aff (Array NgramsTerm)
, onSaveRef :: R.Ref (Maybe (Unit -> Effect Unit)) , onCancelRef :: NgramsActionRef
, treeEdit :: T.Box TreeEdit ) , onNgramsClickRef :: R.Ref (Maybe NgramsClick)
, onSaveRef :: NgramsActionRef
)
ngramsTreeEdit :: R2.Component NgramsTreeEditProps ngramsTreeEdit :: R2.Component NgramsTreeEditProps
ngramsTreeEdit = R.createElement ngramsTreeEditCpt ngramsTreeEdit = R.createElement ngramsTreeEditCpt
ngramsTreeEditCpt :: R.Component NgramsTreeEditProps ngramsTreeEditCpt :: R.Component NgramsTreeEditProps
ngramsTreeEditCpt = here.component "ngramsTreeEdit" cpt where ngramsTreeEditCpt = here.component "ngramsTreeEdit" cpt where
cpt props@{ treeEdit } _ = do cpt props@{ box } _ = do
{ ngramsParent } <- T.useLive T.unequal treeEdit { ngramsParent } <- T.useLive T.unequal box
pure $ case ngramsParent of
Nothing -> H.div {} []
Just ngramsParent' -> ngramsTreeEditReal (Record.merge props { ngramsParent' }) []
pure $ if ngramsParent == Nothing type NgramsTreeEditRealProps =
then ( ngramsParent' :: NgramsTerm
H.div {} [] | NgramsTreeEditProps )
else
ngramsTreeEditReal props []
ngramsTreeEditReal :: R2.Component NgramsTreeEditProps ngramsTreeEditReal :: R2.Component NgramsTreeEditRealProps
ngramsTreeEditReal = R.createElement ngramsTreeEditRealCpt ngramsTreeEditReal = R.createElement ngramsTreeEditRealCpt
ngramsTreeEditRealCpt :: R.Component NgramsTreeEditProps ngramsTreeEditRealCpt :: R.Component NgramsTreeEditRealProps
ngramsTreeEditRealCpt = here.component "ngramsTreeEditReal" cpt where ngramsTreeEditRealCpt = here.component "ngramsTreeEditReal" cpt where
cpt { onCancelRef, onNgramsClickRef, onSaveRef, treeEdit } _ = do cpt { box, getNgramsChildren, ngramsParent', onCancelRef, onNgramsClickRef, onSaveRef } _ = do
-- pure $ H.div {} [ H.text "ngramsTreeEditReal" ] { ngramsChildren, ngramsChildrenDiff } <- T.useLive T.unequal box
{ ngramsChildren, ngramsChildrenDiff, ngramsParent } <- T.useLive T.unequal treeEdit let ngramsDepth = { depth: 1, ngrams: ngramsParent' }
ngramsChildrenPatched :: Set NgramsTerm
--let ngramsTable = applyPatchSet (patchSetFromMap ngramsChildrenDiff) ngramsChildren ngramsChildrenPatched = applyPatchSet (patchSetFromMap ngramsChildrenDiff) $ Set.fromFoldable ngramsChildren
let ngramsDepth = { depth: 1, ngrams: ngramsParent }
pure $ H.div {} pure $ H.div {}
[ H.p {} [ H.p {}
[ H.text $ "Editing " <> ngramsTermText ngramsDepth.ngrams ] [ H.text $ "Editing " <> ngramsTermText ngramsDepth.ngrams ]
, NTC.renderNgramsTree { ngramsChildren: applyPatchSet (patchSetFromMap ngramsChildrenDiff) $ Set.toUnfoldable ngramsChildren , NTC.renderNgramsTree { getNgramsChildren
, ngramsChildren: List.fromFoldable ngramsChildrenPatched
, ngramsClick , ngramsClick
, ngramsDepth , ngramsDepth
, ngramsEdit , ngramsEdit
, ngramsStyle: [] , ngramsStyle: []
} }
, H.button { className: "btn btn-primary" , H.button { className: "btn btn-primary"
, on: {click: onSaveClick} --(const $ dispatch AddTermChildren)} , on: { click: onSaveClick } --(const $ dispatch AddTermChildren)}
} [H.text "Save"] } [ H.text "Save" ]
, H.button { className: "btn btn-primary" , H.button { className: "btn btn-primary"
, on: {click: onCancelClick } --(const $ dispatch ClearTreeEdit)} , on: { click: onCancelClick } --(const $ dispatch ClearTreeEdit)}
} [H.text "Cancel"] } [ H.text "Cancel" ]
] ]
where where
-- ngramsTable = ngramsTableCache # at ngrams -- ngramsTable = ngramsTableCache # at ngrams
...@@ -670,15 +716,19 @@ ngramsTreeEditRealCpt = here.component "ngramsTreeEditReal" cpt where ...@@ -670,15 +716,19 @@ ngramsTreeEditRealCpt = here.component "ngramsTreeEditReal" cpt where
-- %~ applyPatchSet (patchSetFromMap ngramsChildrenDiff) -- %~ applyPatchSet (patchSetFromMap ngramsChildrenDiff)
--ngramsClick {depth: 1, ngrams: child} = Just $ dispatch $ ToggleChild false child --ngramsClick {depth: 1, ngrams: child} = Just $ dispatch $ ToggleChild false child
--ngramsClick _ = Nothing --ngramsClick _ = Nothing
ngramsClick :: NgramsClick
ngramsClick nd = case R.readRef onNgramsClickRef of ngramsClick nd = case R.readRef onNgramsClickRef of
Nothing -> Nothing Nothing -> Nothing
Just ngc -> ngc nd Just ngc -> ngc nd
ngramsEdit :: NgramsClick
ngramsEdit _ = Nothing ngramsEdit _ = Nothing
onCancelClick :: forall e. e -> Effect Unit
onCancelClick _ = case R.readRef onCancelRef of onCancelClick _ = case R.readRef onCancelRef of
Nothing -> Nothing Nothing -> pure unit
Just onCancel -> onCancel unit Just onCancel -> onCancel unit
onSaveClick :: forall e. e -> Effect Unit
onSaveClick _ = case R.readRef onSaveRef of onSaveClick _ = case R.readRef onSaveRef of
Nothing -> Nothing Nothing -> pure unit
Just onSave -> onSave unit Just onSave -> onSave unit
mainNgramsTableCacheOn :: R2.Component MainNgramsTableProps mainNgramsTableCacheOn :: R2.Component MainNgramsTableProps
...@@ -776,10 +826,10 @@ mainNgramsTableCacheOffCpt = here.component "mainNgramsTableCacheOff" cpt where ...@@ -776,10 +826,10 @@ mainNgramsTableCacheOffCpt = here.component "mainNgramsTableCacheOff" cpt where
type MainNgramsTablePaintProps = ( type MainNgramsTablePaintProps = (
cacheState :: NT.CacheState cacheState :: NT.CacheState
, treeEdit :: T.Box TreeEdit , path :: T.Box PageParams
, path :: T.Box PageParams , treeEdit :: Record NgramsTreeEditProps
, versioned :: VersionedNgramsTable , versioned :: VersionedNgramsTable
| CommonProps | CommonProps
) )
...@@ -816,7 +866,7 @@ mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt ...@@ -816,7 +866,7 @@ mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt
type MainNgramsTablePaintNoCacheProps = ( type MainNgramsTablePaintNoCacheProps = (
cacheState :: NT.CacheState cacheState :: NT.CacheState
, path :: T.Box PageParams , path :: T.Box PageParams
, treeEdit :: T.Box TreeEdit , treeEdit :: Record NgramsTreeEditProps
, versionedWithCount :: VersionedWithCountNgramsTable , versionedWithCount :: VersionedWithCountNgramsTable
| CommonProps | CommonProps
) )
......
...@@ -11,6 +11,8 @@ import Data.Nullable (null, toMaybe) ...@@ -11,6 +11,8 @@ import Data.Nullable (null, toMaybe)
import Data.Set (Set) import Data.Set (Set)
import Data.Set as Set import Data.Set as Set
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import FFI.Simple (delay) import FFI.Simple (delay)
import Gargantext.Components.NgramsTable.Core (Action(..), Dispatch, NgramsClick, NgramsDepth, NgramsElement, NgramsTable, NgramsTablePatch, NgramsTerm, _NgramsElement, _NgramsRepoElement, _PatchMap, _children, _list, _ngrams, _occurrences, ngramsTermText, replace, setTermListA) import Gargantext.Components.NgramsTable.Core (Action(..), Dispatch, NgramsClick, NgramsDepth, NgramsElement, NgramsTable, NgramsTablePatch, NgramsTerm, _NgramsElement, _NgramsRepoElement, _PatchMap, _children, _list, _ngrams, _occurrences, ngramsTermText, replace, setTermListA)
import Gargantext.Components.Table as Tbl import Gargantext.Components.Table as Tbl
...@@ -118,11 +120,12 @@ selectionCheckboxCpt = here.component "selectionCheckbox" cpt ...@@ -118,11 +120,12 @@ selectionCheckboxCpt = here.component "selectionCheckbox" cpt
type RenderNgramsTree = type RenderNgramsTree =
( ngramsChildren :: List NgramsTerm ( getNgramsChildren :: NgramsTerm -> Aff (Array NgramsTerm)
, ngramsClick :: NgramsClick , ngramsChildren :: List NgramsTerm
, ngramsDepth :: NgramsDepth , ngramsClick :: NgramsClick
, ngramsEdit :: NgramsClick , ngramsDepth :: NgramsDepth
, ngramsStyle :: Array DOM.Props , ngramsEdit :: NgramsClick
, ngramsStyle :: Array DOM.Props
--, ngramsTable :: NgramsTable --, ngramsTable :: NgramsTable
) )
...@@ -131,11 +134,12 @@ renderNgramsTree p = R.createElement renderNgramsTreeCpt p [] ...@@ -131,11 +134,12 @@ 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 { ngramsChildren, ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle } _ = cpt { getNgramsChildren, ngramsChildren, ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle } _ =
pure $ H.ul {} pure $ H.ul {}
[ H.span { className: "tree" } [ H.span { className: "tree" }
[ H.span { className: "righthanded" } [ H.span { className: "righthanded" }
[ tree { ngramsChildren [ tree { getNgramsChildren
, ngramsChildren
, ngramsClick , ngramsClick
, ngramsDepth , ngramsDepth
, ngramsEdit , ngramsEdit
...@@ -163,8 +167,9 @@ tag tagProps = ...@@ -163,8 +167,9 @@ tag tagProps =
-} -}
type TreeProps = type TreeProps =
( ngramsChildren :: List NgramsTerm ( getNgramsChildren :: NgramsTerm -> Aff (Array NgramsTerm)
, ngramsEdit :: NgramsClick , ngramsChildren :: List NgramsTerm
, ngramsEdit :: NgramsClick
--, ngramsTable :: NgramsTable --, ngramsTable :: NgramsTable
| TagProps | TagProps
) )
...@@ -174,11 +179,13 @@ tree p = R.createElement treeCpt p [] ...@@ -174,11 +179,13 @@ tree p = R.createElement treeCpt p []
treeCpt :: R.Component TreeProps treeCpt :: R.Component TreeProps
treeCpt = here.component "tree" cpt treeCpt = here.component "tree" cpt
where where
cpt params@{ ngramsChildren, ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle } _ = do cpt params@{ getNgramsChildren, ngramsChildren, ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle } _ = do
R.useEffect' $ do R.useEffect' $ do
here.log2 "[tree] ngramsChildren" ngramsChildren launchAff_ $ do
c <- getNgramsChildren ngramsDepth.ngrams
liftEffect $ here.log2 "[tree] ngrams" ngramsDepth.ngrams
liftEffect $ here.log2 "[tree] children" c
pure $ pure $
H.li { style: { width : "100%" } } H.li { style: { width : "100%" } }
([ H.i { className, style } [] ] ([ H.i { className, style } [] ]
...@@ -212,8 +219,9 @@ treeCpt = here.component "tree" cpt ...@@ -212,8 +219,9 @@ treeCpt = here.component "tree" cpt
H.ul {} <<< map (\ngrams -> tree (params { ngramsDepth = {depth, ngrams} })) <<< L.toUnfoldable H.ul {} <<< map (\ngrams -> tree (params { ngramsDepth = {depth, ngrams} })) <<< L.toUnfoldable
type RenderNgramsItem = ( type RenderNgramsItem =
dispatch :: Action -> Effect Unit ( dispatch :: Action -> Effect Unit
, getNgramsChildren :: NgramsTerm -> Aff (Array NgramsTerm)
, ngrams :: NgramsTerm , ngrams :: NgramsTerm
, ngramsElement :: NgramsElement , ngramsElement :: NgramsElement
, ngramsLocalPatch :: NgramsTablePatch , ngramsLocalPatch :: NgramsTablePatch
...@@ -228,6 +236,7 @@ renderNgramsItemCpt :: R.Component RenderNgramsItem ...@@ -228,6 +236,7 @@ renderNgramsItemCpt :: R.Component RenderNgramsItem
renderNgramsItemCpt = here.component "renderNgramsItem" cpt renderNgramsItemCpt = here.component "renderNgramsItem" cpt
where where
cpt { dispatch cpt { dispatch
, getNgramsChildren
, ngrams , ngrams
, ngramsElement , ngramsElement
, ngramsLocalPatch , ngramsLocalPatch
...@@ -245,7 +254,8 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt ...@@ -245,7 +254,8 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt
, checkbox GT.StopTerm , checkbox GT.StopTerm
, H.div {} , H.div {}
( if ngramsParent == Nothing ( if ngramsParent == Nothing
then [renderNgramsTree { ngramsChildren then [renderNgramsTree { getNgramsChildren
, ngramsChildren
, ngramsClick , ngramsClick
, ngramsDepth , ngramsDepth
, ngramsEdit , ngramsEdit
......
...@@ -80,6 +80,7 @@ module Gargantext.Components.NgramsTable.Core ...@@ -80,6 +80,7 @@ module Gargantext.Components.NgramsTable.Core
, NgramsDepth , NgramsDepth
, NgramsClick , NgramsClick
, NgramsActionRef
) )
where where
...@@ -1197,3 +1198,4 @@ postNgramsChartsAsync { listIds, nodeId, session, tabType } = do ...@@ -1197,3 +1198,4 @@ postNgramsChartsAsync { listIds, nodeId, session, tabType } = do
type NgramsDepth = { ngrams :: NgramsTerm, depth :: Int } type NgramsDepth = { ngrams :: NgramsTerm, depth :: Int }
type NgramsClick = NgramsDepth -> Maybe (Effect Unit) type NgramsClick = NgramsDepth -> Maybe (Effect Unit)
type NgramsActionRef = R.Ref (Maybe (Unit -> Effect Unit))
...@@ -113,22 +113,30 @@ ngramsViewCpt = here.component "ngramsView" cpt where ...@@ -113,22 +113,30 @@ ngramsViewCpt = here.component "ngramsView" cpt where
NTC.initialPageParams session nodeId NTC.initialPageParams session nodeId
[ defaultListId ] (TabDocument TabDocs) [ defaultListId ] (TabDocument TabDocs)
treeEdit <- T.useBox NT.initialTreeEdit onCancelRef <- R.useRef Nothing
onNgramsClickRef <- R.useRef Nothing
onSaveRef <- R.useRef Nothing
treeEditBox <- T.useBox NT.initialTreeEdit
pure $ NT.mainNgramsTable (props' treeEdit path) [] let most = RX.pick props :: Record NTCommon
where props' =
most = RX.pick props :: Record NTCommon
props' treeEdit path =
(Record.merge most (Record.merge most
{ afterSync { afterSync
, path , path
, tabType: TabPairing (TabNgramType $ modeTabType mode) , tabType: TabPairing (TabNgramType $ modeTabType mode)
, tabNgramType: modeTabType' mode , tabNgramType: modeTabType' mode
, treeEdit , treeEdit: { box: treeEditBox
, getNgramsChildren: \_ -> pure []
, onCancelRef
, onNgramsClickRef
, onSaveRef }
, withAutoUpdate: false }) :: Record NT.MainNgramsTableProps , withAutoUpdate: false }) :: Record NT.MainNgramsTableProps
afterSync :: Unit -> Aff Unit afterSync :: Unit -> Aff Unit
afterSync _ = pure unit afterSync _ = pure unit
pure $ NT.mainNgramsTable props' []
type NTCommon = type NTCommon =
( boxes :: Boxes ( boxes :: Boxes
, cacheState :: T.Box LTypes.CacheState , cacheState :: T.Box LTypes.CacheState
......
...@@ -146,7 +146,10 @@ ngramsViewCpt = here.component "ngramsView" cpt ...@@ -146,7 +146,10 @@ ngramsViewCpt = here.component "ngramsView" cpt
, nodeId , nodeId
, session } _ = do , session } _ = do
path <- T.useBox $ NTC.initialPageParams session nodeId [defaultListId] (TabDocument TabDocs) path <- T.useBox $ NTC.initialPageParams session nodeId [defaultListId] (TabDocument TabDocs)
treeEdit <- T.useBox NT.initialTreeEdit onCancelRef <- R.useRef Nothing
onNgramsClickRef <- R.useRef Nothing
onSaveRef <- R.useRef Nothing
treeEditBox <- T.useBox NT.initialTreeEdit
pure $ NT.mainNgramsTable { pure $ NT.mainNgramsTable {
afterSync: \_ -> pure unit afterSync: \_ -> pure unit
...@@ -157,7 +160,11 @@ ngramsViewCpt = here.component "ngramsView" cpt ...@@ -157,7 +160,11 @@ ngramsViewCpt = here.component "ngramsView" cpt
, session , session
, tabNgramType , tabNgramType
, tabType , tabType
, treeEdit , treeEdit: { box: treeEditBox
, getNgramsChildren: \_ -> pure []
, onCancelRef
, onNgramsClickRef
, onSaveRef }
, withAutoUpdate: false , withAutoUpdate: false
} [] } []
where where
......
...@@ -89,7 +89,10 @@ ngramsViewCpt = here.component "ngramsView" cpt where ...@@ -89,7 +89,10 @@ ngramsViewCpt = here.component "ngramsView" cpt where
, session , session
, path } _ = do , path } _ = do
chartsReload <- T.useBox T2.newReload chartsReload <- T.useBox T2.newReload
treeEdit <- T.useBox NT.initialTreeEdit onCancelRef <- R.useRef Nothing
onNgramsClickRef <- R.useRef Nothing
onSaveRef <- R.useRef Nothing
treeEditBox <- T.useBox NT.initialTreeEdit
{ listIds, nodeId, params } <- T.useLive T.unequal path { listIds, nodeId, params } <- T.useLive T.unequal path
...@@ -115,7 +118,11 @@ ngramsViewCpt = here.component "ngramsView" cpt where ...@@ -115,7 +118,11 @@ ngramsViewCpt = here.component "ngramsView" cpt where
, session , session
, tabNgramType , tabNgramType
, tabType , tabType
, treeEdit , treeEdit: { box: treeEditBox
, getNgramsChildren: \_ -> pure []
, onCancelRef
, onNgramsClickRef
, onSaveRef }
, withAutoUpdate: false , withAutoUpdate: false
} [] } []
] ]
......
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