]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/logging/parser/parser.factor
core, basis, extra: Remove DOS line endings from files.
[factor.git] / basis / logging / parser / parser.factor
index a359c9a25476a2d79eb525a7817903a135703e02..7e0520d86f92e66deda4c161151c81f3246f177c 100644 (file)
-! Copyright (C) 2008, 2010 Slava Pestov.\r
-! See http://factorcode.org/license.txt for BSD license.\r
-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 assocs prettyprint ;\r
-IN: logging.parser\r
-\r
-TUPLE: log-entry date level word-name message ;\r
-\r
-: string-of ( quot -- parser )\r
-    satisfy repeat0 [ >string ] action ; inline\r
-\r
-SYMBOL: multiline\r
-\r
-: 'date' ( -- parser )\r
-    [ "]" member? not ] string-of [\r
-        dup multiline-header =\r
-        [ drop multiline ] [ rfc3339>timestamp ] if\r
-    ] action\r
-    "[" "]" surrounded-by ;\r
-\r
-: 'log-level' ( -- parser )\r
-    log-levels keys [\r
-        [ name>> token ] keep [ nip ] curry action\r
-    ] map choice ;\r
-\r
-: 'word-name' ( -- parser )\r
-    [ " :" member? not ] string-of ;\r
-\r
-SYMBOL: malformed\r
-\r
-: 'malformed-line' ( -- parser )\r
-    [ drop t ] string-of\r
-    [ log-entry new swap >>message malformed >>level ] action ;\r
-\r
-: 'log-message' ( -- parser )\r
-    [ drop t ] string-of\r
-    [ 1vector ] action ;\r
-\r
-: 'log-line' ( -- parser )\r
-    [\r
-        'date' ,\r
-        " " token hide ,\r
-        'log-level' ,\r
-        " " token hide ,\r
-        'word-name' ,\r
-        ": " token hide ,\r
-        'log-message' ,\r
-    ] seq* [ first4 log-entry boa ] action\r
-    'malformed-line' 2choice ;\r
-\r
-PEG: parse-log-line ( string -- entry ) 'log-line' ;\r
-\r
-: malformed? ( line -- ? )\r
-    level>> malformed eq? ;\r
-\r
-: multiline? ( line -- ? )\r
-    level>> multiline eq? ;\r
-\r
-: malformed-line ( line -- )\r
-    "Warning: malformed log line:" print\r
-    message>> print ;\r
-\r
-: add-multiline ( line -- )\r
-    building get empty? [\r
-        "Warning: log begins with multiline entry" print drop\r
-    ] [\r
-        message>> first building get last message>> push\r
-    ] if ;\r
-\r
-: parse-log ( lines -- entries )\r
-    [\r
-        [\r
-            parse-log-line {\r
-                { [ dup malformed? ] [ malformed-line ] }\r
-                { [ dup multiline? ] [ add-multiline ] }\r
-                [ , ]\r
-            } cond\r
-        ] each\r
-    ] { } make ;\r
-\r
-: parse-log-file ( service -- entries )\r
-    log-path 1 log# dup exists?\r
-    [ utf8 file-lines parse-log ] [ drop f ] if ;\r
-\r
-GENERIC: log-timestamp. ( date -- )\r
-\r
-M: timestamp log-timestamp. (timestamp>string) ;\r
-M: word log-timestamp. drop "multiline" write ;\r
-\r
-: log-entry. ( entry -- )\r
-    "====== " write\r
-    {\r
-        [ date>> log-timestamp. bl ]\r
-        [ level>> pprint bl ]\r
-        [ word-name>> write nl ]\r
-        [ message>> "\n" join print ]\r
-    } cleave ;\r
-\r
-: log-entries. ( errors -- )\r
-    [ log-entry. ] each ;\r
+! Copyright (C) 2008, 2010 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+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 assocs prettyprint ;
+IN: logging.parser
+
+TUPLE: log-entry date level word-name message ;
+
+: string-of ( quot -- parser )
+    satisfy repeat0 [ >string ] action ; inline
+
+SYMBOL: multiline
+
+: 'date' ( -- parser )
+    [ "]" member? not ] string-of [
+        dup multiline-header =
+        [ drop multiline ] [ rfc3339>timestamp ] if
+    ] action
+    "[" "]" surrounded-by ;
+
+: 'log-level' ( -- parser )
+    log-levels keys [
+        [ name>> token ] keep [ nip ] curry action
+    ] map choice ;
+
+: 'word-name' ( -- parser )
+    [ " :" member? not ] string-of ;
+
+SYMBOL: malformed
+
+: 'malformed-line' ( -- parser )
+    [ drop t ] string-of
+    [ log-entry new swap >>message malformed >>level ] action ;
+
+: 'log-message' ( -- parser )
+    [ drop t ] string-of
+    [ 1vector ] action ;
+
+: 'log-line' ( -- parser )
+    [
+        'date' ,
+        " " token hide ,
+        'log-level' ,
+        " " token hide ,
+        'word-name' ,
+        ": " token hide ,
+        'log-message' ,
+    ] seq* [ first4 log-entry boa ] action
+    'malformed-line' 2choice ;
+
+PEG: parse-log-line ( string -- entry ) 'log-line' ;
+
+: malformed? ( line -- ? )
+    level>> malformed eq? ;
+
+: multiline? ( line -- ? )
+    level>> multiline eq? ;
+
+: malformed-line ( line -- )
+    "Warning: malformed log line:" print
+    message>> print ;
+
+: add-multiline ( line -- )
+    building get empty? [
+        "Warning: log begins with multiline entry" print drop
+    ] [
+        message>> first building get last message>> push
+    ] if ;
+
+: parse-log ( lines -- entries )
+    [
+        [
+            parse-log-line {
+                { [ dup malformed? ] [ malformed-line ] }
+                { [ dup multiline? ] [ add-multiline ] }
+                [ , ]
+            } cond
+        ] each
+    ] { } make ;
+
+: parse-log-file ( service -- entries )
+    log-path 1 log# dup exists?
+    [ utf8 file-lines parse-log ] [ drop f ] if ;
+
+GENERIC: log-timestamp. ( date -- )
+
+M: timestamp log-timestamp. (timestamp>string) ;
+M: word log-timestamp. drop "multiline" write ;
+
+: log-entry. ( entry -- )
+    "====== " write
+    {
+        [ date>> log-timestamp. bl ]
+        [ level>> pprint bl ]
+        [ word-name>> write nl ]
+        [ message>> "\n" join print ]
+    } cleave ;
+
+: log-entries. ( errors -- )
+    [ log-entry. ] each ;