Add treeErrorToFrontendError

src/Gargantext/API/Errors.hs

@@ -24,6 +24,7 @@ import Servant.Server
 import qualified Data.Aeson as JSON
 import qualified Network.HTTP.Types.Status as HTTP
 import qualified Data.Text as T
+import Gargantext.Database.Query.Tree hiding (treeError)
 
 $(deriveHttpStatusCode ''BackendErrorCode)
 
@@ -34,8 +35,8 @@ backendErrorToFrontendError :: BackendInternalError -> FrontendError
 backendErrorToFrontendError = \case
   InternalNodeError nodeError
     -> nodeErrorToFrontendError nodeError
-  InternalTreeError _treeError
-    -> undefined
+  InternalTreeError treeError
+    -> treeErrorToFrontendError treeError
   InternalValidationError _validationError
     -> undefined
   InternalJoseError _joseError
@@ -80,6 +81,12 @@ nodeErrorToFrontendError ne = case ne of
   QueryNoParse _txt
     -> undefined
 
+treeErrorToFrontendError :: TreeError -> FrontendError
+treeErrorToFrontendError te = case te of
+  NoRoot             -> mkFrontendErrShow FE_tree_error_root_not_found
+  EmptyRoot          -> mkFrontendErrShow FE_tree_error_empty_root
+  TooManyRoots roots -> mkFrontendErrShow $ FE_tree_error_too_many_roots roots
+
 -- | Converts a 'FrontendError' into a 'ServerError' that the servant app can
 -- return to the frontend.
 frontendErrorToServerError :: FrontendError -> ServerError

src/Gargantext/API/Errors/Types.hs

@@ -43,6 +43,7 @@ import Control.Lens (makePrisms)
 import Data.Aeson as JSON
 import Data.Aeson.Types (typeMismatch, emptyArray)
 import Data.Singletons.TH
+import Data.List.NonEmpty (NonEmpty)
 import Data.Typeable
 import Data.Validity (Validation)
 import GHC.Generics
@@ -65,6 +66,7 @@ import qualified Data.Text as T
 import qualified Gargantext.Utils.Jobs.Monad as Jobs
 import qualified Servant.Job.Types as SJ
 import Text.Read (readMaybe)
+import qualified Data.List.NonEmpty as NE
 
 -- | A 'WithStacktrace' carries an error alongside its
 -- 'CallStack', to be able to print the correct source location
@@ -193,7 +195,15 @@ data instance ToFrontendErrorData 'EC_404__node_error_not_found =
 --
 
 data instance ToFrontendErrorData 'EC_404__tree_error_root_not_found =
-  RootNotFound { _rnf_rootId :: RootId }
+  FE_tree_error_root_not_found
+  deriving (Show, Eq, Generic)
+
+data instance ToFrontendErrorData 'EC_404__tree_error_empty_root =
+  FE_tree_error_empty_root
+  deriving (Show, Eq, Generic)
+
+data instance ToFrontendErrorData 'EC_500__tree_error_too_many_roots =
+  FE_tree_error_too_many_roots { tmr_roots :: NonEmpty NodeId }
   deriving (Show, Eq, Generic)
 
 ----------------------------------------------------------------------------
