ocaml-sqlite / bin / sql.ml

open Cmdliner

let log_src = Logs.Src.create "sql"

module Log = (val Logs.src_log log_src : Logs.LOG)

(* -- write subcommand -- *)

let open_or_create ~sw path =
  try Sqlite.open_ ~sw path with Failure _ | Eio.Io _ -> Sqlite.v ~sw path

let write_entry t (k, v) =
  Log.info (fun m -> m "put %s=%s" k v);
  Sqlite.put t k v

let write () db pairs =
  Eio_main.run @@ fun env ->
  let cwd = Eio.Stdenv.cwd env in
  Eio.Switch.run @@ fun sw ->
  let path = Eio.Path.(cwd / db) in
  let t = open_or_create ~sw path in
  List.iter (write_entry t) pairs;
  Sqlite.close t;
  Log.info (fun m -> m "wrote %d entries to %s" (List.length pairs) db)

let err_kv_pair s = Error (`Msg (Fmt.str "expected KEY=VALUE, got %S" s))

let kv_pair =
  let parse s =
    match String.split_on_char '=' s with
    | [ k; v ] -> Ok (k, v)
    | _ -> err_kv_pair s
  in
  let pp ppf (k, v) = Fmt.pf ppf "%s=%s" k v in
  Arg.conv (parse, pp)

let write_cmd =
  let db =
    Arg.(
      required
      & pos 0 (some string) None
      & info [] ~docv:"DB" ~doc:"Database file path.")
  in
  let pairs =
    Arg.(
      value & pos_right 0 kv_pair []
      & info [] ~docv:"KEY=VALUE" ~doc:"Key-value pairs to write.")
  in
  let info =
    Cmd.info "write" ~doc:"Write key-value pairs to a database."
      ~man:
        [
          `S Manpage.s_description;
          `P "Write key-value pairs to a database, creating it if needed.";
          `S Manpage.s_examples;
          `P "$(iname) mydb.db hello=world foo=bar";
        ]
  in
  Cmd.v info Term.(const write $ Vlog.setup "sql" $ db $ pairs)

(* -- read subcommand -- *)

let pp_value_pipe ppf = function
  | Sqlite.Vnull -> Fmt.string ppf "NULL"
  | Sqlite.Vint n -> Fmt.pf ppf "%Ld" n
  | Sqlite.Vfloat f -> Fmt.pf ppf "%f" f
  | Sqlite.Vblob s -> Fmt.pf ppf "BLOB(%d)" (String.length s)
  | Sqlite.Vtext s -> Fmt.pf ppf "%S" s

let read () db table_name =
  Eio_main.run @@ fun env ->
  let cwd = Eio.Stdenv.cwd env in
  Eio.Switch.run @@ fun sw ->
  let path = Eio.Path.(cwd / db) in
  let t = Sqlite.open_ ~sw path in
  (match table_name with
  | None ->
      (* Original KV behavior *)
      if Tty.is_tty () then begin
        let rows = ref [] in
        Sqlite.iter t ~f:(fun k v ->
            rows := [ Tty.Span.text k; Tty.Span.text v ] :: !rows);
        let rows = List.rev !rows in
        let table =
          Tty.Table.(
            of_rows ~border:Tty.Border.rounded
              [ column "key"; column "value" ]
              rows)
        in
        Tty.Table.pp Format.std_formatter table
      end
      else Sqlite.iter t ~f:(fun k v -> Fmt.pr "%s|%s@." k v)
  | Some name ->
      (* Generic table read *)
      if Tty.is_tty () then begin
        let schemas = Sqlite.tables t in
        let schema = List.find (fun s -> s.Sqlite.tbl_name = name) schemas in
        let cols =
          List.map
            (fun c -> Tty.Table.column c.Sqlite.col_name)
            schema.Sqlite.columns
        in
        let rows = ref [] in
        Sqlite.iter_table t name ~f:(fun _rowid values ->
            let row =
              List.map
                (fun v -> Tty.Span.text (Fmt.str "%a" pp_value_pipe v))
                values
            in
            rows := row :: !rows);
        let rows = List.rev !rows in
        let table = Tty.Table.(of_rows ~border:Tty.Border.rounded cols rows) in
        Tty.Table.pp Format.std_formatter table
      end
      else
        Sqlite.iter_table t name ~f:(fun _rowid values ->
            let strs =
              List.map (fun v -> Fmt.str "%a" pp_value_pipe v) values
            in
            Fmt.pr "%s@." (String.concat "|" strs)));
  Sqlite.close t

let read_cmd =
  let db =
    Arg.(
      required
      & pos 0 (some string) None
      & info [] ~docv:"DB" ~doc:"Database file path.")
  in
  let table_name =
    Arg.(
      value
      & opt (some string) None
      & info [ "t"; "table" ] ~docv:"TABLE"
          ~doc:"Table to read. Defaults to the kv table.")
  in
  let info =
    Cmd.info "read" ~doc:"Read all entries from a database."
      ~man:
        [
          `S Manpage.s_description;
          `P "Dump all key-value pairs from a SQLite database.";
          `P
            "When stdout is a terminal, output is rendered as a table. \
             Otherwise, entries are printed as pipe-separated values.";
          `P
            "Use $(b,--table) to read a specific table. Without it, reads the \
             default $(b,kv) table.";
          `S Manpage.s_examples;
          `P "$(iname) mydb.db";
          `P "$(iname) mydb.db -t users";
        ]
  in
  Cmd.v info Term.(const read $ Vlog.setup "sql" $ db $ table_name)

