stringify.ml 6.77 KB
Newer Older
1
open Types
2
open Util
3 4 5 6 7

let tab = "    "

let indent = Str.global_replace (Str.regexp "^\\(.\\)") (tab ^ "\\1")

8 9
let prefix_space = function "" -> "" | s -> " " ^ s

10 11 12 13 14
let rec cat sep fn = function
  | [] -> ""
  | [hd] -> fn hd
  | hd :: tl -> fn hd ^ sep ^ cat sep fn tl

15 16 17 18 19
let string_of_num n =
  if float_of_int (int_of_float n) = n
    then string_of_int (int_of_float n)
    else string_of_float n

20 21 22 23
(*
 * Pretty-printing
 *)

24
let rec string_of_expr = function
25 26 27 28
  | Ident id -> id
  | Strlit str -> "\"" ^ str ^ "\""
  | Uri uri when String.contains uri ')' -> "url(\"" ^ uri ^ "\")"
  | Uri uri -> "url(" ^ uri ^ ")"
29 30 31 32
  | Concat values -> cat " " string_of_expr values
  | Number (n, None) -> string_of_num n
  | Number (n, Some u) -> string_of_num n ^ u
  | Function (name, arg) -> name ^ "(" ^ string_of_expr arg ^ ")"
33
  | Hexcolor hex -> "#" ^ hex
34
  | Unary (op, opnd) -> op ^ string_of_expr opnd
35
  | Nary (",", opnds) -> cat ", " string_of_expr opnds
36
  | Nary (op, opnds) -> cat op string_of_expr opnds
37

38 39 40
let string_of_declaration (name, value, important) =
  let imp = if important then " !important" else "" in
  name ^ ": " ^ string_of_expr value ^ imp ^ ";"
41

42 43 44 45 46 47 48
let rec string_of_selector = function
  | Simple simple -> simple
  | Combinator (left, " ", right) ->
    string_of_selector left ^ " " ^ string_of_selector right
  | Combinator (left, com, right) ->
    string_of_selector left ^ " " ^ com ^ " " ^ string_of_selector right

49 50 51 52
let string_of_media_feature = function
  | (feature, None) -> "(" ^ feature ^ ")"
  | (feature, Some value) -> "(" ^ feature ^ ": " ^ string_of_expr value ^ ")"

53
let string_of_media_query =
54
  let features_str = cat " and " string_of_media_feature in
55
  function
56 57 58 59 60 61 62 63 64 65
  | (None, None, []) -> ""
  | (None, Some mtype, []) -> mtype
  | (Some pre, Some mtype, []) -> pre ^ " " ^ mtype
  | (None, None, features) -> features_str features
  | (None, Some mtype, features) -> mtype ^ " and " ^ features_str features
  | (Some pre, Some mtype, features) ->
    pre ^ " " ^ mtype ^ " and " ^ features_str features
  | (Some pre, None, _) ->
    failwith "unexpected media query prefix \"" ^ pre ^ "\""

