Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
purescript-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
142
Issues
142
List
Board
Labels
Milestones
Merge Requests
4
Merge Requests
4
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
purescript-gargantext
Commits
a1b4c82f
Commit
a1b4c82f
authored
Jun 10, 2022
by
Przemyslaw Kaminski
Committed by
Karen Konou
Jun 30, 2022
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[ngrams] tree edit refactoring
Doesn't work yet as expected, but some progress made in good direction.
parent
83a6e5e4
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
209 additions
and
112 deletions
+209
-112
NgramsTable.purs
src/Gargantext/Components/NgramsTable.purs
+143
-65
Components.purs
src/Gargantext/Components/NgramsTable/Components.purs
+45
-34
Core.purs
src/Gargantext/Components/NgramsTable/Core.purs
+2
-1
Tabs.purs
src/Gargantext/Components/Nodes/Annuaire/Tabs.purs
+15
-12
Tabs.purs
...gantext/Components/Nodes/Annuaire/User/Contacts/Tabs.purs
+2
-0
Tabs.purs
src/Gargantext/Components/Nodes/Lists/Tabs.purs
+2
-0
No files found.
src/Gargantext/Components/NgramsTable.purs
View file @
a1b4c82f
module Gargantext.Components.NgramsTable
module Gargantext.Components.NgramsTable
( MainNgramsTableProps
( MainNgramsTableProps
, CommonProps
, CommonProps
, TreeEdit
, initialTreeEdit
, mainNgramsTable
, mainNgramsTable
) where
) where
...
@@ -8,11 +10,13 @@ import Gargantext.Prelude
...
@@ -8,11 +10,13 @@ import Gargantext.Prelude
import Data.Array as A
import Data.Array as A
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)
import Data.Lens.Common (_Just)
import Data.Lens.Common (_Just)
import Data.Lens.Fold (folded)
import Data.Lens.Fold (folded)
import Data.Lens.Index (ix)
import Data.Lens.Index (ix)
import Data.List (List)
import Data.List as List
import Data.Map (Map)
import Data.Map (Map)
import Data.Map as Map
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe, isNothing, maybe)
import Data.Maybe (Maybe(..), fromMaybe, isNothing, maybe)
...
@@ -52,23 +56,33 @@ import Unsafe.Coerce (unsafeCoerce)
...
@@ -52,23 +56,33 @@ import Unsafe.Coerce (unsafeCoerce)
here :: R2.Here
here :: R2.Here
here = R2.here "Gargantext.Components.NgramsTable"
here = R2.here "Gargantext.Components.NgramsTable"
type TreeEdit =
{ ngramsChildren :: List NgramsTerm
-- ^ Root children, as were originally present
-- in the table, before editing
, ngramsChildrenDiff :: Map NgramsTerm Boolean
-- ^ Used only when grouping.
-- This updates the children of `ngramsParent`,
-- ngrams set to `true` are to be added, and `false` to
-- be removed.
, ngramsParent :: Maybe NgramsTerm -- Nothing means we are not currently grouping terms
}
type State =
type State =
CoreState (
CoreState (
ngramsChildren :: Map NgramsTerm Boolean
ngramsSelection :: Set NgramsTerm
-- ^ Used only when grouping.
-- This updates the children of `ngramsParent`,
-- ngrams set to `true` are to be added, and `false` to
-- be removed.
, ngramsParent :: Maybe NgramsTerm -- Nothing means we are not currently grouping terms
, ngramsSelection :: Set NgramsTerm
-- ^ The set of selected checkboxes of the first column.
-- ^ The set of selected checkboxes of the first column.
)
)
initialTreeEdit :: TreeEdit
initialTreeEdit =
{ ngramsChildren : List.Nil
, ngramsChildrenDiff: Map.empty
, ngramsParent : Nothing }
initialState :: VersionedNgramsTable -> State
initialState :: VersionedNgramsTable -> State
initialState (Versioned {version}) = {
initialState (Versioned {version}) = {
ngramsChildren: Map.empty
ngramsLocalPatch: mempty
, ngramsLocalPatch: mempty
, ngramsParent: Nothing
, ngramsSelection: mempty
, ngramsSelection: mempty
, ngramsStagePatch: mempty
, ngramsStagePatch: mempty
, ngramsValidPatch: mempty
, ngramsValidPatch: mempty
...
@@ -97,13 +111,12 @@ type PreConversionRows = Seq.Seq NgramsElement
...
@@ -97,13 +111,12 @@ type PreConversionRows = Seq.Seq NgramsElement
type TableContainerProps =
type TableContainerProps =
( dispatch :: Dispatch
( dispatch :: Dispatch
, ngramsChildren :: Map NgramsTerm Boolean
, ngramsParent :: Maybe NgramsTerm
, ngramsSelection :: Set NgramsTerm
, ngramsSelection :: Set NgramsTerm
, ngramsTable :: NgramsTable
, ngramsTable :: NgramsTable
, queryExactMatches :: Boolean
, queryExactMatches :: Boolean
, path :: T.Box PageParams
, path :: T.Box PageParams
, tabNgramType :: CTabNgramType
, tabNgramType :: CTabNgramType
, treeEdit :: TreeEdit
, syncResetButton :: Array R.Element
, syncResetButton :: Array R.Element
, addCallback :: String -> Effect Unit
, addCallback :: String -> Effect Unit
)
)
...
@@ -112,13 +125,13 @@ tableContainer :: Record TableContainerProps -> Record TT.TableContainerProps ->
...
@@ -112,13 +125,13 @@ tableContainer :: Record TableContainerProps -> Record TT.TableContainerProps ->
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 { dispatch
, ngramsChildren
, ngramsParent
, ngramsSelection
, ngramsSelection
, ngramsTable: ngramsTableCache
, ngramsTable: ngramsTableCache
, path
, path
, queryExactMatches
, queryExactMatches
, tabNgramType
, tabNgramType
, treeEdit: { ngramsChildrenDiff
, ngramsParent }
, syncResetButton
, syncResetButton
, addCallback
, addCallback
} = here.component "tableContainer" cpt
} = here.component "tableContainer" cpt
...
@@ -210,26 +223,27 @@ tableContainerCpt { dispatch
...
@@ -210,26 +223,27 @@ 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 { ngramsTable
, NTC.renderNgramsTree { ngramsChildren
, ngrams
, ngramsStyle: []
, ngramsClick
, ngramsClick
, ngramsDepth
, ngramsEdit
, ngramsEdit
, ngramsStyle: []
}
}
, H.button { className: "btn btn-primary"
, H.button { className: "btn btn-primary"
, on: {click: (const $ do
, on: {click: (const $ dispatch AddTermChildren)}
dispatch AddTermChildren)}
} [H.text "Save"]
} [H.text "Save"]
, H.button { className: "btn btn-primary"
, H.button { className: "btn btn-primary"
, on: {click: (const $ dispatch
$ SetParentResetChildren Nothing
)}
, on: {click: (const $ dispatch
ClearTreeEdit
)}
} [H.text "Cancel"]
} [H.text "Cancel"]
]
]
where
where
ngramsChildren = ngramsTable ^.. ix ngrams <<< _NgramsRepoElement <<< _children <<< folded
ngramsDepth = { ngrams, depth: 0 }
ngramsTable = ngramsTableCache # at ngrams
ngramsTable = ngramsTableCache # at ngrams
<<< _Just
<<< _Just
<<< _NgramsRepoElement
<<< _NgramsRepoElement
<<< _children
<<< _children
%~ applyPatchSet (patchSetFromMap ngramsChildren)
%~ applyPatchSet (patchSetFromMap ngramsChildren
Diff
)
ngramsClick {depth: 1, ngrams: child} = Just $ dispatch $ ToggleChild false child
ngramsClick {depth: 1, ngrams: child} = Just $ dispatch $ ToggleChild false child
ngramsClick _ = Nothing
ngramsClick _ = Nothing
ngramsEdit _ = Nothing
ngramsEdit _ = Nothing
...
@@ -265,6 +279,7 @@ type PropsNoReload =
...
@@ -265,6 +279,7 @@ type PropsNoReload =
, 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
, versioned :: VersionedNgramsTable
, versioned :: VersionedNgramsTable
| CommonProps
| CommonProps
)
)
...
@@ -302,9 +317,11 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
...
@@ -302,9 +317,11 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
, path
, path
, state
, state
, tabNgramType
, tabNgramType
, treeEdit
, versioned: Versioned { data: initTable }
, versioned: Versioned { data: initTable }
} _ = do
} _ = do
state'@{ ngramsChildren, ngramsLocalPatch, ngramsParent, ngramsSelection } <- T.useLive T.unequal state
treeEdit'@{ ngramsParent } <- T.useLive T.unequal treeEdit
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
params'@{ orderBy } <- T.useLive T.unequal params
params'@{ orderBy } <- T.useLive T.unequal params
...
@@ -340,7 +357,8 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
...
@@ -340,7 +357,8 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
, rootsWithMatches
, rootsWithMatches
, state: state'
, state: state'
, termListFilter
, termListFilter
, termSizeFilter } then
, termSizeFilter
, treeEdit: treeEdit' } then
Just ngramsElement
Just ngramsElement
else
else
Nothing
Nothing
...
@@ -348,7 +366,7 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
...
@@ -348,7 +366,7 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
performAction = mkDispatch { filteredRows
performAction = mkDispatch { filteredRows
, path: path'
, path: path'
, state
, state
,
state'
}
,
treeEdit
}
-- filteredRows :: PreConversionRows
-- filteredRows :: PreConversionRows
-- no need to filter offset if cache is off
-- no need to filter offset if cache is off
...
@@ -414,14 +432,13 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
...
@@ -414,14 +432,13 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
{ colNames
{ colNames
, container: tableContainer
, container: tableContainer
{ dispatch: performAction
{ dispatch: performAction
, ngramsChildren
, ngramsParent
, ngramsSelection
, ngramsSelection
, ngramsTable
, ngramsTable
, path
, path
, queryExactMatches: exactMatches
, queryExactMatches: exactMatches
, syncResetButton: [ syncResetButton ]
, syncResetButton: [ syncResetButton ]
, tabNgramType
, tabNgramType
, treeEdit: treeEdit'
, addCallback
, addCallback
}
}
, params
, params
...
@@ -453,60 +470,59 @@ type MkDispatchProps = (
...
@@ -453,60 +470,59 @@ type MkDispatchProps = (
filteredRows :: PreConversionRows
filteredRows :: PreConversionRows
, path :: PageParams
, path :: PageParams
, state :: T.Box State
, state :: T.Box State
,
state' :: State
,
treeEdit :: T.Box TreeEdit
)
)
mkDispatch :: Record MkDispatchProps -> (Action -> Effect Unit)
mkDispatch :: Record MkDispatchProps -> (Action -> Effect Unit)
mkDispatch { filteredRows
mkDispatch { filteredRows
, path
, path
, state
, state
, state': { ngramsChildren
, treeEdit } = performAction
, ngramsParent
, ngramsSelection } } = performAction
where
where
allNgramsSelected = allNgramsSelectedOnFirstPage ngramsSelection filteredRows
setParentResetChildren :: Maybe NgramsTerm -> State -> State
setParentResetChildren p = _ { ngramsParent = p, ngramsChildren = Map.empty }
performAction :: Action -> Effect Unit
performAction :: Action -> Effect Unit
performAction (SetParentResetChildren p) =
performAction ClearTreeEdit =
T.modify_ (setParentResetChildren p) state
T.write_ initialTreeEdit treeEdit
performAction (SetParentResetChildren p c) =
T.write_ { ngramsChildren: c
, ngramsChildrenDiff: Map.empty
, ngramsParent: p } treeEdit
performAction (ToggleChild b c) =
performAction (ToggleChild b c) =
T.modify_ (\
s@{ ngramsChildren: nc } -> s { ngramsChildren = newNC nc }) state
T.modify_ (\
g@{ ngramsChildrenDiff: nc } -> g { ngramsChildrenDiff = newNC nc }) treeEdit
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) =
T.modify_ (\s@{ ngramsSelection: ns } -> s { ngramsSelection = toggleSet c ns }) state
T.modify_ (\s@{ ngramsSelection: ns } -> s { ngramsSelection = toggleSet c ns }) state
performAction ToggleSelectAll =
performAction ToggleSelectAll = do
T.modify_ toggler state
{ ngramsSelection } <- T.read state
T.modify_ (toggler ngramsSelection) state
where
where
toggler s =
toggler
ngramsSelection
s =
if allNgramsSelected then
if allNgramsSelected
OnFirstPage ngramsSelection filteredRows
then
s { ngramsSelection = Set.empty :: Set NgramsTerm }
s { ngramsSelection = Set.empty :: Set NgramsTerm }
else
else
s { ngramsSelection = selectNgramsOnFirstPage filteredRows }
s { ngramsSelection = selectNgramsOnFirstPage filteredRows }
performAction AddTermChildren = do
performAction AddTermChildren = do
{ ngramsChildren, ngramsChildrenDiff, ngramsParent } <- T.read treeEdit
case ngramsParent of
case ngramsParent of
Nothing ->
Nothing ->
-- impossible but harmless
-- impossible but harmless
pure unit
pure unit
Just parent -> do
Just parent -> do
here.log2 "[performAction] AddTermChildren, parent" parent
here.log2 "[performAction] AddTermChildren, parent" parent
here.log2 "[performAction] AddTermChildren, ngramsChildren
" ngramsChildren
here.log2 "[performAction] AddTermChildren, ngramsChildren
Diff" ngramsChildrenDiff
let pc = patchSetFromMap ngramsChildren
let pc = patchSetFromMap ngramsChildren
Diff
pe = NgramsPatch { patch_list: mempty, patch_children: pc }
pe = NgramsPatch { patch_list: mempty, patch_children: pc }
pt = singletonNgramsTablePatch parent pe
pt = singletonNgramsTablePatch parent pe
T.modify_ (setParentResetChildren Nothing) state
performAction ClearTreeEdit
here.log2 "[performAction] pt" pt
here.log2 "[performAction] pt" pt
let ppt = case (A.head $ Set.toUnfoldable $ Map.keys ngramsChildren
) of
-- let ppt = case (A.head $ Set.toUnfoldable $ Map.keys ngramsChildrenDiff
) of
Nothing -> mempty
--
Nothing -> mempty
Just h ->
--
Just h ->
let pp = NgramsPatch { patch_list: mempty
--
let pp = NgramsPatch { patch_list: mempty
, patch_children: patchSetFromMap $ Map.mapMaybe (\v -> Just $ not v) ngramsChildren
}
-- , patch_children: patchSetFromMap $ Map.mapMaybe (\v -> Just $ not v) ngramsChildrenDiff
}
in
--
in
singletonNgramsTablePatch h pp
--
singletonNgramsTablePatch h pp
here.log2 "[performAction] pt with patchSetFromMap" $ pt <> ppt
--
here.log2 "[performAction] pt with patchSetFromMap" $ pt <> ppt
commitPatch (pt {-<> ppt-}) state
commitPatch (pt {-<> ppt-}) state
performAction (CoreAction a) = coreDispatch path state a
performAction (CoreAction a) = coreDispatch path state a
...
@@ -516,15 +532,17 @@ displayRow :: { ngramsElement :: NgramsElement
...
@@ -516,15 +532,17 @@ displayRow :: { ngramsElement :: NgramsElement
, rootsWithMatches :: Set NgramsTerm
, rootsWithMatches :: Set NgramsTerm
, state :: State
, state :: State
, termListFilter :: Maybe TermList
, termListFilter :: Maybe TermList
, termSizeFilter :: Maybe TermSize } -> Boolean
, termSizeFilter :: Maybe TermSize
, treeEdit :: TreeEdit } -> Boolean
displayRow { ngramsElement: NgramsElement {ngrams, root, list}
displayRow { ngramsElement: NgramsElement {ngrams, root, list}
, ngramsParentRoot
, ngramsParentRoot
, state: { ngramsChildren
, state: { ngramsLocalPatch }
, ngramsLocalPatch
, ngramsParent }
, rootsWithMatches
, rootsWithMatches
, termListFilter
, termListFilter
, termSizeFilter } =
, termSizeFilter
, treeEdit: { ngramsChildren
, ngramsChildrenDiff
, ngramsParent } } =
-- See these issues about the evolution of this filtering.
-- See these issues about the evolution of this filtering.
-- * https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/340
-- * https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/340
-- * https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/87
-- * https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/87
...
@@ -534,7 +552,7 @@ displayRow { ngramsElement: NgramsElement {ngrams, root, list}
...
@@ -534,7 +552,7 @@ displayRow { ngramsElement: NgramsElement {ngrams, root, list}
-- ^ and which matches the search query.
-- ^ and which matches the search query.
&& maybe true (_ == list) termListFilter
&& maybe true (_ == list) termListFilter
-- ^ and which matches the ListType filter.
-- ^ and which matches the ListType filter.
&& ngramsChildren ^. at ngrams /= Just true
&& ngramsChildren
Diff
^. at ngrams /= Just true
-- ^ and which are not scheduled to be added already
-- ^ and which are not scheduled to be added already
&& Just ngrams /= ngramsParent
&& Just ngrams /= ngramsParent
-- ^ and which are not our new parent
-- ^ and which are not our new parent
...
@@ -542,7 +560,7 @@ displayRow { ngramsElement: NgramsElement {ngrams, root, list}
...
@@ -542,7 +560,7 @@ displayRow { ngramsElement: NgramsElement {ngrams, root, list}
-- ^ and which are not the root of our new parent
-- ^ and which are not the root of our new parent
&& filterTermSize termSizeFilter ngrams
&& filterTermSize termSizeFilter ngrams
-- ^ and which satisfies the chosen term size
-- ^ and which satisfies the chosen term size
|| ngramsChildren ^. at ngrams == Just false
|| ngramsChildren
Diff
^. at ngrams == Just false
-- ^ unless they are scheduled to be removed.
-- ^ unless they are scheduled to be removed.
|| NTC.tablePatchHasNgrams ngramsLocalPatch ngrams
|| NTC.tablePatchHasNgrams ngramsLocalPatch ngrams
-- ^ unless they are being processed at the moment.
-- ^ unless they are being processed at the moment.
...
@@ -561,6 +579,7 @@ type MainNgramsTableProps = (
...
@@ -561,6 +579,7 @@ type MainNgramsTableProps = (
, path :: T.Box PageParams
, path :: T.Box PageParams
, session :: Session
, session :: Session
, tabType :: TabType
, tabType :: TabType
, treeEdit :: T.Box TreeEdit
| CommonProps
| CommonProps
)
)
...
@@ -572,6 +591,8 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt
...
@@ -572,6 +591,8 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt
cpt props@{ cacheState, path } _ = do
cpt props@{ cacheState, path } _ = 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
onSave <- T.useBox Nothing
treeEdit <- T.useBox initialTreeEdit
-- let path = initialPageParams session nodeId [defaultListId] tabType
-- let path = initialPageParams session nodeId [defaultListId] tabType
...
@@ -579,16 +600,63 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt
...
@@ -579,16 +600,63 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt
NT.CacheOn -> pure $ R.fragment
NT.CacheOn -> pure $ R.fragment
[
[
loadedNgramsTableHeader { searchQuery } []
loadedNgramsTableHeader { searchQuery } []
,
, mainNgramsTableCacheOn props []
mainNgramsTableCacheOn props []
]
]
NT.CacheOff -> pure $ R.fragment
NT.CacheOff -> pure $ R.fragment
[
[
loadedNgramsTableHeader { searchQuery } []
loadedNgramsTableHeader { searchQuery } []
,
,
ngramsTreeEdit { onSave, treeEdit } []
mainNgramsTableCacheOff props
[]
, mainNgramsTableCacheOff (props { treeEdit = treeEdit })
[]
]
]
type NgramsTreeEditProps =
( onSave :: T.Box (Maybe (Effect Unit))
, treeEdit :: T.Box TreeEdit )
ngramsTreeEdit :: R2.Component NgramsTreeEditProps
ngramsTreeEdit = R.createElement ngramsTreeEditCpt
ngramsTreeEditCpt :: R.Component NgramsTreeEditProps
ngramsTreeEditCpt = here.component "ngramsTreeEdit" cpt where
cpt { onSave, treeEdit } _ = do
{ ngramsParent } <- T.useLive T.unequal treeEdit
pure $ if ngramsParent == Nothing
then
H.div {} []
else
ngramsTreeEditReal { onSave, treeEdit } []
ngramsTreeEditReal :: R2.Component NgramsTreeEditProps
ngramsTreeEditReal = R.createElement ngramsTreeEditRealCpt
ngramsTreeEditRealCpt :: R.Component NgramsTreeEditProps
ngramsTreeEditRealCpt = here.component "ngramsTreeEditReal" cpt where
cpt { treeEdit } _ = do
pure $ H.div {} [ H.text "ngramsTreeEditReal" ]
-- pure $ H.div {}
-- [ H.p {}
-- [ H.text $ "Editing " <> ngramsTermText ngrams ]
-- , NTC.renderNgramsTree { ngramsClick
-- , ngramsDepth
-- , ngramsEdit
-- , ngramsStyle: []
-- , ngramsTable
-- }
-- , H.button { className: "btn btn-primary"
-- , on: {click: (const $ dispatch AddTermChildren)}
-- } [H.text "Save"]
-- , H.button { className: "btn btn-primary"
-- , on: {click: (const $ dispatch ClearTreeEdit)}
-- } [H.text "Cancel"]
-- ]
-- where
-- ngramsTable = ngramsTableCache # at ngrams
-- <<< _Just
-- <<< _NgramsRepoElement
-- <<< _children
-- %~ applyPatchSet (patchSetFromMap ngramsChildrenDiff)
-- ngramsClick {depth: 1, ngrams: child} = Just $ dispatch $ ToggleChild false child
-- ngramsClick _ = Nothing
-- ngramsEdit _ = Nothing
mainNgramsTableCacheOn :: R2.Component MainNgramsTableProps
mainNgramsTableCacheOn :: R2.Component MainNgramsTableProps
mainNgramsTableCacheOn = R.createElement mainNgramsTableCacheOnCpt
mainNgramsTableCacheOn = R.createElement mainNgramsTableCacheOnCpt
...
@@ -599,6 +667,7 @@ mainNgramsTableCacheOnCpt = here.component "mainNgramsTableCacheOn" cpt where
...
@@ -599,6 +667,7 @@ mainNgramsTableCacheOnCpt = here.component "mainNgramsTableCacheOn" cpt where
, defaultListId
, defaultListId
, path
, path
, tabNgramType
, tabNgramType
, treeEdit
, withAutoUpdate } _ = do
, withAutoUpdate } _ = do
-- let path = initialPageParams session nodeId [defaultListId] tabType
-- let path = initialPageParams session nodeId [defaultListId] tabType
...
@@ -609,6 +678,7 @@ mainNgramsTableCacheOnCpt = here.component "mainNgramsTableCacheOn" cpt where
...
@@ -609,6 +678,7 @@ mainNgramsTableCacheOnCpt = here.component "mainNgramsTableCacheOn" cpt where
, cacheState: NT.CacheOn
, cacheState: NT.CacheOn
, path
, path
, tabNgramType
, tabNgramType
, treeEdit
, versioned
, versioned
, withAutoUpdate } []
, withAutoUpdate } []
useLoaderWithCacheAPI {
useLoaderWithCacheAPI {
...
@@ -641,12 +711,14 @@ mainNgramsTableCacheOffCpt = here.component "mainNgramsTableCacheOff" cpt where
...
@@ -641,12 +711,14 @@ mainNgramsTableCacheOffCpt = here.component "mainNgramsTableCacheOff" cpt where
, boxes
, boxes
, path
, path
, tabNgramType
, tabNgramType
, treeEdit
, withAutoUpdate } _ = do
, withAutoUpdate } _ = do
let render versionedWithCount = mainNgramsTablePaintNoCache { afterSync
let render versionedWithCount = mainNgramsTablePaintNoCache { afterSync
, boxes
, boxes
, cacheState: NT.CacheOff
, cacheState: NT.CacheOff
, path
, path
, tabNgramType
, tabNgramType
, treeEdit
, versionedWithCount
, versionedWithCount
, withAutoUpdate } []
, withAutoUpdate } []
useLoaderBox { errorHandler
useLoaderBox { errorHandler
...
@@ -682,6 +754,7 @@ mainNgramsTableCacheOffCpt = here.component "mainNgramsTableCacheOff" cpt where
...
@@ -682,6 +754,7 @@ 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
, versioned :: VersionedNgramsTable
, versioned :: VersionedNgramsTable
| CommonProps
| CommonProps
...
@@ -697,6 +770,7 @@ mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt
...
@@ -697,6 +770,7 @@ mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt
, cacheState
, cacheState
, path
, path
, tabNgramType
, tabNgramType
, treeEdit
, versioned
, versioned
, withAutoUpdate } _ = do
, withAutoUpdate } _ = do
state <- T.useBox $ initialState versioned
state <- T.useBox $ initialState versioned
...
@@ -711,6 +785,7 @@ mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt
...
@@ -711,6 +785,7 @@ mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt
, path
, path
, state
, state
, tabNgramType
, tabNgramType
, treeEdit
, versioned
, versioned
, withAutoUpdate
, withAutoUpdate
} []
} []
...
@@ -718,6 +793,7 @@ mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt
...
@@ -718,6 +793,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
, versionedWithCount :: VersionedWithCountNgramsTable
, versionedWithCount :: VersionedWithCountNgramsTable
| CommonProps
| CommonProps
)
)
...
@@ -732,6 +808,7 @@ mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cp
...
@@ -732,6 +808,7 @@ mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cp
, cacheState
, cacheState
, path
, path
, tabNgramType
, tabNgramType
, treeEdit
, versionedWithCount
, versionedWithCount
, withAutoUpdate } _ = do
, withAutoUpdate } _ = do
-- TODO This is lame, make versionedWithCount a proper box?
-- TODO This is lame, make versionedWithCount a proper box?
...
@@ -749,6 +826,7 @@ mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cp
...
@@ -749,6 +826,7 @@ mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cp
, path
, path
, state
, state
, tabNgramType
, tabNgramType
, treeEdit
, versioned
, versioned
, withAutoUpdate } []
, withAutoUpdate } []
...
...
src/Gargantext/Components/NgramsTable/Components.purs
View file @
a1b4c82f
...
@@ -4,6 +4,7 @@ import Data.Lens ((^..), (^.), view)
...
@@ -4,6 +4,7 @@ import Data.Lens ((^..), (^.), view)
import Data.Lens.At (at)
import Data.Lens.At (at)
import Data.Lens.Fold (folded)
import Data.Lens.Fold (folded)
import Data.Lens.Index (ix)
import Data.Lens.Index (ix)
import Data.List (List)
import Data.List (null, toUnfoldable) as L
import Data.List (null, toUnfoldable) as L
import Data.Maybe (Maybe(..), maybe, isJust)
import Data.Maybe (Maybe(..), maybe, isJust)
import Data.Nullable (null, toMaybe)
import Data.Nullable (null, toMaybe)
...
@@ -117,35 +118,35 @@ selectionCheckboxCpt = here.component "selectionCheckbox" cpt
...
@@ -117,35 +118,35 @@ selectionCheckboxCpt = here.component "selectionCheckbox" cpt
type RenderNgramsTree =
type RenderNgramsTree =
( ngrams :: NgramsTerm
( ngramsChildren :: List NgramsTerm
, ngramsClick :: NgramsClick
, ngramsClick :: NgramsClick
, ngramsEdit :: NgramsClick
, ngramsDepth :: NgramsDepth
, ngramsStyle :: Array DOM.Props
, ngramsEdit :: NgramsClick
, ngramsTable :: NgramsTable
, ngramsStyle :: Array DOM.Props
--, ngramsTable :: NgramsTable
)
)
renderNgramsTree :: Record RenderNgramsTree -> R.Element
renderNgramsTree :: Record RenderNgramsTree -> R.Element
renderNgramsTree p = R.createElement renderNgramsTreeCpt p []
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 { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit} _ =
cpt { 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 { ngramsClick
[ tree { ngramsChildren
, ngramsDepth: {ngrams, depth: 0}
, ngramsClick
, ngramsDepth
, ngramsEdit
, ngramsEdit
, ngramsStyle
, ngramsStyle
, ngramsTable
}
}
]
]
]
]
]
]
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 TagProps =
type TagProps =
...
@@ -165,24 +166,28 @@ tag tagProps =
...
@@ -165,24 +166,28 @@ tag tagProps =
-}
-}
type TreeProps =
type TreeProps =
( ngramsEdit :: NgramsClick
( ngramsChildren :: List NgramsTerm
, ngramsTable :: NgramsTable
, ngramsEdit :: NgramsClick
--, ngramsTable :: NgramsTable
| TagProps
| TagProps
)
)
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
treeCpt = here.component "tree" cpt
where
where
cpt params@{ ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle, ngramsTable } _ =
cpt params@{ ngramsChildren, ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle } _ = do
R.useEffect' $ do
here.log2 "[tree] ngramsChildren" ngramsChildren
pure $
pure $
H.li { style: {
width : "100%"
} }
H.li { style: {
width : "100%"
} }
([ H.i { className, style } [] ]
([ H.i { className, style } [] ]
<> [ R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ] ]
<> [ R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ] ]
<> maybe [] edit (ngramsEdit ngramsDepth)
<> maybe [] edit (ngramsEdit ngramsDepth)
<> [ forest
cs
]
<> [ forest
ngramsChildren
]
)
)
where
where
tag =
tag =
...
@@ -195,11 +200,11 @@ treeCpt = here.component "tree" cpt
...
@@ -195,11 +200,11 @@ treeCpt = here.component "tree" cpt
, H.i { className: "fa fa-pencil"
, H.i { className: "fa fa-pencil"
, on: { click: const effect } } []
, on: { click: const effect } } []
]
]
leaf = L.null
cs
leaf = L.null
ngramsChildren
className = "fa fa-chevron-" <> if open then "down" else "right"
className = "fa fa-chevron-" <> if open then "down" else "right"
style = if leaf then {color: "#adb5bd"} else {color: ""}
style = if leaf then {color: "#adb5bd"} else {color: ""}
open = not leaf || false {- TODO -}
open = not leaf || false {- TODO -}
cs = ngramsTable ^.. ix ngramsDepth.ngrams <<< _NgramsRepoElement <<< _children <<< folded
--
cs = ngramsTable ^.. ix ngramsDepth.ngrams <<< _NgramsRepoElement <<< _children <<< folded
-- cs has a list is ok, the length is the number of direct children of an ngram which is generally < 10.
-- cs has a list is ok, the length is the number of direct children of an ngram which is generally < 10.
forest =
forest =
...
@@ -233,25 +238,30 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt
...
@@ -233,25 +238,30 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt
, ngramsSelection
, ngramsSelection
, ngramsTable
, ngramsTable
} _ = do
} _ = do
pure $ Tbl.makeRow
[
pure $ Tbl.makeRow
H.div { className: "ngrams-selector" } [
[ H.div { className: "ngrams-selector" }
H.span { className: "ngrams-chooser fa fa-eye-slash"
[
H.span { className: "ngrams-chooser fa fa-eye-slash"
, on: { click: onClick } } []
, on: { click: onClick } } []
]
]
, selected
, selected
, checkbox GT.MapTerm
, checkbox GT.MapTerm
, checkbox GT.StopTerm
, checkbox GT.StopTerm
, H.div {} ( if ngramsParent == Nothing
, H.div {}
then [renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit }]
( if ngramsParent == Nothing
else [H.a { on: { click: const $ dispatch $ ToggleChild true ngrams } }
then [renderNgramsTree { ngramsChildren
[ H.i { className: "fa fa-plus" } []]
, ngramsClick
, R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ]
, ngramsDepth
]
, ngramsEdit
)
, ngramsStyle }]
else [H.a { on: { click: const $ dispatch $ ToggleChild true ngrams } }
[ H.i { className: "fa fa-plus" } []]
, R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ]
]
)
, H.text $ show (ngramsElement ^. _NgramsElement <<< _occurrences)
, H.text $ show (ngramsElement ^. _NgramsElement <<< _occurrences)
]
]
where
where
ngramsDepth= {ngrams, depth: 0 }
ngramsDepth= {
ngrams, depth: 0 }
tag =
tag =
case ngramsClick ngramsDepth of
case ngramsClick ngramsDepth of
Just effect ->
Just effect ->
...
@@ -263,7 +273,8 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt
...
@@ -263,7 +273,8 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt
-- R2.callTrigger toggleSidePanel unit
-- R2.callTrigger toggleSidePanel unit
termList = ngramsElement ^. _NgramsElement <<< _list
termList = ngramsElement ^. _NgramsElement <<< _list
ngramsStyle = [termStyle termList ngramsOpacity]
ngramsStyle = [termStyle termList ngramsOpacity]
ngramsEdit = Just <<< dispatch <<< SetParentResetChildren <<< Just <<< view _ngrams
ngramsEdit { ngrams } = Just $ dispatch $ SetParentResetChildren (Just ngrams) ngramsChildren
ngramsChildren = ngramsTable ^.. ix ngrams <<< _NgramsRepoElement <<< _children <<< folded
ngramsClick =
ngramsClick =
Just <<< dispatch <<< CoreAction <<< cycleTermListItem <<< view _ngrams
Just <<< dispatch <<< CoreAction <<< cycleTermListItem <<< view _ngrams
-- ^ This is the old behavior it is nicer to use since one can
-- ^ This is the old behavior it is nicer to use since one can
...
...
src/Gargantext/Components/NgramsTable/Core.purs
View file @
a1b4c82f
...
@@ -1020,7 +1020,8 @@ data CoreAction
...
@@ -1020,7 +1020,8 @@ data CoreAction
data Action
data Action
= CoreAction CoreAction
= CoreAction CoreAction
| SetParentResetChildren (Maybe NgramsTerm)
| ClearTreeEdit
| SetParentResetChildren (Maybe NgramsTerm) (List NgramsTerm)
-- ^ This sets `ngramsParent` and resets `ngramsChildren`.
-- ^ This sets `ngramsParent` and resets `ngramsChildren`.
| ToggleChild Boolean NgramsTerm
| ToggleChild Boolean NgramsTerm
-- ^ Toggles the NgramsTerm in the `PatchSet` `ngramsChildren`.
-- ^ Toggles the NgramsTerm in the `PatchSet` `ngramsChildren`.
...
...
src/Gargantext/Components/Nodes/Annuaire/Tabs.purs
View file @
a1b4c82f
...
@@ -113,18 +113,21 @@ ngramsViewCpt = here.component "ngramsView" cpt where
...
@@ -113,18 +113,21 @@ ngramsViewCpt = here.component "ngramsView" cpt where
NTC.initialPageParams session nodeId
NTC.initialPageParams session nodeId
[ defaultListId ] (TabDocument TabDocs)
[ defaultListId ] (TabDocument TabDocs)
pure $ NT.mainNgramsTable (props' path) [] where
treeEdit <- T.useBox NT.initialTreeEdit
most = RX.pick props :: Record NTCommon
props' path =
pure $ NT.mainNgramsTable (props' treeEdit path) []
(Record.merge most
where
{ afterSync
most = RX.pick props :: Record NTCommon
, path
props' treeEdit path =
, tabType: TabPairing (TabNgramType $ modeTabType mode)
(Record.merge most
, tabNgramType: modeTabType' mode
{ afterSync
, withAutoUpdate: false }) :: Record NT.MainNgramsTableProps
, path
where
, tabType: TabPairing (TabNgramType $ modeTabType mode)
afterSync :: Unit -> Aff Unit
, tabNgramType: modeTabType' mode
afterSync _ = pure unit
, treeEdit
, withAutoUpdate: false }) :: Record NT.MainNgramsTableProps
afterSync :: Unit -> Aff Unit
afterSync _ = pure unit
type NTCommon =
type NTCommon =
( boxes :: Boxes
( boxes :: Boxes
...
...
src/Gargantext/Components/Nodes/Annuaire/User/Contacts/Tabs.purs
View file @
a1b4c82f
...
@@ -146,6 +146,7 @@ ngramsViewCpt = here.component "ngramsView" cpt
...
@@ -146,6 +146,7 @@ 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
pure $ NT.mainNgramsTable {
pure $ NT.mainNgramsTable {
afterSync: \_ -> pure unit
afterSync: \_ -> pure unit
...
@@ -156,6 +157,7 @@ ngramsViewCpt = here.component "ngramsView" cpt
...
@@ -156,6 +157,7 @@ ngramsViewCpt = here.component "ngramsView" cpt
, session
, session
, tabNgramType
, tabNgramType
, tabType
, tabType
, treeEdit
, withAutoUpdate: false
, withAutoUpdate: false
} []
} []
where
where
...
...
src/Gargantext/Components/Nodes/Lists/Tabs.purs
View file @
a1b4c82f
...
@@ -89,6 +89,7 @@ ngramsViewCpt = here.component "ngramsView" cpt where
...
@@ -89,6 +89,7 @@ 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
{ listIds, nodeId, params } <- T.useLive T.unequal path
{ listIds, nodeId, params } <- T.useLive T.unequal path
...
@@ -114,6 +115,7 @@ ngramsViewCpt = here.component "ngramsView" cpt where
...
@@ -114,6 +115,7 @@ ngramsViewCpt = here.component "ngramsView" cpt where
, session
, session
, tabNgramType
, tabNgramType
, tabType
, tabType
, treeEdit
, withAutoUpdate: false
, withAutoUpdate: false
} []
} []
]
]
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment