Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/ac968b6b1c5fe03202c6752de0293c1b77fa36da >--------------------------------------------------------------- commit ac968b6b1c5fe03202c6752de0293c1b77fa36da Author: bjorn <[email protected]> Date: Sun Oct 7 09:31:21 2007 +0000 user-install field in config file. >--------------------------------------------------------------- .../src/Network/Hackage/CabalInstall/Config.hs | 1 + .../src/Network/Hackage/CabalInstall/Utils.hs | 26 +++++++++++++++++-- 2 files changed, 24 insertions(+), 3 deletions(-) diff --git a/cabal-install/src/Network/Hackage/CabalInstall/Config.hs b/cabal-install/src/Network/Hackage/CabalInstall/Config.hs index 0fb2fcd..03518df 100644 --- a/cabal-install/src/Network/Hackage/CabalInstall/Config.hs +++ b/cabal-install/src/Network/Hackage/CabalInstall/Config.hs @@ -221,6 +221,7 @@ configWriteFieldDescrs = , listField "repos" (text . showRepo) parseRepo configRepos (\rs cfg -> cfg { configRepos = rs }) + , boolField "user-install" configUserInstall (\u cfg -> cfg { configUserInstall = u }) , simpleField "prefix" (text . show) (readS_to_P reads) (prefixDirTemplate . configInstallDirs) (\d -> setInstallDir (\ds -> ds { prefixDirTemplate = d })) diff --git a/cabal-install/src/Network/Hackage/CabalInstall/Utils.hs b/cabal-install/src/Network/Hackage/CabalInstall/Utils.hs index e400559..97b836f 100644 --- a/cabal-install/src/Network/Hackage/CabalInstall/Utils.hs +++ b/cabal-install/src/Network/Hackage/CabalInstall/Utils.hs @@ -1,16 +1,16 @@ module Network.Hackage.CabalInstall.Utils where -import Distribution.Compat.ReadP (ReadP, readP_to_S) +import Distribution.Compat.ReadP (ReadP, readP_to_S, pfail, get, look, choice) import Distribution.ParseUtils import Distribution.Verbosity import Network.Hackage.CabalInstall.Types import Control.Exception import Control.Monad (foldM, guard) -import Data.Char (isSpace) +import Data.Char (isSpace, isAlphaNum, toLower) import Data.Maybe (listToMaybe) import System.IO.Error (isDoesNotExistError) -import Text.PrettyPrint.HughesPJ +import Text.PrettyPrint.HughesPJ (Doc, render, vcat, text, (<>), (<+>)) isVerbose cfg = configVerbose cfg >= verbose @@ -61,6 +61,26 @@ setField _ x s = lookupFieldDescr :: [FieldDescr a] -> String -> Maybe (FieldDescr a) lookupFieldDescr fs n = listToMaybe [f | f@(FieldDescr name _ _) <- fs, name == n] +boolField :: String -> (a -> Bool) -> (Bool -> a -> a) -> FieldDescr a +boolField name get set = liftField get set $ field name showBool readBool + where + showBool :: Bool -> Doc + showBool True = text "true" + showBool False = text "false" + + readBool :: ReadP r Bool + readBool = choice [ stringNoCase "true" >> return True + , stringNoCase "false" >> return False + , stringNoCase "yes" >> return True + , stringNoCase "no" >> return False] showFields :: [FieldDescr a] -> a -> String showFields fs x = render $ vcat [ text name <> text ":" <+> get x | FieldDescr name get _ <- fs] + + +stringNoCase :: String -> ReadP r String +stringNoCase this = look >>= scan this + where + scan [] _ = return this + scan (x:xs) (y:ys) | toLower x == toLower y = get >> scan xs ys + scan _ _ = pfail _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
