Commit 385d4328 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[HANDLING] Error, prism for ServantErr.

parent 2fb1a0fa
Pipeline #95 canceled with stage
...@@ -267,7 +267,7 @@ graphAPI nId = do ...@@ -267,7 +267,7 @@ graphAPI nId = do
-- TODO what do we get about the node? to replace contextText -- TODO what do we get about the node? to replace contextText
instance HasNodeError ServantErr where 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 where
e = "NodeError: " e = "NodeError: "
mk NoListFound = err404 { errBody = e <> "No list found" } mk NoListFound = err404 { errBody = e <> "No list found" }
...@@ -276,7 +276,7 @@ instance HasNodeError ServantErr where ...@@ -276,7 +276,7 @@ instance HasNodeError ServantErr where
mk NoUserFound = err404 { errBody = e <> "No User 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 with negative Id" }
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" }
...@@ -285,7 +285,7 @@ instance HasNodeError ServantErr where ...@@ -285,7 +285,7 @@ instance HasNodeError ServantErr where
-- 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
_TreeError = prism' mk (const $ panic "HasTreeError ServantErr: not a prism") _TreeError = prism' mk (const Nothing) -- $ panic "HasTreeError ServantErr: not a prism")
where where
e = "TreeError: " e = "TreeError: "
mk NoRoot = err404 { errBody = e <> "Root node not found" } mk NoRoot = err404 { errBody = e <> "Root node not found" }
......
...@@ -526,7 +526,7 @@ mkCorpus n h p u = insertNodesR [nodeCorpusW n h p u] ...@@ -526,7 +526,7 @@ mkCorpus n h p u = insertNodesR [nodeCorpusW n h p u]
getOrMkList :: HasNodeError err => ParentId -> UserId -> Cmd err Int getOrMkList :: HasNodeError err => ParentId -> UserId -> Cmd err Int
getOrMkList pId uId = getOrMkList pId uId =
defaultList pId `catchNodeError` 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 :: HasNodeError err => CorpusId -> Cmd err ListId
defaultList cId = defaultList cId =
......
...@@ -37,6 +37,7 @@ import Database.PostgreSQL.Simple.FromField ( Conversion, ResultError(Conversion ...@@ -37,6 +37,7 @@ import Database.PostgreSQL.Simple.FromField ( Conversion, ResultError(Conversion
import Database.PostgreSQL.Simple.Internal (Field) import Database.PostgreSQL.Simple.Internal (Field)
import Gargantext.Prelude import Gargantext.Prelude
import Opaleye (Query, Unpackspec, showSqlForPostgres, FromFields, Select, runQuery) import Opaleye (Query, Unpackspec, showSqlForPostgres, FromFields, Select, runQuery)
import Servant (ServantErr)
import System.IO (FilePath) import System.IO (FilePath)
import Text.Read (read) import Text.Read (read)
import qualified Data.ByteString as DB import qualified Data.ByteString as DB
...@@ -72,6 +73,11 @@ runCmdDev f = do ...@@ -72,6 +73,11 @@ runCmdDev f = do
conn <- connectGargandb "gargantext.ini" conn <- connectGargandb "gargantext.ini"
either (fail . show) pure =<< runCmd conn f 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 -- Use only for dev
runCmdDevNoErr :: Cmd () a -> IO a runCmdDevNoErr :: Cmd () a -> IO a
runCmdDevNoErr = runCmdDev runCmdDevNoErr = runCmdDev
......
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