From c77951ba16a25e0c1ffa12b3eb92e687a83529a6 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Kim=20Nguy=E1=BB=85n?= Date: Tue, 23 Oct 2012 23:14:07 +0200 Subject: [PATCH] Improved version. --- tiki_of_html.cd | 90 ++++++++++++++++++++++++++++++++++--------------- 1 file changed, 63 insertions(+), 27 deletions(-) diff --git a/tiki_of_html.cd b/tiki_of_html.cd index b3dec8e..ff79a69 100644 --- a/tiki_of_html.cd +++ b/tiki_of_html.cd @@ -4,52 +4,88 @@ 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 tiki_of_html (h : [ Any* ]) : [Byte*] = -/* Applique le pattern a chaque element de la liste. - l'expression de droite doit etre une liste, et le tout +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 */ - _ -> [] + (* 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 *) + | l -> tiki_of_html level (remove_spaces l) @ "||" + + | [ space* (l::content)* ] -> "|" @ tiki_of_html level (remove_spaces l) - /* Le gras */ - | (l&[Any*]) -> "__" @ tiki_of_html l @ "__" + | <(`th|`td) ..>l -> "|" @ tiki_of_html level l - /* Les liens */ - | (l&[Any*]) -> - "[" @ url @ "|" @ tiki_of_html l @ "]" + (* Les images *) + | _ -> + " {img src=" @ url @ "} " - /* Les listes non */ - | <((`ul|`ol)&tag) ..>(l&[Any*]) -> - let sym = if tag = `ol then "# " else "* " in + (* Les liens *) + | 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
  • + et avant le
    • *) + + | <((`ul|`ol)&tag) ..>l -> + + let sym = if tag = `ol then "#" else "*" in + let prefix = repeat sym level in let res = - transform "\n" @ l with -
  • (l&[Any*]) -> sym @ tiki_of_html l @"\n" - | x -> tiki_of_html [ x ] + transform remove_spaces l with +
  • c -> + prefix @ tiki_of_html (level+1) (trim_spaces c) @"\n" + | e -> tiki_of_html (level+1) [e] in - res + "\n" @ res - /* Un tag qu'on ne connait pas, on se rapplique récursivement */ - | <_ ..>(l&[Any*]) -> " "@tiki_of_html l@" " + (* 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 */ + (* Un charactère, on le copie dans la sortie *) | Byte & c -> [ c ] - /* Autre chose ? on l'ignore */ - | _ -> [] -;; +;; +(* main *) let [] = match argv [] with [ (url & Latin1) ] -> - print (tiki_of_html (load_html url)) - - + 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 -- 2.17.1