From f845bbee4119c197ad370729578494cbf8f83551 Mon Sep 17 00:00:00 2001 From: Simon Hengel Date: Tue, 21 Jan 2025 09:49:35 +0700 Subject: [PATCH] Don't generate `build-tools` starting with `cabal-version: 2` (fixes #596) --- .ghci | 2 +- CHANGELOG.md | 3 + LICENSE | 2 +- src/Hpack/Config.hs | 156 ++++++++++++++++++++++++--------------- src/Hpack/Render.hs | 88 +++++++++++----------- test/EndToEndSpec.hs | 30 +++++++- test/Hpack/RenderSpec.hs | 11 ++- 7 files changed, 181 insertions(+), 111 deletions(-) diff --git a/.ghci b/.ghci index decd796a..a446ea04 100644 --- a/.ghci +++ b/.ghci @@ -1 +1 @@ -:set -XHaskell2010 -Wredundant-constraints -fno-warn-incomplete-uni-patterns -DTEST -isrc -itest -i./dist-newstyle/build/x86_64-linux/ghc-9.6.2/hpack-0.36.0/build/autogen +:set -XHaskell2010 -Wredundant-constraints -fno-warn-incomplete-uni-patterns -DTEST -isrc -itest -i./dist-newstyle/build/x86_64-linux/ghc-9.10.1/hpack-0.37.0/build/autogen diff --git a/CHANGELOG.md b/CHANGELOG.md index b36c70e5..de3d3de8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,6 @@ +## Changes in 0.38.0 + - Don't generate `build-tools` starting with `cabal-version: 2` (fixes #596) + ## Changes in 0.37.0 - Add support for `asm-options` and `asm-sources` (see #573) diff --git a/LICENSE b/LICENSE index 28fc5ddf..6dff93ee 100644 --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2014-2023 Simon Hengel +Copyright (c) 2014-2025 Simon Hengel Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal diff --git a/src/Hpack/Config.hs b/src/Hpack/Config.hs index b25fad01..f8f7a600 100644 --- a/src/Hpack/Config.hs +++ b/src/Hpack/Config.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} @@ -41,6 +42,8 @@ module Hpack.Config ( , package , section , Package(..) +, CabalVersion(..) +, makeCabalVersion , Dependencies(..) , DependencyInfo(..) , VersionConstraint(..) @@ -104,7 +107,8 @@ import Control.Monad.State (MonadState, StateT, evalStateT) import qualified Control.Monad.State as State import Control.Monad.Writer (MonadWriter, WriterT, runWriterT, tell) import Control.Monad.Except -import Data.Version (Version, makeVersion, showVersion) +import Data.Version (Version, showVersion) +import qualified Data.Version as Version import Distribution.Pretty (prettyShow) import qualified Distribution.SPDX.License as SPDX @@ -132,9 +136,13 @@ import qualified Path import qualified Paths_hpack as Hpack (version) +defaultCabalVersion :: Version +defaultCabalVersion = Version.makeVersion [1,12] + package :: String -> String -> Package package name version = Package { - packageName = name + packageCabalVersion = CabalVersion defaultCabalVersion + , packageName = name , packageVersion = version , packageSynopsis = Nothing , packageDescription = Nothing @@ -698,8 +706,13 @@ readPackageConfigWithError (DecodeOptions _ file mUserDataDir readValue formatYa userDataDir <- liftIO $ maybe (getAppUserDataDirectory "hpack") return mUserDataDir toPackage formatYamlParseError userDataDir dir config where - addCabalFile :: ((Package, String), [String]) -> DecodeResult - addCabalFile ((pkg, cabalVersion), warnings) = DecodeResult pkg cabalVersion (takeDirectory_ file (packageName pkg ++ ".cabal")) warnings + addCabalFile :: (Package, [String]) -> DecodeResult + addCabalFile (pkg, warnings) = DecodeResult { + decodeResultPackage = pkg + , decodeResultCabalVersion = "cabal-version: " ++ showCabalVersion (packageCabalVersion pkg) ++ "\n\n" + , decodeResultCabalFile = takeDirectory_ file packageName pkg <.> "cabal" + , decodeResultWarnings = warnings + } takeDirectory_ :: FilePath -> FilePath takeDirectory_ p @@ -718,9 +731,9 @@ verbatimValueToString = \ case VerbatimBool b -> show b VerbatimNull -> "" -addPathsModuleToGeneratedModules :: Package -> Version -> Package -addPathsModuleToGeneratedModules pkg cabalVersion - | cabalVersion < makeVersion [2] = pkg +addPathsModuleToGeneratedModules :: Package -> Package +addPathsModuleToGeneratedModules pkg + | packageCabalVersion pkg < makeCabalVersion [2] = pkg | otherwise = pkg { packageLibrary = fmap mapLibrary <$> packageLibrary pkg , packageInternalLibraries = fmap mapLibrary <$> packageInternalLibraries pkg @@ -749,22 +762,56 @@ addPathsModuleToGeneratedModules pkg cabalVersion where generatedModules = executableGeneratedModules executable -determineCabalVersion :: Maybe (License SPDX.License) -> Package -> (Package, String, Maybe Version) -determineCabalVersion inferredLicense pkg@Package{..} = ( - pkg { - packageVerbatim = deleteVerbatimField "cabal-version" packageVerbatim - , packageLicense = formatLicense <$> license - } - , "cabal-version: " ++ effectiveCabalVersion ++ "\n\n" - , parseVersion effectiveCabalVersion - ) +data CabalVersion = CabalVersion Version | VerbatimCabalVersion String + deriving (Eq, Ord, Show) + +makeCabalVersion :: [Int] -> CabalVersion +makeCabalVersion = CabalVersion . Version.makeVersion + +showCabalVersion :: CabalVersion -> String +showCabalVersion = \ case + CabalVersion v -> showVersion v + VerbatimCabalVersion v -> v + +extractVerbatimCabalVersion :: [Verbatim] -> (Maybe CabalVersion, [Verbatim]) +extractVerbatimCabalVersion verbatim = case listToMaybe (mapMaybe extractCabalVersion verbatim) of + Nothing -> (Nothing, verbatim) + Just verbatimVersion -> (Just cabalVersion, deleteVerbatimField "cabal-version" verbatim) + where + cabalVersion :: CabalVersion + cabalVersion = case parseVersion verbatimVersion of + Nothing -> VerbatimCabalVersion verbatimVersion + Just v -> CabalVersion v + where + + + extractCabalVersion :: Verbatim -> Maybe String + extractCabalVersion = \ case + VerbatimLiteral _ -> Nothing + VerbatimObject o -> case Map.lookup "cabal-version" o of + Just v -> Just (verbatimValueToString v) + Nothing -> Nothing + +ensureRequiredCabalVersion :: Maybe (License SPDX.License) -> Package -> Package +ensureRequiredCabalVersion inferredLicense pkg@Package{..} = pkg { + packageCabalVersion = version + , packageLicense = formatLicense <$> license + , packageVerbatim = verbatim + } where - effectiveCabalVersion = fromMaybe inferredCabalVersion verbatimCabalVersion + (verbatimCabalVersion, verbatim) = extractVerbatimCabalVersion packageVerbatim + + makeVersion :: [Int] -> CabalVersion + makeVersion = makeCabalVersion + + license :: Maybe (License String) license = fmap prettyShow <$> (parsedLicense <|> inferredLicense) + parsedLicense :: Maybe (License SPDX.License) parsedLicense = parseLicense <$> packageLicense + formatLicense :: License String -> String formatLicense = \ case MustSPDX spdx -> spdx CanSPDX _ spdx | version >= makeVersion [2,2] -> spdx @@ -779,21 +826,11 @@ determineCabalVersion inferredLicense pkg@Package{..} = ( CanSPDX _ _ -> False MustSPDX _ -> True - verbatimCabalVersion :: Maybe String - verbatimCabalVersion = listToMaybe (mapMaybe f packageVerbatim) - where - f :: Verbatim -> Maybe String - f = \ case - VerbatimLiteral _ -> Nothing - VerbatimObject o -> case Map.lookup "cabal-version" o of - Just v -> Just (verbatimValueToString v) - Nothing -> Nothing - - inferredCabalVersion :: String - inferredCabalVersion = showVersion version - - version = fromMaybe (makeVersion [1,12]) $ maximum [ - packageCabalVersion + version :: CabalVersion + version = flip fromMaybe verbatimCabalVersion $ fromMaybe packageCabalVersion $ maximum [ + makeVersion [2,2] <$ guard mustSPDX + , makeVersion [1,24] <$ packageCustomSetup + , makeVersion [1,18] <$ guard (not (null packageExtraDocFiles)) , packageLibrary >>= libraryCabalVersion , internalLibsCabalVersion packageInternalLibraries , executablesCabalVersion packageExecutables @@ -801,15 +838,7 @@ determineCabalVersion inferredLicense pkg@Package{..} = ( , executablesCabalVersion packageBenchmarks ] - packageCabalVersion :: Maybe Version - packageCabalVersion = maximum [ - Nothing - , makeVersion [2,2] <$ guard mustSPDX - , makeVersion [1,24] <$ packageCustomSetup - , makeVersion [1,18] <$ guard (not (null packageExtraDocFiles)) - ] - - libraryCabalVersion :: Section Library -> Maybe Version + libraryCabalVersion :: Section Library -> Maybe CabalVersion libraryCabalVersion sect = maximum [ makeVersion [1,22] <$ guard (has libraryReexportedModules) , makeVersion [2,0] <$ guard (has librarySignatures) @@ -820,17 +849,17 @@ determineCabalVersion inferredLicense pkg@Package{..} = ( where has field = any (not . null . field) sect - internalLibsCabalVersion :: Map String (Section Library) -> Maybe Version + internalLibsCabalVersion :: Map String (Section Library) -> Maybe CabalVersion internalLibsCabalVersion internalLibraries | Map.null internalLibraries = Nothing | otherwise = foldr max (Just $ makeVersion [2,0]) versions where versions = libraryCabalVersion <$> Map.elems internalLibraries - executablesCabalVersion :: Map String (Section Executable) -> Maybe Version + executablesCabalVersion :: Map String (Section Executable) -> Maybe CabalVersion executablesCabalVersion = foldr max Nothing . map executableCabalVersion . Map.elems - executableCabalVersion :: Section Executable -> Maybe Version + executableCabalVersion :: Section Executable -> Maybe CabalVersion executableCabalVersion sect = maximum [ makeVersion [2,0] <$ guard (executableHasGeneratedModules sect) , sectionCabalVersion (concatMap getExecutableModules) sect @@ -839,7 +868,7 @@ determineCabalVersion inferredLicense pkg@Package{..} = ( executableHasGeneratedModules :: Section Executable -> Bool executableHasGeneratedModules = any (not . null . executableGeneratedModules) - sectionCabalVersion :: (Section a -> [Module]) -> Section a -> Maybe Version + sectionCabalVersion :: (Section a -> [Module]) -> Section a -> Maybe CabalVersion sectionCabalVersion getMentionedModules sect = maximum $ [ makeVersion [2,2] <$ guard (sectionSatisfies (not . null . sectionCxxSources) sect) , makeVersion [2,2] <$ guard (sectionSatisfies (not . null . sectionCxxOptions) sect) @@ -853,17 +882,23 @@ determineCabalVersion inferredLicense pkg@Package{..} = ( && pathsModule `elem` getMentionedModules sect) ] ++ map versionFromSystemBuildTool systemBuildTools where + defaultExtensions :: [String] defaultExtensions = sectionAll sectionDefaultExtensions sect + + uses :: String -> Bool uses = (`elem` defaultExtensions) + pathsModule :: Module pathsModule = pathsModuleFromPackageName packageName + versionFromSystemBuildTool :: String -> Maybe CabalVersion versionFromSystemBuildTool name | name `elem` known_1_10 = Nothing | name `elem` known_1_14 = Just (makeVersion [1,14]) | name `elem` known_1_22 = Just (makeVersion [1,22]) | otherwise = Just (makeVersion [2,0]) + known_1_10 :: [String] known_1_10 = [ "ghc" , "ghc-pkg" @@ -891,9 +926,13 @@ determineCabalVersion inferredLicense pkg@Package{..} = ( , "lhc" , "lhc-pkg" ] + + known_1_14 :: [String] known_1_14 = [ "hpc" ] + + known_1_22 :: [String] known_1_22 = [ "ghcjs" , "ghcjs-pkg" @@ -966,7 +1005,8 @@ instance FromValue ParseSpecVersion where Nothing -> fail ("invalid value " ++ show s) data Package = Package { - packageName :: String + packageCabalVersion :: CabalVersion +, packageName :: String , packageVersion :: String , packageSynopsis :: Maybe String , packageDescription :: Maybe String @@ -1093,7 +1133,7 @@ type ConfigWithDefaults = Product type CommonOptionsWithDefaults a = Product DefaultsConfig (CommonOptions ParseAsmSources ParseCSources ParseCxxSources ParseJsSources a) type WithCommonOptionsWithDefaults a = Product DefaultsConfig (WithCommonOptions ParseAsmSources ParseCSources ParseCxxSources ParseJsSources a) -toPackage :: FormatYamlParseError -> FilePath -> FilePath -> ConfigWithDefaults -> ConfigM IO (Package, String) +toPackage :: FormatYamlParseError -> FilePath -> FilePath -> ConfigWithDefaults -> ConfigM IO Package toPackage formatYamlParseError userDataDir dir = expandDefaultsInConfig formatYamlParseError userDataDir dir >=> setDefaultLanguage "Haskell2010" @@ -1195,9 +1235,9 @@ toExecutableMap name executables mExecutable = do type GlobalOptions = CommonOptions AsmSources CSources CxxSources JsSources Empty -toPackage_ :: (MonadIO m, Warnings m, State m) => FilePath -> Product GlobalOptions (PackageConfig AsmSources CSources CxxSources JsSources) -> m (Package, String) +toPackage_ :: (MonadIO m, Warnings m, State m) => FilePath -> Product GlobalOptions (PackageConfig AsmSources CSources CxxSources JsSources) -> m Package toPackage_ dir (Product g PackageConfig{..}) = do - executableMap <- toExecutableMap packageName_ packageConfigExecutables packageConfigExecutable + executableMap <- toExecutableMap packageName packageConfigExecutables packageConfigExecutable let globalVerbatim = commonOptionsVerbatim g globalOptions = g {commonOptionsVerbatim = Nothing} @@ -1205,13 +1245,13 @@ toPackage_ dir (Product g PackageConfig{..}) = do executableNames = maybe [] Map.keys executableMap toSect :: (Warnings m, Monoid a) => WithCommonOptions AsmSources CSources CxxSources JsSources a -> m (Section a) - toSect = toSection packageName_ executableNames . first ((mempty <$ globalOptions) <>) + toSect = toSection packageName executableNames . first ((mempty <$ globalOptions) <>) toSections :: (Warnings m, Monoid a) => Maybe (Map String (WithCommonOptions AsmSources CSources CxxSources JsSources a)) -> m (Map String (Section a)) toSections = maybe (return mempty) (traverse toSect) - toLib = toLibrary dir packageName_ - toExecutables = toSections >=> traverse (toExecutable dir packageName_) + toLib = toLibrary dir packageName + toExecutables = toSections >=> traverse (toExecutable dir packageName) mLibrary <- traverse (toSect >=> toLib) packageConfigLibrary internalLibraries <- toSections packageConfigInternalLibraries >>= traverse toLib @@ -1257,7 +1297,8 @@ toPackage_ dir (Product g PackageConfig{..}) = do defaultBuildType = maybe Simple (const Custom) mCustomSetup pkg = Package { - packageName = packageName_ + packageCabalVersion = CabalVersion defaultCabalVersion + , packageName , packageVersion = maybe "0.0.0" unPackageVersion packageConfigVersion , packageSynopsis = packageConfigSynopsis , packageDescription = packageConfigDescription @@ -1290,12 +1331,11 @@ toPackage_ dir (Product g PackageConfig{..}) = do tell nameWarnings tell (formatMissingSourceDirs missingSourceDirs) - let (pkg_, renderedCabalVersion, cabalVersion) = determineCabalVersion inferredLicense pkg - return (maybe pkg_ (addPathsModuleToGeneratedModules pkg_) cabalVersion, renderedCabalVersion) + return $ addPathsModuleToGeneratedModules $ ensureRequiredCabalVersion inferredLicense pkg where nameWarnings :: [String] - packageName_ :: String - (nameWarnings, packageName_) = case packageConfigName of + packageName :: String + (nameWarnings, packageName) = case packageConfigName of Nothing -> let inferredName = takeBaseName dir in (["Package name not specified, inferred " ++ show inferredName], inferredName) Just n -> ([], n) @@ -1418,7 +1458,7 @@ inferModules dir packageName_ getMentionedModules getInferredModules fromData fr let pathsModule :: [Module] pathsModule = case specVersion of - SpecVersion v | v >= makeVersion [0,36,0] -> [] + SpecVersion v | v >= Version.makeVersion [0,36,0] -> [] _ -> [pathsModuleFromPackageName packageName_] removeConditionalsThatAreAlwaysFalse <$> traverseSectionAndConditionals diff --git a/src/Hpack/Render.hs b/src/Hpack/Render.hs index 6a002172..09f0fafb 100644 --- a/src/Hpack/Render.hs +++ b/src/Hpack/Render.hs @@ -79,7 +79,7 @@ renderPackageWith settings headerFieldsAlignment existingFieldOrder sectionsFiel customSetup = maybe [] (return . renderCustomSetup) packageCustomSetup library :: [Element] - library = maybe [] (return . renderLibrary) packageLibrary + library = maybe [] (return . renderLibrary packageCabalVersion) packageLibrary stanzas :: [Element] stanzas = concat [ @@ -87,10 +87,10 @@ renderPackageWith settings headerFieldsAlignment existingFieldOrder sectionsFiel , customSetup , map renderFlag packageFlags , library - , renderInternalLibraries packageInternalLibraries - , renderExecutables packageExecutables - , renderTests packageTests - , renderBenchmarks packageBenchmarks + , renderInternalLibraries packageCabalVersion packageInternalLibraries + , renderExecutables packageCabalVersion packageExecutables + , renderTests packageCabalVersion packageTests + , renderBenchmarks packageCabalVersion packageBenchmarks ] headerFields :: [Element] @@ -155,38 +155,38 @@ renderFlag Flag {..} = Stanza ("flag " ++ flagName) $ description ++ [ where description = maybe [] (return . Field "description" . Literal) flagDescription -renderInternalLibraries :: Map String (Section Library) -> [Element] -renderInternalLibraries = map renderInternalLibrary . Map.toList +renderInternalLibraries :: CabalVersion -> Map String (Section Library) -> [Element] +renderInternalLibraries cabalVersion = map (renderInternalLibrary cabalVersion) . Map.toList -renderInternalLibrary :: (String, Section Library) -> Element -renderInternalLibrary (name, sect) = - Stanza ("library " ++ name) (renderLibrarySection sect) +renderInternalLibrary :: CabalVersion -> (String, Section Library) -> Element +renderInternalLibrary cabalVersion (name, sect) = + Stanza ("library " ++ name) (renderLibrarySection cabalVersion sect) -renderExecutables :: Map String (Section Executable) -> [Element] -renderExecutables = map renderExecutable . Map.toList +renderExecutables :: CabalVersion -> Map String (Section Executable) -> [Element] +renderExecutables cabalVersion = map (renderExecutable cabalVersion) . Map.toList -renderExecutable :: (String, Section Executable) -> Element -renderExecutable (name, sect) = - Stanza ("executable " ++ name) (renderExecutableSection [] sect) +renderExecutable :: CabalVersion -> (String, Section Executable) -> Element +renderExecutable cabalVersion (name, sect) = + Stanza ("executable " ++ name) (renderExecutableSection cabalVersion [] sect) -renderTests :: Map String (Section Executable) -> [Element] -renderTests = map renderTest . Map.toList +renderTests :: CabalVersion -> Map String (Section Executable) -> [Element] +renderTests cabalVersion = map (renderTest cabalVersion) . Map.toList -renderTest :: (String, Section Executable) -> Element -renderTest (name, sect) = +renderTest :: CabalVersion -> (String, Section Executable) -> Element +renderTest cabalVersion (name, sect) = Stanza ("test-suite " ++ name) - (renderExecutableSection [Field "type" "exitcode-stdio-1.0"] sect) + (renderExecutableSection cabalVersion [Field "type" "exitcode-stdio-1.0"] sect) -renderBenchmarks :: Map String (Section Executable) -> [Element] -renderBenchmarks = map renderBenchmark . Map.toList +renderBenchmarks :: CabalVersion -> Map String (Section Executable) -> [Element] +renderBenchmarks cabalVersion = map (renderBenchmark cabalVersion) . Map.toList -renderBenchmark :: (String, Section Executable) -> Element -renderBenchmark (name, sect) = +renderBenchmark :: CabalVersion -> (String, Section Executable) -> Element +renderBenchmark cabalVersion (name, sect) = Stanza ("benchmark " ++ name) - (renderExecutableSection [Field "type" "exitcode-stdio-1.0"] sect) + (renderExecutableSection cabalVersion [Field "type" "exitcode-stdio-1.0"] sect) -renderExecutableSection :: [Element] -> Section Executable -> [Element] -renderExecutableSection extraFields = renderSection renderExecutableFields extraFields +renderExecutableSection :: CabalVersion -> [Element] -> Section Executable -> [Element] +renderExecutableSection cabalVersion extraFields = renderSection cabalVersion renderExecutableFields extraFields renderExecutableFields :: Executable -> [Element] renderExecutableFields Executable{..} = mainIs ++ [otherModules, generatedModules] @@ -199,11 +199,11 @@ renderCustomSetup :: CustomSetup -> Element renderCustomSetup CustomSetup{..} = Stanza "custom-setup" $ renderDependencies "setup-depends" customSetupDependencies -renderLibrary :: Section Library -> Element -renderLibrary sect = Stanza "library" $ renderLibrarySection sect +renderLibrary :: CabalVersion -> Section Library -> Element +renderLibrary cabalVersion sect = Stanza "library" $ renderLibrarySection cabalVersion sect -renderLibrarySection :: Section Library -> [Element] -renderLibrarySection = renderSection renderLibraryFields [] +renderLibrarySection :: CabalVersion -> Section Library -> [Element] +renderLibrarySection cabalVersion = renderSection cabalVersion renderLibraryFields [] renderLibraryFields :: Library -> [Element] renderLibraryFields Library{..} = @@ -222,8 +222,8 @@ renderExposed = Field "exposed" . Literal . show renderVisibility :: String -> Element renderVisibility = Field "visibility" . Literal -renderSection :: (a -> [Element]) -> [Element] -> Section a -> [Element] -renderSection renderSectionData extraFieldsStart Section{..} = addVerbatim sectionVerbatim $ +renderSection :: CabalVersion -> (a -> [Element]) -> [Element] -> Section a -> [Element] +renderSection cabalVersion renderSectionData extraFieldsStart Section{..} = addVerbatim sectionVerbatim $ extraFieldsStart ++ renderSectionData sectionData ++ [ renderDirectories "hs-source-dirs" sectionSourceDirs @@ -250,11 +250,11 @@ renderSection renderSectionData extraFieldsStart Section{..} = addVerbatim secti , renderLdOptions sectionLdOptions , Field "pkgconfig-depends" (CommaSeparatedList sectionPkgConfigDependencies) ] - ++ renderBuildTools sectionBuildTools sectionSystemBuildTools + ++ renderBuildTools cabalVersion sectionBuildTools sectionSystemBuildTools ++ renderDependencies "build-depends" sectionDependencies ++ maybe [] (return . renderBuildable) sectionBuildable ++ maybe [] (return . renderLanguage) sectionLanguage - ++ map (renderConditional renderSectionData) sectionConditionals + ++ map (renderConditional cabalVersion renderSectionData) sectionConditionals addVerbatim :: [Verbatim] -> [Element] -> [Element] addVerbatim verbatim fields = filterVerbatim verbatim fields ++ renderVerbatim verbatim @@ -285,12 +285,12 @@ renderVerbatimObject = map renderPair . Map.toList [x] -> Field key (Literal x) xs -> Field key (LineSeparatedList xs) -renderConditional :: (a -> [Element]) -> Conditional (Section a) -> Element -renderConditional renderSectionData (Conditional condition sect mElse) = case mElse of +renderConditional :: CabalVersion -> (a -> [Element]) -> Conditional (Section a) -> Element +renderConditional cabalVersion renderSectionData (Conditional condition sect mElse) = case mElse of Nothing -> if_ - Just else_ -> Group if_ (Stanza "else" $ renderSection renderSectionData [] else_) + Just else_ -> Group if_ (Stanza "else" $ renderSection cabalVersion renderSectionData [] else_) where - if_ = Stanza ("if " ++ renderCond condition) (renderSection renderSectionData [] sect) + if_ = Stanza ("if " ++ renderCond condition) (renderSection cabalVersion renderSectionData [] sect) renderCond :: Cond -> String renderCond = \ case @@ -343,19 +343,19 @@ renderVersionConstraint version = case version of AnyVersion -> "" VersionRange x -> " " ++ x -renderBuildTools :: Map BuildTool DependencyVersion -> SystemBuildTools -> [Element] -renderBuildTools (map renderBuildTool . Map.toList -> xs) systemBuildTools = [ +renderBuildTools :: CabalVersion -> Map BuildTool DependencyVersion -> SystemBuildTools -> [Element] +renderBuildTools cabalVersion (map (renderBuildTool cabalVersion) . Map.toList -> xs) systemBuildTools = [ Field "build-tools" (CommaSeparatedList $ [x | BuildTools x <- xs] ++ renderSystemBuildTools systemBuildTools) , Field "build-tool-depends" (CommaSeparatedList [x | BuildToolDepends x <- xs]) ] data RenderBuildTool = BuildTools String | BuildToolDepends String -renderBuildTool :: (BuildTool, DependencyVersion) -> RenderBuildTool -renderBuildTool (buildTool, renderVersion -> version) = case buildTool of +renderBuildTool :: CabalVersion -> (BuildTool, DependencyVersion) -> RenderBuildTool +renderBuildTool cabalVersion (buildTool, renderVersion -> version) = case buildTool of LocalBuildTool executable -> BuildTools (executable ++ version) BuildTool pkg executable - | pkg == executable && executable `elem` knownBuildTools -> BuildTools (executable ++ version) + | cabalVersion < makeCabalVersion [2] && pkg == executable && executable `elem` knownBuildTools -> BuildTools (executable ++ version) | otherwise -> BuildToolDepends (pkg ++ ":" ++ executable ++ version) where knownBuildTools :: [String] diff --git a/test/EndToEndSpec.hs b/test/EndToEndSpec.hs index 8f25fbe8..eef1f0f2 100644 --- a/test/EndToEndSpec.hs +++ b/test/EndToEndSpec.hs @@ -19,7 +19,7 @@ import Data.String.Interpolate.Util import Data.Version (showVersion) import qualified Hpack.Render as Hpack -import Hpack.Config (packageConfig, readPackageConfig, DecodeOptions(..), DecodeResult(..), defaultDecodeOptions) +import Hpack.Config (packageConfig, readPackageConfig, DecodeOptions(..), defaultDecodeOptions, DecodeResult(..)) import Hpack.Render.Hints (FormattingHints(..), sniffFormattingHints) import qualified Paths_hpack as Hpack (version) @@ -649,6 +649,22 @@ spec = around_ (inTempDirectoryNamed "my-package") $ do alex ==0.1.0 |] + it "adds known build tools to build-tools" $ do + [i| + verbatim: + cabal-version: 2.0 + executable: + build-tools: + alex == 0.1.0 + |] `shouldRenderTo` (executable_ "my-package" [i| + autogen-modules: + Paths_my_package + build-tool-depends: + alex:alex ==0.1.0 + |]) { + packageCabalVersion = "2.0" + } + it "adds other build tools to build-tool-depends" $ do [i| executable: @@ -1887,9 +1903,17 @@ spec = around_ (inTempDirectoryNamed "my-package") $ do context "when specified globally" $ do it "overrides header fields" $ do [i| + license: BSD-3-Clause verbatim: cabal-version: foo - |] `shouldRenderTo` (package "") {packageCabalVersion = "foo"} + |] `shouldRenderTo` (package "license: BSD-3-Clause") {packageCabalVersion = "foo"} + + it "overrides header fields" $ do + [i| + license: BSD-3-Clause + verbatim: + cabal-version: 0.8 + |] `shouldRenderTo` (package "license: BSD-3-Clause") {packageCabalVersion = "0.8"} it "overrides other fields" $ do touch "foo" @@ -1960,7 +1984,7 @@ run_ :: FilePath -> FilePath -> String -> IO (Either String ([String], String)) run_ userDataDir c old = do mPackage <- readPackageConfig defaultDecodeOptions {decodeOptionsTarget = c, decodeOptionsUserDataDir = Just userDataDir} return $ case mPackage of - Right (DecodeResult pkg cabalVersion _ warnings) -> + Right r@(DecodeResult pkg cabalVersion _ warnings) -> let FormattingHints{..} = sniffFormattingHints (lines old) alignment = fromMaybe 0 formattingHintsAlignment diff --git a/test/Hpack/RenderSpec.hs b/test/Hpack/RenderSpec.hs index f8753105..458eed78 100644 --- a/test/Hpack/RenderSpec.hs +++ b/test/Hpack/RenderSpec.hs @@ -21,6 +21,9 @@ executable = (section $ Executable (Just "Main.hs") [] []) { renderEmptySection :: Empty -> [Element] renderEmptySection Empty = [] +cabalVersion :: CabalVersion +cabalVersion = makeCabalVersion [1,12] + spec :: Spec spec = do describe "renderPackageWith" $ do @@ -222,7 +225,7 @@ spec = do describe "renderConditional" $ do it "renders conditionals" $ do let conditional = Conditional "os(windows)" (section Empty) {sectionDependencies = deps ["Win32"]} Nothing - render defaultRenderSettings 0 (renderConditional renderEmptySection conditional) `shouldBe` [ + render defaultRenderSettings 0 (renderConditional cabalVersion renderEmptySection conditional) `shouldBe` [ "if os(windows)" , " build-depends:" , " Win32" @@ -230,7 +233,7 @@ spec = do it "renders conditionals with else-branch" $ do let conditional = Conditional "os(windows)" (section Empty) {sectionDependencies = deps ["Win32"]} (Just $ (section Empty) {sectionDependencies = deps ["unix"]}) - render defaultRenderSettings 0 (renderConditional renderEmptySection conditional) `shouldBe` [ + render defaultRenderSettings 0 (renderConditional cabalVersion renderEmptySection conditional) `shouldBe` [ "if os(windows)" , " build-depends:" , " Win32" @@ -242,7 +245,7 @@ spec = do it "renders nested conditionals" $ do let conditional = Conditional "arch(i386)" (section Empty) {sectionGhcOptions = ["-threaded"], sectionConditionals = [innerConditional]} Nothing innerConditional = Conditional "os(windows)" (section Empty) {sectionDependencies = deps ["Win32"]} Nothing - render defaultRenderSettings 0 (renderConditional renderEmptySection conditional) `shouldBe` [ + render defaultRenderSettings 0 (renderConditional cabalVersion renderEmptySection conditional) `shouldBe` [ "if arch(i386)" , " ghc-options: -threaded" , " if os(windows)" @@ -253,7 +256,7 @@ spec = do it "conditionalises both build-depends and mixins" $ do let conditional = Conditional "os(windows)" (section Empty) {sectionDependencies = [("Win32", depInfo)]} Nothing depInfo = defaultInfo { dependencyInfoMixins = ["hiding (Blah)"] } - render defaultRenderSettings 0 (renderConditional renderEmptySection conditional) `shouldBe` [ + render defaultRenderSettings 0 (renderConditional cabalVersion renderEmptySection conditional) `shouldBe` [ "if os(windows)" , " build-depends:" , " Win32"