log: add critical due to error level inflation

rr0gi · rr0gi · commit f1b26ec783fa · 2026-04-21T17:04:19.000-04:00
diff --git a/log.ml b/log.ml
@@ -133,7 +133,7 @@ let set_utc () = State.utc_timezone := true
     By default, it reads the configuration in the environment variable [DEVKIT_LOG]
     which can be overwritten using the optional [process_name] parameter.
 
-    The value of environment variable should match the following grammar: [(\[<facil|prefix*>=\]debug|info|warn|error\[,\])*]
+    The value of environment variable should match the following grammar: [(\[<facil|prefix*>=\]debug|info|warn|error|critical\[,\])*]
 
     @raise Failure on invalid level values of wrong format
 *)
@@ -184,12 +184,14 @@ let debug_s = make_s debug_s in
 let warn_s = make_s warn_s in
 let info_s = make_s info_s in
 let error_s = make_s error_s in
+let critical_s = make_s critical_s in
 let put_s level = make_s (put_s level) in
 object
 method debug_s = debug_s
 method warn_s = warn_s
 method info_s = info_s
 method error_s = error_s
+method critical_s = critical_s
 method put_s = put_s
 
 (* expecting direct inlining to be faster but it is not o_O
@@ -201,6 +203,7 @@ method debug : 'a. 'a pr = make debug_s
 method warn : 'a. 'a pr = make warn_s
 method info : 'a. 'a pr = make info_s
 method error : 'a. 'a pr = make error_s
+method critical : 'a. 'a pr = make critical_s
 method put : 'a. Logger.level -> 'a pr = fun level -> make (put_s level)
 
 method allow (level:Logger.level) = Logger.set_filter facil level
diff --git a/logger.ml b/logger.ml
@@ -1,35 +1,39 @@
 
 open Printf
 
-type level = [`Debug | `Info | `Warn | `Error | `Nothing]
+type level = [`Debug | `Info | `Warn | `Error | `Critical | `Nothing]
 type facil = { name : string; mutable show : int; }
 let int_level = function
   | `Debug -> 0
   | `Info -> 1
   | `Warn -> 2
   | `Error -> 3
+  | `Critical -> 4
   | `Nothing -> 100
 let set_filter facil level = facil.show <- int_level level
 let get_level facil = match facil.show with
   | 0 -> `Debug
   | 1 -> `Info
   | 2 -> `Warn
+  | 3 -> `Error
   | x when x = 100 -> `Nothing
-  | _ -> `Error (* ! *)
+  | _ -> `Critical (* ! *)
 let allowed facil level = level <> `Nothing && int_level level >= facil.show
 
 let string_level = function
   | `Debug -> "debug"
   | `Info -> "info"
   | `Warn -> "warn"
   | `Error -> "error"
+  | `Critical -> "critical"
   | `Nothing -> "nothing"
 
 let level = function
   | "info" -> `Info
   | "debug" -> `Debug
   | "warn" -> `Warn
   | "error" -> `Error
+  | "critical" -> `Critical
   | "nothing" -> `Nothing
   | s -> Exn.fail "unrecognized level %s" s
 
@@ -86,11 +90,13 @@ module Make(T : Put) = struct
   let info_s = T.put `Info
   let warn_s = T.put `Warn
   let error_s = T.put `Error
+  let critical_s = T.put `Critical
   let put_s = T.put
 
   let debug f fmt = ksprintf (debug_s f) fmt
   let info f fmt = ksprintf (info_s f) fmt
   let warn f fmt = ksprintf (warn_s f) fmt
   let error f fmt = ksprintf (error_s f) fmt
+  let critical f fmt = ksprintf (critical_s f) fmt
 
 end
