Skip to content

P
purescript-gargantext
Verified Commit f3532d2b authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

[node] some more refactoring of node action views

parent 317f5942
Hide whitespace changes
Inline Side-by-side
Showing with 295 additions and 242 deletions
src/Gargantext/Components/FolderView.purs
View file @ f3532d2b
......@@ -330,7 +330,6 @@ performAction = performAction' where
performAction' (DoSearch task) p = doSearch task p
performAction' (UpdateNode params) p = updateNode params p
performAction' (RenameNode name) p = renameNode name p
performAction' (ShareTeam username) p = shareTeam username p
performAction' (SharePublic { params }) p = sharePublic params p
performAction' (AddContact params) p = addContact params p
performAction' (AddNode name nodeType) p = addNode' name nodeType p
......@@ -385,10 +384,6 @@ performAction = performAction' where
GAT.insert id task tasks
here.log2 "[performAction] UpdateNode task:" task
shareTeam username { boxes: { errors }, nodeId: id, session } = do
eTask <- Share.shareReq session id $ Share.ShareTeamParams { username }
handleRESTError here errors eTask $ \_task -> pure unit
sharePublic params p@{ boxes: { errors }, session } = traverse_ f params where
f (SubTreeOut { in: inId, out }) = do
eTask <- Share.shareReq session inId $ Share.SharePublicParams { node_id: out }
......
src/Gargantext/Components/Forest/Tree.purs
View file @ f3532d2b
......@@ -325,10 +325,6 @@ renameNode name p@{ boxes: { errors }, session, tree: (NTree (LNode {id}) _) } =
handleRESTError here errors eTask $ \_task -> pure unit
refreshTree p
shareTeam username { boxes: { errors }, session, tree: (NTree (LNode {id}) _) } = do
eTask <- Share.shareReq session id $ Share.ShareTeamParams { username }
handleRESTError here errors eTask $ \_task -> pure unit
sharePublic params p@{ boxes: { errors, forestOpen }, session } = traverse_ f params where
f (SubTreeOut { in: inId, out }) = do
eTask <- Share.shareReq session inId $ Share.SharePublicParams { node_id: out }
......@@ -398,7 +394,6 @@ performAction (DeleteNode nt) p = deleteNode' nt p
performAction (DoSearch task) p = doSearch task p
performAction (UpdateNode params) p = updateNode params p
performAction (RenameNode name) p = renameNode name p
performAction (ShareTeam username) p = shareTeam username p
performAction (SharePublic { params }) p = sharePublic params p
performAction (AddContact params) p = addContact params p
performAction (AddNode name nodeType) p = addNode' name nodeType p
......@@ -407,7 +402,6 @@ performAction (UploadFile nodeType fileType fileFormat lang mName contents selec
uploadFile' nodeType fileType fileFormat lang mName contents p selection
performAction (UploadArbitraryFile fileFormat mName blob selection) p =
uploadArbitraryFile' fileFormat mName blob p selection
performAction DownloadNode _ = liftEffect $ here.log "[performAction] DownloadNode"
performAction (MoveNode {params}) p = moveNode params p
performAction (MergeNode {params}) p = mergeNode params p
performAction (LinkNode { nodeType, params }) p = linkNode nodeType params p
......@@ -415,3 +409,5 @@ performAction RefreshTree p = refreshTree p
performAction CloseBox p = closeBox p
performAction (DocumentsFromWriteNodes params) p = documentsFromWriteNodes params p
performAction NoAction _ = liftEffect $ here.log "[performAction] NoAction"
performAction DownloadNode _ = liftEffect $ here.log "[performAction] DownloadNode"
performAction (ShareTeam _) _ = liftEffect $ here.log "[performAction] ShareTeam not used as action, see Node/Action/Share instead"
src/Gargantext/Components/Forest/Tree/Node/Action/Add.purs
View file @ f3532d2b
......@@ -104,24 +104,24 @@ addNodeViewCpt = here.component "addNodeView" cpt where
)
where
defaultNt = (fromMaybe Error $ head nodeTypes)
maybeEdit = [ if edit
then inputWithEnterWithKey {
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"
, key: show nodeType'
, required: false
}
else H.div {} []
]
maybeEdit = if edit then
[ inputWithEnterWithKey {
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"
, key: show nodeType'
, required: false
} ]
else []
pure $ Tools.panelWithSubmitButton { action: AddNode nodeName' nt'
, dispatch } (maybeChoose <> maybeEdit)
, dispatch
, mError: Nothing } (maybeChoose <> maybeEdit)
-- END Create Node
......
src/Gargantext/Components/Forest/Tree/Node/Action/Contact.purs
View file @ f3532d2b
......@@ -3,20 +3,21 @@ module Gargantext.Components.Forest.Tree.Node.Action.Contact where
import Prelude
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff, launchAff)
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.Types (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Contact.Types (AddContactParams(..))
import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools as Tools
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Config.REST (AffRESTError)
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"
......@@ -34,21 +35,19 @@ 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"} }
pure $
Tools.panelNoFooter { mError: Nothing }
[ textInputBox
{ boxAction: \p -> AddContact p
, dispatch
, id
, params: { firstname: "", lastname: "" } }
]
type TextInputBoxProps =
( boxAction :: AddContactParams -> Action
, boxName :: String
, dispatch :: Action -> Aff Unit
, id :: ID
, isOpen :: T.Box Boolean
, params :: Record AddContactProps )
type AddContactProps = ( firstname :: String, lastname :: String )
......@@ -57,38 +56,50 @@ textInputBox :: R2.Leaf TextInputBoxProps
textInputBox = R2.leaf textInputBoxCpt
textInputBoxCpt :: R.Component TextInputBoxProps
textInputBoxCpt = here.component "textInputBox" cpt where
cpt { boxName, boxAction, dispatch, isOpen
, params: { firstname, lastname } } _ =
content <$> T.useLive T.unequal isOpen
<*> T.useBox firstname <*> T.useBox lastname
cpt { boxAction, dispatch
, params: { firstname, lastname } } _ = do
firstName <- T.useBox firstname
lastName <- T.useBox lastname
let submitF unit = do
f <- T.read firstName
l <- T.read lastName
launchAff_ $
dispatch (boxAction $ AddContactParams { firstname: f, lastname: l })
pure $ H.div { className: "from-group" }
[ textInput "First name" firstName firstname submitF true
, textInput "Last name" lastName lastname submitF false
, R2.row [
submitBtn submitF
]
]
where
content false _ _ = H.div {} []
content true firstName lastName =
H.div { className: "from-group row" }
[ textInput firstName
, textInput lastName
, submitBtn firstName lastName
, cancelBtn
] where
textInput value =
H.div {className: "col-md-8"}
[ F.bindInput
{ value, className: "form-control", type: "text"
, placeholder: (boxName <> " Node") } ]
submitBtn first last =
H.a
{ className: "btn glyphitem fa fa-ok col-md-2 pull-left"
, type: "button", on: { click }, title:"Submit"
} [] where
click _ = do
f <- T.read first
l <- T.read last
T.write_ false isOpen
launchAff $
dispatch (boxAction $ AddContactParams { firstname: f, lastname: l })
cancelBtn =
H.a
{ className: "btn text-danger glyphitem fa fa-remove col-md-2 pull-left"
, on: { click }, title: "Cancel", type: "button"
} [] where
click _ = T.write_ false isOpen
textInput placeholder value defaultValue submitF autoFocus =
R2.row
[ R2.col 8
[ inputWithEnter { onBlur: \s -> T.write_ s value
, onEnter: submitF
, onValueChanged: \s -> T.write_ s value
, autoFocus
, className: "form-control"
, defaultValue
, placeholder
, type: "value"
, required: true }
]
-- [ F.bindInput
-- { value
-- , className: "form-control"
-- , type: "text"
-- , placeholder: boxName <> " Node" }
-- ]
]
submitBtn submitF =
H.a { className: "btn glyphitem fa fa-send col-md-2 pull-left"
, type: "button"
, on: { click: \_ -> submitF unit }
, title:"Submit"
} []
src/Gargantext/Components/Forest/Tree/Node/Action/Delete.purs
View file @ f3532d2b
......@@ -54,7 +54,7 @@ actionDeleteUserCpt :: R.Component Delete
actionDeleteUserCpt = here.component "actionDeleteUser" cpt where
cpt _ _ = do
pure $
Tools.panelNoFooter {}
Tools.panelNoFooter { mError: Nothing }
[ H.div { style: {margin: "10px"}}
[ H.text $ "Yes, we are RGPD compliant!"
<> " But you can not delete User Node yet."
......@@ -70,7 +70,8 @@ actionDeleteOtherCpt = here.component "actionDeleteOther" cpt where
cpt { dispatch, nodeType } _ = do
pure $
Tools.panelWithSubmitButton { action: DeleteNode nodeType
, dispatch }
, dispatch
, mError: Nothing }
(map (\t -> H.p {} [H.text t])
[ "Are your sure you want to delete it ?"
, "If yes, click again below."
......
src/Gargantext/Components/Forest/Tree/Node/Action/Documentation.purs
View file @ f3532d2b
module Gargantext.Components.Forest.Tree.Node.Action.Documentation where
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude (map, pure, show, ($), (<>))
import Data.Maybe (Maybe(..))
import Gargantext.Components.Forest.Tree.Node.Tools as Tools
import Gargantext.Prelude (map, pure, show, ($), (<>))
import Gargantext.Types (NodeType)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Documentation"
......@@ -23,9 +22,9 @@ actionDocCpt :: R.Component ActionDoc
actionDocCpt = here.component "actionDoc" cpt where
cpt { nodeType } _ = do
pure $
Tools.panelNoFooter {}
Tools.panelNoFooter { mError: Nothing }
([ infoTitle nodeType ]
<> (map (\info -> H.p {} [H.text info]) $ docOf nodeType))
<> (map (\info -> H.p {} [ H.text info ]) $ docOf nodeType))
where
infoTitle :: NodeType -> R.Element
infoTitle nt = H.div { style: {margin: "10px"}}
......
src/Gargantext/Components/Forest/Tree/Node/Action/Download.purs
View file @ f3532d2b
......@@ -5,7 +5,7 @@ import Data.Maybe (Maybe(..))
import Data.Show.Generic (genericShow)
import Data.String.Common (toLower)
import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(DownloadNode))
import Gargantext.Components.Forest.Tree.Node.Tools (fragmentPT, panel, submitButtonHref)
import Gargantext.Components.Forest.Tree.Node.Tools as Tools
import Gargantext.Ends (url)
import Gargantext.Prelude
import Gargantext.Routes as Routes
......@@ -41,10 +41,11 @@ 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]
-- footer
, submitButtonHref DownloadNode href ]
pure $
Tools.panelWithSubmitButtonHref { action: DownloadNode
, href
, mError: Nothing }
[ H.div {} [H.text info] ]
where
href = url session $ Routes.NodeAPI GT.Corpus (Just id) "export"
info = "Download as JSON"
......@@ -54,10 +55,11 @@ 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]
-- footer
, submitButtonHref DownloadNode href ]
pure $
Tools.panelWithSubmitButtonHref { action: DownloadNode
, href
, mError: Nothing }
[ H.div {} [H.text info] ]
where
href = url session $ Routes.NodeAPI GT.Graph (Just id) "gexf"
info = "Info about the Graph as GEXF format"
......@@ -83,16 +85,17 @@ actionDownloadNodeListCpt = here.component "actionDownloadNodeList" cpt where
downloadFormat <- T.useBox NL_JSON
downloadFormat' <- T.useLive T.unequal downloadFormat
pure $ panel {}
[ R2.select { className: "form-control"
, defaultValue: show downloadFormat'
, on: { change: onChange downloadFormat } }
[ opt NL_CSV downloadFormat
, opt NL_JSON downloadFormat ]
, H.div {} [ H.text $ info downloadFormat' ]
-- footer
, submitButtonHref DownloadNode $ href downloadFormat' ]
pure $
Tools.panelWithSubmitButtonHref { action: DownloadNode
, href: href downloadFormat'
, mError: Nothing }
[ R2.select { className: "form-control"
, defaultValue: show downloadFormat'
, on: { change: onChange downloadFormat } }
[ opt NL_CSV downloadFormat
, opt NL_JSON downloadFormat ]
, H.div {} [ H.text $ info downloadFormat' ]
]
where
opt t downloadFormat = H.option { value: show t } [ H.text $ show t ]
where
......@@ -127,16 +130,16 @@ actionDownloadNodeTextsCpt = here.component "actionDownloadNodeTexts" cpt where
downloadFormat <- T.useBox NT_JSON
downloadFormat' <- T.useLive T.unequal downloadFormat
pure $ panel {}
pure $ Tools.panelWithSubmitButtonHref { action: DownloadNode
, href: href downloadFormat'
, mError: Nothing }
[ R2.select { className: "form-control"
, defaultValue: show downloadFormat'
, on: { change: onChange downloadFormat } }
[ opt NT_CSV downloadFormat
, opt NT_JSON downloadFormat ]
, H.div {} [ H.text $ info downloadFormat' ]
-- footer
, submitButtonHref DownloadNode $ href downloadFormat' ]
]
where
opt t downloadFormat = H.option { value: show t } [ H.text $ show t ]
where
......@@ -160,4 +163,4 @@ actionDownloadOther = R.createElement actionDownloadOtherCpt
actionDownloadOtherCpt :: R.Component ActionDownload
actionDownloadOtherCpt = here.component "actionDownloadOther" cpt where
cpt _ _ = do
pure $ fragmentPT $ "Soon, you will be able to download your file here "
pure $ Tools.fragmentPT $ "Soon, you will be able to download your file here "
src/Gargantext/Components/Forest/Tree/Node/Action/Link.purs
View file @ f3532d2b
......@@ -69,15 +69,15 @@ linkNodeCpt' = here.component "__clone__" cpt
let
button = case action' of
LinkNode { params } -> case params of
Just (SubTreeOut { in: inId }) ->
Tools.submitButton { action: toParams nodeType inId
, dispatch }
Nothing -> mempty
LinkNode { params } ->
R2.fromMaybe params $
\(SubTreeOut { in: inId }) ->
Tools.submitButton { action: toParams nodeType inId
, dispatch }
_ -> mempty
pure $
Tools.panel {}
Tools.panel { mError: Nothing }
[ subTreeView { action
, boxes
, dispatch
......
src/Gargantext/Components/Forest/Tree/Node/Action/ManageTeam.purs
View file @ f3532d2b
......@@ -4,6 +4,7 @@ import Gargantext.Prelude
import Data.Array (filter, null, (:))
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Effect.Aff (runAff_)
import Effect.Class (liftEffect)
import Gargantext.Components.Forest.Tree.Node.Tools as Tools
......@@ -52,55 +53,53 @@ type TeamProps =
teamLayoutWrapper :: R2.Component TeamProps
teamLayoutWrapper = R.createElement teamLayoutWrapperCpt
teamLayoutWrapperCpt :: R.Component TeamProps
teamLayoutWrapperCpt = here.component "teamLayoutWrapper" cpt where
cpt {nodeId, session, team: {team_owner_username, team_members}} _ = do
teamS <- T.useBox team_members
team' <- T.useLive T.unequal teamS
error <- T.useBox ""
error' <- T.useLive T.unequal error
team_members <- T.useBox team_members
error <- T.useBox Nothing
pure $ teamLayoutRows {nodeId, session, team: teamS, team', error, error', team_owner_username}
pure $ teamLayoutRows {nodeId, session, team_members, error, team_owner_username}
type TeamRowProps =
( nodeId :: ID
, session :: Session
, team :: T.Box (Array TeamMember)
, error :: T.Box String
, team' :: Array TeamMember
, error' :: String
, team_members :: T.Box (Array TeamMember)
, error :: T.Box (Maybe String)
, team_owner_username :: String
)
teamLayoutRows :: R2.Leaf TeamRowProps
teamLayoutRows = R2.leaf teamLayoutRowsCpt
teamLayoutRowsCpt :: R.Component TeamRowProps
teamLayoutRowsCpt = here.component "teamLayoutRows" cpt where
cpt { team, nodeId, session, error, team', error', team_owner_username} _ = do
cpt { team_members, nodeId, session, error, team_owner_username } _ = do
team_members' <- T.useLive T.unequal team_members
error' <- T.useLive T.unequal error
pure $
if null team' then
if null team_members' then
H.div { style: {margin: "10px"}}
[ H.h4 {} [H.text "Your team is empty, you can send some invitations."]]
else
Tools.panel {}
((makeLeader team_owner_username : (map makeTeam team')) <> [ H.div {} [H.text error'] ])
Tools.panelNoFooter { mError: error' }
(makeLeader team_owner_username : (map makeTeam team_members'))
where
makeTeam :: TeamMember -> R.Element
makeTeam { username, shared_folder_id } = H.div {className: "from-group row"} [ H.div { className: "col-8" } [ H.text username ]
, H.a { className: "text-danger col-2 fa fa-times"
, title: "Remove user from team"
, type: "button"
, on: {click: submit shared_folder_id }
} []
]
makeLeader username = H.div {className: "from-group row"} [ H.div { className: "col-8"} [ H.text username ]
, H.p { className: "col-2"} [ H.text "owner"]
]
makeTeam { username, shared_folder_id } =
H.div {className: "from-group row"} [ H.div { className: "col-8" } [ H.text username ]
, H.a { className: "text-danger col-2 fa fa-times"
, title: "Remove user from team"
, type: "button"
, on: {click: submit shared_folder_id }
} []
]
makeLeader username =
H.div {className: "from-group row"} [ H.div { className: "col-8"} [ H.text username ]
, H.p { className: "col-2"} [ H.text "owner"]
]
submit sharedFolderId _ = do
runAff_ callback $ saveDeleteTeam { session, nodeId, sharedFolderId }
......@@ -108,14 +107,15 @@ teamLayoutRowsCpt = here.component "teamLayoutRows" cpt where
callback res =
case res of
Left _ -> do
_ <- liftEffect $ T.write "Only the Team owner can remove users" error
_ <- liftEffect $ T.write (Just "Only the Team owner can remove users") error
pure unit
Right val ->
case val of
Left _ -> do
pure unit
Right r -> do
T.write_ (filter (\tm -> tm.shared_folder_id /= r) team') team
T.modify_ (filter (\tm -> tm.shared_folder_id /= r)) team_members
T.write_ Nothing error
-------------------------------------------------------------
......
src/Gargantext/Components/Forest/Tree/Node/Action/Merge.purs
View file @ f3532d2b
......@@ -36,13 +36,13 @@ mergeNodeCpt = here.component "mergeNode" cpt
options <- T.useBox (Set.singleton GT.MapTerm)
let button = case action' of
MergeNode {params} -> case params of
Just val -> Tools.submitButton { action: MergeNode {params: Just val}
, dispatch }
Nothing -> H.div {} []
MergeNode { params } ->
R2.fromMaybe params $
\val -> Tools.submitButton { action: MergeNode {params: Just val }
, dispatch }
_ -> H.div {} []
pure $ Tools.panel {}
pure $ Tools.panel { mError: Nothing }
[ subTreeView { action
, boxes
, dispatch
......@@ -52,12 +52,12 @@ mergeNodeCpt = here.component "mergeNode" cpt
, subTreeParams
} []
, H.ul { className:"merge mx-auto list-group"}
([ H.li { className: "list-group-item" }
[ H.h5 { className: "mb-1" } [ H.text "Merge which list?" ]
, Tools.checkboxesListGroup { groups: [ GT.MapTerm, GT.CandidateTerm, GT.StopTerm ]
, options } []
]
])
[ H.li { className: "list-group-item" }
[ H.h5 { className: "mb-1" } [ H.text "Merge which list?" ]
, Tools.checkboxesListGroup { groups: [ GT.MapTerm, GT.CandidateTerm, GT.StopTerm ]
, options } []
]
]
, H.ul { className:"merge mx-auto list-group"}
[ H.li { className: "list-group-item" }
[ H.h5 { className: "mb-1" } [ H.text "Title" ]
......
src/Gargantext/Components/Forest/Tree/Node/Action/Move.purs
View file @ f3532d2b
......@@ -59,15 +59,15 @@ moveNodeCpt' = here.component "__clone__" cpt where
action' <- T.useLive T.unequal action
let button = case action' of
MoveNode { params } -> case params of
Just val -> Tools.submitButton { action: MoveNode {params: Just val}
, dispatch }
Nothing -> H.div {} []
MoveNode { params } ->
R2.fromMaybe params $
\val -> Tools.submitButton { action: MoveNode {params: Just val}
, dispatch }
_ -> H.div {} []
pure $
Tools.panel {}
Tools.panel { mError: Nothing }
[ subTreeView { action
, boxes
, dispatch
......
src/Gargantext/Components/Forest/Tree/Node/Action/Share.purs
View file @ f3532d2b
......@@ -43,9 +43,6 @@ getCompletionsReq :: { session :: Session } -> AffRESTError (Array String)
getCompletionsReq { session } =
get session GR.Members
shareAction :: String -> Action
shareAction username = Action.ShareTeam (trim username)
------------------------------------------------------------------------
data ShareNodeParams = ShareTeamParams { username :: String }
......@@ -63,7 +60,6 @@ instance Show ShareNodeParams where show = genericShow
------------------------------------------------------------------------
type ShareNode =
( id :: ID
, dispatch :: Action -> Aff Unit
, session :: Session )
shareNode :: R2.Component ShareNode
......@@ -71,7 +67,7 @@ shareNode = R.createElement shareNodeCpt
shareNodeCpt :: R.Component ShareNode
shareNodeCpt = here.component "shareNode" cpt
where
cpt { dispatch, id, session } _ = do
cpt { id, session } _ = do
useLoader {
loader: getCompletionsReq
, path: { session }
......@@ -83,8 +79,7 @@ shareNodeCpt = here.component "shareNode" cpt
type ShareNodeInner =
( completions :: Array String
, id :: ID
, session :: Session
| ShareNode
)
shareNodeInner :: R2.Component ShareNodeInner
......@@ -95,18 +90,19 @@ shareNodeInnerCpt = here.component "shareNodeInner" cpt
cpt { completions, id, session } _ = do
state' /\ state <- R2.useBox' ""
text' /\ text <- R2.useBox' ""
mError' /\ mError <- R2.useBox' Nothing
pure $ Tools.panel {}
pure $ Tools.panel { mError: mError' }
[ inputWithAutocomplete { autoFocus: true
, autocompleteSearch
, classes: "share-users-completions d-flex align-items-center"
, onAutocompleteClick
, onEnterPress: onEnterPress text
, placeholder: "username or email"
, onEnterPress: onEnterPress text mError
, pattern: "^\\S+$" -- pattern doesn't allow space characters
, title
, state }
[ B.iconButton { callback: \_ -> onEnterPress text state'
, placeholder: "username or email"
, state
, title }
[ B.iconButton { callback: \_ -> onEnterPress text mError state'
, elevation: Level1
, name: "send"
, title: "Submit" } ]
......@@ -116,13 +112,16 @@ shareNodeInnerCpt = here.component "shareNodeInner" cpt
where
autocompleteSearch input = pure $ nub $ filter (contains (Pattern input)) completions
onAutocompleteClick _ = pure unit
onEnterPress text val = do
-- launchAff_ $ dispatch (shareAction val)
onEnterPress text mError val = do
T.write_ Nothing mError
launchAff_ do
eRes <- shareReq session id $ ShareTeamParams { username: val }
liftEffect $ case eRes of
Left err -> T.write_ (show err) text
Right _ -> T.write_ ("Invited " <> val <> " to the team") text
Left err -> do
T.write_ (Just $ show err) mError
Right _ -> do
T.write_ ("Invited " <> val <> " to the team") text
T.write_ Nothing mError
title = "Enter a username or an email address (space characters are not allowed)"
------------------------------------------------------------------------
publishNode :: R2.Component SubTreeParamsIn
......@@ -135,13 +134,13 @@ publishNodeCpt = here.component "publishNode" cpt
action' <- T.useLive T.unequal action
let button = case action' of
Action.SharePublic { params } -> case params of
Just val -> Tools.submitButton { action: Action.SharePublic {params: Just val}
, dispatch }
Nothing -> H.div {} []
Action.SharePublic { params } ->
R2.fromMaybe params $
\val -> Tools.submitButton { action: Action.SharePublic {params: Just val}
, dispatch }
_ -> H.div {} []
pure $ Tools.panel {}
pure $ Tools.panel { mError: Nothing }
[ subTreeView { action
, boxes
, dispatch
......
src/Gargantext/Components/Forest/Tree/Node/Action/Update.purs
View file @ f3532d2b
......@@ -64,7 +64,8 @@ updateDashboardCpt = here.component "updateDashboard" cpt where
pure $
Tools.panelWithSubmitButton { action: UpdateNode $ UpdateNodeParamsBoard { methodBoard: methodBoard' }
, dispatch }
, dispatch
, mError: Nothing }
[ -- H.text "Update with"
Tools.formChoiceSafe { items: [All, Sources, Authors, Institutes, Ngrams]
, default: methodBoard'
......@@ -108,7 +109,9 @@ updateGraphCpt = here.component "updateGraph" cpt where
}
pure $
Tools.panelWithSubmitButton { action, dispatch: callback }
Tools.panelWithSubmitButton { action
, dispatch: callback
, mError: Nothing }
[ H.text "Show subjects with Order1 or concepts with Order2 ?"
, Tools.formChoiceSafe { items: [Order1, Order2_A, Order2_B]
, default: methodGraphMetric'
......@@ -218,7 +221,8 @@ updateNodeListCpt = here.component "updateNodeList" cpt where
pure $
Tools.panelWithSubmitButton { action: UpdateNode $ UpdateNodeParamsList { methodList: methodList' }
, dispatch }
, dispatch
, mError: Nothing }
[ -- H.text "Update with"
Tools.formChoiceSafe { items: [Basic, Advanced, WithModel]
, default: methodList'
......@@ -236,7 +240,8 @@ updateTextsCpt = here.component "updateTexts" cpt where
pure $
Tools.panelWithSubmitButton { action: UpdateNode $ UpdateNodeParamsTexts { methodTexts: Both }
, dispatch }
, dispatch
, mError: Nothing }
[] -- H.text "Update with"
-- formChoiceSafe { items: [NewNgrams, NewTexts, Both]
-- , default: methodTexts'
......
src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs
View file @ f3532d2b
......@@ -23,7 +23,7 @@ import Gargantext.Components.Forest.Tree.Node.Action (Props)
import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileFormat(..), FileType(..), UploadFileBlob(..), readUFBAsBase64, readUFBAsText)
import Gargantext.Components.Forest.Tree.Node.Action.Utils (loadLanguages)
import Gargantext.Components.Forest.Tree.Node.Tools (fragmentPT, formChoiceSafe, panel)
import Gargantext.Components.Forest.Tree.Node.Tools as Tools
import Gargantext.Components.Lang (Lang(..), langReader)
import Gargantext.Components.ListSelection as ListSelection
import Gargantext.Components.ListSelection.Types (Selection(..))
......@@ -83,7 +83,7 @@ actionUploadOther = R.createElement actionUploadOtherCpt
actionUploadOtherCpt :: R.Component ActionUpload
actionUploadOtherCpt = here.component "actionUploadOther" cpt where
cpt _ _ = do
pure $ fragmentPT $ "Soon, upload for this NodeType."
pure $ Tools.fragmentPT $ "Soon, upload for this NodeType."
-- file upload types
......@@ -153,30 +153,30 @@ uploadFileViewWithLangsCpt = here.component "uploadFileViewWithLangs" cpt
]
, R2.row
[ H.div {className:"col-6 flex-space-around"}
[ formChoiceSafe { items: [ CSV
, CSV_HAL
, Istex
, WOS
, JSON
-- , Iramuteq
]
[ Tools.formChoiceSafe { items: [ CSV
, CSV_HAL
, Istex
, WOS
, JSON
-- , Iramuteq
]
, default: CSV
, callback: setFileType'
, print: show } []
, formChoiceSafe { items: [ Plain
, ZIP ]
, default: Plain
, callback: setFileFormat'
, print: show } []
, Tools.formChoiceSafe { items: [ Plain
, ZIP ]
, default: Plain
, callback: setFileFormat'
, print: show } []
]
]
, R2.row
[ H.div {className:"col-6 flex-space-around"}
[ formChoiceSafe { items: langs <> [No_extraction]
, default: EN
, callback: setLang'
, print: show
} []
[ Tools.formChoiceSafe { items: langs <> [No_extraction]
, default: EN
, callback: setLang'
, print: show
} []
]
]
, R2.row
......@@ -194,7 +194,7 @@ uploadFileViewWithLangsCpt = here.component "uploadFileViewWithLangs" cpt
, selection
} []
]
pure $ panel {} (bodies <> [ footer ])
pure $ Tools.panel { mError: Nothing } (bodies <> [ footer ])
onChangeContents :: forall e. T.Box (Maybe UploadFile) -> E.SyntheticEvent_ e -> Effect Unit
......@@ -318,7 +318,7 @@ uploadListViewCpt = here.component "uploadListView" cpt where
-- Render
pure $
panel {}
Tools.panel { mError: Nothing }
-- Body
[
-- Upload
......@@ -663,7 +663,7 @@ uploadTermListViewCpt = here.component "uploadTermListView" cpt
}
]
pure $ panel {}
pure $ Tools.panel { mError: Nothing }
[ H.form {}
[ R2.row [ R2.col 12 [ input ] ]
, R2.row [ R2.col 12 [ uploadTypeHtml ] ]
......@@ -815,7 +815,7 @@ uploadFrameCalcViewWithLangsCpt = here.component "uploadFrameCalcViewWithLangs"
[ H.text "Upload!" ]
]
pure $ panel {} (bodies <> [ footer ])
pure $ Tools.panel { mError: Nothing } (bodies <> [ footer ])
where
onClick lang' selection' _ = do
......
src/Gargantext/Components/Forest/Tree/Node/Action/WriteNodesDocuments.purs
View file @ f3532d2b
......@@ -76,7 +76,8 @@ actionWriteNodesDocumentsWithLangsCpt = here.component "actionWriteNodesDocument
, lang: lang'
, selection: selection'
, paragraphs: paragraphs' }
, dispatch }
, dispatch
, mError: Nothing }
[
H.div
{ className: "col-12 flex-space-around" }
......
src/Gargantext/Components/Forest/Tree/Node/Box.purs
View file @ f3532d2b
......@@ -351,7 +351,7 @@ panelActionCpt = here.component "panelAction" cpt
pure $ moveNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
cpt { action: Link {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
pure $ linkNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
cpt { action : Share, dispatch, id, session } _ = pure $ Share.shareNode { dispatch, id, session } []
cpt { action : Share, id, session } _ = pure $ Share.shareNode { id, session } []
cpt { action : AddingContact, dispatch, id } _ = pure $ Contact.actionAddContact { dispatch, id } []
cpt { action : Publish {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
pure $ Share.publishNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
......
src/Gargantext/Components/Forest/Tree/Node/Tools.purs
View file @ f3532d2b
......@@ -31,28 +31,45 @@ fragmentPT :: String -> R.Element
fragmentPT text = H.div { style: { margin: "10px" }} [ H.text text ]
type PanelProps = ()
type PanelProps =
( mError :: Maybe String )
-- | Last element of panel's children goes to footer, all others go to body
panel :: R2.Component PanelProps
panel = R.createElement panelCpt
panelCpt :: R.Component PanelProps
panelCpt = here.component "panel" cpt where
cpt {} children =
cpt { mError } children = do
let errorCpt =
R2.fromMaybe mError $
\err ->
R2.row
[ R2.col 12
[ H.div { className: "alert alert-danger" } [ H.text err ]
]
]
pure $ R.fragment
[ H.div { className: "card-body" }
[ H.div { className: "row" }
-- TODO add type for text or form here [ H.form {className: "form-horizontal"} bodies ]
[ H.div { className: "col-12" } bodies ]]
[ H.div { className: "card-text" }
[ R2.row
-- TODO add type for text or form here [ H.form {className: "form-horizontal"} bodies ]
[ R2.col 12 bodies ]
, errorCpt
]
]
, H.div {className: "card-footer"}
[ H.div { className: "row" }
[ H.div { className: "mx-auto"} [ footer ] ]]]
[ R2.row
[ H.div { className: "mx-auto"} [ footer ] ]
]
]
where
bodies /\ footer =
case A.unsnoc children of
Nothing -> [] /\ (H.div {} [])
Just { init, last } -> init /\ last
-- | A panel without a footer
panelNoFooter :: R2.Component PanelProps
panelNoFooter = R.createElement panelNoFooterCpt
panelNoFooterCpt :: R.Component PanelProps
......@@ -66,6 +83,7 @@ type PanelWithSubmitButtonProps =
, dispatch :: Action -> Aff Unit
| PanelProps )
-- | A panel with 'submitButton { action, dispatch }'
panelWithSubmitButton :: R2.Component PanelWithSubmitButtonProps
panelWithSubmitButton = R.createElement panelWithSubmitButtonCpt
panelWithSubmitButtonCpt :: R.Component PanelWithSubmitButtonProps
......@@ -76,6 +94,22 @@ panelWithSubmitButtonCpt = here.component "panelWithSubmitButton" cpt where
-- footer
<> [ submitButton { action, dispatch } ])
type PanelWithSubmitButtonHrefProps =
( action :: Action
, href :: String
| PanelProps )
-- | A panel with 'submitButtonHref { action, href }'
panelWithSubmitButtonHref :: R2.Component PanelWithSubmitButtonHrefProps
panelWithSubmitButtonHref = R.createElement panelWithSubmitButtonHrefCpt
panelWithSubmitButtonHrefCpt :: R.Component PanelWithSubmitButtonHrefProps
panelWithSubmitButtonHrefCpt = here.component "panelWithSubmitButtonHref" cpt where
cpt props@{ action, href } children = do
let pProps = (RX.pick props :: Record PanelProps)
pure $ panel pProps (children
-- footer
<> [ submitButtonHref { action, href } ])
type TextInputBoxProps =
( id :: GT.ID
......@@ -198,15 +232,15 @@ inviteInputBoxCpt = here.component "textInputBox" cpt where
T.write_ ("Invited " <> R.readRef ref <> " to the team") username
launchAff_ $ dispatch (boxAction $ R.readRef ref)
type DefaultText = String
-- type DefaultText = String
formEdit :: forall prev next
. DefaultText -> ((prev -> String) -> Effect next) -> R.Element
formEdit defaultValue setter =
H.div { className: "form-group" }
[ H.input { defaultValue, type: "text", on: { input }
, placeholder: defaultValue, className: "form-control" }
] where input = setter <<< const <<< R.unsafeEventValue
-- formEdit :: forall prev next
-- . DefaultText -> ((prev -> String) -> Effect next) -> R.Element
-- formEdit defaultValue setter =
-- H.div { className: "form-group" }
-- [ H.input { defaultValue, type: "text", on: { input }
-- , placeholder: defaultValue, className: "form-control" }
-- ] where input = setter <<< const <<< R.unsafeEventValue
type FormChoiceSafeProps item m =
( items :: Array item
......@@ -305,14 +339,23 @@ submitButtonCpt = here.component "submitButton" cpt where
}
[ H.span {className: "font-family-theme mx-1"} [ H.text $ " " <> text action] ]
type Href = String
submitButtonHref :: Action -> Href -> R.Element
submitButtonHref action href =
H.a { className, href, target: "_blank" }
[ H.span {className: "font-family-theme mx-1"} [ H.text $ " " <> text action ] ]
where
className = "btn btn-primary fa fa-" <> icon action
type SubmitButtonHrefProps =
( action :: Action
, href :: Href )
submitButtonHref :: R2.Leaf SubmitButtonHrefProps
submitButtonHref = R2.leaf submitButtonHrefCpt
submitButtonHrefCpt :: R.Component SubmitButtonHrefProps
submitButtonHrefCpt = here.component "submitButtonHref" cpt where
cpt { action, href } _ = do
pure $
H.a { className, href, target: "_blank" }
[ H.span {className: "font-family-theme mx-1"} [ H.text $ " " <> text action ] ]
where
className = "btn btn-primary fa fa-" <> icon action
------------------------------------------------------------------------
-- | CheckBox tools
......
src/Gargantext/Components/TreeSearch.purs
View file @ f3532d2b
......@@ -78,15 +78,15 @@ treeSearchCpt = here.component "treeSearch" cpt where
{ className: "input-group p-1" }
[
inputWithEnter { className: "form-control"
, autoFocus: true
, onEnter: submit inputRef query
, onValueChanged: R.setRef inputRef
, onBlur: R.setRef inputRef
, type: "value"
, defaultValue: ""
, required: true
, placeholder: "Search keys..."
}
, autoFocus: true
, onEnter: submit inputRef query
, onValueChanged: R.setRef inputRef
, onBlur: R.setRef inputRef
, type: "value"
, defaultValue: ""
, required: true
, placeholder: "Search keys..."
}
,
H.div { className: "input-group-append"}
[
......
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