first commit

.gitignore

@@ -0,0 +1,3 @@
+_build/
+*.merlin
+*.install

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.
+

README.md

@@ -0,0 +1,3 @@
+# Opazl
+
+Opazl is an OCaml parser for ZNC logs.

dune-project

@@ -0,0 +1,3 @@
+(lang dune 1.6)
+
+(name opazl)

example/dune

@@ -0,0 +1,3 @@
+(executable
+ (name reprint)
+ (libraries opazl))

example/reprint.ml

@@ -0,0 +1,12 @@
+let _ =
+
+  if Array.length Sys.argv < 2 then failwith (Format.sprintf "usage: %s <log file>" 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

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) <leo@ndrs.fr>"
+maintainer: "Léo Andrès (zapashcanon) <leo@ndrs.fr>"
+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."

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

src/dune

@@ -0,0 +1,5 @@
+(library
+ (public_name opazl)
+ (libraries sedlex)
+ (preprocess
+  (pps sedlex.ppx)))

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)"

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

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