Initial commit

17 files changed, 955 insertions, 0 deletions

diff --git a/.gitignore b/.gitignore
new file mode 100755
index 0000000..682da15
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+_build/
+*.swp
diff --git a/Makefile b/Makefile
new file mode 100755
index 0000000..29bb294
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,16 @@
+all:
+	dune build @all
+
+clean:
+	dune clean
+
+docs:
+	dune build @doc
+
+install:
+	dune install --prefix "/usr" -p css_merge
+
+deps:
+	opam install . --deps-only
+
+.PHONY: all clean
diff --git a/bin/css_merge.ml b/bin/css_merge.ml
new file mode 100755
index 0000000..7e0ee6b
--- /dev/null
+++ b/bin/css_merge.ml
@@ -0,0 +1,34 @@
+open StdLabels
+
+module Args = struct
+  type t =
+    { out: string [@short "-o"]
+    } [@@deriving argparse{
+    positional =
+      [ "css", "The css file"
+      ]
+  }]
+
+  let default =
+    { out = ""
+    }
+end
+
+let () =
+
+  let arg, rest = Args.argparse Args.default "css_merge" Sys.argv in
+  let css = Array.fold_left rest
+      ~init:Css_lib.Merge.empty
+      ~f:(fun map arg ->
+          let content = Stdio.In_channel.read_all arg in
+          let css = Css.Parser.parse_stylesheet content in
+          Css_lib.Merge.add_css map css
+        ) in
+
+  Stdio.Out_channel.with_file arg.Args.out ~f:(fun channel ->
+      let format = Format.formatter_of_out_channel channel in
+      Css_lib.Print.css
+        Css_lib.Print.minify_printer
+        format
+        (Css_lib.Merge.extract_css css)
+    )
diff --git a/bin/dune b/bin/dune
new file mode 100755
index 0000000..611ab5d
--- /dev/null
+++ b/bin/dune
@@ -0,0 +1,18 @@
+(env
+  (dev
+    (flags (:standard -warn-error -A))
+    )
+ (release
+  (ocamlopt_flags (-O3)))
+)
+
+(executable
+ (public_name css_merge)
+ (package css_merge)
+ (libraries 
+    stdio
+    css_lib
+ )
+ (preprocess (pps lwt_ppx ppx_deriving_argparse))
+)
+
diff --git a/css_lib.opam b/css_lib.opam
new file mode 100755
index 0000000..1d5fd0e
--- /dev/null
+++ b/css_lib.opam
@@ -0,0 +1,25 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+version: "1.0"
+synopsis: "Css merger"
+maintainer: ["Sébastien Dailly"]
+authors: ["Sébastien Dailly"]
+depends: [
+  "dune" {>= "2.1"}
+  "ocaml" {>= "4.10.0"}
+  "css-parser" {>= "0.2.4"}
+]
+build: [
+  ["dune" "subst"] {pinned}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
diff --git a/css_merge.opam b/css_merge.opam
new file mode 100755
index 0000000..698eb2f
--- /dev/null
+++ b/css_merge.opam
@@ -0,0 +1,27 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+version: "1.0"
+synopsis: "Css merger"
+maintainer: ["Sébastien Dailly"]
+authors: ["Sébastien Dailly"]
+depends: [
+  "dune" {>= "2.1"}
+  "ocaml" {>= "4.10.0"}
+  "css-parser" {>= "0.2.4"}
+  "ppx_deriving_argparse" {>= "0.0.5"}
+  "css_lib" {>= "1.0"}
+]
+build: [
+  ["dune" "subst"] {pinned}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
diff --git a/dune-project b/dune-project
new file mode 100755
index 0000000..88123d2
--- /dev/null
+++ b/dune-project
@@ -0,0 +1,28 @@
+(lang dune 2.1)
+(name css_merge)
+(version 1.0)
+
+(generate_opam_files true)
+(authors "Sébastien Dailly")
+(maintainers "Sébastien Dailly")
+
+(package 
+  (name css_merge)
+  (synopsis "Css merger")
+  (depends
+   (ocaml (>= 4.10.0))
+   (css-parser (>= 0.2.4))
+   (ppx_deriving_argparse (>= 0.0.5))
+   (css_lib (>= 1.0))
+   
+   )
+)
+
+(package 
+  (name css_lib)
+  (synopsis "Css merger")
+  (depends
+   (ocaml (>= 4.10.0))
+   (css-parser (>= 0.2.4))
+   )
+)
diff --git a/lib/common.ml b/lib/common.ml
new file mode 100755
index 0000000..ba9aee6
--- /dev/null
+++ b/lib/common.ml
@@ -0,0 +1,61 @@
+open StdLabels
+open Css.Types
+
+let location_none = 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 * Location.t) -> (Declaration_list.t * Location.t) list -> (Declaration_list.t * 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/lib/comparator.ml b/lib/comparator.ml
new file mode 100755
index 0000000..a7b1c09
--- /dev/null
+++ b/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/lib/css_lib.ml b/lib/css_lib.ml
new file mode 100755
index 0000000..dbd689d
--- /dev/null
+++ b/lib/css_lib.ml
@@ -0,0 +1,5 @@
+(** Merge CSS *)
+module Merge = Merge
+
+(** Print CSS *)
+module Print = Print
diff --git a/lib/dune b/lib/dune
new file mode 100755
index 0000000..a105f36
--- /dev/null
+++ b/lib/dune
@@ -0,0 +1,8 @@
+(library
+ (public_name css_lib)
+ (libraries 
+    stdio
+    css-parser
+ )
+ (preprocess (pps lwt_ppx ppx_deriving_argparse))
+)
diff --git a/lib/merge.ml b/lib/merge.ml
new file mode 100755
index 0000000..2f71d58
--- /dev/null
+++ b/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 * Location.t) list
+  | Stylesheet of (Merge_style.t * ats)
+
+and at_map_content = (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 -> 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 -> 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/lib/merge.mli b/lib/merge.mli
new file mode 100755
index 0000000..2fa9254
--- /dev/null
+++ b/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/lib/merge_style.ml b/lib/merge_style.ml
new file mode 100755
index 0000000..1e8be7d
--- /dev/null
+++ b/lib/merge_style.ml
@@ -0,0 +1,131 @@
+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 * 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 * 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/lib/print.ml b/lib/print.ml
new file mode 100755
index 0000000..5e48923
--- /dev/null
+++ b/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/lib/print.mli b/lib/print.mli
new file mode 100755
index 0000000..2884f9b
--- /dev/null
+++ b/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
diff --git a/readme.rst b/readme.rst
new file mode 100755
index 0000000..f9a3c2d
--- /dev/null
+++ b/readme.rst
@@ -0,0 +1,60 @@
+=======
+CSS_lib
+=======
+
+.. default-role:: literal
+
+.. role:: ocaml(code)
+   :language: ocaml
+
+`css_lib` is a library for OCaml which allow to work with CSS file. The library
+is build on top on `css-parser`_.
+
+.. _css-parser: https://github.com/astrada/ocaml-css-parser/
+
+
+Installation
+============
+
+The repository is hosted at this location :
+http://git.chimrod.com/css_lib.git/. You can install the library with opam :
+
+.. code-block:: bash
+
+  opam pin add http://git.chimrod.com/css_lib.git
+
+css_merge
+=========
+
+`css_merge` is a standalone program which combine multiple css document into a
+single one. It produce a minified output resulting of all the document.
+
+Usage
+-----
+
+.. code-block:: bash
+
+ css_merge -out ${out_file} file1.css file2.css …
+
+The file `file1.css` and `file2.css` will be combined together, the rule from
+`file2.css` overrides the one given in `file1.css`.
+
+Example
+-------
+
+.. code-block:: css
+
+  body, p {
+      color: "black";
+  }
+
+  body, a {
+      color: "red";
+
+  }
+
+will become
+
+.. code-block:: css
+
+  p{color:"black"}a,body{color:"red"}