Logging no longer uses parser combinators

extra/logging/analysis/analysis.factor

@@ -1,8 +1,9 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences namespaces words assocs logging sorting
-prettyprint io io.styles strings logging.parser calendar.format
+prettyprint io io.styles io.files io.encodings.utf8
-combinators ;
+strings combinators
+logging.server logging.parser calendar.format ;
 IN: logging.analysis
 
 SYMBOL: word-names
@@ -69,3 +70,6 @@ SYMBOL: message-histogram
 
 : analyze-log ( lines word-names -- )
     >r parse-log r> analyze-entries analysis. ;
+
+: analyze-log-file ( service word-names -- )
+    >r parse-log-file r> analyze-entries analysis. ;

extra/logging/insomniac/insomniac.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: logging.analysis logging.server logging smtp kernel
 io.files io.streams.string namespaces alarms assocs
-io.encodings.utf8 accessors calendar qualified ;
+io.encodings.utf8 accessors calendar sequences qualified ;
 QUALIFIED: io.sockets
 IN: logging.insomniac
 
@@ -10,11 +10,7 @@ SYMBOL: insomniac-sender
 SYMBOL: insomniac-recipients
 
 : ?analyze-log ( service word-names -- string/f )
-    >r log-path 1 log# dup exists? [
+    [ analyze-log-file ] with-string-writer ;
-        utf8 file-lines r> [ analyze-log ] with-string-writer
-    ] [
-        r> 2drop f
-    ] if ;
 
 : email-subject ( service -- string )
     [
@@ -22,14 +18,14 @@ SYMBOL: insomniac-recipients
     ] "" make ;
 
 : (email-log-report) ( service word-names -- )
-    dupd ?analyze-log dup [
+    dupd ?analyze-log dup empty? [ 2drop ] [
         <email>
             swap >>body
             insomniac-recipients get >>to
             insomniac-sender get >>from
             swap email-subject >>subject
         send-email
-    ] [ 2drop ] if ;
+    ] if ;
 
 \ (email-log-report) NOTICE add-error-logging
 

extra/logging/parser/parser.factor

@@ -1,12 +1,15 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors parser-combinators memoize kernel sequences
+USING: accessors peg peg.parsers memoize kernel sequences
-logging arrays words strings vectors io io.files
+logging arrays words strings vectors io io.files io.encodings.utf8
 namespaces combinators combinators.lib logging.server
 calendar calendar.format ;
 IN: logging.parser
 
-: string-of ( quot -- parser ) satisfy <!*> [ >string ] <@ ;
+TUPLE: log-entry date level word-name message ;
+
+: string-of ( quot -- parser )
+    satisfy repeat0 [ >string ] action ; inline
 
 SYMBOL: multiline
 
@@ -14,13 +17,13 @@ SYMBOL: multiline
     [ "]" member? not ] string-of [
         dup multiline-header =
         [ drop multiline ] [ rfc3339>timestamp ] if
-    ] <@
+    ] action
     "[" "]" surrounded-by ;
 
 : 'log-level' ( -- parser )
     log-levels [
-        [ name>> token ] keep [ nip ] curry <@
+        [ name>> token ] keep [ nip ] curry action
-    ] map <or-parser> ;
+    ] map choice ;
 
 : 'word-name' ( -- parser )
     [ " :" member? not ] string-of ;
@@ -28,36 +31,42 @@ SYMBOL: multiline
 SYMBOL: malformed
 
 : 'malformed-line' ( -- parser )
-    [ drop t ] string-of [ malformed swap 2array ] <@ ;
+    [ drop t ] string-of
+    [ log-entry new swap >>message malformed >>level ] action ;
 
 : 'log-message' ( -- parser )
-    [ drop t ] string-of [ 1vector ] <@ ;
+    [ drop t ] string-of
+    [ 1vector ] action ;
 
-MEMO: 'log-line' ( -- parser )
+: 'log-line' ( -- parser )
-    'date' " " token <&
+    [
-    'log-level' " " token <& <&>
+        'date' ,
-    'word-name' ": " token <& <:&>
+        " " token hide ,
-    'log-message' <:&>
+        'log-level' ,
-    'malformed-line' <|> ;
+        " " token hide ,
+        'word-name' ,
+        ": " token hide ,
+        'log-message' ,
+    ] seq* [ first4 log-entry boa ] action
+    'malformed-line' 2choice ;
 
-: parse-log-line ( string -- entry )
+PEG: parse-log-line ( string -- entry ) 'log-line' ;
-    'log-line' parse-1 ;
 
 : malformed? ( line -- ? )
-    first malformed eq? ;
+    level>> malformed eq? ;
 
 : multiline? ( line -- ? )
-    first multiline eq? ;
+    level>> multiline eq? ;
 
 : malformed-line ( line -- )
     "Warning: malformed log line:" print
-    second print ;
+    message>> print ;
 
 : add-multiline ( line -- )
     building get empty? [
         "Warning: log begins with multiline entry" print drop
     ] [
-        fourth first building get peek fourth push
+        message>> first building get peek message>> push
     ] if ;
 
 : parse-log ( lines -- entries )
@@ -70,3 +79,7 @@ MEMO: 'log-line' ( -- parser )
             } cond
         ] each
     ] { } make ;
+
+: parse-log-file ( service -- entries )
+    log-path 1 log# dup exists?
+    [ utf8 file-lines parse-log ] [ drop f ] if ;