Skip to content
This repository
tag: v458
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 175 lines (140 sloc) 8.41 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174
(*
    Copyright © 2011 MLstate

    This file is part of OPA.

    OPA is free software: you can redistribute it and/or modify it under the
    terms of the GNU Affero General Public License, version 3, as published by
    the Free Software Foundation.

    OPA 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 Affero General Public License for
    more details.

    You should have received a copy of the GNU Affero General Public License
    along with OPA. If not, see <http://www.gnu.org/licenses/>.
*)
{{ open Parser_utils }}
(** Importing definitions from the lexer/parser *)

spacing <- Opa_lexer.spacing
just_hexa <- Opa_lexer.hexa
;let deco rule = (=Opa_parser.careful_deco(rule));
pos <- Opa_parser.pos


(** Css parser (ie. for css = css ... declarations) *)
;hexa = deco just_hexa

;tag = deco just_tag;
just_tag <- '-'? [a-zA-Z_] [a-zA-Z0-9_\-]* $_
          / '*' $_

name_or_expr <- Xml.name_no_sp:s {{ string2 s }}
              / Opa_parser.opa_in_braces_nosp:e {{ e }}

;event_name = deco just_event_name;
just_event_name <- "hover" / "active" / "visited" / "link" / "first-child" {{ "first_child" (** - not allowed in record field name *) }}

event <- event_name:s {{ coerce_name_expr (wrap_e (unc2 simple_record) s) Opacapi.Types.Css.event }}

tag_or_expr <-
  / tag:t {{ string2 t }}
  / Opa_parser.opa_in_braces_nosp:e {{ e }}
  / event

item_type <- ("." {{ "class" }} / "#" {{ "id" }})?:o {{ Option.default "tag" o }}

selector_item <-
  / item_type:item tag_or_expr:e {{ coerce_name_expr (record [(item,e)]) Opacapi.Types.Css.selector_item }}
  / ":" event:e {{ coerce_name_expr (record [("event",e)]) Opacapi.Types.Css.selector_item }}

selector_conjunction <- selector_item_plus:l {{ unc2 list_expr_of_expr_list l }}
;selector_item_plus = deco just_selector_item_plus;
just_selector_item_plus <- selector_item+:l {{ l }}

selector_path <- spacing (=deco(just_selector_path)):l {{ unc2 list_expr_of_expr_list l }}
just_selector_path <- selector_conjunction:v (spacing selector_conjunction:v {{v}})*:l spacing {{ v :: l }}

;paths <- (=deco(just_paths)):l {{ unc2 list_expr_of_expr_list l }}
just_paths <- selector_path:v (Opa_lexer.comma selector_path:v {{v}})*:l {{ v :: l }}

just_prop_name <- [a-z]+ ([-] [a-z]+)* $_
;prop_name <- (=deco(just_prop_name)):s {{ string2 s }}

percentage <- (=deco(Opa_lexer.int)):i spacing "%" spacing {{ coerce_name_expr (int2 i) Opacapi.Types.Css.percentage }}

unit <- ("em"/"ex"/"px"/"inch"/"cm"/"mm"/"pt"/"pc")?

length <-
   (=deco(Opa_lexer.float)):f spacing unit:unit
    {{ let u = Option.default "nounitF" unit in
         coerce_name_expr (record [(u,float2 f)]) Opacapi.Types.Css.length
     }}
 / (=deco(Opa_lexer.int)):i spacing unit:unit
    {{ let u = Option.default "nounitI" unit in
         coerce_name_expr (record [(u,floatint2 i)]) Opacapi.Types.Css.length
     }}

;color_name = deco just_color_name;
just_color_name <-
    "aliceblue" / "antiquewhite" / "aquamarine" / "aqua" / "azure" / "beige" / "bisque" / "black" /
    "blanchedalmond" / "blueviolet" / "blue" / "brown" / "burlywood" / "cadetblue" / "chartreuse" /
    "chocolate" / "coral" / "cornflowerblue" / "cornsilk" / "crimson" / "cyan" / "darkblue" /
    "darkcyan" / "darkgoldenrod" / "darkgray" / "darkgreen" / "darkkhaki" / "darkmagenta" /
    "darkolivegreen" / "darkorange" / "darkorchid" / "darkred" / "darksalmon" / "darkseagreen" /
    "darkslateblue" / "darkslategray" / "darkturquoise" / "darkviolet" / "deeppink" / "deepskyblue" /
    "dimgray" / "dodgerblue" / "firebrick" / "floralwhite" / "forestgreen" / "fuchsia" / "gainsboro" /
    "ghostwhite" / "goldenrod" / "gold" / "gray" / "greenyellow" / "green" / "honeydew" / "hotpink" /
    "indianred" / "indigo" / "ivory" / "khaki" / "lavenderblush" / "lavender" / "lawngreen" / "lemonchiffon" /
    "lightblue" / "lightcoral" / "lightcyan" / "lightgoldenrodyellow" / "lightgrey" / "lightgreen" /
    "lightpink" / "lightsalmon" / "lightseagreen" / "lightskyblue" / "lightslategray" / "lightsteelblue" /
    "lightyellow" / "limegreen" / "lime" / "linen" / "magenta" / "maroon" / "mediumaquamarine" / "mediumblue" /
    "mediumorchid" / "mediumpurple" / "mediumseagreen" / "mediumslateblue" / "mediumspringgreen" /
    "mediumturquoise" / "mediumvioletred" / "midnightblue" / "mintcream" / "mistyrose" / "moccasin" /
    "navajowhite" / "navy" / "oldlace" / "olivedrab" / "olive" / "orangered" / "orange" / "orchid" /
    "palegoldenrod" / "palegreen" / "paleturquoise" / "palevioletred" / "papayawhip" / "peachpuff" / "peru" /
    "pink" / "plum" / "powderblue" / "purple" / "red" / "rosybrown" / "royalblue" / "saddlebrown" / "salmon" /
    "sandybrown" / "seagreen" / "seashell" / "sienna" / "silver" / "skyblue" / "slateblue" / "slategray" /
    "snow" / "springgreen" / "steelblue" / "tan" / "teal" / "thistle" / "tomato" / "turquoise" / "violet" /
    "wheat" / "whitesmoke" / "white" / "yellowgreen" / "yellow" /
    "transparent"

