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 <[email protected]> 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 = _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
