Nathan McCarty
e2a26d9519
Provide a proper logging effect that filters messages by log level before generating them.
146 lines
3.4 KiB
Markdown
146 lines
3.4 KiB
Markdown
# Effects utilities
|
|
|
|
Contains utility functions extending the functionality of the `eff` package.
|
|
|
|
```idris
|
|
module Util.Eff
|
|
|
|
import Control.Eff
|
|
import Text.ANSI
|
|
|
|
import System
|
|
import System.File
|
|
|
|
%default total
|
|
```
|
|
|
|
## Logging
|
|
|
|
### Log Levels
|
|
|
|
Basic enumeration describing log levels, we define some (hidden) utility functions for working with these.
|
|
|
|
```idris
|
|
public export
|
|
data Level = Err | Warn | Info | Debug | Trace | Other Nat
|
|
```
|
|
|
|
<!-- idris
|
|
export
|
|
levelToNat : Level -> Nat
|
|
levelToNat Err = 0
|
|
levelToNat Warn = 1
|
|
levelToNat Info = 2
|
|
levelToNat Debug = 3
|
|
levelToNat Trace = 4
|
|
levelToNat (Other k) = k
|
|
|
|
export
|
|
natToLevel : Nat -> Level
|
|
natToLevel 0 = Err
|
|
natToLevel 1 = Warn
|
|
natToLevel 2 = Info
|
|
natToLevel 3 = Debug
|
|
natToLevel 4 = Trace
|
|
natToLevel k = Other k
|
|
|
|
export
|
|
Eq Level where
|
|
x == y = levelToNat x == levelToNat y
|
|
|
|
export
|
|
Ord Level where
|
|
compare x y = compare (levelToNat x) (levelToNat y)
|
|
|
|
export infixl 8 >+
|
|
export
|
|
(>+) : Level -> Nat -> Level
|
|
(>+) x k = natToLevel (k + levelToNat x)
|
|
-->
|
|
|
|
Convert a `Level` into a colorized tag
|
|
|
|
```idris
|
|
export
|
|
levelToTag : Level -> String
|
|
levelToTag Err =
|
|
show . bolden . show . colored BrightRed $ "[Error]"
|
|
levelToTag Warn =
|
|
show . bolden . show . colored BrightYellow $ "[Warning]"
|
|
levelToTag Info =
|
|
show . bolden . show . colored Green $ "[Info]"
|
|
levelToTag Debug =
|
|
show . bolden . show . colored Magenta $ "[Debug]"
|
|
levelToTag Trace =
|
|
show . bolden . show . colored Cyan $ "[Trace]"
|
|
levelToTag (Other k) =
|
|
show . bolden . show . colored BrightWhite $ "[\{show k}]"
|
|
```
|
|
|
|
### Logger effect
|
|
|
|
This is a basic data structure that captures a lazy log message (so we don't have to pay any of the costs associated with generating the log message when it is filtered)
|
|
|
|
```idris
|
|
public export
|
|
data Logger : Type -> Type where
|
|
Log : (level : Level) -> (msg : Lazy String) -> Logger ()
|
|
```
|
|
|
|
We'll also provide some basic accessors, and an `ignore` function useful for writing handlers.
|
|
|
|
```idris
|
|
export
|
|
(.level) : Logger t -> Level
|
|
(.level) (Log level msg) = level
|
|
|
|
export
|
|
(.msg) : Logger t -> Lazy String
|
|
(.msg) (Log level msg) = msg
|
|
|
|
export
|
|
ignore : Logger t -> t
|
|
ignore (Log level msg) = ()
|
|
```
|
|
|
|
#### Handler
|
|
|
|
Because we know that we will only be using `logger` in an `IO` context, we aren't currently going to provide a `runLogger` or the like, instead we'll define a function, suitable for use as a `runEff` handler, that filters log messages and prints them to `stderr` over `IO`.
|
|
|
|
In the event a log message is filtered out, it's inner message is never inspected, avoiding evaluation.
|
|
|
|
```idris
|
|
export
|
|
handleLoggerIO :
|
|
(max_level : Level) -> Logger t -> IO t
|
|
handleLoggerIO max_level x =
|
|
if x.level <= max_level
|
|
then do
|
|
_ <- fPutStrLn stderr "\{levelToTag x.level}: \{x.msg}"
|
|
pure . ignore $ x
|
|
else pure . ignore $ x
|
|
```
|
|
|
|
Use the `WriterL "log" String` effect like a logging library. We'll provide a few "log levels" as verbs for the effect, but no filtering is done, when logging is enabled, all logs are always displayed, however the log level is indicated with a colored tag.
|
|
|
|
```idris
|
|
export
|
|
error : Has Logger fs => Lazy String -> Eff fs ()
|
|
error x = send $ Log Err x
|
|
|
|
export
|
|
warn : Has Logger fs => Lazy String -> Eff fs ()
|
|
warn x = send $ Log Warn x
|
|
|
|
export
|
|
info : Has Logger fs => Lazy String -> Eff fs ()
|
|
info x = send $ Log Info x
|
|
|
|
export
|
|
debug : Has Logger fs => Lazy String -> Eff fs ()
|
|
debug x = send $ Log Debug x
|
|
|
|
export
|
|
trace : Has Logger fs => Lazy String -> Eff fs ()
|
|
trace x = send $ Log Trace x
|
|
```
|