Skip to content

P
purescript-gargantext
Commit 93e4036b authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

[ngrams] tree edit refactoring 

Doesn't work yet as expected, but some progress made in good direction.
parent 70f28cf3
Pipeline #2902 failed with stage
    in 0 seconds
    Hide whitespace changes
    Inline Side-by-side
    Showing with 209 additions and 112 deletions
    src/Gargantext/Components/NgramsTable.purs
    View file @ 93e4036b
    module Gargantext.Components.NgramsTable
    ( MainNgramsTableProps
    , CommonProps
    , TreeEdit
    , initialTreeEdit
    , mainNgramsTable
    ) where
    ......@@ -8,11 +10,13 @@ import Gargantext.Prelude
    import Data.Array as A
    import Data.FunctorWithIndex (mapWithIndex)
    import Data.Lens (to, view, (%~), (.~), (^.), (^?))
    import Data.Lens (to, view, (%~), (.~), (^.), (^?), (^..))
    import Data.Lens.At (at)
    import Data.Lens.Common (_Just)
    import Data.Lens.Fold (folded)
    import Data.Lens.Index (ix)
    import Data.List (List)
    import Data.List as List
    import Data.Map (Map)
    import Data.Map as Map
    import Data.Maybe (Maybe(..), fromMaybe, isNothing, maybe)
    ......@@ -52,23 +56,33 @@ import Unsafe.Coerce (unsafeCoerce)
    here :: R2.Here
    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 =
    CoreState (
    ngramsChildren :: 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
    , ngramsSelection :: Set NgramsTerm
    ngramsSelection :: Set NgramsTerm
    -- ^ The set of selected checkboxes of the first column.
    )
    initialTreeEdit :: TreeEdit
    initialTreeEdit =
    { ngramsChildren : List.Nil
    , ngramsChildrenDiff: Map.empty
    , ngramsParent : Nothing }
    initialState :: VersionedNgramsTable -> State
    initialState (Versioned {version}) = {
    ngramsChildren: Map.empty
    , ngramsLocalPatch: mempty
    , ngramsParent: Nothing
    ngramsLocalPatch: mempty
    , ngramsSelection: mempty
    , ngramsStagePatch: mempty
    , ngramsValidPatch: mempty
    ......@@ -97,13 +111,12 @@ type PreConversionRows = Seq.Seq NgramsElement
    type TableContainerProps =
    ( dispatch :: Dispatch
    , ngramsChildren :: Map NgramsTerm Boolean
    , ngramsParent :: Maybe NgramsTerm
    , ngramsSelection :: Set NgramsTerm
    , ngramsTable :: NgramsTable
    , queryExactMatches :: Boolean
    , path :: T.Box PageParams
    , tabNgramType :: CTabNgramType
    , treeEdit :: TreeEdit
    , syncResetButton :: Array R.Element
    , addCallback :: String -> Effect Unit
    )
    ......@@ -112,13 +125,13 @@ tableContainer :: Record TableContainerProps -> Record TT.TableContainerProps ->
    tableContainer p q = R.createElement (tableContainerCpt p) q []
    tableContainerCpt :: Record TableContainerProps -> R.Component TT.TableContainerProps
    tableContainerCpt { dispatch
    , ngramsChildren
    , ngramsParent
    , ngramsSelection
    , ngramsTable: ngramsTableCache
    , path
    , queryExactMatches
    , tabNgramType
    , treeEdit: { ngramsChildrenDiff
    , ngramsParent }
    , syncResetButton
    , addCallback
    } = here.component "tableContainer" cpt
    ......@@ -211,26 +224,27 @@ tableContainerCpt { dispatch
    editor = H.div {} $ maybe [] edit ngramsParent
    where
    edit ngrams = [ H.p {} [H.text $ "Editing " <> ngramsTermText ngrams]
    , NTC.renderNgramsTree { ngramsTable
    , ngrams
    , ngramsStyle: []
    , NTC.renderNgramsTree { ngramsChildren
    , ngramsClick
    , ngramsDepth
    , ngramsEdit
    , ngramsStyle: []
    }
    , H.button { className: "btn btn-primary"
    , on: {click: (const $ do
    dispatch AddTermChildren)}
    , on: {click: (const $ dispatch AddTermChildren)}
    } [H.text "Save"]
    , H.button { className: "btn btn-primary"
    , on: {click: (const $ dispatch $ SetParentResetChildren Nothing)}
    , on: {click: (const $ dispatch ClearTreeEdit)}
    } [H.text "Cancel"]
    ]
    where
    ngramsChildren = ngramsTable ^.. ix ngrams <<< _NgramsRepoElement <<< _children <<< folded
    ngramsDepth = { ngrams, depth: 0 }
    ngramsTable = ngramsTableCache # at ngrams
    <<< _Just
    <<< _NgramsRepoElement
    <<< _children
    %~ applyPatchSet (patchSetFromMap ngramsChildren)
    %~ applyPatchSet (patchSetFromMap ngramsChildrenDiff)
    ngramsClick {depth: 1, ngrams: child} = Just $ dispatch $ ToggleChild false child
    ngramsClick _ = Nothing
    ngramsEdit _ = Nothing
    ......@@ -266,6 +280,7 @@ type PropsNoReload =
    , mTotalRows :: Maybe Int
    , path :: T.Box PageParams
    , state :: T.Box State
    , treeEdit :: T.Box TreeEdit
    , versioned :: VersionedNgramsTable
    | CommonProps
    )
    ......@@ -303,9 +318,11 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
    , path
    , state
    , tabNgramType
    , treeEdit
    , versioned: Versioned { data: initTable }
    } _ = 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
    params <- T.useFocused (_.params) (\a b -> b { params = a }) path
    params'@{ orderBy } <- T.useLive T.unequal params
    ......@@ -341,7 +358,8 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
    , rootsWithMatches
    , state: state'
    , termListFilter
    , termSizeFilter } then
    , termSizeFilter
    , treeEdit: treeEdit' } then
    Just ngramsElement
    else
    Nothing
    ......@@ -349,7 +367,7 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
    performAction = mkDispatch { filteredRows
    , path: path'
    , state
    , state' }
    , treeEdit }
    -- filteredRows :: PreConversionRows
    -- no need to filter offset if cache is off
    ......@@ -415,14 +433,13 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
    { colNames
    , container: tableContainer
    { dispatch: performAction
    , ngramsChildren
    , ngramsParent
    , ngramsSelection
    , ngramsTable
    , path
    , queryExactMatches: exactMatches
    , syncResetButton: [ syncResetButton ]
    , tabNgramType
    , treeEdit: treeEdit'
    , addCallback
    }
    , params
    ......@@ -454,60 +471,59 @@ type MkDispatchProps = (
    filteredRows :: PreConversionRows
    , path :: PageParams
    , state :: T.Box State
    , state' :: State
    , treeEdit :: T.Box TreeEdit
    )
    mkDispatch :: Record MkDispatchProps -> (Action -> Effect Unit)
    mkDispatch { filteredRows
    , path
    , state
    , state': { ngramsChildren
    , ngramsParent
    , ngramsSelection } } = performAction
    , treeEdit } = performAction
    where
    allNgramsSelected = allNgramsSelectedOnFirstPage ngramsSelection filteredRows
    setParentResetChildren :: Maybe NgramsTerm -> State -> State
    setParentResetChildren p = _ { ngramsParent = p, ngramsChildren = Map.empty }
    performAction :: Action -> Effect Unit
    performAction (SetParentResetChildren p) =
    T.modify_ (setParentResetChildren p) state
    performAction ClearTreeEdit =
    T.write_ initialTreeEdit treeEdit
    performAction (SetParentResetChildren p c) =
    T.write_ { ngramsChildren: c
    , ngramsChildrenDiff: Map.empty
    , ngramsParent: p } treeEdit
    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
    newNC nc = Map.alter (maybe (Just b) (const Nothing)) c nc
    performAction (ToggleSelect c) =
    T.modify_ (\s@{ ngramsSelection: ns } -> s { ngramsSelection = toggleSet c ns }) state
    performAction ToggleSelectAll =
    T.modify_ toggler state
    performAction ToggleSelectAll = do
    { ngramsSelection } <- T.read state
    T.modify_ (toggler ngramsSelection) state
    where
    toggler s =
    if allNgramsSelected then
    toggler ngramsSelection s =
    if allNgramsSelectedOnFirstPage ngramsSelection filteredRows then
    s { ngramsSelection = Set.empty :: Set NgramsTerm }
    else
    s { ngramsSelection = selectNgramsOnFirstPage filteredRows }
    performAction AddTermChildren = do
    { ngramsChildren, ngramsChildrenDiff, ngramsParent } <- T.read treeEdit
    case ngramsParent of
    Nothing ->
    -- impossible but harmless
    pure unit
    Just parent -> do
    here.log2 "[performAction] AddTermChildren, parent" parent
    here.log2 "[performAction] AddTermChildren, ngramsChildren" ngramsChildren
    let pc = patchSetFromMap ngramsChildren
    here.log2 "[performAction] AddTermChildren, ngramsChildrenDiff" ngramsChildrenDiff
    let pc = patchSetFromMap ngramsChildrenDiff
    pe = NgramsPatch { patch_list: mempty, patch_children: pc }
    pt = singletonNgramsTablePatch parent pe
    T.modify_ (setParentResetChildren Nothing) state
    performAction ClearTreeEdit
    here.log2 "[performAction] pt" pt
    let ppt = case (A.head $ Set.toUnfoldable $ Map.keys ngramsChildren) of
    Nothing -> mempty
    Just h ->
    let pp = NgramsPatch { patch_list: mempty
    , patch_children: patchSetFromMap $ Map.mapMaybe (\v -> Just $ not v) ngramsChildren }
    in
    singletonNgramsTablePatch h pp
    here.log2 "[performAction] pt with patchSetFromMap" $ pt <> ppt
    -- let ppt = case (A.head $ Set.toUnfoldable $ Map.keys ngramsChildrenDiff) of
    -- Nothing -> mempty
    -- Just h ->
    -- let pp = NgramsPatch { patch_list: mempty
    -- , patch_children: patchSetFromMap $ Map.mapMaybe (\v -> Just $ not v) ngramsChildrenDiff }
    -- in
    -- singletonNgramsTablePatch h pp
    -- here.log2 "[performAction] pt with patchSetFromMap" $ pt <> ppt
    commitPatch (pt {-<> ppt-}) state
    performAction (CoreAction a) = coreDispatch path state a
    ......@@ -517,15 +533,17 @@ displayRow :: { ngramsElement :: NgramsElement
    , rootsWithMatches :: Set NgramsTerm
    , state :: State
    , termListFilter :: Maybe TermList
    , termSizeFilter :: Maybe TermSize } -> Boolean
    , termSizeFilter :: Maybe TermSize
    , treeEdit :: TreeEdit } -> Boolean
    displayRow { ngramsElement: NgramsElement {ngrams, root, list}
    , ngramsParentRoot
    , state: { ngramsChildren
    , ngramsLocalPatch
    , ngramsParent }
    , state: { ngramsLocalPatch }
    , rootsWithMatches
    , termListFilter
    , termSizeFilter } =
    , termSizeFilter
    , treeEdit: { ngramsChildren
    , ngramsChildrenDiff
    , ngramsParent } } =
    -- See these issues about the evolution of this filtering.
    -- * https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/340
    -- * https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/87
    ......@@ -535,7 +553,7 @@ displayRow { ngramsElement: NgramsElement {ngrams, root, list}
    -- ^ and which matches the search query.
    && maybe true (_ == list) termListFilter
    -- ^ and which matches the ListType filter.
    && ngramsChildren ^. at ngrams /= Just true
    && ngramsChildrenDiff ^. at ngrams /= Just true
    -- ^ and which are not scheduled to be added already
    && Just ngrams /= ngramsParent
    -- ^ and which are not our new parent
    ......@@ -543,7 +561,7 @@ displayRow { ngramsElement: NgramsElement {ngrams, root, list}
    -- ^ and which are not the root of our new parent
    && filterTermSize termSizeFilter ngrams
    -- ^ and which satisfies the chosen term size
    || ngramsChildren ^. at ngrams == Just false
    || ngramsChildrenDiff ^. at ngrams == Just false
    -- ^ unless they are scheduled to be removed.
    || NTC.tablePatchHasNgrams ngramsLocalPatch ngrams
    -- ^ unless they are being processed at the moment.
    ......@@ -562,6 +580,7 @@ type MainNgramsTableProps = (
    , path :: T.Box PageParams
    , session :: Session
    , tabType :: TabType
    , treeEdit :: T.Box TreeEdit
    | CommonProps
    )
    ......@@ -573,6 +592,8 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt
    cpt props@{ cacheState, path } _ = do
    searchQuery <- T.useFocused (_.searchQuery) (\a b -> b { searchQuery = a }) path
    cacheState' <- T.useLive T.unequal cacheState
    onSave <- T.useBox Nothing
    treeEdit <- T.useBox initialTreeEdit
    -- let path = initialPageParams session nodeId [defaultListId] tabType
    ......@@ -580,16 +601,63 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt
    NT.CacheOn -> pure $ R.fragment
    [
    loadedNgramsTableHeader { searchQuery } []
    ,
    mainNgramsTableCacheOn props []
    , mainNgramsTableCacheOn props []
    ]
    NT.CacheOff -> pure $ R.fragment
    [
    loadedNgramsTableHeader { searchQuery } []
    ,
    mainNgramsTableCacheOff props []
    , ngramsTreeEdit { onSave, treeEdit } []
    , 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 = R.createElement mainNgramsTableCacheOnCpt
    ......@@ -600,6 +668,7 @@ mainNgramsTableCacheOnCpt = here.component "mainNgramsTableCacheOn" cpt where
    , defaultListId
    , path
    , tabNgramType
    , treeEdit
    , withAutoUpdate } _ = do
    -- let path = initialPageParams session nodeId [defaultListId] tabType
    ......@@ -610,6 +679,7 @@ mainNgramsTableCacheOnCpt = here.component "mainNgramsTableCacheOn" cpt where
    , cacheState: NT.CacheOn
    , path
    , tabNgramType
    , treeEdit
    , versioned
    , withAutoUpdate } []
    useLoaderWithCacheAPI {
    ......@@ -642,12 +712,14 @@ mainNgramsTableCacheOffCpt = here.component "mainNgramsTableCacheOff" cpt where
    , boxes
    , path
    , tabNgramType
    , treeEdit
    , withAutoUpdate } _ = do
    let render versionedWithCount = mainNgramsTablePaintNoCache { afterSync
    , boxes
    , cacheState: NT.CacheOff
    , path
    , tabNgramType
    , treeEdit
    , versionedWithCount
    , withAutoUpdate } []
    useLoaderBox { errorHandler
    ......@@ -683,6 +755,7 @@ mainNgramsTableCacheOffCpt = here.component "mainNgramsTableCacheOff" cpt where
    type MainNgramsTablePaintProps = (
    cacheState :: NT.CacheState
    , treeEdit :: T.Box TreeEdit
    , path :: T.Box PageParams
    , versioned :: VersionedNgramsTable
    | CommonProps
    ......@@ -698,6 +771,7 @@ mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt
    , cacheState
    , path
    , tabNgramType
    , treeEdit
    , versioned
    , withAutoUpdate } _ = do
    state <- T.useBox $ initialState versioned
    ......@@ -712,6 +786,7 @@ mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt
    , path
    , state
    , tabNgramType
    , treeEdit
    , versioned
    , withAutoUpdate
    } []
    ......@@ -719,6 +794,7 @@ mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt
    type MainNgramsTablePaintNoCacheProps = (
    cacheState :: NT.CacheState
    , path :: T.Box PageParams
    , treeEdit :: T.Box TreeEdit
    , versionedWithCount :: VersionedWithCountNgramsTable
    | CommonProps
    )
    ......@@ -733,6 +809,7 @@ mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cp
    , cacheState
    , path
    , tabNgramType
    , treeEdit
    , versionedWithCount
    , withAutoUpdate } _ = do
    -- TODO This is lame, make versionedWithCount a proper box?
    ......@@ -750,6 +827,7 @@ mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cp
    , path
    , state
    , tabNgramType
    , treeEdit
    , versioned
    , withAutoUpdate } []
    ......
    src/Gargantext/Components/NgramsTable/Components.purs
    View file @ 93e4036b
    ......@@ -4,6 +4,7 @@ import Data.Lens ((^..), (^.), view)
    import Data.Lens.At (at)
    import Data.Lens.Fold (folded)
    import Data.Lens.Index (ix)
    import Data.List (List)
    import Data.List (null, toUnfoldable) as L
    import Data.Maybe (Maybe(..), maybe, isJust)
    import Data.Nullable (null, toMaybe)
    ......@@ -117,35 +118,35 @@ selectionCheckboxCpt = here.component "selectionCheckbox" cpt
    type RenderNgramsTree =
    ( ngrams :: NgramsTerm
    , ngramsClick :: NgramsClick
    , ngramsEdit :: NgramsClick
    , ngramsStyle :: Array DOM.Props
    , ngramsTable :: NgramsTable
    ( ngramsChildren :: List NgramsTerm
    , ngramsClick :: NgramsClick
    , ngramsDepth :: NgramsDepth
    , ngramsEdit :: NgramsClick
    , ngramsStyle :: Array DOM.Props
    --, ngramsTable :: NgramsTable
    )
    renderNgramsTree :: Record RenderNgramsTree -> R.Element
    renderNgramsTree p = R.createElement renderNgramsTreeCpt p []
    renderNgramsTreeCpt :: R.Component RenderNgramsTree
    renderNgramsTreeCpt = here.component "renderNgramsTree" cpt
    where
    cpt { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit} _ =
    pure $ H.ul {} [
    H.span { className: "tree" } [
    H.span { className: "righthanded" } [
    tree { ngramsClick
    , ngramsDepth: {ngrams, depth: 0}
    cpt { ngramsChildren, ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle } _ =
    pure $ H.ul {}
    [ H.span { className: "tree" }
    [ H.span { className: "righthanded" }
    [ tree { ngramsChildren
    , ngramsClick
    , ngramsDepth
    , ngramsEdit
    , ngramsStyle
    , ngramsTable
    }
    ]
    ]
    ]
    type NgramsDepth = {ngrams :: NgramsTerm, depth :: Int}
    type NgramsDepth = { ngrams :: NgramsTerm, depth :: Int }
    type NgramsClick = NgramsDepth -> Maybe (Effect Unit)
    type TagProps =
    ......@@ -165,24 +166,28 @@ tag tagProps =
    -}
    type TreeProps =
    ( ngramsEdit :: NgramsClick
    , ngramsTable :: NgramsTable
    ( ngramsChildren :: List NgramsTerm
    , ngramsEdit :: NgramsClick
    --, ngramsTable :: NgramsTable
    | TagProps
    )
    tree :: Record TreeProps -> R.Element
    tree p = R.createElement treeCpt p []
    treeCpt :: R.Component TreeProps
    treeCpt = here.component "tree" cpt
    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 $
    H.li { style: {width : "100%"} }
    H.li { style: { width : "100%" } }
    ([ H.i { className, style } [] ]
    <> [ R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ] ]
    <> maybe [] edit (ngramsEdit ngramsDepth)
    <> [ forest cs ]
    <> [ forest ngramsChildren ]
    )
    where
    tag =
    ......@@ -195,11 +200,11 @@ treeCpt = here.component "tree" cpt
    , H.i { className: "fa fa-pencil"
    , on: { click: const effect } } []
    ]
    leaf = L.null cs
    leaf = L.null ngramsChildren
    className = "fa fa-chevron-" <> if open then "down" else "right"
    style = if leaf then {color: "#adb5bd"} else {color: ""}
    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.
    forest =
    ......@@ -233,25 +238,30 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt
    , ngramsSelection
    , ngramsTable
    } _ = do
    pure $ Tbl.makeRow [
    H.div { className: "ngrams-selector" } [
    H.span { className: "ngrams-chooser fa fa-eye-slash"
    pure $ Tbl.makeRow
    [ H.div { className: "ngrams-selector" }
    [ H.span { className: "ngrams-chooser fa fa-eye-slash"
    , on: { click: onClick } } []
    ]
    , selected
    , checkbox GT.MapTerm
    , checkbox GT.StopTerm
    , H.div {} ( if ngramsParent == Nothing
    then [renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit }]
    else [H.a { on: { click: const $ dispatch $ ToggleChild true ngrams } }
    [ H.i { className: "fa fa-plus" } []]
    , R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ]
    ]
    )
    , H.div {}
    ( if ngramsParent == Nothing
    then [renderNgramsTree { ngramsChildren
    , ngramsClick
    , 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)
    ]
    where
    ngramsDepth= {ngrams, depth: 0 }
    ngramsDepth= { ngrams, depth: 0 }
    tag =
    case ngramsClick ngramsDepth of
    Just effect ->
    ......@@ -263,7 +273,8 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt
    -- R2.callTrigger toggleSidePanel unit
    termList = ngramsElement ^. _NgramsElement <<< _list
    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 =
    Just <<< dispatch <<< CoreAction <<< cycleTermListItem <<< view _ngrams
    -- ^ This is the old behavior it is nicer to use since one can
    ......
    src/Gargantext/Components/NgramsTable/Core.purs
    View file @ 93e4036b
    ......@@ -1020,7 +1020,8 @@ data CoreAction
    data Action
    = CoreAction CoreAction
    | SetParentResetChildren (Maybe NgramsTerm)
    | ClearTreeEdit
    | SetParentResetChildren (Maybe NgramsTerm) (List NgramsTerm)
    -- ^ This sets `ngramsParent` and resets `ngramsChildren`.
    | ToggleChild Boolean NgramsTerm
    -- ^ Toggles the NgramsTerm in the `PatchSet` `ngramsChildren`.
    ......
    src/Gargantext/Components/Nodes/Annuaire/Tabs.purs
    View file @ 93e4036b
    ......@@ -113,18 +113,21 @@ ngramsViewCpt = here.component "ngramsView" cpt where
    NTC.initialPageParams session nodeId
    [ defaultListId ] (TabDocument TabDocs)
    pure $ NT.mainNgramsTable (props' path) [] where
    most = RX.pick props :: Record NTCommon
    props' path =
    (Record.merge most
    { afterSync
    , path
    , tabType: TabPairing (TabNgramType $ modeTabType mode)
    , tabNgramType: modeTabType' mode
    , withAutoUpdate: false }) :: Record NT.MainNgramsTableProps
    where
    afterSync :: Unit -> Aff Unit
    afterSync _ = pure unit
    treeEdit <- T.useBox NT.initialTreeEdit
    pure $ NT.mainNgramsTable (props' treeEdit path) []
    where
    most = RX.pick props :: Record NTCommon
    props' treeEdit path =
    (Record.merge most
    { afterSync
    , path
    , tabType: TabPairing (TabNgramType $ modeTabType mode)
    , tabNgramType: modeTabType' mode
    , treeEdit
    , withAutoUpdate: false }) :: Record NT.MainNgramsTableProps
    afterSync :: Unit -> Aff Unit
    afterSync _ = pure unit
    type NTCommon =
    ( boxes :: Boxes
    ......
    src/Gargantext/Components/Nodes/Annuaire/User/Contacts/Tabs.purs
    View file @ 93e4036b
    ......@@ -146,6 +146,7 @@ ngramsViewCpt = here.component "ngramsView" cpt
    , nodeId
    , session } _ = do
    path <- T.useBox $ NTC.initialPageParams session nodeId [defaultListId] (TabDocument TabDocs)
    treeEdit <- T.useBox NT.initialTreeEdit
    pure $ NT.mainNgramsTable {
    afterSync: \_ -> pure unit
    ......@@ -156,6 +157,7 @@ ngramsViewCpt = here.component "ngramsView" cpt
    , session
    , tabNgramType
    , tabType
    , treeEdit
    , withAutoUpdate: false
    } []
    where
    ......
    src/Gargantext/Components/Nodes/Lists/Tabs.purs
    View file @ 93e4036b
    ......@@ -89,6 +89,7 @@ ngramsViewCpt = here.component "ngramsView" cpt where
    , session
    , path } _ = do
    chartsReload <- T.useBox T2.newReload
    treeEdit <- T.useBox NT.initialTreeEdit
    { listIds, nodeId, params } <- T.useLive T.unequal path
    ......@@ -114,6 +115,7 @@ ngramsViewCpt = here.component "ngramsView" cpt where
    , session
    , tabNgramType
    , tabType
    , treeEdit
    , 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