with-logging takes a log-level, more docs

diff --git a/basis/logging/insomniac/insomniac.factor b/basis/logging/insomniac/insomniac.factor
index 91baae631f507dfdeea5f92fac3c954e3d1762cd..935326da2d45eea602a97fb45cfbbaf1c406a33c 100644 (file)
--- a/basis/logging/insomniac/insomniac.factor
+++ b/basis/logging/insomniac/insomniac.factor
@@ -30,7 +30,7 @@ SYMBOL: insomniac-recipients
 \ (email-log-report) NOTICE add-error-logging\r
 \r
 : email-log-report ( service word-names -- )\r
-    "logging.insomniac" [ (email-log-report) ] with-logging ;\r
+    "logging.insomniac" DEBUG [ (email-log-report) ] with-logging ;\r
 \r
 : schedule-insomniac ( service word-names -- )\r
     [ [ email-log-report ] assoc-each rotate-logs ] 2curry\r

diff --git a/basis/logging/logging-docs.factor b/basis/logging/logging-docs.factor
index 275d900f3dff82c29120d396d930bff0bfb22816..64956493c6ff4896fb561334872b99a7fcdbbec2 100644 (file)
--- a/basis/logging/logging-docs.factor
+++ b/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"
-

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

diff --git a/basis/logging/parser/parser.factor b/basis/logging/parser/parser.factor
index 07a84ec5c6973f3c02730f31d83dbe404370701a..5406d8fcd0796d1e4a82377e4f3601df5270aa17 100644 (file)
--- a/basis/logging/parser/parser.factor
+++ b/basis/logging/parser/parser.factor
@@ -3,7 +3,7 @@
 USING: accessors peg peg.parsers memoize kernel sequences\r
 logging arrays words strings vectors io io.files\r
 io.encodings.utf8 namespaces make combinators logging.server\r
-calendar calendar.format ;\r
+calendar calendar.format assocs ;\r
 IN: logging.parser\r
 \r
 TUPLE: log-entry date level word-name message ;\r
@@ -21,7 +21,7 @@ SYMBOL: multiline
     "[" "]" surrounded-by ;\r
 \r
 : 'log-level' ( -- parser )\r
-    log-levels [\r
+    log-levels keys [\r
         [ name>> token ] keep [ nip ] curry action\r
     ] map choice ;\r
 \r