Commit 59956b27 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[ERROR] More errors handled now thanks to ErrorMonad.

parent 3c85f903
Pipeline #93 canceled with stage
...@@ -271,12 +271,17 @@ instance HasNodeError ServantErr where ...@@ -271,12 +271,17 @@ instance HasNodeError ServantErr where
where where
e = "NodeError: " e = "NodeError: "
mk NoListFound = err404 { errBody = e <> "No list found" } 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 MkNode = err500 { errBody = e <> "Cannot mk node" }
mk NegativeId = err500 { errBody = e <> "Node Id non positive" } 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 HasParent = err500 { errBody = e <> "NodeType has parent" }
mk NotImplYet = err500 { errBody = e <> "Not implemented yet" } mk NotImplYet = err500 { errBody = e <> "Not implemented yet" }
mk ManyParents = err500 { errBody = e <> "Too many parents" } 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. -- TODO(orphan): There should be a proper APIError data type with a case TreeError.
instance HasTreeError ServantErr where instance HasTreeError ServantErr where
......
...@@ -38,7 +38,7 @@ import Gargantext.Database.Node.Document.Add (add) ...@@ -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.Node.Document.Insert (insertDocuments, ReturnId(..), addUniqIdsDoc, addUniqIdsContact, ToDbData(..))
import Gargantext.Database.Root (getRoot) import Gargantext.Database.Root (getRoot)
import Gargantext.Database.Schema.Ngrams (insertNgrams, Ngrams(..), NgramsT(..), NgramsIndexed(..), indexNgramsT, NgramsType(..), text2ngrams) 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.NodeNgram (NodeNgramPoly(..), insertNodeNgrams)
import Gargantext.Database.Schema.NodeNgramsNgrams (NodeNgramsNgramsPoly(..), insertNodeNgramsNgramsNew) import Gargantext.Database.Schema.NodeNgramsNgrams (NodeNgramsNgramsPoly(..), insertNodeNgramsNgramsNew)
import Gargantext.Database.Schema.User (getUser, UserLight(..)) import Gargantext.Database.Schema.User (getUser, UserLight(..))
...@@ -140,19 +140,19 @@ subFlowCorpus :: HasNodeError err => Username -> CorpusName -> Cmd err (UserId, ...@@ -140,19 +140,19 @@ subFlowCorpus :: HasNodeError err => Username -> CorpusName -> Cmd err (UserId,
subFlowCorpus username cName = do subFlowCorpus username cName = do
maybeUserId <- getUser username maybeUserId <- getUser username
let userId = case maybeUserId of userId <- case maybeUserId of
Nothing -> panic "Error: User does not exist (yet)" Nothing -> nodeError NoUser
-- mk NodeUser gargantua_id "Node Gargantua" -- mk NodeUser gargantua_id "Node Gargantua"
Just user -> userLight_id user Just user -> pure $ userLight_id user
rootId' <- map _node_id <$> getRoot username rootId' <- map _node_id <$> getRoot username
rootId'' <- case rootId' of rootId'' <- case rootId' of
[] -> mkRoot username userId [] -> mkRoot username userId
n -> case length n >= 2 of n -> case length n >= 2 of
True -> panic "Error: more than 1 userNode / user" True -> nodeError ManyNodeUsers
False -> pure rootId' False -> pure rootId'
let rootId = maybe (panic "error rootId") identity (head rootId'') rootId <- maybe (nodeError NoRootFound) pure (head rootId'')
corpusId'' <- if username == userMaster corpusId'' <- if username == userMaster
then do then do
...@@ -165,7 +165,7 @@ subFlowCorpus username cName = do ...@@ -165,7 +165,7 @@ subFlowCorpus username cName = do
then pure corpusId'' then pure corpusId''
else mkCorpus (Just cName) Nothing rootId userId 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)" printDebug "(username, userId, rootId, corpusId)"
(username, userId, rootId, corpusId) (username, userId, rootId, corpusId)
...@@ -176,23 +176,23 @@ subFlowAnnuaire :: HasNodeError err => Username -> CorpusName -> Cmd err (UserId ...@@ -176,23 +176,23 @@ subFlowAnnuaire :: HasNodeError err => Username -> CorpusName -> Cmd err (UserId
subFlowAnnuaire username _cName = do subFlowAnnuaire username _cName = do
maybeUserId <- getUser username maybeUserId <- getUser username
let userId = case maybeUserId of userId <- case maybeUserId of
Nothing -> panic "Error: User does not exist (yet)" Nothing -> nodeError NoUser
-- mk NodeUser gargantua_id "Node Gargantua" -- mk NodeUser gargantua_id "Node Gargantua"
Just user -> userLight_id user Just user -> pure $ userLight_id user
rootId' <- map _node_id <$> getRoot username rootId' <- map _node_id <$> getRoot username
rootId'' <- case rootId' of rootId'' <- case rootId' of
[] -> mkRoot username userId [] -> mkRoot username userId
n -> case length n >= 2 of n -> case length n >= 2 of
True -> panic "Error: more than 1 userNode / user" True -> nodeError ManyNodeUsers
False -> pure rootId' False -> pure rootId'
let rootId = maybe (panic "error rootId") identity (head rootId'') rootId <- maybe (nodeError NoRootFound) pure (head rootId'')
corpusId' <- mkAnnuaire rootId userId 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)" printDebug "(username, userId, rootId, corpusId)"
(username, userId, rootId, corpusId) (username, userId, rootId, corpusId)
......
...@@ -51,12 +51,16 @@ import Prelude hiding (null, id, map, sum) ...@@ -51,12 +51,16 @@ import Prelude hiding (null, id, map, sum)
------------------------------------------------------------------------ ------------------------------------------------------------------------
data NodeError = NoListFound data NodeError = NoListFound
| NoRootFound
| NoCorpusFound
| MkNode | MkNode
| UserNoParent | UserNoParent
| HasParent | HasParent
| ManyParents | ManyParents
| NegativeId | NegativeId
| NotImplYet | NotImplYet
| NoUser
| ManyNodeUsers
deriving (Show) deriving (Show)
class HasNodeError e where class HasNodeError e where
......
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