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 */
- <head ..>_ -> []
+ (* 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)
- /* Le gras */
- | <b ..>(l&[Any*]) -> "__" @ tiki_of_html l @ "__"
+ | <(`th|`td) ..>l -> "|" @ tiki_of_html level l
- /* Les liens */
- | <a href=(url & Latin1) ..>(l&[Any*]) ->
- "[" @ url @ "|" @ tiki_of_html l @ "]"
+ (* Les images *)
+ | <img src=(url & Latin1) ..>_ ->
+ " {img src=" @ url @ "} "
- /* Les listes non */
- | <((`ul|`ol)&tag) ..>(l&[Any*]) ->
- let sym = if tag = `ol then "# " else "* " in
+ (* 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 "\n" @ l with
- <li ..>(l&[Any*]) -> sym @ tiki_of_html l @"\n"
- | x -> tiki_of_html [ x ]
+ 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
- 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
projects / hacks / tiki_of_html.git / commitdiff