Commit 556bee6b authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[NgramsTable] edit works now but with bugs

parent 2785cff9
Pipeline #2917 failed with stage
...@@ -3,6 +3,7 @@ module Gargantext.Components.NgramsTable ...@@ -3,6 +3,7 @@ module Gargantext.Components.NgramsTable
, CommonProps , CommonProps
, TreeEdit , TreeEdit
, NgramsTreeEditProps , NgramsTreeEditProps
, getNgramsChildrenAff
, initialTreeEdit , initialTreeEdit
, mainNgramsTable , mainNgramsTable
) where ) where
...@@ -31,11 +32,12 @@ import Data.Tuple (Tuple(..)) ...@@ -31,11 +32,12 @@ import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Gargantext.Components.App.Store (Boxes) 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, 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.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
...@@ -44,7 +46,7 @@ import Gargantext.Config.REST (AffRESTError, logRESTError) ...@@ -44,7 +46,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, NodeID, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes) import Gargantext.Types (CTabNgramType, ListId, 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
...@@ -122,7 +124,6 @@ type TableContainerProps = ...@@ -122,7 +124,6 @@ type TableContainerProps =
, queryExactMatches :: Boolean , queryExactMatches :: Boolean
, syncResetButton :: Array R.Element , syncResetButton :: Array R.Element
, tabNgramType :: CTabNgramType , tabNgramType :: CTabNgramType
, treeEdit :: TreeEdit
) )
tableContainer :: Record TableContainerProps -> Record TT.TableContainerProps -> R.Element tableContainer :: Record TableContainerProps -> Record TT.TableContainerProps -> R.Element
...@@ -137,8 +138,6 @@ tableContainerCpt { addCallback ...@@ -137,8 +138,6 @@ tableContainerCpt { addCallback
, queryExactMatches , queryExactMatches
, syncResetButton , syncResetButton
, tabNgramType , tabNgramType
, treeEdit: { ngramsChildrenDiff
, ngramsParent }
} = here.component "tableContainer" cpt } = here.component "tableContainer" cpt
where where
cpt props _ = do cpt props _ = do
...@@ -199,7 +198,6 @@ tableContainerCpt { addCallback ...@@ -199,7 +198,6 @@ tableContainerCpt { addCallback
] ]
] ]
] ]
, editor
, if (selectionsExist ngramsSelection) , if (selectionsExist ngramsSelection)
then H.li {className: "list-group-item"} then H.li {className: "list-group-item"}
[selectButtons true] [selectButtons true]
...@@ -226,35 +224,6 @@ tableContainerCpt { addCallback ...@@ -226,35 +224,6 @@ tableContainerCpt { addCallback
setTermSizeFilter x = T.modify (_ { termSizeFilter = x }) path setTermSizeFilter x = T.modify (_ { termSizeFilter = x }) path
setSelection term = dispatch $ setTermListSetA ngramsTableCache ngramsSelection term setSelection term = dispatch $ setTermListSetA ngramsTableCache ngramsSelection term
editor = H.div {} $ maybe [] edit ngramsParent
where
edit ngrams = [ H.p {} [H.text $ "Editing " <> ngramsTermText ngrams]
, NTC.renderNgramsTree { getNgramsChildren
, ngramsChildren
, ngramsClick
, ngramsDepth
, ngramsEdit
, ngramsStyle: []
}
, 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
ngramsChildren = ngramsTable ^.. ix ngrams <<< _NgramsRepoElement <<< _children <<< folded
ngramsDepth = { ngrams, depth: 0 }
ngramsTable = ngramsTableCache # at ngrams
<<< _Just
<<< _NgramsRepoElement
<<< _children
%~ applyPatchSet (patchSetFromMap ngramsChildrenDiff)
ngramsClick {depth: 1, ngrams: child} = Just $ dispatch $ ToggleChild false child
ngramsClick _ = Nothing
ngramsEdit _ = Nothing
selectionsExist :: Set NgramsTerm -> Boolean selectionsExist :: Set NgramsTerm -> Boolean
selectionsExist = not <<< Set.isEmpty selectionsExist = not <<< Set.isEmpty
...@@ -438,7 +407,7 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where ...@@ -438,7 +407,7 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
R.useEffect' $ do R.useEffect' $ do
R.setRef treeEdit.onCancelRef $ Just $ const $ performAction ClearTreeEdit R.setRef treeEdit.onCancelRef $ Just $ const $ performAction ClearTreeEdit
R.setRef treeEdit.onSaveRef $ Just $ const $ performAction AddTermChildren R.setRef treeEdit.onSaveRef $ Just $ const $ performAction AddTermChildren
let ngramsClick { depth: 1, ngrams: child } = Just $ performAction $ ToggleChild false child let ngramsClick { depth: 1, ngrams: child } = Just $ performAction $ ToggleChild false child
ngramsClick _ = Nothing ngramsClick _ = Nothing
R.setRef treeEdit.onNgramsClickRef $ Just ngramsClick R.setRef treeEdit.onNgramsClickRef $ Just ngramsClick
...@@ -455,7 +424,6 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where ...@@ -455,7 +424,6 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
, queryExactMatches: exactMatches , queryExactMatches: exactMatches
, syncResetButton: [ syncResetButton ] , syncResetButton: [ syncResetButton ]
, tabNgramType , tabNgramType
, treeEdit: treeEdit'
} }
, params , params
, rows: filteredConvertedRows , rows: filteredConvertedRows
...@@ -498,14 +466,16 @@ mkDispatch { filteredRows ...@@ -498,14 +466,16 @@ mkDispatch { filteredRows
performAction :: Action -> Effect Unit performAction :: Action -> Effect Unit
performAction ClearTreeEdit = do performAction ClearTreeEdit = do
T.write_ initialTreeEdit treeEdit.box T.write_ initialTreeEdit treeEdit.box
performAction (SetParentResetChildren p c) = do performAction (SetParentResetChildren ngramsParent ngramsChildren) = do
T.write_ { ngramsChildren: c T.write_ { ngramsChildren
, ngramsChildrenDiff: Map.empty , ngramsChildrenDiff: Map.empty
, ngramsParent: p } treeEdit.box , ngramsParent } treeEdit.box
performAction (ToggleChild b c) = performAction (ToggleChild b c) = do
T.modify_ (\g@{ ngramsChildrenDiff: nc } -> g { ngramsChildrenDiff = newNC nc }) treeEdit.box here.log2 "[mkDispatch] ToggleChild b" b
here.log2 "[mkDispatch] ToggleChild c" c
T.modify_ (\g@{ ngramsChildrenDiff: ncd } -> g { ngramsChildrenDiff = newNC ncd }) treeEdit.box
where where
newNC nc = Map.alter (maybe (Just b) (const Nothing)) c nc newNC ncd = Map.alter (maybe (Just b) (const Nothing)) c ncd
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 = do performAction ToggleSelectAll = do
...@@ -524,13 +494,10 @@ mkDispatch { filteredRows ...@@ -524,13 +494,10 @@ mkDispatch { filteredRows
-- 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, ngramsChildrenDiff" ngramsChildrenDiff
let pc = patchSetFromMap ngramsChildrenDiff let pc = patchSetFromMap ngramsChildrenDiff
pe = NgramsPatch { patch_list: mempty, patch_children: pc } pe = NgramsPatch { patch_list: mempty, patch_children: pc }
pt = singletonNgramsTablePatch parent pe pt = singletonNgramsTablePatch parent pe
performAction ClearTreeEdit performAction ClearTreeEdit
here.log2 "[performAction] pt" pt
-- let ppt = case (A.head $ Set.toUnfoldable $ Map.keys ngramsChildrenDiff) of -- let ppt = case (A.head $ Set.toUnfoldable $ Map.keys ngramsChildrenDiff) of
-- Nothing -> mempty -- Nothing -> mempty
-- Just h -> -- Just h ->
...@@ -599,18 +566,18 @@ type MainNgramsTableProps = ( ...@@ -599,18 +566,18 @@ type MainNgramsTableProps = (
| CommonProps | CommonProps
) )
getNgramsChildrenAff :: Session -> NodeID -> TabType -> NgramsTerm -> Aff (Array NgramsTerm) getNgramsChildrenAff :: Session -> NodeID -> Array ListId -> TabType -> NgramsTerm -> Aff (Array NgramsTerm)
getNgramsChildrenAff session nodeId tabType ngrams = do getNgramsChildrenAff session nodeId listIds tabType (NormNgramsTerm ngrams) = do
res <- get session $ R.GetNgrams params (Just nodeId) res <- get session $ R.GetNgrams params (Just nodeId)
case res of case res of
Left err -> pure [] Left err -> pure []
Right r -> pure r Right r -> pure r
where where
params = { limit: 10 params = { limit: 10
, listIds: [] , listIds
, offset: Nothing , offset: Nothing
, orderBy: Nothing , orderBy: Nothing
, searchQuery: show ngrams , searchQuery: ngrams
, tabType , tabType
, termListFilter: Nothing , termListFilter: Nothing
, termSizeFilter: Nothing } , termSizeFilter: Nothing }
...@@ -620,7 +587,7 @@ mainNgramsTable = R.createElement mainNgramsTableCpt ...@@ -620,7 +587,7 @@ 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, session, tabType } _ = do cpt props@{ cacheState, path, session, tabType, treeEdit } _ = 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
...@@ -630,7 +597,14 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt ...@@ -630,7 +597,14 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt
nodeId <- T.useFocused (_.nodeId) (\a b -> b { nodeId = a }) path nodeId <- T.useFocused (_.nodeId) (\a b -> b { nodeId = a }) path
nodeId' <- T.useLive T.unequal nodeId nodeId' <- T.useLive T.unequal nodeId
-- let treeEdit = { box: treeEditBox
-- , getNgramsChildren: getNgramsChildrenAff session nodeId' tabType
-- , onCancelRef
-- , onNgramsClickRef
-- , onSaveRef
-- }
-- let path = initialPageParams session nodeId [defaultListId] tabType -- let path = initialPageParams session nodeId [defaultListId] tabType
case cacheState' of case cacheState' of
...@@ -642,19 +616,8 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt ...@@ -642,19 +616,8 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt
NT.CacheOff -> pure $ R.fragment NT.CacheOff -> pure $ R.fragment
[ [
loadedNgramsTableHeader { searchQuery } [] loadedNgramsTableHeader { searchQuery } []
, ngramsTreeEdit { box: treeEditBox , ngramsTreeEdit treeEdit []
, getNgramsChildren: getNgramsChildrenAff session nodeId' tabType , mainNgramsTableCacheOff props []
, onCancelRef
, onNgramsClickRef
, onSaveRef } []
, mainNgramsTableCacheOff (Record.merge props
{ treeEdit: { box: treeEditBox
, onCancelRef
, onNgramsClickRef
, onSaveRef
, getNgramsChildren: getNgramsChildrenAff session nodeId' tabType
}
}) []
] ]
type NgramsTreeEditProps = type NgramsTreeEditProps =
...@@ -670,9 +633,11 @@ ngramsTreeEdit = R.createElement ngramsTreeEditCpt ...@@ -670,9 +633,11 @@ 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@{ box } _ = do cpt props@{ box } _ = do
{ ngramsParent } <- T.useLive T.unequal box box' <- T.useLive T.unequal box
ngramsParentFocused <- T.useFocused (_.ngramsParent) (\a b -> b { ngramsParent = a }) box
ngramsParentFocused' <- T.useLive T.unequal ngramsParentFocused
pure $ case ngramsParent of pure $ case ngramsParentFocused' of
Nothing -> H.div {} [] Nothing -> H.div {} []
Just ngramsParent' -> ngramsTreeEditReal (Record.merge props { ngramsParent' }) [] Just ngramsParent' -> ngramsTreeEditReal (Record.merge props { ngramsParent' }) []
...@@ -690,12 +655,16 @@ ngramsTreeEditRealCpt = here.component "ngramsTreeEditReal" cpt where ...@@ -690,12 +655,16 @@ ngramsTreeEditRealCpt = here.component "ngramsTreeEditReal" cpt where
let ngramsDepth = { depth: 1, ngrams: ngramsParent' } let ngramsDepth = { depth: 1, ngrams: ngramsParent' }
ngramsChildrenPatched :: Set NgramsTerm ngramsChildrenPatched :: Set NgramsTerm
ngramsChildrenPatched = applyPatchSet (patchSetFromMap ngramsChildrenDiff) $ Set.fromFoldable ngramsChildren ngramsChildrenPatched = applyPatchSet (patchSetFromMap ngramsChildrenDiff) $ Set.fromFoldable ngramsChildren
gnc ngrams = if ngrams == ngramsParent'
then do
pure $ A.fromFoldable ngramsChildrenPatched
else do
pure []
pure $ H.div {} pure $ H.div {}
[ H.p {} [ H.p {}
[ H.text $ "Editing " <> ngramsTermText ngramsDepth.ngrams ] [ H.text $ "Editing " <> ngramsTermText ngramsDepth.ngrams ]
, NTC.renderNgramsTree { getNgramsChildren , NTC.renderNgramsTree { getNgramsChildren: gnc
, ngramsChildren: List.fromFoldable ngramsChildrenPatched
, ngramsClick , ngramsClick
, ngramsDepth , ngramsDepth
, ngramsEdit , ngramsEdit
...@@ -709,11 +678,6 @@ ngramsTreeEditRealCpt = here.component "ngramsTreeEditReal" cpt where ...@@ -709,11 +678,6 @@ ngramsTreeEditRealCpt = here.component "ngramsTreeEditReal" cpt where
} [ H.text "Cancel" ] } [ H.text "Cancel" ]
] ]
where where
-- ngramsTable = ngramsTableCache # at ngrams
-- <<< _Just
-- <<< _NgramsRepoElement
-- <<< _children
-- %~ 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 :: NgramsClick
...@@ -890,7 +854,6 @@ mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cp ...@@ -890,7 +854,6 @@ mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cp
state <- T.useBox $ initialState versioned state <- T.useBox $ initialState versioned
pure $ pure $
loadedNgramsTableBody loadedNgramsTableBody
{ afterSync { afterSync
, boxes , boxes
......
module Gargantext.Components.NgramsTable.Components where module Gargantext.Components.NgramsTable.Components where
import Data.Either (Either(..))
import Data.Lens ((^..), (^.), view) 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 (List)
import Data.List (null, toUnfoldable) as L import Data.List as L
import Data.Maybe (Maybe(..), maybe, isJust) import Data.Maybe (Maybe(..), maybe, isJust)
import Data.Nullable (null, toMaybe) import Data.Nullable (null, toMaybe)
import Data.Set (Set) import Data.Set (Set)
...@@ -16,6 +17,8 @@ import Effect.Class (liftEffect) ...@@ -16,6 +17,8 @@ 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
import Gargantext.Config.REST (logRESTError)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Unit, bind, const, discard, map, not, otherwise, pure, show, unit, ($), (+), (/=), (<<<), (<>), (==), (>), (||)) import Gargantext.Prelude (Unit, bind, const, discard, map, not, otherwise, pure, show, unit, ($), (+), (/=), (<<<), (<>), (==), (>), (||))
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -23,7 +26,9 @@ import React.DOM (a, span, text) ...@@ -23,7 +26,9 @@ import React.DOM (a, span, text)
import React.DOM.Props as DOM import React.DOM.Props as DOM
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 Type.Proxy (Proxy(..))
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.NgramsTable.Components" here = R2.here "Gargantext.Components.NgramsTable.Components"
...@@ -121,7 +126,7 @@ selectionCheckboxCpt = here.component "selectionCheckbox" cpt ...@@ -121,7 +126,7 @@ selectionCheckboxCpt = here.component "selectionCheckbox" cpt
type RenderNgramsTree = type RenderNgramsTree =
( getNgramsChildren :: NgramsTerm -> Aff (Array NgramsTerm) ( getNgramsChildren :: NgramsTerm -> Aff (Array NgramsTerm)
, ngramsChildren :: List NgramsTerm --, ngramsChildren :: List NgramsTerm
, ngramsClick :: NgramsClick , ngramsClick :: NgramsClick
, ngramsDepth :: NgramsDepth , ngramsDepth :: NgramsDepth
, ngramsEdit :: NgramsClick , ngramsEdit :: NgramsClick
...@@ -134,12 +139,12 @@ renderNgramsTree p = R.createElement renderNgramsTreeCpt p [] ...@@ -134,12 +139,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 { getNgramsChildren, ngramsChildren, ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle } _ = cpt { getNgramsChildren, 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 { getNgramsChildren [ tree { getNgramsChildren
, ngramsChildren --, ngramsChildren
, ngramsClick , ngramsClick
, ngramsDepth , ngramsDepth
, ngramsEdit , ngramsEdit
...@@ -168,7 +173,6 @@ tag tagProps = ...@@ -168,7 +173,6 @@ tag tagProps =
type TreeProps = type TreeProps =
( getNgramsChildren :: NgramsTerm -> Aff (Array NgramsTerm) ( getNgramsChildren :: NgramsTerm -> Aff (Array NgramsTerm)
, ngramsChildren :: List NgramsTerm
, ngramsEdit :: NgramsClick , ngramsEdit :: NgramsClick
--, ngramsTable :: NgramsTable --, ngramsTable :: NgramsTable
| TagProps | TagProps
...@@ -177,47 +181,60 @@ type TreeProps = ...@@ -177,47 +181,60 @@ type TreeProps =
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 props@{ getNgramsChildren, ngramsDepth } _ = do
cpt params@{ getNgramsChildren, ngramsChildren, ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle } _ = do let loader p = do
R.useEffect' $ do res <- getNgramsChildren p
launchAff_ $ do pure $ Right res
c <- getNgramsChildren ngramsDepth.ngrams let render nc = treeLoaded (Record.merge props { ngramsChildren: L.fromFoldable nc })
liftEffect $ here.log2 "[tree] ngrams" ngramsDepth.ngrams
liftEffect $ here.log2 "[tree] children" c useLoader { errorHandler
, loader
pure $ , path: ngramsDepth.ngrams
H.li { style: { width : "100%" } } , render }
([ H.i { className, style } [] ] where
<> [ R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ] ] errorHandler = logRESTError here "[tree]"
<> maybe [] edit (ngramsEdit ngramsDepth)
<> [ forest ngramsChildren ] type TreeLoaded =
) ( ngramsChildren :: List NgramsTerm
where | TreeProps )
tag =
case ngramsClick ngramsDepth of treeLoaded :: Record TreeLoaded -> R.Element
Just effect -> treeLoaded p = R.createElement treeLoadedCpt p []
a (ngramsStyle <> [DOM.onClick $ const effect]) treeLoadedCpt :: R.Component TreeLoaded
Nothing -> treeLoadedCpt = here.component "treeLoaded" cpt where
span ngramsStyle cpt params@{ ngramsChildren, ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle } _ = do
edit effect = [ H.text " " pure $
, H.i { className: "fa fa-pencil" H.li { style: { width : "100%" } }
, on: { click: const effect } } [] ([ H.i { className, style } [] ]
] <> [ R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ] ]
leaf = L.null ngramsChildren <> maybe [] edit (ngramsEdit ngramsDepth)
className = "fa fa-chevron-" <> if open then "down" else "right" <> [ forest ngramsChildren ]
style = if leaf then {color: "#adb5bd"} else {color: ""} )
open = not leaf || false {- TODO -} where
--cs = ngramsTable ^.. ix ngramsDepth.ngrams <<< _NgramsRepoElement <<< _children <<< folded tag =
-- cs has a list is ok, the length is the number of direct children of an ngram which is generally < 10. case ngramsClick ngramsDepth of
Just effect ->
forest = a (ngramsStyle <> [DOM.onClick $ const effect])
let depth = ngramsDepth.depth + 1 in Nothing ->
if depth > 10 then span ngramsStyle
const $ H.text "ERROR DEPTH > 10" edit effect = [ H.text " "
else , H.i { className: "fa fa-pencil"
H.ul {} <<< map (\ngrams -> tree (params { ngramsDepth = {depth, ngrams} })) <<< L.toUnfoldable , on: { click: const effect } } []
]
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 has a list is ok, the length is the number of direct children of an ngram which is generally < 10.
forest =
let depth = ngramsDepth.depth + 1 in
if depth > 10 then
const $ H.text "ERROR DEPTH > 10"
else
H.ul {} <<< map (\ngrams -> tree ((Record.delete (Proxy :: Proxy "ngramsChildren") params) { ngramsDepth = {depth, ngrams} })) <<< L.toUnfoldable
type RenderNgramsItem = type RenderNgramsItem =
( dispatch :: Action -> Effect Unit ( dispatch :: Action -> Effect Unit
...@@ -254,21 +271,20 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt ...@@ -254,21 +271,20 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt
, checkbox GT.StopTerm , checkbox GT.StopTerm
, H.div {} , H.div {}
( if ngramsParent == Nothing ( if ngramsParent == Nothing
then [renderNgramsTree { getNgramsChildren then [ renderNgramsTree { getNgramsChildren
, ngramsChildren , ngramsClick
, ngramsClick , ngramsDepth
, ngramsDepth , ngramsEdit
, ngramsEdit , ngramsStyle } ]
, ngramsStyle }] else [ H.a { on: { click: const $ dispatch $ ToggleChild true ngrams } }
else [H.a { on: { click: const $ dispatch $ ToggleChild true ngrams } } [ H.i { className: "fa fa-plus" } [] ]
[ H.i { className: "fa fa-plus" } []]
, R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ] , 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 ->
......
...@@ -151,16 +151,15 @@ pageLayoutCpt = here.component "pageLayout" cpt ...@@ -151,16 +151,15 @@ pageLayoutCpt = here.component "pageLayout" cpt
errorHandler = logRESTError here "[pageLayout]" errorHandler = logRESTError here "[pageLayout]"
type PageProps = type PageProps =
( session :: Session ( frontends :: Frontends
, frontends :: Frontends
, pagePath :: T.Box PagePath , pagePath :: T.Box PagePath
-- , info :: AnnuaireInfo -- , info :: AnnuaireInfo
, session :: Session
, table :: TableResult CT.NodeContact , table :: TableResult CT.NodeContact
) )
page :: Record PageProps -> R.Element page :: Record PageProps -> R.Element
page props = R.createElement pageCpt props [] page props = R.createElement pageCpt props []
pageCpt :: R.Component PageProps pageCpt :: R.Component PageProps
pageCpt = here.component "page" cpt pageCpt = here.component "page" cpt
where where
......
...@@ -100,13 +100,13 @@ ngramsViewCpt = here.component "ngramsView" cpt where ...@@ -100,13 +100,13 @@ ngramsViewCpt = here.component "ngramsView" cpt where
R.fragment R.fragment
[ [
ngramsView' ngramsView'
{ mode { boxes
, boxes , corpusData: props.corpusData
, session
, params
, listIds , listIds
, mode
, nodeId , nodeId
, corpusData: props.corpusData , params
, session
} [] } []
, ,
NT.mainNgramsTable NT.mainNgramsTable
...@@ -119,7 +119,7 @@ ngramsViewCpt = here.component "ngramsView" cpt where ...@@ -119,7 +119,7 @@ ngramsViewCpt = here.component "ngramsView" cpt where
, tabNgramType , tabNgramType
, tabType , tabType
, treeEdit: { box: treeEditBox , treeEdit: { box: treeEditBox
, getNgramsChildren: \_ -> pure [] , getNgramsChildren: NT.getNgramsChildrenAff session nodeId listIds tabType
, onCancelRef , onCancelRef
, onNgramsClickRef , onNgramsClickRef
, onSaveRef } , onSaveRef }
...@@ -148,26 +148,28 @@ ngramsViewCpt = here.component "ngramsView" cpt where ...@@ -148,26 +148,28 @@ ngramsViewCpt = here.component "ngramsView" cpt where
-- @XXX re-render issue -> clone component -- @XXX re-render issue -> clone component
type NgramsViewProps' = type NgramsViewProps' =
( mode :: Mode ( boxes :: Boxes
, boxes :: Boxes , corpusData :: CorpusData
, session :: Session
, listIds :: Array Int , listIds :: Array Int
, params :: Params , mode :: Mode
, nodeId :: Int , nodeId :: Int
, corpusData :: CorpusData , params :: Params
, session :: Session
) )
ngramsView' :: R2.Component NgramsViewProps' ngramsView' :: R2.Component NgramsViewProps'
ngramsView' = R.createElement ngramsViewCpt' ngramsView' = R.createElement ngramsViewCpt'
ngramsViewCpt' :: R.Memo NgramsViewProps' --ngramsViewCpt' :: R.Memo NgramsViewProps'
ngramsViewCpt' = R.memo' $ here.component "ngramsView_clone" cpt where --ngramsViewCpt' = R.memo' $ here.component "ngramsView_clone" cpt where
cpt { mode ngramsViewCpt' :: R.Component NgramsViewProps'
, boxes ngramsViewCpt' = here.component "ngramsView_clone" cpt where
, session cpt { boxes
, corpusData: { defaultListId }
, listIds , listIds
, params , mode
, nodeId , nodeId
, corpusData: { defaultListId } , params
, session
} _ = do } _ = do
let path' = { let path' = {
......
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