basis/logging/parser/parser.factor

   1 ! Copyright (C) 2008 Slava Pestov.\r
   2 ! See http://factorcode.org/license.txt for BSD license.\r
   3 USING: accessors peg peg.parsers memoize kernel sequences\r
   4 logging arrays words strings vectors io io.files\r
   5 io.encodings.utf8 namespaces make combinators logging.server\r
   6 calendar calendar.format ;\r
   7 IN: logging.parser\r
   8 \r
   9 TUPLE: log-entry date level word-name message ;\r
  10 \r
  11 : string-of ( quot -- parser )\r
  12     satisfy repeat0 [ >string ] action ; inline\r
  13 \r
  14 SYMBOL: multiline\r
  15 \r
  16 : 'date' ( -- parser )\r
  17     [ "]" member? not ] string-of [\r
  18         dup multiline-header =\r
  19         [ drop multiline ] [ rfc3339>timestamp ] if\r
  20     ] action\r
  21     "[" "]" surrounded-by ;\r
  22 \r
  23 : 'log-level' ( -- parser )\r
  24     log-levels [\r
  25         [ name>> token ] keep [ nip ] curry action\r
  26     ] map choice ;\r
  27 \r
  28 : 'word-name' ( -- parser )\r
  29     [ " :" member? not ] string-of ;\r
  30 \r
  31 SYMBOL: malformed\r
  32 \r
  33 : 'malformed-line' ( -- parser )\r
  34     [ drop t ] string-of\r
  35     [ log-entry new swap >>message malformed >>level ] action ;\r
  36 \r
  37 : 'log-message' ( -- parser )\r
  38     [ drop t ] string-of\r
  39     [ 1vector ] action ;\r
  40 \r
  41 : 'log-line' ( -- parser )\r
  42     [\r
  43         'date' ,\r
  44         " " token hide ,\r
  45         'log-level' ,\r
  46         " " token hide ,\r
  47         'word-name' ,\r
  48         ": " token hide ,\r
  49         'log-message' ,\r
  50     ] seq* [ first4 log-entry boa ] action\r
  51     'malformed-line' 2choice ;\r
  52 \r
  53 PEG: parse-log-line ( string -- entry ) 'log-line' ;\r
  54 \r
  55 : malformed? ( line -- ? )\r
  56     level>> malformed eq? ;\r
  57 \r
  58 : multiline? ( line -- ? )\r
  59     level>> multiline eq? ;\r
  60 \r
  61 : malformed-line ( line -- )\r
  62     "Warning: malformed log line:" print\r
  63     message>> print ;\r
  64 \r
  65 : add-multiline ( line -- )\r
  66     building get empty? [\r
  67         "Warning: log begins with multiline entry" print drop\r
  68     ] [\r
  69         message>> first building get peek message>> push\r
  70     ] if ;\r
  71 \r
  72 : parse-log ( lines -- entries )\r
  73     [\r
  74         [\r
  75             parse-log-line {\r
  76                 { [ dup malformed? ] [ malformed-line ] }\r
  77                 { [ dup multiline? ] [ add-multiline ] }\r
  78                 [ , ]\r
  79             } cond\r
  80         ] each\r
  81     ] { } make ;\r
  82 \r
  83 : parse-log-file ( service -- entries )\r
  84     log-path 1 log# dup exists?\r
  85     [ utf8 file-lines parse-log ] [ drop f ] if ;\r