[ERRORS] Handling: adding some errors in DB.

src/Gargantext/API/Node.hs

@@ -269,16 +269,23 @@ graphAPI nId = do
 instance HasNodeError ServantErr where
   _NodeError = prism' mk (const $ panic "HasNodeError ServantErr: not a prism")
     where
-      mk NoListFound = err404 { errBody = "NodeError: No list found" }
-      mk MkNodeError = err404 { errBody = "NodeError: Cannot mk node" }
+      e = "NodeError: "
+      mk NoListFound = err404 { errBody = e <> "No list 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 HasParent   = err500 { errBody = e <> "NodeType has parent"   }
+      mk NotImplYet  = err500 { errBody = e <> "Not implemented yet"   }
+      mk ManyParents = err500 { errBody = e <> "Too many parents"      }
 
 -- TODO(orphan): There should be a proper APIError data type with a case TreeError.
 instance HasTreeError ServantErr where
   _TreeError = prism' mk (const $ panic "HasTreeError ServantErr: not a prism")
     where
-      mk NoRoot       = err404 { errBody = "Root node not found"           }
-      mk EmptyRoot    = err500 { errBody = "Root node should not be empty" }
-      mk TooManyRoots = err500 { errBody = "Too many root nodes"           }
+      e = "TreeError: "
+      mk NoRoot       = err404 { errBody = e <> "Root node not found"           }
+      mk EmptyRoot    = err500 { errBody = e <> "Root node should not be empty" }
+      mk TooManyRoots = err500 { errBody = e <> "Too many root nodes"           }
 
 type TreeAPI   = Get '[JSON] (Tree NodeTree)
 treeAPI :: NodeId -> GargServer TreeAPI

src/Gargantext/Database/Schema/Node.hs

@@ -50,7 +50,13 @@ import Prelude hiding (null, id, map, sum)
 
 ------------------------------------------------------------------------
 
-data NodeError = NoListFound | MkNodeError
+data NodeError = NoListFound
+               | MkNode
+               | UserNoParent
+               | HasParent
+               | ManyParents
+               | NegativeId
+               | NotImplYet
   deriving (Show)
 
 class HasNodeError e where
@@ -415,7 +421,7 @@ insertNodes ns = mkCmd $ \conn -> runInsertMany conn nodeTable ns
 
 insertNodesR :: [NodeWrite] -> Cmd err [Int]
 insertNodesR ns = mkCmd $ \conn ->
-  runInsert_ conn (Insert nodeTable ns (rReturning (\(Node i _ _ _ _ _ __) -> i)) Nothing)
+  runInsert_ conn (Insert nodeTable ns (rReturning (\(Node i _ _ _ _ _ _) -> i)) Nothing)
 
 insertNodesWithParent :: Maybe ParentId -> [NodeWrite] -> Cmd err Int64
 insertNodesWithParent pid ns = insertNodes (set node_parentId (pgInt4 <$> pid) <$> ns)
@@ -462,12 +468,12 @@ data NewNode = NewNode { _newNodeId :: Int
                        , _newNodeChildren :: [Int] }
 
 -- | postNode
-postNode :: UserId -> Maybe ParentId -> Node' -> Cmd err NewNode
+postNode :: HasNodeError err => UserId -> Maybe ParentId -> Node' -> Cmd err NewNode
 postNode uid pid (Node' nt txt v []) = do
   pids <- mkNodeR [node2table uid pid (Node' nt txt v [])]
   case pids of
     [pid] -> pure $ NewNode pid []
-    _ -> panic "postNode: only one pid expected"
+    _ -> nodeError ManyParents
 
 postNode uid pid (Node' NodeCorpus txt v ns) = do
   NewNode pid' _ <- postNode uid pid (Node' NodeCorpus txt v [])
@@ -478,7 +484,7 @@ postNode uid pid (Node' NodeAnnuaire txt v ns) = do
   NewNode pid' _ <- postNode uid pid (Node' NodeAnnuaire txt v [])
   pids  <- mkNodeR (concat $ map (\n -> [childWith uid pid' n]) ns)
   pure $ NewNode pid' pids
-postNode _ _ (Node' _ _ _ _) = panic "TODO: postNode for this type not implemented yet"
+postNode _ _ (Node' _ _ _ _) = nodeError NotImplYet
 
 
 childWith :: UserId -> ParentId -> Node' -> NodeWrite
@@ -487,7 +493,6 @@ childWith uId pId (Node' NodeContact  txt v []) = node2table uId (Just pId) (Nod
 childWith _   _   (Node' _        _   _ _) = panic "This NodeType can not be a child"
 
 
-
 mk :: NodeType -> Maybe ParentId -> Text -> Cmd err [Int]
 mk nt pId name  = mk' nt userId pId name
   where
@@ -500,15 +505,15 @@ mk' nt uId pId name  = map fromIntegral <$> insertNodesWithParentR pId [node nt
 
 type Name = Text
 
-mk'' :: NodeType -> Maybe ParentId -> UserId -> Name -> Cmd err [Int]
+mk'' :: HasNodeError err => NodeType -> Maybe ParentId -> UserId -> Name -> Cmd err [Int]
 mk'' NodeUser Nothing uId name  = mk' NodeUser uId Nothing name
-mk'' NodeUser _       _   _     = panic "NodeUser do not have any parent"
-mk'' _        Nothing _   _     = panic "NodeType does   have a   parent"
+mk'' NodeUser _       _   _     = nodeError UserNoParent
+mk'' _        Nothing _   _     = nodeError HasParent
 mk'' nt       pId     uId name  = mk' nt uId pId name
 
-mkRoot :: Username -> UserId -> Cmd err [Int]
+mkRoot :: HasNodeError err => Username -> UserId -> Cmd err [Int]
 mkRoot uname uId = case uId > 0 of
-               False -> panic "UserId <= 0"
+               False -> nodeError NegativeId
                True  -> mk'' NodeUser Nothing uId uname
 
 mkCorpus :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> Cmd err [Int]
@@ -516,9 +521,8 @@ mkCorpus n h p u = insertNodesR [nodeCorpusW n h p u]
 
 getOrMkList :: HasNodeError err => ParentId -> UserId -> Cmd err Int
 getOrMkList pId uId =
-  defaultList pId
-    `catchNodeError`
-  (\_ -> maybe (nodeError MkNodeError) pure . headMay =<< mkList pId uId)
+  defaultList pId `catchNodeError`
+  (\_ -> maybe (nodeError MkNode) pure . headMay =<< mkList pId uId)
 
 defaultList :: HasNodeError err => CorpusId -> Cmd err ListId
 defaultList cId =