X-Git-Url: http://git.annexia.org/?p=whenjobs.git;a=blobdiff_plain;f=lib%2Fpa_when.ml;h=2f415ea0b625cbfef03727a7de3b532aed2a247d;hp=3b8f36ee4f8711f21eb7907ec860367ce6d8a3cd;hb=HEAD;hpb=0e4f253777af9b8aa7c3107d71dfbb061172a53e

diff --git a/lib/pa_when.ml b/lib/pa_when.ml
index 3b8f36e..2f415ea 100644
--- a/lib/pa_when.ml
+++ b/lib/pa_when.ml
@@ -33,6 +33,36 @@ let unique = let i = ref 0 in fun () -> incr i; !i
 
 let unique_job_name () = sprintf "job$%d" (unique ())
 
+let rec find s sub =
+  let len = String.length s in
+  let sublen = String.length sub in
+  let rec loop i =
+    if i <= len-sublen then (
+      let rec loop2 j =
+        if j < sublen then (
+          if s.[i+j] = sub.[j] then loop2 (j+1)
+          else -1
+        ) else
+          i (* found *)
+      in
+      let r = loop2 0 in
+      if r = -1 then loop (i+1) else r
+    ) else
+      -1 (* not found *)
+  in
+  loop 0
+
+let rec replace_str s s1 s2 =
+  let len = String.length s in
+  let sublen = String.length s1 in
+  let i = find s s1 in
+  if i = -1 then s
+  else (
+    let s' = String.sub s 0 i in
+    let s'' = String.sub s (i+sublen) (len-i-sublen) in
+    s' ^ s2 ^ replace_str s'' s1 s2
+  )
+
 (* Convert a _loc to an AST. *)
 let expr_of_loc _loc loc =
   let file_name,
@@ -45,6 +75,11 @@ let expr_of_loc _loc loc =
      $`int:stop_line$, $`int:stop_bol$, $`int:stop_off$,
      $`bool:ghost$) >>
 
