exception Error of string

open Node

let macros : macro list ref = ref []

let incdirs : string list ref = ref []

let add_incdir dir =
  incdirs := dir::!incdirs

let no_nl_outside =
  ["a"]

let no_nl_inside =
  ["tr"]

let indentinc = "  " (* How much to indent for pp *)

let kill_quotes str =
  if String.get str 0 = '"' then
    String.sub str 1 ((String.length str) - 3)
  else str

let chop_space str =
  Pcre.qreplace ~pat:"\s+$" str

let rec pp_attribs s (name,v) =
  s ^ " " ^ name ^ "=\"" ^ (chop_space v) ^ "\""

let rec pp_one tree indent =
  match tree with
  | Tag(name,attribs,children,line, fname) ->
    indent ^ "<" ^ name
    ^ (List.fold_left pp_attribs "" attribs)
    ^ ">"
    ^ (pp_list children (indent ^ indentinc))
    ^ indent ^ "</" ^ name ^ ">\n"
  | CloseTag(name, line, fname) ->
    indent ^ "</" ^ name ^ ">\n"
  | STag(name, attrs, line, fname) ->
    indent ^ "<" ^ name 
    ^ (List.fold_left pp_attribs "" attrs)
    ^ ">\n"
  | Text(s, line, fname) ->
    indent ^ s ^ "\n"
  | Comment(s, line, fname) ->
    indent ^ s ^ "\n"

and pp_list treelist indent =
  match treelist with
  | [] -> ""
  | h::t ->
    (pp_one h indent) ^ (pp_list t indent)

let pp_string treelist = pp_list treelist ""

let rec print_raw_one tree =
  match tree with
  | Tag(name,attribs,children,line, fname) ->
    "<" ^ name
    ^ (List.fold_left pp_attribs "" attribs)
    ^ ">"
    ^ (print_raw_list children)
    ^ "</" ^ name ^ ">"
  | CloseTag(name,line, fname) ->
    "</" ^ name ^ ">"
  | STag(name, attrs, line, fname) ->
    "<" ^ name 
    ^ (List.fold_left pp_attribs "" attrs)
    ^ ">"
  | Text(s, line, fname) ->
    s
  | Comment(s, line, fname) ->
    s

and print_raw_list treelist =
  match treelist with
  | [] -> ""
  | h::t -> (print_raw_one h) ^ (print_raw_list t)

let raw_string treelist = print_raw_list treelist

let rec build_element = function
  | [] -> ([], [], "", 0, "")
  | h::t ->
    match h with
    | Text(s, line, fname) as n ->
      let (tree, leftover, close, _, _) = build_element t in
      (* (n::tree, leftover, close) *)
      (Text(chop_space s, line, fname)::tree, leftover, close, line, fname)
    | STag(name, attrs, line, fname) as n ->
      let (tree, leftover, close, _, _) = build_element t in
      (n::tree, leftover, close, line, fname)
    | Tag(name, attrs, kids, line, fname) ->
      let (tree, leftover, close, _, _) = build_element t in
      if not (name = close) then begin
        (* print_string "Tree:\n";
        print_string (pp_string tree);
        print_string
          ("ERROR: Tag '" ^ name ^ "' expected, got '" ^ close ^ "'.\n");
        print_string ("In file " ^ fname ^ " line ");
        print_int line;
        print_newline(); *)
        (*print_string
          ("  " ^ fname ^ " " ^ (string_of_int line) ^ ": Tag '" ^ name ^ "' expected, got '" ^ close ^ "'.");
        print_newline(); *)
      end;
        (* raise (Error ("Tag '" ^ name ^ "' expected, got '" ^ close ^ "'.")); *)
      let (tree2, leftover2, close2, line2, fname2) = build_element leftover in
      (*print_string ("Name: " ^ name
      ^ "\tclose: " ^ close);
      print_newline();
(*      let n = if close2 = "" then close else close in *) *)
      (Tag(name, attrs, tree, line, fname)::tree2, leftover2, close2, line2, fname2)
      (* (Tag(name, attrs, tree)::[], leftover, close) *)
    | CloseTag(name, line, fname) ->
      ([], t, name, line, fname)
    | Comment(s, _, _) as n ->
      let (tree, leftover, close, line, fname) = build_element t in
      (n::tree, leftover, close, line, fname)
      
