Commit 47c8f500 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[Forest] Link Corpus -> Annuaire.

parent 8ab51c74
...@@ -349,11 +349,11 @@ performAction (MergeNode {params}) p@{session} = ...@@ -349,11 +349,11 @@ performAction (MergeNode {params}) p@{session} =
void $ mergeNodeReq session in' out void $ mergeNodeReq session in' out
performAction RefreshTree p performAction RefreshTree p
performAction (LinkNode {params}) p@{session} = performAction (LinkNode {nodeType, params}) p@{session} = do
case params of case params of
Nothing -> performAction NoAction p Nothing -> performAction NoAction p
Just (SubTreeOut {in:in',out}) -> do Just (SubTreeOut {in:in',out}) -> do
void $ linkNodeReq session in' out void $ linkNodeReq session nodeType in' out
performAction RefreshTree p performAction RefreshTree p
------- -------
......
...@@ -33,7 +33,7 @@ data Action = AddNode String GT.NodeType ...@@ -33,7 +33,7 @@ data Action = AddNode String GT.NodeType
| SharePublic {params :: Maybe SubTreeOut} | SharePublic {params :: Maybe SubTreeOut}
| MoveNode {params :: Maybe SubTreeOut} | MoveNode {params :: Maybe SubTreeOut}
| MergeNode {params :: Maybe SubTreeOut} | MergeNode {params :: Maybe SubTreeOut}
| LinkNode {params :: Maybe SubTreeOut} | LinkNode {nodeType :: Maybe GT.NodeType, params :: Maybe SubTreeOut}
| NoAction | NoAction
...@@ -48,7 +48,7 @@ subTreeOut _ = Nothing ...@@ -48,7 +48,7 @@ subTreeOut _ = Nothing
setTreeOut :: Action -> Maybe SubTreeOut -> Action setTreeOut :: Action -> Maybe SubTreeOut -> Action
setTreeOut (MoveNode {params:_}) p = MoveNode {params: p} setTreeOut (MoveNode {params:_}) p = MoveNode {params: p}
setTreeOut (MergeNode {params:_}) p = MergeNode {params: p} setTreeOut (MergeNode {params:_}) p = MergeNode {params: p}
setTreeOut (LinkNode {params:_}) p = LinkNode {params: p} setTreeOut (LinkNode {nodeType, params:_}) p = LinkNode {nodeType, params: p}
setTreeOut (SharePublic {params:_}) p = SharePublic {params: p} setTreeOut (SharePublic {params:_}) p = SharePublic {params: p}
setTreeOut a _ = a setTreeOut a _ = a
......
module Gargantext.Components.Forest.Tree.Node.Action.Link module Gargantext.Components.Forest.Tree.Node.Action.Link
where where
import Data.Argonaut as Argonaut
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
...@@ -9,14 +12,45 @@ import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel) ...@@ -9,14 +12,45 @@ import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn) import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, put_) import Gargantext.Sessions (Session, post)
import Gargantext.Routes as GR
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
linkNodeReq :: Session -> GT.ID -> GT.ID -> Aff (Array GT.ID)
linkNodeReq session fromId toId = data LinkNodeReq = LinkNodeReq { nodeType :: GT.NodeType
put_ session $ NodeAPI GT.Node (Just fromId) ("pairWith/" <> show toId) , id :: GT.ID
}
derive instance eqLinkNodeReq :: Eq LinkNodeReq
derive instance genericLinkNodeReq :: Generic LinkNodeReq _
instance showLinkNodeReq :: Show LinkNodeReq where
show = genericShow
instance decodeJsonLinkNodeReq :: Argonaut.DecodeJson LinkNodeReq where
decodeJson = genericSumDecodeJson
instance encodeJsonLinkNodeReq :: Argonaut.EncodeJson LinkNodeReq where
encodeJson = genericSumEncodeJson
linkNodeReq :: Session -> Maybe GT.NodeType -> GT.ID -> GT.ID -> Aff GT.AsyncTaskWithType
linkNodeReq session nt fromId toId = do
task <- post session (NodeAPI GT.Node (Just fromId) "update")
(LinkNodeReq { nodeType: linkNodeType nt
, id: toId
}
)
pure $ GT.AsyncTaskWithType {task, typ: GT.UpdateNode }
where
p = GR.NodeAPI GT.Node (Just fromId) "update"
linkNodeType :: Maybe GT.NodeType -> GT.NodeType
linkNodeType (Just GT.Corpus) = GT.Annuaire
linkNodeType (Just GT.Annuaire) = GT.Corpus
linkNodeType _ = GT.Error
linkNode :: Record SubTreeParamsIn -> R.Element linkNode :: Record SubTreeParamsIn -> R.Element
linkNode p = R.createElement linkNodeCpt p [] linkNode p = R.createElement linkNodeCpt p []
...@@ -26,11 +60,11 @@ linkNodeCpt = R.hooksComponent "G.C.F.T.N.A.L.linkNode" cpt ...@@ -26,11 +60,11 @@ linkNodeCpt = R.hooksComponent "G.C.F.T.N.A.L.linkNode" cpt
where where
cpt p@{dispatch, subTreeParams, id, nodeType, session} _ = do cpt p@{dispatch, subTreeParams, id, nodeType, session} _ = do
action@(valAction /\ setAction) :: R.State Action <- R.useState' (LinkNode {params:Nothing}) action@(valAction /\ setAction) :: R.State Action <- R.useState' (LinkNode {nodeType:Nothing,params:Nothing})
let button = case valAction of let button = case valAction of
LinkNode {params} -> case params of LinkNode {params} -> case params of
Just val -> submitButton (LinkNode {params: Just val}) dispatch Just val -> submitButton (LinkNode {nodeType: Just nodeType, params: Just val}) dispatch
Nothing -> H.div {} [] Nothing -> H.div {} []
_ -> H.div {} [] _ -> H.div {} []
......
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