(*
  
  cduce --compile tiki_of_html.cd
  cduce --run tiki_of_html.cdo --arg http://digicosme.lri.fr/innovation.html

*)
type html_element = <_ ..>html_content
type html_content = [ (Byte | html_element)* ]
type space = ' ' | '\t' | '\n'
type content = (Byte| html_element) \ space


let repeat (s : Latin1) (n : Int) : Latin1 =
  if n = 0 then s else s @ repeat s (n - 1)

let remove_spaces (l : html_content) : html_content =
  match l with
  | [ (x :: content | _ )* ] -> x

let trim_spaces (l : html_content) : html_content =
  match l with
    [ space* (x::(Byte|html_element))*? space* ] -> x

let tiki_of_html (level : Int) (h : html_content) : Latin1 =
(* Applique le pattern a chaque element de la liste.
   l''expression de droite doit etre une liste, et le tout
   est reconcaténé:
   Équivalent de List.concat (List.map f l) où f est la transformation
   faite par le pattern
*)
  transform h with

  (* on ignore le header et les balises de script *)
    <(`script|`head) ..>_ -> []

  (* Le gras *)
  | <(`b|`strong) ..>l  -> "__" @ tiki_of_html level l @ "__"

  (* L''italique *)
  | <(`em|`i) ..>l  -> "''" @ tiki_of_html level l @ "''"

  (* Les tableaux *)
  | <table ..>l ->  tiki_of_html level (remove_spaces l) @ "||"

  | <tr ..>[ space* (l::content)* ] ->  "|" @ tiki_of_html level (remove_spaces l)

  | <(`th|`td) ..>l -> "|" @ tiki_of_html level l

  (* Les images *)
  | <img src=(url & Latin1) ..>_ ->
      " {img src=" @ url @ "} "

  (* Les liens *)
  | <a href=(url & Latin1) ..>l  ->
      "[" @ url @ "|" @ tiki_of_html level l @ "]"

  (* Les listes on extrait uniquement la partie li
     pour chaque li on retire les blancs après le <li>
     et avant le </li>*)

  | <((`ul|`ol)&tag) ..>l ->

      let sym = if tag = `ol then "#" else "*" in
      let prefix = repeat sym level in
      let res =
        transform remove_spaces  l with
          <li ..>c  ->
            prefix @ tiki_of_html (level+1) (trim_spaces c) @"\n"
        | e -> tiki_of_html (level+1) [e]
      in
      "\n" @ res

  (* Un tag qu''on ne connait pas, on se rapplique récursivement *)
  | <_ ..>l -> " " @ tiki_of_html level l @ " "

  (* Un charactère, on le copie dans la sortie *)
  | Byte & c -> [ c ]

(* main *)
let [] =
  match argv [] with
    [ (url & Latin1) ] ->
      let [] =
        match load_html url with
        | html_content & src -> print(tiki_of_html 0 src)
        | _ -> print "Html invalide?\n"; exit 2
      in []
  | _ -> print "Nombre d'arguments invalides\n"; exit 1