add \Box

[wix.git] / src / Doc.lhs

diff --git a/src/Doc.lhs b/src/Doc.lhs
index 05ff37e..4d28e65 100644 (file)
--- a/src/Doc.lhs
+++ b/src/Doc.lhs
@@ -1,4 +1,8 @@
 \begin{code}
+-- Copyright 2008 the Contributors, as shown in the revision logs.
+-- Licensed under the Apache Public Source License 2.0 ("the License").
+-- You may not use this file except in compliance with the License.
+
 module Doc
 where
 import Numeric
@@ -42,7 +46,7 @@ data Text      = WS
 data Glyph     = Euro | CircleR | CircleC | TradeMark | ServiceMark
                | Emdash | Ellipsis | Cent | Daggar | DoubleDaggar
                | Clover | Flat | Sharp | Natural | CheckMark | XMark
-               | LeftArrow | DoubleLeftArrow | DoubleRightArrow
+               | LeftArrow | RightArrow | DoubleLeftArrow | DoubleRightArrow
                | DoubleLeftRightArrow | LeftRightArrow | Degree
 
 data Login     = Login String (Maybe String)
@@ -118,7 +122,7 @@ unindent (Tree "I" indent _) v = unindent' ((length indent)+1) v
 
 instance FromTree [Text] where
   fromTree (Tree "Word"    chars       _) = [Chars              $ concatMap fromTree chars]
-  fromTree (Tree "Ordinal" x           _) = [Command "ordinal"  $ [Chars (show x)]]
+  fromTree (Tree "Ordinal" x           _) = [Command "ordinal"  $ [Chars $ concatMap show x]]
   fromTree (Tree "Fraction" [n,d]      _) = [Command "fraction" $ [(Chars (show n)), (Chars (show d))]]
   fromTree (Tree "WS"     _            _) = [WS]
   fromTree (Tree "Quotes" [x]          _) = [Quotes $ fromTree x]
@@ -169,20 +173,22 @@ instance Show URL where
        (Just log) -> (show log)++"@")
      ++(show h)
      ++"/"
-     ++(urlEscape path)
+     ++path
      ++(case ref of
           Nothing -> ""
           (Just []) -> ""
-          (Just j) -> "#"++(urlEscape j))
+          (Just j) -> "#"++j)
 
 instance FromTree URL where
   fromTree (Tree "URL"   stuff                         _) = fromTrees stuff
   fromTree (Tree "Email" [(Tree "username" un _),host] _) = Email (fromTrees un) (fromTree host)
-  fromTree (Tree "Path"  stuff                         _) = URLPath $ map fromUrlChar stuff
-   where
-    fromUrlChar (Tree "%" [(Tree a [] _),(Tree b [] _)] _) = chr $ (fst $ head $ readHex (a++b))
-    fromUrlChar (Tree [c] []                            _) = c
-    fromUrlChar t                                          = error $ "could not parse as an url char: " ++ (show t)
+  fromTree (Tree "Path"  stuff                         _) = URLPath $ concatMap fromUrlChar stuff
+
+--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"
+fromUrlChar (Tree "%" [(Tree a [] _),(Tree b [] _)] _) = "%"++a++b
+fromUrlChar (Tree [c] []                            _) = [c]
+fromUrlChar t                                          = error $ "could not parse as an url char: " ++ (show t)
 
 fromTreeChildren (Tree _ c _) = fromTrees c
 instance FromTrees URL where
@@ -191,7 +197,7 @@ instance FromTrees URL where
          url_host   = fromTree host,
          url_login  = Nothing,
          url_port   = case port of { (Tree "Port" port _) -> Just $ fromTrees port; _ -> Nothing },
-         url_path   = case rest of { ((Tree "Path" p _):_) -> fromTrees p; _ -> "" },
+         url_path   = case rest of { ((Tree "Path" p _):_) -> concatMap fromUrlChar p; _ -> "" },
          url_ref    = case rest of { (_:(Tree "Path" r _):_) -> Just $ fromTrees r; _ -> Nothing }
        }
  fromTrees x = error $ show x