\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
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)
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]
(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
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