src/cli.ml

   1 (** command-line *)
   2
   3 open Printf
   4 open ExtLib
   5 open Sqlgg
   6
   7 module Cxx = Gen.Make(Gen_cxx)
   8 module Caml = Gen.Make(Gen_caml.Generator)
   9 module Caml_io = Gen.Make(Gen_caml.Generator_io)
  10 module Xml_gen = Gen.Make(Gen_xml)
  11 module Java = Gen.Make(Gen_java)
  12 module CSharp = Gen.Make(Gen_csharp)
  13
  14 (*
  15   common usecase:
  16      sqlgg [-gen none] ddl.sql -gen cxx dml.sql
  17 *)
  18 let generate = ref None
  19 let name = ref "sqlgg"
  20
  21 let set_out s =
  22   generate :=
  23   match (String.lowercase_ascii s) with
  24   | "cxx" | "c++" | "cpp" -> Some Cxx.process
  25   | "caml" | "ocaml" | "ml" -> Some Caml.process
  26   | "caml_io" -> Some Caml_io.process
  27   | "xml" -> Some Xml_gen.process
  28   | "java" -> Some Java.process
  29   | "csharp" | "c#" | "cs" -> Some CSharp.process
  30   | "none" -> None
  31   | _ -> failwith (sprintf "Unknown output language: %s" s)
  32
  33 let set_params_mode s =
  34   Gen.params_mode :=
  35   match String.lowercase_ascii s with
  36   | "named" -> Some Gen.Named
  37   | "unnamed" -> Some Gen.Unnamed
  38   | "oracle" -> Some Gen.Oracle
  39   | "postgresql" -> Some Gen.PostgreSQL
  40   | "none" -> None
  41   | _ -> failwith (sprintf "Unknown params mode: %s" s)
  42
  43 let all_categories = String.concat " " @@ List.map Stmt.show_category Stmt.all_categories
  44 let category_of_string s =
  45   match List.find (fun cat -> String.equal (String.lowercase_ascii @@ Stmt.show_category cat) s) Stmt.all_categories with
  46   | exception _ -> failwith @@ sprintf "bad category %S" s
  47   | x -> x
  48 let set_category s =
  49   let s = String.lowercase_ascii s in
  50   Sqlgg_config.include_category :=
  51     match s with
  52     | "all" -> `All
  53     | "none" -> `None
  54     | "" -> failwith "bad category \"\""
  55     | _ when s.[0] = '-' -> `Except (List.map category_of_string @@ String.nsplit (String.slice ~first:1 s) ",")
  56     | _ -> `Only (List.map category_of_string @@ String.nsplit s ",")
  57 let filter_category cat =
  58   match !Sqlgg_config.include_category with
  59   | `All -> true
  60   | `None -> false
  61   | `Only l -> List.mem cat l
  62   | `Except l -> not (List.mem cat l)
  63
  64 let each_input =
  65   let run input =
  66     let l = match input with Some ch -> Main.get_statements ch | None -> [] in
  67     match !generate with
  68     | None -> []
  69     | Some _ -> List.filter (fun stmt -> filter_category (Stmt.category_of_stmt_kind stmt.Gen.kind)) l
  70   in
  71   function
  72   | "-" -> run (Some stdin)
  73   | filename -> Main.with_channel filename run
  74
  75 let generate l =
  76   match !generate with
  77   | None -> ()
  78   | Some f -> f !name l
  79
  80 let usage_msg =
  81   let s1 = sprintf "SQL Guided (code) Generator ver. %s\n" Sqlgg_config.version in
  82   let s2 = sprintf "Usage: %s <options> <file.sql> [<file2.sql> ...]\n" (Filename.basename Sys.executable_name) in
  83   let s3 = "Options are:" in
  84   s1 ^ s2 ^ s3
  85
  86 let show_version () = print_endline Sqlgg_config.version
  87
  88 let main () =
  89   let l = ref [] in
  90   let work s = l := each_input s :: !l in
  91   let args = Arg.align
  92   [
  93     "-version", Arg.Unit show_version, " Show version";
  94     "-category", Arg.String set_category, sprintf "{all|none|[-]<category>{,<category>}+} Only generate code for these specific query categories (possible values: %s)" all_categories;
  95     "-gen", Arg.String set_out, "cxx|caml|java|xml|csharp|none Set output language (default: none)";
  96     "-name", Arg.String (fun x -> name := x), "<identifier> Set output module name (default: sqlgg)";
  97     "-params", Arg.String set_params_mode, "named|unnamed|oracle|postgresql|none Output query parameters substitution (default: none)";
  98     "-debug", Arg.Int Sqlgg_config.set_debug_level, "<N> set debug level";
  99     "-no-header", Arg.Unit (fun () -> Sqlgg_config.gen_header := None),
 100       "do not put version header in generated output";
 101     "-no-header-timestamp", Arg.Unit (fun () -> Sqlgg_config.gen_header := Some `Without_timestamp),
 102       "do not put timestamp in version header in generated output";
 103     "-static-header", Arg.Unit (fun () -> Sqlgg_config.gen_header := Some `Static), "only output short static header without version/timestamp";
 104     "-show-tables", Arg.Unit Tables.print_all, " Show all current tables";
 105     "-show-table", Arg.String Tables.print1, "<name> Show specified table";
 106     "-", Arg.Unit (fun () -> work "-"), " Read sql from stdin";
 107     "-test", Arg.Unit Test.run, " Run unit tests";
 108   ]
 109   in
 110   Arg.parse args work usage_msg;
 111   match !l with
 112   | [] -> if Array.length Sys.argv = 1 then Arg.usage args usage_msg; 0
 113   | l ->
 114     if !Error.errors then
 115       begin Error.log "Errors encountered, no code generated"; 1 end
 116     else
 117       begin generate @@ List.concat @@ List.rev l; 0 end
 118
 119 let () = exit @@ main ()