(* FIXME: really need factorisation *)
/** css color **/
color <- color_name:c {{ dot (ident "Color" (label c)) (undecorate c) }}
       / "#" hexa:h1 hexa:h2 hexa:h3 hexa:h4 hexa:h5 hexa:h6 hexa:h7 hexa:h8 {{ color_hexa h1 h2 h3 h4 h5 h6 h7 h8 }}
       / "#" hexa:h1 hexa:h2 hexa:h3 hexa:h4 hexa:h5 hexa:h6 {{ color_hexa h1 h2 h3 h4 h5 h6 ('f',label h6) ('f',label h6) }}
       / "#" hexa:h1 hexa:h2 hexa:h3 hexa:h4 {{ color_hexa h1 h1 h2 h2 h3 h3 h4 h4 }}
       / "#" hexa:h1 hexa:h2 hexa:h3 {{ color_hexa h1 h1 h2 h2 h3 h3 ('f',label h3) ('f',label h3) }}
       / "rgb" Opa_lexer.lpar Opa_parser.expr:e1 Opa_lexer.comma Opa_parser.expr:e2 Opa_lexer.comma Opa_parser.expr:e3 Opa_lexer.rpar {{ rgb e1 e2 e3 }}
       / "rgba" Opa_lexer.lpar Opa_parser.expr:e1 Opa_lexer.comma Opa_parser.expr:e2 Opa_lexer.comma Opa_parser.expr:e3 Opa_lexer.comma Opa_parser.expr:e4 Opa_lexer.rpar {{ rgba e1 e2 e3 e4 }}

special <- [(),""']

url_content <- ( ([\\] special {{ String.make 1 __2 }})
                / (![\\] !special .)+ $_)+ {{ String.concat "" __1 }}
/** css url **/
css_url <- "url" Opa_lexer.lpar (=deco(
                      ["] url_content:s ["] {{ s }}
                    / ['] url_content:s ['] {{ s }}
                    / url_content:s {{ s }}
                  )):p spacing Opa_lexer.rpar {{
                   let f = (Dot ((Ident "Url", nlabel p), "make"), nlabel p) in
                   apply f (string2 p) }}
/** css property value **/
prop_value_expr_opa <-
  ( percentage:v {{ ("percentage", v) }}
  / length:v {{ ("length", v) }}
  / color:v {{ ("color",v) }}
  / css_url:v {{ ("url", v) }}
  ):v
  {{ coerce_name_expr (record [v]) Opacapi.Types.Css.prop_value_item }}

prop_value_name <- [a-zA-Z]+ ('-' [a-zA-Z]+)* $_

prop_value_aux3 <- (=deco(spacing prop_value_name (Opa_lexer.comma spacing prop_value_name)* $_)):s
                   {{ coerce_name_expr (record [("property",string2 s)]) Opacapi.Types.Css.prop_value_item }}

prop_value_item <-
  / Opa_parser.opa_in_braces:e {{ coerce_name_expr e Opacapi.Types.Css.prop_value_item }}
  / prop_value_expr_opa
  / prop_value_aux3

prop_value <- prop_value_item:v (spacing prop_value_item:v {{v}})*:l {{ list_expr_of_expr_list_unsafe (v :: l) }}

;prop = deco just_prop;
;just_prop <- prop_name:a Opa_lexer.colon spacing prop_value:b {{ (a,b) }}

  props <- prop:p (Opa_lexer.semic spacing props?:v {{v}})?:props
           {{ let ((k,v),pos) = p in
              let props =
                match props with
                  | None
                  | Some None -> stringmap_empty pos
                  | Some (Some v) -> v in
                stringmap_add pos k v props
            }}
props_aux <-
      / Opa_lexer.lbrace spacing props:v Opa_lexer.rbrace {{ v }}
      / Opa_lexer.lbrace pos:pos Opa_lexer.rbrace {{ stringmap_empty pos }}

/** css block **/
bloc_css <- paths:paths props_aux:props bloc_css?:o
      {{ let pos = label paths in
         let bloc_css = Option.default (cssentrymap_empty pos) o in
           map_add_merge pos paths props bloc_css
       }}

css_map <- Opa_lexer.CSS spacing bloc_css:v spacing {{ v }}

/** global css definition **/
css <- (=deco(Opa_lexer.CSS)):p Opa_lexer.assign css_map:v
       {{ NewVal ([(patident "css" (label p),list_expr_of_expr_list_unsafe [v])],false) }}
Something went wrong with that request. Please try again.