tiki_of_html.cd

   1 (*
   2
   3   cduce --compile tiki_of_html.cd
   4   cduce --run tiki_of_html.cdo --arg http://digicosme.lri.fr/innovation.html
   5
   6 *)
   7 type html_element = <_ ..>html_content
   8 type html_content = [ (Byte | html_element)* ]
   9 type space = ' ' | '\t' | '\n'
  10 type content = (Byte| html_element) \ space
  11
  12
  13 let repeat (s : Latin1) (n : Int) : Latin1 =
  14   if n = 0 then s else s @ repeat s (n - 1)
  15
  16 let remove_spaces (l : html_content) : html_content =
  17   match l with
  18   | [ (x :: content | _ )* ] -> x
  19
  20 let trim_spaces (l : html_content) : html_content =
  21   match l with
  22     [ space* (x::(Byte|html_element))*? space* ] -> x
  23
  24 let tiki_of_html (level : Int) (h : html_content) : Latin1 =
  25 (* Applique le pattern a chaque element de la liste.
  26    l''expression de droite doit etre une liste, et le tout
  27    est reconcaténé:
  28    Équivalent de List.concat (List.map f l) où f est la transformation
  29    faite par le pattern
  30 *)
  31   transform h with
  32
  33   (* on ignore le header et les balises de script *)
  34     <(`script|`head) ..>_ -> []
  35
  36   (* Le gras *)
  37   | <(`b|`strong) ..>l  -> "__" @ tiki_of_html level l @ "__"
  38
  39   (* L''italique *)
  40   | <(`em|`i) ..>l  -> "''" @ tiki_of_html level l @ "''"
  41
  42   (* Les tableaux *)
  43   | <table ..>l ->  tiki_of_html level (remove_spaces l) @ "||"
  44
  45   | <tr ..>[ space* (l::content)* ] ->  "|" @ tiki_of_html level (remove_spaces l)
  46
  47   | <(`th|`td) ..>l -> "|" @ tiki_of_html level l
  48
  49   (* Les images *)
  50   | <img src=(url & Latin1) ..>_ ->
  51       " {img src=" @ url @ "} "
  52
  53   (* Les liens *)
  54   | <a href=(url & Latin1) ..>l  ->
  55       "[" @ url @ "|" @ tiki_of_html level l @ "]"
  56
  57   (* Les listes on extrait uniquement la partie li
  58      pour chaque li on retire les blancs après le <li>
  59      et avant le </li>*)
  60
  61   | <((`ul|`ol)&tag) ..>l ->
  62
  63       let sym = if tag = `ol then "#" else "*" in
  64       let prefix = repeat sym level in
  65       let res =
  66         transform remove_spaces  l with
  67           <li ..>c  ->
  68             prefix @ tiki_of_html (level+1) (trim_spaces c) @"\n"
  69         | e -> tiki_of_html (level+1) [e]
  70       in
  71       "\n" @ res
  72
  73   (* Un tag qu''on ne connait pas, on se rapplique récursivement *)
  74   | <_ ..>l -> " " @ tiki_of_html level l @ " "
  75
  76   (* Un charactère, on le copie dans la sortie *)
  77   | Byte & c -> [ c ]
  78
  79 (* main *)
  80 let [] =
  81   match argv [] with
  82     [ (url & Latin1) ] ->
  83       let [] =
  84         match load_html url with
  85         | html_content & src -> print(tiki_of_html 0 src)
  86         | _ -> print "Html invalide?\n"; exit 2
  87       in []
  88   | _ -> print "Nombre d'arguments invalides\n"; exit 1