Source file s.ml

(*********************************************************************************)
(*                OCaml-CSS                                                      *)
(*                                                                               *)
(*    Copyright (C) 2023-2024 INRIA All rights reserved.                         *)
(*    Author: Maxence Guesdon, INRIA Saclay                                      *)
(*                                                                               *)
(*    This program is free software; you can redistribute it and/or modify       *)
(*    it under the terms of the GNU General Public License as                    *)
(*    published by the Free Software Foundation, version 3 of the License.       *)
(*                                                                               *)
(*    This program 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 General Public License for more details.                               *)
(*                                                                               *)
(*    You should have received a copy of the GNU General Public                  *)
(*    License along with this program; if not, write to the Free Software        *)
(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
(*    02111-1307  USA                                                            *)
(*                                                                               *)
(*    As a special exception, you have permission to link this program           *)
(*    with the OCaml compiler and distribute executables, as long as you         *)
(*    follow the requirements of the GNU GPL in regard to all of the             *)
(*    software in the executable aside from the OCaml compiler.                  *)
(*                                                                               *)
(*    Contact: Maxence.Guesdon@inria.fr                                          *)
(*                                                                               *)
(*********************************************************************************)

(** Statements. *)

open T

let rec pp_list sep pp ppf = function
| [] -> ()
| [x] -> pp ppf x
| x :: q -> Format.fprintf ppf "%a%s%a" pp x sep (pp_list sep pp) q

type 'a qname = 'a * string

type attr_value_operator =
  | Exact (* [attr=value] *)
  | Exact_list (* [attr~=value] *)
  | Hyphen (* [attr|=value] *)
  | Prefix (* [attr^=value] *)
  | Suffix  (* [attr$=value] *)
  | Contain (* [attr*=value] *)

type attr_value =
  { v:string;
    op: attr_value_operator ;
    case_sensitive : bool ;
  }
type 'ns attr_selector =
| Attr_present of 'ns qname
| Attr_value of 'ns qname * attr_value

type 'ns pseudo_class = [
| `Active | `Default | `Disabled | `Empty | `Enabled
| `First_child | `First_of_type | `Focus | `Fullscreen
| `Hover | `In_range | `Indeterminate | `Invalid
| `Lang of string | `Last_child | `Last_of_type | `Link
| `Not of 'ns selector | `Nth_child of int
| `Nth_last_child of int
| `Nth_last_of_type | `Nth_of_type of int
| `Only_of_type | `Only_child | `Optional
| `Out_of_range | `Read_only | `Read_write
| `Required | `Root | `Target | `Valid | `Visited
| `Other of string
]

and 'ns single_selector =
  {
    sel_qname : 'ns qname with_loc option ;
    sel_attr : 'ns attr_selector with_loc list ;
    sel_id : string with_loc option ;
    sel_pseudo_class : ('ns pseudo_class with_loc) list ;
    sel_pseudo_elt : (string * string option) with_loc option ;
  }

and 'ns selector =
| Single of 'ns single_selector
| Inside of 'ns selector * 'ns single_selector
| Child of 'ns selector * 'ns single_selector
| Adjacent of 'ns selector * 'ns single_selector
| Sibling of 'ns selector * 'ns single_selector

let pseudo_class_kws : 'a pseudo_class list = [
    `Active ; `Default ; `Disabled ; `Empty ; `Enabled ;
    `First_child ; `First_of_type ; `Focus ; `Fullscreen ;
    `Hover ; `In_range ; `Indeterminate ; `Invalid ;
    `Last_child ; `Last_of_type ; `Link ;
    `Nth_last_of_type ;
    `Only_of_type ; `Only_child ; `Optional ; `Out_of_range ;
    `Read_only ; `Read_write ; `Required ; `Root ;
    `Target ; `Valid ; `Visited ]

let selector_is_empty s =
  match s.sel_qname, s.sel_id, s.sel_attr, s.sel_pseudo_class, s.sel_pseudo_elt with
  | None, None, [], [], None -> true
  | _ -> false

type nested_rule_rel = [ `Add_to_parent | `Inside | `Child | `Adjacent | `Sibling ]
let string_of_nested_rule_rel : nested_rule_rel -> string = function
| `Add_to_parent -> ""
| `Inside -> " "
| `Child -> " > "
| `Adjacent -> " + "
| `Sibling -> " ~ "

type 'ns rule_ =
  { sel : 'ns selector with_loc list ;
    decls : P.binding list ;
    nested : 'ns nested_rule list ;
  }
and 'ns rule = 'ns rule_ with_loc
and 'ns nested_rule_ = nested_rule_rel * 'ns rule
and 'ns nested_rule = 'ns nested_rule_ with_loc

let string_of_attr_value (v:attr_value) =
  let str_v = T.(string_of_str { s = v.v; quoted = true }) in
  let str_op =
  match v.op with
  | Exact -> "="
  | Exact_list -> "~="
  | Hyphen -> "|="
  | Prefix -> "^="
  | Suffix -> "$="
  | Contain -> "*="
  in
  Printf.sprintf "%s%s" str_op str_v

let string_of_attr_selector string_of_qname = function
| Attr_present name -> Printf.sprintf "[%s]" (string_of_qname name)
| Attr_value ((_,"class"), { op=Exact ; v ; case_sensitive = true}) -> Printf.sprintf ".%s" v
| Attr_value (name,v) -> Printf.sprintf "[%s%s%s]"
  (string_of_qname name) (string_of_attr_value v)
  (if v.case_sensitive then "" else " i")

let string_of_attr_selector_list string_of_qname l =
  String.concat "" (List.map
   (fun (a,_loc) -> string_of_attr_selector string_of_qname a) l)

let rec string_of_single_selector string_of_qname s =
  Printf.sprintf "%s%s%s%s%s"
    (match s.sel_qname with None -> "" | Some (q,_) -> string_of_qname q)
    (match s.sel_id with None -> "" | Some (id,_) -> "#"^id)
    (string_of_attr_selector_list string_of_qname s.sel_attr)
    (String.concat ""
     (List.map (fun (c,_loc) ->
         Printf.sprintf ":%s" (string_of_pseudo_class string_of_qname c))
      s.sel_pseudo_class)
     )
    (match s.sel_pseudo_elt with
     | None -> ""
     | Some ((s,args),_) ->
         Printf.sprintf "::%s%s" s
           (match args with None -> "" | Some args -> Printf.sprintf "(%s)" args)
    )

and string_of_selector string_of_qname = function
| Single s -> string_of_single_selector string_of_qname s
| Inside (s, ss) -> Printf.sprintf "%s %s"
  (string_of_selector string_of_qname s)
  (string_of_single_selector string_of_qname ss)
| Child (s, ss) -> Printf.sprintf "%s > %s"
  (string_of_selector string_of_qname s)
  (string_of_single_selector string_of_qname ss)
| Adjacent (s, ss) -> Printf.sprintf "%s + %s"
  (string_of_selector string_of_qname s)
  (string_of_single_selector string_of_qname ss)
| Sibling (s, ss) -> Printf.sprintf "%s ~ %s"
  (string_of_selector string_of_qname s)
  (string_of_single_selector string_of_qname ss)

and string_of_selector_ string_of_qname (s,_loc) =
  string_of_selector string_of_qname s

and string_of_pseudo_class string_of_qname = function
| `Active -> "active"
| `Default -> "default"
| `Disabled -> "disabled"
| `Empty -> "empty"
| `Enabled -> "enabled"
| `First_child -> "first-child"
| `First_of_type -> "first-of-type"
| `Focus -> "focus"
| `Fullscreen -> "fullscreen"
| `Hover -> "hover"
| `In_range -> "in-range"
| `Indeterminate -> "indeterminate"
| `Invalid -> "invalid"
| `Lang str -> Printf.sprintf "lang(%s)" str
| `Last_child -> "last-child"
| `Last_of_type -> "last-of-type"
| `Link -> "link"
| `Not sel -> Printf.sprintf "not(%s)" (string_of_selector string_of_qname sel)
| `Nth_child n -> Printf.sprintf "nth-child(%d)" n
| `Nth_last_child n -> Printf.sprintf "nth-last-child(%d)" n
| `Nth_last_of_type -> "nth-last-of-type"
| `Nth_of_type n -> Printf.sprintf "nth-of-type(%d)" n
| `Only_of_type -> "only-of-type"
| `Only_child -> "only-child"
| `Optional -> "optional"
| `Out_of_range -> "out-of-range"
| `Read_only -> "read-only"
| `Read_write -> "read-write"
| `Required -> "required"
| `Root -> "root"
| `Target -> "target"
| `Valid -> "valid"
| `Visited -> "visited"
| `Other str -> str

let pseudo_class_of_string =
  T.mk_of_string ~case_sensitive:false
    (string_of_pseudo_class
     (fun (ns,s) -> match ns with "" -> s | _ -> Printf.sprintf "%s|%s" ns s)
    )
    pseudo_class_kws

let pp_decl ppf = function
| P.B (prop, {v ; important}) ->
    Format.fprintf ppf "%s: %s%s ;"
      (P.name prop)
      (P.value_to_string prop v)
      (if important then " !important" else "")

let pp_decls ppf l = List.iter (fun d -> Format.fprintf ppf "%a@\n" pp_decl d) l

let rec pp_rule_ string_of_qname ppf r =
  Format.pp_open_vbox ppf 2 ;
  Format.fprintf ppf "%s {@\n"
    (String.concat ", "
     (List.map (string_of_selector_ string_of_qname) r.sel));
  pp_decls ppf r.decls ;
  (match r.nested with
   | [] -> ()
   | l ->
       List.iter (pp_nested_rule string_of_qname ppf) l
  );
  Format.fprintf ppf "@]}@\n"

and pp_rule string_of_qname ppf (r, _loc) =
  pp_rule_ string_of_qname ppf r

and pp_nested_rule string_of_qname ppf ((rel, r), _) =
  Format.fprintf ppf "&%s%a"
    (string_of_nested_rule_rel rel) (pp_rule string_of_qname) r

(* from https://drafts.csswg.org/mediaqueries/#media-type *)
type media_type = [
    `All
  | `Aural
  | `Braille
  | `Embossed
  | `Handheld
  | `Print
  | `Projection
  | `Screen
  | `Speech
  | `Tty
  | `Tv
  ]
