rewrite Haskell parts in Scala
[wix.git] / src / Doc.scala
1 import edu.berkeley.sbp.scala._
2
3 import Html.mapToHtml
4 import Html.joinStrings
5 import Html.{urlEscape,htmlEscape}
6 import Html.{pre,stag,tag,stag_,tag_,stag0,link}
7
8 object Doc {
9
10   def concatMap[A,B](f: A => Seq[B], s:Seq[A]) : Seq[B] =
11     concat(s.map(f))
12
13   def concat[A](s:Seq[Seq[A]]) : Seq[A] =
14     s.foldLeft(Seq[A]())(_ ++ _)
15
16   def docFromTree(t:Tree) : Doc =
17     t match { case Tree(_,Seq(_,Tree(_,a))) => new Doc(new Header(), a.map(sectionFromTree)) }
18
19   def sectionFromTree(t:Tree) : Section =
20     t match {
21       case Tree("Section", seq) =>
22         seq(0) match {
23           case Tree("SectionHeader", Seq(Tree("=",e),c)) =>
24             new Section(e.length-1, textSequenceFromTree(c), paragraphsFromTrees(seq.tail))
25         }
26     }
27
28   def textSequenceFromTree (t:Tree) : Seq[Text] =
29     t match {
30       case Tree("Word",    chars          ) => Seq(new Chars(stringFromTrees(chars)))
31       case Tree("Ordinal", x              ) => Seq(new Command("ordinal", Seq(new Chars(stringFromTrees(x)))))
32       case Tree("Fraction", Seq(n,d)      ) => Seq(new Command("fraction",Seq(new Chars(stringFromTree(n)),
33                                                                               new Chars(stringFromTree(d)))))
34       case Tree("WS",     _               ) => Seq(WS)
35       case Tree("Quotes", Seq(x)          ) => Seq(new Quotes(textSequenceFromTree(x)))
36       case Tree("Pars", y                 ) => Seq(new SubPar(paragraphsFromTrees(y)))
37       case Tree("Command", Seq(x,y)       ) => Seq(new Command(stringFromTree(x), textSequenceFromTree(y)))
38       case Tree("Command",  Seq(x)        ) => Seq(new Command(stringFromTree(x), Seq()))
39       case Tree("Link",  Seq(text,link)   ) => Seq(new Link(urlFromTree(link), textSequenceFromTree(text)))
40       case Tree("Footnote", x             ) => Seq(new Footnote(concatMap(textSequenceFromTree,x)))
41       case Tree("Keyword", x              ) => Seq(new Keyword(concatMap(textSequenceFromTree,x)))
42       case Tree("Math", x                 ) => Seq(new Math(stringFromTrees(x)))
43       case Tree("Italic",  Seq(x)         ) => Seq(new Styled(Italic        , textSequenceFromTree(x)))
44       case Tree("Bold",  Seq(x)           ) => Seq(new Styled(Bold          , textSequenceFromTree(x)))
45       case Tree("Highlight",  Seq(x)      ) => Seq(new Styled(Highlight     , textSequenceFromTree(x)))
46       case Tree("TT", x                   ) => Seq(new Styled(TT            , concatMap(textSequenceFromTree,x)))
47       case Tree("Strikethrough", x        ) => Seq(new Styled(Strikethrough , concatMap(textSequenceFromTree,x)))
48       case Tree("Superscript", x          ) => Seq(new Styled(Superscript   , concatMap(textSequenceFromTree,x)))
49       case Tree("Subscript", x            ) => Seq(new Styled(Subscript     , concatMap(textSequenceFromTree,x)))
50       case Tree("Underline", x            ) => Seq(new Styled(Underline     , concatMap(textSequenceFromTree,x)))
51       case Tree("(e)",  _)                  => Seq(new GlyphText(Euro))
52       case Tree("(r)",  _)                  => Seq(new GlyphText(CircleR))
53       case Tree("(c)",  _)                  => Seq(new GlyphText(CircleC))
54       case Tree("(tm)",  _)                 => Seq(new GlyphText(TradeMark))
55       case Tree("--",  _)                   => Seq(new GlyphText(Emdash))
56       case Tree("<-",  _)                   => Seq(new GlyphText(LeftArrow))
57       case Tree("<=",  _)                   => Seq(new GlyphText(DoubleLeftArrow))
58       case Tree("=>",  _)                   => Seq(new GlyphText(DoubleRightArrow))
59       case Tree("<=>",  _)                  => Seq(new GlyphText(DoubleLeftRightArrow))
60       case Tree("<->",  _)                  => Seq(new GlyphText(LeftRightArrow))
61       case Tree("^o",  _)                   => Seq(new GlyphText(Degree))
62       case Tree("...",  _)                  => Seq(new GlyphText(Ellipsis))
63       case Tree("Text",   ts)               => concat(ts.map(textSequenceFromTree))
64       case Tree("",    Seq())               => Seq()
65       case t => throw new RuntimeException("unable to create [Text] from " + t)
66     }
67
68   def hostFromTree(t:Tree) : Host =
69     t match {
70       case Tree("IP", Seq(Tree(_,a),Tree(_,b),Tree(_,c),Tree(_,d))) =>
71         new HostIP(intFromTrees(a), intFromTrees(b), intFromTrees(c), intFromTrees(d))
72       case Tree("DNS", parts) =>
73         new HostDNS(parts.map( (t:Tree) => t match { case Tree(_, c) => stringFromTrees(c) }))
74     }
75
76   def urlFromTree(t:Tree) : URL =
77     t match {
78       case Tree("URL", stuff)                            => urlFromTrees(stuff)
79       case Tree("Email", Seq(Tree("username", un),host)) => new URLEmail(stringFromTrees(un), hostFromTree(host))
80       case Tree("Path",stuff)                            => new URLPath(stuff.map(fromUrlChar).foldLeft("")(_ + _))
81     }
82
83   def urlFromTrees(t:Seq[Tree]) : URL =
84     t match {
85       case Seq(Tree(_,method), login, host, port, rest @_*) =>
86         new URLNormal(stringFromTrees(method),
87                       None,
88                       hostFromTree(host),
89                       port match { case Tree("Port",port) => {
90                                      val q = stringFromTrees(port)
91                                      if (q.equals("")) None else Some(java.lang.Integer.parseInt(q))
92                                    }
93                                    case _ => None },
94                       rest match { case Seq(Tree("Path",p), x@_*) => p.map(fromUrlChar).foldLeft("")(_ + _)
95                                    case _ => "" },
96                       rest match { case Seq(_ , Tree("Path",r), x@_*) => Some(stringFromTrees(r))
97                                    case _ => None })
98     }
99
100   //fromUrlChar (Tree "%" [(Tree a [] _),(Tree b [] _)] _) = chr $ (fst $ head $ readHex (a++b))
101   // FIXME: problem here is the "/" vs "%2F" issue, so we "leave urls urlencoded"
102   def fromUrlChar(t:Tree) : String =
103     t match {
104       case Tree("%", Seq(Tree(a,Seq()),Tree(b,Seq()))) => "%"+a+b
105       case Tree(x,y) =>
106         if (x.length==1) x
107         else throw new RuntimeException("could not parse as URL char: " + t)
108     }
109
110   def paragraphsFromTrees(ts:Seq[Tree]) : Seq[Paragraph] =
111     consolidate(concatMap(paragraphsFromTree,ts))
112
113   def paragraphsFromTree(t:Tree) : Seq[Paragraph] =
114     consolidate (t match {
115       case Tree("Verbatim",       Seq(indent,v)) => Seq(new P(    Seq(new Verbatim(unindent(indent,unverbate(v))))))
116       case Tree("TextParagraph",  Seq(Tree(_,text))) => Seq(new P(concatMap(textSequenceFromTree,text)))
117       case Tree("Pars",           pars         ) => concatMap(paragraphsFromTree,pars)
118       case Tree("HR",             _            ) => Seq(HR)
119       case Tree("OL",             a            ) =>
120         Seq(new OL(a.map( (t:Tree) => t match { case Tree("LI",x) => paragraphsFromTrees(x)})))
121       case Tree("UL",             a            ) =>
122         Seq(new UL(a.map( (t:Tree) => t match { case Tree("LI",x) => paragraphsFromTrees(x)})))
123       case Tree("",               _            ) => Seq()
124       case Tree("Blockquote",     pars         ) => Seq(Blockquote(paragraphsFromTrees(pars)))
125       case _ => throw new RuntimeException("unable to create [Paragraph] from " + t)
126     })
127
128   def unverbate (t:Tree) : String =
129     t match {
130       case Tree("Verbatim",x) => x.map(unverbate).foldLeft("")(_ + _)
131       case Tree("VerbatimBrace",Seq(x,y)) => unverbate(x)+" "+unverbate(y)
132       case Tree(t,Seq()) => t
133     }
134
135   def unindent (t:Tree,v:String) : String =
136     t match {
137       case Tree("I", indent) => unindent_(indent.length+1, v)
138     }
139
140   private def unindent_ (i:Int,v:String) : String =
141     if (v.length==0)    ""
142     else if (v.charAt(0) == '\n') "\n"+unindent_(i, drop_(i, v.substring(1)))
143     else v.charAt(0)+unindent_(i, v.substring(1))
144
145   private def drop_(n:Int, x:String) : String = {
146     val x_ : Seq[Char] = x;
147     if (n==0) x
148     else (x_ match {
149       case Seq('\n', r@_*) => x
150       case Seq()           => ""
151       case Seq(a, b@_*)    => drop_(n-1, x.substring(1))
152     })
153   }
154
155   def consolidate(x:Seq[Paragraph]) : Seq[Paragraph] =
156     x match {
157       case Seq() => Seq()
158       case Seq(a) => Seq(a)
159       case Seq(OL(Seq()), x@_*) => consolidate(x)
160       case Seq(UL(Seq()), x@_*) => consolidate(x)
161       case Seq(OL(a),     OL(b), x@_*) => consolidate(Seq(OL(a++b))++x)
162       case Seq(UL(a),     UL(b), x@_*) => consolidate(Seq(UL(a++b))++x)
163       case Seq(a, b @_*) => Seq(a)++consolidate(b)
164     }
165
166   def intFromTrees(t:Seq[Tree]) : Int =
167     java.lang.Integer.parseInt(stringFromTrees(t))
168   def stringFromTree(t:Tree) : String =
169     t match { case Tree(h,c) => h++concatMap(stringFromTree,c) }
170   def stringFromTrees(ts:Seq[Tree]) : String =
171     ts.map(stringFromTree).foldLeft("")(_ + _)
172
173 }
174
175 class Doc (val header:Header, val sections:Seq[Section]) extends ToHtml {
176   override def toHtml =
177      "<!-- This document was AUTOMATICALLY GENERATED from wix source -->\n"+
178      "<!--    it is probably not a wise idea to edit it directly     -->\n\n"+
179      "<html>\n"+
180      "<head>\n"+
181      Html.style+
182      // FIXME: title tag
183      "</head>\n"+
184      "<body>\n"+   // tell jsmath we will escape stuff manually
185      Html.jsMath+  // FIXME: only put this in if math appears on the page
186      "<center><table><tr><td width=600>\n"+
187      mapToHtml(sections)+
188      "<br><br>\n"+
189      "<table width=100% class=footer><tr><td align=left>"+
190      "<img src='"+Html.printIconBase64+"'></td>"+
191      "<td align=right><span class='signature'>rendered from "+
192      "<a href=http://www.megacz.com/software/wix>"+
193      "W<span style='vertical-align:-20%'>I</span>X</a></span></div></td></tr></table>\n"+
194      "</td></tr></table></center>\n"+
195      "</body></html>"
196 }
197
198 class Header()
199
200 class Section (val level:Int, val header:Seq[Text], val paragraphs:Seq[Paragraph]) extends ToHtml {
201   def toHtml = "\n<h"+((level+1))+">\n"+(mapToHtml(header))+"\n</h"+((level+1))+">\n"+(mapToHtml(paragraphs)) }
202
203 abstract class Paragraph extends ToHtml
204   case class P          (val body :Seq[Text]                  ) extends Paragraph { override def toHtml = stag_("p",body) }
205   case object HR                                                       extends Paragraph { override def toHtml = stag("hr") }
206   case class OL         (val items:Seq[Seq[Paragraph]] ) extends Paragraph {
207     override def toHtml = stag0("ol", items.map( (s:Seq[Paragraph]) => stag_("li", s) ).foldLeft("")(_ + _)) }
208   case class UL         (val items:Seq[Seq[Paragraph]] ) extends Paragraph {
209     override def toHtml = stag0("ul", items.map( (s:Seq[Paragraph]) => stag_("li", s) ).foldLeft("")(_ + _)) }
210   case class Blockquote (val body :Seq[Paragraph]             ) extends Paragraph {
211     override def toHtml = 
212       "\n<table class=blockquote border=0 cellpadding=5px>\n"+
213       "<tr><td valign=top><image src='"+Html.quoteIconBase64+"'></td>\n"+
214       "<td class=warn>\n"+
215       mapToHtml(body)+
216       "</td></tr></table>\n"
217   }
218
219 abstract class Style
220   case object TT extends Style
221   case object Underline extends Style
222   case object Superscript extends Style
223   case object Subscript extends Style
224   case object Strikethrough extends Style
225   case object Italic extends Style
226   case object Bold extends Style
227   case object Highlight extends Style
228
229 abstract class Text extends ToHtml
230   case object WS extends Text { def toHtml = " " }
231   case class Chars(val body:String) extends Text { def toHtml = htmlEscape(body) }
232   case class Quotes(val body:Seq[Text]) extends Text { def toHtml = "&#8220;"+mapToHtml(body)+"&#8221;" }
233   case class GlyphText(val body:Glyph) extends Text { override def toHtml = body.toHtml }
234   case class Math(val body:String) extends Text { override def toHtml = "<span class=math>" +body+ "</span>" }
235   case class Verbatim(val body:String) extends Text { override def toHtml = pre(body) }
236   case class Link(val url:URL, val body:Seq[Text]) extends Text { override def toHtml = link(url.toString, body) }
237   case class Footnote(val body:Seq[Text]) extends Text { override def toHtml = throw new Exception() }
238   case class Keyword(val body:Seq[Text]) extends Text { override def toHtml = tag_("tt", body) }
239   case class SubPar(val body:Seq[Paragraph]) extends Text { override def toHtml = stag_("p", body) }
240   case class Styled(val style:Style, val body:Seq[Text]) extends Text {
241     override def toHtml =
242       style match {
243         case Underline =>       tag_("u", body)
244         case TT =>              tag_("tt", body)
245         case Italic =>          tag_("i", body)
246         case Strikethrough =>   tag_("strike", body)
247         case Superscript =>     tag_("sup", body)
248         case Subscript =>       tag_("sub", body)
249         case Bold =>            tag_("b", body)
250         case Highlight =>       "<span class=highlight>"+mapToHtml(body)+"</span>"
251       }
252   }
253   case class Command(val command:String, val body:Seq[Text]) extends Text {
254     override def toHtml = 
255       command match {
256         case "comment" =>     ""
257         case "url"     =>     "<tt>"+link(mapToHtml(body),body)+"</tt>"
258         case "WiX"     =>     "W<span style='vertical-align:-20%'>I</span>X"
259         case "TeX"     =>     "T<span style='vertical-align:-20%'>E</span>X"
260         case "red"     =>     "<font color=red>"+mapToHtml(body)+"</font>"
261         case "orange"  =>     "<font color=orange>"+mapToHtml(body)+"</font>"
262         case "green"   =>     "<font color=green>"+mapToHtml(body)+"</font>"
263         case "sc"      =>     "<sc>"+mapToHtml(body)+"</sc>"
264         case "image"   =>     "<img src='"+mapToHtml(body)+"'/>"
265         case "imagec"  =>     "<center><img src='"+mapToHtml(body)+"'/></center>"
266         case "image2"  =>     "<img width=180px src='"+mapToHtml(body)+"'/>"
267         case "image3"  =>     "<img width=200px src='"+mapToHtml(body)+"'/>"
268         case "image4"  =>     "<center><img width=550px src='"+mapToHtml(body)+"'/></center>"
269         case "warn"    =>     "\n<div class=warn>\n<table border=0 cellpadding=5px>\n"+
270                               "<tr><td valign=top><image src='"+Html.warnIconBase64+"'></td>\n"+
271                               "<td class=warn>\n"+
272                               mapToHtml(body)+
273                               "</td></tr></table></div>\n"
274         case "announce" =>    "\n<div class=announce>\n<table border=0 cellpadding=5px>\n"+
275                               "<tr><td valign=top></td>\n"+
276                               "<td class=warn>\n"+
277                               mapToHtml(body)+
278                               "</td></tr></table></div>\n"
279         case "br"      =>     "\n<br/>\n"
280         case "cent"    =>     "&#189;"
281         case "euro"    =>     "&#8364;"
282         // gross hack
283         case "ordinal"     => {
284           val x = mapToHtml(body)
285           if      (x.charAt(x.length-1) == '1') x+"<sup>"+"st"+"</sup>"
286           else if (x.charAt(x.length-1) == '2') x+"<sup>"+"nd"+"</sup>"
287           else if (x.charAt(x.length-1) == '3') x+"<sup>"+"rd"+"</sup>"
288           else                                  x+"<sup>"+"th"+"</sup>"
289         }
290         // TO DO: use "unicode vulgar fractions" here
291         // directional quotes: see http://www.dwheeler.com/essays/quotes-in-html.html
292         /*    u'1/2' : u'\u00BD',
293         //    u'1/4' : u'\u00BC',
294         //    u'3/4' : u'\u00BE',
295         //    u'1/3' : u'\u2153',
296         //    u'2/3' : u'\u2154',
297         //    u'1/5' : u'\u2155',
298         //    u'2/5' : u'\u2156',
299         //    u'3/5' : u'\u2157',
300         //    u'4/5' : u'\u2158',
301         //    u'1/6' : u'\u2159',
302         //    u'5/6' : u'\u215A',
303         //    u'1/8' : u'\u215B',
304         //    u'3/8' : u'\u215C',
305         //    u'5/8' : u'\u215D',
306         //    u'7/8' : u'\u215E',
307         */
308         case "fraction"           => "<sup>"++body(0).toHtml++"</sup>"++"/"++"<sub>"++body(1).toHtml++"</sub>"
309         case "rfc"                => "<tt><a href=http://tools.ietf.org/html/rfc"+mapToHtml(body)+">RFC"+mapToHtml(body)+"</a></tt>"
310         case "keystroke:command"  => "&#x2318;"
311         case "keystroke:shift"    => "&#x21E7;"
312         case "keystroke:option"   => "&#x2325;"
313         case "keystroke:control"  => "&#x2303;"
314         case "keystroke:capslock" => "&#x21EA;"
315         case "keystroke:apple"    => "&#xF8FF;"
316         case _                    => throw new RuntimeException("unsupported command " + command)
317       }
318   }
319
320
321 abstract class Glyph extends ToHtml
322   case object Euro extends Glyph { override def toHtml = "&#8364;" }
323   case object CircleR extends Glyph { override def toHtml = "&#162;" }
324   case object CircleC extends Glyph { override def toHtml = "&#174;" }
325   case object TradeMark extends Glyph { override def toHtml = "&#8482;" }
326   case object ServiceMark extends Glyph { override def toHtml = "&#8482;" }
327   case object Emdash extends Glyph { override def toHtml = "&mdash;" }
328   case object Ellipsis extends Glyph { override def toHtml = "&#0133;"  /* &cdots;? */ }
329   case object Cent extends Glyph { override def toHtml = "&#189;" }
330   case object Daggar extends Glyph { override def toHtml = "&#8224;" }
331   case object DoubleDaggar extends Glyph { override def toHtml = "&#8225;" }
332   case object Clover extends Glyph { override def toHtml = "&#8984;" }
333   case object Flat extends Glyph { override def toHtml = "&#8918;" }
334   case object Natural extends Glyph { override def toHtml = "&#8919;" }
335   case object Sharp extends Glyph { override def toHtml = "&#8920;" }
336   case object CheckMark extends Glyph { override def toHtml = "&#10003;" }
337   case object XMark extends Glyph { override def toHtml = "&#10007;" }
338   case object LeftArrow extends Glyph { override def toHtml = "&larr;" }
339   case object RightArrow extends Glyph { override def toHtml = "&rarr;" }
340   case object DoubleLeftArrow extends Glyph { override def toHtml = "&#;"  /* FIXME */ }
341   case object DoubleRightArrow extends Glyph { override def toHtml = "&#;"  /* FIXME */ }
342   case object DoubleLeftRightArrow extends Glyph { override def toHtml = "&#;"  /* FIXME */ }
343   case object LeftRightArrow extends Glyph { override def toHtml = "&#;"  /* FIXME */ }
344   case object Degree extends Glyph { override def toHtml = "&#;"  /* FIXME */ }
345
346 class Login(val user:String, val password:Option[String]) {
347   override def toString =
348     password match {
349       case None    => user
350       case Some(x) => user+":"+urlEscape(x) }
351 }
352
353 abstract class URL
354   case class URLPath(val path:String) extends URL { override def toString = path }
355   case class URLEmail(val user:String, val host:Host) extends URL { override def toString = "mailto:"+user+"@"+host }
356   case class URLNormal(val method:String,
357                        val login:Option[Login],
358                        val host:Host,
359                        val port:Option[Int],
360                        val path:String,
361                        val ref:Option[String]) extends URL {
362     override def toString =
363      method+"://"+
364      (login match {
365        case None => ""
366        case Some(log) => log+"@" })+
367      host+
368      "/"+
369      path+
370      (ref match {
371        case None => ""
372        case Some("") => ""
373        case Some(x) => "#"+x })
374
375   }
376
377
378 abstract class Host
379   case class HostIP(val ip0:Int, val ip1:Int, val ip2:Int, val ip3:Int) extends Host {
380     override def toString = ip0+"."+ip1+"."+ip2+"."+ip3 }
381   case class HostDNS(val parts:Seq[String]) extends Host {
382     override def toString = joinStrings(parts, ".") }
383
384
385
386
387
388
389
390
391
392
393
394
395
396