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

[ngramsTable] WIP

parent 55f5754c
Pipeline #2906 failed with stage
This diff is collapsed.
...@@ -11,6 +11,8 @@ import Data.Nullable (null, toMaybe) ...@@ -11,6 +11,8 @@ import Data.Nullable (null, toMaybe)
import Data.Set (Set) import Data.Set (Set)
import Data.Set as Set import Data.Set as Set
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import FFI.Simple (delay) import FFI.Simple (delay)
import Gargantext.Components.NgramsTable.Core (Action(..), Dispatch, NgramsClick, NgramsDepth, NgramsElement, NgramsTable, NgramsTablePatch, NgramsTerm, _NgramsElement, _NgramsRepoElement, _PatchMap, _children, _list, _ngrams, _occurrences, ngramsTermText, replace, setTermListA) import Gargantext.Components.NgramsTable.Core (Action(..), Dispatch, NgramsClick, NgramsDepth, NgramsElement, NgramsTable, NgramsTablePatch, NgramsTerm, _NgramsElement, _NgramsRepoElement, _PatchMap, _children, _list, _ngrams, _occurrences, ngramsTermText, replace, setTermListA)
import Gargantext.Components.Table as Tbl import Gargantext.Components.Table as Tbl
...@@ -118,11 +120,12 @@ selectionCheckboxCpt = here.component "selectionCheckbox" cpt ...@@ -118,11 +120,12 @@ selectionCheckboxCpt = here.component "selectionCheckbox" cpt
type RenderNgramsTree = type RenderNgramsTree =
( ngramsChildren :: List NgramsTerm ( getNgramsChildren :: NgramsTerm -> Aff (Array NgramsTerm)
, ngramsClick :: NgramsClick , ngramsChildren :: List NgramsTerm
, ngramsDepth :: NgramsDepth , ngramsClick :: NgramsClick
, ngramsEdit :: NgramsClick , ngramsDepth :: NgramsDepth
, ngramsStyle :: Array DOM.Props , ngramsEdit :: NgramsClick
, ngramsStyle :: Array DOM.Props
--, ngramsTable :: NgramsTable --, ngramsTable :: NgramsTable
) )
...@@ -131,11 +134,12 @@ renderNgramsTree p = R.createElement renderNgramsTreeCpt p [] ...@@ -131,11 +134,12 @@ renderNgramsTree p = R.createElement renderNgramsTreeCpt p []
renderNgramsTreeCpt :: R.Component RenderNgramsTree renderNgramsTreeCpt :: R.Component RenderNgramsTree
renderNgramsTreeCpt = here.component "renderNgramsTree" cpt renderNgramsTreeCpt = here.component "renderNgramsTree" cpt
where where
cpt { ngramsChildren, ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle } _ = cpt { getNgramsChildren, ngramsChildren, ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle } _ =
pure $ H.ul {} pure $ H.ul {}
[ H.span { className: "tree" } [ H.span { className: "tree" }
[ H.span { className: "righthanded" } [ H.span { className: "righthanded" }
[ tree { ngramsChildren [ tree { getNgramsChildren
, ngramsChildren
, ngramsClick , ngramsClick
, ngramsDepth , ngramsDepth
, ngramsEdit , ngramsEdit
...@@ -163,8 +167,9 @@ tag tagProps = ...@@ -163,8 +167,9 @@ tag tagProps =
-} -}
type TreeProps = type TreeProps =
( ngramsChildren :: List NgramsTerm ( getNgramsChildren :: NgramsTerm -> Aff (Array NgramsTerm)
, ngramsEdit :: NgramsClick , ngramsChildren :: List NgramsTerm
, ngramsEdit :: NgramsClick
--, ngramsTable :: NgramsTable --, ngramsTable :: NgramsTable
| TagProps | TagProps
) )
...@@ -174,11 +179,13 @@ tree p = R.createElement treeCpt p [] ...@@ -174,11 +179,13 @@ tree p = R.createElement treeCpt p []
treeCpt :: R.Component TreeProps treeCpt :: R.Component TreeProps
treeCpt = here.component "tree" cpt treeCpt = here.component "tree" cpt
where where
cpt params@{ ngramsChildren, ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle } _ = do cpt params@{ getNgramsChildren, ngramsChildren, ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle } _ = do
R.useEffect' $ do R.useEffect' $ do
here.log2 "[tree] ngramsChildren" ngramsChildren launchAff_ $ do
c <- getNgramsChildren ngramsDepth.ngrams
liftEffect $ here.log2 "[tree] ngrams" ngramsDepth.ngrams
liftEffect $ here.log2 "[tree] children" c
pure $ pure $
H.li { style: { width : "100%" } } H.li { style: { width : "100%" } }
([ H.i { className, style } [] ] ([ H.i { className, style } [] ]
...@@ -212,8 +219,9 @@ treeCpt = here.component "tree" cpt ...@@ -212,8 +219,9 @@ treeCpt = here.component "tree" cpt
H.ul {} <<< map (\ngrams -> tree (params { ngramsDepth = {depth, ngrams} })) <<< L.toUnfoldable H.ul {} <<< map (\ngrams -> tree (params { ngramsDepth = {depth, ngrams} })) <<< L.toUnfoldable
type RenderNgramsItem = ( type RenderNgramsItem =
dispatch :: Action -> Effect Unit ( dispatch :: Action -> Effect Unit
, getNgramsChildren :: NgramsTerm -> Aff (Array NgramsTerm)
, ngrams :: NgramsTerm , ngrams :: NgramsTerm
, ngramsElement :: NgramsElement , ngramsElement :: NgramsElement
, ngramsLocalPatch :: NgramsTablePatch , ngramsLocalPatch :: NgramsTablePatch
...@@ -228,6 +236,7 @@ renderNgramsItemCpt :: R.Component RenderNgramsItem ...@@ -228,6 +236,7 @@ renderNgramsItemCpt :: R.Component RenderNgramsItem
renderNgramsItemCpt = here.component "renderNgramsItem" cpt renderNgramsItemCpt = here.component "renderNgramsItem" cpt
where where
cpt { dispatch cpt { dispatch
, getNgramsChildren
, ngrams , ngrams
, ngramsElement , ngramsElement
, ngramsLocalPatch , ngramsLocalPatch
...@@ -245,7 +254,8 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt ...@@ -245,7 +254,8 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt
, checkbox GT.StopTerm , checkbox GT.StopTerm
, H.div {} , H.div {}
( if ngramsParent == Nothing ( if ngramsParent == Nothing
then [renderNgramsTree { ngramsChildren then [renderNgramsTree { getNgramsChildren
, ngramsChildren
, ngramsClick , ngramsClick
, ngramsDepth , ngramsDepth
, ngramsEdit , ngramsEdit
......
...@@ -80,6 +80,7 @@ module Gargantext.Components.NgramsTable.Core ...@@ -80,6 +80,7 @@ module Gargantext.Components.NgramsTable.Core
, NgramsDepth , NgramsDepth
, NgramsClick , NgramsClick
, NgramsActionRef
) )
where where
...@@ -1197,3 +1198,4 @@ postNgramsChartsAsync { listIds, nodeId, session, tabType } = do ...@@ -1197,3 +1198,4 @@ postNgramsChartsAsync { listIds, nodeId, session, tabType } = do
type NgramsDepth = { ngrams :: NgramsTerm, depth :: Int } type NgramsDepth = { ngrams :: NgramsTerm, depth :: Int }
type NgramsClick = NgramsDepth -> Maybe (Effect Unit) type NgramsClick = NgramsDepth -> Maybe (Effect Unit)
type NgramsActionRef = R.Ref (Maybe (Unit -> Effect Unit))
...@@ -113,22 +113,30 @@ ngramsViewCpt = here.component "ngramsView" cpt where ...@@ -113,22 +113,30 @@ ngramsViewCpt = here.component "ngramsView" cpt where
NTC.initialPageParams session nodeId NTC.initialPageParams session nodeId
[ defaultListId ] (TabDocument TabDocs) [ defaultListId ] (TabDocument TabDocs)
treeEdit <- T.useBox NT.initialTreeEdit onCancelRef <- R.useRef Nothing
onNgramsClickRef <- R.useRef Nothing
onSaveRef <- R.useRef Nothing
treeEditBox <- T.useBox NT.initialTreeEdit
pure $ NT.mainNgramsTable (props' treeEdit path) [] let most = RX.pick props :: Record NTCommon
where props' =
most = RX.pick props :: Record NTCommon
props' treeEdit path =
(Record.merge most (Record.merge most
{ afterSync { afterSync
, path , path
, tabType: TabPairing (TabNgramType $ modeTabType mode) , tabType: TabPairing (TabNgramType $ modeTabType mode)
, tabNgramType: modeTabType' mode , tabNgramType: modeTabType' mode
, treeEdit , treeEdit: { box: treeEditBox
, getNgramsChildren: \_ -> pure []
, onCancelRef
, onNgramsClickRef
, onSaveRef }
, withAutoUpdate: false }) :: Record NT.MainNgramsTableProps , withAutoUpdate: false }) :: Record NT.MainNgramsTableProps
afterSync :: Unit -> Aff Unit afterSync :: Unit -> Aff Unit
afterSync _ = pure unit afterSync _ = pure unit
pure $ NT.mainNgramsTable props' []
type NTCommon = type NTCommon =
( boxes :: Boxes ( boxes :: Boxes
, cacheState :: T.Box LTypes.CacheState , cacheState :: T.Box LTypes.CacheState
......
...@@ -146,7 +146,10 @@ ngramsViewCpt = here.component "ngramsView" cpt ...@@ -146,7 +146,10 @@ ngramsViewCpt = here.component "ngramsView" cpt
, nodeId , nodeId
, session } _ = do , session } _ = do
path <- T.useBox $ NTC.initialPageParams session nodeId [defaultListId] (TabDocument TabDocs) path <- T.useBox $ NTC.initialPageParams session nodeId [defaultListId] (TabDocument TabDocs)
treeEdit <- T.useBox NT.initialTreeEdit onCancelRef <- R.useRef Nothing
onNgramsClickRef <- R.useRef Nothing
onSaveRef <- R.useRef Nothing
treeEditBox <- T.useBox NT.initialTreeEdit
pure $ NT.mainNgramsTable { pure $ NT.mainNgramsTable {
afterSync: \_ -> pure unit afterSync: \_ -> pure unit
...@@ -157,7 +160,11 @@ ngramsViewCpt = here.component "ngramsView" cpt ...@@ -157,7 +160,11 @@ ngramsViewCpt = here.component "ngramsView" cpt
, session , session
, tabNgramType , tabNgramType
, tabType , tabType
, treeEdit , treeEdit: { box: treeEditBox
, getNgramsChildren: \_ -> pure []
, onCancelRef
, onNgramsClickRef
, onSaveRef }
, withAutoUpdate: false , withAutoUpdate: false
} [] } []
where where
......
...@@ -89,7 +89,10 @@ ngramsViewCpt = here.component "ngramsView" cpt where ...@@ -89,7 +89,10 @@ ngramsViewCpt = here.component "ngramsView" cpt where
, session , session
, path } _ = do , path } _ = do
chartsReload <- T.useBox T2.newReload chartsReload <- T.useBox T2.newReload
treeEdit <- T.useBox NT.initialTreeEdit onCancelRef <- R.useRef Nothing
onNgramsClickRef <- R.useRef Nothing
onSaveRef <- R.useRef Nothing
treeEditBox <- T.useBox NT.initialTreeEdit
{ listIds, nodeId, params } <- T.useLive T.unequal path { listIds, nodeId, params } <- T.useLive T.unequal path
...@@ -115,7 +118,11 @@ ngramsViewCpt = here.component "ngramsView" cpt where ...@@ -115,7 +118,11 @@ ngramsViewCpt = here.component "ngramsView" cpt where
, session , session
, tabNgramType , tabNgramType
, tabType , tabType
, treeEdit , treeEdit: { box: treeEditBox
, getNgramsChildren: \_ -> pure []
, onCancelRef
, onNgramsClickRef
, onSaveRef }
, withAutoUpdate: false , withAutoUpdate: false
} [] } []
] ]
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment