diff --git a/src/Gargantext/API/Admin/EnvTypes.hs b/src/Gargantext/API/Admin/EnvTypes.hs index f4628a4adbe0448c6d92d8223556c372cbb12d10..6482129605e8e0d20cbf056304feb976c83c718b 100644 --- a/src/Gargantext/API/Admin/EnvTypes.hs +++ b/src/Gargantext/API/Admin/EnvTypes.hs @@ -13,6 +13,7 @@ module Gargantext.API.Admin.EnvTypes ( , env_manager , env_self_url , menv_firewall + , dev_env_logger , MockEnv(..) , DevEnv(..) @@ -233,9 +234,31 @@ data MockEnv = MockEnv makeLenses ''MockEnv +instance MonadLogger (GargM DevEnv GargError) where + getLogger = asks _dev_env_logger + +instance HasLogger (GargM DevEnv GargError) where + data instance Logger (GargM DevEnv GargError) = + GargDevLogger { + dev_logger_mode :: Mode + , dev_logger_set :: FL.LoggerSet + } + type instance LogInitParams (GargM DevEnv GargError) = Mode + type instance LogPayload (GargM DevEnv GargError) = FL.LogStr + initLogger = \mode -> do + dev_logger_set <- liftIO $ FL.newStderrLoggerSet FL.defaultBufSize + pure $ GargDevLogger mode dev_logger_set + destroyLogger = \GargDevLogger{..} -> liftIO $ FL.rmLoggerSet dev_logger_set + logMsg = \(GargDevLogger mode logger_set) lvl msg -> do + let pfx = "[" <> show lvl <> "] " + when (lvl `elem` (modeToLoggingLevels mode)) $ + liftIO $ FL.pushLogStrLn logger_set $ FL.toLogStr pfx <> msg + logTxt lgr lvl msg = logMsg lgr lvl (FL.toLogStr $ T.unpack msg) + data DevEnv = DevEnv { _dev_env_settings :: !Settings , _dev_env_config :: !GargConfig + , _dev_env_logger :: !(Logger (GargM DevEnv GargError)) , _dev_env_pool :: !(Pool Connection) , _dev_env_nodeStory :: !NodeStoryEnv , _dev_env_mail :: !MailConfig diff --git a/src/Gargantext/API/Dev.hs b/src/Gargantext/API/Dev.hs index 3102f45536161d8e5681671cc84283b1e81bbfba..31885596bad3300b989d105284b366804f39536c 100644 --- a/src/Gargantext/API/Dev.hs +++ b/src/Gargantext/API/Dev.hs @@ -29,16 +29,17 @@ import qualified Gargantext.Prelude.Mail as Mail import qualified Gargantext.Prelude.NLP as NLP import Servant import System.IO (FilePath) +import Gargantext.System.Logging type IniPath = FilePath ------------------------------------------------------------------- withDevEnv :: IniPath -> (DevEnv -> IO a) -> IO a -withDevEnv iniPath k = do - env <- newDevEnv +withDevEnv iniPath k = withLoggerHoisted Dev $ \logger -> do + env <- newDevEnv logger k env -- `finally` cleanEnv env where - newDevEnv = do + newDevEnv logger = do cfg <- readConfig iniPath dbParam <- databaseParameters iniPath --nodeStory_env <- readNodeStoryEnv (_gc_repofilepath cfg) @@ -49,6 +50,7 @@ withDevEnv iniPath k = do nlp_config <- NLP.readConfig iniPath pure $ DevEnv { _dev_env_pool = pool + , _dev_env_logger = logger , _dev_env_nodeStory = nodeStory_env , _dev_env_settings = setts , _dev_env_config = cfg