Permalink
Browse files

Merge branch 'master' of github.com:haskell/cabal

  • Loading branch information...
2 parents ffa24d5 + 5ced794 commit 43af8a442407cf5fcecef09e411385ab0b75b328 @igfoo igfoo committed Aug 23, 2012
View
@@ -46,7 +46,7 @@ Library
if flag(base4) { build-depends: base >= 4 } else { build-depends: base < 4 }
if flag(base3) { build-depends: base >= 3 } else { build-depends: base < 3 }
if flag(base3)
- Build-Depends: directory >= 1 && < 1.2,
+ Build-Depends: directory >= 1 && < 1.3,
process >= 1 && < 1.2,
old-time >= 1 && < 1.2,
containers >= 0.1 && < 0.6,
@@ -8,7 +8,8 @@
-- Stability : provisional
-- Portability : portable
--
--- Utilities for handling saved state such as known packages, known servers and downloaded packages.
+-- Utilities for handling saved state such as known packages, known servers and
+-- downloaded packages.
-----------------------------------------------------------------------------
module Distribution.Client.Config (
SavedConfig(..),
@@ -21,7 +22,14 @@ module Distribution.Client.Config (
defaultCabalDir,
defaultConfigFile,
defaultCacheDir,
+ defaultCompiler,
defaultLogsDir,
+
+ baseSavedConfig,
+ commentSavedConfig,
+ initialSavedConfig,
+ configFieldDescriptions,
+ installDirsFields
) where
@@ -54,6 +62,8 @@ import Distribution.ParseUtils
, locatedErrorMsg, showPWarning
, readFields, warning, lineNo
, simpleField, listField, parseFilePathQ, parseTokenQ )
+import Distribution.Client.ParseUtils
+ ( parseFields, ppFields, ppSection )
import qualified Distribution.ParseUtils as ParseUtils
( Field(..) )
import qualified Distribution.Text as Text
@@ -78,19 +88,18 @@ import Data.Monoid
( Monoid(..) )
import Control.Monad
( when, foldM, liftM )
-import qualified Data.Map as Map
import qualified Distribution.Compat.ReadP as Parse
( option )
import qualified Text.PrettyPrint as Disp
- ( Doc, render, text, colon, vcat, empty, isEmpty, nest )
+ ( render, text, empty )
import Text.PrettyPrint
- ( (<>), (<+>), ($$), ($+$) )
+ ( ($+$) )
import System.Directory
- ( createDirectoryIfMissing, getAppUserDataDirectory )
+ ( createDirectoryIfMissing, getAppUserDataDirectory, renameFile )
import Network.URI
( URI(..), URIAuth(..) )
import System.FilePath
- ( (</>), takeDirectory )
+ ( (<.>), (</>), takeDirectory )
import System.Environment
( getEnvironment )
import System.IO.Error
@@ -303,8 +312,10 @@ readConfigFile initial file = handleNotExists $
writeConfigFile :: FilePath -> SavedConfig -> SavedConfig -> IO ()
writeConfigFile file comments vals = do
+ let tmpFile = file <.> "tmp"
createDirectoryIfMissing True (takeDirectory file)
- writeFile file $ explanation ++ showConfigWithComments comments vals ++ "\n"
+ writeFile tmpFile $ explanation ++ showConfigWithComments comments vals ++ "\n"
+ renameFile tmpFile file
where
explanation = unlines
["-- This is the configuration file for the 'cabal' command line tool."
@@ -528,42 +539,5 @@ showConfigWithComments comment vals = Disp.render $
ppSection "install-dirs" name installDirsFields
(field comment) (field vals)
-------------------------
--- * Parsing utils
---
-
---FIXME: replace this with something better in Cabal-1.5
-parseFields :: [FieldDescr a] -> a -> [ParseUtils.Field] -> ParseResult a
-parseFields fields initial = foldM setField initial
- where
- fieldMap = Map.fromList
- [ (name, f) | f@(FieldDescr name _ _) <- fields ]
- setField accum (ParseUtils.F line name value) = case Map.lookup name fieldMap of
- Just (FieldDescr _ _ set) -> set line value accum
- Nothing -> do
- warning $ "Unrecognized field " ++ name ++ " on line " ++ show line
- return accum
- setField accum f = do
- warning $ "Unrecognized stanza on line " ++ show (lineNo f)
- return accum
-
--- | This is a customised version of the function from Cabal that also prints
--- default values for empty fields as comments.
---
-ppFields :: [FieldDescr a] -> a -> a -> Disp.Doc
-ppFields fields def cur = Disp.vcat [ ppField name (getter def) (getter cur)
- | FieldDescr name getter _ <- fields]
-
-ppField :: String -> Disp.Doc -> Disp.Doc -> Disp.Doc
-ppField name def cur
- | Disp.isEmpty cur = Disp.text "--" <+> Disp.text name <> Disp.colon <+> def
- | otherwise = Disp.text name <> Disp.colon <+> cur
-
-ppSection :: String -> String -> [FieldDescr a] -> a -> a -> Disp.Doc
-ppSection name arg fields def cur =
- Disp.text name <+> Disp.text arg
- $$ Disp.nest 2 (ppFields fields def cur)
-
installDirsFields :: [FieldDescr (InstallDirs (Flag PathTemplate))]
installDirsFields = map viewAsFieldDescr installDirsOptions
-
Oops, something went wrong.

0 comments on commit 43af8a4

Please sign in to comment.