Permalink
Browse files

Handle AdLib inserts inside HTML assets

  • Loading branch information...
1 parent e9b8e5e commit b29cfce89686894766a81f6cbd673ef8ffb9d6da @VictorNicollet committed May 13, 2012
Showing with 70 additions and 5 deletions.
  1. +3 −0 src/adLib.ml
  2. +4 −0 src/adLib.mli
  3. +29 −0 tool/_build/parseAsset.mli
  4. +6 −0 tool/asset.ml
  5. +7 −5 tool/parseAsset.mly
  6. +18 −0 tool/syntaxAsset.ml
  7. +3 −0 tool/tokenAsset.mll
View
@@ -10,6 +10,9 @@ end
let get key =
Run.map (fun ctx -> ctx # adlib key) Run.context
+let write key =
+ Run.map (fun ctx -> Html.esc (ctx # adlib key)) Run.context
+
let (!!) fmt = Printf.sprintf fmt
let const x _ = x
View
@@ -25,6 +25,10 @@ end
(** Extract a source from the context and grab a key out of it. *)
val get : 'key -> ('key # ctx, string) Run.t
+(** Extract a source from the context and grab a key out of it,
+ rendered as HTML. *)
+val write : 'key -> ('key # ctx, Html.writer) Run.t
+
(** {2 Utilities} *)
(** Alias for [Printf.sprintf]. *)
@@ -0,0 +1,29 @@
+type token =
+ | STYLE of ( string )
+ | OPEN_LIST of ( SyntaxAsset.pos )
+ | ELSE of ( SyntaxAsset.pos )
+ | OPEN_IF of ( SyntaxAsset.pos )
+ | OPEN_OPTION of ( SyntaxAsset.pos )
+ | DOT of ( SyntaxAsset.pos )
+ | OPEN of ( SyntaxAsset.pos )
+ | OPEN_SUB of ( SyntaxAsset.pos )
+ | CLOSE_SUB of ( SyntaxAsset.pos )
+ | OPEN_DEF of ( SyntaxAsset.pos )
+ | CLOSE_DEF of ( SyntaxAsset.pos )
+ | EOL of ( SyntaxAsset.pos )
+ | EQUAL of ( SyntaxAsset.pos )
+ | CLOSE of ( SyntaxAsset.pos )
+ | PIPE of ( SyntaxAsset.pos )
+ | CLOSE_IF of ( SyntaxAsset.pos )
+ | CLOSE_LIST of ( SyntaxAsset.pos )
+ | CLOSE_OPTION of ( SyntaxAsset.pos )
+ | OPEN_SDEF of ( SyntaxAsset.pos )
+ | STR of ( string * SyntaxAsset.pos )
+ | MODULE of ( string * SyntaxAsset.pos )
+ | IDENT of ( string * SyntaxAsset.pos )
+ | VARIANT of ( string * SyntaxAsset.pos )
+ | ERROR of ( char * SyntaxAsset.pos )
+ | EOF
+
+val file :
+ (Lexing.lexbuf -> token) -> Lexing.lexbuf -> SyntaxAsset.cell list
View
@@ -97,6 +97,12 @@ let generate_asset revpath asset =
| `Ohm (uid,uid',tail) ->
(`Stmt (!! "let! _%d = Ohm.Universal.ohm _%d in" uid uid'))
:: print_root tail
+ | `AdLib (uid,variant,uid',tail) ->
+ (`Stmt (!! "let! _%d = Ohm.Universal.ohm (Ohm.AdLib.write %s) in" uid
+ (match uid' with
+ | None -> SyntaxAsset.contents variant
+ | Some uid' -> !! "(%s _%d)" (SyntaxAsset.contents variant) uid')))
+ :: print_root tail
| `Put (uid,uid',`Raw,tail) ->
(`Stmt (!! "let _%d _html = Buffer.add_string _html.Ohm.Html.html _%d in"
uid uid'))
View
@@ -9,7 +9,7 @@
%token < SyntaxAsset.pos > OPEN_LIST ELSE OPEN_IF OPEN_OPTION DOT
%token < SyntaxAsset.pos > OPEN OPEN_SUB CLOSE_SUB OPEN_DEF CLOSE_DEF EOL EQUAL CLOSE PIPE
%token < SyntaxAsset.pos > CLOSE_IF CLOSE_LIST CLOSE_OPTION OPEN_SDEF
-%token < string * SyntaxAsset.pos > STR MODULE IDENT
+%token < string * SyntaxAsset.pos > STR MODULE IDENT VARIANT
%token < char * SyntaxAsset.pos > ERROR
%token EOF
@@ -32,6 +32,8 @@ cell :
| STR { Cell_String (fst $1) }
| EOL { Cell_String "\n" }
| OPEN expr CLOSE { Cell_Print $2 }
+ | OPEN VARIANT CLOSE { Cell_AdLib (located $2,None) }
+ | OPEN VARIANT expr CLOSE { Cell_AdLib (located $2, Some $3) }
| OPEN_IF expr CLOSE cells CLOSE_IF { Cell_If ($2,$4,[]) }
| OPEN_IF expr CLOSE cells ELSE cells CLOSE_IF { Cell_If ($2,$4,$6) }
| OPEN_SUB expr CLOSE cells CLOSE_SUB { Cell_Sub ($2,$4) }
@@ -53,11 +55,11 @@ expr :
;
pipes :
- | pipe { [$1] }
- | pipe PIPE pipes { $1 :: $3 }
+ | func { [$1] }
+ | func PIPE pipes { $1 :: $3 }
;
-pipe :
- | MODULE DOT pipe { located $1 :: $3 }
+func :
+ | MODULE DOT func { located $1 :: $3 }
| IDENT { [located $1] }
;
View
@@ -5,6 +5,7 @@ type pos = Lexing.position * Lexing.position
type cell =
| Cell_String of string
| Cell_Print of expr
+ | Cell_AdLib of located * expr option
| Cell_If of expr * cell list * cell list
| Cell_Option of located option * expr * cell list * cell list
| Cell_List of located option * expr * cell list * cell list
@@ -299,6 +300,7 @@ let rec clean_strings = function
| Cell_String a :: Cell_String b :: tail -> clean_strings (Cell_String (a ^ b) :: tail)
| Cell_String a :: tail -> Cell_String (clean_string a) :: clean_strings tail
| Cell_Print x :: tail -> Cell_Print x :: clean_strings tail
+ | Cell_AdLib (v,e) :: tail -> Cell_AdLib (v,e) :: clean_strings tail
| Cell_If (e,a,b) :: tail -> Cell_If (e,
clean_strings a,
clean_strings b) :: clean_strings tail
@@ -317,6 +319,7 @@ let rec clean_strings = function
type buffered_cell =
[ `Print of expr
+ | `AdLib of located * expr option
| `If of expr * buffered_cell list * buffered_cell list
| `Option of located option * expr * buffered_cell list * buffered_cell list
| `List of located option * expr * buffered_cell list * buffered_cell list
@@ -348,6 +351,7 @@ let rec extract_strings extracted list =
let extract extracted = function
| Cell_Print e -> extracted, `Print e
+ | Cell_AdLib (v,e) -> extracted, `AdLib (v,e)
| Cell_Style s -> Buffer.add_string extracted.css s ; extracted, `String (0,0)
| Cell_If (e,a,b) -> let extracted, a = extract_strings extracted a in
let extracted, b = extract_strings extracted b in
@@ -377,6 +381,7 @@ let rec extract_strings extracted list =
type clean_cell =
[ `Print of expr
+ | `AdLib of located * expr option
| `If of expr * clean_cell list * clean_cell list
| `Option of located option * expr * clean_cell list * clean_cell list
| `List of located option * expr * clean_cell list * clean_cell list
@@ -388,6 +393,7 @@ type clean_cell =
let rec extract_assets revpath sub (list : buffered_cell list) =
let extract sub = function
| `Print e -> sub, `Print e
+ | `AdLib (v,e) -> sub, `AdLib (v,e)
| `If (e,a,b) -> let sub, a = extract_assets revpath sub a in
let sub, b = extract_assets revpath sub b in
sub, `If (e,a,b)
@@ -424,6 +430,7 @@ type rooted_cell =
and cell_root =
[ `Render of rooted_cell list
| `Extract of int * located * cell_root
+ | `AdLib of int * located * int option * cell_root
| `Apply of int * int * located list * cell_root
| `Ohm of int * int * cell_root
| `Put of int * int * [ `Raw | `Esc ] * cell_root
@@ -470,6 +477,17 @@ let rec extract_roots ?(accum=[]) (list:clean_cell list) =
| `Print expr :: tail -> let uid, fill = split_expr ~printed:true expr in
let accum = `Print uid :: accum in
fill (extract_roots ~accum tail)
+ | `AdLib (variant,expr) :: tail -> let uid, fill = match expr with
+ | None -> None, (fun inner -> inner)
+ | Some e -> let uid, fill = split_expr e in
+ Some uid, fill
+ in
+ let uid' = getuid () in
+ let accum = `Print uid' :: accum in
+ let fill inner =
+ fill (`AdLib (uid', variant, uid, inner))
+ in
+ fill (extract_roots ~accum tail)
| `Sub (e,l) :: tail -> let uid, fill = split_expr e in
let uid' = getuid () in
let fill inner = fill (`Sub (uid', uid, extract_roots l, inner)) in
View
@@ -28,6 +28,7 @@
| PIPE _ -> "|"
| IDENT (_,_) -> "ident"
| EQUAL _ -> "="
+ | VARIANT (_,_) -> "`Variant"
| ERROR (c,_) -> Printf.sprintf "#! %C !#" c
}
@@ -59,6 +60,8 @@ and inner = parse
| [ ' ' '\t' '\r' ] { inner lexbuf }
| [ 'A' - 'Z'] [ 'A'-'Z' 'a'-'z' '_' '0'-'9' ] * as str
{ MODULE (str, pos lexbuf) }
+ | '`' [ 'A' - 'Z'] [ 'A'-'Z' 'a'-'z' '_' '0'-'9' ] * as str
+ { VARIANT (str, pos lexbuf) }
| '.' { DOT (pos lexbuf) }
| '|' { PIPE (pos lexbuf) }
| [ 'a' - 'z' ] [ 'A'-'Z' 'a'-'z' '_' '0'-'9' ] * as str

0 comments on commit b29cfce

Please sign in to comment.