66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83
let stringify_condition w c =
  let rec transform =
    let p c = `Parens (transform c) in
    function
    | Not c -> `Not (p c)
    | And c -> `And (List.map p c)
    | Or c -> `Or (List.map p c)
    | Decl (name, value) -> `Decl (name, value)
  in
  let rec str = function
    | `Not c -> "not " ^ str c
    | `And c -> cat " and " str c
    | `Or c -> cat " or " str c
    | `Decl (name, value) -> "(" ^ name ^ ":" ^ w ^ string_of_expr value ^ ")"
    | `Parens (`Decl _ as d) -> str d
    | `Parens c -> "(" ^ str c ^ ")"
  in
  str (transform c)
84

85
let block = function "" -> " {}" | body -> " {\n" ^ indent body ^ "\n}"
86

87 88
let rec string_of_statement = function
  | Ruleset (selectors, decls) ->
89
    cat ", " string_of_selector selectors ^
90 91
    block (cat "\n" string_of_declaration decls)
  | Media (queries, rulesets) ->
92
    "@media" ^ prefix_space (cat ", " string_of_media_query queries) ^
93
    block (cat "\n\n" string_of_statement rulesets)
94 95 96
  | Import (target, []) ->
    "@import " ^ string_of_expr target ^ ";"
  | Import (target, queries) ->
97
    "@import " ^ string_of_expr target ^ " " ^ cat ", " string_of_media_query queries ^ ";"
98 99
  | Charset charset ->
    "@charset \"" ^ charset ^ "\";"
100 101 102 103
  | Page (None, decls) ->
    "@page" ^ block (cat "\n" string_of_declaration decls)
  | Page (Some pseudo, decls) ->
    "@page :" ^ pseudo ^ block (cat "\n" string_of_declaration decls)
104 105 106 107 108
  | Font_face decls ->
    let string_of_descriptor_declaration (name, value) =
      name ^ ": " ^ string_of_expr value ^ ";"
    in
    "@font-face" ^ block (cat "\n" string_of_descriptor_declaration decls)
109
  | Namespace (None, uri) ->
110
    "@namespace " ^ string_of_expr uri ^ ";"
111
  | Namespace (Some prefix, uri) ->
112
    "@namespace " ^ prefix ^ " " ^ string_of_expr uri ^ ";"
113
  | Keyframes (prefix, id, rules) ->
114 115 116
    let string_of_keyframe_ruleset (expr, decls) =
      string_of_expr expr ^ block (cat "\n" string_of_declaration decls)
    in
117 118
    "@" ^ prefix ^ "keyframes " ^ id ^
    block (cat "\n\n" string_of_keyframe_ruleset rules)
119
  | Supports (condition, statements) ->
120
    "@supports " ^ stringify_condition " " condition ^
121
    block (cat "\n\n" string_of_statement statements)
122

123
let string_of_stylesheet = cat "\n\n" string_of_statement
124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145

(*
 * Minified stringification
 *)

let rec minify_expr = function
  | Concat values -> cat " " minify_expr values
  | Function (name, arg) -> name ^ "(" ^ minify_expr arg ^ ")"
  | Unary (op, opnd) -> op ^ minify_expr opnd
  | Nary (",", opnds) -> cat "," minify_expr opnds
  | Nary (op, opnds) -> cat op minify_expr opnds
  | expr -> string_of_expr expr

let minify_declaration (name, value, important) =
  let imp = if important then "!important" else "" in
  name ^ ":" ^ minify_expr value ^ imp

let rec minify_selector = function
  | Simple simple -> simple
  | Combinator (left, com, right) ->
    minify_selector left ^ com ^ minify_selector right

146 147 148 149 150
let minify_media_feature = function
  | (feature, None) -> "(" ^ feature ^ ")"
  | (feature, Some value) -> "(" ^ feature ^ ":" ^ minify_expr value ^ ")"

let minify_media_query query =
151
  let features_str = cat "and " minify_media_feature in
152 153 154 155 156 157 158
  match query with
  | (None, None, features) -> features_str features
  | (None, Some mtype, features) -> mtype ^ " and " ^ features_str features
  | (Some pre, Some mtype, features) ->
    pre ^ " " ^ mtype ^ " and " ^ features_str features
  | _ -> string_of_media_query query

159 160 161
let rec minify_statement = function
  | Ruleset (selectors, decls) ->
    cat "," minify_selector selectors ^
162
    "{" ^ cat ";" minify_declaration decls ^ "}"
163
  | Media (queries, rulesets) ->
164
    "@media" ^ prefix_space (cat "," minify_media_query queries) ^
165
    "{" ^ cat "" minify_statement rulesets ^ "}"
166 167 168
  | Import (target, []) ->
    "@import " ^ string_of_expr target ^ ";"
  | Import (target, queries) ->
169 170
    "@import " ^ string_of_expr target ^ " " ^
    cat "," string_of_media_query queries ^ ";"
171
  | Page (None, decls) ->
172
    "@page{" ^ cat ";" minify_declaration decls ^ "}"
173
  | Page (Some pseudo, decls) ->
174
    "@page :" ^ pseudo ^ "{" ^ cat ";" minify_declaration decls ^ "}"
175 176 177 178 179
  | Font_face decls ->
    let minify_descriptor_declaration (name, value) =
      name ^ ":" ^ string_of_expr value
    in
    "@font-face{" ^ cat ";" minify_descriptor_declaration decls ^ "}"
180
  | Keyframes (prefix, id, rules) ->
181 182 183
    let minify_keyframe_ruleset (expr, decls) =
      minify_expr expr ^ "{" ^ cat ";" minify_declaration decls ^ "}"
    in
184 185
    "@" ^ prefix ^ "keyframes " ^ id ^
    "{" ^ cat "" minify_keyframe_ruleset rules ^ "}"
186
  | Supports (condition, statements) ->
187
    "@supports " ^ stringify_condition "" condition ^
188
    "{" ^ cat "" minify_statement statements ^ "}"
189 190 191
  | statement -> string_of_statement statement

let minify_stylesheet = cat "" minify_statement