[DEBUG] if SQL query fails then print Query in logs.

src/Gargantext/API/Ngrams.hs

@@ -35,6 +35,7 @@ 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 (($>))
@@ -893,7 +894,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)
+getTableNgrams :: (RepoCmdM env err m, HasNodeError err, HasConnection env, Exception err)
                => CorpusId -> TabType
                -> ListId -> Limit -> Maybe Offset
                -> Maybe ListType

src/Gargantext/API/Node.hs

@@ -15,6 +15,7 @@ Node API
 {-# LANGUAGE DataKinds          #-}
 {-# LANGUAGE DeriveGeneric      #-}
 {-# LANGUAGE FlexibleContexts   #-}
+{-# LANGUAGE MonoLocalBinds     #-}
 {-# LANGUAGE NoImplicitPrelude  #-}
 {-# LANGUAGE OverloadedStrings  #-}
 {-# LANGUAGE RankNTypes         #-}

src/Gargantext/API/Settings.hs

@@ -8,22 +8,24 @@ Stability   : experimental
 Portability : POSIX
 -}
 
-
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 
-{-# LANGUAGE NoImplicitPrelude           #-}
-{-# LANGUAGE DataKinds                   #-}
-{-# LANGUAGE DeriveGeneric               #-}
-{-# LANGUAGE ScopedTypeVariables         #-}
-{-# LANGUAGE TemplateHaskell             #-}
-{-# LANGUAGE OverloadedStrings           #-}
-{-# LANGUAGE FlexibleContexts            #-}
-{-# LANGUAGE FlexibleInstances           #-}
-{-# LANGUAGE RankNTypes                  #-}
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE DeriveGeneric       #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE FlexibleInstances   #-}
+{-# LANGUAGE MonoLocalBinds      #-}
+{-# LANGUAGE NoImplicitPrelude   #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell     #-}
 
 module Gargantext.API.Settings
     where
 
+import Control.Exception (Exception)
 import System.Directory
 import System.Log.FastLogger
 import GHC.Enum
@@ -274,7 +276,7 @@ withDevEnv k = do
   k env `finally` unlockFile (env ^. repoEnv . renv_lock)
 
 -- | Run Cmd Sugar for the Repl (GHCI)
-runCmdRepl :: Show err => Cmd' DevEnv err a -> IO a
+runCmdRepl :: (Show err, Exception err) => Cmd' DevEnv err a -> IO a
 runCmdRepl f = withDevEnv $ \env -> runCmdDev env f
 
 runCmdReplServantErr :: Cmd' DevEnv ServantErr a -> IO a
@@ -288,12 +290,14 @@ newDevEnv = newDevEnvWith "gargantext.ini"
 -- the command.
 -- This function is constrained to the DevEnv rather than
 -- using HasConnection and HasRepoVar.
-runCmdDev :: Show err => DevEnv -> Cmd' DevEnv err a -> IO a
+runCmdDev :: (Show err, Exception 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

src/Gargantext/Database/Flow.hs

@@ -20,6 +20,7 @@ Portability : POSIX
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes        #-}
 {-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE MonoLocalBinds    #-}
 
 module Gargantext.Database.Flow -- (flowDatabase, ngrams2list)
     where

src/Gargantext/Database/Metrics.hs

@@ -11,9 +11,9 @@ Node API
 -}
 
 
-{-# LANGUAGE NoImplicitPrelude  #-}
+{-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE FlexibleContexts  #-}
-
+{-# LANGUAGE MonoLocalBinds    #-}
 
 module Gargantext.Database.Metrics
   where

src/Gargantext/Database/Utils.hs

@@ -20,8 +20,9 @@ commentary with @some markup@.
 
 module Gargantext.Database.Utils where
 
-import Control.Exception
-import Data.Text (Text)
+import Data.ByteString.Char8 (hPutStrLn)
+import System.IO (stderr)
+import Control.Exception 
 import Control.Monad.Error.Class -- (MonadError(..), Error)
 import Control.Lens (Getter, view)
 import Control.Monad.Reader
@@ -55,11 +56,13 @@ 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
@@ -72,7 +75,7 @@ mkCmd k = do
   conn <- view connection
   liftIO $ k conn
 
-runCmd :: HasConnection env => env
+runCmd :: (HasConnection env, Exception err) => env
        -> Cmd' env err a
        -> IO (Either err a)
 runCmd env m = runExceptT $ runReaderT m env
@@ -83,25 +86,19 @@ runOpaQuery q = mkCmd $ \c -> runQuery c q
 formatPGSQuery :: PGS.ToRow a => PGS.Query -> a -> Cmd err DB.ByteString
 formatPGSQuery q a = mkCmd $ \conn -> PGS.formatQuery conn q a
 
-runPGSQuery :: (PGS.ToRow a, PGS.FromRow b) => PGS.Query -> a -> Cmd err [b]
-runPGSQuery q a = mkCmd $ \conn -> PGS.query conn q a
+-- TODO use runPGSQueryDebug everywhere
+runPGSQuery' :: (PGS.ToRow a, PGS.FromRow b) => PGS.Query -> a -> Cmd err [b]
+runPGSQuery' q a = mkCmd $ \conn -> PGS.query conn q a
 
-
-data SqlErrorX = SqlErrorX
-  deriving (Eq, Show)
-
-instance Exception SqlErrorX
-
-
-runPGSQuery' :: (MonadError (SqlErrorX) m, MonadReader env m,
-                PGS.FromRow r, PGS.ToRow q, MonadIO m, HasConnection env)
+runPGSQuery :: (MonadError err m, MonadReader env m,
+                PGS.FromRow r, PGS.ToRow q, MonadIO m, HasConnection env, Exception err)
                 => PGS.Query -> q -> m [r]
-runPGSQuery' q a = mkCmd $ \conn -> catchError (PGS.query conn q a) (printError conn)
+runPGSQuery q a = mkCmd $ \conn -> catch (PGS.query conn q a) (printError conn)
   where
-    printError c e = do
+    printError c (SomeException e) = do
       q' <- (PGS.formatQuery c q a :: IO DB.ByteString)
-      putStrLn (cs q':: Text)
-      throwError e
+      hPutStrLn stderr q'
+      throw e
 
 
 execPGSQuery :: PGS.ToRow a => PGS.Query -> a -> Cmd err Int64