--- /dev/null
+(* whenjobs
+ * Copyright (C) 2012 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+(* For general information about camlp4, see:
+ * http://brion.inria.fr/gallium/index.php/Camlp4
+ *
+ * For information about quotations, see:
+ * http://brion.inria.fr/gallium/index.php/Quotation
+ *)
+
+open Printf
+
+open Camlp4.PreCast
+open Syntax
+open Ast
+
+open Whenutils
+
+let unique = let i = ref 0 in fun () -> incr i; !i
+
+let unique_job_name () = sprintf "job$%d" (unique ())
+
+(* Convert a _loc to an AST. *)
+let expr_of_loc _loc loc =
+ let file_name,
+ start_line, start_bol, start_off,
+ stop_line, stop_bol, stop_off,
+ ghost = Loc.to_tuple loc in
+ <:expr< Camlp4.PreCast.Loc.of_tuple
+ ($str:file_name$,
+ $`int:start_line$, $`int:start_bol$, $`int:start_off$,
+ $`int:stop_line$, $`int:stop_bol$, $`int:stop_off$,
+ $`bool:ghost$) >>
+
+(* "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
+ *)
+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
+ match stmt with
+ | `When e -> when_stmt _loc name e sh
+ | `Every p -> every_stmt _loc name p sh
+
+(* Handle a top level "when" statement.
+ * e -> when expression
+ * sh -> the shell script to run
+ * 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 =
+ 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$
+ >>
+
+(* Handle a top level "every" statement. *)
+and every_stmt _loc name period sh =
+ let loc = expr_of_loc _loc _loc in
+ <:str_item<
+ open Camlp4.PreCast
+ Whenfile.add_every_job $loc$ $name$ $period$ $sh$
+ >>
+
+let () =
+ (* Quotation expander for shell script. *)
+ let sh_quotation_expander _loc _ sh =
+ let loc = expr_of_loc _loc _loc in
+
+ (* XXX Expand %- or $- expressions in code. *)
+ (* XXX Escape >> in code. *)
+
+ <:expr< { Whenutils.sh_loc = $loc$;
+ sh_script = $str:sh$ } >>
+ in
+ Quotation.add "sh" Quotation.DynAst.expr_tag sh_quotation_expander;
+
+ (* Default quotation expander (<< .. >>) should be shell script ("sh"). *)
+ Quotation.default := "sh"
+
+(* For period expressions "<NN> (secs|mins|hours|...)" we cannot use
+ * the ordinary camlp4 parser since it only looks ahead by 1 symbol, so
+ * it gets "stuck" on the integer. Write a custom parser instead.
+ *
+ * Note the EXTEND macro implicitly reserves KEYWORDs.
+ *)
+let period_parser =
+ Gram.Entry.of_parser "period"
+ (fun stream ->
+ match Stream.peek stream with
+ | Some (INT (_, i), info) ->
+ let i = int_of_string i in
+ let _loc = Gram.token_location info in
+ Stream.junk stream;
+ (match Stream.next stream with
+ | KEYWORD ("sec"|"secs"|"second"|"seconds"), _ ->
+ <:expr< Whenutils.Every_seconds $`int:i$ >>
+ | KEYWORD ("min"|"mins"|"minute"|"minutes"), _ ->
+ let i = 60 * i in
+ <:expr< Whenutils.Every_seconds $`int:i$ >>
+ | KEYWORD ("hour"|"hours"), _ ->
+ let i = 3600 * i in
+ <:expr< Whenutils.Every_seconds $`int:i$ >>
+ | KEYWORD ("day"|"days"), _ ->
+ <:expr< Whenutils.Every_days $`int:i$ >>
+ | KEYWORD ("week"|"weeks"), _ ->
+ let i = 7 * i in
+ <:expr< Whenutils.Every_days $`int:i$ >>
+ | KEYWORD ("month"|"months"), _ ->
+ <:expr< Whenutils.Every_months $`int:i$ >>
+ | KEYWORD ("year"|"years"), _ ->
+ <:expr< Whenutils.Every_years $`int:i$ >>
+ | KEYWORD ("decade"|"decades"), _ ->
+ let i = 10 * i in
+ <:expr< Whenutils.Every_years $`int:i$ >>
+ | KEYWORD ("century"|"centuries"|"centurys"), _ ->
+ let i = 100 * i in
+ <:expr< Whenutils.Every_years $`int:i$ >>
+ | KEYWORD ("millenium"|"millenia"|"milleniums"), _ ->
+ let i = 1000 * i in
+ <:expr< Whenutils.Every_years $`int:i$ >>
+ | (KEYWORD s | LIDENT s), _ ->
+ eprintf "period: failed to parse %d %s\n%!" i s;
+ raise Stream.Failure
+ | _ ->
+ raise Stream.Failure
+ )
+ | _ -> 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
+ GLOBAL: str_item;
+
+ (* A period expression (used in "every"). *)
+ periodexpr: [
+ [ ["sec"|"secs"|"second"|"seconds"] ->
+ <:expr< Whenutils.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 >> ]
+ | [ ["century"|"centuries"|"centurys"] ->
+ <:expr< Whenutils.Every_years 100 >> ]
+ | [ ["millenium"|"millenia"|"milleniums"] ->
+ <:expr< Whenutils.Every_years 1000 >> ]
+ | [ e = period_parser -> e ]
+ ];
+
+ (* Top level statements. *)
+ statement: [
+ [ "when"; e = expr; ":"; sh = expr ->
+ (_loc, `When e, sh) ]
+ | [ "every"; p = periodexpr; ":"; sh = expr ->
+ (_loc, `Every p, sh) ]
+ ];
+
+ (* "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 ]
+ ];
+
+END
git.annexia.org / whenjobs.git / blobdiff