@@ -238,12 +248,25 @@ instance FromJSON (ToFrontendErrorData 'EC_404__node_error_not_found) where
     pure FE_node_error_not_found{..}
 
 instance ToJSON (ToFrontendErrorData 'EC_404__tree_error_root_not_found) where
-  toJSON RootNotFound{..} = object [ "root_id" .= toJSON _rnf_rootId ]
+  toJSON _ = JSON.Null
 
 instance FromJSON (ToFrontendErrorData 'EC_404__tree_error_root_not_found) where
-  parseJSON = withObject "RootNotFound" $ \o -> do
-    _rnf_rootId <- o .: "root_id"
-    pure RootNotFound{..}
+  parseJSON _ = pure FE_tree_error_root_not_found
+
+instance ToJSON (ToFrontendErrorData 'EC_404__tree_error_empty_root) where
+  toJSON _ = JSON.Null
+
+instance FromJSON (ToFrontendErrorData 'EC_404__tree_error_empty_root) where
+  parseJSON _ = pure FE_tree_error_empty_root
+
+instance ToJSON (ToFrontendErrorData 'EC_500__tree_error_too_many_roots) where
+  toJSON (FE_tree_error_too_many_roots roots) =
+    object [ "node_ids" .= NE.toList roots ]
+
+instance FromJSON (ToFrontendErrorData 'EC_500__tree_error_too_many_roots) where
+  parseJSON = withObject "FE_tree_error_too_many_roots" $ \o -> do
+    tmr_roots <- o .: "node_ids"
+    pure FE_tree_error_too_many_roots{..}
 
 ----------------------------------------------------------------------------
 -- Arbitrary instances and test data generation
@@ -272,8 +295,12 @@ genFrontendErr be = do
 
     -- tree errors
     EC_404__tree_error_root_not_found
-      -> do rootId <- arbitrary
-            pure $ mkFrontendErr' txt (RootNotFound rootId)
+      -> pure $ mkFrontendErr' txt $ FE_tree_error_root_not_found
+    EC_404__tree_error_empty_root
+      -> pure $ mkFrontendErr' txt $ FE_tree_error_empty_root
+    EC_500__tree_error_too_many_roots
+      -> do nodes <- arbitrary
+            pure $ mkFrontendErr' txt $ FE_tree_error_too_many_roots nodes
 
 instance ToJSON BackendErrorCode where
   toJSON = JSON.String . T.pack . drop 3 . show
@@ -308,11 +335,17 @@ instance FromJSON FrontendError where
       EC_404__node_error_not_found -> do
         (fe_data :: ToFrontendErrorData 'EC_404__node_error_not_found) <- o .: "data"
         pure FrontendError{..}
+      EC_500__node_error_not_implemented_yet -> do
+        (fe_data :: ToFrontendErrorData 'EC_500__node_error_not_implemented_yet) <- o .: "data"
+        pure FrontendError{..}
 
       -- tree errors
       EC_404__tree_error_root_not_found -> do
         (fe_data :: ToFrontendErrorData 'EC_404__tree_error_root_not_found) <- o .: "data"
         pure FrontendError{..}
-      EC_500__node_error_not_implemented_yet -> do
-        (fe_data :: ToFrontendErrorData 'EC_500__node_error_not_implemented_yet) <- o .: "data"
+      EC_404__tree_error_empty_root -> do
+        (fe_data :: ToFrontendErrorData 'EC_404__tree_error_empty_root) <- o .: "data"
+        pure FrontendError{..}
+      EC_500__tree_error_too_many_roots -> do
+        (fe_data :: ToFrontendErrorData 'EC_500__tree_error_too_many_roots) <- o .: "data"
         pure FrontendError{..}

src/Gargantext/API/Errors/Types/Backend.hs

@@ -23,6 +23,8 @@ data BackendErrorCode
   | EC_500__node_error_not_implemented_yet
   -- tree errors
   | EC_404__tree_error_root_not_found
+  | EC_404__tree_error_empty_root
+  | EC_500__tree_error_too_many_roots
   deriving (Show, Read, Eq, Enum, Bounded)
 
 $(genSingletons [''BackendErrorCode])

src/Gargantext/Database/Query/Tree.hs

@@ -64,6 +64,7 @@ import Gargantext.Database.Query.Tree.Error
 import Gargantext.Database.Schema.Node (NodePoly(..))
 import Gargantext.Database.Schema.NodeNode (NodeNodePoly(..))
 import Gargantext.Prelude hiding (to)
+import qualified Data.List.NonEmpty as NE
 
 ------------------------------------------------------------------------
 data DbTreeNode = DbTreeNode { _dt_nodeId   :: NodeId
@@ -254,6 +255,9 @@ findNodesWithType root target through =
       isInTarget n = List.elem (fromDBid $ view dt_typeId n)
                    $ List.nub $ target <> through
 
+treeNodeToNodeId :: DbTreeNode -> NodeId
+treeNodeToNodeId = _dt_nodeId
+
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
 toTree :: ( MonadError e m
@@ -266,7 +270,7 @@ toTree m =
         Just [root] -> pure $ toTree' m root
         Nothing     -> treeError NoRoot
         Just []     -> treeError EmptyRoot
-        Just _r     -> treeError TooManyRoots
+        Just r      -> treeError $ TooManyRoots (NE.fromList $ map treeNodeToNodeId r)
 
       where
         toTree' :: Map (Maybe ParentId) [DbTreeNode]

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

@@ -15,19 +15,22 @@ module Gargantext.Database.Query.Tree.Error
   where
 
 import Control.Lens (Prism', (#))
+import Gargantext.Core.Types
 import Gargantext.Prelude
 import Prelude qualified
+import qualified Data.List.NonEmpty as NE
+import qualified Data.Text as T
 
 ------------------------------------------------------------------------
 data TreeError = NoRoot
                | EmptyRoot
-               | TooManyRoots
+               | TooManyRoots (NonEmpty NodeId)
 
 instance Prelude.Show TreeError
   where
-    show NoRoot       = "Root node not found"
-    show EmptyRoot    = "Root node should not be empty"
-    show TooManyRoots = "Too many root nodes"
+    show NoRoot               = "Root node not found"
+    show EmptyRoot            = "Root node should not be empty"
+    show (TooManyRoots roots) = "Too many root nodes: [" <> T.unpack (T.intercalate "," . map show $ NE.toList roots) <> "]"
 
 class HasTreeError e where
   _TreeError :: Prism' e TreeError