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
147
Issues
147
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
59956b27
Commit
59956b27
authored
Jan 04, 2019
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[ERROR] More errors handled now thanks to ErrorMonad.
parent
3c85f903
Pipeline
#93
canceled with stage
Changes
3
Pipelines
1
Show whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
30 additions
and
21 deletions
+30
-21
Node.hs
src/Gargantext/API/Node.hs
+12
-7
Flow.hs
src/Gargantext/Database/Flow.hs
+14
-14
Node.hs
src/Gargantext/Database/Schema/Node.hs
+4
-0
No files found.
src/Gargantext/API/Node.hs
View file @
59956b27
...
...
@@ -271,12 +271,17 @@ instance HasNodeError ServantErr where
where
e
=
"NodeError: "
mk
NoListFound
=
err404
{
errBody
=
e
<>
"No list found"
}
mk
NoRootFound
=
err404
{
errBody
=
e
<>
"No Root found"
}
mk
NoCorpusFound
=
err404
{
errBody
=
e
<>
"No Corpus found"
}
mk
NoUserFound
=
err404
{
errBody
=
e
<>
"No User found"
}
mk
MkNode
=
err500
{
errBody
=
e
<>
"Cannot mk node"
}
mk
NegativeId
=
err500
{
errBody
=
e
<>
"Node Id non positive"
}
mk
UserNoParent
=
err500
{
errBody
=
e
<>
"Should not have parent"
}
mk
UserNoParent
=
err500
{
errBody
=
e
<>
"Should not have parent"
}
mk
HasParent
=
err500
{
errBody
=
e
<>
"NodeType has parent"
}
mk
NotImplYet
=
err500
{
errBody
=
e
<>
"Not implemented yet"
}
mk
ManyParents
=
err500
{
errBody
=
e
<>
"Too many parents"
}
mk
ManyNodeUsers
=
err500
{
errBody
=
e
<>
"Many userNode/user"
}
-- TODO(orphan): There should be a proper APIError data type with a case TreeError.
instance
HasTreeError
ServantErr
where
...
...
src/Gargantext/Database/Flow.hs
View file @
59956b27
...
...
@@ -38,7 +38,7 @@ import Gargantext.Database.Node.Document.Add (add)
import
Gargantext.Database.Node.Document.Insert
(
insertDocuments
,
ReturnId
(
..
),
addUniqIdsDoc
,
addUniqIdsContact
,
ToDbData
(
..
))
import
Gargantext.Database.Root
(
getRoot
)
import
Gargantext.Database.Schema.Ngrams
(
insertNgrams
,
Ngrams
(
..
),
NgramsT
(
..
),
NgramsIndexed
(
..
),
indexNgramsT
,
NgramsType
(
..
),
text2ngrams
)
import
Gargantext.Database.Schema.Node
(
mkRoot
,
mkCorpus
,
getOrMkList
,
mkGraph
,
mkDashboard
,
mkAnnuaire
,
getCorporaWithParentId
,
HasNodeError
)
import
Gargantext.Database.Schema.Node
(
mkRoot
,
mkCorpus
,
getOrMkList
,
mkGraph
,
mkDashboard
,
mkAnnuaire
,
getCorporaWithParentId
,
HasNodeError
,
NodeError
(
..
),
nodeError
)
import
Gargantext.Database.Schema.NodeNgram
(
NodeNgramPoly
(
..
),
insertNodeNgrams
)
import
Gargantext.Database.Schema.NodeNgramsNgrams
(
NodeNgramsNgramsPoly
(
..
),
insertNodeNgramsNgramsNew
)
import
Gargantext.Database.Schema.User
(
getUser
,
UserLight
(
..
))
...
...
@@ -140,19 +140,19 @@ subFlowCorpus :: HasNodeError err => Username -> CorpusName -> Cmd err (UserId,
subFlowCorpus
username
cName
=
do
maybeUserId
<-
getUser
username
let
userId
=
case
maybeUserId
of
Nothing
->
panic
"Error: User does not exist (yet)"
userId
<-
case
maybeUserId
of
Nothing
->
nodeError
NoUser
-- mk NodeUser gargantua_id "Node Gargantua"
Just
user
->
userLight_id
user
Just
user
->
pure
$
userLight_id
user
rootId'
<-
map
_node_id
<$>
getRoot
username
rootId''
<-
case
rootId'
of
[]
->
mkRoot
username
userId
n
->
case
length
n
>=
2
of
True
->
panic
"Error: more than 1 userNode / user"
True
->
nodeError
ManyNodeUsers
False
->
pure
rootId'
let
rootId
=
maybe
(
panic
"error rootId"
)
identity
(
head
rootId''
)
rootId
<-
maybe
(
nodeError
NoRootFound
)
pure
(
head
rootId''
)
corpusId''
<-
if
username
==
userMaster
then
do
...
...
@@ -165,7 +165,7 @@ subFlowCorpus username cName = do
then
pure
corpusId''
else
mkCorpus
(
Just
cName
)
Nothing
rootId
userId
let
corpusId
=
maybe
(
panic
"error corpusId"
)
identity
(
head
corpusId'
)
corpusId
<-
maybe
(
nodeError
NoCorpusFound
)
pure
(
head
corpusId'
)
printDebug
"(username, userId, rootId, corpusId)"
(
username
,
userId
,
rootId
,
corpusId
)
...
...
@@ -176,23 +176,23 @@ subFlowAnnuaire :: HasNodeError err => Username -> CorpusName -> Cmd err (UserId
subFlowAnnuaire
username
_cName
=
do
maybeUserId
<-
getUser
username
let
userId
=
case
maybeUserId
of
Nothing
->
panic
"Error: User does not exist (yet)"
userId
<-
case
maybeUserId
of
Nothing
->
nodeError
NoUser
-- mk NodeUser gargantua_id "Node Gargantua"
Just
user
->
userLight_id
user
Just
user
->
pure
$
userLight_id
user
rootId'
<-
map
_node_id
<$>
getRoot
username
rootId''
<-
case
rootId'
of
[]
->
mkRoot
username
userId
n
->
case
length
n
>=
2
of
True
->
panic
"Error: more than 1 userNode / user"
True
->
nodeError
ManyNodeUsers
False
->
pure
rootId'
let
rootId
=
maybe
(
panic
"error rootId"
)
identity
(
head
rootId''
)
rootId
<-
maybe
(
nodeError
NoRootFound
)
pure
(
head
rootId''
)
corpusId'
<-
mkAnnuaire
rootId
userId
let
corpusId
=
maybe
(
panic
"error corpusId"
)
identity
(
head
corpusId'
)
corpusId
<-
maybe
(
nodeError
NoCorpusFound
)
pure
(
head
corpusId'
)
printDebug
"(username, userId, rootId, corpusId)"
(
username
,
userId
,
rootId
,
corpusId
)
...
...
src/Gargantext/Database/Schema/Node.hs
View file @
59956b27
...
...
@@ -51,12 +51,16 @@ import Prelude hiding (null, id, map, sum)
------------------------------------------------------------------------
data
NodeError
=
NoListFound
|
NoRootFound
|
NoCorpusFound
|
MkNode
|
UserNoParent
|
HasParent
|
ManyParents
|
NegativeId
|
NotImplYet
|
NoUser
|
ManyNodeUsers
deriving
(
Show
)
class
HasNodeError
e
where
...
...
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