move journald functionality out of this module

.gitignore

@@ -1 +1,2 @@
 /_build
+/result

README.md

@@ -37,14 +37,6 @@ end
 Xlog.init_pretty_writer stdout
   ~min_level:Xlog.DEBUG
   (* other options *)
-
-(* if running as a daemon *)
-if Xlog.should_upgrade_to_journald () then
-  Xlog.init_journald_writer ()
-    ~min_level:Xlog.DEBUG
-else
-  Xlog.init_pretty_writer stdout
-    ~min_level:Xlog.DEBUG
 ```
 
 ## usage with ppx

dune-project

@@ -1,7 +1,7 @@
 (lang dune 3.15)
 
 (name xlog)
-(version 0.0.1)
+(version 0.1.0)
 
 (generate_opam_files true)
 
@@ -13,9 +13,10 @@
  (homepage "https://git.lain.faith/haskal/xlog")
  (bug_reports "https://git.lain.faith/haskal/xlog")
  (authors "iitalics <git.lain.faith/iitalics>" "xenia <xenia@awoo.systems>")
- (maintainers "iitalics <git.lain.faith/iitalics>" "xenia <xenia@awoo.systems>")
+ (maintainers "xenia <xenia@awoo.systems>")
  (source
   (uri "https://git.lain.faith/haskal/xlog.git"))
  (depends ocaml dune
   (ptime (>= 1.1))
-  (ppxlib (>= 0.32))))
+  (ppxlib (>= 0.32))
+  (ppx_unicode (>= 0.0.1))))

lib/dune

@@ -1,4 +1,5 @@
 (library
  (name xlog)
  (public_name xlog)
+ (preprocess (pps ppx_unicode))
  (libraries ptime ptime.clock.os str unix))

lib/journald.ml

@@ -1,70 +0,0 @@
-open Core
-
-let default_socket_path = "/run/systemd/journal/socket"
-
-type t = {
-  mutex : Mutex.t;
-  sock_fd : Unix.file_descr;
-  dest : Unix.sockaddr;
-  buf : Buffer.t;
-}
-
-let should_upgrade () =
-  let stderr = Unix.fstat Unix.stderr in
-  let dev_ino = Printf.sprintf "%d:%d" stderr.st_dev stderr.st_ino in
-  Sys.getenv_opt "JOURNAL_STREAM" = Some dev_ino
-
-let make ?(path = default_socket_path) () = {
-  mutex = Mutex.create ();
-  sock_fd = Unix.socket PF_UNIX SOCK_DGRAM 0 ~cloexec:true;
-  dest = ADDR_UNIX path;
-  buf = Buffer.create 256;
-}
-
-let add_field dgram key value =
-  if String.contains value '\n' then
-    begin
-      Buffer.add_string dgram key;
-      Buffer.add_char dgram '\n';
-      Buffer.add_int64_le dgram (Int64.of_int (String.length value));
-      Buffer.add_string dgram value;
-      Buffer.add_char dgram '\n';
-    end
-  else
-    Printf.bprintf dgram "%s=%s\n" key value
-
-let syslog_priority = function
-  | TRACE
-  | DEBUG -> "7" (* LOG_DEBUG *)
-  | INFO  -> "6" (* LOG_INFO *)
-  | WARN  -> "4" (* LOG_WARNING *)
-  | ERROR -> "3" (* LOG_ERR *)
-
-let writer t ~ts ~ns ~filename ~lineno ~func ~errno ~exn ~lvl msg =
-  Mutex.lock t.mutex;
-  let dgram =
-    Buffer.clear t.buf;
-    ignore ts;
-    let maybe_exn = match exn with
-    | Some (exn, bt) ->
-        Printf.sprintf "\nException: %s\n%s" (Printexc.to_string exn)
-          (Printexc.raw_backtrace_to_string bt)
-    | None -> ""
-    in
-    add_field t.buf "MESSAGE" (Printf.sprintf "%s: %s%s" ns msg maybe_exn);
-    add_field t.buf "PRIORITY" (syslog_priority lvl);
-    begin if not (filename = "") then
-      add_field t.buf "CODE_FILE" filename;
-      add_field t.buf "CODE_LINE" (Printf.sprintf "%d" lineno)
-    end;
-    begin if not (func = "") then
-      add_field t.buf "CODE_FUNC" func
-    end;
-    let errno = Util.get_errno errno exn in
-    begin if errno != 0 then
-      add_field t.buf "ERRNO" (Printf.sprintf "%d" errno)
-    end;
-    Buffer.to_bytes t.buf
-  in
-  Mutex.unlock t.mutex;
-  Unix.sendto t.sock_fd dgram 0 (Bytes.length dgram) [] t.dest |> ignore

lib/xlog.ml

@@ -143,17 +143,6 @@ let init_pretty_writer
   Pretty.writer |>
   add_writer ?min_level
 
-let init_journald_writer
-      ?min_level
-      ?path
-      ()
-  =
-  Journald.make () ?path |>
-  Journald.writer |>
-  add_writer ?min_level
-
-let should_upgrade_to_journald = Journald.should_upgrade
-
 let dump_tree () =
   let rec dt (parent : logger) (child : logger) (ts : string) : unit =
     Printf.eprintf "%slogger: %s\n%!" ts child.namespace;

lib/xlog.mli

@@ -41,9 +41,18 @@ val init_pretty_writer :
   ?backtrace:bool ->
   out_channel -> unit
 
-val init_journald_writer :
-  ?min_level:level ->
-  ?path:string ->
-  unit -> unit
+type writer =
+  ts:Time.t ->
+  ns:string ->
+  filename:string ->
+  lineno:int ->
+  func:string ->
+  errno:int ->
+  exn:((exn * Printexc.raw_backtrace) option) ->
+  lvl:level ->
+  string ->
+  unit
 
-val should_upgrade_to_journald : unit -> bool
+val add_writer :
+  ?min_level:level ->
+  writer -> unit

package.nix

@@ -1,10 +1,12 @@
 {
   lib,
   mkShell,
+  gitSource,
 
   buildDunePackage,
   ptime,
   ppxlib,
+  ppx_unicode,
 
   ocaml,
   dune_3,
@@ -14,24 +16,17 @@
   enableShell ? false
 }:
 
-let
-  sourceRoot = ./.;
-  fs = lib.fileset;
-  sourceFiles = fs.difference
-    (fs.gitTracked sourceRoot)
-    (fs.fileFilter (file: file.hasExt "nix") sourceRoot);
-  sourceSet = fs.toSource { root = sourceRoot; fileset = sourceFiles; };
-in buildDunePackage rec {
+buildDunePackage rec {
   pname = "xlog";
-  version = "0.0.1";
-  src = sourceSet;
+  version = "0.0.2";
+  src = gitSource { root = ./.; };
 
   minimalOCamlVersion = "5.1";
   dontStrip = true;
 
+  buildInputs = [ ppx_unicode ] ++ lib.optionals enableShell [ utop ];
   propagatedBuildInputs = [ ptime ppxlib ];
-
-  nativeBuildInputs = lib.optionals enableShell [
+  nativeBuildInputs = [ ppxlib ppx_unicode ] ++ lib.optionals enableShell [
     ocaml dune_3 odoc utop
   ];
 }

ppx/dune

@@ -3,6 +3,6 @@
  (public_name xlog.ppx)
  (synopsis "ppx rewriters for xlog")
  (preprocess
-  (pps ppxlib.metaquot))
+  (pps ppx_unicode ppxlib.metaquot))
  (libraries ppxlib)
- (kind ppx_deriver))
+ (kind ppx_rewriter))

ppx/xlog_ppx.ml

@@ -2,32 +2,35 @@ open Ppxlib
 
 let log_expander ~ctxt (e : expression) (l : (arg_label * expression) list) : expression =
   let loc = Expansion_context.Extension.extension_point_loc ctxt in
-  let is_exn = begin match e.pexp_desc with
+  let open (val Ast_builder.make loc) in
+  let (is_exn, err) = begin match e.pexp_desc with
   | Pexp_ident { txt = Lident "trace"; _ }
   | Pexp_ident { txt = Lident "debug"; _ }
   | Pexp_ident { txt = Lident "info"; _ }
   | Pexp_ident { txt = Lident "warn"; _ }
-  | Pexp_ident { txt = Lident "error"; _ } -> false
-  | Pexp_ident { txt = Lident "exn"; _ } -> true
+  | Pexp_ident { txt = Lident "error"; _ } -> (false, None)
+  | Pexp_ident { txt = Lident "exn"; _ } -> (true, None)
   | _ ->
-      raise (Location.Error (Location.Error.make ~loc ~sub:[]
-                              "log type must be one of: trace, debug, info, warn, error, exn"))
-  end in
-  let open (val Ast_builder.make loc) in
-  if is_exn then
-    match l with
-    | [] ->
-      raise (Location.Error (Location.Error.make ~loc ~sub:[]
-                              "must provide exn value"))
-    | (_, v)::l ->
-        let application =
-          eapply (pexp_ident { txt = Lident "m"; loc}) (List.map snd l) in
-        [%expr [%e e] [%e v] (Printexc.get_raw_backtrace ()) ~__POS__ ~__FUNCTION__
-                      (fun m -> [%e application])]
-  else
-    let application =
-      eapply (pexp_ident { txt = Lident "m"; loc}) (List.map snd l) in
-    [%expr [%e e] ~__POS__ ~__FUNCTION__ (fun m -> [%e application])]
+      (false,
+       Some (pexp_extension @@ Location.error_extensionf ~loc
+             "log type must be one of: trace, debug, info, warn, error, exn"))
+  end in match err with
+  | Some err -> err
+  | None ->
+    if is_exn then
+      match l with
+      | [] ->
+        pexp_extension @@ Location.error_extensionf ~loc
+          "must provide exn value"
+      | (_, v)::l ->
+          let application =
+            eapply (pexp_ident { txt = Lident "m"; loc}) (List.map snd l) in
+          [%expr [%e e] [%e v] (Printexc.get_raw_backtrace ()) ~__POS__ ~__FUNCTION__
+                        (fun m -> [%e application])]
+    else
+      let application =
+        eapply (pexp_ident { txt = Lident "m"; loc}) (List.map snd l) in
+      [%expr [%e e] ~__POS__ ~__FUNCTION__ (fun m -> [%e application])]
 
 let log_extension =
   let pattern =

test/dune

@@ -1,4 +1,4 @@
 (test
  (name test_xlog)
- (preprocess (pps xlog.ppx))
+ (preprocess (pps ppx_unicode xlog.ppx))
  (libraries xlog))

xlog.opam

@@ -1,11 +1,9 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-version: "0.0.1"
+version: "0.1.0"
 synopsis: "logging library"
 description: "logging library for cats written in ocaml"
-maintainer: [
-  "iitalics <git.lain.faith/iitalics>" "xenia <xenia@awoo.systems>"
-]
+maintainer: ["xenia <xenia@awoo.systems>"]
 authors: ["iitalics <git.lain.faith/iitalics>" "xenia <xenia@awoo.systems>"]
 license: "LGPL-2.0-or-later"
 homepage: "https://git.lain.faith/haskal/xlog"
@@ -15,6 +13,7 @@ depends: [
   "dune" {>= "3.15"}
   "ptime" {>= "1.1"}
   "ppxlib" {>= "0.32"}
+  "ppx_unicode" {>= "0.0.1"}
   "odoc" {with-doc}
 ]
 build: [