Commit 57258f2d authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'feature/toestand-global-state' of...

Merge branch 'feature/toestand-global-state' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev-merge
parents 4ab78f3b 8b60a7c0
......@@ -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'
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
......
......@@ -58,8 +58,29 @@ setTreeOut (LinkNode {nodeType, params:_}) p = LinkNode {nodeType, params: p}
setTreeOut (SharePublic {params:_}) p = SharePublic {params: p}
setTreeOut a _ = a
instance showShow :: Show Action where
derive instance genericAction :: Generic Action _
instance eqAction :: Eq Action where
eq (AddNode s1 nt1) (AddNode s2 nt2) = (eq s1 s2) && (eq nt1 nt2)
eq (DeleteNode nt1) (DeleteNode nt2) = eq nt1 nt2
eq (RenameNode s1) (RenameNode s2) = eq s1 s2
eq (UpdateNode un1) (UpdateNode un2) = eq un1 un2
eq (DoSearch at1) (DoSearch at2) = eq at1 at2
eq (UploadFile nt1 ft1 s1 _) (UploadFile nt2 ft2 s2 _) = (eq nt1 nt2) && (eq ft1 ft2) && (eq s1 s2)
eq (UploadArbitraryFile s1 _) (UploadArbitraryFile s2 _) = eq s1 s2
eq DownloadNode DownloadNode = true
eq RefreshTree RefreshTree = true
eq ClosePopover ClosePopover = true
eq (ShareTeam s1) (ShareTeam s2) = eq s1 s2
eq (AddContact ac1) (AddContact ac2) = eq ac1 ac2
eq (SharePublic p1) (SharePublic p2) = eq p1 p2
eq (MoveNode p1) (MoveNode p2) = eq p1 p2
eq (MergeNode p1) (MergeNode p2) = eq p1 p2
eq (LinkNode l1) (LinkNode l2) = eq l1 l2
eq NoAction NoAction = true
eq _ _ = false
instance showAction :: Show Action where
show (AddNode _ _ ) = "AddNode"
show (DeleteNode _ ) = "DeleteNode"
show (RenameNode _ ) = "RenameNode"
......
......@@ -8,6 +8,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.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
......@@ -53,11 +54,11 @@ linkNodeCpt :: R.Component SubTreeParamsIn
linkNodeCpt = here.component "linkNode" cpt
where
cpt p@{dispatch, subTreeParams, id, nodeType, session, handed} _ = do
action <- T.useBox (LinkNode { nodeType: Nothing, params: Nothing})
action' <- T.useLive T.unequal action
action@(valAction /\ setAction) :: R.State Action <- R.useState' (LinkNode {nodeType:Nothing,params:Nothing})
let button = case valAction of
LinkNode {params} -> case params of
let button = case action' of
LinkNode { params } -> case params of
Just val -> submitButton (LinkNode {nodeType: Just nodeType, params: Just val}) dispatch
Nothing -> H.div {} []
_ -> H.div {} []
......@@ -65,10 +66,10 @@ linkNodeCpt = here.component "linkNode" cpt
pure $ panel [
subTreeView { action
, dispatch
, handed
, id
, nodeType
, session
, subTreeParams
, handed
}
} []
] button
......@@ -31,7 +31,8 @@ mergeNodeCpt :: R.Component SubTreeParamsIn
mergeNodeCpt = here.component "mergeNode" cpt
where
cpt p@{dispatch, subTreeParams, id, nodeType, session, handed} _ = do
action@(action' /\ _) :: R.State Action <- R.useState' (MergeNode {params:Nothing})
action <- T.useBox (MergeNode { params: Nothing })
action' <- T.useLive T.unequal action
merge <- T.useBox false
options <- T.useBox (Set.singleton GT.MapTerm)
......@@ -45,12 +46,12 @@ mergeNodeCpt = here.component "mergeNode" cpt
pure $ panel
[ subTreeView { action
, dispatch
, handed
, id
, nodeType
, session
, subTreeParams
, handed
}
} []
, H.ul { className:"merge mx-auto list-group"}
([ H.li { className: "list-group-item" }
[ H.h5 { className: "mb-1" } [ H.text "Merge which list?" ]
......
......@@ -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
......@@ -9,6 +9,7 @@ import Effect.Aff (Aff)
import Prelude (($))
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Components.Forest.Tree.Node.Action (Action)
import Gargantext.Components.Forest.Tree.Node.Action as Action
......@@ -63,21 +64,22 @@ shareNodeCpt :: R.Component SubTreeParamsIn
shareNodeCpt = here.component "shareNode" cpt
where
cpt p@{dispatch, subTreeParams, id, nodeType, session, handed} _ = do
action@(valAction /\ setAction) :: R.State Action <- R.useState' (Action.SharePublic {params: Nothing})
action <- T.useBox (Action.SharePublic { params: Nothing })
action' <- T.useLive T.unequal action
let button = case valAction of
Action.SharePublic {params} -> case params of
let button = case action' of
Action.SharePublic { params } -> case params of
Just val -> Tools.submitButton (Action.SharePublic {params: Just val}) dispatch
Nothing -> H.div {} []
_ -> H.div {} []
pure $ Tools.panel [ subTreeView { action
, dispatch
, handed
, id
, nodeType
, session
, subTreeParams
, handed
}
} []
] 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,8 +50,7 @@ subTreeViewCpt = here.component "subTreeView" cpt
, nodeType
, session
, subTreeParams
} _ =
do
} _ = do
let
SubTreeParams {showtypes} = subTreeParams
-- (valAction /\ setAction) = action
......@@ -66,7 +66,7 @@ subTreeViewCpt = here.component "subTreeView" cpt
, 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 (CorpusTreeRenderProps pRender) [] ]
]
subTreeTreeView :: Record CorpusTreeProps -> R.Element
subTreeTreeView props = R.createElement subTreeTreeViewCpt props []
newtype CorpusTreeRenderProps = CorpusTreeRenderProps
{ render :: CorpusTreeRenderProps -> Array R.Element -> R.Element
| CorpusTreeProps }
subTreeTreeView :: CorpusTreeRenderProps -> Array R.Element -> R.Element
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
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
children = (map (\ctree -> render (CorpusTreeRenderProps (p { tree = ctree })) []) sortedAry) :: Array R.Element
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'
......@@ -10,14 +10,20 @@ import Reactix as R
data SubTreeOut = SubTreeOut { in :: GT.ID
, out :: GT.ID
}
derive instance genericSubTreeOut :: Generic SubTreeOut _
instance eqSubTreOut :: Eq SubTreeOut where
eq = genericEq
instance showSubTreeOut :: Show SubTreeOut where
show = genericShow
------------------------------------------------------------------------
data SubTreeParams = SubTreeParams { showtypes :: Array GT.NodeType
, valitypes :: Array GT.NodeType
}
derive instance eqSubTreeParams :: Eq SubTreeParams
derive instance genericSubTreeParams :: Generic SubTreeParams _
instance eqSubTreeParams :: Eq SubTreeParams where
eq = genericEq
instance showSubTreeParams :: Show SubTreeParams where
show = genericShow
------------------------------------------------------------------------
......
......@@ -100,7 +100,10 @@ frameLayoutViewCpt :: R.Component ViewProps
frameLayoutViewCpt = here.component "frameLayoutView" cpt
where
cpt { frame: (NodePoly { hyperdata: Hyperdata { base, frame_id }})
, nodeId, reload, session, nodeType } _ =
, nodeId
, nodeType
, reload
, session } _ =
pure $ H.div { className : "frame"
, rows: "100%,*" }
[ H.iframe { src: hframeUrl nodeType base frame_id
......
......@@ -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]
......
......@@ -53,13 +53,15 @@ 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 }
, 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) }
, 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