let media_types = [ `All; `Aural; `Braille; `Embossed; `Handheld; `Print;
    `Projection; `Screen; `Speech; `Tty; `Tv ]
let string_of_media_type : media_type -> string = Kw.string_of_kw
let pp_media_type = mk_pp string_of_media_type

type media_feature_name = string T.with_loc
type media_feature_value =
  [ `Number of T.number
  | `Dim of T.dimension
  | `Ident of string T.with_loc
  | `Ratio of T.ratio
  ]
let string_of_media_feature_value = function
| `Number n -> T.string_of_number n
| `Dim (n,u) -> T.string_of_dimension n u
| `Ident (s,_) -> s
| `Ratio r -> T.string_of_ratio r

type media_feature_range =
  [ `Lt of media_feature_value
  | `Lte of media_feature_value
  | `Gt of media_feature_value
  | `Gte of media_feature_value
  | `Gt_lt of media_feature_value * media_feature_value
  | `Gte_lt of media_feature_value * media_feature_value
  | `Gt_lte of media_feature_value * media_feature_value
  | `Gte_lte of media_feature_value * media_feature_value
  ]
let string_of_media_feature_range name = function
| `Lt v -> Printf.sprintf "%s < %s" name (string_of_media_feature_value v)
| `Lte v-> Printf.sprintf "%s <= %s" name (string_of_media_feature_value v)
| `Gt v -> Printf.sprintf "%s > %s" name (string_of_media_feature_value v)
| `Gte v-> Printf.sprintf "%s >= %s" name (string_of_media_feature_value v)
| `Gt_lt (v1, v2) ->
    Printf.sprintf "%s < %s < %s"
      (string_of_media_feature_value v1) name (string_of_media_feature_value v2)
| `Gte_lt (v1, v2) ->
    Printf.sprintf "%s <= %s < %s"
      (string_of_media_feature_value v1) name (string_of_media_feature_value v2)
| `Gt_lte (v1, v2) ->
    Printf.sprintf "%s < %s <= %s"
      (string_of_media_feature_value v1) name (string_of_media_feature_value v2)
| `Gte_lte (v1, v2) ->
    Printf.sprintf "%s <= %s <= %s"
      (string_of_media_feature_value v1) name (string_of_media_feature_value v2)

type media_feature_constraint =
  [ `Present
  | `Value of media_feature_value
  | `Range of media_feature_range
  ]

