From 385d4328e33ad8775ed2b11e6923d84fc24690af Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Alexandre=20Delano=C3=AB?= <devel+git@delanoe.org>
Date: Fri, 4 Jan 2019 16:41:57 +0100
Subject: [PATCH] [HANDLING] Error, prism for ServantErr.
---
src/Gargantext/API/Node.hs | 6 +++---
src/Gargantext/Database/Schema/Node.hs | 2 +-
src/Gargantext/Database/Utils.hs | 6 ++++++
3 files changed, 10 insertions(+), 4 deletions(-)
diff --git a/src/Gargantext/API/Node.hs b/src/Gargantext/API/Node.hs
index 05ab712e..4a637f0f 100644
--- a/src/Gargantext/API/Node.hs
+++ b/src/Gargantext/API/Node.hs
@@ -267,7 +267,7 @@ graphAPI nId = do
-- TODO what do we get about the node? to replace contextText
instance HasNodeError ServantErr where
- _NodeError = prism' mk (const $ panic "HasNodeError ServantErr: not a prism")
+ _NodeError = prism' mk (const Nothing) -- $ panic "HasNodeError ServantErr: not a prism")
where
e = "NodeError: "
mk NoListFound = err404 { errBody = e <> "No list found" }
@@ -276,7 +276,7 @@ instance HasNodeError ServantErr where
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 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" }
@@ -285,7 +285,7 @@ instance HasNodeError ServantErr where
-- 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")
+ _TreeError = prism' mk (const Nothing) -- $ panic "HasTreeError ServantErr: not a prism")
where
e = "TreeError: "
mk NoRoot = err404 { errBody = e <> "Root node not found" }
diff --git a/src/Gargantext/Database/Schema/Node.hs b/src/Gargantext/Database/Schema/Node.hs
index 3cb939b1..07475b35 100644
--- a/src/Gargantext/Database/Schema/Node.hs
+++ b/src/Gargantext/Database/Schema/Node.hs
@@ -526,7 +526,7 @@ 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 MkNode) pure . headMay =<< mkList pId uId)
+ (\x -> maybe (nodeError x) pure . headMay =<< mkList pId uId)
defaultList :: HasNodeError err => CorpusId -> Cmd err ListId
defaultList cId =
diff --git a/src/Gargantext/Database/Utils.hs b/src/Gargantext/Database/Utils.hs
index 5d07ad0c..60206170 100644
--- a/src/Gargantext/Database/Utils.hs
+++ b/src/Gargantext/Database/Utils.hs
@@ -37,6 +37,7 @@ import Database.PostgreSQL.Simple.FromField ( Conversion, ResultError(Conversion
import Database.PostgreSQL.Simple.Internal (Field)
import Gargantext.Prelude
import Opaleye (Query, Unpackspec, showSqlForPostgres, FromFields, Select, runQuery)
+import Servant (ServantErr)
import System.IO (FilePath)
import Text.Read (read)
import qualified Data.ByteString as DB
@@ -72,6 +73,11 @@ runCmdDev f = do
conn <- connectGargandb "gargantext.ini"
either (fail . show) pure =<< runCmd conn f
+runCmdDev' :: Cmd ServantErr a -> IO a
+runCmdDev' f = do
+ conn <- connectGargandb "gargantext.ini"
+ either (fail . show) pure =<< runCmd conn f
+
-- Use only for dev
runCmdDevNoErr :: Cmd () a -> IO a
runCmdDevNoErr = runCmdDev
--
2.21.0