aboutsummaryrefslogtreecommitdiff
path: root/css/merge_lib
diff options
context:
space:
mode:
Diffstat (limited to 'css/merge_lib')
-rwxr-xr-xcss/merge_lib/common.ml61
-rwxr-xr-xcss/merge_lib/comparator.ml160
-rwxr-xr-xcss/merge_lib/css_lib.ml5
-rwxr-xr-xcss/merge_lib/dune6
-rwxr-xr-xcss/merge_lib/merge.ml138
-rwxr-xr-xcss/merge_lib/merge.mli10
-rwxr-xr-xcss/merge_lib/merge_style.ml132
-rwxr-xr-xcss/merge_lib/print.ml225
-rwxr-xr-xcss/merge_lib/print.mli7
9 files changed, 744 insertions, 0 deletions
diff --git a/css/merge_lib/common.ml b/css/merge_lib/common.ml
new file mode 100755
index 0000000..48c1b1f
--- /dev/null
+++ b/css/merge_lib/common.ml
@@ -0,0 +1,61 @@
+open StdLabels
+open Css.Types
+
+let location_none = Css.Location.none
+
+(** Update the declaration list with this new property if the same property
+ name is already present.
+
+ If not return [None] *)
+let merge_declations
+ : Declaration_list.t -> Declaration_list.kind -> Declaration_list.t option
+ = fun decls1 decl2 ->
+ let declarations, loc = decls1 in
+ let updated, list' =
+ List.fold_left_map declarations
+ ~init:false
+ ~f:(fun res kind ->
+ if Comparator.declaration_kind' kind decl2 = 0 then
+ true, decl2
+ else
+ res, kind)
+ in
+ match updated with
+ | false -> None
+ | _ -> Some
+ ( list'
+ , loc )
+
+(** Add all the declarations from [decl2] into the list [decl1]
+ and return the list, and all the new declarations to add *)
+let add_all_declarations
+ : Declaration_list.t -> Declaration_list.t -> Declaration_list.t * Declaration_list.t
+ = fun decls1 (decls2, loc2) ->
+
+ let decls1, remain' = List.fold_left decls2
+ ~init:(decls1, [])
+ ~f:(fun (decls1, remain) new_declaration ->
+ match merge_declations decls1 new_declaration with
+ (* TODO : Handle empty property as None *)
+ | None -> decls1, (Some new_declaration::remain)
+ | Some decls1 -> decls1, remain
+ ) in
+ (* Remove all the unused properties *)
+ let remain' = List.filter_map ~f:(fun x -> x) remain' in
+ ( decls1
+ , (remain', loc2) )
+
+
+let update_declarations
+ : (Declaration_list.t * Css.Location.t) -> (Declaration_list.t * Css.Location.t) list -> (Declaration_list.t * Css.Location.t) list
+ = fun (block, loc) existing ->
+ let remain, tl = List.fold_left
+ existing
+ ~init:(block, [])
+ ~f:(fun (block, prev) (declarations, location) ->
+
+ let update, remain = add_all_declarations declarations block in
+ remain, (update, location)::prev) in
+ match fst remain with
+ | [] -> tl
+ | other -> (((other, loc), loc)::tl)
diff --git a/css/merge_lib/comparator.ml b/css/merge_lib/comparator.ml
new file mode 100755
index 0000000..a7b1c09
--- /dev/null
+++ b/css/merge_lib/comparator.ml
@@ -0,0 +1,160 @@
+open Css.Types
+open StdLabels
+
+(** The module Comparator helps to compare two stylesheet together. *)
+
+(** Compare two list in a safe way *)
+let compare_list
+ : ('a -> 'a -> int) -> 'a list -> 'a list -> int
+ = fun cmp l1 l2 ->
+ let length = List.compare_lengths l1 l2 in
+ if length <> 0 then
+ length
+ else
+ List.fold_left2
+ ~f:(fun res v1 v2 ->
+ if res <> 0 then res
+ else cmp v1 v2
+ )
+ ~init:0
+ l1 l2
+
+(** Compare each component without the loccation information *)
+let rec component_value
+ : Component_value.t with_loc -> Component_value.t with_loc -> int
+ = fun v1 v2 ->
+ let open Component_value in
+ match (fst v1), (fst v2) with
+ | Paren_block b1, Paren_block b2
+ | Bracket_block b1, Bracket_block b2 ->
+ compare_list
+ component_value
+ b1 b2
+ | Percentage v1, Percentage v2
+ | Ident v1, Ident v2
+ | String v1, String v2
+ | Uri v1, Uri v2
+ | Operator v1, Operator v2
+ | Delim v1, Delim v2
+ | Hash v1, Hash v2
+ | Number v1, Number v2
+ | Unicode_range v1, Unicode_range v2 ->
+ String.compare v1 v2
+ | Float_dimension v1, Float_dimension v2 ->
+ Stdlib.compare v1 v2
+ | Dimension v1, Dimension v2 ->
+ Stdlib.compare v1 v2
+
+ | Function (n1, v1), Function (n2, v2) ->
+ let name1 = fst (n1)
+ and name2 = fst (n2) in
+ let cmp = String.compare name1 name2 in
+ if cmp <> 0 then cmp
+ else
+ compare_list
+ component_value
+ (fst v1) (fst v2)
+ | v1, v2 -> Stdlib.compare v1 v2
+
+let rec brace_block
+ : Brace_block.t -> Brace_block.t -> int
+ = fun v1 v2 ->
+ match v1, v2 with
+ | Declaration_list l1, Declaration_list l2 -> declaration_list l1 l2
+ | Stylesheet s1, Stylesheet s2 -> style_sheet s1 s2
+ | _, _ -> Stdlib.compare v1 v2
+
+and at_rule
+ : At_rule.t -> At_rule.t -> int
+ = fun v1 v2 ->
+ let cmp = String.compare (fst v1.name) (fst v2.name) in
+ if cmp <> 0 then cmp
+ else
+ let cmp =
+ compare_list
+ component_value
+ (fst v1.prelude) (fst v2.prelude)
+ in
+ if cmp <> 0 then cmp
+ else
+ brace_block v1.block v2.block
+
+and declaration
+ : Declaration.t -> Declaration.t -> int
+ = fun v1 v2 ->
+ let cmp = String.compare (fst v1.name) (fst v2.name) in
+ if cmp <> 0 then cmp
+ else
+ let cmp = Stdlib.compare (fst v1.important) (fst v2.important) in
+ if cmp <> 0 then cmp
+ else
+ compare_list
+ component_value
+ (fst v1.value) (fst v2.value)
+
+and declaration_kind
+ : Declaration_list.kind -> Declaration_list.kind -> int
+ = fun v1 v2 ->
+ match v1, v2 with
+ | Declaration v1, Declaration v2 -> declaration v1 v2
+ | At_rule v1, At_rule v2 -> at_rule v1 v2
+ | _, _ -> Stdlib.compare v1 v2
+
+and declaration_list
+ : Declaration_list.t -> Declaration_list.t -> int
+ = fun v1 v2 ->
+ compare_list
+ declaration_kind
+ (fst v1) (fst v2)
+
+and style_rule
+ : Style_rule.t -> Style_rule.t -> int
+ = fun v1 v2 ->
+ let cmp = declaration_list v1.block v2.block in
+ if cmp <> 0 then
+ cmp
+ else
+ compare_list
+ component_value
+ (fst v1.prelude) (fst v2.prelude)
+
+and rule
+ : Rule.t -> Rule.t -> int
+ = fun v1 v2 ->
+ begin match v1, v2 with
+ | Style_rule v1, Style_rule v2 -> style_rule v1 v2
+ | At_rule v1, At_rule v2 -> at_rule v1 v2
+ | _, _ -> Stdlib.compare v1 v2
+ end
+
+and style_sheet
+ : Stylesheet.t -> Stylesheet.t -> int
+ = fun v1 v2 ->
+ compare_list rule (fst v1) (fst v2)
+
+(** Compare two rules by name only *)
+let at_rule'
+ : At_rule.t -> At_rule.t -> int
+ = fun v1 v2 ->
+ let cmp = String.compare (fst v1.name) (fst v2.name) in
+ if cmp <> 0 then
+ cmp
+ else
+ compare_list
+ component_value
+ (fst v1.prelude) (fst v2.prelude)
+
+(** Compare two declarations by name only *)
+let declaration'
+ : Declaration.t -> Declaration.t -> int
+ = fun v1 v2 ->
+ String.compare (fst v1.name) (fst v2.name)
+
+(** Compare two declaration_kind by name only *)
+let declaration_kind'
+ : Declaration_list.kind -> Declaration_list.kind -> int
+ = fun v1 v2 ->
+ match v1, v2 with
+ | Declaration v1, Declaration v2 -> declaration' v1 v2
+ | At_rule v1, At_rule v2 -> at_rule' v1 v2
+ | _, _ -> Stdlib.compare v1 v2
diff --git a/css/merge_lib/css_lib.ml b/css/merge_lib/css_lib.ml
new file mode 100755
index 0000000..dbd689d
--- /dev/null
+++ b/css/merge_lib/css_lib.ml
@@ -0,0 +1,5 @@
+(** Merge CSS *)
+module Merge = Merge
+
+(** Print CSS *)
+module Print = Print
diff --git a/css/merge_lib/dune b/css/merge_lib/dune
new file mode 100755
index 0000000..e6748cd
--- /dev/null
+++ b/css/merge_lib/dune
@@ -0,0 +1,6 @@
+(library
+ (name css_lib)
+ (libraries
+ Css
+ )
+)
diff --git a/css/merge_lib/merge.ml b/css/merge_lib/merge.ml
new file mode 100755
index 0000000..af95298
--- /dev/null
+++ b/css/merge_lib/merge.ml
@@ -0,0 +1,138 @@
+open StdLabels
+open Css.Types
+
+module AtRule = Map.Make(struct
+ type t = string * (Component_value.t list)
+ let compare at1 at2 =
+
+ let cmp = String.compare (fst at1) (fst at2) in
+ if cmp <> 0 then cmp
+ else
+ Comparator.compare_list (fun l1 l2 ->
+ Comparator.component_value
+ (l1, Common.location_none)
+ (l2, Common.location_none) )
+ (snd at1)
+ (snd at2)
+ end)
+
+type at_type =
+ | Empty
+ | Declaration of (Declaration_list.t * Css.Location.t) list
+ | Stylesheet of (Merge_style.t * ats)
+
+and at_map_content = (Css.Location.t * at_type)
+
+and ats = at_map_content AtRule.t
+
+type t = Merge_style.t * ats
+
+let rec add_brace_block
+ : Brace_block.t -> Css.Location.t -> at_map_content option -> at_map_content option
+ = fun block loc value ->
+
+ begin match block, value with
+ (* Empty element, update the existing one if any *)
+ | Brace_block.Empty, _ ->
+ Some
+ ( loc
+ , Empty )
+
+ (* New declarationList, juste add it *)
+ | Brace_block.Declaration_list decls, None ->
+ Some
+ ( loc
+ , Declaration [(decls, loc)])
+
+ | Brace_block.Declaration_list decls, (Some (loc, Declaration decl2)) ->
+ Some
+ ( loc
+ , Declaration (Common.update_declarations
+ (decls, Common.location_none) decl2 ))
+
+ | Brace_block.Stylesheet s, None ->
+ let eval = add_css (Merge_style.empty, AtRule.empty) s in
+ Some
+ ( loc
+ , Stylesheet eval )
+
+ | Brace_block.Stylesheet s, Some (loc, Stylesheet css) ->
+ let eval = add_css css s in
+ Some
+ ( loc
+ , Stylesheet eval )
+
+ (* Othe cases are not handled *)
+ | _ -> None
+ end
+
+(** Add a new @ definition *)
+and add_at
+ : Css.Types.At_rule.t -> ats -> ats
+ = fun {name; prelude; block; loc} map ->
+
+ let prelude = List.map (fst prelude) ~f:fst in
+ let key = (fst name), prelude in
+ AtRule.update key
+ (add_brace_block block loc)
+ map
+
+and add_css
+ : t -> Stylesheet.t -> t
+ = fun (styles, atrules) css ->
+ List.fold_left (fst css)
+ ~init:(styles, atrules)
+ ~f:(fun (styles, ats)-> function
+ | Rule.At_rule r -> (styles, add_at r ats)
+ | Rule.Style_rule r -> (Merge_style.add_style r styles, ats))
+
+(** Helper function for retrieving the location *)
+let get_loc
+ : Rule.t -> Css.Location.t
+ = function
+ | Rule.Style_rule t -> t.Style_rule.loc
+ | Rule.At_rule t -> t.At_rule.loc
+
+let rec extract_at
+ : ats -> Css.Types.Rule.t Seq.t
+ = fun map ->
+ AtRule.to_seq map
+ |> Seq.map (fun ((name, prelude), (loc, value)) ->
+
+ let name = name, loc
+ and prelude = List.map ~f:(fun x -> x, loc) prelude, loc in
+
+ match value with
+ | Stylesheet css ->
+
+ let stylesheet = extract_css css in
+ let block = Brace_block.Stylesheet stylesheet in
+ (Rule.At_rule (At_rule.{name; prelude; block; loc}))
+ | Empty ->
+ let block = Brace_block.Empty in
+ (Rule.At_rule (At_rule.{name; prelude; block; loc}))
+
+ | Declaration decls ->
+ let declarations = List.fold_left decls
+ ~init:[]
+ ~f:(fun acc (decl, _) ->
+ let elems = fst decl in
+ List.append elems acc) in
+ let block = Brace_block.Declaration_list (declarations, loc) in
+ (Rule.At_rule (At_rule.{name; prelude; block; loc})))
+
+and extract_css
+ : t -> Stylesheet.t
+ = fun (styles, ats) ->
+ let arr =
+ Seq.append
+ (extract_at ats)
+ (Merge_style.extract_style styles)
+ |> Array.of_seq in
+ (* Sort the declaration in initial ordering (using the location attribute) *)
+ Array.fast_sort ~cmp:(fun v1 v2 -> Stdlib.compare (get_loc v1) (get_loc v2) ) arr;
+ (Array.to_list arr, Common.location_none)
+
+let empty
+ : t
+ = Merge_style.empty, AtRule.empty
diff --git a/css/merge_lib/merge.mli b/css/merge_lib/merge.mli
new file mode 100755
index 0000000..2fa9254
--- /dev/null
+++ b/css/merge_lib/merge.mli
@@ -0,0 +1,10 @@
+type t
+
+val empty
+ : t
+
+val add_css
+ : t -> Css.Types.Stylesheet.t -> t
+
+val extract_css
+ : t -> Css.Types.Stylesheet.t
diff --git a/css/merge_lib/merge_style.ml b/css/merge_lib/merge_style.ml
new file mode 100755
index 0000000..6d8851b
--- /dev/null
+++ b/css/merge_lib/merge_style.ml
@@ -0,0 +1,132 @@
+open StdLabels
+open Css.Types
+
+let delim_coma = ( Component_value.Delim ","
+ , Common.location_none )
+
+module MapRule = Map.Make(struct
+ type t = Component_value.t list
+ let compare =
+ Comparator.compare_list (fun l1 l2 ->
+ Comparator.component_value
+ (l1, Common.location_none)
+ (l2, Common.location_none)
+ )
+ end)
+
+(** The type of the map contains both :
+
+ - The declaration inside the selector
+ - The selector Location
+
+*)
+type t = (Declaration_list.t * Css.Location.t) list MapRule.t
+
+type acc = Component_value.t list * Component_value.t list list
+
+(** Group all the selectors together, using a given delimiter *)
+let group_selector
+ : string -> Component_value.t with_loc list with_loc -> Component_value.t list list
+ = fun delim elems ->
+
+ let add_element
+ : acc -> Component_value.t with_loc -> acc
+ = fun (acc, prev) elem ->
+ match (fst elem) with
+ | Delim s when String.equal s delim -> [], (List.rev acc)::prev
+ | other -> other::acc, prev
+ in
+ let last, prev = List.fold_left
+ (fst elems)
+ ~init:([], [])
+ ~f:add_element in
+ (List.rev last)::prev
+
+(** Add a new style in the map. *)
+let add_style
+ : Style_rule.t -> t -> t
+ = fun {prelude; block; loc} map ->
+ List.fold_left (group_selector "," prelude)
+ ~init:map
+ ~f:(fun map group ->
+ MapRule.update group
+ (function
+ | None ->
+ (* There is no declaration yet, just add this one *)
+ Some [(block, loc)]
+ | Some tl ->
+
+ (* The declaration is already present.
+
+ For each of them, we check if the declaration is overriden
+ by the new one, and update the list.
+
+ The news declarations are added in a new block (a second
+ pass may be necessary to join all the remaining elements
+ together.
+ *)
+ Some (Common.update_declarations (block, loc) tl))
+ map)
+
+module ReversedMapRule = Map.Make(struct
+ type t = Declaration_list.t * Css.Location.t
+
+ (* Use a custom comparaison without the location *)
+ let compare l1 l2 =
+ Comparator.declaration_list
+ (fst l1)
+ (fst l2)
+ end)
+type splitted_rules' = (Component_value.t list list) ReversedMapRule.t
+
+(** Extract all the styles, and return them as a Rule.t sequence *)
+let extract_style
+ : t -> Rule.t Seq.t
+ = fun map ->
+ (* First, iterate all the values and match the identical one together *)
+
+ let table:splitted_rules' =
+ MapRule.fold
+ (fun k values map' ->
+
+ (* Each element may be present multiple times in the declaration. We
+ have te extract each of them *)
+ List.fold_left values
+ ~init:map'
+ ~f:(fun map' (v, loc) ->
+
+ ReversedMapRule.update (v, loc)
+ (function
+ | None -> Some [k]
+ | Some tl -> Some (k::tl))
+ map' ))
+ map
+ ReversedMapRule.empty in
+
+ (* The rebuild the rules *)
+ ReversedMapRule.to_seq table
+ |> Seq.map (fun ((block, loc), k) ->
+
+ let selectors =
+ List.fold_left k
+ ~init:[]
+ ~f:(fun acc v ->
+ let selectors = List.map
+ v
+ ~f:(fun x -> x , Common.location_none) in
+ let tail = List.append selectors acc in
+ delim_coma::tail) in
+
+ let prelude =
+ match selectors with
+ | (Component_value.Delim ",", _)::tl ->
+ (* Remove the first delimiter element *)
+ ( tl
+ , Common.location_none)
+ | _->
+ ( selectors
+ , Common.location_none )
+ in
+ Rule.Style_rule (Style_rule.{prelude; block; loc}))
+
+let empty = MapRule.empty
diff --git a/css/merge_lib/print.ml b/css/merge_lib/print.ml
new file mode 100755
index 0000000..5e48923
--- /dev/null
+++ b/css/merge_lib/print.ml
@@ -0,0 +1,225 @@
+open StdLabels
+open Css.Types
+
+(* Types helpers *)
+
+type ('a, 'b) printer = (Format.formatter -> 'a -> unit) -> 'a -> 'b
+type ('a, 'b) format_printer = (('a, 'b) printer, Format.formatter, unit) format
+
+type style_rule_format = ( Component_value.t with_loc list
+ , (Declaration_list.kind list, unit) printer) format_printer
+type declaration_format= ( Declaration_list.kind list,
+ unit) format_printer
+type stylesheet_format = ( Rule.t list,
+ unit) format_printer
+type at_rule_format = (string ->
+ ( Component_value.t with_loc list
+ , (Brace_block.t, unit) printer) printer, Format.formatter, unit) format
+
+type important_format = (unit, Format.formatter, unit) format
+
+
+type template =
+ { main_css : stylesheet_format
+ ; style_rule : style_rule_format
+ ; declaration : declaration_format
+ ; stylesheet : stylesheet_format
+ ; at_rule : at_rule_format
+ ; important : important_format
+ }
+
+let pp_sep_column formater () = Format.fprintf formater ";@,"
+
+let pretty_printer =
+ { main_css = Stdlib.format_of_string "@[<v>%a@]@."
+ ; style_rule = Stdlib.format_of_string "%a {@;<1 1>@[<v>%a@]@,}@,"
+ ; declaration = Stdlib.format_of_string "{@;<1 1>@[<v>%a@]@,}@,"
+ ; stylesheet = Stdlib.format_of_string "{@;<1 1>@[<v>%a@]@,}@,"
+ ; at_rule = Stdlib.format_of_string "@%s%a%a@,"
+ ; important = Stdlib.format_of_string " !important"
+ }
+
+let minify_printer =
+ { main_css = Stdlib.format_of_string "@[<h>%a@]@."
+ ; style_rule = Stdlib.format_of_string "%a{%a}"
+ ; declaration = Stdlib.format_of_string " {%a}"
+ ; stylesheet = Stdlib.format_of_string " {%a}"
+ ; at_rule = Stdlib.format_of_string "@%s%a%a"
+ ; important = Stdlib.format_of_string "!important"
+ }
+
+type sep_printer
+ = Format.formatter -> bool -> unit
+
+let print_space
+ : sep_printer
+ = fun formatter -> function
+ | true -> Format.fprintf formatter " "
+ | false -> ()
+
+let print_coma
+ : sep_printer
+ = fun formatter -> function
+ | true -> Format.fprintf formatter ","
+ | false -> ()
+
+let rec print_block
+ : ?printer:sep_printer -> ?add_space:bool -> bool -> Format.formatter -> Component_value.t with_loc list -> unit
+ = fun ?(printer=print_space) ?(add_space=false) is_selector formatter values ->
+ let _ = List.fold_left values
+ ~init:add_space
+ ~f:(fun v -> print_component printer is_selector v formatter) in
+ ()
+
+(** Print a component list.
+
+ [print_component sep is_selector]
+
+ [sep] : The space is the common separator, but it may be a coma when the
+ components are selectors.
+
+ [is_selector] tell if we are in a selector or in declaration. Some
+ operators are handled differently in selectors (hash represent id and
+ should be prepend by space)
+
+ [add_space] tell the printer that a space shall be added before the print.
+
+
+*)
+and print_component
+ : sep_printer -> bool -> bool -> Format.formatter -> Component_value.t with_loc -> bool
+ = fun sep_printer is_selector add_space formatter (value, _) ->
+ let _ = sep_printer in
+ match value with
+ | Delim str ->
+ begin match is_selector, str with
+ | true, "*"-> Format.fprintf formatter "%a*" print_space add_space
+ | _ -> Format.fprintf formatter "%s" str
+ end;
+ false
+ | Uri str ->
+ Format.fprintf formatter {|%aurl(%s)|}
+ print_space add_space
+ str;
+ true
+ | Ident str
+ | Operator str
+ | Number str ->
+ Format.fprintf formatter {|%a%s|}
+ print_space add_space
+ str;
+ true
+ | String str
+ | Unicode_range str ->
+ Format.fprintf formatter {|"%a%s"|}
+ print_space add_space
+ str;
+ true
+ | Hash str ->
+ begin match is_selector with
+ | true ->
+ (* We are in a selector, the # Operator is alway attached to an
+ element — * are explicited in the parser. We do not need to add
+ space before *)
+ Format.fprintf formatter "#%s" str
+ | false ->
+ Format.fprintf formatter "%a#%s"
+ print_space add_space
+ str;
+ end;
+ true
+ | Percentage str ->
+ Format.fprintf formatter "%a%s%%"
+ print_space add_space
+ str;
+ true
+ | Dimension (str, unit') ->
+ Format.fprintf formatter "%a%s %s"
+ print_space add_space
+ str unit';
+ true
+ | Float_dimension (str, unit', _) ->
+ Format.fprintf formatter "%a%s%s"
+ print_space add_space
+ str unit';
+ true
+ | Bracket_block elems ->
+ Format.fprintf formatter "%a[%a]"
+ print_space add_space
+ (print_block is_selector) elems;
+ true
+ | Paren_block elems ->
+ Format.fprintf formatter "%a(%a)"
+ print_space add_space
+ (print_block is_selector) elems;
+ true
+ | Function (name, elems) ->
+
+ let printer = print_coma in
+
+ Format.fprintf formatter "%a%s(%a)"
+ print_space add_space
+ (fst name)
+ (print_block ~printer is_selector) (fst elems);
+ true
+
+let print_important
+ : template -> Format.formatter -> bool with_loc -> unit
+ = fun template formatter (is_important, _) ->
+ match is_important with
+ | true -> Format.fprintf formatter template.important
+ | false -> ()
+
+let rec print_brace_block
+ : template -> Format.formatter -> Brace_block.t -> unit
+ = fun template formatter -> function
+ | Empty -> Format.fprintf formatter ";"
+ | Declaration_list d ->
+ Format.fprintf formatter template.declaration
+ (Format.pp_print_list ~pp_sep:pp_sep_column (print_declaration_list template)) (fst d)
+ | Stylesheet css ->
+ Format.fprintf formatter template.stylesheet
+ (Format.pp_print_list (print_rule template)) (fst css)
+
+and print_at_rule
+ : template -> Format.formatter -> At_rule.t -> unit
+ = fun template formatter rule ->
+ Format.fprintf formatter template.at_rule
+ (fst rule.name)
+ (print_block true ~add_space:true) (fst rule.prelude)
+ (print_brace_block template) rule.block
+
+and print_declaration
+ : template -> Format.formatter -> Css.Types.Declaration.t -> unit
+ = fun template formatter {name; value; important; _ } ->
+ Format.fprintf formatter "%s:%a%a"
+ (fst name)
+ (print_block false) (fst value)
+ (print_important template) important
+
+and print_declaration_list
+ : template -> Format.formatter -> Css.Types.Declaration_list.kind -> unit
+ = fun template formatter -> function
+ | Declaration decl -> print_declaration template formatter decl
+ | At_rule rule -> print_at_rule template formatter rule
+
+and print_style_rule
+ : template -> Format.formatter -> Css.Types.Style_rule.t -> unit
+ = fun template formatter rule ->
+ Format.fprintf formatter template.style_rule
+ (print_block true) (fst rule.prelude)
+ (Format.pp_print_list ~pp_sep:pp_sep_column (print_declaration_list template)) (fst rule.block)
+
+and print_rule
+ : template -> Format.formatter -> Css.Types.Rule.t -> unit
+ = fun template formatter -> function
+ | Rule.Style_rule style ->
+ print_style_rule template formatter style
+ | Rule.At_rule rule ->
+ print_at_rule template formatter rule
+
+let css
+ : template -> Format.formatter -> Css.Types.Stylesheet.t -> unit
+ = fun template formatter css ->
+ Format.fprintf formatter template.main_css
+ (Format.pp_print_list (print_rule template)) (fst css)
diff --git a/css/merge_lib/print.mli b/css/merge_lib/print.mli
new file mode 100755
index 0000000..2884f9b
--- /dev/null
+++ b/css/merge_lib/print.mli
@@ -0,0 +1,7 @@
+type template
+
+val pretty_printer : template
+val minify_printer : template
+
+val css
+ : template -> Format.formatter -> Css.Types.Stylesheet.t -> unit