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
Show 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,7 +92,7 @@ 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
then ([ Tools.formChoice { items: nodeTypes
, default: nodeType'
, callback: setNodeType'
, print: print hasChromeAgent' } [] ] /\ nodeType')
......@@ -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"}}
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."
]
] (H.div {} [])
]
actionDeleteOther :: R2.Component Delete
actionDeleteOther = R.createElement actionDeleteOtherCpt
actionDeleteOtherCpt :: R.Component Delete
actionDeleteOtherCpt = here.component "actionDeleteOther" cpt where
cpt { dispatch, nodeType } _ = do
pure $ panel (map (\t -> H.p {} [H.text t])
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."
]
) (submitButton (DeleteNode nodeType) dispatch)
])
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,14 +70,15 @@ 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
pure $
Tools.panel {}
[ subTreeView { action
, boxes
, dispatch
, id
......@@ -85,7 +86,9 @@ linkNodeCpt' = here.component "__clone__" cpt
, session
, subTreeParams
} []
] button
-- 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"}}
pure $
if null team' then
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'])
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
......@@ -53,7 +54,7 @@ mergeNodeCpt = here.component "mergeNode" cpt
, 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 ]
, Tools.checkboxesListGroup { groups: [ GT.MapTerm, GT.CandidateTerm, GT.StopTerm ]
, options } []
]
])
......@@ -63,10 +64,11 @@ mergeNodeCpt = here.component "mergeNode" cpt
]
, H.li { className: "list-group-item" }
[ H.div { className: " form-check" }
[ checkbox { value: merge }
[ Tools.checkbox { value: merge }
, H.label { className: "form-check-label" } [ H.text "Merge data?" ]
]
]
]
]
button
-- 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(..))
......@@ -60,13 +60,14 @@ moveNodeCpt' = here.component "__clone__" cpt where
let button = case action' of
MoveNode { params } -> case params of
Just val -> submitButton (MoveNode {params: Just val}) dispatch
Just val -> Tools.submitButton { action: MoveNode {params: Just val}
, dispatch }
Nothing -> H.div {} []
_ -> H.div {} []
pure $
panel
Tools.panel {}
[ subTreeView { action
, boxes
, dispatch
......@@ -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]
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 } []
]
(submitButton (UpdateNode $ UpdateNodeParamsBoard { methodBoard: methodBoard' }) dispatch)
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]
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]
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 } []
]
(submitButton (UpdateNode $ UpdateNodeParamsList { methodList: methodList' }) dispatch)
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"
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)
(submitButton (UpdateNode $ UpdateNodeParamsTexts { methodTexts: Both }) 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,7 +71,13 @@ actionWriteNodesDocumentsWithLangsCpt = here.component "actionWriteNodesDocument
paragraphs' /\ paragraphBox
<- R2.useBox' "7"
let bodies = [
pure $
Tools.panelWithSubmitButton { action: DocumentsFromWriteNodes { id
, lang: lang'
, selection: selection'
, paragraphs: paragraphs' }
, dispatch }
[
H.div
{ className: "col-12 flex-space-around" }
[ H.h4 {}
......@@ -144,8 +150,6 @@ actionWriteNodesDocumentsWithLangsCpt = here.component "actionWriteNodesDocument
]
]
pure $ panel bodies (submitButton (DocumentsFromWriteNodes { id, lang: lang', selection: selection', paragraphs: paragraphs' }) dispatch)
type Params =
( id :: GT.ID
......
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 = ()
panel :: Body -> Footer -> R.Element
panel bodies submit =
R.fragment
-- | 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"} [ submit ] ]]]
[ 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 } ])
type TextInputBoxProps =
( id :: GT.ID
......@@ -252,9 +287,17 @@ 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 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
......
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 =
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 }
| otherwise = Left "Invalid response from server"
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