Skip to content

P
purescript-gargantext
Commit 79910d34 authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[FIX] subtree out params

parent a918d9b1
Show whitespace changes
Inline Side-by-side
Showing with 82 additions and 65 deletions
src/Gargantext/Components/Forest/Tree.purs
View file @ 79910d34
......@@ -10,6 +10,7 @@ import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest.Tree.Node (nodeMainSpan)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
import Gargantext.Components.Forest.Tree.Node.Action.Delete (deleteNode)
......@@ -104,8 +105,6 @@ getNodeTree :: Session -> GT.ID -> Aff FTree
getNodeTree session nodeId = get session $ GR.NodeAPI GT.Tree (Just nodeId) ""
--------------
type TreeViewProps = ( asyncTasks :: R.State GAT.Storage
, tree :: FTree
, tasks :: Record Tasks
......@@ -306,16 +305,25 @@ performAction (UploadFile nodeType fileType mName contents) { session
performAction DownloadNode _ = do
liftEffect $ log "[performAction] DownloadNode"
-------
performAction (MoveNode n1 n2) p@{session} = do
void $ moveNodeReq session n1 n2
performAction (MoveNode {params}) p@{session} =
case params of
Nothing -> performAction NoAction p
Just (SubTreeOut {in:in',out}) -> do
void $ moveNodeReq session in' out
performAction RefreshTree p
performAction (MergeNode n1 n2) p@{session} = do
void $ mergeNodeReq session n1 n2
performAction (MergeNode {params}) p@{session} =
case params of
Nothing -> performAction NoAction p
Just (SubTreeOut {in:in',out}) -> do
void $ mergeNodeReq session in' out
performAction RefreshTree p
performAction (LinkNode n1 n2) p@{session} = do
void $ linkNodeReq session n1 n2
performAction (LinkNode {params}) p@{session} =
case params of
Nothing -> performAction NoAction p
Just (SubTreeOut {in:in',out}) -> do
void $ linkNodeReq session in' out
performAction RefreshTree p
-------
......
src/Gargantext/Components/Forest/Tree/Node/Action.purs
View file @ 79910d34
module Gargantext.Components.Forest.Tree.Node.Action where
import Data.Maybe (Maybe)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Gargantext.Prelude (class Show, Unit)
import Gargantext.Sessions (Session)
......@@ -29,16 +29,24 @@ data Action = AddNode String GT.NodeType
| DownloadNode
| RefreshTree
| MoveNode GT.ID GT.ID
| MergeNode GT.ID GT.ID
| LinkNode GT.ID GT.ID
| MoveNode {params :: Maybe SubTreeOut}
| MergeNode {params :: Maybe SubTreeOut}
| LinkNode {params :: Maybe SubTreeOut}
-- | MoveNode (Maybe SubTreeOut)
-- | MergeNode (Maybe SubTreeOut)
-- | LinkNode (Maybe SubTreeOut)
| NoAction
subTreeOut :: Action -> Maybe SubTreeOut
subTreeOut (MoveNode {params}) = params
subTreeOut (MergeNode {params}) = params
subTreeOut (LinkNode {params}) = params
subTreeOut _ = Nothing
setTreeOut :: Action -> Maybe SubTreeOut -> Action
setTreeOut (MoveNode {params:_}) p = MoveNode {params: p}
setTreeOut a _ = a
instance showShow :: Show Action where
show (AddNode _ _ )= "AddNode"
show DeleteNode = "DeleteNode"
......@@ -49,9 +57,9 @@ instance showShow :: Show Action where
show (UploadFile _ _ _ _)= "UploadFile"
show RefreshTree = "RefreshTree"
show DownloadNode = "Download"
show (MoveNode _ _) = "MoveNode"
show (MergeNode _ _) = "MergeNode"
show (LinkNode _ _) = "LinkNode"
show (MoveNode _ ) = "MoveNode"
show (MergeNode _ ) = "MergeNode"
show (LinkNode _ ) = "LinkNode"
show NoAction = "NoAction"
-----------------------------------------------------------------------
......@@ -65,9 +73,9 @@ icon (DoSearch _) = glyphiconNodeAction SearchBox
icon (UploadFile _ _ _ _) = glyphiconNodeAction Upload
icon RefreshTree = glyphiconNodeAction Refresh
icon DownloadNode = glyphiconNodeAction Download
icon (MoveNode _ _) = glyphiconNodeAction (Move { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (MergeNode _ _) = glyphiconNodeAction (Merge { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (LinkNode _ _) = glyphiconNodeAction (Link { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (MoveNode _ ) = glyphiconNodeAction (Move { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (MergeNode _ ) = glyphiconNodeAction (Merge { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (LinkNode _ ) = glyphiconNodeAction (Link { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon NoAction = "hand-o-right"
......@@ -83,8 +91,8 @@ text (DoSearch _ )= "Launch search !"
text (UploadFile _ _ _ _)= "Upload File !"
text RefreshTree = "Refresh Tree !"
text DownloadNode = "Download !"
text (MoveNode _ _ ) = "Move !"
text (MergeNode _ _ ) = "Merge !"
text (LinkNode _ _ ) = "Link !"
text (MoveNode _ ) = "Move !"
text (MergeNode _ ) = "Merge !"
text (LinkNode _ ) = "Link !"
text NoAction = "No Action"
-----------------------------------------------------------------------
src/Gargantext/Components/Forest/Tree/Node/Action/Link.purs
View file @ 79910d34
......@@ -21,19 +21,21 @@ linkNodeReq session fromId toId =
linkNode :: Record SubTreeParamsIn -> R.Hooks R.Element
linkNode p@{dispatch, subTreeParams, id, nodeType, session} = do
subTreeOut@(subTreeOutParams /\ setSubTreeOut) :: R.State (Maybe SubTreeOut)
<- R.useState' Nothing
let button = case subTreeOutParams of
action@(valAction /\ setAction) :: R.State Action <- R.useState' (MoveNode {params:Nothing})
let button = case valAction of
MoveNode {params} -> case params of
Just val -> submitButton (MoveNode {params: Just val}) dispatch
Nothing -> H.div {} []
Just sbto -> submitButton (LinkNode inId outId) dispatch
where
(SubTreeOut { in:inId, out:outId}) = sbto
pure $ panel [ subTreeView { subTreeOut
_ -> H.div {} []
pure $ panel [ subTreeView { action
, dispatch
, subTreeParams
, id
, nodeType
, session
, subTreeParams
}
] button
src/Gargantext/Components/Forest/Tree/Node/Action/Merge.purs
View file @ 79910d34
......@@ -22,24 +22,23 @@ mergeNodeReq session fromId toId =
mergeNode :: Record SubTreeParamsIn -> R.Hooks R.Element
mergeNode p@{dispatch, subTreeParams, id, nodeType, session} = do
subTreeOut@(subTreeOutParams /\ setSubTreeOut) :: R.State (Maybe SubTreeOut)
<- R.useState' Nothing
action@(valAction /\ setAction) :: R.State Action <- R.useState' (MoveNode {params:Nothing})
merge <- R.useState' false
options <- R.useState' (Set.singleton GT.MapTerm)
let button = case subTreeOutParams of
let button = case valAction of
MoveNode {params} -> case params of
Just val -> submitButton (MoveNode {params: Just val}) dispatch
Nothing -> H.div {} []
Just sbto -> submitButton (MergeNode inId outId) dispatch
where
(SubTreeOut { in:inId, out:outId}) = sbto
_ -> H.div {} []
pure $ panel [ subTreeView { subTreeOut
pure $ panel [ subTreeView { action
, dispatch
, subTreeParams
, id
, nodeType
, session
, subTreeParams
}
, H.div {} [ H.text "Merge which list?"
, checkboxes [GT.MapTerm, GT.CandidateTerm, GT.StopTerm] options
......
src/Gargantext/Components/Forest/Tree/Node/Action/Move.purs
View file @ 79910d34
......@@ -21,21 +21,20 @@ moveNodeReq session fromId toId =
moveNode :: Record SubTreeParamsIn -> R.Hooks R.Element
moveNode p@{dispatch, subTreeParams, id, nodeType, session} = do
subTreeOut@(subTreeOutParams /\ setSubTreeOut) :: R.State (Maybe SubTreeOut)
<- R.useState' Nothing
action@(valAction /\ setAction) :: R.State Action <- R.useState' (MoveNode {params:Nothing})
let button = case subTreeOutParams of
let button = case valAction of
MoveNode {params} -> case params of
Just val -> submitButton (MoveNode {params: Just val}) dispatch
Nothing -> H.div {} []
Just sbto -> submitButton (MoveNode inId outId) dispatch
where
(SubTreeOut { in:inId, out:outId}) = sbto
_ -> H.div {} []
pure $ panel [ subTreeView { subTreeOut
pure $ panel [ subTreeView { action
, dispatch
, subTreeParams
, id
, nodeType
, session
, subTreeParams
}
] button
src/Gargantext/Components/Forest/Tree/Node/Tools/SubTree.purs
View file @ 79910d34
......@@ -5,7 +5,7 @@ import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Effect.Uncurried (mkEffectFn1)
import Effect.Aff (Aff)
import Gargantext.Components.Forest.Tree.Node.Action (Props)
import Gargantext.Components.Forest.Tree.Node.Action (Props, Action(..), subTreeOut, setTreeOut)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeParams(..), SubTreeOut(..))
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..))
import Gargantext.Components.Forest.Tree.Node.Tools (nodeText)
......@@ -24,7 +24,7 @@ type SubTreeParamsIn =
------------------------------------------------------------------------
type SubTreeParamsProps =
( subTreeOut :: R.State (Maybe SubTreeOut)
( action :: R.State Action
| SubTreeParamsIn
)
......@@ -39,7 +39,7 @@ subTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.subTreeView" cpt
, nodeType
, session
, subTreeParams
, subTreeOut
, action
} _ =
do
let SubTreeParams {showtypes} = subTreeParams
......@@ -52,7 +52,7 @@ subTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.subTreeView" cpt
, session
, tree
, subTreeParams
, subTreeOut
, action
}
loadSubTree :: Array GT.NodeType -> Session -> Aff FTree
......@@ -97,12 +97,12 @@ subTreeTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.subTreeTreeViewCpt" cpt
) ary
, subTreeParams
, dispatch
, subTreeOut
, action
} _ = do
pure $ H.div {} [ H.div { className: "node " <> GT.fldr nodeType true}
( [ H.span { className: "name " <> clickable
, on: { click: onClick }
} [ nodeText { isSelected: isSelected targetId subTreeOutParams
} [ nodeText { isSelected: isSelected targetId valAction
, name: " " <> name
}
]
......@@ -122,15 +122,16 @@ subTreeTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.subTreeTreeViewCpt" cpt
clickable = if validNodeType then "clickable" else ""
sbto@( subTreeOutParams /\ setSubTreeOut) = subTreeOut
( valAction /\ setAction) = action
isSelected n sbtop = case sbtop of
isSelected n action = case (subTreeOut action) of
Nothing -> false
(Just (SubTreeOut {out})) -> n == out
onClick _ = mkEffectFn1 $ \_ -> case validNodeType of
false -> setSubTreeOut (const Nothing)
true -> setSubTreeOut (const $ Just $ SubTreeOut { in: id, out:targetId})
false -> setAction (const $ setTreeOut valAction Nothing)
true -> setAction (const $ setTreeOut valAction (Just $ SubTreeOut { in: id, out:targetId}))
--------------------------------------------------------------------------------------------
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