From 22e7c328a3ece8b489e39372261bbb3405095639 Mon Sep 17 00:00:00 2001 From: zapashcanon Date: Sun, 17 Nov 2019 17:16:56 +0100 Subject: [PATCH] first commit --- .gitignore | 3 +++ LICENSE.md | 9 ++++++++ README.md | 3 +++ dune-project | 3 +++ example/dune | 3 +++ example/reprint.ml | 12 +++++++++++ opazl.opam | 24 ++++++++++++++++++++++ src/ast.ml | 13 ++++++++++++ src/dune | 5 +++++ src/lexer.ml | 51 ++++++++++++++++++++++++++++++++++++++++++++++ src/parser.ml | 15 ++++++++++++++ src/pp.ml | 21 +++++++++++++++++++ 12 files changed, 162 insertions(+) create mode 100644 .gitignore create mode 100644 LICENSE.md create mode 100644 README.md create mode 100644 dune-project create mode 100644 example/dune create mode 100644 example/reprint.ml create mode 100644 opazl.opam create mode 100644 src/ast.ml create mode 100644 src/dune create mode 100644 src/lexer.ml create mode 100644 src/parser.ml create mode 100644 src/pp.ml diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..2e7b482 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +_build/ +*.merlin +*.install diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 index 0000000..c3c7108 --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,9 @@ +The ISC License (ISC) +===================== + +Copyright © 2019, Léo Andrès + +Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies. + +THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + diff --git a/README.md b/README.md new file mode 100644 index 0000000..5c279a8 --- /dev/null +++ b/README.md @@ -0,0 +1,3 @@ +# Opazl + +Opazl is an OCaml parser for ZNC logs. diff --git a/dune-project b/dune-project new file mode 100644 index 0000000..8bc71d2 --- /dev/null +++ b/dune-project @@ -0,0 +1,3 @@ +(lang dune 1.6) + +(name opazl) diff --git a/example/dune b/example/dune new file mode 100644 index 0000000..28c1216 --- /dev/null +++ b/example/dune @@ -0,0 +1,3 @@ +(executable + (name reprint) + (libraries opazl)) diff --git a/example/reprint.ml b/example/reprint.ml new file mode 100644 index 0000000..43800da --- /dev/null +++ b/example/reprint.ml @@ -0,0 +1,12 @@ +let _ = + + if Array.length Sys.argv < 2 then failwith (Format.sprintf "usage: %s " Sys.argv.(0)); + + let file = Sys.argv.(1) in + let chan = open_in file in + + let msgs = Opazl.Parser.from_channel chan in + + close_in chan; + + Opazl.Pp.fprintf_file Format.std_formatter msgs diff --git a/opazl.opam b/opazl.opam new file mode 100644 index 0000000..6501d2d --- /dev/null +++ b/opazl.opam @@ -0,0 +1,24 @@ +opam-version: "2.0" + +synopsis: "ZNC logs parser" + +version: "dev" +license: "ISC" +homepage: "https://git.zapashcanon.fr/zapashcanon/opazl" +bug-reports: "https://git.zapashcanon.fr/zapashcanon/opazl/issues" + +authors: "Léo Andrès (zapashcanon) " +maintainer: "Léo Andrès (zapashcanon) " +dev-repo: "git+https://git.zapashcanon.fr/zapashcanon/opazl.git" + +depends: [ + "ocaml" + "dune" {>= "1.11.0"} + "sedlex" +] + +build: [ + ["dune" "build" "-p" name "-j" jobs] +] + +description: "ZNC logs parser." diff --git a/src/ast.ml b/src/ast.ml new file mode 100644 index 0000000..c737a60 --- /dev/null +++ b/src/ast.ml @@ -0,0 +1,13 @@ +type time = int * int * int + +type user = string +type msg = string +type notice = string +type action = string + +type content = + | Msg of user * msg + | Notice of notice + | Action of action + +type line = time * content diff --git a/src/dune b/src/dune new file mode 100644 index 0000000..c625496 --- /dev/null +++ b/src/dune @@ -0,0 +1,5 @@ +(library + (public_name opazl) + (libraries sedlex) + (preprocess + (pps sedlex.ppx))) diff --git a/src/lexer.ml b/src/lexer.ml new file mode 100644 index 0000000..12c35c7 --- /dev/null +++ b/src/lexer.ml @@ -0,0 +1,51 @@ +open Ast + +let digit = [%sedlex.regexp? '0'..'9'] +let digit2 = [%sedlex.regexp? digit , digit] +let eol = [%sedlex.regexp? '\n'] +let any_except_eol = [%sedlex.regexp? Star Sub (any, '\n')] +let any_except_eol_eon = [%sedlex.regexp? Star Sub (Sub (any, '\n'), '>')] + +let lxm = Sedlexing.Utf8.lexeme + +let extract_time s = + Scanf.sscanf s "[%d:%d:%d]" (fun x y z -> x, y, z) + +let extract_sub useless start s = + let len = String.length s - useless in + if len < 1 then "" else String.sub s start len + +let extract_user = extract_sub 4 2 +let extract_notice = extract_sub 6 5 +let extract_action = extract_sub 4 3 +let extract_msg = extract_sub 1 0 + +let rec file buf = + + match%sedlex buf with + | '[', digit2, ':', digit2, ':', digit2, ']' -> + let time = extract_time (lxm buf) in + let content = line_content buf in + Some (time, content) + | eof -> None + | _ -> failwith "unexpected character (file)" + +and line_content buf = + + match%sedlex buf with + | " <", any_except_eol_eon, "> " -> + let user = extract_user (lxm buf) in + let msg = msg buf in + Msg (user, msg) + | " *** ", any_except_eol, eol -> + Notice (extract_notice (lxm buf)) + | " * ", any_except_eol, eol -> + Action (extract_action (lxm buf)) + | _ -> failwith "unexpected character (line_content)" + +and msg buf = + + match%sedlex buf with + | any_except_eol, eol -> + extract_msg (lxm buf) + | _ -> failwith "unexpected character (msg)" diff --git a/src/parser.ml b/src/parser.ml new file mode 100644 index 0000000..96b1697 --- /dev/null +++ b/src/parser.ml @@ -0,0 +1,15 @@ +let from_channel chan = + + let lexbuf = Sedlexing.Utf8.from_channel chan in + let next_line () = Lexer.file lexbuf in + + let msgs = ref [] in + + let rec loop = function + | Some msg -> msgs := msg :: !msgs; loop (next_line ()) + | None -> () + in + + loop (next_line ()); + + List.rev !msgs diff --git a/src/pp.ml b/src/pp.ml new file mode 100644 index 0000000..39118c3 --- /dev/null +++ b/src/pp.ml @@ -0,0 +1,21 @@ +open Ast + +let fprintf_content fmt = function + | Msg (usr, msg) -> Format.fprintf fmt "<%s> %s" usr msg + | Notice s -> Format.fprintf fmt "* %s" s + | Action s -> Format.fprintf fmt "*** %s" s + +let pad_int fmt i = + Format.fprintf fmt (if i < 10 then "0%d" else "%d") i + +let fprintf_time fmt (h, m, s) = + Format.fprintf fmt "[%a:%a:%a]" pad_int h pad_int m pad_int s + +let fprintf_line fmt (time, content) = + Format.fprintf fmt "%a %a" fprintf_time time fprintf_content content + +let print_lines lines = + Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt "@.") fprintf_line lines + +let fprintf_file fmt file = + Format.fprintf fmt "%a@." print_lines file