let rec build = function
  | [] -> []
  | _ as treelist ->
    let (tree, leftover, close, _, _) = build_element treelist in
    tree @ (build leftover)

let rec open_include filename = function
  | [] -> raise (Sys_error ("Cannot find include file" ^ filename))
  | h::t ->
    try
      open_in (h ^ filename)
    with Sys_error(s) -> open_include filename t

let rec expand_includes = function
  | [] -> []
  | h::t ->
    match h with
    | STag(name, attrs, line, fname) ->
      if name = "include" then begin
        let s = (List.assoc "file" attrs) in
        (* let filename = String.sub s 1 ((String.length s) - 3) in *)
        let filename = kill_quotes s in
        (*print_string ("Including: '" ^ filename ^ "'");
        print_newline(); *)
        (* let input = open_in filename in *)
        let input = open_include filename (""::!incdirs) in
        Node.lineNum := 1;
        Node.curFile := filename;
        let lexbuf = Lexing.from_channel input in
        let result = Parser.html Lexer.token lexbuf in
        close_in input;
        let treelist = build result in
        let included = expand_includes treelist in
        (* (expand_includes result) :: (expand_includes t) *)
        included @ (expand_includes t)
      end else STag(name, attrs, line, fname)::(expand_includes t)
    | Tag(name, attrs, kids, line, fname) ->
      Tag(name, attrs, expand_includes kids, line, fname) :: (expand_includes t)
    | _ as n -> n::(expand_includes t)

let rec extract_text = function
  | [] -> ""
  | h::t ->
    match h with
    | Text(s, line, fname) -> s ^ (extract_text t)
    | Tag(name, attrs, kids, line, fname) -> (extract_text kids) ^ (extract_text t)
    | _ -> extract_text t

let rec grep_opts = function
  | [] -> []
  | h::t ->
    match h with
    | Tag(name, attrs, kids, line, fname) ->
      if name = "moption" then begin
        let opname = List.assoc "name" attrs in
        (*let value = chop_space (extract_text kids) in *)
        let value = chop_space (raw_string kids) in
        (opname,value)::(grep_opts t)
      end else (grep_opts t)
    | _ -> grep_opts t

let rec grep_body = function
  | [] -> []
  | h::t ->
    match h with
    | Tag(name, attrs, kids, line, fname) ->
      if name = "mbody" then kids
      else (grep_body t)
    | _ -> grep_body t

let grep_macro attrs mac =
  let name = kill_quotes (List.assoc "name" attrs) in
  let opts = grep_opts mac in
  let body = grep_body mac in
  let new_macro = (name,(opts,body)) in
  macros := new_macro::!macros
    
let rec extract_macros = function
  | [] -> []
  | h::t ->
    match h with
    | Tag(name, attrs, kids, line, fname) as m ->
      if name = "macro" then begin
        (* print_string "Found Macro!";
        print_newline(); *)
        (* macros := m :: !macros; *)
        grep_macro attrs kids;
        extract_macros t
      end else Tag(name, attrs, extract_macros kids, line, fname) :: (extract_macros t)
    | _ as n -> n::(extract_macros t)


(* Adds the first given nodelist into the second at all the <content> tags *)
let rec add_content body = function
  | [] -> []
  | h::t ->
    match h with
    | STag(s, attrs, line, fname) as m ->
      if s = "content" then begin
        (* print_string "Found place to insert content.";
        print_newline(); *)
        body @ (add_content body t)
      end else m::(add_content body t)
    | Tag(name, attrs, kids, line, fname) as m ->
      Tag(name, attrs, add_content body kids, line, fname)::(add_content body t)
    | _ as m -> m::(add_content body t)


