Merge PR #11 (@smondet, Examples and improvements)

.gitignore

@@ -1,2 +1,6 @@
 /_build/
-/genspio.byte
+/genspio.byte
+/.merlin
+/.ocamlinit
+/genspio-examples.byte
+/genspio-test.byte

myocamlbuild.ml

@@ -44,7 +44,11 @@ let test : Project.item list =
       Project.app (project_name ^ "-test")
         ~thread:()
         ~file:"src/test/main.ml"
-        ~internal_deps:[lib; test_lib]
+        ~internal_deps:[lib; test_lib];
+      Project.app (project_name ^ "-examples")
+        ~thread:()
+        ~file:"src/test/examples.ml"
+        ~internal_deps:[lib; test_lib];
     ]
   else
     []

src/lib/EDSL.ml

@@ -1,6 +1,62 @@
 type 'a t = 'a Language.t
-type cli_option = Language.cli_option
+type 'a cli_option = 'a Language.cli_option
 type 'a option_spec = 'a Language.option_spec
 type ('a, 'b) cli_options = ('a, 'b) Language.cli_options
+let (//) = Filename.concat
+
 include Language.Construct
 
+open Nonstd
+module String = Sosa.Native_string
+
+let case condition body = `Case (condition, seq body)
+let default d = `Default (seq d)
+let switch l =
+  let default = ref None in
+  let cases =
+    List.filter_map l ~f:(function
+      | `Default d when !default <> None ->
+        failwith "Cannot build switch with >1 defaults"
+      | `Default d -> default := (Some d); None
+      | `Case t -> Some t)
+  in
+  make_switch ~default:(Option.value ~default:nop !default) cases
+
+let string_concat sl =
+  (* This is a pretty unefficient implementation: *)
+  let out s = call [string "printf"; string "%s"; s] in
+  seq (List.map sl ~f:out) |> output_as_string
+
+type string_variable = <
+    get : string Language.t;
+    set : string Language.t -> unit Language.t;
+  >
+let tmp_file ?(tmp_dir = string "/tmp") name : string_variable =
+  let path =
+    let clean =
+      String.map name ~f:(function
+        | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' as c -> c
+        | other -> '_') in
+    string_concat [
+      tmp_dir;
+      string "/";
+      string
+        (sprintf "genspio-tmp-file-%s-%s" clean Digest.(string name |> to_hex));
+    ]
+  in
+  let tmp = string_concat [path; string "-tmp"] in
+  object
+    method get = output_as_string (call [string "cat"; path])
+    method set v =
+      seq [
+        call [string "echo"; string "Setting"];
+        call [string "echo"; tmp];
+        v >> exec ["cat"] |> write_output ~stdout:tmp;
+        call [string "mv"; string "-f"; tmp; path];
+      ]
+  end
+
+let if_seq ~t ?e c =
+  match e with
+  | None -> if_then c (seq t)
+  | Some f -> if_then_else c (seq t) (seq f) 

src/lib/EDSL.mli

@@ -1,13 +1,27 @@
 type 'a t = 'a Language.t
-type cli_option = Language.cli_option
-type 'a option_spec = 'a Language.option_spec
-type ('a, 'b) cli_options = ('a, 'b) Language.cli_options
 
 
 val fail: unit t
 (** Abort the script/command immediately. *)
 
+val call : string t list -> unit t
+(** Call a command from its list of “arguments” (including the first
+    argument being the actual command).
+
+    Note that UNIX does not allow strings passed as arguments to
+    executables to contain NUL-characters (['\x00']).
+    The function {!Language.to_many_lines} raises an exception
+    if an argument is a literal and contains a NUL, but if the
+    argument is the result of some other expression the behavior is
+    for now undefined.
+*)
+
 val exec : string list -> unit t
+(** Like {!call} but with string literals; i.e. [exec ["a"; "b"]] is
+    actually [call [string "a"; string "b"]] which is the usual shell command
+    ["a b"] (with proper escaping). *)
+
+
 val ( &&& ) : bool t -> bool t -> bool t
 val ( ||| ) : bool t -> bool t -> bool t
 val ( =$= ) : string t -> string t -> bool t
@@ -23,36 +37,97 @@ val nop : unit t
 val if_then_else :
   bool t -> unit t -> unit t -> unit t
 val if_then : bool t -> unit t -> unit t
+
 val seq : unit t list -> unit t
+(** Sequence a list of expressions into an expression. *)
+
+val if_seq:
+  t:unit t list ->
+  ?e:unit t list ->
+  bool t ->
+  unit t
+(** [if_seq c ~t ~e] is an alternate API for {!if_then_else} (when
+    [?e] is provided) or {!if_then} (otherwise) that assumes “then”
+    and “else” bodies to be lists for {!seq} construct. *)
+
 val not : bool t -> bool t
-val printf : ('a, unit, string, unit t) format4 -> 'a
-val file_exists : string -> bool t
+
+val file_exists : string t -> bool t
+
+(** {3 Switch Statements } *)
+
 val switch :
-  (bool t * unit t) list ->
-  default:unit t -> unit t
+  [ `Case of bool t * unit t | `Default of unit t ] list -> unit t
+(** Create a switch statement from a list of {!case} and optionally a
+    {!default} (the function raises an exception if there are more
+    than one default cases). *)
+
+val case :
+  bool t ->
+  unit t list ->
+  [> `Case of bool t * unit t ]
+(** Create a normal case for a {!switch} statement. *)
+
+val default : unit t list -> [> `Default of unit t ]
+(** Create the default case for a {!switch} statement. *)
+
+
+(**/**)
+val make_switch :
+  (bool Language.t * unit Language.t) list ->
+  default:unit Language.t -> unit Language.t
+(**/**)
+
+
 val write_output :
-  ?stdout:string ->
-  ?stderr:string ->
-  ?return_value:string -> unit t -> unit t
-val write_stdout : path:string -> unit t -> unit t
+  ?stdout:string t ->
+  ?stderr:string t ->
+  ?return_value:string t -> unit t -> unit t
+
+val write_stdout : path: string t -> unit t -> unit t
+
+(** {3 Literals } *)
 
 val string : string -> string t
 val int : int -> int t
-val bool : bool t
+val bool : bool -> bool t
+
 val output_as_string : unit t -> string t
 val feed : string:string t -> unit t -> unit t
 val ( >> ) : string t -> unit t -> unit t
 val loop_while : bool t -> body:unit t -> unit t
 
+type 'argument_type cli_option = 'argument_type Language.cli_option
+type 'argument_type option_spec = 'argument_type Language.option_spec
+type ('parse_function, 'return_type) cli_options = ('parse_function, 'return_type) Language.cli_options
 module Option_list : sig
   val string :
-    doc:string -> char -> string t option_spec
-  val flag : doc:string -> char -> bool t option_spec
+    ?default: string t ->
+    doc:string -> char ->
+    string t option_spec
+  val flag :
+    ?default: bool t ->
+    doc:string -> char ->
+    bool t option_spec
   val ( & ) :
-    'a option_spec ->
-    ('b, 'c) cli_options -> ('a -> 'b, 'c) cli_options
-  val usage : string -> ('a, 'a) cli_options
+    'argument_type option_spec ->
+    ('parse_function, 'return_type) cli_options ->
+    ('argument_type -> 'parse_function, 'return_type) cli_options
+  val usage : string -> ('last_return_type, 'last_return_type) cli_options
 end
 
 val parse_command_line :
-  ('a, unit t) cli_options -> 'a -> unit t
+  ('parse_function, unit t) cli_options -> 'parse_function -> unit t
+
+val string_concat: string t list -> string t
+
+type string_variable = <
+    get : string Language.t;
+    set : string Language.t -> unit Language.t;
+  >
+val tmp_file:
+  ?tmp_dir: string t ->
+  string ->
+  string_variable
+(** Create a temporary file that may contain arbitrary strings (can be
+    used as variable containing [string t] values). *)