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
Pipeline #5481 failed with stage
    in 0 seconds
    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