X-Git-Url: http://git.megacz.com/?p=wix.git;a=blobdiff_plain;f=src%2FDoc.lhs;h=6d1baa73495afc6690b6a9a3a0dd1311607f3e98;hp=589043922e2a2788bbf04b5bd8c379225dae2796;hb=e6b058675419bdc7fb164809807837eb5e49c7dd;hpb=0c91eca8f33ec53c701be60ba6d11461153466a8 diff --git a/src/Doc.lhs b/src/Doc.lhs index 5890439..6d1baa7 100644 --- a/src/Doc.lhs +++ b/src/Doc.lhs @@ -1,10 +1,14 @@ \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 import Data.Bits import Data.Char -import Edu.Berkeley.Sbp.Haskell.SBP +import Edu_Berkeley_Sbp_Haskell_SBP import Util import FromTree import qualified Text.PrettyPrint.Leijen as PP @@ -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] @@ -178,11 +182,13 @@ instance Show URL where 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