[DB/Errors] clean error messages and structure

src/Gargantext/API/Admin/Types.hs

@@ -41,7 +41,7 @@ import Gargantext.API.Admin.Settings
 import Gargantext.API.Ngrams
 import Gargantext.Core.Types
 import Gargantext.Database.Query.Tree
-import Gargantext.Database.Admin.Types.Errors (NodeError(..), HasNodeError(..))
+import Gargantext.Database.Query.Table.Node.Error (NodeError(..), HasNodeError(..))
 import Gargantext.Database.Prelude
 import Gargantext.Prelude
 import Servant

src/Gargantext/API/Corpus/Export.hs

@@ -41,7 +41,7 @@ import Gargantext.Database.Action.Metrics.NgramsByNode (getNgramsByNodeOnlyUser)
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Select (selectNodesWithUsername)
 import Gargantext.Database.Admin.Config (userMaster)
-import Gargantext.Database.Admin.Types.Errors (HasNodeError)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Admin.Types.Node (Node, HyperdataDocument(..), NodeId, ListId, CorpusId)
 import Gargantext.Database.Prelude (Cmd)
 import Gargantext.Database.Schema.Node (_node_id, _node_hyperdata)

src/Gargantext/API/Ngrams.hs

@@ -129,7 +129,7 @@ import Gargantext.Database.Action.Metrics.NgramsByNode (getOccByNgramsOnlyFast')
 import Gargantext.Database.Query.Table.Node.Select
 import Gargantext.Database.Query.Table.Ngrams hiding (NgramsType(..), ngrams, ngramsType, ngrams_terms)
 import Gargantext.Database.Admin.Config (userMaster)
-import Gargantext.Database.Admin.Types.Errors (HasNodeError)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Admin.Types.Node (NodeType(..))
 import Gargantext.Database.Prelude (fromField', HasConnectionPool)
 import Gargantext.Prelude

src/Gargantext/API/Node.hs

@@ -62,7 +62,7 @@ import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Query.Table.Node.User
 import Gargantext.Database.Query.Tree (treeDB)
 import Gargantext.Database.Admin.Config (nodeTypeId)
-import Gargantext.Database.Admin.Types.Errors (HasNodeError(..))
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude -- (Cmd, CmdM)
 import Gargantext.Database.Schema.Node (node_userId, _node_typename)
@@ -317,35 +317,6 @@ type TreeApi = Summary " Tree API"
 
 ------------------------------------------------------------------------
 
-{-
-NOTE: These instances are not necessary. However, these messages could be part
-      of a display function for NodeError/TreeError.
-instance HasNodeError ServantErr where
-  _NodeError = prism' mk (const Nothing) -- panic "HasNodeError ServantErr: not a prism")
-    where
-      e = "Gargantext 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 with negative Id" }
-      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"    }
-
-instance HasTreeError ServantErr where
-  _TreeError = prism' mk (const Nothing) -- panic "HasTreeError ServantErr: not a prism")
-    where
-      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   = QueryParams "type" NodeType :> Get '[JSON] (Tree NodeTree)
 
 treeAPI :: NodeId -> GargServer TreeAPI

src/Gargantext/Database/Action/Flow.hs

@@ -72,7 +72,7 @@ import Gargantext.Database.Query.Table.Node.Document.Insert -- (insertDocuments,
 import Gargantext.Database.Query.Tree.Root (getOrMkRoot, getOrMk_RootWithCorpus)
 import Gargantext.Database.Action.Search (searchInDatabase)
 import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
-import Gargantext.Database.Admin.Types.Errors (HasNodeError(..))
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Database.Admin.Types.Node -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
 import Gargantext.Database.Prelude (Cmd)
 import Gargantext.Database.Query.Table.Ngrams

src/Gargantext/Database/Action/Flow/Types.hs

@@ -28,7 +28,7 @@ import Gargantext.Core.Flow.Types
 import Gargantext.Text
 import Gargantext.Text.Terms
 import Gargantext.API.Ngrams (HasRepoVar, RepoCmdM)
-import Gargantext.Database.Admin.Types.Errors (HasNodeError)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Prelude (CmdM)
 import Gargantext.Database.Query.Table.Node.Document.Insert
 

src/Gargantext/Database/Action/Flow/Utils.hs

@@ -21,7 +21,7 @@ import Data.Map (Map)
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.User
-import Gargantext.Database.Admin.Types.Errors
+import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude (Cmd)
 import Gargantext.Database.Schema.Ngrams

src/Gargantext/Database/Query.hs

@@ -30,7 +30,7 @@ module Gargantext.Database.Query
 import Gargantext.Core.Types (Name)
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.User
-import Gargantext.Database.Admin.Types.Errors
+import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude (Cmd)
 import Prelude hiding (null, id, map, sum)
@@ -71,8 +71,8 @@ mkNodeWithParent NodeFolderPublic (Just i) uId _ =
     where
       hd = defaultFolder
 
-mkNodeWithParent NodeTeam (Just i) uId _ =
-   insertNodesWithParentR (Just i) [node NodeTeam "Team" hd Nothing uId]
+mkNodeWithParent NodeTeam (Just i) uId name =
+   insertNodesWithParentR (Just i) [node NodeTeam name hd Nothing uId]
     where
       hd = defaultFolder
 ------------------------------------------------------------------------
@@ -86,12 +86,10 @@ mkNodeWithParent NodeAnnuaire (Just i) uId name =
     where
       hd = defaultAnnuaire
 
-{-
 mkNodeWithParent NodeList (Just i) uId name =
    insertNodesWithParentR (Just i) [node NodeList name hd Nothing uId]
     where
-      hd = defaultList
--}
+      hd = defaultAnnuaire
 
 mkNodeWithParent _ _ _ _       = nodeError NotImplYet
 

src/Gargantext/Database/Query/Table/Node.hs

 {-|
+import Gargantext.Database.Prelude (Cmd, runPGSQuery)
 Module      : Gargantext.Database.Query.Table.Node
 Description : Main Tools of Node to the database
 Copyright   : (c) CNRS, 2017-Present
@@ -36,7 +37,7 @@ import GHC.Int (Int64)
 import Gargantext.Core.Types
 import Gargantext.Database.Query.Filter (limit', offset')
 import Gargantext.Database.Admin.Config (nodeTypeId)
-import Gargantext.Database.Admin.Types.Errors
+import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Database.Admin.Types.Node (NodeType(..), defaultCorpus, Hyperdata, HyperData(..))
 import Gargantext.Database.Prelude
 import Gargantext.Database.Query.Table.Node.Contact (HyperdataContact(..), arbitraryHyperdataContact)
@@ -57,7 +58,6 @@ selectNode id = proc () -> do
     restrict -< _node_id row .== id
     returnA -< row
 
-
 runGetNodes :: Query NodeRead -> Cmd err [Node HyperdataAny]
 runGetNodes = runOpaQuery
 
@@ -341,6 +341,7 @@ post c uid pid [ Node' NodeCorpus "name" "{}" []
 -- TODO
 -- currently this function removes the child relation
 -- needs a Temporary type between Node' and NodeWriteT
+
 node2table :: UserId -> Maybe ParentId -> Node' -> NodeWrite
 node2table uid pid (Node' nt txt v []) = Node Nothing (pgInt4 $ nodeTypeId nt) (pgInt4 uid) (fmap pgNodeId pid) (pgStrictText txt) Nothing (pgStrictJSONB $ cs $ encode v)
 node2table _ _ (Node' _ _ _ _) = panic "node2table: should not happen, Tree insert not implemented yet"

src/Gargantext/Database/Admin/Types/Errors.hs → src/Gargantext/Database/Query/Table/Node/Error.hs

 {-|
-Module      : Gargantext.Database.Types.Errors
-Description : Main requests of Node to the database
+Module      : Gargantext.Database.Types.Error
+Description :
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
 Maintainer  : team@gargantext.org
@@ -24,7 +24,7 @@ Portability : POSIX
 {-# LANGUAGE TemplateHaskell        #-}
 {-# LANGUAGE TypeFamilies           #-}
 
-module Gargantext.Database.Admin.Types.Errors where
+module Gargantext.Database.Query.Table.Node.Error where
 
 import Control.Lens (Prism', (#), (^?))
 import Control.Monad.Error.Class (MonadError(..))
@@ -43,12 +43,28 @@ data NodeError = NoListFound
                | NegativeId
                | NotImplYet
                | ManyNodeUsers
-  deriving (Show)
+
+instance Show NodeError
+  where
+    show NoListFound   = "No list   found"
+    show NoRootFound   = "No Root   found"
+    show NoCorpusFound = "No Corpus found"
+    show NoUserFound   = "No user   found"
+
+    show MkNode        = "Cannot make node"
+    show NegativeId    = "Node with negative Id"
+    show UserNoParent  = "Should not have parent"
+    show HasParent     = "NodeType has parent"
+    show NotImplYet    = "Not implemented yet"
+    show ManyParents   = "Too many parents"
+    show ManyNodeUsers = "Many userNode/user"
 
 class HasNodeError e where
   _NodeError :: Prism' e NodeError
 
-nodeError :: (MonadError e m, HasNodeError e) => NodeError -> m a
+nodeError :: ( MonadError e m
+             , HasNodeError e)
+          => NodeError -> m a
 nodeError ne = throwError $ _NodeError # ne
 
 catchNodeError :: (MonadError e m, HasNodeError e) => m a -> (NodeError -> m a) -> m a

src/Gargantext/Database/Query/Tree.hs

@@ -19,10 +19,15 @@ Let a Root Node, return the Tree of the Node as a directed acyclic graph
 {-# LANGUAGE RankNTypes        #-}
 
 module Gargantext.Database.Query.Tree
+  ( module Gargantext.Database.Query.Tree.Error
+  , isDescendantOf
+  , isIn
+  , treeDB
+  )
   where
 
-import Control.Lens (Prism', (#), (^..), at, each, _Just, to)
-import Control.Monad.Error.Class (MonadError(throwError))
+import Control.Lens ((^..), at, each, _Just, to)
+import Control.Monad.Error.Class (MonadError())
 import Data.Map (Map, fromListWith, lookup)
 import Data.Text (Text)
 import Database.PostgreSQL.Simple
@@ -32,28 +37,16 @@ import Gargantext.Database.Admin.Types.Node -- (pgNodeId, NodeType(..))
 import Gargantext.Database.Admin.Config (fromNodeTypeId, nodeTypeId)
 import Gargantext.Database.Admin.Types.Node (NodeId, NodeType, DocId, allNodeTypes)
 import Gargantext.Database.Prelude (Cmd, runPGSQuery)
+import Gargantext.Database.Query.Tree.Error
 import Gargantext.Prelude
 
 ------------------------------------------------------------------------
 -- TODO more generic find fun
-findCorpus :: RootId -> Cmd err (Maybe CorpusId)
-findCorpus r = do
+_findCorpus :: RootId -> Cmd err (Maybe CorpusId)
+_findCorpus r = do
   _mapNodes <- toTreeParent <$> dbTree r []
   pure Nothing
 
-------------------------------------------------------------------------
-data TreeError = NoRoot | EmptyRoot | TooManyRoots
-  deriving (Show)
-
-class HasTreeError e where
-  _TreeError :: Prism' e TreeError
-
-treeError :: ( MonadError e m
-             , HasTreeError e)
-             => TreeError
-             -> m a
-treeError te = throwError $ _TreeError # te
-
 -- | Returns the Tree of Nodes in Database
 treeDB :: HasTreeError err
        => RootId

src/Gargantext/Database/Query/Tree/Error.hs

+{-|
+Module      : Gargantext.Database.Tree.Error
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes       #-}
+{-# LANGUAGE RankNTypes        #-}
+
+module Gargantext.Database.Query.Tree.Error
+  where
+
+import Control.Lens (Prism', (#))
+import Control.Monad.Error.Class (MonadError(throwError))
+import Gargantext.Prelude
+
+------------------------------------------------------------------------
+data TreeError = NoRoot
+               | EmptyRoot
+               | TooManyRoots
+
+instance Show TreeError
+  where
+    show NoRoot       = "Root node not found"
+    show EmptyRoot    = "Root node should not be empty"
+    show TooManyRoots = "Too many root nodes"
+
+class HasTreeError e where
+  _TreeError :: Prism' e TreeError
+
+treeError :: ( MonadError e m
+             , HasTreeError e)
+             => TreeError
+             -> m a
+treeError te = throwError $ _TreeError # te
+

src/Gargantext/Database/Query/Tree/Root.hs

@@ -32,7 +32,7 @@ import Control.Arrow (returnA)
 import Gargantext.Core.Types.Main (CorpusName)
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Admin.Config (nodeTypeId, userMaster)
-import Gargantext.Database.Admin.Types.Errors
+import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.User (HyperdataUser)

src/Gargantext/Viz/Graph/API.hs

@@ -51,7 +51,7 @@ import Gargantext.Database.Schema.Ngrams
 import Gargantext.Database.Query.Table.Node.Select
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.User
-import Gargantext.Database.Admin.Types.Errors (HasNodeError)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Prelude (Cmd)