Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...

[factor.git] / basis / logging / server / server.factor

diff --git a/basis/logging/server/server.factor b/basis/logging/server/server.factor
old mode 100755 (executable)
new mode 100644 (file)
index d13ae61..848ad5d
--- a/basis/logging/server/server.factor
+++ b/basis/logging/server/server.factor
@@ -1,10 +1,10 @@
 ! Copyright (C) 2008 Slava Pestov.\r
 ! See http://factorcode.org/license.txt for BSD license.\r
-USING: namespaces kernel io calendar sequences io.files\r
-io.sockets continuations destructors prettyprint assocs\r
-math.parser words debugger math combinators\r
-concurrency.messaging threads arrays init math.ranges strings\r
-calendar.format io.encodings.utf8 ;\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
 IN: logging.server\r
 \r
 : log-root ( -- string )\r
@@ -26,9 +26,9 @@ SYMBOL: log-files
 : log-stream ( service -- stream )\r
     log-files get [ open-log-stream ] cache ;\r
 \r
-: multiline-header 20 CHAR: - <string> ; foldable\r
+: multiline-header ( -- string ) 20 CHAR: - <string> ; foldable\r
 \r
-: (write-message) ( msg name>> level multi? -- )\r
+: (write-message) ( msg word-name level multi? -- )\r
     [\r
         "[" write multiline-header write "] " write\r
     ] [\r
@@ -36,18 +36,19 @@ SYMBOL: log-files
     ] if\r
     write bl write ": " write print ;\r
 \r
-: write-message ( msg name>> level -- )\r
-    rot harvest {\r
-        { [ dup empty? ] [ 3drop ] }\r
-        { [ dup length 1 = ] [ first -rot f (write-message) ] }\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 -rot f (write-message) ] 3keep\r
-            rest -rot [ t (write-message) ] 2curry each\r
+            [ [ first ] 2dip f (write-message) ]\r
+            [ [ rest ] 2dip [ t (write-message) ] 2curry each ]\r
+            3bi\r
         ]\r
     } cond ;\r
 \r
 : (log-message) ( msg -- )\r
-    #! msg: { msg name>> level service }\r
+    #! msg: { msg word-name level service }\r
     first4 log-stream [ write-message flush ] with-output-stream* ;\r
 \r
 : try-dispose ( stream -- )\r
@@ -62,7 +63,7 @@ SYMBOL: log-files
     dup values [ try-dispose ] each\r
     clear-assoc ;\r
 \r
-: keep-logs 10 ;\r
+CONSTANT: keep-logs 10\r
 \r
 : ?delete-file ( path -- )\r
     dup exists? [ delete-file ] [ drop ] if ;\r
@@ -73,7 +74,7 @@ SYMBOL: log-files
     over exists? [ move-file ] [ 2drop ] if ;\r
 \r
 : advance-log ( path n -- )\r
-    [ 1- log# ] 2keep log# ?move-file ;\r
+    [ 1 - log# ] 2keep log# ?move-file ;\r
 \r
 : rotate-log ( service -- )\r
     dup close-log\r
@@ -83,7 +84,7 @@ SYMBOL: log-files
 \r
 : (rotate-logs) ( -- )\r
     (close-logs)\r
-    log-root directory [ drop rotate-log ] assoc-each ;\r
+    log-root directory-files [ rotate-log ] each ;\r
 \r
 : log-server-loop ( -- )\r
     receive unclip {\r