
   0 | module Control.RIO.Logging
   1 | 
   2 | import Text.ANSI
   3 | import Control.RIO.Console
   4 | 
   5 | %default total
   6 | 
   7 | --------------------------------------------------------------------------------
   8 | --          Log Level
   9 | --------------------------------------------------------------------------------
  10 | 
  11 | public export
  12 | data LogLevel = Trace | Debug | Info | Warning | Error
  13 | 
  14 | public export
  15 | priority : LogLevel -> Nat
  16 | priority Trace   = 0
  17 | priority Debug   = 1
  18 | priority Info    = 2
  19 | priority Warning = 3
  20 | priority Error   = 4
  21 | 
  22 | public export
  23 | Eq LogLevel where (==) = (==) `on` priority
  24 | 
  25 | public export
  26 | Ord LogLevel where compare = compare `on` priority
  27 | 
  28 | export
  29 | Interpolation LogLevel where
  30 |   interpolate Trace   = "trace"
  31 |   interpolate Debug   = "debug"
  32 |   interpolate Info    = "info"
  33 |   interpolate Warning = "warning"
  34 |   interpolate Error   = "error"
  35 | 
  36 | --------------------------------------------------------------------------------
  37 | --          Record
  38 | --------------------------------------------------------------------------------
  39 | 
  40 | public export
  41 | record Logger where
  42 |   constructor MkLogger
  43 |   log : LogLevel -> Lazy String -> IO ()
  44 | 
  45 | ||| Only log message of at least the given logging level.
  46 | export
  47 | filter : LogLevel -> Logger -> Logger
  48 | filter lvl x = MkLogger $ \l,s => case l >= lvl of
  49 |   True  => x.log l s
  50 |   False => pure ()
  51 | 
  52 | export
  53 | Semigroup Logger where
  54 |   x <+> y = MkLogger $ \l,s => x.log l s >> y.log l s
  55 | 
  56 | export
  57 | Monoid Logger where
  58 |   neutral = MkLogger $ \_,_ => pure ()
  59 | 
  60 | export
  61 | consoleLogger : ConsoleOut -> (LogLevel -> Lazy String -> String) -> Logger
  62 | consoleLogger c f = MkLogger $ \l,s => case l of
  63 |   Error => c.putErr_ (f l s ++ "\n")
  64 |   _     => c.putStr_ (f l s ++ "\n")
  65 | 
  66 | export
  67 | basicConsoleLogger : ConsoleOut -> Logger
  68 | basicConsoleLogger c = consoleLogger c $ \l,s => "[\{l}] \{s}"
  69 | 
  70 | col : LogLevel -> String
  71 | col Trace   = show $ colored White "trace"
  72 | col Debug   = show $ colored Cyan "debug"
  73 | col Info    = show $ colored Green "info"
  74 | col Warning = show $ colored Yellow "warning"
  75 | col Error   = show $ colored Red "error"
  76 | 
  77 | ||| A console logger with colored log level tags
  78 | export
  79 | colorConsoleLogger : ConsoleOut -> Logger
  80 | colorConsoleLogger c = consoleLogger c $ \l,s => "[\{col l}] \{s}"
  81 | 
  82 | --------------------------------------------------------------------------------
  83 | --          Syslog
  84 | --------------------------------------------------------------------------------
  85 | 
  86 | public export
  87 | data Facility =
  88 |     Kernel
  89 |   | UserLevel
  90 |   | MailSystem
  91 |   | SystemDaemon
  92 |   | Authorization
  93 |   | SyslogInternal
  94 |   | LinePrinter
  95 |   | NetworkNews
  96 |   | UUCP
  97 |   | ClockDaemon
  98 |   | SecurityMessages
  99 |   | FTPDaemon
 100 |   | NTP
 101 |   | LogAudit
 102 |   | LogAlert
 103 |   | ClockDaemon2
 104 | 
 105 | facility : Facility -> Nat
 106 | facility Kernel           = 0
 107 | facility UserLevel        = 1
 108 | facility MailSystem       = 2
 109 | facility SystemDaemon     = 3
 110 | facility Authorization    = 4
 111 | facility SyslogInternal   = 5
 112 | facility LinePrinter      = 6
 113 | facility NetworkNews      = 7
 114 | facility UUCP             = 8
 115 | facility ClockDaemon      = 9
 116 | facility SecurityMessages = 10
 117 | facility FTPDaemon        = 11
 118 | facility NTP              = 12
 119 | facility LogAudit         = 13
 120 | facility LogAlert         = 14
 121 | facility ClockDaemon2     = 15
 122 | 
 123 | severity : LogLevel -> Nat
 124 | severity Trace   = 7
 125 | severity Debug   = 7
 126 | severity Info    = 6
 127 | severity Warning = 5
 128 | severity Error   = 3
 129 | 
 130 | ||| A logger using syslog priority codes. This can be used with
 131 | ||| systemd services.
 132 | export
 133 | syslogLogger : Facility -> ConsoleOut -> Logger
 134 | syslogLogger f c =
 135 |   consoleLogger c $
 136 |     \l,s =>
 137 |       let lvl := 8 * facility f + severity l
 138 |        in "<\{show lvl}> \{s}"
 139 | 
 140 | --------------------------------------------------------------------------------
 141 | --          Interface
 142 | --------------------------------------------------------------------------------
 143 | 
 144 | export
 145 | log : Logger => HasIO io => LogLevel -> Lazy String -> io ()
 146 | log l s = liftIO (log %search l s)
 147 | 
 148 | export %inline
 149 | trace : Logger => HasIO io => Lazy String -> io ()
 150 | trace = log Trace
 151 | 
 152 | export %inline
 153 | debug : Logger => HasIO io => Lazy String -> io ()
 154 | debug = log Debug
 155 | 
 156 | export %inline
 157 | info : Logger => HasIO io => Lazy String -> io ()
 158 | info = log Info
 159 | 
 160 | export %inline
 161 | warn : Logger => HasIO io => Lazy String -> io ()
 162 | warn = log Warning
 163 | 
 164 | export %inline
 165 | error : Logger => HasIO io => Lazy String -> io ()
 166 | error = log Error
 167 |