+(* Convert 'expr option' to an expression that contains the option inside. *)
+let expr_of_option _loc = function
+  | None -> <:expr< None >>
+  | Some e -> <:expr< Some $e$ >>
+
 (* "Lift" an expression, turning it from an expression into an OCaml
  * abstract syntax tree in the output.  This is pretty obscure.
  * http://caml.inria.fr/pub/ml-archives/caml-list/2008/09/591f7c4a8df9295d675a5adcb6802748.en.html
@@ -53,12 +88,16 @@ module M = Ast.Meta.Make (Ast.Meta.MetaGhostLoc)
 let lift_expr = M.Expr.meta_expr
 
 (* Handle a top level statement. *)
-let rec call_stmt name (_loc, stmt, sh) =
-  let name = if name <> "" then name else unique_job_name () in
-  let name = <:expr< $str:name$ >> in
+let rec call_stmt ?name ?pre ?post (_loc, stmt, sh) =
+  let name =
+    match name with
+    | None -> let name = unique_job_name () in <:expr< $str:name$ >>
+    | Some name -> name in
+  let pre = expr_of_option _loc pre in
+  let post = expr_of_option _loc post in
   match stmt with
-  | `When e -> when_stmt _loc name e sh
-  | `Every p -> every_stmt _loc name p sh
+  | `When e -> when_stmt _loc name pre post e sh
+  | `Every p -> every_stmt _loc name pre post p sh
 
 (* Handle a top level "when" statement.
  * e -> when expression
@@ -66,20 +105,20 @@ let rec call_stmt name (_loc, stmt, sh) =
  * Returns a top level statement (str_item) which when executed just
  * adds the statement to a global list.
  *)
-and when_stmt _loc name e sh =
+and when_stmt _loc name pre post e sh =
   let loc = expr_of_loc _loc _loc in
   let e = lift_expr _loc e in
   <:str_item<
     open Camlp4.PreCast
-    Whenfile.add_when_job $loc$ $name$ $e$ $sh$
+    Whenfile.add_when_job $loc$ $name$ $pre$ $post$ $e$ $sh$
   >>
 
 (* Handle a top level "every" statement. *)
-and every_stmt _loc name period sh =
+and every_stmt _loc name pre post period sh =
   let loc = expr_of_loc _loc _loc in
   <:str_item<
     open Camlp4.PreCast
-    Whenfile.add_every_job $loc$ $name$ $period$ $sh$
+    Whenfile.add_every_job $loc$ $name$ $pre$ $post$ $period$ $sh$
   >>
 
 let () =
@@ -87,10 +126,10 @@ let () =
   let sh_quotation_expander _loc _ sh =
     let loc = expr_of_loc _loc _loc in
 
-    (* XXX Expand %- or $- expressions in code. *)
-    (* XXX Escape >> in code. *)
+    (* Convert ">\>" to ">>" in code. *)
+    let sh = replace_str sh ">\\>" ">>" in
 
-    <:expr< { Whenutils.sh_loc = $loc$;
+    <:expr< { Whenexpr.sh_loc = $loc$;
               sh_script = $str:sh$ } >>
   in
   Quotation.add "sh" Quotation.DynAst.expr_tag sh_quotation_expander;
@@ -114,31 +153,31 @@ let period_parser =
         Stream.junk stream;
         (match Stream.next stream with
         | KEYWORD ("sec"|"secs"|"second"|"seconds"), _ ->
-          <:expr< Whenutils.Every_seconds $`int:i$ >>
+          <:expr< Whenexpr.Every_seconds $`int:i$ >>
         | KEYWORD ("min"|"mins"|"minute"|"minutes"), _ ->
           let i = 60 * i in
-          <:expr< Whenutils.Every_seconds $`int:i$ >>
+          <:expr< Whenexpr.Every_seconds $`int:i$ >>
         | KEYWORD ("hour"|"hours"), _ ->
           let i = 3600 * i in
-          <:expr< Whenutils.Every_seconds $`int:i$ >>
+          <:expr< Whenexpr.Every_seconds $`int:i$ >>
         | KEYWORD ("day"|"days"), _ ->
-          <:expr< Whenutils.Every_days $`int:i$ >>
+          <:expr< Whenexpr.Every_days $`int:i$ >>
         | KEYWORD ("week"|"weeks"), _ ->
           let i = 7 * i in
-          <:expr< Whenutils.Every_days $`int:i$ >>
+          <:expr< Whenexpr.Every_days $`int:i$ >>
         | KEYWORD ("month"|"months"), _ ->
-          <:expr< Whenutils.Every_months $`int:i$ >>
+          <:expr< Whenexpr.Every_months $`int:i$ >>
         | KEYWORD ("year"|"years"), _ ->
-          <:expr< Whenutils.Every_years $`int:i$ >>
+          <:expr< Whenexpr.Every_years $`int:i$ >>
         | KEYWORD ("decade"|"decades"), _ ->
           let i = 10 * i in
-          <:expr< Whenutils.Every_years $`int:i$ >>
+          <:expr< Whenexpr.Every_years $`int:i$ >>
         | KEYWORD ("century"|"centuries"|"centurys"), _ ->
           let i = 100 * i in
-          <:expr< Whenutils.Every_years $`int:i$ >>
+          <:expr< Whenexpr.Every_years $`int:i$ >>
         | KEYWORD ("millenium"|"millenia"|"milleniums"), _ ->
           let i = 1000 * i in
-          <:expr< Whenutils.Every_years $`int:i$ >>
+          <:expr< Whenexpr.Every_years $`int:i$ >>
         | (KEYWORD s | LIDENT s), _ ->
           eprintf "period: failed to parse %d %s\n%!" i s;
           raise Stream.Failure
@@ -147,26 +186,6 @@ let period_parser =
         )
       | _ -> raise Stream.Failure
     )
-
-(*
-(* This hand-written parser looks for "job <name>" before a statement. *)
-let optjob =
-  Gram.Entry.of_parser "optjob"
-    (fun stream ->
-      let info, name =
-        match Stream.npeek 2 stream with
-        | [ LIDENT "job", info; STRING (_,name), _ ] ->
-          Stream.junk stream;
-          Stream.junk stream;
-          info, name
-        | (_, info) :: _ ->
-          (* Job is unnamed so generate a unique internal name. *)
-          info, unique_job_name ()
-        | _ -> assert false in
-      let _loc = Gram.token_location info in
-      <:expr< $str:name$ >>
-    )
-*)
 ;;
 
 EXTEND Gram
@@ -175,22 +194,26 @@ EXTEND Gram
   (* A period expression (used in "every"). *)
   periodexpr: [
     [ ["sec"|"secs"|"second"|"seconds"] ->
-      <:expr< Whenutils.Every_seconds 1 >> ]
+      <:expr< Whenexpr.Every_seconds 1 >> ]
   | [ ["min"|"mins"|"minute"|"minutes"] ->
-      <:expr< Whenutils.Every_seconds 60 >> ]
-  | [ ["hour"|"hours"] -> <:expr< Whenutils.Every_seconds 3600 >> ]
-  | [ ["day"|"days"] -> <:expr< Whenutils.Every_days 1 >> ]
-  | [ ["week"|"weeks"] -> <:expr< Whenutils.Every_days 7 >> ]
-  | [ ["month"|"months"] -> <:expr< Whenutils.Every_months 1 >> ]
-  | [ ["year"|"years"] -> <:expr< Whenutils.Every_years 1 >> ]
-  | [ ["decade"|"decades"] -> <:expr< Whenutils.Every_years 10 >> ]
+      <:expr< Whenexpr.Every_seconds 60 >> ]
+  | [ ["hour"|"hours"] -> <:expr< Whenexpr.Every_seconds 3600 >> ]
+  | [ ["day"|"days"] -> <:expr< Whenexpr.Every_days 1 >> ]
+  | [ ["week"|"weeks"] -> <:expr< Whenexpr.Every_days 7 >> ]
+  | [ ["month"|"months"] -> <:expr< Whenexpr.Every_months 1 >> ]
+  | [ ["year"|"years"] -> <:expr< Whenexpr.Every_years 1 >> ]
+  | [ ["decade"|"decades"] -> <:expr< Whenexpr.Every_years 10 >> ]
   | [ ["century"|"centuries"|"centurys"] ->
-      <:expr< Whenutils.Every_years 100 >> ]
+      <:expr< Whenexpr.Every_years 100 >> ]
   | [ ["millenium"|"millenia"|"milleniums"] ->
-      <:expr< Whenutils.Every_years 1000 >> ]
+      <:expr< Whenexpr.Every_years 1000 >> ]
   | [ e = period_parser -> e ]
   ];
 
+  (* Pre and post functions. *)
+  pre: [[ "pre"; f = expr -> f ]];
+  post: [[ "post"; f = expr -> f ]];
+
   (* Top level statements. *)
   statement: [
     [ "when"; e = expr; ":"; sh = expr ->
@@ -201,8 +224,12 @@ EXTEND Gram
 
   (* "str_item" is a top level statement in an OCaml program. *)
   str_item: LEVEL "top" [
-    [ s = statement -> call_stmt "" s ]
-  | [ "job"; name = STRING; s = statement -> call_stmt name s ]
+    [ s = statement -> call_stmt s ]
+  | [ "job"; name = expr;
+      pre = OPT pre;
+      post = OPT post;
+      s = statement ->
+        call_stmt ~name ?pre ?post s ]
   ];
 
 END