(* -- delete subcommand -- *)

let delete_entry t k =
  Log.info (fun m -> m "delete %s" k);
  Sqlite.delete t k

let delete () db keys =
  Eio_main.run @@ fun env ->
  let cwd = Eio.Stdenv.cwd env in
  Eio.Switch.run @@ fun sw ->
  let path = Eio.Path.(cwd / db) in
  let t = Sqlite.open_ ~sw path in
  List.iter (delete_entry t) keys;
  Sqlite.close t;
  Log.info (fun m -> m "deleted %d entries from %s" (List.length keys) db)

let delete_cmd =
  let db =
    Arg.(
      required
      & pos 0 (some string) None
      & info [] ~docv:"DB" ~doc:"Database file path.")
  in
  let keys =
    Arg.(
      value & pos_right 0 string [] & info [] ~docv:"KEY" ~doc:"Keys to delete.")
  in
  let info =
    Cmd.info "delete" ~doc:"Delete entries from a database."
      ~man:
        [
          `S Manpage.s_description;
          `P "Remove the given keys from a SQLite database.";
          `S Manpage.s_examples;
          `P "$(iname) mydb.db key1 key2";
        ]
  in
  Cmd.v info Term.(const delete $ Vlog.setup "sql" $ db $ keys)

(* -- tables subcommand -- *)

let pp_column (c : Sqlite.column) =
  let base =
    if c.col_affinity = "" then c.col_name
    else c.col_name ^ " " ^ c.col_affinity
  in
  if c.col_is_rowid_alias then base ^ " PRIMARY KEY" else base

let pp_schema (s : Sqlite.schema) =
  let cols = List.map pp_column s.columns in
  Fmt.pr "%s (%s)@." s.tbl_name (String.concat ", " cols)

let tables () db =
  Eio_main.run @@ fun env ->
  let cwd = Eio.Stdenv.cwd env in
  Eio.Switch.run @@ fun sw ->
  let path = Eio.Path.(cwd / db) in
  let t = Sqlite.open_ ~sw path in
  List.iter pp_schema (Sqlite.tables t);
  Sqlite.close t

let tables_cmd =
  let db =
    Arg.(
      required
      & pos 0 (some string) None
      & info [] ~docv:"DB" ~doc:"Database file path.")
  in
  let info =
    Cmd.info "tables" ~doc:"List tables in a database."
      ~man:
        [
          `S Manpage.s_description;
          `P "List all tables and their schemas in a SQLite database.";
          `S Manpage.s_examples;
          `P "$(iname) mydb.db";
        ]
  in
  Cmd.v info Term.(const tables $ Vlog.setup "sql" $ db)

(* -- main -- *)

let main_cmd =
  let info =
    Cmd.info "sql" ~version:"%%VERSION%%"
      ~doc:"SQLite-compatible key-value store."
      ~man:
        [
          `S Manpage.s_description;
          `P
            "$(tname) creates and reads SQLite-compatible databases using a \
             pure OCaml B-tree implementation. Files produced by $(tname) can \
             be read by the $(b,sqlite3) CLI and vice versa.";
        ]
  in
  Cmd.group info [ write_cmd; read_cmd; delete_cmd; tables_cmd ]

let () = exit (Cmd.eval main_cmd)