Skip to content

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

[errors] refactoring for new kind of errors 

Also, refactoring of Node/Action/Tools to use proper components.
parent 0f377b27
Pipeline #5471 failed with stage
    in 0 seconds
    Hide whitespace changes
    Inline Side-by-side
    Showing with 432 additions and 252 deletions
    src/Gargantext/Components/Forest/Tree/Node/Action/Add.purs
    View file @ 317f5942
    ......@@ -13,7 +13,7 @@ import Effect (Effect)
    import Effect.Aff (Aff, launchAff_)
    import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
    import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
    import Gargantext.Components.Forest.Tree.Node.Tools (formChoice, panel, submitButton)
    import Gargantext.Components.Forest.Tree.Node.Tools as Tools
    import Gargantext.Components.InputWithEnter (inputWithEnterWithKey)
    import Gargantext.Components.Lang (Lang(..), translate)
    import Gargantext.Config.REST (RESTError, AffRESTError)
    ......@@ -92,10 +92,10 @@ addNodeViewCpt = here.component "addNodeView" cpt where
    T.write_ (GT.prettyNodeType nt) nodeName
    T.write_ nt nodeType
    (maybeChoose /\ nt') = if length nodeTypes > 1
    then ([ formChoice { items: nodeTypes
    , default: nodeType'
    , callback: setNodeType'
    , print: print hasChromeAgent' } [] ] /\ nodeType')
    then ([ Tools.formChoice { items: nodeTypes
    , default: nodeType'
    , callback: setNodeType'
    , print: print hasChromeAgent' } [] ] /\ nodeType')
    else ([H.div {} [H.text $ "Creating a node of type "
    <> show defaultNt
    <> " with name:"
    ......@@ -120,7 +120,8 @@ addNodeViewCpt = here.component "addNodeView" cpt where
    else H.div {} []
    ]
    pure $ panel (maybeChoose <> maybeEdit) (submitButton (AddNode nodeName' nt') dispatch)
    pure $ Tools.panelWithSubmitButton { action: AddNode nodeName' nt'
    , dispatch } (maybeChoose <> maybeEdit)
    -- END Create Node
    ......
    src/Gargantext/Components/Forest/Tree/Node/Action/Delete.purs
    View file @ 317f5942
    ......@@ -6,7 +6,7 @@ import Gargantext.Prelude
    import Data.Maybe (Maybe(..))
    import Effect.Aff (Aff)
    import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
    import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
    import Gargantext.Components.Forest.Tree.Node.Tools as Tools
    import Gargantext.Config.REST (AffRESTError)
    import Gargantext.Routes (SessionRoute(..))
    import Gargantext.Sessions (Session, delete, put_)
    ......@@ -53,21 +53,25 @@ 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 {} [])
    pure $
    Tools.panelNoFooter {}
    [ 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."
    ]
    ]
    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."
    ]
    ) (submitButton (DeleteNode nodeType) dispatch)
    pure $
    Tools.panelWithSubmitButton { action: DeleteNode nodeType
    , dispatch }
    (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 @ 317f5942
    ......@@ -5,7 +5,7 @@ import Reactix.DOM.HTML as H
    import Gargantext.Prelude (map, pure, show, ($), (<>))
    import Gargantext.Components.Forest.Tree.Node.Tools (panel)
    import Gargantext.Components.Forest.Tree.Node.Tools as Tools
    import Gargantext.Types (NodeType)
    import Gargantext.Types as GT
    import Gargantext.Utils.Reactix as R2
    ......@@ -22,10 +22,10 @@ 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 {} [])
    pure $
    Tools.panelNoFooter {}
    ([ infoTitle 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 @ 317f5942
    ......@@ -41,8 +41,10 @@ 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)
    pure $ panel {} [ H.div {} [H.text info]
    -- footer
    , submitButtonHref DownloadNode href ]
    where
    href = url session $ Routes.NodeAPI GT.Corpus (Just id) "export"
    info = "Download as JSON"
    ......@@ -52,8 +54,10 @@ 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)
    pure $ panel {} [ H.div {} [H.text info]
    -- footer
    , submitButtonHref DownloadNode href ]
    where
    href = url session $ Routes.NodeAPI GT.Graph (Just id) "gexf"
    info = "Info about the Graph as GEXF format"
    ......@@ -79,15 +83,16 @@ actionDownloadNodeListCpt = here.component "actionDownloadNodeList" cpt where
    downloadFormat <- T.useBox NL_JSON
    downloadFormat' <- T.useLive T.unequal downloadFormat
    pure $ panel
    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' ]
    ]
    (submitButtonHref DownloadNode $ href downloadFormat')
    -- footer
    , submitButtonHref DownloadNode $ href downloadFormat' ]
    where
    opt t downloadFormat = H.option { value: show t } [ H.text $ show t ]
    where
    ......@@ -122,15 +127,16 @@ actionDownloadNodeTextsCpt = here.component "actionDownloadNodeTexts" cpt where
    downloadFormat <- T.useBox NT_JSON
    downloadFormat' <- T.useLive T.unequal downloadFormat
    pure $ panel
    pure $ panel {}
    [ 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' ]
    ]
    (submitButtonHref DownloadNode $ href downloadFormat')
    -- footer
    , submitButtonHref DownloadNode $ href downloadFormat' ]
    where
    opt t downloadFormat = H.option { value: show t } [ H.text $ show t ]
    where
    ......
    src/Gargantext/Components/Forest/Tree/Node/Action/Link.purs
    View file @ 317f5942
    ......@@ -6,7 +6,7 @@ import Data.Either (Either)
    import Data.Maybe (Maybe(..))
    import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
    import Gargantext.Components.Forest.Tree.Node.Action.Update.Types (LinkNodeReq(..), UpdateNodeParams(..))
    import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
    import Gargantext.Components.Forest.Tree.Node.Tools as Tools
    import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
    import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
    import Gargantext.Config.REST (AffRESTError, RESTError)
    ......@@ -70,22 +70,25 @@ linkNodeCpt' = here.component "__clone__" cpt
    button = case action' of
    LinkNode { params } -> case params of
    Just (SubTreeOut { in: inId }) -> submitButton
    (toParams nodeType inId)
    dispatch
    Just (SubTreeOut { in: inId }) ->
    Tools.submitButton { action: toParams nodeType inId
    , dispatch }
    Nothing -> mempty
    _ -> mempty
    pure $ panel [
    subTreeView { action
    , boxes
    , dispatch
    , id
    , nodeType
    , session
    , subTreeParams
    } []
    ] button
    pure $
    Tools.panel {}
    [ subTreeView { action
    , boxes
    , dispatch
    , id
    , nodeType
    , session
    , subTreeParams
    } []
    -- footer
    , button ]
    toParams :: GT.NodeType -> GT.ID -> Action
    toParams nodeType id
    ......
    src/Gargantext/Components/Forest/Tree/Node/Action/ManageTeam.purs
    View file @ 317f5942
    ......@@ -80,10 +80,13 @@ teamLayoutRowsCpt :: R.Component TeamRowProps
    teamLayoutRowsCpt = here.component "teamLayoutRows" cpt where
    cpt { team, nodeId, session, error, team', error', team_owner_username} _ = do
    case null team' of
    true -> pure $ H.div { style: {margin: "10px"}}
    [ H.h4 {} [H.text "Your team is empty, you can send some invitations."]]
    false -> pure $ Tools.panel (makeLeader team_owner_username : (map makeTeam team')) (H.div {} [H.text error'])
    pure $
    if null team' 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'] ])
    where
    makeTeam :: TeamMember -> R.Element
    ......
    src/Gargantext/Components/Forest/Tree/Node/Action/Merge.purs
    View file @ 317f5942
    ......@@ -5,7 +5,7 @@ import Gargantext.Prelude
    import Data.Maybe (Maybe(..))
    import Data.Set as Set
    import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
    import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel, checkbox, checkboxesListGroup)
    import Gargantext.Components.Forest.Tree.Node.Tools as Tools
    import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
    import Gargantext.Config.REST (AffRESTError)
    import Gargantext.Routes (SessionRoute(..))
    ......@@ -37,11 +37,12 @@ mergeNodeCpt = here.component "mergeNode" cpt
    let button = case action' of
    MergeNode {params} -> case params of
    Just val -> submitButton (MergeNode {params: Just val}) dispatch
    Just val -> Tools.submitButton { action: MergeNode {params: Just val}
    , dispatch }
    Nothing -> H.div {} []
    _ -> H.div {} []
    pure $ panel
    pure $ Tools.panel {}
    [ subTreeView { action
    , boxes
    , dispatch
    ......@@ -50,23 +51,24 @@ mergeNodeCpt = here.component "mergeNode" cpt
    , session
    , 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?" ]
    , 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" ]
    ]
    , H.li { className: "list-group-item" }
    [ H.div { className: " form-check" }
    [ checkbox { value: merge }
    , H.label { className: "form-check-label" } [ H.text "Merge data?" ]
    ]
    ]
    ]
    ]
    button
    , 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.ul { className:"merge mx-auto list-group"}
    [ H.li { className: "list-group-item" }
    [ H.h5 { className: "mb-1" } [ H.text "Title" ]
    ]
    , H.li { className: "list-group-item" }
    [ H.div { className: " form-check" }
    [ Tools.checkbox { value: merge }
    , H.label { className: "form-check-label" } [ H.text "Merge data?" ]
    ]
    ]
    ]
    -- footer
    , button ]
    src/Gargantext/Components/Forest/Tree/Node/Action/Move.purs
    View file @ 317f5942
    ......@@ -7,7 +7,7 @@ import Gargantext.Prelude
    import Data.Maybe (Maybe(..))
    import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
    import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
    import Gargantext.Components.Forest.Tree.Node.Tools as Tools
    import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (SubTreeParamsIn, subTreeView)
    import Gargantext.Config.REST (AffRESTError)
    import Gargantext.Routes (SessionRoute(..))
    ......@@ -59,15 +59,16 @@ moveNodeCpt' = here.component "__clone__" cpt where
    action' <- T.useLive T.unequal action
    let button = case action' of
    MoveNode { params } -> case params of
    Just val -> submitButton (MoveNode {params: Just val}) dispatch
    Nothing -> H.div {} []
    _ -> H.div {} []
    MoveNode { params } -> case params of
    Just val -> Tools.submitButton { action: MoveNode {params: Just val}
    , dispatch }
    Nothing -> H.div {} []
    _ -> H.div {} []
    pure $
    panel
    [ subTreeView { action
    Tools.panel {}
    [ subTreeView { action
    , boxes
    , dispatch
    , id
    ......@@ -75,4 +76,6 @@ moveNodeCpt' = here.component "__clone__" cpt where
    , session
    , subTreeParams
    } []
    ] button
    -- footer
    , button ]
    src/Gargantext/Components/Forest/Tree/Node/Action/Share.purs
    View file @ 317f5942
    ......@@ -4,11 +4,13 @@ import Gargantext.Prelude
    import Data.Array (filter, nub)
    import Data.Generic.Rep (class Generic)
    import Data.Either (Either(..))
    import Data.Maybe (Maybe(..))
    import Data.Show.Generic (genericShow)
    import Data.String (Pattern(..), contains, trim)
    import Data.Tuple.Nested ((/\))
    import Effect.Aff (Aff, launchAff_)
    import Effect.Class (liftEffect)
    import Gargantext.Components.Bootstrap as B
    import Gargantext.Components.Bootstrap.Types (Elevation(Level1))
    import Gargantext.Components.Forest.Tree.Node.Action.Types (Action)
    ......@@ -62,26 +64,27 @@ instance Show ShareNodeParams where show = genericShow
    type ShareNode =
    ( id :: ID
    , dispatch :: Action -> Aff Unit
    , session :: Session)
    , session :: Session )
    shareNode :: R2.Component ShareNode
    shareNode = R.createElement shareNodeCpt
    shareNodeCpt :: R.Component ShareNode
    shareNodeCpt = here.component "shareNode" cpt
    where
    cpt {session, dispatch} _ = do
    cpt { dispatch, id, session } _ = do
    useLoader {
    loader: getCompletionsReq
    , path: { session }
    , render: \completions -> shareNodeInner { completions, dispatch } []
    , render: \completions -> shareNodeInner { completions, id, session } []
    , errorHandler
    }
    where
    errorHandler = logRESTError here "[shareNode]"
    type ShareNodeInner =
    ( dispatch :: Action -> Aff Unit
    , completions :: Array String
    ( completions :: Array String
    , id :: ID
    , session :: Session
    )
    shareNodeInner :: R2.Component ShareNodeInner
    ......@@ -89,11 +92,11 @@ shareNodeInner = R.createElement shareNodeInnerCpt
    shareNodeInnerCpt :: R.Component ShareNodeInner
    shareNodeInnerCpt = here.component "shareNodeInner" cpt
    where
    cpt { dispatch, completions } _ = do
    cpt { completions, id, session } _ = do
    state' /\ state <- R2.useBox' ""
    text' /\ text <- R2.useBox' ""
    pure $ Tools.panel
    pure $ Tools.panel {}
    [ inputWithAutocomplete { autoFocus: true
    , autocompleteSearch
    , classes: "share-users-completions d-flex align-items-center"
    ......@@ -107,13 +110,19 @@ shareNodeInnerCpt = here.component "shareNodeInner" cpt
    , elevation: Level1
    , name: "send"
    , title: "Submit" } ]
    ] (H.div {} [ H.text text' ])
    -- footer
    , H.div {} [ H.text text' ] ]
    where
    autocompleteSearch input = pure $ nub $ filter (contains (Pattern input)) completions
    onAutocompleteClick _ = pure unit
    onEnterPress text val = do
    launchAff_ $ dispatch (shareAction val)
    T.write_ ("Invited " <> val <> " to the team") text
    -- launchAff_ $ dispatch (shareAction val)
    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
    title = "Enter a username or an email address (space characters are not allowed)"
    ------------------------------------------------------------------------
    publishNode :: R2.Component SubTreeParamsIn
    ......@@ -127,11 +136,12 @@ publishNodeCpt = here.component "publishNode" cpt
    let button = case action' of
    Action.SharePublic { params } -> case params of
    Just val -> Tools.submitButton (Action.SharePublic {params: Just val}) dispatch
    Just val -> Tools.submitButton { action: Action.SharePublic {params: Just val}
    , dispatch }
    Nothing -> H.div {} []
    _ -> H.div {} []
    pure $ Tools.panel
    pure $ Tools.panel {}
    [ subTreeView { action
    , boxes
    , dispatch
    ......@@ -140,4 +150,6 @@ publishNodeCpt = here.component "publishNode" cpt
    , session
    , subTreeParams
    } []
    ] button
    -- footer
    , button ]
    src/Gargantext/Components/Forest/Tree/Node/Action/Update.purs
    View file @ 317f5942
    ......@@ -11,7 +11,7 @@ import Effect (Effect)
    import Effect.Aff (Aff, launchAff_)
    import Gargantext.Components.Bootstrap.Types (ComponentStatus(..))
    import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
    import Gargantext.Components.Forest.Tree.Node.Tools (formChoiceSafe, submitButton, panel)
    import Gargantext.Components.Forest.Tree.Node.Tools as Tools
    import Gargantext.Components.PhyloExplorer.API as Phylo
    import Gargantext.Components.PhyloExplorer.Config.ConfigForm as PhyloForm
    import Gargantext.Components.PhyloExplorer.ConfigFormParser as PhyloHook
    ......@@ -62,13 +62,15 @@ updateDashboardCpt = here.component "updateDashboard" cpt where
    methodBoard <- T.useBox All
    methodBoard' <- T.useLive T.unequal methodBoard
    pure $ panel [ -- H.text "Update with"
    formChoiceSafe { items: [All, Sources, Authors, Institutes, Ngrams]
    , default: methodBoard'
    , callback: \val -> T.write_ val methodBoard
    , print: show } []
    ]
    (submitButton (UpdateNode $ UpdateNodeParamsBoard { methodBoard: methodBoard' }) dispatch)
    pure $
    Tools.panelWithSubmitButton { action: UpdateNode $ UpdateNodeParamsBoard { methodBoard: methodBoard' }
    , dispatch }
    [ -- H.text "Update with"
    Tools.formChoiceSafe { items: [All, Sources, Authors, Institutes, Ngrams]
    , default: methodBoard'
    , callback: \val -> T.write_ val methodBoard
    , print: show } []
    ]
    updateGraph :: R2.Component UpdateProps
    updateGraph = R.createElement updateGraphCpt
    ......@@ -97,12 +99,22 @@ updateGraphCpt = here.component "updateGraph" cpt where
    callback :: Action -> Aff Unit
    callback = dispatch >=> \_ -> dispatch CloseBox
    pure $ panel [ H.text "Show subjects with Order1 or concepts with Order2 ?"
    , formChoiceSafe { items: [Order1, Order2_A, Order2_B]
    , default: methodGraphMetric'
    , callback: \val -> T.write_ val methodGraphMetric
    , print: show } []
    let action = UpdateNode $ UpdateNodeParamsGraph { methodGraphMetric: methodGraphMetric'
    , methodGraphClustering: methodGraphClustering'
    , methodGraphBridgeness: methodGraphBridgeness'
    , methodGraphEdgesStrength : methodGraphEdgesStrength'
    , methodGraphNodeType1 : methodGraphNodeType1'
    , methodGraphNodeType2 : methodGraphNodeType2'
    }
    pure $
    Tools.panelWithSubmitButton { action, dispatch: callback }
    [ H.text "Show subjects with Order1 or concepts with Order2 ?"
    , Tools.formChoiceSafe { items: [Order1, Order2_A, Order2_B]
    , default: methodGraphMetric'
    , callback: \val -> T.write_ val methodGraphMetric
    , print: show } []
    ]
    {-
    ......@@ -138,16 +150,6 @@ updateGraphCpt = here.component "updateGraph" cpt where
    , callback: \val -> T.write_ val methodGraphClustering
    , print: show } []
    -}
    ]
    (submitButton (UpdateNode $ UpdateNodeParamsGraph { methodGraphMetric: methodGraphMetric'
    , methodGraphClustering: methodGraphClustering'
    , methodGraphBridgeness: methodGraphBridgeness'
    , methodGraphEdgesStrength : methodGraphEdgesStrength'
    , methodGraphNodeType1 : methodGraphNodeType1'
    , methodGraphNodeType2 : methodGraphNodeType2'
    }
    ) callback
    )
    ......@@ -214,13 +216,15 @@ updateNodeListCpt = here.component "updateNodeList" cpt where
    methodList <- T.useBox Basic
    methodList' <- T.useLive T.unequal methodList
    pure $ panel [ -- H.text "Update with"
    formChoiceSafe { items: [Basic, Advanced, WithModel]
    , default: methodList'
    , callback: \val -> T.write_ val methodList
    , print: show } []
    ]
    (submitButton (UpdateNode $ UpdateNodeParamsList { methodList: methodList' }) dispatch)
    pure $
    Tools.panelWithSubmitButton { action: UpdateNode $ UpdateNodeParamsList { methodList: methodList' }
    , dispatch }
    [ -- H.text "Update with"
    Tools.formChoiceSafe { items: [Basic, Advanced, WithModel]
    , default: methodList'
    , callback: \val -> T.write_ val methodList
    , print: show } []
    ]
    updateTexts :: R2.Component UpdateProps
    updateTexts = R.createElement updateTextsCpt
    ......@@ -230,14 +234,15 @@ updateTextsCpt = here.component "updateTexts" cpt where
    -- methodTexts <- T.useBox NewNgrams
    -- methodTexts' <- T.useLive T.unequal methodTexts
    pure $ panel [ -- H.text "Update with"
    -- formChoiceSafe { items: [NewNgrams, NewTexts, Both]
    -- , default: methodTexts'
    -- , callback: \val -> T.write_ val methodTexts
    -- , print: show } []
    ]
    -- (submitButton (UpdateNode $ UpdateNodeParamsTexts { methodTexts: methodTexts' }) dispatch)
    (submitButton (UpdateNode $ UpdateNodeParamsTexts { methodTexts: Both }) dispatch)
    pure $
    Tools.panelWithSubmitButton { action: UpdateNode $ UpdateNodeParamsTexts { methodTexts: Both }
    , dispatch }
    [] -- H.text "Update with"
    -- formChoiceSafe { items: [NewNgrams, NewTexts, Both]
    -- , default: methodTexts'
    -- , callback: \val -> T.write_ val methodTexts
    -- , print: show } []
    -- (submitButton (UpdateNode $ UpdateNodeParamsTexts { methodTexts: methodTexts' }) dispatch)
    updateOther :: R2.Component UpdateProps
    ......
    src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs
    View file @ 317f5942
    ......@@ -194,7 +194,7 @@ uploadFileViewWithLangsCpt = here.component "uploadFileViewWithLangs" cpt
    , selection
    } []
    ]
    pure $ panel bodies footer
    pure $ panel {} (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
    panel {}
    -- Body
    [
    -- Upload
    ......@@ -423,9 +423,9 @@ uploadListViewCpt = here.component "uploadListView" cpt where
    } []
    ]
    ]
    ]
    -- Footer
    (
    ,
    H.div
    {}
    [
    ......@@ -439,7 +439,7 @@ uploadListViewCpt = here.component "uploadListView" cpt where
    , nodeType: GT.Annuaire
    } []
    ]
    )
    ]
    -- START File Type View
    type FileTypeProps =
    ......@@ -663,12 +663,12 @@ uploadTermListViewCpt = here.component "uploadTermListView" cpt
    }
    ]
    pure $ panel
    pure $ panel {}
    [ H.form {}
    [ R2.row [ R2.col 12 [ input ] ]
    , R2.row [ R2.col 12 [ uploadTypeHtml ] ]
    ]
    ] footer
    , footer ]
    onChangeContents :: forall e. T.Box (Maybe UploadFile)
    -> E.SyntheticEvent_ e
    ......@@ -815,7 +815,7 @@ uploadFrameCalcViewWithLangsCpt = here.component "uploadFrameCalcViewWithLangs"
    [ H.text "Upload!" ]
    ]
    pure $ panel bodies footer
    pure $ panel {} (bodies <> [ footer ])
    where
    onClick lang' selection' _ = do
    ......
    src/Gargantext/Components/Forest/Tree/Node/Action/WriteNodesDocuments.purs
    View file @ 317f5942
    ......@@ -11,7 +11,7 @@ import Gargantext.Components.App.Store (Boxes)
    import Gargantext.Components.Bootstrap as B
    import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
    import Gargantext.Components.Forest.Tree.Node.Action.Utils (loadLanguages)
    import Gargantext.Components.Forest.Tree.Node.Tools (panel, submitButton)
    import Gargantext.Components.Forest.Tree.Node.Tools as Tools
    import Gargantext.Components.Lang (Lang(..))
    import Gargantext.Components.ListSelection as ListSelection
    import Gargantext.Components.ListSelection.Types as ListSelection
    ......@@ -71,80 +71,84 @@ actionWriteNodesDocumentsWithLangsCpt = here.component "actionWriteNodesDocument
    paragraphs' /\ paragraphBox
    <- R2.useBox' "7"
    let bodies = [
    H.div
    { className: "col-12 flex-space-around" }
    [ H.h4 {}
    [ H.text "Will traverse all Write Nodes and insert them as documents into current corpus." ]
    ]
    ,
    -- lang
    H.div
    { className: "form-group" }
    [
    H.div
    { className: "form-group__label" }
    pure $
    Tools.panelWithSubmitButton { action: DocumentsFromWriteNodes { id
    , lang: lang'
    , selection: selection'
    , paragraphs: paragraphs' }
    , dispatch }
    [
    B.label_ $
    "File lang"
    H.div
    { className: "col-12 flex-space-around" }
    [ H.h4 {}
    [ H.text "Will traverse all Write Nodes and insert them as documents into current corpus." ]
    ]
    ,
    -- lang
    H.div
    { className: "form-group" }
    [
    H.div
    { className: "form-group__label" }
    [
    B.label_ $
    "File lang"
    ]
    ,
    H.div
    { className: "form-group__field" }
    [
    B.formSelect'
    { callback: flip T.write_ langBox
    , value: lang'
    , list: langs <> [ No_extraction ]
    }
    []
    ]
    ]
    ,
    -- paragraph
    H.div
    { className: "form-group "}
    [
    H.div
    { className: "form-group__label" }
    [
    B.label_ $
    "Paragraph size (sentences)"
    ]
    ,
    H.div
    { className: "form-group__field" }
    [
    B.formInput
    { callback: flip T.write_ paragraphBox
    , value: paragraphs'
    }
    ]
    ]
    ,
    --selection
    H.div
    { className: "form-group" }
    [
    H.div
    { className: "form-group__label" }
    [
    B.label_ $
    "List selection"
    ]
    ,
    H.div
    { className: "form-group__field" }
    [
    ListSelection.selection
    { selection: selectionBox
    , session
    } []
    ]
    ]
    ]
    ,
    H.div
    { className: "form-group__field" }
    [
    B.formSelect'
    { callback: flip T.write_ langBox
    , value: lang'
    , list: langs <> [ No_extraction ]
    }
    []
    ]
    ]
    ,
    -- paragraph
    H.div
    { className: "form-group "}
    [
    H.div
    { className: "form-group__label" }
    [
    B.label_ $
    "Paragraph size (sentences)"
    ]
    ,
    H.div
    { className: "form-group__field" }
    [
    B.formInput
    { callback: flip T.write_ paragraphBox
    , value: paragraphs'
    }
    ]
    ]
    ,
    --selection
    H.div
    { className: "form-group" }
    [
    H.div
    { className: "form-group__label" }
    [
    B.label_ $
    "List selection"
    ]
    ,
    H.div
    { className: "form-group__field" }
    [
    ListSelection.selection
    { selection: selectionBox
    , session
    } []
    ]
    ]
    ]
    pure $ panel bodies (submitButton (DocumentsFromWriteNodes { id, lang: lang', selection: selection', paragraphs: paragraphs' }) dispatch)
    type Params =
    ......
    src/Gargantext/Components/Forest/Tree/Node/Tools.purs
    View file @ 317f5942
    ......@@ -2,10 +2,12 @@ module Gargantext.Components.Forest.Tree.Node.Tools where
    import Gargantext.Prelude
    import Data.Maybe (fromMaybe)
    import Data.Array as A
    import Data.Maybe (fromMaybe, Maybe(..))
    import Data.Set (Set)
    import Data.Set as Set
    import Data.String as S
    import Data.Tuple.Nested ((/\))
    import Effect (Effect)
    import Effect.Aff (Aff, launchAff, launchAff_)
    import Gargantext.Components.Bootstrap as B
    ......@@ -19,6 +21,7 @@ import Gargantext.Utils.Reactix as R2
    import Gargantext.Utils.Show as GUS
    import Reactix as R
    import Reactix.DOM.HTML as H
    import Record.Extra as RX
    import Toestand as T
    here :: R2.Here
    ......@@ -27,20 +30,52 @@ here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools"
    fragmentPT :: String -> R.Element
    fragmentPT text = H.div { style: { margin: "10px" }} [ H.text text ]
    type Body = Array R.Element
    type Footer = R.Element
    type PanelProps = ()
    -- | 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 =
    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-footer"}
    [ H.div { className: "row" }
    [ H.div { className: "mx-auto"} [ footer ] ]]]
    where
    bodies /\ footer =
    case A.unsnoc children of
    Nothing -> [] /\ (H.div {} [])
    Just { init, last } -> init /\ last
    panelNoFooter :: R2.Component PanelProps
    panelNoFooter = R.createElement panelNoFooterCpt
    panelNoFooterCpt :: R.Component PanelProps
    panelNoFooterCpt = here.component "panelNoFooter" cpt where
    cpt props children =
    pure $ panel props (children <> [ H.div {} [] ])
    type PanelWithSubmitButtonProps =
    ( action :: Action
    , dispatch :: Action -> Aff Unit
    | PanelProps )
    panelWithSubmitButton :: R2.Component PanelWithSubmitButtonProps
    panelWithSubmitButton = R.createElement panelWithSubmitButtonCpt
    panelWithSubmitButtonCpt :: R.Component PanelWithSubmitButtonProps
    panelWithSubmitButtonCpt = here.component "panelWithSubmitButton" cpt where
    cpt props@{ action, dispatch } children = do
    let pProps = (RX.pick props :: Record PanelProps)
    pure $ panel pProps (children
    -- footer
    <> [ submitButton { action, dispatch } ])
    panel :: Body -> Footer -> R.Element
    panel bodies submit =
    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-footer"}
    [ H.div { className: "row" }
    [ H.div { className: "mx-auto"} [ submit ] ]]]
    type TextInputBoxProps =
    ( id :: GT.ID
    ......@@ -252,15 +287,23 @@ formButtonCpt = here.component "formButton" cpt where
    ------------------------------------------------------------------------
    ------------------------------------------------------------------------
    submitButton :: Action -> (Action -> Aff Unit) -> R.Element
    submitButton action dispatch =
    H.button { className : "btn btn-primary fa fa-" <> icon action
    , type: "button"
    , id: S.toLower $ show action
    , title: show action
    , on: {click: \_ -> launchAff $ dispatch action}
    }
    [ H.span {className: "font-family-theme mx-1"} [ H.text $ " " <> text action] ]
    type SubmitButtonProps =
    ( action :: Action
    , dispatch :: Action -> Aff Unit )
    submitButton :: R2.Leaf SubmitButtonProps
    submitButton = R2.leaf submitButtonCpt
    submitButtonCpt :: R.Component SubmitButtonProps
    submitButtonCpt = here.component "submitButton" cpt where
    cpt { action
    , dispatch } _ = do
    pure $ H.button { className : "btn btn-primary fa fa-" <> icon action
    , type: "button"
    , id: S.toLower $ show action
    , title: show action
    , on: {click: \_ -> launchAff $ dispatch action}
    }
    [ H.span {className: "font-family-theme mx-1"} [ H.text $ " " <> text action] ]
    type Href = String
    ......
    src/Gargantext/Config/REST.purs
    View file @ 317f5942
    ......@@ -14,6 +14,7 @@ import Data.Generic.Rep (class Generic)
    import Data.HTTP.Method (Method(..))
    import Data.Maybe (Maybe(..))
    import Data.MediaType.Common (applicationFormURLEncoded, applicationJSON, multipartFormData)
    import Data.Show.Generic (genericShow)
    import Data.Tuple (Tuple)
    import Effect (Effect)
    import Effect.Aff (Aff)
    ......@@ -31,6 +32,7 @@ type Token = String
    data RESTError =
    CustomError String
    | FE FrontendError
    | ReadJSONError Foreign.MultipleErrors
    | SendResponseError Affjax.Error
    | ServerError String
    ......@@ -38,6 +40,7 @@ data RESTError =
    derive instance Generic RESTError _
    instance Show RESTError where
    show (CustomError s) = "CustomError " <> s
    show (FE e) = show e
    show (ReadJSONError e) = "ReadJSONError " <> show e
    show (SendResponseError e) = "SendResponseError " <> showError e
    where
    ......@@ -52,6 +55,87 @@ instance Eq RESTError where
    -- this is crude but we need it only because of useLoader
    eq _ _ = false
    data FrontendError =
    EC_400__node_creation_failed_insert_node { user_id :: Int
    , parent_id :: Int }
    | EC_400__node_creation_failed_no_parent { user_id :: Int }
    | EC_400__node_creation_failed_parent_exists { parent_id :: Int
    , user_id :: Int }
    | EC_400__node_creation_failed_user_negative_id { user_id :: Int }
    | EC_400__node_lookup_failed_user_too_many_roots { user_id :: Int
    , roots :: Array Int }
    | EC_400__node_needs_configuration
    | EC_403__login_failed_error { node_id :: Int
    , user_id :: Int }
    | EC_403__login_failed_invalid_username_or_password
    | EC_404__node_context_not_found { context_id :: Int }
    | EC_404__node_lookup_failed_not_found { node_id :: Int }
    | EC_404__node_lookup_failed_parent_not_found { node_id :: Int }
    | EC_404__node_lookup_failed_username_not_found { username :: String }
    | EC_404__node_list_not_found { list_id :: Int }
    | EC_404__node_root_not_found
    | EC_500__node_generic_exception { error :: String }
    | EC_500__node_not_implemented_yet
    derive instance Generic FrontendError _
    instance Show FrontendError where
    show EC_403__login_failed_invalid_username_or_password = "Invalid username or password"
    show (EC_404__node_lookup_failed_username_not_found { username }) = "User '" <> username <> "' not found"
    show a = genericShow a
    instance JSON.ReadForeign FrontendError where
    readImpl f = do
    { type: type_ } <- JSON.readImpl f :: Foreign.F { type :: String }
    case type_ of
    "EC_400__node_creation_failed_insert_node" -> do
    { data: { parent_id, user_id } } <- JSON.readImpl f :: Foreign.F { data :: { parent_id :: Int
    , user_id :: Int } }
    pure $ EC_400__node_creation_failed_insert_node { parent_id, user_id }
    "EC_400__node_creation_failed_no_parent" -> do
    { data: { user_id } } <- JSON.readImpl f :: Foreign.F { data :: { user_id :: Int } }
    pure $ EC_400__node_creation_failed_no_parent { user_id }
    "EC_400__node_creation_failed_parent_exists" -> do
    { data: { parent_id, user_id } } <- JSON.readImpl f :: Foreign.F { data :: { parent_id :: Int
    , user_id :: Int } }
    pure $ EC_400__node_creation_failed_parent_exists { parent_id, user_id }
    "EC_400__node_creation_failed_user_negative_id" -> do
    { data: { user_id } } <- JSON.readImpl f :: Foreign.F { data :: { user_id :: Int } }
    pure $ EC_400__node_creation_failed_user_negative_id { user_id }
    "EC_400__node_lookup_failed_user_too_many_roots" -> do
    { data: { user_id, roots } } <- JSON.readImpl f :: Foreign.F { data :: { user_id :: Int
    , roots :: Array Int } }
    pure $ EC_400__node_lookup_failed_user_too_many_roots { user_id, roots }
    "EC_400__node_needs_configuration" -> do
    pure $ EC_400__node_needs_configuration
    "EC_403__login_failed_error" -> do
    { data: { node_id, user_id } } <- JSON.readImpl f :: Foreign.F { data :: { node_id :: Int
    , user_id :: Int } }
    pure $ EC_403__login_failed_error { node_id, user_id }
    "EC_403__login_failed_invalid_username_or_password" -> do
    pure $ EC_403__login_failed_invalid_username_or_password
    "EC_404__node_context_not_found" -> do
    { data: { context_id } } <- JSON.readImpl f :: Foreign.F { data :: { context_id :: Int } }
    pure $ EC_404__node_context_not_found { context_id }
    "EC_404__node_lookup_failed_not_found" -> do
    { data: { node_id } } <- JSON.readImpl f :: Foreign.F { data :: { node_id :: Int } }
    pure $ EC_404__node_lookup_failed_not_found { node_id }
    "EC_404__node_lookup_failed_parent_not_found" -> do
    { data: { node_id } } <- JSON.readImpl f :: Foreign.F { data :: { node_id :: Int } }
    pure $ EC_404__node_lookup_failed_parent_not_found { node_id }
    "EC_404__node_lookup_failed_username_not_found" -> do
    { data: { username } } <- JSON.readImpl f :: Foreign.F { data :: { username :: String } }
    pure $ EC_404__node_lookup_failed_username_not_found { username }
    "EC_404__node_list_not_found" -> do
    { data: { list_id } } <- JSON.readImpl f :: Foreign.F { data :: { list_id :: Int } }
    pure $ EC_404__node_list_not_found { list_id }
    "EC_404__node_root_not_found" -> do
    pure $ EC_404__node_root_not_found
    "EC_500__node_generic_exception" -> do
    { data: { error } } <- JSON.readImpl f :: Foreign.F { data :: { error :: String } }
    pure $ EC_500__node_generic_exception { error }
    "EC_500__node_not_implemented_yet" -> do
    pure $ EC_500__node_not_implemented_yet
    _ -> Foreign.fail $ Foreign.ForeignError $ "deserialization for '" <> type_ <> "' not implemented"
    logRESTError :: R2.Here -> String -> RESTError -> Effect Unit
    logRESTError here' prefix e = here'.warn2 (prefix <> " " <> show e) e
    -- logRESTError here prefix (SendResponseError e) = here.warn2 (prefix <> " SendResponseError ") e -- TODO: No show
    ......@@ -61,8 +145,8 @@ logRESTError here' prefix e = here'.warn2 (prefix <> " " <> show e) e
    type AffRESTError a = Aff (Either RESTError a)
    readJSON :: forall a. JSON.ReadForeign a =>
    Either Affjax.Error (Affjax.Response AC.Json)
    readJSON :: forall a. JSON.ReadForeign a
    => Either Affjax.Error (Affjax.Response AC.Json)
    -> Either RESTError a
    readJSON affResp =
    case affResp of
    ......@@ -74,15 +158,27 @@ readJSON affResp =
    --_ <- liftEffect $ log json.status
    --_ <- liftEffect $ log json.headers
    --_ <- liftEffect $ log json.body
    case resp.status of
    StatusCode 500 ->
    case (JSON.readJSON $ AC.stringify resp.body :: JSON.E { error :: String }) of
    Right ({ error }) -> Left $ ServerError error
    Left _ -> Left $ UnknownServerError $ AC.stringify resp.body
    _ ->
    StatusCode 200 ->
    case (JSON.readJSON $ AC.stringify resp.body) of
    Left err -> Left $ ReadJSONError err
    Right r -> Right r
    _ -> case (JSON.readJSON $ AC.stringify resp.body :: JSON.E FrontendError) of
    Right err -> Left $ FE err
    Left _ -> Left $ UnknownServerError $ AC.stringify resp.body
    -- _ -> Left $ parseServerError resp
    parseServerError :: Affjax.Response AC.Json -> RESTError
    parseServerError { body } =
    case (JSON.readJSON $ AC.stringify body :: JSON.E { type :: String }) of
    Right { type: "EC_404__node_lookup_failed_username_not_found" } ->
    ServerError "username not found"
    -- TODO Add more errors for the frontend
    Right { type: type_ } ->
    UnknownServerError $ "Server error of type '" <> type_ <> "' not supported"
    Left _ -> UnknownServerError $ AC.stringify body
    -- TODO too much duplicate code in `postWwwUrlencoded`
    send :: forall body res. JSON.WriteForeign body => JSON.ReadForeign res =>
    ......@@ -94,6 +190,7 @@ send m mtoken url reqbody = do
    , method = Left m
    , headers = [ ARH.ContentType applicationJSON
    , ARH.Accept applicationJSON
    , ARH.RequestHeader "X-Garg-Error-Scheme" $ "new"
    ] <>
    foldMap (\token ->
    [ARH.RequestHeader "Authorization" $ "Bearer " <> token]
    ......@@ -106,7 +203,7 @@ send m mtoken url reqbody = do
    let cookie = "JWT-Cookie=" <> token <> "; Path=/;" --" HttpOnly; Secure; SameSite=Lax"
    R2.setCookie cookie
    affResp <- request req
    liftEffect $ here.log2 "[send] affResp" affResp
    -- liftEffect $ here.log2 "[send] affResp" affResp
    pure $ readJSON affResp
    noReqBody :: Maybe String
    ......
    src/Gargantext/Sessions.purs
    View file @ 317f5942
    ......@@ -115,12 +115,9 @@ postAuthRequest :: Backend -> AuthRequest -> Aff (Either String Session)
    postAuthRequest backend ar@(AuthRequest {username}) =
    decode <$> REST.post Nothing (toUrl backend "auth") ar
    where
    decode (Left err) = Left $ "Error when sending REST.post: " <> show err
    decode (Right (AuthResponse ar2))
    | {inval: Just (AuthInvalid {message})} <- ar2 = Left message
    | {valid: Just (AuthData {token, tree_id, user_id})} <- ar2 =
    Right $ Session { backend, caches: Map.empty, token, treeId: tree_id, username, userId: user_id }
    | otherwise = Left "Invalid response from server"
    decode (Left err) = Left $ show err
    decode (Right (AuthData { token, tree_id, user_id })) =
    Right $ Session { backend, caches: Map.empty, token, treeId: tree_id, username, userId: user_id }
    postForgotPasswordRequest :: Backend -> String -> Aff (Either String { status :: String })
    postForgotPasswordRequest backend email =
    ......
    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