@@ 1,5 1,5 @@ 
 
-example:	example.mlb log.mlb log.sig log.sml example.sml
+example:	example.mlb log.mlb log.sig log.sml example.sml category-log-fn.sml
 	mlton example.mlb
 	./example
 

          

@@ 0,0 1,106 @@ 
+
+(** Create a logger that prepends a category name to every line it
+    logs, and that logs at debug and info levels only if that category
+    is enabled. (Warnings and errors are always logged if the log
+    level is appropriate; the category is ignored for these.)
+
+    A category is enabled if any of the following is true:
+
+    1. The LOGCATS environment variable is not set. (i.e. the default
+       is to log all categories.)
+
+    2. The LOGCATS environment variable is set to a comma-separated
+       list of categories, and the list contains the category in
+       question.
+
+    3. The LOGCATS environment variable is set to a comma-separated
+       list of categories, one of them is the special category *
+       meaning "all", and the list does not contain an entry which is
+       the category in question prefixed by the character "-".
+
+    For example, the category "foo" would be logged if LOGCATS was
+    unset or was set to any of the strings "foo", "bar,foo", "*",
+    "*,-bar", "bar,*", or "*,foo" (though this last one is redundant
+    as * already includes foo). The category foo would not be logged
+    if LOGCATS was set to "", "bar", "*,-foo", "-foo,*", or
+    "*,-bar,-foo" among other things.
+*)
+functor CategoryLogFn (ARG : sig
+                           val category : string
+                       end)
+        : LOG
+    = struct
+
+    open Log
+
+    val should : bool option ref = ref NONE
+             
+    fun shouldLog () =
+        case !should of
+            SOME s => s
+          | NONE => 
+            let val s =
+                    case OS.Process.getEnv "LOGCATS" of
+                        NONE => true
+                      | SOME str =>
+                        let val cats = (String.tokens (fn #"," => true
+                                                        | _ => false)
+                                                      str)
+                        in
+                            List.exists (fn c => c = ARG.category) cats
+                            orelse
+                            (List.exists (fn c => c = "*") cats andalso
+                             (not (List.exists
+                                       (fn c => c = "-" ^ ARG.category)
+                                       cats)))
+                        end
+            in
+                should := SOME s;
+                s
+            end
+             
+    val prefix =
+        String.concatWith
+            "%%"
+            (String.fields
+                 (fn #"%" => true | _ => false)
+                 (StringInterpolate.interpolate "[%1] " [ARG.category]))
+
+    fun adapt arg =
+        case arg of
+            [] => []
+          | format :: args => (prefix ^ format) :: args
+        
+    fun log level f =
+        if (case (level, shouldLog ()) of
+                (ERROR, _) => true
+              | (WARN, _) => true
+              | (_, s) => s)
+        then Log.log level (fn () => adapt (f ()))
+        else ()
+            
+    val debug = log DEBUG
+    val info = log INFO
+    val warn = log WARN
+    val error = log ERROR
+
+    fun fatal f =
+        Log.fatal (fn () => adapt (f ()))
+                    
+    fun log_d level arg =
+        if (case (level, shouldLog ()) of
+                (ERROR, _) => true
+              | (WARN, _) => true
+              | (_, s) => s)
+        then Log.log_d level (adapt arg)
+        else ()
+            
+    val debug_d = log_d DEBUG
+    val info_d = log_d INFO
+    val warn_d = log_d WARN
+    val error_d = log_d ERROR
+
+    fun fatal_d arg =
+        Log.fatal_d (adapt arg)
+
+end

          

@@ 2,3 2,4 @@ 
 ../sml-stringinterpolate/string-interpolate.mlb
 log.sig
 log.sml
+category-log-fn.sml

          

@@ 24,7 24,9 @@ 
     to actually print the resulting message.
 
     Various functions to adjust the global log level and formatting
-    are also provided.
+    are also provided. The default logger refers to the LOGLEVEL
+    environment variable (with possible values debug, info, warn, or
+    error) to set the log level at startup.
 
     See also STRING_INTERPOLATE for details of the string
     interpolation and conversion mechanisms.

          
@@ 143,7 145,7 @@ signature LOG = sig
         arguments, if the current log level is at least as severe as the
         given one. *)
     val log_d : level -> arg -> unit
-
+                                    
     (** Same as StringInterpolate.interpolate, exposed for convenience *)
     val interpolate : string -> string list -> string