[commit: Cabal] master: Use a local copy of the new parseFields from Cabal lib (b9d02ee)

[Ian Lynagh]

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

On branch  : master

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

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

commit b9d02eef7614e0d9c546c85d0f6f93ab6c0ee802
Author: Duncan Coutts <duncan at haskell.org>
Date:   Wed Aug 6 12:53:18 2008 +0000

    Use a local copy of the new parseFields from Cabal lib
    We can remove the local copy once we switch to the next
    Cabal version. In the mean time, the code is at least sane
    and consistent between libs.

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

 cabal-install/Distribution/Client/Config.hs     |    6 ++-
 cabal-install/Distribution/Client/Logging.hs    |    4 +-
 cabal-install/Distribution/Client/ParseUtils.hs |   39 ++++++++++------------
 cabal-install/Distribution/Client/Reporting.hs  |    4 +-
 4 files changed, 26 insertions(+), 27 deletions(-)

diff --git a/cabal-install/Distribution/Client/Config.hs b/cabal-install/Distribution/Client/Config.hs
index 82c9645..5b5b9b2 100644
--- a/cabal-install/Distribution/Client/Config.hs
+++ b/cabal-install/Distribution/Client/Config.hs
@@ -55,7 +55,7 @@ import Distribution.System
 
 import Distribution.Client.Types
          ( RemoteRepo(..), Repo(..), Username(..), Password(..) )
-import Distribution.Client.ParseUtils (parseBasicStanza)
+import Distribution.Client.ParseUtils (parseFields)
 import Distribution.Client.Utils (readFileIfExists)
 import Distribution.Simple.Utils (notice, warn)
 
@@ -180,7 +180,7 @@ loadConfig verbosity configFile = do
       notice verbosity $ "Writing default configuration to " ++ configFile
       writeDefaultConfigFile configFile defaultConf
       return defaultConf
-    Just inp -> case parseBasicStanza configFieldDescrs defaultConf' inp of
+    Just inp -> case parseConfig defaultConf' inp of
       ParseOk ws conf -> do
         when (not $ null ws) $ warn verbosity $
           unlines (map (showPWarning configFile) ws)
@@ -195,6 +195,8 @@ loadConfig verbosity configFile = do
 
       where defaultConf' = defaultConf { configRemoteRepos = [] }
 
+parseConfig :: SavedConfig -> String -> ParseResult SavedConfig
+parseConfig = parseFields configFieldDescrs
 
 writeDefaultConfigFile :: FilePath -> SavedConfig -> IO ()
 writeDefaultConfigFile file cfg = 
diff --git a/cabal-install/Distribution/Client/Logging.hs b/cabal-install/Distribution/Client/Logging.hs
index 6ef9e51..df49514 100644
--- a/cabal-install/Distribution/Client/Logging.hs
+++ b/cabal-install/Distribution/Client/Logging.hs
@@ -43,7 +43,7 @@ import qualified Distribution.Client.InstallPlan as InstallPlan
 import Distribution.Client.InstallPlan
          ( InstallPlan, PlanPackage )
 import Distribution.Client.ParseUtils
-         ( parseBasicStanza )
+         ( parseFields )
 import qualified Paths_cabal_install (version)
 
 import Distribution.Package
@@ -184,7 +184,7 @@ initialBuildLogEntry = BuildLogEntry {
 -- Parsing
 
 parseBuildLogEntry :: String -> ParseResult BuildLogEntry
-parseBuildLogEntry = parseBasicStanza fieldDescrs initialBuildLogEntry
+parseBuildLogEntry = parseFields fieldDescrs initialBuildLogEntry
 
 parseBuildLog :: String -> [BuildLogEntry]
 parseBuildLog str =
diff --git a/cabal-install/Distribution/Client/ParseUtils.hs b/cabal-install/Distribution/Client/ParseUtils.hs
index 6efbfb9..5fb8e22 100644
--- a/cabal-install/Distribution/Client/ParseUtils.hs
+++ b/cabal-install/Distribution/Client/ParseUtils.hs
@@ -1,5 +1,6 @@
+--FIXME: make this whole module go away!
 module Distribution.Client.ParseUtils (
-    parseBasicStanza,
+    parseFields
   ) where
 
 import Distribution.ParseUtils 
@@ -7,25 +8,21 @@ import Distribution.ParseUtils
          , readFields, warning, lineNo )
  
 import Control.Monad (foldM)
-import Data.Maybe (listToMaybe)
+import qualified Data.Map as Map
 
-parseBasicStanza :: [FieldDescr a] -> a -> String -> ParseResult a
-parseBasicStanza fields empty inp = 
-    readFields inp >>= foldM (setField fields) empty
+--FIXME: this function is now in Cabal as of 1.5, so remove this local copy
+parseFields :: [FieldDescr a] -> a -> String -> ParseResult a
+parseFields fields initial = \str ->
+  readFields str >>= foldM setField initial
+  where
+    fieldMap = Map.fromList
+      [ (name, f) | f@(FieldDescr name _ _) <- fields ]
+    setField accum (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
 
-setField :: [FieldDescr a]
-         -> a
-         -> Field
-         -> ParseResult a
-setField fs x (F line f val) =
-    case lookupFieldDescr fs f of
-      Nothing -> 
-          do warning ("Unrecognized field " ++ f ++ " on line " ++ show line)
-             return x
-      Just (FieldDescr _ _ set) -> set line val x
-setField _ x s = 
-    do warning ("Unrecognized stanza on line " ++ show (lineNo s))
-       return x
-
-lookupFieldDescr :: [FieldDescr a] -> String -> Maybe (FieldDescr a)
-lookupFieldDescr fs n = listToMaybe [f | f@(FieldDescr name _ _) <- fs, name == n]
diff --git a/cabal-install/Distribution/Client/Reporting.hs b/cabal-install/Distribution/Client/Reporting.hs
index 60b38ca..bc7362b 100644
--- a/cabal-install/Distribution/Client/Reporting.hs
+++ b/cabal-install/Distribution/Client/Reporting.hs
@@ -40,7 +40,7 @@ import qualified Distribution.Client.InstallPlan as InstallPlan
 import Distribution.Client.InstallPlan
          ( InstallPlan, PlanPackage )
 import Distribution.Client.ParseUtils
-         ( parseBasicStanza )
+         ( parseFields )
 import qualified Paths_cabal_install (version)
 
 import Distribution.Package
@@ -200,7 +200,7 @@ initialBuildReport = BuildReport {
 -- Parsing
 
 parseBuildReport :: String -> ParseResult BuildReport
-parseBuildReport = parseBasicStanza fieldDescrs initialBuildReport
+parseBuildReport = parseFields fieldDescrs initialBuildReport
 
 parseBuildReports :: String -> [BuildReport]
 parseBuildReports str =