loggin: some cleanup, particularly of write-message.

diff --git a/basis/logging/logging.factor b/basis/logging/logging.factor
index ae85af8def3c785af60a99ad811ab0869a5bc683..ab35bc500635fffdcd685d03966235df7217bb0c 100644 (file)
--- a/basis/logging/logging.factor
+++ b/basis/logging/logging.factor
@@ -21,11 +21,11 @@ log-level [ DEBUG ] initialize
         { WARNING 20 }\r
         { ERROR 30 }\r
         { CRITICAL 40 }\r
-    } ;\r
+    } ; inline\r
 \r
 ERROR: undefined-log-level ;\r
 \r
-: log-level<=> ( log-level log-level -- ? )\r
+: log-level<=> ( log-level log-level -- <=> )\r
     [ log-levels at* [ undefined-log-level ] unless ] compare ;\r
 \r
 : log? ( log-level -- ? )\r

diff --git a/basis/logging/server/server.factor b/basis/logging/server/server.factor
index 0a7daf310f819236369afb6053a3eeae88fe58de..440e192107b527c6d00ed78a6ca33a1da9317dab 100644 (file)
--- a/basis/logging/server/server.factor
+++ b/basis/logging/server/server.factor
@@ -1,14 +1,14 @@
 ! Copyright (C) 2008 Slava Pestov.\r
 ! See http://factorcode.org/license.txt for BSD license.\r
-USING: namespaces kernel io io.files io.pathnames io.directories\r
-io.encodings.utf8 calendar calendar.format sequences continuations\r
-destructors prettyprint assocs math.parser words debugger math\r
-combinators concurrency.messaging threads arrays init math.ranges\r
-strings ;\r
+USING: assocs calendar calendar.format combinators\r
+concurrency.messaging continuations debugger destructors init io\r
+io.directories io.encodings.utf8 io.files io.pathnames kernel\r
+literals math math.parser math.ranges namespaces sequences\r
+strings threads ;\r
 IN: logging.server\r
 \r
 : log-root ( -- string )\r
-    \ log-root get "logs" resource-path or ;\r
+    \ log-root get [ "logs" resource-path ] unless* ;\r
 \r
 : log-path ( service -- path )\r
     log-root prepend-path ;\r
@@ -26,32 +26,26 @@ SYMBOL: log-files
 : log-stream ( service -- stream )\r
     log-files get [ open-log-stream ] cache ;\r
 \r
-: multiline-header ( -- string ) 20 CHAR: - <string> ; foldable\r
+: timestamp-header. ( -- )\r
+    "[" write now (timestamp>rfc3339) "] " write ;\r
 \r
-: (write-message) ( msg word-name level multi? -- )\r
-    [\r
-        "[" write multiline-header write "] " write\r
-    ] [\r
-        "[" write now (timestamp>rfc3339) "] " write\r
-    ] if\r
-    write bl write ": " write print ;\r
+CONSTANT: multiline-header $[ 20 CHAR: - <string> ]\r
+\r
+: multiline-header. ( -- )\r
+    "[" write multiline-header write "] " write ;\r
 \r
 : write-message ( msg word-name level -- )\r
-    [ harvest ] 2dip {\r
-        { [ pick empty? ] [ 3drop ] }\r
-        { [ pick length 1 = ] [ [ first ] 2dip f (write-message) ] }\r
-        [\r
-            [ [ first ] 2dip f (write-message) ]\r
-            [ [ rest ] 2dip [ t (write-message) ] 2curry each ]\r
-            3bi\r
-        ]\r
-    } cond ;\r
+    [ harvest ] 2dip pick empty? [ 3drop ] [\r
+        timestamp-header.\r
+        [ write bl write ": " write print ] 2curry\r
+        [ multiline-header. ] swap interleave\r
+    ] if ;\r
 \r
 : (log-message) ( msg -- )\r
     #! msg: { msg word-name level service }\r
     first4 log-stream [ write-message flush ] with-output-stream* ;\r
 \r
-: try-dispose ( stream -- )\r
+: try-dispose ( obj -- )\r
     [ dispose ] curry [ error. ] recover ;\r
 \r
 : close-log ( service -- )\r
@@ -67,7 +61,8 @@ CONSTANT: keep-logs 10
 : ?delete-file ( path -- )\r
     dup exists? [ delete-file ] [ drop ] if ;\r
 \r
-: delete-oldest ( service -- ) keep-logs log# ?delete-file ;\r
+: delete-oldest ( service -- )\r
+    keep-logs log# ?delete-file ;\r
 \r
 : ?move-file ( old new -- )\r
     over exists? [ move-file ] [ 2drop ] if ;\r