(* passed a name=value pair goes through list looking for match *)
let rec expand_attr optlist (name,value) =
  match optlist with
  | [] -> (name,value)
  | (opt,replacement)::t ->
    let pat = "\$" ^ opt in
    (* print_string ("Searching for " ^ pat ^ " in " ^ value);
    print_newline(); *)
    if Pcre.pmatch ~pat: pat value then
      let value = Pcre.qreplace ~pat: pat ~templ: replacement value in
      expand_attr t (name,value)
    else expand_attr t (name,value)
  
let rec expand_text optlist text =
  match optlist with
  | [] -> text
  | (opt, replacement)::t ->
    let pat = "\$" ^ opt in
    if Pcre.pmatch ~pat:pat text then
      let text = Pcre.qreplace ~pat: pat ~templ: replacement text in
      expand_text t text
    else expand_text t text

(* Expand the attributes in the bodys and tags *)
let rec expand_opts opts = function
  | [] -> []
  | h::t ->
    match h with
    | Tag(name, attrs, kids, line, fname) as m ->
      let attrs = List.map (expand_attr opts) attrs in
      Tag(name, attrs, expand_opts opts kids, line, fname)::(expand_opts opts t)
    | STag(name, attrs, line, fname) as m ->
      let attrs = List.map (expand_attr opts) attrs in
      STag(name, attrs, line, fname)::(expand_opts opts t)
    | Text(s, line, fname) ->
      Text(expand_text opts s, line, fname)::(expand_opts opts t)
    | _ as n -> n::(expand_opts opts t)


(* Expand the macros in a nodelist *)
let rec expand_macros = function
  (* Go through the list of nodes given *)
  | [] -> [] (* End of this branch *)
  | h::t ->
    match h with (* What sort of node is the first in the list? *)
    | Tag(name, attrs, kids, line, fname) as m ->
    
      (* It is a tag, lets check to see if it is a macro *)
      if List.mem_assoc name !macros then begin
      
        (* What do you know, it is a macro *)
        (* print_string ("Expanding macro - '" ^ name ^ "'");
        print_newline(); *)
        
        (* Grab the macro from the global list *)
        let (opts, body) = List.assoc name !macros in
        
        (* Put in default values *)
        let all_opts = attrs @ opts in
        
        (* Insert the body into the <content> tag *)
        let with_content = add_content kids body in
        
        (* Expand the attribute vars in the body and tags *)
        let with_opts = expand_opts all_opts with_content in
        
        (* Return the (recursively) expanded result *)
        (expand_macros with_opts) @ (expand_macros t)
        
      end else begin
        (* Its not a macro, so lets just move on *)
        (* print_string ("No macro found at '" ^ name ^ "'.");
        print_newline(); *)
        Tag(name, attrs, expand_macros kids, line, fname)::(expand_macros t)
      end
    | _ as n -> n::(expand_macros t)

let rec print_macros = function
  | [] -> ()
  | (name,body)::t ->
    print_string ("Macro " ^ name);
    print_newline();
    print_macros t


let shellexec cmd instr =
  (*print_string ("  Executing: '" ^ cmd ^ "'");
  print_newline(); *)
  let (inchan, outchan) = Unix.open_process cmd in
  output_string outchan instr;
  close_out outchan;
  let outstr = ref "" in
  begin
    try
      while true do outstr := !outstr ^ (input_line inchan) ^ "\n" done;
      !outstr
    with _ -> !outstr
  end


let rec do_shell_tag = function
  | [] -> []
  | h::t ->
    match h with
    | Tag(name, attrs, kids, line, fname) as m ->
      if name = "shell" then begin
        (* let s = pp_string (do_shell_tag kids) in *)
        let s = raw_string (do_shell_tag kids) in
        let cmd = (List.assoc "cmd" attrs) in
        let output = shellexec cmd s in
        Text(output, line, fname) :: (do_shell_tag t)
      end else Tag(name, attrs, do_shell_tag kids, line, fname) :: (do_shell_tag t)
    | _ as n -> n::(do_shell_tag t)