git.iko.soy/Idris-dev
on master help sign in
Renamed Logging Effects, improved simple logger
40481dcJan de Muijnck-Hughes
libs/effects/Effect/Logging.idr → libs/effects/Effect/Logging/Category.idrrenamed+23−73
compare with master
unifiedsplit
@@ -1,88 +1,29 @@
1−-- ------------------------------------------------------------- [ Logging.idr ]
1+-- ------------------------------------------------------------ [ Category.idr ]
2−-- Module : Logging.idr
2+-- Module : Category.idr
3-- Copyright : (c) The Idris Community
3-- Copyright : (c) The Idris Community
4-- License : see LICENSE
4-- License : see LICENSE
5-- --------------------------------------------------------------------- [ EOH ]
5-- --------------------------------------------------------------------- [ EOH ]
6−
7||| A logging effect that allows messages to be logged using both
6||| A logging effect that allows messages to be logged using both
8||| numerical levels and user specified categories. The higher the
7||| numerical levels and user specified categories. The higher the
9||| logging level the grater in verbosity the logging.
8||| logging level the grater in verbosity the logging.
10|||
9|||
11||| In this effect the resource we are computing over is the logging
10||| In this effect the resource we are computing over is the logging
12||| level itself and the list of categories to show.
11||| level itself and the list of categories to show.
13−|||
14−module Effect.Logging
12+module Effect.Logging.Category
15
13
16import Effects
14import Effects
15+import public Effect.Logging.Level
17
16
18%access public
17%access public
19
18
20−-- ---------------------------------------------------- [ Log Level Definition ]
19+-- -------------------------------------------------------- [ Logging Resource ]
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
79
20
80||| The Logging details, this is the resource that the effect is
21||| The Logging details, this is the resource that the effect is
81||| defined over.
22||| defined over.
82record LogRes (a : Type) where
23record LogRes (a : Type) where
83 constructor MkLogRes
24 constructor MkLogRes
84− lvl : LogLevel n
25+ getLevel : LogLevel n
85− cats : List a
26+ getCategories : List a
86
27
87instance (Show a) => Show (LogRes a) where
28instance (Show a) => Show (LogRes a) where
88 show (MkLogRes l cs) = unwords ["Log Settings:", show l, show cs]
29 show (MkLogRes l cs) = unwords ["Log Settings:", show l, show cs]
@@ -90,6 +31,8 @@ instance (Show a) => Show (LogRes a) where
90instance Default (LogRes a) where
31instance Default (LogRes a) where
91 default = MkLogRes OFF Nil
32 default = MkLogRes OFF Nil
92
33
34+-- ------------------------------------------------------- [ Effect Definition ]
35+
93||| A Logging effect to log levels and categories.
36||| A Logging effect to log levels and categories.
94data Logging : Effect where
37data Logging : Effect where
95 ||| Log a message.
38 ||| Log a message.
@@ -126,12 +69,14 @@ data Logging : Effect where
126 (ncats : List a) ->
69 (ncats : List a) ->
127 sig Logging () (LogRes a) (LogRes a)
70 sig Logging () (LogRes a) (LogRes a)
128
71
72+-- -------------------------------------------------------------- [ IO Handler ]
73+
129instance Handler Logging IO where
74instance Handler Logging IO where
130 handle st (SetLogLvl nlvl) k = do
75 handle st (SetLogLvl nlvl) k = do
131− let newSt = record {lvl = nlvl} st
76+ let newSt = record {getLevel = nlvl} st
132 k () newSt
77 k () newSt
133 handle st (SetLogCats newcs) k = do
78 handle st (SetLogCats newcs) k = do
134− let newSt = record {cats = newcs} st
79+ let newSt = record {getCategories = newcs} st
135 k () newSt
80 k () newSt
136
81
137 handle st (InitLogger l cs) k = do
82 handle st (InitLogger l cs) k = do
@@ -139,25 +84,30 @@ instance Handler Logging IO where
139 k () newSt
84 k () newSt
140
85
141 handle st (Log l cs' msg) k = do
86 handle st (Log l cs' msg) k = do
142− case cmpLevel l (lvl st) of
87+ case cmpLevel l (getLevel st) of
143 GT => k () st
88 GT => k () st
144 otherwise => do
89 otherwise => do
145− let res = and $ map (\x => elem x cs') (cats st)
90+ let res = and $ map (\x => elem x cs') (getCategories st)
146− let prompt = if isNil (cats st)
91+ let prompt = if isNil (getCategories st)
147 then unwords [show l, ":"]
92 then unwords [show l, ":"]
148− else unwords [show l, ":", show (cats st), ":"]
93+ else unwords [show l, ":", show (getCategories st), ":"]
149− if res || isNil (cats st)
94+ if res || isNil (getCategories st)
150 then do
95 then do
151 putStrLn $ unwords [prompt, msg]
96 putStrLn $ unwords [prompt, msg]
152 k () st
97 k () st
153 else k () st
98 else k () st
154
99
100+
101+-- ------------------------------------------------------- [ Effect Descriptor ]
102+
155||| The Logging effect.
103||| The Logging effect.
156|||
104|||
157||| @cTy The type used to differentiate categories.
105||| @cTy The type used to differentiate categories.
158LOG : (cTy : Type) -> EFFECT
106LOG : (cTy : Type) -> EFFECT
159LOG cTy = MkEff (LogRes cTy) Logging
107LOG cTy = MkEff (LogRes cTy) Logging
160
108
109+-- ----------------------------------------------------------- [ Effectful API ]
110+
161||| Change the logging level.
111||| Change the logging level.
162|||
112|||
163||| @l The new logging level.
113||| @l The new logging level.
libs/effects/Effect/Logging/Default.idrnew file+109
@@ -0,0 +1,109 @@
1+-- ------------------------------------------------------------- [ Default.idr ]
2+-- Module : Default.idr
3+-- Copyright : (c) The Idris Community
4+-- License : see LICENSE
5+--------------------------------------------------------------------- [ EOH ]
6+||| The default logging effect that allows messages to be logged at
7+||| different numerical levels. The higher the number the greater in
8+||| verbosity the logging.
9+|||
10+||| In this effect the resource we are computing over is the logging
11+||| level itself.
12+|||
13+module Effect.Logging.Default
14+
15+import Effects
16+import public Effect.Logging.Level
17+
18+-- ------------------------------------------------------------ [ The Resource ]
19+
20+||| The resource that the log effect is defined over.
21+record LogRes where
22+ constructor MkLogRes
23+ getLevel : LogLevel n
24+
25+instance Default LogRes where
26+ default = MkLogRes OFF
27+
28+-- ------------------------------------------------------ [ The Logging Effect ]
29+
30+||| A Logging effect that displays a logging message to be logged at a
31+||| certain level.
32+data Logging : Effect where
33+ ||| Change the logging level.
34+ |||
35+ ||| @lvl The new logging level.
36+ SetLvl : (lvl : LogLevel n)
37+ -> sig Logging () (LogRes) (LogRes)
38+
39+ ||| Log a message.
40+ |||
41+ ||| @lvl The logging level it should appear at.
42+ ||| @msg The message to log.
43+ Log : (lvl : LogLevel n)
44+ -> (msg : String)
45+ -> sig Logging () (LogRes)
46+
47+-- -------------------------------------------------------------- [ IO Handler ]
48+
49+-- For logging in the IO context
50+instance Handler Logging IO where
51+ handle st (SetLvl newLvl) k = k () (MkLogRes newLvl)
52+ handle st (Log lvl msg) k = do
53+ case cmpLevel lvl (getLevel st) of
54+ GT => k () st
55+ otherwise => do
56+ putStrLn $ unwords [show lvl, ":", msg]
57+ k () st
58+
59+-- ------------------------------------------------------- [ Effect Descriptor ]
60+
61+||| A Logging Effect.
62+LOG : EFFECT
63+LOG = MkEff (LogRes) Logging
64+
65+-- ----------------------------------------------------------- [ Effectful API ]
66+
67+||| Set the logging level.
68+|||
69+||| @l The new logging level.
70+setLogLvl : (l : LogLevel n) -> Eff () [LOG]
71+setLogLvl l = call $ SetLvl l
72+
73+||| Log `msg` at the given level.
74+|||
75+||| @l The level to log.
76+||| @m The message to log.
77+log : (l : Nat) -> {auto prf : LTE l 70} -> (m : String) -> Eff () [LOG]
78+log l msg = call $ Log (getProof lvl) msg
79+ where
80+ lvl : (n ** LogLevel n)
81+ lvl = case cast {to=String} (cast {to=Int} l) of
82+ "0" => (_ ** OFF)
83+ "10" => (_ ** TRACE)
84+ "20" => (_ ** DEBUG)
85+ "30" => (_ ** INFO)
86+ "40" => (_ ** WARN)
87+ "50" => (_ ** FATAL)
88+ "60" => (_ ** ERROR)
89+ _ => (_ ** CUSTOM l)
90+
91+trace : String -> Eff () [LOG]
92+trace msg = call $ Log TRACE msg
93+
94+debug : String -> Eff () [LOG]
95+debug msg = call $ Log DEBUG msg
96+
97+info : String -> Eff () [LOG]
98+info msg = call $ Log INFO msg
99+
100+warn : String -> Eff () [LOG]
101+warn msg = call $ Log WARN msg
102+
103+fatal : String -> Eff () [LOG]
104+fatal msg = call $ Log FATAL msg
105+
106+error : String -> Eff () [LOG]
107+error msg = call $ Log ERROR msg
108+
109+-- --------------------------------------------------------------------- [ EOF ]
libs/effects/Effect/Logging/Level.idrnew file+81
@@ -0,0 +1,81 @@
1+-- --------------------------------------------------------------- [ Level.idr ]
2+-- Module : Level.idr
3+-- Copyright : (c) The Idris Community
4+-- License : see LICENSE
5+-- --------------------------------------------------------------------- [ EOH ]
6+||| A dependently typed logging level representation where logging
7+||| levels are based on a Natural number range [0,70].
8+|||
9+||| The `LogLevel` type allows for semantic constructors to be used
10+||| for the majority of logging levels, with an option for custom
11+||| levels to be defined.
12+|||
13+||| The logging level design comes from the Log4j/Python family of
14+||| loggers.
15+module Effect.Logging.Level
16+
17+%access public
18+%default total
19+
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+||| Compare to logging levels.
78+cmpLevel : LogLevel a -> LogLevel b -> Ordering
79+cmpLevel {a} {b} _ _ = compare a b
80+
81+-- --------------------------------------------------------------------- [ EOF ]
libs/effects/Effect/Logging/Simple.idrdeleted−54
@@ -1,54 +0,0 @@
1−-- -------------------------------------------------------------- [ Simple.idr ]
2−-- Module : Logging.idr
3−-- Copyright : (c) The Idris Community
4−-- License : see LICENSE
5−--------------------------------------------------------------------- [ EOH ]
6−
7−||| A simple logging effect that allows messages to be logged at
8−||| different numerical level. The higher the number the grater in
9−||| verbosity the logging.
10−|||
11−||| In this effect the resource we are computing over is the logging
12−||| level itself.
13−|||
14−module Effect.Logging.Simple
15−
16−import Effects
17−
18−||| A Logging effect that displays a logging message to be logged at a
19−||| certain level.
20−data Logging : Effect where
21− SetLvl : (lvl : Nat)
22− -> sig Logging () Nat Nat
23− Log : (lvl : Nat)
24− -> (msg : String)
25− -> sig Logging () Nat
26−
27−||| A Logging Effect.
28−LOG : EFFECT
29−LOG = MkEff Nat Logging
30−
31−-- For logging in the IO context
32−instance Handler Logging IO where
33− handle st (SetLvl newL) k = k () st
34− handle st (Log lvl msg) k = do
35− case lvl <= st of
36− False => k () st
37− True => do
38− putStrLn $ unwords [show lvl, ":", msg]
39− k () st
40−
41−||| Set the logging level.
42−|||
43−||| @l The new logging level.
44−setLogLvl : (l : Nat) -> Eff () [LOG]
45−setLogLvl l = call $ SetLvl l
46−
47−||| Log `msg` at the given level.
48−|||
49−||| @l The level to log.
50−||| @m The message to log.
51−log : (l : Nat) -> (m : String) -> Eff () [LOG]
52−log lvl msg = call $ Log lvl msg
53−
54−-- --------------------------------------------------------------------- [ EOF ]
libs/effects/effects.ipkg+3−2
@@ -15,5 +15,6 @@ modules = Effects
15 , Effect.Memory
15 , Effect.Memory
16 , Effect.System
16 , Effect.System
17 , Effect.Trans
17 , Effect.Trans
18− , Effect.Logging
18+ , Effect.Logging.Level
19− , Effect.Logging.Simple
19+ , Effect.Logging.Default
20+ , Effect.Logging.Category