Commit 3e01bbde authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[forest] node action rewrite to toestand

Also, make components for the panelAction case expression.
parent 4928fe08
......@@ -76,7 +76,6 @@ forestCpt = here.component "forest" cpt where
-- R.useEffect' $ do
-- T.write_ (Just tasks') tasks
handed' <- T.useLive T.unequal handed
reloadForest' <- T.useLive T.unequal reloadForest
sessions' <- T.useLive T.unequal sessions
-- forestOpen' <- T.useLive T.unequal forestOpen
-- reloadRoot' <- T.useLive T.unequal reloadRoot
......
......@@ -7,6 +7,7 @@ import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff_)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude
......@@ -59,45 +60,49 @@ type CreateNodeProps =
, nodeTypes :: Array NodeType
)
addNodeView :: Record CreateNodeProps
-> R.Element
addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
where
el = here.component "addNodeView" cpt
cpt {id, name} _ = do
nodeName@(name' /\ setNodeName) <- R.useState' "Name"
nodeType'@(nt /\ setNodeType) <- R.useState' $ fromMaybe Folder $ head nodeTypes
let
SettingsBox {edit} = settingsBox nt
setNodeType' nt = do
setNodeName $ const $ GT.prettyNodeType nt
setNodeType $ const nt
(maybeChoose /\ nt') = if length nodeTypes > 1
then ([ formChoiceSafe nodeTypes Error setNodeType' ] /\ nt)
else ([H.div {} [H.text $ "Creating a node of type "
<> show defaultNt
<> " with name:"
]
] /\ defaultNt
)
where
defaultNt = (fromMaybe Error $ head nodeTypes)
maybeEdit = [ if edit
then inputWithEnter {
onBlur: \val -> setNodeName $ const val
, onEnter: \_ -> launchAff_ $ dispatch (AddNode name' nt')
, onValueChanged: \val -> setNodeName $ const val
, autoFocus: true
, className: "form-control"
, defaultValue: name' -- (prettyNodeType nt')
, placeholder: name' -- (prettyNodeType nt')
, type: "text"
}
else H.div {} []
]
pure $ panel (maybeChoose <> maybeEdit) (submitButton (AddNode name' nt') dispatch)
addNodeView :: R2.Component CreateNodeProps
addNodeView = R.createElement addNodeViewCpt
addNodeViewCpt :: R.Component CreateNodeProps
addNodeViewCpt = here.component "addNodeView" cpt where
cpt { dispatch
, id
, name
, nodeTypes } _ = do
nodeName <- T.useBox "Name"
nodeName' <- T.useLive T.unequal nodeName
nodeType <- T.useBox $ fromMaybe Folder $ head nodeTypes
nodeType' <- T.useLive T.unequal nodeType
let
SettingsBox {edit} = settingsBox nodeType'
setNodeType' nt = do
T.write_ (GT.prettyNodeType nt) nodeName
T.write_ nt nodeType
(maybeChoose /\ nt') = if length nodeTypes > 1
then ([ formChoiceSafe nodeTypes Error setNodeType' ] /\ nodeType')
else ([H.div {} [H.text $ "Creating a node of type "
<> show defaultNt
<> " with name:"
]
] /\ defaultNt
)
where
defaultNt = (fromMaybe Error $ head nodeTypes)
maybeEdit = [ if edit
then inputWithEnter {
onBlur: \val -> T.write_ val nodeName
, onEnter: \_ -> launchAff_ $ dispatch (AddNode nodeName' nt')
, onValueChanged: \val -> T.write_ val nodeName
, autoFocus: true
, className: "form-control"
, defaultValue: nodeName' -- (prettyNodeType nt')
, placeholder: nodeName' -- (prettyNodeType nt')
, type: "text"
}
else H.div {} []
]
pure $ panel (maybeChoose <> maybeEdit) (submitButton (AddNode nodeName' nt') dispatch)
-- END Create Node
......
module Gargantext.Components.Forest.Tree.Node.Action.Contact where
import Prelude
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff, launchAff)
import Formula as F
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 (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Contact.Types (AddContactParams(..))
-- import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Types (ID)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Contact"
......@@ -24,20 +23,36 @@ contactReq :: Session -> ID -> AddContactParams -> Aff ID
contactReq session nodeId =
post session $ GR.NodeAPI GT.Annuaire (Just nodeId) "contact"
type ActionAddContact =
( dispatch :: Action -> Aff Unit
, id :: ID )
actionAddContact :: R2.Component ActionAddContact
actionAddContact = R.createElement actionAddContactCpt
actionAddContactCpt :: R.Component ActionAddContact
actionAddContactCpt = here.component "actionAddContact" cpt where
cpt { dispatch, id } _ = do
isOpen <- T.useBox true
pure $ textInputBox
{ boxAction: \p -> AddContact p
, boxName:"addContact"
, dispatch
, id
, isOpen
, params: {firstname:"First Name", lastname: "Last Name"} }
type TextInputBoxProps =
( id :: ID
( boxAction :: AddContactParams -> Action
, boxName :: String
, dispatch :: Action -> Aff Unit
, params :: Record AddContactProps
, id :: ID
, isOpen :: T.Box Boolean
, boxName :: String
, boxAction :: AddContactParams -> Action
)
, params :: Record AddContactProps )
type AddContactProps = ( firstname :: String, lastname :: String)
type AddContactProps = ( firstname :: String, lastname :: String )
textInputBox :: R2.Leaf TextInputBoxProps
textInputBox props = R.createElement textInputBoxCpt props []
textInputBoxCpt :: R.Component TextInputBoxProps
textInputBoxCpt = here.component "textInputBox" cpt where
cpt p@{ boxName, boxAction, dispatch, isOpen
......
......@@ -2,18 +2,25 @@ module Gargantext.Components.Forest.Tree.Node.Action.Delete
where
import Data.Maybe (Maybe(..))
import Gargantext.Prelude
import Effect.Aff (Aff)
import Gargantext.Types as GT
import Gargantext.Sessions (Session, delete, put_)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Types (NodeType(..))
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Reactix as R
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, delete, put_)
import Gargantext.Types as GT
import Gargantext.Types (NodeType(..))
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Delete"
-- TODO Delete with asyncTaskWithType
deleteNode :: Session -> NodeType -> GT.ID -> Aff GT.ID
deleteNode session nt nodeId = delete session $ NodeAPI GT.Node (Just nodeId) ""
......@@ -30,21 +37,37 @@ unpublishNode s p n = put_ s $ NodeAPI GT.Node p ("unpublish/" <> show n)
-- | Action : Delete
actionDelete :: NodeType -> (Action -> Aff Unit) -> R.Hooks R.Element
actionDelete NodeUser _ = do
pure $ panel [ H.div { style: {margin: "10px"}}
[ H.text $ "Yes, we are RGPD compliant!"
<> " But you can not delete User Node yet."
<> " We are still on development."
<> " Thanks for your comprehensin."
type Delete =
( dispatch :: Action -> Aff Unit
, nodeType :: NodeType )
actionDelete :: R2.Component Delete
actionDelete = R.createElement actionDeleteCpt
actionDeleteCpt :: R.Component Delete
actionDeleteCpt = here.component "actionDelete" cpt where
cpt props@{ nodeType: NodeUser } _ = pure $ actionDeleteUser props []
cpt props _ = pure $ actionDeleteOther props []
actionDeleteUser :: R2.Component Delete
actionDeleteUser = R.createElement actionDeleteUserCpt
actionDeleteUserCpt :: R.Component Delete
actionDeleteUserCpt = here.component "actionDeleteUser" cpt where
cpt _ _ = do
pure $ panel [ H.div { style: {margin: "10px"}}
[ H.text $ "Yes, we are RGPD compliant!"
<> " But you can not delete User Node yet."
<> " We are still on development."
<> " Thanks for your comprehensin."
]
] (H.div {} [])
actionDeleteOther :: R2.Component Delete
actionDeleteOther = R.createElement actionDeleteOtherCpt
actionDeleteOtherCpt :: R.Component Delete
actionDeleteOtherCpt = here.component "actionDeleteOther" cpt where
cpt { dispatch, nodeType } _ = do
pure $ panel (map (\t -> H.p {} [H.text t])
[ "Are your sure you want to delete it ?"
, "If yes, click again below."
]
]
(H.div {} [])
actionDelete nt dispatch = do
pure $ panel (map (\t -> H.p {} [H.text t])
[ "Are your sure you want to delete it ?"
, "If yes, click again below."
]
)
(submitButton (DeleteNode nt) dispatch)
) (submitButton (DeleteNode nodeType) dispatch)
module Gargantext.Components.Forest.Tree.Node.Action.Documentation where
import Gargantext.Prelude (map, pure, show, ($), (<>))
import Gargantext.Types (NodeType)
import Gargantext.Types as GT
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude (map, pure, show, ($), (<>))
import Gargantext.Components.Forest.Tree.Node.Tools (panel)
import Gargantext.Types (NodeType)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Documentation"
-- | Action: Show Documentation
actionDoc :: NodeType -> R.Hooks R.Element
actionDoc nodeType =
pure $ panel ( [ infoTitle nodeType ]
<> (map (\info -> H.p {} [H.text info]) $ docOf nodeType)
)
( H.div {} [])
where
infoTitle :: NodeType -> R.Element
infoTitle nt = H.div { style: {margin: "10px"}}
[ H.h3 {} [H.text "Documentation about " ]
, H.h3 {className: GT.fldr nt true} [ H.text $ show nt ]
]
type ActionDoc =
( nodeType :: NodeType )
actionDoc :: R2.Component ActionDoc
actionDoc = R.createElement actionDocCpt
actionDocCpt :: R.Component ActionDoc
actionDocCpt = here.component "actionDoc" cpt where
cpt { nodeType } _ = do
pure $ panel ([ infoTitle nodeType ]
<> (map (\info -> H.p {} [H.text info]) $ docOf nodeType)
)
(H.div {} [])
where
infoTitle :: NodeType -> R.Element
infoTitle nt = H.div { style: {margin: "10px"}}
[ H.h3 {} [H.text "Documentation about " ]
, H.h3 {className: GT.fldr nt true} [ H.text $ show nt ]
]
-- | TODO add documentation of all NodeType
docOf :: NodeType -> Array String
......
module Gargantext.Components.Forest.Tree.Node.Action.Download where
import Data.Maybe (Maybe(..))
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Forest.Tree.Node.Action (Action(DownloadNode))
import Gargantext.Components.Forest.Tree.Node.Tools (fragmentPT, panel, submitButtonHref)
import Gargantext.Ends (url)
import Gargantext.Prelude (pure, ($))
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session)
import Gargantext.Types (NodeType(..), ID)
import Gargantext.Types (ID)
import Gargantext.Types as GT
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Documentation"
-- | Action : Download
actionDownload :: NodeType -> ID -> Session -> R.Hooks R.Element
actionDownload NodeList id session = pure $ panel [H.div {} [H.text info]]
(submitButtonHref DownloadNode href)
type ActionDownload =
( id :: ID
, nodeType :: GT.NodeType
, session :: Session )
actionDownload :: R2.Component ActionDownload
actionDownload = R.createElement actionDownloadCpt
actionDownloadCpt :: R.Component ActionDownload
actionDownloadCpt = here.component "actionDownload" cpt where
cpt props@{ nodeType: GT.Corpus } _ = pure $ actionDownloadCorpus props []
cpt props@{ nodeType: GT.Graph } _ = pure $ actionDownloadGraph props []
cpt props@{ nodeType: GT.NodeList } _ = pure $ actionDownloadNodeList props []
cpt props@{ nodeType: _ } _ = pure $ actionDownloadOther props []
actionDownloadCorpus :: R2.Component ActionDownload
actionDownloadCorpus = R.createElement actionDownloadCorpusCpt
actionDownloadCorpusCpt :: R.Component ActionDownload
actionDownloadCorpusCpt = here.component "actionDownloadCorpus" cpt where
cpt { id, session } _ = do
pure $ panel [H.div {} [H.text info]]
(submitButtonHref DownloadNode href)
where
href = url session $ Routes.NodeAPI GT.NodeList (Just id) ""
info = "Info about the List as JSON format"
href = url session $ Routes.NodeAPI GT.Corpus (Just id) "export"
info = "Download as JSON"
actionDownload GT.Graph id session = pure $ panel [H.div {} [H.text info]]
(submitButtonHref DownloadNode href)
actionDownloadGraph :: R2.Component ActionDownload
actionDownloadGraph = R.createElement actionDownloadGraphCpt
actionDownloadGraphCpt :: R.Component ActionDownload
actionDownloadGraphCpt = here.component "actionDownloadGraph" cpt where
cpt { id, session } _ = do
pure $ panel [H.div {} [H.text info]]
(submitButtonHref DownloadNode href)
where
href = url session $ Routes.NodeAPI GT.Graph (Just id) "gexf"
info = "Info about the Graph as GEXF format"
actionDownload GT.Corpus id session = pure $ panel [H.div {} [H.text info]]
(submitButtonHref DownloadNode href)
actionDownloadNodeList :: R2.Component ActionDownload
actionDownloadNodeList = R.createElement actionDownloadNodeListCpt
actionDownloadNodeListCpt :: R.Component ActionDownload
actionDownloadNodeListCpt = here.component "actionDownloadNodeList" cpt where
cpt { id, session } _ = do
pure $ panel [ H.div {} [H.text info] ]
(submitButtonHref DownloadNode href)
where
href = url session $ Routes.NodeAPI GT.Corpus (Just id) "export"
info = "Download as JSON"
href = url session $ Routes.NodeAPI GT.NodeList (Just id) ""
info = "Info about the List as JSON format"
{-
-- TODO fix the route
......@@ -40,5 +73,9 @@ actionDownload GT.Texts id session = pure $ panel [H.div {} [H.text info]]
href = url session $ Routes.NodeAPI GT.Texts (Just id) ""
info = "TODO: fix the backend route. What is the expected result ?"
-}
actionDownload _ _ _ = pure $ fragmentPT $ "Soon, you will be able to download your file here "
actionDownloadOther :: R2.Component ActionDownload
actionDownloadOther = R.createElement actionDownloadOtherCpt
actionDownloadOtherCpt :: R.Component ActionDownload
actionDownloadOtherCpt = here.component "actionDownloadOther" cpt where
cpt { id, session } _ = do
pure $ fragmentPT $ "Soon, you will be able to download your file here "
......@@ -49,7 +49,6 @@ linkNodeType _ = GT.Error
linkNode :: R2.Component SubTreeParamsIn
linkNode = R.createElement linkNodeCpt
linkNodeCpt :: R.Component SubTreeParamsIn
linkNodeCpt = here.component "linkNode" cpt
where
......
......@@ -2,7 +2,6 @@ module Gargantext.Components.Forest.Tree.Node.Action.Merge where
import Data.Maybe (Maybe(..))
import Data.Set as Set
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
......@@ -26,7 +25,6 @@ mergeNodeReq session fromId toId =
mergeNode :: R2.Component SubTreeParamsIn
mergeNode = R.createElement mergeNodeCpt
mergeNodeCpt :: R.Component SubTreeParamsIn
mergeNodeCpt = here.component "mergeNode" cpt
where
......
module Gargantext.Components.Forest.Tree.Node.Action.Move where
import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
......@@ -26,7 +25,6 @@ moveNodeReq session fromId toId =
moveNode :: R2.Component SubTreeParamsIn
moveNode = R.createElement moveNodeCpt
moveNodeCpt :: R.Component SubTreeParamsIn
moveNodeCpt = here.component "moveNode" cpt
where
......
......@@ -32,7 +32,6 @@ type Props =
-- | Action : Search
actionSearch :: R2.Component Props
actionSearch = R.createElement actionSearchCpt
actionSearchCpt :: R.Component Props
actionSearchCpt = here.component "actionSearch" cpt
where
......
......@@ -4,7 +4,6 @@ import Data.Argonaut as Argonaut
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Prelude (($))
import Reactix as R
......@@ -15,7 +14,7 @@ import Gargantext.Components.Forest.Tree.Node.Action (Action)
import Gargantext.Components.Forest.Tree.Node.Action as Action
import Gargantext.Components.Forest.Tree.Node.Tools as Tools
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Prelude (class Eq, class Show, bind, pure)
import Gargantext.Prelude (class Eq, class Show, bind, pure, Unit)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Types (ID)
......@@ -34,9 +33,6 @@ shareReq session nodeId =
shareAction :: String -> Action
shareAction username = Action.ShareTeam username
------------------------------------------------------------------------
textInputBox :: Record Tools.TextInputBoxProps -> R.Element
textInputBox p = Tools.textInputBox p []
------------------------------------------------------------------------
data ShareNodeParams = ShareTeamParams { username :: String }
......@@ -57,11 +53,30 @@ instance encodeJsonShareNodeParams :: Argonaut.EncodeJson ShareNodeParams where
------------------------------------------------------------------------
shareNode :: Record SubTreeParamsIn -> R.Element
shareNode p = R.createElement shareNodeCpt p []
type ShareNode =
( id :: ID
, dispatch :: Action -> Aff Unit )
shareNodeCpt :: R.Component SubTreeParamsIn
shareNode :: R2.Component ShareNode
shareNode = R.createElement shareNodeCpt
shareNodeCpt :: R.Component ShareNode
shareNodeCpt = here.component "shareNode" cpt
where
cpt { dispatch, id } _ = do
isOpen <- T.useBox true
pure $ Tools.panel
[ Tools.textInputBox { boxAction: shareAction
, boxName: "Share"
, dispatch
, id
, isOpen
, text: "username" } []
] (H.div {} [])
------------------------------------------------------------------------
publishNode :: R2.Component SubTreeParamsIn
publishNode = R.createElement publishNodeCpt
publishNodeCpt :: R.Component SubTreeParamsIn
publishNodeCpt = here.component "publishNode" cpt
where
cpt p@{dispatch, subTreeParams, id, nodeType, session, handed} _ = do
action <- T.useBox (Action.SharePublic { params: Nothing })
......@@ -73,13 +88,13 @@ shareNodeCpt = here.component "shareNode" cpt
Nothing -> H.div {} []
_ -> H.div {} []
pure $ Tools.panel [ subTreeView { action
, dispatch
, handed
, id
, nodeType
, session
, subTreeParams
} []
] button
pure $ Tools.panel
[ subTreeView { action
, dispatch
, handed
, id
, nodeType
, session
, subTreeParams
} []
] button
module Gargantext.Components.Forest.Tree.Node.Action.Update where
import Data.Tuple.Nested ((/\))
import Gargantext.Components.Forest.Tree.Node.Action.Update.Types
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Update.Types
import Gargantext.Components.Forest.Tree.Node.Tools (formChoiceSafe, submitButton, panel)
import Gargantext.Types (NodeType(..), ID)
import Gargantext.Types as GT
import Gargantext.Sessions (Session, post)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Types (NodeType(..), ID)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Update"
updateRequest :: UpdateNodeParams -> Session -> ID -> Aff GT.AsyncTaskWithType
updateRequest updateNodeParams session nodeId = do
......@@ -25,49 +29,77 @@ updateRequest updateNodeParams session nodeId = do
p = GR.NodeAPI GT.Node (Just nodeId) "update"
----------------------------------------------------------------------
update :: NodeType
-> (Action -> Aff Unit)
-> R.Hooks R.Element
update NodeList dispatch = do
meth @( methodList /\ setMethod ) <- R.useState' Basic
let setMethod' = setMethod <<< const
pure $ panel [ -- H.text "Update with"
formChoiceSafe [Basic, Advanced, WithModel] Basic setMethod'
]
(submitButton (UpdateNode $ UpdateNodeParamsList {methodList}) dispatch)
update Graph dispatch = do
meth @( methodGraph /\ setMethod ) <- R.useState' Order1
let setMethod' = setMethod <<< const
pure $ panel [ -- H.text "Update with"
formChoiceSafe [Order1, Order2] Order1 setMethod'
]
(submitButton (UpdateNode $ UpdateNodeParamsGraph {methodGraph}) dispatch)
update Texts dispatch = do
meth @( methodTexts /\ setMethod ) <- R.useState' NewNgrams
let setMethod' = setMethod <<< const
pure $ panel [ -- H.text "Update with"
formChoiceSafe [NewNgrams, NewTexts, Both] NewNgrams setMethod'
]
(submitButton (UpdateNode $ UpdateNodeParamsTexts {methodTexts}) dispatch)
update Dashboard dispatch = do
meth @( methodBoard /\ setMethod ) <- R.useState' All
let setMethod' = setMethod <<< const
pure $ panel [ -- H.text "Update with"
formChoiceSafe [All, Sources, Authors, Institutes, Ngrams] All setMethod'
]
(submitButton (UpdateNode $ UpdateNodeParamsBoard {methodBoard}) dispatch)
update _ _ = pure $ H.div {} []
type UpdateProps =
( dispatch :: Action -> Aff Unit
, nodeType :: NodeType )
update :: R2.Component UpdateProps
update = R.createElement updateCpt
updateCpt :: R.Component UpdateProps
updateCpt = here.component "update" cpt where
cpt props@{ dispatch, nodeType: Dashboard } _ = pure $ updateDashboard props []
cpt props@{ dispatch, nodeType: Graph } _ = pure $ updateGraph props []
cpt props@{ dispatch, nodeType: NodeList } _ = pure $ updateNodeList props []
cpt props@{ dispatch, nodeType: Texts } _ = pure $ updateTexts props []
cpt props@{ dispatch, nodeType: _ } _ = pure $ updateOther props []
updateDashboard :: R2.Component UpdateProps
updateDashboard = R.createElement updateDashboardCpt
updateDashboardCpt :: R.Component UpdateProps
updateDashboardCpt = here.component "updateDashboard" cpt where
cpt { dispatch } _ = do
methodBoard <- T.useBox All
methodBoard' <- T.useLive T.unequal methodBoard
pure $ panel [ -- H.text "Update with"
formChoiceSafe [All, Sources, Authors, Institutes, Ngrams] All (\val -> T.write_ val methodBoard)
]
(submitButton (UpdateNode $ UpdateNodeParamsBoard { methodBoard: methodBoard' }) dispatch)
updateGraph :: R2.Component UpdateProps
updateGraph = R.createElement updateGraphCpt
updateGraphCpt :: R.Component UpdateProps
updateGraphCpt = here.component "updateGraph" cpt where
cpt { dispatch } _ = do
methodGraph <- T.useBox Order1
methodGraph' <- T.useLive T.unequal methodGraph
pure $ panel [ -- H.text "Update with"
formChoiceSafe [Order1, Order2] Order1 (\val -> T.write_ val methodGraph)
]
(submitButton (UpdateNode $ UpdateNodeParamsGraph { methodGraph: methodGraph' }) dispatch)
updateNodeList :: R2.Component UpdateProps
updateNodeList = R.createElement updateNodeListCpt
updateNodeListCpt :: R.Component UpdateProps
updateNodeListCpt = here.component "updateNodeList" cpt where
cpt { dispatch } _ = do
methodList <- T.useBox Basic
methodList' <- T.useLive T.unequal methodList
pure $ panel [ -- H.text "Update with"
formChoiceSafe [Basic, Advanced, WithModel] Basic (\val -> T.write_ val methodList)
]
(submitButton (UpdateNode $ UpdateNodeParamsList { methodList: methodList' }) dispatch)
updateTexts :: R2.Component UpdateProps
updateTexts = R.createElement updateTextsCpt
updateTextsCpt :: R.Component UpdateProps
updateTextsCpt = here.component "updateTexts" cpt where
cpt { dispatch } _ = do
methodTexts <- T.useBox NewNgrams
methodTexts' <- T.useLive T.unequal methodTexts
pure $ panel [ -- H.text "Update with"
formChoiceSafe [NewNgrams, NewTexts, Both] NewNgrams (\val -> T.write_ val methodTexts)
]
(submitButton (UpdateNode $ UpdateNodeParamsTexts { methodTexts: methodTexts' }) dispatch)
updateOther :: R2.Component UpdateProps
updateOther = R.createElement updateOtherCpt
updateOtherCpt :: R.Component UpdateProps
updateOtherCpt = here.component "updateOther" cpt where
cpt { dispatch } _ = do
pure $ H.div {} []
-- fragmentPT $ "Update " <> show nodeType
......@@ -40,20 +40,31 @@ here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Upload"
-- UploadFile Action
-- | Action : Upload
actionUpload :: NodeType -> ID -> Session -> (Action -> Aff Unit) -> R.Hooks R.Element
actionUpload NodeList id session dispatch =
pure $ uploadTermListView {dispatch, id, nodeType: GT.NodeList, session}
actionUpload Corpus id session dispatch =
pure $ uploadFileView {dispatch, id, nodeType: Corpus, session}
type ActionUpload =
( dispatch :: Action -> Aff Unit
, id :: ID
, nodeType :: NodeType
, session :: Session )
actionUpload :: R2.Component ActionUpload
actionUpload = R.createElement actionUploadCpt
actionUploadCpt :: R.Component ActionUpload
actionUploadCpt = here.component "actionUpload" cpt where
cpt { nodeType: Corpus, dispatch, id, session } _ = pure $ uploadFileView {dispatch, id, nodeType: GT.Corpus, session}
cpt { nodeType: NodeList, dispatch, id, session } _ = pure $ uploadTermListView {dispatch, id, nodeType: GT.NodeList, session}
cpt props@{ nodeType: _, dispatch, id, session } _ = pure $ actionUploadOther props []
{-
actionUpload Annuaire id session dispatch =
pure $ uploadFileView {dispatch, id, nodeType: Annuaire, session}
-}
actionUpload _ _ _ _ =
pure $ fragmentPT $ "Soon, upload for this NodeType."
actionUploadOther :: R2.Component ActionUpload
actionUploadOther = R.createElement actionUploadOtherCpt
actionUploadOtherCpt :: R.Component ActionUpload
actionUploadOtherCpt = here.component "actionUploadOther" cpt where
cpt _ _ = do
pure $ fragmentPT $ "Soon, upload for this NodeType."
-- file upload types
......
......@@ -169,13 +169,13 @@ panelAction p = R.createElement panelActionCpt p []
panelActionCpt :: R.Component PanelActionProps
panelActionCpt = here.component "panelAction" cpt
where
cpt {action: Documentation nodeType} _ = actionDoc nodeType
cpt {action: Download, id, nodeType, session} _ = actionDownload nodeType id session
cpt {action: Upload, dispatch, id, nodeType, session} _ = actionUpload nodeType id session dispatch
cpt {action: Delete, nodeType, dispatch} _ = actionDelete nodeType dispatch
cpt {action: Documentation nodeType} _ = pure $ actionDoc { nodeType } []
cpt {action: Download, id, nodeType, session} _ = pure $ actionDownload { id, nodeType, session } []
cpt {action: Upload, dispatch, id, nodeType, session} _ = pure $ actionUpload { dispatch, id, nodeType, session } []
cpt {action: Delete, nodeType, dispatch} _ = pure $ actionDelete { dispatch, nodeType } []
cpt {action: Add xs, dispatch, id, name, nodeType} _ =
pure $ addNodeView {dispatch, id, name, nodeType, nodeTypes: xs}
cpt {action: Refresh , dispatch, id, nodeType, session} _ = update nodeType dispatch
pure $ addNodeView {dispatch, id, name, nodeType, nodeTypes: xs} []
cpt {action: Refresh , dispatch, id, nodeType, session} _ = pure $ update { dispatch, nodeType } []
cpt {action: Config , dispatch, id, nodeType, session} _ =
pure $ fragmentPT $ "Config " <> show nodeType
-- Functions using SubTree
......@@ -185,21 +185,10 @@ panelActionCpt = here.component "panelAction" cpt
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
isOpen <- T.useBox true
pure $ panel
[ textInputBox
{ boxAction: Share.shareAction, boxName: "Share"
, dispatch, id, text: "username", isOpen } []
] (H.div {} [])
cpt {action : AddingContact, dispatch, id, name } _ = do
isOpen <- T.useBox true
pure $ Contact.textInputBox
{ id, dispatch, isOpen, boxName:"addContact"
, params : {firstname:"First Name", lastname: "Last Name"}
, boxAction: \p -> AddContact p }
cpt {action : Share, dispatch, id, name } _ = pure $ Share.shareNode { dispatch, id } []
cpt {action : AddingContact, dispatch, id, name } _ = pure $ Contact.actionAddContact { dispatch, id } []
cpt {action : Publish {subTreeParams}, dispatch, id, nodeType, session, handed} _ =
pure $ Share.shareNode {dispatch, id, nodeType, session, subTreeParams, handed}
pure $ Share.publishNode { dispatch, handed, id, nodeType, session, subTreeParams } []
cpt props@{action: SearchBox, id, session, dispatch, nodePopup} _ =
pure $ actionSearch { dispatch, id: (Just id), nodePopup, session } []
cpt _ _ = pure $ H.div {} []
......@@ -192,8 +192,8 @@ sidePanelCpt = here.component "sidePanel" cpt where
, sidePanelState
, sidePanelLists
, sidePanelTexts } } _ = do
sidePanelState' <- T.useLive T.unequal sidePanelState
session' <- T.useLive T.unequal session
sidePanelState' <- T.useLive T.unequal sidePanelState
case session' of
Nothing -> pure $ H.div {} []
......@@ -209,19 +209,18 @@ openedSidePanelCpt :: R.Component (WithSession Props)
openedSidePanelCpt = here.component "openedSidePanel" cpt where
cpt props@{ boxes: boxes@{ graphVersion
, reloadForest
, route
, sidePanelGraph
, sidePanelState
, sidePanelLists
, sidePanelTexts }
, session} _ = do
route' <- T.useLive T.unequal boxes.route
{ mGraph, mMetaData, removedNodeIds, selectedNodeIds, sideTab } <- GEST.focusedSidePanel sidePanelGraph
mGraph' <- T.useLive T.unequal mGraph
mGraphMetaData' <- T.useLive T.unequal mMetaData
route' <- T.useLive T.unequal route
let className = "side-panel"
let wrapper = H.div { className }
let wrapper = H.div { className: "side-panel" }
case route' of
GR.Lists s n -> do
......@@ -258,7 +257,7 @@ annuaire = R.createElement annuaireCpt
annuaireCpt :: R.Component SessionNodeProps
annuaireCpt = here.component "annuaire" cpt where
cpt props@{ boxes, nodeId, sessionId } _ = do
cpt props@{ boxes, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
annuaireLayout { frontends: defaultFrontends
......@@ -287,11 +286,13 @@ corpusDocument = R.createElement corpusDocumentCpt
corpusDocumentCpt :: R.Component CorpusDocumentProps
corpusDocumentCpt = here.component "corpusDocument" cpt
where
cpt props@{ boxes, corpusId: corpusId', listId, nodeId, sessionId } _ = do
cpt props@{ boxes, corpusId: corpusId', listId, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
documentMainLayout { mCorpusId: corpusId, listId: listId, nodeId, session } [] } sessionProps )[]
where corpusId = Just corpusId'
documentMainLayout { mCorpusId: Just corpusId'
, listId: listId
, nodeId
, session } [] } sessionProps )[]
dashboard :: R2.Component SessionNodeProps
dashboard = R.createElement dashboardCpt
......@@ -311,11 +312,13 @@ document = R.createElement documentCpt
documentCpt :: R.Component DocumentProps
documentCpt = here.component "document" cpt where
cpt props@{ boxes, listId, nodeId, sessionId } _ = do
cpt props@{ boxes, listId, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
documentMainLayout { listId, nodeId, mCorpusId, session } [] } sessionProps) []
where mCorpusId = Nothing
documentMainLayout { listId
, nodeId
, mCorpusId: Nothing
, session } [] } sessionProps) []
graphExplorer :: R2.Component SessionNodeProps
graphExplorer = R.createElement graphExplorerCpt
......@@ -370,8 +373,7 @@ listsCpt = here.component "lists" cpt where
, sidePanelState
, sidePanelLists
, tasks }
, nodeId
, sessionId } _ = do
, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
Lists.listsLayout { nodeId
......@@ -396,7 +398,7 @@ routeFile = R.createElement routeFileCpt
routeFileCpt :: R.Component SessionNodeProps
routeFileCpt = here.component "routeFile" cpt where
cpt props@{ boxes, nodeId, sessionId } _ = do
cpt props@{ boxes, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
fileLayout { nodeId, session } } sessionProps) []
......@@ -411,7 +413,7 @@ routeFrame = R.createElement routeFrameCpt
routeFrameCpt :: R.Component RouteFrameProps
routeFrameCpt = here.component "routeFrame" cpt where
cpt props@{ boxes, nodeId, nodeType, sessionId } _ = do
cpt props@{ boxes, nodeId, nodeType } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
frameLayout { nodeId, nodeType, session } } sessionProps) []
......@@ -421,7 +423,7 @@ team = R.createElement teamCpt
teamCpt :: R.Component SessionNodeProps
teamCpt = here.component "team" cpt where
cpt props@{ boxes, nodeId, sessionId } _ = do
cpt props@{ boxes, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
corpusLayout { nodeId, session } } sessionProps) []
......@@ -443,8 +445,7 @@ textsCpt = here.component "texts" cpt
, sidePanelState
, sidePanelTexts
, tasks }
, nodeId
, sessionId } _ = do
, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
Texts.textsLayout { frontends: defaultFrontends
......@@ -463,8 +464,7 @@ userCpt = here.component "user" cpt where
, sidePanelState
, sidePanelTexts
, tasks }
, nodeId
, sessionId } _ = do
, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
userLayout { frontends: defaultFrontends
......@@ -489,8 +489,7 @@ contactCpt = here.component "contact" cpt where
, sidePanelTexts
, sidePanelState
, tasks }
, nodeId
, sessionId } _ = do
, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
let forestedProps = RE.pick props :: Record Props
pure $ authed (Record.merge { content: \session ->
......
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