Commit b717ee25 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[toestand] some more subtree refactoring - but doesn't compile yet

parent 0ebcd871
......@@ -171,11 +171,10 @@ forestLayoutRawCpt = here.component "forestLayoutRaw" cpt where
, tasks } children = do
handed' <- T.useLive T.unequal p.handed
pure $ R2.row $ reverseHanded
([ H.div { className: "col-md-2 forest-layout-raw-tree" }
pure $ R2.row $ reverseHanded handed' $
[ H.div { className: "col-md-2 forest-layout-raw-tree" }
[ forest' p.handed ]
] <> children
) handed'
] <> children
where
forest' handed =
forest { backend
......
......@@ -101,7 +101,7 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
tasks' <- T.read tasks
pure $ H.span (dropProps droppedFile isDragOver)
$ reverseHanded
$ reverseHanded handed
[ folderIcon { folderOpen, nodeType } []
, chevronIcon { folderOpen, handed, isLeaf, nodeType } []
, nodeLink { frontends, handed, folderOpen, id, isSelected
......@@ -136,7 +136,7 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
, refresh: const $ dispatch RefreshTree
, session
} []
] handed
]
where
onTaskFinish id' t _ = do
mT <- T.read tasks
......
......@@ -5,6 +5,7 @@ import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude
......@@ -30,10 +31,11 @@ moveNodeCpt :: R.Component SubTreeParamsIn
moveNodeCpt = here.component "moveNode" cpt
where
cpt { dispatch, handed, id, nodeType, session, subTreeParams } _ = do
action@(valAction /\ setAction) :: R.State Action <- R.useState' (MoveNode {params: Nothing})
action :: T.Box Action <- T.useBox (MoveNode {params: Nothing})
action' <- T.useLive T.unequal action
let button = case valAction of
MoveNode {params} -> case params of
let button = case action' of
MoveNode { params } -> case params of
Just val -> submitButton (MoveNode {params: Just val}) dispatch
Nothing -> H.div {} []
_ -> H.div {} []
......@@ -45,5 +47,5 @@ moveNodeCpt = here.component "moveNode" cpt
, nodeType
, session
, subTreeParams
}
} []
] button
......@@ -184,7 +184,7 @@ panelActionCpt = here.component "panelAction" cpt
cpt {action: Merge {subTreeParams}, dispatch, id, nodeType, session, handed} _ =
pure $ mergeNode {dispatch, id, nodeType, session, subTreeParams, handed} []
cpt {action: Move {subTreeParams}, dispatch, id, nodeType, session, handed} _ =
pure $ moveNode {dispatch, id, nodeType, session, subTreeParams, handed} []
pure $ moveNode { dispatch, id, nodeType, session, subTreeParams, handed } []
cpt {action: Link {subTreeParams}, dispatch, id, nodeType, session, handed} _ =
pure $ linkNode {dispatch, id, nodeType, session, subTreeParams, handed} []
cpt {action : Share, dispatch, id, name } _ = do
......
......@@ -7,6 +7,7 @@ import Effect.Aff (Aff)
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
import Gargantext.Prelude
......@@ -25,19 +26,19 @@ here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools.SubTree"
type SubTreeParamsIn =
( subTreeParams :: SubTreeParams
, handed :: GT.Handed
( handed :: GT.Handed
, subTreeParams :: SubTreeParams
| Props
)
------------------------------------------------------------------------
type SubTreeParamsProps =
( action :: R.State Action
( action :: T.Box Action
| SubTreeParamsIn
)
subTreeView :: Record SubTreeParamsProps -> R.Element
subTreeView props = R.createElement subTreeViewCpt props []
subTreeView :: R2.Component SubTreeParamsProps
subTreeView = R.createElement subTreeViewCpt
subTreeViewCpt :: R.Component SubTreeParamsProps
subTreeViewCpt = here.component "subTreeView" cpt
......@@ -49,24 +50,23 @@ subTreeViewCpt = here.component "subTreeView" cpt
, nodeType
, session
, subTreeParams
} _ =
do
let
SubTreeParams {showtypes} = subTreeParams
-- (valAction /\ setAction) = action
-- _ <- pure $ setAction (const $ setTreeOut valAction Nothing)
useLoader session (loadSubTree showtypes) $
\tree ->
subTreeViewLoaded { action
, dispatch
, handed
, id
, nodeType
, session
, subTreeParams
, tree
}
} _ = do
let
SubTreeParams {showtypes} = subTreeParams
-- (valAction /\ setAction) = action
-- _ <- pure $ setAction (const $ setTreeOut valAction Nothing)
useLoader session (loadSubTree showtypes) $
\tree ->
subTreeViewLoaded { action
, dispatch
, handed
, id
, nodeType
, session
, subTreeParams
, tree
} []
loadSubTree :: Array GT.NodeType -> Session -> Aff FTree
loadSubTree nodetypes session = getSubTree session treeId nodetypes
......@@ -84,55 +84,68 @@ type CorpusTreeProps =
| SubTreeParamsProps
)
subTreeViewLoaded :: Record CorpusTreeProps -> R.Element
subTreeViewLoaded props = R.createElement subTreeViewLoadedCpt props []
subTreeViewLoaded :: R2.Component CorpusTreeProps
subTreeViewLoaded = R.createElement subTreeViewLoadedCpt
subTreeViewLoadedCpt :: R.Component CorpusTreeProps
subTreeViewLoadedCpt = here.component "subTreeViewLoadedCpt" cpt
subTreeViewLoadedCpt = here.component "subTreeViewLoaded" cpt
where
cpt p@{dispatch, id, nodeType, session, tree, handed} _ = do
cpt p@{ dispatch, handed, id, nodeType, session, tree } _ = do
let pRender = Record.merge { render: subTreeTreeView } p
pure $ H.div {className:"tree"}
[H.div { className: if handed == GT.RightHanded
[ H.div { className: if handed == GT.RightHanded
then "righthanded"
else "lefthanded"
}
[ subTreeTreeView p ]
[ subTreeTreeView pRender [] ]
]
subTreeTreeView :: Record CorpusTreeProps -> R.Element
subTreeTreeView props = R.createElement subTreeTreeViewCpt props []
subTreeTreeViewCpt :: R.Component CorpusTreeProps
subTreeTreeViewCpt = here.component "subTreeTreeViewCpt" cpt where
cpt p@{ tree: NTree (LNode { id: targetId, name, nodeType }) ary
, id, subTreeParams, dispatch, action, handed } _ = do
pure $ H.div {} $ GT.reverseHanded
newtype CorpusTreeRenderProps = CorpusTreeRenderProps
{ render :: R2.NTHooksComponent CorpusTreeRenderProps
| CorpusTreeProps }
subTreeTreeView :: R2.NTComponent CorpusTreeRenderProps
subTreeTreeView = R2.ntCreateElement subTreeTreeViewCpt
subTreeTreeViewCpt :: R2.NTComponent CorpusTreeRenderProps
subTreeTreeViewCpt = here.ntComponent "subTreeTreeView" cpt where
cpt (CorpusTreeRenderProps p@{ action
, dispatch
, handed
, id
, render
, subTreeParams
, tree: NTree (LNode { id: targetId, name, nodeType }) ary }) _ = do
action' <- T.useLive T.unequal action
let click e = do
let action'' = if not validNodeType then Nothing else Just $ SubTreeOut { in: id, out: targetId }
E.preventDefault e
E.stopPropagation e
T.modify_ (\a -> setTreeOut a action'') action
children = map (\ctree -> render (CorpusTreeRenderProps (p { tree = ctree })) []) sortedAry
pure $ H.div {} $ GT.reverseHanded handed
[ H.div { className: nodeClass validNodeType }
[ H.span { className: "text"
, on: { click } }
[ nodeText { handed
, isSelected: isSelected targetId valAction
, isSelected: isSelected targetId action'
, name: " " <> name } []
, H.span { className: "children" } children
]
]
]
handed
where
nodeClass vnt = "node " <> GT.fldr nodeType true <> " " <> validNodeTypeClass where
validNodeTypeClass = if vnt then "node-type-valid" else ""
SubTreeParams { valitypes } = subTreeParams
sortedAry = A.sortWith (\(NTree (LNode {id:id'}) _) -> id')
$ A.filter (\(NTree (LNode {id:id'}) _) -> id'/= id) ary
children = map (\ctree -> subTreeTreeView (p { tree = ctree })) sortedAry
validNodeType = (A.elem nodeType valitypes) && (id /= targetId)
clickable = if validNodeType then "clickable" else ""
(valAction /\ setAction) = action
isSelected n action' = case (subTreeOut action') of
Nothing -> false
(Just (SubTreeOut {out})) -> n == out
click e = do
let action' = if not validNodeType then Nothing else Just $ SubTreeOut { in: id, out: targetId }
E.preventDefault e
E.stopPropagation e
setAction $ const $ setTreeOut valAction action'
......@@ -29,19 +29,19 @@ topBarCpt = here.component "topBar" cpt
pure $ H.div { className: "navbar navbar-expand-lg navbar-dark bg-dark fixed-top"
, id: "dafixedtop"
, role: "navigation"
} $ reverseHanded [
} $ reverseHanded handed' [
-- NOTE: first (and only) entry in the sorted array should have the "ml-auto class"
-- https://stackoverflow.com/questions/19733447/bootstrap-navbar-with-left-center-or-right-aligned-items
-- In practice: only apply "ml-auto" to the last element of this list, if handed == LeftHanded
logo
, H.ul { className: "navbar-nav " <> if handed' == LeftHanded then "ml-auto" else "" } $ reverseHanded [
, H.ul { className: "navbar-nav " <> if handed' == LeftHanded then "ml-auto" else "" } $ reverseHanded handed' [
divDropdownLeft {} []
, handButton handed'
, smiley
, H.li { className: "nav-item" } [ themeSwitcher { theme: defaultTheme
, themes: allThemes } [] ]
] handed'
] handed'
]
]
where
handButton handed' = H.li { title: "If you are Left Handed you can change\n"
<> "the interface by clicking on me. Click\n"
......
......@@ -24,9 +24,9 @@ switchHanded :: forall a. a -> a -> Handed -> a
switchHanded l _ LeftHanded = l
switchHanded _ r RightHanded = r
reverseHanded :: forall a. Array a -> Handed -> Array a
reverseHanded a LeftHanded = A.reverse a
reverseHanded a RightHanded = a
reverseHanded :: forall a. Handed -> Array a -> Array a
reverseHanded LeftHanded a = A.reverse a
reverseHanded RightHanded a = a
flipHanded :: R.Element -> R.Element -> Handed -> R.Element
flipHanded l r LeftHanded = R.fragment [r, l]
......
......@@ -51,15 +51,17 @@ type Component p = Record p -> Array R.Element -> R.Element
type Leaf p = Record p -> R.Element
type Here =
{ component :: forall p. String -> R.HooksComponent p -> R.Component p
, log :: forall l. l -> Effect Unit
, log2 :: forall l. String -> l -> Effect Unit }
{ component :: forall p. String -> R.HooksComponent p -> R.Component p
, log :: forall l. l -> Effect Unit
, log2 :: forall l. String -> l -> Effect Unit
, ntComponent :: forall p. String -> NTHooksComponent p -> NTComponent p }
here :: Module -> Here
here mod =
{ component: R.hooksComponentWithModule mod
, log: log2 ("[" <> mod <> "]")
, log2: \msg -> log2 ("[" <> mod <> "] " <> msg) }
{ component: R.hooksComponentWithModule mod
, log: log2 ("[" <> mod <> "]")
, log2: \msg -> log2 ("[" <> mod <> "] " <> msg)
, ntComponent: ntHooksComponentWithModule mod }
-- newtypes
type NTHooksComponent props = props -> Array R.Element -> R.Hooks R.Element
......
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