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