Skip to content

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

[refactor] support for more REST errors 

Also, refactored node/settings as there were lots of duplications.
parent f3532d2b
Pipeline #5484 failed with stage
    in 0 seconds
    Hide whitespace changes
    Inline Side-by-side
    Showing with 366 additions and 430 deletions
    packages.dhall
    View file @ 81ad30d2
    ......@@ -104,7 +104,23 @@ let overrides =
    }
    let additions =
    { sequences =
    { convertable-options =
    { dependencies = [ "console", "effect", "maybe", "record" ]
    , repo = "https://github.com/natefaubion/purescript-convertable-options"
    , version = "v1.0.0"
    }
    , data-default =
    { dependencies =
    [ "assert", "lists", "maybe", "record", "effect", "prelude" ]
    , repo = "https://github.com/thought2/purescript-data-default"
    , version = "350e600a5a022c9599865a2dd14196b442f59bcc"
    }
    , dom-filereader =
    { dependencies = [ "aff", "arraybuffer-types", "web-file", "web-html" ]
    , repo = "https://github.com/nwolverson/purescript-dom-filereader"
    , version = "v5.0.0"
    }
    , sequences =
    { dependencies =
    [ "arrays"
    , "assert"
    ......@@ -126,6 +142,28 @@ let additions =
    , repo = "https://github.com/garganscript/purescript-sequences.git"
    , version = "recursion-fix"
    }
    , read =
    { dependencies = [ "prelude", "maybe", "strings" ]
    , repo = "https://github.com/truqu/purescript-read"
    , version = "v1.0.1"
    }
    , simple-json-generics =
    { dependencies =
    [ "assert"
    , "control"
    , "effect"
    , "either"
    , "foreign"
    , "partial"
    , "prelude"
    , "simple-json"
    , "transformers"
    , "typelevel-prelude"
    ]
    , repo =
    "https://github.com/garganscript/purescript-simple-json-generics"
    , version = "master"
    }
    , spec-discovery =
    { dependencies = [ "prelude", "effect", "arrays", "spec", "node-fs" ]
    , repo = "https://github.com/purescript-spec/purescript-spec-discovery"
    ......@@ -156,28 +194,6 @@ let additions =
    "https://gitlab.iscpif.fr/gargantext/purescript-string-search.git"
    , version = "v0.1.6"
    }
    , dom-filereader =
    { dependencies = [ "aff", "arraybuffer-types", "web-file", "web-html" ]
    , repo = "https://github.com/nwolverson/purescript-dom-filereader"
    , version = "v5.0.0"
    }
    , simple-json-generics =
    { dependencies =
    [ "assert"
    , "control"
    , "effect"
    , "either"
    , "foreign"
    , "partial"
    , "prelude"
    , "simple-json"
    , "transformers"
    , "typelevel-prelude"
    ]
    , repo =
    "https://github.com/garganscript/purescript-simple-json-generics"
    , version = "master"
    }
    , tuples-native =
    { dependencies =
    [ "console"
    ......@@ -191,11 +207,6 @@ let additions =
    , repo = "https://github.com/garganscript/purescript-tuples-native"
    , version = "v2.3.0"
    }
    , read =
    { dependencies = [ "prelude", "maybe", "strings" ]
    , repo = "https://github.com/truqu/purescript-read"
    , version = "v1.0.1"
    }
    , versions =
    { dependencies = [ "prelude" ]
    , repo = "https://github.com/hdgarrood/purescript-versions.git"
    ......@@ -206,11 +217,6 @@ let additions =
    , repo = "https://github.com/mjepronk/purescript-web-url"
    , version = "v2.0.0"
    }
    , convertable-options =
    { dependencies = [ "console", "effect", "maybe", "record" ]
    , repo = "https://github.com/natefaubion/purescript-convertable-options"
    , version = "v1.0.0"
    }
    }
    in upstream // overrides // additions
    spago.dhall
    View file @ 81ad30d2
    ......@@ -28,6 +28,7 @@ to generate this file without the comments in this block.
    , "convertable-options"
    , "css"
    , "d3"
    , "data-default"
    , "datetime"
    , "debug"
    , "dom-filereader"
    ......
    src/Gargantext/Components/Forest/Tree/Node/Action/Add.purs
    View file @ 81ad30d2
    ......@@ -43,9 +43,7 @@ addNodeAsync :: Session
    -> AffRESTError GT.AsyncTaskWithType
    addNodeAsync session parentId q = do
    eTask :: Either RESTError GT.AsyncTask <- post session p q
    case eTask of
    Left err -> pure $ Left err
    Right task -> pure $ Right $ GT.AsyncTaskWithType { task, typ: GT.AddNode }
    pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.AddNode }) <$> eTask
    where
    p = GR.NodeAPI GT.Node (Just parentId) (GT.asyncTaskTypePath GT.AddNode)
    ......@@ -91,33 +89,37 @@ addNodeViewCpt = here.component "addNodeView" cpt where
    setNodeType' nt = do
    T.write_ (GT.prettyNodeType nt) nodeName
    T.write_ nt nodeType
    (maybeChoose /\ nt') = if length nodeTypes > 1
    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:"
    ]
    ] /\ defaultNt
    )
    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 []
    (maybeChoose /\ nt') =
    if length nodeTypes > 1 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:"
    ]
    ] /\ defaultNt
    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 []
    pure $ Tools.panelWithSubmitButton { action: AddNode nodeName' nt'
    , dispatch
    ......
    src/Gargantext/Components/Forest/Tree/Node/Box.purs
    View file @ 81ad30d2
    ......@@ -332,31 +332,39 @@ panelAction = R2.leaf panelActionCpt
    panelActionCpt :: R.Component PanelActionProps
    panelActionCpt = here.component "panelAction" cpt
    where
    cpt { action: Documentation nodeType} _ = pure $ actionDoc { nodeType } []
    cpt { action: Download, id, nodeType, session} _ = pure $ actionDownload { id, nodeType, session } []
    cpt { action: Upload, dispatch, id, nodeType, session} _ = pure $ actionUpload { dispatch, id, nodeType, session } []
    cpt { action: Delete, nodeType, dispatch} _ = pure $ actionDelete { dispatch, nodeType } []
    cpt { action: ManageTeam, nodeType, id, session} _ = pure $ actionManageTeam { id, nodeType, session } []
    cpt { action: Add xs, dispatch, id, name, nodeType} _ =
    pure $ addNodeView {dispatch, id, name, nodeType, nodeTypes: xs} []
    cpt { action: Refresh , dispatch, nodeType } _ = pure $ update { dispatch, nodeType } []
    cpt { action: ReloadWithSettings , dispatch, nodeType } _ = pure $ update { dispatch, nodeType } []
    cpt { action : AddingContact, dispatch, id } _ =
    pure $ Contact.actionAddContact { dispatch, id } []
    cpt { action: Config, nodeType } _ =
    pure $ fragmentPT $ "Config " <> show nodeType
    -- Functions using SubTree
    cpt { action: Reconstruct , dispatch, nodeType } _ = pure $ update { dispatch, nodeType } []
    cpt { action: Delete, nodeType, dispatch} _ =
    pure $ actionDelete { dispatch, nodeType } []
    cpt { action: Documentation nodeType} _ =
    pure $ actionDoc { nodeType } []
    cpt { action: Download, id, nodeType, session} _ =
    pure $ actionDownload { id, nodeType, session } []
    cpt { action: Link {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
    pure $ linkNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
    cpt { action: ManageTeam, nodeType, id, session} _ =
    pure $ actionManageTeam { id, nodeType, session } []
    cpt { action: Merge {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
    pure $ mergeNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
    cpt { action: Move {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
    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, 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 } []
    cpt { action: Reconstruct , dispatch, nodeType } _ =
    pure $ update { dispatch, nodeType } []
    cpt { action: Refresh , dispatch, nodeType } _ =
    pure $ update { dispatch, nodeType } []
    cpt { action: ReloadWithSettings , dispatch, nodeType } _ =
    pure $ update { dispatch, nodeType } []
    cpt { action: SearchBox, boxes, dispatch, id, session } _ =
    pure $ actionSearch { boxes, dispatch, id: Just id, session } []
    cpt { action : Share, id, session } _ = pure $ Share.shareNode { id, session } []
    cpt { action: Upload, dispatch, id, nodeType, session} _ =
    pure $ actionUpload { dispatch, id, nodeType, session } []
    cpt { action: WriteNodesDocuments, boxes, dispatch, id, session } _ =
    pure $ actionWriteNodesDocuments { boxes, dispatch, id, session } []
    cpt _ _ = pure $ H.div {} []
    src/Gargantext/Components/Forest/Tree/Node/Settings.purs
    View file @ 81ad30d2
    module Gargantext.Components.Forest.Tree.Node.Settings where
    import Gargantext.Prelude (class Eq, class Show, show, (&&), (<>), (==))
    import Data.Default (class Default, def)
    import Data.Lens (Lens', lens, (.~))
    import Data.Lens.Record (prop)
    import Gargantext.Prelude (class Eq, class Show, show, (&&), (<>), (==), ($), (<<<))
    import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeParams(..))
    import Gargantext.Types
    import Type.Proxy (Proxy(..))
    ------------------------------------------------------------------------
    ------------------------------------------------------------------------
    ......@@ -11,92 +15,89 @@ import Gargantext.Types
    if user has access to node then he can do all his related actions
    -}
    ------------------------------------------------------------------------
    data NodeAction = Documentation NodeType
    | SearchBox
    | Download
    | Upload
    | Refresh
    | ReloadWithSettings
    data NodeAction = Add (Array NodeType)
    | AddingContact
    | CloseNodePopover
    | Config
    | Reconstruct
    | Delete
    | Share
    | Documentation NodeType
    | Download
    | Link { subTreeParams :: SubTreeParams }
    | ManageTeam
    | Publish { subTreeParams :: SubTreeParams }
    | Add (Array NodeType)
    | Merge { subTreeParams :: SubTreeParams }
    | Move { subTreeParams :: SubTreeParams }
    | Link { subTreeParams :: SubTreeParams }
    | Clone
    | AddingContact
    | CloseNodePopover
    | Publish { subTreeParams :: SubTreeParams }
    | Refresh
    | ReloadWithSettings
    | Reconstruct
    | SearchBox
    | Share
    | Upload
    | WriteNodesDocuments -- https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/331
    ------------------------------------------------------------------------
    instance Eq NodeAction where
    eq (Add x) (Add y) = x == y
    eq AddingContact AddingContact = true
    eq CloseNodePopover CloseNodePopover = true
    eq Config Config = true
    eq Delete Delete = true
    eq (Documentation x) (Documentation y) = true && (x == y)
    eq SearchBox SearchBox = true
    eq Download Download = true
    eq Upload Upload = true
    eq Refresh Refresh = true
    eq ReloadWithSettings ReloadWithSettings = true
    eq (Move x) (Move y) = x == y
    eq Clone Clone = true
    eq Delete Delete = true
    eq Share Share = true
    eq ManageTeam ManageTeam = true
    eq (Link x) (Link y) = x == y
    eq (Add x) (Add y) = x == y
    eq ManageTeam ManageTeam = true
    eq (Merge x) (Merge y) = x == y
    eq Config Config = true
    eq Reconstruct Reconstruct = true
    eq (Move x) (Move y) = x == y
    eq (Publish x) (Publish y) = x == y
    eq AddingContact AddingContact = true
    eq CloseNodePopover CloseNodePopover = true
    eq Reconstruct Reconstruct = true
    eq Refresh Refresh = true
    eq ReloadWithSettings ReloadWithSettings = true
    eq SearchBox SearchBox = true
    eq Share Share = true
    eq Upload Upload = true
    eq WriteNodesDocuments WriteNodesDocuments = true
    eq _ _ = false
    instance Show NodeAction where
    show (Add _) = "Add Child" -- foldl (\a b -> a <> show b) "Add " xs
    show AddingContact = "AddingContact"
    show CloseNodePopover = "CloseNodePopover"
    show Config = "Config"
    show Delete = "Delete"
    show (Documentation x) = "Documentation of " <> show x
    show SearchBox = "SearchBox"
    show Download = "Download"
    show Upload = "Upload"
    show Refresh = "Refresh"
    show ReloadWithSettings = "Reload (with settings)"
    show (Move _) = "Move with subtree params" -- <> show t
    show Clone = "Clone"
    show Delete = "Delete"
    show Share = "Share"
    show ManageTeam = "Team"
    show Config = "Config"
    show Reconstruct = "Reconstruct"
    show (Link _) = "Link to " -- <> show x
    show (Add _) = "Add Child" -- foldl (\a b -> a <> show b) "Add " xs
    show ManageTeam = "Team"
    show (Merge _) = "Merge with subtree" -- <> show t
    show (Move _) = "Move with subtree params" -- <> show t
    show (Publish _) = "Publish" -- <> show x
    show AddingContact = "AddingContact"
    show CloseNodePopover = "CloseNodePopover"
    show Reconstruct = "Reconstruct"
    show Refresh = "Refresh"
    show ReloadWithSettings = "Reload (with settings)"
    show SearchBox = "SearchBox"
    show Share = "Share"
    show Upload = "Upload"
    show WriteNodesDocuments = "WriteNodesDocuments"
    glyphiconNodeAction :: NodeAction -> String
    glyphiconNodeAction (Documentation _) = "question-circle"
    glyphiconNodeAction Delete = "trash"
    glyphiconNodeAction (Add _) = "plus"
    glyphiconNodeAction SearchBox = "search"
    glyphiconNodeAction Upload = "upload"
    glyphiconNodeAction (Link _) = "arrows-h"
    glyphiconNodeAction AddingContact = "user-plus"
    glyphiconNodeAction CloseNodePopover = "close"
    glyphiconNodeAction Config = "wrench"
    glyphiconNodeAction Delete = "trash"
    glyphiconNodeAction (Documentation _) = "question-circle"
    glyphiconNodeAction Download = "download"
    glyphiconNodeAction (Link _) = "arrows-h"
    glyphiconNodeAction ManageTeam = "users"
    glyphiconNodeAction (Merge _) = "random"
    glyphiconNodeAction (Move _) = "share-square-o"
    glyphiconNodeAction (Publish _) = fldr FolderPublic true
    glyphiconNodeAction Reconstruct = "cogs"
    glyphiconNodeAction Refresh = "refresh"
    glyphiconNodeAction ReloadWithSettings = "reload-with-settings"
    glyphiconNodeAction Config = "wrench"
    glyphiconNodeAction Reconstruct = "cogs"
    glyphiconNodeAction SearchBox = "search"
    glyphiconNodeAction Share = "user-plus"
    glyphiconNodeAction ManageTeam = "users"
    glyphiconNodeAction AddingContact = "user-plus"
    glyphiconNodeAction (Move _) = "share-square-o"
    glyphiconNodeAction (Publish _) = fldr FolderPublic true
    glyphiconNodeAction CloseNodePopover = "close"
    glyphiconNodeAction Upload = "upload"
    glyphiconNodeAction WriteNodesDocuments = "bars"
    glyphiconNodeAction _ = ""
    ......@@ -107,294 +108,197 @@ data SettingsBox =
    , doc :: NodeAction
    , buttons :: Array NodeAction
    }
    instance Default SettingsBox where
    def = SettingsBox { show: true
    , edit: true
    , doc: Documentation Annuaire
    , buttons: []
    }
    defNt :: NodeType -> SettingsBox
    defNt nt = (_doc .~ Documentation nt) def
    _show :: Lens' SettingsBox Boolean
    _show = lens (\(SettingsBox { show }) -> show) (\(SettingsBox sb) val -> SettingsBox (sb { show = val }))
    _edit :: Lens' SettingsBox Boolean
    _edit = lens (\(SettingsBox { edit }) -> edit) (\(SettingsBox sb) val -> SettingsBox (sb { edit = val }))
    _doc :: Lens' SettingsBox NodeAction
    _doc = lens (\(SettingsBox { doc }) -> doc) (\(SettingsBox sb) val -> SettingsBox (sb { doc = val }))
    _buttons :: Lens' SettingsBox (Array NodeAction)
    _buttons = lens (\(SettingsBox { buttons }) -> buttons)
    (\(SettingsBox sb) val -> SettingsBox (sb { buttons = val }))
    ------------------------------------------------------------------------
    settingsBox :: NodeType -> SettingsBox
    settingsBox NodeUser =
    SettingsBox { show : true
    , edit : false
    , doc : Documentation NodeUser
    , buttons : [ Delete
    ]
    }
    settingsBox FolderPrivate =
    SettingsBox { show : true
    , edit : false
    , doc : Documentation FolderPrivate
    , buttons : [ Add [ Notes
    , Corpus
    , Calc
    , Folder
    , Annuaire
    -- , NodeFrameNotebook
    ]
    ]
    }
    settingsBox Team =
    SettingsBox { show : true
    , edit : true
    , doc : Documentation Team
    , buttons : [ Add [ Notes
    , Corpus
    , Calc
    , Folder
    , Team
    , Annuaire
    -- , NodeFrameNotebook
    -- , FolderShared
    , NodeFrameVisio
    ]
    , Share
    , ManageTeam
    , Delete
    ]
    }
    settingsBox FolderShared =
    SettingsBox { show : true
    , edit : true
    , doc : Documentation FolderShared
    , buttons : [ Add [Team, FolderShared]
    ]
    }
    settingsBox FolderPublic =
    SettingsBox { show : true
    , edit : true
    , doc : Documentation FolderPublic
    , buttons : [ Add [ FolderPublic ]
    ]
    }
    settingsBox Folder =
    SettingsBox { show : true
    , edit : true
    , doc : Documentation Folder
    , buttons : [ Add [ Notes
    , Corpus
    , Calc
    , Folder
    , Annuaire
    -- , NodeFrameNotebook
    ]
    , Move moveParameters
    , Delete
    ]
    }
    settingsBox Corpus =
    SettingsBox { show : true
    , edit : true
    , doc : Documentation Corpus
    , buttons : [ Add [ Graph
    , Notes
    , Calc
    , NodeTexts
    , NodeList
    , Graph
    -- , Dashboard
    , Phylo
    -- , NodeFrameNotebook
    ]
    , Move moveParameters
    , Upload
    , SearchBox
    , WriteNodesDocuments
    -- , Download
    , Link (linkParams Annuaire)
    , Delete
    ]
    }
    settingsBox NodeTexts =
    SettingsBox { show : true
    , edit : true
    , doc : Documentation NodeTexts
    , buttons : [ ReloadWithSettings
    , Upload
    , Download
    , Delete
    ]
    }
    settingsBox Graph =
    SettingsBox { show : true
    , edit : true
    , doc : Documentation Graph
    , buttons : [ ReloadWithSettings
    , Config
    , Download -- TODO as GEXF or JSON
    -- , Publish publishParams
    , Delete
    ]
    }
    settingsBox Phylo =
    SettingsBox { show : true
    , edit : true
    , doc : Documentation Phylo
    , buttons : [ Reconstruct
    , Delete
    ]
    }
    settingsBox (NodePublic Graph) =
    SettingsBox { show : true
    , edit : true
    , doc : Documentation Graph
    , buttons : [ Download -- TODO as GEXF or JSON
    , Delete
    ]
    }
    settingsBox (NodePublic Dashboard) =
    SettingsBox { show : true
    , edit : true
    , doc : Documentation Dashboard
    , buttons : [ Delete
    ]
    }
    settingsBox (NodePublic NodeFile) =
    SettingsBox { show : true
    , edit : true
    , doc : Documentation NodeFile
    , buttons : [ Delete
    ]
    }
    settingsBox (NodePublic FolderPublic) =
    SettingsBox { show : true
    , edit : true
    , doc : Documentation FolderPublic
    , buttons : [ Add [FolderPublic]
    , Delete
    ]
    }
    settingsBox NodeList =
    SettingsBox { show : true
    , edit : true
    , doc : Documentation NodeList
    , buttons : [ ReloadWithSettings
    , Config
    , Upload
    , Download
    , Merge {subTreeParams : SubTreeParams { showtypes: [ FolderPrivate
    , FolderShared
    , Team
    , FolderPublic
    , Folder
    , Corpus
    , NodeList
    ]
    , valitypes: [ NodeList ]
    }
    }
    , Delete
    ]
    }
    settingsBox Dashboard =
    SettingsBox { show : true
    , edit : false
    , doc : Documentation Dashboard
    , buttons : [ ReloadWithSettings
    , Publish publishParams
    , Delete
    ]
    }
    settingsBox Annuaire =
    SettingsBox { show : true
    , edit : true
    , doc : Documentation Annuaire
    , buttons : [ Upload
    , AddingContact
    , Move moveParameters
    , Link (linkParams Corpus)
    , Delete
    ]
    }
    settingsBox Notes =
    SettingsBox { show : true
    , edit : true
    , doc : Documentation Notes
    , buttons : [ Add [ Notes
    , Calc
    , Folder
    , Corpus
    ]
    , Move moveFrameParameters
    , Delete
    ]
    }
    settingsBox Calc =
    SettingsBox { show : true
    , edit : true
    , doc : Documentation Calc
    , buttons : [ Upload
    , Add [ Calc
    , Notes
    ]
    , Move moveFrameParameters
    , Delete
    ]
    }
    settingsBox NodeFrameNotebook =
    SettingsBox { show : true
    , edit : true
    , doc : Documentation NodeFrameNotebook
    , buttons : [ Add [ Calc
    , Notes
    -- , NodeFrameNotebook
    ]
    , Move moveFrameParameters
    , Delete
    ]
    }
    settingsBox NodeFrameVisio =
    SettingsBox { show : true
    , edit : true
    , doc : Documentation NodeFrameVisio
    , buttons : [ Add [ NodeFrameVisio
    , Notes
    , Calc
    ]
    , Delete
    ]
    }
    settingsBox NodeFile =
    SettingsBox { show: true
    , edit: true
    , doc: Documentation NodeFile
    , buttons: [ Publish publishParams
    , Delete ]
    }
    settingsBox p = (settingsBoxLens p) $ defNt p
    settingsBoxLens :: NodeType -> (SettingsBox -> SettingsBox)
    settingsBoxLens Annuaire =
    _buttons .~ [ Upload
    , AddingContact
    , Move moveParameters
    , Link (linkParams Corpus)
    , Delete ]
    settingsBoxLens Calc =
    _buttons .~ [ Upload
    , Add [ Calc
    , Notes ]
    , Move moveFrameParameters
    , Delete ]
    settingsBoxLens Corpus =
    _buttons .~ [ Add [ Graph
    , Notes
    , Calc
    , NodeTexts
    , NodeList
    , Graph
    -- , Dashboard
    , Phylo
    -- , NodeFrameNotebook
    ]
    , Move moveParameters
    , Upload
    , SearchBox
    , WriteNodesDocuments
    -- , Download
    , Link (linkParams Annuaire)
    , Delete
    ]
    settingsBoxLens Dashboard =
    (_edit .~ false) <<<
    (_buttons .~ [ ReloadWithSettings
    , Publish publishParams
    , Delete
    ])
    settingsBoxLens Folder =
    _buttons .~ [ Add [ Notes
    , Corpus
    , Calc
    , Folder
    , Annuaire
    -- , NodeFrameNotebook
    ]
    , Move moveParameters
    , Delete
    ]
    settingsBoxLens FolderPrivate =
    (_edit .~ false) <<<
    (_buttons .~ [ Add [ Notes
    , Corpus
    , Calc
    , Folder
    , Annuaire
    -- , NodeFrameNotebook
    ]
    ])
    settingsBoxLens FolderPublic =
    _buttons .~ [ Add [ FolderPublic ]
    ]
    settingsBoxLens FolderShared =
    _buttons .~ [ Add [Team, FolderShared]
    ]
    settingsBoxLens Graph =
    _buttons .~ [ ReloadWithSettings
    , Config
    , Download -- TODO as GEXF or JSON
    -- , Publish publishParams
    , Delete
    ]
    settingsBoxLens NodeFile =
    _buttons .~ [ Publish publishParams
    , Delete ]
    settingsBoxLens NodeFrameNotebook =
    _buttons .~ [ Add [ Calc
    , Notes
    -- , NodeFrameNotebook
    ]
    , Move moveFrameParameters
    , Delete
    ]
    settingsBoxLens NodeFrameVisio =
    _buttons .~ [ Add [ NodeFrameVisio
    , Notes
    , Calc
    ]
    , Delete
    ]
    settingsBoxLens NodeList =
    _buttons .~ [ ReloadWithSettings
    , Config
    , Upload
    , Download
    , Merge {subTreeParams : SubTreeParams { showtypes: [ FolderPrivate
    , FolderShared
    , Team
    , FolderPublic
    , Folder
    , Corpus
    , NodeList
    ]
    , valitypes: [ NodeList ]
    }
    }
    , Delete
    ]
    settingsBoxLens (NodePublic Dashboard) =
    _buttons .~ [ Delete
    ]
    settingsBoxLens (NodePublic FolderPublic) =
    _buttons .~ [ Add [FolderPublic]
    , Delete
    ]
    settingsBoxLens (NodePublic Graph) =
    _buttons .~ [ Download -- TODO as GEXF or JSON
    , Delete
    ]
    settingsBoxLens (NodePublic NodeFile) =
    _buttons .~ [ Delete
    ]
    settingsBoxLens NodeTexts =
    _buttons .~ [ ReloadWithSettings
    , Upload
    , Download
    , Delete
    ]
    settingsBoxLens NodeUser =
    (_edit .~ false) <<<
    (_buttons .~ [ Delete
    ])
    settingsBoxLens Notes =
    _buttons .~ [ Add [ Notes
    , Calc
    , Folder
    , Corpus
    ]
    , Move moveFrameParameters
    , Delete
    ]
    settingsBoxLens Phylo =
    _buttons .~ [ Reconstruct
    , Delete
    ]
    settingsBoxLens Team =
    _buttons .~ [ Add [ Notes
    , Corpus
    , Calc
    , Folder
    , Team
    , Annuaire
    -- , NodeFrameNotebook
    -- , FolderShared
    , NodeFrameVisio
    ]
    , Share
    , ManageTeam
    , Delete
    ]
    settingsBoxLens _ =
    (_show .~ false) <<<
    (_edit .~ false)
    settingsBox _ =
    SettingsBox { show : false
    , edit : false
    , doc : Documentation NodeUser
    , buttons : []
    }
    -- | SubTree Parameters
    ......
    src/Gargantext/Config/REST.purs
    View file @ 81ad30d2
    ......@@ -79,9 +79,35 @@ data FrontendError =
    | 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
    show (EC_400__node_creation_failed_insert_node { user_id, parent_id }) =
    "Failed to insert node for user " <> show user_id <> ", parent " <> show parent_id
    show (EC_400__node_creation_failed_no_parent { user_id }) =
    "Failed to insert node for user " <> show user_id <> ": no parent"
    show (EC_400__node_creation_failed_parent_exists { user_id, parent_id }) =
    "Failed to insert node for user " <> show user_id <> ", parent " <> show parent_id <> " exists"
    show (EC_400__node_creation_failed_user_negative_id { user_id }) =
    "Failed to insert node for use " <> show user_id <> " (negative user_id)"
    show (EC_400__node_lookup_failed_user_too_many_roots { user_id, roots }) =
    "Failed to lookup node for user " <> show user_id <> ": too many roots (" <> show roots <> ")"
    show EC_400__node_needs_configuration = "Node needs configuration"
    show (EC_403__login_failed_error { node_id, user_id }) =
    "Login failed for node_id " <> show node_id <> ", user id " <> show user_id
    show EC_403__login_failed_invalid_username_or_password =
    "Invalid username or password"
    show (EC_404__node_context_not_found { context_id }) =
    "Context not found with id " <> show context_id
    show (EC_404__node_lookup_failed_not_found { node_id }) =
    "Node not found with id " <> show node_id
    show (EC_404__node_lookup_failed_parent_not_found { node_id }) =
    "Node parent not found for id " <> show node_id
    show (EC_404__node_lookup_failed_username_not_found { username }) =
    "User '" <> username <> "' not found"
    show (EC_404__node_list_not_found { list_id }) =
    "Node list not found for id " <> show list_id
    show EC_404__node_root_not_found = "Node root not found"
    show (EC_500__node_generic_exception { error }) =
    "Node exception: " <> error
    show EC_500__node_not_implemented_yet = "Node not implemented yet"
    instance JSON.ReadForeign FrontendError where
    readImpl f = do
    { type: type_ } <- JSON.readImpl f :: Foreign.F { type :: String }
    ......@@ -167,17 +193,6 @@ readJSON affResp =
    _ -> 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`
    ......
    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