X-Git-Url: http://git.megacz.com/?p=wix.git;a=blobdiff_plain;f=src%2FDoc.lhs;fp=src%2FDoc.lhs;h=6d1baa73495afc6690b6a9a3a0dd1311607f3e98;hp=1d2c11932c9f1e47ca015ea3a99c227e3fe192b7;hb=0e25c5f2daeb3bca86501cb92cc785a5e698906e;hpb=bed61afd3cf648b5cccc121c88af033c108f0106

diff --git a/src/Doc.lhs b/src/Doc.lhs
index 1d2c119..6d1baa7 100644
--- a/src/Doc.lhs
+++ b/src/Doc.lhs
@@ -182,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
@@ -195,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