Merge pull request #993 from 23Skidoo/package-environment-file

cabal-install/Distribution/Client/Config.hs

@@ -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
-