-! 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 ;