type media_feature = media_feature_name * media_feature_constraint
let string_of_media_feature : media_feature -> string = fun ((name,_),v) ->
    match v with
    | `Present -> Printf.sprintf "(%s)" name
    | `Value v -> Printf.sprintf "(%s:%s)" name (string_of_media_feature_value v)
    | `Range r -> Printf.sprintf "(%s)" (string_of_media_feature_range name r)

let pp_media_feature = mk_pp string_of_media_feature

let get_min_max str =
  let len = String.length str in
  if len >= 4 then
    match String.sub str 0 4 with
    | "min-" -> Some (`Min (String.sub str 4 (len - 4)))
    | "max-" -> Some (`Max (String.sub str 4 (len - 4)))
    | _ -> None
  else
    None

let media_feature_map_min_max (((name,loc),constr) as feat) =
  match constr with
  | `Present | `Range _ -> feat
  | `Value v ->
      match get_min_max name with
      | None -> feat
      | Some (`Min name) -> ((name,loc), `Range (`Gte v))
      | Some (`Max name) -> ((name,loc), `Range (`Lte v))

type media_condition = [
    `Feature of media_feature
  | `And of media_condition * media_condition
  | `Or of media_condition * media_condition
  | `Not of media_condition
]
let string_of_media_condition =
  let if_comb b str = function `Feature _ -> () | _ -> Buffer.add_string b str in
  let p b fmt = Printf.bprintf b fmt in
  let rec iter b = function
  | `Feature f -> Buffer.add_string b (string_of_media_feature f)
  | `Not c ->
      p b "not ";
      if_comb b "(" c;
      iter b c ;
      if_comb b ")" c
  | `And (c1, c2) ->
      if_comb b "(" c1; iter b c1 ; if_comb b ")" c1;
      p b " and ";
      if_comb b "(" c2; iter b c2 ; if_comb b ")" c2
  | `Or (c1, c2) ->
      if_comb b "(" c1; iter b c1 ; if_comb b ")" c1;
      p b " or ";
      if_comb b "(" c2; iter b c2 ; if_comb b ")" c2
  in
  fun c ->
    let b = Buffer.create 256 in
    iter b c;
    Buffer.contents b

type media_query = {
    negated : bool ;
    media_type: media_type option ;
    media_condition : media_condition option;
  }
let string_of_media_query q =
  let b = Buffer.create 125 in
  if q.negated then Buffer.add_string b "not " ;
  let () =
    match q.media_type, q.media_condition with
    | None, None -> ()
    | Some t, None -> Buffer.add_string b (string_of_media_type t)
    | None, Some c -> Buffer.add_string b (string_of_media_condition c)
    | Some t, Some c ->
        Buffer.add_string b (string_of_media_type t);
        Buffer.add_string b " and ";
        Buffer.add_string b (string_of_media_condition c)
  in
  Buffer.contents b

let pp_media_query = mk_pp string_of_media_query

let pp_media_query_list =
  let pp_sep ppf () = Format.pp_print_string ppf ", " in
  Format.pp_print_list ~pp_sep pp_media_query

type import_conditions = unit
type layer_name = string list
let pp_layer_name = pp_list "." Format.pp_print_string
let pp_layer_names = pp_list ", " pp_layer_name

type 'ns at_rule_ =
| Charset of string
| Import of T.url * layer_name option * import_conditions option
| Layer of layer_name list * 'ns statement list
| Media of media_query list * 'ns statement list
| Namespace of string option * T.url
| Other of string

and 'ns at_rule = 'ns at_rule_ * loc

and 'ns statement =
| Rule of 'ns rule
| At_rule of 'ns at_rule

let rec pp_at_rule_ string_of_qname ppf r =
  match r with
  | Charset cs -> Format.fprintf ppf "@@charset %S;@\n" cs
  | Import (url, layer, cond) ->
      Format.fprintf ppf "@@import %s" (T.string_of_url url);
      (match layer with
       | None -> ()
       | Some [] -> Format.pp_print_string ppf " layer"
       | Some l -> Format.fprintf ppf " layer(%a)" pp_layer_name l);
      Format.fprintf ppf ";@\n"
  | Layer (names, stmts) ->
      if stmts <> [] then Format.pp_open_vbox ppf 2 ;
      Format.fprintf ppf "@@layer";
      (match names with
       | [] -> ()
       | _ -> Format.fprintf ppf " %a" pp_layer_names names );
      (match stmts with
       | [] -> Format.fprintf ppf ";@\n"
       | _ ->
           Format.fprintf ppf " {@\n%a@]}@\n"
             (pp_statement_list string_of_qname) stmts
      );
  | Media (queries, stmts) ->
      Format.pp_open_vbox ppf 2 ;
      Format.fprintf ppf "@@media %a {" pp_media_query_list queries;
      Format.fprintf ppf "@\n%a@]}@\n"
        (pp_statement_list string_of_qname) stmts
  | Namespace (p, iri) ->
      Format.fprintf ppf "@@namespace %s%s;@\n"
        (match p with None -> "" | Some s -> s^" ")
        (T.string_of_url iri)
  | Other _ -> ()

and pp_at_rule string_of_qname ppf (r, _) =
  pp_at_rule_ string_of_qname ppf r

and pp_statement string_of_qname ppf = function
| Rule r -> pp_rule string_of_qname ppf r
| At_rule r -> pp_at_rule string_of_qname ppf r

and pp_statement_list string_of_qname ppf l =
  List.iter (pp_statement string_of_qname ppf) l

module Smap = T.Smap

let empty_iri = Iri.of_string ""

let expand_qname ?(all=true) ns loc (n,ln) =
  try
    match n with
    | "" when not all -> (empty_iri, ln)
    | _ ->
        let base = Smap.find n ns in
        (base, ln)
  with
  | Not_found -> T.error (Undefined_namespace (n, loc))

let expand_attr_selector ns loc = function
| Attr_present qname -> Attr_present (expand_qname ~all:false ns loc qname)
| Attr_value (qname, v) -> Attr_value (expand_qname ~all:false ns loc qname, v)

let rec expand_pseudo_class ns = function
| `Not s -> `Not (expand_selector ns s)
| `Active | `Default | `Disabled | `Empty | `Enabled
| `First_child | `First_of_type | `Focus | `Fullscreen
| `Hover | `In_range | `Indeterminate | `Invalid
| `Lang _ | `Last_child | `Last_of_type | `Link
| `Nth_child _
| `Nth_last_child _
| `Nth_last_of_type | `Nth_of_type _
| `Only_of_type | `Only_child | `Optional
| `Out_of_range | `Read_only | `Read_write
| `Required | `Root | `Target | `Valid | `Visited
| `Other _ as x -> x

and expand_single_selector (ns:Iri.t Smap.t) s =
    let sel_attr = List.map
      (fun (a,loc) -> (expand_attr_selector ns loc a, loc)) s.sel_attr
    in
    let sel_pseudo_class =
      List.map (fun (c,loc) -> expand_pseudo_class ns c, loc) s.sel_pseudo_class
    in
    {
      sel_qname = Option.map (fun (a,loc) -> (expand_qname ns loc a, loc)) s.sel_qname ;
      sel_attr ;
      sel_id = s.sel_id ;
      sel_pseudo_class ;
      sel_pseudo_elt = s.sel_pseudo_elt ;
    }

and expand_selector ns = function
| Single s -> Single (expand_single_selector ns s)
| Inside (s, ss) -> Inside (expand_selector ns s, expand_single_selector ns ss)
| Child (s, ss) -> Child (expand_selector ns s, expand_single_selector ns ss)
| Adjacent (s, ss) -> Adjacent (expand_selector ns s, expand_single_selector ns ss)
| Sibling (s, ss) -> Sibling (expand_selector ns s, expand_single_selector ns ss)

let rec expand_rule ns r =
  let sel = List.map (fun (s,loc) -> (expand_selector ns s, loc)) r.sel in
  let nested = List.map (fun ((rel,(r,locr)), loc) ->
       ((rel, (expand_rule ns r, locr)), loc)) r.nested
  in
  { r with sel ; nested }

let html_ns_iri = Iri.of_string "http://www.w3.org/1999/xhtml"
let math_ns = ("math", Iri.of_string "http://www.w3.org/1998/Math/MathML")
let svg_ns = ("svg", Iri.of_string "http://www.w3.org/2000/svg")

(** Default namespaces used when expanding namespaces in CSS.
  These consist in:
  {ul
   {- [""] mapped to ["http://www.w3.org/1999/xhtml"],}
   {- ["math"] mapped to ["http://www.w3.org/1998/Math/MathML"],}
   {- ["svg"] mapped to ["http://www.w3.org/2000/svg"].}
  }*)
let default_ns =
  List.fold_left (fun acc (name,iri) -> Smap.add name iri acc)
     (Smap.singleton "" html_ns_iri)
    [ math_ns ; svg_ns ]

let rec expand_at_rule :
  'a Smap.t -> string at_rule_ -> 'a Smap.t * 'a at_rule_  = fun ns -> function
| Namespace (p,url) ->
    let ns =
       match url with
       | `Iri iri
       | `Src (`Iri iri) ->
            let s = match p with None -> "" | Some s -> s in
            Smap.add s iri ns
       | `Data _ | `Src (`Var _) ->
            Log.warn (fun m -> m "invalid namespace %s" (T.string_of_url url));
            ns
    in
    (ns, Namespace (p,url))
| Layer (names, stmts) ->
    let stmts = expand_statement_list ~ns stmts in
    (ns, Layer (names, stmts))
| Media (cond, stmts) ->
    let stmts = expand_statement_list ~ns stmts in
    (ns, Media (cond, stmts))
| Charset c -> ns, Charset c
| Import (url, name, cond) -> ns, Import (url, name, cond)
| Other str -> ns, Other str


and expand_statement ns = function
| Rule (r, loc) -> ns, Rule (expand_rule ns r, loc)
| At_rule (r, loc) ->
    let (ns, r) = expand_at_rule ns r in
    (ns, At_rule (r, loc))

and expand_statement_list =
  let f (ns, acc) st =
    let (ns, st) = expand_statement ns st in
    (ns, st :: acc)
  in
  fun ?(ns=default_ns) l ->
    let (_ns, stmts) = List.fold_left f (ns, []) l in
    List.rev stmts

let expand_nested : 'a statement list -> 'a statement list =
  let warn loc str =
    Log.warn (fun m -> m "Expanding nested at %a: %s" T.pp_loc loc str)
  in
  let add_to_ss nested_ss ss =
    { ss with
      sel_attr = ss.sel_attr @ nested_ss.sel_attr ;
      sel_id = (match ss.sel_id with None -> nested_ss.sel_id | x -> x) ;
      sel_pseudo_class = ss.sel_pseudo_class @ nested_ss.sel_pseudo_class ;
      sel_pseudo_elt = nested_ss.sel_pseudo_elt ;
    }
  in
  let add_to_parent nested_ss loc (parent_sel,_) acc =
    match parent_sel with
    | Single ss | Inside (_,ss) | Child (_,ss)
    | Adjacent (_,ss) | Sibling (_,ss) when ss.sel_pseudo_elt <> None -> acc
    | _ ->
        let sel =
          match parent_sel with
          | Single ss -> Single (add_to_ss nested_ss ss)
          | Inside (s,ss) -> Inside (s, add_to_ss nested_ss ss)
          | Child (s,ss) -> Child (s, add_to_ss nested_ss ss)
          | Adjacent (s,ss) -> Adjacent (s, add_to_ss nested_ss ss)
          | Sibling (s,ss) -> Sibling (s, add_to_ss nested_ss ss)
        in
        (sel,loc) :: acc
  in
  let append_ f nested_ss loc (parent_sel,_) acc =
    (f parent_sel nested_ss, loc) :: acc
  in
  let append_inside x = append_ (fun s ss -> Inside (s,ss)) x in
  let append_child x = append_ (fun s ss -> Child (s,ss)) x in
  let append_adjacent x = append_ (fun s ss -> Adjacent (s,ss)) x in
  let append_sibling x = append_ (fun s ss -> Sibling (s,ss)) x in

  let rec exp_stmt acc = function
  | At_rule (r,loc) -> At_rule (exp_at_rule r, loc) :: acc
  | Rule (r, loc) ->
      let rules = exp_rule r in
      List.fold_left (fun acc r -> Rule(r, loc) :: acc) acc rules
  and exp_stmts l = List.fold_left exp_stmt [] l
  and exp_at_rule r =
    match r with
    | Namespace _ -> r
    | Layer (names, stmts) -> Layer (names, exp_stmts stmts)
    | Media (cond, stmts) -> Media (cond, exp_stmts stmts)
    | Charset _ | Import _ | Other _ -> r
  and exp_rule r =
    let r0 = { r with nested = [] } in
    let rules = List.map (fun ((rel,(subr,subrloc)), loc) ->
       match subr.sel with
       | [] -> warn loc "Nested rule has no selector"; []
       | (Single s,loc) :: q ->
             if q <> [] then warn loc "Handling only first selector of nested rule";
             let new_sel =
               match rel with
               | `Add_to_parent -> List.fold_right (add_to_parent s loc) r.sel []
               | `Inside -> List.fold_right (append_inside s loc) r.sel []
               | `Child -> List.fold_right (append_child s loc) r.sel []
               | `Adjacent -> List.fold_right (append_adjacent s loc) r.sel []
               | `Sibling -> List.fold_right (append_sibling s loc) r.sel []
              in
              let r = { subr with sel = new_sel } in
              exp_rule r
       | _ -> warn loc "Only single selectors handled in nested rules"; []
     ) r.nested
   in
   r0 :: (List.flatten rules)
  in
  fun l -> List.rev (exp_stmts l)