@@ -1,88 +1,29 @@
1−-- ------------------------------------------------------------- [ Logging.idr ]
2−-- Module : Logging.idr
1+-- ------------------------------------------------------------ [ Category.idr ]
2+-- Module : Category.idr
33-- Copyright : (c) The Idris Community
44-- License : see LICENSE
55-- --------------------------------------------------------------------- [ EOH ]
6−
76||| A logging effect that allows messages to be logged using both
87||| numerical levels and user specified categories. The higher the
98||| logging level the grater in verbosity the logging.
109|||
1110||| In this effect the resource we are computing over is the logging
1211||| level itself and the list of categories to show.
13−|||
14−module Effect.Logging
12+module Effect.Logging.Category
1513
1614import Effects
15+import public Effect.Logging.Level
1716
1817%access public
1918
20−-- ---------------------------------------------------- [ Log Level Definition ]
21−
22−||| Logging levels are natural numbers wrapped in a data type for
23−||| convenience.
24−|||
25−||| Several aliases have been defined to aide in semantic use of the
26−||| logging levels. These aliases have come from the Log4j/Python
27−||| family of loggers.
28−data LogLevel : Nat -> Type where
29− ||| Log No Events
30− OFF : LogLevel 0
31−
32− ||| A fine-grained debug message, typically capturing the flow through
33− ||| the application.
34− TRACE : LogLevel 10
35−
36− ||| A general debugging event.
37− DEBUG : LogLevel 20
38−
39− ||| An event for informational purposes.
40− INFO : LogLevel 30
41−
42− ||| An event that might possible lead to an error.
43− WARN : LogLevel 40
44−
45− ||| An error in the application, possibly recoverable.
46− ERROR : LogLevel 50
47−
48− ||| A severe error that will prevent the application from continuing.
49− FATAL : LogLevel 60
50−
51− ||| All events should be logged.
52− ALL : LogLevel 70
53−
54− ||| User defined logging level.
55− CUSTOM : (n : Nat) -> {auto prf : LTE n 70} -> LogLevel n
56−
57−instance Cast (LogLevel n) Nat where
58− cast {n} _ = n
59−
60−instance Show (LogLevel n) where
61− show OFF = "OFF"
62− show TRACE = "TRACE"
63− show DEBUG = "DEBUG"
64− show INFO = "INFO"
65− show WARN = "WARN"
66− show FATAL = "FATAL"
67− show ERROR = "ERROR"
68− show ALL = "ALL"
69− show (CUSTOM n) = unwords ["CUSTOM", show n]
70−
71−instance Eq (LogLevel n) where
72− (==) x y = lvlEq x y
73− where
74− lvlEq : LogLevel a -> LogLevel b -> Bool
75− lvlEq {a} {b} _ _ = a == b
76−
77−cmpLevel : LogLevel a -> LogLevel b -> Ordering
78−cmpLevel {a} {b} _ _ = compare a b
19+-- -------------------------------------------------------- [ Logging Resource ]
7920
8021||| The Logging details, this is the resource that the effect is
8122||| defined over.
8223record LogRes (a : Type) where
8324 constructor MkLogRes
84− lvl : LogLevel n
85− cats : List a
25+ getLevel : LogLevel n
26+ getCategories : List a
8627
8728instance (Show a) => Show (LogRes a) where
8829 show (MkLogRes l cs) = unwords ["Log Settings:", show l, show cs]
@@ -90,6 +31,8 @@ instance (Show a) => Show (LogRes a) where
9031instance Default (LogRes a) where
9132 default = MkLogRes OFF Nil
9233
34+-- ------------------------------------------------------- [ Effect Definition ]
35+
9336||| A Logging effect to log levels and categories.
9437data Logging : Effect where
9538 ||| Log a message.
@@ -126,12 +69,14 @@ data Logging : Effect where
12669 (ncats : List a) ->
12770 sig Logging () (LogRes a) (LogRes a)
12871
72+-- -------------------------------------------------------------- [ IO Handler ]
73+
12974instance Handler Logging IO where
13075 handle st (SetLogLvl nlvl) k = do
131− let newSt = record {lvl = nlvl} st
76+ let newSt = record {getLevel = nlvl} st
13277 k () newSt
13378 handle st (SetLogCats newcs) k = do
134− let newSt = record {cats = newcs} st
79+ let newSt = record {getCategories = newcs} st
13580 k () newSt
13681
13782 handle st (InitLogger l cs) k = do
@@ -139,25 +84,30 @@ instance Handler Logging IO where
13984 k () newSt
14085
14186 handle st (Log l cs' msg) k = do
142− case cmpLevel l (lvl st) of
87+ case cmpLevel l (getLevel st) of
14388 GT => k () st
14489 otherwise => do
145− let res = and $ map (\x => elem x cs') (cats st)
146− let prompt = if isNil (cats st)
90+ let res = and $ map (\x => elem x cs') (getCategories st)
91+ let prompt = if isNil (getCategories st)
14792 then unwords [show l, ":"]
148− else unwords [show l, ":", show (cats st), ":"]
149− if res || isNil (cats st)
93+ else unwords [show l, ":", show (getCategories st), ":"]
94+ if res || isNil (getCategories st)
15095 then do
15196 putStrLn $ unwords [prompt, msg]
15297 k () st
15398 else k () st
15499
100+
101+-- ------------------------------------------------------- [ Effect Descriptor ]
102+
155103||| The Logging effect.
156104|||
157105||| @cTy The type used to differentiate categories.
158106LOG : (cTy : Type) -> EFFECT
159107LOG cTy = MkEff (LogRes cTy) Logging
160108
109+-- ----------------------------------------------------------- [ Effectful API ]
110+
161111||| Change the logging level.
162112|||
163113||| @l The new logging level.