Fix runPGSQuery exception handling

parent 72ba377f
Pipeline #306 failed with stage
......@@ -35,7 +35,6 @@ module Gargantext.API.Ngrams
where
-- import Debug.Trace (trace)
import Control.Exception (Exception)
import Prelude (Enum, Bounded, Semigroup(..), minBound, maxBound {-, round-}, error)
-- import Gargantext.Database.Schema.User (UserId)
import Data.Functor (($>))
......@@ -894,7 +893,7 @@ type MaxSize = Int
-- TODO: polymorphic for Annuaire or Corpus or ...
-- | Table of Ngrams is a ListNgrams formatted (sorted and/or cut).
-- TODO: should take only one ListId
getTableNgrams :: (RepoCmdM env err m, HasNodeError err, HasConnection env, Exception err)
getTableNgrams :: (RepoCmdM env err m, HasNodeError err, HasConnection env)
=> CorpusId -> TabType
-> ListId -> Limit -> Maybe Offset
-> Maybe ListType
......
......@@ -15,7 +15,6 @@ Node API
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
......
......@@ -8,14 +8,12 @@ Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
......@@ -25,7 +23,6 @@ Portability : POSIX
module Gargantext.API.Settings
where
import Control.Exception (Exception)
import System.Directory
import System.Log.FastLogger
import GHC.Enum
......@@ -276,7 +273,7 @@ withDevEnv k = do
k env `finally` unlockFile (env ^. repoEnv . renv_lock)
-- | Run Cmd Sugar for the Repl (GHCI)
runCmdRepl :: (Show err, Exception err) => Cmd' DevEnv err a -> IO a
runCmdRepl :: Show err => Cmd' DevEnv err a -> IO a
runCmdRepl f = withDevEnv $ \env -> runCmdDev env f
runCmdReplServantErr :: Cmd' DevEnv ServantErr a -> IO a
......@@ -290,14 +287,12 @@ newDevEnv = newDevEnvWith "gargantext.ini"
-- the command.
-- This function is constrained to the DevEnv rather than
-- using HasConnection and HasRepoVar.
runCmdDev :: (Show err, Exception err) => DevEnv -> Cmd' DevEnv err a -> IO a
runCmdDev :: Show err => DevEnv -> Cmd' DevEnv err a -> IO a
runCmdDev env f =
(either (fail . show) pure =<< runCmd env f)
`finally`
runReaderT saveRepo env
instance Exception ()
-- Use only for dev
runCmdDevNoErr :: DevEnv -> Cmd' DevEnv () a -> IO a
runCmdDevNoErr = runCmdDev
......
......@@ -20,7 +20,6 @@ Portability : POSIX
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MonoLocalBinds #-}
module Gargantext.Database.Flow -- (flowDatabase, ngrams2list)
where
......
......@@ -13,7 +13,6 @@ Node API
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MonoLocalBinds #-}
module Gargantext.Database.Metrics
where
......
......@@ -56,13 +56,11 @@ type CmdM' env err m =
( MonadReader env m
, MonadError err m
, MonadIO m
, Exception err
)
type CmdM env err m =
( CmdM' env err m
, HasConnection env
, Exception err
)
type Cmd' env err a = forall m. CmdM' env err m => m a
......@@ -75,7 +73,7 @@ mkCmd k = do
conn <- view connection
liftIO $ k conn
runCmd :: (HasConnection env, Exception err) => env
runCmd :: (HasConnection env) => env
-> Cmd' env err a
-> IO (Either err a)
runCmd env m = runExceptT $ runReaderT m env
......@@ -91,14 +89,14 @@ runPGSQuery' :: (PGS.ToRow a, PGS.FromRow b) => PGS.Query -> a -> Cmd err [b]
runPGSQuery' q a = mkCmd $ \conn -> PGS.query conn q a
runPGSQuery :: (MonadError err m, MonadReader env m,
PGS.FromRow r, PGS.ToRow q, MonadIO m, HasConnection env, Exception err)
PGS.FromRow r, PGS.ToRow q, MonadIO m, HasConnection env)
=> PGS.Query -> q -> m [r]
runPGSQuery q a = mkCmd $ \conn -> catch (PGS.query conn q a) (printError conn)
where
printError c (SomeException e) = do
q' <- (PGS.formatQuery c q a :: IO DB.ByteString)
q' <- PGS.formatQuery c q a
hPutStrLn stderr q'
throw e
throw (SomeException e)
execPGSQuery :: PGS.ToRow a => PGS.Query -> a -> Cmd err Int64
......
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