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

diff --git a/src/Doc.lhs b/src/Doc.lhs
index ab1418f..6d1baa7 100644
--- 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
@@ -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