with-logging takes a log-level, more docs

basis/logging/insomniac/insomniac.factor

@@ -30,7 +30,7 @@ SYMBOL: insomniac-recipients
 \ (email-log-report) NOTICE add-error-logging
 
 : email-log-report ( service word-names -- )
-    "logging.insomniac" [ (email-log-report) ] with-logging ;
+    "logging.insomniac" DEBUG [ (email-log-report) ] with-logging ;
 
 : schedule-insomniac ( service word-names -- )
     [ [ email-log-report ] assoc-each rotate-logs ] 2curry

basis/logging/logging-docs.factor

@@ -8,6 +8,9 @@ HELP: DEBUG
 HELP: NOTICE
 { $description "Log level for ordinary messages." } ;
 
+HELP: WARNING
+{ $description "Log level for warnings." } ;
+
 HELP: ERROR
 { $description "Log level for error messages." } ;
 
@@ -18,6 +21,7 @@ ARTICLE: "logging.levels" "Log levels"
 "Several log levels are supported, from lowest to highest:"
 { $subsection DEBUG }
 { $subsection NOTICE }
+{ $subsection WARNING }
 { $subsection ERROR }
 { $subsection CRITICAL } ;
 
@@ -36,7 +40,7 @@ ARTICLE: "logging.files" "Log files"
 
 HELP: log-message
 { $values { "msg" string } { "word" word } { "level" "a log level" } }
-{ $description "Sends a message to the current log. Does nothing if not executing in a dynamic scope established by " { $link with-logging } "." } ;
+{ $description "Sends a message to the current log if the level is more urgent than " { $link log-level } ". Does nothing if not executing in a dynamic scope established by " { $link with-logging } "." } ;
 
 HELP: add-logging
 { $values { "level" "a log level" } { "word" word } }
@@ -90,8 +94,8 @@ HELP: close-logs
 { $description "Closes all open log streams. Subsequent logging will re-open the streams. This should be used before moving or deleting log files." } ;
 
 HELP: with-logging
-{ $values { "service" "a log service name" } { "quot" quotation } }
-{ $description "Calls the quotation a new dynamic scope where all logging calls are sent to the log file for " { $snippet "service" } "." } ;
+{ $values { "service" "a log service name" } { "level" "a log level" } { "quot" quotation } }
+{ $description "Calls the quotation a new dynamic scope where all logging calls more urgent than " { $link log-level } " are sent to the log file for " { $snippet "service" } "." } ;
 
 ARTICLE: "logging.rotation" "Log rotation"
 "Log files should be rotated periodically to prevent unbounded growth."
@@ -120,4 +124,3 @@ ARTICLE: "logging" "Logging framework"
 { $subsection "logging.server" } ;
 
 ABOUT: "logging"
-

basis/logging/logging.factor

@@ -4,12 +4,29 @@ USING: logging.server sequences namespaces concurrency.messaging
 words kernel arrays shuffle tools.annotations
 prettyprint.config prettyprint debugger io.streams.string
 splitting continuations effects generalizations parser strings
-quotations fry accessors ;
+quotations fry accessors math assocs math.order ;
 IN: logging
 
 SYMBOLS: DEBUG NOTICE WARNING ERROR CRITICAL ;
 
-: log-levels { DEBUG NOTICE NOTICE WARNING ERROR CRITICAL } ;
+SYMBOL: log-level
+
+: log-levels ( -- assoc )
+    H{
+        { DEBUG 0 }
+        { NOTICE 10 }
+        { WARNING 20 }
+        { ERROR 30 }
+        { CRITICAL 40 }
+    } ;
+
+ERROR: undefined-log-level ;
+
+: log-level<=> ( log-level log-level -- ? )
+    [ log-levels at* [ undefined-log-level ] unless ] bi@ <=> ;
+
+: log? ( log-level -- ? )
+    log-level get log-level<=> +lt+ = not ;
 
 : send-to-log-server ( array string -- )
     prefix "log-server" get send ;
@@ -22,7 +39,8 @@ SYMBOL: log-service
 
 : log-message ( msg word level -- )
     check-log-message
-    log-service get dup [
+    dup log?
+    log-service get dup and [
         [ [ string-lines ] [ name>> ] [ name>> ] tri* ] dip
         4array "log-message" send-to-log-server
     ] [
@@ -35,8 +53,10 @@ SYMBOL: log-service
 : close-logs ( -- )
     { } "close-logs" send-to-log-server ;
 
-: with-logging ( service quot -- )
-    log-service swap with-variable ; inline
+: with-logging ( service level quot -- )
+    '[
+        _ log-service [ _ log-level _ with-variable ] with-variable
+    ] call ; inline
 
 ! Aspect-oriented programming idioms
 

basis/logging/parser/parser.factor

@@ -3,7 +3,7 @@
 USING: accessors peg peg.parsers memoize kernel sequences
 logging arrays words strings vectors io io.files
 io.encodings.utf8 namespaces make combinators logging.server
-calendar calendar.format ;
+calendar calendar.format assocs ;
 IN: logging.parser
 
 TUPLE: log-entry date level word-name message ;
@@ -21,7 +21,7 @@ SYMBOL: multiline
     "[" "]" surrounded-by ;
 
 : 'log-level' ( -- parser )
-    log-levels [
+    log-levels keys [
         [ name>> token ] keep [ nip ] curry action
     ] map choice ;