stringify.ml 2.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960
  1. open Types
  2. let tab = " "
  3. let indent = Str.global_replace (Str.regexp "^\\(.\\)") (tab ^ "\\1")
  4. let rec cat sep fn = function
  5. | [] -> ""
  6. | [hd] -> fn hd
  7. | hd :: tl -> fn hd ^ sep ^ cat sep fn tl
  8. let string_of_num n =
  9. if float_of_int (int_of_float n) = n
  10. then string_of_int (int_of_float n)
  11. else string_of_float n
  12. let rec string_of_expr = function
  13. | Ident id -> id
  14. | Strlit str -> "\"" ^ str ^ "\""
  15. | Uri uri when String.contains uri ')' -> "url(\"" ^ uri ^ "\")"
  16. | Uri uri -> "url(" ^ uri ^ ")"
  17. | Concat values -> cat " " string_of_expr values
  18. | Number (n, None) -> string_of_num n
  19. | Number (n, Some u) -> string_of_num n ^ u
  20. | Function (name, arg) -> name ^ "(" ^ string_of_expr arg ^ ")"
  21. | Hexcolor hex -> "#" ^ hex
  22. | Unary (op, opnd) -> op ^ string_of_expr opnd
  23. | Nary (op, opnds) -> cat op string_of_expr opnds
  24. let string_of_declaration (name, value, important) =
  25. let imp = if important then " !important" else "" in
  26. name ^ ": " ^ string_of_expr value ^ imp ^ ";"
  27. let block body = " {\n" ^ indent body ^ "\n}"
  28. let rec string_of_statement = function
  29. | Ruleset (selectors, decls) ->
  30. cat ", " (String.concat " ") selectors ^
  31. block (cat "\n" string_of_declaration decls)
  32. | Media (queries, rulesets) ->
  33. "@media " ^ String.concat ", " queries ^
  34. block (cat "\n\n" string_of_statement rulesets)
  35. | Import (filename, []) ->
  36. "@import \"" ^ filename ^ "\";"
  37. | Import (filename, queries) ->
  38. "@import \"" ^ filename ^ "\" " ^ String.concat ", " queries ^ ";"
  39. | Charset charset ->
  40. "@charset \"" ^ charset ^ "\";"
  41. | Page (None, decls) ->
  42. "@page" ^ block (cat "\n" string_of_declaration decls)
  43. | Page (Some pseudo, decls) ->
  44. "@page :" ^ pseudo ^ block (cat "\n" string_of_declaration decls)
  45. | Fontface decls ->
  46. "@font-face " ^ block (cat "\n" string_of_declaration decls)
  47. | Namespace (None, uri) ->
  48. "@namespace \"" ^ uri ^ "\";"
  49. | Namespace (Some prefix, uri) ->
  50. "@namespace " ^ prefix ^ " \"" ^ uri ^ "\";"
  51. let string_of_stylesheet = cat "\n\n" string_of_statement