Barebone logging interface, to ease debugging

bin/gargantext-server/Main.hs

@@ -16,15 +16,18 @@ Script to start gargantext with different modes (Dev, Prod, Mock).
 {-# LANGUAGE Strict               #-}
 {-# LANGUAGE TypeOperators        #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE TypeFamilies #-}
 
 
 module Main where
 
 
+import Data.String (String)
 import Data.Text (unpack)
 import Data.Version (showVersion)
 import Gargantext.API (startGargantext, Mode(..)) -- , startGargantextMock)
 import Gargantext.Prelude
+import Gargantext.System.Logging
 import Options.Generic
 import System.Exit (exitSuccess)
 import qualified Paths_gargantext as PG -- cabal magic build module
@@ -49,14 +52,25 @@ data MyOptions w =
 instance ParseRecord (MyOptions Wrapped)
 deriving instance Show (MyOptions Unwrapped)
 
+-- | A plain logger in the IO monad, waiting for more serious logging solutions like
+-- the one described in https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/229
+instance HasLogger IO where
+  data instance Logger IO  = IOLogger
+  type instance InitParams IO = ()
+  type instance Payload IO  = String
+  initLogger                = \() -> pure IOLogger
+  destroyLogger             = \_  -> pure ()
+  logMsg = \IOLogger lvl msg ->
+    let pfx = "[" <> show lvl <> "] "
+    in putStrLn $ pfx <> msg
 
 main :: IO ()
-main = do
+main = withLogger () $ \ioLogger -> do
   MyOptions myMode myPort myIniFile myVersion  <- unwrapRecord
           "Gargantext server"
   ---------------------------------------------------------------
   if myVersion then do
-    putStrLn $ "Version: " <> showVersion PG.version
+    logMsg ioLogger INFO $ "Version: " <> showVersion PG.version
     System.Exit.exitSuccess
   else
     return ()
@@ -73,6 +87,6 @@ main = do
   let start = case myMode of
         Mock -> panic "[ERROR] Mock mode unsupported"
         _ -> startGargantext myMode myPort' (unpack myIniFile')
-  putStrLn $ "Starting with " <> show myMode <> " mode."
+  logMsg ioLogger INFO $ "Starting with " <> show myMode <> " mode."
   start
   ---------------------------------------------------------------

gargantext.cabal

@@ -117,6 +117,7 @@ library
       Gargantext.Database.Query.Table.Node.UpdateOpaleye
       Gargantext.Database.Query.Table.User
       Gargantext.Database.Schema.Ngrams
+      Gargantext.System.Logging
       Gargantext.Defaults
       Gargantext.Utils.Jobs
       Gargantext.Utils.Jobs.Internal

src/Gargantext/System/Logging.hs

+{-# LANGUAGE TypeFamilies #-}
+
+module Gargantext.System.Logging where
+
+import Prelude
+import Data.Kind (Type)
+import Control.Monad.Trans.Control
+import Control.Exception.Lifted (bracket)
+
+data Level =
+  -- | Debug messages
+  DEBUG
+  -- | Information
+  | INFO
+  -- | Normal runtime conditions
+  | NOTICE
+  -- | General Warnings
+  | WARNING
+  -- | General Errors
+  | ERROR
+  -- | Severe situations
+  | CRITICAL
+  -- | Take immediate action
+  | ALERT
+  -- | System is unusable
+  | EMERGENCY
+  deriving (Show, Eq, Ord, Enum, Bounded)
+
+-- | This is a barebore logging interface which we
+-- can extend to plug a proper logging library, without
+-- the details of the logger cropping up everywhere in
+-- the rest of the codebase.
+class HasLogger m where
+  data family Logger m     :: Type
+  type family InitParams m :: Type
+  type family Payload m    :: Type
+  initLogger    :: InitParams m -> m (Logger m)
+  destroyLogger :: Logger m -> m ()
+  logMsg :: Logger m -> Level -> Payload m -> m ()
+
+-- | exception-safe combinator that creates and destroys a logger.
+-- Think about it like a 'bracket' function from 'Control.Exception'.
+withLogger :: (MonadBaseControl IO m, HasLogger m)
+           => InitParams m
+           -> (Logger m -> m a)
+           -> m a
+withLogger params = bracket (initLogger params) destroyLogger