rewrite Haskell parts in Scala
[wix.git] / src / Doc.scala
diff --git a/src/Doc.scala b/src/Doc.scala
new file mode 100644 (file)
index 0000000..76e4b55
--- /dev/null
@@ -0,0 +1,396 @@
+import edu.berkeley.sbp.scala._
+
+import Html.mapToHtml
+import Html.joinStrings
+import Html.{urlEscape,htmlEscape}
+import Html.{pre,stag,tag,stag_,tag_,stag0,link}
+
+object Doc {
+
+  def concatMap[A,B](f: A => Seq[B], s:Seq[A]) : Seq[B] =
+    concat(s.map(f))
+
+  def concat[A](s:Seq[Seq[A]]) : Seq[A] =
+    s.foldLeft(Seq[A]())(_ ++ _)
+
+  def docFromTree(t:Tree) : Doc =
+    t match { case Tree(_,Seq(_,Tree(_,a))) => new Doc(new Header(), a.map(sectionFromTree)) }
+
+  def sectionFromTree(t:Tree) : Section =
+    t match {
+      case Tree("Section", seq) =>
+        seq(0) match {
+          case Tree("SectionHeader", Seq(Tree("=",e),c)) =>
+            new Section(e.length-1, textSequenceFromTree(c), paragraphsFromTrees(seq.tail))
+        }
+    }
+
+  def textSequenceFromTree (t:Tree) : Seq[Text] =
+    t match {
+      case Tree("Word",    chars          ) => Seq(new Chars(stringFromTrees(chars)))
+      case Tree("Ordinal", x              ) => Seq(new Command("ordinal", Seq(new Chars(stringFromTrees(x)))))
+      case Tree("Fraction", Seq(n,d)      ) => Seq(new Command("fraction",Seq(new Chars(stringFromTree(n)),
+                                                                              new Chars(stringFromTree(d)))))
+      case Tree("WS",     _               ) => Seq(WS)
+      case Tree("Quotes", Seq(x)          ) => Seq(new Quotes(textSequenceFromTree(x)))
+      case Tree("Pars", y                 ) => Seq(new SubPar(paragraphsFromTrees(y)))
+      case Tree("Command", Seq(x,y)       ) => Seq(new Command(stringFromTree(x), textSequenceFromTree(y)))
+      case Tree("Command",  Seq(x)        ) => Seq(new Command(stringFromTree(x), Seq()))
+      case Tree("Link",  Seq(text,link)   ) => Seq(new Link(urlFromTree(link), textSequenceFromTree(text)))
+      case Tree("Footnote", x             ) => Seq(new Footnote(concatMap(textSequenceFromTree,x)))
+      case Tree("Keyword", x              ) => Seq(new Keyword(concatMap(textSequenceFromTree,x)))
+      case Tree("Math", x                 ) => Seq(new Math(stringFromTrees(x)))
+      case Tree("Italic",  Seq(x)         ) => Seq(new Styled(Italic        , textSequenceFromTree(x)))
+      case Tree("Bold",  Seq(x)           ) => Seq(new Styled(Bold          , textSequenceFromTree(x)))
+      case Tree("Highlight",  Seq(x)      ) => Seq(new Styled(Highlight     , textSequenceFromTree(x)))
+      case Tree("TT", x                   ) => Seq(new Styled(TT            , concatMap(textSequenceFromTree,x)))
+      case Tree("Strikethrough", x        ) => Seq(new Styled(Strikethrough , concatMap(textSequenceFromTree,x)))
+      case Tree("Superscript", x          ) => Seq(new Styled(Superscript   , concatMap(textSequenceFromTree,x)))
+      case Tree("Subscript", x            ) => Seq(new Styled(Subscript     , concatMap(textSequenceFromTree,x)))
+      case Tree("Underline", x            ) => Seq(new Styled(Underline     , concatMap(textSequenceFromTree,x)))
+      case Tree("(e)",  _)                  => Seq(new GlyphText(Euro))
+      case Tree("(r)",  _)                  => Seq(new GlyphText(CircleR))
+      case Tree("(c)",  _)                  => Seq(new GlyphText(CircleC))
+      case Tree("(tm)",  _)                 => Seq(new GlyphText(TradeMark))
+      case Tree("--",  _)                   => Seq(new GlyphText(Emdash))
+      case Tree("<-",  _)                   => Seq(new GlyphText(LeftArrow))
+      case Tree("<=",  _)                   => Seq(new GlyphText(DoubleLeftArrow))
+      case Tree("=>",  _)                   => Seq(new GlyphText(DoubleRightArrow))
+      case Tree("<=>",  _)                  => Seq(new GlyphText(DoubleLeftRightArrow))
+      case Tree("<->",  _)                  => Seq(new GlyphText(LeftRightArrow))
+      case Tree("^o",  _)                   => Seq(new GlyphText(Degree))
+      case Tree("...",  _)                  => Seq(new GlyphText(Ellipsis))
+      case Tree("Text",   ts)               => concat(ts.map(textSequenceFromTree))
+      case Tree("",    Seq())               => Seq()
+      case t => throw new RuntimeException("unable to create [Text] from " + t)
+    }
+
+  def hostFromTree(t:Tree) : Host =
+    t match {
+      case Tree("IP", Seq(Tree(_,a),Tree(_,b),Tree(_,c),Tree(_,d))) =>
+        new HostIP(intFromTrees(a), intFromTrees(b), intFromTrees(c), intFromTrees(d))
+      case Tree("DNS", parts) =>
+        new HostDNS(parts.map( (t:Tree) => t match { case Tree(_, c) => stringFromTrees(c) }))
+    }
+
+  def urlFromTree(t:Tree) : URL =
+    t match {
+      case Tree("URL", stuff)                            => urlFromTrees(stuff)
+      case Tree("Email", Seq(Tree("username", un),host)) => new URLEmail(stringFromTrees(un), hostFromTree(host))
+      case Tree("Path",stuff)                            => new URLPath(stuff.map(fromUrlChar).foldLeft("")(_ + _))
+    }
+
+  def urlFromTrees(t:Seq[Tree]) : URL =
+    t match {
+      case Seq(Tree(_,method), login, host, port, rest @_*) =>
+        new URLNormal(stringFromTrees(method),
+                      None,
+                      hostFromTree(host),
+                      port match { case Tree("Port",port) => {
+                                     val q = stringFromTrees(port)
+                                     if (q.equals("")) None else Some(java.lang.Integer.parseInt(q))
+                                   }
+                                   case _ => None },
+                      rest match { case Seq(Tree("Path",p), x@_*) => p.map(fromUrlChar).foldLeft("")(_ + _)
+                                   case _ => "" },
+                      rest match { case Seq(_ , Tree("Path",r), x@_*) => Some(stringFromTrees(r))
+                                   case _ => None })
+    }
+
+  //fromUrlChar (Tree "%" [(Tree a [] _),(Tree b [] _)] _) = chr $ (fst $ head $ readHex (a++b))
+  // FIXME: problem here is the "/" vs "%2F" issue, so we "leave urls urlencoded"
+  def fromUrlChar(t:Tree) : String =
+    t match {
+      case Tree("%", Seq(Tree(a,Seq()),Tree(b,Seq()))) => "%"+a+b
+      case Tree(x,y) =>
+        if (x.length==1) x
+        else throw new RuntimeException("could not parse as URL char: " + t)
+    }
+
+  def paragraphsFromTrees(ts:Seq[Tree]) : Seq[Paragraph] =
+    consolidate(concatMap(paragraphsFromTree,ts))
+
+  def paragraphsFromTree(t:Tree) : Seq[Paragraph] =
+    consolidate (t match {
+      case Tree("Verbatim",       Seq(indent,v)) => Seq(new P(    Seq(new Verbatim(unindent(indent,unverbate(v))))))
+      case Tree("TextParagraph",  Seq(Tree(_,text))) => Seq(new P(concatMap(textSequenceFromTree,text)))
+      case Tree("Pars",           pars         ) => concatMap(paragraphsFromTree,pars)
+      case Tree("HR",             _            ) => Seq(HR)
+      case Tree("OL",             a            ) =>
+        Seq(new OL(a.map( (t:Tree) => t match { case Tree("LI",x) => paragraphsFromTrees(x)})))
+      case Tree("UL",             a            ) =>
+        Seq(new UL(a.map( (t:Tree) => t match { case Tree("LI",x) => paragraphsFromTrees(x)})))
+      case Tree("",               _            ) => Seq()
+      case Tree("Blockquote",     pars         ) => Seq(Blockquote(paragraphsFromTrees(pars)))
+      case _ => throw new RuntimeException("unable to create [Paragraph] from " + t)
+    })
+
+  def unverbate (t:Tree) : String =
+    t match {
+      case Tree("Verbatim",x) => x.map(unverbate).foldLeft("")(_ + _)
+      case Tree("VerbatimBrace",Seq(x,y)) => unverbate(x)+" "+unverbate(y)
+      case Tree(t,Seq()) => t
+    }
+
+  def unindent (t:Tree,v:String) : String =
+    t match {
+      case Tree("I", indent) => unindent_(indent.length+1, v)
+    }
+
+  private def unindent_ (i:Int,v:String) : String =
+    if (v.length==0)    ""
+    else if (v.charAt(0) == '\n') "\n"+unindent_(i, drop_(i, v.substring(1)))
+    else v.charAt(0)+unindent_(i, v.substring(1))
+
+  private def drop_(n:Int, x:String) : String = {
+    val x_ : Seq[Char] = x;
+    if (n==0) x
+    else (x_ match {
+      case Seq('\n', r@_*) => x
+      case Seq()           => ""
+      case Seq(a, b@_*)    => drop_(n-1, x.substring(1))
+    })
+  }
+
+  def consolidate(x:Seq[Paragraph]) : Seq[Paragraph] =
+    x match {
+      case Seq() => Seq()
+      case Seq(a) => Seq(a)
+      case Seq(OL(Seq()), x@_*) => consolidate(x)
+      case Seq(UL(Seq()), x@_*) => consolidate(x)
+      case Seq(OL(a),     OL(b), x@_*) => consolidate(Seq(OL(a++b))++x)
+      case Seq(UL(a),     UL(b), x@_*) => consolidate(Seq(UL(a++b))++x)
+      case Seq(a, b @_*) => Seq(a)++consolidate(b)
+    }
+
+  def intFromTrees(t:Seq[Tree]) : Int =
+    java.lang.Integer.parseInt(stringFromTrees(t))
+  def stringFromTree(t:Tree) : String =
+    t match { case Tree(h,c) => h++concatMap(stringFromTree,c) }
+  def stringFromTrees(ts:Seq[Tree]) : String =
+    ts.map(stringFromTree).foldLeft("")(_ + _)
+
+}
+
+class Doc (val header:Header, val sections:Seq[Section]) extends ToHtml {
+  override def toHtml =
+     "<!-- This document was AUTOMATICALLY GENERATED from wix source -->\n"+
+     "<!--    it is probably not a wise idea to edit it directly     -->\n\n"+
+     "<html>\n"+
+     "<head>\n"+
+     Html.style+
+     // FIXME: title tag
+     "</head>\n"+
+     "<body>\n"+   // tell jsmath we will escape stuff manually
+     Html.jsMath+  // FIXME: only put this in if math appears on the page
+     "<center><table><tr><td width=600>\n"+
+     mapToHtml(sections)+
+     "<br><br>\n"+
+     "<table width=100% class=footer><tr><td align=left>"+
+     "<img src='"+Html.printIconBase64+"'></td>"+
+     "<td align=right><span class='signature'>rendered from "+
+     "<a href=http://www.megacz.com/software/wix>"+
+     "W<span style='vertical-align:-20%'>I</span>X</a></span></div></td></tr></table>\n"+
+     "</td></tr></table></center>\n"+
+     "</body></html>"
+}
+
+class Header()
+
+class Section (val level:Int, val header:Seq[Text], val paragraphs:Seq[Paragraph]) extends ToHtml {
+  def toHtml = "\n<h"+((level+1))+">\n"+(mapToHtml(header))+"\n</h"+((level+1))+">\n"+(mapToHtml(paragraphs)) }
+
+abstract class Paragraph extends ToHtml
+  case class P          (val body :Seq[Text]                  ) extends Paragraph { override def toHtml = stag_("p",body) }
+  case object HR                                                       extends Paragraph { override def toHtml = stag("hr") }
+  case class OL         (val items:Seq[Seq[Paragraph]] ) extends Paragraph {
+    override def toHtml = stag0("ol", items.map( (s:Seq[Paragraph]) => stag_("li", s) ).foldLeft("")(_ + _)) }
+  case class UL         (val items:Seq[Seq[Paragraph]] ) extends Paragraph {
+    override def toHtml = stag0("ul", items.map( (s:Seq[Paragraph]) => stag_("li", s) ).foldLeft("")(_ + _)) }
+  case class Blockquote (val body :Seq[Paragraph]             ) extends Paragraph {
+    override def toHtml = 
+      "\n<table class=blockquote border=0 cellpadding=5px>\n"+
+      "<tr><td valign=top><image src='"+Html.quoteIconBase64+"'></td>\n"+
+      "<td class=warn>\n"+
+      mapToHtml(body)+
+      "</td></tr></table>\n"
+  }
+
+abstract class Style
+  case object TT extends Style
+  case object Underline extends Style
+  case object Superscript extends Style
+  case object Subscript extends Style
+  case object Strikethrough extends Style
+  case object Italic extends Style
+  case object Bold extends Style
+  case object Highlight extends Style
+
+abstract class Text extends ToHtml
+  case object WS extends Text { def toHtml = " " }
+  case class Chars(val body:String) extends Text { def toHtml = htmlEscape(body) }
+  case class Quotes(val body:Seq[Text]) extends Text { def toHtml = "&#8220;"+mapToHtml(body)+"&#8221;" }
+  case class GlyphText(val body:Glyph) extends Text { override def toHtml = body.toHtml }
+  case class Math(val body:String) extends Text { override def toHtml = "<span class=math>" +body+ "</span>" }
+  case class Verbatim(val body:String) extends Text { override def toHtml = pre(body) }
+  case class Link(val url:URL, val body:Seq[Text]) extends Text { override def toHtml = link(url.toString, body) }
+  case class Footnote(val body:Seq[Text]) extends Text { override def toHtml = throw new Exception() }
+  case class Keyword(val body:Seq[Text]) extends Text { override def toHtml = tag_("tt", body) }
+  case class SubPar(val body:Seq[Paragraph]) extends Text { override def toHtml = stag_("p", body) }
+  case class Styled(val style:Style, val body:Seq[Text]) extends Text {
+    override def toHtml =
+      style match {
+        case Underline =>       tag_("u", body)
+        case TT =>              tag_("tt", body)
+        case Italic =>          tag_("i", body)
+        case Strikethrough =>   tag_("strike", body)
+        case Superscript =>     tag_("sup", body)
+        case Subscript =>       tag_("sub", body)
+        case Bold =>            tag_("b", body)
+        case Highlight =>       "<span class=highlight>"+mapToHtml(body)+"</span>"
+      }
+  }
+  case class Command(val command:String, val body:Seq[Text]) extends Text {
+    override def toHtml = 
+      command match {
+        case "comment" =>     ""
+        case "url"     =>     "<tt>"+link(mapToHtml(body),body)+"</tt>"
+        case "WiX"     =>     "W<span style='vertical-align:-20%'>I</span>X"
+        case "TeX"     =>     "T<span style='vertical-align:-20%'>E</span>X"
+        case "red"     =>     "<font color=red>"+mapToHtml(body)+"</font>"
+        case "orange"  =>     "<font color=orange>"+mapToHtml(body)+"</font>"
+        case "green"   =>     "<font color=green>"+mapToHtml(body)+"</font>"
+        case "sc"      =>     "<sc>"+mapToHtml(body)+"</sc>"
+        case "image"   =>     "<img src='"+mapToHtml(body)+"'/>"
+        case "imagec"  =>     "<center><img src='"+mapToHtml(body)+"'/></center>"
+        case "image2"  =>     "<img width=180px src='"+mapToHtml(body)+"'/>"
+        case "image3"  =>     "<img width=200px src='"+mapToHtml(body)+"'/>"
+        case "image4"  =>     "<center><img width=550px src='"+mapToHtml(body)+"'/></center>"
+        case "warn"    =>     "\n<div class=warn>\n<table border=0 cellpadding=5px>\n"+
+                              "<tr><td valign=top><image src='"+Html.warnIconBase64+"'></td>\n"+
+                              "<td class=warn>\n"+
+                              mapToHtml(body)+
+                              "</td></tr></table></div>\n"
+        case "announce" =>    "\n<div class=announce>\n<table border=0 cellpadding=5px>\n"+
+                              "<tr><td valign=top></td>\n"+
+                              "<td class=warn>\n"+
+                              mapToHtml(body)+
+                              "</td></tr></table></div>\n"
+        case "br"      =>     "\n<br/>\n"
+        case "cent"    =>     "&#189;"
+        case "euro"    =>     "&#8364;"
+        // gross hack
+        case "ordinal"     => {
+          val x = mapToHtml(body)
+          if      (x.charAt(x.length-1) == '1') x+"<sup>"+"st"+"</sup>"
+          else if (x.charAt(x.length-1) == '2') x+"<sup>"+"nd"+"</sup>"
+          else if (x.charAt(x.length-1) == '3') x+"<sup>"+"rd"+"</sup>"
+          else                                  x+"<sup>"+"th"+"</sup>"
+        }
+        // TO DO: use "unicode vulgar fractions" here
+        // directional quotes: see http://www.dwheeler.com/essays/quotes-in-html.html
+        /*    u'1/2' : u'\u00BD',
+        //    u'1/4' : u'\u00BC',
+        //    u'3/4' : u'\u00BE',
+        //    u'1/3' : u'\u2153',
+        //    u'2/3' : u'\u2154',
+        //    u'1/5' : u'\u2155',
+        //    u'2/5' : u'\u2156',
+        //    u'3/5' : u'\u2157',
+        //    u'4/5' : u'\u2158',
+        //    u'1/6' : u'\u2159',
+        //    u'5/6' : u'\u215A',
+        //    u'1/8' : u'\u215B',
+        //    u'3/8' : u'\u215C',
+        //    u'5/8' : u'\u215D',
+        //    u'7/8' : u'\u215E',
+        */
+        case "fraction"           => "<sup>"++body(0).toHtml++"</sup>"++"/"++"<sub>"++body(1).toHtml++"</sub>"
+        case "rfc"                => "<tt><a href=http://tools.ietf.org/html/rfc"+mapToHtml(body)+">RFC"+mapToHtml(body)+"</a></tt>"
+        case "keystroke:command"  => "&#x2318;"
+        case "keystroke:shift"    => "&#x21E7;"
+        case "keystroke:option"   => "&#x2325;"
+        case "keystroke:control"  => "&#x2303;"
+        case "keystroke:capslock" => "&#x21EA;"
+        case "keystroke:apple"    => "&#xF8FF;"
+        case _                    => throw new RuntimeException("unsupported command " + command)
+      }
+  }
+
+
+abstract class Glyph extends ToHtml
+  case object Euro extends Glyph { override def toHtml = "&#8364;" }
+  case object CircleR extends Glyph { override def toHtml = "&#162;" }
+  case object CircleC extends Glyph { override def toHtml = "&#174;" }
+  case object TradeMark extends Glyph { override def toHtml = "&#8482;" }
+  case object ServiceMark extends Glyph { override def toHtml = "&#8482;" }
+  case object Emdash extends Glyph { override def toHtml = "&mdash;" }
+  case object Ellipsis extends Glyph { override def toHtml = "&#0133;"  /* &cdots;? */ }
+  case object Cent extends Glyph { override def toHtml = "&#189;" }
+  case object Daggar extends Glyph { override def toHtml = "&#8224;" }
+  case object DoubleDaggar extends Glyph { override def toHtml = "&#8225;" }
+  case object Clover extends Glyph { override def toHtml = "&#8984;" }
+  case object Flat extends Glyph { override def toHtml = "&#8918;" }
+  case object Natural extends Glyph { override def toHtml = "&#8919;" }
+  case object Sharp extends Glyph { override def toHtml = "&#8920;" }
+  case object CheckMark extends Glyph { override def toHtml = "&#10003;" }
+  case object XMark extends Glyph { override def toHtml = "&#10007;" }
+  case object LeftArrow extends Glyph { override def toHtml = "&larr;" }
+  case object RightArrow extends Glyph { override def toHtml = "&rarr;" }
+  case object DoubleLeftArrow extends Glyph { override def toHtml = "&#;"  /* FIXME */ }
+  case object DoubleRightArrow extends Glyph { override def toHtml = "&#;"  /* FIXME */ }
+  case object DoubleLeftRightArrow extends Glyph { override def toHtml = "&#;"  /* FIXME */ }
+  case object LeftRightArrow extends Glyph { override def toHtml = "&#;"  /* FIXME */ }
+  case object Degree extends Glyph { override def toHtml = "&#;"  /* FIXME */ }
+
+class Login(val user:String, val password:Option[String]) {
+  override def toString =
+    password match {
+      case None    => user
+      case Some(x) => user+":"+urlEscape(x) }
+}
+
+abstract class URL
+  case class URLPath(val path:String) extends URL { override def toString = path }
+  case class URLEmail(val user:String, val host:Host) extends URL { override def toString = "mailto:"+user+"@"+host }
+  case class URLNormal(val method:String,
+                       val login:Option[Login],
+                       val host:Host,
+                       val port:Option[Int],
+                       val path:String,
+                       val ref:Option[String]) extends URL {
+    override def toString =
+     method+"://"+
+     (login match {
+       case None => ""
+       case Some(log) => log+"@" })+
+     host+
+     "/"+
+     path+
+     (ref match {
+       case None => ""
+       case Some("") => ""
+       case Some(x) => "#"+x })
+
+  }
+
+
+abstract class Host
+  case class HostIP(val ip0:Int, val ip1:Int, val ip2:Int, val ip3:Int) extends Host {
+    override def toString = ip0+"."+ip1+"."+ip2+"."+ip3 }
+  case class HostDNS(val parts:Seq[String]) extends Host {
+    override def toString = joinStrings(parts, ".") }
+
+
+
+
+
+
+
+
+
+
+
+
+
+