Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
153
Issues
153
List
Board
Labels
Milestones
Merge Requests
9
Merge Requests
9
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
haskell-gargantext
Commits
fcb2c87f
Commit
fcb2c87f
authored
Jun 01, 2023
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Plain Diff
Merge remote-tracking branch 'origin/213-dev-implement-json-errors' into dev
parents
aff1578e
f3e4c0e0
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
34 additions
and
16 deletions
+34
-16
Server.hs
src/Gargantext/API/Server.hs
+19
-7
Table.hs
src/Gargantext/API/Table.hs
+2
-4
Node.hs
src/Gargantext/Database/Query/Table/Node.hs
+1
-1
Error.hs
src/Gargantext/Database/Query/Table/Node/Error.hs
+12
-4
No files found.
src/Gargantext/API/Server.hs
View file @
fcb2c87f
...
...
@@ -17,7 +17,8 @@ module Gargantext.API.Server where
import
Control.Lens
((
^.
))
import
Control.Monad.Except
(
withExceptT
)
import
Control.Monad.Reader
(
runReaderT
)
import
Data.Text
(
Text
)
import
qualified
Data.Aeson
as
Aeson
import
Data.Text
(
Text
,
pack
)
import
Data.Version
(
showVersion
)
import
Servant
import
Servant.Swagger.UI
(
swaggerSchemaUIServer
)
...
...
@@ -63,24 +64,35 @@ server env = do
:<|>
hoistServerWithContext
(
Proxy
::
Proxy
GargAPI
)
(
Proxy
::
Proxy
AuthContext
)
transform
transform
JSON
(
serverGargAPI
(
env
^.
hasConfig
.
gc_url_backend_api
))
:<|>
hoistServerWithContext
(
Proxy
::
Proxy
GraphQL
.
API
)
(
Proxy
::
Proxy
AuthContext
)
transform
transform
JSON
GraphQL
.
api
:<|>
frontEndServer
where
transform
::
forall
a
.
GargM
Env
GargError
a
->
Handler
a
transform
=
Handler
.
withExceptT
showAsServantErr
.
(`
runReaderT
`
env
)
-- transform :: forall a. GargM Env GargError a -> Handler a
-- transform = Handler . withExceptT showAsServantErr . (`runReaderT` env)
transformJSON
::
forall
a
.
GargM
Env
GargError
a
->
Handler
a
transformJSON
=
Handler
.
withExceptT
showAsServantJSONErr
.
(`
runReaderT
`
env
)
showAsServantErr
::
GargError
->
ServerError
showAsServantErr
(
GargNodeError
err
@
NoListFound
)
=
err404
{
errBody
=
BL8
.
pack
$
show
err
}
showAsServantErr
(
GargNodeError
err
@
(
NoListFound
{})
)
=
err404
{
errBody
=
BL8
.
pack
$
show
err
}
showAsServantErr
(
GargNodeError
err
@
NoRootFound
)
=
err404
{
errBody
=
BL8
.
pack
$
show
err
}
showAsServantErr
(
GargNodeError
err
@
NoCorpusFound
)
=
err404
{
errBody
=
BL8
.
pack
$
show
err
}
showAsServantErr
(
GargNodeError
err
@
NoUserFound
)
=
err404
{
errBody
=
BL8
.
pack
$
show
err
}
showAsServantErr
(
GargNodeError
err
@
(
DoesNotExist
_
))
=
err404
{
errBody
=
BL8
.
pack
$
show
err
}
showAsServantErr
(
GargNodeError
err
@
(
DoesNotExist
{}
))
=
err404
{
errBody
=
BL8
.
pack
$
show
err
}
showAsServantErr
(
GargServerError
err
)
=
err
showAsServantErr
a
=
err500
{
errBody
=
BL8
.
pack
$
show
a
}
showAsServantJSONErr
::
GargError
->
ServerError
showAsServantJSONErr
(
GargNodeError
err
@
(
NoListFound
{}))
=
err404
{
errBody
=
Aeson
.
encode
err
}
showAsServantJSONErr
(
GargNodeError
err
@
NoRootFound
)
=
err404
{
errBody
=
Aeson
.
encode
err
}
showAsServantJSONErr
(
GargNodeError
err
@
NoCorpusFound
)
=
err404
{
errBody
=
Aeson
.
encode
err
}
showAsServantJSONErr
(
GargNodeError
err
@
NoUserFound
)
=
err404
{
errBody
=
Aeson
.
encode
err
}
showAsServantJSONErr
(
GargNodeError
err
@
(
DoesNotExist
{}))
=
err404
{
errBody
=
Aeson
.
encode
err
}
showAsServantJSONErr
(
GargServerError
err
)
=
err
showAsServantJSONErr
a
=
err500
{
errBody
=
Aeson
.
encode
$
Aeson
.
object
[
(
"error"
,
Aeson
.
String
$
pack
$
show
a
)
]
}
src/Gargantext/API/Table.hs
View file @
fcb2c87f
...
...
@@ -58,7 +58,6 @@ import Gargantext.Prelude
type
TableApi
=
Summary
"Table API"
:>
QueryParam
"tabType"
TabType
:>
QueryParam
"list"
ListId
:>
QueryParam
"limit"
Limit
:>
QueryParam
"offset"
Offset
:>
QueryParam
"orderBy"
OrderBy
...
...
@@ -105,14 +104,13 @@ tableApi id' = getTableApi id'
getTableApi
::
HasNodeError
err
=>
NodeId
->
Maybe
TabType
->
Maybe
ListId
->
Maybe
Limit
->
Maybe
Offset
->
Maybe
OrderBy
->
Maybe
Text
->
Maybe
Text
->
Cmd
err
(
HashedResponse
FacetTableResult
)
getTableApi
cId
tabType
_mListId
mLimit
mOffset
mOrderBy
mQuery
mYear
=
do
getTableApi
cId
tabType
mLimit
mOffset
mOrderBy
mQuery
mYear
=
do
-- printDebug "[getTableApi] mQuery" mQuery
-- printDebug "[getTableApi] mYear" mYear
t
<-
getTable
cId
tabType
mOffset
mLimit
mOrderBy
mQuery
mYear
...
...
@@ -129,7 +127,7 @@ postTableApi cId (TableQuery o l order ft q) = case ft of
getTableHashApi
::
HasNodeError
err
=>
NodeId
->
Maybe
TabType
->
Cmd
err
Text
getTableHashApi
cId
tabType
=
do
HashedResponse
{
hash
=
h
}
<-
getTableApi
cId
tabType
Nothing
Nothing
Nothing
Nothing
Nothing
Nothing
HashedResponse
{
hash
=
h
}
<-
getTableApi
cId
tabType
Nothing
Nothing
Nothing
Nothing
Nothing
pure
h
searchInCorpus'
::
CorpusId
...
...
src/Gargantext/Database/Query/Table/Node.hs
View file @
fcb2c87f
...
...
@@ -419,7 +419,7 @@ getOrMkList pId uId =
-- | TODO remove defaultList
defaultList
::
(
HasNodeError
err
,
HasDBid
NodeType
)
=>
CorpusId
->
Cmd
err
ListId
defaultList
cId
=
maybe
(
nodeError
NoListFound
)
(
pure
.
view
node_id
)
.
headMay
=<<
getListsWithParentId
cId
maybe
(
nodeError
(
NoListFound
cId
)
)
(
pure
.
view
node_id
)
.
headMay
=<<
getListsWithParentId
cId
defaultListMaybe
::
(
HasNodeError
err
,
HasDBid
NodeType
)
=>
CorpusId
->
Cmd
err
(
Maybe
NodeId
)
defaultListMaybe
cId
=
headMay
<$>
map
(
view
node_id
)
<$>
getListsWithParentId
cId
...
...
src/Gargantext/Database/Query/Table/Node/Error.hs
View file @
fcb2c87f
...
...
@@ -12,15 +12,16 @@ module Gargantext.Database.Query.Table.Node.Error where
import
Control.Lens
(
Prism
'
,
(
#
),
(
^?
))
import
Control.Monad.Except
(
MonadError
(
..
))
import
Data.Text
(
Text
)
import
Data.Aeson
import
Data.Text
(
Text
,
pack
)
import
Prelude
hiding
(
null
,
id
,
map
,
sum
)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
)
import
Gargantext.Database.Admin.Types.Node
(
ListId
,
NodeId
(
..
)
)
import
Gargantext.Prelude
hiding
(
sum
,
head
)
------------------------------------------------------------------------
data
NodeError
=
NoListFound
data
NodeError
=
NoListFound
{
listId
::
ListId
}
|
NoRootFound
|
NoCorpusFound
|
NoUserFound
...
...
@@ -37,7 +38,7 @@ data NodeError = NoListFound
instance
Show
NodeError
where
show
NoListFound
=
"No list found"
show
(
NoListFound
{})
=
"No list found"
show
NoRootFound
=
"No Root found"
show
NoCorpusFound
=
"No Corpus found"
show
NoUserFound
=
"No user found"
...
...
@@ -53,6 +54,13 @@ instance Show NodeError
show
NeedsConfiguration
=
"Needs configuration"
show
(
NodeError
e
)
=
"NodeError: "
<>
cs
e
instance
ToJSON
NodeError
where
toJSON
(
NoListFound
{
listId
=
NodeId
listId
})
=
object
[
(
"error"
,
"No list found"
)
,
(
"listId"
,
Number
$
fromIntegral
listId
)
]
toJSON
err
=
object
[
(
"error"
,
String
$
pack
$
show
err
)
]
class
HasNodeError
e
where
_NodeError
::
Prism'
e
NodeError
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment