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