extra/logging/parser/parser.factor

   1 ! Copyright (C) 2008 Slava Pestov.\r
   2 ! See http://factorcode.org/license.txt for BSD license.\r
   3 USING: parser-combinators memoize kernel sequences\r
   4 logging arrays words strings vectors io io.files\r
   5 namespaces combinators combinators.lib logging.server\r
   6 calendar calendar.format ;\r
   7 IN: logging.parser\r
   8 \r
   9 : string-of ( quot -- parser ) satisfy <!*> [ >string ] <@ ;\r
  10 \r
  11 SYMBOL: multiline\r
  12 \r
  13 : 'date' ( -- parser )\r
  14     [ "]" member? not ] string-of [\r
  15         dup multiline-header =\r
  16         [ drop multiline ] [ rfc3339>timestamp ] if\r
  17     ] <@\r
  18     "[" "]" surrounded-by ;\r
  19 \r
  20 : 'log-level' ( -- parser )\r
  21     log-levels [\r
  22         [ word-name token ] keep [ nip ] curry <@\r
  23     ] map <or-parser> ;\r
  24 \r
  25 : 'word-name' ( -- parser )\r
  26     [ " :" member? not ] string-of ;\r
  27 \r
  28 SYMBOL: malformed\r
  29 \r
  30 : 'malformed-line' ( -- parser )\r
  31     [ drop t ] string-of [ malformed swap 2array ] <@ ;\r
  32 \r
  33 : 'log-message' ( -- parser )\r
  34     [ drop t ] string-of [ 1vector ] <@ ;\r
  35 \r
  36 MEMO: 'log-line' ( -- parser )\r
  37     'date' " " token <&\r
  38     'log-level' " " token <& <&>\r
  39     'word-name' ": " token <& <:&>\r
  40     'log-message' <:&>\r
  41     'malformed-line' <|> ;\r
  42 \r
  43 : parse-log-line ( string -- entry )\r
  44     'log-line' parse-1 ;\r
  45 \r
  46 : malformed? ( line -- ? )\r
  47     first malformed eq? ;\r
  48 \r
  49 : multiline? ( line -- ? )\r
  50     first multiline eq? ;\r
  51 \r
  52 : malformed-line ( line -- )\r
  53     "Warning: malformed log line:" print\r
  54     second print ;\r
  55 \r
  56 : add-multiline ( line -- )\r
  57     building get empty? [\r
  58         "Warning: log begins with multiline entry" print drop\r
  59     ] [\r
  60         fourth first building get peek fourth push\r
  61     ] if ;\r
  62 \r
  63 : parse-log ( lines -- entries )\r
  64     [\r
  65         [\r
  66             parse-log-line {\r
  67                 { [ dup malformed? ] [ malformed-line ] }\r
  68                 { [ dup multiline? ] [ add-multiline ] }\r
  69                 [ , ]\r
  70             } cond\r
  71         ] each\r
  72     ] { } make ;\r