diff --git a/Cabal/Distribution/Verbosity.hs b/Cabal/Distribution/Verbosity.hs index a79dfe96963142b53836feed6aca4fb52f4cd26c..e239f36520837a66d3799653c11c18e2ca529981 100644 --- a/Cabal/Distribution/Verbosity.hs +++ b/Cabal/Distribution/Verbosity.hs @@ -65,17 +65,11 @@ data Verbosity = Verbosity { vLevel :: VerbosityLevel, vFlags :: Set VerbosityFlag, vQuiet :: Bool - } deriving (Generic) + } deriving (Generic, Show, Read) mkVerbosity :: VerbosityLevel -> Verbosity mkVerbosity l = Verbosity { vLevel = l, vFlags = Set.empty, vQuiet = False } -instance Show Verbosity where - showsPrec n = showsPrec n . vLevel - -instance Read Verbosity where - readsPrec n s = map (\(x,y) -> (mkVerbosity x,y)) (readsPrec n s) - instance Eq Verbosity where x == y = vLevel x == vLevel y @@ -152,6 +146,25 @@ intToVerbosity 2 = Just (mkVerbosity Verbose) intToVerbosity 3 = Just (mkVerbosity Deafening) intToVerbosity _ = Nothing +-- | Parser verbosity +-- +-- >>> explicitEitherParsec parsecVerbosity "normal" +-- Right (Right (Verbosity {vLevel = Normal, vFlags = fromList [], vQuiet = False})) +-- +-- >>> explicitEitherParsec parsecVerbosity "normal+nowrap " +-- Right (Right (Verbosity {vLevel = Normal, vFlags = fromList [VNoWrap], vQuiet = False})) +-- +-- >>> explicitEitherParsec parsecVerbosity "normal+nowrap +markoutput" +-- Right (Right (Verbosity {vLevel = Normal, vFlags = fromList [VNoWrap,VMarkOutput], vQuiet = False})) +-- +-- >>> explicitEitherParsec parsecVerbosity "normal +nowrap +markoutput" +-- Right (Right (Verbosity {vLevel = Normal, vFlags = fromList [VNoWrap,VMarkOutput], vQuiet = False})) +-- +-- >>> explicitEitherParsec parsecVerbosity "normal+nowrap+markoutput" +-- Right (Right (Verbosity {vLevel = Normal, vFlags = fromList [VNoWrap,VMarkOutput], vQuiet = False})) +-- +-- /Note:/ this parser will eat trailing spaces. +-- parsecVerbosity :: CabalParsing m => m (Either Int Verbosity) parsecVerbosity = parseIntVerbosity <|> parseStringVerbosity where @@ -159,7 +172,7 @@ parsecVerbosity = parseIntVerbosity <|> parseStringVerbosity parseStringVerbosity = fmap Right $ do level <- parseVerbosityLevel _ <- P.spaces - extras <- P.sepBy parseExtra P.skipSpaces1 + extras <- many (parseExtra <* P.spaces) return (foldr (.) id extras (mkVerbosity level)) parseVerbosityLevel = P.choice [ P.string "silent" >> return Silent diff --git a/Cabal/tests/ParserTests/regressions/common.cabal b/Cabal/tests/ParserTests/regressions/common.cabal index 73bd1c89b66576e89ee3a285385509f8561b157a..a5961c5f0ff1d0be448efd5c5f5191c601f4e4e5 100644 --- a/Cabal/tests/ParserTests/regressions/common.cabal +++ b/Cabal/tests/ParserTests/regressions/common.cabal @@ -2,6 +2,12 @@ name: common version: 0 x-revision: 1 synopsis: Common-stanza demo demo +description: + * foo + . + * inner1 + . + * inner2 build-type: Simple cabal-version: >=1.10 -- note: empty field diff --git a/cabal-install/Distribution/Client/CmdBuild.hs b/cabal-install/Distribution/Client/CmdBuild.hs index cb1858837a4b29e656c47562aba99ff9049764b8..4ec57c851f9f9b69ce87c8a8e14045e8e935ee07 100644 --- a/cabal-install/Distribution/Client/CmdBuild.hs +++ b/cabal-install/Distribution/Client/CmdBuild.hs @@ -110,6 +110,7 @@ buildAction , (configFlags, configExFlags, installFlags, haddockFlags, testFlags)) targetStrings globalFlags = do -- TODO: This flags defaults business is ugly + print configFlags let onlyConfigure = fromFlag (buildOnlyConfigure defaultBuildFlags <> buildOnlyConfigure buildFlags) targetAction diff --git a/cabal-install/Distribution/Client/Config.hs b/cabal-install/Distribution/Client/Config.hs index a3ef527a1e4f2dc60053d13720239cb03852ffcb..5f1171f8844743b8516740b465b26abf1551082f 100644 --- a/cabal-install/Distribution/Client/Config.hs +++ b/cabal-install/Distribution/Client/Config.hs @@ -44,6 +44,8 @@ module Distribution.Client.Config ( remoteRepoFields ) where +import Debug.Trace + import Language.Haskell.Extension ( Language(Haskell2010) ) import Distribution.Deprecated.ViewAsFieldDescr @@ -391,7 +393,7 @@ instance Semigroup SavedConfig where configCID = combine configCID, configDistPref = combine configDistPref, configCabalFilePath = combine configCabalFilePath, - configVerbosity = combine configVerbosity, + configVerbosity = traceShowId $ combineTr configVerbosity, configUserInstall = combine configUserInstall, -- TODO: NubListify configPackageDBs = lastNonEmpty configPackageDBs, @@ -417,6 +419,11 @@ instance Semigroup SavedConfig where } where combine = combine' savedConfigureFlags + combineTr = combineTr' savedConfigureFlags + combineTr' :: Show a => (SavedConfig -> flags) -> (flags -> Flag a) -> Flag a + combineTr' field subfield = + (traceShowId $ subfield . field $ a) `mappend` (traceShowId $ subfield . field $ b) + lastNonEmpty = lastNonEmpty' savedConfigureFlags lastNonEmptyNL = lastNonEmptyNL' savedConfigureFlags lastNonMempty = lastNonMempty' savedConfigureFlags @@ -526,8 +533,7 @@ baseSavedConfig = do return mempty { savedConfigureFlags = mempty { configHcFlavor = toFlag defaultCompiler, - configUserInstall = toFlag defaultUserInstall, - configVerbosity = toFlag normal + configUserInstall = toFlag defaultUserInstall }, savedUserInstallDirs = mempty { prefix = toFlag (toPathTemplate userPrefix)