Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/b2f4423db785062525f616edb7da564e08ef2126

>---------------------------------------------------------------

commit b2f4423db785062525f616edb7da564e08ef2126
Author: Duncan Coutts <[email protected]>
Date:   Wed Mar 12 13:53:35 2008 +0000

    Parse filepaths in the config file the same way as in .cabal files
    That is, allow quoted and unquoted paths.

>---------------------------------------------------------------

 cabal-install/Hackage/Config.hs |   19 ++++++++++++-------
 1 files changed, 12 insertions(+), 7 deletions(-)

diff --git a/cabal-install/Hackage/Config.hs b/cabal-install/Hackage/Config.hs
index 074fb05..d1b1399 100644
--- a/cabal-install/Hackage/Config.hs
+++ b/cabal-install/Hackage/Config.hs
@@ -32,9 +32,12 @@ import Text.PrettyPrint.HughesPJ (text)
 import Distribution.Compat.ReadP (ReadP, char, munch1, readS_to_P)
 import Distribution.Compiler (CompilerFlavor(..), defaultCompilerFlavor)
 import Distribution.PackageDescription.Parse (ParseResult(..))
-import Distribution.ParseUtils (FieldDescr(..), simpleField, listField, 
liftField, field)
+import Distribution.ParseUtils
+         ( FieldDescr(..), simpleField, listField, liftField, field
+         , parseFilePathQ, parseTokenQ )
 import Distribution.Simple.Compiler (PackageDB(..))
-import Distribution.Simple.InstallDirs (InstallDirs(..), PathTemplate, 
toPathTemplate)
+import Distribution.Simple.InstallDirs
+         ( InstallDirs(..), PathTemplate, toPathTemplate, fromPathTemplate )
 import Distribution.Simple.Setup (Flag(..), toFlag, fromFlag, 
fromFlagOrDefault)
 import qualified Distribution.Simple.Setup as Cabal
 import Distribution.Verbosity (Verbosity, normal)
@@ -195,16 +198,17 @@ configWriteFieldDescrs =
                 (text . showRepo)                  parseRepo
                 configRemoteRepos (\rs cfg -> cfg { configRemoteRepos = rs })
     , simpleField "cachedir"
-                (text . show . fromFlagOrDefault "") (fmap emptyToNothing $ 
readS_to_P reads)
+                (text . show . fromFlagOrDefault "")
+                (fmap emptyToNothing parseFilePathQ)
                 configCacheDir    (\d cfg -> cfg { configCacheDir = d })
     , boolField "user-install" (fromFlag . configUserInstall) (\u cfg -> cfg { 
configUserInstall = toFlag u })
     , simpleField "hackage-username"
                 (text . show . fromFlagOrDefault "")
-                (fmap emptyToNothing $ readS_to_P reads)
+                (fmap emptyToNothing parseTokenQ)
                 configUploadUsername    (\d cfg -> cfg { configUploadUsername 
= d })
     , simpleField "hackage-password"
                 (text . show . fromFlagOrDefault "")
-                (fmap emptyToNothing $ readS_to_P reads)
+                (fmap emptyToNothing parseTokenQ)
                 configUploadPassword    (\d cfg -> cfg { configUploadPassword 
= d })
     ]
     where emptyToNothing "" = mempty
@@ -239,8 +243,9 @@ installDirField :: String
                 -> (Flag PathTemplate -> InstallDirs (Flag PathTemplate) -> 
InstallDirs (Flag PathTemplate))
                 -> FieldDescr (InstallDirs (Flag PathTemplate))
 installDirField name get set = 
-    liftField get set $ field name (text . show . fromFlag)
-                                   (fmap toFlag $ readS_to_P reads)
+    liftField get set $
+      field name (text . fromPathTemplate . fromFlag)
+                 (fmap (toFlag . toPathTemplate) parseFilePathQ)
 
 modifyFieldName :: (String -> String) -> FieldDescr a -> FieldDescr a
 modifyFieldName f d = d { fieldName = f (fieldName d) }



_______________________________________________
Cvs-libraries mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/cvs-libraries

Reply via email to