[refactor] replace printDebug with log

parent a304d123
......@@ -102,6 +102,7 @@ rec {
hlint
libffi
lapack
lnav
lzma
pcre
pkgconfig
......
......@@ -35,6 +35,7 @@ import Data.Text (splitOn, pack, toLower)
import Gargantext.Core (Lang(..))
import Gargantext.Core.Types
import Gargantext.Prelude hiding (ByteString, toLower)
import Gargantext.System.Logging qualified as Log
import Network.HTTP.Simple
import Network.URI (URI(..))
import Text.CoreNLP.Types qualified as CoreNLP
......@@ -126,8 +127,9 @@ corenlp' uri lang txt = do
case e of
JSONParseException _req res _err -> do
let body = getResponseBody res
printDebug "[corenlp'] request text" (cs txt :: ByteString)
printDebug "[corenlp'] response body (error)" body
logger <- Log.getLogger
$(Log.logLoc) logger Log.DEBUG $ "[corenlp'] request text " <> (decodeUtf8 $ BSL.toStrict $ cs txt)
$(Log.logLoc) logger Log.DEBUG $ "[corenlp'] response body (error) " <> show body
throwIO e
JSONConversionException _req _res _err -> throwIO e
where
......
......@@ -58,17 +58,15 @@ instance HasConfig GargConfig where
type JSONB = DefaultFromField SqlJsonb
-------------------------------------------------------
type CmdM'' env err m =
type CmdM' env err m =
( MonadReader env m
, MonadError err m
, MonadBaseControl IO m
, MonadRandom m
)
type CmdM' env err m =
( MonadReader env m
, MonadError err m
, MonadBaseControl IO m
type CmdM'' env err m =
( CmdM' env err m
, MonadRandom m
)
-- | If possible, try to not add more constraints here. When performing
......
......@@ -10,6 +10,7 @@ Portability : POSIX
-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Query.Table.Node.UpdateOpaleye
......@@ -24,14 +25,16 @@ import Gargantext.Database.Query.Table.Node
import Gargantext.Database.Query.Table.Node.Error
import Gargantext.Database.Schema.Node
import Gargantext.Prelude
import Gargantext.System.Logging qualified as Log
import Opaleye
-- import Debug.Trace (trace)
updateHyperdata :: HyperdataC a => NodeId -> a -> DBCmd err Int64
updateHyperdata i h = mkCmd $ \c -> putStrLn ("before runUpdate_" :: Text) >>
runUpdate_ c (updateHyperdataQuery i h) >>= \res ->
putStrLn ("after runUpdate_" :: Text) >> pure res
updateHyperdata i h = mkCmd $ \c -> do
logger <- liftIO Log.getLogger
liftIO $ $(Log.logLoc) logger Log.DEBUG ("before runUpdate_" :: Text)
res <- runUpdate_ c (updateHyperdataQuery i h)
liftIO $ $(Log.logLoc) logger Log.DEBUG ("after runUpdate_" :: Text)
pure res
updateHyperdataQuery :: HyperdataC a => NodeId -> a -> Update Int64
updateHyperdataQuery i h = seq h' $ {- trace "updateHyperdataQuery: encoded JSON" $ -} Update
......
{-|
Module : Gargantext.System.Logging
Description : Error logging etc
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
TODO-SECURITY: Critical
-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeApplications #-}
......@@ -13,14 +26,16 @@ module Gargantext.System.Logging (
, withLoggerHoisted
) where
import Language.Haskell.TH hiding (Type)
import Control.Exception.Lifted (bracket)
import Control.Monad.IO.Class
import Control.Monad.Trans.Control
import Data.Kind (Type)
import Data.Text qualified as T
import Language.Haskell.TH hiding (Type)
import Language.Haskell.TH.Syntax qualified as TH
import Prelude
import qualified Data.Text as T
import qualified Language.Haskell.TH.Syntax as TH
data LogLevel =
-- | Debug messages
......@@ -55,7 +70,7 @@ class HasLogger m where
logTxt :: Logger m -> LogLevel -> T.Text -> m ()
-- | Separate typeclass to get hold of a 'Logger' from within a monad.
-- We keey 'HasLogger' and 'MonadLogger' separate to enforce compositionality,
-- We key 'HasLogger' and 'MonadLogger' separate to enforce compositionality,
-- i.e. we can still give instances to 'HasLogger' for things like 'IO' without
-- having to force actually acquiring a logger for those monads.
class HasLogger m => MonadLogger m where
......@@ -126,7 +141,10 @@ instance HasLogger IO where
type instance LogPayload IO = String
initLogger = \() -> pure IOLogger
destroyLogger = \_ -> pure ()
logMsg = \IOLogger lvl msg ->
logMsg IOLogger lvl msg =
let pfx = "[" <> show lvl <> "] "
in putStrLn $ pfx <> msg
logTxt lgr lvl msg = logMsg lgr lvl (T.unpack msg)
instance MonadLogger IO where
getLogger = pure IOLogger
......@@ -23,7 +23,6 @@ import Gargantext.Database.Admin.Trigger.Init
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Prelude
import Gargantext.Database.Query.Table.Node (getOrMkList)
-- import Gargantext.Prelude (printDebug)
import Gargantext.Prelude.Config
import Gargantext.System.Logging
import Network.HTTP.Client.TLS (newTlsManager)
......@@ -104,7 +103,6 @@ setupEnvironment env = flip runReaderT env $ runTestMonad $ do
(Left corpusMasterName)
(Nothing :: Maybe HyperdataCorpus)
masterListId <- getOrMkList masterCorpusId masterUserId
-- printDebug "[setupEnvironment] masterListId: " masterListId
void $ initLastTriggers masterListId
-- | Creates two users, Alice & Bob. Alice shouldn't be able to see
......
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