[commit: Cabal] master: user-install field in config file. (ac968b6)

[Ian Lynagh]

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

On branch  : master

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

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

commit ac968b6b1c5fe03202c6752de0293c1b77fa36da
Author: bjorn <bjorn at bringert.net>
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