diff --git a/Cabal2Ebuild.hs b/Cabal2Ebuild.hs --- a/Cabal2Ebuild.hs +++ b/Cabal2Ebuild.hs @@ -25,8 +25,10 @@ (PackageDescription(..), license) import qualified Distribution.Package as Cabal (PackageIdentifier(..) , Dependency(..)) -import qualified Distribution.Version as Cabal (VersionRange, foldVersionRange') -import Distribution.Text (display) +import qualified Distribution.Version as Cabal (VersionRange, cataVersionRange, normaliseVersionRange + , wildcardUpperBound, majorUpperBound) +import Distribution.Version (VersionRangeF(..)) +import Distribution.Pretty (prettyShow) import Data.Char (isUpper) import Data.Maybe @@ -44,9 +46,9 @@ cabal2ebuild :: Portage.Category -> Cabal.PackageDescription -> Portage.EBuild cabal2ebuild cat pkg = Portage.ebuildTemplate { E.name = Portage.cabal_pn_to_PN cabal_pn, - E.category = display cat, + E.category = prettyShow cat, E.hackage_name= cabalPkgName, - E.version = display (Cabal.pkgVersion (Cabal.package pkg)), + E.version = prettyShow (Cabal.pkgVersion (Cabal.package pkg)), E.description = if null (Cabal.synopsis pkg) then Cabal.description pkg else Cabal.synopsis pkg, E.long_desc = if null (Cabal.description pkg) then Cabal.synopsis pkg @@ -69,7 +71,7 @@ else []) } where cabal_pn = Cabal.pkgName $ Cabal.package pkg - cabalPkgName = display cabal_pn + cabalPkgName = prettyShow cabal_pn hasLibs = isJust (Cabal.library pkg) hasTests = (not . null) (Cabal.testSuites pkg) thisHomepage = if (null $ Cabal.homepage pkg) @@ -80,7 +82,7 @@ convertDependencies overlay category = map (convertDependency overlay category) convertDependency :: O.Overlay -> Portage.Category -> Cabal.Dependency -> Dependency -convertDependency overlay category (Cabal.Dependency pname versionRange) +convertDependency overlay category (Cabal.Dependency pname versionRange _lib) = convert versionRange where pn = case Portage.resolveFullPortageName overlay pname of @@ -91,16 +93,18 @@ p_v v = fromCabalVersion v convert :: Cabal.VersionRange -> Dependency - convert = Cabal.foldVersionRange' - ( mk_p (DRange ZeroB InfinityB) -- ^ @\"-any\"@ version - )(\v -> mk_p (DExact (p_v v)) -- ^ @\"== v\"@ - )(\v -> mk_p (DRange (StrictLB (p_v v)) InfinityB) -- ^ @\"> v\"@ - )(\v -> mk_p (DRange ZeroB (StrictUB (p_v v))) -- ^ @\"< v\"@ - )(\v -> mk_p (DRange (NonstrictLB (p_v v)) InfinityB) -- ^ @\">= v\"@ - )(\v -> mk_p (DRange ZeroB (NonstrictUB (p_v v))) -- ^ @\"<= v\"@ - )(\v1 v2 -> mk_p (DRange (NonstrictLB (p_v v1)) (StrictUB (p_v v2))) -- ^ @\"== v.*\"@ wildcard. (incl lower, excl upper) - )(\v1 v2 -> mk_p (DRange (NonstrictLB (p_v v1)) (StrictUB (p_v v2))) -- ^ @\"^>= v\"@ major upper bound - )(\g1 g2 -> DependAnyOf [g1, g2] -- ^ @\"_ || _\"@ union - )(\r1 r2 -> DependAllOf [r1, r2] -- ^ @\"_ && _\"@ intersection - )(\dp -> dp -- ^ @\"(_)\"@ parentheses - ) + convert = Cabal.cataVersionRange alg . Cabal.normaliseVersionRange + where + alg AnyVersionF = mk_p $ DRange ZeroB InfinityB + alg (ThisVersionF v) = mk_p $ DExact $ p_v v + alg (LaterVersionF v) = mk_p $ DRange (StrictLB $ p_v v) InfinityB + alg (EarlierVersionF v) = mk_p $ DRange ZeroB $ StrictUB $ p_v v + alg (OrLaterVersionF v) = mk_p $ DRange (NonstrictLB $ p_v v) InfinityB + alg (OrEarlierVersionF v) = mk_p $ DRange ZeroB $ NonstrictUB $ p_v v + alg (WildcardVersionF v) = mk_p $ DRange (NonstrictLB $ p_v v) + $ StrictUB $ p_v $ Cabal.wildcardUpperBound v + alg (MajorBoundVersionF v) = mk_p $ DRange (NonstrictLB $ p_v v) + $ StrictUB $ p_v $ Cabal.majorUpperBound v + alg (UnionVersionRangesF v1 v2) = DependAnyOf [v1, v2] + alg (IntersectVersionRangesF v1 v2) = DependAllOf [v1, v2] + alg (VersionRangeParensF v) = v diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -18,12 +18,15 @@ ) import Distribution.Simple.Command -- commandsRun -import Distribution.Simple.Utils ( die, cabalVersion, warn ) +import Distribution.Simple.Utils ( dieNoVerbosity, cabalVersion, warn ) import qualified Distribution.PackageDescription.Parsec as Cabal import qualified Distribution.Package as Cabal import Distribution.Verbosity (Verbosity, normal) -import Distribution.Text (display, simpleParse) +import Data.Version (showVersion) +import Distribution.Pretty (prettyShow) +import Distribution.Parsec (simpleParsec) + import qualified Distribution.Client.Setup as CabalInstall import qualified Distribution.Client.Types as CabalInstall import qualified Distribution.Client.Update as CabalInstall @@ -122,7 +125,7 @@ pretty (isInOverlay, pkgId) = let dec | isInOverlay = " * " | otherwise = " " - in dec ++ display pkgId + in dec ++ prettyShow pkgId ----------------------------------------------------------------------- @@ -167,7 +170,7 @@ (catstr,cabals) <- case args of (category:cabal1:cabaln) -> return (category, cabal1:cabaln) _ -> throwEx (ArgumentError "make-ebuild needs at least two arguments. ") - cat <- case simpleParse catstr of + cat <- case simpleParsec catstr of Just c -> return c Nothing -> throwEx (ArgumentError ("could not parse category: " ++ catstr)) let verbosity = fromFlag (makeEbuildVerbosity flags) @@ -254,7 +257,7 @@ updateAction :: UpdateFlags -> [String] -> H.GlobalFlags -> IO () updateAction flags extraArgs globalFlags = do unless (null extraArgs) $ - die $ "'update' doesn't take any extra arguments: " ++ unwords extraArgs + dieNoVerbosity $ "'update' doesn't take any extra arguments: " ++ unwords extraArgs let verbosity = fromFlag (updateVerbosity flags) H.withHackPortContext verbosity globalFlags $ \repoContext -> @@ -475,13 +478,13 @@ printErrors errs = do putStr (concat (intersperse "\n" errs)) exitFailure - printNumericVersion = putStrLn $ display Paths_hackport.version + printNumericVersion = putStrLn $ showVersion Paths_hackport.version printVersion = putStrLn $ "hackport version " - ++ display Paths_hackport.version + ++ showVersion Paths_hackport.version ++ "\nusing cabal-install " - ++ display Paths_cabal_install.version + ++ showVersion Paths_cabal_install.version ++ " and the Cabal library version " - ++ display cabalVersion + ++ prettyShow cabalVersion errorHandler :: HackPortError -> IO () errorHandler e = do putStrLn (hackPortShowError e) diff --git a/Merge.hs b/Merge.hs --- a/Merge.hs +++ b/Merge.hs @@ -21,7 +21,7 @@ import qualified Distribution.Solver.Types.SourcePackage as CabalInstall import qualified Distribution.Solver.Types.PackageIndex as CabalInstall -import Distribution.Text (display) +import Distribution.Pretty (prettyShow) import Distribution.Verbosity import Distribution.Simple.Utils @@ -39,7 +39,8 @@ , listDirectory ) import System.Process (system) -import System.FilePath ((), isExtensionOf) +import System.FilePath (()) +import qualified System.FilePath as SF import System.Exit import qualified Cabal2Ebuild as C2E @@ -80,12 +81,13 @@ [pkg] -> return pkg _ -> Left (ArgumentError ("Too many arguments: " ++ unwords args)) case Portage.parseFriendlyPackage packageString of - Just v@(_,_,Nothing) -> return v + Right v@(_,_,Nothing) -> return v -- we only allow versions we can convert into cabal versions - Just v@(_,_,Just (Portage.Version _ Nothing [] 0)) -> return v - _ -> Left (ArgumentError ("Could not parse [category/]package[-version]: " ++ packageString)) - - + Right v@(_,_,Just (Portage.Version _ Nothing [] 0)) -> return v + Left e -> Left $ ArgumentError $ "Could not parse [category/]package[-version]: " + ++ packageString ++ "\nParsec error: " ++ e + _ -> Left $ ArgumentError $ "Could not parse [category/]package[-version]: " + ++ packageString -- | Given a list of available packages, and maybe a preferred version, -- return the available package with that version. Latest version is chosen @@ -129,7 +131,7 @@ notice verbosity $ "Ambiguous names: " ++ L.intercalate ", " names forM_ pkgs $ \ps -> do let p_name = (cabal_pkg_to_pn . L.head) ps - notice verbosity $ p_name ++ ": " ++ (L.intercalate ", " $ map (display . Cabal.pkgVersion . CabalInstall.packageInfoId) ps) + notice verbosity $ p_name ++ ": " ++ (L.intercalate ", " $ map (prettyShow . Cabal.pkgVersion . CabalInstall.packageInfoId) ps) return $ concat pkgs -- select a single package taking into account the user specified version @@ -138,7 +140,7 @@ Nothing -> do putStrLn "No such version for that package, available versions:" forM_ availablePkgs $ \ avail -> - putStrLn (display . CabalInstall.packageInfoId $ avail) + putStrLn (prettyShow . CabalInstall.packageInfoId $ avail) throwEx (ArgumentError "no such version for that package") Just avail -> return avail @@ -147,7 +149,7 @@ forM_ availablePkgs $ \ avail -> do let match_text | CabalInstall.packageInfoId avail == CabalInstall.packageInfoId selectedPkg = "* " | otherwise = "- " - info verbosity $ match_text ++ (display . CabalInstall.packageInfoId $ avail) + info verbosity $ match_text ++ (prettyShow . CabalInstall.packageInfoId $ avail) let cabal_pkgId = CabalInstall.packageInfoId selectedPkg norm_pkgName = Cabal.packageName (Portage.normalizeCabalPackageId cabal_pkgId) @@ -171,10 +173,7 @@ exitSuccess -- | Maybe return a PackageId of the next highest version for a given --- package, relative to the provided PackageId of the new version. --- We achieve this by mapping Portage.filePathToPackageId over the --- provided package directory, whose contents are filtered for files --- with the '.ebuild' file extension +-- package, relative to the provided PackageId. getPreviousPackageId :: [FilePath] -- ^ list of ebuilds for given package -> Portage.PackageId -- ^ new PackageId -> Maybe Portage.PackageId -- ^ maybe PackageId of previous version @@ -182,8 +181,8 @@ let pkgIds = reverse . L.sortOn (Portage.pkgVersion) . filter ( filter (\fp -> ".ebuild" `isExtensionOf` fp) pkgDir + $ mapMaybe (Portage.filePathToPackageId (Portage.category . Portage.packageId $ newPkgId)) + $ SF.dropExtension <$> filter (\fp -> SF.takeExtension fp == ".ebuild") pkgDir case pkgIds of x:_ -> Just x _ -> Nothing @@ -253,8 +252,8 @@ debug verbosity "searching for minimal suitable ghc version" (compiler_info, ghc_packages, pkgDesc0, _flags, pix) <- case GHCCore.minimumGHCVersionToBuildPackage pkgGenericDesc (Cabal.mkFlagAssignment user_specified_fas) of Just v -> return v - Nothing -> let pn = display merged_cabal_pkg_name - cn = display cat + Nothing -> let pn = prettyShow merged_cabal_pkg_name + cn = prettyShow cat in error $ unlines [ "mergeGenericPackageDescription: failed to find suitable GHC for " ++ pn , " You can try to merge the package manually:" , " $ cabal unpack " ++ pn @@ -384,11 +383,11 @@ cabal_to_emerge_dep cabal_pkg = Merge.resolveDependencies overlay cabal_pkg compiler_info ghc_packages merged_cabal_pkg_name debug verbosity $ "buildDepends pkgDesc0 raw: " ++ Cabal.showPackageDescription pkgDesc0 - debug verbosity $ "buildDepends pkgDesc0: " ++ show (map display (Merge.exeAndLibDeps pkgDesc0)) - debug verbosity $ "buildDepends pkgDesc: " ++ show (map display (Merge.buildDepends pkgDesc)) + debug verbosity $ "buildDepends pkgDesc0: " ++ show (map prettyShow (Merge.exeAndLibDeps pkgDesc0)) + debug verbosity $ "buildDepends pkgDesc: " ++ show (map prettyShow (Merge.buildDepends pkgDesc)) - notice verbosity $ "Accepted depends: " ++ show (map display accepted_deps) - notice verbosity $ "Skipped depends: " ++ show (map display skipped_deps) + notice verbosity $ "Accepted depends: " ++ show (map prettyShow accepted_deps) + notice verbosity $ "Skipped depends: " ++ show (map prettyShow skipped_deps) notice verbosity $ "Dead flags: " ++ show (map pp_fa irresolvable_flag_assignments) notice verbosity $ "Dropped flags: " ++ show (map (Cabal.unFlagName.fst) common_fa) notice verbosity $ "Active flags: " ++ show (map Cabal.unFlagName active_flags) @@ -442,7 +441,7 @@ when fetch $ do let cabal_pkgId = Cabal.packageId (Merge.packageDescription pkgDesc) norm_pkgName = Cabal.packageName (Portage.normalizeCabalPackageId cabal_pkgId) - fetchDigestAndCheck verbosity (overlayPath display cat display norm_pkgName) + fetchDigestAndCheck verbosity (overlayPath prettyShow cat prettyShow norm_pkgName) fetchDigestAndCheck :: Verbosity -> FilePath -- ^ directory of ebuild diff --git a/Merge/Dependencies.hs b/Merge/Dependencies.hs --- a/Merge/Dependencies.hs +++ b/Merge/Dependencies.hs @@ -18,7 +18,7 @@ import qualified Distribution.Package as Cabal import qualified Distribution.PackageDescription as Cabal import qualified Distribution.Version as Cabal -import qualified Distribution.Text as Cabal +import qualified Distribution.Pretty as Cabal import qualified Distribution.Types.ExeDependency as Cabal import qualified Distribution.Types.LegacyExeDependency as Cabal import qualified Distribution.Types.PkgconfigDependency as Cabal @@ -219,7 +219,7 @@ C2E.convertDependency overlay (Portage.Category "dev-haskell") (Cabal.Dependency (Cabal.mkPackageName "Cabal") - finalCabalDep) + finalCabalDep (S.singleton Cabal.defaultLibName)) where versionNumbers = Cabal.versionNumbers cabal_version userCabalVersion = Cabal.orLaterVersion (Cabal.specVersion pkg) @@ -389,7 +389,7 @@ legacyBuildToolsDependencies (Cabal.PackageDescription { Cabal.library = lib, Cabal.executables = exes }) = L.nub $ [ case pkg of Just p -> p - Nothing -> trace ("WARNING: Unknown build tool '" ++ Cabal.display exe ++ "'. Check the generated ebuild.") + Nothing -> trace ("WARNING: Unknown build tool '" ++ Cabal.prettyShow exe ++ "'. Check the generated ebuild.") (any_c_p "unknown-build-tool" pn) | exe@(Cabal.LegacyExeDependency pn _range) <- cabalDeps , pkg <- return (lookup pn buildToolsTable) @@ -429,7 +429,7 @@ hackageBuildToolsDependencies :: Portage.Overlay -> Cabal.PackageDescription -> [Portage.Dependency] hackageBuildToolsDependencies overlay (Cabal.PackageDescription { Cabal.library = lib, Cabal.executables = exes }) = haskellDependencies overlay $ L.nub $ - [ Cabal.Dependency pn versionRange + [ Cabal.Dependency pn versionRange $ S.singleton Cabal.defaultLibName | Cabal.ExeDependency pn _component versionRange <- cabalDeps ] where @@ -452,7 +452,7 @@ resolvePkgConfigs overlay cdeps = [ case resolvePkgConfig overlay pkg of Just d -> d - Nothing -> trace ("WARNING: Could not resolve pkg-config: " ++ Cabal.display pkg ++ ". Check generated ebuild.") + Nothing -> trace ("WARNING: Could not resolve pkg-config: " ++ Cabal.prettyShow pkg ++ ". Check generated ebuild.") (any_c_p "unknown-pkg-config" pn) | pkg@(Cabal.PkgconfigDependency cabal_pn _range) <- cdeps , let pn = Cabal.unPkgconfigName cabal_pn diff --git a/Portage/Cabal.hs b/Portage/Cabal.hs --- a/Portage/Cabal.hs +++ b/Portage/Cabal.hs @@ -8,24 +8,24 @@ import qualified Distribution.License as Cabal import qualified Distribution.SPDX.License as SPDX import qualified Distribution.Package as Cabal -import qualified Distribution.Text as Cabal +import qualified Distribution.Pretty as Cabal -- map the cabal license type to the gentoo license string format convertLicense :: SPDX.License -> Either String String convertLicense l = case Cabal.licenseFromSPDX l of -- good ones - Cabal.AGPL mv -> Right $ "AGPL-" ++ (maybe "3" Cabal.display mv) -- almost certainly version 3 - Cabal.GPL mv -> Right $ "GPL-" ++ (maybe "2" Cabal.display mv) -- almost certainly version 2 - Cabal.LGPL mv -> Right $ "LGPL-" ++ (maybe "2.1" Cabal.display mv) -- probably version 2.1 + Cabal.AGPL mv -> Right $ "AGPL-" ++ (maybe "3" Cabal.prettyShow mv) -- almost certainly version 3 + Cabal.GPL mv -> Right $ "GPL-" ++ (maybe "2" Cabal.prettyShow mv) -- almost certainly version 2 + Cabal.LGPL mv -> Right $ "LGPL-" ++ (maybe "2.1" Cabal.prettyShow mv) -- probably version 2.1 Cabal.BSD2 -> Right "BSD-2" Cabal.BSD3 -> Right "BSD" Cabal.BSD4 -> Right "BSD-4" Cabal.PublicDomain -> Right "public-domain" Cabal.MIT -> Right "MIT" - Cabal.Apache mv -> Right $ "Apache-" ++ (maybe "1.1" Cabal.display mv) -- probably version 1.1 + Cabal.Apache mv -> Right $ "Apache-" ++ (maybe "1.1" Cabal.prettyShow mv) -- probably version 1.1 Cabal.ISC -> Right "ISC" - Cabal.MPL v -> Right $ "MPL-" ++ Cabal.display v -- probably version 1.0 + Cabal.MPL v -> Right $ "MPL-" ++ Cabal.prettyShow v -- probably version 1.0 -- bad ones Cabal.AllRightsReserved -> Left "EULA-style licence. Please pick it manually." Cabal.UnknownLicense _ -> Left "license unknown to cabal. Please pick it manually." @@ -34,6 +34,6 @@ partition_depends :: [Cabal.PackageName] -> Cabal.PackageName -> [Cabal.Dependency] -> ([Cabal.Dependency], [Cabal.Dependency]) partition_depends ghc_package_names merged_cabal_pkg_name = L.partition (not . is_internal_depend) - where is_internal_depend (Cabal.Dependency pn _vr) = is_itself || is_ghc_package + where is_internal_depend (Cabal.Dependency pn _vr _lib) = is_itself || is_ghc_package where is_itself = pn == merged_cabal_pkg_name is_ghc_package = pn `elem` ghc_package_names diff --git a/Portage/Dependency/Print.hs b/Portage/Dependency/Print.hs --- a/Portage/Dependency/Print.hs +++ b/Portage/Dependency/Print.hs @@ -11,7 +11,7 @@ import Portage.PackageId -import qualified Distribution.Text as DT +import qualified Distribution.Pretty as DP (Pretty(..)) import qualified Text.PrettyPrint as Disp import Text.PrettyPrint ( vcat, nest, render ) import Text.PrettyPrint as PP ((<>)) @@ -24,13 +24,13 @@ dispSlot (GivenSlot slot) = Disp.text (':' : slot) dispLBound :: PackageName -> LBound -> Disp.Doc -dispLBound pn (StrictLB v) = Disp.char '>' PP.<> DT.disp pn <-> DT.disp v -dispLBound pn (NonstrictLB v) = Disp.text ">=" PP.<> DT.disp pn <-> DT.disp v +dispLBound pn (StrictLB v) = Disp.char '>' PP.<> DP.pretty pn <-> DP.pretty v +dispLBound pn (NonstrictLB v) = Disp.text ">=" PP.<> DP.pretty pn <-> DP.pretty v dispLBound _pn ZeroB = error "unhandled 'dispLBound ZeroB'" dispUBound :: PackageName -> UBound -> Disp.Doc -dispUBound pn (StrictUB v) = Disp.char '<' PP.<> DT.disp pn <-> DT.disp v -dispUBound pn (NonstrictUB v) = Disp.text "<=" PP.<> DT.disp pn <-> DT.disp v +dispUBound pn (StrictUB v) = Disp.char '<' PP.<> DP.pretty pn <-> DP.pretty v +dispUBound pn (NonstrictUB v) = Disp.text "<=" PP.<> DP.pretty pn <-> DP.pretty v dispUBound _pn InfinityB = error "unhandled 'dispUBound Infinity'" dispDAttr :: DAttr -> Disp.Doc @@ -58,7 +58,7 @@ showDepend (DependAtom (Atom pn range dattr)) = case range of -- any version - DRange ZeroB InfinityB -> DT.disp pn PP.<> dispDAttr dattr + DRange ZeroB InfinityB -> DP.pretty pn PP.<> dispDAttr dattr DRange ZeroB ub -> dispUBound pn ub PP.<> dispDAttr dattr DRange lb InfinityB -> dispLBound pn lb PP.<> dispDAttr dattr -- TODO: handle >=foo-0 special case @@ -66,15 +66,15 @@ DRange lb ub -> showDepend (DependAtom (Atom pn (DRange lb InfinityB) dattr)) PP.<> Disp.char ' ' PP.<> showDepend (DependAtom (Atom pn (DRange ZeroB ub) dattr)) - DExact v -> Disp.char '~' PP.<> DT.disp pn <-> DT.disp v { versionRevision = 0 } PP.<> dispDAttr dattr + DExact v -> Disp.char '~' PP.<> DP.pretty pn <-> DP.pretty v { versionRevision = 0 } PP.<> dispDAttr dattr showDepend (DependIfUse u td fd) = valign $ vcat [td_doc, fd_doc] where td_doc | is_empty_dependency td = Disp.empty - | otherwise = DT.disp u PP.<> Disp.char '?' PP.<> sp PP.<> sparens (showDepend td) + | otherwise = DP.pretty u PP.<> Disp.char '?' PP.<> sp PP.<> sparens (showDepend td) fd_doc | is_empty_dependency fd = Disp.empty - | otherwise = Disp.char '!' PP.<> DT.disp u PP.<> Disp.char '?' PP.<> sp PP.<> sparens (showDepend fd) + | otherwise = Disp.char '!' PP.<> DP.pretty u PP.<> Disp.char '?' PP.<> sp PP.<> sparens (showDepend fd) showDepend (DependAnyOf deps) = Disp.text "||" PP.<> sp PP.<> sparens (vcat $ map showDependInAnyOf deps) showDepend (DependAllOf deps) = valign $ vcat $ map showDepend deps diff --git a/Portage/GHCCore.hs b/Portage/GHCCore.hs --- a/Portage/GHCCore.hs +++ b/Portage/GHCCore.hs @@ -21,8 +21,9 @@ import Distribution.Compiler (CompilerId(..), CompilerFlavor(GHC)) import Distribution.System import Distribution.Types.ComponentRequestedSpec (defaultComponentRequestedSpec) +import Distribution.Types.Dependency (depPkgName, depVerRange) -import Distribution.Text +import Distribution.Pretty (prettyShow) import Data.Maybe import Data.List ( nub ) @@ -66,9 +67,9 @@ -- Packages that are not core will always be accepted, packages that are -- core in any ghc must be satisfied by the 'PackageIndex'. dependencySatisfiable :: InstalledPackageIndex -> Cabal.Dependency -> Bool -dependencySatisfiable pindex dep@(Cabal.Dependency pn _rang) +dependencySatisfiable pindex dep@(Cabal.Dependency pn _rang _lib) | Cabal.unPackageName pn == "Win32" = False -- only exists on windows, not in linux - | not . null $ lookupDependency pindex dep = True -- the package index satisfies the dep + | not . null $ lookupDependency pindex (depPkgName dep) (depVerRange dep) = True -- the package index satisfies the dep | packageIsCoreInAnyGHC pn = False -- some other ghcs support the dependency | otherwise = True -- the dep is not related with core packages, accept the dep @@ -88,8 +89,8 @@ _ -> trace (unwords ["accepting dep:" , show_compiler compiler_info ] ) v - show_deps = show . map display - show_compiler (DC.CompilerInfo { DC.compilerInfoId = CompilerId GHC v }) = "ghc-" ++ display v + show_deps = show . map prettyShow + show_compiler (DC.CompilerInfo { DC.compilerInfoId = CompilerId GHC v }) = "ghc-" ++ prettyShow v show_compiler c = show c -- | Given a 'GenericPackageDescription' it returns the miminum GHC version diff --git a/Portage/Overlay.hs b/Portage/Overlay.hs --- a/Portage/Overlay.hs +++ b/Portage/Overlay.hs @@ -16,7 +16,7 @@ import qualified Distribution.Package as Cabal -import Distribution.Text (simpleParse) +import Distribution.Parsec (simpleParsec) import Distribution.Simple.Utils ( comparing, equating ) import Data.List as List @@ -135,14 +135,14 @@ categories entries = [ (category, entries') | Directory dir entries' <- entries - , Just category <- [simpleParse dir] ] + , Just category <- [simpleParsec dir] ] packages :: Portage.Category -> DirectoryTree -> [(Portage.PackageName, DirectoryTree)] packages category entries = [ (Portage.PackageName category name, entries') | Directory dir entries' <- entries - , Just name <- [simpleParse dir] ] + , Just name <- [simpleParsec dir] ] versions :: Portage.PackageName -> DirectoryTree -> [Portage.Version] versions name@(Portage.PackageName (Portage.Category category) _) entries = @@ -151,7 +151,7 @@ , let (baseName, ext) = splitExtension fileName , ext == ".ebuild" , let fullName = category ++ '/' : baseName - , Just (Portage.PackageId name' version) <- [simpleParse fullName] + , Just (Portage.PackageId name' version) <- [simpleParsec fullName] , name == name' ] readOverlay :: DirectoryTree -> [Portage.PackageId] diff --git a/Portage/PackageId.hs b/Portage/PackageId.hs --- a/Portage/PackageId.hs +++ b/Portage/PackageId.hs @@ -18,21 +18,19 @@ cabal_pn_to_PN ) where -import Data.Char - import qualified Distribution.Package as Cabal -import Distribution.Text (Text(..)) -import qualified Distribution.Compat.ReadP as Parse +import Distribution.Parsec (CabalParsing(..), Parsec(..), explicitEitherParsec) +import qualified Distribution.Compat.CharParsing as P import qualified Portage.Version as Portage import qualified Text.PrettyPrint as Disp import Text.PrettyPrint ((<>)) -import qualified Data.Char as Char (isAlphaNum, isSpace, toLower) +import qualified Data.Char as Char (isAlphaNum, toLower) -import Distribution.Text(display) -import System.FilePath ((), dropExtension) +import Distribution.Pretty (Pretty(..), prettyShow) +import System.FilePath (()) #if MIN_VERSION_base(4,11,0) import Prelude hiding ((<>)) @@ -47,47 +45,61 @@ data PackageId = PackageId { packageId :: PackageName, pkgVersion :: Portage.Version } deriving (Eq, Ord, Show, Read) -{- -instance Text PN where - disp (PN n) = Disp.text n - parse = do - ns <- Parse.sepBy1 component (Parse.char '-') - return (PN (concat (intersperse "-" ns))) +instance Pretty Category where + pretty (Category c) = Disp.text c + +instance Parsec Category where + parsec = Category <$> P.munch1 categoryChar where - component = do - cs <- Parse.munch1 Char.isAlphaNum - if all Char.isDigit cs then Parse.pfail else return cs - -- each component must contain an alphabetic character, to avoid - -- ambiguity in identifiers like foo-1 (the 1 is the version number). --} + categoryChar c = Char.isAlphaNum c || c == '-' +instance Pretty PackageName where + pretty (PackageName category name) = + pretty category <> Disp.char '/' <> pretty name + +instance Parsec PackageName where + parsec = do + category <- parsec + _ <- P.char '/' + name <- parsec + return $ PackageName category name + +instance Pretty PackageId where + pretty (PackageId name version) = + pretty name <> Disp.char '-' <> pretty version + +instance Parsec PackageId where + parsec = do + name <- parsec + _ <- P.char '-' + version <- parsec + return $ PackageId name version + packageIdToFilePath :: PackageId -> FilePath packageIdToFilePath (PackageId (PackageName cat pn) version) = - display cat display pn display pn <-> display version <.> "ebuild" + prettyShow cat prettyShow pn prettyShow pn <-> prettyShow version <.> "ebuild" where a <-> b = a ++ '-':b a <.> b = a ++ '.':b --- | Attempt to generate a PackageId from a FilePath. If not, return --- the provided PackageId as-is. -filePathToPackageId :: PackageId -> FilePath -> PackageId -filePathToPackageId pkgId fp = do - -- take package name from provided FilePath - let pn = take (length - $ Cabal.unPackageName . cabalPkgName . packageId - $ pkgId) fp - -- drop .ebuild file extension - p = dropExtension fp - -- drop package name and the following dash - v = drop ((length pn) +1) p - c = unCategory . category . packageId $ pkgId - -- parse and extract version - parsed_v = case parseVersion v of - Just (Just my_v) -> my_v - _ -> pkgVersion pkgId - -- Construct PackageId - PackageId (mkPackageName c pn) parsed_v - +-- TODO: fix the parser such that it can tolerate malformed package strings, +-- strings with ".ebuild" extensions and strings which are not in fact package +-- strings at all (e.g. metadata.xml). Then we can eliminate the string manipulation +-- present in Merge.getPreviousPackageId, which ensures this function is only fed +-- well-formed package strings, i.e -. +-- | Maybe generate a PackageId from a FilePath. +filePathToPackageId :: Category -> FilePath -> Maybe PackageId +filePathToPackageId cat fp = + case explicitEitherParsec parser fp of + Right x -> Just x + _ -> Nothing + where + parser = do + pn <- parseCabalPackageName + _ <- P.char '-' + v <- parsec + return $ PackageId (PackageName cat pn) v + mkPackageName :: String -> String -> PackageName mkPackageName cat package = PackageName (Category cat) (Cabal.mkPackageName package) @@ -109,64 +121,33 @@ fmap (Cabal.PackageIdentifier name) (Portage.toCabalVersion version) -instance Text Category where - disp (Category c) = Disp.text c - parse = fmap Category (Parse.munch1 categoryChar) - where - categoryChar c = Char.isAlphaNum c || c == '-' - -instance Text PackageName where - disp (PackageName category name) = - disp category <> Disp.char '/' <> disp name - - parse = do - category <- parse - _ <- Parse.char '/' - name <- parse - return (PackageName category name) - -instance Text PackageId where - disp (PackageId name version) = - disp name <> Disp.char '-' <> disp version - - parse = do - name <- parse - _ <- Parse.char '-' - version <- parse - return (PackageId name version) - -parseFriendlyPackage :: String -> Maybe (Maybe Category, Cabal.PackageName, Maybe Portage.Version) -parseFriendlyPackage str = - case [ p | (p,s) <- Parse.readP_to_S parser str - , all Char.isSpace s ] of - [] -> Nothing - (x:_) -> Just x +parseFriendlyPackage :: String -> Either String (Maybe Category, Cabal.PackageName, Maybe Portage.Version) +parseFriendlyPackage str = explicitEitherParsec parser str where parser = do - mc <- Parse.option Nothing $ do - c <- parse - _ <- Parse.char '/' - return (Just c) - p <- parse - mv <- Parse.option Nothing $ do - _ <- Parse.char '-' - v <- parse - return (Just v) + mc <- P.optional . P.try $ do + c <- parsec + _ <- P.char '/' + return c + p <- parseCabalPackageName + mv <- P.optional $ do + _ <- P.char '-' + v <- parsec + return v return (mc, p, mv) --- | Parse a String in the form of a Portage version -parseVersion :: FilePath -> Maybe (Maybe Portage.Version) -parseVersion str = - case [ p | (p,s) <- Parse.readP_to_S parser str - , all Char.isSpace s ] of - [] -> Nothing - (x:_) -> Just x - where - parser = do - mv <- Parse.option Nothing $ do - v <- parse - return (Just v) - return mv - +-- | Parse a Cabal PackageName. Note that we cannot use the @parsec@ +-- method as defined in the @Parsec PackageName@ instance, since it +-- fails the entire PackageName parse if it tries to parse a version +-- number. +parseCabalPackageName :: CabalParsing m => m Cabal.PackageName +parseCabalPackageName = do + pn <- P.some . P.try $ + P.choice + [ P.alphaNum + , P.char '-' <* P.notFollowedBy (P.some P.digit <* P.notFollowedBy P.letter) + ] + return $ Cabal.mkPackageName pn + cabal_pn_to_PN :: Cabal.PackageName -> String -cabal_pn_to_PN = map toLower . display +cabal_pn_to_PN = map Char.toLower . prettyShow diff --git a/Portage/Resolve.hs b/Portage/Resolve.hs --- a/Portage/Resolve.hs +++ b/Portage/Resolve.hs @@ -10,7 +10,7 @@ import qualified Portage.PackageId as Portage import Distribution.Verbosity -import Distribution.Text (display) +import Distribution.Pretty (prettyShow) import qualified Distribution.Package as Cabal import Distribution.Simple.Utils @@ -31,10 +31,10 @@ return devhaskell [cat] -> do info verbosity $ "Exact match of already existing package, using category: " - ++ display cat + ++ prettyShow cat return cat cats -> do - warn verbosity $ "Multiple matches of categories: " ++ unwords (map display cats) + warn verbosity $ "Multiple matches of categories: " ++ unwords (map prettyShow cats) if devhaskell `elem` cats then do notice verbosity "Defaulting to dev-haskell" return devhaskell diff --git a/Portage/Use.hs b/Portage/Use.hs --- a/Portage/Use.hs +++ b/Portage/Use.hs @@ -13,7 +13,7 @@ import qualified Text.PrettyPrint as Disp import Text.PrettyPrint ((<>)) -import qualified Distribution.Text as DT +import Distribution.Pretty (Pretty(..)) #if MIN_VERSION_base(4,11,0) import Prelude hiding ((<>)) @@ -27,6 +27,9 @@ | N UseFlag -- ^ - modificator deriving (Eq,Show,Ord,Read) +instance Pretty UseFlag where + pretty = showModificator + mkUse :: Use -> UseFlag mkUse = UseFlag @@ -36,31 +39,26 @@ mkQUse :: Use -> UseFlag mkQUse = Q . UseFlag -instance DT.Text UseFlag where - disp = showModificator - parse = error "instance DT.Text UseFlag: not implemented" - showModificator :: UseFlag -> Disp.Doc -showModificator (UseFlag u) = DT.disp u -showModificator (X u) = Disp.char '!' <> DT.disp u -showModificator (Q u) = DT.disp u <> Disp.char '?' -showModificator (E u) = DT.disp u <> Disp.char '=' -showModificator (N u) = Disp.char '-' <> DT.disp u +showModificator (UseFlag u) = pretty u +showModificator (X u) = Disp.char '!' <> pretty u +showModificator (Q u) = pretty u <> Disp.char '?' +showModificator (E u) = pretty u <> Disp.char '=' +showModificator (N u) = Disp.char '-' <> pretty u dispUses :: [UseFlag] -> Disp.Doc dispUses [] = Disp.empty -dispUses us = Disp.brackets $ Disp.hcat $ (Disp.punctuate (Disp.text ", ")) $ map DT.disp us +dispUses us = Disp.brackets $ Disp.hcat $ (Disp.punctuate (Disp.text ", ")) $ map pretty us newtype Use = Use String deriving (Eq, Read, Show) +instance Pretty Use where + pretty (Use u) = Disp.text u + instance Ord Use where compare (Use a) (Use b) = case (a,b) of ("test", "test") -> EQ ("test", _) -> LT (_, "test") -> GT (_, _) -> a `compare` b - -instance DT.Text Use where - disp (Use u) = Disp.text u - parse = error "instance DT.Text Use: not implemented" diff --git a/Portage/Version.hs b/Portage/Version.hs --- a/Portage/Version.hs +++ b/Portage/Version.hs @@ -21,9 +21,10 @@ import qualified Distribution.Version as Cabal -import Distribution.Text (Text(..)) +import Distribution.Pretty (Pretty(..)) -import qualified Distribution.Compat.ReadP as Parse +import Distribution.Parsec (Parsec(..)) +import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp import Text.PrettyPrint ((<>)) import qualified Data.Char as Char (isAlpha, isDigit) @@ -39,6 +40,24 @@ } deriving (Eq, Ord, Show, Read) +instance Pretty Version where + pretty (Version ver c suf rev) = + dispVer ver <> dispC c <> dispSuf suf <> dispRev rev + where + dispVer = Disp.hcat . Disp.punctuate (Disp.char '.') . map Disp.int + dispC = maybe Disp.empty Disp.char + dispSuf = Disp.hcat . map pretty + dispRev 0 = Disp.empty + dispRev n = Disp.text "-r" <> Disp.int n + +instance Parsec Version where + parsec = do + ver <- P.sepBy1 digits (P.char '.') + c <- P.optional $ P.satisfy Char.isAlpha + suf <- P.many parsec + rev <- P.option 0 $ P.string "-r" *> digits + return $ Version ver c suf rev + -- foo-9999* is treated as live ebuild -- Cabal-1.17.9999* as well is_live :: Version -> Bool @@ -55,32 +74,8 @@ data Suffix = Alpha Int | Beta Int | Pre Int | RC Int | P Int deriving (Eq, Ord, Show, Read) -fromCabalVersion :: Cabal.Version -> Version -fromCabalVersion cabal_version = Version (Cabal.versionNumbers cabal_version) Nothing [] 0 - -toCabalVersion :: Version -> Maybe Cabal.Version -toCabalVersion (Version nums Nothing [] _) = Just (Cabal.mkVersion nums) -toCabalVersion _ = Nothing - -instance Text Version where - disp (Version ver c suf rev) = - dispVer ver <> dispC c <> dispSuf suf <> dispRev rev - where - dispVer = Disp.hcat . Disp.punctuate (Disp.char '.') . map Disp.int - dispC = maybe Disp.empty Disp.char - dispSuf = Disp.hcat . map disp - dispRev 0 = Disp.empty - dispRev n = Disp.text "-r" <> Disp.int n - - parse = do - ver <- Parse.sepBy1 digits (Parse.char '.') - c <- Parse.option Nothing (fmap Just (Parse.satisfy Char.isAlpha)) - suf <- Parse.many parse - rev <- Parse.option 0 (Parse.string "-r" >> digits) - return (Version ver c suf rev) - -instance Text Suffix where - disp suf = case suf of +instance Pretty Suffix where + pretty suf = case suf of Alpha n -> Disp.text "_alpha" <> dispPos n Beta n -> Disp.text "_beta" <> dispPos n Pre n -> Disp.text "_pre" <> dispPos n @@ -92,16 +87,24 @@ dispPos 0 = Disp.empty dispPos n = Disp.int n - parse = Parse.char '_' - >> Parse.choice - [ Parse.string "alpha" >> fmap Alpha maybeDigits - , Parse.string "beta" >> fmap Beta maybeDigits - , Parse.string "pre" >> fmap Pre maybeDigits - , Parse.string "rc" >> fmap RC maybeDigits - , Parse.string "p" >> fmap P maybeDigits +instance Parsec Suffix where + parsec = P.char '_' + >> P.choice + [ P.string "alpha" >> fmap Alpha maybeDigits + , P.string "beta" >> fmap Beta maybeDigits + , P.string "pre" >> fmap Pre maybeDigits + , P.string "rc" >> fmap RC maybeDigits + , P.string "p" >> fmap P maybeDigits ] where - maybeDigits = Parse.option 0 digits + maybeDigits = P.option 0 digits -digits :: Parse.ReadP r Int -digits = fmap read (Parse.munch1 Char.isDigit) +fromCabalVersion :: Cabal.Version -> Version +fromCabalVersion cabal_version = Version (Cabal.versionNumbers cabal_version) Nothing [] 0 + +toCabalVersion :: Version -> Maybe Cabal.Version +toCabalVersion (Version nums Nothing [] _) = Just (Cabal.mkVersion nums) +toCabalVersion _ = Nothing + +digits :: P.CharParsing m => m Int +digits = read <$> P.munch1 Char.isDigit diff --git a/Status.hs b/Status.hs --- a/Status.hs +++ b/Status.hs @@ -30,8 +30,9 @@ -- cabal import qualified Distribution.Verbosity as Cabal import qualified Distribution.Package as Cabal (pkgName) -import qualified Distribution.Simple.Utils as Cabal (comparing, die, equating) -import qualified Distribution.Text as Cabal ( display, simpleParse ) +import qualified Distribution.Simple.Utils as Cabal (comparing, die', equating) +import Distribution.Pretty (prettyShow) +import Distribution.Parsec (simpleParsec) import qualified Distribution.Client.GlobalFlags as CabalInstall import qualified Distribution.Client.IndexUtils as CabalInstall @@ -145,8 +146,8 @@ PortagePlusOverlay -> id HackageToOverlay -> fromHackageFilter pkgs' <- forM pkgs $ \p -> - case Cabal.simpleParse p of - Nothing -> Cabal.die ("Could not parse package name: " ++ p ++ ". Format cat/pkg") + case simpleParsec p of + Nothing -> Cabal.die' verbosity ("Could not parse package name: " ++ p ++ ". Format cat/pkg") Just pn -> return pn tree0 <- status verbosity portdir overlaydir repoContext let tree = pkgFilter tree0 @@ -204,10 +205,10 @@ let (PackageName c p) = pkg putStr (bold (show ix)) putStr " " - putStr $ Cabal.display c ++ '/' : bold (Cabal.display p) + putStr $ prettyShow c ++ '/' : bold (prettyShow p) putStr " " forM_ ebuilds $ \e -> do - putStr $ toColor (fmap (Cabal.display . pkgVersion . ebuildId) e) + putStr $ toColor (fmap (prettyShow . pkgVersion . ebuildId) e) putChar ' ' putStrLn "" diff --git a/cabal/.gitattributes b/cabal/.gitattributes new file mode 100644 --- /dev/null +++ b/cabal/.gitattributes @@ -0,0 +1,3 @@ +/Cabal/ChangeLog.md merge=union +/cabal-install/changelog merge=union +/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/script.hs eol=crlf diff --git a/cabal/.github/ISSUE_TEMPLATE/bug_report.md b/cabal/.github/ISSUE_TEMPLATE/bug_report.md new file mode 100644 --- /dev/null +++ b/cabal/.github/ISSUE_TEMPLATE/bug_report.md @@ -0,0 +1,30 @@ +--- +name: Bug report +about: Create a report to help us improve +title: '' +labels: '' +assignees: '' + +--- + +**Describe the bug** +A clear and concise description of what the bug is. + +**To Reproduce** +Steps to reproduce the behavior: + +``` +$ cabal v2-build ... +``` + +Please use version-prefixed commands (e.g. `v2-build` or `v1-build`) to avoid ambiguity. + +**Expected behavior** +A clear and concise description of what you expected to happen. + +**System informataion** + - Operating system + - `cabal`, `ghc` versions + +**Additional context** +Add any other context about the problem here. diff --git a/cabal/.github/PULL_REQUEST_TEMPLATE.md b/cabal/.github/PULL_REQUEST_TEMPLATE.md --- a/cabal/.github/PULL_REQUEST_TEMPLATE.md +++ b/cabal/.github/PULL_REQUEST_TEMPLATE.md @@ -1,7 +1,8 @@ + --- Please include the following checklist in your PR: -* [ ] Patches conform to the [coding conventions](https://github.com/haskell/cabal/#conventions). +* [ ] Patches conform to the [coding conventions](https://github.com/haskell/cabal/blob/master/CONTRIBUTING.md#conventions). * [ ] Any changes that could be relevant to users have been recorded in the changelog. * [ ] The documentation has been updated, if necessary. * [ ] If the change is docs-only, `[ci skip]` is used to avoid triggering the build bots. diff --git a/cabal/.gitignore b/cabal/.gitignore --- a/cabal/.gitignore +++ b/cabal/.gitignore @@ -17,6 +17,7 @@ cabal-tests.log /Cabal/dist/ +/Cabal/.python-sphinx-virtualenv/ /Cabal/tests/Setup /Cabal/Setup /Cabal/source-file-list diff --git a/cabal/.mailmap b/cabal/.mailmap --- a/cabal/.mailmap +++ b/cabal/.mailmap @@ -6,12 +6,14 @@ Adam Langley Alex Biehl +Alex Biehl Alex Biehl Alexander Biehl Alex Biehl alexbiehl Alex Washburn Alex Washburn recursion-ninja Alistair Bailey alistair Alson Kemp alson +Andreas Klebinger klebinger.andreas@gmx.at Andres Löh Andres Löh Andres Löh @@ -43,6 +45,7 @@ David Waern David Waern Dennis Gosnell Dmitry Kovanikov ChShersh +Domen Kožar Don Stewart Duncan Coutts Duncan Coutts @@ -56,7 +59,8 @@ Einar Karttunen Federico Mastellone Felix Yan Felix Yan -Francesco Gazzetta +Francesco Gazzetta +Francesco Gazzetta Ganesh Sittampalam Geoff Nixon Gershom Bazerman @@ -120,6 +124,8 @@ Neil Mitchell Neil Mitchell Niklas Broberg Niklas Broberg +Nikolai Obedin +Nikolai Obedin # 3c1502bb633b61ae4d24d40898fca66d7f169679 Peter Higley Peter Simons Peter Trško Peter Trsko @@ -154,3 +160,4 @@ ghthrowaway7 <41365123+ghthrowaway7@users.noreply.github.com> # Goes by that name online quasicomputational # Goes by that name online vedksah <31156362+vedksah@users.noreply.github.com> # Goes by that name online +! diff --git a/cabal/.travis.yml b/cabal/.travis.yml --- a/cabal/.travis.yml +++ b/cabal/.travis.yml @@ -13,6 +13,7 @@ branches: only: - master + - "3.0" - "2.4" - "2.2" - "2.0" @@ -58,9 +59,12 @@ - env: GHCVER=8.4.4 SCRIPT=script USE_GOLD=YES DEPLOY_DOCS=YES os: linux sudo: required - - env: GHCVER=8.6.2 SCRIPT=script USE_GOLD=YES + - env: GHCVER=8.6.4 SCRIPT=script USE_GOLD=YES os: linux sudo: required + #- env: GHCVER=8.8.1 SCRIPT=script USE_GOLD=YES + # os: linux + # sudo: required - env: GHCVER=8.4.4 SCRIPT=solver-debug-flags USE_GOLD=YES sudo: required @@ -92,13 +96,17 @@ - env: GHCVER=8.0.2 SCRIPT=bootstrap os: osx - - env: GHCVER=via-stack SCRIPT=stack STACK_CONFIG=stack.yaml - os: linux - + # It's been long known that CI with + # Stack does not work so it's disabled until further notice + # to reduce latency and avoid wasting CI slots for no reason. + # + #- env: GHCVER=via-stack SCRIPT=stack STACK_CONFIG=stack.yaml + # os: linux + # # See https://github.com/haskell/cabal/pull/4667#issuecomment-321036564 # for why failures are allowed. - allow_failures: - - env: GHCVER=via-stack SCRIPT=stack STACK_CONFIG=stack.yaml + # allow_failures: + # - env: GHCVER=via-stack SCRIPT=stack STACK_CONFIG=stack.yaml # TODO add PARSEC_BUNDLED=YES when it's so # It seems pointless to run head if we're going to ignore the results. @@ -112,7 +120,6 @@ - export PATH=$HOME/.cabal/bin:$PATH - export PATH=$HOME/.local/bin:$PATH - export PATH=/opt/cabal/2.4/bin:$PATH - - export PATH=/opt/alex/3.1.7/bin:$PATH - if [ "$USE_GOLD" = "YES" ]; then sudo update-alternatives --install "/usr/bin/ld" "ld" "/usr/bin/ld.gold" 20; fi - if [ "$USE_GOLD" = "YES" ]; then sudo update-alternatives --install "/usr/bin/ld" "ld" "/usr/bin/ld.bfd" 10; fi - ld -v diff --git a/cabal/AUTHORS b/cabal/AUTHORS --- a/cabal/AUTHORS +++ b/cabal/AUTHORS @@ -20,6 +20,7 @@ Amir Mohammad Saied Anders Kaseorg Andrea Vezzosi +Andreas Klebinger Andres Löh Andrzej Rybczak Andrés Sicard-Ramírez @@ -55,6 +56,7 @@ Bryan O'Sullivan Bryan Richter Carter Tazio Schonwald +Chaitanya Koparkar Chang Yang Jiao Chris Allen Chris Wong @@ -85,6 +87,7 @@ Dino Morelli Dmitry Astapov Dmitry Kovanikov +Domen Kožar Dominic Steinitz Don Stewart Doug Beardsley @@ -107,7 +110,7 @@ Felix Yan Florian Hartwig Francesco Ariis -Francesco Gazzetta +Francesco Gazzetta Franz Thoma Fujimura Daisuke Gabor Greif @@ -142,6 +145,7 @@ Jacco Krijnen Jack Henahan Jake Wheat +Jan Path Jason Dagit Jean-Philippe Bernardy Jens Petersen @@ -163,6 +167,7 @@ Jookia <166291@gmail.com> Josef Svenningsson Josh Hoyt +Josh Kalderimis Judah Jacobson Jürgen Nicklisch-Franken Karel Gardas @@ -176,6 +181,7 @@ Lennart Kolmodin Lennart Spitzner Leon Isenberg +Leon Schoorl Leonid Onokhov Li-yao Xia Liyang HU @@ -193,6 +199,7 @@ Martin Vlk Masahiro Yamauchi Mathieu Boespflug +Matt Renaud Matthew William Cox Matthias Fischmann Matthias Kilian @@ -223,6 +230,7 @@ Nikita Karetnikov Niklas Broberg Niklas Hambüchen +Nikolai Obedin Oleg Grenrus Oleksandr Manzyuk Omar Mefire @@ -299,6 +307,7 @@ Tomas Vestelind Toshio Ito Travis Cardwell +Travis Whitaker Tuncer Ayaz Vaibhav Sagar Veronika Romashkina @@ -309,6 +318,7 @@ Yitzchak Gale Yuras Shumovich Yuriy Syrovetskiy +Zejun Wu capsjac ghthrowaway7 <41365123+ghthrowaway7@users.noreply.github.com> quasicomputational diff --git a/cabal/CONTRIBUTING.md b/cabal/CONTRIBUTING.md new file mode 100644 --- /dev/null +++ b/cabal/CONTRIBUTING.md @@ -0,0 +1,254 @@ +# Contributing to Cabal + +Building Cabal for hacking +-------------------------- + +The current recommended way of developing Cabal is to use the +`new-build` feature which [shipped in cabal-install-1.24](http://blog.ezyang.com/2016/05/announcing-cabal-new-build-nix-style-local-builds/). Assuming +that you have a sufficiently recent cabal-install (see above), +it is sufficient to run: + +~~~~ +cabal new-build cabal +~~~~ + +To build a local, development copy of cabal-install. The location +of your build products will vary depending on which version of +cabal-install you use to build; see the documentation section +[Where are my build products?](http://cabal.readthedocs.io/en/latest/nix-local-build.html#where-are-my-build-products) +to find the binary (or just run `find -type f -executable -name cabal`). + +Here are some other useful variations on the commands: + +~~~~ +cabal new-build Cabal # build library only +cabal new-build Cabal:unit-tests # build Cabal's unit test suite +cabal new-build cabal-tests # etc... +~~~~ + +**Dogfooding HEAD.** +Many of the core developers of Cabal dogfood `cabal-install` HEAD +when doing development on Cabal. This helps us identify bugs +which were missed by the test suite and easily experiment with new +features. + +The recommended workflow in this case is slightly different: you will +maintain two Cabal source trees: your production tree (built with a +released version of Cabal) which always tracks `master` and which you +update only when you want to move to a new version of Cabal to dogfood, +and your development tree (built with your production Cabal) that you +actually do development on. + +In more detail, suppose you have checkouts of Cabal at `~/cabal-prod` +and `~/cabal-dev`, and you have a release copy of cabal installed at +`/opt/cabal/2.4/bin/cabal`. First, build your production tree: + +~~~~ +cd ~/cabal-prod +/opt/cabal/2.4/bin/cabal new-build cabal +~~~~ + +This will produce a cabal binary (see also: [Where are my build products?](http://cabal.readthedocs.io/en/latest/nix-local-build.html#where-are-my-build-products) +). Add this binary to your PATH, +and then use it to build your development copy: + +~~~~ +cd ~/cabal-dev +cabal new-build cabal +~~~~ + +Running tests +------------- + +**Using Travis and AppVeyor.** +If you are not in a hurry, the most convenient way to run tests on Cabal +is to make a branch on GitHub and then open a pull request; our +continuous integration service on Travis and AppVeyor will build and +test your code. Title your PR with WIP so we know that it does not need +code review. + +Some tips for using Travis effectively: + +* Travis builds take a long time. Use them when you are pretty + sure everything is OK; otherwise, try to run relevant tests locally + first. + +* Watch over your jobs on the [Travis website](http://travis-ci.org). + If you know a build of yours is going to fail (because one job has + already failed), be nice to others and cancel the rest of the jobs, + so that other commits on the build queue can be processed. + +* If you want realtime notification when builds of your PRs finish, we have a [Slack team](https://haskell-cabal.slack.com/). To get issued an invite, fill in your email at [this sign up page](https://haskell-cabal.herokuapp.com). + +**How to debug a failing CI test.** +One of the annoying things about running tests on CI is when they +fail, there is often no easy way to further troubleshoot the broken +build. Here are some guidelines for debugging continuous integration +failures: + +1. Can you tell what the problem is by looking at the logs? The + `cabal-testsuite` tests run with `-v` logging by default, which + is dumped to the log upon failure; you may be able to figure out + what the problem is directly this way. + +2. Can you reproduce the problem by running the test locally? + See the next section for how to run the various test suites + on your local machine. + +3. Is the test failing only for a specific version of GHC, or + a specific operating system? If so, try reproducing the + problem on the specific configuration. + +4. Is the test failing on a Travis per-GHC build + ([for example](https://travis-ci.org/haskell-pushbot/cabal-binaries/builds/208128401))? + In this case, if you click on "Branch", you can get access to + the precise binaries that were built by Travis that are being + tested. If you have an Ubuntu system, you can download + the binaries and run them directly. + +5. Is the test failing on AppVeyor? Consider logging in via + Remote Desktop to the build VM: + https://www.appveyor.com/docs/how-to/rdp-to-build-worker/ + +If none of these let you reproduce, there might be some race condition +or continuous integration breakage; please file a bug. + +**Running tests locally.** +To run tests locally with `new-build`, you will need to know the +name of the test suite you want. Cabal and cabal-install have +several. Also, you'll want to read [Where are my build products?](http://cabal.readthedocs.io/en/latest/nix-local-build.html#where-are-my-build-products) + +The most important test suite is `cabal-testsuite`: most user-visible +changes to Cabal should come with a test in this framework. See +[cabal-testsuite/README.md](cabal-testsuite/README.md) for more +information about how to run tests and write new ones. Quick +start: use `cabal-tests` to run `Cabal` tests, and `cabal-tests +--with-cabal=/path/to/cabal` to run `cabal-install` tests +(don't forget `--with-cabal`! Your cabal-install tests won't +run without it). + +There are also other test suites: + +* `Cabal:unit-tests` are small, quick-running unit tests + on small pieces of functionality in Cabal. If you are working + on some utility functions in the Cabal library you should run this + test suite. + +* `cabal-install:unit-tests` are small, quick-running unit tests on + small pieces of functionality in cabal-install. If you are working + on some utility functions in cabal-install you should run this test + suite. + +* `cabal-install:solver-quickcheck` are QuickCheck tests on + cabal-install's dependency solver. If you are working + on the solver you should run this test suite. + +* `cabal-install:integration-tests2` are integration tests on some + top-level API functions inside the `cabal-install` source code. + +For these test executables, `-p` which applies a regex filter to the test +names. + +Conventions +----------- + +* Spaces, not tabs. + +* Try to follow style conventions of a file you are modifying, and + avoid gratuitous reformatting (it makes merges harder!) + +* Format your commit messages [in the standard way](https://chris.beams.io/posts/git-commit/#seven-rules). + +* A lot of Cabal does not have top-level comments. We are trying to + fix this. If you add new top-level definitions, please Haddock them; + and if you spend some time understanding what a function does, help + us out and add a comment. We'll try to remind you during code review. + +* If you do something tricky or non-obvious, add a comment. + +* If your commit only touches comments, you can use `[ci skip]` + anywhere in the body of the commit message to avoid needlessly + triggering the build bots. + +* For local imports (Cabal module importing Cabal module), import lists + are NOT required (although you may use them at your discretion.) For + third-party and standard library imports, please use either qualified imports + or explicit import lists. + +* You can use basically any GHC extension supported by a GHC in our + support window, except Template Haskell, which would cause + bootstrapping problems in the GHC compilation process. + +* Our GHC support window is five years for the Cabal library and three + years for cabal-install: that is, the Cabal library must be + buildable out-of-the-box with the dependencies that shipped with GHC + for at least five years. The Travis CI checks this, so most + developers submit a PR to see if their code works on all these + versions of GHC. `cabal-install` must also be buildable on all + supported GHCs, although it does not have to be buildable + out-of-the-box. Instead, the `cabal-install/bootstrap.sh` script + must be able to download and install all of the dependencies (this + is also checked by CI). Also, self-upgrade to the latest version + (i.e. `cabal install cabal-install`) must work with all versions of + `cabal-install` released during the last three years. + +* `Cabal` has its own Prelude, in `Distribution.Compat.Prelude`, + that provides a compatibility layer and exports some commonly + used additional functions. Use it in all new modules. + +* As far as possible, please do not use CPP. If you must use it, + try to put it in a `Compat` module, and minimize the amount of code + that is enclosed by CPP. For example, prefer: + ``` + f :: Int -> Int + #ifdef mingw32_HOST_OS + f = (+1) + #else + f = (+2) + #endif + ``` + + over: + ``` + #ifdef mingw32_HOST_OS + f :: Int -> Int + f = (+1) + #else + f :: Int -> Int + f = (+2) + #endif + ``` + +We like [this style guide][guide]. + +[guide]: https://github.com/tibbe/haskell-style-guide/blob/master/haskell-style.md + +Communicating +------------- + +There are a few main venues of communication: + +* Most developers subscribe to receive messages from [all issues](https://github.com/haskell/cabal/issues); issues can be used to [open discussion](https://github.com/haskell/cabal/issues?q=is%3Aissue+is%3Aopen+custom+label%3A%22type%3A+discussion%22). If you know someone who should hear about a message, CC them explicitly using the @username GitHub syntax. + +* For more organizational concerns, the [mailing + list](http://www.haskell.org/mailman/listinfo/cabal-devel) is used. + +* Many developers idle on `#hackage` on `irc.freenode.net` ([archives](http://ircbrowse.net/browse/hackage)). `#ghc` ([archives](http://ircbrowse.net/browse/ghc)) is also a decently good bet. + +Releases +-------- + +Notes for how to make a release are at the +wiki page ["Making a release"](https://github.com/haskell/cabal/wiki/Making-a-release). +Currently, @23Skidoo, @rthomas, @tibbe and @dcoutts have access to +`haskell.org/cabal`, and @davean is the point of contact for getting +permissions. + +API Documentation +----------------- + +Auto-generated API documentation for the `master` branch of Cabal is automatically uploaded here: http://haskell.github.io/cabal-website/doc/html/Cabal/. + +## Issue triage [![Open Source Helpers](https://www.codetriage.com/haskell/cabal/badges/users.svg)](https://www.codetriage.com/haskell/cabal) + +You can contribute by triaging issues which may include reproducing bug reports or asking for vital information, such as version numbers or reproduction instructions. If you would like to start triaging issues, one easy way to get started is to [subscribe to cabal on CodeTriage](https://www.codetriage.com/haskell/cabal). diff --git a/cabal/Cabal/Cabal.cabal b/cabal/Cabal/Cabal.cabal --- a/cabal/Cabal/Cabal.cabal +++ b/cabal/Cabal/Cabal.cabal @@ -1,6 +1,7 @@ +cabal-version: >=1.10 name: Cabal -version: 2.4.1.0 -copyright: 2003-2018, Cabal Development Team (see AUTHORS file) +version: 3.1.0.0 +copyright: 2003-2019, Cabal Development Team (see AUTHORS file) license: BSD3 license-file: LICENSE author: Cabal Development Team @@ -16,7 +17,6 @@ The Haskell Cabal is part of a larger infrastructure for distributing, organizing, and cataloging Haskell libraries and tools. category: Distribution -cabal-version: >=1.10 build-type: Simple -- If we use a new Cabal feature, this needs to be changed to Custom so -- we can bootstrap. @@ -33,6 +33,8 @@ -- Generated with 'make gen-extra-source-files' -- Do NOT edit this section manually; instead, run the script. -- BEGIN gen-extra-source-files + tests/ParserTests/errors/MiniAgda.cabal + tests/ParserTests/errors/MiniAgda.errors tests/ParserTests/errors/common1.cabal tests/ParserTests/errors/common1.errors tests/ParserTests/errors/common2.cabal @@ -49,20 +51,48 @@ tests/ParserTests/errors/issue-5055-2.errors tests/ParserTests/errors/issue-5055.cabal tests/ParserTests/errors/issue-5055.errors + tests/ParserTests/errors/leading-comma-2.cabal + tests/ParserTests/errors/leading-comma-2.errors + tests/ParserTests/errors/leading-comma-2b.cabal + tests/ParserTests/errors/leading-comma-2b.errors + tests/ParserTests/errors/leading-comma-2c.cabal + tests/ParserTests/errors/leading-comma-2c.errors tests/ParserTests/errors/leading-comma.cabal tests/ParserTests/errors/leading-comma.errors + tests/ParserTests/errors/libpq1.cabal + tests/ParserTests/errors/libpq1.errors + tests/ParserTests/errors/libpq2.cabal + tests/ParserTests/errors/libpq2.errors + tests/ParserTests/errors/mixin-1.cabal + tests/ParserTests/errors/mixin-1.errors + tests/ParserTests/errors/mixin-2.cabal + tests/ParserTests/errors/mixin-2.errors + tests/ParserTests/errors/multiple-libs.cabal + tests/ParserTests/errors/multiple-libs.errors tests/ParserTests/errors/noVersion.cabal tests/ParserTests/errors/noVersion.errors tests/ParserTests/errors/noVersion2.cabal tests/ParserTests/errors/noVersion2.errors tests/ParserTests/errors/range-ge-wild.cabal tests/ParserTests/errors/range-ge-wild.errors + tests/ParserTests/errors/removed-fields.cabal + tests/ParserTests/errors/removed-fields.errors tests/ParserTests/errors/spdx-1.cabal tests/ParserTests/errors/spdx-1.errors tests/ParserTests/errors/spdx-2.cabal tests/ParserTests/errors/spdx-2.errors tests/ParserTests/errors/spdx-3.cabal tests/ParserTests/errors/spdx-3.errors + tests/ParserTests/errors/undefined-flag.cabal + tests/ParserTests/errors/undefined-flag.errors + tests/ParserTests/errors/version-sets-1.cabal + tests/ParserTests/errors/version-sets-1.errors + tests/ParserTests/errors/version-sets-2.cabal + tests/ParserTests/errors/version-sets-2.errors + tests/ParserTests/errors/version-sets-3.cabal + tests/ParserTests/errors/version-sets-3.errors + tests/ParserTests/errors/version-sets-4.cabal + tests/ParserTests/errors/version-sets-4.errors tests/ParserTests/ipi/Includes2.cabal tests/ParserTests/ipi/Includes2.expr tests/ParserTests/ipi/Includes2.format @@ -75,8 +105,6 @@ tests/ParserTests/ipi/transformers.cabal tests/ParserTests/ipi/transformers.expr tests/ParserTests/ipi/transformers.format - tests/ParserTests/regressions/MiniAgda.cabal - tests/ParserTests/regressions/MiniAgda.check tests/ParserTests/regressions/Octree-0.5.cabal tests/ParserTests/regressions/Octree-0.5.expr tests/ParserTests/regressions/Octree-0.5.format @@ -84,12 +112,18 @@ tests/ParserTests/regressions/bad-glob-syntax.check tests/ParserTests/regressions/cc-options-with-optimization.cabal tests/ParserTests/regressions/cc-options-with-optimization.check + tests/ParserTests/regressions/common-conditional.cabal + tests/ParserTests/regressions/common-conditional.expr + tests/ParserTests/regressions/common-conditional.format tests/ParserTests/regressions/common.cabal tests/ParserTests/regressions/common.expr tests/ParserTests/regressions/common.format tests/ParserTests/regressions/common2.cabal tests/ParserTests/regressions/common2.expr tests/ParserTests/regressions/common2.format + tests/ParserTests/regressions/common3.cabal + tests/ParserTests/regressions/common3.expr + tests/ParserTests/regressions/common3.format tests/ParserTests/regressions/cxx-options-with-optimization.cabal tests/ParserTests/regressions/cxx-options-with-optimization.check tests/ParserTests/regressions/elif.cabal @@ -110,6 +144,18 @@ tests/ParserTests/regressions/ghc-option-j.check tests/ParserTests/regressions/haddock-api-2.18.1-check.cabal tests/ParserTests/regressions/haddock-api-2.18.1-check.check + tests/ParserTests/regressions/hidden-main-lib.cabal + tests/ParserTests/regressions/hidden-main-lib.expr + tests/ParserTests/regressions/hidden-main-lib.format + tests/ParserTests/regressions/indentation.cabal + tests/ParserTests/regressions/indentation.expr + tests/ParserTests/regressions/indentation.format + tests/ParserTests/regressions/indentation2.cabal + tests/ParserTests/regressions/indentation2.expr + tests/ParserTests/regressions/indentation2.format + tests/ParserTests/regressions/indentation3.cabal + tests/ParserTests/regressions/indentation3.expr + tests/ParserTests/regressions/indentation3.format tests/ParserTests/regressions/issue-5055.cabal tests/ParserTests/regressions/issue-5055.expr tests/ParserTests/regressions/issue-5055.format @@ -117,9 +163,34 @@ tests/ParserTests/regressions/issue-774.check tests/ParserTests/regressions/issue-774.expr tests/ParserTests/regressions/issue-774.format + tests/ParserTests/regressions/jaeger-flamegraph.cabal + tests/ParserTests/regressions/jaeger-flamegraph.expr + tests/ParserTests/regressions/jaeger-flamegraph.format + tests/ParserTests/regressions/leading-comma-2.cabal + tests/ParserTests/regressions/leading-comma-2.expr + tests/ParserTests/regressions/leading-comma-2.format tests/ParserTests/regressions/leading-comma.cabal tests/ParserTests/regressions/leading-comma.expr tests/ParserTests/regressions/leading-comma.format + tests/ParserTests/regressions/libpq1.cabal + tests/ParserTests/regressions/libpq1.expr + tests/ParserTests/regressions/libpq1.format + tests/ParserTests/regressions/libpq2.cabal + tests/ParserTests/regressions/libpq2.expr + tests/ParserTests/regressions/libpq2.format + tests/ParserTests/regressions/mixin-1.cabal + tests/ParserTests/regressions/mixin-1.expr + tests/ParserTests/regressions/mixin-1.format + tests/ParserTests/regressions/mixin-2.cabal + tests/ParserTests/regressions/mixin-2.expr + tests/ParserTests/regressions/mixin-2.format + tests/ParserTests/regressions/mixin-3.cabal + tests/ParserTests/regressions/mixin-3.expr + tests/ParserTests/regressions/mixin-3.format + tests/ParserTests/regressions/multiple-libs-2.cabal + tests/ParserTests/regressions/multiple-libs-2.check + tests/ParserTests/regressions/multiple-libs-2.expr + tests/ParserTests/regressions/multiple-libs-2.format tests/ParserTests/regressions/noVersion.cabal tests/ParserTests/regressions/noVersion.expr tests/ParserTests/regressions/noVersion.format @@ -146,6 +217,9 @@ tests/ParserTests/regressions/th-lift-instances.cabal tests/ParserTests/regressions/th-lift-instances.expr tests/ParserTests/regressions/th-lift-instances.format + tests/ParserTests/regressions/version-sets.cabal + tests/ParserTests/regressions/version-sets.expr + tests/ParserTests/regressions/version-sets.format tests/ParserTests/regressions/wl-pprint-indef.cabal tests/ParserTests/regressions/wl-pprint-indef.expr tests/ParserTests/regressions/wl-pprint-indef.format @@ -166,6 +240,7 @@ tests/ParserTests/warnings/unknownsection.cabal tests/ParserTests/warnings/utf8.cabal tests/ParserTests/warnings/versiontag.cabal + tests/cbits/rpmvercmp.c tests/hackage/check.sh tests/hackage/download.sh tests/hackage/unpack.sh @@ -208,6 +283,11 @@ ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances + if !impl(ghc >= 8.0) + -- at least one of lib:Cabal's dependency (i.e. `parsec`) + -- already depends on `fail` and `semigroups` transitively + build-depends: fail == 4.9.*, semigroups >= 0.18.3 && < 0.20 + exposed-modules: Distribution.Backpack Distribution.Backpack.Configure @@ -230,8 +310,8 @@ Distribution.Compat.Graph Distribution.Compat.Internal.TempFile Distribution.Compat.Newtype + Distribution.Compat.ResponseFile Distribution.Compat.Prelude.Internal - Distribution.Compat.ReadP Distribution.Compat.Semigroup Distribution.Compat.Stack Distribution.Compat.Time @@ -251,8 +331,6 @@ Distribution.PackageDescription.Configuration Distribution.PackageDescription.PrettyPrint Distribution.PackageDescription.Utils - Distribution.ParseUtils - Distribution.PrettyUtils Distribution.ReadE Distribution.Simple Distribution.Simple.Bench @@ -276,6 +354,7 @@ Distribution.Simple.Hpc Distribution.Simple.Install Distribution.Simple.InstallDirs + Distribution.Simple.InstallDirs.Internal Distribution.Simple.LocalBuildInfo Distribution.Simple.PackageIndex Distribution.Simple.PreProcess @@ -297,6 +376,7 @@ Distribution.Simple.Program.Types Distribution.Simple.Register Distribution.Simple.Setup + Distribution.Simple.ShowBuildInfo Distribution.Simple.SrcDist Distribution.Simple.Test Distribution.Simple.Test.ExeV10 @@ -336,6 +416,7 @@ Distribution.Types.Executable Distribution.Types.ExecutableScope Distribution.Types.Library + Distribution.Types.LibraryVisibility Distribution.Types.ForeignLib Distribution.Types.ForeignLibType Distribution.Types.ForeignLibOption @@ -343,9 +424,13 @@ Distribution.Types.ModuleReexport Distribution.Types.ModuleRenaming Distribution.Types.ComponentName + Distribution.Types.LibraryName Distribution.Types.MungedPackageName Distribution.Types.PackageName + Distribution.Types.PackageName.Magic Distribution.Types.PkgconfigName + Distribution.Types.PkgconfigVersion + Distribution.Types.PkgconfigVersionRange Distribution.Types.UnqualComponentName Distribution.Types.IncludeRenaming Distribution.Types.Mixin @@ -366,12 +451,16 @@ Distribution.Types.TargetInfo Distribution.Types.Version Distribution.Types.VersionRange + Distribution.Types.VersionRange.Internal Distribution.Types.VersionInterval + Distribution.Types.GivenComponent + Distribution.Types.PackageVersionConstraint Distribution.Utils.Generic Distribution.Utils.NubList Distribution.Utils.ShortText Distribution.Utils.Progress Distribution.Verbosity + Distribution.Verbosity.Internal Distribution.Version Language.Haskell.Extension Distribution.Compat.Binary @@ -395,16 +484,20 @@ Distribution.PackageDescription.FieldGrammar Distribution.PackageDescription.Parsec Distribution.PackageDescription.Quirks - Distribution.Parsec.Class - Distribution.Parsec.Common - Distribution.Parsec.ConfVar - Distribution.Parsec.Field - Distribution.Parsec.FieldLineStream - Distribution.Parsec.Lexer - Distribution.Parsec.LexerMonad + Distribution.Parsec + Distribution.Parsec.Error Distribution.Parsec.Newtypes - Distribution.Parsec.ParseResult - Distribution.Parsec.Parser + Distribution.Parsec.Position + Distribution.Parsec.Warning + Distribution.Parsec.FieldLineStream + Distribution.Fields + Distribution.Fields.ConfVar + Distribution.Fields.Field + Distribution.Fields.Lexer + Distribution.Fields.LexerMonad + Distribution.Fields.ParseResult + Distribution.Fields.Parser + Distribution.Fields.Pretty -- Lens functionality exposed-modules: @@ -443,6 +536,7 @@ Distribution.Simple.GHC.EnvironmentParser Distribution.Simple.GHC.Internal Distribution.Simple.GHC.ImplInfo + Distribution.Simple.Utils.Json Paths_Cabal if flag(bundled-binary-generic) @@ -489,7 +583,6 @@ Test.Laws Test.QuickCheck.Utils UnitTests.Distribution.Compat.CreatePipe - UnitTests.Distribution.Compat.ReadP UnitTests.Distribution.Compat.Time UnitTests.Distribution.Compat.Graph UnitTests.Distribution.Simple.Glob @@ -502,10 +595,12 @@ UnitTests.Distribution.Utils.NubList UnitTests.Distribution.Utils.ShortText UnitTests.Distribution.Version + UnitTests.Distribution.PkgconfigVersion main-is: UnitTests.hs build-depends: array, base, + binary, bytestring, containers, directory, @@ -531,6 +626,7 @@ base, base-compat >=0.10.4 && <0.11, bytestring, + directory, filepath, tasty >= 1.1.0.3 && < 1.2, tasty-hunit, @@ -541,9 +637,12 @@ ghc-options: -Wall default-language: Haskell2010 + if !impl(ghc >= 8.0) + build-depends: semigroups + if impl(ghc >= 7.8) build-depends: - tree-diff >= 0.0.1 && <0.1 + tree-diff >= 0.0.2 && <0.1 other-modules: Instances.TreeDiff Instances.TreeDiff.Language @@ -557,6 +656,7 @@ build-depends: base, bytestring, + directory, filepath, tasty >= 1.1.0.3 && < 1.2, tasty-golden >=2.3.1.1 && <2.4, @@ -564,6 +664,8 @@ Cabal ghc-options: -Wall default-language: Haskell2010 + if !impl(ghc >= 8.0) + build-depends: semigroups test-suite custom-setup-tests type: exitcode-stdio-1.0 @@ -603,11 +705,12 @@ base-compat >=0.10.4 && <0.11, base-orphans >=0.6 && <0.9, optparse-applicative >=0.13.2.0 && <0.15, + stm >=2.4.5.0 && <2.6, tar >=0.5.0.3 && <0.6 if impl(ghc >= 7.8) build-depends: - tree-diff >= 0.0.1 && <0.1 + tree-diff >= 0.0.2 && <0.1 other-modules: Instances.TreeDiff Instances.TreeDiff.Language @@ -616,4 +719,26 @@ ghc-options: -Wall -rtsopts -threaded default-extensions: CPP + default-language: Haskell2010 + +test-suite rpmvercmp + type: exitcode-stdio-1.0 + main-is: RPMVerCmp.hs + + hs-source-dirs: tests + build-depends: + base, + Cabal, + bytestring + + build-depends: + tasty >= 1.1.0.3 && < 1.2, + tasty-hunit, + tasty-quickcheck, + QuickCheck + + c-sources: tests/cbits/rpmvercmp.c + cc-options: -Wall + + ghc-options: -Wall default-language: Haskell2010 diff --git a/cabal/Cabal/ChangeLog.md b/cabal/Cabal/ChangeLog.md --- a/cabal/Cabal/ChangeLog.md +++ b/cabal/Cabal/ChangeLog.md @@ -1,9 +1,60 @@ +# 3.1.0.0 (current development version) + +# 3.0.0.0 TBD + * TODO + * Introduce set notation for `^>=` and `==` operators + ([#5906](https://github.com/haskell/cabal/pull/5906)). + * 'check' reports warnings for various ghc-\*-options fields separately + ([#5342](https://github.com/haskell/cabal/issues/5432)). + * `KnownExtension`: added new extensions `DerivingVia` and + `EmptyDataDeriving`. + * Add `extra-dynamic-library-flavours`, to specify extra dynamic library + flavours to build and install from a .cabal file. + * `autoconfUserHooks` now passes `--host=$HOST` when cross-compiling + * Introduce multiple public libraries feature + ([#5526](https://github.com/haskell/cabal/pull/5526)). + * New build-depends syntax + * Add a set of library components to the `Dependency` datatype + * New `visibility` field in the `library` stanza + * New `LibraryVisibility` field in `InstalledPackageInfo` + * New syntax for the `--dependency` Cabal flag + * Static linking + * Add `--enable-executable-static` flag for building fully + static executables (GHC's normal "statish" linking links + Haskell libraries statically, but libc and system dependencies + dynamically). This new flag links everything statically. + * Note you likely want to link against `musl` or another libc that + supports fully static linking; + [`glibc` has some issues](https://sourceware.org/glibc/wiki/FAQ#Even_statically_linked_programs_need_some_shared_libraries_which_is_not_acceptable_for_me.__What_can_I_do.3F) + with fully static linking. + * Fix corrupted config file header for non-ASCII package names + ([2557](https://github.com/haskell/cabal/issues/2557)). + * Extend `Distribution.Simple.Utils.rewriteFileEx` from ASCII to UTF-8 encoding. + * Change the arguments of `Newtype` class to better suit @DeriveAnyClass@ usage, + add default implementation in terms of `coerce` / `unsafeCoerce`. + * Implement support for response file arguments to defaultMain* and cabal-install. + * Uniformly provide 'Semigroup' instances for `base < 4.9` via `semigroups` package + * Setting `debug-info` now implies `library-stripping: False` and + `executable-stripping: False) ([#2702](https://github.com/haskell/cabal/issues/2702)) + * `Setup.hs copy` and `install` now work in the presence of + `data-files` that use `**` syntax + ([#6125](https://github.com/haskell/cabal/issues/6125)). + +---- + +### 2.4.1.1 [Mikhail Glushenkov](mailto:mikhail.glushenkov@gmail.com) December 2018 + + * Fix `--with-compiler` failing to locate compiler on Windows + ([#5753](https://github.com/haskell/cabal/pull/5753)). + * Cabal can once again be built with GHC 7.8 and 7.6 + ([#5730](https://github.com/haskell/cabal/pull/5730)). + ### 2.4.1.0 [Mikhail Glushenkov](mailto:mikhail.glushenkov@gmail.com) November 2018 * Warnings in autogenerated files are now silenced - ([#5678](https://github.com/haskell/cabal/pulls/5678)). + ([#5678](https://github.com/haskell/cabal/pull/5678)). * Improved recompilation avoidance, especially when using GHC 8.6 - ([#5589](https://github.com/haskell/cabal/pulls/5589)). + ([#5589](https://github.com/haskell/cabal/pull/5589)). * Do not error on empty packagedbs in `getInstalledPackages` ([#5516](https://github.com/haskell/cabal/issues/5516)). @@ -26,6 +77,8 @@ `non`) and an optics to access the modules in a component of a `PackageDescription` by the `ComponentName`: `componentBuildInfo` and `componentModules` + * Linker `ld-options` are now passed to GHC as `-optl` options + ([#4925](https://github.com/haskell/cabal/pull/4925)). * Add `readGhcEnvironmentFile` to parse GHC environment files. * Drop support for GHC 7.4, since it is out of our support window (and has been for over a year!) @@ -414,7 +467,7 @@ * Experimental support for emitting DWARF debug info. * Preliminary support for relocatable packages. * Allow cabal to be used inside cabal exec enviroments. - * hpc: support mutliple "ways" (e.g. profiling and vanilla). + * hpc: support multiple "ways" (e.g. profiling and vanilla). * Support GHCJS. * Improved command line documentation. * Add `-none` constraint syntax for version ranges (#2093). diff --git a/cabal/Cabal/Distribution/Backpack.hs b/cabal/Cabal/Distribution/Backpack.hs --- a/cabal/Cabal/Distribution/Backpack.hs +++ b/cabal/Cabal/Distribution/Backpack.hs @@ -29,8 +29,6 @@ OpenModuleSubst, dispOpenModuleSubst, dispOpenModuleSubstEntry, - parseOpenModuleSubst, - parseOpenModuleSubstEntry, parsecOpenModuleSubst, parsecOpenModuleSubstEntry, openModuleSubstFreeHoles, @@ -41,18 +39,15 @@ ) where import Distribution.Compat.Prelude hiding (mod) -import Distribution.Compat.ReadP ((<++)) -import Distribution.Parsec.Class +import Distribution.Parsec import Distribution.Pretty import Prelude () import Text.PrettyPrint (hcat) import qualified Distribution.Compat.CharParsing as P -import qualified Distribution.Compat.ReadP as Parse import qualified Text.PrettyPrint as Disp import Distribution.ModuleName -import Distribution.Text import Distribution.Types.ComponentId import Distribution.Types.Module import Distribution.Types.UnitId @@ -134,15 +129,6 @@ parsecOpenModuleSubst return (IndefFullUnitId cid insts) -instance Text OpenUnitId where - parse = parseOpenUnitId <++ fmap DefiniteUnitId parse - where - parseOpenUnitId = do - cid <- parse - insts <- Parse.between (Parse.char '[') (Parse.char ']') - parseOpenModuleSubst - return (IndefFullUnitId cid insts) - -- | Get the set of holes ('ModuleVar') embedded in a 'UnitId'. openUnitIdFreeHoles :: OpenUnitId -> Set ModuleName openUnitIdFreeHoles (IndefFullUnitId _ insts) = openModuleSubstFreeHoles insts @@ -211,20 +197,6 @@ _ <- P.char '>' return (OpenModuleVar mod_name) -instance Text OpenModule where - parse = parseModuleVar <++ parseOpenModule - where - parseOpenModule = do - uid <- parse - _ <- Parse.char ':' - mod_name <- parse - return (OpenModule uid mod_name) - parseModuleVar = do - _ <- Parse.char '<' - mod_name <- parse - _ <- Parse.char '>' - return (OpenModuleVar mod_name) - -- | Get the set of holes ('ModuleVar') embedded in a 'Module'. openModuleFreeHoles :: OpenModule -> Set ModuleName openModuleFreeHoles (OpenModuleVar mod_name) = Set.singleton mod_name @@ -249,21 +221,7 @@ -- | Pretty-print a single entry of a module substitution. dispOpenModuleSubstEntry :: (ModuleName, OpenModule) -> Disp.Doc -dispOpenModuleSubstEntry (k, v) = disp k <<>> Disp.char '=' <<>> disp v - --- | Inverse to 'dispModSubst'. -parseOpenModuleSubst :: Parse.ReadP r OpenModuleSubst -parseOpenModuleSubst = fmap Map.fromList - . flip Parse.sepBy (Parse.char ',') - $ parseOpenModuleSubstEntry - --- | Inverse to 'dispModSubstEntry'. -parseOpenModuleSubstEntry :: Parse.ReadP r (ModuleName, OpenModule) -parseOpenModuleSubstEntry = - do k <- parse - _ <- Parse.char '=' - v <- parse - return (k, v) +dispOpenModuleSubstEntry (k, v) = pretty k <<>> Disp.char '=' <<>> pretty v -- | Inverse to 'dispModSubst'. -- @@ -307,5 +265,5 @@ | Map.null subst = Nothing | otherwise = Just . hashToBase62 $ - concat [ display mod_name ++ "=" ++ display m ++ "\n" + concat [ prettyShow mod_name ++ "=" ++ prettyShow m ++ "\n" | (mod_name, m) <- Map.toList subst] diff --git a/cabal/Cabal/Distribution/Backpack/ComponentsGraph.hs b/cabal/Cabal/Distribution/Backpack/ComponentsGraph.hs --- a/cabal/Cabal/Distribution/Backpack/ComponentsGraph.hs +++ b/cabal/Cabal/Distribution/Backpack/ComponentsGraph.hs @@ -20,8 +20,7 @@ import Distribution.Compat.Graph (Graph, Node(..)) import qualified Distribution.Compat.Graph as Graph -import Distribution.Text - ( Text(disp) ) +import Distribution.Pretty (pretty) import Text.PrettyPrint ------------------------------------------------------------------------------ @@ -42,8 +41,8 @@ -- dispComponentsWithDeps :: ComponentsWithDeps -> Doc dispComponentsWithDeps graph = - vcat [ hang (text "component" <+> disp (componentName c)) 4 - (vcat [ text "dependency" <+> disp cdep | cdep <- cdeps ]) + vcat [ hang (text "component" <+> pretty (componentName c)) 4 + (vcat [ text "dependency" <+> pretty cdep | cdep <- cdeps ]) | (c, cdeps) <- graph ] -- | Create a 'Graph' of 'Component', or report a cycle if there is a @@ -66,16 +65,17 @@ (CExeName <$> getAllInternalToolDependencies pkg_descr bi) ++ [ if pkgname == packageName pkg_descr - then CLibName - else CSubLibName toolname - | Dependency pkgname _ <- targetBuildDepends bi + then CLibName LMainLibName + else CLibName (LSubLibName toolname) + | Dependency pkgname _ _ <- targetBuildDepends bi , let toolname = packageNameToUnqualComponentName pkgname , toolname `elem` internalPkgDeps ] where bi = componentBuildInfo component internalPkgDeps = map (conv . libName) (allLibraries pkg_descr) - conv Nothing = packageNameToUnqualComponentName $ packageName pkg_descr - conv (Just s) = s + + conv LMainLibName = packageNameToUnqualComponentName $ packageName pkg_descr + conv (LSubLibName s) = s -- | Given the package description and a 'PackageDescription' (used -- to determine if a package name is internal or not), sort the diff --git a/cabal/Cabal/Distribution/Backpack/Configure.hs b/cabal/Cabal/Distribution/Backpack/Configure.hs --- a/cabal/Cabal/Distribution/Backpack/Configure.hs +++ b/cabal/Cabal/Distribution/Backpack/Configure.hs @@ -41,6 +41,7 @@ import Distribution.Types.AnnotatedId import Distribution.Types.ComponentRequestedSpec import Distribution.Types.ComponentInclude +import Distribution.Types.MungedPackageName import Distribution.Verbosity import qualified Distribution.Compat.Graph as Graph import Distribution.Compat.Graph (Graph, IsNode(..)) @@ -50,7 +51,7 @@ ( lefts ) import qualified Data.Set as Set import qualified Data.Map as Map -import Distribution.Text +import Distribution.Pretty import Text.PrettyPrint ------------------------------------------------------------------------------ @@ -105,7 +106,7 @@ | Just pkg <- PackageIndex.lookupUnitId installedPackageSet uid = FullUnitId (Installed.installedComponentId pkg) (Map.fromList (Installed.instantiatedWith pkg)) - | otherwise = error ("uid_lookup: " ++ display uid) + | otherwise = error ("uid_lookup: " ++ prettyShow uid) where uid = unDefUnitId def_uid graph2 <- toLinkedComponents verbosity uid_lookup (package pkg_descr) shape_pkg_map graph1 @@ -186,14 +187,14 @@ ++ "packages must be rebuilt before they can be used.\n" -- TODO: Undupe. ++ unlines [ "installed package " - ++ display (packageId pkg) + ++ prettyShow (packageId pkg) ++ " is broken due to missing package " - ++ intercalate ", " (map display deps) + ++ intercalate ", " (map prettyShow deps) | (Left pkg, deps) <- broken ] ++ unlines [ "planned package " - ++ display (packageId pkg) + ++ prettyShow (packageId pkg) ++ " is broken due to missing package " - ++ intercalate ", " (map display deps) + ++ intercalate ", " (map prettyShow deps) | (Right pkg, deps) <- broken ] -- In this section, we'd like to look at the 'packageDependsIndex' @@ -224,9 +225,9 @@ warnProgress $ hang (text "This package indirectly depends on multiple versions of the same" <+> text "package. This is very likely to cause a compile failure.") 2 - (vcat [ text "package" <+> disp (packageName user) <+> - parens (disp (installedUnitId user)) <+> text "requires" <+> - disp inst + (vcat [ text "package" <+> pretty (packageName user) <+> + parens (pretty (installedUnitId user)) <+> text "requires" <+> + pretty inst | (_dep_key, insts) <- inconsistencies , (inst, users) <- insts , user <- users ]) @@ -277,7 +278,7 @@ Right instc -> [ (m, OpenModule (DefiniteUnitId uid') m') | (m, Module uid' m') <- instc_insts instc ] - compat_name = computeCompatPackageName (packageName rc) (libName lib) + compat_name = MungedPackageName (packageName rc) (libName lib) compat_key = computeCompatPackageKey comp compat_name (packageVersion rc) this_uid in LibComponentLocalBuildInfo { diff --git a/cabal/Cabal/Distribution/Backpack/ConfiguredComponent.hs b/cabal/Cabal/Distribution/Backpack/ConfiguredComponent.hs --- a/cabal/Cabal/Distribution/Backpack/ConfiguredComponent.hs +++ b/cabal/Cabal/Distribution/Backpack/ConfiguredComponent.hs @@ -30,6 +30,7 @@ import Distribution.Types.PackageName import Distribution.Types.Mixin import Distribution.Types.ComponentName +import Distribution.Types.LibraryName import Distribution.Types.UnqualComponentName import Distribution.Types.ComponentInclude import Distribution.Package @@ -45,7 +46,7 @@ import Control.Monad import qualified Data.Set as Set import qualified Data.Map as Map -import Distribution.Text +import Distribution.Pretty import Text.PrettyPrint -- | A configured component, we know exactly what its 'ComponentId' is, @@ -91,8 +92,9 @@ -- | Pretty-print a 'ConfiguredComponent'. dispConfiguredComponent :: ConfiguredComponent -> Doc dispConfiguredComponent cc = - hang (text "component" <+> disp (cc_cid cc)) 4 - (vcat [ hsep $ [ text "include", disp (ci_id incl), disp (ci_renaming incl) ] + hang (text "component" <+> pretty (cc_cid cc)) 4 + (vcat [ hsep $ [ text "include" + , pretty (ci_id incl), pretty (ci_renaming incl) ] | incl <- cc_includes cc ]) @@ -114,9 +116,9 @@ aid <- case Map.lookup keys deps_map of Nothing -> dieProgress $ - text "Mix-in refers to non-existent package" <+> - quotes (disp name) $$ - text "(did you forget to add the package to build-depends?)" + text "Mix-in refers to non-existent package" <+> + quotes (pretty name) $$ + text "(did you forget to add the package to build-depends?)" Just r -> return r return ComponentInclude { ci_ann_id = aid, @@ -150,7 +152,7 @@ bi = componentBuildInfo component deps_map = Map.fromList [ ((packageName dep, ann_cname dep), dep) | dep <- lib_deps ] - is_public = componentName component == CLibName + is_public = componentName component == CLibName LMainLibName type ConfiguredComponentMap = Map PackageName (Map ComponentName (AnnotatedId ComponentId)) @@ -165,16 +167,30 @@ toConfiguredComponent pkg_descr this_cid lib_dep_map exe_dep_map component = do lib_deps <- if newPackageDepsBehaviour pkg_descr - then forM (targetBuildDepends bi) $ \(Dependency name _) -> do - let (pn, cn) = fixFakePkgName pkg_descr name - value <- case Map.lookup cn =<< Map.lookup pn lib_dep_map of + then fmap concat $ forM (targetBuildDepends bi) $ + \(Dependency name _ sublibs) -> do + -- The package name still needs fixing in case of legacy + -- sublibrary dependency syntax + let (pn, _) = fixFakePkgName pkg_descr name + pkg <- case Map.lookup pn lib_dep_map of Nothing -> dieProgress $ - text "Dependency on unbuildable (i.e. 'buildable: False')" <+> - text (showComponentName cn) <+> - text "from" <+> disp pn - Just v -> return v - return value + text "Dependency on unbuildable" <+> + text "package" <+> pretty pn + Just p -> return p + -- Return all library components + forM (Set.toList sublibs) $ \lib -> + let comp = CLibName lib in + case Map.lookup (CLibName $ LSubLibName $ + packageNameToUnqualComponentName name) pkg + <|> Map.lookup comp pkg + of + Nothing -> + dieProgress $ + text "Dependency on unbuildable" <+> + text (showLibraryName lib) <+> + text "from" <+> pretty pn + Just v -> return v else return old_style_lib_deps mkConfiguredComponent pkg_descr this_cid @@ -192,7 +208,7 @@ | (pn, comp_map) <- Map.toList lib_dep_map , pn /= packageName pkg_descr , (cn, e) <- Map.toList comp_map - , cn == CLibName ] + , cn == CLibName LMainLibName ] -- We have to nub here, because 'getAllToolDependencies' may return -- duplicates (see #4986). (NB: This is not needed for lib_deps, -- since those elaborate into includes, for which there explicitly @@ -231,8 +247,8 @@ else cc where -- TODO: pass component names to it too! - this_cid = computeComponentId deterministic ipid_flag cid_flag (package pkg_descr) - (componentName component) (Just (deps, flags)) + this_cid = computeComponentId deterministic ipid_flag cid_flag + (package pkg_descr) (componentName component) (Just (deps, flags)) deps = [ ann_id aid | m <- Map.elems dep_map , aid <- Map.elems m ] @@ -293,11 +309,14 @@ -- and internal libraries are specified the same. For now, we assume internal -- libraries shadow, and this function disambiguates accordingly, but soon the -- underlying ambiguity will be addressed. +-- Multiple public libraries (cabal 3.0) added an unambiguous way of specifying +-- sublibraries, but we still have to support the old syntax for bc reasons. fixFakePkgName :: PackageDescription -> PackageName -> (PackageName, ComponentName) fixFakePkgName pkg_descr pn = if subLibName `elem` internalLibraries - then (packageName pkg_descr, CSubLibName subLibName) - else (pn, CLibName) + then (packageName pkg_descr, CLibName (LSubLibName subLibName)) + else (pn, CLibName LMainLibName ) where - subLibName = packageNameToUnqualComponentName pn - internalLibraries = mapMaybe libName (allLibraries pkg_descr) + subLibName = packageNameToUnqualComponentName pn + internalLibraries = mapMaybe (libraryNameString . libName) + (allLibraries pkg_descr) diff --git a/cabal/Cabal/Distribution/Backpack/DescribeUnitId.hs b/cabal/Cabal/Distribution/Backpack/DescribeUnitId.hs --- a/cabal/Cabal/Distribution/Backpack/DescribeUnitId.hs +++ b/cabal/Cabal/Distribution/Backpack/DescribeUnitId.hs @@ -1,17 +1,17 @@ -{-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE Rank2Types #-} module Distribution.Backpack.DescribeUnitId where -import Prelude () import Distribution.Compat.Prelude +import Prelude () -import Distribution.Types.PackageId -import Distribution.Types.ComponentName import Distribution.Compat.Stack -import Distribution.Verbosity import Distribution.ModuleName -import Distribution.Text +import Distribution.Pretty import Distribution.Simple.Utils +import Distribution.Types.ComponentName +import Distribution.Types.PackageId +import Distribution.Verbosity import Text.PrettyPrint @@ -37,7 +37,7 @@ -- for (2) which component (with enough details to uniquely identify -- the build in question.) -- -setupMessage' :: Text a => Verbosity +setupMessage' :: Pretty a => Verbosity -> String -- ^ Operation being done (capitalized), on: -> PackageIdentifier -- ^ Package -> ComponentName -- ^ Component name @@ -50,7 +50,7 @@ case mb_insts of Just insts | not (null insts) -> hang (msg_doc <+> text "instantiated with") 2 - (vcat [ disp k <+> text "=" <+> disp v + (vcat [ pretty k <+> text "=" <+> pretty v | (k,v) <- insts ]) $$ for_doc _ -> @@ -58,4 +58,4 @@ where msg_doc = text msg <+> text (showComponentName cname) - for_doc = text "for" <+> disp pkgid <<>> text ".." + for_doc = text "for" <+> pretty pkgid <<>> text ".." diff --git a/cabal/Cabal/Distribution/Backpack/Id.hs b/cabal/Cabal/Distribution/Backpack/Id.hs --- a/cabal/Cabal/Distribution/Backpack/Id.hs +++ b/cabal/Cabal/Distribution/Backpack/Id.hs @@ -5,7 +5,6 @@ module Distribution.Backpack.Id( computeComponentId, computeCompatPackageKey, - computeCompatPackageName, ) where import Prelude () @@ -24,8 +23,9 @@ import Distribution.Utils.Base62 import Distribution.Version -import Distribution.Text - ( display, simpleParse ) +import Distribution.Pretty + ( prettyShow ) +import Distribution.Parsec ( simpleParsec ) -- | This method computes a default, "good enough" 'ComponentId' -- for a package. The intent is that cabal-install (or the user) will @@ -50,11 +50,11 @@ -- For safety, include the package + version here -- for GHC 7.10, where just the hash is used as -- the package key - ( display pid + ( prettyShow pid ++ show dep_ipids ++ show flags ) | otherwise = "" - generated_base = display pid ++ hash_suffix + generated_base = prettyShow pid ++ hash_suffix explicit_base cid0 = fromPathTemplate (InstallDirs.substPathTemplate env (toPathTemplate cid0)) -- Hack to reuse install dirs machinery @@ -62,7 +62,7 @@ where env = packageTemplateEnv pid (mkUnitId "") actual_base = case mb_ipid of Flag ipid0 -> explicit_base ipid0 - NoFlag | deterministic -> display pid + NoFlag | deterministic -> prettyShow pid | otherwise -> generated_base in case mb_cid of Flag cid -> cid @@ -126,15 +126,15 @@ -> String computeCompatPackageKey comp pkg_name pkg_version uid | not (packageKeySupported comp) = - display pkg_name ++ "-" ++ display pkg_version + prettyShow pkg_name ++ "-" ++ prettyShow pkg_version | not (unifiedIPIDRequired comp) = let str = unUnitId uid -- assume no Backpack support mb_verbatim_key - = case simpleParse str :: Maybe PackageId of + = case simpleParsec str :: Maybe PackageId of -- Something like 'foo-0.1', use it verbatim. -- (NB: hash tags look like tags, so they are parsed, -- so the extra equality check tests if a tag was dropped.) - Just pid0 | display pid0 == str -> Just str + Just pid0 | prettyShow pid0 == str -> Just str _ -> Nothing mb_truncated_key = let cand = reverse (takeWhile isAlphaNum (reverse str)) @@ -143,4 +143,4 @@ else Nothing rehashed_key = hashToBase62 str in fromMaybe rehashed_key (mb_verbatim_key `mplus` mb_truncated_key) - | otherwise = display uid + | otherwise = prettyShow uid diff --git a/cabal/Cabal/Distribution/Backpack/LinkedComponent.hs b/cabal/Cabal/Distribution/Backpack/LinkedComponent.hs --- a/cabal/Cabal/Distribution/Backpack/LinkedComponent.hs +++ b/cabal/Cabal/Distribution/Backpack/LinkedComponent.hs @@ -45,8 +45,7 @@ import qualified Data.Map as Map import Data.Traversable ( mapM ) -import Distribution.Text - ( Text(disp) ) +import Distribution.Pretty (pretty) import Text.PrettyPrint import Data.Either @@ -104,11 +103,11 @@ dispLinkedComponent :: LinkedComponent -> Doc dispLinkedComponent lc = - hang (text "unit" <+> disp (lc_uid lc)) 4 $ - vcat [ text "include" <+> disp (ci_id incl) <+> disp (ci_renaming incl) + hang (text "unit" <+> pretty (lc_uid lc)) 4 $ + vcat [ text "include" <+> pretty (ci_id incl) <+> pretty (ci_renaming incl) | incl <- lc_includes lc ] $+$ - vcat [ text "signature include" <+> disp (ci_id incl) + vcat [ text "signature include" <+> pretty (ci_id incl) | incl <- lc_sig_includes lc ] $+$ dispOpenModuleSubst (modShapeProvides (lc_shape lc)) @@ -230,7 +229,7 @@ when (not (Set.null reqs) && isNotLib component) $ dieProgress $ hang (text "Non-library component has unfilled requirements:") - 4 (vcat [disp req | req <- Set.toList reqs]) + 4 (vcat [pretty req | req <- Set.toList reqs]) -- NB: do NOT include hidden modules here: GHC 7.10's ghc-pkg -- won't allow it (since someone could directly synthesize @@ -285,7 +284,7 @@ let build_reexports m (k, v) | Map.member k m = dieProgress $ hsep - [ text "Module name ", disp k, text " is exported multiple times." ] + [ text "Module name ", pretty k, text " is exported multiple times." ] | otherwise = return (Map.insert k v m) provs <- foldM build_reexports Map.empty $ -- TODO: doublecheck we have checked for @@ -364,17 +363,17 @@ brokenReexportMsg :: ModuleReexport -> Doc brokenReexportMsg (ModuleReexport (Just pn) from _to) = - vcat [ text "The package" <+> quotes (disp pn) - , text "does not export a module" <+> quotes (disp from) ] + vcat [ text "The package" <+> quotes (pretty pn) + , text "does not export a module" <+> quotes (pretty from) ] brokenReexportMsg (ModuleReexport Nothing from _to) = - vcat [ text "The module" <+> quotes (disp from) + vcat [ text "The module" <+> quotes (pretty from) , text "is not exported by any suitable package." , text "It occurs in neither the 'exposed-modules' of this package," , text "nor any of its 'build-depends' dependencies." ] ambiguousReexportMsg :: ModuleReexport -> ModuleWithSource -> [ModuleWithSource] -> Doc ambiguousReexportMsg (ModuleReexport mb_pn from _to) y1 ys = - vcat [ text "Ambiguous reexport" <+> quotes (disp from) + vcat [ text "Ambiguous reexport" <+> quotes (pretty from) , hang (text "It could refer to either:") 2 (vcat (msg : msgs)) , help_msg mb_pn ] @@ -393,7 +392,7 @@ , text "mixins field to rename one of the module" , text "names differently." ] displayModuleWithSource y - = vcat [ quotes (disp (unWithSource y)) + = vcat [ quotes (pretty (unWithSource y)) , text "brought into scope by" <+> dispModuleSource (getSource y) ] diff --git a/cabal/Cabal/Distribution/Backpack/MixLink.hs b/cabal/Cabal/Distribution/Backpack/MixLink.hs --- a/cabal/Cabal/Distribution/Backpack/MixLink.hs +++ b/cabal/Cabal/Distribution/Backpack/MixLink.hs @@ -14,7 +14,7 @@ import qualified Distribution.Utils.UnionFind as UnionFind import Distribution.ModuleName -import Distribution.Text +import Distribution.Pretty import Distribution.Types.ComponentId import Text.PrettyPrint @@ -56,10 +56,10 @@ Just () -> return () Nothing -> do addErr $ - text "Ambiguous module" <+> quotes (disp mod_name) $$ + text "Ambiguous module" <+> quotes (pretty mod_name) $$ text "It could refer to" <+> - ( text " " <+> (quotes (disp mod) $$ in_scope_by (getSource prov)) $$ - text "or" <+> (quotes (disp mod') $$ in_scope_by (getSource prov')) ) $$ + ( text " " <+> (quotes (pretty mod) $$ in_scope_by (getSource prov)) $$ + text "or" <+> (quotes (pretty mod') $$ in_scope_by (getSource prov')) ) $$ link_doc mod <- convertModuleU (unWithSource prov) req_mod <- convertModuleU (unWithSource req) @@ -67,7 +67,7 @@ case mod of OpenModule (IndefFullUnitId cid _) _ | cid == self_cid -> addErr $ - text "Cannot instantiate requirement" <+> quotes (disp mod_name) <+> + text "Cannot instantiate requirement" <+> quotes (pretty mod_name) <+> in_scope_by (getSource req) $$ text "with locally defined module" <+> in_scope_by (getSource prov) $$ text "as this would create a cyclic dependency, which GHC does not support." $$ @@ -79,9 +79,9 @@ Just () -> return () Nothing -> do -- TODO: Record and report WHERE the bad constraint came from - addErr $ text "Could not instantiate requirement" <+> quotes (disp mod_name) $$ - nest 4 (text "Expected:" <+> disp mod $$ - text "Actual: " <+> disp req_mod) $$ + addErr $ text "Could not instantiate requirement" <+> quotes (pretty mod_name) $$ + nest 4 (text "Expected:" <+> pretty mod $$ + text "Actual: " <+> pretty req_mod) $$ parens (text "This can occur if an exposed module of" <+> text "a libraries shares a name with another module.") $$ link_doc @@ -90,7 +90,7 @@ unify s1 s2 = tryM $ addErrContext short_link_doc $ unifyModule (unWithSource s1) (unWithSource s2) in_scope_by s = text "brought into scope by" <+> dispModuleSource s - short_link_doc = text "While filling requirement" <+> quotes (disp mod_name) + short_link_doc = text "While filling requirement" <+> quotes (pretty mod_name) link_doc = text "While filling requirements of" <+> reqs_doc reqs_doc | null reqs = dispModuleSource (getSource req) @@ -117,8 +117,8 @@ | u1 == u2 -> return () | otherwise -> failWith $ hang (text "Couldn't match unit IDs:") 4 - (text " " <+> disp u1 $$ - text "and" <+> disp u2) + (text " " <+> pretty u1 $$ + text "and" <+> pretty u2) (UnitIdThunkU uid1, UnitIdU _ cid2 insts2) -> unifyThunkWith cid2 insts2 uid2_u uid1 uid1_u (UnitIdU _ cid1 insts1, UnitIdThunkU uid2) @@ -151,8 +151,8 @@ -- easier to understand error message. failWith $ hang (text "Couldn't match component IDs:") 4 - (text " " <+> disp cid1 $$ - text "and" <+> disp cid2) + (text " " <+> pretty cid1 $$ + text "and" <+> pretty cid2) -- The KEY STEP which makes this a Huet-style unification -- algorithm. (Also a payoff of using union-find.) -- We can build infinite unit IDs this way, which is necessary @@ -176,8 +176,8 @@ when (mod_name1 /= mod_name2) $ failWith $ hang (text "Cannot match module names") 4 $ - text " " <+> disp mod_name1 $$ - text "and" <+> disp mod_name2 + text " " <+> pretty mod_name1 $$ + text "and" <+> pretty mod_name2 -- NB: this is not actually necessary (because we'll -- detect loops eventually in 'unifyUnitId'), but it -- seems harmless enough diff --git a/cabal/Cabal/Distribution/Backpack/ModuleScope.hs b/cabal/Cabal/Distribution/Backpack/ModuleScope.hs --- a/cabal/Cabal/Distribution/Backpack/ModuleScope.hs +++ b/cabal/Cabal/Distribution/Backpack/ModuleScope.hs @@ -23,10 +23,11 @@ import Distribution.Types.IncludeRenaming import Distribution.Types.PackageName import Distribution.Types.ComponentName +import Distribution.Types.LibraryName +import Distribution.Pretty import Distribution.Backpack import Distribution.Backpack.ModSubst -import Distribution.Text import qualified Data.Map as Map import Text.PrettyPrint @@ -96,15 +97,15 @@ -- TODO: Deduplicate this with Distribution.Backpack.UnifyM.ci_msg dispModuleSource :: ModuleSource -> Doc dispModuleSource (FromMixins pn cn incls) - = text "mixins:" <+> dispComponent pn cn <+> disp incls + = text "mixins:" <+> dispComponent pn cn <+> pretty incls dispModuleSource (FromBuildDepends pn cn) = text "build-depends:" <+> dispComponent pn cn dispModuleSource (FromExposedModules m) - = text "exposed-modules:" <+> disp m + = text "exposed-modules:" <+> pretty m dispModuleSource (FromOtherModules m) - = text "other-modules:" <+> disp m + = text "other-modules:" <+> pretty m dispModuleSource (FromSignatures m) - = text "signatures:" <+> disp m + = text "signatures:" <+> pretty m -- Dependency dispComponent :: PackageName -> ComponentName -> Doc @@ -113,10 +114,10 @@ -- should be clear enough. To do source syntax, we'd -- need to know what the package we're linking is. case cn of - CLibName -> disp pn - CSubLibName ucn -> disp pn <<>> colon <<>> disp ucn + CLibName LMainLibName -> pretty pn + CLibName (LSubLibName ucn) -> pretty pn <<>> colon <<>> pretty ucn -- Case below shouldn't happen - _ -> disp pn <+> parens (disp cn) + _ -> pretty pn <+> parens (pretty cn) -- | An 'OpenModule', annotated with where it came from in a Cabal file. data WithSource a = WithSource ModuleSource a diff --git a/cabal/Cabal/Distribution/Backpack/PreExistingComponent.hs b/cabal/Cabal/Distribution/Backpack/PreExistingComponent.hs --- a/cabal/Cabal/Distribution/Backpack/PreExistingComponent.hs +++ b/cabal/Cabal/Distribution/Backpack/PreExistingComponent.hs @@ -46,7 +46,7 @@ ipiToPreExistingComponent ipi = PreExistingComponent { pc_pkgname = packageName ipi, - pc_compname = libraryComponentName $ Installed.sourceLibName ipi, + pc_compname = CLibName $ Installed.sourceLibName ipi, pc_munged_id = mungedId ipi, pc_uid = Installed.installedUnitId ipi, pc_cid = Installed.installedComponentId ipi, diff --git a/cabal/Cabal/Distribution/Backpack/ReadyComponent.hs b/cabal/Cabal/Distribution/Backpack/ReadyComponent.hs --- a/cabal/Cabal/Distribution/Backpack/ReadyComponent.hs +++ b/cabal/Cabal/Distribution/Backpack/ReadyComponent.hs @@ -26,12 +26,14 @@ import Distribution.Types.ComponentId import Distribution.Types.ComponentName import Distribution.Types.PackageId +import Distribution.Types.PackageName.Magic import Distribution.Types.UnitId import Distribution.Compat.Graph (IsNode(..)) import Distribution.Types.Module import Distribution.Types.MungedPackageId import Distribution.Types.MungedPackageName import Distribution.Types.Library +import Distribution.Types.LibraryName import Distribution.ModuleName import Distribution.Package @@ -43,9 +45,10 @@ import Control.Monad import Text.PrettyPrint import qualified Data.Map as Map +import qualified Data.Set as Set import Distribution.Version -import Distribution.Text +import Distribution.Pretty -- | A 'ReadyComponent' is one that we can actually generate build -- products for. We have a ready component for the typecheck-only @@ -134,15 +137,14 @@ (instc_includes instc) ++ instc_insts_deps instc where - toMungedPackageId :: Text id => ComponentInclude id rn -> MungedPackageId + toMungedPackageId :: Pretty id => ComponentInclude id rn -> MungedPackageId toMungedPackageId ci = computeCompatPackageId (ci_pkgid ci) (case ci_cname ci of - CLibName -> Nothing - CSubLibName uqn -> Just uqn - _ -> error $ display (rc_cid rc) ++ - " depends on non-library " ++ display (ci_id ci)) + CLibName name -> name + _ -> error $ prettyShow (rc_cid rc) ++ + " depends on non-library " ++ prettyShow (ci_id ci)) -- | Get the 'MungedPackageId' of a 'ReadyComponent' IF it is -- a library. @@ -178,9 +180,9 @@ hang (text (case rc_i rc of Left _ -> "indefinite" Right _ -> "definite") - <+> disp (nodeKey rc) + <+> pretty (nodeKey rc) {- <+> dispModSubst (Map.fromList (lc_insts lc)) -} ) 4 $ - vcat [ text "depends" <+> disp uid + vcat [ text "depends" <+> pretty uid | uid <- nodeNeighbors rc ] -- | The state of 'InstM'; a mapping from 'UnitId's to their @@ -274,7 +276,7 @@ fmap rc_munged_id (join (Map.lookup dep_uid s)))] where err_pid = MungedPackageId - (mkMungedPackageName "nonexistent-package-this-is-a-cabal-bug") + (MungedPackageName nonExistentPackageThisIsCabalBug LMainLibName) (mkVersion [0]) instc = InstantiatedComponent { instc_insts = Map.toList insts, @@ -336,11 +338,19 @@ indefiniteComponent :: UnitId -> ComponentId -> InstM (Maybe ReadyComponent) indefiniteComponent uid cid | Just lc <- Map.lookup cid cmap = do + -- We're going to process includes, in case some of them + -- are fully definite even without any substitution. We + -- want to build those too; see #5634. + inst_includes <- forM (lc_includes lc) $ \ci -> + if Set.null (openUnitIdFreeHoles (ci_id ci)) + then do uid' <- substUnitId Map.empty (ci_id ci) + return $ ci { ci_ann_id = fmap (const (DefiniteUnitId uid')) (ci_ann_id ci) } + else return ci exe_deps <- mapM (substExeDep Map.empty) (lc_exe_deps lc) let indefc = IndefiniteComponent { indefc_requires = map fst (lc_insts lc), indefc_provides = modShapeProvides (lc_shape lc), - indefc_includes = lc_includes lc ++ lc_sig_includes lc + indefc_includes = inst_includes ++ lc_sig_includes lc } return $ Just ReadyComponent { rc_ann_id = (lc_ann_id lc) { ann_id = uid }, @@ -357,6 +367,7 @@ ready_map = snd $ runInstM work Map.empty work + -- Top-level instantiation per subst0 | not (Map.null subst0) , [lc] <- filter lc_public (Map.elems cmap) = do _ <- instantiateUnitId (lc_cid lc) subst0 diff --git a/cabal/Cabal/Distribution/Backpack/UnifyM.hs b/cabal/Cabal/Distribution/Backpack/UnifyM.hs --- a/cabal/Cabal/Distribution/Backpack/UnifyM.hs +++ b/cabal/Cabal/Distribution/Backpack/UnifyM.hs @@ -56,7 +56,7 @@ import Distribution.ModuleName import Distribution.Package import Distribution.PackageDescription -import Distribution.Text +import Distribution.Pretty import Distribution.Types.IncludeRenaming import Distribution.Types.ComponentInclude import Distribution.Types.AnnotatedId @@ -436,15 +436,15 @@ ci_msg :: ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming -> Doc ci_msg ci | ci_implicit ci = text "build-depends:" <+> pp_pn - | otherwise = text "mixins:" <+> pp_pn <+> disp (ci_renaming ci) + | otherwise = text "mixins:" <+> pp_pn <+> pretty (ci_renaming ci) where pn = pkgName (ci_pkgid ci) pp_pn = case ci_cname ci of - CLibName -> disp pn - CSubLibName cn -> disp pn <<>> colon <<>> disp cn + CLibName LMainLibName -> pretty pn + CLibName (LSubLibName cn) -> pretty pn <<>> colon <<>> pretty cn -- Shouldn't happen - cn -> disp pn <+> parens (disp cn) + cn -> pretty pn <+> parens (pretty cn) -- | Convert a 'ModuleShape' into a 'ModuleScopeU', so we can do -- unification on it. @@ -505,8 +505,8 @@ [] -> error "req_rename" [v] -> return v v:vs -> do addErr $ - text "Conflicting renamings of requirement" <+> quotes (disp k) $$ - text "Renamed to: " <+> vcat (map disp (v:vs)) + text "Conflicting renamings of requirement" <+> quotes (pretty k) $$ + text "Renamed to: " <+> vcat (map pretty (v:vs)) return v let req_rename_fn k = case Map.lookup k req_rename of @@ -536,9 +536,9 @@ unless (Set.null leftover) $ addErr $ hang (text "The" <+> text (showComponentName compname) <+> - text "from package" <+> quotes (disp pid) + text "from package" <+> quotes (pretty pid) <+> text "does not require:") 4 - (vcat (map disp (Set.toList leftover))) + (vcat (map pretty (Set.toList leftover))) -- Provision computation is more complex. -- For example, if we have: @@ -576,8 +576,8 @@ [ case Map.lookup from provs of Just m -> return (to, m) Nothing -> failWith $ - text "Package" <+> quotes (disp pid) <+> - text "does not expose the module" <+> quotes (disp from) + text "Package" <+> quotes (pretty pid) <+> + text "does not expose the module" <+> quotes (pretty from) | (from, to) <- rns ] return (r, prov_rns) let prov_scope = modSubst req_subst diff --git a/cabal/Cabal/Distribution/CabalSpecVersion.hs b/cabal/Cabal/Distribution/CabalSpecVersion.hs --- a/cabal/Cabal/Distribution/CabalSpecVersion.hs +++ b/cabal/Cabal/Distribution/CabalSpecVersion.hs @@ -4,73 +4,88 @@ import Prelude () import Distribution.Compat.Prelude -import qualified Data.Set as Set -- | Different Cabal-the-spec versions. -- -- We branch based on this at least in the parser. -- data CabalSpecVersion - = CabalSpecOld + = CabalSpecV1_0 -- ^ this is older than 'CabalSpecV1_2' + | CabalSpecV1_2 -- ^ new syntax (sections) + | CabalSpecV1_4 + | CabalSpecV1_6 + | CabalSpecV1_8 + | CabalSpecV1_10 + | CabalSpecV1_12 + -- 1.16 -- 1.14: no changes + | CabalSpecV1_18 + | CabalSpecV1_20 | CabalSpecV1_22 | CabalSpecV1_24 | CabalSpecV2_0 | CabalSpecV2_2 | CabalSpecV2_4 + | CabalSpecV3_0 deriving (Eq, Ord, Show, Read, Enum, Bounded, Typeable, Data, Generic) -cabalSpecLatest :: CabalSpecVersion -cabalSpecLatest = CabalSpecV2_4 +-- | Show cabal spec version, but not the way in the .cabal files +-- +-- @since 3.0.0.0 +showCabalSpecVersion :: CabalSpecVersion -> String +showCabalSpecVersion CabalSpecV3_0 = "3.0" +showCabalSpecVersion CabalSpecV2_4 = "2.4" +showCabalSpecVersion CabalSpecV2_2 = "2.2" +showCabalSpecVersion CabalSpecV2_0 = "2.0" +showCabalSpecVersion CabalSpecV1_24 = "1.24" +showCabalSpecVersion CabalSpecV1_22 = "1.22" +showCabalSpecVersion CabalSpecV1_20 = "1.20" +showCabalSpecVersion CabalSpecV1_18 = "1.18" +showCabalSpecVersion CabalSpecV1_12 = "1.12" +showCabalSpecVersion CabalSpecV1_10 = "1.10" +showCabalSpecVersion CabalSpecV1_8 = "1.8" +showCabalSpecVersion CabalSpecV1_6 = "1.6" +showCabalSpecVersion CabalSpecV1_4 = "1.4" +showCabalSpecVersion CabalSpecV1_2 = "1.2" +showCabalSpecVersion CabalSpecV1_0 = "1.0" -cabalSpecFeatures :: CabalSpecVersion -> Set.Set CabalFeature -cabalSpecFeatures CabalSpecOld = Set.empty -cabalSpecFeatures CabalSpecV1_22 = Set.empty -cabalSpecFeatures CabalSpecV1_24 = Set.empty -cabalSpecFeatures CabalSpecV2_0 = Set.empty -cabalSpecFeatures CabalSpecV2_2 = Set.fromList - [ Elif - , CommonStanzas - ] -cabalSpecFeatures CabalSpecV2_4 = Set.fromList - [ Elif - , CommonStanzas - , Globstar - ] +cabalSpecLatest :: CabalSpecVersion +cabalSpecLatest = CabalSpecV3_0 -cabalSpecSupports :: CabalSpecVersion -> [Int] -> Bool -cabalSpecSupports CabalSpecOld v = v < [1,21] -cabalSpecSupports CabalSpecV1_22 v = v < [1,23] -cabalSpecSupports CabalSpecV1_24 v = v < [1,25] -cabalSpecSupports CabalSpecV2_0 v = v < [2,1] -cabalSpecSupports CabalSpecV2_2 v = v < [2,3] -cabalSpecSupports CabalSpecV2_4 _ = True +cabalSpecFromVersionDigits :: [Int] -> CabalSpecVersion +cabalSpecFromVersionDigits v + | v >= [2,5] = CabalSpecV3_0 + | v >= [2,3] = CabalSpecV2_4 + | v >= [2,1] = CabalSpecV2_2 + | v >= [1,25] = CabalSpecV2_0 + | v >= [1,23] = CabalSpecV1_24 + | v >= [1,21] = CabalSpecV1_22 + | v >= [1,19] = CabalSpecV1_20 + | v >= [1,17] = CabalSpecV1_18 + | v >= [1,11] = CabalSpecV1_12 + | v >= [1,9] = CabalSpecV1_10 + | v >= [1,7] = CabalSpecV1_8 + | v >= [1,5] = CabalSpecV1_6 + | v >= [1,3] = CabalSpecV1_4 + | v >= [1,1] = CabalSpecV1_2 + | otherwise = CabalSpecV1_0 specHasCommonStanzas :: CabalSpecVersion -> HasCommonStanzas -specHasCommonStanzas CabalSpecV2_2 = HasCommonStanzas -specHasCommonStanzas CabalSpecV2_4 = HasCommonStanzas -specHasCommonStanzas _ = NoCommonStanzas +specHasCommonStanzas v = + if v >= CabalSpecV2_2 + then HasCommonStanzas + else NoCommonStanzas specHasElif :: CabalSpecVersion -> HasElif -specHasElif CabalSpecV2_2 = HasElif -specHasElif CabalSpecV2_4 = HasElif -specHasElif _ = NoElif - -------------------------------------------------------------------------------- --- Features -------------------------------------------------------------------------------- - -data CabalFeature - = Elif - | CommonStanzas - | Globstar - -- ^ Implemented in #5284. Not actually a change to the parser, - -- as filename patterns are opaque to it currently. - deriving (Eq, Ord, Show, Read, Enum, Bounded, Typeable, Data, Generic) +specHasElif v = + if v >= CabalSpecV2_2 + then HasElif + else NoElif ------------------------------------------------------------------------------- -- Booleans ------------------------------------------------------------------------------- +-- IDEA: make some kind of tagged booleans? data HasElif = HasElif | NoElif deriving (Eq, Show) diff --git a/cabal/Cabal/Distribution/Compat/CharParsing.hs b/cabal/Cabal/Distribution/Compat/CharParsing.hs --- a/cabal/Cabal/Distribution/Compat/CharParsing.hs +++ b/cabal/Cabal/Distribution/Compat/CharParsing.hs @@ -60,7 +60,6 @@ import Data.Text (Text, unpack) import qualified Text.Parsec as Parsec -import qualified Distribution.Compat.ReadP as ReadP import Distribution.Compat.Parsing @@ -309,13 +308,6 @@ notChar c = Parsec.satisfy (/= c) anyChar = Parsec.anyChar string = Parsec.string - -instance t ~ Char => CharParsing (ReadP.Parser r t) where - satisfy = ReadP.satisfy - char = ReadP.char - notChar c = ReadP.satisfy (/= c) - anyChar = ReadP.get - string = ReadP.string ------------------------------------------------------------------------------- -- Our additions diff --git a/cabal/Cabal/Distribution/Compat/CopyFile.hs b/cabal/Cabal/Distribution/Compat/CopyFile.hs --- a/cabal/Cabal/Distribution/Compat/CopyFile.hs +++ b/cabal/Cabal/Distribution/Compat/CopyFile.hs @@ -51,7 +51,17 @@ import System.Directory ( doesFileExist ) import System.FilePath - ( isRelative, normalise ) + ( addTrailingPathSeparator + , hasTrailingPathSeparator + , isPathSeparator + , isRelative + , joinDrive + , joinPath + , pathSeparator + , pathSeparators + , splitDirectories + , splitDrive + ) import System.IO ( IOMode(ReadMode), hFileSize , withBinaryFile ) @@ -113,16 +123,107 @@ -- | Add the @"\\\\?\\"@ prefix if necessary or possible. The path remains -- unchanged if the prefix is not added. This function can sometimes be used -- to bypass the @MAX_PATH@ length restriction in Windows API calls. +-- +-- See Note [Path normalization]. toExtendedLengthPath :: FilePath -> FilePath toExtendedLengthPath path | isRelative path = path | otherwise = - case normalise path of - '\\' : '?' : '?' : '\\' : _ -> path - '\\' : '\\' : '?' : '\\' : _ -> path - '\\' : '\\' : '.' : '\\' : _ -> path - '\\' : subpath@('\\' : _) -> "\\\\?\\UNC" <> subpath - normalisedPath -> "\\\\?\\" <> normalisedPath + case normalisedPath of + '\\' : '?' : '?' : '\\' : _ -> normalisedPath + '\\' : '\\' : '?' : '\\' : _ -> normalisedPath + '\\' : '\\' : '.' : '\\' : _ -> normalisedPath + '\\' : subpath@('\\' : _) -> "\\\\?\\UNC" <> subpath + _ -> "\\\\?\\" <> normalisedPath + where normalisedPath = simplifyWindows path + +-- | Similar to 'normalise' but: +-- +-- * empty paths stay empty, +-- * parent dirs (@..@) are expanded, and +-- * paths starting with @\\\\?\\@ are preserved. +-- +-- The goal is to preserve the meaning of paths better than 'normalise'. +-- +-- Note [Path normalization] +-- 'normalise' doesn't simplify path names but will convert / into \\ +-- this would normally not be a problem as once the path hits the RTS we would +-- have simplified the path then. However since we're calling the WIn32 API +-- directly we have to do the simplification before the call. Without this the +-- path Z:// would become Z:\\\\ and when converted to a device path the path +-- becomes \\?\Z:\\\\ which is an invalid path. +-- +-- This is not a bug in normalise as it explicitly states that it won't simplify +-- a FilePath. +simplifyWindows :: FilePath -> FilePath +simplifyWindows "" = "" +simplifyWindows path = + case drive' of + "\\\\?\\" -> drive' <> subpath + _ -> simplifiedPath + where + simplifiedPath = joinDrive drive' subpath' + (drive, subpath) = splitDrive path + drive' = upperDrive (normaliseTrailingSep (normalisePathSeps drive)) + subpath' = appendSep . avoidEmpty . prependSep . joinPath . + stripPardirs . expandDots . skipSeps . + splitDirectories $ subpath + + upperDrive d = case d of + c : ':' : s | isAlpha c && all isPathSeparator s -> toUpper c : ':' : s + _ -> d + skipSeps = filter (not . (`elem` (pure <$> pathSeparators))) + stripPardirs | pathIsAbsolute || subpathIsAbsolute = dropWhile (== "..") + | otherwise = id + prependSep | subpathIsAbsolute = (pathSeparator :) + | otherwise = id + avoidEmpty | not pathIsAbsolute + && (null drive || hasTrailingPathSep) -- prefer "C:" over "C:." + = emptyToCurDir + | otherwise = id + appendSep p | hasTrailingPathSep + && not (pathIsAbsolute && null p) + = addTrailingPathSeparator p + | otherwise = p + pathIsAbsolute = not (isRelative path) + subpathIsAbsolute = any isPathSeparator (take 1 subpath) + hasTrailingPathSep = hasTrailingPathSeparator subpath + +-- | Given a list of path segments, expand @.@ and @..@. The path segments +-- must not contain path separators. +expandDots :: [FilePath] -> [FilePath] +expandDots = reverse . go [] + where + go ys' xs' = + case xs' of + [] -> ys' + x : xs -> + case x of + "." -> go ys' xs + ".." -> + case ys' of + [] -> go (x : ys') xs + ".." : _ -> go (x : ys') xs + _ : ys -> go ys xs + _ -> go (x : ys') xs + +-- | Convert to the right kind of slashes. +normalisePathSeps :: FilePath -> FilePath +normalisePathSeps p = (\ c -> if isPathSeparator c then pathSeparator else c) <$> p + +-- | Remove redundant trailing slashes and pick the right kind of slash. +normaliseTrailingSep :: FilePath -> FilePath +normaliseTrailingSep path = do + let path' = reverse path + let (sep, path'') = span isPathSeparator path' + let addSep = if null sep then id else (pathSeparator :) + reverse (addSep path'') + +-- | Convert empty paths to the current directory, otherwise leave it +-- unchanged. +emptyToCurDir :: FilePath -> FilePath +emptyToCurDir "" = "." +emptyToCurDir path = path #endif /* mingw32_HOST_OS */ -- | Like `copyFile`, but does not touch the target if source and destination diff --git a/cabal/Cabal/Distribution/Compat/Directory.hs b/cabal/Cabal/Distribution/Compat/Directory.hs --- a/cabal/Cabal/Distribution/Compat/Directory.hs +++ b/cabal/Cabal/Distribution/Compat/Directory.hs @@ -38,7 +38,12 @@ #if !MIN_VERSION_directory(1,2,7) doesPathExist :: FilePath -> IO Bool -doesPathExist path = (||) <$> doesDirectoryExist path <*> doesFileExist path +doesPathExist path = do + -- not using Applicative, as this way we can do less IO + e <- doesDirectoryExist path + if e + then return True + else doesFileExist path #endif diff --git a/cabal/Cabal/Distribution/Compat/MonadFail.hs b/cabal/Cabal/Distribution/Compat/MonadFail.hs --- a/cabal/Cabal/Distribution/Compat/MonadFail.hs +++ b/cabal/Cabal/Distribution/Compat/MonadFail.hs @@ -1,36 +1,5 @@ {-# LANGUAGE CPP #-} -- | Compatibility layer for "Control.Monad.Fail" -module Distribution.Compat.MonadFail ( MonadFail(fail) ) where -#if __GLASGOW_HASKELL__ >= 800 --- provided by base-4.9.0.0 and later -import Control.Monad.Fail (MonadFail(fail)) -#else --- the following code corresponds to --- http://hackage.haskell.org/package/fail-4.9.0.0 -import qualified Prelude as P -import Distribution.Compat.Prelude hiding (fail) - -import Text.ParserCombinators.ReadP -import Text.ParserCombinators.ReadPrec - -class Monad m => MonadFail m where - fail :: String -> m a - --- instances provided by base-4.9 - -instance MonadFail Maybe where - fail _ = Nothing - -instance MonadFail [] where - fail _ = [] - -instance MonadFail P.IO where - fail = P.fail - -instance MonadFail ReadPrec where - fail = P.fail -- = P (\_ -> fail s) - -instance MonadFail ReadP where - fail = P.fail -#endif +module Distribution.Compat.MonadFail ( Control.Monad.Fail.MonadFail(fail) ) where +import Control.Monad.Fail diff --git a/cabal/Cabal/Distribution/Compat/Newtype.hs b/cabal/Cabal/Distribution/Compat/Newtype.hs --- a/cabal/Cabal/Distribution/Compat/Newtype.hs +++ b/cabal/Cabal/Distribution/Compat/Newtype.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} -- | Per Conor McBride, the 'Newtype' typeclass represents the packing and @@ -14,31 +16,50 @@ import Data.Functor.Identity (Identity (..)) import Data.Monoid (Sum (..), Product (..), Endo (..)) +#if MIN_VERSION_base(4,7,0) +import Data.Coerce (coerce, Coercible) +#else +import Unsafe.Coerce (unsafeCoerce) +#endif + -- | The @FunctionalDependencies@ version of 'Newtype' type-class. -- --- /Note:/ for actual newtypes the implementation can be --- @pack = coerce; unpack = coerce@. We don't have default implementation, --- because @Cabal@ have to support older than @base >= 4.7@ compilers. --- Also, 'Newtype' could witness a non-structural isomorphism. -class Newtype n o | n -> o where +-- Since Cabal-3.0 class arguments are in a different order than in @newtype@ package. +-- This change is to allow usage with @DeriveAnyClass@ (and @DerivingStrategies@, in GHC-8.2). +-- Unfortunately one have to repeat inner type. +-- +-- @ +-- newtype New = New Old +-- deriving anyclass (Newtype Old) +-- @ +-- +-- Another approach would be to use @TypeFamilies@ (and possibly +-- compute inner type using "GHC.Generics"), but we think @FunctionalDependencies@ +-- version gives cleaner type signatures. +-- +class Newtype o n | n -> o where pack :: o -> n - unpack :: n -> o - -instance Newtype (Identity a) a where - pack = Identity - unpack = runIdentity - -instance Newtype (Sum a) a where - pack = Sum - unpack = getSum +#if MIN_VERSION_base(4,7,0) + default pack :: Coercible o n => o -> n + pack = coerce +#else + default pack :: o -> n + pack = unsafeCoerce +#endif -instance Newtype (Product a) a where - pack = Product - unpack = getProduct + unpack :: n -> o +#if MIN_VERSION_base(4,7,0) + default unpack :: Coercible n o => n -> o + unpack = coerce +#else + default unpack :: n -> o + unpack = unsafeCoerce +#endif -instance Newtype (Endo a) (a -> a) where - pack = Endo - unpack = appEndo +instance Newtype a (Identity a) +instance Newtype a (Sum a) +instance Newtype a (Product a) +instance Newtype (a -> a) (Endo a) -- | -- @@ -49,7 +70,7 @@ -- -- >>> ala (Sum . (+1)) foldMap [1, 2, 3, 4 :: Int] -- 10 -ala :: (Newtype n o, Newtype n' o') => (o -> n) -> ((o -> n) -> b -> n') -> (b -> o') +ala :: (Newtype o n, Newtype o' n') => (o -> n) -> ((o -> n) -> b -> n') -> (b -> o') ala pa hof = alaf pa hof id -- | @@ -58,13 +79,13 @@ -- 12 -- -- /Note:/ as with 'ala', the user supplied function for the newtype is /ignored/. -alaf :: (Newtype n o, Newtype n' o') => (o -> n) -> ((a -> n) -> b -> n') -> (a -> o) -> (b -> o') +alaf :: (Newtype o n, Newtype o' n') => (o -> n) -> ((a -> n) -> b -> n') -> (a -> o) -> (b -> o') alaf _ hof f = unpack . hof (pack . f) -- | Variant of 'pack', which takes a phantom type. -pack' :: Newtype n o => (o -> n) -> o -> n +pack' :: Newtype o n => (o -> n) -> o -> n pack' _ = pack -- | Variant of 'pack', which takes a phantom type. -unpack' :: Newtype n o => (o -> n) -> n -> o +unpack' :: Newtype o n => (o -> n) -> n -> o unpack' _ = unpack diff --git a/cabal/Cabal/Distribution/Compat/Parsing.hs b/cabal/Cabal/Distribution/Compat/Parsing.hs --- a/cabal/Cabal/Distribution/Compat/Parsing.hs +++ b/cabal/Cabal/Distribution/Compat/Parsing.hs @@ -26,7 +26,7 @@ , many -- from Control.Applicative , sepBy , sepBy1 - -- , sepByNonEmpty + , sepByNonEmpty , sepEndBy1 -- , sepEndByNonEmpty , sepEndBy @@ -59,7 +59,6 @@ import Data.Foldable (asum) import qualified Text.Parsec as Parsec -import qualified Distribution.Compat.ReadP as ReadP -- | @choice ps@ tries to apply the parsers in the list @ps@ in order, -- until one of them succeeds. Returns the value of the succeeding @@ -107,13 +106,11 @@ -- toList <$> sepByNonEmpty p sep {-# INLINE sepBy1 #-} -{- -- | @sepByNonEmpty p sep@ parses /one/ or more occurrences of @p@, separated -- by @sep@. Returns a non-empty list of values returned by @p@. sepByNonEmpty :: Alternative m => m a -> m sep -> m (NonEmpty a) sepByNonEmpty p sep = (:|) <$> p <*> many (sep *> p) {-# INLINE sepByNonEmpty #-} --} -- | @sepEndBy1 p sep@ parses /one/ or more occurrences of @p@, -- separated and optionally ended by @sep@. Returns a list of values @@ -389,15 +386,3 @@ unexpected = Parsec.unexpected eof = Parsec.eof notFollowedBy = Parsec.notFollowedBy - -instance t ~ Char => Parsing (ReadP.Parser r t) where - try = id - () = const - skipMany = ReadP.skipMany - skipSome = ReadP.skipMany1 - unexpected = const ReadP.pfail - eof = ReadP.eof - - -- TODO: we would like to have <++ here - notFollowedBy p = ((Just <$> p) ReadP.+++ pure Nothing) - >>= maybe (pure ()) (unexpected . show) diff --git a/cabal/Cabal/Distribution/Compat/Prelude.hs b/cabal/Cabal/Distribution/Compat/Prelude.hs --- a/cabal/Cabal/Distribution/Compat/Prelude.hs +++ b/cabal/Cabal/Distribution/Compat/Prelude.hs @@ -4,16 +4,18 @@ {-# LANGUAGE FlexibleContexts #-} #ifdef MIN_VERSION_base +#define MINVER_base_411 MIN_VERSION_base(4,11,0) #define MINVER_base_48 MIN_VERSION_base(4,8,0) #define MINVER_base_47 MIN_VERSION_base(4,7,0) #else +#define MINVER_base_411 (__GLASGOW_HASKELL__ >= 804) #define MINVER_base_48 (__GLASGOW_HASKELL__ >= 710) #define MINVER_base_47 (__GLASGOW_HASKELL__ >= 708) #endif -- | This module does two things: -- --- * Acts as a compatiblity layer, like @base-compat@. +-- * Acts as a compatibility layer, like @base-compat@. -- -- * Provides commonly used imports. module Distribution.Compat.Prelude ( @@ -57,6 +59,9 @@ sort, sortBy, nub, nubBy, + -- * Data.List.NonEmpty + NonEmpty((:|)), foldl1, foldr1, + -- * Data.Foldable Foldable, foldMap, foldr, null, length, @@ -89,11 +94,21 @@ -- * Text.PrettyPrint (<<>>), - ) where + -- * Text.Read + readMaybe, + ) where -- We also could hide few partial function import Prelude as BasePrelude hiding ( IO, mapM, mapM_, sequence, null, length, foldr, any, all + -- partial functions + , read + , foldr1, foldl1 +#if MINVER_base_411 + -- As of base 4.11.0.0 Prelude exports part of Semigroup(..). + -- Hide this so we instead rely on Distribution.Compat.Semigroup. + , Semigroup(..) +#endif #if MINVER_base_48 , Word -- We hide them, as we import only some members @@ -111,6 +126,7 @@ import Data.Foldable (Foldable (foldMap, foldr), find, foldl', for_, traverse_, any, all) import Data.Traversable (Traversable (traverse, sequenceA), for) +import qualified Data.Foldable import Control.Applicative (Alternative (..)) import Control.DeepSeq (NFData (..)) @@ -130,10 +146,12 @@ import Data.List (intercalate, intersperse, isPrefixOf, isSuffixOf, nub, nubBy, sort, sortBy, unfoldr) +import Data.List.NonEmpty (NonEmpty((:|))) import Data.Maybe import Data.String (IsString (..)) import Data.Int import Data.Word +import Text.Read (readMaybe) import qualified Text.PrettyPrint as Disp @@ -202,3 +220,28 @@ grnf (L1 x) = grnf x grnf (R1 x) = grnf x {-# INLINEABLE grnf #-} + + +-- TODO: if we want foldr1/foldl1 to work on more than NonEmpty, we +-- can define a local typeclass 'Foldable1', e.g. +-- +-- @ +-- class Foldable f => Foldable1 f +-- +-- instance Foldable1 NonEmpty +-- +-- foldr1 :: Foldable1 t => (a -> a -> a) -> t a -> a +-- foldr1 = Data.Foldable.foldr1 +-- +-- foldl1 :: Foldable1 t => (a -> a -> a) -> t a -> a +-- foldl1 = Data.Foldable.foldl1 +-- @ +-- + +{-# INLINE foldr1 #-} +foldr1 :: (a -> a -> a) -> NonEmpty a -> a +foldr1 = Data.Foldable.foldr1 + +{-# INLINE foldl1 #-} +foldl1 :: (a -> a -> a) -> NonEmpty a -> a +foldl1 = Data.Foldable.foldl1 diff --git a/cabal/Cabal/Distribution/Compat/ReadP.hs b/cabal/Cabal/Distribution/Compat/ReadP.hs deleted file mode 100644 --- a/cabal/Cabal/Distribution/Compat/ReadP.hs +++ /dev/null @@ -1,424 +0,0 @@ -{-# LANGUAGE GADTs #-} ------------------------------------------------------------------------------ --- | --- Module : Distribution.Compat.ReadP --- Copyright : (c) The University of Glasgow 2002 --- License : BSD-style (see the file libraries/base/LICENSE) --- --- Maintainer : libraries@haskell.org --- Portability : portable --- --- This is a library of parser combinators, originally written by Koen Claessen. --- It parses all alternatives in parallel, so it never keeps hold of --- the beginning of the input string, a common source of space leaks with --- other parsers. The '(+++)' choice combinator is genuinely commutative; --- it makes no difference which branch is \"shorter\". --- --- See also Koen's paper /Parallel Parsing Processes/ --- (). --- --- This version of ReadP has been locally hacked to make it H98, by --- Martin Sjögren --- --- The unit tests have been moved to UnitTest.Distribution.Compat.ReadP, by --- Mark Lentczner ------------------------------------------------------------------------------ - -module Distribution.Compat.ReadP - ( - -- * The 'ReadP' type - ReadP, -- :: * -> *; instance Functor, Monad, MonadPlus - - -- * Primitive operations - get, -- :: ReadP Char - look, -- :: ReadP String - (+++), -- :: ReadP a -> ReadP a -> ReadP a - (<++), -- :: ReadP a -> ReadP a -> ReadP a - gather, -- :: ReadP a -> ReadP (String, a) - - -- * Other operations - pfail, -- :: ReadP a - eof, -- :: ReadP () - satisfy, -- :: (Char -> Bool) -> ReadP Char - char, -- :: Char -> ReadP Char - string, -- :: String -> ReadP String - munch, -- :: (Char -> Bool) -> ReadP String - munch1, -- :: (Char -> Bool) -> ReadP String - skipSpaces, -- :: ReadP () - skipSpaces1,-- :: ReadP () - choice, -- :: [ReadP a] -> ReadP a - count, -- :: Int -> ReadP a -> ReadP [a] - between, -- :: ReadP open -> ReadP close -> ReadP a -> ReadP a - option, -- :: a -> ReadP a -> ReadP a - optional, -- :: ReadP a -> ReadP () - many, -- :: ReadP a -> ReadP [a] - many1, -- :: ReadP a -> ReadP [a] - skipMany, -- :: ReadP a -> ReadP () - skipMany1, -- :: ReadP a -> ReadP () - sepBy, -- :: ReadP a -> ReadP sep -> ReadP [a] - sepBy1, -- :: ReadP a -> ReadP sep -> ReadP [a] - endBy, -- :: ReadP a -> ReadP sep -> ReadP [a] - endBy1, -- :: ReadP a -> ReadP sep -> ReadP [a] - chainr, -- :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a - chainl, -- :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a - chainl1, -- :: ReadP a -> ReadP (a -> a -> a) -> ReadP a - chainr1, -- :: ReadP a -> ReadP (a -> a -> a) -> ReadP a - manyTill, -- :: ReadP a -> ReadP end -> ReadP [a] - - -- * Running a parser - ReadS, -- :: *; = String -> [(a,String)] - readP_to_S, -- :: ReadP a -> ReadS a - readS_to_P, -- :: ReadS a -> ReadP a - - -- ** Internal - Parser, - ) - where - -import Prelude () -import Distribution.Compat.Prelude hiding (many, get) - -import qualified Distribution.Compat.MonadFail as Fail - -import Control.Monad( replicateM, (>=>) ) - -infixr 5 +++, <++ - --- --------------------------------------------------------------------------- --- The P type --- is representation type -- should be kept abstract - -data P s a - = Get (s -> P s a) - | Look ([s] -> P s a) - | Fail - | Result a (P s a) - | Final [(a,[s])] -- invariant: list is non-empty! - --- Monad, MonadPlus - -instance Functor (P s) where - fmap = liftM - -instance Applicative (P s) where - pure x = Result x Fail - (<*>) = ap - -instance Monad (P s) where - return = pure - - (Get f) >>= k = Get (f >=> k) - (Look f) >>= k = Look (f >=> k) - Fail >>= _ = Fail - (Result x p) >>= k = k x `mplus` (p >>= k) - (Final r) >>= k = final [ys' | (x,s) <- r, ys' <- run (k x) s] - - fail = Fail.fail - -instance Fail.MonadFail (P s) where - fail _ = Fail - -instance Alternative (P s) where - empty = mzero - (<|>) = mplus - -instance MonadPlus (P s) where - mzero = Fail - - -- most common case: two gets are combined - Get f1 `mplus` Get f2 = Get (\c -> f1 c `mplus` f2 c) - - -- results are delivered as soon as possible - Result x p `mplus` q = Result x (p `mplus` q) - p `mplus` Result x q = Result x (p `mplus` q) - - -- fail disappears - Fail `mplus` p = p - p `mplus` Fail = p - - -- two finals are combined - -- final + look becomes one look and one final (=optimization) - -- final + sthg else becomes one look and one final - Final r `mplus` Final t = Final (r ++ t) - Final r `mplus` Look f = Look (\s -> Final (r ++ run (f s) s)) - Final r `mplus` p = Look (\s -> Final (r ++ run p s)) - Look f `mplus` Final r = Look (\s -> Final (run (f s) s ++ r)) - p `mplus` Final r = Look (\s -> Final (run p s ++ r)) - - -- two looks are combined (=optimization) - -- look + sthg else floats upwards - Look f `mplus` Look g = Look (\s -> f s `mplus` g s) - Look f `mplus` p = Look (\s -> f s `mplus` p) - p `mplus` Look f = Look (\s -> p `mplus` f s) - --- --------------------------------------------------------------------------- --- The ReadP type - -newtype Parser r s a = R ((a -> P s r) -> P s r) -type ReadP r a = Parser r Char a - --- Functor, Monad, MonadPlus - -instance Functor (Parser r s) where - fmap h (R f) = R (\k -> f (k . h)) - -instance Applicative (Parser r s) where - pure x = R (\k -> k x) - (<*>) = ap - -instance s ~ Char => Alternative (Parser r s) where - empty = pfail - (<|>) = (+++) - -instance Monad (Parser r s) where - return = pure - fail = Fail.fail - R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k)) - -instance Fail.MonadFail (Parser r s) where - fail _ = R (const Fail) - -instance s ~ Char => MonadPlus (Parser r s) where - mzero = pfail - mplus = (+++) - --- --------------------------------------------------------------------------- --- Operations over P - -final :: [(a,[s])] -> P s a --- Maintains invariant for Final constructor -final [] = Fail -final r = Final r - -run :: P c a -> ([c] -> [(a, [c])]) -run (Get f) (c:s) = run (f c) s -run (Look f) s = run (f s) s -run (Result x p) s = (x,s) : run p s -run (Final r) _ = r -run _ _ = [] - --- --------------------------------------------------------------------------- --- Operations over ReadP - -get :: ReadP r Char --- ^ Consumes and returns the next character. --- Fails if there is no input left. -get = R Get - -look :: ReadP r String --- ^ Look-ahead: returns the part of the input that is left, without --- consuming it. -look = R Look - -pfail :: ReadP r a --- ^ Always fails. -pfail = R (const Fail) - -eof :: ReadP r () --- ^ Succeeds iff we are at the end of input -eof = do { s <- look - ; if null s then return () - else pfail } - -(+++) :: ReadP r a -> ReadP r a -> ReadP r a --- ^ Symmetric choice. -R f1 +++ R f2 = R (\k -> f1 k `mplus` f2 k) - -(<++) :: ReadP a a -> ReadP r a -> ReadP r a --- ^ Local, exclusive, left-biased choice: If left parser --- locally produces any result at all, then right parser is --- not used. -R f <++ q = - do s <- look - probe (f return) s 0 - where - probe (Get f') (c:s) n = probe (f' c) s (n+1 :: Int) - probe (Look f') s n = probe (f' s) s n - probe p@(Result _ _) _ n = discard n >> R (p >>=) - probe (Final r) _ _ = R (Final r >>=) - probe _ _ _ = q - - discard 0 = return () - discard n = get >> discard (n-1 :: Int) - -gather :: ReadP (String -> P Char r) a -> ReadP r (String, a) --- ^ Transforms a parser into one that does the same, but --- in addition returns the exact characters read. --- IMPORTANT NOTE: 'gather' gives a runtime error if its first argument --- is built using any occurrences of readS_to_P. -gather (R m) = - R (\k -> gath id (m (\a -> return (\s -> k (s,a))))) - where - gath l (Get f) = Get (\c -> gath (l.(c:)) (f c)) - gath _ Fail = Fail - gath l (Look f) = Look (gath l . f) - gath l (Result k p) = k (l []) `mplus` gath l p - gath _ (Final _) = error "do not use readS_to_P in gather!" - --- --------------------------------------------------------------------------- --- Derived operations - -satisfy :: (Char -> Bool) -> ReadP r Char --- ^ Consumes and returns the next character, if it satisfies the --- specified predicate. -satisfy p = do c <- get; if p c then return c else pfail - -char :: Char -> ReadP r Char --- ^ Parses and returns the specified character. -char c = satisfy (c ==) - -string :: String -> ReadP r String --- ^ Parses and returns the specified string. -string this = do s <- look; scan this s - where - scan [] _ = return this - scan (x:xs) (y:ys) | x == y = get >> scan xs ys - scan _ _ = pfail - -munch :: (Char -> Bool) -> ReadP r String --- ^ Parses the first zero or more characters satisfying the predicate. -munch p = - do s <- look - scan s - where - scan (c:cs) | p c = do _ <- get; s <- scan cs; return (c:s) - scan _ = do return "" - -munch1 :: (Char -> Bool) -> ReadP r String --- ^ Parses the first one or more characters satisfying the predicate. -munch1 p = - do c <- get - if p c then do s <- munch p; return (c:s) - else pfail - -choice :: [ReadP r a] -> ReadP r a --- ^ Combines all parsers in the specified list. -choice [] = pfail -choice [p] = p -choice (p:ps) = p +++ choice ps - -skipSpaces :: ReadP r () --- ^ Skips all whitespace. -skipSpaces = - do s <- look - skip s - where - skip (c:s) | isSpace c = do _ <- get; skip s - skip _ = do return () - -skipSpaces1 :: ReadP r () --- ^ Like 'skipSpaces' but succeeds only if there is at least one --- whitespace character to skip. -skipSpaces1 = satisfy isSpace >> skipSpaces - -count :: Int -> ReadP r a -> ReadP r [a] --- ^ @ count n p @ parses @n@ occurrences of @p@ in sequence. A list of --- results is returned. -count n p = replicateM n p - -between :: ReadP r open -> ReadP r close -> ReadP r a -> ReadP r a --- ^ @ between open close p @ parses @open@, followed by @p@ and finally --- @close@. Only the value of @p@ is returned. -between open close p = do _ <- open - x <- p - _ <- close - return x - -option :: a -> ReadP r a -> ReadP r a --- ^ @option x p@ will either parse @p@ or return @x@ without consuming --- any input. -option x p = p +++ return x - -optional :: ReadP r a -> ReadP r () --- ^ @optional p@ optionally parses @p@ and always returns @()@. -optional p = (p >> return ()) +++ return () - -many :: ReadP r a -> ReadP r [a] --- ^ Parses zero or more occurrences of the given parser. -many p = return [] +++ many1 p - -many1 :: ReadP r a -> ReadP r [a] --- ^ Parses one or more occurrences of the given parser. -many1 p = liftM2 (:) p (many p) - -skipMany :: ReadP r a -> ReadP r () --- ^ Like 'many', but discards the result. -skipMany p = many p >> return () - -skipMany1 :: ReadP r a -> ReadP r () --- ^ Like 'many1', but discards the result. -skipMany1 p = p >> skipMany p - -sepBy :: ReadP r a -> ReadP r sep -> ReadP r [a] --- ^ @sepBy p sep@ parses zero or more occurrences of @p@, separated by @sep@. --- Returns a list of values returned by @p@. -sepBy p sep = sepBy1 p sep +++ return [] - -sepBy1 :: ReadP r a -> ReadP r sep -> ReadP r [a] --- ^ @sepBy1 p sep@ parses one or more occurrences of @p@, separated by @sep@. --- Returns a list of values returned by @p@. -sepBy1 p sep = liftM2 (:) p (many (sep >> p)) - -endBy :: ReadP r a -> ReadP r sep -> ReadP r [a] --- ^ @endBy p sep@ parses zero or more occurrences of @p@, separated and ended --- by @sep@. -endBy p sep = many (do x <- p ; _ <- sep ; return x) - -endBy1 :: ReadP r a -> ReadP r sep -> ReadP r [a] --- ^ @endBy p sep@ parses one or more occurrences of @p@, separated and ended --- by @sep@. -endBy1 p sep = many1 (do x <- p ; _ <- sep ; return x) - -chainr :: ReadP r a -> ReadP r (a -> a -> a) -> a -> ReadP r a --- ^ @chainr p op x@ parses zero or more occurrences of @p@, separated by @op@. --- Returns a value produced by a /right/ associative application of all --- functions returned by @op@. If there are no occurrences of @p@, @x@ is --- returned. -chainr p op x = chainr1 p op +++ return x - -chainl :: ReadP r a -> ReadP r (a -> a -> a) -> a -> ReadP r a --- ^ @chainl p op x@ parses zero or more occurrences of @p@, separated by @op@. --- Returns a value produced by a /left/ associative application of all --- functions returned by @op@. If there are no occurrences of @p@, @x@ is --- returned. -chainl p op x = chainl1 p op +++ return x - -chainr1 :: ReadP r a -> ReadP r (a -> a -> a) -> ReadP r a --- ^ Like 'chainr', but parses one or more occurrences of @p@. -chainr1 p op = scan - where scan = p >>= rest - rest x = do f <- op - y <- scan - return (f x y) - +++ return x - -chainl1 :: ReadP r a -> ReadP r (a -> a -> a) -> ReadP r a --- ^ Like 'chainl', but parses one or more occurrences of @p@. -chainl1 p op = p >>= rest - where rest x = do f <- op - y <- p - rest (f x y) - +++ return x - -manyTill :: ReadP r a -> ReadP [a] end -> ReadP r [a] --- ^ @manyTill p end@ parses zero or more occurrences of @p@, until @end@ --- succeeds. Returns a list of values returned by @p@. -manyTill p end = scan - where scan = (end >> return []) <++ (liftM2 (:) p scan) - --- --------------------------------------------------------------------------- --- Converting between ReadP and Read - -readP_to_S :: ReadP a a -> ReadS a --- ^ Converts a parser into a Haskell ReadS-style function. --- This is the main way in which you can \"run\" a 'ReadP' parser: --- the expanded type is --- @ readP_to_S :: ReadP a -> String -> [(a,String)] @ -readP_to_S (R f) = run (f return) - -readS_to_P :: ReadS a -> ReadP r a --- ^ Converts a Haskell ReadS-style function into a parser. --- Warning: This introduces local backtracking in the resulting --- parser, and therefore a possible inefficiency. -readS_to_P r = - R (\k -> Look (\s -> final [bs'' | (a,s') <- r s, bs'' <- run (k a) s'])) diff --git a/cabal/Cabal/Distribution/Compat/ResponseFile.hs b/cabal/Cabal/Distribution/Compat/ResponseFile.hs new file mode 100644 --- /dev/null +++ b/cabal/Cabal/Distribution/Compat/ResponseFile.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE CPP, RankNTypes, FlexibleContexts #-} + +-- Compatibility layer for GHC.ResponseFile +-- Implementation from base 4.12.0 is used. +-- http://hackage.haskell.org/package/base-4.12.0.0/src/LICENSE +module Distribution.Compat.ResponseFile (expandResponse) where + +import Prelude (mapM) +import Distribution.Compat.Prelude + +import System.Exit +import System.FilePath +import System.IO (hPutStrLn, stderr) +import System.IO.Error + +#if MIN_VERSION_base(4,12,0) +import GHC.ResponseFile (unescapeArgs) +#else + +unescapeArgs :: String -> [String] +unescapeArgs = filter (not . null) . unescape + +data Quoting = NoneQ | SngQ | DblQ + +unescape :: String -> [String] +unescape args = reverse . map reverse $ go args NoneQ False [] [] + where + -- n.b., the order of these cases matters; these are cribbed from gcc + -- case 1: end of input + go [] _q _bs a as = a:as + -- case 2: back-slash escape in progress + go (c:cs) q True a as = go cs q False (c:a) as + -- case 3: no back-slash escape in progress, but got a back-slash + go (c:cs) q False a as + | '\\' == c = go cs q True a as + -- case 4: single-quote escaping in progress + go (c:cs) SngQ False a as + | '\'' == c = go cs NoneQ False a as + | otherwise = go cs SngQ False (c:a) as + -- case 5: double-quote escaping in progress + go (c:cs) DblQ False a as + | '"' == c = go cs NoneQ False a as + | otherwise = go cs DblQ False (c:a) as + -- case 6: no escaping is in progress + go (c:cs) NoneQ False a as + | isSpace c = go cs NoneQ False [] (a:as) + | '\'' == c = go cs SngQ False a as + | '"' == c = go cs DblQ False a as + | otherwise = go cs NoneQ False (c:a) as + +#endif + +expandResponse :: [String] -> IO [String] +expandResponse = go recursionLimit "." + where + recursionLimit = 100 + + go :: Int -> FilePath -> [String] -> IO [String] + go n dir + | n >= 0 = fmap concat . mapM (expand n dir) + | otherwise = const $ hPutStrLn stderr "Error: response file recursion limit exceeded." >> exitFailure + + expand :: Int -> FilePath -> String -> IO [String] + expand n dir arg@('@':f) = readRecursively n (dir f) `catchIOError` (const $ print "?" >> return [arg]) + expand _n _dir x = return [x] + + readRecursively :: Int -> FilePath -> IO [String] + readRecursively n f = go (n - 1) (takeDirectory f) =<< unescapeArgs <$> readFile f diff --git a/cabal/Cabal/Distribution/Compat/Semigroup.hs b/cabal/Cabal/Distribution/Compat/Semigroup.hs --- a/cabal/Cabal/Distribution/Compat/Semigroup.hs +++ b/cabal/Cabal/Distribution/Compat/Semigroup.hs @@ -11,113 +11,54 @@ , All(..) , Any(..) + , First'(..) , Last'(..) + , Option'(..) + , gmappend , gmempty ) where import Distribution.Compat.Binary (Binary) -import Control.Applicative as App import GHC.Generics -#if __GLASGOW_HASKELL__ >= 711 --- Data.Semigroup is available since GHC 8.0/base-4.9 +-- Data.Semigroup is available since GHC 8.0/base-4.9 in `base` +-- for older GHC/base, it's provided by `semigroups` import Data.Semigroup import qualified Data.Monoid as Mon -#else --- provide internal simplified non-exposed class for older GHCs -import Data.Monoid as Mon (Monoid(..), All(..), Any(..), Dual(..)) --- containers -import Data.Set (Set) -import Data.IntSet (IntSet) -import Data.Map (Map) -import Data.IntMap (IntMap) -class Semigroup a where - (<>) :: a -> a -> a - --- several primitive instances -instance Semigroup () where - _ <> _ = () - -instance Semigroup [a] where - (<>) = (++) - -instance Semigroup a => Semigroup (Dual a) where - Dual a <> Dual b = Dual (b <> a) - -instance Semigroup a => Semigroup (Maybe a) where - Nothing <> b = b - a <> Nothing = a - Just a <> Just b = Just (a <> b) - -instance Semigroup (Either a b) where - Left _ <> b = b - a <> _ = a - -instance Semigroup Ordering where - LT <> _ = LT - EQ <> y = y - GT <> _ = GT - -instance Semigroup b => Semigroup (a -> b) where - f <> g = \a -> f a <> g a - -instance Semigroup All where - All a <> All b = All (a && b) - -instance Semigroup Any where - Any a <> Any b = Any (a || b) - -instance (Semigroup a, Semigroup b) => Semigroup (a, b) where - (a,b) <> (a',b') = (a<>a',b<>b') - -instance (Semigroup a, Semigroup b, Semigroup c) - => Semigroup (a, b, c) where - (a,b,c) <> (a',b',c') = (a<>a',b<>b',c<>c') - -instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d) - => Semigroup (a, b, c, d) where - (a,b,c,d) <> (a',b',c',d') = (a<>a',b<>b',c<>c',d<>d') - -instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e) - => Semigroup (a, b, c, d, e) where - (a,b,c,d,e) <> (a',b',c',d',e') = (a<>a',b<>b',c<>c',d<>d',e<>e') +-- | A copy of 'Data.Semigroup.First'. +newtype First' a = First' { getFirst' :: a } + deriving (Eq, Ord, Show) --- containers instances -instance Semigroup IntSet where - (<>) = mappend +instance Semigroup (First' a) where + a <> _ = a -instance Ord a => Semigroup (Set a) where - (<>) = mappend +-- | A copy of 'Data.Semigroup.Last'. +newtype Last' a = Last' { getLast' :: a } + deriving (Eq, Ord, Read, Show, Binary) -instance Semigroup (IntMap v) where - (<>) = mappend +instance Semigroup (Last' a) where + _ <> b = b -instance Ord k => Semigroup (Map k v) where - (<>) = mappend -#endif +instance Functor Last' where + fmap f (Last' x) = Last' (f x) --- | Cabal's own 'Data.Monoid.Last' copy to avoid requiring an orphan --- 'Binary' instance. --- --- Once the oldest `binary` version we support provides a 'Binary' --- instance for 'Data.Monoid.Last' we can remove this one here. --- --- NB: 'Data.Semigroup.Last' is defined differently and not a 'Monoid' -newtype Last' a = Last' { getLast' :: Maybe a } - deriving (Eq, Ord, Read, Show, Binary, - Functor, App.Applicative, Generic) +-- | A wrapper around 'Maybe', providing the 'Semigroup' and 'Monoid' instances +-- implemented for 'Maybe' since @base-4.11@. +newtype Option' a = Option' { getOption' :: Maybe a } + deriving (Eq, Ord, Read, Show, Binary, Functor) -instance Semigroup (Last' a) where - x <> Last' Nothing = x - _ <> x = x +instance Semigroup a => Semigroup (Option' a) where + Option' (Just a) <> Option' (Just b) = Option' (Just (a <> b)) + Option' Nothing <> b = b + a <> Option' Nothing = a -instance Monoid (Last' a) where - mempty = Last' Nothing - mappend = (<>) +instance Semigroup a => Monoid (Option' a) where + mempty = Option' Nothing + mappend = (<>) ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- diff --git a/cabal/Cabal/Distribution/Compiler.hs b/cabal/Cabal/Distribution/Compiler.hs --- a/cabal/Cabal/Distribution/Compiler.hs +++ b/cabal/Cabal/Distribution/Compiler.hs @@ -30,10 +30,13 @@ buildCompilerId, buildCompilerFlavor, defaultCompilerFlavor, - parseCompilerFlavorCompat, classifyCompilerFlavor, knownCompilerFlavors, + -- * Per compiler flavor + PerCompilerFlavor (..), + perCompilerFlavorToList, + -- * Compiler id CompilerId(..), @@ -51,10 +54,8 @@ import Distribution.Version (Version, mkVersion', nullVersion) import qualified System.Info (compilerName, compilerVersion) -import Distribution.Parsec.Class (Parsec (..)) -import Distribution.Pretty (Pretty (..)) -import Distribution.Text (Text(..), display) -import qualified Distribution.Compat.ReadP as Parse +import Distribution.Parsec (Parsec (..)) +import Distribution.Pretty (Pretty (..), prettyShow) import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp @@ -85,44 +86,13 @@ cs <- P.munch1 isAlphaNum if all isDigit cs then fail "all digits compiler name" else return cs -instance Text CompilerFlavor where - parse = do - comp <- Parse.munch1 isAlphaNum - when (all isDigit comp) Parse.pfail - return (classifyCompilerFlavor comp) - classifyCompilerFlavor :: String -> CompilerFlavor classifyCompilerFlavor s = fromMaybe (OtherCompiler s) $ lookup (lowercase s) compilerMap where - compilerMap = [ (lowercase (display compiler), compiler) + compilerMap = [ (lowercase (prettyShow compiler), compiler) | compiler <- knownCompilerFlavors ] - ---TODO: In some future release, remove 'parseCompilerFlavorCompat' and use --- ordinary 'parse'. Also add ("nhc", NHC) to the above 'compilerMap'. - --- | Like 'classifyCompilerFlavor' but compatible with the old ReadS parser. --- --- It is compatible in the sense that it accepts only the same strings, --- eg "GHC" but not "ghc". However other strings get mapped to 'OtherCompiler'. --- The point of this is that we do not allow extra valid values that would --- upset older Cabal versions that had a stricter parser however we cope with --- new values more gracefully so that we'll be able to introduce new value in --- future without breaking things so much. --- -parseCompilerFlavorCompat :: Parse.ReadP r CompilerFlavor -parseCompilerFlavorCompat = do - comp <- Parse.munch1 isAlphaNum - when (all isDigit comp) Parse.pfail - case lookup comp compilerMap of - Just compiler -> return compiler - Nothing -> return (OtherCompiler comp) - where - compilerMap = [ (show compiler, compiler) - | compiler <- knownCompilerFlavors - , compiler /= YHC ] - buildCompilerFlavor :: CompilerFlavor buildCompilerFlavor = classifyCompilerFlavor System.Info.compilerName @@ -143,6 +113,31 @@ OtherCompiler _ -> Nothing _ -> Just buildCompilerFlavor +------------------------------------------------------------------------------- +-- Per compiler data +------------------------------------------------------------------------------- + +-- | 'PerCompilerFlavor' carries only info per GHC and GHCJS +-- +-- Cabal parses only @ghc-options@ and @ghcjs-options@, others are omitted. +-- +data PerCompilerFlavor v = PerCompilerFlavor v v + deriving (Generic, Show, Read, Eq, Typeable, Data) + +instance Binary a => Binary (PerCompilerFlavor a) +instance NFData a => NFData (PerCompilerFlavor a) + +perCompilerFlavorToList :: PerCompilerFlavor v -> [(CompilerFlavor, v)] +perCompilerFlavorToList (PerCompilerFlavor a b) = [(GHC, a), (GHCJS, b)] + +instance Semigroup a => Semigroup (PerCompilerFlavor a) where + PerCompilerFlavor a b <> PerCompilerFlavor a' b' = PerCompilerFlavor + (a <> a') (b <> b') + +instance (Semigroup a, Monoid a) => Monoid (PerCompilerFlavor a) where + mempty = PerCompilerFlavor mempty mempty + mappend = (<>) + -- ------------------------------------------------------------ -- * Compiler Id -- ------------------------------------------------------------ @@ -154,14 +149,15 @@ instance NFData CompilerId where rnf = genericRnf -instance Text CompilerId where - disp (CompilerId f v) - | v == nullVersion = disp f - | otherwise = disp f <<>> Disp.char '-' <<>> disp v +instance Pretty CompilerId where + pretty (CompilerId f v) + | v == nullVersion = pretty f + | otherwise = pretty f <<>> Disp.char '-' <<>> pretty v - parse = do - flavour <- parse - version <- (Parse.char '-' >> parse) Parse.<++ return nullVersion +instance Parsec CompilerId where + parsec = do + flavour <- parsec + version <- (P.char '-' >> parsec) <|> return nullVersion return (CompilerId flavour version) lowercase :: String -> String @@ -200,12 +196,13 @@ instance Binary AbiTag -instance Text AbiTag where - disp NoAbiTag = Disp.empty - disp (AbiTag tag) = Disp.text tag +instance Pretty AbiTag where + pretty NoAbiTag = Disp.empty + pretty (AbiTag tag) = Disp.text tag - parse = do - tag <- Parse.munch (\c -> isAlphaNum c || c == '_') +instance Parsec AbiTag where + parsec = do + tag <- P.munch (\c -> isAlphaNum c || c == '_') if null tag then return NoAbiTag else return (AbiTag tag) abiTagString :: AbiTag -> String diff --git a/cabal/Cabal/Distribution/FieldGrammar.hs b/cabal/Cabal/Distribution/FieldGrammar.hs --- a/cabal/Cabal/Distribution/FieldGrammar.hs +++ b/cabal/Cabal/Distribution/FieldGrammar.hs @@ -9,7 +9,6 @@ optionalField, optionalFieldDef, monoidalField, - deprecatedField', -- * Concrete grammar implementations ParsecFieldGrammar, ParsecFieldGrammar', @@ -36,7 +35,7 @@ import Distribution.FieldGrammar.Class import Distribution.FieldGrammar.Parsec import Distribution.FieldGrammar.Pretty -import Distribution.Parsec.Field +import Distribution.Fields.Field import Distribution.Utils.Generic (spanMaybe) type ParsecFieldGrammar' a = ParsecFieldGrammar a a diff --git a/cabal/Cabal/Distribution/FieldGrammar/Class.hs b/cabal/Cabal/Distribution/FieldGrammar/Class.hs --- a/cabal/Cabal/Distribution/FieldGrammar/Class.hs +++ b/cabal/Cabal/Distribution/FieldGrammar/Class.hs @@ -4,7 +4,6 @@ optionalField, optionalFieldDef, monoidalField, - deprecatedField', ) where import Distribution.Compat.Lens @@ -13,10 +12,11 @@ import Data.Functor.Identity (Identity (..)) -import Distribution.Compat.Newtype (Newtype) -import Distribution.Parsec.Class (Parsec) -import Distribution.Parsec.Field -import Distribution.Pretty (Pretty) +import Distribution.CabalSpecVersion (CabalSpecVersion) +import Distribution.Compat.Newtype (Newtype) +import Distribution.Fields.Field +import Distribution.Parsec (Parsec) +import Distribution.Pretty (Pretty) -- | 'FieldGrammar' is parametrised by -- @@ -33,7 +33,7 @@ -- | Field which should be defined, exactly once. uniqueFieldAla - :: (Parsec b, Pretty b, Newtype b a) + :: (Parsec b, Pretty b, Newtype a b) => FieldName -- ^ field name -> (a -> b) -- ^ 'Newtype' pack -> ALens' s a -- ^ lens into the field @@ -48,7 +48,7 @@ -- | Optional field. optionalFieldAla - :: (Parsec b, Pretty b, Newtype b a) + :: (Parsec b, Pretty b, Newtype a b) => FieldName -- ^ field name -> (a -> b) -- ^ 'pack' -> ALens' s (Maybe a) -- ^ lens into the field @@ -56,13 +56,31 @@ -- | Optional field with default value. optionalFieldDefAla - :: (Parsec b, Pretty b, Newtype b a, Eq a) + :: (Parsec b, Pretty b, Newtype a b, Eq a) => FieldName -- ^ field name -> (a -> b) -- ^ 'Newtype' pack -> ALens' s a -- ^ @'Lens'' s a@: lens into the field -> a -- ^ default value -> g s a + -- | Free text field is essentially 'optionalFieldDefAla` with @""@ + -- as the default and "accept everything" parser. + -- + -- @since 3.0.0.0 + freeTextField + :: FieldName + -> ALens' s (Maybe String) -- ^ lens into the field + -> g s (Maybe String) + + -- | Free text field is essentially 'optionalFieldDefAla` with @""@ + -- as the default and "accept everything" parser. + -- + -- @since 3.0.0.0 + freeTextFieldDef + :: FieldName + -> ALens' s String -- ^ lens into the field + -> g s String + -- | Monoidal field. -- -- Values are combined with 'mappend'. @@ -70,7 +88,7 @@ -- /Note:/ 'optionalFieldAla' is a @monoidalField@ with 'Last' monoid. -- monoidalFieldAla - :: (Parsec b, Pretty b, Monoid a, Newtype b a) + :: (Parsec b, Pretty b, Monoid a, Newtype a b) => FieldName -- ^ field name -> (a -> b) -- ^ 'pack' -> ALens' s a -- ^ lens into the field @@ -90,15 +108,22 @@ -- | Deprecated since deprecatedSince - :: [Int] -- ^ version - -> String -- ^ deprecation message + :: CabalSpecVersion -- ^ version + -> String -- ^ deprecation message -> g s a -> g s a + -- | Removed in. If we occur removed field, parsing fails. + removedIn + :: CabalSpecVersion -- ^ version + -> String -- ^ removal message + -> g s a + -> g s a + -- | Annotate field with since spec-version. availableSince - :: [Int] -- ^ spec version - -> a -- ^ default value + :: CabalSpecVersion -- ^ spec version + -> a -- ^ default value -> g s a -> g s a @@ -134,14 +159,3 @@ -> ALens' s a -- ^ lens into the field -> g s a monoidalField fn = monoidalFieldAla fn Identity - --- | Deprecated field. If found, warning is issued. --- --- /Note:/ also it's not pretty printed! --- -deprecatedField' - :: FieldGrammar g - => String -- ^ deprecation message - -> g s a - -> g s a -deprecatedField' = deprecatedSince [] diff --git a/cabal/Cabal/Distribution/FieldGrammar/FieldDescrs.hs b/cabal/Cabal/Distribution/FieldGrammar/FieldDescrs.hs --- a/cabal/Cabal/Distribution/FieldGrammar/FieldDescrs.hs +++ b/cabal/Cabal/Distribution/FieldGrammar/FieldDescrs.hs @@ -11,16 +11,17 @@ import Distribution.Compat.Prelude import Prelude () +import Data.List (dropWhileEnd) import Distribution.Compat.Lens (aview, cloneLens) import Distribution.Compat.Newtype import Distribution.FieldGrammar -import Distribution.Pretty (pretty) -import Distribution.Utils.Generic (fromUTF8BS) +import Distribution.Pretty (pretty, showFreeText) -import qualified Data.Map as Map -import qualified Distribution.Parsec.Class as P -import qualified Distribution.Parsec.Field as P -import qualified Text.PrettyPrint as Disp +import qualified Data.Map as Map +import qualified Distribution.Compat.CharParsing as C +import qualified Distribution.Fields.Field as P +import qualified Distribution.Parsec as P +import qualified Text.PrettyPrint as Disp -- strict pair data SP s = SP @@ -29,7 +30,7 @@ } -- | A collection field parsers and pretty-printers. -newtype FieldDescrs s a = F { runF :: Map String (SP s) } +newtype FieldDescrs s a = F { runF :: Map P.FieldName (SP s) } deriving (Functor) instance Applicative (FieldDescrs s) where @@ -37,20 +38,20 @@ f <*> x = F (mappend (runF f) (runF x)) singletonF :: P.FieldName -> (s -> Disp.Doc) -> (forall m. P.CabalParsing m => s -> m s) -> FieldDescrs s a -singletonF fn f g = F $ Map.singleton (fromUTF8BS fn) (SP f g) +singletonF fn f g = F $ Map.singleton fn (SP f g) -- | Lookup a field value pretty-printer. -fieldDescrPretty :: FieldDescrs s a -> String -> Maybe (s -> Disp.Doc) +fieldDescrPretty :: FieldDescrs s a -> P.FieldName -> Maybe (s -> Disp.Doc) fieldDescrPretty (F m) fn = pPretty <$> Map.lookup fn m -- | Lookup a field value parser. -fieldDescrParse :: P.CabalParsing m => FieldDescrs s a -> String -> Maybe (s -> m s) +fieldDescrParse :: P.CabalParsing m => FieldDescrs s a -> P.FieldName -> Maybe (s -> m s) fieldDescrParse (F m) fn = pParse <$> Map.lookup fn m fieldDescrsToList :: P.CabalParsing m => FieldDescrs s a - -> [(String, s -> Disp.Doc, s -> m s)] + -> [(P.FieldName, s -> Disp.Doc, s -> m s)] fieldDescrsToList = map mk . Map.toList . runF where mk (name, SP ppr parse) = (name, ppr, parse) @@ -76,6 +77,14 @@ f s = pretty (pack' _pack (aview l s)) g s = cloneLens l (const (unpack' _pack <$> P.parsec)) s + freeTextField fn l = singletonF fn f g where + f s = maybe mempty showFreeText (aview l s) + g s = cloneLens l (const (Just <$> parsecFreeText)) s + + freeTextFieldDef fn l = singletonF fn f g where + f s = showFreeText (aview l s) + g s = cloneLens l (const parsecFreeText) s + monoidalFieldAla fn _pack l = singletonF fn f g where f s = pretty (pack' _pack (aview l s)) g s = cloneLens l (\x -> mappend x . unpack' _pack <$> P.parsec) s @@ -83,5 +92,23 @@ prefixedFields _fnPfx _l = F mempty knownField _ = pure () deprecatedSince _ _ x = x + removedIn _ _ x = x availableSince _ _ = id hiddenField _ = F mempty + +parsecFreeText :: P.CabalParsing m => m String +parsecFreeText = dropDotLines <$ C.spaces <*> many C.anyChar + where + -- Example package with dot lines + -- http://hackage.haskell.org/package/copilot-cbmc-0.1/copilot-cbmc.cabal + dropDotLines "." = "." + dropDotLines x = intercalate "\n" . map dotToEmpty . lines $ x + + dotToEmpty x | trim' x == "." = "" + dotToEmpty x = trim x + + trim' :: String -> String + trim' = dropWhileEnd (`elem` (" \t" :: String)) + + trim :: String -> String + trim = dropWhile isSpace . dropWhileEnd isSpace diff --git a/cabal/Cabal/Distribution/FieldGrammar/Parsec.hs b/cabal/Cabal/Distribution/FieldGrammar/Parsec.hs --- a/cabal/Cabal/Distribution/FieldGrammar/Parsec.hs +++ b/cabal/Cabal/Distribution/FieldGrammar/Parsec.hs @@ -61,6 +61,7 @@ Section (..), runFieldParser, runFieldParser', + fieldLinesToStream, ) where import Data.List (dropWhileEnd) @@ -72,18 +73,18 @@ import Prelude () import qualified Data.ByteString as BS -import qualified Data.Set as Set import qualified Data.Map.Strict as Map +import qualified Data.Set as Set import qualified Text.Parsec as P import qualified Text.Parsec.Error as P import Distribution.CabalSpecVersion import Distribution.FieldGrammar.Class -import Distribution.Parsec.Class -import Distribution.Parsec.Common -import Distribution.Parsec.Field +import Distribution.Fields.Field +import Distribution.Fields.ParseResult +import Distribution.Parsec import Distribution.Parsec.FieldLineStream -import Distribution.Parsec.ParseResult +import Distribution.Parsec.Position (positionRow, positionCol) ------------------------------------------------------------------------------- -- Auxiliary types @@ -205,6 +206,34 @@ | null fls = pure def | otherwise = unpack' _pack <$> runFieldParser pos parsec v fls + freeTextField fn _ = ParsecFG (Set.singleton fn) Set.empty parser where + parser v fields = case Map.lookup fn fields of + Nothing -> pure Nothing + Just [] -> pure Nothing + Just [x] -> parseOne v x + Just xs -> do + warnMultipleSingularFields fn xs + last <$> traverse (parseOne v) xs + + parseOne v (MkNamelessField pos fls) + | null fls = pure Nothing + | v >= CabalSpecV3_0 = pure (Just (fieldlinesToFreeText3 pos fls)) + | otherwise = pure (Just (fieldlinesToFreeText fls)) + + freeTextFieldDef fn _ = ParsecFG (Set.singleton fn) Set.empty parser where + parser v fields = case Map.lookup fn fields of + Nothing -> pure "" + Just [] -> pure "" + Just [x] -> parseOne v x + Just xs -> do + warnMultipleSingularFields fn xs + last <$> traverse (parseOne v) xs + + parseOne v (MkNamelessField pos fls) + | null fls = pure "" + | v >= CabalSpecV3_0 = pure (fieldlinesToFreeText3 pos fls) + | otherwise = pure (fieldlinesToFreeText fls) + monoidalFieldAla fn _pack _extract = ParsecFG (Set.singleton fn) Set.empty parser where parser v fields = case Map.lookup fn fields of @@ -231,29 +260,55 @@ availableSince vs def (ParsecFG names prefixes parser) = ParsecFG names prefixes parser' where parser' v values - | cabalSpecSupports v vs = parser v values + | v >= vs = parser v values | otherwise = do let unknownFields = Map.intersection values $ Map.fromSet (const ()) names for_ (Map.toList unknownFields) $ \(name, fields) -> for_ fields $ \(MkNamelessField pos _) -> parseWarning pos PWTUnknownField $ - "The field " <> show name <> " is available since Cabal " ++ show vs + "The field " <> show name <> " is available only since the Cabal specification version " ++ showCabalSpecVersion vs ++ ". This field will be ignored." pure def -- todo we know about this field - deprecatedSince (_ : _) _ grammar = grammar -- pass on non-empty version - deprecatedSince _ msg (ParsecFG names prefixes parser) = ParsecFG names prefixes parser' + deprecatedSince vs msg (ParsecFG names prefixes parser) = ParsecFG names prefixes parser' where - parser' v values = do - let deprecatedFields = Map.intersection values $ Map.fromSet (const ()) names - for_ (Map.toList deprecatedFields) $ \(name, fields) -> - for_ fields $ \(MkNamelessField pos _) -> - parseWarning pos PWTDeprecatedField $ - "The field " <> show name <> " is deprecated. " ++ msg + parser' v values + | v >= vs = do + let deprecatedFields = Map.intersection values $ Map.fromSet (const ()) names + for_ (Map.toList deprecatedFields) $ \(name, fields) -> + for_ fields $ \(MkNamelessField pos _) -> + parseWarning pos PWTDeprecatedField $ + "The field " <> show name <> " is deprecated in the Cabal specification version " ++ showCabalSpecVersion vs ++ ". " ++ msg - parser v values + parser v values + | otherwise = parser v values + + removedIn vs msg (ParsecFG names prefixes parser) = ParsecFG names prefixes parser' where + parser' v values + | v >= vs = do + let msg' = if null msg then "" else ' ' : msg + let unknownFields = Map.intersection values $ Map.fromSet (const ()) names + let namePos = + [ (name, pos) + | (name, fields) <- Map.toList unknownFields + , MkNamelessField pos _ <- fields + ] + + let makeMsg name = "The field " <> show name <> " is removed in the Cabal specification version " ++ showCabalSpecVersion vs ++ "." ++ msg' + + case namePos of + -- no fields => proceed (with empty values, to be sure) + [] -> parser v mempty + + -- if there's single field: fail fatally with it + ((name, pos) : rest) -> do + for_ rest $ \(name', pos') -> parseFailure pos' $ makeMsg name' + parseFatalFailure pos $ makeMsg name + + | otherwise = parser v values + knownField fn = ParsecFG (Set.singleton fn) Set.empty (\_ _ -> pure ()) hiddenField = id @@ -262,36 +317,92 @@ -- Parsec ------------------------------------------------------------------------------- -runFieldParser' :: Position -> ParsecParser a -> CabalSpecVersion -> FieldLineStream -> ParseResult a -runFieldParser' (Position row col) p v str = case P.runParser p' [] "" str of +runFieldParser' :: [Position] -> ParsecParser a -> CabalSpecVersion -> FieldLineStream -> ParseResult a +runFieldParser' inputPoss p v str = case P.runParser p' [] "" str of Right (pok, ws) -> do - -- TODO: map pos - traverse_ (\(PWarning t pos w) -> parseWarning pos t w) ws + traverse_ (\(PWarning t pos w) -> parseWarning (mapPosition pos) t w) ws pure pok Left err -> do let ppos = P.errorPos err - -- Positions start from 1:1, not 0:0 - let epos = Position (row - 1 + P.sourceLine ppos) (col - 1 + P.sourceColumn ppos) + let epos = mapPosition $ Position (P.sourceLine ppos) (P.sourceColumn ppos) + let msg = P.showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (P.errorMessages err) - let str' = unlines (filter (not . all isSpace) (fieldLineStreamToLines str)) - - parseFatalFailure epos $ msg ++ "\n" ++ "\n" ++ str' + parseFatalFailure epos $ msg ++ "\n" where p' = (,) <$ P.spaces <*> unPP p v <* P.spaces <* P.eof <*> P.getState -fieldLineStreamToLines :: FieldLineStream -> [String] -fieldLineStreamToLines (FLSLast bs) = [ fromUTF8BS bs ] -fieldLineStreamToLines (FLSCons bs s) = fromUTF8BS bs : fieldLineStreamToLines s + -- Positions start from 1:1, not 0:0 + mapPosition (Position prow pcol) = go (prow - 1) inputPoss where + go _ [] = zeroPos + go _ [Position row col] = Position row (col + pcol - 1) + go n (Position row col:_) | n <= 0 = Position row (col + pcol - 1) + go n (_:ps) = go (n - 1) ps runFieldParser :: Position -> ParsecParser a -> CabalSpecVersion -> [FieldLine Position] -> ParseResult a -runFieldParser pp p v ls = runFieldParser' pos p v (fieldLinesToStream ls) +runFieldParser pp p v ls = runFieldParser' poss p v (fieldLinesToStream ls) where - -- TODO: make per line lookup - pos = case ls of - [] -> pp - (FieldLine pos' _ : _) -> pos' + poss = map (\(FieldLine pos _) -> pos) ls ++ [pp] -- add "default" position fieldlinesToBS :: [FieldLine ann] -> BS.ByteString fieldlinesToBS = BS.intercalate "\n" . map (\(FieldLine _ bs) -> bs) + +-- Example package with dot lines +-- http://hackage.haskell.org/package/copilot-cbmc-0.1/copilot-cbmc.cabal +fieldlinesToFreeText :: [FieldLine ann] -> String +fieldlinesToFreeText [FieldLine _ "."] = "." +fieldlinesToFreeText fls = intercalate "\n" (map go fls) + where + go (FieldLine _ bs) + | s == "." = "" + | otherwise = s + where + s = trim (fromUTF8BS bs) + + trim :: String -> String + trim = dropWhile isSpace . dropWhileEnd isSpace + +fieldlinesToFreeText3 :: Position -> [FieldLine Position] -> String +fieldlinesToFreeText3 _ [] = "" +fieldlinesToFreeText3 _ [FieldLine _ bs] = fromUTF8BS bs +fieldlinesToFreeText3 pos (FieldLine pos1 bs1 : fls2@(FieldLine pos2 _ : _)) + -- if first line is on the same line with field name: + -- the indentation level is either + -- 1. the indentation of left most line in rest fields + -- 2. the indentation of the first line + -- whichever is leftmost + | positionRow pos == positionRow pos1 = concat + $ fromUTF8BS bs1 + : mealy (mk mcol1) pos1 fls2 + + -- otherwise, also indent the first line + | otherwise = concat + $ replicate (positionCol pos1 - mcol2) ' ' + : fromUTF8BS bs1 + : mealy (mk mcol2) pos1 fls2 + + where + mcol1 = foldl' (\a b -> min a $ positionCol $ fieldLineAnn b) (min (positionCol pos1) (positionCol pos2)) fls2 + mcol2 = foldl' (\a b -> min a $ positionCol $ fieldLineAnn b) (positionCol pos1) fls2 + + mk :: Int -> Position -> FieldLine Position -> (Position, String) + mk col p (FieldLine q bs) = + ( q + , replicate newlines '\n' + ++ replicate indent ' ' + ++ fromUTF8BS bs + ) + where + newlines = positionRow q - positionRow p + indent = positionCol q - col + +mealy :: (s -> a -> (s, b)) -> s -> [a] -> [b] +mealy f = go where + go _ [] = [] + go s (x : xs) = let ~(s', y) = f s x in y : go s' xs + +fieldLinesToStream :: [FieldLine ann] -> FieldLineStream +fieldLinesToStream [] = fieldLineStreamEnd +fieldLinesToStream [FieldLine _ bs] = FLSLast bs +fieldLinesToStream (FieldLine _ bs : fs) = FLSCons bs (fieldLinesToStream fs) diff --git a/cabal/Cabal/Distribution/FieldGrammar/Pretty.hs b/cabal/Cabal/Distribution/FieldGrammar/Pretty.hs --- a/cabal/Cabal/Distribution/FieldGrammar/Pretty.hs +++ b/cabal/Cabal/Distribution/FieldGrammar/Pretty.hs @@ -4,77 +4,98 @@ prettyFieldGrammar, ) where +import Distribution.CabalSpecVersion import Distribution.Compat.Lens import Distribution.Compat.Newtype import Distribution.Compat.Prelude -import Distribution.Pretty (Pretty (..)) -import Distribution.Simple.Utils (fromUTF8BS) +import Distribution.Fields.Field (FieldName) +import Distribution.Fields.Pretty (PrettyField (..)) +import Distribution.Pretty (Pretty (..), showFreeText, showFreeTextV3) +import Distribution.Simple.Utils (toUTF8BS) import Prelude () -import Text.PrettyPrint (Doc) -import qualified Text.PrettyPrint as PP +import Text.PrettyPrint (Doc) +import qualified Text.PrettyPrint as PP import Distribution.FieldGrammar.Class -import Distribution.ParseUtils (ppField) newtype PrettyFieldGrammar s a = PrettyFG - { fieldGrammarPretty :: s -> Doc + { fieldGrammarPretty :: CabalSpecVersion -> s -> [PrettyField ()] } deriving (Functor) instance Applicative (PrettyFieldGrammar s) where - pure _ = PrettyFG (\_ -> mempty) - PrettyFG f <*> PrettyFG x = PrettyFG (\s -> f s PP.$$ x s) + pure _ = PrettyFG (\_ _ -> mempty) + PrettyFG f <*> PrettyFG x = PrettyFG (\v s -> f v s <> x v s) -- | We can use 'PrettyFieldGrammar' to pp print the @s@. -- -- /Note:/ there is not trailing @($+$ text "")@. -prettyFieldGrammar :: PrettyFieldGrammar s a -> s -> Doc -prettyFieldGrammar = fieldGrammarPretty +prettyFieldGrammar :: CabalSpecVersion -> PrettyFieldGrammar s a -> s -> [PrettyField ()] +prettyFieldGrammar = flip fieldGrammarPretty instance FieldGrammar PrettyFieldGrammar where - blurFieldGrammar f (PrettyFG pp) = PrettyFG (pp . aview f) + blurFieldGrammar f (PrettyFG pp) = PrettyFG (\v -> pp v . aview f) - uniqueFieldAla fn _pack l = PrettyFG $ \s -> - ppField (fromUTF8BS fn) (pretty (pack' _pack (aview l s))) + uniqueFieldAla fn _pack l = PrettyFG $ \_v s -> + ppField fn (pretty (pack' _pack (aview l s))) booleanFieldDef fn l def = PrettyFG pp where - pp s + pp _v s | b == def = mempty - | otherwise = ppField (fromUTF8BS fn) (PP.text (show b)) + | otherwise = ppField fn (PP.text (show b)) where b = aview l s optionalFieldAla fn _pack l = PrettyFG pp where - pp s = case aview l s of + pp v s = case aview l s of Nothing -> mempty - Just a -> ppField (fromUTF8BS fn) (pretty (pack' _pack a)) + Just a -> ppField fn (prettyVersioned v (pack' _pack a)) optionalFieldDefAla fn _pack l def = PrettyFG pp where - pp s + pp v s | x == def = mempty - | otherwise = ppField (fromUTF8BS fn) (pretty (pack' _pack x)) + | otherwise = ppField fn (prettyVersioned v (pack' _pack x)) where x = aview l s + freeTextField fn l = PrettyFG pp where + pp v s = maybe mempty (ppField fn . showFT) (aview l s) where + showFT | v >= CabalSpecV3_0 = showFreeTextV3 + | otherwise = showFreeText + + -- it's ok to just show, as showFreeText of empty string is empty. + freeTextFieldDef fn l = PrettyFG pp where + pp v s = ppField fn (showFT (aview l s)) where + showFT | v >= CabalSpecV3_0 = showFreeTextV3 + | otherwise = showFreeText + monoidalFieldAla fn _pack l = PrettyFG pp where - pp s = ppField (fromUTF8BS fn) (pretty (pack' _pack (aview l s))) + pp v s = ppField fn (prettyVersioned v (pack' _pack (aview l s))) - prefixedFields _fnPfx l = PrettyFG (pp . aview l) + prefixedFields _fnPfx l = PrettyFG (\_ -> pp . aview l) where - pp xs = PP.vcat - -- always print the field, even its Doc is empty + pp xs = + -- always print the field, even its Doc is empty. -- i.e. don't use ppField - [ PP.text n <<>> PP.colon PP.<+> (PP.vcat $ map PP.text $ lines s) + [ PrettyField () (toUTF8BS n) $ PP.vcat $ map PP.text $ lines s | (n, s) <- xs -- fnPfx `isPrefixOf` n ] knownField _ = pure () - deprecatedSince [] _ _ = PrettyFG (\_ -> mempty) - deprecatedSince _ _ x = x + deprecatedSince _ _ x = x + -- TODO: as PrettyFieldGrammar isn't aware of cabal-version: we output the field + -- this doesn't affect roundtrip as `removedIn` fields cannot be parsed + -- so invalid documents can be only manually constructed. + removedIn _ _ x = x availableSince _ _ = id hiddenField _ = PrettyFG (\_ -> mempty) + +ppField :: FieldName -> Doc -> [PrettyField ()] +ppField name fielddoc + | PP.isEmpty fielddoc = [] + | otherwise = [ PrettyField () name fielddoc ] diff --git a/cabal/Cabal/Distribution/Fields.hs b/cabal/Cabal/Distribution/Fields.hs new file mode 100644 --- /dev/null +++ b/cabal/Cabal/Distribution/Fields.hs @@ -0,0 +1,42 @@ +-- | Utilitiies to work with @.cabal@ like file structure. +module Distribution.Fields ( + -- * Types + Field(..), + Name(..), + FieldLine(..), + SectionArg(..), + FieldName, + -- * Grammar and parsing + -- + -- See "Distribution.Fields.Parser" for grammar. + readFields, + readFields', + -- ** ParseResult + ParseResult, + runParseResult, + parseString, + parseWarning, + parseWarnings, + parseFailure, + parseFatalFailure, + -- ** Warnings + PWarnType (..), + PWarning (..), + showPWarning, + -- ** Errors + PError (..), + showPError, + -- * Pretty printing + PrettyField (..), + showFields, + -- ** Transformation from Field + genericFromParsecFields, + fromParsecFields, + ) where + +import Distribution.Fields.Field +import Distribution.Fields.Parser +import Distribution.Fields.ParseResult +import Distribution.Fields.Pretty +import Distribution.Parsec.Error +import Distribution.Parsec.Warning diff --git a/cabal/Cabal/Distribution/Fields/ConfVar.hs b/cabal/Cabal/Distribution/Fields/ConfVar.hs new file mode 100644 --- /dev/null +++ b/cabal/Cabal/Distribution/Fields/ConfVar.hs @@ -0,0 +1,127 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoMonoLocalBinds #-} +module Distribution.Fields.ConfVar (parseConditionConfVar) where + +import Distribution.Compat.CharParsing (char, integral) +import Distribution.Compat.Prelude +import Distribution.Parsec (Parsec (..), runParsecParser, Position (..)) +import Distribution.Parsec.FieldLineStream (fieldLineStreamFromBS) +import Distribution.Fields.Field (SectionArg (..)) +import Distribution.Fields.ParseResult +import Distribution.Types.Condition +import Distribution.Types.GenericPackageDescription (ConfVar (..)) +import Distribution.Version + (anyVersion, earlierVersion, intersectVersionRanges, laterVersion, majorBoundVersion, + mkVersion, noVersion, orEarlierVersion, orLaterVersion, thisVersion, unionVersionRanges, + withinVersion) +import Prelude () + +import qualified Text.Parsec as P +import qualified Text.Parsec.Error as P + +-- | Parse @'Condition' 'ConfVar'@ from section arguments provided by parsec +-- based outline parser. +parseConditionConfVar :: [SectionArg Position] -> ParseResult (Condition ConfVar) +parseConditionConfVar args = + -- The name of the input file is irrelevant, as we reformat the error message. + case P.runParser (parser <* P.eof) () "" args of + Right x -> pure x + Left err -> do + -- Mangle the position to the actual one + let ppos = P.errorPos err + let epos = Position (P.sourceLine ppos) (P.sourceColumn ppos) + let msg = P.showErrorMessages + "or" "unknown parse error" "expecting" "unexpected" "end of input" + (P.errorMessages err) + parseFailure epos msg + pure $ Lit True + +type Parser = P.Parsec [SectionArg Position] () + +sepByNonEmpty :: Parser a -> Parser sep -> Parser (NonEmpty a) +sepByNonEmpty p sep = (:|) <$> p <*> many (sep *> p) + +parser :: Parser (Condition ConfVar) +parser = condOr + where + condOr = sepByNonEmpty condAnd (oper "||") >>= return . foldl1 COr + condAnd = sepByNonEmpty cond (oper "&&") >>= return . foldl1 CAnd + cond = P.choice + [ boolLiteral, parens condOr, notCond, osCond, archCond, flagCond, implCond ] + + notCond = CNot <$ oper "!" <*> cond + + boolLiteral = Lit <$> boolLiteral' + osCond = Var . OS <$ string "os" <*> parens fromParsec + flagCond = Var . Flag <$ string "flag" <*> parens fromParsec + archCond = Var . Arch <$ string "arch" <*> parens fromParsec + implCond = Var <$ string "impl" <*> parens implCond' + + implCond' = Impl + <$> fromParsec + <*> P.option anyVersion versionRange + + version = fromParsec + versionStar = mkVersion <$> fromParsec' versionStar' <* oper "*" + versionStar' = some (integral <* char '.') + + versionRange = expr + where + expr = foldl1 unionVersionRanges <$> sepByNonEmpty term (oper "||") + term = foldl1 intersectVersionRanges <$> sepByNonEmpty factor (oper "&&") + + factor = P.choice + $ parens expr + : parseAnyVersion + : parseNoVersion + : parseWildcardRange + : map parseRangeOp rangeOps + + parseAnyVersion = anyVersion <$ string "-any" + parseNoVersion = noVersion <$ string "-none" + + parseWildcardRange = P.try $ withinVersion <$ oper "==" <*> versionStar + + parseRangeOp (s,f) = P.try (f <$ oper s <*> version) + rangeOps = [ ("<", earlierVersion), + ("<=", orEarlierVersion), + (">", laterVersion), + (">=", orLaterVersion), + ("^>=", majorBoundVersion), + ("==", thisVersion) ] + + -- Number token can have many dots in it: SecArgNum (Position 65 15) "7.6.1" + identBS = tokenPrim $ \t -> case t of + SecArgName _ s -> Just s + _ -> Nothing + + boolLiteral' = tokenPrim $ \t -> case t of + SecArgName _ s + | s == "True" -> Just True + | s == "true" -> Just True + | s == "False" -> Just False + | s == "false" -> Just False + _ -> Nothing + + string s = tokenPrim $ \t -> case t of + SecArgName _ s' | s == s' -> Just () + _ -> Nothing + + oper o = tokenPrim $ \t -> case t of + SecArgOther _ o' | o == o' -> Just () + _ -> Nothing + + parens = P.between (oper "(") (oper ")") + + tokenPrim = P.tokenPrim prettySectionArg updatePosition + -- TODO: check where the errors are reported + updatePosition x _ _ = x + prettySectionArg = show + + fromParsec :: Parsec a => Parser a + fromParsec = fromParsec' parsec + + fromParsec' p = do + bs <- identBS + let fls = fieldLineStreamFromBS bs + either (fail . show) pure (runParsecParser p "" fls) diff --git a/cabal/Cabal/Distribution/Fields/Field.hs b/cabal/Cabal/Distribution/Fields/Field.hs new file mode 100644 --- /dev/null +++ b/cabal/Cabal/Distribution/Fields/Field.hs @@ -0,0 +1,108 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveTraversable #-} +-- | Cabal-like file AST types: 'Field', 'Section' etc +-- +-- These types are parametrized by an annotation. +module Distribution.Fields.Field ( + -- * Cabal file + Field (..), + fieldName, + fieldAnn, + fieldUniverse, + FieldLine (..), + fieldLineAnn, + fieldLineBS, + SectionArg (..), + sectionArgAnn, + -- * Name + FieldName, + Name (..), + mkName, + getName, + nameAnn, + ) where + +import Prelude () +import Distribution.Compat.Prelude +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as B +import qualified Data.Char as Char + +------------------------------------------------------------------------------- +-- Cabal file +------------------------------------------------------------------------------- + +-- | A Cabal-like file consists of a series of fields (@foo: bar@) and sections (@library ...@). +data Field ann + = Field !(Name ann) [FieldLine ann] + | Section !(Name ann) [SectionArg ann] [Field ann] + deriving (Eq, Show, Functor, Foldable, Traversable) + +-- | Section of field name +fieldName :: Field ann -> Name ann +fieldName (Field n _ ) = n +fieldName (Section n _ _) = n + +fieldAnn :: Field ann -> ann +fieldAnn = nameAnn . fieldName + +-- | All transitive descendands of 'Field', including itself. +-- +-- /Note:/ the resulting list is never empty. +-- +fieldUniverse :: Field ann -> [Field ann] +fieldUniverse f@(Section _ _ fs) = f : concatMap fieldUniverse fs +fieldUniverse f@(Field _ _) = [f] + +-- | A line of text representing the value of a field from a Cabal file. +-- A field may contain multiple lines. +-- +-- /Invariant:/ 'ByteString' has no newlines. +data FieldLine ann = FieldLine !ann !ByteString + deriving (Eq, Show, Functor, Foldable, Traversable) + +-- | @since 3.0.0.0 +fieldLineAnn :: FieldLine ann -> ann +fieldLineAnn (FieldLine ann _) = ann + +-- | @since 3.0.0.0 +fieldLineBS :: FieldLine ann -> ByteString +fieldLineBS (FieldLine _ bs) = bs + +-- | Section arguments, e.g. name of the library +data SectionArg ann + = SecArgName !ann !ByteString + -- ^ identifier, or omething which loos like number. Also many dot numbers, i.e. "7.6.3" + | SecArgStr !ann !ByteString + -- ^ quoted string + | SecArgOther !ann !ByteString + -- ^ everything else, mm. operators (e.g. in if-section conditionals) + deriving (Eq, Show, Functor, Foldable, Traversable) + +-- | Extract annotation from 'SectionArg'. +sectionArgAnn :: SectionArg ann -> ann +sectionArgAnn (SecArgName ann _) = ann +sectionArgAnn (SecArgStr ann _) = ann +sectionArgAnn (SecArgOther ann _) = ann + +------------------------------------------------------------------------------- +-- Name +------------------------------------------------------------------------------- + +type FieldName = ByteString + +-- | A field name. +-- +-- /Invariant/: 'ByteString' is lower-case ASCII. +data Name ann = Name !ann !FieldName + deriving (Eq, Show, Functor, Foldable, Traversable) + +mkName :: ann -> FieldName -> Name ann +mkName ann bs = Name ann (B.map Char.toLower bs) + +getName :: Name ann -> FieldName +getName (Name _ bs) = bs + +nameAnn :: Name ann -> ann +nameAnn (Name ann _) = ann diff --git a/cabal/Cabal/Distribution/Fields/Lexer.hs b/cabal/Cabal/Distribution/Fields/Lexer.hs new file mode 100644 --- /dev/null +++ b/cabal/Cabal/Distribution/Fields/Lexer.hs @@ -0,0 +1,488 @@ +{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-missing-signatures #-} +{-# LANGUAGE CPP,MagicHash #-} +{-# LINE 1 "boot/Lexer.x" #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Fields.Lexer +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Lexer for the cabal files. +{-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} +#ifdef CABAL_PARSEC_DEBUG +{-# LANGUAGE PatternGuards #-} +#endif +{-# OPTIONS_GHC -fno-warn-unused-imports #-} +module Distribution.Fields.Lexer + (ltest, lexToken, Token(..), LToken(..) + ,bol_section, in_section, in_field_layout, in_field_braces + ,mkLexState) where + +-- [Note: boostrapping parsec parser] +-- +-- We manually produce the `Lexer.hs` file from `boot/Lexer.x` (make lexer) +-- because boostrapping cabal-install would be otherwise tricky. +-- Alex is (atm) tricky package to build, cabal-install has some magic +-- to move bundled generated files in place, so rather we don't depend +-- on it before we can build it ourselves. +-- Therefore there is one thing less to worry in bootstrap.sh, which is a win. +-- +-- See also https://github.com/haskell/cabal/issues/4633 +-- + +import Prelude () +import qualified Prelude as Prelude +import Distribution.Compat.Prelude + +import Distribution.Fields.LexerMonad +import Distribution.Parsec.Position (Position (..), incPos, retPos) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as B.Char8 +import qualified Data.Word as Word + +#ifdef CABAL_PARSEC_DEBUG +import Debug.Trace +import qualified Data.Vector as V +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Text.Encoding.Error as T +#endif + +#if __GLASGOW_HASKELL__ >= 603 +#include "ghcconfig.h" +#elif defined(__GLASGOW_HASKELL__) +#include "config.h" +#endif +#if __GLASGOW_HASKELL__ >= 503 +import Data.Array +import Data.Array.Base (unsafeAt) +#else +import Array +#endif +#if __GLASGOW_HASKELL__ >= 503 +import GHC.Exts +#else +import GlaExts +#endif +alex_tab_size :: Int +alex_tab_size = 8 +alex_base :: AlexAddr +alex_base = AlexA# + "\x12\xff\xff\xff\xf9\xff\xff\xff\xfb\xff\xff\xff\x01\x00\x00\x00\x2f\x00\x00\x00\x50\x00\x00\x00\xd0\x00\x00\x00\x48\xff\xff\xff\xdc\xff\xff\xff\x51\xff\xff\xff\x6d\xff\xff\xff\x6f\xff\xff\xff\x50\x01\x00\x00\x74\x01\x00\x00\x70\xff\xff\xff\x68\x00\x00\x00\x09\x00\x00\x00\x00\x00\x00\x00\x07\x00\x00\x00\xa3\x01\x00\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6a\x00\x00\x00\xd1\x01\x00\x00\xfb\x01\x00\x00\x7b\x02\x00\x00\xfb\x02\x00\x00\x00\x00\x00\x00\x7b\x03\x00\x00\x7d\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x00\x00\x6d\x00\x00\x00\x6b\x00\x00\x00\xfc\x03\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x6f\x00\x00\x00\x1c\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00"# + +alex_table :: AlexAddr +alex_table = AlexA# + "\x00\x00\x09\x00\x0f\x00\x11\x00\x02\x00\x11\x00\x12\x00\x00\x00\x12\x00\x13\x00\x03\x00\x11\x00\x07\x00\x10\x00\x12\x00\x25\x00\x14\x00\x11\x00\x10\x00\x11\x00\x14\x00\x11\x00\x12\x00\x23\x00\x12\x00\x0f\x00\x28\x00\x02\x00\x2e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x08\x00\x10\x00\x00\x00\x14\x00\x00\x00\x00\x00\x08\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2a\x00\x2e\x00\xff\xff\xff\xff\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x28\x00\xff\xff\xff\xff\x29\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x0f\x00\x11\x00\x17\x00\x26\x00\x12\x00\x25\x00\x11\x00\x2a\x00\x00\x00\x12\x00\x00\x00\x15\x00\x00\x00\x16\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0f\x00\x00\x00\x17\x00\x26\x00\x00\x00\x25\x00\x00\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x00\x00\x2d\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x0e\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x17\x00\x23\x00\xff\xff\xff\xff\x24\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x17\x00\x1e\x00\x0d\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x00\x00\x1f\x00\x1f\x00\x1e\x00\x1e\x00\x1e\x00\x19\x00\x1a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x1f\x00\x1e\x00\x1f\x00\x1e\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x21\x00\x1e\x00\x22\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x1d\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x0c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1e\x00\xff\xff\x1e\x00\x1e\x00\x1e\x00\x1e\x00\xff\xff\xff\xff\xff\xff\x1e\x00\x1e\x00\x1e\x00\x18\x00\x1a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x1e\x00\xff\xff\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x1e\x00\xff\xff\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1e\x00\xff\xff\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x00\x00\xff\xff\xff\xff\x1e\x00\x1e\x00\x1e\x00\x1a\x00\x1a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x1e\x00\xff\xff\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x1e\x00\xff\xff\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x1c\x00\x1e\x00\x00\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x00\x00\x1e\x00\x00\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\xff\xff\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\xff\xff\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +alex_check :: AlexAddr +alex_check = AlexA# + "\xff\xff\xef\x00\x09\x00\x0a\x00\x09\x00\x0a\x00\x0d\x00\xbf\x00\x0d\x00\x2d\x00\x09\x00\x0a\x00\xbb\x00\xa0\x00\x0d\x00\xa0\x00\xa0\x00\x0a\x00\x09\x00\x0a\x00\x09\x00\x0a\x00\x0d\x00\x0a\x00\x0d\x00\x20\x00\x0a\x00\x20\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\x2d\x00\x20\x00\xff\xff\x20\x00\xff\xff\xff\xff\x2d\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x09\x00\x0a\x00\x09\x00\x09\x00\x0d\x00\x09\x00\x0a\x00\x09\x00\xff\xff\x0d\x00\xff\xff\x7b\x00\xff\xff\x7d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x20\x00\x20\x00\xff\xff\x20\x00\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\x7d\x00\xff\xff\x7f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc2\x00\xff\xff\xc2\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc2\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc2\x00\xff\xff\xc2\x00\xff\xff\x7f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc2\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\xc2\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\xff\xff\x22\x00\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\xff\xff\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x5c\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x5c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\xff\xff\x7f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x7f\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5b\x00\x5c\x00\x5d\x00\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5b\x00\x5c\x00\x5d\x00\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5b\x00\x5c\x00\x5d\x00\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\xff\xff\x22\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\x7f\x00\x7e\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\x7d\x00\xff\xff\x7f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + +alex_deflt :: AlexAddr +alex_deflt = AlexA# + "\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x00\x27\x00\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x13\x00\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\x1b\x00\x1b\x00\x1b\x00\xff\xff\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\x2b\x00\xff\xff\xff\xff\xff\xff\xff\xff"# + +alex_accept = listArray (0 :: Int, 47) + [ AlexAcc 29 + , AlexAcc 28 + , AlexAcc 27 + , AlexAcc 26 + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAccNone + , AlexAcc 25 + , AlexAcc 24 + , AlexAccSkip + , AlexAcc 23 + , AlexAcc 22 + , AlexAcc 21 + , AlexAccSkip + , AlexAccSkip + , AlexAcc 20 + , AlexAcc 19 + , AlexAcc 18 + , AlexAcc 17 + , AlexAcc 16 + , AlexAcc 15 + , AlexAcc 14 + , AlexAcc 13 + , AlexAcc 12 + , AlexAcc 11 + , AlexAcc 10 + , AlexAcc 9 + , AlexAcc 8 + , AlexAccSkip + , AlexAcc 7 + , AlexAcc 6 + , AlexAcc 5 + , AlexAccSkip + , AlexAcc 4 + , AlexAcc 3 + , AlexAcc 2 + , AlexAcc 1 + , AlexAcc 0 + ] + +alex_actions = array (0 :: Int, 30) + [ (29,alex_action_0) + , (28,alex_action_20) + , (27,alex_action_16) + , (26,alex_action_3) + , (25,alex_action_1) + , (24,alex_action_1) + , (23,alex_action_3) + , (22,alex_action_4) + , (21,alex_action_5) + , (20,alex_action_8) + , (19,alex_action_8) + , (18,alex_action_8) + , (17,alex_action_9) + , (16,alex_action_9) + , (15,alex_action_10) + , (14,alex_action_11) + , (13,alex_action_12) + , (12,alex_action_13) + , (11,alex_action_14) + , (10,alex_action_15) + , (9,alex_action_15) + , (8,alex_action_16) + , (7,alex_action_18) + , (6,alex_action_19) + , (5,alex_action_19) + , (4,alex_action_22) + , (3,alex_action_23) + , (2,alex_action_24) + , (1,alex_action_25) + , (0,alex_action_25) + ] + +{-# LINE 151 "boot/Lexer.x" #-} + +-- | Tokens of outer cabal file structure. Field values are treated opaquely. +data Token = TokSym !ByteString -- ^ Haskell-like identifier, number or operator + | TokStr !ByteString -- ^ String in quotes + | TokOther !ByteString -- ^ Operators and parens + | Indent !Int -- ^ Indentation token + | TokFieldLine !ByteString -- ^ Lines after @:@ + | Colon + | OpenBrace + | CloseBrace + | EOF + | LexicalError InputStream --TODO: add separate string lexical error + deriving Show + +data LToken = L !Position !Token + deriving Show + +toki :: (ByteString -> Token) -> Position -> Int -> ByteString -> Lex LToken +toki t pos len input = return $! L pos (t (B.take len input)) + +tok :: Token -> Position -> Int -> ByteString -> Lex LToken +tok t pos _len _input = return $! L pos t + +checkLeadingWhitespace :: Int -> ByteString -> Lex Int +checkLeadingWhitespace len bs + | B.any (== 9) (B.take len bs) = do + addWarning LexWarningTab + checkWhitespace len bs + | otherwise = checkWhitespace len bs + +checkWhitespace :: Int -> ByteString -> Lex Int +checkWhitespace len bs + | B.any (== 194) (B.take len bs) = do + addWarning LexWarningNBSP + return $ len - B.count 194 (B.take len bs) + | otherwise = return len + +-- ----------------------------------------------------------------------------- +-- The input type + +type AlexInput = InputStream + +alexInputPrevChar :: AlexInput -> Char +alexInputPrevChar _ = error "alexInputPrevChar not used" + +alexGetByte :: AlexInput -> Maybe (Word.Word8,AlexInput) +alexGetByte = B.uncons + +lexicalError :: Position -> InputStream -> Lex LToken +lexicalError pos inp = do + setInput B.empty + return $! L pos (LexicalError inp) + +lexToken :: Lex LToken +lexToken = do + pos <- getPos + inp <- getInput + st <- getStartCode + case alexScan inp st of + AlexEOF -> return (L pos EOF) + AlexError inp' -> + let !len_bytes = B.length inp - B.length inp' in + --FIXME: we want len_chars here really + -- need to decode utf8 up to this point + lexicalError (incPos len_bytes pos) inp' + AlexSkip inp' len_chars -> do + checkPosition pos inp inp' len_chars + adjustPos (incPos len_chars) + setInput inp' + lexToken + AlexToken inp' len_chars action -> do + checkPosition pos inp inp' len_chars + adjustPos (incPos len_chars) + setInput inp' + let !len_bytes = B.length inp - B.length inp' + t <- action pos len_bytes inp + --traceShow t $ return tok + return t + +checkPosition :: Position -> ByteString -> ByteString -> Int -> Lex () +#ifdef CABAL_PARSEC_DEBUG +checkPosition pos@(Position lineno colno) inp inp' len_chars = do + text_lines <- getDbgText + let len_bytes = B.length inp - B.length inp' + pos_txt | lineno-1 < V.length text_lines = T.take len_chars (T.drop (colno-1) (text_lines V.! (lineno-1))) + | otherwise = T.empty + real_txt = B.take len_bytes inp + when (pos_txt /= T.decodeUtf8 real_txt) $ + traceShow (pos, pos_txt, T.decodeUtf8 real_txt) $ + traceShow (take 3 (V.toList text_lines)) $ return () + where + getDbgText = Lex $ \s@LexState{ dbgText = txt } -> LexResult s txt +#else +checkPosition _ _ _ _ = return () +#endif + +lexAll :: Lex [LToken] +lexAll = do + t <- lexToken + case t of + L _ EOF -> return [t] + _ -> do ts <- lexAll + return (t : ts) + +ltest :: Int -> String -> Prelude.IO () +ltest code s = + let (ws, xs) = execLexer (setStartCode code >> lexAll) (B.Char8.pack s) + in traverse_ print ws >> traverse_ print xs + +mkLexState :: ByteString -> LexState +mkLexState input = LexState + { curPos = Position 1 1 + , curInput = input + , curCode = 0 + , warnings = [] +#ifdef CABAL_PARSEC_DEBUG + , dbgText = V.fromList . lines' . T.decodeUtf8With T.lenientDecode $ input +#endif + } + +#ifdef CABAL_PARSEC_DEBUG +lines' :: T.Text -> [T.Text] +lines' s1 + | T.null s1 = [] + | otherwise = case T.break (\c -> c == '\r' || c == '\n') s1 of + (l, s2) | Just (c,s3) <- T.uncons s2 + -> case T.uncons s3 of + Just ('\n', s4) | c == '\r' -> l `T.snoc` '\r' `T.snoc` '\n' : lines' s4 + _ -> l `T.snoc` c : lines' s3 + + | otherwise + -> [l] +#endif + +bol_field_braces,bol_field_layout,bol_section,in_field_braces,in_field_layout,in_section :: Int +bol_field_braces = 1 +bol_field_layout = 2 +bol_section = 3 +in_field_braces = 4 +in_field_layout = 5 +in_section = 6 +alex_action_0 = \_ len _ -> do + when (len /= 0) $ addWarning LexWarningBOM + setStartCode bol_section + lexToken + +alex_action_1 = \_pos len inp -> checkWhitespace len inp >> adjustPos retPos >> lexToken +alex_action_3 = \pos len inp -> checkLeadingWhitespace len inp >> + if B.length inp == len + then return (L pos EOF) + else setStartCode in_section + >> return (L pos (Indent len)) +alex_action_4 = tok OpenBrace +alex_action_5 = tok CloseBrace +alex_action_8 = toki TokSym +alex_action_9 = \pos len inp -> return $! L pos (TokStr (B.take (len - 2) (B.tail inp))) +alex_action_10 = toki TokOther +alex_action_11 = toki TokOther +alex_action_12 = tok Colon +alex_action_13 = tok OpenBrace +alex_action_14 = tok CloseBrace +alex_action_15 = \_ _ _ -> adjustPos retPos >> setStartCode bol_section >> lexToken +alex_action_16 = \pos len inp -> checkLeadingWhitespace len inp >>= \len' -> + if B.length inp == len + then return (L pos EOF) + else setStartCode in_field_layout + >> return (L pos (Indent len')) +alex_action_18 = toki TokFieldLine +alex_action_19 = \_ _ _ -> adjustPos retPos >> setStartCode bol_field_layout >> lexToken +alex_action_20 = \_ _ _ -> setStartCode in_field_braces >> lexToken +alex_action_22 = toki TokFieldLine +alex_action_23 = tok OpenBrace +alex_action_24 = tok CloseBrace +alex_action_25 = \_ _ _ -> adjustPos retPos >> setStartCode bol_field_braces >> lexToken +{-# LINE 1 "templates/GenericTemplate.hs" #-} +-- ----------------------------------------------------------------------------- +-- ALEX TEMPLATE +-- +-- This code is in the PUBLIC DOMAIN; you may copy it freely and use +-- it for any purpose whatsoever. + +-- ----------------------------------------------------------------------------- +-- INTERNALS and main scanner engine + +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. +#if __GLASGOW_HASKELL__ > 706 +#define GTE(n,m) (tagToEnum# (n >=# m)) +#define EQ(n,m) (tagToEnum# (n ==# m)) +#else +#define GTE(n,m) (n >=# m) +#define EQ(n,m) (n ==# m) +#endif + +data AlexAddr = AlexA# Addr# +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. +#if __GLASGOW_HASKELL__ < 503 +uncheckedShiftL# = shiftL# +#endif + +{-# INLINE alexIndexInt16OffAddr #-} +alexIndexInt16OffAddr (AlexA# arr) off = +#ifdef WORDS_BIGENDIAN + narrow16Int# i + where + i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low) + high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) + low = int2Word# (ord# (indexCharOffAddr# arr off')) + off' = off *# 2# +#else + indexInt16OffAddr# arr off +#endif + +{-# INLINE alexIndexInt32OffAddr #-} +alexIndexInt32OffAddr (AlexA# arr) off = +#ifdef WORDS_BIGENDIAN + narrow32Int# i + where + i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#` + (b2 `uncheckedShiftL#` 16#) `or#` + (b1 `uncheckedShiftL#` 8#) `or#` b0) + b3 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#))) + b2 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#))) + b1 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) + b0 = int2Word# (ord# (indexCharOffAddr# arr off')) + off' = off *# 4# +#else + indexInt32OffAddr# arr off +#endif + +#if __GLASGOW_HASKELL__ < 503 +quickIndex arr i = arr ! i +#else +-- GHC >= 503, unsafeAt is available from Data.Array.Base. +quickIndex = unsafeAt +#endif + +-- ----------------------------------------------------------------------------- +-- Main lexing routines + +data AlexReturn a + = AlexEOF + | AlexError !AlexInput + | AlexSkip !AlexInput !Int + | AlexToken !AlexInput !Int a + +-- alexScan :: AlexInput -> StartCode -> AlexReturn a +alexScan input__ (I# (sc)) + = alexScanUser undefined input__ (I# (sc)) + +alexScanUser user__ input__ (I# (sc)) + = case alex_scan_tkn user__ input__ 0# input__ sc AlexNone of + (AlexNone, input__') -> + case alexGetByte input__ of + Nothing -> + + AlexEOF + Just _ -> + + AlexError input__' + + (AlexLastSkip input__'' len, _) -> + + AlexSkip input__'' len + + (AlexLastAcc k input__''' len, _) -> + + AlexToken input__''' len (alex_actions ! k) + +-- Push the input through the DFA, remembering the most recent accepting +-- state it encountered. + +alex_scan_tkn user__ orig_input len input__ s last_acc = + input__ `seq` -- strict in the input + let + new_acc = (check_accs (alex_accept `quickIndex` (I# (s)))) + in + new_acc `seq` + case alexGetByte input__ of + Nothing -> (new_acc, input__) + Just (c, new_input) -> + + case fromIntegral c of { (I# (ord_c)) -> + let + base = alexIndexInt32OffAddr alex_base s + offset = (base +# ord_c) + check = alexIndexInt16OffAddr alex_check offset + + new_s = if GTE(offset,0#) && EQ(check,ord_c) + then alexIndexInt16OffAddr alex_table offset + else alexIndexInt16OffAddr alex_deflt s + in + case new_s of + -1# -> (new_acc, input__) + -- on an error, we want to keep the input *before* the + -- character that failed, not after. + _ -> alex_scan_tkn user__ orig_input (if c < 0x80 || c >= 0xC0 then (len +# 1#) else len) + -- note that the length is increased ONLY if this is the 1st byte in a char encoding) + new_input new_s new_acc + } + where + check_accs (AlexAccNone) = last_acc + check_accs (AlexAcc a ) = AlexLastAcc a input__ (I# (len)) + check_accs (AlexAccSkip) = AlexLastSkip input__ (I# (len)) + +data AlexLastAcc + = AlexNone + | AlexLastAcc !Int !AlexInput !Int + | AlexLastSkip !AlexInput !Int + +data AlexAcc user + = AlexAccNone + | AlexAcc Int + | AlexAccSkip + diff --git a/cabal/Cabal/Distribution/Fields/LexerMonad.hs b/cabal/Cabal/Distribution/Fields/LexerMonad.hs new file mode 100644 --- /dev/null +++ b/cabal/Cabal/Distribution/Fields/LexerMonad.hs @@ -0,0 +1,154 @@ +{-# LANGUAGE CPP #-} +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Fields.LexerMonad +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +module Distribution.Fields.LexerMonad ( + InputStream, + LexState(..), + LexResult(..), + + Lex(..), + execLexer, + + getPos, + setPos, + adjustPos, + + getInput, + setInput, + + getStartCode, + setStartCode, + + LexWarning(..), + LexWarningType(..), + addWarning, + toPWarnings, + + ) where + +import qualified Data.ByteString as B +import Distribution.Compat.Prelude +import Distribution.Parsec.Position (Position (..), showPos) +import Distribution.Parsec.Warning (PWarnType (..), PWarning (..)) +import Prelude () + +import qualified Data.Map.Strict as Map + +#ifdef CABAL_PARSEC_DEBUG +-- testing only: +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Vector as V +#endif + +-- simple state monad +newtype Lex a = Lex { unLex :: LexState -> LexResult a } + +instance Functor Lex where + fmap = liftM + +instance Applicative Lex where + pure = returnLex + (<*>) = ap + +instance Monad Lex where + return = pure + (>>=) = thenLex + +data LexResult a = LexResult {-# UNPACK #-} !LexState a + +data LexWarningType + = LexWarningNBSP -- ^ Encountered non breaking space + | LexWarningBOM -- ^ BOM at the start of the cabal file + | LexWarningTab -- ^ Leading tags + deriving (Eq, Ord, Show) + +data LexWarning = LexWarning !LexWarningType + {-# UNPACK #-} !Position + deriving (Show) + +toPWarnings :: [LexWarning] -> [PWarning] +toPWarnings + = map (uncurry toWarning) + . Map.toList + . Map.fromListWith (++) + . map (\(LexWarning t p) -> (t, [p])) + where + toWarning LexWarningBOM poss = + PWarning PWTLexBOM (head poss) "Byte-order mark found at the beginning of the file" + toWarning LexWarningNBSP poss = + PWarning PWTLexNBSP (head poss) $ "Non breaking spaces at " ++ intercalate ", " (map showPos poss) + toWarning LexWarningTab poss = + PWarning PWTLexTab (head poss) $ "Tabs used as indentation at " ++ intercalate ", " (map showPos poss) + +data LexState = LexState { + curPos :: {-# UNPACK #-} !Position, -- ^ position at current input location + curInput :: {-# UNPACK #-} !InputStream, -- ^ the current input + curCode :: {-# UNPACK #-} !StartCode, -- ^ lexer code + warnings :: [LexWarning] +#ifdef CABAL_PARSEC_DEBUG + , dbgText :: V.Vector T.Text -- ^ input lines, to print pretty debug info +#endif + } --TODO: check if we should cache the first token + -- since it looks like parsec's uncons can be called many times on the same input + +type StartCode = Int -- ^ An @alex@ lexer start code +type InputStream = B.ByteString + + + +-- | Execute the given lexer on the supplied input stream. +execLexer :: Lex a -> InputStream -> ([LexWarning], a) +execLexer (Lex lexer) input = + case lexer initialState of + LexResult LexState{ warnings = ws } result -> (ws, result) + where + initialState = LexState + -- TODO: add 'startPosition' + { curPos = Position 1 1 + , curInput = input + , curCode = 0 + , warnings = [] +#ifdef CABAL_PARSEC_DEBUG + , dbgText = V.fromList . T.lines . T.decodeUtf8 $ input +#endif + } + +{-# INLINE returnLex #-} +returnLex :: a -> Lex a +returnLex a = Lex $ \s -> LexResult s a + +{-# INLINE thenLex #-} +thenLex :: Lex a -> (a -> Lex b) -> Lex b +(Lex m) `thenLex` k = Lex $ \s -> case m s of LexResult s' a -> (unLex (k a)) s' + +setPos :: Position -> Lex () +setPos pos = Lex $ \s -> LexResult s{ curPos = pos } () + +getPos :: Lex Position +getPos = Lex $ \s@LexState{ curPos = pos } -> LexResult s pos + +adjustPos :: (Position -> Position) -> Lex () +adjustPos f = Lex $ \s@LexState{ curPos = pos } -> LexResult s{ curPos = f pos } () + +getInput :: Lex InputStream +getInput = Lex $ \s@LexState{ curInput = i } -> LexResult s i + +setInput :: InputStream -> Lex () +setInput i = Lex $ \s -> LexResult s{ curInput = i } () + +getStartCode :: Lex Int +getStartCode = Lex $ \s@LexState{ curCode = c } -> LexResult s c + +setStartCode :: Int -> Lex () +setStartCode c = Lex $ \s -> LexResult s{ curCode = c } () + +-- | Add warning at the current position +addWarning :: LexWarningType -> Lex () +addWarning wt = Lex $ \s@LexState{ curPos = pos, warnings = ws } -> + LexResult s{ warnings = LexWarning wt pos : ws } () diff --git a/cabal/Cabal/Distribution/Fields/ParseResult.hs b/cabal/Cabal/Distribution/Fields/ParseResult.hs new file mode 100644 --- /dev/null +++ b/cabal/Cabal/Distribution/Fields/ParseResult.hs @@ -0,0 +1,185 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} +-- | A parse result type for parsers from AST to Haskell types. +module Distribution.Fields.ParseResult ( + ParseResult, + runParseResult, + recoverWith, + parseWarning, + parseWarnings, + parseFailure, + parseFatalFailure, + parseFatalFailure', + getCabalSpecVersion, + setCabalSpecVersion, + readAndParseFile, + parseString + ) where + +import qualified Data.ByteString.Char8 as BS +import Distribution.Compat.Prelude +import Distribution.Parsec.Error (PError (..), showPError) +import Distribution.Parsec.Position (Position (..), zeroPos) +import Distribution.Parsec.Warning (PWarnType (..), PWarning (..), showPWarning) +import Distribution.Simple.Utils (die', warn) +import Distribution.Verbosity (Verbosity) +import Distribution.Version (Version) +import Prelude () +import System.Directory (doesFileExist) + +#if MIN_VERSION_base(4,10,0) +import Control.Applicative (Applicative (..)) +#endif + +-- | A monad with failure and accumulating errors and warnings. +newtype ParseResult a = PR + { unPR + :: forall r. PRState + -> (PRState -> r) -- failure, but we were able to recover a new-style spec-version declaration + -> (PRState -> a -> r) -- success + -> r + } + +data PRState = PRState ![PWarning] ![PError] !(Maybe Version) + +emptyPRState :: PRState +emptyPRState = PRState [] [] Nothing + +-- | Destruct a 'ParseResult' into the emitted warnings and either +-- a successful value or +-- list of errors and possibly recovered a spec-version declaration. +runParseResult :: ParseResult a -> ([PWarning], Either (Maybe Version, NonEmpty PError) a) +runParseResult pr = unPR pr emptyPRState failure success + where + failure (PRState warns [] v) = (warns, Left (v, PError zeroPos "panic" :| [])) + failure (PRState warns (err:errs) v) = (warns, Left (v, err :| errs)) where + success (PRState warns [] _) x = (warns, Right x) + -- If there are any errors, don't return the result + success (PRState warns (err:errs) v) _ = (warns, Left (v, err :| errs)) + +instance Functor ParseResult where + fmap f (PR pr) = PR $ \ !s failure success -> + pr s failure $ \ !s' a -> + success s' (f a) + {-# INLINE fmap #-} + +instance Applicative ParseResult where + pure x = PR $ \ !s _ success -> success s x + {-# INLINE pure #-} + + f <*> x = PR $ \ !s0 failure success -> + unPR f s0 failure $ \ !s1 f' -> + unPR x s1 failure $ \ !s2 x' -> + success s2 (f' x') + {-# INLINE (<*>) #-} + + x *> y = PR $ \ !s0 failure success -> + unPR x s0 failure $ \ !s1 _ -> + unPR y s1 failure success + {-# INLINE (*>) #-} + + x <* y = PR $ \ !s0 failure success -> + unPR x s0 failure $ \ !s1 x' -> + unPR y s1 failure $ \ !s2 _ -> + success s2 x' + {-# INLINE (<*) #-} + +#if MIN_VERSION_base(4,10,0) + liftA2 f x y = PR $ \ !s0 failure success -> + unPR x s0 failure $ \ !s1 x' -> + unPR y s1 failure $ \ !s2 y' -> + success s2 (f x' y') + {-# INLINE liftA2 #-} +#endif + +instance Monad ParseResult where + return = pure + (>>) = (*>) + + m >>= k = PR $ \ !s failure success -> + unPR m s failure $ \ !s' a -> + unPR (k a) s' failure success + {-# INLINE (>>=) #-} + +-- | "Recover" the parse result, so we can proceed parsing. +-- 'runParseResult' will still result in 'Nothing', if there are recorded errors. +recoverWith :: ParseResult a -> a -> ParseResult a +recoverWith (PR pr) x = PR $ \ !s _failure success -> + pr s (\ !s' -> success s' x) success + +-- | Set cabal spec version. +setCabalSpecVersion :: Maybe Version -> ParseResult () +setCabalSpecVersion v = PR $ \(PRState warns errs _) _failure success -> + success (PRState warns errs v) () + +-- | Get cabal spec version. +getCabalSpecVersion :: ParseResult (Maybe Version) +getCabalSpecVersion = PR $ \s@(PRState _ _ v) _failure success -> + success s v + +-- | Add a warning. This doesn't fail the parsing process. +parseWarning :: Position -> PWarnType -> String -> ParseResult () +parseWarning pos t msg = PR $ \(PRState warns errs v) _failure success -> + success (PRState (PWarning t pos msg : warns) errs v) () + +-- | Add multiple warnings at once. +parseWarnings :: [PWarning] -> ParseResult () +parseWarnings newWarns = PR $ \(PRState warns errs v) _failure success -> + success (PRState (newWarns ++ warns) errs v) () + +-- | Add an error, but not fail the parser yet. +-- +-- For fatal failure use 'parseFatalFailure' +parseFailure :: Position -> String -> ParseResult () +parseFailure pos msg = PR $ \(PRState warns errs v) _failure success -> + success (PRState warns (PError pos msg : errs) v) () + +-- | Add an fatal error. +parseFatalFailure :: Position -> String -> ParseResult a +parseFatalFailure pos msg = PR $ \(PRState warns errs v) failure _success -> + failure (PRState warns (PError pos msg : errs) v) + +-- | A 'mzero'. +parseFatalFailure' :: ParseResult a +parseFatalFailure' = PR pr + where + pr (PRState warns [] v) failure _success = failure (PRState warns [err] v) + pr s failure _success = failure s + + err = PError zeroPos "Unknown fatal error" + +-- | Helper combinator to do parsing plumbing for files. +-- +-- Given a parser and a filename, return the parse of the file, +-- after checking if the file exists. +-- +-- Argument order is chosen to encourage partial application. +readAndParseFile + :: (BS.ByteString -> ParseResult a) -- ^ File contents to final value parser + -> Verbosity -- ^ Verbosity level + -> FilePath -- ^ File to read + -> IO a +readAndParseFile parser verbosity fpath = do + exists <- doesFileExist fpath + unless exists $ + die' verbosity $ + "Error Parsing: file \"" ++ fpath ++ "\" doesn't exist. Cannot continue." + bs <- BS.readFile fpath + parseString parser verbosity fpath bs + +parseString + :: (BS.ByteString -> ParseResult a) -- ^ File contents to final value parser + -> Verbosity -- ^ Verbosity level + -> String -- ^ File name + -> BS.ByteString + -> IO a +parseString parser verbosity name bs = do + let (warnings, result) = runParseResult (parser bs) + traverse_ (warn verbosity . showPWarning name) warnings + case result of + Right x -> return x + Left (_, errors) -> do + traverse_ (warn verbosity . showPError name) errors + die' verbosity $ "Failed parsing \"" ++ name ++ "\"." diff --git a/cabal/Cabal/Distribution/Fields/Parser.hs b/cabal/Cabal/Distribution/Fields/Parser.hs new file mode 100644 --- /dev/null +++ b/cabal/Cabal/Distribution/Fields/Parser.hs @@ -0,0 +1,378 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternGuards #-} +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Fields.Parser +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +module Distribution.Fields.Parser ( + -- * Types + Field(..), + Name(..), + FieldLine(..), + SectionArg(..), + -- * Grammar and parsing + -- $grammar + readFields, + readFields', +#ifdef CABAL_PARSEC_DEBUG + -- * Internal + parseFile, + parseStr, + parseBS, +#endif + ) where + +import Control.Monad (guard) +import qualified Data.ByteString.Char8 as B8 +import Data.Functor.Identity +import Distribution.Compat.Prelude +import Distribution.Fields.Field +import Distribution.Fields.Lexer +import Distribution.Fields.LexerMonad + (LexResult (..), LexState (..), LexWarning (..), unLex) +import Distribution.Parsec.Position (Position (..)) +import Prelude () +import Text.Parsec.Combinator hiding (eof, notFollowedBy) +import Text.Parsec.Error +import Text.Parsec.Pos +import Text.Parsec.Prim hiding (many, (<|>)) + +#ifdef CABAL_PARSEC_DEBUG +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Text.Encoding.Error as T +#endif + +-- | The 'LexState'' (with a prime) is an instance of parsec's 'Stream' +-- wrapped around lexer's 'LexState' (without a prime) +data LexState' = LexState' !LexState (LToken, LexState') + +mkLexState' :: LexState -> LexState' +mkLexState' st = LexState' st + (case unLex lexToken st of LexResult st' tok -> (tok, mkLexState' st')) + +type Parser a = ParsecT LexState' () Identity a + +instance Stream LexState' Identity LToken where + uncons (LexState' _ (tok, st')) = + case tok of + L _ EOF -> return Nothing + _ -> return (Just (tok, st')) + +-- | Get lexer warnings accumulated so far +getLexerWarnings :: Parser [LexWarning] +getLexerWarnings = do + LexState' (LexState { warnings = ws }) _ <- getInput + return ws + +-- | Set Alex code i.e. the mode "state" lexer is in. +setLexerMode :: Int -> Parser () +setLexerMode code = do + LexState' ls _ <- getInput + setInput $! mkLexState' ls { curCode = code } + +getToken :: (Token -> Maybe a) -> Parser a +getToken getTok = getTokenWithPos (\(L _ t) -> getTok t) + +getTokenWithPos :: (LToken -> Maybe a) -> Parser a +getTokenWithPos getTok = tokenPrim (\(L _ t) -> describeToken t) updatePos getTok + where + updatePos :: SourcePos -> LToken -> LexState' -> SourcePos + updatePos pos (L (Position col line) _) _ = newPos (sourceName pos) col line + +describeToken :: Token -> String +describeToken t = case t of + TokSym s -> "symbol " ++ show s + TokStr s -> "string " ++ show s + TokOther s -> "operator " ++ show s + Indent _ -> "new line" + TokFieldLine _ -> "field content" + Colon -> "\":\"" + OpenBrace -> "\"{\"" + CloseBrace -> "\"}\"" +-- SemiColon -> "\";\"" + EOF -> "end of file" + LexicalError is -> "character in input " ++ show (B8.head is) + +tokSym :: Parser (Name Position) +tokSym', tokStr, tokOther :: Parser (SectionArg Position) +tokIndent :: Parser Int +tokColon, tokOpenBrace, tokCloseBrace :: Parser () +tokFieldLine :: Parser (FieldLine Position) + +tokSym = getTokenWithPos $ \t -> case t of L pos (TokSym x) -> Just (mkName pos x); _ -> Nothing +tokSym' = getTokenWithPos $ \t -> case t of L pos (TokSym x) -> Just (SecArgName pos x); _ -> Nothing +tokStr = getTokenWithPos $ \t -> case t of L pos (TokStr x) -> Just (SecArgStr pos x); _ -> Nothing +tokOther = getTokenWithPos $ \t -> case t of L pos (TokOther x) -> Just (SecArgOther pos x); _ -> Nothing +tokIndent = getToken $ \t -> case t of Indent x -> Just x; _ -> Nothing +tokColon = getToken $ \t -> case t of Colon -> Just (); _ -> Nothing +tokOpenBrace = getToken $ \t -> case t of OpenBrace -> Just (); _ -> Nothing +tokCloseBrace = getToken $ \t -> case t of CloseBrace -> Just (); _ -> Nothing +tokFieldLine = getTokenWithPos $ \t -> case t of L pos (TokFieldLine s) -> Just (FieldLine pos s); _ -> Nothing + +colon, openBrace, closeBrace :: Parser () + +sectionArg :: Parser (SectionArg Position) +sectionArg = tokSym' <|> tokStr <|> tokOther "section parameter" + +fieldSecName :: Parser (Name Position) +fieldSecName = tokSym "field or section name" + +colon = tokColon "\":\"" +openBrace = tokOpenBrace "\"{\"" +closeBrace = tokCloseBrace "\"}\"" + +fieldContent :: Parser (FieldLine Position) +fieldContent = tokFieldLine "field contents" + +newtype IndentLevel = IndentLevel Int + +zeroIndentLevel :: IndentLevel +zeroIndentLevel = IndentLevel 0 + +incIndentLevel :: IndentLevel -> IndentLevel +incIndentLevel (IndentLevel i) = IndentLevel (succ i) + +indentOfAtLeast :: IndentLevel -> Parser IndentLevel +indentOfAtLeast (IndentLevel i) = try $ do + j <- tokIndent + guard (j >= i) "indentation of at least " ++ show i + return (IndentLevel j) + + +newtype LexerMode = LexerMode Int + +inLexerMode :: LexerMode -> Parser p -> Parser p +inLexerMode (LexerMode mode) p = + do setLexerMode mode; x <- p; setLexerMode in_section; return x + + +----------------------- +-- Cabal file grammar +-- + +-- $grammar +-- +-- @ +-- CabalStyleFile ::= SecElems +-- +-- SecElems ::= SecElem* '\\n'? +-- SecElem ::= '\\n' SecElemLayout | SecElemBraces +-- SecElemLayout ::= FieldLayout | FieldBraces | SectionLayout | SectionBraces +-- SecElemBraces ::= FieldInline | FieldBraces | SectionBraces +-- FieldLayout ::= name ':' line? ('\\n' line)* +-- FieldBraces ::= name ':' '\\n'? '{' content '}' +-- FieldInline ::= name ':' content +-- SectionLayout ::= name arg* SecElems +-- SectionBraces ::= name arg* '\\n'? '{' SecElems '}' +-- @ +-- +-- and the same thing but left factored... +-- +-- @ +-- SecElems ::= SecElem* +-- SecElem ::= '\\n' name SecElemLayout +-- | name SecElemBraces +-- SecElemLayout ::= ':' FieldLayoutOrBraces +-- | arg* SectionLayoutOrBraces +-- FieldLayoutOrBraces ::= '\\n'? '{' content '}' +-- | line? ('\\n' line)* +-- SectionLayoutOrBraces ::= '\\n'? '{' SecElems '\\n'? '}' +-- | SecElems +-- SecElemBraces ::= ':' FieldInlineOrBraces +-- | arg* '\\n'? '{' SecElems '\\n'? '}' +-- FieldInlineOrBraces ::= '\\n'? '{' content '}' +-- | content +-- @ +-- +-- Note how we have several productions with the sequence: +-- +-- > '\\n'? '{' +-- +-- That is, an optional newline (and indent) followed by a @{@ token. +-- In the @SectionLayoutOrBraces@ case you can see that this makes it +-- not fully left factored (because @SecElems@ can start with a @\\n@). +-- Fully left factoring here would be ugly, and though we could use a +-- lookahead of two tokens to resolve the alternatives, we can't +-- conveniently use Parsec's 'try' here to get a lookahead of only two. +-- So instead we deal with this case in the lexer by making a line +-- where the first non-space is @{@ lex as just the @{@ token, without +-- the usual indent token. Then in the parser we can resolve everything +-- with just one token of lookahead and so without using 'try'. + +-- Top level of a file using cabal syntax +-- +cabalStyleFile :: Parser [Field Position] +cabalStyleFile = do es <- elements zeroIndentLevel + eof + return es + +-- Elements that live at the top level or inside a section, ie fields +-- and sectionscontent +-- +-- elements ::= element* +elements :: IndentLevel -> Parser [Field Position] +elements ilevel = many (element ilevel) + +-- An individual element, ie a field or a section. These can either use +-- layout style or braces style. For layout style then it must start on +-- a line on its own (so that we know its indentation level). +-- +-- element ::= '\\n' name elementInLayoutContext +-- | name elementInNonLayoutContext +element :: IndentLevel -> Parser (Field Position) +element ilevel = + (do ilevel' <- indentOfAtLeast ilevel + name <- fieldSecName + elementInLayoutContext (incIndentLevel ilevel') name) + <|> (do name <- fieldSecName + elementInNonLayoutContext name) + +-- An element (field or section) that is valid in a layout context. +-- In a layout context we can have fields and sections that themselves +-- either use layout style or that use braces style. +-- +-- elementInLayoutContext ::= ':' fieldLayoutOrBraces +-- | arg* sectionLayoutOrBraces +elementInLayoutContext :: IndentLevel -> Name Position -> Parser (Field Position) +elementInLayoutContext ilevel name = + (do colon; fieldLayoutOrBraces ilevel name) + <|> (do args <- many sectionArg + elems <- sectionLayoutOrBraces ilevel + return (Section name args elems)) + +-- An element (field or section) that is valid in a non-layout context. +-- In a non-layout context we can have only have fields and sections that +-- themselves use braces style, or inline style fields. +-- +-- elementInNonLayoutContext ::= ':' FieldInlineOrBraces +-- | arg* '\\n'? '{' elements '\\n'? '}' +elementInNonLayoutContext :: Name Position -> Parser (Field Position) +elementInNonLayoutContext name = + (do colon; fieldInlineOrBraces name) + <|> (do args <- many sectionArg + openBrace + elems <- elements zeroIndentLevel + optional tokIndent + closeBrace + return (Section name args elems)) + +-- The body of a field, using either layout style or braces style. +-- +-- fieldLayoutOrBraces ::= '\\n'? '{' content '}' +-- | line? ('\\n' line)* +fieldLayoutOrBraces :: IndentLevel -> Name Position -> Parser (Field Position) +fieldLayoutOrBraces ilevel name = braces <|> fieldLayout + where + braces = do + openBrace + ls <- inLexerMode (LexerMode in_field_braces) (many fieldContent) + closeBrace + return (Field name ls) + fieldLayout = inLexerMode (LexerMode in_field_layout) $ do + l <- optionMaybe fieldContent + ls <- many (do _ <- indentOfAtLeast ilevel; fieldContent) + return $ case l of + Nothing -> Field name ls + Just l' -> Field name (l' : ls) + +-- The body of a section, using either layout style or braces style. +-- +-- sectionLayoutOrBraces ::= '\\n'? '{' elements \\n? '}' +-- | elements +sectionLayoutOrBraces :: IndentLevel -> Parser [Field Position] +sectionLayoutOrBraces ilevel = + (do openBrace + elems <- elements zeroIndentLevel + optional tokIndent + closeBrace + return elems) + <|> (elements ilevel) + +-- The body of a field, using either inline style or braces. +-- +-- fieldInlineOrBraces ::= '\\n'? '{' content '}' +-- | content +fieldInlineOrBraces :: Name Position -> Parser (Field Position) +fieldInlineOrBraces name = + (do openBrace + ls <- inLexerMode (LexerMode in_field_braces) (many fieldContent) + closeBrace + return (Field name ls)) + <|> (do ls <- inLexerMode (LexerMode in_field_braces) (option [] (fmap (\l -> [l]) fieldContent)) + return (Field name ls)) + + +-- | Parse cabal style 'B8.ByteString' into list of 'Field's, i.e. the cabal AST. +readFields :: B8.ByteString -> Either ParseError [Field Position] +readFields s = fmap fst (readFields' s) + +-- | Like 'readFields' but also return lexer warnings +readFields' :: B8.ByteString -> Either ParseError ([Field Position], [LexWarning]) +readFields' s = do + parse parser "the input" lexSt + where + parser = do + fields <- cabalStyleFile + ws <- getLexerWarnings + pure (fields, ws) + + lexSt = mkLexState' (mkLexState s) + +#ifdef CABAL_PARSEC_DEBUG +parseTest' :: Show a => Parsec LexState' () a -> SourceName -> B8.ByteString -> IO () +parseTest' p fname s = + case parse p fname (lexSt s) of + Left err -> putStrLn (formatError s err) + + Right x -> print x + where + lexSt = mkLexState' . mkLexState + +parseFile :: Show a => Parser a -> FilePath -> IO () +parseFile p f = B8.readFile f >>= \s -> parseTest' p f s + +parseStr :: Show a => Parser a -> String -> IO () +parseStr p = parseBS p . B8.pack + +parseBS :: Show a => Parser a -> B8.ByteString -> IO () +parseBS p = parseTest' p "" + +formatError :: B8.ByteString -> ParseError -> String +formatError input perr = + unlines + [ "Parse error "++ show (errorPos perr) ++ ":" + , errLine + , indicator ++ errmsg ] + where + pos = errorPos perr + ls = lines' (T.decodeUtf8With T.lenientDecode input) + errLine = T.unpack (ls !! (sourceLine pos - 1)) + indicator = replicate (sourceColumn pos) ' ' ++ "^" + errmsg = showErrorMessages "or" "unknown parse error" + "expecting" "unexpected" "end of file" + (errorMessages perr) + +-- | Handles windows/osx/unix line breaks uniformly +lines' :: T.Text -> [T.Text] +lines' s1 + | T.null s1 = [] + | otherwise = case T.break (\c -> c == '\r' || c == '\n') s1 of + (l, s2) | Just (c,s3) <- T.uncons s2 + -> case T.uncons s3 of + Just ('\n', s4) | c == '\r' -> l : lines' s4 + _ -> l : lines' s3 + | otherwise -> [l] +#endif + +eof :: Parser () +eof = notFollowedBy anyToken "end of file" + where + notFollowedBy :: Parser LToken -> Parser () + notFollowedBy p = try ( (do L _ t <- try p; unexpected (describeToken t)) + <|> return ()) diff --git a/cabal/Cabal/Distribution/Fields/Pretty.hs b/cabal/Cabal/Distribution/Fields/Pretty.hs new file mode 100644 --- /dev/null +++ b/cabal/Cabal/Distribution/Fields/Pretty.hs @@ -0,0 +1,163 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveTraversable #-} +-- | Cabal-like file AST types: 'Field', 'Section' etc, +-- +-- This (intermediate) data type is used for pretty-printing. +-- +-- @since 3.0.0.0 +-- +module Distribution.Fields.Pretty ( + -- * Fields + PrettyField (..), + showFields, + showFields', + -- * Transformation from 'P.Field' + fromParsecFields, + genericFromParsecFields, + prettyFieldLines, + prettySectionArgs, + ) where + +import Data.Functor.Identity (Identity (..)) +import Distribution.Compat.Prelude +import Distribution.Pretty (showToken) +import Prelude () + +import Distribution.Fields.Field (FieldName) +import Distribution.Simple.Utils (fromUTF8BS) + +import qualified Distribution.Fields.Parser as P + +import qualified Data.ByteString as BS +import qualified Text.PrettyPrint as PP + +data PrettyField ann + = PrettyField ann FieldName PP.Doc + | PrettySection ann FieldName [PP.Doc] [PrettyField ann] + deriving (Functor, Foldable, Traversable) + +-- | Prettyprint a list of fields. +-- +-- Note: the first argument should return 'String's without newlines +-- and properly prefixes (with @--@) to count as comments. +-- This unsafety is left in place so one could generate empty lines +-- between comment lines. +-- +showFields :: (ann -> [String]) -> [PrettyField ann] -> String +showFields rann = showFields' rann 4 + +-- | 'showFields' with user specified indentation. +showFields' :: (ann -> [String]) -> Int -> [PrettyField ann] -> String +showFields' rann n = unlines . renderFields (Opts rann indent) where + -- few hardcoded, "unrolled" variants. + indent | n == 4 = indent4 + | n == 2 = indent2 + | otherwise = (replicate (max n 1) ' ' ++) + + indent4 :: String -> String + indent4 [] = [] + indent4 xs = ' ' : ' ' : ' ' : ' ' : xs + + indent2 :: String -> String + indent2 [] = [] + indent2 xs = ' ' : ' ' : xs + +data Opts ann = Opts (ann -> [String]) (String -> String) + +renderFields :: Opts ann -> [PrettyField ann] -> [String] +renderFields opts fields = flattenBlocks $ map (renderField opts len) fields + where + len = maxNameLength 0 fields + + maxNameLength !acc [] = acc + maxNameLength !acc (PrettyField _ name _ : rest) = maxNameLength (max acc (BS.length name)) rest + maxNameLength !acc (PrettySection {} : rest) = maxNameLength acc rest + +-- | Block of lines, +-- Boolean parameter tells whether block should be surrounded by empty lines +data Block = Block Margin Margin [String] + +data Margin = Margin | NoMargin + deriving Eq + +-- | Collapse margins, any margin = margin +instance Semigroup Margin where + NoMargin <> NoMargin = NoMargin + _ <> _ = Margin + +flattenBlocks :: [Block] -> [String] +flattenBlocks = go0 where + go0 [] = [] + go0 (Block _before after strs : blocks) = strs ++ go after blocks + + go _surr' [] = [] + go surr' (Block before after strs : blocks) = ins $ strs ++ go after blocks where + ins | surr' <> before == Margin = ("" :) + | otherwise = id + +renderField :: Opts ann -> Int -> PrettyField ann -> Block +renderField (Opts rann indent) fw (PrettyField ann name doc) = + Block before after $ comments ++ lines' + where + comments = rann ann + before = if null comments then NoMargin else Margin + + (lines', after) = case lines narrow of + [] -> ([ name' ++ ":" ], NoMargin) + [singleLine] | length singleLine < 60 + -> ([ name' ++ ": " ++ replicate (fw - length name') ' ' ++ narrow ], NoMargin) + _ -> ((name' ++ ":") : map indent (lines (PP.render doc)), Margin) + + name' = fromUTF8BS name + narrow = PP.renderStyle narrowStyle doc + + narrowStyle :: PP.Style + narrowStyle = PP.style { PP.lineLength = PP.lineLength PP.style - fw } + +renderField opts@(Opts rann indent) _ (PrettySection ann name args fields) = Block Margin Margin $ + rann ann + ++ + [ PP.render $ PP.hsep $ PP.text (fromUTF8BS name) : args ] + ++ + (map indent $ renderFields opts fields) + +------------------------------------------------------------------------------- +-- Transform from Parsec.Field +------------------------------------------------------------------------------- + +genericFromParsecFields + :: Applicative f + => (FieldName -> [P.FieldLine ann] -> f PP.Doc) -- ^ transform field contents + -> (FieldName -> [P.SectionArg ann] -> f [PP.Doc]) -- ^ transform section arguments + -> [P.Field ann] + -> f [PrettyField ann] +genericFromParsecFields f g = goMany where + goMany = traverse go + + go (P.Field (P.Name ann name) fls) = PrettyField ann name <$> f name fls + go (P.Section (P.Name ann name) secargs fs) = PrettySection ann name <$> g name secargs <*> goMany fs + +-- | Used in 'fromParsecFields'. +prettyFieldLines :: FieldName -> [P.FieldLine ann] -> PP.Doc +prettyFieldLines _ fls = PP.vcat + [ PP.text $ fromUTF8BS bs + | P.FieldLine _ bs <- fls + ] + +-- | Used in 'fromParsecFields'. +prettySectionArgs :: FieldName -> [P.SectionArg ann] -> [PP.Doc] +prettySectionArgs _ = map $ \sa -> case sa of + P.SecArgName _ bs -> showToken $ fromUTF8BS bs + P.SecArgStr _ bs -> showToken $ fromUTF8BS bs + P.SecArgOther _ bs -> PP.text $ fromUTF8BS bs + +-- | Simple variant of 'genericFromParsecField' +fromParsecFields :: [P.Field ann] -> [PrettyField ann] +fromParsecFields = runIdentity . genericFromParsecFields + (Identity .: prettyFieldLines) + (Identity .: prettySectionArgs) + where + (.:) :: (a -> b) -> (c -> d -> a) -> (c -> d -> b) + (f .: g) x y = f (g x y) diff --git a/cabal/Cabal/Distribution/InstalledPackageInfo.hs b/cabal/Cabal/Distribution/InstalledPackageInfo.hs --- a/cabal/Cabal/Distribution/InstalledPackageInfo.hs +++ b/cabal/Cabal/Distribution/InstalledPackageInfo.hs @@ -26,14 +26,12 @@ module Distribution.InstalledPackageInfo ( InstalledPackageInfo(..), - installedPackageId, installedComponentId, installedOpenUnitId, sourceComponentName, requiredSignatures, ExposedModule(..), AbiDependency(..), - ParseResult(..), PError(..), PWarning, emptyInstalledPackageInfo, parseInstalledPackageInfo, showInstalledPackageInfo, @@ -51,18 +49,13 @@ import Distribution.FieldGrammar import Distribution.FieldGrammar.FieldDescrs import Distribution.ModuleName -import Distribution.Package hiding (installedPackageId, installedUnitId) -import Distribution.ParseUtils +import Distribution.Package hiding (installedUnitId) import Distribution.Types.ComponentName import Distribution.Utils.Generic (toUTF8BS) -import qualified Data.Map as Map -import qualified Distribution.Parsec.Common as P -import qualified Distribution.Parsec.Parser as P -import qualified Distribution.Parsec.ParseResult as P -import qualified Text.Parsec.Error as Parsec -import qualified Text.Parsec.Pos as Parsec -import qualified Text.PrettyPrint as Disp +import qualified Data.Map as Map +import qualified Distribution.Fields as P +import qualified Text.PrettyPrint as Disp import Distribution.Types.InstalledPackageInfo import Distribution.Types.InstalledPackageInfo.FieldGrammar @@ -89,36 +82,29 @@ requiredSignatures :: InstalledPackageInfo -> Set ModuleName requiredSignatures ipi = openModuleSubstFreeHoles (Map.fromList (instantiatedWith ipi)) -{-# DEPRECATED installedPackageId "Use installedUnitId instead" #-} --- | Backwards compatibility with Cabal pre-1.24. --- --- This type synonym is slightly awful because in cabal-install --- we define an 'InstalledPackageId' but it's a ComponentId, --- not a UnitId! -installedPackageId :: InstalledPackageInfo -> UnitId -installedPackageId = installedUnitId - -- ----------------------------------------------------------------------------- -- Munging sourceComponentName :: InstalledPackageInfo -> ComponentName -sourceComponentName ipi = - case sourceLibName ipi of - Nothing -> CLibName - Just qn -> CSubLibName qn +sourceComponentName = CLibName . sourceLibName -- ----------------------------------------------------------------------------- -- Parsing -parseInstalledPackageInfo :: String -> ParseResult InstalledPackageInfo +-- | Return either errors, or IPI with list of warnings +-- +-- /Note:/ errors array /may/ be empty, but the parse is still failed (it's a bug though) +parseInstalledPackageInfo + :: String + -> Either (NonEmpty String) ([String], InstalledPackageInfo) parseInstalledPackageInfo s = case P.readFields (toUTF8BS s) of - Left err -> ParseFailed (NoParse (show err) $ Parsec.sourceLine $ Parsec.errorPos err) + Left err -> Left (show err :| []) Right fs -> case partitionFields fs of (fs', _) -> case P.runParseResult $ parseFieldGrammar cabalSpecLatest fs' ipiFieldGrammar of - (ws, Right x) -> ParseOk ws' x where - ws' = map (PWarning . P.showPWarning "") ws - (_, Left (_, errs)) -> ParseFailed (NoParse errs' 0) where - errs' = intercalate "; " $ map (\(P.PError _ msg) -> msg) errs + (ws, Right x) -> Right (ws', x) where + ws' = map (P.showPWarning "") ws + (_, Left (_, errs)) -> Left errs' where + errs' = fmap (P.showPError "") errs -- ----------------------------------------------------------------------------- -- Pretty-printing @@ -132,7 +118,7 @@ -- | The variant of 'showInstalledPackageInfo' which outputs @pkgroot@ field too. showFullInstalledPackageInfo :: InstalledPackageInfo -> String -showFullInstalledPackageInfo = Disp.render . (Disp.$+$ Disp.text "") . prettyFieldGrammar ipiFieldGrammar +showFullInstalledPackageInfo = P.showFields (const []) . prettyFieldGrammar cabalSpecLatest ipiFieldGrammar -- | -- @@ -141,10 +127,15 @@ -- Just "maintainer: Tester" showInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String) showInstalledPackageInfoField fn = - fmap (\g -> Disp.render . ppField fn . g) $ fieldDescrPretty ipiFieldGrammar fn + fmap (\g -> Disp.render . ppField fn . g) $ fieldDescrPretty ipiFieldGrammar (toUTF8BS fn) showSimpleInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String) showSimpleInstalledPackageInfoField fn = - fmap (Disp.renderStyle myStyle .) $ fieldDescrPretty ipiFieldGrammar fn + fmap (Disp.renderStyle myStyle .) $ fieldDescrPretty ipiFieldGrammar (toUTF8BS fn) where myStyle = Disp.style { Disp.mode = Disp.LeftMode } + +ppField :: String -> Disp.Doc -> Disp.Doc +ppField name fielddoc + | Disp.isEmpty fielddoc = mempty + | otherwise = Disp.text name <<>> Disp.colon Disp.<+> fielddoc diff --git a/cabal/Cabal/Distribution/License.hs b/cabal/Cabal/Distribution/License.hs --- a/cabal/Cabal/Distribution/License.hs +++ b/cabal/Cabal/Distribution/License.hs @@ -52,14 +52,12 @@ import Distribution.Compat.Prelude import Prelude () -import Distribution.Parsec.Class +import Distribution.Parsec import Distribution.Pretty -import Distribution.Text import Distribution.Version import qualified Distribution.Compat.CharParsing as P import qualified Data.Map.Strict as Map -import qualified Distribution.Compat.ReadP as Parse import qualified Distribution.SPDX as SPDX import qualified Text.PrettyPrint as Disp @@ -244,32 +242,11 @@ ("AllRightsReserved", Nothing) -> AllRightsReserved ("OtherLicense", Nothing) -> OtherLicense _ -> UnknownLicense $ name ++ - maybe "" (('-':) . display) version - -instance Text License where - parse = do - name <- Parse.munch1 (\c -> isAlphaNum c && c /= '-') - version <- Parse.option Nothing (Parse.char '-' >> fmap Just parse) - return $! case (name, version :: Maybe Version) of - ("GPL", _ ) -> GPL version - ("LGPL", _ ) -> LGPL version - ("AGPL", _ ) -> AGPL version - ("BSD2", Nothing) -> BSD2 - ("BSD3", Nothing) -> BSD3 - ("BSD4", Nothing) -> BSD4 - ("ISC", Nothing) -> ISC - ("MIT", Nothing) -> MIT - ("MPL", Just version') -> MPL version' - ("Apache", _ ) -> Apache version - ("PublicDomain", Nothing) -> PublicDomain - ("AllRightsReserved", Nothing) -> AllRightsReserved - ("OtherLicense", Nothing) -> OtherLicense - _ -> UnknownLicense $ name ++ - maybe "" (('-':) . display) version + maybe "" (('-':) . prettyShow) version dispOptVersion :: Maybe Version -> Disp.Doc dispOptVersion Nothing = Disp.empty dispOptVersion (Just v) = dispVersion v dispVersion :: Version -> Disp.Doc -dispVersion v = Disp.char '-' <<>> disp v +dispVersion v = Disp.char '-' <<>> pretty v diff --git a/cabal/Cabal/Distribution/Make.hs b/cabal/Cabal/Distribution/Make.hs --- a/cabal/Cabal/Distribution/Make.hs +++ b/cabal/Cabal/Distribution/Make.hs @@ -60,7 +60,7 @@ module Distribution.Make ( module Distribution.Package, License(..), Version, - defaultMain, defaultMainArgs, defaultMainNoRead + defaultMain, defaultMainArgs ) where import Prelude () @@ -70,7 +70,6 @@ import Distribution.Compat.Exception import Distribution.Package import Distribution.Simple.Program -import Distribution.PackageDescription import Distribution.Simple.Setup import Distribution.Simple.Command @@ -78,7 +77,7 @@ import Distribution.License import Distribution.Version -import Distribution.Text +import Distribution.Pretty import System.Environment (getArgs, getProgName) import System.Exit @@ -89,10 +88,6 @@ defaultMainArgs :: [String] -> IO () defaultMainArgs = defaultMainHelper -{-# DEPRECATED defaultMainNoRead "it ignores its PackageDescription arg" #-} -defaultMainNoRead :: PackageDescription -> IO () -defaultMainNoRead = const defaultMain - defaultMainHelper :: [String] -> IO () defaultMainHelper args = case commandsRun (globalCommand commands) commands args of @@ -114,9 +109,9 @@ printErrors errs = do putStr (intercalate "\n" errs) exitWith (ExitFailure 1) - printNumericVersion = putStrLn $ display cabalVersion + printNumericVersion = putStrLn $ prettyShow cabalVersion printVersion = putStrLn $ "Cabal library version " - ++ display cabalVersion + ++ prettyShow cabalVersion progs = defaultProgramDb commands = diff --git a/cabal/Cabal/Distribution/ModuleName.hs b/cabal/Cabal/Distribution/ModuleName.hs --- a/cabal/Cabal/Distribution/ModuleName.hs +++ b/cabal/Cabal/Distribution/ModuleName.hs @@ -19,7 +19,6 @@ components, toFilePath, main, - simple, -- * Internal validModuleComponent, ) where @@ -31,11 +30,9 @@ import System.FilePath ( pathSeparator ) import Distribution.Pretty -import Distribution.Parsec.Class -import Distribution.Text +import Distribution.Parsec import qualified Distribution.Compat.CharParsing as P -import qualified Distribution.Compat.ReadP as Parse import qualified Text.PrettyPrint as Disp -- | A valid Haskell module name. @@ -60,17 +57,6 @@ cs <- P.munch validModuleChar return (c:cs) -instance Text ModuleName where - parse = do - ms <- Parse.sepBy1 component (Parse.char '.') - return (ModuleName $ stlFromStrings ms) - - where - component = do - c <- Parse.satisfy isUpper - cs <- Parse.munch validModuleChar - return (c:cs) - validModuleChar :: Char -> Bool validModuleChar c = isAlphaNum c || c == '_' || c == '\'' @@ -78,10 +64,6 @@ validModuleComponent [] = False validModuleComponent (c:cs) = isUpper c && all validModuleChar cs - -{-# DEPRECATED simple "use ModuleName.fromString instead. This symbol will be removed in Cabal-3.0 (est. Mar 2019)." #-} -simple :: String -> ModuleName -simple str = ModuleName (stlFromStrings [str]) -- | Construct a 'ModuleName' from a valid module name 'String'. -- diff --git a/cabal/Cabal/Distribution/Package.hs b/cabal/Cabal/Distribution/Package.hs --- a/cabal/Cabal/Distribution/Package.hs +++ b/cabal/Cabal/Distribution/Package.hs @@ -28,7 +28,6 @@ , Package(..), packageName, packageVersion , HasMungedPackageId(..), mungedName', mungedVersion' , HasUnitId(..) - , installedPackageId , PackageInstalled(..) ) where @@ -86,11 +85,6 @@ -- | Packages that have an installed unit ID class Package pkg => HasUnitId pkg where installedUnitId :: pkg -> UnitId - -{-# DEPRECATED installedPackageId "Use installedUnitId instead. This symbol will be removed in Cabal-3.0 (est. Mar 2019)." #-} --- | Compatibility wrapper for Cabal pre-1.24. -installedPackageId :: HasUnitId pkg => pkg -> UnitId -installedPackageId = installedUnitId -- | Class of installed packages. -- diff --git a/cabal/Cabal/Distribution/PackageDescription.hs b/cabal/Cabal/Distribution/PackageDescription.hs --- a/cabal/Cabal/Distribution/PackageDescription.hs +++ b/cabal/Cabal/Distribution/PackageDescription.hs @@ -20,7 +20,6 @@ specVersion, buildType, license, - descCabalVersion, BuildType(..), knownBuildTypes, allLibraries, @@ -38,7 +37,6 @@ hasLibs, explicitLibModules, libModulesAutogen, - libModules, -- ** Executables Executable(..), @@ -89,6 +87,7 @@ allBuildDepends, enabledBuildDepends, ComponentName(..), + LibraryName(..), defaultLibName, HookedBuildInfo, emptyHookedBuildInfo, @@ -101,7 +100,7 @@ FlagAssignment, mkFlagAssignment, unFlagAssignment, nullFlagAssignment, showFlagValue, diffFlagAssignment, lookupFlagAssignment, insertFlagAssignment, - dispFlagAssignment, parseFlagAssignment, parsecFlagAssignment, + dispFlagAssignment, parsecFlagAssignment, findDuplicateFlagAssignments, CondTree(..), ConfVar(..), Condition(..), cNot, cAnd, cOr, @@ -138,5 +137,6 @@ import Distribution.Types.Condition import Distribution.Types.PackageDescription import Distribution.Types.ComponentName +import Distribution.Types.LibraryName import Distribution.Types.HookedBuildInfo import Distribution.Types.SourceRepo diff --git a/cabal/Cabal/Distribution/PackageDescription/Check.hs b/cabal/Cabal/Distribution/PackageDescription/Check.hs --- a/cabal/Cabal/Distribution/PackageDescription/Check.hs +++ b/cabal/Cabal/Distribution/PackageDescription/Check.hs @@ -52,10 +52,10 @@ import Distribution.Simple.Glob import Distribution.Simple.Utils hiding (findPackageDesc, notice) import Distribution.System -import Distribution.Text import Distribution.Types.ComponentRequestedSpec import Distribution.Types.CondTree import Distribution.Types.ExeDependency +import Distribution.Types.LibraryName import Distribution.Types.UnqualComponentName import Distribution.Utils.Generic (isAscii) import Distribution.Verbosity @@ -165,7 +165,7 @@ ++ checkFields pkg ++ checkLicense pkg ++ checkSourceRepos pkg - ++ checkGhcOptions pkg + ++ checkAllGhcOptions pkg ++ checkCCOptions pkg ++ checkCxxOptions pkg ++ checkCPPOptions pkg @@ -197,7 +197,7 @@ PackageBuildImpossible "No executables, libraries, tests, or benchmarks found. Nothing to do." - , check (any isNothing (map libName $ subLibraries pkg)) $ + , check (any (== LMainLibName) (map libName $ subLibraries pkg)) $ PackageBuildImpossible $ "Found one or more unnamed internal libraries. " ++ "Only the non-internal library can have the same name as the package." @@ -210,13 +210,13 @@ -- NB: but it's OK for executables to have the same name! -- TODO shouldn't need to compare on the string level - , check (any (== display (packageName pkg)) (display <$> subLibNames)) $ + , check (any (== prettyShow (packageName pkg)) (prettyShow <$> subLibNames)) $ PackageBuildImpossible $ "Illegal internal library name " - ++ display (packageName pkg) + ++ prettyShow (packageName pkg) ++ ". Internal libraries cannot have the same name as the package." ++ " Maybe you wanted a non-internal library?" ++ " If so, rewrite the section stanza" - ++ " from 'library: '" ++ display (packageName pkg) ++ "' to 'library'." + ++ " from 'library: '" ++ prettyShow (packageName pkg) ++ "' to 'library'." ] --TODO: check for name clashes case insensitively: windows file systems cannot --cope. @@ -231,14 +231,14 @@ check (specVersion pkg > cabalVersion) $ PackageBuildImpossible $ "This package description follows version " - ++ display (specVersion pkg) ++ " of the Cabal specification. This " - ++ "tool only supports up to version " ++ display cabalVersion ++ "." + ++ prettyShow (specVersion pkg) ++ " of the Cabal specification. This " + ++ "tool only supports up to version " ++ prettyShow cabalVersion ++ "." ] where -- The public 'library' gets special dispensation, because it -- is common practice to export a library and name the executable -- the same as the package. - subLibNames = catMaybes . map libName $ subLibraries pkg + subLibNames = mapMaybe (libraryNameString . libName) $ subLibraries pkg exeNames = map exeName $ executables pkg testNames = map testName $ testSuites pkg bmNames = map benchmarkName $ benchmarks pkg @@ -251,15 +251,12 @@ check (not (null moduleDuplicates)) $ PackageBuildImpossible $ "Duplicate modules in library: " - ++ commaSep (map display moduleDuplicates) + ++ commaSep (map prettyShow moduleDuplicates) -- TODO: This check is bogus if a required-signature was passed through , check (null (explicitLibModules lib) && null (reexportedModules lib)) $ PackageDistSuspiciousWarn $ - "Library " ++ (case libName lib of - Nothing -> "" - Just n -> display n - ) ++ "does not expose any modules" + showLibraryName (libName lib) ++ " does not expose any modules" -- check use of signatures sections , checkVersion [1,25] (not (null (signatures lib))) $ @@ -274,6 +271,12 @@ "An 'autogen-module' is neither on 'exposed-modules' or " ++ "'other-modules'." + -- check that all autogen-includes appear on includes or install-includes + , check + (not $ and $ map (flip elem (allExplicitIncludes lib)) (view L.autogenIncludes lib)) $ + PackageBuildImpossible $ + "An include in 'autogen-includes' is neither in 'includes' or " + ++ "'install-includes'." ] where @@ -286,13 +289,16 @@ moduleDuplicates = dups (explicitLibModules lib ++ map moduleReexportName (reexportedModules lib)) +allExplicitIncludes :: L.HasBuildInfo a => a -> [FilePath] +allExplicitIncludes x = view L.includes x ++ view L.installIncludes x + checkExecutable :: PackageDescription -> Executable -> [PackageCheck] checkExecutable pkg exe = catMaybes [ check (null (modulePath exe)) $ PackageBuildImpossible $ - "No 'main-is' field found for executable " ++ display (exeName exe) + "No 'main-is' field found for executable " ++ prettyShow (exeName exe) , check (not (null (modulePath exe)) && (not $ fileExtensionSupportedLanguage $ modulePath exe)) $ @@ -310,15 +316,20 @@ , check (not (null moduleDuplicates)) $ PackageBuildImpossible $ - "Duplicate modules in executable '" ++ display (exeName exe) ++ "': " - ++ commaSep (map display moduleDuplicates) + "Duplicate modules in executable '" ++ prettyShow (exeName exe) ++ "': " + ++ commaSep (map prettyShow moduleDuplicates) -- check that all autogen-modules appear on other-modules , check (not $ and $ map (flip elem (exeModules exe)) (exeModulesAutogen exe)) $ PackageBuildImpossible $ - "On executable '" ++ display (exeName exe) ++ "' an 'autogen-module' is not " + "On executable '" ++ prettyShow (exeName exe) ++ "' an 'autogen-module' is not " ++ "on 'other-modules'" + + -- check that all autogen-includes appear on includes + , check + (not $ and $ map (flip elem (view L.includes exe)) (view L.autogenIncludes exe)) $ + PackageBuildImpossible "An include in 'autogen-includes' is not in 'includes'." ] where moduleDuplicates = dups (exeModules exe) @@ -330,21 +341,21 @@ case testInterface test of TestSuiteUnsupported tt@(TestTypeUnknown _ _) -> Just $ PackageBuildWarning $ - quote (display tt) ++ " is not a known type of test suite. " + quote (prettyShow tt) ++ " is not a known type of test suite. " ++ "The known test suite types are: " - ++ commaSep (map display knownTestTypes) + ++ commaSep (map prettyShow knownTestTypes) TestSuiteUnsupported tt -> Just $ PackageBuildWarning $ - quote (display tt) ++ " is not a supported test suite version. " + quote (prettyShow tt) ++ " is not a supported test suite version. " ++ "The known test suite types are: " - ++ commaSep (map display knownTestTypes) + ++ commaSep (map prettyShow knownTestTypes) _ -> Nothing , check (not $ null moduleDuplicates) $ PackageBuildImpossible $ - "Duplicate modules in test suite '" ++ display (testName test) ++ "': " - ++ commaSep (map display moduleDuplicates) + "Duplicate modules in test suite '" ++ prettyShow (testName test) ++ "': " + ++ commaSep (map prettyShow moduleDuplicates) , check mainIsWrongExt $ PackageBuildImpossible $ @@ -359,13 +370,15 @@ -- check that all autogen-modules appear on other-modules , check - (not $ and $ map - (flip elem (testModules test)) - (testModulesAutogen test) - ) $ + (not $ and $ map (flip elem (testModules test)) (testModulesAutogen test)) $ PackageBuildImpossible $ - "On test suite '" ++ display (testName test) ++ "' an 'autogen-module' is not " + "On test suite '" ++ prettyShow (testName test) ++ "' an 'autogen-module' is not " ++ "on 'other-modules'" + + -- check that all autogen-includes appear on includes + , check + (not $ and $ map (flip elem (view L.includes test)) (view L.autogenIncludes test)) $ + PackageBuildImpossible "An include in 'autogen-includes' is not in 'includes'." ] where moduleDuplicates = dups $ testModules test @@ -385,21 +398,21 @@ case benchmarkInterface bm of BenchmarkUnsupported tt@(BenchmarkTypeUnknown _ _) -> Just $ PackageBuildWarning $ - quote (display tt) ++ " is not a known type of benchmark. " + quote (prettyShow tt) ++ " is not a known type of benchmark. " ++ "The known benchmark types are: " - ++ commaSep (map display knownBenchmarkTypes) + ++ commaSep (map prettyShow knownBenchmarkTypes) BenchmarkUnsupported tt -> Just $ PackageBuildWarning $ - quote (display tt) ++ " is not a supported benchmark version. " + quote (prettyShow tt) ++ " is not a supported benchmark version. " ++ "The known benchmark types are: " - ++ commaSep (map display knownBenchmarkTypes) + ++ commaSep (map prettyShow knownBenchmarkTypes) _ -> Nothing , check (not $ null moduleDuplicates) $ PackageBuildImpossible $ - "Duplicate modules in benchmark '" ++ display (benchmarkName bm) ++ "': " - ++ commaSep (map display moduleDuplicates) + "Duplicate modules in benchmark '" ++ prettyShow (benchmarkName bm) ++ "': " + ++ commaSep (map prettyShow moduleDuplicates) , check mainIsWrongExt $ PackageBuildImpossible $ @@ -408,13 +421,15 @@ -- check that all autogen-modules appear on other-modules , check - (not $ and $ map - (flip elem (benchmarkModules bm)) - (benchmarkModulesAutogen bm) - ) $ + (not $ and $ map (flip elem (benchmarkModules bm)) (benchmarkModulesAutogen bm)) $ PackageBuildImpossible $ - "On benchmark '" ++ display (benchmarkName bm) ++ "' an 'autogen-module' is " + "On benchmark '" ++ prettyShow (benchmarkName bm) ++ "' an 'autogen-module' is " ++ "not on 'other-modules'" + + -- check that all autogen-includes appear on includes + , check + (not $ and $ map (flip elem (view L.includes bm)) (view L.autogenIncludes bm)) $ + PackageBuildImpossible "An include in 'autogen-includes' is not in 'includes'." ] where moduleDuplicates = dups $ benchmarkModules bm @@ -431,14 +446,14 @@ checkFields pkg = catMaybes [ - check (not . FilePath.Windows.isValid . display . packageName $ pkg) $ + check (not . FilePath.Windows.isValid . prettyShow . packageName $ pkg) $ PackageDistInexcusable $ - "Unfortunately, the package name '" ++ display (packageName pkg) + "Unfortunately, the package name '" ++ prettyShow (packageName pkg) ++ "' is one of the reserved system file names on Windows. Many tools " ++ "need to convert package names to file names so using this name " ++ "would cause problems." - , check ((isPrefixOf "z-") . display . packageName $ pkg) $ + , check ((isPrefixOf "z-") . prettyShow . packageName $ pkg) $ PackageDistInexcusable $ "Package names with the prefix 'z-' are reserved by Cabal and " ++ "cannot be used." @@ -477,10 +492,10 @@ , check (not (null ourDeprecatedExtensions)) $ PackageDistSuspicious $ "Deprecated extensions: " - ++ commaSep (map (quote . display . fst) ourDeprecatedExtensions) + ++ commaSep (map (quote . prettyShow . fst) ourDeprecatedExtensions) ++ ". " ++ unwords - [ "Instead of '" ++ display ext - ++ "' use '" ++ display replacement ++ "'." + [ "Instead of '" ++ prettyShow ext + ++ "' use '" ++ prettyShow replacement ++ "'." | (ext, Just replacement) <- ourDeprecatedExtensions ] , check (null (category pkg)) $ @@ -526,20 +541,17 @@ , check (not (null testedWithImpossibleRanges)) $ PackageDistInexcusable $ "Invalid 'tested-with' version range: " - ++ commaSep (map display testedWithImpossibleRanges) + ++ commaSep (map prettyShow testedWithImpossibleRanges) ++ ". To indicate that you have tested a package with multiple " ++ "different versions of the same compiler use multiple entries, " ++ "for example 'tested-with: GHC==6.10.4, GHC==6.12.3' and not " ++ "'tested-with: GHC==6.10.4 && ==6.12.3'." - -- Disabled due to #5119: we generate loads of spurious instances of - -- this warning. Re-enabling this check should be part of the fix to - -- #5119. - , check (False && not (null depInternalLibraryWithExtraVersion)) $ + , check (not (null depInternalLibraryWithExtraVersion)) $ PackageBuildWarning $ "The package has an extraneous version range for a dependency on an " ++ "internal library: " - ++ commaSep (map display depInternalLibraryWithExtraVersion) + ++ commaSep (map prettyShow depInternalLibraryWithExtraVersion) ++ ". This version range includes the current package but isn't needed " ++ "as the current package's library will always be used." @@ -547,7 +559,7 @@ PackageBuildImpossible $ "The package has an impossible version range for a dependency on an " ++ "internal library: " - ++ commaSep (map display depInternalLibraryWithImpossibleVersion) + ++ commaSep (map prettyShow depInternalLibraryWithImpossibleVersion) ++ ". This version range does not include the current package, and must " ++ "be removed as the current package's library will always be used." @@ -555,7 +567,7 @@ PackageBuildWarning $ "The package has an extraneous version range for a dependency on an " ++ "internal executable: " - ++ commaSep (map display depInternalExecutableWithExtraVersion) + ++ commaSep (map prettyShow depInternalExecutableWithExtraVersion) ++ ". This version range includes the current package but isn't needed " ++ "as the current package's executable will always be used." @@ -563,14 +575,14 @@ PackageBuildImpossible $ "The package has an impossible version range for a dependency on an " ++ "internal executable: " - ++ commaSep (map display depInternalExecutableWithImpossibleVersion) + ++ commaSep (map prettyShow depInternalExecutableWithImpossibleVersion) ++ ". This version range does not include the current package, and must " ++ "be removed as the current package's executable will always be used." , check (not (null depMissingInternalExecutable)) $ PackageBuildImpossible $ "The package depends on a missing internal executable: " - ++ commaSep (map display depInternalExecutableWithImpossibleVersion) + ++ commaSep (map prettyShow depInternalExecutableWithImpossibleVersion) ] where unknownCompilers = [ name | (OtherCompiler name, _) <- testedWith pkg ] @@ -578,7 +590,7 @@ , UnknownLanguage name <- allLanguages bi ] unknownExtensions = [ name | bi <- allBuildInfo pkg , UnknownExtension name <- allExtensions bi - , name `notElem` map display knownLanguages ] + , name `notElem` map prettyShow knownLanguages ] ourDeprecatedExtensions = nub $ catMaybes [ find ((==ext) . fst) deprecatedExtensions | bi <- allBuildInfo pkg @@ -586,15 +598,15 @@ languagesUsedAsExtensions = [ name | bi <- allBuildInfo pkg , UnknownExtension name <- allExtensions bi - , name `elem` map display knownLanguages ] + , name `elem` map prettyShow knownLanguages ] testedWithImpossibleRanges = - [ Dependency (mkPackageName (display compiler)) vr + [ Dependency (mkPackageName (prettyShow compiler)) vr Set.empty | (compiler, vr) <- testedWith pkg , isNoVersion vr ] internalLibraries = - map (maybe (packageName pkg) (unqualComponentNameToPackageName) . libName) + map (maybe (packageName pkg) (unqualComponentNameToPackageName) . libraryNameString . libName) (allLibraries pkg) internalExecutables = map exeName $ executables pkg @@ -602,7 +614,7 @@ internalLibDeps = [ dep | bi <- allBuildInfo pkg - , dep@(Dependency name _) <- targetBuildDepends bi + , dep@(Dependency name _ _) <- targetBuildDepends bi , name `elem` internalLibraries ] @@ -615,14 +627,14 @@ depInternalLibraryWithExtraVersion = [ dep - | dep@(Dependency _ versionRange) <- internalLibDeps + | dep@(Dependency _ versionRange _) <- internalLibDeps , not $ isAnyVersion versionRange , packageVersion pkg `withinRange` versionRange ] depInternalLibraryWithImpossibleVersion = [ dep - | dep@(Dependency _ versionRange) <- internalLibDeps + | dep@(Dependency _ versionRange _) <- internalLibDeps , not $ packageVersion pkg `withinRange` versionRange ] @@ -680,7 +692,7 @@ PackageBuildWarning $ quote ("license: " ++ l) ++ " is not a recognised license. The " ++ "known licenses are: " - ++ commaSep (map display knownLicenses) + ++ commaSep (map prettyShow knownLicenses) _ -> Nothing , check (lic == BSD4) $ @@ -692,9 +704,9 @@ , case unknownLicenseVersion (lic) of Just knownVersions -> Just $ PackageDistSuspicious $ - "'license: " ++ display (lic) ++ "' is not a known " + "'license: " ++ prettyShow (lic) ++ "' is not a known " ++ "version of that license. The known versions are " - ++ commaSep (map display knownVersions) + ++ commaSep (map prettyShow knownVersions) ++ ". If this is not a mistake and you think it should be a known " ++ "version then please file a ticket." _ -> Nothing @@ -766,86 +778,97 @@ --TODO: check location looks like a URL for some repo types. -checkGhcOptions :: PackageDescription -> [PackageCheck] -checkGhcOptions pkg = +-- | Checks GHC options from all ghc-*-options fields in the given +-- PackageDescription and reports commonly misused or non-portable flags +checkAllGhcOptions :: PackageDescription -> [PackageCheck] +checkAllGhcOptions pkg = + checkGhcOptions "ghc-options" (hcOptions GHC) pkg + ++ checkGhcOptions "ghc-prof-options" (hcProfOptions GHC) pkg + ++ checkGhcOptions "ghc-shared-options" (hcSharedOptions GHC) pkg + +-- | Extracts GHC options belonging to the given field from the given +-- PackageDescription using given function and checks them for commonly misused +-- or non-portable flags +checkGhcOptions :: String -> (BuildInfo -> [String]) -> PackageDescription -> [PackageCheck] +checkGhcOptions fieldName getOptions pkg = catMaybes [ checkFlags ["-fasm"] $ PackageDistInexcusable $ - "'ghc-options: -fasm' is unnecessary and will not work on CPU " + "'" ++ fieldName ++ ": -fasm' is unnecessary and will not work on CPU " ++ "architectures other than x86, x86-64, ppc or sparc." , checkFlags ["-fvia-C"] $ PackageDistSuspicious $ - "'ghc-options: -fvia-C' is usually unnecessary. If your package " + "'" ++ fieldName ++": -fvia-C' is usually unnecessary. If your package " ++ "needs -via-C for correctness rather than performance then it " ++ "is using the FFI incorrectly and will probably not work with GHC " ++ "6.10 or later." , checkFlags ["-fhpc"] $ PackageDistInexcusable $ - "'ghc-options: -fhpc' is not not necessary. Use the configure flag " + "'" ++ fieldName ++ ": -fhpc' is not not necessary. Use the configure flag " ++ " --enable-coverage instead." , checkFlags ["-prof"] $ PackageBuildWarning $ - "'ghc-options: -prof' is not necessary and will lead to problems " + "'" ++ fieldName ++ ": -prof' is not necessary and will lead to problems " ++ "when used on a library. Use the configure flag " ++ "--enable-library-profiling and/or --enable-profiling." , checkFlags ["-o"] $ PackageBuildWarning $ - "'ghc-options: -o' is not needed. " + "'" ++ fieldName ++ ": -o' is not needed. " ++ "The output files are named automatically." , checkFlags ["-hide-package"] $ PackageBuildWarning $ - "'ghc-options: -hide-package' is never needed. " + "'" ++ fieldName ++ ": -hide-package' is never needed. " ++ "Cabal hides all packages." , checkFlags ["--make"] $ PackageBuildWarning $ - "'ghc-options: --make' is never needed. Cabal uses this automatically." + "'" ++ fieldName ++ ": --make' is never needed. Cabal uses this automatically." , checkFlags ["-main-is"] $ PackageDistSuspicious $ - "'ghc-options: -main-is' is not portable." + "'" ++ fieldName ++ ": -main-is' is not portable." , checkNonTestAndBenchmarkFlags ["-O0", "-Onot"] $ PackageDistSuspicious $ - "'ghc-options: -O0' is not needed. " + "'" ++ fieldName ++ ": -O0' is not needed. " ++ "Use the --disable-optimization configure flag." , checkTestAndBenchmarkFlags ["-O0", "-Onot"] $ PackageDistSuspiciousWarn $ - "'ghc-options: -O0' is not needed. " + "'" ++ fieldName ++ ": -O0' is not needed. " ++ "Use the --disable-optimization configure flag." , checkFlags [ "-O", "-O1"] $ PackageDistInexcusable $ - "'ghc-options: -O' is not needed. " + "'" ++ fieldName ++ ": -O' is not needed. " ++ "Cabal automatically adds the '-O' flag. " ++ "Setting it yourself interferes with the --disable-optimization flag." , checkFlags ["-O2"] $ PackageDistSuspiciousWarn $ - "'ghc-options: -O2' is rarely needed. " + "'" ++ fieldName ++ ": -O2' is rarely needed. " ++ "Check that it is giving a real benefit " ++ "and not just imposing longer compile times on your users." , checkFlags ["-split-sections"] $ PackageBuildWarning $ - "'ghc-options: -split-sections' is not needed. " + "'" ++ fieldName ++ ": -split-sections' is not needed. " ++ "Use the --enable-split-sections configure flag." , checkFlags ["-split-objs"] $ PackageBuildWarning $ - "'ghc-options: -split-objs' is not needed. " + "'" ++ fieldName ++ ": -split-objs' is not needed. " ++ "Use the --enable-split-objs configure flag." , checkFlags ["-optl-Wl,-s", "-optl-s"] $ PackageDistInexcusable $ - "'ghc-options: -optl-Wl,-s' is not needed and is not portable to all" + "'" ++ fieldName ++ ": -optl-Wl,-s' is not needed and is not portable to all" ++ " operating systems. Cabal 1.4 and later automatically strip" ++ " executables. Cabal also has a flag --disable-executable-stripping" ++ " which is necessary when building packages for some Linux" @@ -853,67 +876,64 @@ , checkFlags ["-fglasgow-exts"] $ PackageDistSuspicious $ - "Instead of 'ghc-options: -fglasgow-exts' it is preferable to use " + "Instead of '" ++ fieldName ++ ": -fglasgow-exts' it is preferable to use " ++ "the 'extensions' field." , check ("-threaded" `elem` lib_ghc_options) $ PackageBuildWarning $ - "'ghc-options: -threaded' has no effect for libraries. It should " + "'" ++ fieldName ++ ": -threaded' has no effect for libraries. It should " ++ "only be used for executables." , check ("-rtsopts" `elem` lib_ghc_options) $ PackageBuildWarning $ - "'ghc-options: -rtsopts' has no effect for libraries. It should " + "'" ++ fieldName ++ ": -rtsopts' has no effect for libraries. It should " ++ "only be used for executables." , check (any (\opt -> "-with-rtsopts" `isPrefixOf` opt) lib_ghc_options) $ PackageBuildWarning $ - "'ghc-options: -with-rtsopts' has no effect for libraries. It " + "'" ++ fieldName ++ ": -with-rtsopts' has no effect for libraries. It " ++ "should only be used for executables." - , checkAlternatives "ghc-options" "extensions" - [ (flag, display extension) | flag <- all_ghc_options + , checkAlternatives fieldName "extensions" + [ (flag, prettyShow extension) | flag <- all_ghc_options , Just extension <- [ghcExtension flag] ] - , checkAlternatives "ghc-options" "extensions" + , checkAlternatives fieldName "extensions" [ (flag, extension) | flag@('-':'X':extension) <- all_ghc_options ] - , checkAlternatives "ghc-options" "cpp-options" $ + , checkAlternatives fieldName "cpp-options" $ [ (flag, flag) | flag@('-':'D':_) <- all_ghc_options ] ++ [ (flag, flag) | flag@('-':'U':_) <- all_ghc_options ] - , checkAlternatives "ghc-options" "include-dirs" + , checkAlternatives fieldName "include-dirs" [ (flag, dir) | flag@('-':'I':dir) <- all_ghc_options ] - , checkAlternatives "ghc-options" "extra-libraries" + , checkAlternatives fieldName "extra-libraries" [ (flag, lib) | flag@('-':'l':lib) <- all_ghc_options ] - , checkAlternatives "ghc-options" "extra-lib-dirs" + , checkAlternatives fieldName "extra-lib-dirs" [ (flag, dir) | flag@('-':'L':dir) <- all_ghc_options ] - , checkAlternatives "ghc-options" "frameworks" + , checkAlternatives fieldName "frameworks" [ (flag, fmwk) | (flag@"-framework", fmwk) <- zip all_ghc_options (safeTail all_ghc_options) ] - , checkAlternatives "ghc-options" "extra-framework-dirs" + , checkAlternatives fieldName "extra-framework-dirs" [ (flag, dir) | (flag@"-framework-path", dir) <- zip all_ghc_options (safeTail all_ghc_options) ] ] where - all_ghc_options = concatMap get_ghc_options (allBuildInfo pkg) - lib_ghc_options = concatMap (get_ghc_options . libBuildInfo) + all_ghc_options = concatMap getOptions (allBuildInfo pkg) + lib_ghc_options = concatMap (getOptions . libBuildInfo) (allLibraries pkg) - get_ghc_options bi = hcOptions GHC bi ++ hcProfOptions GHC bi - ++ hcSharedOptions GHC bi - - test_ghc_options = concatMap (get_ghc_options . testBuildInfo) + test_ghc_options = concatMap (getOptions . testBuildInfo) (testSuites pkg) - benchmark_ghc_options = concatMap (get_ghc_options . benchmarkBuildInfo) + benchmark_ghc_options = concatMap (getOptions . benchmarkBuildInfo) (benchmarks pkg) test_and_benchmark_ghc_options = test_ghc_options ++ benchmark_ghc_options - non_test_and_benchmark_ghc_options = concatMap get_ghc_options + non_test_and_benchmark_ghc_options = concatMap getOptions (allBuildInfo (pkg { testSuites = [] , benchmarks = [] })) @@ -1054,7 +1074,7 @@ ++ "manager). In addition the layout of the 'dist' directory is subject " ++ "to change in future versions of Cabal." | bi <- allBuildInfo pkg - , (GHC, flags) <- options bi + , (GHC, flags) <- perCompilerFlavorToList $ options bi , path <- flags , isInsideDist path ] ++ @@ -1127,7 +1147,7 @@ PackageBuildWarning $ "Packages relying on Cabal 1.10 or later must only specify a " ++ "version range of the form 'cabal-version: >= x.y'. Use " - ++ "'cabal-version: >= " ++ display (specVersion pkg) ++ "'." + ++ "'cabal-version: >= " ++ prettyShow (specVersion pkg) ++ "'." -- check syntax of cabal-version field , check (specVersion pkg < mkVersion [1,9] @@ -1135,7 +1155,7 @@ PackageDistSuspicious $ "It is recommended that the 'cabal-version' field only specify a " ++ "version range of the form '>= x.y'. Use " - ++ "'cabal-version: >= " ++ display (specVersion pkg) ++ "'. " + ++ "'cabal-version: >= " ++ prettyShow (specVersion pkg) ++ "'. " ++ "Tools based on Cabal 1.10 and later will ignore upper bounds." -- check syntax of cabal-version field @@ -1143,7 +1163,7 @@ PackageBuildWarning $ "With Cabal 1.10 or earlier, the 'cabal-version' field must use " ++ "range syntax rather than a simple version number. Use " - ++ "'cabal-version: >= " ++ display (specVersion pkg) ++ "'." + ++ "'cabal-version: >= " ++ prettyShow (specVersion pkg) ++ "'." -- check syntax of cabal-version field , check (specVersion pkg >= mkVersion [1,12] @@ -1152,7 +1172,7 @@ "Packages relying on Cabal 1.12 or later should specify a " ++ "specific version of the Cabal spec of the form " ++ "'cabal-version: x.y'. " - ++ "Use 'cabal-version: " ++ display (specVersion pkg) ++ "'." + ++ "Use 'cabal-version: " ++ prettyShow (specVersion pkg) ++ "'." -- check use of test suite sections , checkVersion [1,8] (not (null $ testSuites pkg)) $ @@ -1243,24 +1263,24 @@ , checkVersion [1,6] (not (null depsUsingWildcardSyntax)) $ PackageDistInexcusable $ "The package uses wildcard syntax in the 'build-depends' field: " - ++ commaSep (map display depsUsingWildcardSyntax) + ++ commaSep (map prettyShow depsUsingWildcardSyntax) ++ ". To use this new syntax the package need to specify at least " ++ "'cabal-version: >= 1.6'. Alternatively, if broader compatibility " ++ "is important then use: " ++ commaSep - [ display (Dependency name (eliminateWildcardSyntax versionRange)) - | Dependency name versionRange <- depsUsingWildcardSyntax ] + [ prettyShow (Dependency name (eliminateWildcardSyntax versionRange) Set.empty) + | Dependency name versionRange _ <- depsUsingWildcardSyntax ] -- check use of "build-depends: foo ^>= 1.2.3" syntax , checkVersion [2,0] (not (null depsUsingMajorBoundSyntax)) $ PackageDistInexcusable $ "The package uses major bounded version syntax in the " ++ "'build-depends' field: " - ++ commaSep (map display depsUsingMajorBoundSyntax) + ++ commaSep (map prettyShow depsUsingMajorBoundSyntax) ++ ". To use this new syntax the package need to specify at least " ++ "'cabal-version: 2.0'. Alternatively, if broader compatibility " ++ "is important then use: " ++ commaSep - [ display (Dependency name (eliminateMajorBoundSyntax versionRange)) - | Dependency name versionRange <- depsUsingMajorBoundSyntax ] + [ prettyShow (Dependency name (eliminateMajorBoundSyntax versionRange) Set.empty) + | Dependency name versionRange _ <- depsUsingMajorBoundSyntax ] , checkVersion [2,1] (any (not . null) (concatMap buildInfoField @@ -1273,6 +1293,14 @@ ++ " and 'extra-library-flavours' requires the package " ++ " to specify at least 'cabal-version: >= 2.1'." + , checkVersion [2,5] (any (not . null) $ buildInfoField extraDynLibFlavours) $ + PackageDistInexcusable $ + "The use of 'extra-dynamic-library-flavours' requires the package " + ++ " to specify at least 'cabal-version: >= 2.5'. The flavours are: " + ++ commaSep [ flav + | flavs <- buildInfoField extraDynLibFlavours + , flav <- flavs ] + , checkVersion [2,1] (any (not . null) (buildInfoField virtualModules)) $ PackageDistInexcusable $ @@ -1292,12 +1320,12 @@ , checkVersion [1,6] (not (null testedWithUsingWildcardSyntax)) $ PackageDistInexcusable $ "The package uses wildcard syntax in the 'tested-with' field: " - ++ commaSep (map display testedWithUsingWildcardSyntax) + ++ commaSep (map prettyShow testedWithUsingWildcardSyntax) ++ ". To use this new syntax the package need to specify at least " ++ "'cabal-version: >= 1.6'. Alternatively, if broader compatibility " ++ "is important then use: " ++ commaSep - [ display (Dependency name (eliminateWildcardSyntax versionRange)) - | Dependency name versionRange <- testedWithUsingWildcardSyntax ] + [ prettyShow (Dependency name (eliminateWildcardSyntax versionRange) Set.empty) + | Dependency name versionRange _ <- testedWithUsingWildcardSyntax ] -- check use of "source-repository" section , checkVersion [1,6] (not (null (sourceRepos pkg))) $ @@ -1310,7 +1338,7 @@ , checkVersion [1,2,3] (not (null mentionedExtensionsThatNeedCabal12)) $ PackageDistInexcusable $ "Unfortunately the language extensions " - ++ commaSep (map (quote . display) mentionedExtensionsThatNeedCabal12) + ++ commaSep (map (quote . prettyShow) mentionedExtensionsThatNeedCabal12) ++ " break the parser in earlier Cabal versions so you need to " ++ "specify 'cabal-version: >= 1.2.3'. Alternatively if you require " ++ "compatibility with earlier Cabal versions then you may be able to " @@ -1319,7 +1347,7 @@ , checkVersion [1,4] (not (null mentionedExtensionsThatNeedCabal14)) $ PackageDistInexcusable $ "Unfortunately the language extensions " - ++ commaSep (map (quote . display) mentionedExtensionsThatNeedCabal14) + ++ commaSep (map (quote . prettyShow) mentionedExtensionsThatNeedCabal14) ++ " break the parser in earlier Cabal versions so you need to " ++ "specify 'cabal-version: >= 1.4'. Alternatively if you require " ++ "compatibility with earlier Cabal versions then you may be able to " @@ -1339,7 +1367,7 @@ && isNothing (setupBuildInfo pkg) && buildType pkg == Custom) $ PackageDistSuspiciousWarn $ - "From version 1.24 cabal supports specifiying explicit dependencies " + "From version 1.24 cabal supports specifying explicit dependencies " ++ "for Custom setup scripts. Consider using cabal-version >= 1.24 and " ++ "adding a 'custom-setup' section with a 'setup-depends' field " ++ "that specifies the dependencies of the Setup.hs script itself. " @@ -1371,11 +1399,11 @@ buildInfoField field = map field (allBuildInfo pkg) versionRangeExpressions = - [ dep | dep@(Dependency _ vr) <- allBuildDepends pkg + [ dep | dep@(Dependency _ vr _) <- allBuildDepends pkg , usesNewVersionRangeSyntax vr ] testedWithVersionRangeExpressions = - [ Dependency (mkPackageName (display compiler)) vr + [ Dependency (mkPackageName (prettyShow compiler)) vr Set.empty | (compiler, vr) <- testedWith pkg , usesNewVersionRangeSyntax vr ] @@ -1399,16 +1427,16 @@ alg (VersionRangeParensF _) = 3 alg _ = 1 :: Int - depsUsingWildcardSyntax = [ dep | dep@(Dependency _ vr) <- allBuildDepends pkg + depsUsingWildcardSyntax = [ dep | dep@(Dependency _ vr _) <- allBuildDepends pkg , usesWildcardSyntax vr ] - depsUsingMajorBoundSyntax = [ dep | dep@(Dependency _ vr) <- allBuildDepends pkg + depsUsingMajorBoundSyntax = [ dep | dep@(Dependency _ vr _) <- allBuildDepends pkg , usesMajorBoundSyntax vr ] usesBackpackIncludes = any (not . null . mixins) (allBuildInfo pkg) testedWithUsingWildcardSyntax = - [ Dependency (mkPackageName (display compiler)) vr + [ Dependency (mkPackageName (prettyShow compiler)) vr Set.empty | (compiler, vr) <- testedWith pkg , usesWildcardSyntax vr ] @@ -1497,8 +1525,8 @@ allModuleNamesAutogen = concatMap autogenModules (allBuildInfo pkg) displayRawDependency :: Dependency -> String -displayRawDependency (Dependency pkg vr) = - display pkg ++ " " ++ display vr +displayRawDependency (Dependency pkg vr _sublibs) = + prettyShow pkg ++ " " ++ prettyShow vr -- ------------------------------------------------------------ @@ -1549,7 +1577,7 @@ foldr intersectVersionRanges anyVersion baseDeps where baseDeps = - [ vr | Dependency pname vr <- allBuildDepends pkg' + [ vr | Dependency pname vr _ <- allBuildDepends pkg' , pname == mkPackageName "base" ] -- Just in case finalizePD fails for any reason, @@ -1696,41 +1724,53 @@ strings = EnableExtension OverloadedStrings lists = EnableExtension OverloadedLists +-- | Checks GHC options from all ghc-*-options fields from the given BuildInfo +-- and reports flags that are OK during development process, but are +-- unacceptable in a distrubuted package checkDevelopmentOnlyFlagsBuildInfo :: BuildInfo -> [PackageCheck] checkDevelopmentOnlyFlagsBuildInfo bi = + checkDevelopmentOnlyFlagsOptions "ghc-options" (hcOptions GHC bi) + ++ checkDevelopmentOnlyFlagsOptions "ghc-prof-options" (hcProfOptions GHC bi) + ++ checkDevelopmentOnlyFlagsOptions "ghc-shared-options" (hcSharedOptions GHC bi) + +-- | Checks the given list of flags belonging to the given field and reports +-- flags that are OK during development process, but are unacceptable in a +-- distributed package +checkDevelopmentOnlyFlagsOptions :: String -> [String] -> [PackageCheck] +checkDevelopmentOnlyFlagsOptions fieldName ghcOptions = catMaybes [ check has_WerrorWall $ PackageDistInexcusable $ - "'ghc-options: -Wall -Werror' makes the package very easy to " + "'" ++ fieldName ++ ": -Wall -Werror' makes the package very easy to " ++ "break with future GHC versions because new GHC versions often " - ++ "add new warnings. Use just 'ghc-options: -Wall' instead." + ++ "add new warnings. Use just '" ++ fieldName ++ ": -Wall' instead." ++ extraExplanation , check (not has_WerrorWall && has_Werror) $ PackageDistInexcusable $ - "'ghc-options: -Werror' makes the package easy to " + "'" ++ fieldName ++ ": -Werror' makes the package easy to " ++ "break with future GHC versions because new GHC versions often " ++ "add new warnings. " ++ extraExplanation , check (has_J) $ PackageDistInexcusable $ - "'ghc-options: -j[N]' can make sense for specific user's setup," + "'" ++ fieldName ++ ": -j[N]' can make sense for specific user's setup," ++ " but it is not appropriate for a distributed package." ++ extraExplanation , checkFlags ["-fdefer-type-errors"] $ PackageDistInexcusable $ - "'ghc-options: -fdefer-type-errors' is fine during development but " + "'" ++ fieldName ++ ": -fdefer-type-errors' is fine during development but " ++ "is not appropriate for a distributed package. " ++ extraExplanation -- -dynamic is not a debug flag , check (any (\opt -> "-d" `isPrefixOf` opt && opt /= "-dynamic") - ghc_options) $ + ghcOptions) $ PackageDistInexcusable $ - "'ghc-options: -d*' debug flags are not appropriate " + "'" ++ fieldName ++ ": -d*' debug flags are not appropriate " ++ "for a distributed package. " ++ extraExplanation @@ -1738,7 +1778,7 @@ "-fprof-cafs", "-fno-prof-count-entries", "-auto-all", "-auto", "-caf-all"] $ PackageDistSuspicious $ - "'ghc-options/ghc-prof-options: -fprof*' profiling flags are typically not " + "'" ++ fieldName ++ ": -fprof*' profiling flags are typically not " ++ "appropriate for a distributed library package. These flags are " ++ "useful to profile this package, but when profiling other packages " ++ "that use this one these flags clutter the profile output with " @@ -1754,21 +1794,18 @@ ++ "False') and enable that flag during development." has_WerrorWall = has_Werror && ( has_Wall || has_W ) - has_Werror = "-Werror" `elem` ghc_options - has_Wall = "-Wall" `elem` ghc_options - has_W = "-W" `elem` ghc_options + has_Werror = "-Werror" `elem` ghcOptions + has_Wall = "-Wall" `elem` ghcOptions + has_W = "-W" `elem` ghcOptions has_J = any (\o -> case o of "-j" -> True ('-' : 'j' : d : _) -> isDigit d _ -> False ) - ghc_options - ghc_options = hcOptions GHC bi ++ hcProfOptions GHC bi - ++ hcSharedOptions GHC bi - + ghcOptions checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck - checkFlags flags = check (any (`elem` flags) ghc_options) + checkFlags flags = check (any (`elem` flags) ghcOptions) checkDevelopmentOnlyFlags :: GenericPackageDescription -> [PackageCheck] checkDevelopmentOnlyFlags pkg = diff --git a/cabal/Cabal/Distribution/PackageDescription/Configuration.hs b/cabal/Cabal/Distribution/PackageDescription/Configuration.hs --- a/cabal/Cabal/Distribution/PackageDescription/Configuration.hs +++ b/cabal/Cabal/Distribution/PackageDescription/Configuration.hs @@ -1,5 +1,6 @@ -- -fno-warn-deprecations for use of Map.foldWithKey {-# OPTIONS_GHC -fno-warn-deprecations #-} +{-# LANGUAGE NoMonoLocalBinds #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.PackageDescription.Configuration @@ -17,7 +18,6 @@ module Distribution.PackageDescription.Configuration ( finalizePD, - finalizePackageDescription, flattenPackageDescription, -- Utils @@ -48,11 +48,12 @@ import Distribution.Version import Distribution.Compiler import Distribution.System +import Distribution.Parsec +import Distribution.Pretty +import Distribution.Compat.CharParsing hiding (char) +import qualified Distribution.Compat.CharParsing as P import Distribution.Simple.Utils -import Distribution.Text import Distribution.Compat.Lens -import Distribution.Compat.ReadP as ReadP hiding ( char ) -import qualified Distribution.Compat.ReadP as ReadP ( char ) import Distribution.Types.ComponentRequestedSpec import Distribution.Types.ForeignLib import Distribution.Types.Component @@ -65,6 +66,8 @@ import qualified Data.Map.Strict as Map.Strict import qualified Data.Map.Lazy as Map +import Data.Set ( Set ) +import qualified Data.Set as Set import Data.Tree ( Tree(Node) ) ------------------------------------------------------------------------------ @@ -107,28 +110,29 @@ -- -- | Parse a configuration condition from a string. -parseCondition :: ReadP r (Condition ConfVar) +parseCondition :: CabalParsing m => m (Condition ConfVar) parseCondition = condOr where - condOr = sepBy1 condAnd (oper "||") >>= return . foldl1 COr - condAnd = sepBy1 cond (oper "&&")>>= return . foldl1 CAnd - cond = sp >> (boolLiteral +++ inparens condOr +++ notCond +++ osCond - +++ archCond +++ flagCond +++ implCond ) - inparens = between (ReadP.char '(' >> sp) (sp >> ReadP.char ')' >> sp) - notCond = ReadP.char '!' >> sp >> cond >>= return . CNot + condOr = sepByNonEmpty condAnd (oper "||") >>= return . foldl1 COr + condAnd = sepByNonEmpty cond (oper "&&")>>= return . foldl1 CAnd + -- TODO: try? + cond = sp >> (boolLiteral <|> inparens condOr <|> notCond <|> osCond + <|> archCond <|> flagCond <|> implCond ) + inparens = between (P.char '(' >> sp) (sp >> P.char ')' >> sp) + notCond = P.char '!' >> sp >> cond >>= return . CNot osCond = string "os" >> sp >> inparens osIdent >>= return . Var archCond = string "arch" >> sp >> inparens archIdent >>= return . Var flagCond = string "flag" >> sp >> inparens flagIdent >>= return . Var implCond = string "impl" >> sp >> inparens implIdent >>= return . Var - boolLiteral = fmap Lit parse - archIdent = fmap Arch parse - osIdent = fmap OS parse + boolLiteral = fmap Lit parsec + archIdent = fmap Arch parsec + osIdent = fmap OS parsec flagIdent = fmap (Flag . mkFlagName . lowercase) (munch1 isIdentChar) isIdentChar c = isAlphaNum c || c == '_' || c == '-' oper s = sp >> string s >> sp - sp = skipSpaces - implIdent = do i <- parse - vr <- sp >> option anyVersion parse + sp = spaces + implIdent = do i <- parsec + vr <- sp >> option anyVersion parsec return $ Impl i vr ------------------------------------------------------------------------------ @@ -229,7 +233,7 @@ mp (Left xs) (Left ys) = let union = Map.foldrWithKey (Map.Strict.insertWith combine) (unDepMapUnion xs) (unDepMapUnion ys) - combine x y = simplifyVersionRange $ unionVersionRanges x y + combine x y = (\(vr, cs) -> (simplifyVersionRange vr,cs)) $ unionVersionRanges' x y in union `seq` Left (DepMapUnion union) -- `mzero' @@ -307,14 +311,22 @@ -- | A map of dependencies that combines version ranges using 'unionVersionRanges'. -newtype DepMapUnion = DepMapUnion { unDepMapUnion :: Map PackageName VersionRange } +newtype DepMapUnion = DepMapUnion { unDepMapUnion :: Map PackageName (VersionRange, Set LibraryName) } +-- An union of versions should correspond to an intersection of the components. +-- The intersection may not be necessary. +unionVersionRanges' :: (VersionRange, Set LibraryName) + -> (VersionRange, Set LibraryName) + -> (VersionRange, Set LibraryName) +unionVersionRanges' (vra, csa) (vrb, csb) = + (unionVersionRanges vra vrb, Set.intersection csa csb) + toDepMapUnion :: [Dependency] -> DepMapUnion toDepMapUnion ds = - DepMapUnion $ Map.fromListWith unionVersionRanges [ (p,vr) | Dependency p vr <- ds ] + DepMapUnion $ Map.fromListWith unionVersionRanges' [ (p,(vr,cs)) | Dependency p vr cs <- ds ] fromDepMapUnion :: DepMapUnion -> [Dependency] -fromDepMapUnion m = [ Dependency p vr | (p,vr) <- Map.toList (unDepMapUnion m) ] +fromDepMapUnion m = [ Dependency p vr cs | (p,(vr,cs)) <- Map.toList (unDepMapUnion m) ] freeVars :: CondTree ConfVar c a -> [FlagName] freeVars t = [ f | Flag f <- freeVars' t ] @@ -344,12 +356,14 @@ -- UGH. The embedded componentName in the 'Component's here is -- BLANK. I don't know whose fault this is but I'll use the tag -- instead. -- ezyang - removeDisabledSections (Lib _) = componentNameRequested enabled CLibName + removeDisabledSections (Lib _) = componentNameRequested + enabled + (CLibName LMainLibName) removeDisabledSections (SubComp t c) -- Do NOT use componentName = componentNameRequested enabled $ case c of - CLib _ -> CSubLibName t + CLib _ -> CLibName (LSubLibName t) CFLib _ -> CFLibName t CExe _ -> CExeName t CTest _ -> CTestName t @@ -365,7 +379,7 @@ (Lib l, (Nothing, comps)) -> (Just $ redoBD l, comps) (SubComp n c, (mb_lib, comps)) | any ((== n) . fst) comps -> - userBug $ "There exist several components with the same name: '" ++ display n ++ "'" + userBug $ "There exist several components with the same name: '" ++ prettyShow n ++ "'" | otherwise -> (mb_lib, (n, redoBD c) : comps) (PDNull, x) -> x -- actually this should not happen, but let's be liberal where @@ -441,7 +455,7 @@ (mb_lib, comps) = flattenTaggedTargets targetSet mb_lib' = fmap libFillInDefaults mb_lib comps' = flip map comps $ \(n,c) -> foldComponent - (\l -> CLib (libFillInDefaults l) { libName = Just n + (\l -> CLib (libFillInDefaults l) { libName = LSubLibName n , libExposed = False }) (\l -> CFLib (flibFillInDefaults l) { foreignLibName = n }) (\e -> CExe (exeFillInDefaults e) { exeName = n }) @@ -478,20 +492,6 @@ then DepOk else MissingDeps missingDeps -{-# DEPRECATED finalizePackageDescription "This function now always assumes tests and benchmarks are disabled; use finalizePD with ComponentRequestedSpec to specify something more specific. This symbol will be removed in Cabal-3.0 (est. Mar 2019)." #-} -finalizePackageDescription :: - FlagAssignment -- ^ Explicitly specified flag assignments - -> (Dependency -> Bool) -- ^ Is a given dependency satisfiable from the set of - -- available packages? If this is unknown then use - -- True. - -> Platform -- ^ The 'Arch' and 'OS' - -> CompilerInfo -- ^ Compiler information - -> [Dependency] -- ^ Additional constraints - -> GenericPackageDescription - -> Either [Dependency] - (PackageDescription, FlagAssignment) -finalizePackageDescription flags = finalizePD flags defaultComponentRequestedSpec - {- let tst_p = (CondNode [1::Int] [Distribution.Package.Dependency "a" AnyVersion] []) let tst_p2 = (CondNode [1::Int] [Distribution.Package.Dependency "a" (EarlierVersion (Version [1,0] [])), Distribution.Package.Dependency "a" (LaterVersion (Version [2,0] []))] []) @@ -527,14 +527,14 @@ } where mlib = f <$> mlib0 - where f lib = (libFillInDefaults . fst . ignoreConditions $ lib) { libName = Nothing } + where f lib = (libFillInDefaults . fst . ignoreConditions $ lib) { libName = LMainLibName } sub_libs = flattenLib <$> sub_libs0 flibs = flattenFLib <$> flibs0 exes = flattenExe <$> exes0 tests = flattenTst <$> tests0 bms = flattenBm <$> bms0 flattenLib (n, t) = libFillInDefaults $ (fst $ ignoreConditions t) - { libName = Just n, libExposed = False } + { libName = LSubLibName n, libExposed = False } flattenFLib (n, t) = flibFillInDefaults $ (fst $ ignoreConditions t) { foreignLibName = n } flattenExe (n, t) = exeFillInDefaults $ (fst $ ignoreConditions t) diff --git a/cabal/Cabal/Distribution/PackageDescription/FieldGrammar.hs b/cabal/Cabal/Distribution/PackageDescription/FieldGrammar.hs --- a/cabal/Cabal/Distribution/PackageDescription/FieldGrammar.hs +++ b/cabal/Cabal/Distribution/PackageDescription/FieldGrammar.hs @@ -43,18 +43,20 @@ import Distribution.Compat.Prelude import Prelude () -import Distribution.Compiler (CompilerFlavor (..)) +import Distribution.CabalSpecVersion +import Distribution.Compiler (CompilerFlavor (..), PerCompilerFlavor (..)) import Distribution.FieldGrammar import Distribution.ModuleName (ModuleName) import Distribution.Package import Distribution.PackageDescription -import Distribution.Parsec.Common +import Distribution.Parsec import Distribution.Parsec.Newtypes -import Distribution.Parsec.ParseResult -import Distribution.Text (display) +import Distribution.Fields +import Distribution.Pretty (prettyShow) import Distribution.Types.ExecutableScope import Distribution.Types.ForeignLib import Distribution.Types.ForeignLibType +import Distribution.Types.LibraryVisibility import Distribution.Types.UnqualComponentName import Distribution.Version (anyVersion) @@ -74,18 +76,18 @@ <*> blurFieldGrammar L.package packageIdentifierGrammar <*> optionalFieldDefAla "license" SpecLicense L.licenseRaw (Left SPDX.NONE) <*> licenseFilesGrammar - <*> optionalFieldDefAla "copyright" FreeText L.copyright "" - <*> optionalFieldDefAla "maintainer" FreeText L.maintainer "" - <*> optionalFieldDefAla "author" FreeText L.author "" - <*> optionalFieldDefAla "stability" FreeText L.stability "" + <*> freeTextFieldDef "copyright" L.copyright + <*> freeTextFieldDef "maintainer" L.maintainer + <*> freeTextFieldDef "author" L.author + <*> freeTextFieldDef "stability" L.stability <*> monoidalFieldAla "tested-with" (alaList' FSep TestedWith) L.testedWith - <*> optionalFieldDefAla "homepage" FreeText L.homepage "" - <*> optionalFieldDefAla "package-url" FreeText L.pkgUrl "" - <*> optionalFieldDefAla "bug-reports" FreeText L.bugReports "" + <*> freeTextFieldDef "homepage" L.homepage + <*> freeTextFieldDef "package-url" L.pkgUrl + <*> freeTextFieldDef "bug-reports" L.bugReports <*> pure [] -- source-repos are stanza - <*> optionalFieldDefAla "synopsis" FreeText L.synopsis "" - <*> optionalFieldDefAla "description" FreeText L.description "" - <*> optionalFieldDefAla "category" FreeText L.category "" + <*> freeTextFieldDef "synopsis" L.synopsis + <*> freeTextFieldDef "description" L.description + <*> freeTextFieldDef "category" L.category <*> prefixedFields "x-" L.customFieldsPD <*> optionalField "build-type" L.buildTypeRaw <*> pure Nothing -- custom-setup @@ -121,17 +123,28 @@ libraryFieldGrammar :: (FieldGrammar g, Applicative (g Library), Applicative (g BuildInfo)) - => Maybe UnqualComponentName -> g Library Library + => LibraryName + -> g Library Library libraryFieldGrammar n = Library n <$> monoidalFieldAla "exposed-modules" (alaList' VCat MQuoted) L.exposedModules <*> monoidalFieldAla "reexported-modules" (alaList CommaVCat) L.reexportedModules <*> monoidalFieldAla "signatures" (alaList' VCat MQuoted) L.signatures - ^^^ availableSince [2,0] [] + ^^^ availableSince CabalSpecV2_0 [] <*> booleanFieldDef "exposed" L.libExposed True + <*> visibilityField <*> blurFieldGrammar L.libBuildInfo buildInfoFieldGrammar -{-# SPECIALIZE libraryFieldGrammar :: Maybe UnqualComponentName -> ParsecFieldGrammar' Library #-} -{-# SPECIALIZE libraryFieldGrammar :: Maybe UnqualComponentName -> PrettyFieldGrammar' Library #-} + where + visibilityField = case n of + -- nameless/"main" libraries are public + LMainLibName -> pure LibraryVisibilityPublic + -- named libraries have the field + LSubLibName _ -> + optionalFieldDef "visibility" L.libVisibility LibraryVisibilityPrivate + ^^^ availableSince CabalSpecV3_0 LibraryVisibilityPrivate +{-# SPECIALIZE libraryFieldGrammar :: LibraryName -> ParsecFieldGrammar' Library #-} +{-# SPECIALIZE libraryFieldGrammar :: LibraryName -> PrettyFieldGrammar' Library #-} + ------------------------------------------------------------------------------- -- Foreign library ------------------------------------------------------------------------------- @@ -160,7 +173,7 @@ -- main-is is optional as conditional blocks don't have it <$> optionalFieldDefAla "main-is" FilePathNT L.modulePath "" <*> optionalFieldDef "scope" L.exeScope ExecutablePublic - ^^^ availableSince [2,0] ExecutablePublic + ^^^ availableSince CabalSpecV2_0 ExecutablePublic <*> blurFieldGrammar L.buildInfo buildInfoFieldGrammar {-# SPECIALIZE executableFieldGrammar :: UnqualComponentName -> ParsecFieldGrammar' Executable #-} {-# SPECIALIZE executableFieldGrammar :: UnqualComponentName -> PrettyFieldGrammar' Executable #-} @@ -249,10 +262,10 @@ where missingField name tt = "The '" ++ name ++ "' field is required for the " - ++ display tt ++ " test suite type." + ++ prettyShow tt ++ " test suite type." extraField name tt = "The '" ++ name ++ "' field is not used for the '" - ++ display tt ++ "' test suite type." + ++ prettyShow tt ++ "' test suite type." unvalidateTestSuite :: TestSuite -> TestSuiteStanza unvalidateTestSuite t = TestSuiteStanza @@ -337,10 +350,10 @@ where missingField name tt = "The '" ++ name ++ "' field is required for the " - ++ display tt ++ " benchmark type." + ++ prettyShow tt ++ " benchmark type." extraField name tt = "The '" ++ name ++ "' field is not used for the '" - ++ display tt ++ "' benchmark type." + ++ prettyShow tt ++ "' benchmark type." unvalidateBenchmark :: Benchmark -> BenchmarkStanza unvalidateBenchmark b = BenchmarkStanza @@ -365,7 +378,10 @@ buildInfoFieldGrammar = BuildInfo <$> booleanFieldDef "buildable" L.buildable True <*> monoidalFieldAla "build-tools" (alaList CommaFSep) L.buildTools - ^^^ deprecatedSince [2,0] "Please use 'build-tool-depends' field" + ^^^ deprecatedSince CabalSpecV2_0 + "Please use 'build-tool-depends' field" + ^^^ removedIn CabalSpecV3_0 + "Please use 'build-tool-depends' field." <*> monoidalFieldAla "build-tool-depends" (alaList CommaFSep) L.buildToolDepends -- {- ^^^ availableSince [2,0] [] -} -- here, we explicitly want to recognise build-tool-depends for all Cabal files @@ -377,7 +393,7 @@ <*> monoidalFieldAla "cmm-options" (alaList' NoCommaFSep Token') L.cmmOptions <*> monoidalFieldAla "cc-options" (alaList' NoCommaFSep Token') L.ccOptions <*> monoidalFieldAla "cxx-options" (alaList' NoCommaFSep Token') L.cxxOptions - ^^^ availableSince [2,1] [] -- TODO change to 2,2 when version is bumped + ^^^ availableSince CabalSpecV2_2 [] <*> monoidalFieldAla "ld-options" (alaList' NoCommaFSep Token') L.ldOptions <*> monoidalFieldAla "pkgconfig-depends" (alaList CommaFSep) L.pkgconfigDepends <*> monoidalFieldAla "frameworks" (alaList' FSep Token) L.frameworks @@ -386,35 +402,42 @@ <*> monoidalFieldAla "cmm-sources" (alaList' VCat FilePathNT) L.cmmSources <*> monoidalFieldAla "c-sources" (alaList' VCat FilePathNT) L.cSources <*> monoidalFieldAla "cxx-sources" (alaList' VCat FilePathNT) L.cxxSources - ^^^ availableSince [2,1] [] -- TODO change to 2,2 when version is bumped + ^^^ availableSince CabalSpecV2_2 [] <*> monoidalFieldAla "js-sources" (alaList' VCat FilePathNT) L.jsSources <*> hsSourceDirsGrammar <*> monoidalFieldAla "other-modules" (alaList' VCat MQuoted) L.otherModules <*> monoidalFieldAla "virtual-modules" (alaList' VCat MQuoted) L.virtualModules - ^^^ availableSince [2,1] [] -- TODO change to 2,2 when version is bumped + ^^^ availableSince CabalSpecV2_2 [] <*> monoidalFieldAla "autogen-modules" (alaList' VCat MQuoted) L.autogenModules <*> optionalFieldAla "default-language" MQuoted L.defaultLanguage <*> monoidalFieldAla "other-languages" (alaList' FSep MQuoted) L.otherLanguages <*> monoidalFieldAla "default-extensions" (alaList' FSep MQuoted) L.defaultExtensions <*> monoidalFieldAla "other-extensions" (alaList' FSep MQuoted) L.otherExtensions <*> monoidalFieldAla "extensions" (alaList' FSep MQuoted) L.oldExtensions - ^^^ deprecatedSince [1,12] "Please use 'default-extensions' or 'other-extensions' fields." + ^^^ deprecatedSince CabalSpecV1_12 + "Please use 'default-extensions' or 'other-extensions' fields." + ^^^ removedIn CabalSpecV3_0 + "Please use 'default-extensions' or 'other-extensions' fields." <*> monoidalFieldAla "extra-libraries" (alaList' VCat Token) L.extraLibs <*> monoidalFieldAla "extra-ghci-libraries" (alaList' VCat Token) L.extraGHCiLibs <*> monoidalFieldAla "extra-bundled-libraries" (alaList' VCat Token) L.extraBundledLibs <*> monoidalFieldAla "extra-library-flavours" (alaList' VCat Token) L.extraLibFlavours + <*> monoidalFieldAla "extra-dynamic-library-flavours" (alaList' VCat Token) L.extraDynLibFlavours + ^^^ availableSince CabalSpecV3_0 [] <*> monoidalFieldAla "extra-lib-dirs" (alaList' FSep FilePathNT) L.extraLibDirs <*> monoidalFieldAla "include-dirs" (alaList' FSep FilePathNT) L.includeDirs <*> monoidalFieldAla "includes" (alaList' FSep FilePathNT) L.includes + <*> monoidalFieldAla "autogen-includes" (alaList' FSep FilePathNT) L.autogenIncludes + ^^^ availableSince CabalSpecV3_0 [] <*> monoidalFieldAla "install-includes" (alaList' FSep FilePathNT) L.installIncludes <*> optionsFieldGrammar <*> profOptionsFieldGrammar <*> sharedOptionsFieldGrammar - <*> pure [] -- static-options ??? + <*> pure mempty -- static-options ??? <*> prefixedFields "x-" L.customFieldsBI <*> monoidalFieldAla "build-depends" (alaList CommaVCat) L.targetBuildDepends <*> monoidalFieldAla "mixins" (alaList CommaVCat) L.mixins - ^^^ availableSince [2,0] [] + ^^^ availableSince CabalSpecV2_0 [] {-# SPECIALIZE buildInfoFieldGrammar :: ParsecFieldGrammar' BuildInfo #-} {-# SPECIALIZE buildInfoFieldGrammar :: PrettyFieldGrammar' BuildInfo #-} @@ -423,13 +446,19 @@ => g BuildInfo [FilePath] hsSourceDirsGrammar = (++) <$> monoidalFieldAla "hs-source-dirs" (alaList' FSep FilePathNT) L.hsSourceDirs - <*> monoidalFieldAla "hs-source-dir" (alaList' FSep FilePathNT) L.hsSourceDirs - ^^^ deprecatedField' "Please use 'hs-source-dirs'" + <*> monoidalFieldAla "hs-source-dir" (alaList' FSep FilePathNT) wrongLens + --- https://github.com/haskell/cabal/commit/49e3cdae3bdf21b017ccd42e66670ca402e22b44 + ^^^ deprecatedSince CabalSpecV1_2 "Please use 'hs-source-dirs'" + ^^^ removedIn CabalSpecV3_0 "Please use 'hs-source-dirs' field." + where + -- TODO: make pretty printer aware of CabalSpecVersion + wrongLens :: Functor f => LensLike' f BuildInfo [FilePath] + wrongLens f bi = (\fps -> set L.hsSourceDirs fps bi) <$> f [] optionsFieldGrammar :: (FieldGrammar g, Applicative (g BuildInfo)) - => g BuildInfo [(CompilerFlavor, [String])] -optionsFieldGrammar = combine + => g BuildInfo (PerCompilerFlavor [String]) +optionsFieldGrammar = PerCompilerFlavor <$> monoidalFieldAla "ghc-options" (alaList' NoCommaFSep Token') (extract GHC) <*> monoidalFieldAla "ghcjs-options" (alaList' NoCommaFSep Token') (extract GHCJS) -- NOTE: Hugs, NHC and JHC are not supported anymore, but these @@ -442,51 +471,31 @@ extract :: CompilerFlavor -> ALens' BuildInfo [String] extract flavor = L.options . lookupLens flavor - combine ghc ghcjs = - f GHC ghc ++ f GHCJS ghcjs - where - f _flavor [] = [] - f flavor opts = [(flavor, opts)] - profOptionsFieldGrammar :: (FieldGrammar g, Applicative (g BuildInfo)) - => g BuildInfo [(CompilerFlavor, [String])] -profOptionsFieldGrammar = combine + => g BuildInfo (PerCompilerFlavor [String]) +profOptionsFieldGrammar = PerCompilerFlavor <$> monoidalFieldAla "ghc-prof-options" (alaList' NoCommaFSep Token') (extract GHC) <*> monoidalFieldAla "ghcjs-prof-options" (alaList' NoCommaFSep Token') (extract GHCJS) where extract :: CompilerFlavor -> ALens' BuildInfo [String] extract flavor = L.profOptions . lookupLens flavor - combine ghc ghcjs = f GHC ghc ++ f GHCJS ghcjs - where - f _flavor [] = [] - f flavor opts = [(flavor, opts)] - sharedOptionsFieldGrammar :: (FieldGrammar g, Applicative (g BuildInfo)) - => g BuildInfo [(CompilerFlavor, [String])] -sharedOptionsFieldGrammar = combine + => g BuildInfo (PerCompilerFlavor [String]) +sharedOptionsFieldGrammar = PerCompilerFlavor <$> monoidalFieldAla "ghc-shared-options" (alaList' NoCommaFSep Token') (extract GHC) <*> monoidalFieldAla "ghcjs-shared-options" (alaList' NoCommaFSep Token') (extract GHCJS) where extract :: CompilerFlavor -> ALens' BuildInfo [String] extract flavor = L.sharedOptions . lookupLens flavor - combine ghc ghcjs = f GHC ghc ++ f GHCJS ghcjs - where - f _flavor [] = [] - f flavor opts = [(flavor, opts)] - -lookupLens :: (Functor f, Ord k) => k -> LensLike' f [(k, [v])] [v] -lookupLens k f kvs = str kvs <$> f (gtr kvs) - where - gtr = fromMaybe [] . lookup k - - str [] v = [(k, v)] - str (x@(k',_):xs) v - | k == k' = (k, v) : xs - | otherwise = x : str xs v +lookupLens :: (Functor f, Monoid v) => CompilerFlavor -> LensLike' f (PerCompilerFlavor v) v +lookupLens k f p@(PerCompilerFlavor ghc ghcjs) + | k == GHC = (\n -> PerCompilerFlavor n ghcjs) <$> f ghc + | k == GHCJS = (\n -> PerCompilerFlavor ghc n) <$> f ghcjs + | otherwise = p <$ f mempty ------------------------------------------------------------------------------- -- Flag @@ -496,7 +505,7 @@ :: (FieldGrammar g, Applicative (g Flag)) => FlagName -> g Flag Flag flagFieldGrammar name = MkFlag name - <$> optionalFieldDefAla "description" FreeText L.flagDescription "" + <$> freeTextFieldDef "description" L.flagDescription <*> booleanFieldDef "default" L.flagDefault True <*> booleanFieldDef "manual" L.flagManual False {-# SPECIALIZE flagFieldGrammar :: FlagName -> ParsecFieldGrammar' Flag #-} @@ -511,7 +520,7 @@ => RepoKind -> g SourceRepo SourceRepo sourceRepoFieldGrammar kind = SourceRepo kind <$> optionalField "type" L.repoType - <*> optionalFieldAla "location" FreeText L.repoLocation + <*> freeTextField "location" L.repoLocation <*> optionalFieldAla "module" Token L.repoModule <*> optionalFieldAla "branch" Token L.repoBranch <*> optionalFieldAla "tag" Token L.repoTag diff --git a/cabal/Cabal/Distribution/PackageDescription/Parsec.hs b/cabal/Cabal/Distribution/PackageDescription/Parsec.hs --- a/cabal/Cabal/Distribution/PackageDescription/Parsec.hs +++ b/cabal/Cabal/Distribution/PackageDescription/Parsec.hs @@ -35,38 +35,41 @@ import Distribution.Compat.Prelude import Prelude () -import Control.Monad (guard) -import Control.Monad.State.Strict (StateT, execStateT) -import Control.Monad.Trans.Class (lift) -import Data.List (partition) +import Control.Applicative (Const (..)) +import Control.Monad (guard) +import Control.Monad.State.Strict (StateT, execStateT) +import Control.Monad.Trans.Class (lift) +import Data.List (partition) import Distribution.CabalSpecVersion import Distribution.Compat.Lens import Distribution.FieldGrammar -import Distribution.FieldGrammar.Parsec (NamelessField (..)) +import Distribution.FieldGrammar.Parsec (NamelessField (..)) +import Distribution.Fields.ConfVar (parseConditionConfVar) +import Distribution.Fields.Field (FieldName, getName) +import Distribution.Fields.LexerMonad (LexWarning, toPWarnings) +import Distribution.Fields.Parser +import Distribution.Fields.ParseResult import Distribution.PackageDescription +import Distribution.PackageDescription.Configuration (freeVars) import Distribution.PackageDescription.FieldGrammar -import Distribution.PackageDescription.Quirks (patchQuirks) -import Distribution.Parsec.Class (parsec, simpleParsec) -import Distribution.Parsec.Common -import Distribution.Parsec.ConfVar (parseConditionConfVar) -import Distribution.Parsec.Field (FieldName, getName) -import Distribution.Parsec.FieldLineStream (fieldLineStreamFromBS) -import Distribution.Parsec.LexerMonad (LexWarning, toPWarnings) -import Distribution.Parsec.Newtypes (CommaFSep, List, SpecVersion (..), Token) -import Distribution.Parsec.Parser -import Distribution.Parsec.ParseResult -import Distribution.Pretty (prettyShow) -import Distribution.Simple.Utils (fromUTF8BS) -import Distribution.Text (display) +import Distribution.PackageDescription.Quirks (patchQuirks) +import Distribution.Parsec (parsec, simpleParsec) +import Distribution.Parsec.FieldLineStream (fieldLineStreamFromBS) +import Distribution.Parsec.Newtypes (CommaFSep, List, SpecVersion (..), Token) +import Distribution.Parsec.Position (Position (..), zeroPos) +import Distribution.Parsec.Warning (PWarnType (..)) +import Distribution.Pretty (prettyShow) +import Distribution.Simple.Utils (fromUTF8BS) import Distribution.Types.CondTree -import Distribution.Types.Dependency (Dependency) +import Distribution.Types.Dependency (Dependency) import Distribution.Types.ForeignLib -import Distribution.Types.ForeignLibType (knownForeignLibTypes) -import Distribution.Types.GenericPackageDescription (emptyGenericPackageDescription) -import Distribution.Types.PackageDescription (specVersion') -import Distribution.Types.UnqualComponentName (UnqualComponentName, mkUnqualComponentName) -import Distribution.Utils.Generic (breakMaybe, unfoldrM, validateUTF8) -import Distribution.Verbosity (Verbosity) +import Distribution.Types.ForeignLibType (knownForeignLibTypes) +import Distribution.Types.GenericPackageDescription (emptyGenericPackageDescription) +import Distribution.Types.LibraryVisibility (LibraryVisibility (..)) +import Distribution.Types.PackageDescription (specVersion') +import Distribution.Types.UnqualComponentName (UnqualComponentName, mkUnqualComponentName) +import Distribution.Utils.Generic (breakMaybe, unfoldrM, validateUTF8) +import Distribution.Verbosity (Verbosity) import Distribution.Version (LowerBound (..), Version, asVersionIntervals, mkVersion, orLaterVersion, version0, versionNumbers) @@ -74,8 +77,11 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS8 import qualified Data.Map.Strict as Map +import qualified Data.Set as Set import qualified Distribution.Compat.Newtype as Newtype import qualified Distribution.Types.BuildInfo.Lens as L +import qualified Distribution.Types.Executable.Lens as L +import qualified Distribution.Types.ForeignLib.Lens as L import qualified Distribution.Types.GenericPackageDescription.Lens as L import qualified Distribution.Types.PackageDescription.Lens as L import qualified Text.Parsec as P @@ -100,7 +106,7 @@ setCabalSpecVersion ver -- if we get too new version, fail right away case ver of - Just v | v > mkVersion [2,4] -> parseFailure zeroPos + Just v | v > mkVersion [3,0] -> parseFailure zeroPos "Unsupported cabal-version. See https://github.com/haskell/cabal/issues/4899." _ -> pure () @@ -174,13 +180,7 @@ return v - let specVer - | cabalVer >= mkVersion [2,3] = CabalSpecV2_4 - | cabalVer >= mkVersion [2,1] = CabalSpecV2_2 - | cabalVer >= mkVersion [1,25] = CabalSpecV2_0 - | cabalVer >= mkVersion [1,23] = CabalSpecV1_24 - | cabalVer >= mkVersion [1,21] = CabalSpecV1_22 - | otherwise = CabalSpecOld + let specVer = cabalSpecFromVersionDigits (versionNumbers cabalVer) -- reset cabal version setCabalSpecVersion (Just cabalVer) @@ -197,8 +197,10 @@ -- Sections let gpd = emptyGenericPackageDescription & L.packageDescription .~ pd + gpd1 <- view stateGpd <$> execStateT (goSections specVer sectionFields) (SectionS gpd Map.empty) - view stateGpd <$> execStateT (goSections specVer sectionFields) (SectionS gpd Map.empty) + checkForUndefinedFlags gpd1 + return gpd1 where safeLast :: [a] -> Maybe a safeLast = listToMaybe . reverse @@ -220,11 +222,11 @@ ++ displaySpecVersion (specVersionRaw pkg) ++ "' must use section syntax. See the Cabal user guide for details." where - displaySpecVersion (Left version) = display version + displaySpecVersion (Left version) = prettyShow version displaySpecVersion (Right versionRange) = case asVersionIntervals versionRange of - [] {- impossible -} -> display versionRange - ((LowerBound version _, _):_) -> display (orLaterVersion version) + [] {- impossible -} -> prettyShow versionRange + ((LowerBound version _, _):_) -> prettyShow (orLaterVersion version) maybeWarnCabalVersion _ _ = return () @@ -243,8 +245,9 @@ -- we need signature, because this is polymorphic, but not-closed parseCondTree' - :: FromBuildInfo a + :: L.HasBuildInfo a => ParsecFieldGrammar' a -- ^ grammar + -> (BuildInfo -> a) -> Map String CondTreeBuildInfo -- ^ common stanzas -> [Field Position] -> ParseResult (CondTree ConfVar [Dependency] a) @@ -258,7 +261,7 @@ | name == "common" = do commonStanzas <- use stateCommonStanzas name' <- lift $ parseCommonName pos args - biTree <- lift $ parseCondTree' buildInfoFieldGrammar commonStanzas fields + biTree <- lift $ parseCondTree' buildInfoFieldGrammar id commonStanzas fields case Map.lookup name' commonStanzas of Nothing -> stateCommonStanzas .= Map.insert name' biTree commonStanzas @@ -266,9 +269,15 @@ "Duplicate common stanza: " ++ name' | name == "library" && null args = do + prev <- use $ stateGpd . L.condLibrary + when (isJust prev) $ lift $ parseFailure pos $ + "Multiple main libraries; have you forgotten to specify a name for an internal library?" + commonStanzas <- use stateCommonStanzas - lib <- lift $ parseCondTree' (libraryFieldGrammar Nothing) commonStanzas fields - -- TODO: check that library is defined once + let name'' = LMainLibName + lib <- lift $ parseCondTree' (libraryFieldGrammar name'') (libraryFromBuildInfo name'') commonStanzas fields + -- + -- TODO check that not set stateGpd . L.condLibrary ?= lib -- Sublibraries @@ -276,7 +285,8 @@ | name == "library" = do commonStanzas <- use stateCommonStanzas name' <- parseUnqualComponentName pos args - lib <- lift $ parseCondTree' (libraryFieldGrammar $ Just name') commonStanzas fields + let name'' = LSubLibName name' + lib <- lift $ parseCondTree' (libraryFieldGrammar name'') (libraryFromBuildInfo name'') commonStanzas fields -- TODO check duplicate name here? stateGpd . L.condSubLibraries %= snoc (name', lib) @@ -284,15 +294,15 @@ | name == "foreign-library" = do commonStanzas <- use stateCommonStanzas name' <- parseUnqualComponentName pos args - flib <- lift $ parseCondTree' (foreignLibFieldGrammar name') commonStanzas fields + flib <- lift $ parseCondTree' (foreignLibFieldGrammar name') (fromBuildInfo' name') commonStanzas fields let hasType ts = foreignLibType ts /= foreignLibType mempty unless (onAllBranches hasType flib) $ lift $ parseFailure pos $ concat - [ "Foreign library " ++ show (display name') + [ "Foreign library " ++ show (prettyShow name') , " is missing required field \"type\" or the field " , "is not present in all conditional branches. The " , "available test types are: " - , intercalate ", " (map display knownForeignLibTypes) + , intercalate ", " (map prettyShow knownForeignLibTypes) ] -- TODO check duplicate name here? @@ -301,23 +311,23 @@ | name == "executable" = do commonStanzas <- use stateCommonStanzas name' <- parseUnqualComponentName pos args - exe <- lift $ parseCondTree' (executableFieldGrammar name') commonStanzas fields + exe <- lift $ parseCondTree' (executableFieldGrammar name') (fromBuildInfo' name') commonStanzas fields -- TODO check duplicate name here? stateGpd . L.condExecutables %= snoc (name', exe) | name == "test-suite" = do commonStanzas <- use stateCommonStanzas name' <- parseUnqualComponentName pos args - testStanza <- lift $ parseCondTree' testSuiteFieldGrammar commonStanzas fields + testStanza <- lift $ parseCondTree' testSuiteFieldGrammar (fromBuildInfo' name') commonStanzas fields testSuite <- lift $ traverse (validateTestSuite pos) testStanza let hasType ts = testInterface ts /= testInterface mempty unless (onAllBranches hasType testSuite) $ lift $ parseFailure pos $ concat - [ "Test suite " ++ show (display name') + [ "Test suite " ++ show (prettyShow name') , " is missing required field \"type\" or the field " , "is not present in all conditional branches. The " , "available test types are: " - , intercalate ", " (map display knownTestTypes) + , intercalate ", " (map prettyShow knownTestTypes) ] -- TODO check duplicate name here? @@ -326,16 +336,16 @@ | name == "benchmark" = do commonStanzas <- use stateCommonStanzas name' <- parseUnqualComponentName pos args - benchStanza <- lift $ parseCondTree' benchmarkFieldGrammar commonStanzas fields + benchStanza <- lift $ parseCondTree' benchmarkFieldGrammar (fromBuildInfo' name') commonStanzas fields bench <- lift $ traverse (validateBenchmark pos) benchStanza let hasType ts = benchmarkInterface ts /= benchmarkInterface mempty unless (onAllBranches hasType bench) $ lift $ parseFailure pos $ concat - [ "Benchmark " ++ show (display name') + [ "Benchmark " ++ show (prettyShow name') , " is missing required field \"type\" or the field " , "is not present in all conditional branches. The " , "available benchmark types are: " - , intercalate ", " (map display knownBenchmarkTypes) + , intercalate ", " (map prettyShow knownBenchmarkTypes) ] -- TODO check duplicate name here? @@ -343,7 +353,7 @@ | name == "flag" = do name' <- parseNameBS pos args - name'' <- lift $ runFieldParser' pos parsec specVer (fieldLineStreamFromBS name') `recoverWith` mkFlagName "" + name'' <- lift $ runFieldParser' [pos] parsec specVer (fieldLineStreamFromBS name') `recoverWith` mkFlagName "" flag <- lift $ parseFields specVer fields (flagFieldGrammar name'') -- Check default flag stateGpd . L.genPackageFlags %= snoc flag @@ -355,7 +365,7 @@ | name == "source-repository" = do kind <- lift $ case args of [SecArgName spos secName] -> - runFieldParser' spos parsec specVer (fieldLineStreamFromBS secName) `recoverWith` RepoHead + runFieldParser' [spos] parsec specVer (fieldLineStreamFromBS secName) `recoverWith` RepoHead [] -> do parseFailure pos "'source-repository' requires exactly one argument" pure RepoHead @@ -418,30 +428,36 @@ warnInvalidSubsection :: Section Position -> ParseResult () warnInvalidSubsection (MkSection (Name pos name) _ _) = - void (parseFailure pos $ "invalid subsection " ++ show name) + void $ parseFailure pos $ "invalid subsection " ++ show name parseCondTree - :: forall a c. - CabalSpecVersion - -> HasElif -- ^ accept @elif@ - -> ParsecFieldGrammar' a -- ^ grammar - -> (a -> c) -- ^ condition extractor + :: forall a. L.HasBuildInfo a + => CabalSpecVersion + -> HasElif -- ^ accept @elif@ + -> ParsecFieldGrammar' a -- ^ grammar + -> Map String CondTreeBuildInfo -- ^ common stanzas + -> (BuildInfo -> a) -- ^ constructor from buildInfo + -> (a -> [Dependency]) -- ^ condition extractor -> [Field Position] - -> ParseResult (CondTree ConfVar c a) -parseCondTree v hasElif grammar cond = go + -> ParseResult (CondTree ConfVar [Dependency] a) +parseCondTree v hasElif grammar commonStanzas fromBuildInfo cond = go where - go fields = do + go fields0 = do + (fields, endo) <- + if v >= CabalSpecV3_0 + then processImports v fromBuildInfo commonStanzas fields0 + else traverse (warnImport v) fields0 >>= \fields1 -> return (catMaybes fields1, id) + let (fs, ss) = partitionFields fields x <- parseFieldGrammar v fs grammar branches <- concat <$> traverse parseIfs ss - return (CondNode x (cond x) branches) -- TODO: branches + return $ endo $ CondNode x (cond x) branches - parseIfs :: [Section Position] -> ParseResult [CondBranch ConfVar c a] + parseIfs :: [Section Position] -> ParseResult [CondBranch ConfVar [Dependency] a] parseIfs [] = return [] parseIfs (MkSection (Name _ name) test fields : sections) | name == "if" = do test' <- parseConditionConfVar test fields' <- go fields - -- TODO: else (elseFields, sections') <- parseElseIfs sections return (CondBranch test' fields' elseFields : sections') parseIfs (MkSection (Name pos name) _ _ : sections) = do @@ -450,7 +466,7 @@ parseElseIfs :: [Section Position] - -> ParseResult (Maybe (CondTree ConfVar c a), [CondBranch ConfVar c a]) + -> ParseResult (Maybe (CondTree ConfVar [Dependency] a), [CondBranch ConfVar [Dependency] a]) parseElseIfs [] = return (Nothing, []) parseElseIfs (MkSection (Name pos name) args fields : sections) | name == "else" = do unless (null args) $ @@ -459,10 +475,7 @@ sections' <- parseIfs sections return (Just elseFields, sections') - - parseElseIfs (MkSection (Name _ name) test fields : sections) | hasElif == HasElif, name == "elif" = do - -- TODO: check cabal-version test' <- parseConditionConfVar test fields' <- go fields (elseFields, sections') <- parseElseIfs sections @@ -536,44 +549,67 @@ type CondTreeBuildInfo = CondTree ConfVar [Dependency] BuildInfo -- | Create @a@ from 'BuildInfo'. +-- This class is used to implement common stanza parsing. -- -- Law: @view buildInfo . fromBuildInfo = id@ +-- +-- This takes name, as 'FieldGrammar's take names too. class L.HasBuildInfo a => FromBuildInfo a where - fromBuildInfo :: BuildInfo -> a + fromBuildInfo' :: UnqualComponentName -> BuildInfo -> a -instance FromBuildInfo BuildInfo where fromBuildInfo = id -instance FromBuildInfo Library where fromBuildInfo bi = set L.buildInfo bi emptyLibrary -instance FromBuildInfo ForeignLib where fromBuildInfo bi = set L.buildInfo bi emptyForeignLib -instance FromBuildInfo Executable where fromBuildInfo bi = set L.buildInfo bi emptyExecutable +libraryFromBuildInfo :: LibraryName -> BuildInfo -> Library +libraryFromBuildInfo n bi = emptyLibrary + { libName = n + , libVisibility = case n of + LMainLibName -> LibraryVisibilityPublic + LSubLibName _ -> LibraryVisibilityPrivate + , libBuildInfo = bi + } +instance FromBuildInfo BuildInfo where fromBuildInfo' _ = id +instance FromBuildInfo ForeignLib where fromBuildInfo' n bi = set L.foreignLibName n $ set L.buildInfo bi emptyForeignLib +instance FromBuildInfo Executable where fromBuildInfo' n bi = set L.exeName n $ set L.buildInfo bi emptyExecutable + instance FromBuildInfo TestSuiteStanza where - fromBuildInfo = TestSuiteStanza Nothing Nothing Nothing + fromBuildInfo' _ bi = TestSuiteStanza Nothing Nothing Nothing bi instance FromBuildInfo BenchmarkStanza where - fromBuildInfo = BenchmarkStanza Nothing Nothing Nothing + fromBuildInfo' _ bi = BenchmarkStanza Nothing Nothing Nothing bi parseCondTreeWithCommonStanzas - :: forall a. FromBuildInfo a + :: forall a. L.HasBuildInfo a => CabalSpecVersion -> ParsecFieldGrammar' a -- ^ grammar + -> (BuildInfo -> a) -- ^ construct fromBuildInfo -> Map String CondTreeBuildInfo -- ^ common stanzas -> [Field Position] -> ParseResult (CondTree ConfVar [Dependency] a) -parseCondTreeWithCommonStanzas v grammar commonStanzas = goImports [] +parseCondTreeWithCommonStanzas v grammar fromBuildInfo commonStanzas fields = do + (fields', endo) <- processImports v fromBuildInfo commonStanzas fields + x <- parseCondTree v hasElif grammar commonStanzas fromBuildInfo (view L.targetBuildDepends) fields' + return (endo x) where hasElif = specHasElif v + +processImports + :: forall a. L.HasBuildInfo a + => CabalSpecVersion + -> (BuildInfo -> a) -- ^ construct fromBuildInfo + -> Map String CondTreeBuildInfo -- ^ common stanzas + -> [Field Position] + -> ParseResult ([Field Position], CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a) +processImports v fromBuildInfo commonStanzas = go [] + where hasCommonStanzas = specHasCommonStanzas v getList' :: List CommaFSep Token String -> [String] getList' = Newtype.unpack - -- parse leading imports - -- not supported: - goImports acc (Field (Name pos name) _ : fields) | name == "import", hasCommonStanzas == NoCommonStanzas = do + go acc (Field (Name pos name) _ : fields) | name == "import", hasCommonStanzas == NoCommonStanzas = do parseWarning pos PWTUnknownField "Unknown field: import. You should set cabal-version: 2.2 or larger to use common stanzas" - goImports acc fields + go acc fields -- supported: - goImports acc (Field (Name pos name) fls : fields) | name == "import" = do + go acc (Field (Name pos name) fls : fields) | name == "import" = do names <- getList' <$> runFieldParser pos parsec v fls names' <- for names $ \commonName -> case Map.lookup commonName commonStanzas of @@ -583,23 +619,29 @@ Just commonTree -> pure (Just commonTree) - goImports (acc ++ catMaybes names') fields - - -- Go to parsing condTree after first non-import 'Field'. - goImports acc fields = go acc fields + go (acc ++ catMaybes names') fields -- parse actual CondTree - go :: [CondTreeBuildInfo] -> [Field Position] -> ParseResult (CondTree ConfVar [Dependency] a) - go bis fields = do - x <- parseCondTree v hasElif grammar (view L.targetBuildDepends) fields - pure $ foldr mergeCommonStanza x bis + go acc fields = do + fields' <- catMaybes <$> traverse (warnImport v) fields + pure $ (fields', \x -> foldr (mergeCommonStanza fromBuildInfo) x acc) +-- | Warn on "import" fields, also map to Maybe, so errorneous fields can be filtered +warnImport :: CabalSpecVersion -> Field Position -> ParseResult (Maybe (Field Position)) +warnImport v (Field (Name pos name) _) | name == "import" = do + if specHasCommonStanzas v == NoCommonStanzas + then parseWarning pos PWTUnknownField "Unknown field: import. You should set cabal-version: 2.2 or larger to use common stanzas" + else parseWarning pos PWTUnknownField "Unknown field: import. Common stanza imports should be at the top of the enclosing section" + return Nothing +warnImport _ f = pure (Just f) + mergeCommonStanza - :: forall a. FromBuildInfo a - => CondTree ConfVar [Dependency] BuildInfo + :: L.HasBuildInfo a + => (BuildInfo -> a) + -> CondTree ConfVar [Dependency] BuildInfo -> CondTree ConfVar [Dependency] a -> CondTree ConfVar [Dependency] a -mergeCommonStanza (CondNode bi _ bis) (CondNode x _ cs) = +mergeCommonStanza fromBuildInfo (CondNode bi _ bis) (CondNode x _ cs) = CondNode x' (x' ^. L.targetBuildDepends) cs' where -- new value is old value with buildInfo field _prepended_. @@ -631,6 +673,24 @@ goBranch acc (CondBranch _ t (Just e)) = go acc t && go acc e ------------------------------------------------------------------------------- +-- Flag check +------------------------------------------------------------------------------- + +checkForUndefinedFlags :: GenericPackageDescription -> ParseResult () +checkForUndefinedFlags gpd = do + let definedFlags, usedFlags :: Set.Set FlagName + definedFlags = toSetOf (L.genPackageFlags . traverse . getting flagName) gpd + usedFlags = getConst $ L.allCondTrees f gpd + + -- Note: we can check for defined, but unused flags here too. + unless (usedFlags `Set.isSubsetOf` definedFlags) $ parseFailure zeroPos $ + "These flags are used without having been defined: " ++ + intercalate ", " [ unFlagName fn | fn <- Set.toList $ usedFlags `Set.difference` definedFlags ] + where + f :: CondTree ConfVar c a -> Const (Set.Set FlagName) (CondTree ConfVar c a) + f ct = Const (Set.fromList (freeVars ct)) + +------------------------------------------------------------------------------- -- Old syntax ------------------------------------------------------------------------------- @@ -698,7 +758,7 @@ -- TODO: libFieldNames :: [FieldName] -libFieldNames = fieldGrammarKnownFieldList (libraryFieldGrammar Nothing) +libFieldNames = fieldGrammarKnownFieldList (libraryFieldGrammar LMainLibName) ------------------------------------------------------------------------------- -- Suplementary build information diff --git a/cabal/Cabal/Distribution/PackageDescription/PrettyPrint.hs b/cabal/Cabal/Distribution/PackageDescription/PrettyPrint.hs --- a/cabal/Cabal/Distribution/PackageDescription/PrettyPrint.hs +++ b/cabal/Cabal/Distribution/PackageDescription/PrettyPrint.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.PackageDescription.PrettyPrint @@ -16,6 +17,7 @@ -- * Generic package descriptions writeGenericPackageDescription, showGenericPackageDescription, + ppGenericPackageDescription, -- * Package descriptions writePackageDescription, @@ -26,31 +28,31 @@ showHookedBuildInfo, ) where -import Prelude () import Distribution.Compat.Prelude +import Prelude () +import Distribution.Types.CondTree import Distribution.Types.Dependency -import Distribution.Types.ForeignLib (ForeignLib (foreignLibName)) +import Distribution.Types.ForeignLib (ForeignLib (foreignLibName)) +import Distribution.Types.LibraryName import Distribution.Types.UnqualComponentName -import Distribution.Types.CondTree +import Distribution.CabalSpecVersion +import Distribution.Fields.Pretty import Distribution.PackageDescription +import Distribution.Pretty import Distribution.Simple.Utils -import Distribution.ParseUtils -import Distribution.Text +import Distribution.Types.Version (versionNumbers) -import Distribution.FieldGrammar (PrettyFieldGrammar', prettyFieldGrammar) +import Distribution.FieldGrammar (PrettyFieldGrammar', prettyFieldGrammar) import Distribution.PackageDescription.FieldGrammar - (packageDescriptionFieldGrammar, buildInfoFieldGrammar, - flagFieldGrammar, foreignLibFieldGrammar, libraryFieldGrammar, - benchmarkFieldGrammar, testSuiteFieldGrammar, - setupBInfoFieldGrammar, sourceRepoFieldGrammar, executableFieldGrammar) + (benchmarkFieldGrammar, buildInfoFieldGrammar, executableFieldGrammar, flagFieldGrammar, + foreignLibFieldGrammar, libraryFieldGrammar, packageDescriptionFieldGrammar, + setupBInfoFieldGrammar, sourceRepoFieldGrammar, testSuiteFieldGrammar) import qualified Distribution.PackageDescription.FieldGrammar as FG -import Text.PrettyPrint - (hsep, space, parens, char, nest, ($$), (<+>), - text, vcat, ($+$), Doc, render) +import Text.PrettyPrint (Doc, char, hsep, parens, text, (<+>)) import qualified Data.ByteString.Lazy.Char8 as BS.Char8 @@ -60,63 +62,66 @@ -- | Writes a generic package description to a string showGenericPackageDescription :: GenericPackageDescription -> String -showGenericPackageDescription = render . ($+$ text "") . ppGenericPackageDescription +showGenericPackageDescription gpd = showFields (const []) $ ppGenericPackageDescription v gpd + where + v = cabalSpecFromVersionDigits + $ versionNumbers + $ specVersion + $ packageDescription gpd -ppGenericPackageDescription :: GenericPackageDescription -> Doc -ppGenericPackageDescription gpd = - ppPackageDescription (packageDescription gpd) - $+$ ppSetupBInfo (setupBuildInfo (packageDescription gpd)) - $+$ ppGenPackageFlags (genPackageFlags gpd) - $+$ ppCondLibrary (condLibrary gpd) - $+$ ppCondSubLibraries (condSubLibraries gpd) - $+$ ppCondForeignLibs (condForeignLibs gpd) - $+$ ppCondExecutables (condExecutables gpd) - $+$ ppCondTestSuites (condTestSuites gpd) - $+$ ppCondBenchmarks (condBenchmarks gpd) +-- | Convert a generic package description to 'PrettyField's. +ppGenericPackageDescription :: CabalSpecVersion -> GenericPackageDescription -> [PrettyField ()] +ppGenericPackageDescription v gpd = concat + [ ppPackageDescription v (packageDescription gpd) + , ppSetupBInfo v (setupBuildInfo (packageDescription gpd)) + , ppGenPackageFlags v (genPackageFlags gpd) + , ppCondLibrary v (condLibrary gpd) + , ppCondSubLibraries v (condSubLibraries gpd) + , ppCondForeignLibs v (condForeignLibs gpd) + , ppCondExecutables v (condExecutables gpd) + , ppCondTestSuites v (condTestSuites gpd) + , ppCondBenchmarks v (condBenchmarks gpd) + ] -ppPackageDescription :: PackageDescription -> Doc -ppPackageDescription pd = - prettyFieldGrammar packageDescriptionFieldGrammar pd - $+$ ppSourceRepos (sourceRepos pd) +ppPackageDescription :: CabalSpecVersion -> PackageDescription -> [PrettyField ()] +ppPackageDescription v pd = + prettyFieldGrammar v packageDescriptionFieldGrammar pd + ++ ppSourceRepos v (sourceRepos pd) -ppSourceRepos :: [SourceRepo] -> Doc -ppSourceRepos [] = mempty -ppSourceRepos (hd:tl) = ppSourceRepo hd $+$ ppSourceRepos tl +ppSourceRepos :: CabalSpecVersion -> [SourceRepo] -> [PrettyField ()] +ppSourceRepos = map . ppSourceRepo -ppSourceRepo :: SourceRepo -> Doc -ppSourceRepo repo = - emptyLine $ text "source-repository" <+> disp kind $+$ - nest indentWith (prettyFieldGrammar (sourceRepoFieldGrammar kind) repo) +ppSourceRepo :: CabalSpecVersion -> SourceRepo -> PrettyField () +ppSourceRepo v repo = PrettySection () "source-repository" [pretty kind] $ + prettyFieldGrammar v (sourceRepoFieldGrammar kind) repo where kind = repoKind repo -ppSetupBInfo :: Maybe SetupBuildInfo -> Doc -ppSetupBInfo Nothing = mempty -ppSetupBInfo (Just sbi) +ppSetupBInfo :: CabalSpecVersion -> Maybe SetupBuildInfo -> [PrettyField ()] +ppSetupBInfo _ Nothing = mempty +ppSetupBInfo v (Just sbi) | defaultSetupDepends sbi = mempty - | otherwise = - emptyLine $ text "custom-setup" $+$ - nest indentWith (prettyFieldGrammar (setupBInfoFieldGrammar False) sbi) + | otherwise = pure $ PrettySection () "custom-setup" [] $ + prettyFieldGrammar v (setupBInfoFieldGrammar False) sbi -ppGenPackageFlags :: [Flag] -> Doc -ppGenPackageFlags flds = vcat [ppFlag f | f <- flds] +ppGenPackageFlags :: CabalSpecVersion -> [Flag] -> [PrettyField ()] +ppGenPackageFlags = map . ppFlag -ppFlag :: Flag -> Doc -ppFlag flag@(MkFlag name _ _ _) = - emptyLine $ text "flag" <+> ppFlagName name $+$ - nest indentWith (prettyFieldGrammar (flagFieldGrammar name) flag) +ppFlag :: CabalSpecVersion -> Flag -> PrettyField () +ppFlag v flag@(MkFlag name _ _ _) = PrettySection () "flag" [ppFlagName name] $ + prettyFieldGrammar v (flagFieldGrammar name) flag -ppCondTree2 :: PrettyFieldGrammar' s -> CondTree ConfVar [Dependency] s -> Doc -ppCondTree2 grammar = go +ppCondTree2 :: CabalSpecVersion -> PrettyFieldGrammar' s -> CondTree ConfVar [Dependency] s -> [PrettyField ()] +ppCondTree2 v grammar = go where -- TODO: recognise elif opportunities go (CondNode it _ ifs) = - prettyFieldGrammar grammar it - $+$ vcat (map ppIf ifs) + prettyFieldGrammar v grammar it ++ + concatMap ppIf ifs ppIf (CondBranch c thenTree Nothing) -- | isEmpty thenDoc = mempty - | otherwise = ppIfCondition c $$ nest indentWith thenDoc + | otherwise = [ppIfCondition c thenDoc] where thenDoc = go thenTree @@ -124,52 +129,52 @@ case (False, False) of -- case (isEmpty thenDoc, isEmpty elseDoc) of (True, True) -> mempty - (False, True) -> ppIfCondition c $$ nest indentWith thenDoc - (True, False) -> ppIfCondition (cNot c) $$ nest indentWith elseDoc - (False, False) -> (ppIfCondition c $$ nest indentWith thenDoc) - $+$ (text "else" $$ nest indentWith elseDoc) + (False, True) -> [ ppIfCondition c thenDoc ] + (True, False) -> [ ppIfCondition (cNot c) elseDoc ] + (False, False) -> [ ppIfCondition c thenDoc + , PrettySection () "else" [] elseDoc + ] where thenDoc = go thenTree elseDoc = go elseTree -ppCondLibrary :: Maybe (CondTree ConfVar [Dependency] Library) -> Doc -ppCondLibrary Nothing = mempty -ppCondLibrary (Just condTree) = - emptyLine $ text "library" $+$ - nest indentWith (ppCondTree2 (libraryFieldGrammar Nothing) condTree) +ppCondLibrary :: CabalSpecVersion -> Maybe (CondTree ConfVar [Dependency] Library) -> [PrettyField ()] +ppCondLibrary _ Nothing = mempty +ppCondLibrary v (Just condTree) = pure $ PrettySection () "library" [] $ + ppCondTree2 v (libraryFieldGrammar LMainLibName) condTree -ppCondSubLibraries :: [(UnqualComponentName, CondTree ConfVar [Dependency] Library)] -> Doc -ppCondSubLibraries libs = vcat - [ emptyLine $ (text "library" <+> disp n) $+$ - nest indentWith (ppCondTree2 (libraryFieldGrammar $ Just n) condTree) +ppCondSubLibraries :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)] -> [PrettyField ()] +ppCondSubLibraries v libs = + [ PrettySection () "library" [pretty n] + $ ppCondTree2 v (libraryFieldGrammar $ LSubLibName n) condTree | (n, condTree) <- libs ] -ppCondForeignLibs :: [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)] -> Doc -ppCondForeignLibs flibs = vcat - [ emptyLine $ (text "foreign-library" <+> disp n) $+$ - nest indentWith (ppCondTree2 (foreignLibFieldGrammar n) condTree) +ppCondForeignLibs :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)] -> [PrettyField ()] +ppCondForeignLibs v flibs = + [ PrettySection () "foreign-library" [pretty n] + $ ppCondTree2 v (foreignLibFieldGrammar n) condTree | (n, condTree) <- flibs ] -ppCondExecutables :: [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)] -> Doc -ppCondExecutables exes = vcat - [ emptyLine $ (text "executable" <+> disp n) $+$ - nest indentWith (ppCondTree2 (executableFieldGrammar n) condTree) +ppCondExecutables :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)] -> [PrettyField ()] +ppCondExecutables v exes = + [ PrettySection () "executable" [pretty n] + $ ppCondTree2 v (executableFieldGrammar n) condTree | (n, condTree) <- exes ] -ppCondTestSuites :: [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)] -> Doc -ppCondTestSuites suites = vcat - [ emptyLine $ (text "test-suite" <+> disp n) $+$ - nest indentWith (ppCondTree2 testSuiteFieldGrammar (fmap FG.unvalidateTestSuite condTree)) +ppCondTestSuites :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)] -> [PrettyField ()] +ppCondTestSuites v suites = + [ PrettySection () "test-suite" [pretty n] + $ ppCondTree2 v testSuiteFieldGrammar (fmap FG.unvalidateTestSuite condTree) | (n, condTree) <- suites ] -ppCondBenchmarks :: [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)] -> Doc -ppCondBenchmarks suites = vcat - [ emptyLine $ (text "benchmark" <+> disp n) $+$ - nest indentWith (ppCondTree2 benchmarkFieldGrammar (fmap FG.unvalidateBenchmark condTree)) +ppCondBenchmarks :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)] -> [PrettyField ()] +ppCondBenchmarks v suites = + [ PrettySection () "benchmark" [pretty n] + $ ppCondTree2 v benchmarkFieldGrammar (fmap FG.unvalidateBenchmark condTree) | (n, condTree) <- suites ] @@ -182,19 +187,16 @@ ppCondition (CAnd c1 c2) = parens (hsep [ppCondition c1, text "&&" <+> ppCondition c2]) ppConfVar :: ConfVar -> Doc -ppConfVar (OS os) = text "os" <<>> parens (disp os) -ppConfVar (Arch arch) = text "arch" <<>> parens (disp arch) +ppConfVar (OS os) = text "os" <<>> parens (pretty os) +ppConfVar (Arch arch) = text "arch" <<>> parens (pretty arch) ppConfVar (Flag name) = text "flag" <<>> parens (ppFlagName name) -ppConfVar (Impl c v) = text "impl" <<>> parens (disp c <+> disp v) +ppConfVar (Impl c v) = text "impl" <<>> parens (pretty c <+> pretty v) ppFlagName :: FlagName -> Doc ppFlagName = text . unFlagName -ppIfCondition :: (Condition ConfVar) -> Doc -ppIfCondition c = (emptyLine $ text "if" <+> ppCondition c) - -emptyLine :: Doc -> Doc -emptyLine d = text "" $+$ d +ppIfCondition :: Condition ConfVar -> [PrettyField ()] -> PrettyField () +ppIfCondition c = PrettySection () "if" [ppCondition c] -- | @since 2.0.0.2 writePackageDescription :: FilePath -> PackageDescription -> NoCallStackIO () @@ -222,7 +224,7 @@ -- We set CondTree's [Dependency] to an empty list, as it -- is not pretty printed anyway. mkCondTree x = CondNode x [] [] - mkCondTreeL l = (fromMaybe (mkUnqualComponentName "") (libName l), CondNode l [] []) + mkCondTreeL l = (fromMaybe (mkUnqualComponentName "") (libraryNameString (libName l)), CondNode l [] []) mkCondTree' :: (a -> UnqualComponentName) @@ -236,12 +238,9 @@ -- | @since 2.0.0.2 showHookedBuildInfo :: HookedBuildInfo -> String -showHookedBuildInfo (mb_lib_bi, ex_bis) = render $ - maybe mempty (prettyFieldGrammar buildInfoFieldGrammar) mb_lib_bi - $$ vcat - [ space - $$ (text "executable:" <+> disp name) - $$ prettyFieldGrammar buildInfoFieldGrammar bi - | (name, bi) <- ex_bis - ] - $+$ text "" +showHookedBuildInfo (mb_lib_bi, ex_bis) = showFields (const []) $ + maybe mempty (prettyFieldGrammar cabalSpecLatest buildInfoFieldGrammar) mb_lib_bi ++ + [ PrettySection () "executable:" [pretty name] + $ prettyFieldGrammar cabalSpecLatest buildInfoFieldGrammar bi + | (name, bi) <- ex_bis + ] diff --git a/cabal/Cabal/Distribution/PackageDescription/Quirks.hs b/cabal/Cabal/Distribution/PackageDescription/Quirks.hs --- a/cabal/Cabal/Distribution/PackageDescription/Quirks.hs +++ b/cabal/Cabal/Distribution/PackageDescription/Quirks.hs @@ -152,6 +152,95 @@ (Fingerprint 13690322768477779172 19704059263540994) (Fingerprint 11189374824645442376 8363528115442591078) (bsReplace "&&!" "&& !") + -- flag used, but not defined + , mk "name: brainheck\nversion: 0.1.0.2\nsynopsis: Brainh*ck interpreter in haskell\ndescription: Brainh*ck interpreter written in haskell and taking advantage of many prominent libraries\nhomepage: https://gi" + (Fingerprint 6910727116443152200 15401634478524888973) + (Fingerprint 16551412117098094368 16260377389127603629) + (bsReplace "flag(llvm-fast)" "False") + , mk "name: brainheck\r\nversion: 0.1.0.2\r\nx-revision: 1\r\nsynopsis: Brainh*ck interpreter in haskell\r\ndescription: Brainh*ck interpreter written in haskell and taking advantage of many prominent libraries\r\nhomepage: " + (Fingerprint 14320987921316832277 10031098243571536929) + (Fingerprint 7959395602414037224 13279941216182213050) + (bsReplace "flag(llvm-fast)" "False") + , mk "name: brainheck\r\nversion: 0.1.0.2\r\nx-revision: 2\r\nsynopsis: Brainh*ck interpreter in haskell\r\ndescription: Brainh*ck interpreter written in haskell and taking advantage of many prominent libraries\r\nhomepage: " + (Fingerprint 3809078390223299128 10796026010775813741) + (Fingerprint 1127231189459220796 12088367524333209349) + (bsReplace "flag(llvm-fast)" "False") + , mk "name: brainheck\r\nversion: 0.1.0.2\r\nx-revision: 3\r\nsynopsis: Brainh*ck interpreter in haskell\r\ndescription: Brainh*ck interpreter written in haskell and taking advantage of many prominent libraries\r\nhomepage: " + (Fingerprint 13860013038089410950 12479824176801390651) + (Fingerprint 4687484721703340391 8013395164515771785) + (bsReplace "flag(llvm-fast)" "False") + , mk "name: wordchoice\nversion: 0.1.0.1\nsynopsis: Get word counts and distributions\ndescription: A command line tool to compute the word distribution from various types of document, converting to text with pandoc.\nho" + (Fingerprint 16215911397419608203 15594928482155652475) + (Fingerprint 15120681510314491047 2666192399775157359) + (bsReplace "flag(llvm-fast)" "False") + , mk "name: wordchoice\r\nversion: 0.1.0.1\r\nx-revision: 1\r\nsynopsis: Get word counts and distributions\r\ndescription: A command line tool to compute the word distribution from various types of document, converting to te" + (Fingerprint 16593139224723441188 4052919014346212001) + (Fingerprint 3577381082410411593 11481899387780544641) + (bsReplace "flag(llvm-fast)" "False") + , mk "name: wordchoice\nversion: 0.1.0.2\nsynopsis: Get word counts and distributions\ndescription: A command line tool to compute the word distribution from various types of document, converting to text with pandoc.\nho" + (Fingerprint 9321301260802539374 1316392715016096607) + (Fingerprint 3784628652257760949 12662640594755291035) + (bsReplace "flag(llvm-fast)" "False") + , mk "name: wordchoice\r\nversion: 0.1.0.2\r\nx-revision: 1\r\nsynopsis: Get word counts and distributions\r\ndescription: A command line tool to compute the word distribution from various types of document, converting to te" + (Fingerprint 2546901804824433337 2059732715322561176) + (Fingerprint 8082068680348326500 615008613291421947) + (bsReplace "flag(llvm-fast)" "False") + , mk "name: wordchoice\nversion: 0.1.0.3\nsynopsis: Get word counts and distributions\ndescription: A command line tool to compute the word distribution from various types of document, converting to text with pandoc.\nho" + (Fingerprint 2282380737467965407 12457554753171662424) + (Fingerprint 17324757216926991616 17172911843227482125) + (bsReplace "flag(llvm-fast)" "False") + , mk "name: wordchoice\r\nversion: 0.1.0.3\r\nx-revision: 1\r\nsynopsis: Get word counts and distributions\r\ndescription: A command line tool to compute the word distribution from various types of document, converting to te" + (Fingerprint 12907988890480595481 11078473638628359710) + (Fingerprint 13246185333368731848 4663060731847518614) + (bsReplace "flag(llvm-fast)" "False") + , mk "name: hw-prim-bits\nversion: 0.1.0.0\nsynopsis: Primitive support for bit manipulation\ndescription: Please see README.md\nhomepage: https://github.com/githubuser/hw-prim-bits#readme\nlicense: " + (Fingerprint 12386777729082870356 17414156731912743711) + (Fingerprint 3452290353395041602 14102887112483033720) + (bsReplace "flag(sse42)" "False") + , mk "name: hw-prim-bits\nversion: 0.1.0.1\nsynopsis: Primitive support for bit manipulation\ndescription: Please see README.md\nhomepage: https://github.com/githubuser/hw-prim-bits#readme\nlicen" + (Fingerprint 6870520675313101180 14553457351296240636) + (Fingerprint 12481021059537696455 14711088786769892762) + (bsReplace "flag(sse42)" "False") + -- leading zeros in version digits + -- https://github.com/haskell-infra/hackage-trustees/issues/128 + -- https://github.com/haskell/cabal/issues/5092 + -- https://github.com/haskell/cabal/issues/5138 + , mk "name: Sit\nversion: 0.2017.02.26\nbuild-type: Simple\ncabal-version: >= 1.8\nlicense: OtherLicense\nlicense-file: LICENSE\nauthor: Anonymous\nmaintainer: Anonymous\nhomepage: NONE\ncategory: Dependent" + (Fingerprint 8458530898096910998 3228538743646501413) + (Fingerprint 14470502514907936793 17514354054641875371) + (bsReplace "0.2017.02.26" "0.2017.2.26") + , mk "name: Sit\nversion: 0.2017.05.01\nbuild-type: Simple\ncabal-version: >= 1.8\nlicense: OtherLicense\nlicense-file: LICENSE\nauthor: Andreas Abel \nmaintainer: Andreas Abel \n" + (Fingerprint 1450130849535097473 11742099607098860444) + (Fingerprint 16679762943850814021 4253724355613883542) + (bsReplace "0.2017.05.01" "0.2017.5.1") + , mk "name: Sit\nversion: 0.2017.05.02\nbuild-type: Simple\ncabal-version: >= 1.8\nlicense: OtherLicense\nlicense-file: LICENSE\nauthor: Andreas Abel \nmaintainer: Andreas Abel \n" + (Fingerprint 297248532398492441 17322625167861324800) + (Fingerprint 634812045126693280 1755581866539318862) + (bsReplace "0.2017.05.02" "0.2017.5.2") + , mk "name: Sit\nversion: 0.2017.5.02\nx-revision: 1\n-- x-revision:1 see https://github.com/haskell-infra/hackage-trustees/issues/128\nbuild-type: Simple\ncabal-version: >= 1.8\nlicense: OtherLicense\nlicense-file: LICENSE\nauthor: " + (Fingerprint 3697869560530373941 3942982281026987312) + (Fingerprint 14344526114710295386 16386400353475114712) + (bsReplace "0.2017.5.02" "0.2017.5.2") + , mk "name: MiniAgda\nversion: 0.2017.02.18\nbuild-type: Simple\ncabal-version: >= 1.22\nlicense: OtherLicense\nlicense-file: LICENSE\nauthor: Andreas Abel and Karl Mehltretter\nmaintainer: Andreas Abel ) - ) -import Data.Tree as Tree (Tree(..), flatten) -import qualified Data.Map as Map -import System.FilePath (normalise) - --- ----------------------------------------------------------------------------- - -type LineNo = Int - -data PError = AmbiguousParse String LineNo - | NoParse String LineNo - | TabsError LineNo - | FromString String (Maybe LineNo) - deriving (Eq, Show) - -data PWarning = PWarning String - | UTFWarning LineNo String - deriving (Eq, Show) - -showPWarning :: FilePath -> PWarning -> String -showPWarning fpath (PWarning msg) = - normalise fpath ++ ": " ++ msg -showPWarning fpath (UTFWarning line fname) = - normalise fpath ++ ":" ++ show line - ++ ": Invalid UTF-8 text in the '" ++ fname ++ "' field." - -data ParseResult a = ParseFailed PError | ParseOk [PWarning] a - deriving Show - -instance Functor ParseResult where - fmap _ (ParseFailed err) = ParseFailed err - fmap f (ParseOk ws x) = ParseOk ws $ f x - -instance Applicative ParseResult where - pure = ParseOk [] - (<*>) = ap - - -instance Monad ParseResult where - return = pure - ParseFailed err >>= _ = ParseFailed err - ParseOk ws x >>= f = case f x of - ParseFailed err -> ParseFailed err - ParseOk ws' x' -> ParseOk (ws'++ws) x' - fail = Fail.fail - -instance Fail.MonadFail ParseResult where - fail s = ParseFailed (FromString s Nothing) - -catchParseError :: ParseResult a -> (PError -> ParseResult a) - -> ParseResult a -p@(ParseOk _ _) `catchParseError` _ = p -ParseFailed e `catchParseError` k = k e - -parseFail :: PError -> ParseResult a -parseFail = ParseFailed - -runP :: LineNo -> String -> ReadP a a -> String -> ParseResult a -runP line fieldname p s = - case [ x | (x,"") <- results ] of - [a] -> ParseOk (utf8Warnings line fieldname s) a - --TODO: what is this double parse thing all about? - -- Can't we just do the all isSpace test the first time? - [] -> case [ x | (x,ys) <- results, all isSpace ys ] of - [a] -> ParseOk (utf8Warnings line fieldname s) a - [] -> ParseFailed (NoParse fieldname line) - _ -> ParseFailed (AmbiguousParse fieldname line) - _ -> ParseFailed (AmbiguousParse fieldname line) - where results = readP_to_S p s - -runE :: LineNo -> String -> ReadE a -> String -> ParseResult a -runE line fieldname p s = - case runReadE p s of - Right a -> ParseOk (utf8Warnings line fieldname s) a - Left e -> syntaxError line $ - "Parse of field '" ++ fieldname ++ "' failed (" ++ e ++ "): " ++ s - -utf8Warnings :: LineNo -> String -> String -> [PWarning] -utf8Warnings line fieldname s = - take 1 [ UTFWarning n fieldname - | (n,l) <- zip [line..] (lines s) - , '\xfffd' `elem` l ] - -locatedErrorMsg :: PError -> (Maybe LineNo, String) -locatedErrorMsg (AmbiguousParse f n) = (Just n, - "Ambiguous parse in field '"++f++"'.") -locatedErrorMsg (NoParse f n) = (Just n, - "Parse of field '"++f++"' failed.") -locatedErrorMsg (TabsError n) = (Just n, "Tab used as indentation.") -locatedErrorMsg (FromString s n) = (n, s) - -syntaxError :: LineNo -> String -> ParseResult a -syntaxError n s = ParseFailed $ FromString s (Just n) - -tabsError :: LineNo -> ParseResult a -tabsError ln = ParseFailed $ TabsError ln - -warning :: String -> ParseResult () -warning s = ParseOk [PWarning s] () - --- | Field descriptor. The parameter @a@ parameterizes over where the field's --- value is stored in. -data FieldDescr a - = FieldDescr - { fieldName :: String - , fieldGet :: a -> Doc - , fieldSet :: LineNo -> String -> a -> ParseResult a - -- ^ @fieldSet n str x@ Parses the field value from the given input - -- string @str@ and stores the result in @x@ if the parse was - -- successful. Otherwise, reports an error on line number @n@. - } - -field :: String -> (a -> Doc) -> ReadP a a -> FieldDescr a -field name showF readF = - FieldDescr name showF (\line val _st -> runP line name readF val) - --- Lift a field descriptor storing into an 'a' to a field descriptor storing --- into a 'b'. -liftField :: (b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b -liftField get set (FieldDescr name showF parseF) - = FieldDescr name (showF . get) - (\line str b -> do - a <- parseF line str (get b) - return (set a b)) - --- Parser combinator for simple fields. Takes a field name, a pretty printer, --- a parser function, an accessor, and a setter, returns a FieldDescr over the --- compoid structure. -simpleField :: String -> (a -> Doc) -> ReadP a a - -> (b -> a) -> (a -> b -> b) -> FieldDescr b -simpleField name showF readF get set - = liftField get set $ field name showF readF - -commaListFieldWithSep :: Separator -> String -> (a -> Doc) -> ReadP [a] a - -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b -commaListFieldWithSep separator name showF readF get set = - liftField get set' $ - field name showF' (parseCommaList readF) - where - set' xs b = set (get b ++ xs) b - showF' = separator . punctuate comma . map showF - -commaListField :: String -> (a -> Doc) -> ReadP [a] a - -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b -commaListField = commaListFieldWithSep fsep - -commaNewLineListField :: String -> (a -> Doc) -> ReadP [a] a - -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b -commaNewLineListField = commaListFieldWithSep sep - -spaceListField :: String -> (a -> Doc) -> ReadP [a] a - -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b -spaceListField name showF readF get set = - liftField get set' $ - field name showF' (parseSpaceList readF) - where - set' xs b = set (get b ++ xs) b - showF' = fsep . map showF - -listFieldWithSep :: Separator -> String -> (a -> Doc) -> ReadP [a] a - -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b -listFieldWithSep separator name showF readF get set = - liftField get set' $ - field name showF' (parseOptCommaList readF) - where - set' xs b = set (get b ++ xs) b - showF' = separator . map showF - -listField :: String -> (a -> Doc) -> ReadP [a] a - -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b -listField = listFieldWithSep fsep - -optsField :: String -> CompilerFlavor -> (b -> [(CompilerFlavor,[String])]) - -> ([(CompilerFlavor,[String])] -> b -> b) -> FieldDescr b -optsField name flavor get set = - liftField (fromMaybe [] . lookup flavor . get) - (\opts b -> set (reorder (update flavor opts (get b))) b) $ - field name showF (sepBy parseTokenQ' (munch1 isSpace)) - where - update _ opts l | all null opts = l --empty opts as if no opts - update f opts [] = [(f,opts)] - update f opts ((f',opts'):rest) - | f == f' = (f, opts' ++ opts) : rest - | otherwise = (f',opts') : update f opts rest - reorder = sortBy (comparing fst) - showF = hsep . map text - --- TODO: this is a bit smelly hack. It's because we want to parse bool fields --- liberally but not accept new parses. We cannot do that with ReadP --- because it does not support warnings. We need a new parser framework! -boolField :: String -> (b -> Bool) -> (Bool -> b -> b) -> FieldDescr b -boolField name get set = liftField get set (FieldDescr name showF readF) - where - showF = text . show - readF line str _ - | str == "True" = ParseOk [] True - | str == "False" = ParseOk [] False - | lstr == "true" = ParseOk [caseWarning] True - | lstr == "false" = ParseOk [caseWarning] False - | otherwise = ParseFailed (NoParse name line) - where - lstr = lowercase str - caseWarning = PWarning $ - "The '" ++ name ++ "' field is case sensitive, use 'True' or 'False'." - -ppFields :: [FieldDescr a] -> a -> Doc -ppFields fields x = - vcat [ ppField name (getter x) | FieldDescr name getter _ <- fields ] - -ppField :: String -> Doc -> Doc -ppField name fielddoc - | isEmpty fielddoc = mempty - | name `elem` nestedFields = text name <<>> colon $+$ nest indentWith fielddoc - | otherwise = text name <<>> colon <+> fielddoc - where - nestedFields = - [ "description" - , "build-depends" - , "data-files" - , "extra-source-files" - , "extra-tmp-files" - , "exposed-modules" - , "asm-sources" - , "cmm-sources" - , "c-sources" - , "js-sources" - , "extra-libraries" - , "includes" - , "install-includes" - , "other-modules" - , "autogen-modules" - , "depends" - ] - -showFields :: [FieldDescr a] -> a -> String -showFields fields = render . ($+$ text "") . ppFields fields - -showSingleNamedField :: [FieldDescr a] -> String -> Maybe (a -> String) -showSingleNamedField fields f = - case [ get | (FieldDescr f' get _) <- fields, f' == f ] of - [] -> Nothing - (get:_) -> Just (render . ppField f . get) - -showSimpleSingleNamedField :: [FieldDescr a] -> String -> Maybe (a -> String) -showSimpleSingleNamedField fields f = - case [ get | (FieldDescr f' get _) <- fields, f' == f ] of - [] -> Nothing - (get:_) -> Just (renderStyle myStyle . get) - where myStyle = style { mode = LeftMode } - -parseFields :: [FieldDescr a] -> a -> String -> ParseResult a -parseFields fields initial str = - readFields str >>= accumFields fields initial - -parseFieldsFlat :: [FieldDescr a] -> a -> String -> ParseResult a -parseFieldsFlat fields initial str = - readFieldsFlat str >>= accumFields fields initial - -accumFields :: [FieldDescr a] -> a -> [Field] -> ParseResult a -accumFields fields = foldM setField - 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 - --- | The type of a function which, given a name-value pair of an --- unrecognized field, and the current structure being built, --- decides whether to incorporate the unrecognized field --- (by returning Just x, where x is a possibly modified version --- of the structure being built), or not (by returning Nothing). -type UnrecFieldParser a = (String,String) -> a -> Maybe a - --- | A default unrecognized field parser which simply returns Nothing, --- i.e. ignores all unrecognized fields, so warnings will be generated. -warnUnrec :: UnrecFieldParser a -warnUnrec _ _ = Nothing - --- | A default unrecognized field parser which silently (i.e. no --- warnings will be generated) ignores unrecognized fields, by --- returning the structure being built unmodified. -ignoreUnrec :: UnrecFieldParser a -ignoreUnrec _ = Just - ------------------------------------------------------------------------------- - --- The data type for our three syntactic categories -data Field - = F LineNo String String - -- ^ A regular @: @ field - | Section LineNo String String [Field] - -- ^ A section with a name and possible parameter. The syntactic - -- structure is: - -- - -- @ - -- { - -- * - -- } - -- @ - | IfBlock LineNo String [Field] [Field] - -- ^ A conditional block with an optional else branch: - -- - -- @ - -- if { - -- * - -- } else { - -- * - -- } - -- @ - deriving (Show - ,Eq) -- for testing - -lineNo :: Field -> LineNo -lineNo (F n _ _) = n -lineNo (Section n _ _ _) = n -lineNo (IfBlock n _ _ _) = n - -fName :: Field -> String -fName (F _ n _) = n -fName (Section _ n _ _) = n -fName _ = error "fname: not a field or section" - -readFields :: String -> ParseResult [Field] -readFields input = ifelse - =<< traverse (mkField 0) - =<< mkTree tokens - - where ls = (lines . normaliseLineEndings) input - tokens = (concatMap tokeniseLine . trimLines) ls - -readFieldsFlat :: String -> ParseResult [Field] -readFieldsFlat input = traverse (mkField 0) - =<< mkTree tokens - where ls = (lines . normaliseLineEndings) input - tokens = (concatMap tokeniseLineFlat . trimLines) ls - --- attach line number and determine indentation -trimLines :: [String] -> [(LineNo, Indent, HasTabs, String)] -trimLines ls = [ (lineno, indent, hastabs, trimTrailing l') - | (lineno, l) <- zip [1..] ls - , let (sps, l') = span isSpace l - indent = length sps - hastabs = '\t' `elem` sps - , validLine l' ] - where validLine ('-':'-':_) = False -- Comment - validLine [] = False -- blank line - validLine _ = True - --- | We parse generically based on indent level and braces '{' '}'. To do that --- we split into lines and then '{' '}' tokens and other spans within a line. -data Token = - -- | The 'Line' token is for bits that /start/ a line, eg: - -- - -- > "\n blah blah { blah" - -- - -- tokenises to: - -- - -- > [Line n 2 False "blah blah", OpenBracket, Span n "blah"] - -- - -- so lines are the only ones that can have nested layout, since they - -- have a known indentation level. - -- - -- eg: we can't have this: - -- - -- > if ... { - -- > } else - -- > other - -- - -- because other cannot nest under else, since else doesn't start a line - -- so cannot have nested layout. It'd have to be: - -- - -- > if ... { - -- > } - -- > else - -- > other - -- - -- but that's not so common, people would normally use layout or - -- brackets not both in a single @if else@ construct. - -- - -- > if ... { foo : bar } - -- > else - -- > other - -- - -- this is OK - Line LineNo Indent HasTabs String - | Span LineNo String -- ^ span in a line, following brackets - | OpenBracket LineNo | CloseBracket LineNo - -type Indent = Int -type HasTabs = Bool - --- | Tokenise a single line, splitting on '{' '}' and the spans in between. --- Also trims leading & trailing space on those spans within the line. -tokeniseLine :: (LineNo, Indent, HasTabs, String) -> [Token] -tokeniseLine (n0, i, t, l) = case split n0 l of - (Span _ l':ss) -> Line n0 i t l' :ss - cs -> cs - where split _ "" = [] - split n s = case span (\c -> c /='}' && c /= '{') s of - ("", '{' : s') -> OpenBracket n : split n s' - (w , '{' : s') -> mkspan n w (OpenBracket n : split n s') - ("", '}' : s') -> CloseBracket n : split n s' - (w , '}' : s') -> mkspan n w (CloseBracket n : split n s') - (w , _) -> mkspan n w [] - - mkspan n s ss | null s' = ss - | otherwise = Span n s' : ss - where s' = trimTrailing (trimLeading s) - -tokeniseLineFlat :: (LineNo, Indent, HasTabs, String) -> [Token] -tokeniseLineFlat (n0, i, t, l) - | null l' = [] - | otherwise = [Line n0 i t l'] - where - l' = trimTrailing (trimLeading l) - -trimLeading, trimTrailing :: String -> String -trimLeading = dropWhile isSpace -trimTrailing = dropWhileEndLE isSpace - - -type SyntaxTree = Tree (LineNo, HasTabs, String) - --- | Parse the stream of tokens into a tree of them, based on indent \/ layout -mkTree :: [Token] -> ParseResult [SyntaxTree] -mkTree toks = - layout 0 [] toks >>= \(trees, trailing) -> case trailing of - [] -> return trees - OpenBracket n:_ -> syntaxError n "mismatched brackets, unexpected {" - CloseBracket n:_ -> syntaxError n "mismatched brackets, unexpected }" - -- the following two should never happen: - Span n l :_ -> syntaxError n $ "unexpected span: " ++ show l - Line n _ _ l :_ -> syntaxError n $ "unexpected line: " ++ show l - - --- | Parse the stream of tokens into a tree of them, based on indent --- This parse state expect to be in a layout context, though possibly --- nested within a braces context so we may still encounter closing braces. -layout :: Indent -- ^ indent level of the parent\/previous line - -> [SyntaxTree] -- ^ accumulating param, trees in this level - -> [Token] -- ^ remaining tokens - -> ParseResult ([SyntaxTree], [Token]) - -- ^ collected trees on this level and trailing tokens -layout _ a [] = return (reverse a, []) -layout i a (s@(Line _ i' _ _):ss) | i' < i = return (reverse a, s:ss) -layout i a (Line n _ t l:OpenBracket n':ss) = do - (sub, ss') <- braces n' [] ss - layout i (Node (n,t,l) sub:a) ss' - -layout i a (Span n l:OpenBracket n':ss) = do - (sub, ss') <- braces n' [] ss - layout i (Node (n,False,l) sub:a) ss' - --- look ahead to see if following lines are more indented, giving a sub-tree -layout i a (Line n i' t l:ss) = do - lookahead <- layout (i'+1) [] ss - case lookahead of - ([], _) -> layout i (Node (n,t,l) [] :a) ss - (ts, ss') -> layout i (Node (n,t,l) ts :a) ss' - -layout _ _ ( OpenBracket n :_) = syntaxError n "unexpected '{'" -layout _ a (s@(CloseBracket _):ss) = return (reverse a, s:ss) -layout _ _ ( Span n l : _) = syntaxError n $ "unexpected span: " - ++ show l - --- | Parse the stream of tokens into a tree of them, based on explicit braces --- This parse state expects to find a closing bracket. -braces :: LineNo -- ^ line of the '{', used for error messages - -> [SyntaxTree] -- ^ accumulating param, trees in this level - -> [Token] -- ^ remaining tokens - -> ParseResult ([SyntaxTree],[Token]) - -- ^ collected trees on this level and trailing tokens -braces m a (Line n _ t l:OpenBracket n':ss) = do - (sub, ss') <- braces n' [] ss - braces m (Node (n,t,l) sub:a) ss' - -braces m a (Span n l:OpenBracket n':ss) = do - (sub, ss') <- braces n' [] ss - braces m (Node (n,False,l) sub:a) ss' - -braces m a (Line n i t l:ss) = do - lookahead <- layout (i+1) [] ss - case lookahead of - ([], _) -> braces m (Node (n,t,l) [] :a) ss - (ts, ss') -> braces m (Node (n,t,l) ts :a) ss' - -braces m a (Span n l:ss) = braces m (Node (n,False,l) []:a) ss -braces _ a (CloseBracket _:ss) = return (reverse a, ss) -braces n _ [] = syntaxError n $ "opening brace '{'" - ++ "has no matching closing brace '}'" -braces _ _ (OpenBracket n:_) = syntaxError n "unexpected '{'" - --- | Convert the parse tree into the Field AST --- Also check for dodgy uses of tabs in indentation. -mkField :: Int -> SyntaxTree -> ParseResult Field -mkField d (Node (n,t,_) _) | d >= 1 && t = tabsError n -mkField d (Node (n,_,l) ts) = case span (\c -> isAlphaNum c || c == '-') l of - ([], _) -> syntaxError n $ "unrecognised field or section: " ++ show l - (name, rest) -> case trimLeading rest of - (':':rest') -> do let followingLines = concatMap Tree.flatten ts - tabs = not (null [()| (_,True,_) <- followingLines ]) - if tabs && d >= 1 - then tabsError n - else return $ F n (map toLower name) - (fieldValue rest' followingLines) - rest' -> do ts' <- traverse (mkField (d+1)) ts - return (Section n (map toLower name) rest' ts') - where fieldValue firstLine followingLines = - let firstLine' = trimLeading firstLine - followingLines' = map (\(_,_,s) -> stripDot s) followingLines - allLines | null firstLine' = followingLines' - | otherwise = firstLine' : followingLines' - in intercalate "\n" allLines - stripDot "." = "" - stripDot s = s - --- | Convert if/then/else 'Section's to 'IfBlock's -ifelse :: [Field] -> ParseResult [Field] -ifelse [] = return [] -ifelse (Section n "if" cond thenpart - :Section _ "else" as elsepart:fs) - | null cond = syntaxError n "'if' with missing condition" - | null thenpart = syntaxError n "'then' branch of 'if' is empty" - | not (null as) = syntaxError n "'else' takes no arguments" - | null elsepart = syntaxError n "'else' branch of 'if' is empty" - | otherwise = do tp <- ifelse thenpart - ep <- ifelse elsepart - fs' <- ifelse fs - return (IfBlock n cond tp ep:fs') -ifelse (Section n "if" cond thenpart:fs) - | null cond = syntaxError n "'if' with missing condition" - | null thenpart = syntaxError n "'then' branch of 'if' is empty" - | otherwise = do tp <- ifelse thenpart - fs' <- ifelse fs - return (IfBlock n cond tp []:fs') -ifelse (Section n "else" _ _:_) = syntaxError n - "stray 'else' with no preceding 'if'" -ifelse (Section n s a fs':fs) = do fs'' <- ifelse fs' - fs''' <- ifelse fs - return (Section n s a fs'' : fs''') -ifelse (f:fs) = do fs' <- ifelse fs - return (f : fs') - ------------------------------------------------------------------------------- - --- |parse a module name -parseModuleNameQ :: ReadP r ModuleName -parseModuleNameQ = parseMaybeQuoted parse - -parseFilePathQ :: ReadP r FilePath -parseFilePathQ = parseTokenQ - -- removed until normalise is no longer broken, was: - -- liftM normalise parseTokenQ - -betweenSpaces :: ReadP r a -> ReadP r a -betweenSpaces act = do skipSpaces - res <- act - skipSpaces - return res - -parsePackageName :: ReadP r String -parsePackageName = do - ns <- sepBy1 component (char '-') - return $ intercalate "-" ns - where - component = do - cs <- munch1 isAlphaNum - if all isDigit cs then pfail else return cs - -- each component must contain an alphabetic character, to avoid - -- ambiguity in identifiers like foo-1 (the 1 is the version number). - -parseOptVersion :: ReadP r Version -parseOptVersion = parseMaybeQuoted ver - where ver :: ReadP r Version - ver = parse <++ return nullVersion - -parseTestedWithQ :: ReadP r (CompilerFlavor,VersionRange) -parseTestedWithQ = parseMaybeQuoted tw - where - tw :: ReadP r (CompilerFlavor,VersionRange) - tw = do compiler <- parseCompilerFlavorCompat - version <- betweenSpaces $ parse <++ return anyVersion - return (compiler,version) - -parseLicenseQ :: ReadP r License -parseLicenseQ = parseMaybeQuoted parse - --- urgh, we can't define optQuotes :: ReadP r a -> ReadP r a --- because the "compat" version of ReadP isn't quite powerful enough. In --- particular, the type of <++ is ReadP r r -> ReadP r a -> ReadP r a --- Hence the trick above to make 'lic' polymorphic. - -parseLanguageQ :: ReadP r Language -parseLanguageQ = parseMaybeQuoted parse - -parseExtensionQ :: ReadP r Extension -parseExtensionQ = parseMaybeQuoted parse - -parseHaskellString :: ReadP r String -parseHaskellString = readS_to_P reads - -parseTokenQ :: ReadP r String -parseTokenQ = parseHaskellString <++ munch1 (\x -> not (isSpace x) && x /= ',') - -parseTokenQ' :: ReadP r String -parseTokenQ' = parseHaskellString <++ munch1 (not . isSpace) - -parseSepList :: ReadP r b - -> ReadP r a -- ^The parser for the stuff between commas - -> ReadP r [a] -parseSepList sepr p = sepBy p separator - where separator = betweenSpaces sepr - -parseSpaceList :: ReadP r a -- ^The parser for the stuff between commas - -> ReadP r [a] -parseSpaceList p = sepBy p skipSpaces - -parseCommaList :: ReadP r a -- ^The parser for the stuff between commas - -> ReadP r [a] -parseCommaList = parseSepList (ReadP.char ',') - -parseOptCommaList :: ReadP r a -- ^The parser for the stuff between commas - -> ReadP r [a] -parseOptCommaList = parseSepList (optional (ReadP.char ',')) - -parseQuoted :: ReadP r a -> ReadP r a -parseQuoted = between (ReadP.char '"') (ReadP.char '"') - -parseMaybeQuoted :: (forall r. ReadP r a) -> ReadP r' a -parseMaybeQuoted p = parseQuoted p <++ p - -parseFreeText :: ReadP.ReadP s String -parseFreeText = ReadP.munch (const True) - -readPToMaybe :: ReadP a a -> String -> Maybe a -readPToMaybe p str = listToMaybe [ r | (r,s) <- readP_to_S p str - , all isSpace s ] - -------------------------------------------------------------------------------- --- Internal -------------------------------------------------------------------------------- - -showTestedWith :: (CompilerFlavor, VersionRange) -> Doc -showTestedWith = pretty . pack' TestedWith diff --git a/cabal/Cabal/Distribution/Parsec.hs b/cabal/Cabal/Distribution/Parsec.hs new file mode 100644 --- /dev/null +++ b/cabal/Cabal/Distribution/Parsec.hs @@ -0,0 +1,411 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Distribution.Parsec ( + Parsec(..), + ParsecParser (..), + runParsecParser, + runParsecParser', + simpleParsec, + lexemeParsec, + eitherParsec, + explicitEitherParsec, + -- * CabalParsing and and diagnostics + CabalParsing (..), + -- ** Warnings + PWarnType (..), + PWarning (..), + showPWarning, + -- ** Errors + PError (..), + showPError, + -- * Position + Position (..), + incPos, + retPos, + showPos, + zeroPos, + -- * Utilities + parsecToken, + parsecToken', + parsecFilePath, + parsecQuoted, + parsecMaybeQuoted, + parsecCommaList, + parsecLeadingCommaList, + parsecOptCommaList, + parsecLeadingOptCommaList, + parsecStandard, + parsecUnqualComponentName, + ) where + +import Data.Char (digitToInt, intToDigit) +import Data.Functor.Identity (Identity (..)) +import Data.List (transpose) +import Distribution.CabalSpecVersion +import Distribution.Compat.Prelude +import Distribution.Parsec.Error (PError (..), showPError) +import Distribution.Parsec.FieldLineStream (FieldLineStream, fieldLineStreamFromString) +import Distribution.Parsec.Position (Position (..), incPos, retPos, showPos, zeroPos) +import Distribution.Parsec.Warning (PWarnType (..), PWarning (..), showPWarning) +import Numeric (showIntAtBase) +import Prelude () + +import qualified Distribution.Compat.CharParsing as P +import qualified Distribution.Compat.MonadFail as Fail +import qualified Text.Parsec as Parsec + +------------------------------------------------------------------------------- +-- Class +------------------------------------------------------------------------------- + +-- | Class for parsing with @parsec@. Mainly used for @.cabal@ file fields. +-- +-- For parsing @.cabal@ like file structure, see "Distribution.Fields". +-- +class Parsec a where + parsec :: CabalParsing m => m a + +-- | Parsing class which +-- +-- * can report Cabal parser warnings. +-- +-- * knows @cabal-version@ we work with +-- +class (P.CharParsing m, MonadPlus m, Fail.MonadFail m) => CabalParsing m where + parsecWarning :: PWarnType -> String -> m () + + parsecHaskellString :: m String + parsecHaskellString = stringLiteral + + askCabalSpecVersion :: m CabalSpecVersion + +-- | 'parsec' /could/ consume trailing spaces, this function /will/ consume. +lexemeParsec :: (CabalParsing m, Parsec a) => m a +lexemeParsec = parsec <* P.spaces + +newtype ParsecParser a = PP { unPP + :: CabalSpecVersion -> Parsec.Parsec FieldLineStream [PWarning] a + } + +liftParsec :: Parsec.Parsec FieldLineStream [PWarning] a -> ParsecParser a +liftParsec p = PP $ \_ -> p + +instance Functor ParsecParser where + fmap f p = PP $ \v -> fmap f (unPP p v) + {-# INLINE fmap #-} + + x <$ p = PP $ \v -> x <$ unPP p v + {-# INLINE (<$) #-} + +instance Applicative ParsecParser where + pure = liftParsec . pure + {-# INLINE pure #-} + + f <*> x = PP $ \v -> unPP f v <*> unPP x v + {-# INLINE (<*>) #-} + f *> x = PP $ \v -> unPP f v *> unPP x v + {-# INLINE (*>) #-} + f <* x = PP $ \v -> unPP f v <* unPP x v + {-# INLINE (<*) #-} + +instance Alternative ParsecParser where + empty = liftParsec empty + + a <|> b = PP $ \v -> unPP a v <|> unPP b v + {-# INLINE (<|>) #-} + + many p = PP $ \v -> many (unPP p v) + {-# INLINE many #-} + + some p = PP $ \v -> some (unPP p v) + {-# INLINE some #-} + +instance Monad ParsecParser where + return = pure + + m >>= k = PP $ \v -> unPP m v >>= \x -> unPP (k x) v + {-# INLINE (>>=) #-} + (>>) = (*>) + {-# INLINE (>>) #-} + +#if !(MIN_VERSION_base(4,13,0)) + fail = Fail.fail +#endif + +instance MonadPlus ParsecParser where + mzero = empty + mplus = (<|>) + +instance Fail.MonadFail ParsecParser where + fail = P.unexpected + +instance P.Parsing ParsecParser where + try p = PP $ \v -> P.try (unPP p v) + p d = PP $ \v -> unPP p v P. d + skipMany p = PP $ \v -> P.skipMany (unPP p v) + skipSome p = PP $ \v -> P.skipSome (unPP p v) + unexpected = liftParsec . P.unexpected + eof = liftParsec P.eof + notFollowedBy p = PP $ \v -> P.notFollowedBy (unPP p v) + +instance P.CharParsing ParsecParser where + satisfy = liftParsec . P.satisfy + char = liftParsec . P.char + notChar = liftParsec . P.notChar + anyChar = liftParsec P.anyChar + string = liftParsec . P.string + +instance CabalParsing ParsecParser where + parsecWarning t w = liftParsec $ do + spos <- Parsec.getPosition + Parsec.modifyState + (PWarning t (Position (Parsec.sourceLine spos) (Parsec.sourceColumn spos)) w :) + askCabalSpecVersion = PP pure + +-- | Parse a 'String' with 'lexemeParsec'. +simpleParsec :: Parsec a => String -> Maybe a +simpleParsec + = either (const Nothing) Just + . runParsecParser lexemeParsec "" + . fieldLineStreamFromString + +-- | Parse a 'String' with 'lexemeParsec'. +eitherParsec :: Parsec a => String -> Either String a +eitherParsec = explicitEitherParsec parsec + +-- | Parse a 'String' with given 'ParsecParser'. Trailing whitespace is accepted. +explicitEitherParsec :: ParsecParser a -> String -> Either String a +explicitEitherParsec parser + = either (Left . show) Right + . runParsecParser (parser <* P.spaces) "" + . fieldLineStreamFromString + +-- | Run 'ParsecParser' with 'cabalSpecLatest'. +runParsecParser :: ParsecParser a -> FilePath -> FieldLineStream -> Either Parsec.ParseError a +runParsecParser = runParsecParser' cabalSpecLatest + +-- | Like 'runParsecParser' but lets specify 'CabalSpecVersion' used. +-- +-- @since 3.0.0.0 +-- +runParsecParser' :: CabalSpecVersion -> ParsecParser a -> FilePath -> FieldLineStream -> Either Parsec.ParseError a +runParsecParser' v p n = Parsec.runParser (unPP p v <* P.eof) [] n + +instance Parsec a => Parsec (Identity a) where + parsec = Identity <$> parsec + +instance Parsec Bool where + parsec = P.munch1 isAlpha >>= postprocess + where + postprocess str + | str == "True" = pure True + | str == "False" = pure False + | lstr == "true" = parsecWarning PWTBoolCase caseWarning *> pure True + | lstr == "false" = parsecWarning PWTBoolCase caseWarning *> pure False + | otherwise = fail $ "Not a boolean: " ++ str + where + lstr = map toLower str + caseWarning = + "Boolean values are case sensitive, use 'True' or 'False'." + +-- | @[^ ,]@ +parsecToken :: CabalParsing m => m String +parsecToken = parsecHaskellString <|> ((P.munch1 (\x -> not (isSpace x) && x /= ',') P. "identifier" ) >>= checkNotDoubleDash) + +-- | @[^ ]@ +parsecToken' :: CabalParsing m => m String +parsecToken' = parsecHaskellString <|> ((P.munch1 (not . isSpace) P. "token") >>= checkNotDoubleDash) + +checkNotDoubleDash :: CabalParsing m => String -> m String +checkNotDoubleDash s = do + when (s == "--") $ parsecWarning PWTDoubleDash $ unwords + [ "Double-dash token found." + , "Note: there are no end-of-line comments in .cabal files, only whole line comments." + , "Use \"--\" (quoted double dash) to silence this warning, if you actually want -- token" + ] + + return s + +parsecFilePath :: CabalParsing m => m FilePath +parsecFilePath = parsecToken + +-- | Parse a benchmark/test-suite types. +parsecStandard :: (CabalParsing m, Parsec ver) => (ver -> String -> a) -> m a +parsecStandard f = do + cs <- some $ P.try (component <* P.char '-') + ver <- parsec + let name = map toLower (intercalate "-" cs) + return $! f ver name + where + component = do + cs <- P.munch1 isAlphaNum + if all isDigit cs then fail "all digit component" else return cs + -- each component must contain an alphabetic character, to avoid + -- ambiguity in identifiers like foo-1 (the 1 is the version number). + +parsecCommaList :: CabalParsing m => m a -> m [a] +parsecCommaList p = P.sepBy (p <* P.spaces) (P.char ',' *> P.spaces P. "comma") + +-- | Like 'parsecCommaList' but accept leading or trailing comma. +-- +-- @ +-- p (comma p)* -- p `sepBy` comma +-- (comma p)* -- leading comma +-- (p comma)* -- trailing comma +-- @ +parsecLeadingCommaList :: CabalParsing m => m a -> m [a] +parsecLeadingCommaList p = do + c <- P.optional comma + case c of + Nothing -> P.sepEndBy1 lp comma <|> pure [] + Just _ -> P.sepBy1 lp comma + where + lp = p <* P.spaces + comma = P.char ',' *> P.spaces P. "comma" + +parsecOptCommaList :: CabalParsing m => m a -> m [a] +parsecOptCommaList p = P.sepBy (p <* P.spaces) (P.optional comma) + where + comma = P.char ',' *> P.spaces + +-- | Like 'parsecOptCommaList' but +-- +-- * require all or none commas +-- * accept leading or trailing comma. +-- +-- @ +-- p (comma p)* -- p `sepBy` comma +-- (comma p)* -- leading comma +-- (p comma)* -- trailing comma +-- p* -- no commas: many p +-- @ +-- +-- @since 3.0.0.0 +-- +parsecLeadingOptCommaList :: CabalParsing m => m a -> m [a] +parsecLeadingOptCommaList p = do + c <- P.optional comma + case c of + Nothing -> sepEndBy1Start <|> pure [] + Just _ -> P.sepBy1 lp comma + where + lp = p <* P.spaces + comma = P.char ',' *> P.spaces P. "comma" + + sepEndBy1Start = do + x <- lp + c <- P.optional comma + case c of + Nothing -> (x :) <$> many lp + Just _ -> (x :) <$> P.sepEndBy lp comma + +-- | Content isn't unquoted +parsecQuoted :: CabalParsing m => m a -> m a +parsecQuoted = P.between (P.char '"') (P.char '"') + +-- | @parsecMaybeQuoted p = 'parsecQuoted' p <|> p@. +parsecMaybeQuoted :: CabalParsing m => m a -> m a +parsecMaybeQuoted p = parsecQuoted p <|> p + +parsecUnqualComponentName :: CabalParsing m => m String +parsecUnqualComponentName = intercalate "-" <$> P.sepBy1 component (P.char '-') + where + component :: CabalParsing m => m String + component = do + cs <- P.munch1 isAlphaNum + if all isDigit cs + then fail "all digits in portion of unqualified component name" + else return cs + +stringLiteral :: forall m. P.CharParsing m => m String +stringLiteral = lit where + lit :: m String + lit = foldr (maybe id (:)) "" + <$> P.between (P.char '"') (P.char '"' P. "end of string") (many stringChar) + P. "string" + + stringChar :: m (Maybe Char) + stringChar = Just <$> stringLetter + <|> stringEscape + P. "string character" + + stringLetter :: m Char + stringLetter = P.satisfy (\c -> (c /= '"') && (c /= '\\') && (c > '\026')) + + stringEscape :: m (Maybe Char) + stringEscape = P.char '\\' *> esc where + esc :: m (Maybe Char) + esc = Nothing <$ escapeGap + <|> Nothing <$ escapeEmpty + <|> Just <$> escapeCode + + escapeEmpty, escapeGap :: m Char + escapeEmpty = P.char '&' + escapeGap = P.skipSpaces1 *> (P.char '\\' P. "end of string gap") + +escapeCode :: forall m. P.CharParsing m => m Char +escapeCode = (charEsc <|> charNum <|> charAscii <|> charControl) P. "escape code" + where + charControl, charNum :: m Char + charControl = (\c -> toEnum (fromEnum c - fromEnum '@')) <$> (P.char '^' *> (P.upper <|> P.char '@')) + charNum = toEnum <$> num + where + num :: m Int + num = bounded 10 maxchar + <|> (P.char 'o' *> bounded 8 maxchar) + <|> (P.char 'x' *> bounded 16 maxchar) + maxchar = fromEnum (maxBound :: Char) + + bounded :: Int -> Int -> m Int + bounded base bnd = foldl' (\x d -> base * x + digitToInt d) 0 + <$> bounded' (take base thedigits) (map digitToInt $ showIntAtBase base intToDigit bnd "") + where + thedigits :: [m Char] + thedigits = map P.char ['0'..'9'] ++ map P.oneOf (transpose [['A'..'F'],['a'..'f']]) + + toomuch :: m a + toomuch = P.unexpected "out-of-range numeric escape sequence" + + bounded', bounded'' :: [m Char] -> [Int] -> m [Char] + bounded' dps@(zero:_) bds = P.skipSome zero *> ([] <$ P.notFollowedBy (P.choice dps) <|> bounded'' dps bds) + <|> bounded'' dps bds + bounded' [] _ = error "bounded called with base 0" + bounded'' dps [] = [] <$ P.notFollowedBy (P.choice dps) <|> toomuch + bounded'' dps (bd : bds) = let anyd :: m Char + anyd = P.choice dps + + nomore :: m () + nomore = P.notFollowedBy anyd <|> toomuch + + (low, ex : high) = splitAt bd dps + in ((:) <$> P.choice low <*> atMost (length bds) anyd) <* nomore + <|> ((:) <$> ex <*> ([] <$ nomore <|> bounded'' dps bds)) + <|> if not (null bds) + then (:) <$> P.choice high <*> atMost (length bds - 1) anyd <* nomore + else empty + atMost n p | n <= 0 = pure [] + | otherwise = ((:) <$> p <*> atMost (n - 1) p) <|> pure [] + + charEsc :: m Char + charEsc = P.choice $ parseEsc <$> escMap + + parseEsc (c,code) = code <$ P.char c + escMap = zip "abfnrtv\\\"\'" "\a\b\f\n\r\t\v\\\"\'" + + charAscii :: m Char + charAscii = P.choice $ parseAscii <$> asciiMap + + parseAscii (asc,code) = P.try $ code <$ P.string asc + asciiMap = zip (ascii3codes ++ ascii2codes) (ascii3 ++ ascii2) + ascii2codes, ascii3codes :: [String] + ascii2codes = [ "BS","HT","LF","VT","FF","CR","SO" + , "SI","EM","FS","GS","RS","US","SP"] + ascii3codes = ["NUL","SOH","STX","ETX","EOT","ENQ","ACK" + ,"BEL","DLE","DC1","DC2","DC3","DC4","NAK" + ,"SYN","ETB","CAN","SUB","ESC","DEL"] + ascii2, ascii3 :: String + ascii2 = "\BS\HT\LF\VT\FF\CR\SO\SI\EM\FS\GS\RS\US\SP" + ascii3 = "\NUL\SOH\STX\ETX\EOT\ENQ\ACK\BEL\DLE\DC1\DC2\DC3\DC4\NAK\SYN\ETB\CAN\SUB\ESC\DEL" diff --git a/cabal/Cabal/Distribution/Parsec/Class.hs b/cabal/Cabal/Distribution/Parsec/Class.hs deleted file mode 100644 --- a/cabal/Cabal/Distribution/Parsec/Class.hs +++ /dev/null @@ -1,353 +0,0 @@ -{-# LANGUAGE GADTs #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -module Distribution.Parsec.Class ( - Parsec(..), - ParsecParser (..), - runParsecParser, - simpleParsec, - lexemeParsec, - eitherParsec, - explicitEitherParsec, - -- * CabalParsing & warnings - CabalParsing (..), - PWarnType (..), - -- * Utilities - parsecToken, - parsecToken', - parsecFilePath, - parsecQuoted, - parsecMaybeQuoted, - parsecCommaList, - parsecLeadingCommaList, - parsecOptCommaList, - parsecStandard, - parsecUnqualComponentName, - ) where - -import Data.Char (digitToInt, intToDigit) -import Data.Functor.Identity (Identity (..)) -import Data.List (transpose) -import Distribution.CabalSpecVersion -import Distribution.Compat.Prelude -import Distribution.Parsec.FieldLineStream -import Distribution.Parsec.Common (PWarnType (..), PWarning (..), Position (..)) -import Numeric (showIntAtBase) -import Prelude () - -import qualified Distribution.Compat.CharParsing as P -import qualified Distribution.Compat.MonadFail as Fail -import qualified Distribution.Compat.ReadP as ReadP -import qualified Text.Parsec as Parsec - -------------------------------------------------------------------------------- --- Class -------------------------------------------------------------------------------- - --- | Class for parsing with @parsec@. Mainly used for @.cabal@ file fields. -class Parsec a where - parsec :: CabalParsing m => m a - --- | Parsing class which --- --- * can report Cabal parser warnings. --- --- * knows @cabal-version@ we work with --- -class (P.CharParsing m, MonadPlus m) => CabalParsing m where - parsecWarning :: PWarnType -> String -> m () - - parsecHaskellString :: m String - parsecHaskellString = stringLiteral - - askCabalSpecVersion :: m CabalSpecVersion - -instance t ~ Char => CabalParsing (ReadP.Parser r t) where - parsecWarning _ _ = pure () - askCabalSpecVersion = pure cabalSpecLatest - --- | 'parsec' /could/ consume trailing spaces, this function /will/ consume. -lexemeParsec :: (CabalParsing m, Parsec a) => m a -lexemeParsec = parsec <* P.spaces - -newtype ParsecParser a = PP { unPP - :: CabalSpecVersion -> Parsec.Parsec FieldLineStream [PWarning] a - } - -liftParsec :: Parsec.Parsec FieldLineStream [PWarning] a -> ParsecParser a -liftParsec p = PP $ \_ -> p - -instance Functor ParsecParser where - fmap f p = PP $ \v -> fmap f (unPP p v) - {-# INLINE fmap #-} - - x <$ p = PP $ \v -> x <$ unPP p v - {-# INLINE (<$) #-} - -instance Applicative ParsecParser where - pure = liftParsec . pure - {-# INLINE pure #-} - - f <*> x = PP $ \v -> unPP f v <*> unPP x v - {-# INLINE (<*>) #-} - f *> x = PP $ \v -> unPP f v *> unPP x v - {-# INLINE (*>) #-} - f <* x = PP $ \v -> unPP f v <* unPP x v - {-# INLINE (<*) #-} - -instance Alternative ParsecParser where - empty = liftParsec empty - - a <|> b = PP $ \v -> unPP a v <|> unPP b v - {-# INLINE (<|>) #-} - - many p = PP $ \v -> many (unPP p v) - {-# INLINE many #-} - - some p = PP $ \v -> some (unPP p v) - {-# INLINE some #-} - -instance Monad ParsecParser where - return = pure - - m >>= k = PP $ \v -> unPP m v >>= \x -> unPP (k x) v - {-# INLINE (>>=) #-} - (>>) = (*>) - {-# INLINE (>>) #-} - - fail = Fail.fail - -instance MonadPlus ParsecParser where - mzero = empty - mplus = (<|>) - -instance Fail.MonadFail ParsecParser where - fail = P.unexpected - -instance P.Parsing ParsecParser where - try p = PP $ \v -> P.try (unPP p v) - p d = PP $ \v -> unPP p v P. d - skipMany p = PP $ \v -> P.skipMany (unPP p v) - skipSome p = PP $ \v -> P.skipSome (unPP p v) - unexpected = liftParsec . P.unexpected - eof = liftParsec P.eof - notFollowedBy p = PP $ \v -> P.notFollowedBy (unPP p v) - -instance P.CharParsing ParsecParser where - satisfy = liftParsec . P.satisfy - char = liftParsec . P.char - notChar = liftParsec . P.notChar - anyChar = liftParsec P.anyChar - string = liftParsec . P.string - -instance CabalParsing ParsecParser where - parsecWarning t w = liftParsec $ Parsec.modifyState (PWarning t (Position 0 0) w :) - askCabalSpecVersion = PP pure - --- | Parse a 'String' with 'lexemeParsec'. -simpleParsec :: Parsec a => String -> Maybe a -simpleParsec - = either (const Nothing) Just - . runParsecParser lexemeParsec "" - . fieldLineStreamFromString - --- | Parse a 'String' with 'lexemeParsec'. -eitherParsec :: Parsec a => String -> Either String a -eitherParsec = explicitEitherParsec parsec - --- | Parse a 'String' with given 'ParsecParser'. Trailing whitespace is accepted. -explicitEitherParsec :: ParsecParser a -> String -> Either String a -explicitEitherParsec parser - = either (Left . show) Right - . runParsecParser (parser <* P.spaces) "" - . fieldLineStreamFromString - --- | Run 'ParsecParser' with 'cabalSpecLatest'. -runParsecParser :: ParsecParser a -> FilePath -> FieldLineStream -> Either Parsec.ParseError a -runParsecParser p n = Parsec.runParser (unPP p cabalSpecLatest <* P.eof) [] n - -instance Parsec a => Parsec (Identity a) where - parsec = Identity <$> parsec - -instance Parsec Bool where - parsec = P.munch1 isAlpha >>= postprocess - where - postprocess str - | str == "True" = pure True - | str == "False" = pure False - | lstr == "true" = parsecWarning PWTBoolCase caseWarning *> pure True - | lstr == "false" = parsecWarning PWTBoolCase caseWarning *> pure False - | otherwise = fail $ "Not a boolean: " ++ str - where - lstr = map toLower str - caseWarning = - "Boolean values are case sensitive, use 'True' or 'False'." - --- | @[^ ,]@ -parsecToken :: CabalParsing m => m String -parsecToken = parsecHaskellString <|> ((P.munch1 (\x -> not (isSpace x) && x /= ',') P. "identifier" ) >>= checkNotDoubleDash) - --- | @[^ ]@ -parsecToken' :: CabalParsing m => m String -parsecToken' = parsecHaskellString <|> ((P.munch1 (not . isSpace) P. "token") >>= checkNotDoubleDash) - -checkNotDoubleDash :: CabalParsing m => String -> m String -checkNotDoubleDash s = do - when (s == "--") $ parsecWarning PWTDoubleDash $ unwords - [ "Double-dash token found." - , "Note: there are no end-of-line comments in .cabal files, only whole line comments." - , "Use \"--\" (quoted double dash) to silence this warning, if you actually want -- token" - ] - - return s - -parsecFilePath :: CabalParsing m => m FilePath -parsecFilePath = parsecToken - --- | Parse a benchmark/test-suite types. -parsecStandard :: (CabalParsing m, Parsec ver) => (ver -> String -> a) -> m a -parsecStandard f = do - cs <- some $ P.try (component <* P.char '-') - ver <- parsec - let name = map toLower (intercalate "-" cs) - return $! f ver name - where - component = do - cs <- P.munch1 isAlphaNum - if all isDigit cs then fail "all digit component" else return cs - -- each component must contain an alphabetic character, to avoid - -- ambiguity in identifiers like foo-1 (the 1 is the version number). - -parsecCommaList :: CabalParsing m => m a -> m [a] -parsecCommaList p = P.sepBy (p <* P.spaces) (P.char ',' *> P.spaces P. "comma") - --- | Like 'parsecCommaList' but accept leading or trailing comma. --- --- @ --- p (comma p)* -- p `sepBy` comma --- (comma p)* -- leading comma --- (p comma)* -- trailing comma --- @ -parsecLeadingCommaList :: CabalParsing m => m a -> m [a] -parsecLeadingCommaList p = do - c <- P.optional comma - case c of - Nothing -> P.sepEndBy1 lp comma <|> pure [] - Just _ -> P.sepBy1 lp comma - where - lp = p <* P.spaces - comma = P.char ',' *> P.spaces P. "comma" - -parsecOptCommaList :: CabalParsing m => m a -> m [a] -parsecOptCommaList p = P.sepBy (p <* P.spaces) (P.optional comma) - where - comma = P.char ',' *> P.spaces - --- | Content isn't unquoted -parsecQuoted :: CabalParsing m => m a -> m a -parsecQuoted = P.between (P.char '"') (P.char '"') - --- | @parsecMaybeQuoted p = 'parsecQuoted' p <|> p@. -parsecMaybeQuoted :: CabalParsing m => m a -> m a -parsecMaybeQuoted p = parsecQuoted p <|> p - -parsecUnqualComponentName :: CabalParsing m => m String -parsecUnqualComponentName = intercalate "-" <$> P.sepBy1 component (P.char '-') - where - component :: CabalParsing m => m String - component = do - cs <- P.munch1 isAlphaNum - if all isDigit cs - then fail "all digits in portion of unqualified component name" - else return cs - -stringLiteral :: forall m. P.CharParsing m => m String -stringLiteral = lit where - lit :: m String - lit = foldr (maybe id (:)) "" - <$> P.between (P.char '"') (P.char '"' P. "end of string") (many stringChar) - P. "string" - - stringChar :: m (Maybe Char) - stringChar = Just <$> stringLetter - <|> stringEscape - P. "string character" - - stringLetter :: m Char - stringLetter = P.satisfy (\c -> (c /= '"') && (c /= '\\') && (c > '\026')) - - stringEscape :: m (Maybe Char) - stringEscape = P.char '\\' *> esc where - esc :: m (Maybe Char) - esc = Nothing <$ escapeGap - <|> Nothing <$ escapeEmpty - <|> Just <$> escapeCode - - escapeEmpty, escapeGap :: m Char - escapeEmpty = P.char '&' - escapeGap = P.skipSpaces1 *> (P.char '\\' P. "end of string gap") - -escapeCode :: forall m. P.CharParsing m => m Char -escapeCode = (charEsc <|> charNum <|> charAscii <|> charControl) P. "escape code" - where - charControl, charNum :: m Char - charControl = (\c -> toEnum (fromEnum c - fromEnum '@')) <$> (P.char '^' *> (P.upper <|> P.char '@')) - charNum = toEnum <$> num - where - num :: m Int - num = bounded 10 maxchar - <|> (P.char 'o' *> bounded 8 maxchar) - <|> (P.char 'x' *> bounded 16 maxchar) - maxchar = fromEnum (maxBound :: Char) - - bounded :: Int -> Int -> m Int - bounded base bnd = foldl' (\x d -> base * x + digitToInt d) 0 - <$> bounded' (take base thedigits) (map digitToInt $ showIntAtBase base intToDigit bnd "") - where - thedigits :: [m Char] - thedigits = map P.char ['0'..'9'] ++ map P.oneOf (transpose [['A'..'F'],['a'..'f']]) - - toomuch :: m a - toomuch = P.unexpected "out-of-range numeric escape sequence" - - bounded', bounded'' :: [m Char] -> [Int] -> m [Char] - bounded' dps@(zero:_) bds = P.skipSome zero *> ([] <$ P.notFollowedBy (P.choice dps) <|> bounded'' dps bds) - <|> bounded'' dps bds - bounded' [] _ = error "bounded called with base 0" - bounded'' dps [] = [] <$ P.notFollowedBy (P.choice dps) <|> toomuch - bounded'' dps (bd : bds) = let anyd :: m Char - anyd = P.choice dps - - nomore :: m () - nomore = P.notFollowedBy anyd <|> toomuch - - (low, ex : high) = splitAt bd dps - in ((:) <$> P.choice low <*> atMost (length bds) anyd) <* nomore - <|> ((:) <$> ex <*> ([] <$ nomore <|> bounded'' dps bds)) - <|> if not (null bds) - then (:) <$> P.choice high <*> atMost (length bds - 1) anyd <* nomore - else empty - atMost n p | n <= 0 = pure [] - | otherwise = ((:) <$> p <*> atMost (n - 1) p) <|> pure [] - - charEsc :: m Char - charEsc = P.choice $ parseEsc <$> escMap - - parseEsc (c,code) = code <$ P.char c - escMap = zip "abfnrtv\\\"\'" "\a\b\f\n\r\t\v\\\"\'" - - charAscii :: m Char - charAscii = P.choice $ parseAscii <$> asciiMap - - parseAscii (asc,code) = P.try $ code <$ P.string asc - asciiMap = zip (ascii3codes ++ ascii2codes) (ascii3 ++ ascii2) - ascii2codes, ascii3codes :: [String] - ascii2codes = [ "BS","HT","LF","VT","FF","CR","SO" - , "SI","EM","FS","GS","RS","US","SP"] - ascii3codes = ["NUL","SOH","STX","ETX","EOT","ENQ","ACK" - ,"BEL","DLE","DC1","DC2","DC3","DC4","NAK" - ,"SYN","ETB","CAN","SUB","ESC","DEL"] - ascii2, ascii3 :: String - ascii2 = "\BS\HT\LF\VT\FF\CR\SO\SI\EM\FS\GS\RS\US\SP" - ascii3 = "\NUL\SOH\STX\ETX\EOT\ENQ\ACK\BEL\DLE\DC1\DC2\DC3\DC4\NAK\SYN\ETB\CAN\SUB\ESC\DEL" diff --git a/cabal/Cabal/Distribution/Parsec/Common.hs b/cabal/Cabal/Distribution/Parsec/Common.hs deleted file mode 100644 --- a/cabal/Cabal/Distribution/Parsec/Common.hs +++ /dev/null @@ -1,100 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} --- | Module containing small types -module Distribution.Parsec.Common ( - -- * Diagnostics - PError (..), - showPError, - PWarning (..), - PWarnType (..), - showPWarning, - -- * Position - Position (..), - incPos, - retPos, - showPos, - zeroPos, - ) where - -import Distribution.Compat.Prelude -import Prelude () -import System.FilePath (normalise) - --- | Parser error. -data PError = PError Position String - deriving (Show, Generic) - -instance Binary PError -instance NFData PError where rnf = genericRnf - --- | Type of parser warning. We do classify warnings. --- --- Different application may decide not to show some, or have fatal behaviour on others -data PWarnType - = PWTOther -- ^ Unclassified warning - | PWTUTF -- ^ Invalid UTF encoding - | PWTBoolCase -- ^ @true@ or @false@, not @True@ or @False@ - | PWTVersionTag -- ^ there are version with tags - | PWTNewSyntax -- ^ New syntax used, but no @cabal-version: >= 1.2@ specified - | PWTOldSyntax -- ^ Old syntax used, and @cabal-version >= 1.2@ specified - | PWTDeprecatedField - | PWTInvalidSubsection - | PWTUnknownField - | PWTUnknownSection - | PWTTrailingFields - | PWTExtraMainIs -- ^ extra main-is field - | PWTExtraTestModule -- ^ extra test-module field - | PWTExtraBenchmarkModule -- ^ extra benchmark-module field - | PWTLexNBSP - | PWTLexBOM - | PWTLexTab - | PWTQuirkyCabalFile -- ^ legacy cabal file that we know how to patch - | PWTDoubleDash -- ^ Double dash token, most likely it's a mistake - it's not a comment - | PWTMultipleSingularField -- ^ e.g. name or version should be specified only once. - | PWTBuildTypeDefault -- ^ Workaround for derive-package having build-type: Default. See . - | PWTVersionLeadingZeros -- ^ See https://github.com/haskell-infra/hackage-trustees/issues/128 - deriving (Eq, Ord, Show, Enum, Bounded, Generic) - -instance Binary PWarnType -instance NFData PWarnType where rnf = genericRnf - --- | Parser warning. -data PWarning = PWarning !PWarnType !Position String - deriving (Show, Generic) - -instance Binary PWarning -instance NFData PWarning where rnf = genericRnf - -showPWarning :: FilePath -> PWarning -> String -showPWarning fpath (PWarning _ pos msg) = - normalise fpath ++ ":" ++ showPos pos ++ ": " ++ msg - -showPError :: FilePath -> PError -> String -showPError fpath (PError pos msg) = - normalise fpath ++ ":" ++ showPos pos ++ ": " ++ msg - -------------------------------------------------------------------------------- --- Position -------------------------------------------------------------------------------- - --- | 1-indexed row and column positions in a file. -data Position = Position - {-# UNPACK #-} !Int -- row - {-# UNPACK #-} !Int -- column - deriving (Eq, Ord, Show, Generic) - -instance Binary Position -instance NFData Position where rnf = genericRnf - --- | Shift position by n columns to the right. -incPos :: Int -> Position -> Position -incPos n (Position row col) = Position row (col + n) - --- | Shift position to beginning of next row. -retPos :: Position -> Position -retPos (Position row _col) = Position (row + 1) 1 - -showPos :: Position -> String -showPos (Position row col) = show row ++ ":" ++ show col - -zeroPos :: Position -zeroPos = Position 0 0 diff --git a/cabal/Cabal/Distribution/Parsec/ConfVar.hs b/cabal/Cabal/Distribution/Parsec/ConfVar.hs deleted file mode 100644 --- a/cabal/Cabal/Distribution/Parsec/ConfVar.hs +++ /dev/null @@ -1,125 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE NoMonoLocalBinds #-} -module Distribution.Parsec.ConfVar (parseConditionConfVar) where - -import Distribution.Compat.CharParsing (char, integral) -import Distribution.Compat.Prelude -import Distribution.Parsec.Class (Parsec (..), runParsecParser) -import Distribution.Parsec.Common -import Distribution.Parsec.FieldLineStream -import Distribution.Parsec.Field (SectionArg (..)) -import Distribution.Parsec.ParseResult -import Distribution.Types.Condition -import Distribution.Types.GenericPackageDescription (ConfVar (..)) -import Distribution.Version - (anyVersion, earlierVersion, intersectVersionRanges, laterVersion, majorBoundVersion, - mkVersion, noVersion, orEarlierVersion, orLaterVersion, thisVersion, unionVersionRanges, - withinVersion) -import Prelude () - -import qualified Text.Parsec as P -import qualified Text.Parsec.Error as P - --- | Parse @'Condition' 'ConfVar'@ from section arguments provided by parsec --- based outline parser. -parseConditionConfVar :: [SectionArg Position] -> ParseResult (Condition ConfVar) -parseConditionConfVar args = - -- The name of the input file is irrelevant, as we reformat the error message. - case P.runParser (parser <* P.eof) () "" args of - Right x -> pure x - Left err -> do - -- Mangle the position to the actual one - let ppos = P.errorPos err - let epos = Position (P.sourceLine ppos) (P.sourceColumn ppos) - let msg = P.showErrorMessages - "or" "unknown parse error" "expecting" "unexpected" "end of input" - (P.errorMessages err) - parseFailure epos msg - pure $ Lit True - -type Parser = P.Parsec [SectionArg Position] () - -parser :: Parser (Condition ConfVar) -parser = condOr - where - condOr = P.sepBy1 condAnd (oper "||") >>= return . foldl1 COr - condAnd = P.sepBy1 cond (oper "&&") >>= return . foldl1 CAnd - cond = P.choice - [ boolLiteral, parens condOr, notCond, osCond, archCond, flagCond, implCond ] - - notCond = CNot <$ oper "!" <*> cond - - boolLiteral = Lit <$> boolLiteral' - osCond = Var . OS <$ string "os" <*> parens fromParsec - flagCond = Var . Flag <$ string "flag" <*> parens fromParsec - archCond = Var . Arch <$ string "arch" <*> parens fromParsec - implCond = Var <$ string "impl" <*> parens implCond' - - implCond' = Impl - <$> fromParsec - <*> P.option anyVersion versionRange - - version = fromParsec - versionStar = mkVersion <$> fromParsec' versionStar' <* oper "*" - versionStar' = some (integral <* char '.') - - versionRange = expr - where - expr = foldl1 unionVersionRanges <$> P.sepBy1 term (oper "||") - term = foldl1 intersectVersionRanges <$> P.sepBy1 factor (oper "&&") - - factor = P.choice - $ parens expr - : parseAnyVersion - : parseNoVersion - : parseWildcardRange - : map parseRangeOp rangeOps - - parseAnyVersion = anyVersion <$ string "-any" - parseNoVersion = noVersion <$ string "-none" - - parseWildcardRange = P.try $ withinVersion <$ oper "==" <*> versionStar - - parseRangeOp (s,f) = P.try (f <$ oper s <*> version) - rangeOps = [ ("<", earlierVersion), - ("<=", orEarlierVersion), - (">", laterVersion), - (">=", orLaterVersion), - ("^>=", majorBoundVersion), - ("==", thisVersion) ] - - -- Number token can have many dots in it: SecArgNum (Position 65 15) "7.6.1" - identBS = tokenPrim $ \t -> case t of - SecArgName _ s -> Just s - _ -> Nothing - - boolLiteral' = tokenPrim $ \t -> case t of - SecArgName _ s - | s == "True" -> Just True - | s == "true" -> Just True - | s == "False" -> Just False - | s == "false" -> Just False - _ -> Nothing - - string s = tokenPrim $ \t -> case t of - SecArgName _ s' | s == s' -> Just () - _ -> Nothing - - oper o = tokenPrim $ \t -> case t of - SecArgOther _ o' | o == o' -> Just () - _ -> Nothing - - parens = P.between (oper "(") (oper ")") - - tokenPrim = P.tokenPrim prettySectionArg updatePosition - -- TODO: check where the errors are reported - updatePosition x _ _ = x - prettySectionArg = show - - fromParsec :: Parsec a => Parser a - fromParsec = fromParsec' parsec - - fromParsec' p = do - bs <- identBS - let fls = fieldLineStreamFromBS bs - either (fail . show) pure (runParsecParser p "" fls) diff --git a/cabal/Cabal/Distribution/Parsec/Error.hs b/cabal/Cabal/Distribution/Parsec/Error.hs new file mode 100644 --- /dev/null +++ b/cabal/Cabal/Distribution/Parsec/Error.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE DeriveGeneric #-} +module Distribution.Parsec.Error ( + PError (..), + showPError, + ) where + +import Distribution.Compat.Prelude +import Distribution.Parsec.Position +import Prelude () +import System.FilePath (normalise) + +-- | Parser error. +data PError = PError Position String + deriving (Show, Generic) + +instance Binary PError +instance NFData PError where rnf = genericRnf + +showPError :: FilePath -> PError -> String +showPError fpath (PError pos msg) = + normalise fpath ++ ":" ++ showPos pos ++ ": " ++ msg diff --git a/cabal/Cabal/Distribution/Parsec/Field.hs b/cabal/Cabal/Distribution/Parsec/Field.hs deleted file mode 100644 --- a/cabal/Cabal/Distribution/Parsec/Field.hs +++ /dev/null @@ -1,96 +0,0 @@ -{-# LANGUAGE DeriveFunctor #-} --- | Cabal-like file AST types: 'Field', 'Section' etc --- --- These types are parametrized by an annotation. -module Distribution.Parsec.Field ( - -- * Cabal file - Field (..), - fieldName, - fieldAnn, - fieldUniverse, - FieldLine (..), - SectionArg (..), - sectionArgAnn, - -- * Name - FieldName, - Name (..), - mkName, - getName, - nameAnn, - ) where - -import Prelude () -import Distribution.Compat.Prelude -import Data.ByteString (ByteString) -import qualified Data.ByteString.Char8 as B -import qualified Data.Char as Char - -------------------------------------------------------------------------------- --- Cabal file -------------------------------------------------------------------------------- - --- | A Cabal-like file consists of a series of fields (@foo: bar@) and sections (@library ...@). -data Field ann - = Field !(Name ann) [FieldLine ann] - | Section !(Name ann) [SectionArg ann] [Field ann] - deriving (Eq, Show, Functor) - --- | Section of field name -fieldName :: Field ann -> Name ann -fieldName (Field n _ ) = n -fieldName (Section n _ _) = n - -fieldAnn :: Field ann -> ann -fieldAnn = nameAnn . fieldName - --- | All transitive descendands of 'Field', including itself. --- --- /Note:/ the resulting list is never empty. --- -fieldUniverse :: Field ann -> [Field ann] -fieldUniverse f@(Section _ _ fs) = f : concatMap fieldUniverse fs -fieldUniverse f@(Field _ _) = [f] - --- | A line of text representing the value of a field from a Cabal file. --- A field may contain multiple lines. --- --- /Invariant:/ 'ByteString' has no newlines. -data FieldLine ann = FieldLine !ann !ByteString - deriving (Eq, Show, Functor) - --- | Section arguments, e.g. name of the library -data SectionArg ann - = SecArgName !ann !ByteString - -- ^ identifier, or omething which loos like number. Also many dot numbers, i.e. "7.6.3" - | SecArgStr !ann !ByteString - -- ^ quoted string - | SecArgOther !ann !ByteString - -- ^ everything else, mm. operators (e.g. in if-section conditionals) - deriving (Eq, Show, Functor) - --- | Extract annotation from 'SectionArg'. -sectionArgAnn :: SectionArg ann -> ann -sectionArgAnn (SecArgName ann _) = ann -sectionArgAnn (SecArgStr ann _) = ann -sectionArgAnn (SecArgOther ann _) = ann - -------------------------------------------------------------------------------- --- Name -------------------------------------------------------------------------------- - -type FieldName = ByteString - --- | A field name. --- --- /Invariant/: 'ByteString' is lower-case ASCII. -data Name ann = Name !ann !FieldName - deriving (Eq, Show, Functor) - -mkName :: ann -> FieldName -> Name ann -mkName ann bs = Name ann (B.map Char.toLower bs) - -getName :: Name ann -> FieldName -getName (Name _ bs) = bs - -nameAnn :: Name ann -> ann -nameAnn (Name ann _) = ann diff --git a/cabal/Cabal/Distribution/Parsec/FieldLineStream.hs b/cabal/Cabal/Distribution/Parsec/FieldLineStream.hs --- a/cabal/Cabal/Distribution/Parsec/FieldLineStream.hs +++ b/cabal/Cabal/Distribution/Parsec/FieldLineStream.hs @@ -1,37 +1,32 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings , ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -Wall -Werror #-} module Distribution.Parsec.FieldLineStream ( FieldLineStream (..), - fieldLinesToStream, fieldLineStreamFromString, fieldLineStreamFromBS, + fieldLineStreamEnd, ) where import Data.Bits import Data.ByteString (ByteString) import Distribution.Compat.Prelude -import Distribution.Parsec.Field (FieldLine (..)) import Distribution.Utils.Generic (toUTF8BS) import Prelude () import qualified Data.ByteString as BS import qualified Text.Parsec as Parsec --- | This is essentially a lazy bytestring, but chunks are glued with newline '\n'. +-- | This is essentially a lazy bytestring, but chunks are glued with newline @\'\\n\'@. data FieldLineStream = FLSLast !ByteString | FLSCons {-# UNPACK #-} !ByteString FieldLineStream deriving Show -fieldLinesToStream :: [FieldLine ann] -> FieldLineStream -fieldLinesToStream [] = end -fieldLinesToStream [FieldLine _ bs] = FLSLast bs -fieldLinesToStream (FieldLine _ bs : fs) = FLSCons bs (fieldLinesToStream fs) - -end :: FieldLineStream -end = FLSLast "" +fieldLineStreamEnd :: FieldLineStream +fieldLineStreamEnd = FLSLast mempty -- | Convert 'String' to 'FieldLineStream'. -- @@ -45,14 +40,14 @@ instance Monad m => Parsec.Stream FieldLineStream m Char where uncons (FLSLast bs) = return $ case BS.uncons bs of Nothing -> Nothing - Just (c, bs') -> Just (unconsChar c bs' (\bs'' -> FLSLast bs'') end) + Just (c, bs') -> Just (unconsChar c bs' (\bs'' -> FLSLast bs'') fieldLineStreamEnd) uncons (FLSCons bs s) = return $ case BS.uncons bs of -- as lines are glued with '\n', we return '\n' here! Nothing -> Just ('\n', s) Just (c, bs') -> Just (unconsChar c bs' (\bs'' -> FLSCons bs'' s) s) --- Bssed on implementation 'decodeStringUtf8' +-- Based on implementation 'decodeStringUtf8' unconsChar :: forall a. Word8 -> ByteString -> (ByteString -> a) -> a -> (Char, a) unconsChar c0 bs0 f next | c0 <= 0x7F = (chr (fromIntegral c0), f bs0) diff --git a/cabal/Cabal/Distribution/Parsec/Lexer.hs b/cabal/Cabal/Distribution/Parsec/Lexer.hs deleted file mode 100644 --- a/cabal/Cabal/Distribution/Parsec/Lexer.hs +++ /dev/null @@ -1,422 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-missing-signatures #-} -{-# LANGUAGE CPP,MagicHash #-} -{-# LINE 1 "boot/Lexer.x" #-} - ------------------------------------------------------------------------------ --- | --- Module : Distribution.Parsec.Lexer --- License : BSD3 --- --- Maintainer : cabal-devel@haskell.org --- Portability : portable --- --- Lexer for the cabal files. -{-# LANGUAGE CPP #-} -{-# LANGUAGE BangPatterns #-} -#ifdef CABAL_PARSEC_DEBUG -{-# LANGUAGE PatternGuards #-} -#endif -{-# OPTIONS_GHC -fno-warn-unused-imports #-} -module Distribution.Parsec.Lexer - (ltest, lexToken, Token(..), LToken(..) - ,bol_section, in_section, in_field_layout, in_field_braces - ,mkLexState) where - --- [Note: boostrapping parsec parser] --- --- We manually produce the `Lexer.hs` file from `boot/Lexer.x` (make lexer) --- because boostrapping cabal-install would be otherwise tricky. --- Alex is (atm) tricky package to build, cabal-install has some magic --- to move bundled generated files in place, so rather we don't depend --- on it before we can build it ourselves. --- Therefore there is one thing less to worry in bootstrap.sh, which is a win. --- --- See also https://github.com/haskell/cabal/issues/4633 --- - -import Prelude () -import qualified Prelude as Prelude -import Distribution.Compat.Prelude - -import Distribution.Parsec.LexerMonad -import Distribution.Parsec.Common (Position (..), incPos, retPos) -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as B.Char8 -import qualified Data.Word as Word - -#ifdef CABAL_PARSEC_DEBUG -import Debug.Trace -import qualified Data.Vector as V -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Data.Text.Encoding.Error as T -#endif - -#if __GLASGOW_HASKELL__ >= 603 -#include "ghcconfig.h" -#elif defined(__GLASGOW_HASKELL__) -#include "config.h" -#endif -#if __GLASGOW_HASKELL__ >= 503 -import Data.Array -import Data.Array.Base (unsafeAt) -#else -import Array -#endif -#if __GLASGOW_HASKELL__ >= 503 -import GHC.Exts -#else -import GlaExts -#endif -alex_tab_size :: Int -alex_tab_size = 8 -alex_base :: AlexAddr -alex_base = AlexA# "\x12\xff\xff\xff\xf9\xff\xff\xff\xfb\xff\xff\xff\x01\x00\x00\x00\x2f\x00\x00\x00\x50\x00\x00\x00\xd0\x00\x00\x00\x48\xff\xff\xff\xdc\xff\xff\xff\x51\xff\xff\xff\x6d\xff\xff\xff\x6f\xff\xff\xff\x50\x01\x00\x00\x74\x01\x00\x00\x70\xff\xff\xff\x68\x00\x00\x00\x09\x00\x00\x00\x00\x00\x00\x00\x07\x00\x00\x00\xa3\x01\x00\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6a\x00\x00\x00\xd1\x01\x00\x00\xfb\x01\x00\x00\x7b\x02\x00\x00\xfb\x02\x00\x00\x00\x00\x00\x00\x7b\x03\x00\x00\x7d\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x00\x00\x6d\x00\x00\x00\x6b\x00\x00\x00\xfc\x03\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x6f\x00\x00\x00\x1c\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00"# - -alex_table :: AlexAddr -alex_table = AlexA# "\x00\x00\x09\x00\x0f\x00\x11\x00\x02\x00\x11\x00\x12\x00\x00\x00\x12\x00\x13\x00\x03\x00\x11\x00\x07\x00\x10\x00\x12\x00\x25\x00\x14\x00\x11\x00\x10\x00\x11\x00\x14\x00\x11\x00\x12\x00\x23\x00\x12\x00\x0f\x00\x28\x00\x02\x00\x2e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x08\x00\x10\x00\x00\x00\x14\x00\x00\x00\x00\x00\x08\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2a\x00\x2e\x00\xff\xff\xff\xff\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x28\x00\xff\xff\xff\xff\x29\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x0f\x00\x11\x00\x17\x00\x26\x00\x12\x00\x25\x00\x11\x00\x2a\x00\x00\x00\x12\x00\x00\x00\x15\x00\x00\x00\x16\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0f\x00\x00\x00\x17\x00\x26\x00\x00\x00\x25\x00\x00\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x00\x00\x2d\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x0e\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x17\x00\x23\x00\xff\xff\xff\xff\x24\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x17\x00\x1e\x00\x0d\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x00\x00\x1f\x00\x1f\x00\x1e\x00\x1e\x00\x1e\x00\x19\x00\x1a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x1f\x00\x1e\x00\x1f\x00\x1e\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x21\x00\x1e\x00\x22\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x1d\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x0c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1e\x00\xff\xff\x1e\x00\x1e\x00\x1e\x00\x1e\x00\xff\xff\xff\xff\xff\xff\x1e\x00\x1e\x00\x1e\x00\x18\x00\x1a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x1e\x00\xff\xff\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x1e\x00\xff\xff\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1e\x00\xff\xff\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x00\x00\xff\xff\xff\xff\x1e\x00\x1e\x00\x1e\x00\x1a\x00\x1a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x1e\x00\xff\xff\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x1e\x00\xff\xff\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x1c\x00\x1e\x00\x00\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x00\x00\x1e\x00\x00\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\xff\xff\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\xff\xff\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# - -alex_check :: AlexAddr -alex_check = AlexA# "\xff\xff\xef\x00\x09\x00\x0a\x00\x09\x00\x0a\x00\x0d\x00\xbf\x00\x0d\x00\x2d\x00\x09\x00\x0a\x00\xbb\x00\xa0\x00\x0d\x00\xa0\x00\xa0\x00\x0a\x00\x09\x00\x0a\x00\x09\x00\x0a\x00\x0d\x00\x0a\x00\x0d\x00\x20\x00\x0a\x00\x20\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\x2d\x00\x20\x00\xff\xff\x20\x00\xff\xff\xff\xff\x2d\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x09\x00\x0a\x00\x09\x00\x09\x00\x0d\x00\x09\x00\x0a\x00\x09\x00\xff\xff\x0d\x00\xff\xff\x7b\x00\xff\xff\x7d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x20\x00\x20\x00\xff\xff\x20\x00\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\x7d\x00\xff\xff\x7f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc2\x00\xff\xff\xc2\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc2\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc2\x00\xff\xff\xc2\x00\xff\xff\x7f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc2\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\xc2\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\xff\xff\x22\x00\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\xff\xff\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x5c\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x5c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\xff\xff\x7f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x7f\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5b\x00\x5c\x00\x5d\x00\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5b\x00\x5c\x00\x5d\x00\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5b\x00\x5c\x00\x5d\x00\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\xff\xff\x22\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\x7f\x00\x7e\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\x7d\x00\xff\xff\x7f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# - -alex_deflt :: AlexAddr -alex_deflt = AlexA# "\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x00\x27\x00\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x13\x00\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\x1b\x00\x1b\x00\x1b\x00\xff\xff\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\x2b\x00\xff\xff\xff\xff\xff\xff\xff\xff"# - -alex_accept = listArray (0::Int,47) [AlexAcc (alex_action_0),AlexAcc (alex_action_20),AlexAcc (alex_action_16),AlexAcc (alex_action_3),AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAcc (alex_action_1),AlexAcc (alex_action_1),AlexAccSkip,AlexAcc (alex_action_3),AlexAcc (alex_action_4),AlexAcc (alex_action_5),AlexAccSkip,AlexAccSkip,AlexAcc (alex_action_8),AlexAcc (alex_action_8),AlexAcc (alex_action_8),AlexAcc (alex_action_9),AlexAcc (alex_action_9),AlexAcc (alex_action_10),AlexAcc (alex_action_11),AlexAcc (alex_action_12),AlexAcc (alex_action_13),AlexAcc (alex_action_14),AlexAcc (alex_action_15),AlexAcc (alex_action_15),AlexAcc (alex_action_16),AlexAccSkip,AlexAcc (alex_action_18),AlexAcc (alex_action_19),AlexAcc (alex_action_19),AlexAccSkip,AlexAcc (alex_action_22),AlexAcc (alex_action_23),AlexAcc (alex_action_24),AlexAcc (alex_action_25),AlexAcc (alex_action_25)] -{-# LINE 151 "boot/Lexer.x" #-} - --- | Tokens of outer cabal file structure. Field values are treated opaquely. -data Token = TokSym !ByteString -- ^ Haskell-like identifier, number or operator - | TokStr !ByteString -- ^ String in quotes - | TokOther !ByteString -- ^ Operators and parens - | Indent !Int -- ^ Indentation token - | TokFieldLine !ByteString -- ^ Lines after @:@ - | Colon - | OpenBrace - | CloseBrace - | EOF - | LexicalError InputStream --TODO: add separate string lexical error - deriving Show - -data LToken = L !Position !Token - deriving Show - -toki :: (ByteString -> Token) -> Position -> Int -> ByteString -> Lex LToken -toki t pos len input = return $! L pos (t (B.take len input)) - -tok :: Token -> Position -> Int -> ByteString -> Lex LToken -tok t pos _len _input = return $! L pos t - -checkLeadingWhitespace :: Int -> ByteString -> Lex Int -checkLeadingWhitespace len bs - | B.any (== 9) (B.take len bs) = do - addWarning LexWarningTab - checkWhitespace len bs - | otherwise = checkWhitespace len bs - -checkWhitespace :: Int -> ByteString -> Lex Int -checkWhitespace len bs - | B.any (== 194) (B.take len bs) = do - addWarning LexWarningNBSP - return $ len - B.count 194 (B.take len bs) - | otherwise = return len - --- ----------------------------------------------------------------------------- --- The input type - -type AlexInput = InputStream - -alexInputPrevChar :: AlexInput -> Char -alexInputPrevChar _ = error "alexInputPrevChar not used" - -alexGetByte :: AlexInput -> Maybe (Word.Word8,AlexInput) -alexGetByte = B.uncons - -lexicalError :: Position -> InputStream -> Lex LToken -lexicalError pos inp = do - setInput B.empty - return $! L pos (LexicalError inp) - -lexToken :: Lex LToken -lexToken = do - pos <- getPos - inp <- getInput - st <- getStartCode - case alexScan inp st of - AlexEOF -> return (L pos EOF) - AlexError inp' -> - let !len_bytes = B.length inp - B.length inp' in - --FIXME: we want len_chars here really - -- need to decode utf8 up to this point - lexicalError (incPos len_bytes pos) inp' - AlexSkip inp' len_chars -> do - checkPosition pos inp inp' len_chars - adjustPos (incPos len_chars) - setInput inp' - lexToken - AlexToken inp' len_chars action -> do - checkPosition pos inp inp' len_chars - adjustPos (incPos len_chars) - setInput inp' - let !len_bytes = B.length inp - B.length inp' - t <- action pos len_bytes inp - --traceShow t $ return tok - return t - -checkPosition :: Position -> ByteString -> ByteString -> Int -> Lex () -#ifdef CABAL_PARSEC_DEBUG -checkPosition pos@(Position lineno colno) inp inp' len_chars = do - text_lines <- getDbgText - let len_bytes = B.length inp - B.length inp' - pos_txt | lineno-1 < V.length text_lines = T.take len_chars (T.drop (colno-1) (text_lines V.! (lineno-1))) - | otherwise = T.empty - real_txt = B.take len_bytes inp - when (pos_txt /= T.decodeUtf8 real_txt) $ - traceShow (pos, pos_txt, T.decodeUtf8 real_txt) $ - traceShow (take 3 (V.toList text_lines)) $ return () - where - getDbgText = Lex $ \s@LexState{ dbgText = txt } -> LexResult s txt -#else -checkPosition _ _ _ _ = return () -#endif - -lexAll :: Lex [LToken] -lexAll = do - t <- lexToken - case t of - L _ EOF -> return [t] - _ -> do ts <- lexAll - return (t : ts) - -ltest :: Int -> String -> Prelude.IO () -ltest code s = - let (ws, xs) = execLexer (setStartCode code >> lexAll) (B.Char8.pack s) - in traverse_ print ws >> traverse_ print xs - -mkLexState :: ByteString -> LexState -mkLexState input = LexState - { curPos = Position 1 1 - , curInput = input - , curCode = 0 - , warnings = [] -#ifdef CABAL_PARSEC_DEBUG - , dbgText = V.fromList . lines' . T.decodeUtf8With T.lenientDecode $ input -#endif - } - -#ifdef CABAL_PARSEC_DEBUG -lines' :: T.Text -> [T.Text] -lines' s1 - | T.null s1 = [] - | otherwise = case T.break (\c -> c == '\r' || c == '\n') s1 of - (l, s2) | Just (c,s3) <- T.uncons s2 - -> case T.uncons s3 of - Just ('\n', s4) | c == '\r' -> l `T.snoc` '\r' `T.snoc` '\n' : lines' s4 - _ -> l `T.snoc` c : lines' s3 - - | otherwise - -> [l] -#endif - -bol_field_braces,bol_field_layout,bol_section,in_field_braces,in_field_layout,in_section :: Int -bol_field_braces = 1 -bol_field_layout = 2 -bol_section = 3 -in_field_braces = 4 -in_field_layout = 5 -in_section = 6 -alex_action_0 = \_ len _ -> do - when (len /= 0) $ addWarning LexWarningBOM - setStartCode bol_section - lexToken - -alex_action_1 = \_pos len inp -> checkWhitespace len inp >> adjustPos retPos >> lexToken -alex_action_3 = \pos len inp -> checkLeadingWhitespace len inp >> - if B.length inp == len - then return (L pos EOF) - else setStartCode in_section - >> return (L pos (Indent len)) -alex_action_4 = tok OpenBrace -alex_action_5 = tok CloseBrace -alex_action_8 = toki TokSym -alex_action_9 = \pos len inp -> return $! L pos (TokStr (B.take (len - 2) (B.tail inp))) -alex_action_10 = toki TokOther -alex_action_11 = toki TokOther -alex_action_12 = tok Colon -alex_action_13 = tok OpenBrace -alex_action_14 = tok CloseBrace -alex_action_15 = \_ _ _ -> adjustPos retPos >> setStartCode bol_section >> lexToken -alex_action_16 = \pos len inp -> checkLeadingWhitespace len inp >>= \len' -> - if B.length inp == len - then return (L pos EOF) - else setStartCode in_field_layout - >> return (L pos (Indent len')) -alex_action_18 = toki TokFieldLine -alex_action_19 = \_ _ _ -> adjustPos retPos >> setStartCode bol_field_layout >> lexToken -alex_action_20 = \_ _ _ -> setStartCode in_field_braces >> lexToken -alex_action_22 = toki TokFieldLine -alex_action_23 = tok OpenBrace -alex_action_24 = tok CloseBrace -alex_action_25 = \_ _ _ -> adjustPos retPos >> setStartCode bol_field_braces >> lexToken -{-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} -{-# LINE 1 "" #-} -{-# LINE 10 "" #-} -# 1 "/usr/include/stdc-predef.h" 1 3 4 - -# 17 "/usr/include/stdc-predef.h" 3 4 - -{-# LINE 10 "" #-} -{-# LINE 1 "/opt/ghc/7.10.3/lib/ghc-7.10.3/include/ghcversion.h" #-} - -{-# LINE 10 "" #-} -{-# LINE 1 "templates/GenericTemplate.hs" #-} --- ----------------------------------------------------------------------------- --- ALEX TEMPLATE --- --- This code is in the PUBLIC DOMAIN; you may copy it freely and use --- it for any purpose whatsoever. - --- ----------------------------------------------------------------------------- --- INTERNALS and main scanner engine - -{-# LINE 21 "templates/GenericTemplate.hs" #-} - --- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. -#if __GLASGOW_HASKELL__ > 706 -#define GTE(n,m) (tagToEnum# (n >=# m)) -#define EQ(n,m) (tagToEnum# (n ==# m)) -#else -#define GTE(n,m) (n >=# m) -#define EQ(n,m) (n ==# m) -#endif -{-# LINE 51 "templates/GenericTemplate.hs" #-} - -data AlexAddr = AlexA# Addr# --- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. -#if __GLASGOW_HASKELL__ < 503 -uncheckedShiftL# = shiftL# -#endif - -{-# INLINE alexIndexInt16OffAddr #-} -alexIndexInt16OffAddr (AlexA# arr) off = -#ifdef WORDS_BIGENDIAN - narrow16Int# i - where - i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low) - high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) - low = int2Word# (ord# (indexCharOffAddr# arr off')) - off' = off *# 2# -#else - indexInt16OffAddr# arr off -#endif - -{-# INLINE alexIndexInt32OffAddr #-} -alexIndexInt32OffAddr (AlexA# arr) off = -#ifdef WORDS_BIGENDIAN - narrow32Int# i - where - i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#` - (b2 `uncheckedShiftL#` 16#) `or#` - (b1 `uncheckedShiftL#` 8#) `or#` b0) - b3 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#))) - b2 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#))) - b1 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) - b0 = int2Word# (ord# (indexCharOffAddr# arr off')) - off' = off *# 4# -#else - indexInt32OffAddr# arr off -#endif - -#if __GLASGOW_HASKELL__ < 503 -quickIndex arr i = arr ! i -#else --- GHC >= 503, unsafeAt is available from Data.Array.Base. -quickIndex = unsafeAt -#endif - --- ----------------------------------------------------------------------------- --- Main lexing routines - -data AlexReturn a - = AlexEOF - | AlexError !AlexInput - | AlexSkip !AlexInput !Int - | AlexToken !AlexInput !Int a - --- alexScan :: AlexInput -> StartCode -> AlexReturn a -alexScan input (I# (sc)) - = alexScanUser undefined input (I# (sc)) - -alexScanUser user input (I# (sc)) - = case alex_scan_tkn user input 0# input sc AlexNone of - (AlexNone, input') -> - case alexGetByte input of - Nothing -> - - AlexEOF - Just _ -> - - AlexError input' - - (AlexLastSkip input'' len, _) -> - - AlexSkip input'' len - - (AlexLastAcc k input''' len, _) -> - - AlexToken input''' len k - --- Push the input through the DFA, remembering the most recent accepting --- state it encountered. - -alex_scan_tkn user orig_input len input s last_acc = - input `seq` -- strict in the input - let - new_acc = (check_accs (alex_accept `quickIndex` (I# (s)))) - in - new_acc `seq` - case alexGetByte input of - Nothing -> (new_acc, input) - Just (c, new_input) -> - - case fromIntegral c of { (I# (ord_c)) -> - let - base = alexIndexInt32OffAddr alex_base s - offset = (base +# ord_c) - check = alexIndexInt16OffAddr alex_check offset - - new_s = if GTE(offset,0#) && EQ(check,ord_c) - then alexIndexInt16OffAddr alex_table offset - else alexIndexInt16OffAddr alex_deflt s - in - case new_s of - -1# -> (new_acc, input) - -- on an error, we want to keep the input *before* the - -- character that failed, not after. - _ -> alex_scan_tkn user orig_input (if c < 0x80 || c >= 0xC0 then (len +# 1#) else len) - -- note that the length is increased ONLY if this is the 1st byte in a char encoding) - new_input new_s new_acc - } - where - check_accs (AlexAccNone) = last_acc - check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) - check_accs (AlexAccSkip) = AlexLastSkip input (I# (len)) -{-# LINE 198 "templates/GenericTemplate.hs" #-} - -data AlexLastAcc a - = AlexNone - | AlexLastAcc a !AlexInput !Int - | AlexLastSkip !AlexInput !Int - -instance Functor AlexLastAcc where - fmap _ AlexNone = AlexNone - fmap f (AlexLastAcc x y z) = AlexLastAcc (f x) y z - fmap _ (AlexLastSkip x y) = AlexLastSkip x y - -data AlexAcc a user - = AlexAccNone - | AlexAcc a - | AlexAccSkip diff --git a/cabal/Cabal/Distribution/Parsec/LexerMonad.hs b/cabal/Cabal/Distribution/Parsec/LexerMonad.hs deleted file mode 100644 --- a/cabal/Cabal/Distribution/Parsec/LexerMonad.hs +++ /dev/null @@ -1,153 +0,0 @@ -{-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ --- | --- Module : Distribution.Parsec.LexerMonad --- License : BSD3 --- --- Maintainer : cabal-devel@haskell.org --- Portability : portable -module Distribution.Parsec.LexerMonad ( - InputStream, - LexState(..), - LexResult(..), - - Lex(..), - execLexer, - - getPos, - setPos, - adjustPos, - - getInput, - setInput, - - getStartCode, - setStartCode, - - LexWarning(..), - LexWarningType(..), - addWarning, - toPWarnings, - - ) where - -import qualified Data.ByteString as B -import Distribution.Compat.Prelude -import Distribution.Parsec.Common (PWarnType (..), PWarning (..), Position (..), showPos) -import Prelude () - -import qualified Data.Map.Strict as Map - -#ifdef CABAL_PARSEC_DEBUG --- testing only: -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Data.Vector as V -#endif - --- simple state monad -newtype Lex a = Lex { unLex :: LexState -> LexResult a } - -instance Functor Lex where - fmap = liftM - -instance Applicative Lex where - pure = returnLex - (<*>) = ap - -instance Monad Lex where - return = pure - (>>=) = thenLex - -data LexResult a = LexResult {-# UNPACK #-} !LexState a - -data LexWarningType - = LexWarningNBSP -- ^ Encountered non breaking space - | LexWarningBOM -- ^ BOM at the start of the cabal file - | LexWarningTab -- ^ Leading tags - deriving (Eq, Ord, Show) - -data LexWarning = LexWarning !LexWarningType - {-# UNPACK #-} !Position - deriving (Show) - -toPWarnings :: [LexWarning] -> [PWarning] -toPWarnings - = map (uncurry toWarning) - . Map.toList - . Map.fromListWith (++) - . map (\(LexWarning t p) -> (t, [p])) - where - toWarning LexWarningBOM poss = - PWarning PWTLexBOM (head poss) "Byte-order mark found at the beginning of the file" - toWarning LexWarningNBSP poss = - PWarning PWTLexNBSP (head poss) $ "Non breaking spaces at " ++ intercalate ", " (map showPos poss) - toWarning LexWarningTab poss = - PWarning PWTLexTab (head poss) $ "Tabs used as indentation at " ++ intercalate ", " (map showPos poss) - -data LexState = LexState { - curPos :: {-# UNPACK #-} !Position, -- ^ position at current input location - curInput :: {-# UNPACK #-} !InputStream, -- ^ the current input - curCode :: {-# UNPACK #-} !StartCode, -- ^ lexer code - warnings :: [LexWarning] -#ifdef CABAL_PARSEC_DEBUG - , dbgText :: V.Vector T.Text -- ^ input lines, to print pretty debug info -#endif - } --TODO: check if we should cache the first token - -- since it looks like parsec's uncons can be called many times on the same input - -type StartCode = Int -- ^ An @alex@ lexer start code -type InputStream = B.ByteString - - - --- | Execute the given lexer on the supplied input stream. -execLexer :: Lex a -> InputStream -> ([LexWarning], a) -execLexer (Lex lexer) input = - case lexer initialState of - LexResult LexState{ warnings = ws } result -> (ws, result) - where - initialState = LexState - -- TODO: add 'startPosition' - { curPos = Position 1 1 - , curInput = input - , curCode = 0 - , warnings = [] -#ifdef CABAL_PARSEC_DEBUG - , dbgText = V.fromList . T.lines . T.decodeUtf8 $ input -#endif - } - -{-# INLINE returnLex #-} -returnLex :: a -> Lex a -returnLex a = Lex $ \s -> LexResult s a - -{-# INLINE thenLex #-} -thenLex :: Lex a -> (a -> Lex b) -> Lex b -(Lex m) `thenLex` k = Lex $ \s -> case m s of LexResult s' a -> (unLex (k a)) s' - -setPos :: Position -> Lex () -setPos pos = Lex $ \s -> LexResult s{ curPos = pos } () - -getPos :: Lex Position -getPos = Lex $ \s@LexState{ curPos = pos } -> LexResult s pos - -adjustPos :: (Position -> Position) -> Lex () -adjustPos f = Lex $ \s@LexState{ curPos = pos } -> LexResult s{ curPos = f pos } () - -getInput :: Lex InputStream -getInput = Lex $ \s@LexState{ curInput = i } -> LexResult s i - -setInput :: InputStream -> Lex () -setInput i = Lex $ \s -> LexResult s{ curInput = i } () - -getStartCode :: Lex Int -getStartCode = Lex $ \s@LexState{ curCode = c } -> LexResult s c - -setStartCode :: Int -> Lex () -setStartCode c = Lex $ \s -> LexResult s{ curCode = c } () - --- | Add warning at the current position -addWarning :: LexWarningType -> Lex () -addWarning wt = Lex $ \s@LexState{ curPos = pos, warnings = ws } -> - LexResult s{ warnings = LexWarning wt pos : ws } () diff --git a/cabal/Cabal/Distribution/Parsec/Newtypes.hs b/cabal/Cabal/Distribution/Parsec/Newtypes.hs --- a/cabal/Cabal/Distribution/Parsec/Newtypes.hs +++ b/cabal/Cabal/Distribution/Parsec/Newtypes.hs @@ -15,6 +15,7 @@ VCat (..), FSep (..), NoCommaFSep (..), + Sep (..), -- ** Type List, -- * Version & License @@ -25,7 +26,6 @@ Token (..), Token' (..), MQuoted (..), - FreeText (..), FilePathNT (..), ) where @@ -34,11 +34,10 @@ import Prelude () import Data.Functor.Identity (Identity (..)) -import Data.List (dropWhileEnd) import Distribution.CabalSpecVersion import Distribution.Compiler (CompilerFlavor) import Distribution.License (License) -import Distribution.Parsec.Class +import Distribution.Parsec import Distribution.Pretty import Distribution.Version (LowerBound (..), Version, VersionRange, anyVersion, asVersionIntervals, mkVersion) @@ -82,17 +81,21 @@ if v >= CabalSpecV2_2 then parsecLeadingCommaList p else parsecCommaList p instance Sep VCat where prettySep _ = vcat - parseSep _ = parsecOptCommaList + parseSep _ p = do + v <- askCabalSpecVersion + if v >= CabalSpecV3_0 then parsecLeadingOptCommaList p else parsecOptCommaList p instance Sep FSep where prettySep _ = fsep - parseSep _ = parsecOptCommaList + parseSep _ p = do + v <- askCabalSpecVersion + if v >= CabalSpecV3_0 then parsecLeadingOptCommaList p else parsecOptCommaList p instance Sep NoCommaFSep where prettySep _ = fsep parseSep _ p = many (p <* P.spaces) -- | List separated with optional commas. Displayed with @sep@, arguments of -- type @a@ are parsed and pretty-printed as @b@. -newtype List sep b a = List { getList :: [a] } +newtype List sep b a = List { _getList :: [a] } -- | 'alaList' and 'alaList'' are simply 'List', with additional phantom -- arguments to constraint the resulting type @@ -110,22 +113,18 @@ alaList' :: sep -> (a -> b) -> [a] -> List sep b a alaList' _ _ = List -instance Newtype (List sep wrapper a) [a] where - pack = List - unpack = getList +instance Newtype [a] (List sep wrapper a) -instance (Newtype b a, Sep sep, Parsec b) => Parsec (List sep b a) where +instance (Newtype a b, Sep sep, Parsec b) => Parsec (List sep b a) where parsec = pack . map (unpack :: b -> a) <$> parseSep (P :: P sep) parsec -instance (Newtype b a, Sep sep, Pretty b) => Pretty (List sep b a) where +instance (Newtype a b, Sep sep, Pretty b) => Pretty (List sep b a) where pretty = prettySep (P :: P sep) . map (pretty . (pack :: a -> b)) . unpack -- | Haskell string or @[^ ,]+@ newtype Token = Token { getToken :: String } -instance Newtype Token String where - pack = Token - unpack = getToken +instance Newtype String Token instance Parsec Token where parsec = pack <$> parsecToken @@ -136,9 +135,7 @@ -- | Haskell string or @[^ ]+@ newtype Token' = Token' { getToken' :: String } -instance Newtype Token' String where - pack = Token' - unpack = getToken' +instance Newtype String Token' instance Parsec Token' where parsec = pack <$> parsecToken' @@ -149,9 +146,7 @@ -- | Either @"quoted"@ or @un-quoted@. newtype MQuoted a = MQuoted { getMQuoted :: a } -instance Newtype (MQuoted a) a where - pack = MQuoted - unpack = getMQuoted +instance Newtype a (MQuoted a) instance Parsec a => Parsec (MQuoted a) where parsec = pack <$> parsecMaybeQuoted parsec @@ -170,9 +165,7 @@ -- newtype SpecVersion = SpecVersion { getSpecVersion :: Either Version VersionRange } -instance Newtype SpecVersion (Either Version VersionRange) where - pack = SpecVersion - unpack = getSpecVersion +instance Newtype (Either Version VersionRange) SpecVersion instance Parsec SpecVersion where parsec = pack <$> parsecSpecVersion @@ -195,9 +188,7 @@ -- | SPDX License expression or legacy license newtype SpecLicense = SpecLicense { getSpecLicense :: Either SPDX.License License } -instance Newtype SpecLicense (Either SPDX.License License) where - pack = SpecLicense - unpack = getSpecLicense +instance Newtype (Either SPDX.License License) SpecLicense instance Parsec SpecLicense where parsec = do @@ -212,9 +203,7 @@ -- | Version range or just version newtype TestedWith = TestedWith { getTestedWith :: (CompilerFlavor, VersionRange) } -instance Newtype TestedWith (CompilerFlavor, VersionRange) where - pack = TestedWith - unpack = getTestedWith +instance Newtype (CompilerFlavor, VersionRange) TestedWith instance Parsec TestedWith where parsec = pack <$> parsecTestedWith @@ -223,43 +212,10 @@ pretty x = case unpack x of (compiler, vr) -> pretty compiler <+> pretty vr --- | This is /almost/ @'many' 'Distribution.Compat.P.anyChar'@, but it --- --- * trims whitespace from ends of the lines, --- --- * converts lines with only single dot into empty line. --- -newtype FreeText = FreeText { getFreeText :: String } - -instance Newtype FreeText String where - pack = FreeText - unpack = getFreeText - -instance Parsec FreeText where - parsec = pack . dropDotLines <$ P.spaces <*> many P.anyChar - where - -- Example package with dot lines - -- http://hackage.haskell.org/package/copilot-cbmc-0.1/copilot-cbmc.cabal - dropDotLines "." = "." - dropDotLines x = intercalate "\n" . map dotToEmpty . lines $ x - dotToEmpty x | trim' x == "." = "" - dotToEmpty x = trim x - - trim' :: String -> String - trim' = dropWhileEnd (`elem` (" \t" :: String)) - - trim :: String -> String - trim = dropWhile isSpace . dropWhileEnd isSpace - -instance Pretty FreeText where - pretty = showFreeText . unpack - -- | Filepath are parsed as 'Token'. newtype FilePathNT = FilePathNT { getFilePathNT :: String } -instance Newtype FilePathNT String where - pack = FilePathNT - unpack = getFilePathNT +instance Newtype String FilePathNT instance Parsec FilePathNT where parsec = pack <$> parsecToken diff --git a/cabal/Cabal/Distribution/Parsec/ParseResult.hs b/cabal/Cabal/Distribution/Parsec/ParseResult.hs deleted file mode 100644 --- a/cabal/Cabal/Distribution/Parsec/ParseResult.hs +++ /dev/null @@ -1,184 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE RankNTypes #-} --- | A parse result type for parsers from AST to Haskell types. -module Distribution.Parsec.ParseResult ( - ParseResult, - runParseResult, - recoverWith, - parseWarning, - parseWarnings, - parseFailure, - parseFatalFailure, - parseFatalFailure', - getCabalSpecVersion, - setCabalSpecVersion, - readAndParseFile, - parseString - ) where - -import qualified Data.ByteString.Char8 as BS -import Distribution.Compat.Prelude -import Distribution.Parsec.Common - ( PError (..), PWarnType (..), PWarning (..), Position (..), zeroPos - , showPWarning, showPError) -import Distribution.Simple.Utils (die', warn) -import Distribution.Verbosity (Verbosity) -import Distribution.Version (Version) -import Prelude () -import System.Directory (doesFileExist) - -#if MIN_VERSION_base(4,10,0) -import Control.Applicative (Applicative (..)) -#endif - --- | A monad with failure and accumulating errors and warnings. -newtype ParseResult a = PR - { unPR - :: forall r. PRState - -> (PRState -> r) -- failure, but we were able to recover a new-style spec-version declaration - -> (PRState -> a -> r) -- success - -> r - } - -data PRState = PRState ![PWarning] ![PError] !(Maybe Version) - -emptyPRState :: PRState -emptyPRState = PRState [] [] Nothing - --- | Destruct a 'ParseResult' into the emitted warnings and either --- a successful value or --- list of errors and possibly recovered a spec-version declaration. -runParseResult :: ParseResult a -> ([PWarning], Either (Maybe Version, [PError]) a) -runParseResult pr = unPR pr emptyPRState failure success - where - failure (PRState warns errs v) = (warns, Left (v, errs)) - success (PRState warns [] _) x = (warns, Right x) - -- If there are any errors, don't return the result - success (PRState warns errs v) _ = (warns, Left (v, errs)) - -instance Functor ParseResult where - fmap f (PR pr) = PR $ \ !s failure success -> - pr s failure $ \ !s' a -> - success s' (f a) - {-# INLINE fmap #-} - -instance Applicative ParseResult where - pure x = PR $ \ !s _ success -> success s x - {-# INLINE pure #-} - - f <*> x = PR $ \ !s0 failure success -> - unPR f s0 failure $ \ !s1 f' -> - unPR x s1 failure $ \ !s2 x' -> - success s2 (f' x') - {-# INLINE (<*>) #-} - - x *> y = PR $ \ !s0 failure success -> - unPR x s0 failure $ \ !s1 _ -> - unPR y s1 failure success - {-# INLINE (*>) #-} - - x <* y = PR $ \ !s0 failure success -> - unPR x s0 failure $ \ !s1 x' -> - unPR y s1 failure $ \ !s2 _ -> - success s2 x' - {-# INLINE (<*) #-} - -#if MIN_VERSION_base(4,10,0) - liftA2 f x y = PR $ \ !s0 failure success -> - unPR x s0 failure $ \ !s1 x' -> - unPR y s1 failure $ \ !s2 y' -> - success s2 (f x' y') - {-# INLINE liftA2 #-} -#endif - -instance Monad ParseResult where - return = pure - (>>) = (*>) - - m >>= k = PR $ \ !s failure success -> - unPR m s failure $ \ !s' a -> - unPR (k a) s' failure success - {-# INLINE (>>=) #-} - --- | "Recover" the parse result, so we can proceed parsing. --- 'runParseResult' will still result in 'Nothing', if there are recorded errors. -recoverWith :: ParseResult a -> a -> ParseResult a -recoverWith (PR pr) x = PR $ \ !s _failure success -> - pr s (\ !s' -> success s' x) success - --- | Set cabal spec version. -setCabalSpecVersion :: Maybe Version -> ParseResult () -setCabalSpecVersion v = PR $ \(PRState warns errs _) _failure success -> - success (PRState warns errs v) () - --- | Get cabal spec version. -getCabalSpecVersion :: ParseResult (Maybe Version) -getCabalSpecVersion = PR $ \s@(PRState _ _ v) _failure success -> - success s v - --- | Add a warning. This doesn't fail the parsing process. -parseWarning :: Position -> PWarnType -> String -> ParseResult () -parseWarning pos t msg = PR $ \(PRState warns errs v) _failure success -> - success (PRState (PWarning t pos msg : warns) errs v) () - --- | Add multiple warnings at once. -parseWarnings :: [PWarning] -> ParseResult () -parseWarnings newWarns = PR $ \(PRState warns errs v) _failure success -> - success (PRState (newWarns ++ warns) errs v) () - --- | Add an error, but not fail the parser yet. --- --- For fatal failure use 'parseFatalFailure' -parseFailure :: Position -> String -> ParseResult () -parseFailure pos msg = PR $ \(PRState warns errs v) _failure success -> - success (PRState warns (PError pos msg : errs) v) () - --- | Add an fatal error. -parseFatalFailure :: Position -> String -> ParseResult a -parseFatalFailure pos msg = PR $ \(PRState warns errs v) failure _success -> - failure (PRState warns (PError pos msg : errs) v) - --- | A 'mzero'. -parseFatalFailure' :: ParseResult a -parseFatalFailure' = PR pr - where - pr (PRState warns [] v) failure _success = failure (PRState warns [err] v) - pr s failure _success = failure s - - err = PError zeroPos "Unknown fatal error" - --- | Helper combinator to do parsing plumbing for files. --- --- Given a parser and a filename, return the parse of the file, --- after checking if the file exists. --- --- Argument order is chosen to encourage partial application. -readAndParseFile - :: (BS.ByteString -> ParseResult a) -- ^ File contents to final value parser - -> Verbosity -- ^ Verbosity level - -> FilePath -- ^ File to read - -> IO a -readAndParseFile parser verbosity fpath = do - exists <- doesFileExist fpath - unless exists $ - die' verbosity $ - "Error Parsing: file \"" ++ fpath ++ "\" doesn't exist. Cannot continue." - bs <- BS.readFile fpath - parseString parser verbosity fpath bs - -parseString - :: (BS.ByteString -> ParseResult a) -- ^ File contents to final value parser - -> Verbosity -- ^ Verbosity level - -> String -- ^ File name - -> BS.ByteString - -> IO a -parseString parser verbosity name bs = do - let (warnings, result) = runParseResult (parser bs) - traverse_ (warn verbosity . showPWarning name) warnings - case result of - Right x -> return x - Left (_, errors) -> do - traverse_ (warn verbosity . showPError name) errors - die' verbosity $ "Failed parsing \"" ++ name ++ "\"." diff --git a/cabal/Cabal/Distribution/Parsec/Parser.hs b/cabal/Cabal/Distribution/Parsec/Parser.hs deleted file mode 100644 --- a/cabal/Cabal/Distribution/Parsec/Parser.hs +++ /dev/null @@ -1,378 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternGuards #-} ------------------------------------------------------------------------------ --- | --- Module : Distribution.Parsec.Parser --- License : BSD3 --- --- Maintainer : cabal-devel@haskell.org --- Portability : portable -module Distribution.Parsec.Parser ( - -- * Types - Field(..), - Name(..), - FieldLine(..), - SectionArg(..), - -- * Grammar and parsing - -- $grammar - readFields, - readFields', -#ifdef CABAL_PARSEC_DEBUG - -- * Internal - parseFile, - parseStr, - parseBS, -#endif - ) where - -import Control.Monad (guard) -import qualified Data.ByteString.Char8 as B8 -import Data.Functor.Identity -import Distribution.Compat.Prelude -import Distribution.Parsec.Common -import Distribution.Parsec.Field -import Distribution.Parsec.Lexer -import Distribution.Parsec.LexerMonad - (LexResult (..), LexState (..), LexWarning (..), unLex) -import Prelude () -import Text.Parsec.Combinator hiding (eof, notFollowedBy) -import Text.Parsec.Error -import Text.Parsec.Pos -import Text.Parsec.Prim hiding (many, (<|>)) - -#ifdef CABAL_PARSEC_DEBUG -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Data.Text.Encoding.Error as T -#endif - --- | The 'LexState'' (with a prime) is an instance of parsec's 'Stream' --- wrapped around lexer's 'LexState' (without a prime) -data LexState' = LexState' !LexState (LToken, LexState') - -mkLexState' :: LexState -> LexState' -mkLexState' st = LexState' st - (case unLex lexToken st of LexResult st' tok -> (tok, mkLexState' st')) - -type Parser a = ParsecT LexState' () Identity a - -instance Stream LexState' Identity LToken where - uncons (LexState' _ (tok, st')) = - case tok of - L _ EOF -> return Nothing - _ -> return (Just (tok, st')) - --- | Get lexer warnings accumulated so far -getLexerWarnings :: Parser [LexWarning] -getLexerWarnings = do - LexState' (LexState { warnings = ws }) _ <- getInput - return ws - --- | Set Alex code i.e. the mode "state" lexer is in. -setLexerMode :: Int -> Parser () -setLexerMode code = do - LexState' ls _ <- getInput - setInput $! mkLexState' ls { curCode = code } - -getToken :: (Token -> Maybe a) -> Parser a -getToken getTok = getTokenWithPos (\(L _ t) -> getTok t) - -getTokenWithPos :: (LToken -> Maybe a) -> Parser a -getTokenWithPos getTok = tokenPrim (\(L _ t) -> describeToken t) updatePos getTok - where - updatePos :: SourcePos -> LToken -> LexState' -> SourcePos - updatePos pos (L (Position col line) _) _ = newPos (sourceName pos) col line - -describeToken :: Token -> String -describeToken t = case t of - TokSym s -> "symbol " ++ show s - TokStr s -> "string " ++ show s - TokOther s -> "operator " ++ show s - Indent _ -> "new line" - TokFieldLine _ -> "field content" - Colon -> "\":\"" - OpenBrace -> "\"{\"" - CloseBrace -> "\"}\"" --- SemiColon -> "\";\"" - EOF -> "end of file" - LexicalError is -> "character in input " ++ show (B8.head is) - -tokSym :: Parser (Name Position) -tokSym', tokStr, tokOther :: Parser (SectionArg Position) -tokIndent :: Parser Int -tokColon, tokOpenBrace, tokCloseBrace :: Parser () -tokFieldLine :: Parser (FieldLine Position) - -tokSym = getTokenWithPos $ \t -> case t of L pos (TokSym x) -> Just (mkName pos x); _ -> Nothing -tokSym' = getTokenWithPos $ \t -> case t of L pos (TokSym x) -> Just (SecArgName pos x); _ -> Nothing -tokStr = getTokenWithPos $ \t -> case t of L pos (TokStr x) -> Just (SecArgStr pos x); _ -> Nothing -tokOther = getTokenWithPos $ \t -> case t of L pos (TokOther x) -> Just (SecArgOther pos x); _ -> Nothing -tokIndent = getToken $ \t -> case t of Indent x -> Just x; _ -> Nothing -tokColon = getToken $ \t -> case t of Colon -> Just (); _ -> Nothing -tokOpenBrace = getToken $ \t -> case t of OpenBrace -> Just (); _ -> Nothing -tokCloseBrace = getToken $ \t -> case t of CloseBrace -> Just (); _ -> Nothing -tokFieldLine = getTokenWithPos $ \t -> case t of L pos (TokFieldLine s) -> Just (FieldLine pos s); _ -> Nothing - -colon, openBrace, closeBrace :: Parser () - -sectionArg :: Parser (SectionArg Position) -sectionArg = tokSym' <|> tokStr <|> tokOther "section parameter" - -fieldSecName :: Parser (Name Position) -fieldSecName = tokSym "field or section name" - -colon = tokColon "\":\"" -openBrace = tokOpenBrace "\"{\"" -closeBrace = tokCloseBrace "\"}\"" - -fieldContent :: Parser (FieldLine Position) -fieldContent = tokFieldLine "field contents" - -newtype IndentLevel = IndentLevel Int - -zeroIndentLevel :: IndentLevel -zeroIndentLevel = IndentLevel 0 - -incIndentLevel :: IndentLevel -> IndentLevel -incIndentLevel (IndentLevel i) = IndentLevel (succ i) - -indentOfAtLeast :: IndentLevel -> Parser IndentLevel -indentOfAtLeast (IndentLevel i) = try $ do - j <- tokIndent - guard (j >= i) "indentation of at least " ++ show i - return (IndentLevel j) - - -newtype LexerMode = LexerMode Int - -inLexerMode :: LexerMode -> Parser p -> Parser p -inLexerMode (LexerMode mode) p = - do setLexerMode mode; x <- p; setLexerMode in_section; return x - - ------------------------ --- Cabal file grammar --- - --- $grammar --- --- @ --- CabalStyleFile ::= SecElems --- --- SecElems ::= SecElem* '\n'? --- SecElem ::= '\n' SecElemLayout | SecElemBraces --- SecElemLayout ::= FieldLayout | FieldBraces | SectionLayout | SectionBraces --- SecElemBraces ::= FieldInline | FieldBraces | SectionBraces --- FieldLayout ::= name ':' line? ('\n' line)* --- FieldBraces ::= name ':' '\n'? '{' content '}' --- FieldInline ::= name ':' content --- SectionLayout ::= name arg* SecElems --- SectionBraces ::= name arg* '\n'? '{' SecElems '}' --- @ --- --- and the same thing but left factored... --- --- @ --- SecElems ::= SecElem* --- SecElem ::= '\n' name SecElemLayout --- | name SecElemBraces --- SecElemLayout ::= ':' FieldLayoutOrBraces --- | arg* SectionLayoutOrBraces --- FieldLayoutOrBraces ::= '\n'? '{' content '}' --- | line? ('\n' line)* --- SectionLayoutOrBraces ::= '\n'? '{' SecElems '\n'? '}' --- | SecElems --- SecElemBraces ::= ':' FieldInlineOrBraces --- | arg* '\n'? '{' SecElems '\n'? '}' --- FieldInlineOrBraces ::= '\n'? '{' content '}' --- | content --- @ --- --- Note how we have several productions with the sequence: --- --- > '\n'? '{' --- --- That is, an optional newline (and indent) followed by a @{@ token. --- In the @SectionLayoutOrBraces@ case you can see that this makes it --- not fully left factored (because @SecElems@ can start with a @\n@). --- Fully left factoring here would be ugly, and though we could use a --- lookahead of two tokens to resolve the alternatives, we can't --- conveniently use Parsec's 'try' here to get a lookahead of only two. --- So instead we deal with this case in the lexer by making a line --- where the first non-space is @{@ lex as just the @{@ token, without --- the usual indent token. Then in the parser we can resolve everything --- with just one token of lookahead and so without using 'try'. - --- Top level of a file using cabal syntax --- -cabalStyleFile :: Parser [Field Position] -cabalStyleFile = do es <- elements zeroIndentLevel - eof - return es - --- Elements that live at the top level or inside a section, ie fields --- and sectionscontent --- --- elements ::= element* -elements :: IndentLevel -> Parser [Field Position] -elements ilevel = many (element ilevel) - --- An individual element, ie a field or a section. These can either use --- layout style or braces style. For layout style then it must start on --- a line on its own (so that we know its indentation level). --- --- element ::= '\n' name elementInLayoutContext --- | name elementInNonLayoutContext -element :: IndentLevel -> Parser (Field Position) -element ilevel = - (do ilevel' <- indentOfAtLeast ilevel - name <- fieldSecName - elementInLayoutContext (incIndentLevel ilevel') name) - <|> (do name <- fieldSecName - elementInNonLayoutContext name) - --- An element (field or section) that is valid in a layout context. --- In a layout context we can have fields and sections that themselves --- either use layout style or that use braces style. --- --- elementInLayoutContext ::= ':' fieldLayoutOrBraces --- | arg* sectionLayoutOrBraces -elementInLayoutContext :: IndentLevel -> Name Position -> Parser (Field Position) -elementInLayoutContext ilevel name = - (do colon; fieldLayoutOrBraces ilevel name) - <|> (do args <- many sectionArg - elems <- sectionLayoutOrBraces ilevel - return (Section name args elems)) - --- An element (field or section) that is valid in a non-layout context. --- In a non-layout context we can have only have fields and sections that --- themselves use braces style, or inline style fields. --- --- elementInNonLayoutContext ::= ':' FieldInlineOrBraces --- | arg* '\n'? '{' elements '\n'? '}' -elementInNonLayoutContext :: Name Position -> Parser (Field Position) -elementInNonLayoutContext name = - (do colon; fieldInlineOrBraces name) - <|> (do args <- many sectionArg - openBrace - elems <- elements zeroIndentLevel - optional tokIndent - closeBrace - return (Section name args elems)) - --- The body of a field, using either layout style or braces style. --- --- fieldLayoutOrBraces ::= '\n'? '{' content '}' --- | line? ('\n' line)* -fieldLayoutOrBraces :: IndentLevel -> Name Position -> Parser (Field Position) -fieldLayoutOrBraces ilevel name = braces <|> fieldLayout - where - braces = do - openBrace - ls <- inLexerMode (LexerMode in_field_braces) (many fieldContent) - closeBrace - return (Field name ls) - fieldLayout = inLexerMode (LexerMode in_field_layout) $ do - l <- optionMaybe fieldContent - ls <- many (do _ <- indentOfAtLeast ilevel; fieldContent) - return $ case l of - Nothing -> Field name ls - Just l' -> Field name (l' : ls) - --- The body of a section, using either layout style or braces style. --- --- sectionLayoutOrBraces ::= '\n'? '{' elements \n? '}' --- | elements -sectionLayoutOrBraces :: IndentLevel -> Parser [Field Position] -sectionLayoutOrBraces ilevel = - (do openBrace - elems <- elements zeroIndentLevel - optional tokIndent - closeBrace - return elems) - <|> (elements ilevel) - --- The body of a field, using either inline style or braces. --- --- fieldInlineOrBraces ::= '\n'? '{' content '}' --- | content -fieldInlineOrBraces :: Name Position -> Parser (Field Position) -fieldInlineOrBraces name = - (do openBrace - ls <- inLexerMode (LexerMode in_field_braces) (many fieldContent) - closeBrace - return (Field name ls)) - <|> (do ls <- inLexerMode (LexerMode in_field_braces) (option [] (fmap (\l -> [l]) fieldContent)) - return (Field name ls)) - - --- | Parse cabal style 'B8.ByteString' into list of 'Field's, i.e. the cabal AST. -readFields :: B8.ByteString -> Either ParseError [Field Position] -readFields s = fmap fst (readFields' s) - --- | Like 'readFields' but also return lexer warnings -readFields' :: B8.ByteString -> Either ParseError ([Field Position], [LexWarning]) -readFields' s = do - parse parser "the input" lexSt - where - parser = do - fields <- cabalStyleFile - ws <- getLexerWarnings - pure (fields, ws) - - lexSt = mkLexState' (mkLexState s) - -#ifdef CABAL_PARSEC_DEBUG -parseTest' :: Show a => Parsec LexState' () a -> SourceName -> B8.ByteString -> IO () -parseTest' p fname s = - case parse p fname (lexSt s) of - Left err -> putStrLn (formatError s err) - - Right x -> print x - where - lexSt = mkLexState' . mkLexState - -parseFile :: Show a => Parser a -> FilePath -> IO () -parseFile p f = B8.readFile f >>= \s -> parseTest' p f s - -parseStr :: Show a => Parser a -> String -> IO () -parseStr p = parseBS p . B8.pack - -parseBS :: Show a => Parser a -> B8.ByteString -> IO () -parseBS p = parseTest' p "" - -formatError :: B8.ByteString -> ParseError -> String -formatError input perr = - unlines - [ "Parse error "++ show (errorPos perr) ++ ":" - , errLine - , indicator ++ errmsg ] - where - pos = errorPos perr - ls = lines' (T.decodeUtf8With T.lenientDecode input) - errLine = T.unpack (ls !! (sourceLine pos - 1)) - indicator = replicate (sourceColumn pos) ' ' ++ "^" - errmsg = showErrorMessages "or" "unknown parse error" - "expecting" "unexpected" "end of file" - (errorMessages perr) - --- | Handles windows/osx/unix line breaks uniformly -lines' :: T.Text -> [T.Text] -lines' s1 - | T.null s1 = [] - | otherwise = case T.break (\c -> c == '\r' || c == '\n') s1 of - (l, s2) | Just (c,s3) <- T.uncons s2 - -> case T.uncons s3 of - Just ('\n', s4) | c == '\r' -> l : lines' s4 - _ -> l : lines' s3 - | otherwise -> [l] -#endif - -eof :: Parser () -eof = notFollowedBy anyToken "end of file" - where - notFollowedBy :: Parser LToken -> Parser () - notFollowedBy p = try ( (do L _ t <- try p; unexpected (describeToken t)) - <|> return ()) diff --git a/cabal/Cabal/Distribution/Parsec/Position.hs b/cabal/Cabal/Distribution/Parsec/Position.hs new file mode 100644 --- /dev/null +++ b/cabal/Cabal/Distribution/Parsec/Position.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE DeriveGeneric #-} +module Distribution.Parsec.Position ( + Position (..), + incPos, + retPos, + showPos, + zeroPos, + positionCol, + positionRow, + ) where + +import Distribution.Compat.Prelude +import Prelude () + +-- | 1-indexed row and column positions in a file. +data Position = Position + {-# UNPACK #-} !Int -- row + {-# UNPACK #-} !Int -- column + deriving (Eq, Ord, Show, Generic) + +instance Binary Position +instance NFData Position where rnf = genericRnf + +-- | Shift position by n columns to the right. +incPos :: Int -> Position -> Position +incPos n (Position row col) = Position row (col + n) + +-- | Shift position to beginning of next row. +retPos :: Position -> Position +retPos (Position row _col) = Position (row + 1) 1 + +showPos :: Position -> String +showPos (Position row col) = show row ++ ":" ++ show col + +zeroPos :: Position +zeroPos = Position 0 0 + +-- | @since 3.0.0.0 +positionCol :: Position -> Int +positionCol (Position _ c) = c + +-- | @since 3.0.0.0 +positionRow :: Position -> Int +positionRow (Position r _) = r diff --git a/cabal/Cabal/Distribution/Parsec/Warning.hs b/cabal/Cabal/Distribution/Parsec/Warning.hs new file mode 100644 --- /dev/null +++ b/cabal/Cabal/Distribution/Parsec/Warning.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE DeriveGeneric #-} +module Distribution.Parsec.Warning ( + PWarning (..), + PWarnType (..), + showPWarning, + ) where + +import Distribution.Compat.Prelude +import Distribution.Parsec.Position +import Prelude () +import System.FilePath (normalise) + +-- | Type of parser warning. We do classify warnings. +-- +-- Different application may decide not to show some, or have fatal behaviour on others +data PWarnType + = PWTOther -- ^ Unclassified warning + | PWTUTF -- ^ Invalid UTF encoding + | PWTBoolCase -- ^ @true@ or @false@, not @True@ or @False@ + | PWTVersionTag -- ^ there are version with tags + | PWTNewSyntax -- ^ New syntax used, but no @cabal-version: >= 1.2@ specified + | PWTOldSyntax -- ^ Old syntax used, and @cabal-version >= 1.2@ specified + | PWTDeprecatedField + | PWTInvalidSubsection + | PWTUnknownField + | PWTUnknownSection + | PWTTrailingFields + | PWTExtraMainIs -- ^ extra main-is field + | PWTExtraTestModule -- ^ extra test-module field + | PWTExtraBenchmarkModule -- ^ extra benchmark-module field + | PWTLexNBSP + | PWTLexBOM + | PWTLexTab + | PWTQuirkyCabalFile -- ^ legacy cabal file that we know how to patch + | PWTDoubleDash -- ^ Double dash token, most likely it's a mistake - it's not a comment + | PWTMultipleSingularField -- ^ e.g. name or version should be specified only once. + | PWTBuildTypeDefault -- ^ Workaround for derive-package having build-type: Default. See . + deriving (Eq, Ord, Show, Enum, Bounded, Generic) + +instance Binary PWarnType +instance NFData PWarnType where rnf = genericRnf + +-- | Parser warning. +data PWarning = PWarning !PWarnType !Position String + deriving (Show, Generic) + +instance Binary PWarning +instance NFData PWarning where rnf = genericRnf + +showPWarning :: FilePath -> PWarning -> String +showPWarning fpath (PWarning _ pos msg) = + normalise fpath ++ ":" ++ showPos pos ++ ": " ++ msg diff --git a/cabal/Cabal/Distribution/Pretty.hs b/cabal/Cabal/Distribution/Pretty.hs --- a/cabal/Cabal/Distribution/Pretty.hs +++ b/cabal/Cabal/Distribution/Pretty.hs @@ -7,20 +7,24 @@ showFilePath, showToken, showFreeText, - indentWith, + showFreeTextV3, -- * Deprecated Separator, ) where -import Prelude () +import Data.Functor.Identity (Identity (..)) +import Distribution.CabalSpecVersion import Distribution.Compat.Prelude -import Data.Functor.Identity (Identity (..)) +import Prelude () import qualified Text.PrettyPrint as PP class Pretty a where pretty :: a -> PP.Doc + prettyVersioned :: CabalSpecVersion -> a -> PP.Doc + prettyVersioned _ = pretty + instance Pretty Bool where pretty = PP.text . show @@ -31,7 +35,7 @@ pretty = pretty . runIdentity prettyShow :: Pretty a => a -> String -prettyShow = PP.renderStyle defaultStyle . pretty +prettyShow = PP.renderStyle defaultStyle . pretty -- | The default rendering style used in Cabal for console -- output. It has a fixed page width and adds line breaks @@ -80,6 +84,14 @@ showFreeText "" = mempty showFreeText s = PP.vcat [ PP.text (if null l then "." else l) | l <- lines_ s ] +-- | Pretty-print free-format text. +-- Since @cabal-version: 3.0@ we don't replace blank lines with dots. +-- +-- @since 3.0.0.0 +showFreeTextV3 :: String -> PP.Doc +showFreeTextV3 "" = mempty +showFreeTextV3 s = PP.vcat [ PP.text l | l <- lines_ s ] + -- | 'lines_' breaks a string up into a list of strings at newline -- characters. The resulting strings do not contain newlines. lines_ :: String -> [String] @@ -89,7 +101,3 @@ in l : case s' of [] -> [] (_:s'') -> lines_ s'' - --- | the indentation used for pretty printing -indentWith :: Int -indentWith = 4 diff --git a/cabal/Cabal/Distribution/PrettyUtils.hs b/cabal/Cabal/Distribution/PrettyUtils.hs deleted file mode 100644 --- a/cabal/Cabal/Distribution/PrettyUtils.hs +++ /dev/null @@ -1,23 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Distribution.PrettyUtils --- Copyright : (c) The University of Glasgow 2004 --- License : BSD3 --- --- Maintainer : cabal-devel@haskell.org --- Portability : portable --- --- Utilities for pretty printing. -{-# OPTIONS_HADDOCK hide #-} -module Distribution.PrettyUtils {-# DEPRECATED "Use Distribution.Pretty. This module will be removed in Cabal-3.0 (est. Mar 2019)." #-} ( - Separator, - -- * Internal - showFilePath, - showToken, - showTestedWith, - showFreeText, - indentWith, - ) where - -import Distribution.Pretty -import Distribution.ParseUtils diff --git a/cabal/Cabal/Distribution/ReadE.hs b/cabal/Cabal/Distribution/ReadE.hs --- a/cabal/Cabal/Distribution/ReadE.hs +++ b/cabal/Cabal/Distribution/ReadE.hs @@ -13,16 +13,14 @@ -- * ReadE ReadE(..), succeedReadE, failReadE, -- * Projections - parseReadE, readEOrFail, - readP_to_E, + readEOrFail, parsecToReadE, ) where import Distribution.Compat.Prelude import Prelude () -import Distribution.Compat.ReadP -import Distribution.Parsec.Class +import Distribution.Parsec import Distribution.Parsec.FieldLineStream -- | Parser with simple error reporting @@ -40,21 +38,8 @@ failReadE :: ErrorMsg -> ReadE a failReadE = ReadE . const . Left -parseReadE :: ReadE a -> ReadP r a -parseReadE (ReadE p) = do - txt <- look - either fail return (p txt) - readEOrFail :: ReadE a -> String -> a readEOrFail r = either error id . runReadE r - --- {-# DEPRECATED readP_to_E "Use parsecToReadE. This symbol will be removed in Cabal-3.0 (est. Mar 2019)." #-} -readP_to_E :: (String -> ErrorMsg) -> ReadP a a -> ReadE a -readP_to_E err r = - ReadE $ \txt -> case [ p | (p, s) <- readP_to_S r txt - , all isSpace s ] - of [] -> Left (err txt) - (p:_) -> Right p parsecToReadE :: (String -> ErrorMsg) -> ParsecParser a -> ReadE a parsecToReadE err p = ReadE $ \txt -> diff --git a/cabal/Cabal/Distribution/SPDX/License.hs b/cabal/Cabal/Distribution/SPDX/License.hs --- a/cabal/Cabal/Distribution/SPDX/License.hs +++ b/cabal/Cabal/Distribution/SPDX/License.hs @@ -8,7 +8,7 @@ import Distribution.Compat.Prelude import Distribution.Pretty -import Distribution.Parsec.Class +import Distribution.Parsec import Distribution.SPDX.LicenseExpression import qualified Distribution.Compat.CharParsing as P diff --git a/cabal/Cabal/Distribution/SPDX/LicenseExceptionId.hs b/cabal/Cabal/Distribution/SPDX/LicenseExceptionId.hs --- a/cabal/Cabal/Distribution/SPDX/LicenseExceptionId.hs +++ b/cabal/Cabal/Distribution/SPDX/LicenseExceptionId.hs @@ -13,10 +13,12 @@ import Prelude () import Distribution.Pretty -import Distribution.Parsec.Class +import Distribution.Parsec import Distribution.Utils.Generic (isAsciiAlphaNum) import Distribution.SPDX.LicenseListVersion +import qualified Data.Binary.Get as Binary +import qualified Data.Binary.Put as Binary import qualified Data.Map.Strict as Map import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp @@ -43,25 +45,35 @@ | GCC_exception_2_0 -- ^ @GCC-exception-2.0@, GCC Runtime Library exception 2.0 | GCC_exception_3_1 -- ^ @GCC-exception-3.1@, GCC Runtime Library exception 3.1 | Gnu_javamail_exception -- ^ @gnu-javamail-exception@, GNU JavaMail exception + | GPL_CC_1_0 -- ^ @GPL-CC-1.0@, GPL Cooperation Commitment 1.0, SPDX License List 3.6 | I2p_gpl_java_exception -- ^ @i2p-gpl-java-exception@, i2p GPL+Java Exception | Libtool_exception -- ^ @Libtool-exception@, Libtool Exception | Linux_syscall_note -- ^ @Linux-syscall-note@, Linux Syscall Note - | LLVM_exception -- ^ @LLVM-exception@, LLVM Exception, SPDX License List 3.2 + | LLVM_exception -- ^ @LLVM-exception@, LLVM Exception, SPDX License List 3.2, SPDX License List 3.6 | LZMA_exception -- ^ @LZMA-exception@, LZMA exception | Mif_exception -- ^ @mif-exception@, Macros and Inline Functions Exception - | Nokia_Qt_exception_1_1 -- ^ @Nokia-Qt-exception-1.1@, Nokia Qt LGPL exception 1.1 + | Nokia_Qt_exception_1_1 -- ^ @Nokia-Qt-exception-1.1@, Nokia Qt LGPL exception 1.1, SPDX License List 3.0, SPDX License List 3.2 + | OCaml_LGPL_linking_exception -- ^ @OCaml-LGPL-linking-exception@, OCaml LGPL Linking Exception, SPDX License List 3.6 | OCCT_exception_1_0 -- ^ @OCCT-exception-1.0@, Open CASCADE Exception 1.0 - | OpenJDK_assembly_exception_1_0 -- ^ @OpenJDK-assembly-exception-1.0@, OpenJDK Assembly exception 1.0, SPDX License List 3.2 + | OpenJDK_assembly_exception_1_0 -- ^ @OpenJDK-assembly-exception-1.0@, OpenJDK Assembly exception 1.0, SPDX License List 3.2, SPDX License List 3.6 | Openvpn_openssl_exception -- ^ @openvpn-openssl-exception@, OpenVPN OpenSSL Exception - | PS_or_PDF_font_exception_20170817 -- ^ @PS-or-PDF-font-exception-20170817@, PS/PDF font exception (2017-08-17), SPDX License List 3.2 - | Qt_GPL_exception_1_0 -- ^ @Qt-GPL-exception-1.0@, Qt GPL exception 1.0, SPDX License List 3.2 - | Qt_LGPL_exception_1_1 -- ^ @Qt-LGPL-exception-1.1@, Qt LGPL exception 1.1, SPDX License List 3.2 + | PS_or_PDF_font_exception_20170817 -- ^ @PS-or-PDF-font-exception-20170817@, PS/PDF font exception (2017-08-17), SPDX License List 3.2, SPDX License List 3.6 + | Qt_GPL_exception_1_0 -- ^ @Qt-GPL-exception-1.0@, Qt GPL exception 1.0, SPDX License List 3.2, SPDX License List 3.6 + | Qt_LGPL_exception_1_1 -- ^ @Qt-LGPL-exception-1.1@, Qt LGPL exception 1.1, SPDX License List 3.2, SPDX License List 3.6 | Qwt_exception_1_0 -- ^ @Qwt-exception-1.0@, Qwt exception 1.0 + | Swift_exception -- ^ @Swift-exception@, Swift Exception, SPDX License List 3.6 | U_boot_exception_2_0 -- ^ @u-boot-exception-2.0@, U-Boot exception 2.0 + | Universal_FOSS_exception_1_0 -- ^ @Universal-FOSS-exception-1.0@, Universal FOSS Exception, Version 1.0, SPDX License List 3.6 | WxWindows_exception_3_1 -- ^ @WxWindows-exception-3.1@, WxWindows Library Exception 3.1 deriving (Eq, Ord, Enum, Bounded, Show, Read, Typeable, Data, Generic) -instance Binary LicenseExceptionId +instance Binary LicenseExceptionId where + put = Binary.putWord8 . fromIntegral . fromEnum + get = do + i <- Binary.getWord8 + if i > fromIntegral (fromEnum (maxBound :: LicenseExceptionId)) + then fail "Too large LicenseExceptionId tag" + else return (toEnum (fromIntegral i)) instance Pretty LicenseExceptionId where pretty = Disp.text . licenseExceptionId @@ -98,6 +110,7 @@ licenseExceptionId GCC_exception_2_0 = "GCC-exception-2.0" licenseExceptionId GCC_exception_3_1 = "GCC-exception-3.1" licenseExceptionId Gnu_javamail_exception = "gnu-javamail-exception" +licenseExceptionId GPL_CC_1_0 = "GPL-CC-1.0" licenseExceptionId I2p_gpl_java_exception = "i2p-gpl-java-exception" licenseExceptionId Libtool_exception = "Libtool-exception" licenseExceptionId Linux_syscall_note = "Linux-syscall-note" @@ -105,6 +118,7 @@ licenseExceptionId LZMA_exception = "LZMA-exception" licenseExceptionId Mif_exception = "mif-exception" licenseExceptionId Nokia_Qt_exception_1_1 = "Nokia-Qt-exception-1.1" +licenseExceptionId OCaml_LGPL_linking_exception = "OCaml-LGPL-linking-exception" licenseExceptionId OCCT_exception_1_0 = "OCCT-exception-1.0" licenseExceptionId OpenJDK_assembly_exception_1_0 = "OpenJDK-assembly-exception-1.0" licenseExceptionId Openvpn_openssl_exception = "openvpn-openssl-exception" @@ -112,7 +126,9 @@ licenseExceptionId Qt_GPL_exception_1_0 = "Qt-GPL-exception-1.0" licenseExceptionId Qt_LGPL_exception_1_1 = "Qt-LGPL-exception-1.1" licenseExceptionId Qwt_exception_1_0 = "Qwt-exception-1.0" +licenseExceptionId Swift_exception = "Swift-exception" licenseExceptionId U_boot_exception_2_0 = "u-boot-exception-2.0" +licenseExceptionId Universal_FOSS_exception_1_0 = "Universal-FOSS-exception-1.0" licenseExceptionId WxWindows_exception_3_1 = "WxWindows-exception-3.1" -- | License name, e.g. @"GNU General Public License v2.0 only"@ @@ -133,6 +149,7 @@ licenseExceptionName GCC_exception_2_0 = "GCC Runtime Library exception 2.0" licenseExceptionName GCC_exception_3_1 = "GCC Runtime Library exception 3.1" licenseExceptionName Gnu_javamail_exception = "GNU JavaMail exception" +licenseExceptionName GPL_CC_1_0 = "GPL Cooperation Commitment 1.0" licenseExceptionName I2p_gpl_java_exception = "i2p GPL+Java Exception" licenseExceptionName Libtool_exception = "Libtool Exception" licenseExceptionName Linux_syscall_note = "Linux Syscall Note" @@ -140,6 +157,7 @@ licenseExceptionName LZMA_exception = "LZMA exception" licenseExceptionName Mif_exception = "Macros and Inline Functions Exception" licenseExceptionName Nokia_Qt_exception_1_1 = "Nokia Qt LGPL exception 1.1" +licenseExceptionName OCaml_LGPL_linking_exception = "OCaml LGPL Linking Exception" licenseExceptionName OCCT_exception_1_0 = "Open CASCADE Exception 1.0" licenseExceptionName OpenJDK_assembly_exception_1_0 = "OpenJDK Assembly exception 1.0" licenseExceptionName Openvpn_openssl_exception = "OpenVPN OpenSSL Exception" @@ -147,7 +165,9 @@ licenseExceptionName Qt_GPL_exception_1_0 = "Qt GPL exception 1.0" licenseExceptionName Qt_LGPL_exception_1_1 = "Qt LGPL exception 1.1" licenseExceptionName Qwt_exception_1_0 = "Qwt exception 1.0" +licenseExceptionName Swift_exception = "Swift Exception" licenseExceptionName U_boot_exception_2_0 = "U-Boot exception 2.0" +licenseExceptionName Universal_FOSS_exception_1_0 = "Universal FOSS Exception, Version 1.0" licenseExceptionName WxWindows_exception_3_1 = "WxWindows Library Exception 3.1" ------------------------------------------------------------------------------- @@ -156,21 +176,36 @@ licenseExceptionIdList :: LicenseListVersion -> [LicenseExceptionId] licenseExceptionIdList LicenseListVersion_3_0 = - [] + [ Nokia_Qt_exception_1_1 + ] ++ bulkOfLicenses licenseExceptionIdList LicenseListVersion_3_2 = [ LLVM_exception + , Nokia_Qt_exception_1_1 , OpenJDK_assembly_exception_1_0 , PS_or_PDF_font_exception_20170817 , Qt_GPL_exception_1_0 , Qt_LGPL_exception_1_1 ] ++ bulkOfLicenses +licenseExceptionIdList LicenseListVersion_3_6 = + [ GPL_CC_1_0 + , LLVM_exception + , OCaml_LGPL_linking_exception + , OpenJDK_assembly_exception_1_0 + , PS_or_PDF_font_exception_20170817 + , Qt_GPL_exception_1_0 + , Qt_LGPL_exception_1_1 + , Swift_exception + , Universal_FOSS_exception_1_0 + ] + ++ bulkOfLicenses -- | Create a 'LicenseExceptionId' from a 'String'. mkLicenseExceptionId :: LicenseListVersion -> String -> Maybe LicenseExceptionId mkLicenseExceptionId LicenseListVersion_3_0 s = Map.lookup s stringLookup_3_0 mkLicenseExceptionId LicenseListVersion_3_2 s = Map.lookup s stringLookup_3_2 +mkLicenseExceptionId LicenseListVersion_3_6 s = Map.lookup s stringLookup_3_6 stringLookup_3_0 :: Map String LicenseExceptionId stringLookup_3_0 = Map.fromList $ map (\i -> (licenseExceptionId i, i)) $ @@ -180,6 +215,10 @@ stringLookup_3_2 = Map.fromList $ map (\i -> (licenseExceptionId i, i)) $ licenseExceptionIdList LicenseListVersion_3_2 +stringLookup_3_6 :: Map String LicenseExceptionId +stringLookup_3_6 = Map.fromList $ map (\i -> (licenseExceptionId i, i)) $ + licenseExceptionIdList LicenseListVersion_3_6 + -- | License exceptions in all SPDX License lists bulkOfLicenses :: [LicenseExceptionId] bulkOfLicenses = @@ -204,7 +243,6 @@ , Linux_syscall_note , LZMA_exception , Mif_exception - , Nokia_Qt_exception_1_1 , OCCT_exception_1_0 , Openvpn_openssl_exception , Qwt_exception_1_0 diff --git a/cabal/Cabal/Distribution/SPDX/LicenseExpression.hs b/cabal/Cabal/Distribution/SPDX/LicenseExpression.hs --- a/cabal/Cabal/Distribution/SPDX/LicenseExpression.hs +++ b/cabal/Cabal/Distribution/SPDX/LicenseExpression.hs @@ -9,7 +9,7 @@ import Distribution.Compat.Prelude import Prelude () -import Distribution.Parsec.Class +import Distribution.Parsec import Distribution.Pretty import Distribution.SPDX.LicenseExceptionId import Distribution.SPDX.LicenseId diff --git a/cabal/Cabal/Distribution/SPDX/LicenseId.hs b/cabal/Cabal/Distribution/SPDX/LicenseId.hs --- a/cabal/Cabal/Distribution/SPDX/LicenseId.hs +++ b/cabal/Cabal/Distribution/SPDX/LicenseId.hs @@ -16,10 +16,12 @@ import Prelude () import Distribution.Pretty -import Distribution.Parsec.Class +import Distribution.Parsec import Distribution.Utils.Generic (isAsciiAlphaNum) import Distribution.SPDX.LicenseListVersion +import qualified Data.Binary.Get as Binary +import qualified Data.Binary.Put as Binary import qualified Data.Map.Strict as Map import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp @@ -43,8 +45,8 @@ | AFL_3_0 -- ^ @AFL-3.0@, Academic Free License v3.0 | Afmparse -- ^ @Afmparse@, Afmparse License | AGPL_1_0 -- ^ @AGPL-1.0@, Affero General Public License v1.0, SPDX License List 3.0 - | AGPL_1_0_only -- ^ @AGPL-1.0-only@, Affero General Public License v1.0 only, SPDX License List 3.2 - | AGPL_1_0_or_later -- ^ @AGPL-1.0-or-later@, Affero General Public License v1.0 or later, SPDX License List 3.2 + | AGPL_1_0_only -- ^ @AGPL-1.0-only@, Affero General Public License v1.0 only, SPDX License List 3.2, SPDX License List 3.6 + | AGPL_1_0_or_later -- ^ @AGPL-1.0-or-later@, Affero General Public License v1.0 or later, SPDX License List 3.2, SPDX License List 3.6 | AGPL_3_0_only -- ^ @AGPL-3.0-only@, GNU Affero General Public License v3.0 only | AGPL_3_0_or_later -- ^ @AGPL-3.0-or-later@, GNU Affero General Public License v3.0 or later | Aladdin -- ^ @Aladdin@, Aladdin Free Public License @@ -70,6 +72,8 @@ | Beerware -- ^ @Beerware@, Beerware License | BitTorrent_1_0 -- ^ @BitTorrent-1.0@, BitTorrent Open Source License v1.0 | BitTorrent_1_1 -- ^ @BitTorrent-1.1@, BitTorrent Open Source License v1.1 + | Blessing -- ^ @blessing@, SQLite Blessing, SPDX License List 3.6 + | BlueOak_1_0_0 -- ^ @BlueOak-1.0.0@, Blue Oak Model License 1.0.0, SPDX License List 3.6 | Borceux -- ^ @Borceux@, Borceux license | BSD_1_Clause -- ^ @BSD-1-Clause@, BSD 1-Clause License | BSD_2_Clause_FreeBSD -- ^ @BSD-2-Clause-FreeBSD@, BSD 2-Clause FreeBSD License @@ -82,6 +86,7 @@ | BSD_3_Clause_No_Nuclear_License_2014 -- ^ @BSD-3-Clause-No-Nuclear-License-2014@, BSD 3-Clause No Nuclear License 2014 | BSD_3_Clause_No_Nuclear_License -- ^ @BSD-3-Clause-No-Nuclear-License@, BSD 3-Clause No Nuclear License | BSD_3_Clause_No_Nuclear_Warranty -- ^ @BSD-3-Clause-No-Nuclear-Warranty@, BSD 3-Clause No Nuclear Warranty + | BSD_3_Clause_Open_MPI -- ^ @BSD-3-Clause-Open-MPI@, BSD 3-Clause Open MPI variant, SPDX License List 3.6 | BSD_3_Clause -- ^ @BSD-3-Clause@, BSD 3-Clause "New" or "Revised" License | BSD_4_Clause_UC -- ^ @BSD-4-Clause-UC@, BSD-4-Clause (University of California-Specific) | BSD_4_Clause -- ^ @BSD-4-Clause@, BSD 4-Clause "Original" or "Old" License @@ -122,6 +127,7 @@ | CC_BY_SA_2_5 -- ^ @CC-BY-SA-2.5@, Creative Commons Attribution Share Alike 2.5 Generic | CC_BY_SA_3_0 -- ^ @CC-BY-SA-3.0@, Creative Commons Attribution Share Alike 3.0 Unported | CC_BY_SA_4_0 -- ^ @CC-BY-SA-4.0@, Creative Commons Attribution Share Alike 4.0 International + | CC_PDDC -- ^ @CC-PDDC@, Creative Commons Public Domain Dedication and Certification, SPDX License List 3.6 | CC0_1_0 -- ^ @CC0-1.0@, Creative Commons Zero v1.0 Universal | CDDL_1_0 -- ^ @CDDL-1.0@, Common Development and Distribution License 1.0 | CDDL_1_1 -- ^ @CDDL-1.1@, Common Development and Distribution License 1.1 @@ -133,11 +139,15 @@ | CECILL_2_1 -- ^ @CECILL-2.1@, CeCILL Free Software License Agreement v2.1 | CECILL_B -- ^ @CECILL-B@, CeCILL-B Free Software License Agreement | CECILL_C -- ^ @CECILL-C@, CeCILL-C Free Software License Agreement + | CERN_OHL_1_1 -- ^ @CERN-OHL-1.1@, CERN Open Hardware License v1.1, SPDX License List 3.6 + | CERN_OHL_1_2 -- ^ @CERN-OHL-1.2@, CERN Open Hardware Licence v1.2, SPDX License List 3.6 | ClArtistic -- ^ @ClArtistic@, Clarified Artistic License | CNRI_Jython -- ^ @CNRI-Jython@, CNRI Jython License | CNRI_Python_GPL_Compatible -- ^ @CNRI-Python-GPL-Compatible@, CNRI Python Open Source GPL Compatible License Agreement | CNRI_Python -- ^ @CNRI-Python@, CNRI Python License | Condor_1_1 -- ^ @Condor-1.1@, Condor Public License v1.1 + | Copyleft_next_0_3_0 -- ^ @copyleft-next-0.3.0@, copyleft-next 0.3.0, SPDX License List 3.6 + | Copyleft_next_0_3_1 -- ^ @copyleft-next-0.3.1@, copyleft-next 0.3.1, SPDX License List 3.6 | CPAL_1_0 -- ^ @CPAL-1.0@, Common Public Attribution License 1.0 | CPL_1_0 -- ^ @CPL-1.0@, Common Public License 1.0 | CPOL_1_02 -- ^ @CPOL-1.02@, Code Project Open License 1.02 @@ -170,8 +180,8 @@ | Frameworx_1_0 -- ^ @Frameworx-1.0@, Frameworx Open License 1.0 | FreeImage -- ^ @FreeImage@, FreeImage Public License v1.0 | FSFAP -- ^ @FSFAP@, FSF All Permissive License - | FSFUL -- ^ @FSFUL@, FSF Unlimited License | FSFULLR -- ^ @FSFULLR@, FSF Unlimited License (with License Retention) + | FSFUL -- ^ @FSFUL@, FSF Unlimited License | FTL -- ^ @FTL@, Freetype Project License | GFDL_1_1_only -- ^ @GFDL-1.1-only@, GNU Free Documentation License v1.1 only | GFDL_1_1_or_later -- ^ @GFDL-1.1-or-later@, GNU Free Documentation License v1.1 or later @@ -192,6 +202,7 @@ | GPL_3_0_or_later -- ^ @GPL-3.0-or-later@, GNU General Public License v3.0 or later | GSOAP_1_3b -- ^ @gSOAP-1.3b@, gSOAP Public License v1.3b | HaskellReport -- ^ @HaskellReport@, Haskell Language Report License + | HPND_sell_variant -- ^ @HPND-sell-variant@, Historical Permission Notice and Disclaimer - sell variant, SPDX License List 3.6 | HPND -- ^ @HPND@, Historical Permission Notice and Disclaimer | IBM_pibs -- ^ @IBM-pibs@, IBM PowerPC Initialization and Boot Software | ICU -- ^ @ICU@, ICU License @@ -207,6 +218,7 @@ | IPL_1_0 -- ^ @IPL-1.0@, IBM Public License v1.0 | ISC -- ^ @ISC@, ISC License | JasPer_2_0 -- ^ @JasPer-2.0@, JasPer License + | JPNIC -- ^ @JPNIC@, Japan Network Information Center License, SPDX License List 3.6 | JSON -- ^ @JSON@, JSON License | LAL_1_2 -- ^ @LAL-1.2@, Licence Art Libre 1.2 | LAL_1_3 -- ^ @LAL-1.3@, Licence Art Libre 1.3 @@ -219,14 +231,15 @@ | LGPL_3_0_only -- ^ @LGPL-3.0-only@, GNU Lesser General Public License v3.0 only | LGPL_3_0_or_later -- ^ @LGPL-3.0-or-later@, GNU Lesser General Public License v3.0 or later | LGPLLR -- ^ @LGPLLR@, Lesser General Public License For Linguistic Resources + | Libpng_2_0 -- ^ @libpng-2.0@, PNG Reference Library version 2, SPDX License List 3.6 | Libpng -- ^ @Libpng@, libpng License | Libtiff -- ^ @libtiff@, libtiff License | LiLiQ_P_1_1 -- ^ @LiLiQ-P-1.1@, Licence Libre du Québec – Permissive version 1.1 | LiLiQ_R_1_1 -- ^ @LiLiQ-R-1.1@, Licence Libre du Québec – Réciprocité version 1.1 | LiLiQ_Rplus_1_1 -- ^ @LiLiQ-Rplus-1.1@, Licence Libre du Québec – Réciprocité forte version 1.1 - | Linux_OpenIB -- ^ @Linux-OpenIB@, Linux Kernel Variant of OpenIB.org license, SPDX License List 3.2 - | LPL_1_0 -- ^ @LPL-1.0@, Lucent Public License Version 1.0 + | Linux_OpenIB -- ^ @Linux-OpenIB@, Linux Kernel Variant of OpenIB.org license, SPDX License List 3.2, SPDX License List 3.6 | LPL_1_02 -- ^ @LPL-1.02@, Lucent Public License v1.02 + | LPL_1_0 -- ^ @LPL-1.0@, Lucent Public License Version 1.0 | LPPL_1_0 -- ^ @LPPL-1.0@, LaTeX Project Public License v1.0 | LPPL_1_1 -- ^ @LPPL-1.1@, LaTeX Project Public License v1.1 | LPPL_1_2 -- ^ @LPPL-1.2@, LaTeX Project Public License v1.2 @@ -234,13 +247,13 @@ | LPPL_1_3c -- ^ @LPPL-1.3c@, LaTeX Project Public License v1.3c | MakeIndex -- ^ @MakeIndex@, MakeIndex License | MirOS -- ^ @MirOS@, MirOS License - | MIT_0 -- ^ @MIT-0@, MIT No Attribution, SPDX License List 3.2 + | MIT_0 -- ^ @MIT-0@, MIT No Attribution, SPDX License List 3.2, SPDX License List 3.6 | MIT_advertising -- ^ @MIT-advertising@, Enlightenment License (e16) | MIT_CMU -- ^ @MIT-CMU@, CMU License | MIT_enna -- ^ @MIT-enna@, enna License | MIT_feh -- ^ @MIT-feh@, feh License - | MIT -- ^ @MIT@, MIT License | MITNFA -- ^ @MITNFA@, MIT +no-false-attribs license + | MIT -- ^ @MIT@, MIT License | Motosoto -- ^ @Motosoto@, Motosoto License | Mpich2 -- ^ @mpich2@, mpich2 License | MPL_1_0 -- ^ @MPL-1.0@, Mozilla Public License 1.0 @@ -273,9 +286,12 @@ | OCCT_PL -- ^ @OCCT-PL@, Open CASCADE Technology Public License | OCLC_2_0 -- ^ @OCLC-2.0@, OCLC Research Public License 2.0 | ODbL_1_0 -- ^ @ODbL-1.0@, ODC Open Database License v1.0 - | ODC_By_1_0 -- ^ @ODC-By-1.0@, Open Data Commons Attribution License v1.0, SPDX License List 3.2 + | ODC_By_1_0 -- ^ @ODC-By-1.0@, Open Data Commons Attribution License v1.0, SPDX License List 3.2, SPDX License List 3.6 | OFL_1_0 -- ^ @OFL-1.0@, SIL Open Font License 1.0 | OFL_1_1 -- ^ @OFL-1.1@, SIL Open Font License 1.1 + | OGL_UK_1_0 -- ^ @OGL-UK-1.0@, Open Government Licence v1.0, SPDX License List 3.6 + | OGL_UK_2_0 -- ^ @OGL-UK-2.0@, Open Government Licence v2.0, SPDX License List 3.6 + | OGL_UK_3_0 -- ^ @OGL-UK-3.0@, Open Government Licence v3.0, SPDX License List 3.6 | OGTSL -- ^ @OGTSL@, Open Group Test Suite License | OLDAP_1_1 -- ^ @OLDAP-1.1@, Open LDAP Public License v1.1 | OLDAP_1_2 -- ^ @OLDAP-1.2@, Open LDAP Public License v1.2 @@ -302,9 +318,10 @@ | OSL_2_0 -- ^ @OSL-2.0@, Open Software License 2.0 | OSL_2_1 -- ^ @OSL-2.1@, Open Software License 2.1 | OSL_3_0 -- ^ @OSL-3.0@, Open Software License 3.0 + | Parity_6_0_0 -- ^ @Parity-6.0.0@, The Parity Public License 6.0.0, SPDX License List 3.6 | PDDL_1_0 -- ^ @PDDL-1.0@, ODC Public Domain Dedication & License 1.0 - | PHP_3_0 -- ^ @PHP-3.0@, PHP License v3.0 | PHP_3_01 -- ^ @PHP-3.01@, PHP License v3.01 + | PHP_3_0 -- ^ @PHP-3.0@, PHP License v3.0 | Plexus -- ^ @Plexus@, Plexus Classworlds License | PostgreSQL -- ^ @PostgreSQL@, PostgreSQL License | Psfrag -- ^ @psfrag@, psfrag License @@ -323,10 +340,13 @@ | SAX_PD -- ^ @SAX-PD@, Sax Public Domain Notice | Saxpath -- ^ @Saxpath@, Saxpath License | SCEA -- ^ @SCEA@, SCEA Shared Source License + | Sendmail_8_23 -- ^ @Sendmail-8.23@, Sendmail License 8.23, SPDX License List 3.6 | Sendmail -- ^ @Sendmail@, Sendmail License | SGI_B_1_0 -- ^ @SGI-B-1.0@, SGI Free Software License B v1.0 | SGI_B_1_1 -- ^ @SGI-B-1.1@, SGI Free Software License B v1.1 | SGI_B_2_0 -- ^ @SGI-B-2.0@, SGI Free Software License B v2.0 + | SHL_0_51 -- ^ @SHL-0.51@, Solderpad Hardware License, Version 0.51, SPDX License List 3.6 + | SHL_0_5 -- ^ @SHL-0.5@, Solderpad Hardware License v0.5, SPDX License List 3.6 | SimPL_2_0 -- ^ @SimPL-2.0@, Simple Public License 2.0 | SISSL_1_2 -- ^ @SISSL-1.2@, Sun Industry Standards Source License v1.2 | SISSL -- ^ @SISSL@, Sun Industry Standards Source License v1.1 @@ -338,15 +358,17 @@ | Spencer_94 -- ^ @Spencer-94@, Spencer License 94 | Spencer_99 -- ^ @Spencer-99@, Spencer License 99 | SPL_1_0 -- ^ @SPL-1.0@, Sun Public License v1.0 + | SSPL_1_0 -- ^ @SSPL-1.0@, Server Side Public License, v 1, SPDX License List 3.6 | SugarCRM_1_1_3 -- ^ @SugarCRM-1.1.3@, SugarCRM Public License v1.1.3 | SWL -- ^ @SWL@, Scheme Widget Library (SWL) Software License Agreement + | TAPR_OHL_1_0 -- ^ @TAPR-OHL-1.0@, TAPR Open Hardware License v1.0, SPDX License List 3.6 | TCL -- ^ @TCL@, TCL/TK License | TCP_wrappers -- ^ @TCP-wrappers@, TCP Wrappers License | TMate -- ^ @TMate@, TMate Open Source License | TORQUE_1_1 -- ^ @TORQUE-1.1@, TORQUE v2.5+ Software License v1.1 | TOSL -- ^ @TOSL@, Trusster Open Source License - | TU_Berlin_1_0 -- ^ @TU-Berlin-1.0@, Technische Universitaet Berlin License 1.0, SPDX License List 3.2 - | TU_Berlin_2_0 -- ^ @TU-Berlin-2.0@, Technische Universitaet Berlin License 2.0, SPDX License List 3.2 + | TU_Berlin_1_0 -- ^ @TU-Berlin-1.0@, Technische Universitaet Berlin License 1.0, SPDX License List 3.2, SPDX License List 3.6 + | TU_Berlin_2_0 -- ^ @TU-Berlin-2.0@, Technische Universitaet Berlin License 2.0, SPDX License List 3.2, SPDX License List 3.6 | Unicode_DFS_2015 -- ^ @Unicode-DFS-2015@, Unicode License Agreement - Data Files and Software (2015) | Unicode_DFS_2016 -- ^ @Unicode-DFS-2016@, Unicode License Agreement - Data Files and Software (2016) | Unicode_TOU -- ^ @Unicode-TOU@, Unicode Terms of Use @@ -381,7 +403,15 @@ | ZPL_2_1 -- ^ @ZPL-2.1@, Zope Public License 2.1 deriving (Eq, Ord, Enum, Bounded, Show, Read, Typeable, Data, Generic) -instance Binary LicenseId +instance Binary LicenseId where + -- Word16 is encoded in big endianess + -- https://github.com/kolmodin/binary/blob/master/src/Data/Binary/Class.hs#L220-LL227 + put = Binary.putWord16be . fromIntegral . fromEnum + get = do + i <- Binary.getWord16be + if i > fromIntegral (fromEnum (maxBound :: LicenseId)) + then fail "Too large LicenseId tag" + else return (toEnum (fromIntegral i)) instance Pretty LicenseId where pretty = Disp.text . licenseId @@ -489,6 +519,8 @@ licenseId Beerware = "Beerware" licenseId BitTorrent_1_0 = "BitTorrent-1.0" licenseId BitTorrent_1_1 = "BitTorrent-1.1" +licenseId Blessing = "blessing" +licenseId BlueOak_1_0_0 = "BlueOak-1.0.0" licenseId Borceux = "Borceux" licenseId BSD_1_Clause = "BSD-1-Clause" licenseId BSD_2_Clause_FreeBSD = "BSD-2-Clause-FreeBSD" @@ -501,6 +533,7 @@ licenseId BSD_3_Clause_No_Nuclear_License_2014 = "BSD-3-Clause-No-Nuclear-License-2014" licenseId BSD_3_Clause_No_Nuclear_License = "BSD-3-Clause-No-Nuclear-License" licenseId BSD_3_Clause_No_Nuclear_Warranty = "BSD-3-Clause-No-Nuclear-Warranty" +licenseId BSD_3_Clause_Open_MPI = "BSD-3-Clause-Open-MPI" licenseId BSD_3_Clause = "BSD-3-Clause" licenseId BSD_4_Clause_UC = "BSD-4-Clause-UC" licenseId BSD_4_Clause = "BSD-4-Clause" @@ -541,6 +574,7 @@ licenseId CC_BY_SA_2_5 = "CC-BY-SA-2.5" licenseId CC_BY_SA_3_0 = "CC-BY-SA-3.0" licenseId CC_BY_SA_4_0 = "CC-BY-SA-4.0" +licenseId CC_PDDC = "CC-PDDC" licenseId CC0_1_0 = "CC0-1.0" licenseId CDDL_1_0 = "CDDL-1.0" licenseId CDDL_1_1 = "CDDL-1.1" @@ -552,11 +586,15 @@ licenseId CECILL_2_1 = "CECILL-2.1" licenseId CECILL_B = "CECILL-B" licenseId CECILL_C = "CECILL-C" +licenseId CERN_OHL_1_1 = "CERN-OHL-1.1" +licenseId CERN_OHL_1_2 = "CERN-OHL-1.2" licenseId ClArtistic = "ClArtistic" licenseId CNRI_Jython = "CNRI-Jython" licenseId CNRI_Python_GPL_Compatible = "CNRI-Python-GPL-Compatible" licenseId CNRI_Python = "CNRI-Python" licenseId Condor_1_1 = "Condor-1.1" +licenseId Copyleft_next_0_3_0 = "copyleft-next-0.3.0" +licenseId Copyleft_next_0_3_1 = "copyleft-next-0.3.1" licenseId CPAL_1_0 = "CPAL-1.0" licenseId CPL_1_0 = "CPL-1.0" licenseId CPOL_1_02 = "CPOL-1.02" @@ -589,8 +627,8 @@ licenseId Frameworx_1_0 = "Frameworx-1.0" licenseId FreeImage = "FreeImage" licenseId FSFAP = "FSFAP" -licenseId FSFUL = "FSFUL" licenseId FSFULLR = "FSFULLR" +licenseId FSFUL = "FSFUL" licenseId FTL = "FTL" licenseId GFDL_1_1_only = "GFDL-1.1-only" licenseId GFDL_1_1_or_later = "GFDL-1.1-or-later" @@ -611,6 +649,7 @@ licenseId GPL_3_0_or_later = "GPL-3.0-or-later" licenseId GSOAP_1_3b = "gSOAP-1.3b" licenseId HaskellReport = "HaskellReport" +licenseId HPND_sell_variant = "HPND-sell-variant" licenseId HPND = "HPND" licenseId IBM_pibs = "IBM-pibs" licenseId ICU = "ICU" @@ -626,6 +665,7 @@ licenseId IPL_1_0 = "IPL-1.0" licenseId ISC = "ISC" licenseId JasPer_2_0 = "JasPer-2.0" +licenseId JPNIC = "JPNIC" licenseId JSON = "JSON" licenseId LAL_1_2 = "LAL-1.2" licenseId LAL_1_3 = "LAL-1.3" @@ -638,14 +678,15 @@ licenseId LGPL_3_0_only = "LGPL-3.0-only" licenseId LGPL_3_0_or_later = "LGPL-3.0-or-later" licenseId LGPLLR = "LGPLLR" +licenseId Libpng_2_0 = "libpng-2.0" licenseId Libpng = "Libpng" licenseId Libtiff = "libtiff" licenseId LiLiQ_P_1_1 = "LiLiQ-P-1.1" licenseId LiLiQ_R_1_1 = "LiLiQ-R-1.1" licenseId LiLiQ_Rplus_1_1 = "LiLiQ-Rplus-1.1" licenseId Linux_OpenIB = "Linux-OpenIB" -licenseId LPL_1_0 = "LPL-1.0" licenseId LPL_1_02 = "LPL-1.02" +licenseId LPL_1_0 = "LPL-1.0" licenseId LPPL_1_0 = "LPPL-1.0" licenseId LPPL_1_1 = "LPPL-1.1" licenseId LPPL_1_2 = "LPPL-1.2" @@ -658,8 +699,8 @@ licenseId MIT_CMU = "MIT-CMU" licenseId MIT_enna = "MIT-enna" licenseId MIT_feh = "MIT-feh" -licenseId MIT = "MIT" licenseId MITNFA = "MITNFA" +licenseId MIT = "MIT" licenseId Motosoto = "Motosoto" licenseId Mpich2 = "mpich2" licenseId MPL_1_0 = "MPL-1.0" @@ -695,6 +736,9 @@ licenseId ODC_By_1_0 = "ODC-By-1.0" licenseId OFL_1_0 = "OFL-1.0" licenseId OFL_1_1 = "OFL-1.1" +licenseId OGL_UK_1_0 = "OGL-UK-1.0" +licenseId OGL_UK_2_0 = "OGL-UK-2.0" +licenseId OGL_UK_3_0 = "OGL-UK-3.0" licenseId OGTSL = "OGTSL" licenseId OLDAP_1_1 = "OLDAP-1.1" licenseId OLDAP_1_2 = "OLDAP-1.2" @@ -721,9 +765,10 @@ licenseId OSL_2_0 = "OSL-2.0" licenseId OSL_2_1 = "OSL-2.1" licenseId OSL_3_0 = "OSL-3.0" +licenseId Parity_6_0_0 = "Parity-6.0.0" licenseId PDDL_1_0 = "PDDL-1.0" -licenseId PHP_3_0 = "PHP-3.0" licenseId PHP_3_01 = "PHP-3.01" +licenseId PHP_3_0 = "PHP-3.0" licenseId Plexus = "Plexus" licenseId PostgreSQL = "PostgreSQL" licenseId Psfrag = "psfrag" @@ -742,10 +787,13 @@ licenseId SAX_PD = "SAX-PD" licenseId Saxpath = "Saxpath" licenseId SCEA = "SCEA" +licenseId Sendmail_8_23 = "Sendmail-8.23" licenseId Sendmail = "Sendmail" licenseId SGI_B_1_0 = "SGI-B-1.0" licenseId SGI_B_1_1 = "SGI-B-1.1" licenseId SGI_B_2_0 = "SGI-B-2.0" +licenseId SHL_0_51 = "SHL-0.51" +licenseId SHL_0_5 = "SHL-0.5" licenseId SimPL_2_0 = "SimPL-2.0" licenseId SISSL_1_2 = "SISSL-1.2" licenseId SISSL = "SISSL" @@ -757,8 +805,10 @@ licenseId Spencer_94 = "Spencer-94" licenseId Spencer_99 = "Spencer-99" licenseId SPL_1_0 = "SPL-1.0" +licenseId SSPL_1_0 = "SSPL-1.0" licenseId SugarCRM_1_1_3 = "SugarCRM-1.1.3" licenseId SWL = "SWL" +licenseId TAPR_OHL_1_0 = "TAPR-OHL-1.0" licenseId TCL = "TCL" licenseId TCP_wrappers = "TCP-wrappers" licenseId TMate = "TMate" @@ -841,6 +891,8 @@ licenseName Beerware = "Beerware License" licenseName BitTorrent_1_0 = "BitTorrent Open Source License v1.0" licenseName BitTorrent_1_1 = "BitTorrent Open Source License v1.1" +licenseName Blessing = "SQLite Blessing" +licenseName BlueOak_1_0_0 = "Blue Oak Model License 1.0.0" licenseName Borceux = "Borceux license" licenseName BSD_1_Clause = "BSD 1-Clause License" licenseName BSD_2_Clause_FreeBSD = "BSD 2-Clause FreeBSD License" @@ -853,6 +905,7 @@ licenseName BSD_3_Clause_No_Nuclear_License_2014 = "BSD 3-Clause No Nuclear License 2014" licenseName BSD_3_Clause_No_Nuclear_License = "BSD 3-Clause No Nuclear License" licenseName BSD_3_Clause_No_Nuclear_Warranty = "BSD 3-Clause No Nuclear Warranty" +licenseName BSD_3_Clause_Open_MPI = "BSD 3-Clause Open MPI variant" licenseName BSD_3_Clause = "BSD 3-Clause \"New\" or \"Revised\" License" licenseName BSD_4_Clause_UC = "BSD-4-Clause (University of California-Specific)" licenseName BSD_4_Clause = "BSD 4-Clause \"Original\" or \"Old\" License" @@ -893,6 +946,7 @@ licenseName CC_BY_SA_2_5 = "Creative Commons Attribution Share Alike 2.5 Generic" licenseName CC_BY_SA_3_0 = "Creative Commons Attribution Share Alike 3.0 Unported" licenseName CC_BY_SA_4_0 = "Creative Commons Attribution Share Alike 4.0 International" +licenseName CC_PDDC = "Creative Commons Public Domain Dedication and Certification" licenseName CC0_1_0 = "Creative Commons Zero v1.0 Universal" licenseName CDDL_1_0 = "Common Development and Distribution License 1.0" licenseName CDDL_1_1 = "Common Development and Distribution License 1.1" @@ -904,11 +958,15 @@ licenseName CECILL_2_1 = "CeCILL Free Software License Agreement v2.1" licenseName CECILL_B = "CeCILL-B Free Software License Agreement" licenseName CECILL_C = "CeCILL-C Free Software License Agreement" +licenseName CERN_OHL_1_1 = "CERN Open Hardware License v1.1" +licenseName CERN_OHL_1_2 = "CERN Open Hardware Licence v1.2" licenseName ClArtistic = "Clarified Artistic License" licenseName CNRI_Jython = "CNRI Jython License" licenseName CNRI_Python_GPL_Compatible = "CNRI Python Open Source GPL Compatible License Agreement" licenseName CNRI_Python = "CNRI Python License" licenseName Condor_1_1 = "Condor Public License v1.1" +licenseName Copyleft_next_0_3_0 = "copyleft-next 0.3.0" +licenseName Copyleft_next_0_3_1 = "copyleft-next 0.3.1" licenseName CPAL_1_0 = "Common Public Attribution License 1.0" licenseName CPL_1_0 = "Common Public License 1.0" licenseName CPOL_1_02 = "Code Project Open License 1.02" @@ -941,8 +999,8 @@ licenseName Frameworx_1_0 = "Frameworx Open License 1.0" licenseName FreeImage = "FreeImage Public License v1.0" licenseName FSFAP = "FSF All Permissive License" -licenseName FSFUL = "FSF Unlimited License" licenseName FSFULLR = "FSF Unlimited License (with License Retention)" +licenseName FSFUL = "FSF Unlimited License" licenseName FTL = "Freetype Project License" licenseName GFDL_1_1_only = "GNU Free Documentation License v1.1 only" licenseName GFDL_1_1_or_later = "GNU Free Documentation License v1.1 or later" @@ -963,6 +1021,7 @@ licenseName GPL_3_0_or_later = "GNU General Public License v3.0 or later" licenseName GSOAP_1_3b = "gSOAP Public License v1.3b" licenseName HaskellReport = "Haskell Language Report License" +licenseName HPND_sell_variant = "Historical Permission Notice and Disclaimer - sell variant" licenseName HPND = "Historical Permission Notice and Disclaimer" licenseName IBM_pibs = "IBM PowerPC Initialization and Boot Software" licenseName ICU = "ICU License" @@ -978,6 +1037,7 @@ licenseName IPL_1_0 = "IBM Public License v1.0" licenseName ISC = "ISC License" licenseName JasPer_2_0 = "JasPer License" +licenseName JPNIC = "Japan Network Information Center License" licenseName JSON = "JSON License" licenseName LAL_1_2 = "Licence Art Libre 1.2" licenseName LAL_1_3 = "Licence Art Libre 1.3" @@ -990,14 +1050,15 @@ licenseName LGPL_3_0_only = "GNU Lesser General Public License v3.0 only" licenseName LGPL_3_0_or_later = "GNU Lesser General Public License v3.0 or later" licenseName LGPLLR = "Lesser General Public License For Linguistic Resources" +licenseName Libpng_2_0 = "PNG Reference Library version 2" licenseName Libpng = "libpng License" licenseName Libtiff = "libtiff License" licenseName LiLiQ_P_1_1 = "Licence Libre du Qu\233bec \8211 Permissive version 1.1" licenseName LiLiQ_R_1_1 = "Licence Libre du Qu\233bec \8211 R\233ciprocit\233 version 1.1" licenseName LiLiQ_Rplus_1_1 = "Licence Libre du Qu\233bec \8211 R\233ciprocit\233 forte version 1.1" licenseName Linux_OpenIB = "Linux Kernel Variant of OpenIB.org license" -licenseName LPL_1_0 = "Lucent Public License Version 1.0" licenseName LPL_1_02 = "Lucent Public License v1.02" +licenseName LPL_1_0 = "Lucent Public License Version 1.0" licenseName LPPL_1_0 = "LaTeX Project Public License v1.0" licenseName LPPL_1_1 = "LaTeX Project Public License v1.1" licenseName LPPL_1_2 = "LaTeX Project Public License v1.2" @@ -1010,8 +1071,8 @@ licenseName MIT_CMU = "CMU License" licenseName MIT_enna = "enna License" licenseName MIT_feh = "feh License" -licenseName MIT = "MIT License" licenseName MITNFA = "MIT +no-false-attribs license" +licenseName MIT = "MIT License" licenseName Motosoto = "Motosoto License" licenseName Mpich2 = "mpich2 License" licenseName MPL_1_0 = "Mozilla Public License 1.0" @@ -1047,6 +1108,9 @@ licenseName ODC_By_1_0 = "Open Data Commons Attribution License v1.0" licenseName OFL_1_0 = "SIL Open Font License 1.0" licenseName OFL_1_1 = "SIL Open Font License 1.1" +licenseName OGL_UK_1_0 = "Open Government Licence v1.0" +licenseName OGL_UK_2_0 = "Open Government Licence v2.0" +licenseName OGL_UK_3_0 = "Open Government Licence v3.0" licenseName OGTSL = "Open Group Test Suite License" licenseName OLDAP_1_1 = "Open LDAP Public License v1.1" licenseName OLDAP_1_2 = "Open LDAP Public License v1.2" @@ -1073,9 +1137,10 @@ licenseName OSL_2_0 = "Open Software License 2.0" licenseName OSL_2_1 = "Open Software License 2.1" licenseName OSL_3_0 = "Open Software License 3.0" +licenseName Parity_6_0_0 = "The Parity Public License 6.0.0" licenseName PDDL_1_0 = "ODC Public Domain Dedication & License 1.0" -licenseName PHP_3_0 = "PHP License v3.0" licenseName PHP_3_01 = "PHP License v3.01" +licenseName PHP_3_0 = "PHP License v3.0" licenseName Plexus = "Plexus Classworlds License" licenseName PostgreSQL = "PostgreSQL License" licenseName Psfrag = "psfrag License" @@ -1094,10 +1159,13 @@ licenseName SAX_PD = "Sax Public Domain Notice" licenseName Saxpath = "Saxpath License" licenseName SCEA = "SCEA Shared Source License" +licenseName Sendmail_8_23 = "Sendmail License 8.23" licenseName Sendmail = "Sendmail License" licenseName SGI_B_1_0 = "SGI Free Software License B v1.0" licenseName SGI_B_1_1 = "SGI Free Software License B v1.1" licenseName SGI_B_2_0 = "SGI Free Software License B v2.0" +licenseName SHL_0_51 = "Solderpad Hardware License, Version 0.51" +licenseName SHL_0_5 = "Solderpad Hardware License v0.5" licenseName SimPL_2_0 = "Simple Public License 2.0" licenseName SISSL_1_2 = "Sun Industry Standards Source License v1.2" licenseName SISSL = "Sun Industry Standards Source License v1.1" @@ -1109,8 +1177,10 @@ licenseName Spencer_94 = "Spencer License 94" licenseName Spencer_99 = "Spencer License 99" licenseName SPL_1_0 = "Sun Public License v1.0" +licenseName SSPL_1_0 = "Server Side Public License, v 1" licenseName SugarCRM_1_1_3 = "SugarCRM Public License v1.1.3" licenseName SWL = "Scheme Widget Library (SWL) Software License Agreement" +licenseName TAPR_OHL_1_0 = "TAPR Open Hardware License v1.0" licenseName TCL = "TCL/TK License" licenseName TCP_wrappers = "TCP Wrappers License" licenseName TMate = "TMate Open Source License" @@ -1155,7 +1225,7 @@ -- -- See . licenseIsOsiApproved :: LicenseId -> Bool -licenseIsOsiApproved NullBSD = False +licenseIsOsiApproved NullBSD = True licenseIsOsiApproved AAL = True licenseIsOsiApproved Abstyles = False licenseIsOsiApproved Adobe_2006 = False @@ -1195,6 +1265,8 @@ licenseIsOsiApproved Beerware = False licenseIsOsiApproved BitTorrent_1_0 = False licenseIsOsiApproved BitTorrent_1_1 = False +licenseIsOsiApproved Blessing = False +licenseIsOsiApproved BlueOak_1_0_0 = False licenseIsOsiApproved Borceux = False licenseIsOsiApproved BSD_1_Clause = False licenseIsOsiApproved BSD_2_Clause_FreeBSD = False @@ -1203,10 +1275,11 @@ licenseIsOsiApproved BSD_2_Clause = True licenseIsOsiApproved BSD_3_Clause_Attribution = False licenseIsOsiApproved BSD_3_Clause_Clear = False -licenseIsOsiApproved BSD_3_Clause_LBNL = False +licenseIsOsiApproved BSD_3_Clause_LBNL = True licenseIsOsiApproved BSD_3_Clause_No_Nuclear_License_2014 = False licenseIsOsiApproved BSD_3_Clause_No_Nuclear_License = False licenseIsOsiApproved BSD_3_Clause_No_Nuclear_Warranty = False +licenseIsOsiApproved BSD_3_Clause_Open_MPI = False licenseIsOsiApproved BSD_3_Clause = True licenseIsOsiApproved BSD_4_Clause_UC = False licenseIsOsiApproved BSD_4_Clause = False @@ -1247,6 +1320,7 @@ licenseIsOsiApproved CC_BY_SA_2_5 = False licenseIsOsiApproved CC_BY_SA_3_0 = False licenseIsOsiApproved CC_BY_SA_4_0 = False +licenseIsOsiApproved CC_PDDC = False licenseIsOsiApproved CC0_1_0 = False licenseIsOsiApproved CDDL_1_0 = True licenseIsOsiApproved CDDL_1_1 = False @@ -1258,11 +1332,15 @@ licenseIsOsiApproved CECILL_2_1 = True licenseIsOsiApproved CECILL_B = False licenseIsOsiApproved CECILL_C = False +licenseIsOsiApproved CERN_OHL_1_1 = False +licenseIsOsiApproved CERN_OHL_1_2 = False licenseIsOsiApproved ClArtistic = False licenseIsOsiApproved CNRI_Jython = False licenseIsOsiApproved CNRI_Python_GPL_Compatible = False licenseIsOsiApproved CNRI_Python = True licenseIsOsiApproved Condor_1_1 = False +licenseIsOsiApproved Copyleft_next_0_3_0 = False +licenseIsOsiApproved Copyleft_next_0_3_1 = False licenseIsOsiApproved CPAL_1_0 = True licenseIsOsiApproved CPL_1_0 = True licenseIsOsiApproved CPOL_1_02 = False @@ -1295,8 +1373,8 @@ licenseIsOsiApproved Frameworx_1_0 = True licenseIsOsiApproved FreeImage = False licenseIsOsiApproved FSFAP = False -licenseIsOsiApproved FSFUL = False licenseIsOsiApproved FSFULLR = False +licenseIsOsiApproved FSFUL = False licenseIsOsiApproved FTL = False licenseIsOsiApproved GFDL_1_1_only = False licenseIsOsiApproved GFDL_1_1_or_later = False @@ -1317,6 +1395,7 @@ licenseIsOsiApproved GPL_3_0_or_later = True licenseIsOsiApproved GSOAP_1_3b = False licenseIsOsiApproved HaskellReport = False +licenseIsOsiApproved HPND_sell_variant = False licenseIsOsiApproved HPND = True licenseIsOsiApproved IBM_pibs = False licenseIsOsiApproved ICU = False @@ -1332,6 +1411,7 @@ licenseIsOsiApproved IPL_1_0 = True licenseIsOsiApproved ISC = True licenseIsOsiApproved JasPer_2_0 = False +licenseIsOsiApproved JPNIC = False licenseIsOsiApproved JSON = False licenseIsOsiApproved LAL_1_2 = False licenseIsOsiApproved LAL_1_3 = False @@ -1344,14 +1424,15 @@ licenseIsOsiApproved LGPL_3_0_only = True licenseIsOsiApproved LGPL_3_0_or_later = True licenseIsOsiApproved LGPLLR = False +licenseIsOsiApproved Libpng_2_0 = False licenseIsOsiApproved Libpng = False licenseIsOsiApproved Libtiff = False licenseIsOsiApproved LiLiQ_P_1_1 = True licenseIsOsiApproved LiLiQ_R_1_1 = True licenseIsOsiApproved LiLiQ_Rplus_1_1 = True licenseIsOsiApproved Linux_OpenIB = False -licenseIsOsiApproved LPL_1_0 = True licenseIsOsiApproved LPL_1_02 = True +licenseIsOsiApproved LPL_1_0 = True licenseIsOsiApproved LPPL_1_0 = False licenseIsOsiApproved LPPL_1_1 = False licenseIsOsiApproved LPPL_1_2 = False @@ -1364,8 +1445,8 @@ licenseIsOsiApproved MIT_CMU = False licenseIsOsiApproved MIT_enna = False licenseIsOsiApproved MIT_feh = False -licenseIsOsiApproved MIT = True licenseIsOsiApproved MITNFA = False +licenseIsOsiApproved MIT = True licenseIsOsiApproved Motosoto = True licenseIsOsiApproved Mpich2 = False licenseIsOsiApproved MPL_1_0 = True @@ -1401,6 +1482,9 @@ licenseIsOsiApproved ODC_By_1_0 = False licenseIsOsiApproved OFL_1_0 = False licenseIsOsiApproved OFL_1_1 = True +licenseIsOsiApproved OGL_UK_1_0 = False +licenseIsOsiApproved OGL_UK_2_0 = False +licenseIsOsiApproved OGL_UK_3_0 = False licenseIsOsiApproved OGTSL = True licenseIsOsiApproved OLDAP_1_1 = False licenseIsOsiApproved OLDAP_1_2 = False @@ -1427,9 +1511,10 @@ licenseIsOsiApproved OSL_2_0 = True licenseIsOsiApproved OSL_2_1 = True licenseIsOsiApproved OSL_3_0 = True +licenseIsOsiApproved Parity_6_0_0 = False licenseIsOsiApproved PDDL_1_0 = False -licenseIsOsiApproved PHP_3_0 = True licenseIsOsiApproved PHP_3_01 = False +licenseIsOsiApproved PHP_3_0 = True licenseIsOsiApproved Plexus = False licenseIsOsiApproved PostgreSQL = True licenseIsOsiApproved Psfrag = False @@ -1448,10 +1533,13 @@ licenseIsOsiApproved SAX_PD = False licenseIsOsiApproved Saxpath = False licenseIsOsiApproved SCEA = False +licenseIsOsiApproved Sendmail_8_23 = False licenseIsOsiApproved Sendmail = False licenseIsOsiApproved SGI_B_1_0 = False licenseIsOsiApproved SGI_B_1_1 = False licenseIsOsiApproved SGI_B_2_0 = False +licenseIsOsiApproved SHL_0_51 = False +licenseIsOsiApproved SHL_0_5 = False licenseIsOsiApproved SimPL_2_0 = True licenseIsOsiApproved SISSL_1_2 = False licenseIsOsiApproved SISSL = True @@ -1463,8 +1551,10 @@ licenseIsOsiApproved Spencer_94 = False licenseIsOsiApproved Spencer_99 = False licenseIsOsiApproved SPL_1_0 = True +licenseIsOsiApproved SSPL_1_0 = False licenseIsOsiApproved SugarCRM_1_1_3 = False licenseIsOsiApproved SWL = False +licenseIsOsiApproved TAPR_OHL_1_0 = False licenseIsOsiApproved TCL = False licenseIsOsiApproved TCP_wrappers = False licenseIsOsiApproved TMate = False @@ -1524,11 +1614,42 @@ , TU_Berlin_2_0 ] ++ bulkOfLicenses +licenseIdList LicenseListVersion_3_6 = + [ AGPL_1_0_only + , AGPL_1_0_or_later + , Blessing + , BlueOak_1_0_0 + , BSD_3_Clause_Open_MPI + , CC_PDDC + , CERN_OHL_1_1 + , CERN_OHL_1_2 + , Copyleft_next_0_3_0 + , Copyleft_next_0_3_1 + , HPND_sell_variant + , JPNIC + , Libpng_2_0 + , Linux_OpenIB + , MIT_0 + , ODC_By_1_0 + , OGL_UK_1_0 + , OGL_UK_2_0 + , OGL_UK_3_0 + , Parity_6_0_0 + , Sendmail_8_23 + , SHL_0_51 + , SHL_0_5 + , SSPL_1_0 + , TAPR_OHL_1_0 + , TU_Berlin_1_0 + , TU_Berlin_2_0 + ] + ++ bulkOfLicenses -- | Create a 'LicenseId' from a 'String'. mkLicenseId :: LicenseListVersion -> String -> Maybe LicenseId mkLicenseId LicenseListVersion_3_0 s = Map.lookup s stringLookup_3_0 mkLicenseId LicenseListVersion_3_2 s = Map.lookup s stringLookup_3_2 +mkLicenseId LicenseListVersion_3_6 s = Map.lookup s stringLookup_3_6 stringLookup_3_0 :: Map String LicenseId stringLookup_3_0 = Map.fromList $ map (\i -> (licenseId i, i)) $ @@ -1538,6 +1659,10 @@ stringLookup_3_2 = Map.fromList $ map (\i -> (licenseId i, i)) $ licenseIdList LicenseListVersion_3_2 +stringLookup_3_6 :: Map String LicenseId +stringLookup_3_6 = Map.fromList $ map (\i -> (licenseId i, i)) $ + licenseIdList LicenseListVersion_3_6 + -- | Licenses in all SPDX License lists bulkOfLicenses :: [LicenseId] bulkOfLicenses = @@ -1678,8 +1803,8 @@ , Frameworx_1_0 , FreeImage , FSFAP - , FSFUL , FSFULLR + , FSFUL , FTL , GFDL_1_1_only , GFDL_1_1_or_later @@ -1732,8 +1857,8 @@ , LiLiQ_P_1_1 , LiLiQ_R_1_1 , LiLiQ_Rplus_1_1 - , LPL_1_0 , LPL_1_02 + , LPL_1_0 , LPPL_1_0 , LPPL_1_1 , LPPL_1_2 @@ -1745,8 +1870,8 @@ , MIT_CMU , MIT_enna , MIT_feh - , MIT , MITNFA + , MIT , Motosoto , Mpich2 , MPL_1_0 @@ -1808,8 +1933,8 @@ , OSL_2_1 , OSL_3_0 , PDDL_1_0 - , PHP_3_0 , PHP_3_01 + , PHP_3_0 , Plexus , PostgreSQL , Psfrag diff --git a/cabal/Cabal/Distribution/SPDX/LicenseListVersion.hs b/cabal/Cabal/Distribution/SPDX/LicenseListVersion.hs --- a/cabal/Cabal/Distribution/SPDX/LicenseListVersion.hs +++ b/cabal/Cabal/Distribution/SPDX/LicenseListVersion.hs @@ -9,8 +9,10 @@ data LicenseListVersion = LicenseListVersion_3_0 | LicenseListVersion_3_2 + | LicenseListVersion_3_6 deriving (Eq, Ord, Show, Enum, Bounded) cabalSpecVersionToSPDXListVersion :: CabalSpecVersion -> LicenseListVersion +cabalSpecVersionToSPDXListVersion CabalSpecV3_0 = LicenseListVersion_3_6 cabalSpecVersionToSPDXListVersion CabalSpecV2_4 = LicenseListVersion_3_2 cabalSpecVersionToSPDXListVersion _ = LicenseListVersion_3_0 diff --git a/cabal/Cabal/Distribution/SPDX/LicenseReference.hs b/cabal/Cabal/Distribution/SPDX/LicenseReference.hs --- a/cabal/Cabal/Distribution/SPDX/LicenseReference.hs +++ b/cabal/Cabal/Distribution/SPDX/LicenseReference.hs @@ -13,7 +13,7 @@ import Distribution.Utils.Generic (isAsciiAlphaNum) import Distribution.Pretty -import Distribution.Parsec.Class +import Distribution.Parsec import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp diff --git a/cabal/Cabal/Distribution/Simple.hs b/cabal/Cabal/Distribution/Simple.hs --- a/cabal/Cabal/Distribution/Simple.hs +++ b/cabal/Cabal/Distribution/Simple.hs @@ -1,6 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} - +{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Simple @@ -52,13 +52,12 @@ -- ** Standard sets of hooks simpleUserHooks, autoconfUserHooks, - defaultUserHooks, emptyUserHooks, - -- ** Utils - defaultHookedPackageDesc + emptyUserHooks, ) where -import Prelude () import Control.Exception (try) + +import Prelude () import Distribution.Compat.Prelude -- local @@ -92,7 +91,8 @@ import Language.Haskell.Extension import Distribution.Version import Distribution.License -import Distribution.Text +import Distribution.Pretty +import Distribution.System (buildPlatform) -- Base import System.Environment (getArgs, getProgName) @@ -100,6 +100,7 @@ ,doesDirectoryExist, removeDirectoryRecursive) import System.Exit (exitWith,ExitCode(..)) import System.FilePath (searchPathSeparator, takeDirectory, (), splitDirectories, dropDrive) +import Distribution.Compat.ResponseFile (expandResponse) import Distribution.Compat.Directory (makeAbsolute) import Distribution.Compat.Environment (getEnvironment) import Distribution.Compat.GetShortPathName (getShortPathName) @@ -148,8 +149,9 @@ defaultMainHelper hooks { readDesc = return (Just pkg_descr) } defaultMainHelper :: UserHooks -> Args -> IO () -defaultMainHelper hooks args = topHandler $ - case commandsRun (globalCommand commands) commands args of +defaultMainHelper hooks args = topHandler $ do + args' <- expandResponse args + case commandsRun (globalCommand commands) commands args' of CommandHelp help -> printHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> printErrors errs @@ -168,15 +170,16 @@ printErrors errs = do putStr (intercalate "\n" errs) exitWith (ExitFailure 1) - printNumericVersion = putStrLn $ display cabalVersion + printNumericVersion = putStrLn $ prettyShow cabalVersion printVersion = putStrLn $ "Cabal library version " - ++ display cabalVersion + ++ prettyShow cabalVersion progs = addKnownPrograms (hookedPrograms hooks) defaultProgramDb commands = [configureCommand progs `commandAddAction` \fs as -> configureAction hooks fs as >> return () ,buildCommand progs `commandAddAction` buildAction hooks + ,showBuildInfoCommand progs `commandAddAction` showBuildInfoAction hooks ,replCommand progs `commandAddAction` replAction hooks ,installCommand `commandAddAction` installAction hooks ,copyCommand `commandAddAction` copyAction hooks @@ -258,10 +261,37 @@ (buildProgramArgs flags') (withPrograms lbi) - hookedAction preBuild buildHook postBuild + hookedAction verbosity preBuild buildHook postBuild (return lbi { withPrograms = progs }) hooks flags' { buildArgs = args } args +showBuildInfoAction :: UserHooks -> ShowBuildInfoFlags -> Args -> IO () +showBuildInfoAction hooks (ShowBuildInfoFlags flags fileOutput) args = do + distPref <- findDistPrefOrDefault (buildDistPref flags) + let verbosity = fromFlag $ buildVerbosity flags + lbi <- getBuildConfig hooks verbosity distPref + let flags' = flags { buildDistPref = toFlag distPref + , buildCabalFilePath = maybeToFlag (cabalFilePath lbi) + } + + progs <- reconfigurePrograms verbosity + (buildProgramPaths flags') + (buildProgramArgs flags') + (withPrograms lbi) + + pbi <- preBuild hooks args flags' + let lbi' = lbi { withPrograms = progs } + pkg_descr0 = localPkgDescr lbi' + pkg_descr = updatePackageDescription pbi pkg_descr0 + -- TODO: Somehow don't ignore build hook? + buildInfoString <- showBuildInfo pkg_descr lbi' flags + + case fileOutput of + Nothing -> putStr buildInfoString + Just fp -> writeFile fp buildInfoString + + postBuild hooks args flags' pkg_descr lbi' + replAction :: UserHooks -> ReplFlags -> Args -> IO () replAction hooks flags args = do distPref <- findDistPrefOrDefault (replDistPref flags) @@ -279,7 +309,7 @@ -- takes the args explicitly. UGH. -- ezyang pbi <- preRepl hooks args flags' let pkg_descr0 = localPkgDescr lbi - sanityCheckHookedBuildInfo pkg_descr0 pbi + sanityCheckHookedBuildInfo verbosity pkg_descr0 pbi let pkg_descr = updatePackageDescription pbi pkg_descr0 lbi' = lbi { withPrograms = progs , localPkgDescr = pkg_descr } @@ -294,7 +324,7 @@ let flags' = flags { hscolourDistPref = toFlag distPref , hscolourCabalFilePath = maybeToFlag (cabalFilePath lbi)} - hookedAction preHscolour hscolourHook postHscolour + hookedAction verbosity preHscolour hscolourHook postHscolour (getBuildConfig hooks verbosity distPref) hooks flags' args @@ -310,7 +340,7 @@ (doctestProgramArgs flags') (withPrograms lbi) - hookedAction preDoctest doctestHook postDoctest + hookedAction verbosity preDoctest doctestHook postDoctest (return lbi { withPrograms = progs }) hooks flags' args @@ -327,7 +357,7 @@ (haddockProgramArgs flags') (withPrograms lbi) - hookedAction preHaddock haddockHook postHaddock + hookedAction verbosity preHaddock haddockHook postHaddock (return lbi { withPrograms = progs }) hooks flags' { haddockArgs = args } args @@ -353,7 +383,7 @@ let pkg_descr0 = flattenPackageDescription ppd -- We don't sanity check for clean as an error -- here would prevent cleaning: - --sanityCheckHookedBuildInfo pkg_descr0 pbi + --sanityCheckHookedBuildInfo verbosity pkg_descr0 pbi let pkg_descr = updatePackageDescription pbi pkg_descr0 cleanHook hooks pkg_descr () hooks flags' @@ -368,7 +398,7 @@ lbi <- getBuildConfig hooks verbosity distPref let flags' = flags { copyDistPref = toFlag distPref , copyCabalFilePath = maybeToFlag (cabalFilePath lbi)} - hookedAction preCopy copyHook postCopy + hookedAction verbosity preCopy copyHook postCopy (getBuildConfig hooks verbosity distPref) hooks flags' { copyArgs = args } args @@ -379,15 +409,14 @@ lbi <- getBuildConfig hooks verbosity distPref let flags' = flags { installDistPref = toFlag distPref , installCabalFilePath = maybeToFlag (cabalFilePath lbi)} - hookedAction preInst instHook postInst + hookedAction verbosity preInst instHook postInst (getBuildConfig hooks verbosity distPref) hooks flags' args sdistAction :: UserHooks -> SDistFlags -> Args -> IO () -sdistAction hooks flags args = do +sdistAction hooks flags _args = do distPref <- findDistPrefOrDefault (sDistDistPref flags) - let flags' = flags { sDistDistPref = toFlag distPref } - pbi <- preSDist hooks args flags' + let pbi = emptyHookedBuildInfo mlbi <- maybeGetPersistBuildConfig distPref @@ -404,12 +433,11 @@ (_, ppd) <- confPkgDescr hooks verbosity Nothing let pkg_descr0 = flattenPackageDescription ppd - sanityCheckHookedBuildInfo pkg_descr0 pbi + sanityCheckHookedBuildInfo verbosity pkg_descr0 pbi let pkg_descr = updatePackageDescription pbi pkg_descr0 mlbi' = fmap (\lbi -> lbi { localPkgDescr = pkg_descr }) mlbi - sDistHook hooks pkg_descr mlbi' hooks flags' - postSDist hooks args flags' pkg_descr mlbi' + sdist pkg_descr mlbi' flags srcPref (allSuffixHandlers hooks) where verbosity = fromFlag (sDistVerbosity flags) @@ -419,13 +447,7 @@ let verbosity = fromFlag $ testVerbosity flags flags' = flags { testDistPref = toFlag distPref } - localBuildInfo <- getBuildConfig hooks verbosity distPref - let pkg_descr = localPkgDescr localBuildInfo - -- It is safe to do 'runTests' before the new test handler because the - -- default action is a no-op and if the package uses the old test interface - -- the new handler will find no tests. - runTests hooks args False pkg_descr localBuildInfo - hookedActionWithArgs preTest testHook postTest + hookedActionWithArgs verbosity preTest testHook postTest (getBuildConfig hooks verbosity distPref) hooks flags' args @@ -434,7 +456,7 @@ distPref <- findDistPrefOrDefault (benchmarkDistPref flags) let verbosity = fromFlag $ benchmarkVerbosity flags flags' = flags { benchmarkDistPref = toFlag distPref } - hookedActionWithArgs preBench benchHook postBench + hookedActionWithArgs verbosity preBench benchHook postBench (getBuildConfig hooks verbosity distPref) hooks flags' args @@ -445,7 +467,7 @@ lbi <- getBuildConfig hooks verbosity distPref let flags' = flags { regDistPref = toFlag distPref , regCabalFilePath = maybeToFlag (cabalFilePath lbi)} - hookedAction preReg regHook postReg + hookedAction verbosity preReg regHook postReg (getBuildConfig hooks verbosity distPref) hooks flags' { regArgs = args } args @@ -456,55 +478,62 @@ lbi <- getBuildConfig hooks verbosity distPref let flags' = flags { regDistPref = toFlag distPref , regCabalFilePath = maybeToFlag (cabalFilePath lbi)} - hookedAction preUnreg unregHook postUnreg + hookedAction verbosity preUnreg unregHook postUnreg (getBuildConfig hooks verbosity distPref) hooks flags' args -hookedAction :: (UserHooks -> Args -> flags -> IO HookedBuildInfo) - -> (UserHooks -> PackageDescription -> LocalBuildInfo - -> UserHooks -> flags -> IO ()) - -> (UserHooks -> Args -> flags -> PackageDescription - -> LocalBuildInfo -> IO ()) - -> IO LocalBuildInfo - -> UserHooks -> flags -> Args -> IO () -hookedAction pre_hook cmd_hook = - hookedActionWithArgs pre_hook (\h _ pd lbi uh flags -> - cmd_hook h pd lbi uh flags) +hookedAction + :: Verbosity + -> (UserHooks -> Args -> flags -> IO HookedBuildInfo) + -> (UserHooks -> PackageDescription -> LocalBuildInfo + -> UserHooks -> flags -> IO ()) + -> (UserHooks -> Args -> flags -> PackageDescription + -> LocalBuildInfo -> IO ()) + -> IO LocalBuildInfo + -> UserHooks -> flags -> Args -> IO () +hookedAction verbosity pre_hook cmd_hook = + hookedActionWithArgs verbosity pre_hook + (\h _ pd lbi uh flags -> + cmd_hook h pd lbi uh flags) -hookedActionWithArgs :: (UserHooks -> Args -> flags -> IO HookedBuildInfo) - -> (UserHooks -> Args -> PackageDescription -> LocalBuildInfo - -> UserHooks -> flags -> IO ()) - -> (UserHooks -> Args -> flags -> PackageDescription - -> LocalBuildInfo -> IO ()) - -> IO LocalBuildInfo - -> UserHooks -> flags -> Args -> IO () -hookedActionWithArgs pre_hook cmd_hook post_hook +hookedActionWithArgs + :: Verbosity + -> (UserHooks -> Args -> flags -> IO HookedBuildInfo) + -> (UserHooks -> Args -> PackageDescription -> LocalBuildInfo + -> UserHooks -> flags -> IO ()) + -> (UserHooks -> Args -> flags -> PackageDescription + -> LocalBuildInfo -> IO ()) + -> IO LocalBuildInfo + -> UserHooks -> flags -> Args -> IO () +hookedActionWithArgs verbosity pre_hook cmd_hook post_hook get_build_config hooks flags args = do pbi <- pre_hook hooks args flags lbi0 <- get_build_config let pkg_descr0 = localPkgDescr lbi0 - sanityCheckHookedBuildInfo pkg_descr0 pbi + sanityCheckHookedBuildInfo verbosity pkg_descr0 pbi let pkg_descr = updatePackageDescription pbi pkg_descr0 lbi = lbi0 { localPkgDescr = pkg_descr } cmd_hook hooks args pkg_descr lbi hooks flags post_hook hooks args flags pkg_descr lbi -sanityCheckHookedBuildInfo :: PackageDescription -> HookedBuildInfo -> IO () -sanityCheckHookedBuildInfo PackageDescription { library = Nothing } (Just _,_) - = die $ "The buildinfo contains info for a library, " - ++ "but the package does not have a library." +sanityCheckHookedBuildInfo + :: Verbosity -> PackageDescription -> HookedBuildInfo -> IO () +sanityCheckHookedBuildInfo verbosity + (PackageDescription { library = Nothing }) (Just _,_) + = die' verbosity $ "The buildinfo contains info for a library, " + ++ "but the package does not have a library." -sanityCheckHookedBuildInfo pkg_descr (_, hookExes) +sanityCheckHookedBuildInfo verbosity pkg_descr (_, hookExes) | not (null nonExistant) - = die $ "The buildinfo contains info for an executable called '" - ++ display (head nonExistant) ++ "' but the package does not have a " - ++ "executable with that name." + = die' verbosity $ "The buildinfo contains info for an executable called '" + ++ prettyShow (head nonExistant) ++ "' but the package does not have a " + ++ "executable with that name." where pkgExeNames = nub (map exeName (executables pkg_descr)) hookExeNames = nub (map fst hookExes) nonExistant = hookExeNames \\ pkgExeNames -sanityCheckHookedBuildInfo _ _ = return () +sanityCheckHookedBuildInfo _ _ _ = return () -- | Try to read the 'localBuildInfoFile' tryGetBuildConfig :: UserHooks -> Verbosity -> FilePath @@ -542,8 +571,8 @@ -- Since the list of unconfigured programs is not serialized, -- restore it to the same value as normally used at the beginning -- of a configure run: - configPrograms_ = restoreProgramDb - (builtinPrograms ++ hookedPrograms hooks) + configPrograms_ = fmap (restoreProgramDb + (builtinPrograms ++ hookedPrograms hooks)) `fmap` configPrograms_ cFlags, -- Use the current, not saved verbosity level: @@ -602,7 +631,6 @@ testHook = defaultTestHook, benchHook = defaultBenchHook, instHook = defaultInstallHook, - sDistHook = \p l h f -> sdist p l f srcPref (allSuffixHandlers h), cleanHook = \p _ _ f -> clean p f, hscolourHook = \p l h f -> hscolour p l (allSuffixHandlers h) f, haddockHook = \p l h f -> haddock p l (allSuffixHandlers h) f, @@ -627,37 +655,6 @@ -- Thus @configure@ can use local system information to generate -- /package/@.buildinfo@ and possibly other files. -{-# DEPRECATED defaultUserHooks - "Use simpleUserHooks or autoconfUserHooks, unless you need Cabal-1.2\n compatibility in which case you must stick with defaultUserHooks" #-} -defaultUserHooks :: UserHooks -defaultUserHooks = autoconfUserHooks { - confHook = \pkg flags -> do - let verbosity = fromFlag (configVerbosity flags) - warn verbosity - "defaultUserHooks in Setup script is deprecated." - confHook autoconfUserHooks pkg flags, - postConf = oldCompatPostConf - } - -- This is the annoying old version that only runs configure if it exists. - -- It's here for compatibility with existing Setup.hs scripts. See: - -- https://github.com/haskell/cabal/issues/158 - where oldCompatPostConf args flags pkg_descr lbi - = do let verbosity = fromFlag (configVerbosity flags) - baseDir lbi' = fromMaybe "" (takeDirectory <$> cabalFilePath lbi') - - confExists <- doesFileExist $ (baseDir lbi) "configure" - when confExists $ - runConfigureScript verbosity - backwardsCompatHack flags lbi - - pbi <- getHookedBuildInfo (buildDir lbi) verbosity - sanityCheckHookedBuildInfo pkg_descr pbi - let pkg_descr' = updatePackageDescription pbi pkg_descr - lbi' = lbi { localPkgDescr = pkg_descr' } - postConf simpleUserHooks args flags pkg_descr' lbi' - - backwardsCompatHack = True - autoconfUserHooks :: UserHooks autoconfUserHooks = simpleUserHooks @@ -676,15 +673,16 @@ -> LocalBuildInfo -> IO () defaultPostConf args flags pkg_descr lbi = do let verbosity = fromFlag (configVerbosity flags) - baseDir lbi' = fromMaybe "" (takeDirectory <$> cabalFilePath lbi') + baseDir lbi' = fromMaybe "" + (takeDirectory <$> cabalFilePath lbi') confExists <- doesFileExist $ (baseDir lbi) "configure" if confExists then runConfigureScript verbosity backwardsCompatHack flags lbi - else die "configure script not found." + else die' verbosity "configure script not found." - pbi <- getHookedBuildInfo (buildDir lbi) verbosity - sanityCheckHookedBuildInfo pkg_descr pbi + pbi <- getHookedBuildInfo verbosity (buildDir lbi) + sanityCheckHookedBuildInfo verbosity pkg_descr pbi let pkg_descr' = updatePackageDescription pbi pkg_descr lbi' = lbi { localPkgDescr = pkg_descr' } postConf simpleUserHooks args flags pkg_descr' lbi' @@ -697,7 +695,7 @@ -> IO HookedBuildInfo readHookWithArgs get_verbosity get_dist_pref _ flags = do dist_dir <- findDistPrefOrDefault (get_dist_pref flags) - getHookedBuildInfo (dist_dir "build") verbosity + getHookedBuildInfo verbosity (dist_dir "build") where verbosity = fromFlag (get_verbosity flags) @@ -707,7 +705,7 @@ readHook get_verbosity get_dist_pref a flags = do noExtraFlags a dist_dir <- findDistPrefOrDefault (get_dist_pref flags) - getHookedBuildInfo (dist_dir "build") verbosity + getHookedBuildInfo verbosity (dist_dir "build") where verbosity = fromFlag (get_verbosity flags) @@ -755,7 +753,9 @@ ((intercalate spSep extraPath ++ spSep)++) $ lookup "PATH" env overEnv = ("CFLAGS", Just cflagsEnv) : [("PATH", Just pathEnv) | not (null extraPath)] - args' = configureFile':args ++ ["CC=" ++ ccProgShort] + hp = hostPlatform lbi + maybeHostFlag = if hp == buildPlatform then [] else ["--host=" ++ show (pretty hp)] + args' = configureFile':args ++ ["CC=" ++ ccProgShort] ++ maybeHostFlag shProg = simpleProgram "sh" progDb = modifyProgramSearchPath (\p -> map ProgramSearchPathDir extraPath ++ p) emptyProgramDb @@ -765,7 +765,7 @@ Just sh -> runProgramInvocation verbosity $ (programInvocation (sh {programOverrideEnv = overEnv}) args') { progInvokeCwd = Just (buildDir lbi) } - Nothing -> die notFoundMsg + Nothing -> die' verbosity notFoundMsg where args = configureArgs backwardsCompatHack flags @@ -800,9 +800,9 @@ ++ "If you are not on Windows, ensure that an 'sh' command " ++ "is discoverable in your path." -getHookedBuildInfo :: FilePath -> Verbosity -> IO HookedBuildInfo -getHookedBuildInfo build_dir verbosity = do - maybe_infoFile <- findHookedPackageDesc build_dir +getHookedBuildInfo :: Verbosity -> FilePath -> IO HookedBuildInfo +getHookedBuildInfo verbosity build_dir = do + maybe_infoFile <- findHookedPackageDesc verbosity build_dir case maybe_infoFile of Nothing -> return emptyHookedBuildInfo Just infoFile -> do diff --git a/cabal/Cabal/Distribution/Simple/Bench.hs b/cabal/Cabal/Distribution/Simple/Bench.hs --- a/cabal/Cabal/Distribution/Simple/Bench.hs +++ b/cabal/Cabal/Distribution/Simple/Bench.hs @@ -30,7 +30,7 @@ import Distribution.Simple.Setup import Distribution.Simple.UserHooks import Distribution.Simple.Utils -import Distribution.Text +import Distribution.Pretty import System.Exit ( ExitCode(..), exitFailure, exitSuccess ) import System.Directory ( doesFileExist ) @@ -72,7 +72,7 @@ _ -> do notice verbosity $ "No support for running " ++ "benchmark " ++ name ++ " of type: " - ++ display (PD.benchmarkType bm) + ++ prettyShow (PD.benchmarkType bm) exitFailure where name = unUnqualComponentName $ PD.benchmarkName bm diff --git a/cabal/Cabal/Distribution/Simple/Build.hs b/cabal/Cabal/Distribution/Simple/Build.hs --- a/cabal/Cabal/Distribution/Simple/Build.hs +++ b/cabal/Cabal/Distribution/Simple/Build.hs @@ -19,7 +19,7 @@ -- module Distribution.Simple.Build ( - build, repl, + build, showBuildInfo, repl, startInterpreter, initialBuildSteps, @@ -31,16 +31,17 @@ import Prelude () import Distribution.Compat.Prelude -import Distribution.Types.Dependency -import Distribution.Types.LocalBuildInfo -import Distribution.Types.TargetInfo +import Distribution.Types.ComponentLocalBuildInfo import Distribution.Types.ComponentRequestedSpec +import Distribution.Types.Dependency +import Distribution.Types.ExecutableScope import Distribution.Types.ForeignLib +import Distribution.Types.LibraryVisibility +import Distribution.Types.LocalBuildInfo import Distribution.Types.MungedPackageId import Distribution.Types.MungedPackageName +import Distribution.Types.TargetInfo import Distribution.Types.UnqualComponentName -import Distribution.Types.ComponentLocalBuildInfo -import Distribution.Types.ExecutableScope import Distribution.Package import Distribution.Backpack @@ -51,8 +52,8 @@ import qualified Distribution.Simple.HaskellSuite as HaskellSuite import qualified Distribution.Simple.PackageIndex as Index -import qualified Distribution.Simple.Build.Macros as Build.Macros -import qualified Distribution.Simple.Build.PathsModule as Build.PathsModule +import Distribution.Simple.Build.Macros (generateCabalMacrosHeader) +import Distribution.Simple.Build.PathsModule (generatePathsModule) import qualified Distribution.Simple.Program.HcPkg as HcPkg import Distribution.Simple.Compiler hiding (Flag) @@ -68,14 +69,16 @@ import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Program.Types import Distribution.Simple.Program.Db +import Distribution.Simple.ShowBuildInfo import Distribution.Simple.BuildPaths import Distribution.Simple.Configure import Distribution.Simple.Register import Distribution.Simple.Test.LibV09 import Distribution.Simple.Utils +import Distribution.Simple.Utils.Json import Distribution.System -import Distribution.Text +import Distribution.Pretty import Distribution.Verbosity import Distribution.Compat.Graph (IsNode(..)) @@ -127,6 +130,18 @@ verbosity = fromFlag (buildVerbosity flags) +showBuildInfo :: PackageDescription -- ^ Mostly information from the .cabal file + -> LocalBuildInfo -- ^ Configuration information + -> BuildFlags -- ^ Flags that the user passed to build + -> IO String +showBuildInfo pkg_descr lbi flags = do + let verbosity = fromFlag (buildVerbosity flags) + targets <- readTargetInfos verbosity pkg_descr lbi (buildArgs flags) + let targetsToBuild = neededTargetsInBuildOrder' pkg_descr lbi (map nodeKey targets) + doc = mkBuildInfo pkg_descr lbi flags targetsToBuild + return $ renderJson doc "" + + repl :: PackageDescription -- ^ Mostly information from the .cabal file -> LocalBuildInfo -- ^ Configuration information -> ReplFlags -- ^ Flags that the user passed to build @@ -300,27 +315,27 @@ buildComponent verbosity _ _ _ _ (CTest TestSuite { testInterface = TestSuiteUnsupported tt }) _ _ = - die' verbosity $ "No support for building test suite type " ++ display tt + die' verbosity $ "No support for building test suite type " ++ prettyShow tt buildComponent verbosity numJobs pkg_descr lbi suffixes comp@(CBench bm@Benchmark { benchmarkInterface = BenchmarkExeV10 {} }) - clbi _ = do - let (exe, exeClbi) = benchmarkExeV10asExe bm clbi + clbi _distPref = do + let exe = benchmarkExeV10asExe bm preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes extras <- preprocessExtras verbosity comp lbi setupMessage' verbosity "Building" (packageId pkg_descr) (componentLocalName clbi) (maybeComponentInstantiatedWith clbi) let ebi = buildInfo exe exe' = exe { buildInfo = addExtraCSources ebi extras } - buildExe verbosity numJobs pkg_descr lbi exe' exeClbi + buildExe verbosity numJobs pkg_descr lbi exe' clbi return Nothing buildComponent verbosity _ _ _ _ (CBench Benchmark { benchmarkInterface = BenchmarkUnsupported tt }) _ _ = - die' verbosity $ "No support for building benchmark type " ++ display tt + die' verbosity $ "No support for building benchmark type " ++ prettyShow tt -- | Add extra C sources generated by preprocessing to build @@ -400,24 +415,24 @@ replComponent _ verbosity _ _ _ (CTest TestSuite { testInterface = TestSuiteUnsupported tt }) _ _ = - die' verbosity $ "No support for building test suite type " ++ display tt + die' verbosity $ "No support for building test suite type " ++ prettyShow tt replComponent replFlags verbosity pkg_descr lbi suffixes comp@(CBench bm@Benchmark { benchmarkInterface = BenchmarkExeV10 {} }) - clbi _ = do - let (exe, exeClbi) = benchmarkExeV10asExe bm clbi + clbi _distPref = do + let exe = benchmarkExeV10asExe bm preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes extras <- preprocessExtras verbosity comp lbi let ebi = buildInfo exe exe' = exe { buildInfo = ebi { cSources = cSources ebi ++ extras } } - replExe replFlags verbosity pkg_descr lbi exe' exeClbi + replExe replFlags verbosity pkg_descr lbi exe' clbi replComponent _ verbosity _ _ _ (CBench Benchmark { benchmarkInterface = BenchmarkUnsupported tt }) _ _ = - die' verbosity $ "No support for building benchmark type " ++ display tt + die' verbosity $ "No support for building benchmark type " ++ prettyShow tt ---------------------------------------------------- -- Shared code for buildComponent and replComponent @@ -434,6 +449,17 @@ } testSuiteExeV10AsExe TestSuite{} = error "testSuiteExeV10AsExe: wrong kind" +-- | Translate a exe-style 'Benchmark' component into an exe for building +benchmarkExeV10asExe :: Benchmark -> Executable +benchmarkExeV10asExe bm@Benchmark { benchmarkInterface = BenchmarkExeV10 _ mainFile } = + Executable { + exeName = benchmarkName bm, + modulePath = mainFile, + exeScope = ExecutablePublic, + buildInfo = benchmarkBuildInfo bm + } +benchmarkExeV10asExe Benchmark{} = error "benchmarkExeV10asExe: wrong kind" + -- | Translate a lib-style 'TestSuite' component into a lib + exe for building testSuiteLibV09AsLibAndExe :: PackageDescription -> TestSuite @@ -453,24 +479,26 @@ where bi = testBuildInfo test lib = Library { - libName = Nothing, + libName = LMainLibName, exposedModules = [ m ], reexportedModules = [], signatures = [], libExposed = True, + libVisibility = LibraryVisibilityPrivate, libBuildInfo = bi } -- This is, like, the one place where we use a CTestName for a library. -- Should NOT use library name, since that could conflict! PackageIdentifier pkg_name pkg_ver = package pkg_descr - compat_name = computeCompatPackageName pkg_name (Just (testName test)) + -- Note: we do make internal library from the test! + compat_name = MungedPackageName pkg_name (LSubLibName (testName test)) compat_key = computeCompatPackageKey (compiler lbi) compat_name pkg_ver (componentUnitId clbi) libClbi = LibComponentLocalBuildInfo { componentPackageDeps = componentPackageDeps clbi , componentInternalDeps = componentInternalDeps clbi , componentIsIndefinite_ = False , componentExeDeps = componentExeDeps clbi - , componentLocalName = CSubLibName (testName test) + , componentLocalName = CLibName $ LSubLibName $ testName test , componentIsPublic = False , componentIncludes = componentIncludes clbi , componentUnitId = componentUnitId clbi @@ -481,7 +509,7 @@ , componentExposedModules = [IPI.ExposedModule m Nothing] } pkg = pkg_descr { - package = (package pkg_descr) { pkgName = mkPackageName $ unMungedPackageName compat_name } + package = (package pkg_descr) { pkgName = mkPackageName $ prettyShow compat_name } , executables = [] , testSuites = [] , subLibraries = [lib] @@ -503,7 +531,7 @@ -- | The stub executable needs a new 'ComponentLocalBuildInfo' -- that exposes the relevant test suite library. deps = (IPI.installedUnitId ipi, mungedId ipi) - : (filter (\(_, x) -> let name = unMungedPackageName $ mungedName x + : (filter (\(_, x) -> let name = prettyShow $ mungedName x in name == "Cabal" || name == "base") (componentPackageDeps clbi)) exeClbi = ExeComponentLocalBuildInfo { @@ -524,30 +552,6 @@ testSuiteLibV09AsLibAndExe _ TestSuite{} _ _ _ _ = error "testSuiteLibV09AsLibAndExe: wrong kind" --- | Translate a exe-style 'Benchmark' component into an exe for building -benchmarkExeV10asExe :: Benchmark -> ComponentLocalBuildInfo - -> (Executable, ComponentLocalBuildInfo) -benchmarkExeV10asExe bm@Benchmark { benchmarkInterface = BenchmarkExeV10 _ f } - clbi = - (exe, exeClbi) - where - exe = Executable { - exeName = benchmarkName bm, - modulePath = f, - exeScope = ExecutablePublic, - buildInfo = benchmarkBuildInfo bm - } - exeClbi = ExeComponentLocalBuildInfo { - componentUnitId = componentUnitId clbi, - componentComponentId = componentComponentId clbi, - componentLocalName = CExeName (benchmarkName bm), - componentInternalDeps = componentInternalDeps clbi, - componentExeDeps = componentExeDeps clbi, - componentPackageDeps = componentPackageDeps clbi, - componentIncludes = componentIncludes clbi - } -benchmarkExeV10asExe Benchmark{} _ = error "benchmarkExeV10asExe: wrong kind" - -- | Initialize a new package db file for libraries defined -- internally to the package. createInternalPackageDB :: Verbosity -> LocalBuildInfo -> FilePath @@ -672,7 +676,7 @@ pathsModuleDir = takeDirectory pathsModulePath -- Ensure that the directory exists! createDirectoryIfMissingVerbose verbosity True pathsModuleDir - rewriteFileEx verbosity pathsModulePath (Build.PathsModule.generate pkg lbi clbi) + rewriteFileEx verbosity pathsModulePath (generatePathsModule pkg lbi clbi) --TODO: document what we're doing here, and move it to its own function case clbi of @@ -690,8 +694,8 @@ rewriteFileEx verbosity sigPath $ "{-# OPTIONS_GHC -w #-}\n" ++ "{-# LANGUAGE NoImplicitPrelude #-}\n" ++ - "signature " ++ display mod_name ++ " where" + "signature " ++ prettyShow mod_name ++ " where" _ -> return () let cppHeaderPath = autogenComponentModulesDir lbi clbi cppHeaderName - rewriteFileEx verbosity cppHeaderPath (Build.Macros.generate pkg lbi clbi) + rewriteFileEx verbosity cppHeaderPath (generateCabalMacrosHeader pkg lbi clbi) diff --git a/cabal/Cabal/Distribution/Simple/Build/Macros.hs b/cabal/Cabal/Distribution/Simple/Build/Macros.hs --- a/cabal/Cabal/Distribution/Simple/Build/Macros.hs +++ b/cabal/Cabal/Distribution/Simple/Build/Macros.hs @@ -20,7 +20,7 @@ -- TODO Figure out what to do about backpack and internal libraries. It is very -- suspecious that this stuff works with munged package identifiers module Distribution.Simple.Build.Macros ( - generate, + generateCabalMacrosHeader, generatePackageVersionMacros, ) where @@ -35,7 +35,7 @@ import Distribution.Types.MungedPackageId import Distribution.Types.MungedPackageName import Distribution.Types.PackageId -import Distribution.Text +import Distribution.Pretty -- ------------------------------------------------------------ -- * Generate cabal_macros.h @@ -73,8 +73,8 @@ -- | The contents of the @cabal_macros.h@ for the given configured package. -- -generate :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> String -generate pkg_descr lbi clbi = +generateCabalMacrosHeader :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> String +generateCabalMacrosHeader pkg_descr lbi clbi = "/* DO NOT EDIT: This file is automatically generated by Cabal */\n\n" ++ generatePackageVersionMacros (package pkg_descr : map getPid (componentPackageDeps clbi)) ++ @@ -82,13 +82,11 @@ generateComponentIdMacro lbi clbi ++ generateCurrentPackageVersion pkg_descr where - getPid (_, MungedPackageId mpn v) = - PackageIdentifier pn v - where - -- NB: Drop the component name! We're just reporting package versions. + getPid (_, MungedPackageId (MungedPackageName pn _) v) = + -- NB: Drop the library name! We're just reporting package versions. -- This would have to be revisited if you are allowed to depend -- on different versions of the same package - pn = fst (decodeCompatPackageName mpn) + PackageIdentifier pn v -- | Helper function that generates just the @VERSION_pkg@ and @MIN_VERSION_pkg@ -- macros for a list of package ids (usually used with the specific deps of @@ -96,10 +94,10 @@ -- generatePackageVersionMacros :: [PackageId] -> String generatePackageVersionMacros pkgids = concat - [ line ("/* package " ++ display pkgid ++ " */") + [ line ("/* package " ++ prettyShow pkgid ++ " */") ++ generateMacros "" pkgname version | pkgid@(PackageIdentifier name version) <- pkgids - , let pkgname = map fixchar (display name) + , let pkgname = map fixchar (prettyShow name) ] -- | Helper function that generates just the @TOOL_VERSION_pkg@ and @@ -111,7 +109,7 @@ ++ generateMacros "TOOL_" progname version | prog <- progs , isJust . programVersion $ prog - , let progid = programId prog ++ "-" ++ display version + , let progid = programId prog ++ "-" ++ prettyShow version progname = map fixchar (programId prog) Just version = programVersion prog ] @@ -122,7 +120,7 @@ generateMacros :: String -> String -> Version -> String generateMacros macro_prefix name version = concat - [ifndefDefineStr (macro_prefix ++ "VERSION_" ++ name) (display version) + [ifndefDefineStr (macro_prefix ++ "VERSION_" ++ name) (prettyShow version) ,ifndefDefine ("MIN_" ++ macro_prefix ++ "VERSION_" ++ name) (Just ["major1","major2","minor"]) $ concat [ @@ -144,14 +142,14 @@ LibComponentLocalBuildInfo{} -> ifndefDefineStr "CURRENT_PACKAGE_KEY" (componentCompatPackageKey clbi) _ -> "" - ,ifndefDefineStr "CURRENT_COMPONENT_ID" (display (componentComponentId clbi)) + ,ifndefDefineStr "CURRENT_COMPONENT_ID" (prettyShow (componentComponentId clbi)) ] -- | Generate the @CURRENT_PACKAGE_VERSION@ definition for the declared version -- of the current package. generateCurrentPackageVersion :: PackageDescription -> String generateCurrentPackageVersion pd = - ifndefDefineStr "CURRENT_PACKAGE_VERSION" (display (pkgVersion (package pd))) + ifndefDefineStr "CURRENT_PACKAGE_VERSION" (prettyShow (pkgVersion (package pd))) fixchar :: Char -> Char fixchar '-' = '_' diff --git a/cabal/Cabal/Distribution/Simple/Build/PathsModule.hs b/cabal/Cabal/Distribution/Simple/Build/PathsModule.hs --- a/cabal/Cabal/Distribution/Simple/Build/PathsModule.hs +++ b/cabal/Cabal/Distribution/Simple/Build/PathsModule.hs @@ -15,7 +15,7 @@ -- at runtime. This code should probably be split off into another module. -- module Distribution.Simple.Build.PathsModule ( - generate, pkgPathEnvVar + generatePathsModule, pkgPathEnvVar ) where import Prelude () @@ -28,7 +28,7 @@ import Distribution.Simple.LocalBuildInfo import Distribution.Simple.BuildPaths import Distribution.Simple.Utils -import Distribution.Text +import Distribution.Pretty import Distribution.Version import System.FilePath ( pathSeparator ) @@ -37,8 +37,8 @@ -- * Building Paths_.hs -- ------------------------------------------------------------ -generate :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> String -generate pkg_descr lbi clbi = +generatePathsModule :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> String +generatePathsModule pkg_descr lbi clbi = let pragmas = cpp_pragma ++ no_rebindable_syntax_pragma @@ -80,7 +80,7 @@ header = pragmas++ - "module " ++ display paths_modulename ++ " (\n"++ + "module " ++ prettyShow paths_modulename ++ " (\n"++ " version,\n"++ " getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir,\n"++ " getDataFileName, getSysconfDir\n"++ @@ -195,7 +195,8 @@ datadir = flat_datadir, libexecdir = flat_libexecdir, sysconfdir = flat_sysconfdir - } = absoluteComponentInstallDirs pkg_descr lbi cid NoCopyDest + } = absoluteInstallCommandDirs pkg_descr lbi cid NoCopyDest + InstallDirs { bindir = flat_bindirrel, libdir = flat_libdirrel, @@ -267,7 +268,7 @@ pkgPathEnvVar pkg_descr var = showPkgName (packageName pkg_descr) ++ "_" ++ var where - showPkgName = map fixchar . display + showPkgName = map fixchar . prettyShow fixchar '-' = '_' fixchar c = c diff --git a/cabal/Cabal/Distribution/Simple/BuildPaths.hs b/cabal/Cabal/Distribution/Simple/BuildPaths.hs --- a/cabal/Cabal/Distribution/Simple/BuildPaths.hs +++ b/cabal/Cabal/Distribution/Simple/BuildPaths.hs @@ -16,11 +16,9 @@ module Distribution.Simple.BuildPaths ( defaultDistPref, srcPref, haddockDirName, hscolourPref, haddockPref, - autogenModulesDir, autogenPackageModulesDir, autogenComponentModulesDir, - autogenModuleName, autogenPathsModuleName, cppHeaderName, haddockName, @@ -31,7 +29,8 @@ mkGenericSharedLibName, mkSharedLibName, mkStaticLibName, - + mkGenericSharedBundledLibName, + exeExtension, objExtension, dllExtension, @@ -52,11 +51,12 @@ import Distribution.PackageDescription import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Setup -import Distribution.Text +import Distribution.Pretty import Distribution.System import Distribution.Verbosity import Distribution.Simple.Utils +import Data.List (stripPrefix) import System.FilePath ((), (<.>), normalise) -- --------------------------------------------------------------------------- @@ -71,8 +71,8 @@ -- | This is the name of the directory in which the generated haddocks -- should be stored. It does not include the @/doc/html@ prefix. haddockDirName :: HaddockTarget -> PackageDescription -> FilePath -haddockDirName ForDevelopment = display . packageName -haddockDirName ForHackage = (++ "-docs") . display . packageId +haddockDirName ForDevelopment = prettyShow . packageName +haddockDirName ForHackage = (++ "-docs") . prettyShow . packageId -- | The directory to which generated haddock documentation should be written. haddockPref :: HaddockTarget -> FilePath -> PackageDescription -> FilePath @@ -80,12 +80,6 @@ = distPref "doc" "html" haddockDirName haddockTarget pkg_descr -- | The directory in which we put auto-generated modules for EVERY --- component in the package. See deprecation notice. -{-# DEPRECATED autogenModulesDir "If you can, use 'autogenComponentModulesDir' instead, but if you really wanted package-global generated modules, use 'autogenPackageModulesDir'. In Cabal 2.0, we avoid using autogenerated files which apply to all components, because the information you often want in these files, e.g., dependency information, is best specified per component, so that reconfiguring a different component (e.g., enabling tests) doesn't force the entire to be rebuilt. 'autogenPackageModulesDir' still provides a place to put files you want to apply to the entire package, but most users of 'autogenModulesDir' should seriously consider 'autogenComponentModulesDir' if you really wanted the module to apply to one component." #-} -autogenModulesDir :: LocalBuildInfo -> String -autogenModulesDir = autogenPackageModulesDir - --- | The directory in which we put auto-generated modules for EVERY -- component in the package. autogenPackageModulesDir :: LocalBuildInfo -> String autogenPackageModulesDir lbi = buildDir lbi "global-autogen" @@ -100,21 +94,16 @@ cppHeaderName :: String cppHeaderName = "cabal_macros.h" -{-# DEPRECATED autogenModuleName "Use autogenPathsModuleName instead" #-} --- |The name of the auto-generated module associated with a package -autogenModuleName :: PackageDescription -> ModuleName -autogenModuleName = autogenPathsModuleName - -- | The name of the auto-generated Paths_* module associated with a package autogenPathsModuleName :: PackageDescription -> ModuleName autogenPathsModuleName pkg_descr = ModuleName.fromString $ - "Paths_" ++ map fixchar (display (packageName pkg_descr)) + "Paths_" ++ map fixchar (prettyShow (packageName pkg_descr)) where fixchar '-' = '_' fixchar c = c haddockName :: PackageDescription -> FilePath -haddockName pkg_descr = display (packageName pkg_descr) <.> "haddock" +haddockName pkg_descr = prettyShow (packageName pkg_descr) <.> "haddock" -- ----------------------------------------------------------------------------- -- Source File helper @@ -139,7 +128,7 @@ -> IO [(ModuleName.ModuleName, FilePath)] getExeSourceFiles verbosity lbi exe clbi = do moduleFiles <- getSourceFiles verbosity searchpaths modules - srcMainPath <- findFile (hsSourceDirs bi) (modulePath exe) + srcMainPath <- findFileEx verbosity (hsSourceDirs bi) (modulePath exe) return ((ModuleName.main, srcMainPath) : moduleFiles) where bi = buildInfo exe @@ -168,7 +157,7 @@ findFileWithExtension ["hs", "lhs", "hsig", "lhsig"] dirs (ModuleName.toFilePath m) >>= maybe (notFound m) (return . normalise) where - notFound module_ = die' verbosity $ "can't find source for module " ++ display module_ + notFound module_ = die' verbosity $ "can't find source for module " ++ prettyShow module_ -- | The directory where we put build results for an executable exeBuildDir :: LocalBuildInfo -> Executable -> FilePath @@ -186,7 +175,7 @@ -- Library file names -- | Create a library name for a static library from a given name. --- Prepends 'lib' and appends the static library extension ('.a'). +-- Prepends @lib@ and appends the static library extension (@.a@). mkGenericStaticLibName :: String -> String mkGenericStaticLibName lib = "lib" ++ lib <.> "a" @@ -196,17 +185,17 @@ mkProfLibName :: UnitId -> String mkProfLibName lib = mkGenericStaticLibName (getHSLibraryName lib ++ "_p") --- | Create a library name for a shared lirbary from a given name. --- Prepends 'lib' and appends the '-' +-- | Create a library name for a shared library from a given name. +-- Prepends @lib@ and appends the @-\\@ -- as well as the shared library extension. mkGenericSharedLibName :: Platform -> CompilerId -> String -> String mkGenericSharedLibName platform (CompilerId compilerFlavor compilerVersion) lib = mconcat [ "lib", lib, "-", comp <.> dllExtension platform ] - where comp = display compilerFlavor ++ display compilerVersion + where comp = prettyShow compilerFlavor ++ prettyShow compilerVersion -- Implement proper name mangling for dynamical shared objects --- libHS- --- e.g. libHSbase-2.1-ghc6.6.1.so +-- @libHS\-\\@ +-- e.g. @libHSbase-2.1-ghc6.6.1.so@ mkSharedLibName :: Platform -> CompilerId -> UnitId -> String mkSharedLibName platform comp lib = mkGenericSharedLibName platform comp (getHSLibraryName lib) @@ -216,7 +205,25 @@ mkStaticLibName :: Platform -> CompilerId -> UnitId -> String mkStaticLibName platform (CompilerId compilerFlavor compilerVersion) lib = "lib" ++ getHSLibraryName lib ++ "-" ++ comp <.> staticLibExtension platform - where comp = display compilerFlavor ++ display compilerVersion + where comp = prettyShow compilerFlavor ++ prettyShow compilerVersion + +-- | Create a library name for a bundled shared library from a given name. +-- This matches the naming convention for shared libraries as implemented in +-- GHC's packageHsLibs function in the Packages module. +-- If the given name is prefixed with HS, then this prepends 'lib' and appends +-- the compiler flavour/version and shared library extension e.g.: +-- "HSrts-1.0" -> "libHSrts-1.0-ghc8.7.20190109.so" +-- Otherwise the given name should be prefixed with 'C', then this strips the +-- 'C', prepends 'lib' and appends the shared library extension e.g.: +-- "Cffi" -> "libffi.so" +mkGenericSharedBundledLibName :: Platform -> CompilerId -> String -> String +mkGenericSharedBundledLibName platform comp lib + | "HS" `isPrefixOf` lib + = mkGenericSharedLibName platform comp lib + | Just lib' <- stripPrefix "C" lib + = "lib" ++ lib' <.> dllExtension platform + | otherwise + = error ("Don't understand library name " ++ lib) -- ------------------------------------------------------------ -- * Platform file extensions diff --git a/cabal/Cabal/Distribution/Simple/BuildTarget.hs b/cabal/Cabal/Distribution/Simple/BuildTarget.hs --- a/cabal/Cabal/Distribution/Simple/BuildTarget.hs +++ b/cabal/Cabal/Distribution/Simple/BuildTarget.hs @@ -49,13 +49,12 @@ import Distribution.PackageDescription import Distribution.ModuleName import Distribution.Simple.LocalBuildInfo -import Distribution.Text +import Distribution.Pretty +import Distribution.Parsec import Distribution.Simple.Utils import Distribution.Verbosity -import qualified Distribution.Compat.ReadP as Parse -import Distribution.Compat.ReadP ( (+++), (<++) ) -import Distribution.ParseUtils ( readPToMaybe ) +import qualified Distribution.Compat.CharParsing as P import Control.Monad ( msum ) import Data.List ( stripPrefix, groupBy, partition ) @@ -180,34 +179,60 @@ ,[UserBuildTarget]) readUserBuildTargets = partitionEithers . map readUserBuildTarget +-- | +-- +-- >>> readUserBuildTarget "comp" +-- Right (UserBuildTargetSingle "comp") +-- +-- >>> readUserBuildTarget "lib:comp" +-- Right (UserBuildTargetDouble "lib" "comp") +-- +-- >>> readUserBuildTarget "pkg:lib:comp" +-- Right (UserBuildTargetTriple "pkg" "lib" "comp") +-- +-- >>> readUserBuildTarget "\"comp\"" +-- Right (UserBuildTargetSingle "comp") +-- +-- >>> readUserBuildTarget "lib:\"comp\"" +-- Right (UserBuildTargetDouble "lib" "comp") +-- +-- >>> readUserBuildTarget "pkg:lib:\"comp\"" +-- Right (UserBuildTargetTriple "pkg" "lib" "comp") +-- +-- >>> readUserBuildTarget "pkg:lib:comp:more" +-- Left (UserBuildTargetUnrecognised "pkg:lib:comp:more") +-- +-- >>> readUserBuildTarget "pkg:\"lib\":comp" +-- Left (UserBuildTargetUnrecognised "pkg:\"lib\":comp") +-- readUserBuildTarget :: String -> Either UserBuildTargetProblem UserBuildTarget readUserBuildTarget targetstr = - case readPToMaybe parseTargetApprox targetstr of - Nothing -> Left (UserBuildTargetUnrecognised targetstr) - Just tgt -> Right tgt + case explicitEitherParsec parseTargetApprox targetstr of + Left _ -> Left (UserBuildTargetUnrecognised targetstr) + Right tgt -> Right tgt where - parseTargetApprox :: Parse.ReadP r UserBuildTarget - parseTargetApprox = - (do a <- tokenQ - return (UserBuildTargetSingle a)) - +++ (do a <- token - _ <- Parse.char ':' - b <- tokenQ - return (UserBuildTargetDouble a b)) - +++ (do a <- token - _ <- Parse.char ':' - b <- token - _ <- Parse.char ':' - c <- tokenQ - return (UserBuildTargetTriple a b c)) + parseTargetApprox :: CabalParsing m => m UserBuildTarget + parseTargetApprox = do + -- read one, two, or three tokens, where last could be "hs-string" + ts <- tokens + return $ case ts of + (a, Nothing) -> UserBuildTargetSingle a + (a, Just (b, Nothing)) -> UserBuildTargetDouble a b + (a, Just (b, Just c)) -> UserBuildTargetTriple a b c - token = Parse.munch1 (\x -> not (isSpace x) && x /= ':') - tokenQ = parseHaskellString <++ token - parseHaskellString :: Parse.ReadP r String - parseHaskellString = Parse.readS_to_P reads + tokens :: CabalParsing m => m (String, Maybe (String, Maybe String)) + tokens = (\s -> (s, Nothing)) <$> parsecHaskellString + <|> (,) <$> token <*> P.optional (P.char ':' *> tokens2) + tokens2 :: CabalParsing m => m (String, Maybe String) + tokens2 = (\s -> (s, Nothing)) <$> parsecHaskellString + <|> (,) <$> token <*> P.optional (P.char ':' *> (parsecHaskellString <|> token)) + + token :: CabalParsing m => m String + token = P.munch1 (\x -> not (isSpace x) && x /= ':') + data UserBuildTargetProblem = UserBuildTargetUnrecognised String deriving Show @@ -346,15 +371,15 @@ where single (BuildTargetComponent cn ) = dispCName cn - single (BuildTargetModule _ m) = display m + single (BuildTargetModule _ m) = prettyShow m single (BuildTargetFile _ f) = f double (BuildTargetComponent cn ) = (dispKind cn, dispCName cn) - double (BuildTargetModule cn m) = (dispCName cn, display m) + double (BuildTargetModule cn m) = (dispCName cn, prettyShow m) double (BuildTargetFile cn f) = (dispCName cn, f) triple (BuildTargetComponent _ ) = error "triple BuildTargetComponent" - triple (BuildTargetModule cn m) = (dispKind cn, dispCName cn, display m) + triple (BuildTargetModule cn m) = (dispKind cn, dispCName cn, prettyShow m) triple (BuildTargetFile cn f) = (dispKind cn, dispCName cn, f) dispCName = componentStringName pkgid @@ -477,8 +502,8 @@ , let bi = componentBuildInfo c ] componentStringName :: Package pkg => pkg -> ComponentName -> ComponentStringName -componentStringName pkg CLibName = display (packageName pkg) -componentStringName _ (CSubLibName name) = unUnqualComponentName name +componentStringName pkg (CLibName LMainLibName ) = prettyShow (packageName pkg) +componentStringName _ (CLibName (LSubLibName name)) = unUnqualComponentName name componentStringName _ (CFLibName name) = unUnqualComponentName name componentStringName _ (CExeName name) = unUnqualComponentName name componentStringName _ (CTestName name) = unUnqualComponentName name @@ -489,7 +514,7 @@ -- a user could very well ask to build a specific signature -- that was inherited from other packages. To fix this -- we have to plumb 'LocalBuildInfo' through this code. --- Fortunately, this is only used by 'pkgComponentInfo' +-- Fortunately, this is only used by 'pkgComponentInfo' -- Please don't export this function unless you plan on fixing -- this. componentModules (CLib lib) = explicitLibModules lib @@ -530,8 +555,7 @@ deriving (Eq, Ord, Show) componentKind :: ComponentName -> ComponentKind -componentKind CLibName = LibKind -componentKind (CSubLibName _) = LibKind +componentKind (CLibName _) = LibKind componentKind (CFLibName _) = FLibKind componentKind (CExeName _) = ExeKind componentKind (CTestName _) = TestKind @@ -659,7 +683,7 @@ orNoSuchThing "module" str $ increaseConfidenceFor $ matchInexactly caseFold - [ (display m, m) + [ (prettyShow m, m) | m <- ms ] str @@ -1005,7 +1029,7 @@ ((cname,reason):_) -> die' verbosity $ formatReason (showComponentName cname) reason for_ [ (c, t) | (c, Just t) <- enabled ] $ \(c, t) -> - warn verbosity $ "Ignoring '" ++ either display id t ++ ". The whole " + warn verbosity $ "Ignoring '" ++ either prettyShow id t ++ ". The whole " ++ showComponentName c ++ " will be processed. (Support for " ++ "module and file targets has not been implemented yet.)" diff --git a/cabal/Cabal/Distribution/Simple/Command.hs b/cabal/Cabal/Distribution/Simple/Command.hs --- a/cabal/Cabal/Distribution/Simple/Command.hs +++ b/cabal/Cabal/Distribution/Simple/Command.hs @@ -56,7 +56,7 @@ option, multiOption, -- ** Liftings & Projections - liftOption, viewAsFieldDescr, + liftOption, -- * Option Descriptions OptDescr(..), Description, SFlags, LFlags, OptFlags, ArgPlaceHolder, @@ -72,13 +72,9 @@ import Distribution.Compat.Prelude hiding (get) import qualified Distribution.GetOpt as GetOpt -import Distribution.Text -import Distribution.ParseUtils import Distribution.ReadE import Distribution.Simple.Utils -import Text.PrettyPrint ( punctuate, cat, comma, text ) -import Text.PrettyPrint as PP ( empty ) data CommandUI flags = CommandUI { -- | The name of the command as it would be entered on the command line. @@ -244,73 +240,6 @@ [ GetOpt.Option sfT lfT (GetOpt.NoArg (set True)) ("Enable " ++ d) , GetOpt.Option sfF lfF (GetOpt.NoArg (set False)) ("Disable " ++ d) ] --- | to view as a FieldDescr, we sort the list of interfaces (Req > Bool > --- Choice > Opt) and consider only the first one. -viewAsFieldDescr :: OptionField a -> FieldDescr a -viewAsFieldDescr (OptionField _n []) = - error "Distribution.command.viewAsFieldDescr: unexpected" -viewAsFieldDescr (OptionField n dd) = FieldDescr n get set - where - optDescr = head $ sortBy cmp dd - - cmp :: OptDescr a -> OptDescr a -> Ordering - ReqArg{} `cmp` ReqArg{} = EQ - ReqArg{} `cmp` _ = GT - BoolOpt{} `cmp` ReqArg{} = LT - BoolOpt{} `cmp` BoolOpt{} = EQ - BoolOpt{} `cmp` _ = GT - ChoiceOpt{} `cmp` ReqArg{} = LT - ChoiceOpt{} `cmp` BoolOpt{} = LT - ChoiceOpt{} `cmp` ChoiceOpt{} = EQ - ChoiceOpt{} `cmp` _ = GT - OptArg{} `cmp` OptArg{} = EQ - OptArg{} `cmp` _ = LT - --- get :: a -> Doc - get t = case optDescr of - ReqArg _ _ _ _ ppr -> - (cat . punctuate comma . map text . ppr) t - - OptArg _ _ _ _ _ ppr -> - case ppr t of [] -> PP.empty - (Nothing : _) -> text "True" - (Just a : _) -> text a - - ChoiceOpt alts -> - fromMaybe PP.empty $ listToMaybe - [ text lf | (_,(_,lf:_), _,enabled) <- alts, enabled t] - - BoolOpt _ _ _ _ enabled -> (maybe PP.empty disp . enabled) t - --- set :: LineNo -> String -> a -> ParseResult a - set line val a = - case optDescr of - ReqArg _ _ _ readE _ -> ($ a) `liftM` runE line n readE val - -- We parse for a single value instead of a - -- list, as one can't really implement - -- parseList :: ReadE a -> ReadE [a] with - -- the current ReadE definition - ChoiceOpt{} -> - case getChoiceByLongFlag optDescr val of - Just f -> return (f a) - _ -> syntaxError line val - - BoolOpt _ _ _ setV _ -> (`setV` a) `liftM` runP line n parse val - - OptArg _ _ _ readE _ _ -> ($ a) `liftM` runE line n readE val - -- Optional arguments are parsed just like - -- required arguments here; we don't - -- provide a method to set an OptArg field - -- to the default value. - -getChoiceByLongFlag :: OptDescr b -> String -> Maybe (b->b) -getChoiceByLongFlag (ChoiceOpt alts) val = listToMaybe - [ set | (_,(_sf,lf:_), set, _) <- alts - , lf == val] - -getChoiceByLongFlag _ _ = - error "Distribution.command.getChoiceByLongFlag: expected a choice option" - getCurrentChoice :: OptDescr a -> a -> [String] getCurrentChoice (ChoiceOpt alts) a = [ lf | (_,(_sf,lf:_), _, currentChoice) <- alts, currentChoice a] @@ -591,7 +520,7 @@ -- | Helper function for creating globalCommand description getNormalCommandDescriptions :: [Command action] -> [(String, String)] -getNormalCommandDescriptions cmds = +getNormalCommandDescriptions cmds = [ (name, description) | Command name description _ NormalCommand <- cmds ] diff --git a/cabal/Cabal/Distribution/Simple/Compiler.hs b/cabal/Cabal/Distribution/Simple/Compiler.hs --- a/cabal/Cabal/Distribution/Simple/Compiler.hs +++ b/cabal/Cabal/Distribution/Simple/Compiler.hs @@ -73,10 +73,10 @@ import Prelude () import Distribution.Compat.Prelude +import Distribution.Pretty import Distribution.Compiler import Distribution.Version -import Distribution.Text import Language.Haskell.Extension import Distribution.Simple.Utils @@ -105,11 +105,11 @@ instance Binary Compiler showCompilerId :: Compiler -> String -showCompilerId = display . compilerId +showCompilerId = prettyShow . compilerId showCompilerIdWithAbi :: Compiler -> String showCompilerIdWithAbi comp = - display (compilerId comp) ++ + prettyShow (compilerId comp) ++ case compilerAbiTag comp of NoAbiTag -> [] AbiTag xs -> '-':xs diff --git a/cabal/Cabal/Distribution/Simple/Configure.hs b/cabal/Cabal/Distribution/Simple/Configure.hs --- a/cabal/Cabal/Distribution/Simple/Configure.hs +++ b/cabal/Cabal/Distribution/Simple/Configure.hs @@ -29,33 +29,31 @@ -- the user, the amount of information displayed depending on the verbosity -- level. -module Distribution.Simple.Configure (configure, - writePersistBuildConfig, - getConfigStateFile, - getPersistBuildConfig, - checkPersistBuildConfigOutdated, - tryGetPersistBuildConfig, - maybeGetPersistBuildConfig, - findDistPref, findDistPrefOrDefault, - getInternalPackages, - computeComponentId, - computeCompatPackageKey, - computeCompatPackageName, - localBuildInfoFile, - getInstalledPackages, - getInstalledPackagesMonitorFiles, - getPackageDBContents, - configCompiler, configCompilerAux, - configCompilerEx, configCompilerAuxEx, - computeEffectiveProfiling, - ccLdOptionsBuildInfo, - checkForeignDeps, - interpretPackageDbFlags, - ConfigStateFileError(..), - tryGetConfigStateFile, - platformDefines, - ) - where +module Distribution.Simple.Configure + ( configure + , writePersistBuildConfig + , getConfigStateFile + , getPersistBuildConfig + , checkPersistBuildConfigOutdated + , tryGetPersistBuildConfig + , maybeGetPersistBuildConfig + , findDistPref, findDistPrefOrDefault + , getInternalPackages + , computeComponentId + , computeCompatPackageKey + , localBuildInfoFile + , getInstalledPackages + , getInstalledPackagesMonitorFiles + , getPackageDBContents + , configCompilerEx, configCompilerAuxEx + , computeEffectiveProfiling + , ccLdOptionsBuildInfo + , checkForeignDeps + , interpretPackageDbFlags + , ConfigStateFileError(..) + , tryGetConfigStateFile + , platformDefines, + ) where import Prelude () import Distribution.Compat.Prelude @@ -83,12 +81,15 @@ import Distribution.Types.ExeDependency import Distribution.Types.LegacyExeDependency import Distribution.Types.PkgconfigDependency -import Distribution.Types.MungedPackageName +import Distribution.Types.PkgconfigVersionRange import Distribution.Types.LocalBuildInfo +import Distribution.Types.LibraryName +import Distribution.Types.LibraryVisibility import Distribution.Types.ComponentRequestedSpec import Distribution.Types.ForeignLib import Distribution.Types.ForeignLibType import Distribution.Types.ForeignLibOption +import Distribution.Types.GivenComponent import Distribution.Types.Mixin import Distribution.Types.UnqualComponentName import Distribution.Simple.Utils @@ -123,8 +124,8 @@ ( partitionEithers ) import qualified Data.Map as Map import System.Directory - ( doesFileExist, createDirectoryIfMissing, getTemporaryDirectory - , removeFile) + ( canonicalizePath, createDirectoryIfMissing, doesFileExist + , getTemporaryDirectory, removeFile) import System.FilePath ( (), isAbsolute, takeDirectory ) import Distribution.Compat.Directory @@ -133,15 +134,19 @@ ( compilerName, compilerVersion ) import System.IO ( hPutStrLn, hClose ) -import Distribution.Text - ( Text(disp), defaultStyle, display, simpleParse ) +import Distribution.Pretty + ( pretty, defaultStyle, prettyShow ) +import Distribution.Parsec + ( simpleParsec ) import Text.PrettyPrint ( Doc, (<+>), ($+$), char, comma, hsep, nest , punctuate, quotes, render, renderStyle, sep, text ) import Distribution.Compat.Environment ( lookupEnv ) import Distribution.Compat.Exception ( catchExit, catchIO ) +import qualified Data.Set as Set + type UseExternalInternalDeps = Bool -- | The errors that can be thrown when reading the @setup-config@ file. @@ -174,12 +179,12 @@ where badCabal = text "• the Cabal version changed from" - <+> disp oldCabal <+> "to" <+> disp currentCabalId + <+> pretty oldCabal <+> "to" <+> pretty currentCabalId badCompiler | oldCompiler == currentCompilerId = mempty | otherwise = text "• the compiler changed from" - <+> disp oldCompiler <+> "to" <+> disp currentCompilerId + <+> pretty oldCompiler <+> "to" <+> pretty currentCompilerId instance Show ConfigStateFileError where show = renderStyle defaultStyle . dispConfigStateFileError @@ -272,9 +277,9 @@ ["Saved", "package", "config", "for", pkgId, "written", "by", cabalId, "using", compId] -> fromMaybe (throw ConfigStateFileBadHeader) $ do - _ <- simpleParse (BLC8.unpack pkgId) :: Maybe PackageIdentifier - cabalId' <- simpleParse (BLC8.unpack cabalId) - compId' <- simpleParse (BLC8.unpack compId) + _ <- simpleParsec (fromUTF8LBS pkgId) :: Maybe PackageIdentifier + cabalId' <- simpleParsec (BLC8.unpack cabalId) + compId' <- simpleParsec (BLC8.unpack compId) return (cabalId', compId') _ -> throw ConfigStateFileNoHeader @@ -283,11 +288,11 @@ -> ByteString showHeader pkgId = BLC8.unwords [ "Saved", "package", "config", "for" - , BLC8.pack $ display pkgId + , toUTF8LBS $ prettyShow pkgId , "written", "by" - , BLC8.pack $ display currentCabalId + , BLC8.pack $ prettyShow currentCabalId , "using" - , BLC8.pack $ display currentCompilerId + , BLC8.pack $ prettyShow currentCompilerId ] -- | Check that localBuildInfoFile is up-to-date with respect to the @@ -349,7 +354,8 @@ _ | null (configArgs cfg) -> return Nothing [cname] -> return (Just cname) [] -> die' verbosity "No valid component targets found" - _ -> die' verbosity "Can only configure either single component or all of them" + _ -> die' verbosity + "Can only configure either single component or all of them" let use_external_internal_deps = isJust mb_cname case mb_cname of @@ -420,9 +426,16 @@ -- Some sanity checks related to enabling components. when (isJust mb_cname && (fromFlag (configTests cfg) || fromFlag (configBenchmarks cfg))) $ - die' verbosity $ "--enable-tests/--enable-benchmarks are incompatible with" ++ + die' verbosity $ + "--enable-tests/--enable-benchmarks are incompatible with" ++ " explicitly specifying a component to configure." + -- Some sanity checks related to dynamic/static linking. + when (fromFlag (configDynExe cfg) && fromFlag (configFullyStaticExe cfg)) $ + die' verbosity $ + "--enable-executable-dynamic and --enable-executable-static" ++ + " are incompatible with each other." + -- allConstraints: The set of all 'Dependency's we have. Used ONLY -- to 'configureFinalizedPackage'. -- requiredDepsMap: A map from 'PackageName' to the specifically @@ -437,7 +450,7 @@ -- that is not possible to configure a test-suite to use one -- version of a dependency, and the executable to use another. (allConstraints :: [Dependency], - requiredDepsMap :: Map PackageName InstalledPackageInfo) + requiredDepsMap :: Map (PackageName, ComponentName) InstalledPackageInfo) <- either (die' verbosity) return $ combinedConstraints (configConstraints cfg) (configDependencies cfg) @@ -465,6 +478,7 @@ (dependencySatisfiable use_external_internal_deps (fromFlagOrDefault False (configExactConfiguration cfg)) + (fromFlagOrDefault False (configAllowDependingOnPrivateLibs cfg)) (packageName pkg_descr0) installedPackageSet internalPackageSet @@ -532,17 +546,18 @@ (enabledBuildInfos pkg_descr enabled) let langs = unsupportedLanguages comp langlist when (not (null langs)) $ - die' verbosity $ "The package " ++ display (packageId pkg_descr0) + die' verbosity $ "The package " ++ prettyShow (packageId pkg_descr0) ++ " requires the following languages which are not " - ++ "supported by " ++ display (compilerId comp) ++ ": " - ++ intercalate ", " (map display langs) - let extlist = nub $ concatMap allExtensions (enabledBuildInfos pkg_descr enabled) + ++ "supported by " ++ prettyShow (compilerId comp) ++ ": " + ++ intercalate ", " (map prettyShow langs) + let extlist = nub $ concatMap allExtensions + (enabledBuildInfos pkg_descr enabled) let exts = unsupportedExtensions comp extlist when (not (null exts)) $ - die' verbosity $ "The package " ++ display (packageId pkg_descr0) + die' verbosity $ "The package " ++ prettyShow (packageId pkg_descr0) ++ " requires the following language extensions which are not " - ++ "supported by " ++ display (compilerId comp) ++ ": " - ++ intercalate ", " (map display exts) + ++ "supported by " ++ prettyShow (compilerId comp) ++ ": " + ++ intercalate ", " (map prettyShow exts) -- Check foreign library build requirements let flibs = [flib | CFLib flib <- enabledComponents pkg_descr enabled] @@ -681,6 +696,8 @@ fromFlagOrDefault False $ configStaticLib cfg withDynExe_ = fromFlag $ configDynExe cfg + + withFullyStaticExe_ = fromFlag $ configFullyStaticExe cfg when (withDynExe_ && not withSharedLib_) $ warn verbosity $ "Executables will use dynamic linking, but a shared library " ++ "is not being built. Linking will fail if any executables " @@ -690,6 +707,27 @@ setCoverageLBI <- configureCoverage verbosity cfg comp + + + -- Turn off library and executable stripping when `debug-info` is set + -- to anything other than zero. + let + strip_libexe s f = + let defaultStrip = fromFlagOrDefault True (f cfg) + in case fromFlag (configDebugInfo cfg) of + NoDebugInfo -> return defaultStrip + _ -> case f cfg of + Flag True -> do + warn verbosity $ "Setting debug-info implies " + ++ s ++ "-stripping: False" + return False + + _ -> return False + + strip_lib <- strip_libexe "library" configStripLibs + strip_exe <- strip_libexe "executable" configStripExes + + let reloc = fromFlagOrDefault False $ configRelocatable cfg let buildComponentsMap = @@ -720,6 +758,7 @@ withSharedLib = withSharedLib_, withStaticLib = withStaticLib_, withDynExe = withDynExe_, + withFullyStaticExe = withFullyStaticExe_, withProfLib = False, withProfLibDetail = ProfDetailNone, withProfExe = False, @@ -730,8 +769,8 @@ configGHCiLib cfg, splitSections = split_sections, splitObjs = split_objs, - stripExes = fromFlag $ configStripExes cfg, - stripLibs = fromFlag $ configStripLibs cfg, + stripExes = strip_exe, + stripLibs = strip_lib, exeCoverage = False, libCoverage = False, withPackageDB = packageDbs, @@ -764,10 +803,11 @@ ++ " will not work if you rely on the Path_* module " ++ " or other hard coded paths. Cabal does not yet " ++ " support fully relocatable builds! " - ++ " See #462 #2302 #2994 #3305 #3473 #3586 #3909 #4097 #4291 #4872" + ++ " See #462 #2302 #2994 #3305 #3473 #3586 #3909" + ++ " #4097 #4291 #4872" - info verbosity $ "Using " ++ display currentCabalId - ++ " compiled by " ++ display currentCompilerId + info verbosity $ "Using " ++ prettyShow currentCabalId + ++ " compiled by " ++ prettyShow currentCompilerId info verbosity $ "Using compiler: " ++ showCompilerId comp info verbosity $ "Using install prefix: " ++ prefix dirs @@ -828,7 +868,8 @@ -- | Sanity check: if '--exact-configuration' was given, ensure that the -- complete flag assignment was specified on the command line. -checkExactConfiguration :: Verbosity -> GenericPackageDescription -> ConfigFlags -> IO () +checkExactConfiguration + :: Verbosity -> GenericPackageDescription -> ConfigFlags -> IO () checkExactConfiguration verbosity pkg_descr0 cfg = when (fromFlagOrDefault False (configExactConfiguration cfg)) $ do let cmdlineFlags = map fst (unFlagAssignment (configConfigurationsFlags cfg)) @@ -854,8 +895,8 @@ -- TODO: some day, executables will be fair game here too! let pkg_descr = flattenPackageDescription pkg_descr0 f lib = case libName lib of - Nothing -> (packageName pkg_descr, Nothing) - Just n' -> (unqualComponentNameToPackageName n', Just n') + LMainLibName -> (packageName pkg_descr, Nothing) + LSubLibName n' -> (unqualComponentNameToPackageName n', Just n') in Map.fromList (map f (allLibraries pkg_descr)) -- | Returns true if a dependency is satisfiable. This function may @@ -864,15 +905,19 @@ dependencySatisfiable :: Bool -- ^ use external internal deps? -> Bool -- ^ exact configuration? + -> Bool -- ^ allow depending on private libs? -> PackageName -> InstalledPackageIndex -- ^ installed set -> Map PackageName (Maybe UnqualComponentName) -- ^ internal set - -> Map PackageName InstalledPackageInfo -- ^ required dependencies + -> Map (PackageName, ComponentName) InstalledPackageInfo + -- ^ required dependencies -> (Dependency -> Bool) dependencySatisfiable use_external_internal_deps - exact_config pn installedPackageSet internalPackageSet requiredDepsMap - d@(Dependency depName vr) + exact_config + allow_private_deps + pn installedPackageSet internalPackageSet requiredDepsMap + (Dependency depName vr sublibs) | exact_config -- When we're given '--exact-configuration', we assume that all @@ -887,8 +932,16 @@ -- Except for internal deps, when we're NOT per-component mode; -- those are just True. then True - else depName `Map.member` requiredDepsMap + else + -- Backward compatibility for the old sublibrary syntax + (sublibs == Set.singleton LMainLibName + && Map.member + (pn, CLibName $ LSubLibName $ + packageNameToUnqualComponentName depName) + requiredDepsMap) + || all visible sublibs + | isInternalDep = if use_external_internal_deps -- When we are doing per-component configure, we now need to @@ -906,18 +959,35 @@ isInternalDep = Map.member depName internalPackageSet depSatisfiable = - not . null $ PackageIndex.lookupDependency installedPackageSet d + not . null $ PackageIndex.lookupDependency installedPackageSet depName vr internalDepSatisfiable = not . null $ PackageIndex.lookupInternalDependency - installedPackageSet (Dependency pn vr) cn + installedPackageSet pn vr cn where cn | pn == depName - = Nothing + = LMainLibName | otherwise -- Reinterpret the "package name" as an unqualified component -- name - = Just (mkUnqualComponentName (unPackageName depName)) + = LSubLibName $ packageNameToUnqualComponentName depName + -- Check whether a libray exists and is visible. + -- We don't disambiguate between dependency on non-existent or private + -- library yet, so we just return a bool and later report a generic error. + visible lib = maybe + False -- Does not even exist (wasn't in the depsMap) + (\ipi -> Installed.libVisibility ipi == LibraryVisibilityPublic + -- If the override is enabled, the visibility does + -- not matter (it's handled externally) + || allow_private_deps + -- If it's a library of the same package then it's + -- always visible. + -- This is only triggered when passing a component + -- of the same package as --dependency, such as in: + -- cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit.test.hs + || pkgName (Installed.sourcePackageId ipi) == pn) + maybeIPI + where maybeIPI = Map.lookup (depName, CLibName lib) requiredDepsMap -- | Finalize a generic package description. The workhorse is -- 'finalizePD' but there's a bit of other nattering @@ -950,9 +1020,9 @@ pkg_descr0 of Right r -> return r Left missing -> - die' verbosity $ "Encountered missing dependencies:\n" + die' verbosity $ "Encountered missing or private dependencies:\n" ++ (render . nest 4 . sep . punctuate comma - . map (disp . simplifyDependency) + . map (pretty . simplifyDependency) $ missing) -- add extra include/lib dirs as specified in cfg @@ -961,7 +1031,7 @@ unless (nullFlagAssignment flags) $ info verbosity $ "Flags chosen: " - ++ intercalate ", " [ unFlagName fn ++ "=" ++ display value + ++ intercalate ", " [ unFlagName fn ++ "=" ++ prettyShow value | (fn, value) <- unFlagAssignment flags ] return (pkg_descr, flags) @@ -990,23 +1060,27 @@ } -- | Check for use of Cabal features which require compiler support -checkCompilerProblems :: Verbosity -> Compiler -> PackageDescription -> ComponentRequestedSpec -> IO () +checkCompilerProblems + :: Verbosity -> Compiler -> PackageDescription -> ComponentRequestedSpec -> IO () checkCompilerProblems verbosity comp pkg_descr enabled = do unless (renamingPackageFlagsSupported comp || - all (all (isDefaultIncludeRenaming . mixinIncludeRenaming) . mixins) + all (all (isDefaultIncludeRenaming . mixinIncludeRenaming) . mixins) (enabledBuildInfos pkg_descr enabled)) $ - die' verbosity $ "Your compiler does not support thinning and renaming on " + die' verbosity $ + "Your compiler does not support thinning and renaming on " ++ "package flags. To use this feature you must use " ++ "GHC 7.9 or later." when (any (not.null.PD.reexportedModules) (PD.allLibraries pkg_descr) && not (reexportedModulesSupported comp)) $ - die' verbosity $ "Your compiler does not support module re-exports. To use " - ++ "this feature you must use GHC 7.9 or later." + die' verbosity $ + "Your compiler does not support module re-exports. To use " + ++ "this feature you must use GHC 7.9 or later." when (any (not.null.PD.signatures) (PD.allLibraries pkg_descr) && not (backpackSupported comp)) $ - die' verbosity $ "Your compiler does not support Backpack. To use " + die' verbosity $ + "Your compiler does not support Backpack. To use " ++ "this feature you must use GHC 8.1 or later." -- | Select dependencies for the package. @@ -1015,7 +1089,7 @@ -> UseExternalInternalDeps -> Map PackageName (Maybe UnqualComponentName) -- ^ internal packages -> InstalledPackageIndex -- ^ installed packages - -> Map PackageName InstalledPackageInfo -- ^ required deps + -> Map (PackageName, ComponentName) InstalledPackageInfo -- ^ required deps -> PackageDescription -> ComponentRequestedSpec -> IO [PreExistingComponent] @@ -1023,8 +1097,8 @@ internalPackageSet installedPackageSet requiredDepsMap pkg_descr enableSpec = do let failedDeps :: [FailedDependency] allPkgDeps :: [ResolvedDependency] - (failedDeps, allPkgDeps) = partitionEithers - [ (\s -> (dep, s)) <$> status + (failedDeps, allPkgDeps) = partitionEithers $ concat + [ fmap (\s -> (dep, s)) <$> status | dep <- enabledBuildDepends pkg_descr enableSpec , let status = selectDependency (package pkg_descr) internalPackageSet installedPackageSet @@ -1041,7 +1115,7 @@ when (not (null internalPkgDeps) && not (newPackageDepsBehaviour pkg_descr)) $ die' verbosity $ "The field 'build-depends: " - ++ intercalate ", " (map (display . packageName) internalPkgDeps) + ++ intercalate ", " (map (prettyShow . packageName) internalPkgDeps) ++ "' refers to a library which is defined within the same " ++ "package. To use this feature the package must specify at " ++ "least 'cabal-version: >= 1.8'." @@ -1163,7 +1237,7 @@ UserSpecified p -> " given by user at: " ++ p version = case programVersion configuredProg of Nothing -> "" - Just v -> " version " ++ display v + Just v -> " version " ++ prettyShow v hackageUrl :: String hackageUrl = "http://hackage.haskell.org/package/" @@ -1189,16 +1263,16 @@ selectDependency :: PackageId -- ^ Package id of current package -> Map PackageName (Maybe UnqualComponentName) -> InstalledPackageIndex -- ^ Installed packages - -> Map PackageName InstalledPackageInfo + -> Map (PackageName, ComponentName) InstalledPackageInfo -- ^ Packages for which we have been given specific deps to -- use -> UseExternalInternalDeps -- ^ Are we configuring a -- single component? -> Dependency - -> Either FailedDependency DependencyResolution + -> [Either FailedDependency DependencyResolution] selectDependency pkgid internalIndex installedIndex requiredDepsMap use_external_internal_deps - dep@(Dependency dep_pkgname vr) = + (Dependency dep_pkgname vr libs) = -- If the dependency specification matches anything in the internal package -- index, then we prefer that match to anything in the second. -- For example: @@ -1213,38 +1287,43 @@ -- We want "build-depends: MyLibrary" always to match the internal library -- even if there is a newer installed library "MyLibrary-0.2". case Map.lookup dep_pkgname internalIndex of - Just cname -> if use_external_internal_deps - then do_external (Just cname) - else do_internal - _ -> do_external Nothing + Just cname -> + if use_external_internal_deps + then do_external (Just $ maybeToLibraryName cname) <$> Set.toList libs + else do_internal + _ -> + do_external Nothing <$> Set.toList libs where -- It's an internal library, and we're not per-component build - do_internal = Right $ InternalDependency - $ PackageIdentifier dep_pkgname $ packageVersion pkgid + do_internal = [Right $ InternalDependency + $ PackageIdentifier dep_pkgname $ packageVersion pkgid] -- We have to look it up externally - do_external is_internal = do - ipi <- case Map.lookup dep_pkgname requiredDepsMap of + do_external :: Maybe LibraryName -> LibraryName -> Either FailedDependency DependencyResolution + do_external is_internal lib = do + ipi <- case Map.lookup (dep_pkgname, CLibName lib) requiredDepsMap of -- If we know the exact pkg to use, then use it. Just pkginstance -> Right pkginstance -- Otherwise we just pick an arbitrary instance of the latest version. Nothing -> case is_internal of - Nothing -> do_external_external - Just mb_uqn -> do_external_internal mb_uqn + Nothing -> do_external_external + Just ln -> do_external_internal ln return $ ExternalDependency $ ipiToPreExistingComponent ipi -- It's an external package, normal situation do_external_external = - case PackageIndex.lookupDependency installedIndex dep of + case PackageIndex.lookupDependency installedIndex dep_pkgname vr of [] -> Left (DependencyNotExists dep_pkgname) pkgs -> Right $ head $ snd $ last pkgs -- It's an internal library, being looked up externally - do_external_internal mb_uqn = + do_external_internal + :: LibraryName -> Either FailedDependency InstalledPackageInfo + do_external_internal ln = case PackageIndex.lookupInternalDependency installedIndex - (Dependency (packageName pkgid) vr) mb_uqn of + (packageName pkgid) vr ln of [] -> Left (DependencyMissingInternal dep_pkgname (packageName pkgid)) pkgs -> Right $ head $ snd $ last pkgs @@ -1252,8 +1331,8 @@ -> [ResolvedDependency] -> IO () reportSelectedDependencies verbosity deps = info verbosity $ unlines - [ "Dependency " ++ display (simplifyDependency dep) - ++ ": using " ++ display pkgid + [ "Dependency " ++ prettyShow (simplifyDependency dep) + ++ ": using " ++ prettyShow pkgid | (dep, resolution) <- deps , let pkgid = case resolution of ExternalDependency pkg' -> packageId pkg' @@ -1266,17 +1345,17 @@ where reportFailedDependency (DependencyNotExists pkgname) = - "there is no version of " ++ display pkgname ++ " installed.\n" + "there is no version of " ++ prettyShow pkgname ++ " installed.\n" ++ "Perhaps you need to download and install it from\n" - ++ hackageUrl ++ display pkgname ++ "?" + ++ hackageUrl ++ prettyShow pkgname ++ "?" reportFailedDependency (DependencyMissingInternal pkgname real_pkgname) = - "internal dependency " ++ display pkgname ++ " not installed.\n" + "internal dependency " ++ prettyShow pkgname ++ " not installed.\n" ++ "Perhaps you need to configure and install it first?\n" - ++ "(This library was defined by " ++ display real_pkgname ++ ")" + ++ "(This library was defined by " ++ prettyShow real_pkgname ++ ")" reportFailedDependency (DependencyNoVersion dep) = - "cannot satisfy dependency " ++ display (simplifyDependency dep) ++ "\n" + "cannot satisfy dependency " ++ prettyShow (simplifyDependency dep) ++ "\n" -- | List all installed packages in the given package databases. -- Non-existent package databases do not cause errors, they just get skipped @@ -1302,7 +1381,7 @@ HaskellSuite {} -> HaskellSuite.getInstalledPackages verbosity packageDBs' progdb flv -> die' verbosity $ "don't know how to find the installed packages for " - ++ display flv + ++ prettyShow flv where packageDBExists (SpecificPackageDB path) = do exists <- doesPathExist path @@ -1346,7 +1425,7 @@ verbosity platform progdb packageDBs other -> do warn verbosity $ "don't know how to find change monitoring files for " - ++ "the installed package databases for " ++ display other + ++ "the installed package databases for " ++ prettyShow other return [] -- | The user interface specifies the package dbs to use with a combination of @@ -1375,11 +1454,12 @@ -- But after finalising we then have to make sure we pick the right specific -- deps in the end. So we still need to remember which installed packages to -- pick. -combinedConstraints :: [Dependency] -> - [(PackageName, ComponentId)] -> - InstalledPackageIndex -> - Either String ([Dependency], - Map PackageName InstalledPackageInfo) +combinedConstraints + :: [Dependency] + -> [GivenComponent] + -> InstalledPackageIndex + -> Either String ([Dependency], + Map (PackageName, ComponentName) InstalledPackageInfo) combinedConstraints constraints dependencies installedPackages = do when (not (null badComponentIds)) $ @@ -1395,21 +1475,21 @@ allConstraints :: [Dependency] allConstraints = constraints ++ [ thisPackageVersion (packageId pkg) - | (_, _, Just pkg) <- dependenciesPkgInfo ] + | (_, _, _, Just pkg) <- dependenciesPkgInfo ] - idConstraintMap :: Map PackageName InstalledPackageInfo + idConstraintMap :: Map (PackageName, ComponentName) InstalledPackageInfo idConstraintMap = Map.fromList -- NB: do NOT use the packageName from -- dependenciesPkgInfo! - [ (pn, pkg) - | (pn, _, Just pkg) <- dependenciesPkgInfo ] + [ ((pn, cname), pkg) + | (pn, cname, _, Just pkg) <- dependenciesPkgInfo ] -- The dependencies along with the installed package info, if it exists - dependenciesPkgInfo :: [(PackageName, ComponentId, + dependenciesPkgInfo :: [(PackageName, ComponentName, ComponentId, Maybe InstalledPackageInfo)] dependenciesPkgInfo = - [ (pkgname, cid, mpkg) - | (pkgname, cid) <- dependencies + [ (pkgname, CLibName lname, cid, mpkg) + | GivenComponent pkgname lname cid <- dependencies , let mpkg = PackageIndex.lookupComponentId installedPackages cid ] @@ -1418,13 +1498,20 @@ -- (i.e. someone has written a hash) and didn't find it then it's -- an error. badComponentIds = - [ (pkgname, cid) - | (pkgname, cid, Nothing) <- dependenciesPkgInfo ] + [ (pkgname, cname, cid) + | (pkgname, cname, cid, Nothing) <- dependenciesPkgInfo ] dispDependencies deps = - hsep [ text "--dependency=" - <<>> quotes (disp pkgname <<>> char '=' <<>> disp cid) - | (pkgname, cid) <- deps ] + hsep [ text "--dependency=" + <<>> quotes + (pretty pkgname + <<>> case cname of + CLibName LMainLibName -> "" + CLibName (LSubLibName n) -> ":" <<>> pretty n + _ -> ":" <<>> pretty cname + <<>> char '=' + <<>> pretty cid) + | (pkgname, cname, cid) <- deps ] -- ----------------------------------------------------------------------------- -- Configuring program dependencies @@ -1526,10 +1613,13 @@ version <- pkgconfig ["--modversion", pkg] `catchIO` (\_ -> die' verbosity notFound) `catchExit` (\_ -> die' verbosity notFound) - case simpleParse version of - Nothing -> die' verbosity "parsing output of pkg-config --modversion failed" - Just v | not (withinRange v range) -> die' verbosity (badVersion v) - | otherwise -> info verbosity (depSatisfied v) + case simpleParsec version of + Nothing -> die' verbosity + "parsing output of pkg-config --modversion failed" + Just v | not (withinPkgconfigVersionRange v range) -> + die' verbosity (badVersion v) + | otherwise -> + info verbosity (depSatisfied v) where notFound = "The pkg-config package '" ++ pkg ++ "'" ++ versionRequirement @@ -1537,13 +1627,13 @@ badVersion v = "The pkg-config package '" ++ pkg ++ "'" ++ versionRequirement ++ " is required but the version installed on the" - ++ " system is version " ++ display v - depSatisfied v = "Dependency " ++ display dep - ++ ": using version " ++ display v + ++ " system is version " ++ prettyShow v + depSatisfied v = "Dependency " ++ prettyShow dep + ++ ": using version " ++ prettyShow v versionRequirement - | isAnyVersion range = "" - | otherwise = " version " ++ display range + | isAnyPkgconfigVersion range = "" + | otherwise = " version " ++ prettyShow range pkg = unPkgconfigName pkgn @@ -1571,7 +1661,7 @@ pkgconfigBuildInfo :: [PkgconfigDependency] -> NoCallStackIO BuildInfo pkgconfigBuildInfo [] = return mempty pkgconfigBuildInfo pkgdeps = do - let pkgs = nub [ display pkg | PkgconfigDependency pkg _ <- pkgdeps ] + let pkgs = nub [ prettyShow pkg | PkgconfigDependency pkg _ <- pkgdeps ] ccflags <- pkgconfig ("--cflags" : pkgs) ldflags <- pkgconfig ("--libs" : pkgs) return (ccLdOptionsBuildInfo (words ccflags) (words ldflags)) @@ -1625,25 +1715,6 @@ _ -> die' verbosity "Unknown compiler" return (comp, fromMaybe buildPlatform maybePlatform, programDb) --- Ideally we would like to not have separate configCompiler* and --- configCompiler*Ex sets of functions, but there are many custom setup scripts --- in the wild that are using them, so the versions with old types are kept for --- backwards compatibility. Platform was added to the return triple in 1.18. - -{-# DEPRECATED configCompiler - "'configCompiler' is deprecated. Use 'configCompilerEx' instead." #-} -configCompiler :: Maybe CompilerFlavor -> Maybe FilePath -> Maybe FilePath - -> ProgramDb -> Verbosity - -> IO (Compiler, ProgramDb) -configCompiler mFlavor hcPath hcPkg progdb verbosity = - fmap (\(a,_,b) -> (a,b)) $ configCompilerEx mFlavor hcPath hcPkg progdb verbosity - -{-# DEPRECATED configCompilerAux - "configCompilerAux is deprecated. Use 'configCompilerAuxEx' instead." #-} -configCompilerAux :: ConfigFlags - -> IO (Compiler, ProgramDb) -configCompilerAux = fmap (\(a,_,b) -> (a,b)) . configCompilerAuxEx - -- ----------------------------------------------------------------------------- -- Testing C lib and header dependencies @@ -1685,11 +1756,11 @@ let relIncDirs = filter (not . isAbsolute) (collectField PD.includeDirs) isHeader = isSuffixOf ".h" genHeaders <- forM relIncDirs $ \dir -> - fmap (dir ) . filter isHeader <$> listDirectory (buildDir lbi dir) - `catchIO` (\_ -> return []) + fmap (dir ) . filter isHeader <$> + listDirectory (buildDir lbi dir) `catchIO` (\_ -> return []) srcHeaders <- forM relIncDirs $ \dir -> - fmap (dir ) . filter isHeader <$> listDirectory (baseDir lbi dir) - `catchIO` (\_ -> return []) + fmap (dir ) . filter isHeader <$> + listDirectory (baseDir lbi dir) `catchIO` (\_ -> return []) let commonHeaders = concat genHeaders `intersect` concat srcHeaders forM_ commonHeaders $ \hdr -> do warn verbosity $ "Duplicate header found in " @@ -1733,11 +1804,14 @@ -- should NOT be glomming everything together.) ++ [ "-I" ++ buildDir lbi "autogen" ] -- `configure' may generate headers in the build directory - ++ [ "-I" ++ buildDir lbi dir | dir <- ordNub (collectField PD.includeDirs) - , not (isAbsolute dir)] - -- we might also reference headers from the packages directory. - ++ [ "-I" ++ baseDir lbi dir | dir <- ordNub (collectField PD.includeDirs) - , not (isAbsolute dir)] + ++ [ "-I" ++ buildDir lbi dir + | dir <- ordNub (collectField PD.includeDirs) + , not (isAbsolute dir)] + -- we might also reference headers from the + -- packages directory. + ++ [ "-I" ++ baseDir lbi dir + | dir <- ordNub (collectField PD.includeDirs) + , not (isAbsolute dir)] ++ [ "-I" ++ dir | dir <- ordNub (collectField PD.includeDirs) , isAbsolute dir] ++ ["-I" ++ baseDir lbi] @@ -1760,7 +1834,8 @@ | dep <- deps , opt <- Installed.ccOptions dep ] - commonLdArgs = [ "-L" ++ dir | dir <- ordNub (collectField PD.extraLibDirs) ] + commonLdArgs = [ "-L" ++ dir + | dir <- ordNub (collectField PD.extraLibDirs) ] ++ collectField PD.ldOptions ++ [ "-L" ++ dir | dir <- ordNub [ dir @@ -1813,7 +1888,8 @@ ++ case libs of [] -> [] [lib] -> ["* Missing (or bad) C library: " ++ lib] - _ -> ["* Missing (or bad) C libraries: " ++ intercalate ", " libs] + _ -> ["* Missing (or bad) C libraries: " ++ + intercalate ", " libs] ++ [if plural then messagePlural else messageSingular | missing] ++ case hdr of Just (Left _) -> [ headerCppMessage ] @@ -1895,7 +1971,7 @@ -- Distribution.Simple.GHC.getRPaths checkOS = unless (os `elem` [ OSX, Linux ]) - $ die' verbosity $ "Operating system: " ++ display os ++ + $ die' verbosity $ "Operating system: " ++ prettyShow os ++ ", does not support relocatable builds" where (Platform _ os) = hostPlatform lbi @@ -1934,8 +2010,13 @@ where doCheck pkgr ipkg | maybe False (== pkgr) (Installed.pkgRoot ipkg) - = traverse_ (\l -> when (isNothing $ stripPrefix p l) (die' verbosity (msg l))) - (Installed.libraryDirs ipkg) + = forM_ (Installed.libraryDirs ipkg) $ \libdir -> do + -- When @prefix@ is not under @pkgroot@, + -- @shortRelativePath prefix pkgroot@ will return a path with + -- @..@s and following check will fail without @canonicalizePath@. + canonicalized <- canonicalizePath libdir + unless (p `isPrefixOf` canonicalized) $ + die' verbosity $ msg libdir | otherwise = return () -- NB: should be good enough to check this against the default @@ -1970,8 +2051,7 @@ goGhcPlatform :: Platform -> Maybe String goGhcPlatform (Platform X86_64 OSX ) = goGhcOsx (foreignLibType flib) - goGhcPlatform (Platform I386 Linux ) = goGhcLinux (foreignLibType flib) - goGhcPlatform (Platform X86_64 Linux ) = goGhcLinux (foreignLibType flib) + goGhcPlatform (Platform _ Linux ) = goGhcLinux (foreignLibType flib) goGhcPlatform (Platform I386 Windows) = goGhcWindows (foreignLibType flib) goGhcPlatform (Platform X86_64 Windows) = goGhcWindows (foreignLibType flib) goGhcPlatform _ = unsupported [ diff --git a/cabal/Cabal/Distribution/Simple/Doctest.hs b/cabal/Cabal/Distribution/Simple/Doctest.hs --- a/cabal/Cabal/Distribution/Simple/Doctest.hs +++ b/cabal/Cabal/Distribution/Simple/Doctest.hs @@ -136,7 +136,7 @@ then return vanillaOpts else if withSharedLib lbi then return sharedOpts - else die' verbosity $ "Must have vanilla or shared lirbaries " + else die' verbosity $ "Must have vanilla or shared libraries " ++ "enabled in order to run doctest" ghcVersion <- maybe (die' verbosity "Compiler has no GHC version") return diff --git a/cabal/Cabal/Distribution/Simple/GHC.hs b/cabal/Cabal/Distribution/Simple/GHC.hs --- a/cabal/Cabal/Distribution/Simple/GHC.hs +++ b/cabal/Cabal/Distribution/Simple/GHC.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE CPP #-} @@ -101,7 +102,7 @@ import Distribution.Version import Distribution.System import Distribution.Verbosity -import Distribution.Text +import Distribution.Pretty import Distribution.Types.ForeignLib import Distribution.Types.ForeignLibType import Distribution.Types.ForeignLibOption @@ -109,12 +110,12 @@ import Distribution.Utils.NubList import Language.Haskell.Extension -import Control.Monad (msum) +import Control.Monad (msum, forM_) import Data.Char (isLower) import qualified Data.Map as Map import System.Directory ( doesFileExist, getAppUserDataDirectory, createDirectoryIfMissing - , canonicalizePath, removeFile, renameFile ) + , canonicalizePath, removeFile, renameFile, getDirectoryContents ) import System.FilePath ( (), (<.>), takeExtension , takeDirectory, replaceExtension ,isRelative ) @@ -137,12 +138,12 @@ (userMaybeSpecifyPath "ghc" hcPath conf0) let implInfo = ghcVersionImplInfo ghcVersion - -- Cabal currently supports ghc >= 7.0.1 && < 8.7 - unless (ghcVersion < mkVersion [8,7]) $ + -- Cabal currently supports ghc >= 7.0.1 && < 8.10 + unless (ghcVersion < mkVersion [8,10]) $ warn verbosity $ "Unknown/unsupported 'ghc' version detected " - ++ "(Cabal " ++ display cabalVersion ++ " supports 'ghc' version < 8.7): " - ++ programPath ghcProg ++ " is version " ++ display ghcVersion + ++ "(Cabal " ++ prettyShow cabalVersion ++ " supports 'ghc' version < 8.10): " + ++ programPath ghcProg ++ " is version " ++ prettyShow ghcVersion -- This is slightly tricky, we have to configure ghc first, then we use the -- location of ghc to help find ghc-pkg in the case that the user did not @@ -155,8 +156,8 @@ when (ghcVersion /= ghcPkgVersion) $ die' verbosity $ "Version mismatch between ghc and ghc-pkg: " - ++ programPath ghcProg ++ " is version " ++ display ghcVersion ++ " " - ++ programPath ghcPkgProg ++ " is version " ++ display ghcPkgVersion + ++ programPath ghcProg ++ " is version " ++ prettyShow ghcVersion ++ " " + ++ programPath ghcPkgProg ++ " is version " ++ prettyShow ghcPkgVersion -- Likewise we try to find the matching hsc2hs and haddock programs. let hsc2hsProgram' = hsc2hsProgram { @@ -383,7 +384,8 @@ getProgramOutput verbosity ghcProg ["--print-global-package-db"] -- | Return the 'FilePath' to the per-user GHC package database. -getUserPackageDB :: Verbosity -> ConfiguredProgram -> Platform -> NoCallStackIO FilePath +getUserPackageDB + :: Verbosity -> ConfiguredProgram -> Platform -> NoCallStackIO FilePath getUserPackageDB _verbosity ghcProg platform = do -- It's rather annoying that we have to reconstruct this, because ghc -- hides this information from us otherwise. But for certain use cases @@ -421,9 +423,10 @@ | GlobalPackageDB `notElem` rest = return () checkPackageDbStackPre76 verbosity rest | GlobalPackageDB `notElem` rest = - die' verbosity $ "With current ghc versions the global package db is always used " + die' verbosity $ + "With current ghc versions the global package db is always used " ++ "and must be listed first. This ghc limitation is lifted in GHC 7.6," - ++ "see http://hackage.haskell.org/trac/ghc/ticket/5977" + ++ "see http://ghc.haskell.org/trac/ghc/ticket/5977" checkPackageDbStackPre76 verbosity _ = die' verbosity $ "If the global package db is specified, it must be " ++ "specified first and cannot be specified multiple times" @@ -532,7 +535,7 @@ -- has the package name. I'm going to avoid changing this for -- now, but it would probably be better for this to be the -- component ID instead... - pkg_name = display (PD.package pkg_descr) + pkg_name = prettyShow (PD.package pkg_descr) distPref = fromFlag $ configDistPref $ configFlags lbi hpcdir way | forRepl = mempty -- HPC is not supported in ghci @@ -542,7 +545,8 @@ createDirectoryIfMissingVerbose verbosity True libTargetDir -- TODO: do we need to put hs-boot files into place for mutually recursive -- modules? - let cLikeFiles = fromNubListR $ toNubListR (cSources libBi) <> toNubListR (cxxSources libBi) + let cLikeFiles = fromNubListR $ + toNubListR (cSources libBi) <> toNubListR (cxxSources libBi) cObjs = map (`replaceExtension` objExtension) cLikeFiles baseOpts = componentGhcOptions verbosity lbi libBi clbi libTargetDir vanillaOpts = baseOpts `mappend` mempty { @@ -571,11 +575,18 @@ ghcOptHPCDir = hpcdir Hpc.Dyn } linkerOpts = mempty { - ghcOptLinkOptions = PD.ldOptions libBi, + ghcOptLinkOptions = PD.ldOptions libBi + ++ [ "-static" + | withFullyStaticExe lbi ] + -- Pass extra `ld-options` given + -- through to GHC's linker. + ++ maybe [] programOverrideArgs + (lookupProgram ldProgram (withPrograms lbi)), ghcOptLinkLibs = extraLibs libBi, ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi, ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi, - ghcOptLinkFrameworkDirs = toNubListR $ PD.extraFrameworkDirs libBi, + ghcOptLinkFrameworkDirs = toNubListR $ + PD.extraFrameworkDirs libBi, ghcOptInputFiles = toNubListR [libTargetDir x | x <- cObjs] } @@ -698,19 +709,24 @@ -- link: when has_code . unless forRepl $ do info verbosity "Linking..." - let cProfObjs = map (`replaceExtension` ("p_" ++ objExtension)) - (cSources libBi ++ cxxSources libBi) - cSharedObjs = map (`replaceExtension` ("dyn_" ++ objExtension)) - (cSources libBi ++ cxxSources libBi) - compiler_id = compilerId (compiler lbi) - vanillaLibFilePath = libTargetDir mkLibName uid - profileLibFilePath = libTargetDir mkProfLibName uid - sharedLibFilePath = libTargetDir mkSharedLibName (hostPlatform lbi) compiler_id uid - staticLibFilePath = libTargetDir mkStaticLibName (hostPlatform lbi) compiler_id uid - ghciLibFilePath = libTargetDir Internal.mkGHCiLibName uid - ghciProfLibFilePath = libTargetDir Internal.mkGHCiProfLibName uid - libInstallPath = libdir $ absoluteComponentInstallDirs pkg_descr lbi uid NoCopyDest - sharedLibInstallPath = libInstallPath mkSharedLibName (hostPlatform lbi) compiler_id uid + let cProfObjs = map (`replaceExtension` ("p_" ++ objExtension)) + (cSources libBi ++ cxxSources libBi) + cSharedObjs = map (`replaceExtension` ("dyn_" ++ objExtension)) + (cSources libBi ++ cxxSources libBi) + compiler_id = compilerId (compiler lbi) + vanillaLibFilePath = libTargetDir mkLibName uid + profileLibFilePath = libTargetDir mkProfLibName uid + sharedLibFilePath = libTargetDir + mkSharedLibName (hostPlatform lbi) compiler_id uid + staticLibFilePath = libTargetDir + mkStaticLibName (hostPlatform lbi) compiler_id uid + ghciLibFilePath = libTargetDir Internal.mkGHCiLibName uid + ghciProfLibFilePath = libTargetDir Internal.mkGHCiProfLibName uid + libInstallPath = libdir $ + absoluteComponentInstallDirs + pkg_descr lbi uid NoCopyDest + sharedLibInstallPath = libInstallPath + mkSharedLibName (hostPlatform lbi) compiler_id uid stubObjs <- catMaybes <$> sequenceA [ findFileWithExtension [objExtension] [libTargetDir] @@ -781,13 +797,15 @@ -> toFlag pk _ -> mempty, ghcOptThisComponentId = case clbi of - LibComponentLocalBuildInfo { componentInstantiatedWith = insts } -> + LibComponentLocalBuildInfo + { componentInstantiatedWith = insts } -> if null insts then mempty else toFlag (componentComponentId clbi) _ -> mempty, ghcOptInstantiatedWith = case clbi of - LibComponentLocalBuildInfo { componentInstantiatedWith = insts } + LibComponentLocalBuildInfo + { componentInstantiatedWith = insts } -> insts _ -> [], ghcOptPackages = toNubListR $ @@ -813,13 +831,15 @@ -> toFlag pk _ -> mempty, ghcOptThisComponentId = case clbi of - LibComponentLocalBuildInfo { componentInstantiatedWith = insts } -> + LibComponentLocalBuildInfo + { componentInstantiatedWith = insts } -> if null insts then mempty else toFlag (componentComponentId clbi) _ -> mempty, ghcOptInstantiatedWith = case clbi of - LibComponentLocalBuildInfo { componentInstantiatedWith = insts } + LibComponentLocalBuildInfo + { componentInstantiatedWith = insts } -> insts _ -> [], ghcOptPackages = toNubListR $ @@ -941,8 +961,10 @@ (Windows, ForeignLibNativeShared) -> nm <.> "dll" (Windows, ForeignLibNativeStatic) -> nm <.> "lib" (Linux, ForeignLibNativeShared) -> "lib" ++ nm <.> versionedExt - (_other, ForeignLibNativeShared) -> "lib" ++ nm <.> dllExtension (hostPlatform lbi) - (_other, ForeignLibNativeStatic) -> "lib" ++ nm <.> staticLibExtension (hostPlatform lbi) + (_other, ForeignLibNativeShared) -> + "lib" ++ nm <.> dllExtension (hostPlatform lbi) + (_other, ForeignLibNativeStatic) -> + "lib" ++ nm <.> staticLibExtension (hostPlatform lbi) (_any, ForeignLibTypeUnknown) -> cabalBug "unknown foreign lib type" where nm :: String @@ -1099,7 +1121,7 @@ where exeSources :: Executable -> IO BuildSources exeSources exe@Executable{buildInfo = bnfo, modulePath = modPath} = do - main <- findFile (tmpDir : hsSourceDirs bnfo) modPath + main <- findFileEx verbosity (tmpDir : hsSourceDirs bnfo) modPath let mainModName = fromMaybe ModuleName.main $ exeMainModuleName exe otherModNames = exeModules exe @@ -1119,14 +1141,15 @@ -- specVersion < 2, as 'cabal-version:>=2.0' cabal files -- have no excuse anymore to keep doing it wrong... ;-) warn verbosity $ "Enabling workaround for Main module '" - ++ display mainModName + ++ prettyShow mainModName ++ "' listed in 'other-modules' illegally!" return BuildSources { cSourcesFiles = cSources bnfo, cxxSourceFiles = cxxSources bnfo, inputSourceFiles = [main], - inputSourceModules = filter (/= mainModName) $ exeModules exe + inputSourceModules = filter (/= mainModName) $ + exeModules exe } else return BuildSources { @@ -1253,7 +1276,13 @@ ghcOptHPCDir = hpcdir Hpc.Dyn } linkerOpts = mempty { - ghcOptLinkOptions = PD.ldOptions bnfo, + ghcOptLinkOptions = PD.ldOptions bnfo + ++ [ "-static" + | withFullyStaticExe lbi ] + -- Pass extra `ld-options` given + -- through to GHC's linker. + ++ maybe [] programOverrideArgs + (lookupProgram ldProgram (withPrograms lbi)), ghcOptLinkLibs = extraLibs bnfo, ghcOptLinkLibPath = toNubListR $ extraLibDirs bnfo, ghcOptLinkFrameworks = toNubListR $ @@ -1557,7 +1586,8 @@ -- doesn't really help. extractRtsInfo :: LocalBuildInfo -> RtsInfo extractRtsInfo lbi = - case PackageIndex.lookupPackageName (installedPkgs lbi) (mkPackageName "rts") of + case PackageIndex.lookupPackageName + (installedPkgs lbi) (mkPackageName "rts") of [(_, [rts])] -> aux rts _otherwise -> error "No (or multiple) ghc rts package is registered" where @@ -1583,7 +1613,7 @@ } , rtsLibPaths = InstalledPackageInfo.libraryDirs rts } - withGhcVersion = (++ ("-ghc" ++ display (compilerVersion (compiler lbi)))) + withGhcVersion = (++ ("-ghc" ++ prettyShow (compilerVersion (compiler lbi)))) -- | Returns True if the modification date of the given source file is newer than -- the object file we last compiled for it, or if no object file exists yet. @@ -1659,16 +1689,13 @@ where filterHcOptions :: (String -> Bool) - -> [(CompilerFlavor, [String])] - -> [(CompilerFlavor, [String])] - filterHcOptions p hcoptss = - [ (hc, if hc == GHC then filter p opts else opts) - | (hc, opts) <- hcoptss ] + -> PerCompilerFlavor [String] + -> PerCompilerFlavor [String] + filterHcOptions p (PerCompilerFlavor ghc ghcjs) = + PerCompilerFlavor (filter p ghc) ghcjs - hasThreaded :: [(CompilerFlavor, [String])] -> Bool - hasThreaded hcoptss = - or [ if hc == GHC then elem "-threaded" opts else False - | (hc, opts) <- hcoptss ] + hasThreaded :: PerCompilerFlavor [String] -> Bool + hasThreaded (PerCompilerFlavor ghc _) = elem "-threaded" ghc -- | Extracts a String representing a hash of the ABI of a built -- library. It can fail if the library has not yet been built. @@ -1823,7 +1850,7 @@ -> Library -> ComponentLocalBuildInfo -> IO () -installLib verbosity lbi targetDir dynlibTargetDir _builtDir _pkg lib clbi = do +installLib verbosity lbi targetDir dynlibTargetDir _builtDir pkg lib clbi = do -- copy .hi files over: whenVanilla $ copyModuleFiles "hi" whenProf $ copyModuleFiles "p_hi" @@ -1832,15 +1859,53 @@ -- copy the built library files over: whenHasCode $ do whenVanilla $ do - sequence_ [ installOrdinary builtDir targetDir (mkGenericStaticLibName (l ++ f)) - | l <- getHSLibraryName (componentUnitId clbi):(extraBundledLibs (libBuildInfo lib)) + sequence_ [ installOrdinary + builtDir + targetDir + (mkGenericStaticLibName (l ++ f)) + | l <- getHSLibraryName + (componentUnitId clbi):(extraBundledLibs (libBuildInfo lib)) , f <- "":extraLibFlavours (libBuildInfo lib) ] whenGHCi $ installOrdinary builtDir targetDir ghciLibName whenProf $ do installOrdinary builtDir targetDir profileLibName whenGHCi $ installOrdinary builtDir targetDir ghciProfLibName - whenShared $ installShared builtDir dynlibTargetDir sharedLibName + whenShared $ if + -- The behavior for "extra-bundled-libraries" changed in version 2.5.0. + -- See ghc issue #15837 and Cabal PR #5855. + | specVersion pkg < mkVersion [2,5] -> do + sequence_ [ installShared builtDir dynlibTargetDir + (mkGenericSharedLibName platform compiler_id (l ++ f)) + | l <- getHSLibraryName uid : extraBundledLibs (libBuildInfo lib) + , f <- "":extraDynLibFlavours (libBuildInfo lib) + ] + | otherwise -> do + sequence_ [ installShared + builtDir + dynlibTargetDir + (mkGenericSharedLibName + platform + compiler_id + (getHSLibraryName uid ++ f)) + | f <- "":extraDynLibFlavours (libBuildInfo lib) + ] + sequence_ [ do + files <- getDirectoryContents builtDir + let l' = mkGenericSharedBundledLibName + platform + compiler_id + l + forM_ files $ \ file -> + when (l' `isPrefixOf` file) $ do + isFile <- doesFileExist (builtDir file) + when isFile $ do + installShared + builtDir + dynlibTargetDir + file + | l <- extraBundledLibs (libBuildInfo lib) + ] where builtDir = componentBuildDir lbi clbi @@ -1856,21 +1921,21 @@ else installOrdinaryFile verbosity src dst when (stripLibs lbi) $ Strip.stripLib verbosity - (hostPlatform lbi) (withPrograms lbi) dst + platform (withPrograms lbi) dst installOrdinary = install False installShared = install True copyModuleFiles ext = - findModuleFiles [builtDir] [ext] (allLibModules lib clbi) + findModuleFilesEx verbosity [builtDir] [ext] (allLibModules lib clbi) >>= installOrdinaryFiles verbosity targetDir compiler_id = compilerId (compiler lbi) + platform = hostPlatform lbi uid = componentUnitId clbi profileLibName = mkProfLibName uid ghciLibName = Internal.mkGHCiLibName uid ghciProfLibName = Internal.mkGHCiProfLibName uid - sharedLibName = (mkSharedLibName (hostPlatform lbi) compiler_id) uid hasLib = not $ null (allLibModules lib clbi) && null (cSources (libBuildInfo lib)) @@ -1886,16 +1951,17 @@ -- Registering hcPkgInfo :: ProgramDb -> HcPkg.HcPkgInfo -hcPkgInfo progdb = HcPkg.HcPkgInfo { HcPkg.hcPkgProgram = ghcPkgProg - , HcPkg.noPkgDbStack = v < [6,9] - , HcPkg.noVerboseFlag = v < [6,11] - , HcPkg.flagPackageConf = v < [7,5] - , HcPkg.supportsDirDbs = v >= [6,8] - , HcPkg.requiresDirDbs = v >= [7,10] - , HcPkg.nativeMultiInstance = v >= [7,10] - , HcPkg.recacheMultiInstance = v >= [6,12] - , HcPkg.suppressFilesCheck = v >= [6,6] - } +hcPkgInfo progdb = HcPkg.HcPkgInfo + { HcPkg.hcPkgProgram = ghcPkgProg + , HcPkg.noPkgDbStack = v < [6,9] + , HcPkg.noVerboseFlag = v < [6,11] + , HcPkg.flagPackageConf = v < [7,5] + , HcPkg.supportsDirDbs = v >= [6,8] + , HcPkg.requiresDirDbs = v >= [7,10] + , HcPkg.nativeMultiInstance = v >= [7,10] + , HcPkg.recacheMultiInstance = v >= [6,12] + , HcPkg.suppressFilesCheck = v >= [6,6] + } where v = versionNumbers ver Just ghcPkgProg = lookupProgram ghcPkgProgram progdb @@ -1922,7 +1988,7 @@ appDir <- getAppUserDataDirectory "ghc" let ver = compilerVersion (compiler lbi) subdir = System.Info.arch ++ '-':System.Info.os - ++ '-':display ver + ++ '-':prettyShow ver rootDir = appDir subdir -- We must create the root directory for the user package database if it -- does not yet exists. Otherwise '${pkgroot}' will resolve to a diff --git a/cabal/Cabal/Distribution/Simple/GHC/Internal.hs b/cabal/Cabal/Distribution/Simple/GHC/Internal.hs --- a/cabal/Cabal/Distribution/Simple/GHC/Internal.hs +++ b/cabal/Cabal/Distribution/Simple/GHC/Internal.hs @@ -66,7 +66,8 @@ import Distribution.Simple.Utils import Distribution.Simple.BuildPaths import Distribution.System -import Distribution.Text ( display, simpleParse ) +import Distribution.Pretty ( prettyShow ) +import Distribution.Parsec ( simpleParsec ) import Distribution.Utils.NubList ( toNubListR ) import Distribution.Verbosity import Distribution.Compat.Stack @@ -248,8 +249,8 @@ _ -> "No" ++ extStr , extStr'' <- [extStr, extStr'] ] - let extensions0 = [ (ext, Just $ "-X" ++ display ext) - | Just ext <- map simpleParse extStrs ] + let extensions0 = [ (ext, Just $ "-X" ++ prettyShow ext) + | Just ext <- map simpleParsec extStrs ] extensions1 = if alwaysNondecIndent implInfo then -- ghc-7.2 split NondecreasingIndentation off -- into a proper extension. Before that it @@ -521,7 +522,7 @@ ghcArchString :: Arch -> String ghcArchString PPC = "powerpc" ghcArchString PPC64 = "powerpc64" -ghcArchString other = display other +ghcArchString other = prettyShow other -- | GHC's rendering of its host or target 'OS' as used in its platform -- strings and certain file locations (such as user package db location). @@ -530,7 +531,7 @@ ghcOsString Windows = "mingw32" ghcOsString OSX = "darwin" ghcOsString Solaris = "solaris2" -ghcOsString other = display other +ghcOsString other = prettyShow other -- | GHC's rendering of its platform and compiler version string as used in -- certain file locations (such as user package db location). @@ -538,7 +539,7 @@ -- ghcPlatformAndVersionString :: Platform -> Version -> String ghcPlatformAndVersionString (Platform arch os) version = - intercalate "-" [ ghcArchString arch, ghcOsString os, display version ] + intercalate "-" [ ghcArchString arch, ghcOsString os, prettyShow version ] -- ----------------------------------------------------------------------------- @@ -602,12 +603,13 @@ renderGhcEnvironmentFileEntry :: GhcEnvironmentFileEntry -> String renderGhcEnvironmentFileEntry entry = case entry of GhcEnvFileComment comment -> format comment - where format = intercalate "\n" . map ("-- " ++) . lines - GhcEnvFilePackageId pkgid -> "package-id " ++ display pkgid + where format = intercalate "\n" . map ("--" <+>) . lines + pref <+> "" = pref + pref <+> str = pref ++ " " ++ str + GhcEnvFilePackageId pkgid -> "package-id " ++ prettyShow pkgid GhcEnvFilePackageDb pkgdb -> case pkgdb of GlobalPackageDB -> "global-package-db" UserPackageDB -> "user-package-db" SpecificPackageDB dbfile -> "package-db " ++ dbfile GhcEnvFileClearPackageDbStack -> "clear-package-db" - diff --git a/cabal/Cabal/Distribution/Simple/GHCJS.hs b/cabal/Cabal/Distribution/Simple/GHCJS.hs --- a/cabal/Cabal/Distribution/Simple/GHCJS.hs +++ b/cabal/Cabal/Distribution/Simple/GHCJS.hs @@ -1,884 +1,1819 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} - -module Distribution.Simple.GHCJS ( - configure, getInstalledPackages, getPackageDBContents, - buildLib, buildExe, - replLib, replExe, - startInterpreter, - installLib, installExe, - libAbiHash, - hcPkgInfo, - registerPackage, - componentGhcOptions, - getLibDir, - isDynamic, - getGlobalPackageDB, - runCmd - ) where - -import Prelude () -import Distribution.Compat.Prelude - -import Distribution.Types.UnqualComponentName -import Distribution.Simple.GHC.ImplInfo -import qualified Distribution.Simple.GHC.Internal as Internal -import Distribution.PackageDescription as PD -import Distribution.InstalledPackageInfo -import Distribution.Simple.PackageIndex ( InstalledPackageIndex ) -import qualified Distribution.Simple.PackageIndex as PackageIndex -import Distribution.Simple.LocalBuildInfo -import qualified Distribution.Simple.Hpc as Hpc -import Distribution.Simple.BuildPaths -import Distribution.Simple.Utils -import Distribution.Simple.Program -import qualified Distribution.Simple.Program.HcPkg as HcPkg -import qualified Distribution.Simple.Program.Ar as Ar -import qualified Distribution.Simple.Program.Ld as Ld -import qualified Distribution.Simple.Program.Strip as Strip -import Distribution.Simple.Program.GHC -import Distribution.Simple.Setup hiding ( Flag ) -import qualified Distribution.Simple.Setup as Cabal -import Distribution.Simple.Compiler hiding ( Flag ) -import Distribution.Version -import Distribution.System -import Distribution.Verbosity -import Distribution.Utils.NubList -import Distribution.Text -import Distribution.Types.UnitId - -import qualified Data.Map as Map -import System.Directory ( doesFileExist ) -import System.FilePath ( (), (<.>), takeExtension - , takeDirectory, replaceExtension ) - -configure :: Verbosity -> Maybe FilePath -> Maybe FilePath - -> ProgramDb - -> IO (Compiler, Maybe Platform, ProgramDb) -configure verbosity hcPath hcPkgPath progdb0 = do - (ghcjsProg, ghcjsVersion, progdb1) <- - requireProgramVersion verbosity ghcjsProgram - (orLaterVersion (mkVersion [0,1])) - (userMaybeSpecifyPath "ghcjs" hcPath progdb0) - Just ghcjsGhcVersion <- findGhcjsGhcVersion verbosity (programPath ghcjsProg) - let implInfo = ghcjsVersionImplInfo ghcjsVersion ghcjsGhcVersion - - -- This is slightly tricky, we have to configure ghcjs first, then we use the - -- location of ghcjs to help find ghcjs-pkg in the case that the user did not - -- specify the location of ghc-pkg directly: - (ghcjsPkgProg, ghcjsPkgVersion, progdb2) <- - requireProgramVersion verbosity ghcjsPkgProgram { - programFindLocation = guessGhcjsPkgFromGhcjsPath ghcjsProg - } - anyVersion (userMaybeSpecifyPath "ghcjs-pkg" hcPkgPath progdb1) - - Just ghcjsPkgGhcjsVersion <- findGhcjsPkgGhcjsVersion - verbosity (programPath ghcjsPkgProg) - - when (ghcjsVersion /= ghcjsPkgGhcjsVersion) $ die' verbosity $ - "Version mismatch between ghcjs and ghcjs-pkg: " - ++ programPath ghcjsProg ++ " is version " ++ display ghcjsVersion ++ " " - ++ programPath ghcjsPkgProg ++ " is version " ++ display ghcjsPkgGhcjsVersion - - when (ghcjsGhcVersion /= ghcjsPkgVersion) $ die' verbosity $ - "Version mismatch between ghcjs and ghcjs-pkg: " - ++ programPath ghcjsProg - ++ " was built with GHC version " ++ display ghcjsGhcVersion ++ " " - ++ programPath ghcjsPkgProg - ++ " was built with GHC version " ++ display ghcjsPkgVersion - - -- be sure to use our versions of hsc2hs, c2hs, haddock and ghc - let hsc2hsProgram' = - hsc2hsProgram { programFindLocation = - guessHsc2hsFromGhcjsPath ghcjsProg } - c2hsProgram' = - c2hsProgram { programFindLocation = - guessC2hsFromGhcjsPath ghcjsProg } - - haddockProgram' = - haddockProgram { programFindLocation = - guessHaddockFromGhcjsPath ghcjsProg } - progdb3 = addKnownPrograms [ hsc2hsProgram', c2hsProgram', haddockProgram' ] progdb2 - - languages <- Internal.getLanguages verbosity implInfo ghcjsProg - extensions <- Internal.getExtensions verbosity implInfo ghcjsProg - - ghcInfo <- Internal.getGhcInfo verbosity implInfo ghcjsProg - let ghcInfoMap = Map.fromList ghcInfo - - let comp = Compiler { - compilerId = CompilerId GHCJS ghcjsVersion, - compilerAbiTag = AbiTag $ - "ghc" ++ intercalate "_" (map show . versionNumbers $ ghcjsGhcVersion), - compilerCompat = [CompilerId GHC ghcjsGhcVersion], - compilerLanguages = languages, - compilerExtensions = extensions, - compilerProperties = ghcInfoMap - } - compPlatform = Internal.targetPlatform ghcInfo - -- configure gcc and ld - let progdb4 = if ghcjsNativeToo comp - then Internal.configureToolchain implInfo - ghcjsProg ghcInfoMap progdb3 - else progdb3 - return (comp, compPlatform, progdb4) - -ghcjsNativeToo :: Compiler -> Bool -ghcjsNativeToo = Internal.ghcLookupProperty "Native Too" - -guessGhcjsPkgFromGhcjsPath :: ConfiguredProgram -> Verbosity - -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath])) -guessGhcjsPkgFromGhcjsPath = guessToolFromGhcjsPath ghcjsPkgProgram - -guessHsc2hsFromGhcjsPath :: ConfiguredProgram -> Verbosity - -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath])) -guessHsc2hsFromGhcjsPath = guessToolFromGhcjsPath hsc2hsProgram - -guessC2hsFromGhcjsPath :: ConfiguredProgram -> Verbosity - -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath])) -guessC2hsFromGhcjsPath = guessToolFromGhcjsPath c2hsProgram - -guessHaddockFromGhcjsPath :: ConfiguredProgram -> Verbosity - -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath])) -guessHaddockFromGhcjsPath = guessToolFromGhcjsPath haddockProgram - -guessToolFromGhcjsPath :: Program -> ConfiguredProgram - -> Verbosity -> ProgramSearchPath - -> IO (Maybe (FilePath, [FilePath])) -guessToolFromGhcjsPath tool ghcjsProg verbosity searchpath - = do let toolname = programName tool - path = programPath ghcjsProg - dir = takeDirectory path - versionSuffix = takeVersionSuffix (dropExeExtension path) - guessNormal = dir toolname <.> exeExtension buildPlatform - guessGhcjsVersioned = dir (toolname ++ "-ghcjs" ++ versionSuffix) - <.> exeExtension buildPlatform - guessGhcjs = dir (toolname ++ "-ghcjs") - <.> exeExtension buildPlatform - guessVersioned = dir (toolname ++ versionSuffix) <.> exeExtension buildPlatform - guesses | null versionSuffix = [guessGhcjs, guessNormal] - | otherwise = [guessGhcjsVersioned, - guessGhcjs, - guessVersioned, - guessNormal] - info verbosity $ "looking for tool " ++ toolname - ++ " near compiler in " ++ dir - exists <- traverse doesFileExist guesses - case [ file | (file, True) <- zip guesses exists ] of - -- If we can't find it near ghc, fall back to the usual - -- method. - [] -> programFindLocation tool verbosity searchpath - (fp:_) -> do info verbosity $ "found " ++ toolname ++ " in " ++ fp - let lookedAt = map fst - . takeWhile (\(_file, exist) -> not exist) - $ zip guesses exists - return (Just (fp, lookedAt)) - - where takeVersionSuffix :: FilePath -> String - takeVersionSuffix = reverse . takeWhile (`elem ` "0123456789.-") . - reverse - --- | Given a single package DB, return all installed packages. -getPackageDBContents :: Verbosity -> PackageDB -> ProgramDb - -> IO InstalledPackageIndex -getPackageDBContents verbosity packagedb progdb = do - pkgss <- getInstalledPackages' verbosity [packagedb] progdb - toPackageIndex verbosity pkgss progdb - --- | Given a package DB stack, return all installed packages. -getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramDb - -> IO InstalledPackageIndex -getInstalledPackages verbosity packagedbs progdb = do - checkPackageDbEnvVar verbosity - checkPackageDbStack verbosity packagedbs - pkgss <- getInstalledPackages' verbosity packagedbs progdb - index <- toPackageIndex verbosity pkgss progdb - return $! index - -toPackageIndex :: Verbosity - -> [(PackageDB, [InstalledPackageInfo])] - -> ProgramDb - -> IO InstalledPackageIndex -toPackageIndex verbosity pkgss progdb = do - -- On Windows, various fields have $topdir/foo rather than full - -- paths. We need to substitute the right value in so that when - -- we, for example, call gcc, we have proper paths to give it. - topDir <- getLibDir' verbosity ghcjsProg - let indices = [ PackageIndex.fromList (map (Internal.substTopDir topDir) pkgs) - | (_, pkgs) <- pkgss ] - return $! (mconcat indices) - - where - Just ghcjsProg = lookupProgram ghcjsProgram progdb - -checkPackageDbEnvVar :: Verbosity -> IO () -checkPackageDbEnvVar verbosity = - Internal.checkPackageDbEnvVar verbosity "GHCJS" "GHCJS_PACKAGE_PATH" - -checkPackageDbStack :: Verbosity -> PackageDBStack -> IO () -checkPackageDbStack _ (GlobalPackageDB:rest) - | GlobalPackageDB `notElem` rest = return () -checkPackageDbStack verbosity rest - | GlobalPackageDB `notElem` rest = - die' verbosity $ "With current ghc versions the global package db is always used " - ++ "and must be listed first. This ghc limitation may be lifted in " - ++ "future, see http://hackage.haskell.org/trac/ghc/ticket/5977" -checkPackageDbStack verbosity _ = - die' verbosity $ "If the global package db is specified, it must be " - ++ "specified first and cannot be specified multiple times" - -getInstalledPackages' :: Verbosity -> [PackageDB] -> ProgramDb - -> IO [(PackageDB, [InstalledPackageInfo])] -getInstalledPackages' verbosity packagedbs progdb = - sequenceA - [ do pkgs <- HcPkg.dump (hcPkgInfo progdb) verbosity packagedb - return (packagedb, pkgs) - | packagedb <- packagedbs ] - -getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath -getLibDir verbosity lbi = - (reverse . dropWhile isSpace . reverse) `fmap` - getDbProgramOutput verbosity ghcjsProgram - (withPrograms lbi) ["--print-libdir"] - -getLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath -getLibDir' verbosity ghcjsProg = - (reverse . dropWhile isSpace . reverse) `fmap` - getProgramOutput verbosity ghcjsProg ["--print-libdir"] - --- | Return the 'FilePath' to the global GHC package database. -getGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath -getGlobalPackageDB verbosity ghcjsProg = - (reverse . dropWhile isSpace . reverse) `fmap` - getProgramOutput verbosity ghcjsProg ["--print-global-package-db"] - -toJSLibName :: String -> String -toJSLibName lib - | takeExtension lib `elem` [".dll",".dylib",".so"] - = replaceExtension lib "js_so" - | takeExtension lib == ".a" = replaceExtension lib "js_a" - | otherwise = lib <.> "js_a" - -buildLib :: Verbosity -> Cabal.Flag (Maybe Int) -> PackageDescription - -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo - -> IO () -buildLib = buildOrReplLib Nothing - -replLib :: [String] -> Verbosity - -> Cabal.Flag (Maybe Int) -> PackageDescription - -> LocalBuildInfo -> Library - -> ComponentLocalBuildInfo -> IO () -replLib = buildOrReplLib . Just - -buildOrReplLib :: Maybe [String] -> Verbosity - -> Cabal.Flag (Maybe Int) -> PackageDescription - -> LocalBuildInfo -> Library - -> ComponentLocalBuildInfo -> IO () -buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do - let uid = componentUnitId clbi - libTargetDir = buildDir lbi - whenVanillaLib forceVanilla = - when (not forRepl && (forceVanilla || withVanillaLib lbi)) - whenProfLib = when (not forRepl && withProfLib lbi) - whenSharedLib forceShared = - when (not forRepl && (forceShared || withSharedLib lbi)) - whenGHCiLib = when (not forRepl && withGHCiLib lbi) - forRepl = maybe False (const True) mReplFlags - ifReplLib = when forRepl - replFlags = fromMaybe mempty mReplFlags - comp = compiler lbi - platform = hostPlatform lbi - implInfo = getImplInfo comp - nativeToo = ghcjsNativeToo comp - - (ghcjsProg, _) <- requireProgram verbosity ghcjsProgram (withPrograms lbi) - let runGhcjsProg = runGHC verbosity ghcjsProg comp platform - libBi = libBuildInfo lib - isGhcjsDynamic = isDynamic comp - dynamicTooSupported = supportsDynamicToo comp - doingTH = usesTemplateHaskellOrQQ libBi - forceVanillaLib = doingTH && not isGhcjsDynamic - forceSharedLib = doingTH && isGhcjsDynamic - -- TH always needs default libs, even when building for profiling - - -- Determine if program coverage should be enabled and if so, what - -- '-hpcdir' should be. - let isCoverageEnabled = libCoverage lbi - pkg_name = display $ PD.package pkg_descr - distPref = fromFlag $ configDistPref $ configFlags lbi - hpcdir way - | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way pkg_name - | otherwise = mempty - - createDirectoryIfMissingVerbose verbosity True libTargetDir - -- TODO: do we need to put hs-boot files into place for mutually recursive - -- modules? - let cObjs = map (`replaceExtension` objExtension) (cSources libBi) - jsSrcs = jsSources libBi - baseOpts = componentGhcOptions verbosity lbi libBi clbi libTargetDir - linkJsLibOpts = mempty { - ghcOptExtra = - [ "-link-js-lib" , getHSLibraryName uid - , "-js-lib-outputdir", libTargetDir ] ++ - jsSrcs - } - vanillaOptsNoJsLib = baseOpts `mappend` mempty { - ghcOptMode = toFlag GhcModeMake, - ghcOptNumJobs = numJobs, - ghcOptInputModules = toNubListR $ allLibModules lib clbi, - ghcOptHPCDir = hpcdir Hpc.Vanilla - } - vanillaOpts = vanillaOptsNoJsLib `mappend` linkJsLibOpts - - profOpts = adjustExts "p_hi" "p_o" vanillaOpts `mappend` mempty { - ghcOptProfilingMode = toFlag True, - ghcOptExtra = ghcjsProfOptions libBi, - ghcOptHPCDir = hpcdir Hpc.Prof - } - sharedOpts = adjustExts "dyn_hi" "dyn_o" vanillaOpts `mappend` mempty { - ghcOptDynLinkMode = toFlag GhcDynamicOnly, - ghcOptFPic = toFlag True, - ghcOptExtra = ghcjsSharedOptions libBi, - ghcOptHPCDir = hpcdir Hpc.Dyn - } - linkerOpts = mempty { - ghcOptLinkOptions = PD.ldOptions libBi, - ghcOptLinkLibs = extraLibs libBi, - ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi, - ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi, - ghcOptInputFiles = - toNubListR $ [libTargetDir x | x <- cObjs] ++ jsSrcs - } - replOpts = vanillaOptsNoJsLib { - ghcOptExtra = Internal.filterGhciFlags - (ghcOptExtra vanillaOpts) - <> replFlags, - ghcOptNumJobs = mempty - } - `mappend` linkerOpts - `mappend` mempty { - ghcOptMode = toFlag GhcModeInteractive, - ghcOptOptimisation = toFlag GhcNoOptimisation - } - - vanillaSharedOpts = vanillaOpts `mappend` - mempty { - ghcOptDynLinkMode = toFlag GhcStaticAndDynamic, - ghcOptDynHiSuffix = toFlag "dyn_hi", - ghcOptDynObjSuffix = toFlag "dyn_o", - ghcOptHPCDir = hpcdir Hpc.Dyn - } - - unless (forRepl || (null (allLibModules lib clbi) && null jsSrcs && null cObjs)) $ - do let vanilla = whenVanillaLib forceVanillaLib (runGhcjsProg vanillaOpts) - shared = whenSharedLib forceSharedLib (runGhcjsProg sharedOpts) - useDynToo = dynamicTooSupported && - (forceVanillaLib || withVanillaLib lbi) && - (forceSharedLib || withSharedLib lbi) && - null (ghcjsSharedOptions libBi) - if useDynToo - then do - runGhcjsProg vanillaSharedOpts - case (hpcdir Hpc.Dyn, hpcdir Hpc.Vanilla) of - (Cabal.Flag dynDir, Cabal.Flag vanillaDir) -> do - -- When the vanilla and shared library builds are done - -- in one pass, only one set of HPC module interfaces - -- are generated. This set should suffice for both - -- static and dynamically linked executables. We copy - -- the modules interfaces so they are available under - -- both ways. - copyDirectoryRecursive verbosity dynDir vanillaDir - _ -> return () - else if isGhcjsDynamic - then do shared; vanilla - else do vanilla; shared - whenProfLib (runGhcjsProg profOpts) - - -- build any C sources - unless (null (cSources libBi) || not nativeToo) $ do - info verbosity "Building C Sources..." - sequence_ - [ do let vanillaCcOpts = - (Internal.componentCcGhcOptions verbosity implInfo - lbi libBi clbi libTargetDir filename) - profCcOpts = vanillaCcOpts `mappend` mempty { - ghcOptProfilingMode = toFlag True, - ghcOptObjSuffix = toFlag "p_o" - } - sharedCcOpts = vanillaCcOpts `mappend` mempty { - ghcOptFPic = toFlag True, - ghcOptDynLinkMode = toFlag GhcDynamicOnly, - ghcOptObjSuffix = toFlag "dyn_o" - } - odir = fromFlag (ghcOptObjDir vanillaCcOpts) - createDirectoryIfMissingVerbose verbosity True odir - runGhcjsProg vanillaCcOpts - whenSharedLib forceSharedLib (runGhcjsProg sharedCcOpts) - whenProfLib (runGhcjsProg profCcOpts) - | filename <- cSources libBi] - - -- TODO: problem here is we need the .c files built first, so we can load them - -- with ghci, but .c files can depend on .h files generated by ghc by ffi - -- exports. - unless (null (allLibModules lib clbi)) $ - ifReplLib (runGhcjsProg replOpts) - - -- link: - when (nativeToo && not forRepl) $ do - info verbosity "Linking..." - let cProfObjs = map (`replaceExtension` ("p_" ++ objExtension)) - (cSources libBi) - cSharedObjs = map (`replaceExtension` ("dyn_" ++ objExtension)) - (cSources libBi) - compiler_id = compilerId (compiler lbi) - vanillaLibFilePath = libTargetDir mkLibName uid - profileLibFilePath = libTargetDir mkProfLibName uid - sharedLibFilePath = libTargetDir mkSharedLibName (hostPlatform lbi) compiler_id uid - ghciLibFilePath = libTargetDir Internal.mkGHCiLibName uid - ghciProfLibFilePath = libTargetDir Internal.mkGHCiProfLibName uid - - hObjs <- Internal.getHaskellObjects implInfo lib lbi clbi - libTargetDir objExtension True - hProfObjs <- - if (withProfLib lbi) - then Internal.getHaskellObjects implInfo lib lbi clbi - libTargetDir ("p_" ++ objExtension) True - else return [] - hSharedObjs <- - if (withSharedLib lbi) - then Internal.getHaskellObjects implInfo lib lbi clbi - libTargetDir ("dyn_" ++ objExtension) False - else return [] - - unless (null hObjs && null cObjs) $ do - - let staticObjectFiles = - hObjs - ++ map (libTargetDir ) cObjs - profObjectFiles = - hProfObjs - ++ map (libTargetDir ) cProfObjs - dynamicObjectFiles = - hSharedObjs - ++ map (libTargetDir ) cSharedObjs - -- After the relocation lib is created we invoke ghc -shared - -- with the dependencies spelled out as -package arguments - -- and ghc invokes the linker with the proper library paths - ghcSharedLinkArgs = - mempty { - ghcOptShared = toFlag True, - ghcOptDynLinkMode = toFlag GhcDynamicOnly, - ghcOptInputFiles = toNubListR dynamicObjectFiles, - ghcOptOutputFile = toFlag sharedLibFilePath, - ghcOptExtra = ghcjsSharedOptions libBi, - ghcOptNoAutoLinkPackages = toFlag True, - ghcOptPackageDBs = withPackageDB lbi, - ghcOptPackages = toNubListR $ - Internal.mkGhcOptPackages clbi, - ghcOptLinkLibs = extraLibs libBi, - ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi - } - - whenVanillaLib False $ do - Ar.createArLibArchive verbosity lbi vanillaLibFilePath staticObjectFiles - whenGHCiLib $ do - (ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi) - Ld.combineObjectFiles verbosity lbi ldProg - ghciLibFilePath staticObjectFiles - - whenProfLib $ do - Ar.createArLibArchive verbosity lbi profileLibFilePath profObjectFiles - whenGHCiLib $ do - (ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi) - Ld.combineObjectFiles verbosity lbi ldProg - ghciProfLibFilePath profObjectFiles - - whenSharedLib False $ - runGhcjsProg ghcSharedLinkArgs - --- | Start a REPL without loading any source files. -startInterpreter :: Verbosity -> ProgramDb -> Compiler -> Platform - -> PackageDBStack -> IO () -startInterpreter verbosity progdb comp platform packageDBs = do - let replOpts = mempty { - ghcOptMode = toFlag GhcModeInteractive, - ghcOptPackageDBs = packageDBs - } - checkPackageDbStack verbosity packageDBs - (ghcjsProg, _) <- requireProgram verbosity ghcjsProgram progdb - runGHC verbosity ghcjsProg comp platform replOpts - -buildExe :: Verbosity -> Cabal.Flag (Maybe Int) - -> PackageDescription -> LocalBuildInfo - -> Executable -> ComponentLocalBuildInfo -> IO () -buildExe = buildOrReplExe Nothing - -replExe :: [String] -> Verbosity - -> Cabal.Flag (Maybe Int) -> PackageDescription - -> LocalBuildInfo -> Executable - -> ComponentLocalBuildInfo -> IO () -replExe = buildOrReplExe . Just - -buildOrReplExe :: Maybe [String] -> Verbosity - -> Cabal.Flag (Maybe Int) -> PackageDescription - -> LocalBuildInfo -> Executable - -> ComponentLocalBuildInfo -> IO () -buildOrReplExe mReplFlags verbosity numJobs _pkg_descr lbi - exe@Executable { exeName = exeName', modulePath = modPath } clbi = do - - (ghcjsProg, _) <- requireProgram verbosity ghcjsProgram (withPrograms lbi) - let forRepl = maybe False (const True) mReplFlags - replFlags = fromMaybe mempty mReplFlags - comp = compiler lbi - platform = hostPlatform lbi - implInfo = getImplInfo comp - runGhcjsProg = runGHC verbosity ghcjsProg comp platform - exeBi = buildInfo exe - - let exeName'' = unUnqualComponentName exeName' - -- exeNameReal, the name that GHC really uses (with .exe on Windows) - let exeNameReal = exeName'' <.> - (if takeExtension exeName'' /= ('.':exeExtension buildPlatform) - then exeExtension buildPlatform - else "") - - let targetDir = (buildDir lbi) exeName'' - let exeDir = targetDir (exeName'' ++ "-tmp") - createDirectoryIfMissingVerbose verbosity True targetDir - createDirectoryIfMissingVerbose verbosity True exeDir - -- TODO: do we need to put hs-boot files into place for mutually recursive - -- modules? FIX: what about exeName.hi-boot? - - -- Determine if program coverage should be enabled and if so, what - -- '-hpcdir' should be. - let isCoverageEnabled = exeCoverage lbi - distPref = fromFlag $ configDistPref $ configFlags lbi - hpcdir way - | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way exeName'' - | otherwise = mempty - - -- build executables - - srcMainFile <- findFile (exeDir : hsSourceDirs exeBi) modPath - let isGhcjsDynamic = isDynamic comp - dynamicTooSupported = supportsDynamicToo comp - buildRunner = case clbi of - ExeComponentLocalBuildInfo {} -> False - _ -> True - isHaskellMain = elem (takeExtension srcMainFile) [".hs", ".lhs"] - jsSrcs = jsSources exeBi - cSrcs = cSources exeBi ++ [srcMainFile | not isHaskellMain] - cObjs = map (`replaceExtension` objExtension) cSrcs - nativeToo = ghcjsNativeToo comp - baseOpts = (componentGhcOptions verbosity lbi exeBi clbi exeDir) - `mappend` mempty { - ghcOptMode = toFlag GhcModeMake, - ghcOptInputFiles = toNubListR $ - [ srcMainFile | isHaskellMain], - ghcOptInputModules = toNubListR $ - [ m | not isHaskellMain, m <- exeModules exe], - ghcOptExtra = - if buildRunner then ["-build-runner"] - else mempty - } - staticOpts = baseOpts `mappend` mempty { - ghcOptDynLinkMode = toFlag GhcStaticOnly, - ghcOptHPCDir = hpcdir Hpc.Vanilla - } - profOpts = adjustExts "p_hi" "p_o" baseOpts `mappend` mempty { - ghcOptProfilingMode = toFlag True, - ghcOptExtra = ghcjsProfOptions exeBi, - ghcOptHPCDir = hpcdir Hpc.Prof - } - dynOpts = adjustExts "dyn_hi" "dyn_o" baseOpts `mappend` mempty { - ghcOptDynLinkMode = toFlag GhcDynamicOnly, - ghcOptExtra = ghcjsSharedOptions exeBi, - ghcOptHPCDir = hpcdir Hpc.Dyn - } - dynTooOpts = adjustExts "dyn_hi" "dyn_o" staticOpts `mappend` mempty { - ghcOptDynLinkMode = toFlag GhcStaticAndDynamic, - ghcOptHPCDir = hpcdir Hpc.Dyn - } - linkerOpts = mempty { - ghcOptLinkOptions = PD.ldOptions exeBi, - ghcOptLinkLibs = extraLibs exeBi, - ghcOptLinkLibPath = toNubListR $ extraLibDirs exeBi, - ghcOptLinkFrameworks = toNubListR $ PD.frameworks exeBi, - ghcOptInputFiles = toNubListR $ - [exeDir x | x <- cObjs] ++ jsSrcs - } - replOpts = baseOpts { - ghcOptExtra = Internal.filterGhciFlags - (ghcOptExtra baseOpts) - <> replFlags - } - -- For a normal compile we do separate invocations of ghc for - -- compiling as for linking. But for repl we have to do just - -- the one invocation, so that one has to include all the - -- linker stuff too, like -l flags and any .o files from C - -- files etc. - `mappend` linkerOpts - `mappend` mempty { - ghcOptMode = toFlag GhcModeInteractive, - ghcOptOptimisation = toFlag GhcNoOptimisation - } - commonOpts | withProfExe lbi = profOpts - | withDynExe lbi = dynOpts - | otherwise = staticOpts - compileOpts | useDynToo = dynTooOpts - | otherwise = commonOpts - withStaticExe = (not $ withProfExe lbi) && (not $ withDynExe lbi) - - -- For building exe's that use TH with -prof or -dynamic we actually have - -- to build twice, once without -prof/-dynamic and then again with - -- -prof/-dynamic. This is because the code that TH needs to run at - -- compile time needs to be the vanilla ABI so it can be loaded up and run - -- by the compiler. - -- With dynamic-by-default GHC the TH object files loaded at compile-time - -- need to be .dyn_o instead of .o. - doingTH = usesTemplateHaskellOrQQ exeBi - -- Should we use -dynamic-too instead of compiling twice? - useDynToo = dynamicTooSupported && isGhcjsDynamic - && doingTH && withStaticExe && null (ghcjsSharedOptions exeBi) - compileTHOpts | isGhcjsDynamic = dynOpts - | otherwise = staticOpts - compileForTH - | forRepl = False - | useDynToo = False - | isGhcjsDynamic = doingTH && (withProfExe lbi || withStaticExe) - | otherwise = doingTH && (withProfExe lbi || withDynExe lbi) - - linkOpts = commonOpts `mappend` - linkerOpts `mappend` mempty { - ghcOptLinkNoHsMain = toFlag (not isHaskellMain) - } - - -- Build static/dynamic object files for TH, if needed. - when compileForTH $ - runGhcjsProg compileTHOpts { ghcOptNoLink = toFlag True - , ghcOptNumJobs = numJobs } - - unless forRepl $ - runGhcjsProg compileOpts { ghcOptNoLink = toFlag True - , ghcOptNumJobs = numJobs } - - -- build any C sources - unless (null cSrcs || not nativeToo) $ do - info verbosity "Building C Sources..." - sequence_ - [ do let opts = (Internal.componentCcGhcOptions verbosity implInfo lbi exeBi - clbi exeDir filename) `mappend` mempty { - ghcOptDynLinkMode = toFlag (if withDynExe lbi - then GhcDynamicOnly - else GhcStaticOnly), - ghcOptProfilingMode = toFlag (withProfExe lbi) - } - odir = fromFlag (ghcOptObjDir opts) - createDirectoryIfMissingVerbose verbosity True odir - runGhcjsProg opts - | filename <- cSrcs ] - - -- TODO: problem here is we need the .c files built first, so we can load them - -- with ghci, but .c files can depend on .h files generated by ghc by ffi - -- exports. - when forRepl $ runGhcjsProg replOpts - - -- link: - unless forRepl $ do - info verbosity "Linking..." - runGhcjsProg linkOpts { ghcOptOutputFile = toFlag (targetDir exeNameReal) } - --- |Install for ghc, .hi, .a and, if --with-ghci given, .o -installLib :: Verbosity - -> LocalBuildInfo - -> FilePath -- ^install location - -> FilePath -- ^install location for dynamic libraries - -> FilePath -- ^Build location - -> PackageDescription - -> Library - -> ComponentLocalBuildInfo - -> IO () -installLib verbosity lbi targetDir dynlibTargetDir builtDir _pkg lib clbi = do - whenVanilla $ copyModuleFiles "js_hi" - whenProf $ copyModuleFiles "js_p_hi" - whenShared $ copyModuleFiles "js_dyn_hi" - - whenVanilla $ installOrdinary builtDir targetDir $ toJSLibName vanillaLibName - whenProf $ installOrdinary builtDir targetDir $ toJSLibName profileLibName - whenShared $ installShared builtDir dynlibTargetDir $ toJSLibName sharedLibName - - when (ghcjsNativeToo $ compiler lbi) $ do - -- copy .hi files over: - whenVanilla $ copyModuleFiles "hi" - whenProf $ copyModuleFiles "p_hi" - whenShared $ copyModuleFiles "dyn_hi" - - -- copy the built library files over: - whenVanilla $ do - installOrdinaryNative builtDir targetDir vanillaLibName - whenGHCi $ installOrdinaryNative builtDir targetDir ghciLibName - whenProf $ do - installOrdinaryNative builtDir targetDir profileLibName - whenGHCi $ installOrdinaryNative builtDir targetDir ghciProfLibName - whenShared $ installSharedNative builtDir dynlibTargetDir sharedLibName - - where - install isShared isJS srcDir dstDir name = do - let src = srcDir name - dst = dstDir name - createDirectoryIfMissingVerbose verbosity True dstDir - - if isShared - then installExecutableFile verbosity src dst - else installOrdinaryFile verbosity src dst - - when (stripLibs lbi && not isJS) $ - Strip.stripLib verbosity - (hostPlatform lbi) (withPrograms lbi) dst - - installOrdinary = install False True - installShared = install True True - - installOrdinaryNative = install False False - installSharedNative = install True False - - copyModuleFiles ext = - findModuleFiles [builtDir] [ext] (allLibModules lib clbi) - >>= installOrdinaryFiles verbosity targetDir - - compiler_id = compilerId (compiler lbi) - uid = componentUnitId clbi - vanillaLibName = mkLibName uid - profileLibName = mkProfLibName uid - ghciLibName = Internal.mkGHCiLibName uid - ghciProfLibName = Internal.mkGHCiProfLibName uid - sharedLibName = (mkSharedLibName (hostPlatform lbi) compiler_id) uid - - hasLib = not $ null (allLibModules lib clbi) - && null (cSources (libBuildInfo lib)) - whenVanilla = when (hasLib && withVanillaLib lbi) - whenProf = when (hasLib && withProfLib lbi) - whenGHCi = when (hasLib && withGHCiLib lbi) - whenShared = when (hasLib && withSharedLib lbi) - -installExe :: Verbosity - -> LocalBuildInfo - -> FilePath -- ^Where to copy the files to - -> FilePath -- ^Build location - -> (FilePath, FilePath) -- ^Executable (prefix,suffix) - -> PackageDescription - -> Executable - -> IO () -installExe verbosity lbi binDir buildPref - (progprefix, progsuffix) _pkg exe = do - createDirectoryIfMissingVerbose verbosity True binDir - let exeName' = unUnqualComponentName $ exeName exe - exeFileName = exeName' - fixedExeBaseName = progprefix ++ exeName' ++ progsuffix - installBinary dest = do - runDbProgram verbosity ghcjsProgram (withPrograms lbi) $ - [ "--install-executable" - , buildPref exeName' exeFileName - , "-o", dest - ] ++ - case (stripExes lbi, lookupProgram stripProgram $ withPrograms lbi) of - (True, Just strip) -> ["-strip-program", programPath strip] - _ -> [] - installBinary (binDir fixedExeBaseName) - -libAbiHash :: Verbosity -> PackageDescription -> LocalBuildInfo - -> Library -> ComponentLocalBuildInfo -> IO String -libAbiHash verbosity _pkg_descr lbi lib clbi = do - let - libBi = libBuildInfo lib - comp = compiler lbi - platform = hostPlatform lbi - vanillaArgs = - (componentGhcOptions verbosity lbi libBi clbi (buildDir lbi)) - `mappend` mempty { - ghcOptMode = toFlag GhcModeAbiHash, - ghcOptInputModules = toNubListR $ PD.exposedModules lib - } - profArgs = adjustExts "js_p_hi" "js_p_o" vanillaArgs `mappend` mempty { - ghcOptProfilingMode = toFlag True, - ghcOptExtra = ghcjsProfOptions libBi - } - ghcArgs | withVanillaLib lbi = vanillaArgs - | withProfLib lbi = profArgs - | otherwise = error "libAbiHash: Can't find an enabled library way" - -- - (ghcjsProg, _) <- requireProgram verbosity ghcjsProgram (withPrograms lbi) - hash <- getProgramInvocationOutput verbosity - (ghcInvocation ghcjsProg comp platform ghcArgs) - return (takeWhile (not . isSpace) hash) - -adjustExts :: String -> String -> GhcOptions -> GhcOptions -adjustExts hiSuf objSuf opts = - opts `mappend` mempty { - ghcOptHiSuffix = toFlag hiSuf, - ghcOptObjSuffix = toFlag objSuf - } - -registerPackage :: Verbosity - -> ProgramDb - -> PackageDBStack - -> InstalledPackageInfo - -> HcPkg.RegisterOptions - -> IO () -registerPackage verbosity progdb packageDbs installedPkgInfo registerOptions = - HcPkg.register (hcPkgInfo progdb) verbosity packageDbs - installedPkgInfo registerOptions - -componentGhcOptions :: Verbosity -> LocalBuildInfo - -> BuildInfo -> ComponentLocalBuildInfo -> FilePath - -> GhcOptions -componentGhcOptions verbosity lbi bi clbi odir = - let opts = Internal.componentGhcOptions verbosity implInfo lbi bi clbi odir - comp = compiler lbi - implInfo = getImplInfo comp - in opts { ghcOptExtra = ghcOptExtra opts `mappend` hcOptions GHCJS bi - } - -ghcjsProfOptions :: BuildInfo -> [String] -ghcjsProfOptions bi = - hcProfOptions GHC bi `mappend` hcProfOptions GHCJS bi - -ghcjsSharedOptions :: BuildInfo -> [String] -ghcjsSharedOptions bi = - hcSharedOptions GHC bi `mappend` hcSharedOptions GHCJS bi - -isDynamic :: Compiler -> Bool -isDynamic = Internal.ghcLookupProperty "GHC Dynamic" - -supportsDynamicToo :: Compiler -> Bool -supportsDynamicToo = Internal.ghcLookupProperty "Support dynamic-too" - -findGhcjsGhcVersion :: Verbosity -> FilePath -> IO (Maybe Version) -findGhcjsGhcVersion verbosity pgm = - findProgramVersion "--numeric-ghc-version" id verbosity pgm - -findGhcjsPkgGhcjsVersion :: Verbosity -> FilePath -> IO (Maybe Version) -findGhcjsPkgGhcjsVersion verbosity pgm = - findProgramVersion "--numeric-ghcjs-version" id verbosity pgm - --- ----------------------------------------------------------------------------- --- Registering - -hcPkgInfo :: ProgramDb -> HcPkg.HcPkgInfo -hcPkgInfo progdb = HcPkg.HcPkgInfo { HcPkg.hcPkgProgram = ghcjsPkgProg - , HcPkg.noPkgDbStack = False - , HcPkg.noVerboseFlag = False - , HcPkg.flagPackageConf = False - , HcPkg.supportsDirDbs = True - , HcPkg.requiresDirDbs = ver >= v7_10 - , HcPkg.nativeMultiInstance = ver >= v7_10 - , HcPkg.recacheMultiInstance = True - , HcPkg.suppressFilesCheck = True - } - where - v7_10 = mkVersion [7,10] - Just ghcjsPkgProg = lookupProgram ghcjsPkgProgram progdb - Just ver = programVersion ghcjsPkgProg +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE CPP #-} + +module Distribution.Simple.GHCJS ( + getGhcInfo, + configure, + getInstalledPackages, + getInstalledPackagesMonitorFiles, + getPackageDBContents, + buildLib, buildFLib, buildExe, + replLib, replFLib, replExe, + startInterpreter, + installLib, installFLib, installExe, + libAbiHash, + hcPkgInfo, + registerPackage, + componentGhcOptions, + componentCcGhcOptions, + getLibDir, + isDynamic, + getGlobalPackageDB, + pkgRoot, + runCmd, + -- * Constructing and deconstructing GHC environment files + Internal.GhcEnvironmentFileEntry(..), + Internal.simpleGhcEnvironmentFile, + Internal.renderGhcEnvironmentFile, + Internal.writeGhcEnvironmentFile, + Internal.ghcPlatformAndVersionString, + readGhcEnvironmentFile, + parseGhcEnvironmentFile, + ParseErrorExc(..), + -- * Version-specific implementation quirks + getImplInfo, + GhcImplInfo(..) + ) where + +import Prelude () +import Distribution.Compat.Prelude + +import qualified Distribution.Simple.GHC.Internal as Internal +import Distribution.Simple.GHC.ImplInfo +import Distribution.Simple.GHC.EnvironmentParser +import Distribution.PackageDescription.Utils (cabalBug) +import Distribution.PackageDescription as PD +import Distribution.InstalledPackageInfo (InstalledPackageInfo) +import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo +import Distribution.Simple.PackageIndex (InstalledPackageIndex) +import qualified Distribution.Simple.PackageIndex as PackageIndex +import Distribution.Simple.LocalBuildInfo +import Distribution.Types.ComponentLocalBuildInfo +import qualified Distribution.Simple.Hpc as Hpc +import Distribution.Simple.BuildPaths +import Distribution.Simple.Utils +import Distribution.Package +import qualified Distribution.ModuleName as ModuleName +import Distribution.ModuleName (ModuleName) +import Distribution.Simple.Program +import qualified Distribution.Simple.Program.HcPkg as HcPkg +import qualified Distribution.Simple.Program.Strip as Strip +import Distribution.Simple.Program.GHC +import Distribution.Simple.Setup +import qualified Distribution.Simple.Setup as Cabal +import Distribution.Simple.Compiler hiding (Flag) +import Distribution.Version +import Distribution.System +import Distribution.Verbosity +import Distribution.Pretty +import Distribution.Types.ForeignLib +import Distribution.Types.ForeignLibType +import Distribution.Types.ForeignLibOption +import Distribution.Types.UnqualComponentName +import Distribution.Utils.NubList + +import Control.Monad (msum) +import Data.Char (isLower) +import qualified Data.Map as Map +import System.Directory + ( doesFileExist, getAppUserDataDirectory, createDirectoryIfMissing + , canonicalizePath, removeFile, renameFile ) +import System.FilePath ( (), (<.>), takeExtension + , takeDirectory, replaceExtension + ,isRelative ) +import qualified System.Info + +-- ----------------------------------------------------------------------------- +-- Configuring + +configure :: Verbosity -> Maybe FilePath -> Maybe FilePath + -> ProgramDb + -> IO (Compiler, Maybe Platform, ProgramDb) +configure verbosity hcPath hcPkgPath conf0 = do + + (ghcjsProg, ghcjsVersion, progdb1) <- + requireProgramVersion verbosity ghcjsProgram + (orLaterVersion (mkVersion [0,1])) + (userMaybeSpecifyPath "ghcjs" hcPath conf0) + + Just ghcjsGhcVersion <- findGhcjsGhcVersion verbosity (programPath ghcjsProg) + unless (ghcjsGhcVersion < mkVersion [8,8]) $ + warn verbosity $ + "Unknown/unsupported 'ghc' version detected " + ++ "(Cabal " ++ prettyShow cabalVersion ++ " supports 'ghc' version < 8.8): " + ++ programPath ghcjsProg ++ " is is based on GHC version " ++ + prettyShow ghcjsGhcVersion + + let implInfo = ghcjsVersionImplInfo ghcjsVersion ghcjsGhcVersion + + -- This is slightly tricky, we have to configure ghc first, then we use the + -- location of ghc to help find ghc-pkg in the case that the user did not + -- specify the location of ghc-pkg directly: + (ghcjsPkgProg, ghcjsPkgVersion, progdb2) <- + requireProgramVersion verbosity ghcjsPkgProgram { + programFindLocation = guessGhcjsPkgFromGhcjsPath ghcjsProg + } + anyVersion (userMaybeSpecifyPath "ghcjs-pkg" hcPkgPath progdb1) + + Just ghcjsPkgGhcjsVersion <- findGhcjsPkgGhcjsVersion + verbosity (programPath ghcjsPkgProg) + + when (ghcjsVersion /= ghcjsPkgGhcjsVersion) $ die' verbosity $ + "Version mismatch between ghcjs and ghcjs-pkg: " + ++ programPath ghcjsProg ++ " is version " ++ prettyShow ghcjsVersion ++ " " + ++ programPath ghcjsPkgProg ++ " is version " ++ prettyShow ghcjsPkgGhcjsVersion + + when (ghcjsGhcVersion /= ghcjsPkgVersion) $ die' verbosity $ + "Version mismatch between ghcjs and ghcjs-pkg: " + ++ programPath ghcjsProg + ++ " was built with GHC version " ++ prettyShow ghcjsGhcVersion ++ " " + ++ programPath ghcjsPkgProg + ++ " was built with GHC version " ++ prettyShow ghcjsPkgVersion + + + -- Likewise we try to find the matching hsc2hs and haddock programs. + let hsc2hsProgram' = hsc2hsProgram { + programFindLocation = + guessHsc2hsFromGhcjsPath ghcjsProg + } + haddockProgram' = haddockProgram { + programFindLocation = + guessHaddockFromGhcjsPath ghcjsProg + } + hpcProgram' = hpcProgram { + programFindLocation = guessHpcFromGhcjsPath ghcjsProg + } + {- + runghcProgram' = runghcProgram { + programFindLocation = guessRunghcFromGhcjsPath ghcjsProg + } -} + progdb3 = addKnownProgram haddockProgram' $ + addKnownProgram hsc2hsProgram' $ + addKnownProgram hpcProgram' $ + {- addKnownProgram runghcProgram' -} progdb2 + + languages <- Internal.getLanguages verbosity implInfo ghcjsProg + extensions <- Internal.getExtensions verbosity implInfo ghcjsProg + + ghcjsInfo <- Internal.getGhcInfo verbosity implInfo ghcjsProg + let ghcInfoMap = Map.fromList ghcjsInfo + + let comp = Compiler { + compilerId = CompilerId GHCJS ghcjsVersion, + compilerAbiTag = AbiTag $ + "ghc" ++ intercalate "_" (map show . versionNumbers $ ghcjsGhcVersion), + compilerCompat = [CompilerId GHC ghcjsGhcVersion], + compilerLanguages = languages, + compilerExtensions = extensions, + compilerProperties = ghcInfoMap + } + compPlatform = Internal.targetPlatform ghcjsInfo + return (comp, compPlatform, progdb3) + +guessGhcjsPkgFromGhcjsPath :: ConfiguredProgram -> Verbosity + -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath])) +guessGhcjsPkgFromGhcjsPath = guessToolFromGhcjsPath ghcjsPkgProgram + +guessHsc2hsFromGhcjsPath :: ConfiguredProgram -> Verbosity + -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath])) +guessHsc2hsFromGhcjsPath = guessToolFromGhcjsPath hsc2hsProgram + +guessHaddockFromGhcjsPath :: ConfiguredProgram -> Verbosity + -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath])) +guessHaddockFromGhcjsPath = guessToolFromGhcjsPath haddockProgram + +guessHpcFromGhcjsPath :: ConfiguredProgram + -> Verbosity -> ProgramSearchPath + -> IO (Maybe (FilePath, [FilePath])) +guessHpcFromGhcjsPath = guessToolFromGhcjsPath hpcProgram + + +guessToolFromGhcjsPath :: Program -> ConfiguredProgram + -> Verbosity -> ProgramSearchPath + -> IO (Maybe (FilePath, [FilePath])) +guessToolFromGhcjsPath tool ghcjsProg verbosity searchpath + = do let toolname = programName tool + given_path = programPath ghcjsProg + given_dir = takeDirectory given_path + real_path <- canonicalizePath given_path + let real_dir = takeDirectory real_path + versionSuffix path = takeVersionSuffix (dropExeExtension path) + given_suf = versionSuffix given_path + real_suf = versionSuffix real_path + guessNormal dir = dir toolname <.> exeExtension buildPlatform + guessGhcjs dir = dir (toolname ++ "-ghcjs") + <.> exeExtension buildPlatform + guessGhcjsVersioned dir suf = dir (toolname ++ "-ghcjs" ++ suf) + <.> exeExtension buildPlatform + guessVersioned dir suf = dir (toolname ++ suf) + <.> exeExtension buildPlatform + mkGuesses dir suf | null suf = [guessGhcjs dir, guessNormal dir] + | otherwise = [guessGhcjsVersioned dir suf, + guessVersioned dir suf, + guessGhcjs dir, + guessNormal dir] + guesses = mkGuesses given_dir given_suf ++ + if real_path == given_path + then [] + else mkGuesses real_dir real_suf + info verbosity $ "looking for tool " ++ toolname + ++ " near compiler in " ++ given_dir + debug verbosity $ "candidate locations: " ++ show guesses + exists <- traverse doesFileExist guesses + case [ file | (file, True) <- zip guesses exists ] of + -- If we can't find it near ghc, fall back to the usual + -- method. + [] -> programFindLocation tool verbosity searchpath + (fp:_) -> do info verbosity $ "found " ++ toolname ++ " in " ++ fp + let lookedAt = map fst + . takeWhile (\(_file, exist) -> not exist) + $ zip guesses exists + return (Just (fp, lookedAt)) + + where takeVersionSuffix :: FilePath -> String + takeVersionSuffix = takeWhileEndLE isSuffixChar + + isSuffixChar :: Char -> Bool + isSuffixChar c = isDigit c || c == '.' || c == '-' + +getGhcInfo :: Verbosity -> ConfiguredProgram -> IO [(String, String)] +getGhcInfo verbosity ghcjsProg = Internal.getGhcInfo verbosity implInfo ghcjsProg + where + Just version = programVersion ghcjsProg + implInfo = ghcVersionImplInfo version + +-- | Given a single package DB, return all installed packages. +getPackageDBContents :: Verbosity -> PackageDB -> ProgramDb + -> IO InstalledPackageIndex +getPackageDBContents verbosity packagedb progdb = do + pkgss <- getInstalledPackages' verbosity [packagedb] progdb + toPackageIndex verbosity pkgss progdb + +-- | Given a package DB stack, return all installed packages. +getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramDb + -> IO InstalledPackageIndex +getInstalledPackages verbosity packagedbs progdb = do + checkPackageDbEnvVar verbosity + checkPackageDbStack verbosity packagedbs + pkgss <- getInstalledPackages' verbosity packagedbs progdb + index <- toPackageIndex verbosity pkgss progdb + return $! index + +toPackageIndex :: Verbosity + -> [(PackageDB, [InstalledPackageInfo])] + -> ProgramDb + -> IO InstalledPackageIndex +toPackageIndex verbosity pkgss progdb = do + -- On Windows, various fields have $topdir/foo rather than full + -- paths. We need to substitute the right value in so that when + -- we, for example, call gcc, we have proper paths to give it. + topDir <- getLibDir' verbosity ghcjsProg + let indices = [ PackageIndex.fromList (map (Internal.substTopDir topDir) pkgs) + | (_, pkgs) <- pkgss ] + return $! (mconcat indices) + + where + Just ghcjsProg = lookupProgram ghcjsProgram progdb + +getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath +getLibDir verbosity lbi = + dropWhileEndLE isSpace `fmap` + getDbProgramOutput verbosity ghcjsProgram + (withPrograms lbi) ["--print-libdir"] + +getLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath +getLibDir' verbosity ghcjsProg = + dropWhileEndLE isSpace `fmap` + getProgramOutput verbosity ghcjsProg ["--print-libdir"] + + +-- | Return the 'FilePath' to the global GHC package database. +getGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath +getGlobalPackageDB verbosity ghcProg = + dropWhileEndLE isSpace `fmap` + getProgramOutput verbosity ghcProg ["--print-global-package-db"] + +-- | Return the 'FilePath' to the per-user GHC package database. +getUserPackageDB :: Verbosity -> ConfiguredProgram -> Platform -> NoCallStackIO FilePath +getUserPackageDB _verbosity ghcjsProg platform = do + -- It's rather annoying that we have to reconstruct this, because ghc + -- hides this information from us otherwise. But for certain use cases + -- like change monitoring it really can't remain hidden. + appdir <- getAppUserDataDirectory "ghcjs" + return (appdir platformAndVersion packageConfFileName) + where + platformAndVersion = Internal.ghcPlatformAndVersionString + platform ghcjsVersion + packageConfFileName = "package.conf.d" + Just ghcjsVersion = programVersion ghcjsProg + +checkPackageDbEnvVar :: Verbosity -> IO () +checkPackageDbEnvVar verbosity = + Internal.checkPackageDbEnvVar verbosity "GHCJS" "GHCJS_PACKAGE_PATH" + +checkPackageDbStack :: Verbosity -> PackageDBStack -> IO () +checkPackageDbStack _ (GlobalPackageDB:rest) + | GlobalPackageDB `notElem` rest = return () +checkPackageDbStack verbosity rest + | GlobalPackageDB `notElem` rest = + die' verbosity $ "With current ghc versions the global package db is always used " + ++ "and must be listed first. This ghc limitation may be lifted in " + ++ "future, see http://ghc.haskell.org/trac/ghc/ticket/5977" +checkPackageDbStack verbosity _ = + die' verbosity $ "If the global package db is specified, it must be " + ++ "specified first and cannot be specified multiple times" + +getInstalledPackages' :: Verbosity -> [PackageDB] -> ProgramDb + -> IO [(PackageDB, [InstalledPackageInfo])] +getInstalledPackages' verbosity packagedbs progdb = + sequenceA + [ do pkgs <- HcPkg.dump (hcPkgInfo progdb) verbosity packagedb + return (packagedb, pkgs) + | packagedb <- packagedbs ] + +-- | Get the packages from specific PackageDBs, not cumulative. +-- +getInstalledPackagesMonitorFiles :: Verbosity -> Platform + -> ProgramDb + -> [PackageDB] + -> IO [FilePath] +getInstalledPackagesMonitorFiles verbosity platform progdb = + traverse getPackageDBPath + where + getPackageDBPath :: PackageDB -> IO FilePath + getPackageDBPath GlobalPackageDB = + selectMonitorFile =<< getGlobalPackageDB verbosity ghcjsProg + + getPackageDBPath UserPackageDB = + selectMonitorFile =<< getUserPackageDB verbosity ghcjsProg platform + + getPackageDBPath (SpecificPackageDB path) = selectMonitorFile path + + -- GHC has old style file dbs, and new style directory dbs. + -- Note that for dir style dbs, we only need to monitor the cache file, not + -- the whole directory. The ghc program itself only reads the cache file + -- so it's safe to only monitor this one file. + selectMonitorFile path = do + isFileStyle <- doesFileExist path + if isFileStyle then return path + else return (path "package.cache") + + Just ghcjsProg = lookupProgram ghcjsProgram progdb + + +toJSLibName :: String -> String +toJSLibName lib + | takeExtension lib `elem` [".dll",".dylib",".so"] + = replaceExtension lib "js_so" + | takeExtension lib == ".a" = replaceExtension lib "js_a" + | otherwise = lib <.> "js_a" + +-- ----------------------------------------------------------------------------- +-- Building a library + +buildLib :: Verbosity -> Cabal.Flag (Maybe Int) -> PackageDescription + -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo + -> IO () +buildLib = buildOrReplLib Nothing + +replLib :: [String] -> Verbosity + -> Cabal.Flag (Maybe Int) -> PackageDescription + -> LocalBuildInfo -> Library + -> ComponentLocalBuildInfo -> IO () +replLib = buildOrReplLib . Just + +buildOrReplLib :: Maybe [String] -> Verbosity + -> Cabal.Flag (Maybe Int) -> PackageDescription + -> LocalBuildInfo -> Library + -> ComponentLocalBuildInfo -> IO () +buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do + let uid = componentUnitId clbi + libTargetDir = componentBuildDir lbi clbi + whenVanillaLib forceVanilla = + when (forceVanilla || withVanillaLib lbi) + whenProfLib = when (withProfLib lbi) + whenSharedLib forceShared = + when (forceShared || withSharedLib lbi) + whenStaticLib forceStatic = + when (forceStatic || withStaticLib lbi) + -- whenGHCiLib = when (withGHCiLib lbi) + forRepl = maybe False (const True) mReplFlags + -- ifReplLib = when forRepl + comp = compiler lbi + implInfo = getImplInfo comp + platform@(Platform _hostArch _hostOS) = hostPlatform lbi + has_code = not (componentIsIndefinite clbi) + + (ghcjsProg, _) <- requireProgram verbosity ghcjsProgram (withPrograms lbi) + let runGhcjsProg = runGHC verbosity ghcjsProg comp platform + + let libBi = libBuildInfo lib + + -- fixme flags shouldn't depend on ghcjs being dynamic or not + let isGhcjsDynamic = isDynamic comp + dynamicTooSupported = supportsDynamicToo comp + doingTH = usesTemplateHaskellOrQQ libBi + forceVanillaLib = doingTH && not isGhcjsDynamic + forceSharedLib = doingTH && isGhcjsDynamic + -- TH always needs default libs, even when building for profiling + + -- Determine if program coverage should be enabled and if so, what + -- '-hpcdir' should be. + let isCoverageEnabled = libCoverage lbi + -- TODO: Historically HPC files have been put into a directory which + -- has the package name. I'm going to avoid changing this for + -- now, but it would probably be better for this to be the + -- component ID instead... + pkg_name = prettyShow (PD.package pkg_descr) + distPref = fromFlag $ configDistPref $ configFlags lbi + hpcdir way + | forRepl = mempty -- HPC is not supported in ghci + | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way pkg_name + | otherwise = mempty + + createDirectoryIfMissingVerbose verbosity True libTargetDir + -- TODO: do we need to put hs-boot files into place for mutually recursive + -- modules? + let cLikeFiles = fromNubListR $ toNubListR (cSources libBi) <> toNubListR (cxxSources libBi) + jsSrcs = jsSources libBi + cObjs = map (`replaceExtension` objExtension) cLikeFiles + baseOpts = componentGhcOptions verbosity lbi libBi clbi libTargetDir + linkJsLibOpts = mempty { + ghcOptExtra = + [ "-link-js-lib" , getHSLibraryName uid + , "-js-lib-outputdir", libTargetDir ] ++ + jsSrcs + } + vanillaOptsNoJsLib = baseOpts `mappend` mempty { + ghcOptMode = toFlag GhcModeMake, + ghcOptNumJobs = numJobs, + ghcOptInputModules = toNubListR $ allLibModules lib clbi, + ghcOptHPCDir = hpcdir Hpc.Vanilla + } + vanillaOpts = vanillaOptsNoJsLib `mappend` linkJsLibOpts + + profOpts = adjustExts "p_hi" "p_o" vanillaOpts `mappend` mempty { + ghcOptProfilingMode = toFlag True, + ghcOptProfilingAuto = Internal.profDetailLevelFlag True + (withProfLibDetail lbi), + -- ghcOptHiSuffix = toFlag "p_hi", + -- ghcOptObjSuffix = toFlag "p_o", + ghcOptExtra = hcProfOptions GHC libBi, + ghcOptHPCDir = hpcdir Hpc.Prof + } + + sharedOpts = adjustExts "dyn_hi" "dyn_o" vanillaOpts `mappend` mempty { + ghcOptDynLinkMode = toFlag GhcDynamicOnly, + ghcOptFPic = toFlag True, + -- ghcOptHiSuffix = toFlag "dyn_hi", + -- ghcOptObjSuffix = toFlag "dyn_o", + ghcOptExtra = hcSharedOptions GHC libBi, + ghcOptHPCDir = hpcdir Hpc.Dyn + } + + vanillaSharedOpts = vanillaOpts `mappend` mempty { + ghcOptDynLinkMode = toFlag GhcStaticAndDynamic, + ghcOptDynHiSuffix = toFlag "js_dyn_hi", + ghcOptDynObjSuffix = toFlag "js_dyn_o", + ghcOptHPCDir = hpcdir Hpc.Dyn + } + + unless (forRepl || null (allLibModules lib clbi) && null jsSrcs && null cObjs) $ + do let vanilla = whenVanillaLib forceVanillaLib (runGhcjsProg vanillaOpts) + shared = whenSharedLib forceSharedLib (runGhcjsProg sharedOpts) + useDynToo = dynamicTooSupported && + (forceVanillaLib || withVanillaLib lbi) && + (forceSharedLib || withSharedLib lbi) && + null (hcSharedOptions GHC libBi) + if not has_code + then vanilla + else + if useDynToo + then do + runGhcjsProg vanillaSharedOpts + case (hpcdir Hpc.Dyn, hpcdir Hpc.Vanilla) of + (Cabal.Flag dynDir, Cabal.Flag vanillaDir) -> + -- When the vanilla and shared library builds are done + -- in one pass, only one set of HPC module interfaces + -- are generated. This set should suffice for both + -- static and dynamically linked executables. We copy + -- the modules interfaces so they are available under + -- both ways. + copyDirectoryRecursive verbosity dynDir vanillaDir + _ -> return () + else if isGhcjsDynamic + then do shared; vanilla + else do vanilla; shared + whenProfLib (runGhcjsProg profOpts) + + -- Build any C++ sources separately. + {- + unless (not has_code || null (cxxSources libBi) || not nativeToo) $ do + info verbosity "Building C++ Sources..." + sequence_ + [ do let baseCxxOpts = Internal.componentCxxGhcOptions verbosity implInfo + lbi libBi clbi libTargetDir filename + vanillaCxxOpts = if isGhcjsDynamic + then baseCxxOpts { ghcOptFPic = toFlag True } + else baseCxxOpts + profCxxOpts = vanillaCxxOpts `mappend` mempty { + ghcOptProfilingMode = toFlag True, + ghcOptObjSuffix = toFlag "p_o" + } + sharedCxxOpts = vanillaCxxOpts `mappend` mempty { + ghcOptFPic = toFlag True, + ghcOptDynLinkMode = toFlag GhcDynamicOnly, + ghcOptObjSuffix = toFlag "dyn_o" + } + odir = fromFlag (ghcOptObjDir vanillaCxxOpts) + createDirectoryIfMissingVerbose verbosity True odir + let runGhcProgIfNeeded cxxOpts = do + needsRecomp <- checkNeedsRecompilation filename cxxOpts + when needsRecomp $ runGhcjsProg cxxOpts + runGhcProgIfNeeded vanillaCxxOpts + unless forRepl $ + whenSharedLib forceSharedLib (runGhcProgIfNeeded sharedCxxOpts) + unless forRepl $ whenProfLib (runGhcProgIfNeeded profCxxOpts) + | filename <- cxxSources libBi] + + ifReplLib $ do + when (null (allLibModules lib clbi)) $ warn verbosity "No exposed modules" + ifReplLib (runGhcjsProg replOpts) +-} + -- build any C sources + -- TODO: Add support for S and CMM files. + {- + unless (not has_code || null (cSources libBi) || not nativeToo) $ do + info verbosity "Building C Sources..." + sequence_ + [ do let baseCcOpts = Internal.componentCcGhcOptions verbosity implInfo + lbi libBi clbi libTargetDir filename + vanillaCcOpts = if isGhcjsDynamic + -- Dynamic GHC requires C sources to be built + -- with -fPIC for REPL to work. See #2207. + then baseCcOpts { ghcOptFPic = toFlag True } + else baseCcOpts + profCcOpts = vanillaCcOpts `mappend` mempty { + ghcOptProfilingMode = toFlag True, + ghcOptObjSuffix = toFlag "p_o" + } + sharedCcOpts = vanillaCcOpts `mappend` mempty { + ghcOptFPic = toFlag True, + ghcOptDynLinkMode = toFlag GhcDynamicOnly, + ghcOptObjSuffix = toFlag "dyn_o" + } + odir = fromFlag (ghcOptObjDir vanillaCcOpts) + createDirectoryIfMissingVerbose verbosity True odir + let runGhcProgIfNeeded ccOpts = do + needsRecomp <- checkNeedsRecompilation filename ccOpts + when needsRecomp $ runGhcjsProg ccOpts + runGhcProgIfNeeded vanillaCcOpts + unless forRepl $ + whenSharedLib forceSharedLib (runGhcProgIfNeeded sharedCcOpts) + unless forRepl $ whenProfLib (runGhcProgIfNeeded profCcOpts) + | filename <- cSources libBi] +-} + -- TODO: problem here is we need the .c files built first, so we can load them + -- with ghci, but .c files can depend on .h files generated by ghc by ffi + -- exports. + + -- link: + + when has_code . when False {- fixme nativeToo -} . unless forRepl $ do + info verbosity "Linking..." + let cSharedObjs = map (`replaceExtension` ("dyn_" ++ objExtension)) + (cSources libBi ++ cxxSources libBi) + compiler_id = compilerId (compiler lbi) + sharedLibFilePath = libTargetDir mkSharedLibName (hostPlatform lbi) compiler_id uid + staticLibFilePath = libTargetDir mkStaticLibName (hostPlatform lbi) compiler_id uid + + let stubObjs = [] + stubSharedObjs = [] + +{- + stubObjs <- catMaybes <$> sequenceA + [ findFileWithExtension [objExtension] [libTargetDir] + (ModuleName.toFilePath x ++"_stub") + | ghcVersion < mkVersion [7,2] -- ghc-7.2+ does not make _stub.o files + , x <- allLibModules lib clbi ] + stubProfObjs <- catMaybes <$> sequenceA + [ findFileWithExtension ["p_" ++ objExtension] [libTargetDir] + (ModuleName.toFilePath x ++"_stub") + | ghcVersion < mkVersion [7,2] -- ghc-7.2+ does not make _stub.o files + , x <- allLibModules lib clbi ] + stubSharedObjs <- catMaybes <$> sequenceA + [ findFileWithExtension ["dyn_" ++ objExtension] [libTargetDir] + (ModuleName.toFilePath x ++"_stub") + | ghcVersion < mkVersion [7,2] -- ghc-7.2+ does not make _stub.o files + , x <- allLibModules lib clbi ] +-} + hObjs <- Internal.getHaskellObjects implInfo lib lbi clbi + libTargetDir objExtension True + hSharedObjs <- + if withSharedLib lbi + then Internal.getHaskellObjects implInfo lib lbi clbi + libTargetDir ("dyn_" ++ objExtension) False + else return [] + + unless (null hObjs && null cObjs && null stubObjs) $ do + rpaths <- getRPaths lbi clbi + + let staticObjectFiles = + hObjs + ++ map (libTargetDir ) cObjs + ++ stubObjs + dynamicObjectFiles = + hSharedObjs + ++ map (libTargetDir ) cSharedObjs + ++ stubSharedObjs + -- After the relocation lib is created we invoke ghc -shared + -- with the dependencies spelled out as -package arguments + -- and ghc invokes the linker with the proper library paths + ghcSharedLinkArgs = + mempty { + ghcOptShared = toFlag True, + ghcOptDynLinkMode = toFlag GhcDynamicOnly, + ghcOptInputFiles = toNubListR dynamicObjectFiles, + ghcOptOutputFile = toFlag sharedLibFilePath, + ghcOptExtra = hcSharedOptions GHC libBi, + -- For dynamic libs, Mac OS/X needs to know the install location + -- at build time. This only applies to GHC < 7.8 - see the + -- discussion in #1660. + {- + ghcOptDylibName = if hostOS == OSX + && ghcVersion < mkVersion [7,8] + then toFlag sharedLibInstallPath + else mempty, -} + ghcOptHideAllPackages = toFlag True, + ghcOptNoAutoLinkPackages = toFlag True, + ghcOptPackageDBs = withPackageDB lbi, + ghcOptThisUnitId = case clbi of + LibComponentLocalBuildInfo { componentCompatPackageKey = pk } + -> toFlag pk + _ -> mempty, + ghcOptThisComponentId = case clbi of + LibComponentLocalBuildInfo { componentInstantiatedWith = insts } -> + if null insts + then mempty + else toFlag (componentComponentId clbi) + _ -> mempty, + ghcOptInstantiatedWith = case clbi of + LibComponentLocalBuildInfo { componentInstantiatedWith = insts } + -> insts + _ -> [], + ghcOptPackages = toNubListR $ + Internal.mkGhcOptPackages clbi , + ghcOptLinkLibs = extraLibs libBi, + ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi, + ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi, + ghcOptLinkFrameworkDirs = + toNubListR $ PD.extraFrameworkDirs libBi, + ghcOptRPaths = rpaths + } + ghcStaticLinkArgs = + mempty { + ghcOptStaticLib = toFlag True, + ghcOptInputFiles = toNubListR staticObjectFiles, + ghcOptOutputFile = toFlag staticLibFilePath, + ghcOptExtra = hcStaticOptions GHC libBi, + ghcOptHideAllPackages = toFlag True, + ghcOptNoAutoLinkPackages = toFlag True, + ghcOptPackageDBs = withPackageDB lbi, + ghcOptThisUnitId = case clbi of + LibComponentLocalBuildInfo { componentCompatPackageKey = pk } + -> toFlag pk + _ -> mempty, + ghcOptThisComponentId = case clbi of + LibComponentLocalBuildInfo { componentInstantiatedWith = insts } -> + if null insts + then mempty + else toFlag (componentComponentId clbi) + _ -> mempty, + ghcOptInstantiatedWith = case clbi of + LibComponentLocalBuildInfo { componentInstantiatedWith = insts } + -> insts + _ -> [], + ghcOptPackages = toNubListR $ + Internal.mkGhcOptPackages clbi , + ghcOptLinkLibs = extraLibs libBi, + ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi + } + + info verbosity (show (ghcOptPackages ghcSharedLinkArgs)) +{- + whenVanillaLib False $ do + Ar.createArLibArchive verbosity lbi vanillaLibFilePath staticObjectFiles + whenGHCiLib $ do + (ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi) + Ld.combineObjectFiles verbosity lbi ldProg + ghciLibFilePath staticObjectFiles + -} +{- + whenProfLib $ do + Ar.createArLibArchive verbosity lbi profileLibFilePath profObjectFiles + whenGHCiLib $ do + (ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi) + Ld.combineObjectFiles verbosity lbi ldProg + ghciProfLibFilePath profObjectFiles +-} + whenSharedLib False $ + runGhcjsProg ghcSharedLinkArgs + + whenStaticLib False $ + runGhcjsProg ghcStaticLinkArgs + +-- | Start a REPL without loading any source files. +startInterpreter :: Verbosity -> ProgramDb -> Compiler -> Platform + -> PackageDBStack -> IO () +startInterpreter verbosity progdb comp platform packageDBs = do + let replOpts = mempty { + ghcOptMode = toFlag GhcModeInteractive, + ghcOptPackageDBs = packageDBs + } + checkPackageDbStack verbosity packageDBs + (ghcjsProg, _) <- requireProgram verbosity ghcjsProgram progdb + runGHC verbosity ghcjsProg comp platform replOpts + +-- ----------------------------------------------------------------------------- +-- Building an executable or foreign library + +-- | Build a foreign library +buildFLib + :: Verbosity -> Cabal.Flag (Maybe Int) + -> PackageDescription -> LocalBuildInfo + -> ForeignLib -> ComponentLocalBuildInfo -> IO () +buildFLib v njobs pkg lbi = gbuild v njobs pkg lbi . GBuildFLib + +replFLib + :: [String] -> Verbosity + -> Cabal.Flag (Maybe Int) -> PackageDescription + -> LocalBuildInfo -> ForeignLib + -> ComponentLocalBuildInfo -> IO () +replFLib replFlags v njobs pkg lbi = + gbuild v njobs pkg lbi . GReplFLib replFlags + +-- | Build an executable with GHC. +-- +buildExe + :: Verbosity -> Cabal.Flag (Maybe Int) + -> PackageDescription -> LocalBuildInfo + -> Executable -> ComponentLocalBuildInfo -> IO () +buildExe v njobs pkg lbi = gbuild v njobs pkg lbi . GBuildExe + +replExe + :: [String] -> Verbosity + -> Cabal.Flag (Maybe Int) -> PackageDescription + -> LocalBuildInfo -> Executable + -> ComponentLocalBuildInfo -> IO () +replExe replFlags v njobs pkg lbi = + gbuild v njobs pkg lbi . GReplExe replFlags + +-- | Building an executable, starting the REPL, and building foreign +-- libraries are all very similar and implemented in 'gbuild'. The +-- 'GBuildMode' distinguishes between the various kinds of operation. +data GBuildMode = + GBuildExe Executable + | GReplExe [String] Executable + | GBuildFLib ForeignLib + | GReplFLib [String] ForeignLib + +gbuildInfo :: GBuildMode -> BuildInfo +gbuildInfo (GBuildExe exe) = buildInfo exe +gbuildInfo (GReplExe _ exe) = buildInfo exe +gbuildInfo (GBuildFLib flib) = foreignLibBuildInfo flib +gbuildInfo (GReplFLib _ flib) = foreignLibBuildInfo flib + +gbuildName :: GBuildMode -> String +gbuildName (GBuildExe exe) = unUnqualComponentName $ exeName exe +gbuildName (GReplExe _ exe) = unUnqualComponentName $ exeName exe +gbuildName (GBuildFLib flib) = unUnqualComponentName $ foreignLibName flib +gbuildName (GReplFLib _ flib) = unUnqualComponentName $ foreignLibName flib + +gbuildTargetName :: LocalBuildInfo -> GBuildMode -> String +gbuildTargetName lbi (GBuildExe exe) = exeTargetName (hostPlatform lbi) exe +gbuildTargetName lbi (GReplExe _ exe) = exeTargetName (hostPlatform lbi) exe +gbuildTargetName lbi (GBuildFLib flib) = flibTargetName lbi flib +gbuildTargetName lbi (GReplFLib _ flib) = flibTargetName lbi flib + +exeTargetName :: Platform -> Executable -> String +exeTargetName platform exe = unUnqualComponentName (exeName exe) `withExt` exeExtension platform + +-- | Target name for a foreign library (the actual file name) +-- +-- We do not use mkLibName and co here because the naming for foreign libraries +-- is slightly different (we don't use "_p" or compiler version suffices, and we +-- don't want the "lib" prefix on Windows). +-- +-- TODO: We do use `dllExtension` and co here, but really that's wrong: they +-- use the OS used to build cabal to determine which extension to use, rather +-- than the target OS (but this is wrong elsewhere in Cabal as well). +flibTargetName :: LocalBuildInfo -> ForeignLib -> String +flibTargetName lbi flib = + case (os, foreignLibType flib) of + (Windows, ForeignLibNativeShared) -> nm <.> "dll" + (Windows, ForeignLibNativeStatic) -> nm <.> "lib" + (Linux, ForeignLibNativeShared) -> "lib" ++ nm <.> versionedExt + (_other, ForeignLibNativeShared) -> "lib" ++ nm <.> dllExtension (hostPlatform lbi) + (_other, ForeignLibNativeStatic) -> "lib" ++ nm <.> staticLibExtension (hostPlatform lbi) + (_any, ForeignLibTypeUnknown) -> cabalBug "unknown foreign lib type" + where + nm :: String + nm = unUnqualComponentName $ foreignLibName flib + + os :: OS + os = let (Platform _ os') = hostPlatform lbi + in os' + + -- If a foreign lib foo has lib-version-info 5:1:2 or + -- lib-version-linux 3.2.1, it should be built as libfoo.so.3.2.1 + -- Libtool's version-info data is translated into library versions in a + -- nontrivial way: so refer to libtool documentation. + versionedExt :: String + versionedExt = + let nums = foreignLibVersion flib os + in foldl (<.>) "so" (map show nums) + +-- | Name for the library when building. +-- +-- If the `lib-version-info` field or the `lib-version-linux` field of +-- a foreign library target is set, we need to incorporate that +-- version into the SONAME field. +-- +-- If a foreign library foo has lib-version-info 5:1:2, it should be +-- built as libfoo.so.3.2.1. We want it to get soname libfoo.so.3. +-- However, GHC does not allow overriding soname by setting linker +-- options, as it sets a soname of its own (namely the output +-- filename), after the user-supplied linker options. Hence, we have +-- to compile the library with the soname as its filename. We rename +-- the compiled binary afterwards. +-- +-- This method allows to adjust the name of the library at build time +-- such that the correct soname can be set. +flibBuildName :: LocalBuildInfo -> ForeignLib -> String +flibBuildName lbi flib + -- On linux, if a foreign-library has version data, the first digit is used + -- to produce the SONAME. + | (os, foreignLibType flib) == + (Linux, ForeignLibNativeShared) + = let nums = foreignLibVersion flib os + in "lib" ++ nm <.> foldl (<.>) "so" (map show (take 1 nums)) + | otherwise = flibTargetName lbi flib + where + os :: OS + os = let (Platform _ os') = hostPlatform lbi + in os' + + nm :: String + nm = unUnqualComponentName $ foreignLibName flib + +gbuildIsRepl :: GBuildMode -> Bool +gbuildIsRepl (GBuildExe _) = False +gbuildIsRepl (GReplExe _ _) = True +gbuildIsRepl (GBuildFLib _) = False +gbuildIsRepl (GReplFLib _ _) = True + +gbuildNeedDynamic :: LocalBuildInfo -> GBuildMode -> Bool +gbuildNeedDynamic lbi bm = + case bm of + GBuildExe _ -> withDynExe lbi + GReplExe _ _ -> withDynExe lbi + GBuildFLib flib -> withDynFLib flib + GReplFLib _ flib -> withDynFLib flib + where + withDynFLib flib = + case foreignLibType flib of + ForeignLibNativeShared -> + ForeignLibStandalone `notElem` foreignLibOptions flib + ForeignLibNativeStatic -> + False + ForeignLibTypeUnknown -> + cabalBug "unknown foreign lib type" + +gbuildModDefFiles :: GBuildMode -> [FilePath] +gbuildModDefFiles (GBuildExe _) = [] +gbuildModDefFiles (GReplExe _ _) = [] +gbuildModDefFiles (GBuildFLib flib) = foreignLibModDefFile flib +gbuildModDefFiles (GReplFLib _ flib) = foreignLibModDefFile flib + +-- | "Main" module name when overridden by @ghc-options: -main-is ...@ +-- or 'Nothing' if no @-main-is@ flag could be found. +-- +-- In case of 'Nothing', 'Distribution.ModuleName.main' can be assumed. +exeMainModuleName :: Executable -> Maybe ModuleName +exeMainModuleName Executable{buildInfo = bnfo} = + -- GHC honors the last occurence of a module name updated via -main-is + -- + -- Moreover, -main-is when parsed left-to-right can update either + -- the "Main" module name, or the "main" function name, or both, + -- see also 'decodeMainIsArg'. + msum $ reverse $ map decodeMainIsArg $ findIsMainArgs ghcopts + where + ghcopts = hcOptions GHC bnfo + + findIsMainArgs [] = [] + findIsMainArgs ("-main-is":arg:rest) = arg : findIsMainArgs rest + findIsMainArgs (_:rest) = findIsMainArgs rest + +-- | Decode argument to '-main-is' +-- +-- Returns 'Nothing' if argument set only the function name. +-- +-- This code has been stolen/refactored from GHC's DynFlags.setMainIs +-- function. The logic here is deliberately imperfect as it is +-- intended to be bug-compatible with GHC's parser. See discussion in +-- https://github.com/haskell/cabal/pull/4539#discussion_r118981753. +decodeMainIsArg :: String -> Maybe ModuleName +decodeMainIsArg arg + | not (null main_fn) && isLower (head main_fn) + -- The arg looked like "Foo.Bar.baz" + = Just (ModuleName.fromString main_mod) + | isUpper (head arg) -- The arg looked like "Foo" or "Foo.Bar" + = Just (ModuleName.fromString arg) + | otherwise -- The arg looked like "baz" + = Nothing + where + (main_mod, main_fn) = splitLongestPrefix arg (== '.') + + splitLongestPrefix :: String -> (Char -> Bool) -> (String,String) + splitLongestPrefix str pred' + | null r_pre = (str, []) + | otherwise = (reverse (tail r_pre), reverse r_suf) + -- 'tail' drops the char satisfying 'pred' + where (r_suf, r_pre) = break pred' (reverse str) + + +-- | A collection of: +-- * C input files +-- * C++ input files +-- * GHC input files +-- * GHC input modules +-- +-- Used to correctly build and link sources. +data BuildSources = BuildSources { + cSourcesFiles :: [FilePath], + cxxSourceFiles :: [FilePath], + inputSourceFiles :: [FilePath], + inputSourceModules :: [ModuleName] + } + +-- | Locate and return the 'BuildSources' required to build and link. +gbuildSources :: Verbosity + -> Version -- ^ specVersion + -> FilePath + -> GBuildMode + -> IO BuildSources +gbuildSources verbosity specVer tmpDir bm = + case bm of + GBuildExe exe -> exeSources exe + GReplExe _ exe -> exeSources exe + GBuildFLib flib -> return $ flibSources flib + GReplFLib _ flib -> return $ flibSources flib + where + exeSources :: Executable -> IO BuildSources + exeSources exe@Executable{buildInfo = bnfo, modulePath = modPath} = do + main <- findFileEx verbosity (tmpDir : hsSourceDirs bnfo) modPath + let mainModName = fromMaybe ModuleName.main $ exeMainModuleName exe + otherModNames = exeModules exe + + if isHaskell main + then + if specVer < mkVersion [2] && (mainModName `elem` otherModNames) + then do + -- The cabal manual clearly states that `other-modules` is + -- intended for non-main modules. However, there's at least one + -- important package on Hackage (happy-1.19.5) which + -- violates this. We workaround this here so that we don't + -- invoke GHC with e.g. 'ghc --make Main src/Main.hs' which + -- would result in GHC complaining about duplicate Main + -- modules. + -- + -- Finally, we only enable this workaround for + -- specVersion < 2, as 'cabal-version:>=2.0' cabal files + -- have no excuse anymore to keep doing it wrong... ;-) + warn verbosity $ "Enabling workaround for Main module '" + ++ prettyShow mainModName + ++ "' listed in 'other-modules' illegally!" + + return BuildSources { + cSourcesFiles = cSources bnfo, + cxxSourceFiles = cxxSources bnfo, + inputSourceFiles = [main], + inputSourceModules = filter (/= mainModName) $ exeModules exe + } + + else return BuildSources { + cSourcesFiles = cSources bnfo, + cxxSourceFiles = cxxSources bnfo, + inputSourceFiles = [main], + inputSourceModules = exeModules exe + } + else let (csf, cxxsf) + | isCxx main = ( cSources bnfo, main : cxxSources bnfo) + -- if main is not a Haskell source + -- and main is not a C++ source + -- then we assume that it is a C source + | otherwise = (main : cSources bnfo, cxxSources bnfo) + + in return BuildSources { + cSourcesFiles = csf, + cxxSourceFiles = cxxsf, + inputSourceFiles = [], + inputSourceModules = exeModules exe + } + + flibSources :: ForeignLib -> BuildSources + flibSources flib@ForeignLib{foreignLibBuildInfo = bnfo} = + BuildSources { + cSourcesFiles = cSources bnfo, + cxxSourceFiles = cxxSources bnfo, + inputSourceFiles = [], + inputSourceModules = foreignLibModules flib + } + + isHaskell :: FilePath -> Bool + isHaskell fp = elem (takeExtension fp) [".hs", ".lhs"] + + isCxx :: FilePath -> Bool + isCxx fp = elem (takeExtension fp) [".cpp", ".cxx", ".c++"] + +-- | Generic build function. See comment for 'GBuildMode'. +gbuild :: Verbosity -> Cabal.Flag (Maybe Int) + -> PackageDescription -> LocalBuildInfo + -> GBuildMode -> ComponentLocalBuildInfo -> IO () +gbuild verbosity numJobs pkg_descr lbi bm clbi = do + (ghcjsProg, _) <- requireProgram verbosity ghcjsProgram (withPrograms lbi) + let replFlags = case bm of + GReplExe flags _ -> flags + GReplFLib flags _ -> flags + GBuildExe{} -> mempty + GBuildFLib{} -> mempty + comp = compiler lbi + platform = hostPlatform lbi + implInfo = getImplInfo comp + runGhcProg = runGHC verbosity ghcjsProg comp platform + + let (bnfo, threaded) = case bm of + GBuildFLib _ -> popThreadedFlag (gbuildInfo bm) + _ -> (gbuildInfo bm, False) + + -- the name that GHC really uses (e.g., with .exe on Windows for executables) + let targetName = gbuildTargetName lbi bm + let targetDir = buildDir lbi (gbuildName bm) + let tmpDir = targetDir (gbuildName bm ++ "-tmp") + createDirectoryIfMissingVerbose verbosity True targetDir + createDirectoryIfMissingVerbose verbosity True tmpDir + + -- TODO: do we need to put hs-boot files into place for mutually recursive + -- modules? FIX: what about exeName.hi-boot? + + -- Determine if program coverage should be enabled and if so, what + -- '-hpcdir' should be. + let isCoverageEnabled = exeCoverage lbi + distPref = fromFlag $ configDistPref $ configFlags lbi + hpcdir way + | gbuildIsRepl bm = mempty -- HPC is not supported in ghci + | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way (gbuildName bm) + | otherwise = mempty + + rpaths <- getRPaths lbi clbi + buildSources <- gbuildSources verbosity (specVersion pkg_descr) tmpDir bm + + let cSrcs = cSourcesFiles buildSources + cxxSrcs = cxxSourceFiles buildSources + inputFiles = inputSourceFiles buildSources + inputModules = inputSourceModules buildSources + isGhcDynamic = isDynamic comp + dynamicTooSupported = supportsDynamicToo comp + cObjs = map (`replaceExtension` objExtension) cSrcs + cxxObjs = map (`replaceExtension` objExtension) cxxSrcs + needDynamic = gbuildNeedDynamic lbi bm + needProfiling = withProfExe lbi + + -- build executables + baseOpts = (componentGhcOptions verbosity lbi bnfo clbi tmpDir) + `mappend` mempty { + ghcOptMode = toFlag GhcModeMake, + ghcOptInputFiles = toNubListR inputFiles, + ghcOptInputModules = toNubListR inputModules + } + staticOpts = baseOpts `mappend` mempty { + ghcOptDynLinkMode = toFlag GhcStaticOnly, + ghcOptHPCDir = hpcdir Hpc.Vanilla + } + profOpts = baseOpts `mappend` mempty { + ghcOptProfilingMode = toFlag True, + ghcOptProfilingAuto = Internal.profDetailLevelFlag False + (withProfExeDetail lbi), + ghcOptHiSuffix = toFlag "p_hi", + ghcOptObjSuffix = toFlag "p_o", + ghcOptExtra = hcProfOptions GHC bnfo, + ghcOptHPCDir = hpcdir Hpc.Prof + } + dynOpts = baseOpts `mappend` mempty { + ghcOptDynLinkMode = toFlag GhcDynamicOnly, + -- TODO: Does it hurt to set -fPIC for executables? + ghcOptFPic = toFlag True, + ghcOptHiSuffix = toFlag "dyn_hi", + ghcOptObjSuffix = toFlag "dyn_o", + ghcOptExtra = hcSharedOptions GHC bnfo, + ghcOptHPCDir = hpcdir Hpc.Dyn + } + dynTooOpts = staticOpts `mappend` mempty { + ghcOptDynLinkMode = toFlag GhcStaticAndDynamic, + ghcOptDynHiSuffix = toFlag "dyn_hi", + ghcOptDynObjSuffix = toFlag "dyn_o", + ghcOptHPCDir = hpcdir Hpc.Dyn + } + linkerOpts = mempty { + ghcOptLinkOptions = PD.ldOptions bnfo, + ghcOptLinkLibs = extraLibs bnfo, + ghcOptLinkLibPath = toNubListR $ extraLibDirs bnfo, + ghcOptLinkFrameworks = toNubListR $ + PD.frameworks bnfo, + ghcOptLinkFrameworkDirs = toNubListR $ + PD.extraFrameworkDirs bnfo, + ghcOptInputFiles = toNubListR + [tmpDir x | x <- cObjs ++ cxxObjs] + } + dynLinkerOpts = mempty { + ghcOptRPaths = rpaths + } + replOpts = baseOpts { + ghcOptExtra = Internal.filterGhciFlags + (ghcOptExtra baseOpts) + <> replFlags + } + -- For a normal compile we do separate invocations of ghc for + -- compiling as for linking. But for repl we have to do just + -- the one invocation, so that one has to include all the + -- linker stuff too, like -l flags and any .o files from C + -- files etc. + `mappend` linkerOpts + `mappend` mempty { + ghcOptMode = toFlag GhcModeInteractive, + ghcOptOptimisation = toFlag GhcNoOptimisation + } + commonOpts | needProfiling = profOpts + | needDynamic = dynOpts + | otherwise = staticOpts + compileOpts | useDynToo = dynTooOpts + | otherwise = commonOpts + withStaticExe = not needProfiling && not needDynamic + + -- For building exe's that use TH with -prof or -dynamic we actually have + -- to build twice, once without -prof/-dynamic and then again with + -- -prof/-dynamic. This is because the code that TH needs to run at + -- compile time needs to be the vanilla ABI so it can be loaded up and run + -- by the compiler. + -- With dynamic-by-default GHC the TH object files loaded at compile-time + -- need to be .dyn_o instead of .o. + doingTH = usesTemplateHaskellOrQQ bnfo + -- Should we use -dynamic-too instead of compiling twice? + useDynToo = dynamicTooSupported && isGhcDynamic + && doingTH && withStaticExe + && null (hcSharedOptions GHC bnfo) + compileTHOpts | isGhcDynamic = dynOpts + | otherwise = staticOpts + compileForTH + | gbuildIsRepl bm = False + | useDynToo = False + | isGhcDynamic = doingTH && (needProfiling || withStaticExe) + | otherwise = doingTH && (needProfiling || needDynamic) + + -- Build static/dynamic object files for TH, if needed. + when compileForTH $ + runGhcProg compileTHOpts { ghcOptNoLink = toFlag True + , ghcOptNumJobs = numJobs } + + -- Do not try to build anything if there are no input files. + -- This can happen if the cabal file ends up with only cSrcs + -- but no Haskell modules. + unless ((null inputFiles && null inputModules) + || gbuildIsRepl bm) $ + runGhcProg compileOpts { ghcOptNoLink = toFlag True + , ghcOptNumJobs = numJobs } + + -- build any C++ sources + unless (null cxxSrcs) $ do + info verbosity "Building C++ Sources..." + sequence_ + [ do let baseCxxOpts = Internal.componentCxxGhcOptions verbosity implInfo + lbi bnfo clbi tmpDir filename + vanillaCxxOpts = if isGhcDynamic + -- Dynamic GHC requires C++ sources to be built + -- with -fPIC for REPL to work. See #2207. + then baseCxxOpts { ghcOptFPic = toFlag True } + else baseCxxOpts + profCxxOpts = vanillaCxxOpts `mappend` mempty { + ghcOptProfilingMode = toFlag True + } + sharedCxxOpts = vanillaCxxOpts `mappend` mempty { + ghcOptFPic = toFlag True, + ghcOptDynLinkMode = toFlag GhcDynamicOnly + } + opts | needProfiling = profCxxOpts + | needDynamic = sharedCxxOpts + | otherwise = vanillaCxxOpts + -- TODO: Placing all Haskell, C, & C++ objects in a single directory + -- Has the potential for file collisions. In general we would + -- consider this a user error. However, we should strive to + -- add a warning if this occurs. + odir = fromFlag (ghcOptObjDir opts) + createDirectoryIfMissingVerbose verbosity True odir + needsRecomp <- checkNeedsRecompilation filename opts + when needsRecomp $ + runGhcProg opts + | filename <- cxxSrcs ] + + -- build any C sources + unless (null cSrcs) $ do + info verbosity "Building C Sources..." + sequence_ + [ do let baseCcOpts = Internal.componentCcGhcOptions verbosity implInfo + lbi bnfo clbi tmpDir filename + vanillaCcOpts = if isGhcDynamic + -- Dynamic GHC requires C sources to be built + -- with -fPIC for REPL to work. See #2207. + then baseCcOpts { ghcOptFPic = toFlag True } + else baseCcOpts + profCcOpts = vanillaCcOpts `mappend` mempty { + ghcOptProfilingMode = toFlag True + } + sharedCcOpts = vanillaCcOpts `mappend` mempty { + ghcOptFPic = toFlag True, + ghcOptDynLinkMode = toFlag GhcDynamicOnly + } + opts | needProfiling = profCcOpts + | needDynamic = sharedCcOpts + | otherwise = vanillaCcOpts + odir = fromFlag (ghcOptObjDir opts) + createDirectoryIfMissingVerbose verbosity True odir + needsRecomp <- checkNeedsRecompilation filename opts + when needsRecomp $ + runGhcProg opts + | filename <- cSrcs ] + + -- TODO: problem here is we need the .c files built first, so we can load them + -- with ghci, but .c files can depend on .h files generated by ghc by ffi + -- exports. + case bm of + GReplExe _ _ -> runGhcProg replOpts + GReplFLib _ _ -> runGhcProg replOpts + GBuildExe _ -> do + let linkOpts = commonOpts + `mappend` linkerOpts + `mappend` mempty { + ghcOptLinkNoHsMain = toFlag (null inputFiles) + } + `mappend` (if withDynExe lbi then dynLinkerOpts else mempty) + + info verbosity "Linking..." + -- Work around old GHCs not relinking in this + -- situation, see #3294 + let target = targetDir targetName + when (compilerVersion comp < mkVersion [7,7]) $ do + e <- doesFileExist target + when e (removeFile target) + runGhcProg linkOpts { ghcOptOutputFile = toFlag target } + GBuildFLib flib -> do + let rtsInfo = extractRtsInfo lbi + rtsOptLinkLibs = [ + if needDynamic + then if threaded + then dynRtsThreadedLib (rtsDynamicInfo rtsInfo) + else dynRtsVanillaLib (rtsDynamicInfo rtsInfo) + else if threaded + then statRtsThreadedLib (rtsStaticInfo rtsInfo) + else statRtsVanillaLib (rtsStaticInfo rtsInfo) + ] + linkOpts = case foreignLibType flib of + ForeignLibNativeShared -> + commonOpts + `mappend` linkerOpts + `mappend` dynLinkerOpts + `mappend` mempty { + ghcOptLinkNoHsMain = toFlag True, + ghcOptShared = toFlag True, + ghcOptLinkLibs = rtsOptLinkLibs, + ghcOptLinkLibPath = toNubListR $ rtsLibPaths rtsInfo, + ghcOptFPic = toFlag True, + ghcOptLinkModDefFiles = toNubListR $ gbuildModDefFiles bm + } + -- See Note [RPATH] + `mappend` ifNeedsRPathWorkaround lbi mempty { + ghcOptLinkOptions = ["-Wl,--no-as-needed"] + , ghcOptLinkLibs = ["ffi"] + } + ForeignLibNativeStatic -> + -- this should be caught by buildFLib + -- (and if we do implement tihs, we probably don't even want to call + -- ghc here, but rather Ar.createArLibArchive or something) + cabalBug "static libraries not yet implemented" + ForeignLibTypeUnknown -> + cabalBug "unknown foreign lib type" + -- We build under a (potentially) different filename to set a + -- soname on supported platforms. See also the note for + -- @flibBuildName@. + info verbosity "Linking..." + let buildName = flibBuildName lbi flib + runGhcProg linkOpts { ghcOptOutputFile = toFlag (targetDir buildName) } + renameFile (targetDir buildName) (targetDir targetName) + +{- +Note [RPATH] +~~~~~~~~~~~~ + +Suppose that the dynamic library depends on `base`, but not (directly) on +`integer-gmp` (which, however, is a dependency of `base`). We will link the +library as + + gcc ... -lHSbase-4.7.0.2-ghc7.8.4 -lHSinteger-gmp-0.5.1.0-ghc7.8.4 ... + +However, on systems (like Ubuntu) where the linker gets called with `-as-needed` +by default, the linker will notice that `integer-gmp` isn't actually a direct +dependency and hence omit the link. + +Then when we attempt to link a C program against this dynamic library, the +_static_ linker will attempt to verify that all symbols can be resolved. The +dynamic library itself does not require any symbols from `integer-gmp`, but +`base` does. In order to verify that the symbols used by `base` can be +resolved, the static linker needs to be able to _find_ integer-gmp. + +Finding the `base` dependency is simple, because the dynamic elf header +(`readelf -d`) for the library that we have created looks something like + + (NEEDED) Shared library: [libHSbase-4.7.0.2-ghc7.8.4.so] + (RPATH) Library rpath: [/path/to/base-4.7.0.2:...] + +However, when it comes to resolving the dependency on `integer-gmp`, it needs +to look at the dynamic header for `base`. On modern ghc (7.8 and higher) this +looks something like + + (NEEDED) Shared library: [libHSinteger-gmp-0.5.1.0-ghc7.8.4.so] + (RPATH) Library rpath: [$ORIGIN/../integer-gmp-0.5.1.0:...] + +This specifies the location of `integer-gmp` _in terms of_ the location of base +(using the `$ORIGIN`) variable. But here's the crux: when the static linker +attempts to verify that all symbols can be resolved, [**IT DOES NOT RESOLVE +`$ORIGIN`**](http://stackoverflow.com/questions/6323603/ld-using-rpath-origin-inside-a-shared-library-recursive). +As a consequence, it will not be able to resolve the symbols and report the +missing symbols as errors, _even though the dynamic linker **would** be able to +resolve these symbols_. We can tell the static linker not to report these +errors by using `--unresolved-symbols=ignore-all` and all will be fine when we +run the program ([(indeed, this is what the gold linker +does)](https://sourceware.org/ml/binutils/2013-05/msg00038.html), but it makes +the resulting library more difficult to use. + +Instead what we can do is make sure that the generated dynamic library has +explicit top-level dependencies on these libraries. This means that the static +linker knows where to find them, and when we have transitive dependencies on +the same libraries the linker will only load them once, so we avoid needing to +look at the `RPATH` of our dependencies. We can do this by passing +`--no-as-needed` to the linker, so that it doesn't omit any libraries. + +Note that on older ghc (7.6 and before) the Haskell libraries don't have an +RPATH set at all, which makes it even more important that we make these +top-level dependencies. + +Finally, we have to explicitly link against `libffi` for the same reason. For +newer ghc this _happens_ to be unnecessary on many systems because `libffi` is +a library which is not specific to GHC, and when the static linker verifies +that all symbols can be resolved it will find the `libffi` that is globally +installed (completely independent from ghc). Of course, this may well be the +_wrong_ version of `libffi`, but it's quite possible that symbol resolution +happens to work. This is of course the wrong approach, which is why we link +explicitly against `libffi` so that we will find the _right_ version of +`libffi`. +-} + +-- | Do we need the RPATH workaround? +-- +-- See Note [RPATH]. +ifNeedsRPathWorkaround :: Monoid a => LocalBuildInfo -> a -> a +ifNeedsRPathWorkaround lbi a = + case hostPlatform lbi of + Platform _ Linux -> a + _otherwise -> mempty + +data DynamicRtsInfo = DynamicRtsInfo { + dynRtsVanillaLib :: FilePath + , dynRtsThreadedLib :: FilePath + , dynRtsDebugLib :: FilePath + , dynRtsEventlogLib :: FilePath + , dynRtsThreadedDebugLib :: FilePath + , dynRtsThreadedEventlogLib :: FilePath + } + +data StaticRtsInfo = StaticRtsInfo { + statRtsVanillaLib :: FilePath + , statRtsThreadedLib :: FilePath + , statRtsDebugLib :: FilePath + , statRtsEventlogLib :: FilePath + , statRtsThreadedDebugLib :: FilePath + , statRtsThreadedEventlogLib :: FilePath + , statRtsProfilingLib :: FilePath + , statRtsThreadedProfilingLib :: FilePath + } + +data RtsInfo = RtsInfo { + rtsDynamicInfo :: DynamicRtsInfo + , rtsStaticInfo :: StaticRtsInfo + , rtsLibPaths :: [FilePath] + } + +-- | Extract (and compute) information about the RTS library +-- +-- TODO: This hardcodes the name as @HSrts-ghc@. I don't know if we can +-- find this information somewhere. We can lookup the 'hsLibraries' field of +-- 'InstalledPackageInfo' but it will tell us @["HSrts", "Cffi"]@, which +-- doesn't really help. +extractRtsInfo :: LocalBuildInfo -> RtsInfo +extractRtsInfo lbi = + case PackageIndex.lookupPackageName (installedPkgs lbi) (mkPackageName "rts") of + [(_, [rts])] -> aux rts + _otherwise -> error "No (or multiple) ghc rts package is registered" + where + aux :: InstalledPackageInfo -> RtsInfo + aux rts = RtsInfo { + rtsDynamicInfo = DynamicRtsInfo { + dynRtsVanillaLib = withGhcVersion "HSrts" + , dynRtsThreadedLib = withGhcVersion "HSrts_thr" + , dynRtsDebugLib = withGhcVersion "HSrts_debug" + , dynRtsEventlogLib = withGhcVersion "HSrts_l" + , dynRtsThreadedDebugLib = withGhcVersion "HSrts_thr_debug" + , dynRtsThreadedEventlogLib = withGhcVersion "HSrts_thr_l" + } + , rtsStaticInfo = StaticRtsInfo { + statRtsVanillaLib = "HSrts" + , statRtsThreadedLib = "HSrts_thr" + , statRtsDebugLib = "HSrts_debug" + , statRtsEventlogLib = "HSrts_l" + , statRtsThreadedDebugLib = "HSrts_thr_debug" + , statRtsThreadedEventlogLib = "HSrts_thr_l" + , statRtsProfilingLib = "HSrts_p" + , statRtsThreadedProfilingLib = "HSrts_thr_p" + } + , rtsLibPaths = InstalledPackageInfo.libraryDirs rts + } + withGhcVersion = (++ ("-ghc" ++ prettyShow (compilerVersion (compiler lbi)))) + +-- | Returns True if the modification date of the given source file is newer than +-- the object file we last compiled for it, or if no object file exists yet. +checkNeedsRecompilation :: FilePath -> GhcOptions -> NoCallStackIO Bool +checkNeedsRecompilation filename opts = filename `moreRecentFile` oname + where oname = getObjectFileName filename opts + +-- | Finds the object file name of the given source file +getObjectFileName :: FilePath -> GhcOptions -> FilePath +getObjectFileName filename opts = oname + where odir = fromFlag (ghcOptObjDir opts) + oext = fromFlagOrDefault "o" (ghcOptObjSuffix opts) + oname = odir replaceExtension filename oext + +-- | Calculate the RPATHs for the component we are building. +-- +-- Calculates relative RPATHs when 'relocatable' is set. +getRPaths :: LocalBuildInfo + -> ComponentLocalBuildInfo -- ^ Component we are building + -> NoCallStackIO (NubListR FilePath) +getRPaths lbi clbi | supportRPaths hostOS = do + libraryPaths <- depLibraryPaths False (relocatable lbi) lbi clbi + let hostPref = case hostOS of + OSX -> "@loader_path" + _ -> "$ORIGIN" + relPath p = if isRelative p then hostPref p else p + rpaths = toNubListR (map relPath libraryPaths) + return rpaths + where + (Platform _ hostOS) = hostPlatform lbi + compid = compilerId . compiler $ lbi + + -- The list of RPath-supported operating systems below reflects the + -- platforms on which Cabal's RPATH handling is tested. It does _NOT_ + -- reflect whether the OS supports RPATH. + + -- E.g. when this comment was written, the *BSD operating systems were + -- untested with regards to Cabal RPATH handling, and were hence set to + -- 'False', while those operating systems themselves do support RPATH. + supportRPaths Linux   = True + supportRPaths Windows = False + supportRPaths OSX   = True + supportRPaths FreeBSD   = + case compid of + CompilerId GHC ver | ver >= mkVersion [7,10,2] -> True + _ -> False + supportRPaths OpenBSD   = False + supportRPaths NetBSD   = False + supportRPaths DragonFly = False + supportRPaths Solaris = False + supportRPaths AIX = False + supportRPaths HPUX = False + supportRPaths IRIX = False + supportRPaths HaLVM = False + supportRPaths IOS = False + supportRPaths Android = False + supportRPaths Ghcjs = False + supportRPaths Hurd = False + supportRPaths (OtherOS _) = False + -- Do _not_ add a default case so that we get a warning here when a new OS + -- is added. + +getRPaths _ _ = return mempty + +-- | Remove the "-threaded" flag when building a foreign library, as it has no +-- effect when used with "-shared". Returns the updated 'BuildInfo', along +-- with whether or not the flag was present, so we can use it to link against +-- the appropriate RTS on our own. +popThreadedFlag :: BuildInfo -> (BuildInfo, Bool) +popThreadedFlag bi = + ( bi { options = filterHcOptions (/= "-threaded") (options bi) } + , hasThreaded (options bi)) + + where + filterHcOptions :: (String -> Bool) + -> PerCompilerFlavor [String] + -> PerCompilerFlavor [String] + filterHcOptions p (PerCompilerFlavor ghc ghcjs) = + PerCompilerFlavor (filter p ghc) ghcjs + + hasThreaded :: PerCompilerFlavor [String] -> Bool + hasThreaded (PerCompilerFlavor ghc _) = elem "-threaded" ghc + +-- | Extracts a String representing a hash of the ABI of a built +-- library. It can fail if the library has not yet been built. +-- +libAbiHash :: Verbosity -> PackageDescription -> LocalBuildInfo + -> Library -> ComponentLocalBuildInfo -> IO String +libAbiHash verbosity _pkg_descr lbi lib clbi = do + let + libBi = libBuildInfo lib + comp = compiler lbi + platform = hostPlatform lbi + vanillaArgs0 = + (componentGhcOptions verbosity lbi libBi clbi (componentBuildDir lbi clbi)) + `mappend` mempty { + ghcOptMode = toFlag GhcModeAbiHash, + ghcOptInputModules = toNubListR $ exposedModules lib + } + vanillaArgs = + -- Package DBs unnecessary, and break ghc-cabal. See #3633 + -- BUT, put at least the global database so that 7.4 doesn't + -- break. + vanillaArgs0 { ghcOptPackageDBs = [GlobalPackageDB] + , ghcOptPackages = mempty } + sharedArgs = vanillaArgs `mappend` mempty { + ghcOptDynLinkMode = toFlag GhcDynamicOnly, + ghcOptFPic = toFlag True, + ghcOptHiSuffix = toFlag "js_dyn_hi", + ghcOptObjSuffix = toFlag "js_dyn_o", + ghcOptExtra = hcSharedOptions GHC libBi + } + profArgs = vanillaArgs `mappend` mempty { + ghcOptProfilingMode = toFlag True, + ghcOptProfilingAuto = Internal.profDetailLevelFlag True + (withProfLibDetail lbi), + ghcOptHiSuffix = toFlag "js_p_hi", + ghcOptObjSuffix = toFlag "js_p_o", + ghcOptExtra = hcProfOptions GHC libBi + } + ghcArgs + | withVanillaLib lbi = vanillaArgs + | withSharedLib lbi = sharedArgs + | withProfLib lbi = profArgs + | otherwise = error "libAbiHash: Can't find an enabled library way" + + (ghcjsProg, _) <- requireProgram verbosity ghcjsProgram (withPrograms lbi) + hash <- getProgramInvocationOutput verbosity + (ghcInvocation ghcjsProg comp platform ghcArgs) + return (takeWhile (not . isSpace) hash) + +componentGhcOptions :: Verbosity -> LocalBuildInfo + -> BuildInfo -> ComponentLocalBuildInfo -> FilePath + -> GhcOptions +componentGhcOptions verbosity lbi bi clbi odir = + let opts = Internal.componentGhcOptions verbosity implInfo lbi bi clbi odir + comp = compiler lbi + implInfo = getImplInfo comp + in opts { ghcOptExtra = ghcOptExtra opts `mappend` hcOptions GHCJS bi + } + + +componentCcGhcOptions :: Verbosity -> LocalBuildInfo + -> BuildInfo -> ComponentLocalBuildInfo + -> FilePath -> FilePath + -> GhcOptions +componentCcGhcOptions verbosity lbi = + Internal.componentCcGhcOptions verbosity implInfo lbi + where + comp = compiler lbi + implInfo = getImplInfo comp + + +-- ----------------------------------------------------------------------------- +-- Installing + +-- |Install executables for GHCJS. +installExe :: Verbosity + -> LocalBuildInfo + -> FilePath -- ^Where to copy the files to + -> FilePath -- ^Build location + -> (FilePath, FilePath) -- ^Executable (prefix,suffix) + -> PackageDescription + -> Executable + -> IO () +installExe verbosity lbi binDir buildPref + (progprefix, progsuffix) _pkg exe = do + createDirectoryIfMissingVerbose verbosity True binDir + let exeName' = unUnqualComponentName $ exeName exe + exeFileName = exeName' + fixedExeBaseName = progprefix ++ exeName' ++ progsuffix + installBinary dest = do + runDbProgram verbosity ghcjsProgram (withPrograms lbi) $ + [ "--install-executable" + , buildPref exeName' exeFileName + , "-o", dest + ] ++ + case (stripExes lbi, lookupProgram stripProgram $ withPrograms lbi) of + (True, Just strip) -> ["-strip-program", programPath strip] + _ -> [] + installBinary (binDir fixedExeBaseName) + + +-- |Install foreign library for GHC. +installFLib :: Verbosity + -> LocalBuildInfo + -> FilePath -- ^install location + -> FilePath -- ^Build location + -> PackageDescription + -> ForeignLib + -> IO () +installFLib verbosity lbi targetDir builtDir _pkg flib = + install (foreignLibIsShared flib) + builtDir + targetDir + (flibTargetName lbi flib) + where + install _isShared srcDir dstDir name = do + let src = srcDir name + dst = dstDir name + createDirectoryIfMissingVerbose verbosity True targetDir + installOrdinaryFile verbosity src dst + + +-- |Install for ghc, .hi, .a and, if --with-ghci given, .o +installLib :: Verbosity + -> LocalBuildInfo + -> FilePath -- ^install location + -> FilePath -- ^install location for dynamic libraries + -> FilePath -- ^Build location + -> PackageDescription + -> Library + -> ComponentLocalBuildInfo + -> IO () +installLib verbosity lbi targetDir dynlibTargetDir _builtDir _pkg lib clbi = do + whenVanilla $ copyModuleFiles "js_hi" + whenProf $ copyModuleFiles "js_p_hi" + whenShared $ copyModuleFiles "js_dyn_hi" + + -- whenVanilla $ installOrdinary builtDir targetDir $ toJSLibName vanillaLibName + -- whenProf $ installOrdinary builtDir targetDir $ toJSLibName profileLibName + -- whenShared $ installShared builtDir dynlibTargetDir $ toJSLibName sharedLibName + -- fixme do these make the correct lib names? + whenHasCode $ do + whenVanilla $ do + sequence_ [ installOrdinary builtDir' targetDir (toJSLibName $ mkGenericStaticLibName (l ++ f)) + | l <- getHSLibraryName (componentUnitId clbi):(extraBundledLibs (libBuildInfo lib)) + , f <- "":extraLibFlavours (libBuildInfo lib) + ] + -- whenGHCi $ installOrdinary builtDir targetDir (toJSLibName ghciLibName) + whenProf $ do + installOrdinary builtDir' targetDir (toJSLibName profileLibName) + -- whenGHCi $ installOrdinary builtDir targetDir (toJSLibName ghciProfLibName) + whenShared $ + sequence_ [ installShared builtDir' dynlibTargetDir + (toJSLibName $ mkGenericSharedLibName platform compiler_id (l ++ f)) + | l <- getHSLibraryName uid : extraBundledLibs (libBuildInfo lib) + , f <- "":extraDynLibFlavours (libBuildInfo lib) + ] + where + builtDir' = componentBuildDir lbi clbi + + install isShared isJS srcDir dstDir name = do + let src = srcDir name + dst = dstDir name + createDirectoryIfMissingVerbose verbosity True dstDir + + if isShared + then installExecutableFile verbosity src dst + else installOrdinaryFile verbosity src dst + + when (stripLibs lbi && not isJS) $ + Strip.stripLib verbosity + (hostPlatform lbi) (withPrograms lbi) dst + + installOrdinary = install False True + installShared = install True True + + copyModuleFiles ext = + findModuleFilesEx verbosity [builtDir'] [ext] (allLibModules lib clbi) + >>= installOrdinaryFiles verbosity targetDir + + compiler_id = compilerId (compiler lbi) + platform = hostPlatform lbi + uid = componentUnitId clbi + -- vanillaLibName = mkLibName uid + profileLibName = mkProfLibName uid + -- sharedLibName = (mkSharedLibName (hostPlatform lbi) compiler_id) uid + + hasLib = not $ null (allLibModules lib clbi) + && null (cSources (libBuildInfo lib)) + && null (cxxSources (libBuildInfo lib)) + && null (jsSources (libBuildInfo lib)) + has_code = not (componentIsIndefinite clbi) + whenHasCode = when has_code + whenVanilla = when (hasLib && withVanillaLib lbi) + whenProf = when (hasLib && withProfLib lbi && has_code) + -- whenGHCi = when (hasLib && withGHCiLib lbi && has_code) + whenShared = when (hasLib && withSharedLib lbi && has_code) + + +adjustExts :: String -> String -> GhcOptions -> GhcOptions +adjustExts hiSuf objSuf opts = + opts `mappend` mempty { + ghcOptHiSuffix = toFlag hiSuf, + ghcOptObjSuffix = toFlag objSuf + } + +isDynamic :: Compiler -> Bool +isDynamic = Internal.ghcLookupProperty "GHC Dynamic" + +supportsDynamicToo :: Compiler -> Bool +supportsDynamicToo = Internal.ghcLookupProperty "Support dynamic-too" + +withExt :: FilePath -> String -> FilePath +withExt fp ext = fp <.> if takeExtension fp /= ('.':ext) then ext else "" + +findGhcjsGhcVersion :: Verbosity -> FilePath -> IO (Maybe Version) +findGhcjsGhcVersion verbosity pgm = + findProgramVersion "--numeric-ghc-version" id verbosity pgm + +findGhcjsPkgGhcjsVersion :: Verbosity -> FilePath -> IO (Maybe Version) +findGhcjsPkgGhcjsVersion verbosity pgm = + findProgramVersion "--numeric-ghcjs-version" id verbosity pgm + +-- ----------------------------------------------------------------------------- +-- Registering + +hcPkgInfo :: ProgramDb -> HcPkg.HcPkgInfo +hcPkgInfo progdb = HcPkg.HcPkgInfo { HcPkg.hcPkgProgram = ghcjsPkgProg + , HcPkg.noPkgDbStack = False + , HcPkg.noVerboseFlag = False + , HcPkg.flagPackageConf = False + , HcPkg.supportsDirDbs = True + , HcPkg.requiresDirDbs = ver >= v7_10 + , HcPkg.nativeMultiInstance = ver >= v7_10 + , HcPkg.recacheMultiInstance = True + , HcPkg.suppressFilesCheck = True + } + where + v7_10 = mkVersion [7,10] + Just ghcjsPkgProg = lookupProgram ghcjsPkgProgram progdb + Just ver = programVersion ghcjsPkgProg + +registerPackage + :: Verbosity + -> ProgramDb + -> PackageDBStack + -> InstalledPackageInfo + -> HcPkg.RegisterOptions + -> IO () +registerPackage verbosity progdb packageDbs installedPkgInfo registerOptions = + HcPkg.register (hcPkgInfo progdb) verbosity packageDbs + installedPkgInfo registerOptions + +pkgRoot :: Verbosity -> LocalBuildInfo -> PackageDB -> IO FilePath +pkgRoot verbosity lbi = pkgRoot' + where + pkgRoot' GlobalPackageDB = + let Just ghcjsProg = lookupProgram ghcjsProgram (withPrograms lbi) + in fmap takeDirectory (getGlobalPackageDB verbosity ghcjsProg) + pkgRoot' UserPackageDB = do + appDir <- getAppUserDataDirectory "ghcjs" + -- fixme correct this version + let ver = compilerVersion (compiler lbi) + subdir = System.Info.arch ++ '-':System.Info.os + ++ '-':prettyShow ver + rootDir = appDir subdir + -- We must create the root directory for the user package database if it + -- does not yet exists. Otherwise '${pkgroot}' will resolve to a + -- directory at the time of 'ghc-pkg register', and registration will + -- fail. + createDirectoryIfMissing True rootDir + return rootDir + pkgRoot' (SpecificPackageDB fp) = return (takeDirectory fp) + -- | Get the JavaScript file name and command and arguments to run a -- program compiled by GHCJS diff --git a/cabal/Cabal/Distribution/Simple/Glob.hs b/cabal/Cabal/Distribution/Simple/Glob.hs --- a/cabal/Cabal/Distribution/Simple/Glob.hs +++ b/cabal/Cabal/Distribution/Simple/Glob.hs @@ -210,9 +210,16 @@ -- | This will 'die'' when the glob matches no files, or if the glob -- refers to a missing directory, or if the glob fails to parse. -- --- The returned values do not include the supplied @dir@ prefix, which --- must itself be a valid directory (hence, it can't be the empty --- string). +-- The 'Version' argument must be the spec version of the package +-- description being processed, as globs behave slightly differently +-- in different spec versions. +-- +-- The first 'FilePath' argument is the directory that the glob is +-- relative to. It must be a valid directory (and hence it can't be +-- the empty string). The returned values will not include this +-- prefix. +-- +-- The second 'FilePath' is the glob itself. matchDirFileGlob :: Verbosity -> Version -> FilePath -> FilePath -> IO [FilePath] matchDirFileGlob verbosity version dir filepath = case parseFileGlob version filepath of Left err -> die' verbosity $ explainGlobSyntaxError filepath err @@ -234,9 +241,13 @@ -- | Match files against a pre-parsed glob, starting in a directory. -- --- The returned values do not include the supplied @dir@ prefix, which --- must itself be a valid directory (hence, it can't be the empty --- string). +-- The 'Version' argument must be the spec version of the package +-- description being processed, as globs behave slightly differently +-- in different spec versions. +-- +-- The 'FilePath' argument is the directory that the glob is relative +-- to. It must be a valid directory (and hence it can't be the empty +-- string). The returned values will not include this prefix. runDirFileGlob :: Verbosity -> FilePath -> Glob -> IO [GlobResult FilePath] runDirFileGlob verbosity rawDir pat = do -- The default data-dir is null. Our callers -should- be diff --git a/cabal/Cabal/Distribution/Simple/Haddock.hs b/cabal/Cabal/Distribution/Simple/Haddock.hs --- a/cabal/Cabal/Distribution/Simple/Haddock.hs +++ b/cabal/Cabal/Distribution/Simple/Haddock.hs @@ -32,12 +32,14 @@ -- local import Distribution.Backpack.DescribeUnitId +import Distribution.Backpack (OpenModule) import Distribution.Types.ForeignLib import Distribution.Types.UnqualComponentName import Distribution.Types.ComponentLocalBuildInfo import Distribution.Types.ExecutableScope import Distribution.Types.LocalBuildInfo import Distribution.Types.TargetInfo +import Distribution.Types.ExposedModule import Distribution.Package import qualified Distribution.ModuleName as ModuleName import Distribution.PackageDescription as PD hiding (Flag) @@ -60,9 +62,11 @@ import Distribution.InstalledPackageInfo ( InstalledPackageInfo ) import Distribution.Simple.Utils import Distribution.System -import Distribution.Text +import Distribution.Pretty +import Distribution.Parsec (simpleParsec) import Distribution.Utils.NubList import Distribution.Version + import Distribution.Verbosity import Language.Haskell.Extension @@ -114,6 +118,8 @@ -- ^ Additional flags to pass to GHC. argGhcLibDir :: Flag FilePath, -- ^ To find the correct GHC, required. + argReexports :: [OpenModule], + -- ^ Re-exported modules argTargets :: [FilePath] -- ^ Modules to process. } deriving Generic @@ -192,7 +198,7 @@ haddockGhcVersionStr <- getProgramOutput verbosity haddockProg ["--ghc-version"] - case (simpleParse haddockGhcVersionStr, compilerCompatVersion GHC comp) of + case (simpleParsec haddockGhcVersionStr, compilerCompatVersion GHC comp) of (Nothing, _) -> die' verbosity "Could not get GHC version from Haddock" (_, Nothing) -> die' verbosity "Could not get GHC version from compiler" (Just haddockGhcVersion, Just ghcVersion) @@ -200,8 +206,8 @@ | otherwise -> die' verbosity $ "Haddock's internal GHC version must match the configured " ++ "GHC version.\n" - ++ "The GHC version is " ++ display ghcVersion ++ " but " - ++ "haddock is using GHC version " ++ display haddockGhcVersion + ++ "The GHC version is " ++ prettyShow ghcVersion ++ " but " + ++ "haddock is using GHC version " ++ prettyShow haddockGhcVersion -- the tools match the requests, we can proceed @@ -273,7 +279,9 @@ runHaddock verbosity tmpFileOpts comp platform haddockProg libArgs' case libName lib of - Just _ -> do + LMainLibName -> + pure index + LSubLibName _ -> do pwd <- getCurrentDirectory let @@ -291,8 +299,6 @@ } return $ PackageIndex.insert ipi index - Nothing -> - pure index CFLib flib -> (when (flag haddockForeignLibs) $ do withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi') "tmp" $ @@ -357,7 +363,7 @@ } where desc = PD.description pkg_descr - showPkg = display (packageId pkg_descr) + showPkg = prettyShow (packageId pkg_descr) subtitle | null (synopsis pkg_descr) = "" | otherwise = ": " ++ synopsis pkg_descr @@ -408,10 +414,11 @@ else die' verbosity $ "Must have vanilla or shared libraries " ++ "enabled in order to run haddock" - return ifaceArgs { - argGhcOptions = opts, - argTargets = inFiles - } + return ifaceArgs + { argGhcOptions = opts + , argTargets = inFiles + , argReexports = getReexports clbi + } fromLibrary :: Verbosity -> FilePath @@ -495,6 +502,11 @@ argInterfaces = packageFlags } +getReexports :: ComponentLocalBuildInfo -> [OpenModule] +getReexports LibComponentLocalBuildInfo {componentExposedModules = mods } = + mapMaybe exposedReexport mods +getReexports _ = [] + getGhcCppOpts :: Version -> BuildInfo -> GhcOptions @@ -585,7 +597,7 @@ Hoogle -> pkgstr <.> "txt") $ arg argOutput where - pkgstr = display $ packageName pkgid + pkgstr = prettyShow $ packageName pkgid pkgid = arg argPackageName arg f = fromFlag $ f args @@ -595,8 +607,8 @@ . fromFlag . argInterfaceFile $ args , if isVersion 2 16 - then (\pkg -> [ "--package-name=" ++ display (pkgName pkg) - , "--package-version="++display (pkgVersion pkg) + then (\pkg -> [ "--package-name=" ++ prettyShow (pkgName pkg) + , "--package-version=" ++ prettyShow (pkgVersion pkg) ]) . fromFlag . argPackageName $ args else [] @@ -609,7 +621,7 @@ , [ "--hyperlinked-source" | isVersion 2 17 , fromFlag . argLinkedSource $ args ] - , (\(All b,xs) -> bool (map (("--hide=" ++). display) xs) [] b) + , (\(All b,xs) -> bool (map (("--hide=" ++) . prettyShow) xs) [] b) . argHideModules $ args , bool ["--ignore-all-exports"] [] . getAny . argIgnoreExports $ args @@ -645,6 +657,12 @@ , maybe [] (\l -> ["-B"++l]) $ flagToMaybe (argGhcLibDir args) -- error if Nothing? + -- https://github.com/haskell/haddock/pull/547 + , [ "--reexport=" ++ prettyShow r + | r <- argReexports args + , isVersion 2 19 + ] + , argTargets $ args ] where @@ -717,7 +735,7 @@ let missing = [ pkgid | Left pkgid <- interfaces ] warning = "The documentation for the following packages are not " ++ "installed. No links will be generated to these packages: " - ++ intercalate ", " (map display missing) + ++ intercalate ", " (map prettyShow missing) flags = rights interfaces return (flags, if null missing then Nothing else Just warning) diff --git a/cabal/Cabal/Distribution/Simple/HaskellSuite.hs b/cabal/Cabal/Distribution/Simple/HaskellSuite.hs --- a/cabal/Cabal/Distribution/Simple/HaskellSuite.hs +++ b/cabal/Cabal/Distribution/Simple/HaskellSuite.hs @@ -6,7 +6,10 @@ import Prelude () import Distribution.Compat.Prelude +import Data.Either (partitionEithers) + import qualified Data.Map as Map (empty) +import qualified Data.List.NonEmpty as NE import Distribution.Simple.Program import Distribution.Simple.Compiler as Compiler @@ -14,7 +17,8 @@ import Distribution.Simple.BuildPaths import Distribution.Verbosity import Distribution.Version -import Distribution.Text +import Distribution.Pretty +import Distribution.Parsec (simpleParsec) import Distribution.Package import Distribution.InstalledPackageInfo hiding (includeDirs) import Distribution.Simple.PackageIndex as PackageIndex @@ -99,7 +103,7 @@ versionStr = last parts version <- maybe (die' verbosity "haskell-suite: couldn't determine compiler version") return $ - simpleParse versionStr + simpleParsec versionStr return (name, version) getExtensions :: Verbosity -> ConfiguredProgram -> IO [(Extension, Maybe Compiler.Flag)] @@ -108,7 +112,7 @@ lines `fmap` rawSystemStdout verbosity (programPath prog) ["--supported-extensions"] return - [ (ext, Just $ "-X" ++ display ext) | Just ext <- map simpleParse extStrs ] + [ (ext, Just $ "-X" ++ prettyShow ext) | Just ext <- map simpleParsec extStrs ] getLanguages :: Verbosity -> ConfiguredProgram -> IO [(Language, Compiler.Flag)] getLanguages verbosity prog = do @@ -116,7 +120,7 @@ lines `fmap` rawSystemStdout verbosity (programPath prog) ["--supported-languages"] return - [ (ext, "-G" ++ display ext) | Just ext <- map simpleParse langStrs ] + [ (ext, "-G" ++ prettyShow ext) | Just ext <- map simpleParsec langStrs ] -- Other compilers do some kind of a packagedb stack check here. Not sure -- if we need something like that as well. @@ -134,10 +138,9 @@ where parsePackages str = - let parsed = map parseInstalledPackageInfo (splitPkgs str) - in case [ msg | ParseFailed msg <- parsed ] of - [] -> Right [ pkg | ParseOk _ pkg <- parsed ] - msgs -> Left msgs + case partitionEithers $ map parseInstalledPackageInfo (splitPkgs str) of + ([], ok) -> Right [ pkg | (_, pkg) <- ok ] + (msgss, _) -> Left (foldMap NE.toList msgss) splitPkgs :: String -> [String] splitPkgs = map unlines . splitWith ("---" ==) . lines @@ -173,13 +176,13 @@ ,autogenPackageModulesDir lbi ,odir] ++ includeDirs bi ] ++ [ packageDbOpt pkgDb | pkgDb <- dbStack ] ++ - [ "--package-name", display pkgid ] ++ - concat [ ["--package-id", display ipkgid ] + [ "--package-name", prettyShow pkgid ] ++ + concat [ ["--package-id", prettyShow ipkgid ] | (ipkgid, _) <- componentPackageDeps clbi ] ++ - ["-G", display language] ++ - concat [ ["-X", display ex] | ex <- usedExtensions bi ] ++ + ["-G", prettyShow language] ++ + concat [ ["-X", prettyShow ex] | ex <- usedExtensions bi ] ++ cppOptions (libBuildInfo lib) ++ - [ display modu | modu <- allLibModules lib clbi ] + [ prettyShow modu | modu <- allLibModules lib clbi ] @@ -200,8 +203,8 @@ , "--build-dir", builtDir , "--target-dir", targetDir , "--dynlib-target-dir", dynlibTargetDir - , "--package-id", display $ packageId pkg - ] ++ map display (allLibModules lib clbi) + , "--package-id", prettyShow $ packageId pkg + ] ++ map prettyShow (allLibModules lib clbi) registerPackage :: Verbosity diff --git a/cabal/Cabal/Distribution/Simple/Install.hs b/cabal/Cabal/Distribution/Simple/Install.hs --- a/cabal/Cabal/Distribution/Simple/Install.hs +++ b/cabal/Cabal/Distribution/Simple/Install.hs @@ -56,8 +56,8 @@ ( takeFileName, takeDirectory, (), isRelative ) import Distribution.Verbosity -import Distribution.Text - ( display ) +import Distribution.Pretty + ( prettyShow ) -- |Perform the \"@.\/setup install@\" and \"@.\/setup copy@\" -- actions. Move files into place based on the prefix argument. @@ -97,21 +97,10 @@ -- per-component (data files and Haddock files.) InstallDirs { datadir = dataPref, - -- NB: The situation with Haddock is a bit delicate. On the - -- one hand, the easiest to understand Haddock documentation - -- path is pkgname-0.1, which means it's per-package (not - -- per-component). But this means that it's impossible to - -- install Haddock documentation for internal libraries. We'll - -- keep this constraint for now; this means you can't use - -- Cabal to Haddock internal libraries. This does not seem - -- like a big problem. docdir = docPref, htmldir = htmlPref, - haddockdir = interfacePref} - -- Notice use of 'absoluteInstallDirs' (not the - -- per-component variant). This means for non-library - -- packages we'll just pick a nondescriptive foo-0.1 - = absoluteInstallDirs pkg_descr lbi copydest + haddockdir = interfacePref + } = absoluteInstallCommandDirs pkg_descr lbi (localUnitId lbi) copydest -- Install (package-global) data files installDataFiles verbosity pkg_descr dataPref @@ -161,12 +150,12 @@ libdir = libPref, dynlibdir = dynlibPref, includedir = incPref - } = absoluteComponentInstallDirs pkg_descr lbi (componentUnitId clbi) copydest + } = absoluteInstallCommandDirs pkg_descr lbi (componentUnitId clbi) copydest buildPref = componentBuildDir lbi clbi case libName lib of - Nothing -> noticeNoWrap verbosity ("Installing library in " ++ libPref) - Just n -> noticeNoWrap verbosity ("Installing internal library " ++ display n ++ " in " ++ libPref) + LMainLibName -> noticeNoWrap verbosity ("Installing library in " ++ libPref) + LSubLibName n -> noticeNoWrap verbosity ("Installing internal library " ++ prettyShow n ++ " in " ++ libPref) -- install include files for all compilers - they may be needed to compile -- haskell files (using the CPP extension) @@ -179,7 +168,7 @@ HaskellSuite _ -> HaskellSuite.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr lib clbi _ -> die' verbosity $ "installing with " - ++ display (compilerFlavor (compiler lbi)) + ++ prettyShow (compilerFlavor (compiler lbi)) ++ " is not implemented" copyComponent verbosity pkg_descr lbi (CFLib flib) clbi copydest = do @@ -194,8 +183,9 @@ case compilerFlavor (compiler lbi) of GHC -> GHC.installFLib verbosity lbi flibPref buildPref pkg_descr flib + GHCJS -> GHCJS.installFLib verbosity lbi flibPref buildPref pkg_descr flib _ -> die' verbosity $ "installing foreign lib with " - ++ display (compilerFlavor (compiler lbi)) + ++ prettyShow (compilerFlavor (compiler lbi)) ++ " is not implemented" copyComponent verbosity pkg_descr lbi (CExe exe) clbi copydest = do @@ -210,7 +200,7 @@ progPrefixPref = substPathTemplate pkgid lbi uid (progPrefix lbi) progSuffixPref = substPathTemplate pkgid lbi uid (progSuffix lbi) progFix = (progPrefixPref, progSuffixPref) - noticeNoWrap verbosity ("Installing executable " ++ display (exeName exe) + noticeNoWrap verbosity ("Installing executable " ++ prettyShow (exeName exe) ++ " in " ++ binPref) inPath <- isInSearchPath binPref when (not inPath) $ @@ -222,7 +212,7 @@ UHC -> return () HaskellSuite {} -> return () _ -> die' verbosity $ "installing with " - ++ display (compilerFlavor (compiler lbi)) + ++ prettyShow (compilerFlavor (compiler lbi)) ++ " is not implemented" -- Nothing to do for benchmark/testsuite @@ -233,17 +223,17 @@ -- installDataFiles :: Verbosity -> PackageDescription -> FilePath -> IO () installDataFiles verbosity pkg_descr destDataDir = - flip traverse_ (dataFiles pkg_descr) $ \ file -> do + flip traverse_ (dataFiles pkg_descr) $ \ glob -> do let srcDataDirRaw = dataDir pkg_descr srcDataDir = if null srcDataDirRaw then "." else srcDataDirRaw - files <- matchDirFileGlob verbosity (specVersion pkg_descr) srcDataDir file - let dir = takeDirectory file - createDirectoryIfMissingVerbose verbosity True (destDataDir dir) - sequence_ [ installOrdinaryFile verbosity (srcDataDir file') - (destDataDir file') - | file' <- files ] + files <- matchDirFileGlob verbosity (specVersion pkg_descr) srcDataDir glob + for_ files $ \ file' -> do + let src = srcDataDir file' + dst = destDataDir file' + createDirectoryIfMissingVerbose verbosity True (takeDirectory dst) + installOrdinaryFile verbosity src dst -- | Install the files listed in install-includes for a library -- diff --git a/cabal/Cabal/Distribution/Simple/InstallDirs.hs b/cabal/Cabal/Distribution/Simple/InstallDirs.hs --- a/cabal/Cabal/Distribution/Simple/InstallDirs.hs +++ b/cabal/Cabal/Distribution/Simple/InstallDirs.hs @@ -52,10 +52,11 @@ import Distribution.Compat.Prelude import Distribution.Compat.Environment (lookupEnv) +import Distribution.Pretty import Distribution.Package import Distribution.System import Distribution.Compiler -import Distribution.Text +import Distribution.Simple.InstallDirs.Internal import System.Directory (getAppUserDataDirectory) import System.FilePath @@ -355,47 +356,15 @@ instance Binary PathTemplate -data PathComponent = - Ordinary FilePath - | Variable PathTemplateVariable - deriving (Eq, Ord, Generic) - -instance Binary PathComponent - -data PathTemplateVariable = - PrefixVar -- ^ The @$prefix@ path variable - | BindirVar -- ^ The @$bindir@ path variable - | LibdirVar -- ^ The @$libdir@ path variable - | LibsubdirVar -- ^ The @$libsubdir@ path variable - | DynlibdirVar -- ^ The @$dynlibdir@ path variable - | DatadirVar -- ^ The @$datadir@ path variable - | DatasubdirVar -- ^ The @$datasubdir@ path variable - | DocdirVar -- ^ The @$docdir@ path variable - | HtmldirVar -- ^ The @$htmldir@ path variable - | PkgNameVar -- ^ The @$pkg@ package name path variable - | PkgVerVar -- ^ The @$version@ package version path variable - | PkgIdVar -- ^ The @$pkgid@ package Id path variable, eg @foo-1.0@ - | LibNameVar -- ^ The @$libname@ path variable - | CompilerVar -- ^ The compiler name and version, eg @ghc-6.6.1@ - | OSVar -- ^ The operating system name, eg @windows@ or @linux@ - | ArchVar -- ^ The CPU architecture name, eg @i386@ or @x86_64@ - | AbiVar -- ^ The Compiler's ABI identifier, $arch-$os-$compiler-$abitag - | AbiTagVar -- ^ The optional ABI tag for the compiler - | ExecutableNameVar -- ^ The executable name; used in shell wrappers - | TestSuiteNameVar -- ^ The name of the test suite being run - | TestSuiteResultVar -- ^ The result of the test suite being run, eg - -- @pass@, @fail@, or @error@. - | BenchmarkNameVar -- ^ The name of the benchmark being run - deriving (Eq, Ord, Generic) - -instance Binary PathTemplateVariable - type PathTemplateEnv = [(PathTemplateVariable, PathTemplate)] -- | Convert a 'FilePath' to a 'PathTemplate' including any template vars. -- toPathTemplate :: FilePath -> PathTemplate -toPathTemplate = PathTemplate . read -- TODO: eradicateNoParse +toPathTemplate fp = PathTemplate + . fromMaybe (error $ "panic! toPathTemplate " ++ show fp) + . readMaybe -- TODO: eradicateNoParse + $ fp -- | Convert back to a path, any remaining vars are included -- @@ -430,29 +399,29 @@ packageTemplateEnv :: PackageIdentifier -> UnitId -> PathTemplateEnv packageTemplateEnv pkgId uid = - [(PkgNameVar, PathTemplate [Ordinary $ display (packageName pkgId)]) - ,(PkgVerVar, PathTemplate [Ordinary $ display (packageVersion pkgId)]) + [(PkgNameVar, PathTemplate [Ordinary $ prettyShow (packageName pkgId)]) + ,(PkgVerVar, PathTemplate [Ordinary $ prettyShow (packageVersion pkgId)]) -- Invariant: uid is actually a HashedUnitId. Hard to enforce because -- it's an API change. - ,(LibNameVar, PathTemplate [Ordinary $ display uid]) - ,(PkgIdVar, PathTemplate [Ordinary $ display pkgId]) + ,(LibNameVar, PathTemplate [Ordinary $ prettyShow uid]) + ,(PkgIdVar, PathTemplate [Ordinary $ prettyShow pkgId]) ] compilerTemplateEnv :: CompilerInfo -> PathTemplateEnv compilerTemplateEnv compiler = - [(CompilerVar, PathTemplate [Ordinary $ display (compilerInfoId compiler)]) + [(CompilerVar, PathTemplate [Ordinary $ prettyShow (compilerInfoId compiler)]) ] platformTemplateEnv :: Platform -> PathTemplateEnv platformTemplateEnv (Platform arch os) = - [(OSVar, PathTemplate [Ordinary $ display os]) - ,(ArchVar, PathTemplate [Ordinary $ display arch]) + [(OSVar, PathTemplate [Ordinary $ prettyShow os]) + ,(ArchVar, PathTemplate [Ordinary $ prettyShow arch]) ] abiTemplateEnv :: CompilerInfo -> Platform -> PathTemplateEnv abiTemplateEnv compiler (Platform arch os) = - [(AbiVar, PathTemplate [Ordinary $ display arch ++ '-':display os ++ - '-':display (compilerInfoId compiler) ++ + [(AbiVar, PathTemplate [Ordinary $ prettyShow arch ++ '-':prettyShow os ++ + '-':prettyShow (compilerInfoId compiler) ++ case compilerInfoAbiTag compiler of NoAbiTag -> "" AbiTag tag -> '-':tag]) @@ -481,86 +450,6 @@ -- and this gets parsed to the internal representation as a sequence of path -- spans which are either strings or variables, eg: -- PathTemplate [Variable PrefixVar, Ordinary "/bin" ] - -instance Show PathTemplateVariable where - show PrefixVar = "prefix" - show LibNameVar = "libname" - show BindirVar = "bindir" - show LibdirVar = "libdir" - show LibsubdirVar = "libsubdir" - show DynlibdirVar = "dynlibdir" - show DatadirVar = "datadir" - show DatasubdirVar = "datasubdir" - show DocdirVar = "docdir" - show HtmldirVar = "htmldir" - show PkgNameVar = "pkg" - show PkgVerVar = "version" - show PkgIdVar = "pkgid" - show CompilerVar = "compiler" - show OSVar = "os" - show ArchVar = "arch" - show AbiTagVar = "abitag" - show AbiVar = "abi" - show ExecutableNameVar = "executablename" - show TestSuiteNameVar = "test-suite" - show TestSuiteResultVar = "result" - show BenchmarkNameVar = "benchmark" - -instance Read PathTemplateVariable where - readsPrec _ s = - take 1 - [ (var, drop (length varStr) s) - | (varStr, var) <- vars - , varStr `isPrefixOf` s ] - -- NB: order matters! Longer strings first - where vars = [("prefix", PrefixVar) - ,("bindir", BindirVar) - ,("libdir", LibdirVar) - ,("libsubdir", LibsubdirVar) - ,("dynlibdir", DynlibdirVar) - ,("datadir", DatadirVar) - ,("datasubdir", DatasubdirVar) - ,("docdir", DocdirVar) - ,("htmldir", HtmldirVar) - ,("pkgid", PkgIdVar) - ,("libname", LibNameVar) - ,("pkgkey", LibNameVar) -- backwards compatibility - ,("pkg", PkgNameVar) - ,("version", PkgVerVar) - ,("compiler", CompilerVar) - ,("os", OSVar) - ,("arch", ArchVar) - ,("abitag", AbiTagVar) - ,("abi", AbiVar) - ,("executablename", ExecutableNameVar) - ,("test-suite", TestSuiteNameVar) - ,("result", TestSuiteResultVar) - ,("benchmark", BenchmarkNameVar)] - -instance Show PathComponent where - show (Ordinary path) = path - show (Variable var) = '$':show var - showList = foldr (\x -> (shows x .)) id - -instance Read PathComponent where - -- for some reason we collapse multiple $ symbols here - readsPrec _ = lex0 - where lex0 [] = [] - lex0 ('$':'$':s') = lex0 ('$':s') - lex0 ('$':s') = case [ (Variable var, s'') - | (var, s'') <- reads s' ] of - [] -> lex1 "$" s' - ok -> ok - lex0 s' = lex1 [] s' - lex1 "" "" = [] - lex1 acc "" = [(Ordinary (reverse acc), "")] - lex1 acc ('$':'$':s) = lex1 acc ('$':s) - lex1 acc ('$':s) = [(Ordinary (reverse acc), '$':s)] - lex1 acc (c:s) = lex1 (c:acc) s - readList [] = [([],"")] - readList s = [ (component:components, s'') - | (component, s') <- reads s - , (components, s'') <- readList s' ] instance Show PathTemplate where show (PathTemplate template) = show (show template) diff --git a/cabal/Cabal/Distribution/Simple/InstallDirs/Internal.hs b/cabal/Cabal/Distribution/Simple/InstallDirs/Internal.hs new file mode 100644 --- /dev/null +++ b/cabal/Cabal/Distribution/Simple/InstallDirs/Internal.hs @@ -0,0 +1,124 @@ +{-# LANGUAGE DeriveGeneric #-} +module Distribution.Simple.InstallDirs.Internal + ( PathComponent(..) + , PathTemplateVariable(..) + ) where + +import Prelude () +import Distribution.Compat.Prelude + +data PathComponent = + Ordinary FilePath + | Variable PathTemplateVariable + deriving (Eq, Ord, Generic) + +instance Binary PathComponent + +data PathTemplateVariable = + PrefixVar -- ^ The @$prefix@ path variable + | BindirVar -- ^ The @$bindir@ path variable + | LibdirVar -- ^ The @$libdir@ path variable + | LibsubdirVar -- ^ The @$libsubdir@ path variable + | DynlibdirVar -- ^ The @$dynlibdir@ path variable + | DatadirVar -- ^ The @$datadir@ path variable + | DatasubdirVar -- ^ The @$datasubdir@ path variable + | DocdirVar -- ^ The @$docdir@ path variable + | HtmldirVar -- ^ The @$htmldir@ path variable + | PkgNameVar -- ^ The @$pkg@ package name path variable + | PkgVerVar -- ^ The @$version@ package version path variable + | PkgIdVar -- ^ The @$pkgid@ package Id path variable, eg @foo-1.0@ + | LibNameVar -- ^ The @$libname@ path variable + | CompilerVar -- ^ The compiler name and version, eg @ghc-6.6.1@ + | OSVar -- ^ The operating system name, eg @windows@ or @linux@ + | ArchVar -- ^ The CPU architecture name, eg @i386@ or @x86_64@ + | AbiVar -- ^ The compiler's ABI identifier, + --- $arch-$os-$compiler-$abitag + | AbiTagVar -- ^ The optional ABI tag for the compiler + | ExecutableNameVar -- ^ The executable name; used in shell wrappers + | TestSuiteNameVar -- ^ The name of the test suite being run + | TestSuiteResultVar -- ^ The result of the test suite being run, eg + -- @pass@, @fail@, or @error@. + | BenchmarkNameVar -- ^ The name of the benchmark being run + deriving (Eq, Ord, Generic) + +instance Binary PathTemplateVariable + +instance Show PathTemplateVariable where + show PrefixVar = "prefix" + show LibNameVar = "libname" + show BindirVar = "bindir" + show LibdirVar = "libdir" + show LibsubdirVar = "libsubdir" + show DynlibdirVar = "dynlibdir" + show DatadirVar = "datadir" + show DatasubdirVar = "datasubdir" + show DocdirVar = "docdir" + show HtmldirVar = "htmldir" + show PkgNameVar = "pkg" + show PkgVerVar = "version" + show PkgIdVar = "pkgid" + show CompilerVar = "compiler" + show OSVar = "os" + show ArchVar = "arch" + show AbiTagVar = "abitag" + show AbiVar = "abi" + show ExecutableNameVar = "executablename" + show TestSuiteNameVar = "test-suite" + show TestSuiteResultVar = "result" + show BenchmarkNameVar = "benchmark" + +instance Read PathTemplateVariable where + readsPrec _ s = + take 1 + [ (var, drop (length varStr) s) + | (varStr, var) <- vars + , varStr `isPrefixOf` s ] + -- NB: order matters! Longer strings first + where vars = [("prefix", PrefixVar) + ,("bindir", BindirVar) + ,("libdir", LibdirVar) + ,("libsubdir", LibsubdirVar) + ,("dynlibdir", DynlibdirVar) + ,("datadir", DatadirVar) + ,("datasubdir", DatasubdirVar) + ,("docdir", DocdirVar) + ,("htmldir", HtmldirVar) + ,("pkgid", PkgIdVar) + ,("libname", LibNameVar) + ,("pkgkey", LibNameVar) -- backwards compatibility + ,("pkg", PkgNameVar) + ,("version", PkgVerVar) + ,("compiler", CompilerVar) + ,("os", OSVar) + ,("arch", ArchVar) + ,("abitag", AbiTagVar) + ,("abi", AbiVar) + ,("executablename", ExecutableNameVar) + ,("test-suite", TestSuiteNameVar) + ,("result", TestSuiteResultVar) + ,("benchmark", BenchmarkNameVar)] + +instance Show PathComponent where + show (Ordinary path) = path + show (Variable var) = '$':show var + showList = foldr (\x -> (shows x .)) id + +instance Read PathComponent where + -- for some reason we collapse multiple $ symbols here + readsPrec _ = lex0 + where lex0 [] = [] + lex0 ('$':'$':s') = lex0 ('$':s') + lex0 ('$':s') = case [ (Variable var, s'') + | (var, s'') <- reads s' ] of + [] -> lex1 "$" s' + ok -> ok + lex0 s' = lex1 [] s' + lex1 "" "" = [] + lex1 acc "" = [(Ordinary (reverse acc), "")] + lex1 acc ('$':'$':s) = lex1 acc ('$':s) + lex1 acc ('$':s) = [(Ordinary (reverse acc), '$':s)] + lex1 acc (c:s) = lex1 (c:acc) s + readList [] = [([],"")] + readList s = [ (component:components, s'') + | (component, s') <- reads s + , (components, s'') <- readList s' ] diff --git a/cabal/Cabal/Distribution/Simple/LocalBuildInfo.hs b/cabal/Cabal/Distribution/Simple/LocalBuildInfo.hs --- a/cabal/Cabal/Distribution/Simple/LocalBuildInfo.hs +++ b/cabal/Cabal/Distribution/Simple/LocalBuildInfo.hs @@ -21,7 +21,6 @@ module Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..), - externalPackageDeps, localComponentId, localUnitId, localCompatPackageKey, @@ -29,6 +28,7 @@ -- * Buildable package components Component(..), ComponentName(..), + LibraryName(..), defaultLibName, showComponentName, componentNameString, @@ -42,15 +42,11 @@ pkgBuildableComponents, lookupComponent, getComponent, - getComponentLocalBuildInfo, allComponentsInBuildOrder, - componentsInBuildOrder, depLibraryPaths, allLibModules, withAllComponentsInBuildOrder, - withComponentsInBuildOrder, - withComponentsLBI, withLibLBI, withExeLBI, withBenchLBI, @@ -61,6 +57,7 @@ -- * Installation directories module Distribution.Simple.InstallDirs, absoluteInstallDirs, prefixRelativeInstallDirs, + absoluteInstallCommandDirs, absoluteComponentInstallDirs, prefixRelativeComponentInstallDirs, substPathTemplate, ) where @@ -89,12 +86,11 @@ import Distribution.Simple.Compiler import Distribution.Simple.PackageIndex import Distribution.Simple.Utils -import Distribution.Text +import Distribution.Pretty import qualified Distribution.Compat.Graph as Graph import Data.List (stripPrefix) import System.FilePath -import qualified Data.Map as Map import System.Directory (doesDirectoryExist, canonicalizePath) @@ -108,32 +104,19 @@ componentBuildDir lbi clbi = buildDir lbi case componentLocalName clbi of - CLibName -> - if display (componentUnitId clbi) == display (componentComponentId clbi) + CLibName LMainLibName -> + if prettyShow (componentUnitId clbi) == prettyShow (componentComponentId clbi) then "" - else display (componentUnitId clbi) - CSubLibName s -> - if display (componentUnitId clbi) == display (componentComponentId clbi) + else prettyShow (componentUnitId clbi) + CLibName (LSubLibName s) -> + if prettyShow (componentUnitId clbi) == prettyShow (componentComponentId clbi) then unUnqualComponentName s - else display (componentUnitId clbi) + else prettyShow (componentUnitId clbi) CFLibName s -> unUnqualComponentName s CExeName s -> unUnqualComponentName s CTestName s -> unUnqualComponentName s CBenchName s -> unUnqualComponentName s -{-# DEPRECATED getComponentLocalBuildInfo "This function is not well-defined, because a 'ComponentName' does not uniquely identify a 'ComponentLocalBuildInfo'. If you have a 'TargetInfo', you should use 'targetCLBI' to get the 'ComponentLocalBuildInfo'. Otherwise, use 'componentNameTargets' to get all possible 'ComponentLocalBuildInfo's. This will be removed in Cabal 2.2." #-} -getComponentLocalBuildInfo :: LocalBuildInfo -> ComponentName -> ComponentLocalBuildInfo -getComponentLocalBuildInfo lbi cname = - case componentNameCLBIs lbi cname of - [clbi] -> clbi - [] -> - error $ "internal error: there is no configuration data " - ++ "for component " ++ show cname - clbis -> - error $ "internal error: the component name " ++ show cname - ++ "is ambiguous. Refers to: " - ++ intercalate ", " (map (display . componentUnitId) clbis) - -- | Perform the action on each enabled 'library' in the package -- description with the 'ComponentLocalBuildInfo'. withLibLBI :: PackageDescription -> LocalBuildInfo @@ -160,7 +143,7 @@ withBenchLBI :: PackageDescription -> LocalBuildInfo -> (Benchmark -> ComponentLocalBuildInfo -> IO ()) -> IO () withBenchLBI pkg lbi f = - sequence_ [ f test clbi | (test, clbi) <- enabledBenchLBIs pkg lbi ] + sequence_ [ f bench clbi | (bench, clbi) <- enabledBenchLBIs pkg lbi ] withTestLBI :: PackageDescription -> LocalBuildInfo -> (TestSuite -> ComponentLocalBuildInfo -> IO ()) -> IO () @@ -181,12 +164,6 @@ | target <- allTargetsInBuildOrder' pkg lbi , CBench bench <- [targetComponent target] ] -{-# DEPRECATED withComponentsLBI "Use withAllComponentsInBuildOrder" #-} -withComponentsLBI :: PackageDescription -> LocalBuildInfo - -> (Component -> ComponentLocalBuildInfo -> IO ()) - -> IO () -withComponentsLBI = withAllComponentsInBuildOrder - -- | Perform the action on each buildable 'Library' or 'Executable' (Component) -- in the PackageDescription, subject to the build order specified by the -- 'compBuildOrder' field of the given 'LocalBuildInfo' @@ -197,37 +174,11 @@ withAllTargetsInBuildOrder' pkg lbi $ \target -> f (targetComponent target) (targetCLBI target) -{-# DEPRECATED withComponentsInBuildOrder "You have got a 'TargetInfo' right? Use 'withNeededTargetsInBuildOrder' on the 'UnitId's you can 'nodeKey' out." #-} -withComponentsInBuildOrder :: PackageDescription -> LocalBuildInfo - -> [ComponentName] - -> (Component -> ComponentLocalBuildInfo -> IO ()) - -> IO () -withComponentsInBuildOrder pkg lbi cnames f = - withNeededTargetsInBuildOrder' pkg lbi uids $ \target -> - f (targetComponent target) (targetCLBI target) - where uids = concatMap (componentNameToUnitIds lbi) cnames - allComponentsInBuildOrder :: LocalBuildInfo -> [ComponentLocalBuildInfo] allComponentsInBuildOrder lbi = Graph.topSort (componentGraph lbi) --- | Private helper function for some of the deprecated implementations. -componentNameToUnitIds :: LocalBuildInfo -> ComponentName -> [UnitId] -componentNameToUnitIds lbi cname = - case Map.lookup cname (componentNameMap lbi) of - Just clbis -> map componentUnitId clbis - Nothing -> error $ "componentNameToUnitIds " ++ display cname - -{-# DEPRECATED componentsInBuildOrder "You've got 'TargetInfo' right? Use 'neededTargetsInBuildOrder' on the 'UnitId's you can 'nodeKey' out." #-} -componentsInBuildOrder :: LocalBuildInfo -> [ComponentName] - -> [ComponentLocalBuildInfo] -componentsInBuildOrder lbi cnames - -- NB: use of localPkgDescr here is safe because we throw out the - -- result immediately afterwards - = map targetCLBI (neededTargetsInBuildOrder' (localPkgDescr lbi) lbi uids) - where uids = concatMap (componentNameToUnitIds lbi) cnames - -- ----------------------------------------------------------------------------- -- A random function that has no business in this module @@ -351,6 +302,34 @@ copydest (hostPlatform lbi) (installDirTemplates lbi) + +absoluteInstallCommandDirs :: PackageDescription -> LocalBuildInfo + -> UnitId + -> CopyDest + -> InstallDirs FilePath +absoluteInstallCommandDirs pkg lbi uid copydest = + dirs { + -- Handle files which are not + -- per-component (data files and Haddock files.) + datadir = datadir dirs', + -- NB: The situation with Haddock is a bit delicate. On the + -- one hand, the easiest to understand Haddock documentation + -- path is pkgname-0.1, which means it's per-package (not + -- per-component). But this means that it's impossible to + -- install Haddock documentation for internal libraries. We'll + -- keep this constraint for now; this means you can't use + -- Cabal to Haddock internal libraries. This does not seem + -- like a big problem. + docdir = docdir dirs', + htmldir = htmldir dirs', + haddockdir = haddockdir dirs' + } + where + dirs = absoluteComponentInstallDirs pkg lbi uid copydest + -- Notice use of 'absoluteInstallDirs' (not the + -- per-component variant). This means for non-library + -- packages we'll just pick a nondescriptive foo-0.1 + dirs' = absoluteInstallDirs pkg lbi copydest -- | Backwards compatibility function which computes the InstallDirs -- assuming that @$libname@ points to the public library (or some fake diff --git a/cabal/Cabal/Distribution/Simple/PackageIndex.hs b/cabal/Cabal/Distribution/Simple/PackageIndex.hs --- a/cabal/Cabal/Distribution/Simple/PackageIndex.hs +++ b/cabal/Cabal/Distribution/Simple/PackageIndex.hs @@ -92,11 +92,7 @@ dependencyInconsistencies, dependencyCycles, dependencyGraph, - moduleNameIndex, - - -- * Backwards compatibility - deleteInstalledPackageId, - lookupInstalledPackageId, + moduleNameIndex ) where import Prelude () @@ -109,7 +105,7 @@ import qualified Distribution.InstalledPackageInfo as IPI import Distribution.Version import Distribution.Simple.Utils -import Distribution.Types.UnqualComponentName +import Distribution.Types.LibraryName import Control.Exception (assert) import Data.Array ((!)) @@ -120,6 +116,8 @@ import Control.Monad import Distribution.Compat.Stack +import qualified Prelude (foldr1) + -- | The collection of information about packages from one or more 'PackageDB's. -- These packages generally should have an instance of 'PackageInstalled' -- @@ -143,7 +141,7 @@ -- -- FIXME: Clarify what "preference order" means. Check that this invariant is -- preserved. See #1463 for discussion. - packageIdIndex :: !(Map (PackageName, Maybe UnqualComponentName) (Map Version [a])) + packageIdIndex :: !(Map (PackageName, LibraryName) (Map Version [a])) } deriving (Eq, Generic, Show, Read) @@ -158,7 +156,7 @@ mappend = (<>) --save one mappend with empty in the common case: mconcat [] = mempty - mconcat xs = foldr1 mappend xs + mconcat xs = Prelude.foldr1 mappend xs instance Semigroup (PackageIndex IPI.InstalledPackageInfo) where (<>) = merge @@ -195,7 +193,7 @@ -- mkPackageIndex :: WithCallStack (Map UnitId IPI.InstalledPackageInfo - -> Map (PackageName, Maybe UnqualComponentName) + -> Map (PackageName, LibraryName) (Map Version [IPI.InstalledPackageInfo]) -> InstalledPackageIndex) mkPackageIndex pids pnames = assert (invariant index) index @@ -302,19 +300,13 @@ (\xs -> if null xs then Nothing else Just xs) . List.deleteBy (\_ pkg -> installedUnitId pkg == ipkgid) undefined --- | Backwards compatibility wrapper for Cabal pre-1.24. -{-# DEPRECATED deleteInstalledPackageId "Use deleteUnitId instead. This symbol will be removed in Cabal-3.0 (est. Mar 2019)." #-} -deleteInstalledPackageId :: UnitId -> InstalledPackageIndex - -> InstalledPackageIndex -deleteInstalledPackageId = deleteUnitId - -- | Removes all packages with this source 'PackageId' from the index. -- deleteSourcePackageId :: PackageId -> InstalledPackageIndex -> InstalledPackageIndex deleteSourcePackageId pkgid original@(PackageIndex pids pnames) = -- NB: Doesn't delete internal packages - case Map.lookup (packageName pkgid, Nothing) pnames of + case Map.lookup (packageName pkgid, LMainLibName) pnames of Nothing -> original Just pvers -> case Map.lookup (packageVersion pkgid) pvers of Nothing -> original @@ -323,7 +315,7 @@ (deletePkgName pnames) where deletePkgName = - Map.update deletePkgVersion (packageName pkgid, Nothing) + Map.update deletePkgVersion (packageName pkgid, LMainLibName) deletePkgVersion = (\m -> if Map.null m then Nothing else Just m) @@ -337,12 +329,12 @@ deletePackageName :: PackageName -> InstalledPackageIndex -> InstalledPackageIndex deletePackageName name original@(PackageIndex pids pnames) = - case Map.lookup (name, Nothing) pnames of + case Map.lookup (name, LMainLibName) pnames of Nothing -> original Just pvers -> mkPackageIndex (foldl' (flip (Map.delete . installedUnitId)) pids (concat (Map.elems pvers))) - (Map.delete (name, Nothing) pnames) + (Map.delete (name, LMainLibName) pnames) {- -- | Removes all packages satisfying this dependency from the index. @@ -370,7 +362,7 @@ allPackagesByName :: PackageIndex a -> [(PackageName, [a])] allPackagesByName index = [ (pkgname, concat (Map.elems pvers)) - | ((pkgname, Nothing), pvers) <- Map.toList (packageIdIndex index) ] + | ((pkgname, LMainLibName), pvers) <- Map.toList (packageIdIndex index) ] -- | Get all the packages from the index. -- @@ -382,7 +374,7 @@ -> [(PackageId, [a])] allPackagesBySourcePackageId index = [ (packageId ipkg, ipkgs) - | ((_, Nothing), pvers) <- Map.toList (packageIdIndex index) + | ((_, LMainLibName), pvers) <- Map.toList (packageIdIndex index) , ipkgs@(ipkg:_) <- Map.elems pvers ] -- | Get all the packages from the index. @@ -391,7 +383,7 @@ -- -- This DOES include internal libraries. allPackagesBySourcePackageIdAndLibName :: HasUnitId a => PackageIndex a - -> [((PackageId, Maybe UnqualComponentName), [a])] + -> [((PackageId, LibraryName), [a])] allPackagesBySourcePackageIdAndLibName index = [ ((packageId ipkg, ln), ipkgs) | ((_, ln), pvers) <- Map.toList (packageIdIndex index) @@ -418,13 +410,6 @@ lookupComponentId index cid = Map.lookup (newSimpleUnitId cid) (unitIdIndex index) --- | Backwards compatibility for Cabal pre-1.24. -{-# DEPRECATED lookupInstalledPackageId "Use lookupUnitId instead. This symbol will be removed in Cabal-3.0 (est. Mar 2019)." #-} -lookupInstalledPackageId :: PackageIndex a -> UnitId - -> Maybe a -lookupInstalledPackageId = lookupUnitId - - -- | Does a lookup by source package id (name & version). -- -- There can be multiple installed packages with the same source 'PackageId' @@ -434,7 +419,7 @@ lookupSourcePackageId :: PackageIndex a -> PackageId -> [a] lookupSourcePackageId index pkgid = -- Do not lookup internal libraries - case Map.lookup (packageName pkgid, Nothing) (packageIdIndex index) of + case Map.lookup (packageName pkgid, LMainLibName) (packageIdIndex index) of Nothing -> [] Just pvers -> case Map.lookup (packageVersion pkgid) pvers of Nothing -> [] @@ -454,7 +439,7 @@ -> [(Version, [a])] lookupPackageName index name = -- Do not match internal libraries - case Map.lookup (name, Nothing) (packageIdIndex index) of + case Map.lookup (name, LMainLibName) (packageIdIndex index) of Nothing -> [] Just pvers -> Map.toList pvers @@ -469,11 +454,11 @@ -- -- INVARIANT: List of eligible 'IPI.InstalledPackageInfo' is non-empty. -- -lookupDependency :: InstalledPackageIndex -> Dependency +lookupDependency :: InstalledPackageIndex -> PackageName -> VersionRange -> [(Version, [IPI.InstalledPackageInfo])] -lookupDependency index dep = +lookupDependency index pn vr = -- Yes, a little bit of a misnomer here! - lookupInternalDependency index dep Nothing + lookupInternalDependency index pn vr LMainLibName -- | Does a lookup by source package name and a range of versions. -- @@ -482,10 +467,10 @@ -- -- INVARIANT: List of eligible 'IPI.InstalledPackageInfo' is non-empty. -- -lookupInternalDependency :: InstalledPackageIndex -> Dependency - -> Maybe UnqualComponentName +lookupInternalDependency :: InstalledPackageIndex -> PackageName -> VersionRange + -> LibraryName -> [(Version, [IPI.InstalledPackageInfo])] -lookupInternalDependency index (Dependency name versionRange) libn = +lookupInternalDependency index name versionRange libn = case Map.lookup (name, libn) (packageIdIndex index) of Nothing -> [] Just pvers -> [ (ver, pkgs') @@ -522,7 +507,7 @@ searchByName :: PackageIndex a -> String -> SearchResult [a] searchByName index name = -- Don't match internal packages - case [ pkgs | pkgs@((pname, Nothing),_) <- Map.toList (packageIdIndex index) + case [ pkgs | pkgs@((pname, LMainLibName),_) <- Map.toList (packageIdIndex index) , lowercase (unPackageName pname) == lname ] of [] -> None [(_,pvers)] -> Unambiguous (concat (Map.elems pvers)) @@ -541,7 +526,7 @@ searchByNameSubstring index searchterm = [ pkg -- Don't match internal packages - | ((pname, Nothing), pvers) <- Map.toList (packageIdIndex index) + | ((pname, LMainLibName), pvers) <- Map.toList (packageIdIndex index) , lsearchterm `isInfixOf` lowercase (unPackageName pname) , pkgs <- Map.elems pvers , pkg <- pkgs ] @@ -667,7 +652,7 @@ -- | We maintain the invariant that, for any 'DepUniqueKey', there -- is only one instance of the package in our database. -type DepUniqueKey = (PackageName, Maybe UnqualComponentName, Map ModuleName OpenModule) +type DepUniqueKey = (PackageName, LibraryName, Map ModuleName OpenModule) -- | Given a package index where we assume we want to use all the packages -- (use 'dependencyClosure' if you need to get such a index subset) find out diff --git a/cabal/Cabal/Distribution/Simple/PreProcess.hs b/cabal/Cabal/Distribution/Simple/PreProcess.hs --- a/cabal/Cabal/Distribution/Simple/PreProcess.hs +++ b/cabal/Cabal/Distribution/Simple/PreProcess.hs @@ -50,10 +50,11 @@ import Distribution.Simple.Program.ResponseFile import Distribution.Simple.Test.LibV09 import Distribution.System -import Distribution.Text +import Distribution.Pretty import Distribution.Version import Distribution.Verbosity import Distribution.Types.ForeignLib +import Distribution.Types.LibraryName import Distribution.Types.UnqualComponentName import System.Directory (doesFileExist) @@ -122,6 +123,12 @@ -- preprocessor's output name format. type PreProcessorExtras = FilePath -> IO [FilePath] +-- | A newtype around 'PreProcessorExtras', useful for storing +-- 'PreProcessorExtras' inside of another type constructor (e.g., a list) +-- without impredicativity (recall that the 'IO' type, which is contained in +-- 'PreProcessorExtras', is a synonym for @'HasCallStack' => Prelude.IO@, which +-- is a polymorphic type). +newtype WrappedPreProcessorExtras = WrapPPE { unWrapPPE :: PreProcessorExtras } mkSimplePreProcessor :: (FilePath -> FilePath -> Verbosity -> IO ()) -> (FilePath, FilePath) @@ -191,7 +198,7 @@ preProcessTest test (stubFilePath test) testDir TestSuiteUnsupported tt -> die' verbosity $ "No support for preprocessing test " - ++ "suite type " ++ display tt + ++ "suite type " ++ prettyShow tt CBench bm@Benchmark{ benchmarkName = nm } -> do let nm' = unUnqualComponentName nm case benchmarkInterface bm of @@ -199,7 +206,7 @@ preProcessBench bm f $ buildDir lbi nm' nm' ++ "-tmp" BenchmarkUnsupported tt -> die' verbosity $ "No support for preprocessing benchmark " - ++ "type " ++ display tt + ++ "type " ++ prettyShow tt where builtinHaskellSuffixes = ["hs", "lhs", "hsig", "lhsig"] builtinCSuffixes = cSourceExtensions @@ -396,6 +403,8 @@ (hsc2hsProg, hsc2hsVersion, _) <- requireProgramVersion verbosity hsc2hsProgram anyVersion (withPrograms lbi) -- See Trac #13896 and https://github.com/haskell/cabal/issues/3122. + let isCross = hostPlatform lbi /= buildPlatform + prependCrossFlags = if isCross then ("-x":) else id let hsc2hsSupportsResponseFiles = hsc2hsVersion >= mkVersion [0,68,4] pureArgs = genPureArgs gccProg inFile outFile if hsc2hsSupportsResponseFiles @@ -407,8 +416,8 @@ Nothing pureArgs (\responseFileName -> - runProgram verbosity hsc2hsProg ["@"++ responseFileName]) - else runProgram verbosity hsc2hsProg pureArgs + runProgram verbosity hsc2hsProg (prependCrossFlags ["@"++ responseFileName])) + else runProgram verbosity hsc2hsProg (prependCrossFlags pureArgs) } where -- Returns a list of command line arguments that can either be passed @@ -694,8 +703,8 @@ ] -- |Standard preprocessors with possible extra C sources: c2hs, hsc2hs. -knownExtrasHandlers :: [ PreProcessorExtras ] -knownExtrasHandlers = [ ppC2hsExtras, ppHsc2hsExtras ] +knownExtrasHandlers :: [ WrappedPreProcessorExtras ] +knownExtrasHandlers = [ WrapPPE ppC2hsExtras, WrapPPE ppHsc2hsExtras ] -- | Find any extra C sources generated by preprocessing that need to -- be added to the component (addresses issue #238). @@ -719,7 +728,7 @@ TestSuiteLibV09 _ _ -> pp $ buildDir lbi stubName test stubName test ++ "-tmp" TestSuiteUnsupported tt -> die' verbosity $ "No support for preprocessing test " - ++ "suite type " ++ display tt + ++ "suite type " ++ prettyShow tt CBench bm -> do let nm' = unUnqualComponentName $ benchmarkName bm case benchmarkInterface bm of @@ -727,12 +736,12 @@ pp $ buildDir lbi nm' nm' ++ "-tmp" BenchmarkUnsupported tt -> die' verbosity $ "No support for preprocessing benchmark " - ++ "type " ++ display tt + ++ "type " ++ prettyShow tt where pp :: FilePath -> IO [FilePath] pp dir = (map (dir ) . filter not_sub . concat) <$> for knownExtrasHandlers - (withLexicalCallStack (\f -> f dir)) + (withLexicalCallStack (\f -> f dir) . unWrapPPE) -- TODO: This is a terrible hack to work around #3545 while we don't -- reorganize the directory layout. Basically, for the main -- library, we might accidentally pick up autogenerated sources for @@ -746,7 +755,7 @@ component_dirs = component_names (localPkgDescr lbi) -- TODO: libify me component_names pkg_descr = fmap unUnqualComponentName $ - mapMaybe libName (subLibraries pkg_descr) ++ + mapMaybe (libraryNameString . libName) (subLibraries pkg_descr) ++ map exeName (executables pkg_descr) ++ map testName (testSuites pkg_descr) ++ map benchmarkName (benchmarks pkg_descr) diff --git a/cabal/Cabal/Distribution/Simple/PreProcess/Unlit.hs b/cabal/Cabal/Distribution/Simple/PreProcess/Unlit.hs --- a/cabal/Cabal/Distribution/Simple/PreProcess/Unlit.hs +++ b/cabal/Cabal/Distribution/Simple/PreProcess/Unlit.hs @@ -37,7 +37,8 @@ && length file >= 2 && head file == '"' && last file == '"' - -> Line (read line) (tail (init file)) -- TODO:eradicateNoParse + -- this shouldn't fail as we tested for 'all isDigit' + -> Line (fromMaybe (error $ "panic! read @Int " ++ show line) $ readMaybe line) (tail (init file)) -- TODO:eradicateNoParse _ -> CPP s where tokens = unfoldr $ \str -> case lex str of (t@(_:_), str'):_ -> Just (t, str') diff --git a/cabal/Cabal/Distribution/Simple/Program.hs b/cabal/Cabal/Distribution/Simple/Program.hs --- a/cabal/Cabal/Distribution/Simple/Program.hs +++ b/cabal/Cabal/Distribution/Simple/Program.hs @@ -118,19 +118,6 @@ , cppProgram , pkgConfigProgram , hpcProgram - - -- * deprecated - , ProgramConfiguration - , emptyProgramConfiguration - , defaultProgramConfiguration - , restoreProgramConfiguration - , rawSystemProgram - , rawSystemProgramStdout - , rawSystemProgramConf - , rawSystemProgramStdoutConf - , findProgramOnPath - , findProgramLocation - ) where import Prelude () @@ -192,48 +179,3 @@ where notFound = "The program '" ++ programName prog ++ "' is required but it could not be found" - - ---------------------- --- Deprecated aliases --- - -{-# DEPRECATED rawSystemProgram "use runProgram instead. This symbol will be removed in Cabal-3.0 (est. Mar 2019)." #-} -rawSystemProgram :: Verbosity -> ConfiguredProgram - -> [ProgArg] -> IO () -rawSystemProgram = runProgram - -{-# DEPRECATED rawSystemProgramStdout "use getProgramOutput instead. This symbol will be removed in Cabal-3.0 (est. Mar 2019)." #-} -rawSystemProgramStdout :: Verbosity -> ConfiguredProgram - -> [ProgArg] -> IO String -rawSystemProgramStdout = getProgramOutput - -{-# DEPRECATED rawSystemProgramConf "use runDbProgram instead. This symbol will be removed in Cabal-3.0 (est. Mar 2019)." #-} -rawSystemProgramConf :: Verbosity -> Program -> ProgramConfiguration - -> [ProgArg] -> IO () -rawSystemProgramConf = runDbProgram - -{-# DEPRECATED rawSystemProgramStdoutConf "use getDbProgramOutput instead. This symbol will be removed in Cabal-3.0 (est. Mar 2019)." #-} -rawSystemProgramStdoutConf :: Verbosity -> Program -> ProgramConfiguration - -> [ProgArg] -> IO String -rawSystemProgramStdoutConf = getDbProgramOutput - -{-# DEPRECATED ProgramConfiguration "use ProgramDb instead. This symbol will be removed in Cabal-3.0 (est. Mar 2019)." #-} -type ProgramConfiguration = ProgramDb - -{-# DEPRECATED emptyProgramConfiguration "use emptyProgramDb instead. This symbol will be removed in Cabal-3.0 (est. Mar 2019)." #-} -{-# DEPRECATED defaultProgramConfiguration "use defaultProgramDb instead. This symbol will be removed in Cabal-3.0 (est. Mar 2019)." #-} -emptyProgramConfiguration, defaultProgramConfiguration :: ProgramConfiguration -emptyProgramConfiguration = emptyProgramDb -defaultProgramConfiguration = defaultProgramDb - -{-# DEPRECATED restoreProgramConfiguration "use restoreProgramDb instead. This symbol will be removed in Cabal-3.0 (est. Mar 2019)." #-} -restoreProgramConfiguration :: [Program] -> ProgramConfiguration - -> ProgramConfiguration -restoreProgramConfiguration = restoreProgramDb - -{-# DEPRECATED findProgramOnPath "use findProgramOnSearchPath instead. This symbol will be removed in Cabal-3.0 (est. Mar 2019)." #-} -findProgramOnPath :: String -> Verbosity -> IO (Maybe FilePath) -findProgramOnPath name verbosity = - fmap (fmap fst) $ - findProgramOnSearchPath verbosity defaultProgramSearchPath name diff --git a/cabal/Cabal/Distribution/Simple/Program/Db.hs b/cabal/Cabal/Distribution/Simple/Program/Db.hs --- a/cabal/Cabal/Distribution/Simple/Program/Db.hs +++ b/cabal/Cabal/Distribution/Simple/Program/Db.hs @@ -68,7 +68,7 @@ import Distribution.Simple.Program.Builtin import Distribution.Simple.Utils import Distribution.Version -import Distribution.Text +import Distribution.Pretty import Distribution.Verbosity import Control.Monad (join) @@ -465,14 +465,14 @@ badVersion v l = "The program '" ++ programName prog ++ "'" ++ versionRequirement ++ " is required but the version found at " - ++ locationPath l ++ " is version " ++ display v + ++ locationPath l ++ " is version " ++ prettyShow v unknownVersion l = "The program '" ++ programName prog ++ "'" ++ versionRequirement ++ " is required but the version of " ++ locationPath l ++ " could not be determined." versionRequirement | isAnyVersion range = "" - | otherwise = " version " ++ display range + | otherwise = " version " ++ prettyShow range -- | Like 'lookupProgramVersion', but raises an exception in case of error -- instead of returning 'Left errMsg'. diff --git a/cabal/Cabal/Distribution/Simple/Program/Find.hs b/cabal/Cabal/Distribution/Simple/Program/Find.hs --- a/cabal/Cabal/Distribution/Simple/Program/Find.hs +++ b/cabal/Cabal/Distribution/Simple/Program/Find.hs @@ -102,7 +102,7 @@ -- On windows, getSystemSearchPath is not guaranteed 100% correct so we -- use findExecutable and then approximate the not-found-at locations. tryPathElem ProgramSearchPathDefault | buildOS == Windows = do - mExe <- findExecutable prog + mExe <- firstJustM [ findExecutable (prog <.> ext) | ext <- exeExtensions ] syspath <- getSystemSearchPath case mExe of Nothing -> @@ -129,6 +129,15 @@ if isExe then return (Just f, reverse fs') else go (f:fs') fs + + -- Helper for evaluating actions until the first one returns 'Just' + firstJustM :: Monad m => [m (Maybe a)] -> m (Maybe a) + firstJustM [] = return Nothing + firstJustM (ma:mas) = do + a <- ma + case a of + Just _ -> return a + Nothing -> firstJustM mas -- | Interpret a 'ProgramSearchPath' to construct a new @$PATH@ env var. -- Note that this is close but not perfect because on Windows the search diff --git a/cabal/Cabal/Distribution/Simple/Program/GHC.hs b/cabal/Cabal/Distribution/Simple/Program/GHC.hs --- a/cabal/Cabal/Distribution/Simple/Program/GHC.hs +++ b/cabal/Cabal/Distribution/Simple/Program/GHC.hs @@ -25,6 +25,7 @@ import Distribution.Compat.Prelude import Distribution.Backpack +import Distribution.Compat.Semigroup (First'(..), Last'(..), Option'(..)) import Distribution.Simple.GHC.ImplInfo import Distribution.PackageDescription hiding (Flag) import Distribution.ModuleName @@ -34,7 +35,7 @@ import Distribution.Simple.Program.Types import Distribution.Simple.Program.Run import Distribution.System -import Distribution.Text +import Distribution.Pretty import Distribution.Types.ComponentId import Distribution.Verbosity import Distribution.Version @@ -43,7 +44,7 @@ import Data.List (stripPrefix) import qualified Data.Map as Map -import Data.Monoid (All(..), Any(..), Endo(..), First(..), Last(..)) +import Data.Monoid (All(..), Any(..), Endo(..)) import Data.Set (Set) import qualified Data.Set as Set @@ -85,8 +86,8 @@ checkComponent = foldMap fun . filterGhcOptions . allGhcOptions allGhcOptions :: BuildInfo -> [(CompilerFlavor, [String])] - allGhcOptions = - mconcat [options, profOptions, sharedOptions, staticOptions] + allGhcOptions = foldMap (perCompilerFlavorToList .) + [options, profOptions, sharedOptions, staticOptions] filterGhcOptions :: [(CompilerFlavor, [String])] -> [[String]] filterGhcOptions l = [opts | (GHC, opts) <- l] @@ -127,15 +128,15 @@ flagArgumentFilter :: [String] -> [String] -> [String] flagArgumentFilter flags = go where - makeFilter :: String -> String -> First ([String] -> [String]) - makeFilter flag arg = First $ filterRest <$> stripPrefix flag arg + makeFilter :: String -> String -> Option' (First' ([String] -> [String])) + makeFilter flag arg = Option' $ First' . filterRest <$> stripPrefix flag arg where filterRest leftOver = case dropEq leftOver of [] -> drop 1 _ -> id checkFilter :: String -> Maybe ([String] -> [String]) - checkFilter = getFirst . mconcat (map makeFilter flags) + checkFilter = fmap getFirst' . getOption' . foldMap makeFilter flags go :: [String] -> [String] go [] = [] @@ -242,11 +243,6 @@ parseInt :: String -> Maybe Int parseInt = readMaybe . dropEq - readMaybe :: Read a => String -> Maybe a - readMaybe s = case reads s of - [(x, "")] -> Just x - _ -> Nothing - dropEq :: String -> String dropEq ('=':s) = s dropEq s = s @@ -263,15 +259,13 @@ ] safeToFilterHoles :: Bool - safeToFilterHoles = getAll . checkGhcFlags $ fromLast . foldMap notDeferred + safeToFilterHoles = getAll . checkGhcFlags $ + All . fromMaybe True . fmap getLast' . getOption' . foldMap notDeferred where - fromLast :: Last All -> All - fromLast = fromMaybe (All True) . getLast - - notDeferred :: String -> Last All - notDeferred "-fdefer-typed-holes" = Last . Just . All $ False - notDeferred "-fno-defer-typed-holes" = Last . Just . All $ True - notDeferred _ = Last Nothing + notDeferred :: String -> Option' (Last' Bool) + notDeferred "-fdefer-typed-holes" = Option' . Just . Last' $ False + notDeferred "-fno-defer-typed-holes" = Option' . Just . Last' $ True + notDeferred _ = Option' Nothing isTypedHoleFlag :: String -> Any isTypedHoleFlag = mconcat @@ -702,14 +696,14 @@ , this_arg ] | this_arg <- flag ghcOptThisUnitId ] - , concat [ ["-this-component-id", display this_cid ] + , concat [ ["-this-component-id", prettyShow this_cid ] | this_cid <- flag ghcOptThisComponentId ] , if null (ghcOptInstantiatedWith opts) then [] else "-instantiated-with" - : intercalate "," (map (\(n,m) -> display n ++ "=" - ++ display m) + : intercalate "," (map (\(n,m) -> prettyShow n ++ "=" + ++ prettyShow m) (ghcOptInstantiatedWith opts)) : [] @@ -723,14 +717,14 @@ , concat $ let space "" = "" space xs = ' ' : xs - in [ ["-package-id", display ipkgid ++ space (display rns)] + in [ ["-package-id", prettyShow ipkgid ++ space (prettyShow rns)] | (ipkgid,rns) <- flags ghcOptPackages ] ---------------------------- -- Language and extensions , if supportsHaskell2010 implInfo - then [ "-X" ++ display lang | lang <- flag ghcOptLanguage ] + then [ "-X" ++ prettyShow lang | lang <- flag ghcOptLanguage ] else [] , [ ext' @@ -740,7 +734,7 @@ Just Nothing -> [] Nothing -> error $ "Distribution.Simple.Program.GHC.renderGhcOptions: " - ++ display ext ++ " not present in ghcOptExtensionMap." + ++ prettyShow ext ++ " not present in ghcOptExtensionMap." ] ---------------- @@ -752,7 +746,7 @@ --------------- -- Inputs - , [ display modu | modu <- flags ghcOptInputModules ] + , [ prettyShow modu | modu <- flags ghcOptInputModules ] , flags ghcOptInputFiles , concat [ [ "-o", out] | out <- flag ghcOptOutputFile ] diff --git a/cabal/Cabal/Distribution/Simple/Program/HcPkg.hs b/cabal/Cabal/Distribution/Simple/Program/HcPkg.hs --- a/cabal/Cabal/Distribution/Simple/Program/HcPkg.hs +++ b/cabal/Cabal/Distribution/Simple/Program/HcPkg.hs @@ -45,12 +45,16 @@ import Prelude () import Distribution.Compat.Prelude hiding (init) +import Data.Either (partitionEithers) +import qualified Data.List.NonEmpty as NE + import Distribution.InstalledPackageInfo import Distribution.Simple.Compiler import Distribution.Simple.Program.Types import Distribution.Simple.Program.Run import Distribution.Simple.Utils -import Distribution.Text +import Distribution.Parsec +import Distribution.Pretty import Distribution.Types.ComponentId import Distribution.Types.PackageId import Distribution.Types.UnitId @@ -173,7 +177,7 @@ -> IO () writeRegistrationFileDirectly verbosity hpi (SpecificPackageDB dir) pkgInfo | supportsDirDbs hpi - = do let pkgfile = dir display (installedUnitId pkgInfo) <.> "conf" + = do let pkgfile = dir prettyShow (installedUnitId pkgInfo) <.> "conf" writeUTF8File pkgfile (showInstalledPackageInfo pkgInfo) | otherwise @@ -228,7 +232,7 @@ case parsePackages output of Left ok -> return ok _ -> die' verbosity $ "failed to parse output of '" - ++ programId (hcPkgProgram hpi) ++ " describe " ++ display pid ++ "'" + ++ programId (hcPkgProgram hpi) ++ " describe " ++ prettyShow pid ++ "'" -- | Call @hc-pkg@ to hide a package. -- @@ -256,15 +260,11 @@ _ -> die' verbosity $ "failed to parse output of '" ++ programId (hcPkgProgram hpi) ++ " dump'" -parsePackages :: String -> Either [InstalledPackageInfo] [PError] +parsePackages :: String -> Either [InstalledPackageInfo] [String] parsePackages str = - let parsed = map parseInstalledPackageInfo (splitPkgs str) - in case [ msg | ParseFailed msg <- parsed ] of - [] -> Left [ setUnitId - . maybe id mungePackagePaths (pkgRoot pkg) - $ pkg - | ParseOk _ pkg <- parsed ] - msgs -> Right msgs + case partitionEithers $ map parseInstalledPackageInfo (splitPkgs str) of + ([], ok) -> Left [ setUnitId . maybe id mungePackagePaths (pkgRoot pkg) $ pkg | (_, pkg) <- ok ] + (msgss, _) -> Right (foldMap NE.toList msgss) --TODO: this could be a lot faster. We're doing normaliseLineEndings twice -- and converting back and forth with lines/unlines. @@ -330,7 +330,7 @@ } | unUnitId uid == "" = pkginfo { installedUnitId = mkLegacyUnitId pid, - installedComponentId_ = mkComponentId (display pid) + installedComponentId_ = mkComponentId (prettyShow pid) } setUnitId pkginfo = pkginfo @@ -356,7 +356,7 @@ ++ programId (hcPkgProgram hpi) ++ " list'" where - parsePackageIds = traverse simpleParse . words + parsePackageIds = traverse simpleParsec . words -------------------------- -- The program invocations @@ -399,7 +399,7 @@ -> ProgramInvocation unregisterInvocation hpi verbosity packagedb pkgid = programInvocation (hcPkgProgram hpi) $ - ["unregister", packageDbOpts hpi packagedb, display pkgid] + ["unregister", packageDbOpts hpi packagedb, prettyShow pkgid] ++ verbosityOpts hpi verbosity @@ -415,14 +415,14 @@ -> ProgramInvocation exposeInvocation hpi verbosity packagedb pkgid = programInvocation (hcPkgProgram hpi) $ - ["expose", packageDbOpts hpi packagedb, display pkgid] + ["expose", packageDbOpts hpi packagedb, prettyShow pkgid] ++ verbosityOpts hpi verbosity describeInvocation :: HcPkgInfo -> Verbosity -> PackageDBStack -> PackageId -> ProgramInvocation describeInvocation hpi verbosity packagedbs pkgid = programInvocation (hcPkgProgram hpi) $ - ["describe", display pkgid] + ["describe", prettyShow pkgid] ++ (if noPkgDbStack hpi then [packageDbOpts hpi (last packagedbs)] else packageDbStackOpts hpi packagedbs) @@ -432,7 +432,7 @@ -> ProgramInvocation hideInvocation hpi verbosity packagedb pkgid = programInvocation (hcPkgProgram hpi) $ - ["hide", packageDbOpts hpi packagedb, display pkgid] + ["hide", packageDbOpts hpi packagedb, prettyShow pkgid] ++ verbosityOpts hpi verbosity diff --git a/cabal/Cabal/Distribution/Simple/Program/Hpc.hs b/cabal/Cabal/Distribution/Simple/Program/Hpc.hs --- a/cabal/Cabal/Distribution/Simple/Program/Hpc.hs +++ b/cabal/Cabal/Distribution/Simple/Program/Hpc.hs @@ -25,7 +25,7 @@ import Distribution.ModuleName import Distribution.Simple.Program.Run import Distribution.Simple.Program.Types -import Distribution.Text +import Distribution.Pretty import Distribution.Simple.Utils import Distribution.Verbosity import Distribution.Version @@ -49,7 +49,7 @@ hpcDirs' <- if withinRange hpcVer (orLaterVersion version07) then return hpcDirs else do - warn verbosity $ "Your version of HPC (" ++ display hpcVer + warn verbosity $ "Your version of HPC (" ++ prettyShow hpcVer ++ ") does not properly handle multiple search paths. " ++ "Coverage report generation may fail unexpectedly. These " ++ "issues are addressed in version 0.7 or later (GHC 7.8 or " @@ -82,7 +82,7 @@ , "--destdir=" ++ destDir ] ++ map ("--hpcdir=" ++) hpcDirs - ++ ["--exclude=" ++ display moduleName + ++ ["--exclude=" ++ prettyShow moduleName | moduleName <- excluded ] in programInvocation hpc args @@ -106,6 +106,6 @@ [ ["sum", "--union"] , tixFiles , ["--output=" ++ outFile] - , ["--exclude=" ++ display moduleName + , ["--exclude=" ++ prettyShow moduleName | moduleName <- excluded ] ] diff --git a/cabal/Cabal/Distribution/Simple/Program/Ld.hs b/cabal/Cabal/Distribution/Simple/Program/Ld.hs --- a/cabal/Cabal/Distribution/Simple/Program/Ld.hs +++ b/cabal/Cabal/Distribution/Simple/Program/Ld.hs @@ -90,4 +90,3 @@ run (inv:invs) = do runProgramInvocation verbosity inv renameFile target tmpfile run invs - diff --git a/cabal/Cabal/Distribution/Simple/Register.hs b/cabal/Cabal/Distribution/Simple/Register.hs --- a/cabal/Cabal/Distribution/Simple/Register.hs +++ b/cabal/Cabal/Distribution/Simple/Register.hs @@ -79,8 +79,7 @@ import Distribution.Simple.Utils import Distribution.Utils.MapAccum import Distribution.System -import Distribution.Text -import Distribution.Types.ComponentName +import Distribution.Pretty import Distribution.Verbosity as Verbosity import Distribution.Version import Distribution.Compat.Graph (IsNode(nodeKey)) @@ -157,8 +156,8 @@ for_ ipis $ \installedPkgInfo -> -- Only print the public library's IPI when (packageId installedPkgInfo == packageId pkg - && IPI.sourceLibName installedPkgInfo == Nothing) $ - putStrLn (display (IPI.installedUnitId installedPkgInfo)) + && IPI.sourceLibName installedPkgInfo == LMainLibName) $ + putStrLn (prettyShow (IPI.installedUnitId installedPkgInfo)) -- Three different modes: case () of @@ -167,14 +166,14 @@ | otherwise -> do for_ ipis $ \ipi -> do setupMessage' verbosity "Registering" (packageId pkg) - (libraryComponentName (IPI.sourceLibName ipi)) + (CLibName (IPI.sourceLibName ipi)) (Just (IPI.instantiatedWith ipi)) registerPackage verbosity (compiler lbi) (withPrograms lbi) packageDbs ipi HcPkg.defaultRegisterOptions where modeGenerateRegFile = isJust (flagToMaybe (regGenPkgConf regFlags)) - regFile = fromMaybe (display (packageId pkg) <.> "conf") + regFile = fromMaybe (prettyShow (packageId pkg) <.> "conf") (fromFlag (regGenPkgConf regFlags)) modeGenerateRegScript = fromFlag (regGenScript regFlags) @@ -201,7 +200,7 @@ where ys = take m xs number i = lpad (length (show num_ipis)) (show i) for_ (zip ([1..] :: [Int]) ipis) $ \(i, installedPkgInfo) -> - writeUTF8File (regFile (number i ++ "-" ++ display (IPI.installedUnitId installedPkgInfo))) + writeUTF8File (regFile (number i ++ "-" ++ prettyShow (IPI.installedUnitId installedPkgInfo))) (IPI.showInstalledPackageInfo installedPkgInfo) writeRegisterScript = @@ -447,7 +446,8 @@ IPI.frameworkDirs = extraFrameworkDirs bi, IPI.haddockInterfaces = [haddockdir installDirs haddockName pkg], IPI.haddockHTMLs = [htmldir installDirs], - IPI.pkgRoot = Nothing + IPI.pkgRoot = Nothing, + IPI.libVisibility = libVisibility lib } where ghc84 = case compilerId $ compiler lbi of @@ -500,7 +500,10 @@ generalInstalledPackageInfo adjustRelativeIncludeDirs pkg abi_hash lib lbi clbi installDirs where - adjustRelativeIncludeDirs = map (inplaceDir ) + adjustRelativeIncludeDirs = concatMap $ \d -> + [ inplaceDir d -- local include-dir + , inplaceDir libTargetDir d -- autogen include-dir + ] libTargetDir = componentBuildDir lbi clbi installDirs = (absoluteComponentInstallDirs pkg lbi (componentUnitId clbi) NoCopyDest) { @@ -512,7 +515,7 @@ haddockdir = inplaceHtmldir } inplaceDocdir = inplaceDir distPref "doc" - inplaceHtmldir = inplaceDocdir "html" display (packageName pkg) + inplaceHtmldir = inplaceDocdir "html" prettyShow (packageName pkg) -- | Construct 'InstalledPackageInfo' for the final install location of a diff --git a/cabal/Cabal/Distribution/Simple/Setup.hs b/cabal/Cabal/Distribution/Simple/Setup.hs --- a/cabal/Cabal/Distribution/Simple/Setup.hs +++ b/cabal/Cabal/Distribution/Simple/Setup.hs @@ -46,7 +46,7 @@ HaddockFlags(..), emptyHaddockFlags, defaultHaddockFlags, haddockCommand, HscolourFlags(..), emptyHscolourFlags, defaultHscolourFlags, hscolourCommand, BuildFlags(..), emptyBuildFlags, defaultBuildFlags, buildCommand, - buildVerbose, + ShowBuildInfoFlags(..), defaultShowBuildFlags, showBuildInfoCommand, ReplFlags(..), defaultReplFlags, replCommand, CleanFlags(..), emptyCleanFlags, defaultCleanFlags, cleanCommand, RegisterFlags(..), emptyRegisterFlags, defaultRegisterFlags, registerCommand, @@ -58,9 +58,8 @@ defaultBenchmarkFlags, benchmarkCommand, CopyDest(..), configureArgs, configureOptions, configureCCompiler, configureLinker, - buildOptions, haddockOptions, installDirsOptions, + buildOptions, haddockOptions, installDirsOptions, testOptions', programDbOptions, programDbPaths', - programConfigurationOptions, programConfigurationPaths', programFlagsDescription, replOptions, splitArgs, @@ -76,19 +75,16 @@ maybeToFlag, BooleanFlag(..), boolOpt, boolOpt', trueArg, falseArg, - optionVerbosity, optionNumJobs, readPToMaybe ) where + optionVerbosity, optionNumJobs) where import Prelude () import Distribution.Compat.Prelude hiding (get) import Distribution.Compiler import Distribution.ReadE -import Distribution.Text -import Distribution.Parsec.Class +import Distribution.Parsec import Distribution.Pretty -import qualified Distribution.Compat.ReadP as Parse import qualified Distribution.Compat.CharParsing as P -import Distribution.ParseUtils (readPToMaybe) import qualified Text.PrettyPrint as Disp import Distribution.ModuleName import Distribution.PackageDescription hiding (Flag) @@ -103,11 +99,13 @@ import Distribution.Utils.NubList import Distribution.Types.Dependency import Distribution.Types.ComponentId +import Distribution.Types.GivenComponent import Distribution.Types.Module import Distribution.Types.PackageName +import Distribution.Types.UnqualComponentName (unUnqualComponentName) import Distribution.Compat.Stack -import Distribution.Compat.Semigroup (Last' (..)) +import Distribution.Compat.Semigroup (Last' (..), Option' (..)) import Data.Function (on) @@ -204,8 +202,8 @@ -- because the type of configure is constrained by the UserHooks. -- when we change UserHooks next we should pass the initial -- ProgramDb directly and not via ConfigFlags - configPrograms_ :: Last' ProgramDb, -- ^All programs that - -- @cabal@ may run + configPrograms_ :: Option' (Last' ProgramDb), -- ^All programs that + -- @cabal@ may run configProgramPaths :: [(String, FilePath)], -- ^user specified programs paths configProgramArgs :: [(String, [String])], -- ^user specified programs args @@ -220,6 +218,8 @@ configStaticLib :: Flag Bool, -- ^Build static library configDynExe :: Flag Bool, -- ^Enable dynamic linking of the -- executables. + configFullyStaticExe :: Flag Bool, -- ^Enable fully static linking of the + -- executables. configProfExe :: Flag Bool, -- ^Enable profiling in the -- executables. configProf :: Flag Bool, -- ^Enable profiling in the library @@ -257,7 +257,7 @@ configStripLibs :: Flag Bool, -- ^Enable library stripping configConstraints :: [Dependency], -- ^Additional constraints for -- dependencies. - configDependencies :: [(PackageName, ComponentId)], + configDependencies :: [GivenComponent], -- ^The packages depended on. configInstantiateWith :: [(ModuleName, Module)], -- ^ The requested Backpack instantiation. If empty, either this @@ -275,9 +275,13 @@ -- ^Halt and show an error message indicating an error in flag assignment configRelocatable :: Flag Bool, -- ^ Enable relocatable package built configDebugInfo :: Flag DebugInfoLevel, -- ^ Emit debug info. - configUseResponseFiles :: Flag Bool + configUseResponseFiles :: Flag Bool, -- ^ Whether to use response files at all. They're used for such tools -- as haddock, or or ld. + configAllowDependingOnPrivateLibs :: Flag Bool + -- ^ Allow depending on private sublibraries. This is used by external + -- tools (like cabal-install) so they can add multiple-public-libraries + -- compatibility to older ghcs by checking visibility externally. } deriving (Generic, Read, Show) @@ -286,7 +290,8 @@ -- | More convenient version of 'configPrograms'. Results in an -- 'error' if internal invariant is violated. configPrograms :: WithCallStack (ConfigFlags -> ProgramDb) -configPrograms = maybe (error "FIXME: remove configPrograms") id . getLast' . configPrograms_ +configPrograms = fromMaybe (error "FIXME: remove configPrograms") . fmap getLast' + . getOption' . configPrograms_ instance Eq ConfigFlags where (==) a b = @@ -302,6 +307,7 @@ && equal configSharedLib && equal configStaticLib && equal configDynExe + && equal configFullyStaticExe && equal configProfExe && equal configProf && equal configProfDetail @@ -349,13 +355,14 @@ defaultConfigFlags :: ProgramDb -> ConfigFlags defaultConfigFlags progDb = emptyConfigFlags { configArgs = [], - configPrograms_ = pure progDb, + configPrograms_ = Option' (Just (Last' progDb)), configHcFlavor = maybe NoFlag Flag defaultCompilerFlavor, configVanillaLib = Flag True, configProfLib = NoFlag, configSharedLib = NoFlag, configStaticLib = NoFlag, configDynExe = Flag False, + configFullyStaticExe = Flag False, configProfExe = NoFlag, configProf = NoFlag, configProfDetail = NoFlag, @@ -375,8 +382,8 @@ #endif configSplitSections = Flag False, configSplitObjs = Flag False, -- takes longer, so turn off by default - configStripExes = Flag True, - configStripLibs = Flag True, + configStripExes = NoFlag, + configStripLibs = NoFlag, configTests = Flag False, configBenchmarks = Flag False, configCoverage = Flag False, @@ -422,7 +429,7 @@ -- | Pretty-print a single entry of a module substitution. dispModSubstEntry :: (ModuleName, Module) -> Disp.Doc -dispModSubstEntry (k, v) = disp k <<>> Disp.char '=' <<>> disp v +dispModSubstEntry (k, v) = pretty k <<>> Disp.char '=' <<>> pretty v configureOptions :: ShowOrParseArgs -> [OptionField ConfigFlags] configureOptions showOrParseArgs = @@ -494,6 +501,11 @@ configDynExe (\v flags -> flags { configDynExe = v }) (boolOpt [] []) + ,option "" ["executable-static"] + "Executable fully static linking" + configFullyStaticExe (\v flags -> flags { configFullyStaticExe = v }) + (boolOpt [] []) + ,option "" ["profiling"] "Executable and library profiling" configProf (\v flags -> flags { configProf = v }) @@ -617,7 +629,7 @@ ,option "" ["cid"] "Installed component ID to compile this component as" - (fmap display . configCID) (\v flags -> flags {configCID = fmap mkComponentId v}) + (fmap prettyShow . configCID) (\v flags -> flags {configCID = fmap mkComponentId v}) (reqArgFlag "CID") ,option "" ["extra-lib-dirs"] @@ -641,14 +653,18 @@ configConstraints (\v flags -> flags { configConstraints = v}) (reqArg "DEPENDENCY" (parsecToReadE (const "dependency expected") ((\x -> [x]) `fmap` parsec)) - (map display)) + (map prettyShow)) ,option "" ["dependency"] "A list of exact dependencies. E.g., --dependency=\"void=void-0.5.8-177d5cdf20962d0581fe2e4932a6c309\"" configDependencies (\v flags -> flags { configDependencies = v}) - (reqArg "NAME=CID" - (parsecToReadE (const "dependency expected") ((\x -> [x]) `fmap` parsecDependency)) - (map (\x -> display (fst x) ++ "=" ++ display (snd x)))) + (reqArg "NAME[:COMPONENT_NAME]=CID" + (parsecToReadE (const "dependency expected") ((\x -> [x]) `fmap` parsecGivenComponent)) + (map (\(GivenComponent pn cn cid) -> + prettyShow pn + ++ case cn of LMainLibName -> "" + LSubLibName n -> ":" ++ prettyShow n + ++ "=" ++ prettyShow cid))) ,option "" ["instantiate-with"] "A mapping of signature names to concrete module instantiations." @@ -693,6 +709,13 @@ configUseResponseFiles (\v flags -> flags { configUseResponseFiles = v }) (boolOpt' ([], ["disable-response-files"]) ([], [])) + + ,option "" ["allow-depending-on-private-libs"] + ( "Allow depending on private libraries. " + ++ "If set, the library visibility check MUST be done externally." ) + configAllowDependingOnPrivateLibs + (\v flags -> flags { configAllowDependingOnPrivateLibs = v }) + trueArg ] where liftInstallDirs = @@ -730,12 +753,18 @@ showProfDetailLevelFlag NoFlag = [] showProfDetailLevelFlag (Flag dl) = [showProfDetailLevel dl] -parsecDependency :: ParsecParser (PackageName, ComponentId) -parsecDependency = do - x <- parsec +parsecGivenComponent :: ParsecParser GivenComponent +parsecGivenComponent = do + pn <- parsec + ln <- P.option LMainLibName $ do + _ <- P.char ':' + ucn <- parsec + return $ if unUnqualComponentName ucn == unPackageName pn + then LMainLibName + else LSubLibName ucn _ <- P.char '=' - y <- parsec - return (x, y) + cid <- parsec + return $ GivenComponent pn ln cid installDirsOptions :: [OptionField (InstallDirs (Flag PathTemplate))] installDirsOptions = @@ -1358,12 +1387,13 @@ instance Binary HaddockTarget -instance Text HaddockTarget where - disp ForHackage = Disp.text "for-hackage" - disp ForDevelopment = Disp.text "for-development" +instance Pretty HaddockTarget where + pretty ForHackage = Disp.text "for-hackage" + pretty ForDevelopment = Disp.text "for-development" - parse = Parse.choice [ Parse.string "for-hackage" >> return ForHackage - , Parse.string "for-development" >> return ForDevelopment] +instance Parsec HaddockTarget where + parsec = P.choice [ P.try $ P.string "for-hackage" >> return ForHackage + , P.string "for-development" >> return ForDevelopment] data HaddockFlags = HaddockFlags { haddockProgramPaths :: [(String, FilePath)], @@ -1621,10 +1651,6 @@ } deriving (Read, Show, Generic) -{-# DEPRECATED buildVerbose "Use buildVerbosity instead" #-} -buildVerbose :: BuildFlags -> Verbosity -buildVerbose = fromFlagOrDefault normal . buildVerbosity - defaultBuildFlags :: BuildFlags defaultBuildFlags = BuildFlags { buildProgramPaths = mempty, @@ -1812,8 +1838,10 @@ -- ------------------------------------------------------------ data TestShowDetails = Never | Failures | Always | Streaming | Direct - deriving (Eq, Ord, Enum, Bounded, Show) + deriving (Eq, Ord, Enum, Bounded, Generic, Show) +instance Binary TestShowDetails + knownTestShowDetails :: [TestShowDetails] knownTestShowDetails = [minBound..maxBound] @@ -1826,16 +1854,7 @@ ident = P.munch1 (\c -> isAlpha c || c == '_' || c == '-') classify str = lookup (lowercase str) enumMap enumMap :: [(String, TestShowDetails)] - enumMap = [ (display x, x) - | x <- knownTestShowDetails ] - -instance Text TestShowDetails where - parse = maybe Parse.pfail return . classify =<< ident - where - ident = Parse.munch1 (\c -> isAlpha c || c == '_' || c == '-') - classify str = lookup (lowercase str) enumMap - enumMap :: [(String, TestShowDetails)] - enumMap = [ (display x, x) + enumMap = [ (prettyShow x, x) | x <- knownTestShowDetails ] --TODO: do we need this instance? @@ -1853,6 +1872,8 @@ testMachineLog :: Flag PathTemplate, testShowDetails :: Flag TestShowDetails, testKeepTix :: Flag Bool, + testWrapper :: Flag FilePath, + testFailWhenNoTestSuites :: Flag Bool, -- TODO: think about if/how options are passed to test exes testOptions :: [PathTemplate] } deriving (Generic) @@ -1865,6 +1886,8 @@ testMachineLog = toFlag $ toPathTemplate $ "$pkgid.log", testShowDetails = toFlag Failures, testKeepTix = toFlag False, + testWrapper = NoFlag, + testFailWhenNoTestSuites = toFlag False, testOptions = [] } @@ -1889,60 +1912,72 @@ , "TESTCOMPONENTS [FLAGS]" ] , commandDefaultFlags = defaultTestFlags - , commandOptions = \showOrParseArgs -> - [ optionVerbosity testVerbosity (\v flags -> flags { testVerbosity = v }) - , optionDistPref - testDistPref (\d flags -> flags { testDistPref = d }) - showOrParseArgs - , option [] ["log"] - ("Log all test suite results to file (name template can use " - ++ "$pkgid, $compiler, $os, $arch, $test-suite, $result)") - testHumanLog (\v flags -> flags { testHumanLog = v }) - (reqArg' "TEMPLATE" - (toFlag . toPathTemplate) - (flagToList . fmap fromPathTemplate)) - , option [] ["machine-log"] - ("Produce a machine-readable log file (name template can use " - ++ "$pkgid, $compiler, $os, $arch, $result)") - testMachineLog (\v flags -> flags { testMachineLog = v }) - (reqArg' "TEMPLATE" - (toFlag . toPathTemplate) - (flagToList . fmap fromPathTemplate)) - , option [] ["show-details"] - ("'always': always show results of individual test cases. " - ++ "'never': never show results of individual test cases. " - ++ "'failures': show results of failing test cases. " - ++ "'streaming': show results of test cases in real time." - ++ "'direct': send results of test cases in real time; no log file.") - testShowDetails (\v flags -> flags { testShowDetails = v }) - (reqArg "FILTER" - (parsecToReadE (\_ -> "--show-details flag expects one of " - ++ intercalate ", " - (map display knownTestShowDetails)) - (fmap toFlag parsec)) - (flagToList . fmap display)) - , option [] ["keep-tix-files"] - "keep .tix files for HPC between test runs" - testKeepTix (\v flags -> flags { testKeepTix = v}) - trueArg - , option [] ["test-options"] - ("give extra options to test executables " - ++ "(name templates can use $pkgid, $compiler, " - ++ "$os, $arch, $test-suite)") - testOptions (\v flags -> flags { testOptions = v }) - (reqArg' "TEMPLATES" (map toPathTemplate . splitArgs) - (const [])) - , option [] ["test-option"] - ("give extra option to test executables " - ++ "(no need to quote options containing spaces, " - ++ "name template can use $pkgid, $compiler, " - ++ "$os, $arch, $test-suite)") - testOptions (\v flags -> flags { testOptions = v }) - (reqArg' "TEMPLATE" (\x -> [toPathTemplate x]) - (map fromPathTemplate)) - ] + , commandOptions = testOptions' } +testOptions' :: ShowOrParseArgs -> [OptionField TestFlags] +testOptions' showOrParseArgs = + [ optionVerbosity testVerbosity (\v flags -> flags { testVerbosity = v }) + , optionDistPref + testDistPref (\d flags -> flags { testDistPref = d }) + showOrParseArgs + , option [] ["log"] + ("Log all test suite results to file (name template can use " + ++ "$pkgid, $compiler, $os, $arch, $test-suite, $result)") + testHumanLog (\v flags -> flags { testHumanLog = v }) + (reqArg' "TEMPLATE" + (toFlag . toPathTemplate) + (flagToList . fmap fromPathTemplate)) + , option [] ["machine-log"] + ("Produce a machine-readable log file (name template can use " + ++ "$pkgid, $compiler, $os, $arch, $result)") + testMachineLog (\v flags -> flags { testMachineLog = v }) + (reqArg' "TEMPLATE" + (toFlag . toPathTemplate) + (flagToList . fmap fromPathTemplate)) + , option [] ["show-details"] + ("'always': always show results of individual test cases. " + ++ "'never': never show results of individual test cases. " + ++ "'failures': show results of failing test cases. " + ++ "'streaming': show results of test cases in real time." + ++ "'direct': send results of test cases in real time; no log file.") + testShowDetails (\v flags -> flags { testShowDetails = v }) + (reqArg "FILTER" + (parsecToReadE (\_ -> "--show-details flag expects one of " + ++ intercalate ", " + (map prettyShow knownTestShowDetails)) + (fmap toFlag parsec)) + (flagToList . fmap prettyShow)) + , option [] ["keep-tix-files"] + "keep .tix files for HPC between test runs" + testKeepTix (\v flags -> flags { testKeepTix = v}) + trueArg + , option [] ["test-wrapper"] + "Run test through a wrapper." + testWrapper (\v flags -> flags { testWrapper = v }) + (reqArg' "FILE" (toFlag :: FilePath -> Flag FilePath) + (flagToList :: Flag FilePath -> [FilePath])) + , option [] ["fail-when-no-test-suites"] + ("Exit with failure when no test suites are found.") + testFailWhenNoTestSuites (\v flags -> flags { testFailWhenNoTestSuites = v}) + trueArg + , option [] ["test-options"] + ("give extra options to test executables " + ++ "(name templates can use $pkgid, $compiler, " + ++ "$os, $arch, $test-suite)") + testOptions (\v flags -> flags { testOptions = v }) + (reqArg' "TEMPLATES" (map toPathTemplate . splitArgs) + (const [])) + , option [] ["test-option"] + ("give extra option to test executables " + ++ "(no need to quote options containing spaces, " + ++ "name template can use $pkgid, $compiler, " + ++ "$os, $arch, $test-suite)") + testOptions (\v flags -> flags { testOptions = v }) + (reqArg' "TEMPLATE" (\x -> [toPathTemplate x]) + (map fromPathTemplate)) + ] + emptyTestFlags :: TestFlags emptyTestFlags = mempty @@ -2049,19 +2084,14 @@ programDbPaths progDb showOrParseArgs get set = programDbPaths' ("with-" ++) progDb showOrParseArgs get set -{-# DEPRECATED programConfigurationPaths' "Use programDbPaths' instead" #-} - -- | Like 'programDbPaths', but allows to customise the option name. -programDbPaths', programConfigurationPaths' +programDbPaths' :: (String -> String) -> ProgramDb -> ShowOrParseArgs -> (flags -> [(String, FilePath)]) -> ([(String, FilePath)] -> (flags -> flags)) -> [OptionField flags] - -programConfigurationPaths' = programDbPaths' - programDbPaths' mkName progDb showOrParseArgs get set = case showOrParseArgs of -- we don't want a verbose help text list so we just show a generic one: @@ -2100,19 +2130,15 @@ (\progArgs -> concat [ args | (prog', args) <- progArgs, prog==prog' ])) -{-# DEPRECATED programConfigurationOptions "Use programDbOptions instead" #-} -- | For each known program @PROG@ in 'progDb', produce a @PROG-options@ -- 'OptionField'. -programDbOptions, programConfigurationOptions +programDbOptions :: ProgramDb -> ShowOrParseArgs -> (flags -> [(String, [String])]) -> ([(String, [String])] -> (flags -> flags)) -> [OptionField flags] - -programConfigurationOptions = programDbOptions - programDbOptions progDb showOrParseArgs get set = case showOrParseArgs of -- we don't want a verbose help text list so we just show a generic one: @@ -2192,7 +2218,82 @@ | otherwise -> Right (Just n) _ -> Left "The jobs value should be a number or '$ncpus'" + -- ------------------------------------------------------------ +-- * show-build-info command flags +-- ------------------------------------------------------------ + +data ShowBuildInfoFlags = ShowBuildInfoFlags + { buildInfoBuildFlags :: BuildFlags + , buildInfoOutputFile :: Maybe FilePath + } deriving Show + +defaultShowBuildFlags :: ShowBuildInfoFlags +defaultShowBuildFlags = + ShowBuildInfoFlags + { buildInfoBuildFlags = defaultBuildFlags + , buildInfoOutputFile = Nothing + } + +showBuildInfoCommand :: ProgramDb -> CommandUI ShowBuildInfoFlags +showBuildInfoCommand progDb = CommandUI + { commandName = "show-build-info" + , commandSynopsis = "Emit details about how a package would be built." + , commandDescription = Just $ \_ -> wrapText $ + "Components encompass executables, tests, and benchmarks.\n" + ++ "\n" + ++ "Affected by configuration options, see `configure`.\n" + , commandNotes = Just $ \pname -> + "Examples:\n" + ++ " " ++ pname ++ " show-build-info " + ++ " All the components in the package\n" + ++ " " ++ pname ++ " show-build-info foo " + ++ " A component (i.e. lib, exe, test suite)\n\n" + ++ programFlagsDescription progDb +--TODO: re-enable once we have support for module/file targets +-- ++ " " ++ pname ++ " show-build-info Foo.Bar " +-- ++ " A module\n" +-- ++ " " ++ pname ++ " show-build-info Foo/Bar.hs" +-- ++ " A file\n\n" +-- ++ "If a target is ambiguous it can be qualified with the component " +-- ++ "name, e.g.\n" +-- ++ " " ++ pname ++ " show-build-info foo:Foo.Bar\n" +-- ++ " " ++ pname ++ " show-build-info testsuite1:Foo/Bar.hs\n" + , commandUsage = usageAlternatives "show-build-info" $ + [ "[FLAGS]" + , "COMPONENTS [FLAGS]" + ] + , commandDefaultFlags = defaultShowBuildFlags + , commandOptions = \showOrParseArgs -> + parseBuildFlagsForShowBuildInfoFlags showOrParseArgs progDb + ++ + [ option [] ["buildinfo-json-output"] + "Write the result to the given file instead of stdout" + buildInfoOutputFile (\pf flags -> flags { buildInfoOutputFile = pf }) + (reqArg' "FILE" Just (maybe [] pure)) + ] + + } + +parseBuildFlagsForShowBuildInfoFlags :: ShowOrParseArgs -> ProgramDb -> [OptionField ShowBuildInfoFlags] +parseBuildFlagsForShowBuildInfoFlags showOrParseArgs progDb = + map + (liftOption + buildInfoBuildFlags + (\bf flags -> flags { buildInfoBuildFlags = bf } ) + ) + buildFlags + where + buildFlags = buildOptions progDb showOrParseArgs + ++ + [ optionVerbosity + buildVerbosity (\v flags -> flags { buildVerbosity = v }) + + , optionDistPref + buildDistPref (\d flags -> flags { buildDistPref = d }) showOrParseArgs + ] + +-- ------------------------------------------------------------ -- * Other Utils -- ------------------------------------------------------------ @@ -2212,7 +2313,7 @@ where hc_flag = case (configHcFlavor flags, configHcPath flags) of (_, Flag hc_path) -> [hc_flag_name ++ hc_path] - (Flag hc, NoFlag) -> [hc_flag_name ++ display hc] + (Flag hc, NoFlag) -> [hc_flag_name ++ prettyShow hc] (NoFlag,NoFlag) -> [] hc_flag_name --TODO kill off thic bc hack when defaultUserHooks is removed. diff --git a/cabal/Cabal/Distribution/Simple/ShowBuildInfo.hs b/cabal/Cabal/Distribution/Simple/ShowBuildInfo.hs new file mode 100644 --- /dev/null +++ b/cabal/Cabal/Distribution/Simple/ShowBuildInfo.hs @@ -0,0 +1,158 @@ +-- | +-- This module defines a simple JSON-based format for exporting basic +-- information about a Cabal package and the compiler configuration Cabal +-- would use to build it. This can be produced with the +-- @cabal new-show-build-info@ command. +-- +-- +-- This format is intended for consumption by external tooling and should +-- therefore be rather stable. Moreover, this allows tooling users to avoid +-- linking against Cabal. This is an important advantage as direct API usage +-- tends to be rather fragile in the presence of user-initiated upgrades of +-- Cabal. +-- +-- Below is an example of the output this module produces, +-- +-- @ +-- { "cabal-version": "1.23.0.0", +-- "compiler": { +-- "flavour": "GHC", +-- "compiler-id": "ghc-7.10.2", +-- "path": "/usr/bin/ghc", +-- }, +-- "components": [ +-- { "type": "lib", +-- "name": "lib:Cabal", +-- "compiler-args": +-- ["-O", "-XHaskell98", "-Wall", +-- "-package-id", "parallel-3.2.0.6-b79c38c5c25fff77f3ea7271851879eb"] +-- "modules": ["Project.ModA", "Project.ModB", "Paths_project"], +-- "src-files": [], +-- "src-dirs": ["src"] +-- } +-- ] +-- } +-- @ +-- +-- The @cabal-version@ property provides the version of the Cabal library +-- which generated the output. The @compiler@ property gives some basic +-- information about the compiler Cabal would use to compile the package. +-- +-- The @components@ property gives a list of the Cabal 'Component's defined by +-- the package. Each has, +-- +-- * @type@: the type of the component (one of @lib@, @exe@, +-- @test@, @bench@, or @flib@) +-- * @name@: a string serving to uniquely identify the component within the +-- package. +-- * @compiler-args@: the command-line arguments Cabal would pass to the +-- compiler to compile the component +-- * @modules@: the modules belonging to the component +-- * @src-dirs@: a list of directories where the modules might be found +-- * @src-files@: any other Haskell sources needed by the component +-- +-- Note: At the moment this is only supported when using the GHC compiler. +-- + +module Distribution.Simple.ShowBuildInfo (mkBuildInfo) where + +import qualified Distribution.Simple.GHC as GHC +import qualified Distribution.Simple.Program.GHC as GHC + +import Distribution.PackageDescription +import Distribution.Compiler +import Distribution.Verbosity +import Distribution.Simple.Compiler +import Distribution.Simple.LocalBuildInfo +import Distribution.Simple.Program +import Distribution.Simple.Setup +import Distribution.Simple.Utils (cabalVersion) +import Distribution.Simple.Utils.Json +import Distribution.Types.TargetInfo +import Distribution.Text +import Distribution.Pretty + +-- | Construct a JSON document describing the build information for a +-- package. +mkBuildInfo + :: PackageDescription -- ^ Mostly information from the .cabal file + -> LocalBuildInfo -- ^ Configuration information + -> BuildFlags -- ^ Flags that the user passed to build + -> [TargetInfo] + -> Json +mkBuildInfo pkg_descr lbi _flags targetsToBuild = info + where + targetToNameAndLBI target = + (componentLocalName $ targetCLBI target, targetCLBI target) + componentsToBuild = map targetToNameAndLBI targetsToBuild + (.=) :: String -> Json -> (String, Json) + k .= v = (k, v) + + info = JsonObject + [ "cabal-version" .= JsonString (display cabalVersion) + , "compiler" .= mkCompilerInfo + , "components" .= JsonArray (map mkComponentInfo componentsToBuild) + ] + + mkCompilerInfo = JsonObject + [ "flavour" .= JsonString (prettyShow $ compilerFlavor $ compiler lbi) + , "compiler-id" .= JsonString (showCompilerId $ compiler lbi) + , "path" .= path + ] + where + path = maybe JsonNull (JsonString . programPath) + $ (flavorToProgram . compilerFlavor $ compiler lbi) + >>= flip lookupProgram (withPrograms lbi) + + flavorToProgram :: CompilerFlavor -> Maybe Program + flavorToProgram GHC = Just ghcProgram + flavorToProgram GHCJS = Just ghcjsProgram + flavorToProgram UHC = Just uhcProgram + flavorToProgram JHC = Just jhcProgram + flavorToProgram _ = Nothing + + mkComponentInfo (name, clbi) = JsonObject + [ "type" .= JsonString compType + , "name" .= JsonString (prettyShow name) + , "unit-id" .= JsonString (prettyShow $ componentUnitId clbi) + , "compiler-args" .= JsonArray (map JsonString $ getCompilerArgs bi lbi clbi) + , "modules" .= JsonArray (map (JsonString . display) modules) + , "src-files" .= JsonArray (map JsonString sourceFiles) + , "src-dirs" .= JsonArray (map JsonString $ hsSourceDirs bi) + ] + where + bi = componentBuildInfo comp + Just comp = lookupComponent pkg_descr name + compType = case comp of + CLib _ -> "lib" + CExe _ -> "exe" + CTest _ -> "test" + CBench _ -> "bench" + CFLib _ -> "flib" + modules = case comp of + CLib lib -> explicitLibModules lib + CExe exe -> exeModules exe + _ -> [] + sourceFiles = case comp of + CLib _ -> [] + CExe exe -> [modulePath exe] + _ -> [] + +-- | Get the command-line arguments that would be passed +-- to the compiler to build the given component. +getCompilerArgs + :: BuildInfo + -> LocalBuildInfo + -> ComponentLocalBuildInfo + -> [String] +getCompilerArgs bi lbi clbi = + case compilerFlavor $ compiler lbi of + GHC -> ghc + GHCJS -> ghc + c -> error $ "ShowBuildInfo.getCompilerArgs: Don't know how to get "++ + "build arguments for compiler "++show c + where + -- This is absolutely awful + ghc = GHC.renderGhcOptions (compiler lbi) (hostPlatform lbi) baseOpts + where + baseOpts = GHC.componentGhcOptions normal lbi bi clbi (buildDir lbi) diff --git a/cabal/Cabal/Distribution/Simple/SrcDist.hs b/cabal/Cabal/Distribution/Simple/SrcDist.hs --- a/cabal/Cabal/Distribution/Simple/SrcDist.hs +++ b/cabal/Cabal/Distribution/Simple/SrcDist.hs @@ -52,6 +52,7 @@ import Distribution.ModuleName import qualified Distribution.ModuleName as ModuleName import Distribution.Version +import Distribution.Simple.Configure (findDistPrefOrDefault) import Distribution.Simple.Glob import Distribution.Simple.Utils import Distribution.Simple.Setup @@ -59,7 +60,7 @@ import Distribution.Simple.LocalBuildInfo import Distribution.Simple.BuildPaths import Distribution.Simple.Program -import Distribution.Text +import Distribution.Pretty import Distribution.Types.ForeignLib import Distribution.Verbosity @@ -78,8 +79,12 @@ -> (FilePath -> FilePath) -- ^build prefix (temp dir) -> [PPSuffixHandler] -- ^ extra preprocessors (includes suffixes) -> IO () -sdist pkg mb_lbi flags mkTmpDir pps = +sdist pkg mb_lbi flags mkTmpDir pps = do + distPref <- findDistPrefOrDefault $ sDistDistPref flags + let targetPref = distPref + tmpTargetDir = mkTmpDir distPref + -- When given --list-sources, just output the list of sources to a file. case (sDistListSources flags) of Flag path -> withFile path WriteMode $ \outHandle -> do @@ -123,10 +128,6 @@ verbosity = fromFlag (sDistVerbosity flags) snapshot = fromFlag (sDistSnapshot flags) - distPref = fromFlag $ sDistDistPref flags - targetPref = distPref - tmpTargetDir = mkTmpDir distPref - -- | List all source files of a package. Returns a tuple of lists: first -- component is a list of ordinary files, second one is a list of those files -- that may be executable. @@ -171,14 +172,15 @@ , fmap concat . withAllExe $ \Executable { modulePath = mainPath, buildInfo = exeBi } -> do biSrcs <- allSourcesBuildInfo verbosity exeBi pps [] - mainSrc <- findMainExeFile exeBi pps mainPath + mainSrc <- findMainExeFile verbosity exeBi pps mainPath return (mainSrc:biSrcs) -- Foreign library sources , fmap concat . withAllFLib $ \flib@(ForeignLib { foreignLibBuildInfo = flibBi }) -> do biSrcs <- allSourcesBuildInfo verbosity flibBi pps [] - defFiles <- mapM (findModDefFile flibBi pps) (foreignLibModDefFile flib) + defFiles <- mapM (findModDefFile verbosity flibBi pps) + (foreignLibModDefFile flib) return (defFiles ++ biSrcs) -- Test suites sources. @@ -188,12 +190,12 @@ case testInterface t of TestSuiteExeV10 _ mainPath -> do biSrcs <- allSourcesBuildInfo verbosity bi pps [] - srcMainFile <- findMainExeFile bi pps mainPath + srcMainFile <- findMainExeFile verbosity bi pps mainPath return (srcMainFile:biSrcs) TestSuiteLibV09 _ m -> allSourcesBuildInfo verbosity bi pps [m] - TestSuiteUnsupported tp -> die' verbosity $ "Unsupported test suite type: " - ++ show tp + TestSuiteUnsupported tp -> + die' verbosity $ "Unsupported test suite type: " ++ show tp -- Benchmarks sources. , fmap concat @@ -202,7 +204,7 @@ case benchmarkInterface bm of BenchmarkExeV10 _ mainPath -> do biSrcs <- allSourcesBuildInfo verbosity bi pps [] - srcMainFile <- findMainExeFile bi pps mainPath + srcMainFile <- findMainExeFile verbosity bi pps mainPath return (srcMainFile:biSrcs) BenchmarkUnsupported tp -> die' verbosity $ "Unsupported benchmark type: " ++ show tp @@ -225,12 +227,13 @@ -- License file(s). , return (licenseFiles pkg_descr) - -- Install-include files. + -- Install-include files, without autogen-include files , fmap concat . withAllLib $ \ l -> do - let lbi = libBuildInfo l + let lbi = libBuildInfo l + incls = filter (`notElem` autogenIncludes lbi) (installIncludes lbi) relincdirs = "." : filter isRelative (includeDirs lbi) - traverse (fmap snd . findIncludeFile verbosity relincdirs) (installIncludes lbi) + traverse (fmap snd . findIncludeFile verbosity relincdirs) incls -- Setup script, if it exists. , fmap (maybe [] (\f -> [f])) $ findSetupFile "" @@ -300,20 +303,22 @@ "main = defaultMain"] -- | Find the main executable file. -findMainExeFile :: BuildInfo -> [PPSuffixHandler] -> FilePath -> IO FilePath -findMainExeFile exeBi pps mainPath = do +findMainExeFile + :: Verbosity -> BuildInfo -> [PPSuffixHandler] -> FilePath -> IO FilePath +findMainExeFile verbosity exeBi pps mainPath = do ppFile <- findFileWithExtension (ppSuffixes pps) (hsSourceDirs exeBi) (dropExtension mainPath) case ppFile of - Nothing -> findFile (hsSourceDirs exeBi) mainPath + Nothing -> findFileEx verbosity (hsSourceDirs exeBi) mainPath Just pp -> return pp -- | Find a module definition file -- -- TODO: I don't know if this is right -findModDefFile :: BuildInfo -> [PPSuffixHandler] -> FilePath -> IO FilePath -findModDefFile flibBi _pps modDefPath = - findFile (".":hsSourceDirs flibBi) modDefPath +findModDefFile + :: Verbosity -> BuildInfo -> [PPSuffixHandler] -> FilePath -> IO FilePath +findModDefFile verbosity flibBi _pps modDefPath = + findFileEx verbosity (".":hsSourceDirs flibBi) modDefPath -- | Given a list of include paths, try to find the include file named -- @f@. Return the name of the file and the full path, or exit with error if @@ -375,7 +380,7 @@ replaceVersion :: Version -> String -> String replaceVersion version line | "version:" `isPrefixOf` map toLower line - = "version: " ++ display version + = "version: " ++ prettyShow version | otherwise = line -- | Modifies a 'PackageDescription' by appending a snapshot number @@ -460,7 +465,7 @@ nonEmpty x _ [] = x nonEmpty _ f xs = f xs suffixes = ppSuffixes pps ++ ["hs", "lhs", "hsig", "lhsig"] - notFound m = die' verbosity $ "Error: Could not find module: " ++ display m + notFound m = die' verbosity $ "Error: Could not find module: " ++ prettyShow m ++ " with any suffix: " ++ show suffixes ++ ". If the module " ++ "is autogenerated it should be added to 'autogen-modules'." @@ -490,7 +495,7 @@ -- | The name of the tarball without extension -- tarBallName :: PackageDescription -> String -tarBallName = display . packageId +tarBallName = prettyShow . packageId mapAllBuildInfo :: (BuildInfo -> BuildInfo) -> (PackageDescription -> PackageDescription) diff --git a/cabal/Cabal/Distribution/Simple/Test.hs b/cabal/Cabal/Distribution/Simple/Test.hs --- a/cabal/Cabal/Distribution/Simple/Test.hs +++ b/cabal/Cabal/Distribution/Simple/Test.hs @@ -35,7 +35,7 @@ import Distribution.Simple.Test.Log import Distribution.Simple.Utils import Distribution.TestSuite -import Distribution.Text +import Distribution.Pretty import System.Directory ( createDirectoryIfMissing, doesFileExist, getDirectoryContents @@ -75,7 +75,7 @@ , testOptionsReturned = [] , testResult = Error $ "No support for running test suite type: " - ++ show (disp $ PD.testType suite) + ++ show (pretty $ PD.testType suite) } , logFile = "" } @@ -120,7 +120,7 @@ writeFile packageLogFile $ show packageLog when (LBI.testCoverage lbi) $ - markupPackage verbosity lbi distPref (display $ PD.package pkg_descr) $ + markupPackage verbosity lbi distPref (prettyShow $ PD.package pkg_descr) $ map (fst . fst) testsToRun unless allOk exitFailure diff --git a/cabal/Cabal/Distribution/Simple/Test/ExeV10.hs b/cabal/Cabal/Distribution/Simple/Test/ExeV10.hs --- a/cabal/Cabal/Distribution/Simple/Test/ExeV10.hs +++ b/cabal/Cabal/Distribution/Simple/Test/ExeV10.hs @@ -24,7 +24,7 @@ import Distribution.Simple.Utils import Distribution.System import Distribution.TestSuite -import Distribution.Text +import Distribution.Pretty import Distribution.Verbosity import Control.Concurrent (forkIO) @@ -98,10 +98,15 @@ return (addLibraryPath os paths shellEnv) else return shellEnv - exit <- rawSystemIOWithEnv verbosity cmd opts Nothing (Just shellEnv') + exit <- case testWrapper flags of + Flag path -> rawSystemIOWithEnv verbosity path (cmd:opts) Nothing (Just shellEnv') -- these handles are automatically closed Nothing (Just wOut) (Just wErr) + NoFlag -> rawSystemIOWithEnv verbosity cmd opts Nothing (Just shellEnv') + -- these handles are automatically closed + Nothing (Just wOut) (Just wErr) + -- Generate TestSuiteLog from executable exit code and a machine- -- readable test log. let suiteLog = buildLog exit @@ -129,7 +134,7 @@ notice verbosity $ summarizeSuiteFinish suiteLog when isCoverageEnabled $ - markupTest verbosity lbi distPref (display $ PD.package pkg_descr) suite + markupTest verbosity lbi distPref (prettyShow $ PD.package pkg_descr) suite return suiteLog where diff --git a/cabal/Cabal/Distribution/Simple/Test/LibV09.hs b/cabal/Cabal/Distribution/Simple/Test/LibV09.hs --- a/cabal/Cabal/Distribution/Simple/Test/LibV09.hs +++ b/cabal/Cabal/Distribution/Simple/Test/LibV09.hs @@ -30,7 +30,7 @@ import Distribution.Simple.Utils import Distribution.System import Distribution.TestSuite -import Distribution.Text +import Distribution.Pretty import Distribution.Verbosity import qualified Control.Exception as CE @@ -99,10 +99,15 @@ cpath <- canonicalizePath $ LBI.componentBuildDir lbi clbi return (addLibraryPath os (cpath : paths) shellEnv) else return shellEnv - createProcessWithEnv verbosity cmd opts Nothing (Just shellEnv') - -- these handles are closed automatically - CreatePipe (UseHandle wOut) (UseHandle wOut) + case testWrapper flags of + Flag path -> createProcessWithEnv verbosity path (cmd:opts) Nothing (Just shellEnv') + -- these handles are closed automatically + CreatePipe (UseHandle wOut) (UseHandle wOut) + NoFlag -> createProcessWithEnv verbosity cmd opts Nothing (Just shellEnv') + -- these handles are closed automatically + CreatePipe (UseHandle wOut) (UseHandle wOut) + hPutStr wIn $ show (tempLog, PD.testName suite) hClose wIn @@ -123,7 +128,8 @@ (unUnqualComponentName $ testSuiteName l) (testLogs l) -- Generate TestSuiteLog from executable exit code and a machine- -- readable test log - suiteLog <- fmap ((\l -> l { logFile = finalLogName l }) . read) -- TODO: eradicateNoParse + suiteLog <- fmap (\s -> (\l -> l { logFile = finalLogName l }) + . fromMaybe (error $ "panic! read @TestSuiteLog " ++ show s) $ readMaybe s) -- TODO: eradicateNoParse $ readFile tempLog -- Write summary notice to log file indicating start of test suite @@ -148,7 +154,7 @@ notice verbosity $ summarizeSuiteFinish suiteLog when isCoverageEnabled $ - markupTest verbosity lbi distPref (display $ PD.package pkg_descr) suite + markupTest verbosity lbi distPref (prettyShow $ PD.package pkg_descr) suite return suiteLog where @@ -209,7 +215,7 @@ simpleTestStub m = unlines [ "module Main ( main ) where" , "import Distribution.Simple.Test.LibV09 ( stubMain )" - , "import " ++ show (disp m) ++ " ( tests )" + , "import " ++ show (pretty m) ++ " ( tests )" , "main :: IO ()" , "main = stubMain tests" ] @@ -219,7 +225,7 @@ -- of detectable errors when Cabal is compiled. stubMain :: IO [Test] -> IO () stubMain tests = do - (f, n) <- fmap read getContents -- TODO: eradicateNoParse + (f, n) <- fmap (\s -> fromMaybe (error $ "panic! read " ++ show s) $ readMaybe s) getContents -- TODO: eradicateNoParse dir <- getCurrentDirectory results <- (tests >>= stubRunTests) `CE.catch` errHandler setCurrentDirectory dir diff --git a/cabal/Cabal/Distribution/Simple/Test/Log.hs b/cabal/Cabal/Distribution/Simple/Test/Log.hs --- a/cabal/Cabal/Distribution/Simple/Test/Log.hs +++ b/cabal/Cabal/Distribution/Simple/Test/Log.hs @@ -28,8 +28,10 @@ import Distribution.System import Distribution.TestSuite import Distribution.Verbosity -import Distribution.Text +import Distribution.Pretty +import qualified Prelude (foldl1) + -- | Logs all test results for a package, broken down first by test suite and -- then by test case. data PackageLog = PackageLog @@ -128,7 +130,7 @@ summarizePackage :: Verbosity -> PackageLog -> IO Bool summarizePackage verbosity packageLog = do let counts = map (countTestResults . testLogs) $ testSuites packageLog - (passed, failed, errors) = foldl1 addTriple counts + (passed, failed, errors) = Prelude.foldl1 addTriple counts totalCases = passed + failed + errors passedSuites = length $ filter (suitePassed . testLogs) @@ -155,7 +157,7 @@ -- output for certain verbosity or test filter levels. summarizeSuiteFinish :: TestSuiteLog -> String summarizeSuiteFinish testLog = unlines - [ "Test suite " ++ display (testSuiteName testLog) ++ ": " ++ resStr + [ "Test suite " ++ prettyShow (testSuiteName testLog) ++ ": " ++ resStr , "Test suite logged to: " ++ logFile testLog ] where resStr = map toUpper (resultString $ testLogs testLog) diff --git a/cabal/Cabal/Distribution/Simple/UHC.hs b/cabal/Cabal/Distribution/Simple/UHC.hs --- a/cabal/Cabal/Distribution/Simple/UHC.hs +++ b/cabal/Cabal/Distribution/Simple/UHC.hs @@ -24,8 +24,8 @@ import Prelude () import Distribution.Compat.Prelude +import Data.Foldable (toList) -import Distribution.Compat.ReadP import Distribution.InstalledPackageInfo import Distribution.Package hiding (installedUnitId) import Distribution.PackageDescription @@ -35,7 +35,8 @@ import Distribution.Simple.PackageIndex import Distribution.Simple.Program import Distribution.Simple.Utils -import Distribution.Text +import Distribution.Pretty +import Distribution.Parsec import Distribution.Types.MungedPackageId import Distribution.Verbosity import Distribution.Version @@ -102,7 +103,7 @@ let pkgDirs = nub (concatMap (packageDbPaths userPkgDir systemPkgDir) packagedbs) -- putStrLn $ "pkgdirs: " ++ show pkgDirs pkgs <- liftM (map addBuiltinVersions . concat) $ - traverse (\ d -> getDirectoryContents d >>= filterM (isPkgDir (display compilerid) d)) + traverse (\ d -> getDirectoryContents d >>= filterM (isPkgDir (prettyShow compilerid) d)) pkgDirs -- putStrLn $ "pkgs: " ++ show pkgs let iPkgs = @@ -157,7 +158,7 @@ doesFileExist (candidate installedPkgConfig) parsePackage :: String -> [PackageId] -parsePackage x = map fst (filter (\ (_,y) -> null y) (readP_to_S parse x)) +parsePackage = toList . simpleParsec -- | Create a trivial package info from a directory name. mkInstalledPackageInfo :: PackageId -> InstalledPackageInfo @@ -177,7 +178,7 @@ userPkgDir <- getUserPackageDir let runUhcProg = runDbProgram verbosity uhcProgram (withPrograms lbi) let uhcArgs = -- set package name - ["--pkg-build=" ++ display (packageId pkg_descr)] + ["--pkg-build=" ++ prettyShow (packageId pkg_descr)] -- common flags lib/exe ++ constructUHCCmdLine userPkgDir systemPkgDir lbi (libBuildInfo lib) clbi @@ -186,7 +187,7 @@ -- suboptimal: UHC does not understand module names, so -- we replace periods by path separators ++ map (map (\ c -> if c == '.' then pathSeparator else c)) - (map display (allLibModules lib clbi)) + (map prettyShow (allLibModules lib clbi)) runUhcProg uhcArgs @@ -203,7 +204,7 @@ lbi (buildInfo exe) clbi (buildDir lbi) verbosity -- output file - ++ ["--output", buildDir lbi display (exeName exe)] + ++ ["--output", buildDir lbi prettyShow (exeName exe)] -- main source module ++ [modulePath exe] runUhcProg uhcArgs @@ -224,7 +225,7 @@ ++ ["--hide-all-packages"] ++ uhcPackageDbOptions user system (withPackageDB lbi) ++ ["--package=uhcbase"] - ++ ["--package=" ++ display (mungedName pkgid) | (_, pkgid) <- componentPackageDeps clbi ] + ++ ["--package=" ++ prettyShow (mungedName pkgid) | (_, pkgid) <- componentPackageDeps clbi ] -- search paths ++ ["-i" ++ odir] ++ ["-i" ++ l | l <- nub (hsSourceDirs bi)] @@ -253,7 +254,7 @@ installLib verbosity _lbi targetDir _dynlibTargetDir builtDir pkg _library _clbi = do -- putStrLn $ "dest: " ++ targetDir -- putStrLn $ "built: " ++ builtDir - installDirectoryContents verbosity (builtDir display (packageId pkg)) targetDir + installDirectoryContents verbosity (builtDir prettyShow (packageId pkg)) targetDir -- currently hard-coded UHC code generator and variant to use uhcTarget, uhcTargetVariant :: String @@ -281,7 +282,7 @@ GlobalPackageDB -> getGlobalPackageDir verbosity progdb UserPackageDB -> getUserPackageDir SpecificPackageDB dir -> return dir - let pkgdir = dbdir uhcPackageDir (display pkgid) (display compilerid) + let pkgdir = dbdir uhcPackageDir (prettyShow pkgid) (prettyShow compilerid) createDirectoryIfMissingVerbose verbosity True pkgdir writeUTF8File (pkgdir installedPkgConfig) (showInstalledPackageInfo installedPkgInfo) diff --git a/cabal/Cabal/Distribution/Simple/UserHooks.hs b/cabal/Cabal/Distribution/Simple/UserHooks.hs --- a/cabal/Cabal/Distribution/Simple/UserHooks.hs +++ b/cabal/Cabal/Distribution/Simple/UserHooks.hs @@ -51,8 +51,6 @@ -- break in future releases. data UserHooks = UserHooks { - -- | Used for @.\/setup test@ - runTests :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO (), -- | Read the description file readDesc :: IO (Maybe GenericPackageDescription), -- | Custom preprocessors in addition to and overriding 'knownSuffixHandlers'. @@ -107,13 +105,6 @@ -- on the target, not on the build machine. postInst :: Args -> InstallFlags -> PackageDescription -> LocalBuildInfo -> IO (), - -- |Hook to run before sdist command. Second arg indicates verbosity level. - preSDist :: Args -> SDistFlags -> IO HookedBuildInfo, - -- |Over-ride this hook to get different behavior during sdist. - sDistHook :: PackageDescription -> Maybe LocalBuildInfo -> UserHooks -> SDistFlags -> IO (), - -- |Hook to run after sdist command. Second arg indicates verbosity level. - postSDist :: Args -> SDistFlags -> PackageDescription -> Maybe LocalBuildInfo -> IO (), - -- |Hook to run before register command preReg :: Args -> RegisterFlags -> IO HookedBuildInfo, -- |Over-ride this hook to get different behavior during registration. @@ -164,16 +155,10 @@ postBench :: Args -> BenchmarkFlags -> PackageDescription -> LocalBuildInfo -> IO () } -{-# DEPRECATED runTests "Please use the new testing interface instead!" #-} -{-# DEPRECATED preSDist "SDist hooks violate the invariants of new-sdist. Use 'autogen-modules' and 'build-tool-depends' instead." #-} -{-# DEPRECATED sDistHook "SDist hooks violate the invariants of new-sdist. Use 'autogen-modules' and 'build-tool-depends' instead." #-} -{-# DEPRECATED postSDist "SDist hooks violate the invariants of new-sdist. Use 'autogen-modules' and 'build-tool-depends' instead." #-} - -- |Empty 'UserHooks' which do nothing. emptyUserHooks :: UserHooks emptyUserHooks = UserHooks { - runTests = ru, readDesc = return Nothing, hookedPreProcessors = [], hookedPrograms = [], @@ -195,9 +180,6 @@ preInst = rn, instHook = ru, postInst = ru, - preSDist = rn, - sDistHook = ru, - postSDist = ru, preReg = rn', regHook = ru, postReg = ru, diff --git a/cabal/Cabal/Distribution/Simple/Utils.hs b/cabal/Cabal/Distribution/Simple/Utils.hs --- a/cabal/Cabal/Distribution/Simple/Utils.hs +++ b/cabal/Cabal/Distribution/Simple/Utils.hs @@ -26,9 +26,6 @@ cabalVersion, -- * logging and errors - -- Old style - die, dieWithLocation, - -- New style dieNoVerbosity, die', dieWithLocation', dieNoWrap, @@ -56,7 +53,6 @@ createProcessWithEnv, maybeExit, xargs, - findProgramLocation, findProgramVersion, -- ** 'IOData' re-export @@ -68,10 +64,8 @@ IODataMode(..), -- * copying files - smartCopySources, createDirectoryIfMissingVerbose, copyFileVerbose, - copyDirectoryRecursiveVerbose, copyFiles, copyFileTo, @@ -97,13 +91,13 @@ exeExtensions, -- * finding files - findFile, + findFileEx, findFirstFile, findFileWithExtension, findFileWithExtension', findAllFilesWithExtension, - findModuleFile, - findModuleFiles, + findModuleFileEx, + findModuleFilesEx, getDirectoryContentsRecursive, -- * environment variables @@ -124,13 +118,11 @@ defaultPackageDesc, findPackageDesc, tryFindPackageDesc, - defaultHookedPackageDesc, findHookedPackageDesc, -- * reading and writing files safely withFileContents, writeFileAtomic, - rewriteFile, rewriteFileEx, -- * Unicode @@ -167,12 +159,16 @@ -- * FilePath stuff isAbsoluteOnAnyPlatform, isRelativeOnAnyPlatform, + + -- * Deprecated functions + findFile, + findModuleFile, + findModuleFiles, ) where import Prelude () import Distribution.Compat.Prelude -import Distribution.Text import Distribution.Utils.Generic import Distribution.Utils.IOData (IOData(..), IODataMode(..)) import qualified Distribution.Utils.IOData as IOData @@ -200,15 +196,18 @@ import qualified Paths_Cabal (version) #endif +import Distribution.Pretty +import Distribution.Parsec + import Control.Concurrent.MVar ( newEmptyMVar, putMVar, takeMVar ) import Data.Typeable ( cast ) -import qualified Data.ByteString.Lazy.Char8 as BS.Char8 +import qualified Data.ByteString.Lazy as BS import System.Directory ( Permissions(executable), getDirectoryContents, getPermissions - , doesDirectoryExist, doesFileExist, removeFile, findExecutable + , doesDirectoryExist, doesFileExist, removeFile , getModificationTime, createDirectory, removeDirectoryRecursive ) import System.Environment ( getProgName ) @@ -301,21 +300,6 @@ -- 'ioeSetVerbatim' and 'ioeGetVerbatim'. -- -{-# DEPRECATED dieWithLocation "Messages thrown with dieWithLocation can't be controlled with Verbosity; use dieWithLocation' instead" #-} -dieWithLocation :: FilePath -> Maybe Int -> String -> IO a -dieWithLocation filename lineno msg = - ioError . setLocation lineno - . flip ioeSetFileName (normalise filename) - $ userError msg - where - setLocation Nothing err = err - setLocation (Just n) err = ioeSetLocation err (show n) - _ = callStack -- TODO: Attach CallStack to exception - -{-# DEPRECATED die "Messages thrown with die can't be controlled with Verbosity; use die' instead, or dieNoVerbosity if Verbosity truly is not available" #-} -die :: String -> IO a -die = dieNoVerbosity - dieNoVerbosity :: String -> IO a dieNoVerbosity msg = ioError (userError msg) @@ -491,7 +475,7 @@ -- setupMessage :: Verbosity -> String -> PackageIdentifier -> IO () setupMessage verbosity msg pkgid = withFrozenCallStack $ do - noticeNoWrap verbosity (msg ++ ' ': display pkgid ++ "...") + noticeNoWrap verbosity (msg ++ ' ': prettyShow pkgid ++ "...") -- | More detail on the operation of some action. -- @@ -814,7 +798,7 @@ Nothing Nothing Nothing IODataModeText when (exitCode /= ExitSuccess) $ - die errors + die' verbosity errors return output -- | Run a command and return its output, errors and exit status. Optionally @@ -892,20 +876,6 @@ either (\e -> throwIO (ioeSetFileName e ("output of " ++ path))) return - -{-# DEPRECATED findProgramLocation - "No longer used within Cabal, try findProgramOnSearchPath" #-} --- | Look for a program on the path. -findProgramLocation :: Verbosity -> FilePath -> IO (Maybe FilePath) -findProgramLocation verbosity prog = withFrozenCallStack $ do - debug verbosity $ "searching for " ++ prog ++ " in path." - res <- findExecutable prog - case res of - Nothing -> debug verbosity ("Cannot find " ++ prog ++ " on the path") - Just path -> debug verbosity ("found " ++ prog ++ " at "++ path) - return res - - -- | Look for a program and try to find it's version number. It can accept -- either an absolute path or the name of a program binary, in which case we -- will look for the program on the path. @@ -921,11 +891,11 @@ `catchIO` (\_ -> return "") `catchExit` (\_ -> return "") let version :: Maybe Version - version = simpleParse (selectVersion str) + version = simpleParsec (selectVersion str) case version of Nothing -> warn verbosity $ "cannot determine version of " ++ path ++ " :\n" ++ show str - Just v -> debug verbosity $ path ++ " is version " ++ display v + Just v -> debug verbosity $ path ++ " is version " ++ prettyShow v return version @@ -961,16 +931,24 @@ ---------------- -- Finding files --- | Find a file by looking in a search path. The file path must match exactly. --- + +{-# DEPRECATED findFile "Use findFileEx instead. This symbol will be removed in Cabal 3.2 (est. December 2019)" #-} findFile :: [FilePath] -- ^search locations -> FilePath -- ^File Name -> IO FilePath -findFile searchPath fileName = +findFile = findFileEx normal + +-- | Find a file by looking in a search path. The file path must match exactly. +-- +findFileEx :: Verbosity + -> [FilePath] -- ^search locations + -> FilePath -- ^File Name + -> IO FilePath +findFileEx verbosity searchPath fileName = findFirstFile id [ path fileName | path <- nub searchPath] - >>= maybe (die $ fileName ++ " doesn't exist") return + >>= maybe (die' verbosity $ fileName ++ " doesn't exist") return -- | Find a file by looking in a search path with one of a list of possible -- file extensions. The file base name should be given and it will be tried @@ -1020,34 +998,52 @@ findAllFiles :: (a -> FilePath) -> [a] -> NoCallStackIO [a] findAllFiles file = filterM (doesFileExist . file) --- | Finds the files corresponding to a list of Haskell module names. --- --- As 'findModuleFile' but for a list of module names. --- + +{-# DEPRECATED findModuleFiles "Use findModuleFilesEx instead. This symbol will be removed in Cabal 3.2 (est. December 2019)" #-} findModuleFiles :: [FilePath] -- ^ build prefix (location of objects) -> [String] -- ^ search suffixes -> [ModuleName] -- ^ modules -> IO [(FilePath, FilePath)] -findModuleFiles searchPath extensions moduleNames = - traverse (findModuleFile searchPath extensions) moduleNames +findModuleFiles = findModuleFilesEx normal --- | Find the file corresponding to a Haskell module name. +-- | Finds the files corresponding to a list of Haskell module names. -- --- This is similar to 'findFileWithExtension'' but specialised to a module --- name. The function fails if the file corresponding to the module is missing. +-- As 'findModuleFile' but for a list of module names. -- +findModuleFilesEx :: Verbosity + -> [FilePath] -- ^ build prefix (location of objects) + -> [String] -- ^ search suffixes + -> [ModuleName] -- ^ modules + -> IO [(FilePath, FilePath)] +findModuleFilesEx verbosity searchPath extensions moduleNames = + traverse (findModuleFileEx verbosity searchPath extensions) moduleNames + +{-# DEPRECATED findModuleFile "Use findModuleFileEx instead. This symbol will be removed in Cabal 3.2 (est. December 2019)" #-} findModuleFile :: [FilePath] -- ^ build prefix (location of objects) -> [String] -- ^ search suffixes -> ModuleName -- ^ module -> IO (FilePath, FilePath) -findModuleFile searchPath extensions mod_name = +findModuleFile = findModuleFileEx normal + +-- | Find the file corresponding to a Haskell module name. +-- +-- This is similar to 'findFileWithExtension'' but specialised to a module +-- name. The function fails if the file corresponding to the module is missing. +-- +findModuleFileEx :: Verbosity + -> [FilePath] -- ^ build prefix (location of objects) + -> [String] -- ^ search suffixes + -> ModuleName -- ^ module + -> IO (FilePath, FilePath) +findModuleFileEx verbosity searchPath extensions mod_name = maybe notFound return =<< findFileWithExtension' extensions searchPath (ModuleName.toFilePath mod_name) where - notFound = die $ "Error: Could not find module: " ++ display mod_name - ++ " with any suffix: " ++ show extensions - ++ " in the search path: " ++ show searchPath + notFound = die' verbosity $ + "Error: Could not find module: " ++ prettyShow mod_name + ++ " with any suffix: " ++ show extensions + ++ " in the search path: " ++ show searchPath -- | List all the files in a directory and all subdirectories. -- @@ -1311,25 +1307,6 @@ return (executable perms) else return False ---------------------------------- --- Deprecated file copy functions - -{-# DEPRECATED smartCopySources - "Use findModuleFiles and copyFiles or installOrdinaryFiles" #-} -smartCopySources :: Verbosity -> [FilePath] -> FilePath - -> [ModuleName] -> [String] -> IO () -smartCopySources verbosity searchPath targetDir moduleNames extensions = withFrozenCallStack $ - findModuleFiles searchPath extensions moduleNames - >>= copyFiles verbosity targetDir - -{-# DEPRECATED copyDirectoryRecursiveVerbose - "You probably want installDirectoryContents instead" #-} -copyDirectoryRecursiveVerbose :: Verbosity -> FilePath -> FilePath -> IO () -copyDirectoryRecursiveVerbose verbosity srcDir destDir = withFrozenCallStack $ do - info verbosity ("copy directory '" ++ srcDir ++ "' to '" ++ destDir ++ "'.") - srcFiles <- getDirectoryContentsRecursive srcDir - copyFiles verbosity destDir [ (srcDir, f) | f <- srcFiles ] - --------------------------- -- Temporary files and dirs @@ -1392,27 +1369,26 @@ ----------------------------------- -- Safely reading and writing files -{-# DEPRECATED rewriteFile "Use rewriteFileEx so that Verbosity is respected" #-} -rewriteFile :: FilePath -> String -> IO () -rewriteFile = rewriteFileEx normal - -- | Write a file but only if it would have new content. If we would be writing -- the same as the existing content then leave the file as is so that we do not -- update the file's modification time. -- --- NB: the file is assumed to be ASCII-encoded. +-- NB: Before Cabal-3.0 the file content was assumed to be +-- ASCII-representable. Since Cabal-3.0 the file is assumed to be +-- UTF-8 encoded. rewriteFileEx :: Verbosity -> FilePath -> String -> IO () rewriteFileEx verbosity path newContent = flip catchIO mightNotExist $ do - existingContent <- annotateIO verbosity $ readFile path - _ <- evaluate (length existingContent) - unless (existingContent == newContent) $ + existingContent <- annotateIO verbosity $ BS.readFile path + _ <- evaluate (BS.length existingContent) + unless (existingContent == newContent') $ annotateIO verbosity $ - writeFileAtomic path (BS.Char8.pack newContent) + writeFileAtomic path newContent' where + newContent' = toUTF8LBS newContent + mightNotExist e | isDoesNotExistError e - = annotateIO verbosity $ writeFileAtomic path - (BS.Char8.pack newContent) + = annotateIO verbosity $ writeFileAtomic path newContent' | otherwise = ioError e @@ -1454,9 +1430,9 @@ -- * Finding the description file -- ------------------------------------------------------------ --- |Package description file (/pkgname/@.cabal@) +-- | Package description file (/pkgname/@.cabal@) defaultPackageDesc :: Verbosity -> IO FilePath -defaultPackageDesc _verbosity = tryFindPackageDesc currentDir +defaultPackageDesc verbosity = tryFindPackageDesc verbosity currentDir -- |Find a package description file in the given directory. Looks for -- @.cabal@ files. @@ -1487,20 +1463,17 @@ ++ intercalate ", " l -- |Like 'findPackageDesc', but calls 'die' in case of error. -tryFindPackageDesc :: FilePath -> IO FilePath -tryFindPackageDesc dir = either die return =<< findPackageDesc dir - -{-# DEPRECATED defaultHookedPackageDesc "Use findHookedPackageDesc with the proper base directory instead" #-} --- |Optional auxiliary package information file (/pkgname/@.buildinfo@) -defaultHookedPackageDesc :: IO (Maybe FilePath) -defaultHookedPackageDesc = findHookedPackageDesc currentDir +tryFindPackageDesc :: Verbosity -> FilePath -> IO FilePath +tryFindPackageDesc verbosity dir = + either (die' verbosity) return =<< findPackageDesc dir -- |Find auxiliary package information in the given directory. -- Looks for @.buildinfo@ files. findHookedPackageDesc - :: FilePath -- ^Directory to search + :: Verbosity + -> FilePath -- ^Directory to search -> IO (Maybe FilePath) -- ^/dir/@\/@/pkgname/@.buildinfo@, if present -findHookedPackageDesc dir = do +findHookedPackageDesc verbosity dir = do files <- getDirectoryContents dir buildInfoFiles <- filterM doesFileExist [ dir file @@ -1508,9 +1481,9 @@ , let (name, ext) = splitExtension file , not (null name) && ext == buildInfoExt ] case buildInfoFiles of - [] -> return Nothing + [] -> return Nothing [f] -> return (Just f) - _ -> die ("Multiple files with extension " ++ buildInfoExt) + _ -> die' verbosity ("Multiple files with extension " ++ buildInfoExt) buildInfoExt :: String buildInfoExt = ".buildinfo" diff --git a/cabal/Cabal/Distribution/Simple/Utils/Json.hs b/cabal/Cabal/Distribution/Simple/Utils/Json.hs new file mode 100644 --- /dev/null +++ b/cabal/Cabal/Distribution/Simple/Utils/Json.hs @@ -0,0 +1,46 @@ +-- | Utility json lib for Cabal +-- TODO: Remove it again. +module Distribution.Simple.Utils.Json + ( Json(..) + , renderJson + ) where + +data Json = JsonArray [Json] + | JsonBool !Bool + | JsonNull + | JsonNumber !Int + | JsonObject [(String, Json)] + | JsonString !String + +renderJson :: Json -> ShowS +renderJson (JsonArray objs) = + surround "[" "]" $ intercalate "," $ map renderJson objs +renderJson (JsonBool True) = showString "true" +renderJson (JsonBool False) = showString "false" +renderJson JsonNull = showString "null" +renderJson (JsonNumber n) = shows n +renderJson (JsonObject attrs) = + surround "{" "}" $ intercalate "," $ map render attrs + where + render (k,v) = (surround "\"" "\"" $ showString' k) . showString ":" . renderJson v +renderJson (JsonString s) = surround "\"" "\"" $ showString' s + +surround :: String -> String -> ShowS -> ShowS +surround begin end middle = showString begin . middle . showString end + +showString' :: String -> ShowS +showString' xs = showStringWorker xs + where + showStringWorker :: String -> ShowS + showStringWorker ('\"':as) = showString "\\\"" . showStringWorker as + showStringWorker ('\\':as) = showString "\\\\" . showStringWorker as + showStringWorker ('\'':as) = showString "\\\'" . showStringWorker as + showStringWorker (x:as) = showString [x] . showStringWorker as + showStringWorker [] = showString "" + +intercalate :: String -> [ShowS] -> ShowS +intercalate sep = go + where + go [] = id + go [x] = x + go (x:xs) = x . showString' sep . go xs diff --git a/cabal/Cabal/Distribution/System.hs b/cabal/Cabal/Distribution/System.hs --- a/cabal/Cabal/Distribution/System.hs +++ b/cabal/Cabal/Distribution/System.hs @@ -48,11 +48,9 @@ import qualified System.Info (os, arch) import Distribution.Utils.Generic (lowercase) -import Distribution.Parsec.Class +import Distribution.Parsec import Distribution.Pretty -import Distribution.Text -import qualified Distribution.Compat.ReadP as Parse import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp @@ -134,16 +132,13 @@ instance Parsec OS where parsec = classifyOS Compat <$> parsecIdent -instance Text OS where - parse = fmap (classifyOS Compat) ident - classifyOS :: ClassificationStrictness -> String -> OS classifyOS strictness s = fromMaybe (OtherOS s) $ lookup (lowercase s) osMap where osMap = [ (name, os) | os <- knownOSs - , name <- display os : osAliases strictness os ] + , name <- prettyShow os : osAliases strictness os ] buildOS :: OS buildOS = classifyOS Permissive System.Info.os @@ -203,16 +198,13 @@ instance Parsec Arch where parsec = classifyArch Strict <$> parsecIdent -instance Text Arch where - parse = fmap (classifyArch Strict) ident - classifyArch :: ClassificationStrictness -> String -> Arch classifyArch strictness s = fromMaybe (OtherArch s) $ lookup (lowercase s) archMap where archMap = [ (name, arch) | arch <- knownArches - , name <- display arch : archAliases strictness arch ] + , name <- prettyShow arch : archAliases strictness arch ] buildArch :: Arch buildArch = classifyArch Permissive System.Info.arch @@ -232,6 +224,13 @@ pretty (Platform arch os) = pretty arch <<>> Disp.char '-' <<>> pretty os instance Parsec Platform where + -- TODO: there are ambigious platforms like: `arch-word-os` + -- which could be parsed as + -- * Platform "arch-word" "os" + -- * Platform "arch" "word-os" + -- We could support that preferring variants 'OtherOS' or 'OtherArch' + -- + -- For now we split into arch and os parts on the first dash. parsec = do arch <- parsecDashlessArch _ <- P.char '-' @@ -245,28 +244,6 @@ firstChar = P.satisfy isAlpha rest = P.munch (\c -> isAlphaNum c || c == '_') -instance Text Platform where - -- TODO: there are ambigious platforms like: `arch-word-os` - -- which could be parsed as - -- * Platform "arch-word" "os" - -- * Platform "arch" "word-os" - -- We could support that preferring variants 'OtherOS' or 'OtherArch' - -- - -- For now we split into arch and os parts on the first dash. - parse = do - arch <- parseDashlessArch - _ <- Parse.char '-' - os <- parse - return (Platform arch os) - where - parseDashlessArch :: Parse.ReadP r Arch - parseDashlessArch = fmap (classifyArch Strict) dashlessIdent - - dashlessIdent :: Parse.ReadP r String - dashlessIdent = liftM2 (:) firstChar rest - where firstChar = Parse.satisfy isAlpha - rest = Parse.munch (\c -> isAlphaNum c || c == '_') - -- | The platform Cabal was compiled on. In most cases, -- @LocalBuildInfo.hostPlatform@ should be used instead (the platform we're -- targeting). @@ -275,11 +252,6 @@ -- Utils: -ident :: Parse.ReadP r String -ident = liftM2 (:) firstChar rest - where firstChar = Parse.satisfy isAlpha - rest = Parse.munch (\c -> isAlphaNum c || c == '_' || c == '-') - parsecIdent :: CabalParsing m => m String parsecIdent = (:) <$> firstChar <*> rest where @@ -288,13 +260,13 @@ platformFromTriple :: String -> Maybe Platform platformFromTriple triple = - fmap fst (listToMaybe $ Parse.readP_to_S parseTriple triple) - where parseWord = Parse.munch1 (\c -> isAlphaNum c || c == '_') + either (const Nothing) Just $ explicitEitherParsec parseTriple triple + where parseWord = P.munch1 (\c -> isAlphaNum c || c == '_') parseTriple = do arch <- fmap (classifyArch Permissive) parseWord - _ <- Parse.char '-' + _ <- P.char '-' _ <- parseWord -- Skip vendor - _ <- Parse.char '-' - os <- fmap (classifyOS Permissive) ident -- OS may have hyphens, like + _ <- P.char '-' + os <- fmap (classifyOS Permissive) parsecIdent -- OS may have hyphens, like -- 'nto-qnx' return $ Platform arch os diff --git a/cabal/Cabal/Distribution/Text.hs b/cabal/Cabal/Distribution/Text.hs --- a/cabal/Cabal/Distribution/Text.hs +++ b/cabal/Cabal/Distribution/Text.hs @@ -1,102 +1,12 @@ -{-# LANGUAGE DefaultSignatures #-} ------------------------------------------------------------------------------ --- | --- Module : Distribution.Text --- Copyright : Duncan Coutts 2007 --- --- Maintainer : cabal-devel@haskell.org --- Portability : portable --- --- This defines a 'Text' class which is a bit like the 'Read' and 'Show' --- classes. The difference is that it uses a modern pretty printer and parser --- system and the format is not expected to be Haskell concrete syntax but --- rather the external human readable representation used by Cabal. --- -module Distribution.Text ( - Text(..), - defaultStyle, - display, - flatStyle, - simpleParse, - stdParse, - ) where - -import Prelude () -import Distribution.Compat.Prelude - -import Data.Functor.Identity (Identity (..)) -import Distribution.Pretty -import Distribution.Parsec.Class -import qualified Distribution.Compat.ReadP as Parse -import qualified Text.PrettyPrint as Disp - -import Data.Version (Version(Version)) - --- | /Note:/ this class will soon be deprecated. --- It's not yet, so that we are @-Wall@ clean. -class Text a where - disp :: a -> Disp.Doc - default disp :: Pretty a => a -> Disp.Doc - disp = pretty - - parse :: Parse.ReadP r a - default parse :: Parsec a => Parse.ReadP r a - parse = parsec - --- | Pretty-prints with the default style. -display :: Text a => a -> String -display = Disp.renderStyle defaultStyle . disp - -simpleParse :: Text a => String -> Maybe a -simpleParse str = case [ p | (p, s) <- Parse.readP_to_S parse str - , all isSpace s ] of - [] -> Nothing - (p:_) -> Just p - -stdParse :: Text ver => (ver -> String -> res) -> Parse.ReadP r res -stdParse f = do - cs <- Parse.sepBy1 component (Parse.char '-') - _ <- Parse.char '-' - ver <- parse - let name = intercalate "-" cs - return $! f ver (lowercase name) - where - component = do - cs <- Parse.munch1 isAlphaNum - if all isDigit cs then Parse.pfail else return cs - -- each component must contain an alphabetic character, to avoid - -- ambiguity in identifiers like foo-1 (the 1 is the version number). - -lowercase :: String -> String -lowercase = map toLower - --- ----------------------------------------------------------------------------- --- Instances for types from the base package - -instance Text Bool where - parse = Parse.choice [ (Parse.string "True" Parse.+++ - Parse.string "true") >> return True - , (Parse.string "False" Parse.+++ - Parse.string "false") >> return False ] - -instance Text Int where - parse = fmap negate (Parse.char '-' >> parseNat) Parse.+++ parseNat - -instance Text a => Text (Identity a) where - disp = disp . runIdentity - parse = fmap Identity parse - --- | Parser for non-negative integers. -parseNat :: Parse.ReadP r Int -parseNat = read `fmap` Parse.munch1 isDigit -- TODO: eradicateNoParse +-- Since @3.0@ this is a compat module. +module Distribution.Text (display, simpleParse) where +{- {-# DEPRECATED "Use Distribution.Parsec or Distribution.Pretty" #-} -} +import Distribution.Pretty +import Distribution.Parsec -instance Text Version where - disp (Version branch _tags) -- Death to version tags!! - = Disp.hcat (Disp.punctuate (Disp.char '.') (map Disp.int branch)) +display :: Pretty a => a -> String +display = prettyShow - parse = do - branch <- Parse.sepBy1 parseNat (Parse.char '.') - -- allow but ignore tags: - _tags <- Parse.many (Parse.char '-' >> Parse.munch1 isAlphaNum) - return (Version branch []) +simpleParse :: Parsec a => String -> Maybe a +simpleParse = simpleParsec diff --git a/cabal/Cabal/Distribution/Types/AbiDependency.hs b/cabal/Cabal/Distribution/Types/AbiDependency.hs --- a/cabal/Cabal/Distribution/Types/AbiDependency.hs +++ b/cabal/Cabal/Distribution/Types/AbiDependency.hs @@ -4,12 +4,10 @@ import Distribution.Compat.Prelude import Prelude () -import Distribution.Parsec.Class +import Distribution.Parsec import Distribution.Pretty -import Distribution.Text import qualified Distribution.Compat.CharParsing as P -import qualified Distribution.Compat.ReadP as Parse import qualified Distribution.Package as Package import qualified Text.PrettyPrint as Disp @@ -31,7 +29,7 @@ instance Pretty AbiDependency where pretty (AbiDependency uid abi) = - disp uid <<>> Disp.char '=' <<>> disp abi + pretty uid <<>> Disp.char '=' <<>> pretty abi instance Parsec AbiDependency where parsec = do @@ -40,13 +38,5 @@ abi <- parsec return (AbiDependency uid abi) -instance Text AbiDependency where - parse = do - uid <- parse - _ <- Parse.char '=' - abi <- parse - return (AbiDependency uid abi) - instance Binary AbiDependency - instance NFData AbiDependency where rnf = genericRnf diff --git a/cabal/Cabal/Distribution/Types/AbiHash.hs b/cabal/Cabal/Distribution/Types/AbiHash.hs --- a/cabal/Cabal/Distribution/Types/AbiHash.hs +++ b/cabal/Cabal/Distribution/Types/AbiHash.hs @@ -10,11 +10,9 @@ import Distribution.Compat.Prelude import Distribution.Utils.ShortText -import qualified Distribution.Compat.ReadP as Parse import qualified Distribution.Compat.CharParsing as P -import Distribution.Text import Distribution.Pretty -import Distribution.Parsec.Class +import Distribution.Parsec import Text.PrettyPrint (text) @@ -61,6 +59,3 @@ instance Parsec AbiHash where parsec = fmap mkAbiHash (P.munch isAlphaNum) - -instance Text AbiHash where - parse = fmap mkAbiHash (Parse.munch isAlphaNum) diff --git a/cabal/Cabal/Distribution/Types/BenchmarkType.hs b/cabal/Cabal/Distribution/Types/BenchmarkType.hs --- a/cabal/Cabal/Distribution/Types/BenchmarkType.hs +++ b/cabal/Cabal/Distribution/Types/BenchmarkType.hs @@ -9,9 +9,8 @@ import Distribution.Compat.Prelude import Prelude () -import Distribution.Parsec.Class +import Distribution.Parsec import Distribution.Pretty -import Distribution.Text import Distribution.Version import Text.PrettyPrint (char, text) @@ -38,10 +37,3 @@ parsec = parsecStandard $ \ver name -> case name of "exitcode-stdio" -> BenchmarkTypeExe ver _ -> BenchmarkTypeUnknown name ver - -instance Text BenchmarkType where - parse = stdParse $ \ver name -> case name of - "exitcode-stdio" -> BenchmarkTypeExe ver - _ -> BenchmarkTypeUnknown name ver - - diff --git a/cabal/Cabal/Distribution/Types/BuildInfo.hs b/cabal/Cabal/Distribution/Types/BuildInfo.hs --- a/cabal/Cabal/Distribution/Types/BuildInfo.hs +++ b/cabal/Cabal/Distribution/Types/BuildInfo.hs @@ -78,25 +78,29 @@ extraLibs :: [String], -- ^ what libraries to link with when compiling a program that uses your package extraGHCiLibs :: [String], -- ^ if present, overrides extraLibs when package is loaded with GHCi. - extraBundledLibs :: [String], -- ^ if present, adds libs to hs-lirbaries, which become part of the package. + extraBundledLibs :: [String], -- ^ if present, adds libs to hs-libraries, which become part of the package. -- Example: the Cffi library shipping with the rts, alognside the HSrts-1.0.a,.o,... -- Example 2: a library that is being built by a foreing tool (e.g. rust) -- and copied and registered together with this library. The -- logic on how this library is built will have to be encoded in a -- custom Setup for now. Oherwise cabal would need to lear how to - -- call arbitary lirbary builders. - extraLibFlavours :: [String], -- ^ Hidden Flag. This set of strings, will be appended to all lirbaries when + -- call arbitary library builders. + extraLibFlavours :: [String], -- ^ Hidden Flag. This set of strings, will be appended to all libraries when -- copying. E.g. [libHS_ | flavour <- extraLibFlavours]. This -- should only be needed in very specific cases, e.g. the `rts` package, where -- there are multiple copies of slightly differently built libs. + extraDynLibFlavours :: [String], -- ^ Hidden Flag. This set of strings will be be appended to all /dynamic/ + -- libraries when copying. This is particularly useful with the `rts` package, + -- where we want different dynamic flavours of the RTS library to be installed. extraLibDirs :: [String], includeDirs :: [FilePath], -- ^directories to find .h files includes :: [FilePath], -- ^ The .h files to be found in includeDirs + autogenIncludes :: [FilePath], -- ^ The .h files to be generated (e.g. by @autoconf@) installIncludes :: [FilePath], -- ^ .h files to install with the package - options :: [(CompilerFlavor,[String])], - profOptions :: [(CompilerFlavor,[String])], - sharedOptions :: [(CompilerFlavor,[String])], - staticOptions :: [(CompilerFlavor,[String])], + options :: PerCompilerFlavor [String], + profOptions :: PerCompilerFlavor [String], + sharedOptions :: PerCompilerFlavor [String], + staticOptions :: PerCompilerFlavor [String], customFieldsBI :: [(String,String)], -- ^Custom fields starting -- with x-, stored in a -- simple assoc-list. @@ -141,14 +145,16 @@ extraGHCiLibs = [], extraBundledLibs = [], extraLibFlavours = [], + extraDynLibFlavours = [], extraLibDirs = [], includeDirs = [], includes = [], + autogenIncludes = [], installIncludes = [], - options = [], - profOptions = [], - sharedOptions = [], - staticOptions = [], + options = mempty, + profOptions = mempty, + sharedOptions = mempty, + staticOptions = mempty, customFieldsBI = [], targetBuildDepends = [], mixins = [] @@ -187,9 +193,11 @@ extraGHCiLibs = combine extraGHCiLibs, extraBundledLibs = combine extraBundledLibs, extraLibFlavours = combine extraLibFlavours, + extraDynLibFlavours = combine extraDynLibFlavours, extraLibDirs = combineNub extraLibDirs, includeDirs = combineNub includeDirs, includes = combineNub includes, + autogenIncludes = combineNub autogenIncludes, installIncludes = combineNub installIncludes, options = combine options, profOptions = combine profOptions, @@ -246,8 +254,10 @@ hcStaticOptions :: CompilerFlavor -> BuildInfo -> [String] hcStaticOptions = lookupHcOptions staticOptions -lookupHcOptions :: (BuildInfo -> [(CompilerFlavor,[String])]) +lookupHcOptions :: (BuildInfo -> PerCompilerFlavor [String]) -> CompilerFlavor -> BuildInfo -> [String] -lookupHcOptions f hc bi = [ opt | (hc',opts) <- f bi - , hc' == hc - , opt <- opts ] +lookupHcOptions f hc bi = case f bi of + PerCompilerFlavor ghc ghcjs + | hc == GHC -> ghc + | hc == GHCJS -> ghcjs + | otherwise -> mempty diff --git a/cabal/Cabal/Distribution/Types/BuildInfo/Lens.hs b/cabal/Cabal/Distribution/Types/BuildInfo/Lens.hs --- a/cabal/Cabal/Distribution/Types/BuildInfo/Lens.hs +++ b/cabal/Cabal/Distribution/Types/BuildInfo/Lens.hs @@ -8,7 +8,7 @@ import Distribution.Compat.Prelude import Distribution.Compat.Lens -import Distribution.Compiler (CompilerFlavor) +import Distribution.Compiler (PerCompilerFlavor) import Distribution.ModuleName (ModuleName) import Distribution.Types.BuildInfo (BuildInfo) import Distribution.Types.Dependency (Dependency) @@ -144,6 +144,10 @@ extraLibFlavours = buildInfo . extraLibFlavours {-# INLINE extraLibFlavours #-} + extraDynLibFlavours :: Lens' a [String] + extraDynLibFlavours = buildInfo . extraDynLibFlavours + {-# INLINE extraDynLibFlavours #-} + extraLibDirs :: Lens' a [String] extraLibDirs = buildInfo . extraLibDirs {-# INLINE extraLibDirs #-} @@ -156,23 +160,27 @@ includes = buildInfo . includes {-# INLINE includes #-} + autogenIncludes :: Lens' a [FilePath] + autogenIncludes = buildInfo . autogenIncludes + {-# INLINE autogenIncludes #-} + installIncludes :: Lens' a [FilePath] installIncludes = buildInfo . installIncludes {-# INLINE installIncludes #-} - options :: Lens' a [(CompilerFlavor,[String])] + options :: Lens' a (PerCompilerFlavor [String]) options = buildInfo . options {-# INLINE options #-} - profOptions :: Lens' a [(CompilerFlavor,[String])] + profOptions :: Lens' a (PerCompilerFlavor [String]) profOptions = buildInfo . profOptions {-# INLINE profOptions #-} - sharedOptions :: Lens' a [(CompilerFlavor,[String])] + sharedOptions :: Lens' a (PerCompilerFlavor [String]) sharedOptions = buildInfo . sharedOptions {-# INLINE sharedOptions #-} - staticOptions :: Lens' a [(CompilerFlavor,[String])] + staticOptions :: Lens' a (PerCompilerFlavor [String]) staticOptions = buildInfo . staticOptions {-# INLINE staticOptions #-} @@ -283,6 +291,9 @@ extraLibFlavours f s = fmap (\x -> s { T.extraLibFlavours = x }) (f (T.extraLibFlavours s)) {-# INLINE extraLibFlavours #-} + extraDynLibFlavours f s = fmap (\x -> s { T.extraDynLibFlavours = x}) (f (T.extraDynLibFlavours s)) + {-# INLINE extraDynLibFlavours #-} + extraLibDirs f s = fmap (\x -> s { T.extraLibDirs = x }) (f (T.extraLibDirs s)) {-# INLINE extraLibDirs #-} @@ -291,6 +302,9 @@ includes f s = fmap (\x -> s { T.includes = x }) (f (T.includes s)) {-# INLINE includes #-} + + autogenIncludes f s = fmap (\x -> s { T.autogenIncludes = x }) (f (T.autogenIncludes s)) + {-# INLINE autogenIncludes #-} installIncludes f s = fmap (\x -> s { T.installIncludes = x }) (f (T.installIncludes s)) {-# INLINE installIncludes #-} diff --git a/cabal/Cabal/Distribution/Types/BuildType.hs b/cabal/Cabal/Distribution/Types/BuildType.hs --- a/cabal/Cabal/Distribution/Types/BuildType.hs +++ b/cabal/Cabal/Distribution/Types/BuildType.hs @@ -11,11 +11,9 @@ import Distribution.CabalSpecVersion (CabalSpecVersion (..)) import Distribution.Pretty -import Distribution.Parsec.Class -import Distribution.Text +import Distribution.Parsec import qualified Distribution.Compat.CharParsing as P -import qualified Distribution.Compat.ReadP as Parse import qualified Text.PrettyPrint as Disp -- | The type of build system used by this package. @@ -48,20 +46,9 @@ "Make" -> return Make "Default" -> do v <- askCabalSpecVersion - if v <= CabalSpecOld + if v <= CabalSpecV1_18 -- oldest version needing this, based on hackage-tests then do parsecWarning PWTBuildTypeDefault "build-type: Default is parsed as Custom for legacy reasons. See https://github.com/haskell/cabal/issues/5020" return Custom else fail ("unknown build-type: '" ++ name ++ "'") - _ -> fail ("unknown build-type: '" ++ name ++ "'") - -instance Text BuildType where - parse = do - name <- Parse.munch1 isAlphaNum - case name of - "Simple" -> return Simple - "Configure" -> return Configure - "Custom" -> return Custom - "Make" -> return Make - "Default" -> return Custom _ -> fail ("unknown build-type: '" ++ name ++ "'") diff --git a/cabal/Cabal/Distribution/Types/Component.hs b/cabal/Cabal/Distribution/Types/Component.hs --- a/cabal/Cabal/Distribution/Types/Component.hs +++ b/cabal/Cabal/Distribution/Types/Component.hs @@ -73,7 +73,7 @@ componentName :: Component -> ComponentName componentName = - foldComponent (libraryComponentName . libName) + foldComponent (CLibName . libName) (CFLibName . foreignLibName) (CExeName . exeName) (CTestName . testName) diff --git a/cabal/Cabal/Distribution/Types/ComponentId.hs b/cabal/Cabal/Distribution/Types/ComponentId.hs --- a/cabal/Cabal/Distribution/Types/ComponentId.hs +++ b/cabal/Cabal/Distribution/Types/ComponentId.hs @@ -10,12 +10,10 @@ import Distribution.Compat.Prelude import Distribution.Utils.ShortText -import qualified Distribution.Compat.ReadP as Parse -import qualified Distribution.Compat.CharParsing as P -import Distribution.Text import Distribution.Pretty -import Distribution.Parsec.Class +import Distribution.Parsec +import qualified Distribution.Compat.CharParsing as P import Text.PrettyPrint (text) -- | A 'ComponentId' uniquely identifies the transitive source @@ -64,10 +62,6 @@ instance Parsec ComponentId where parsec = mkComponentId `fmap` P.munch1 abi_char - where abi_char c = isAlphaNum c || c `elem` "-_." - -instance Text ComponentId where - parse = mkComponentId `fmap` Parse.munch1 abi_char where abi_char c = isAlphaNum c || c `elem` "-_." instance NFData ComponentId where diff --git a/cabal/Cabal/Distribution/Types/ComponentName.hs b/cabal/Cabal/Distribution/Types/ComponentName.hs --- a/cabal/Cabal/Distribution/Types/ComponentName.hs +++ b/cabal/Cabal/Distribution/Types/ComponentName.hs @@ -3,8 +3,6 @@ module Distribution.Types.ComponentName ( ComponentName(..), - defaultLibName, - libraryComponentName, showComponentName, componentNameStanza, componentNameString, @@ -13,17 +11,16 @@ import Prelude () import Distribution.Compat.Prelude -import qualified Distribution.Compat.ReadP as Parse -import Distribution.Compat.ReadP ((<++)) import Distribution.Types.UnqualComponentName +import Distribution.Types.LibraryName import Distribution.Pretty -import Distribution.Text +import Distribution.Parsec -import Text.PrettyPrint as Disp +import qualified Text.PrettyPrint as Disp +import qualified Distribution.Compat.CharParsing as P -- Libraries live in a separate namespace, so must distinguish -data ComponentName = CLibName - | CSubLibName UnqualComponentName +data ComponentName = CLibName LibraryName | CFLibName UnqualComponentName | CExeName UnqualComponentName | CTestName UnqualComponentName @@ -34,58 +31,47 @@ -- Build-target-ish syntax instance Pretty ComponentName where - pretty CLibName = Disp.text "lib" - pretty (CSubLibName str) = Disp.text "lib:" <<>> pretty str + pretty (CLibName lib) = prettyLibraryNameComponent lib pretty (CFLibName str) = Disp.text "flib:" <<>> pretty str pretty (CExeName str) = Disp.text "exe:" <<>> pretty str pretty (CTestName str) = Disp.text "test:" <<>> pretty str pretty (CBenchName str) = Disp.text "bench:" <<>> pretty str -instance Text ComponentName where - parse = parseComposite <++ parseSingle - where - parseSingle = Parse.string "lib" >> return CLibName - parseComposite = do - ctor <- Parse.choice [ Parse.string "lib:" >> return CSubLibName - , Parse.string "flib:" >> return CFLibName - , Parse.string "exe:" >> return CExeName - , Parse.string "bench:" >> return CBenchName - , Parse.string "test:" >> return CTestName ] - ctor <$> parse - -defaultLibName :: ComponentName -defaultLibName = CLibName +instance Parsec ComponentName where + -- note: this works as lib/flib/... all start with different character! + parsec = parseComposite <|> parseLib + where + parseLib = CLibName <$> parsecLibraryNameComponent + parseComposite = do + ctor <- P.choice + [ P.string "flib:" >> return CFLibName + , P.string "exe:" >> return CExeName + , P.string "bench:" >> return CBenchName + , P.string "test:" >> return CTestName + ] + ctor <$> parsec showComponentName :: ComponentName -> String -showComponentName CLibName = "library" -showComponentName (CSubLibName name) = "library '" ++ display name ++ "'" -showComponentName (CFLibName name) = "foreign library '" ++ display name ++ "'" -showComponentName (CExeName name) = "executable '" ++ display name ++ "'" -showComponentName (CTestName name) = "test suite '" ++ display name ++ "'" -showComponentName (CBenchName name) = "benchmark '" ++ display name ++ "'" +showComponentName (CLibName lib) = showLibraryName lib +showComponentName (CFLibName name) = "foreign library '" ++ prettyShow name ++ "'" +showComponentName (CExeName name) = "executable '" ++ prettyShow name ++ "'" +showComponentName (CTestName name) = "test suite '" ++ prettyShow name ++ "'" +showComponentName (CBenchName name) = "benchmark '" ++ prettyShow name ++ "'" componentNameStanza :: ComponentName -> String -componentNameStanza CLibName = "library" -componentNameStanza (CSubLibName name) = "library " ++ display name -componentNameStanza (CFLibName name) = "foreign-library " ++ display name -componentNameStanza (CExeName name) = "executable " ++ display name -componentNameStanza (CTestName name) = "test-suite " ++ display name -componentNameStanza (CBenchName name) = "benchmark " ++ display name +componentNameStanza (CLibName lib) = libraryNameStanza lib +componentNameStanza (CFLibName name) = "foreign-library " ++ prettyShow name +componentNameStanza (CExeName name) = "executable " ++ prettyShow name +componentNameStanza (CTestName name) = "test-suite " ++ prettyShow name +componentNameStanza (CBenchName name) = "benchmark " ++ prettyShow name -- | This gets the underlying unqualified component name. In fact, it is -- guaranteed to uniquely identify a component, returning -- @Nothing@ if the 'ComponentName' was for the public -- library. componentNameString :: ComponentName -> Maybe UnqualComponentName -componentNameString CLibName = Nothing -componentNameString (CSubLibName n) = Just n +componentNameString (CLibName lib) = libraryNameString lib componentNameString (CFLibName n) = Just n componentNameString (CExeName n) = Just n componentNameString (CTestName n) = Just n componentNameString (CBenchName n) = Just n - --- | Convert the 'UnqualComponentName' of a library into a --- 'ComponentName'. -libraryComponentName :: Maybe UnqualComponentName -> ComponentName -libraryComponentName Nothing = CLibName -libraryComponentName (Just n) = CSubLibName n diff --git a/cabal/Cabal/Distribution/Types/ComponentRequestedSpec.hs b/cabal/Cabal/Distribution/Types/ComponentRequestedSpec.hs --- a/cabal/Cabal/Distribution/Types/ComponentRequestedSpec.hs +++ b/cabal/Cabal/Distribution/Types/ComponentRequestedSpec.hs @@ -14,11 +14,12 @@ import Prelude () import Distribution.Compat.Prelude -import Distribution.Text import Distribution.Types.Component -- TODO: maybe remove me? import Distribution.Types.ComponentName +import Distribution.Pretty (prettyShow) + -- $buildable_vs_enabled_components -- #buildable_vs_enabled_components# -- @@ -112,7 +113,7 @@ componentNameNotRequestedReason ComponentRequestedSpec{} _ = Nothing componentNameNotRequestedReason (OneComponentRequestedSpec cname) c | c == cname = Nothing - | otherwise = Just (DisabledAllButOne (display cname)) + | otherwise = Just (DisabledAllButOne (prettyShow cname)) -- | A reason explaining why a component is disabled. -- diff --git a/cabal/Cabal/Distribution/Types/CondTree.hs b/cabal/Cabal/Distribution/Types/CondTree.hs --- a/cabal/Cabal/Distribution/Types/CondTree.hs +++ b/cabal/Cabal/Distribution/Types/CondTree.hs @@ -157,12 +157,12 @@ -- | Flattens a CondTree using a partial flag assignment. When a condition -- cannot be evaluated, both branches are ignored. -simplifyCondTree :: (Monoid a, Monoid d) => +simplifyCondTree :: (Semigroup a, Semigroup d) => (v -> Either v Bool) -> CondTree v d a -> (d, a) simplifyCondTree env (CondNode a d ifs) = - mconcat $ (d, a) : mapMaybe simplifyIf ifs + foldl (<>) (d, a) $ mapMaybe simplifyIf ifs where simplifyIf (CondBranch cnd t me) = case simplifyCondition cnd env of @@ -173,7 +173,7 @@ -- | Flatten a CondTree. This will resolve the CondTree by taking all -- possible paths into account. Note that since branches represent exclusive -- choices this may not result in a \"sane\" result. -ignoreConditions :: (Monoid a, Monoid c) => CondTree v c a -> (a, c) -ignoreConditions (CondNode a c ifs) = (a, c) `mappend` mconcat (concatMap f ifs) +ignoreConditions :: (Semigroup a, Semigroup c) => CondTree v c a -> (a, c) +ignoreConditions (CondNode a c ifs) = foldl (<>) (a, c) $ concatMap f ifs where f (CondBranch _ t me) = ignoreConditions t : maybeToList (fmap ignoreConditions me) diff --git a/cabal/Cabal/Distribution/Types/Dependency.hs b/cabal/Cabal/Distribution/Types/Dependency.hs --- a/cabal/Cabal/Distribution/Types/Dependency.hs +++ b/cabal/Cabal/Distribution/Types/Dependency.hs @@ -4,6 +4,7 @@ ( Dependency(..) , depPkgName , depVerRange + , depLibraries , thisPackageVersion , notThisPackageVersion , simplifyDependency @@ -16,57 +17,101 @@ , notThisVersion, anyVersion , simplifyVersionRange ) -import qualified Distribution.Compat.ReadP as Parse - -import Distribution.Text +import Distribution.CabalSpecVersion import Distribution.Pretty -import Distribution.Parsec.Class +import qualified Text.PrettyPrint as PP +import Distribution.Parsec +import Distribution.Compat.CharParsing (char, spaces) +import Distribution.Compat.Parsing (between, option) import Distribution.Types.PackageId import Distribution.Types.PackageName +import Distribution.Types.LibraryName +import Distribution.Types.UnqualComponentName import Text.PrettyPrint ((<+>)) +import Data.Set (Set) +import qualified Data.Set as Set -- | Describes a dependency on a source package (API) -- -data Dependency = Dependency PackageName VersionRange +data Dependency = Dependency + PackageName + VersionRange + (Set LibraryName) + -- ^ The set of libraries required from the package. + -- Only the selected libraries will be built. + -- It does not affect the cabal-install solver yet. deriving (Generic, Read, Show, Eq, Typeable, Data) depPkgName :: Dependency -> PackageName -depPkgName (Dependency pn _) = pn +depPkgName (Dependency pn _ _) = pn depVerRange :: Dependency -> VersionRange -depVerRange (Dependency _ vr) = vr +depVerRange (Dependency _ vr _) = vr +depLibraries :: Dependency -> Set LibraryName +depLibraries (Dependency _ _ cs) = cs + instance Binary Dependency instance NFData Dependency where rnf = genericRnf instance Pretty Dependency where - pretty (Dependency name ver) = pretty name <+> pretty ver + pretty (Dependency name ver sublibs) = pretty name + <+> optionalMonoid + (sublibs /= Set.singleton LMainLibName) + (PP.colon <+> PP.braces prettySublibs) + <+> pretty ver + where + optionalMonoid True x = x + optionalMonoid False _ = mempty + prettySublibs = PP.hsep $ PP.punctuate PP.comma $ prettySublib <$> Set.toList sublibs + prettySublib LMainLibName = PP.text $ unPackageName name + prettySublib (LSubLibName un) = PP.text $ unUnqualComponentName un +versionGuardMultilibs :: (Monad m, CabalParsing m) => m a -> m a +versionGuardMultilibs expr = do + csv <- askCabalSpecVersion + if csv < CabalSpecV3_0 + then fail $ unwords + [ "Sublibrary dependency syntax used." + , "To use this syntax the package needs to specify at least 'cabal-version: 3.0'." + , "Alternatively, if you are depending on an internal library, you can write" + , "directly the library name as it were a package." + ] + else + expr + instance Parsec Dependency where parsec = do name <- lexemeParsec - ver <- parsec <|> pure anyVersion - return (Dependency name ver) -instance Text Dependency where - parse = do name <- parse - Parse.skipSpaces - ver <- parse Parse.<++ return anyVersion - Parse.skipSpaces - return (Dependency name ver) + libs <- option [LMainLibName] + $ (char ':' *> spaces *>) + $ versionGuardMultilibs + $ pure <$> parseLib name <|> parseMultipleLibs name + ver <- parsec <|> pure anyVersion + return $ Dependency name ver $ Set.fromList libs + where makeLib pn ln | unPackageName pn == ln = LMainLibName + | otherwise = LSubLibName $ mkUnqualComponentName ln + parseLib pn = makeLib pn <$> parsecUnqualComponentName + parseMultipleLibs pn = between (char '{' *> spaces) + (spaces <* char '}') + $ parsecCommaList $ parseLib pn +-- mempty should never be in a Dependency-as-dependency. +-- This is only here until the Dependency-as-constraint problem is solved #5570. +-- Same for below. thisPackageVersion :: PackageIdentifier -> Dependency thisPackageVersion (PackageIdentifier n v) = - Dependency n (thisVersion v) + Dependency n (thisVersion v) Set.empty notThisPackageVersion :: PackageIdentifier -> Dependency notThisPackageVersion (PackageIdentifier n v) = - Dependency n (notThisVersion v) + Dependency n (notThisVersion v) Set.empty -- | Simplify the 'VersionRange' expression in a 'Dependency'. -- See 'simplifyVersionRange'. -- simplifyDependency :: Dependency -> Dependency -simplifyDependency (Dependency name range) = - Dependency name (simplifyVersionRange range) +simplifyDependency (Dependency name range comps) = + Dependency name (simplifyVersionRange range) comps diff --git a/cabal/Cabal/Distribution/Types/DependencyMap.hs b/cabal/Cabal/Distribution/Types/DependencyMap.hs --- a/cabal/Cabal/Distribution/Types/DependencyMap.hs +++ b/cabal/Cabal/Distribution/Types/DependencyMap.hs @@ -10,13 +10,15 @@ import Distribution.Types.Dependency import Distribution.Types.PackageName +import Distribution.Types.LibraryName import Distribution.Version +import Data.Set (Set) import qualified Data.Map.Lazy as Map -- | A map of dependencies. Newtyped since the default monoid instance is not -- appropriate. The monoid instance uses 'intersectVersionRanges'. -newtype DependencyMap = DependencyMap { unDependencyMap :: Map PackageName VersionRange } +newtype DependencyMap = DependencyMap { unDependencyMap :: Map PackageName (VersionRange, Set LibraryName) } deriving (Show, Read) instance Monoid DependencyMap where @@ -25,14 +27,20 @@ instance Semigroup DependencyMap where (DependencyMap a) <> (DependencyMap b) = - DependencyMap (Map.unionWith intersectVersionRanges a b) + DependencyMap (Map.unionWith intersectVersionRangesAndJoinComponents a b) +intersectVersionRangesAndJoinComponents :: (VersionRange, Set LibraryName) + -> (VersionRange, Set LibraryName) + -> (VersionRange, Set LibraryName) +intersectVersionRangesAndJoinComponents (va, ca) (vb, cb) = + (intersectVersionRanges va vb, ca <> cb) + toDepMap :: [Dependency] -> DependencyMap toDepMap ds = - DependencyMap $ Map.fromListWith intersectVersionRanges [ (p,vr) | Dependency p vr <- ds ] + DependencyMap $ Map.fromListWith intersectVersionRangesAndJoinComponents [ (p,(vr,cs)) | Dependency p vr cs <- ds ] fromDepMap :: DependencyMap -> [Dependency] -fromDepMap m = [ Dependency p vr | (p,vr) <- Map.toList (unDependencyMap m) ] +fromDepMap m = [ Dependency p vr cs | (p,(vr,cs)) <- Map.toList (unDependencyMap m) ] -- Apply extra constraints to a dependency map. -- Combines dependencies where the result will only contain keys from the left @@ -48,4 +56,4 @@ where tightenConstraint n c l = case Map.lookup n l of Nothing -> l - Just vr -> Map.insert n (intersectVersionRanges vr c) l + Just vrcs -> Map.insert n (intersectVersionRangesAndJoinComponents vrcs c) l diff --git a/cabal/Cabal/Distribution/Types/ExeDependency.hs b/cabal/Cabal/Distribution/Types/ExeDependency.hs --- a/cabal/Cabal/Distribution/Types/ExeDependency.hs +++ b/cabal/Cabal/Distribution/Types/ExeDependency.hs @@ -8,17 +8,14 @@ import Distribution.Compat.Prelude import Prelude () -import Distribution.Parsec.Class +import Distribution.Parsec import Distribution.Pretty -import Distribution.Text import Distribution.Types.ComponentName import Distribution.Types.PackageName import Distribution.Types.UnqualComponentName import Distribution.Version (VersionRange, anyVersion) import qualified Distribution.Compat.CharParsing as P -import Distribution.Compat.ReadP ((<++)) -import qualified Distribution.Compat.ReadP as Parse import Text.PrettyPrint (text, (<+>)) -- | Describes a dependency on an executable from a package @@ -43,15 +40,6 @@ exe <- lexemeParsec ver <- parsec <|> pure anyVersion return (ExeDependency name exe ver) - -instance Text ExeDependency where - parse = do name <- parse - _ <- Parse.char ':' - exe <- parse - Parse.skipSpaces - ver <- parse <++ return anyVersion - Parse.skipSpaces - return (ExeDependency name exe ver) qualifiedExeName :: ExeDependency -> ComponentName qualifiedExeName (ExeDependency _ ucn _) = CExeName ucn diff --git a/cabal/Cabal/Distribution/Types/ExecutableScope.hs b/cabal/Cabal/Distribution/Types/ExecutableScope.hs --- a/cabal/Cabal/Distribution/Types/ExecutableScope.hs +++ b/cabal/Cabal/Distribution/Types/ExecutableScope.hs @@ -9,11 +9,9 @@ import Distribution.Compat.Prelude import Distribution.Pretty -import Distribution.Parsec.Class -import Distribution.Text +import Distribution.Parsec import qualified Distribution.Compat.CharParsing as P -import qualified Distribution.Compat.ReadP as Parse import qualified Text.PrettyPrint as Disp data ExecutableScope = ExecutablePublic @@ -28,12 +26,6 @@ parsec = P.try pub <|> pri where pub = ExecutablePublic <$ P.string "public" pri = ExecutablePrivate <$ P.string "private" - -instance Text ExecutableScope where - parse = Parse.choice - [ Parse.string "public" >> return ExecutablePublic - , Parse.string "private" >> return ExecutablePrivate - ] instance Binary ExecutableScope diff --git a/cabal/Cabal/Distribution/Types/ExposedModule.hs b/cabal/Cabal/Distribution/Types/ExposedModule.hs --- a/cabal/Cabal/Distribution/Types/ExposedModule.hs +++ b/cabal/Cabal/Distribution/Types/ExposedModule.hs @@ -6,13 +6,10 @@ import Distribution.Backpack import Distribution.ModuleName -import Distribution.Parsec.Class -import Distribution.ParseUtils (parseModuleNameQ) +import Distribution.Parsec import Distribution.Pretty -import Distribution.Text import qualified Distribution.Compat.CharParsing as P -import qualified Distribution.Compat.ReadP as Parse import qualified Text.PrettyPrint as Disp data ExposedModule @@ -26,7 +23,7 @@ pretty (ExposedModule m reexport) = Disp.hsep [ pretty m , case reexport of - Just m' -> Disp.hsep [Disp.text "from", disp m'] + Just m' -> Disp.hsep [Disp.text "from", pretty m'] Nothing -> Disp.empty ] @@ -40,16 +37,6 @@ P.skipSpaces1 parsec - return (ExposedModule m reexport) - -instance Text ExposedModule where - parse = do - m <- parseModuleNameQ - Parse.skipSpaces - reexport <- Parse.option Nothing $ do - _ <- Parse.string "from" - Parse.skipSpaces - fmap Just parse return (ExposedModule m reexport) instance Binary ExposedModule diff --git a/cabal/Cabal/Distribution/Types/ForeignLib.hs b/cabal/Cabal/Distribution/Types/ForeignLib.hs --- a/cabal/Cabal/Distribution/Types/ForeignLib.hs +++ b/cabal/Cabal/Distribution/Types/ForeignLib.hs @@ -21,10 +21,9 @@ import Prelude () import Distribution.ModuleName -import Distribution.Parsec.Class +import Distribution.Parsec import Distribution.Pretty import Distribution.System -import Distribution.Text import Distribution.Types.BuildInfo import Distribution.Types.ForeignLibOption import Distribution.Types.ForeignLibType @@ -32,7 +31,6 @@ import Distribution.Version import qualified Distribution.Compat.CharParsing as P -import qualified Distribution.Compat.ReadP as Parse import qualified Text.PrettyPrint as Disp import qualified Text.Read as Read @@ -103,18 +101,6 @@ P.integral return (r,a) return $ mkLibVersionInfo (c,r,a) - -instance Text LibVersionInfo where - parse = do - c <- parseNat - (r, a) <- Parse.option (0,0) $ do - _ <- Parse.char ':' - r <- parseNat - a <- Parse.option 0 (Parse.char ':' >> parseNat) - return (r, a) - return $ mkLibVersionInfo (c,r,a) - where - parseNat = read `fmap` Parse.munch1 isDigit -- | Construct 'LibVersionInfo' from @(current, revision, age)@ -- numbers. diff --git a/cabal/Cabal/Distribution/Types/ForeignLibOption.hs b/cabal/Cabal/Distribution/Types/ForeignLibOption.hs --- a/cabal/Cabal/Distribution/Types/ForeignLibOption.hs +++ b/cabal/Cabal/Distribution/Types/ForeignLibOption.hs @@ -9,11 +9,9 @@ import Distribution.Compat.Prelude import Distribution.Pretty -import Distribution.Parsec.Class -import Distribution.Text +import Distribution.Parsec import qualified Distribution.Compat.CharParsing as P -import qualified Distribution.Compat.ReadP as Parse import qualified Text.PrettyPrint as Disp data ForeignLibOption = @@ -34,11 +32,6 @@ case name of "standalone" -> return ForeignLibStandalone _ -> fail "unrecognized foreign-library option" - -instance Text ForeignLibOption where - parse = Parse.choice [ - do _ <- Parse.string "standalone" ; return ForeignLibStandalone - ] instance Binary ForeignLibOption diff --git a/cabal/Cabal/Distribution/Types/ForeignLibType.hs b/cabal/Cabal/Distribution/Types/ForeignLibType.hs --- a/cabal/Cabal/Distribution/Types/ForeignLibType.hs +++ b/cabal/Cabal/Distribution/Types/ForeignLibType.hs @@ -12,11 +12,9 @@ import Distribution.PackageDescription.Utils import Distribution.Pretty -import Distribution.Parsec.Class -import Distribution.Text +import Distribution.Parsec import qualified Distribution.Compat.CharParsing as P -import qualified Distribution.Compat.ReadP as Parse import qualified Text.PrettyPrint as Disp -- | What kind of foreign library is to be built? @@ -42,12 +40,6 @@ "native-shared" -> ForeignLibNativeShared "native-static" -> ForeignLibNativeStatic _ -> ForeignLibTypeUnknown - -instance Text ForeignLibType where - parse = Parse.choice [ - do _ <- Parse.string "native-shared" ; return ForeignLibNativeShared - , do _ <- Parse.string "native-static" ; return ForeignLibNativeStatic - ] instance Binary ForeignLibType diff --git a/cabal/Cabal/Distribution/Types/GenericPackageDescription.hs b/cabal/Cabal/Distribution/Types/GenericPackageDescription.hs --- a/cabal/Cabal/Distribution/Types/GenericPackageDescription.hs +++ b/cabal/Cabal/Distribution/Types/GenericPackageDescription.hs @@ -21,7 +21,6 @@ nullFlagAssignment, showFlagValue, dispFlagAssignment, - parseFlagAssignment, parsecFlagAssignment, ConfVar(..), ) where @@ -32,9 +31,7 @@ import Distribution.Utils.Generic (lowercase) import qualified Text.PrettyPrint as Disp import qualified Data.Map as Map -import qualified Distribution.Compat.ReadP as Parse import qualified Distribution.Compat.CharParsing as P -import Distribution.Compat.ReadP ((+++)) -- lens import Distribution.Compat.Lens as L @@ -55,9 +52,8 @@ import Distribution.Version import Distribution.Compiler import Distribution.System -import Distribution.Parsec.Class +import Distribution.Parsec import Distribution.Pretty -import Distribution.Text -- --------------------------------------------------------------------------- -- The 'GenericPackageDescription' type @@ -170,21 +166,14 @@ pretty = Disp.text . unFlagName instance Parsec FlagName where + -- Note: we don't check that FlagName doesn't have leading dash, + -- cabal check will do that. parsec = mkFlagName . lowercase <$> parsec' where parsec' = (:) <$> lead <*> rest lead = P.satisfy (\c -> isAlphaNum c || c == '_') rest = P.munch (\c -> isAlphaNum c || c == '_' || c == '-') -instance Text FlagName where - -- Note: we don't check that FlagName doesn't have leading dash, - -- cabal check will do that. - parse = mkFlagName . lowercase <$> parse' - where - parse' = (:) <$> lead <*> rest - lead = Parse.satisfy (\c -> isAlphaNum c || c == '_') - rest = Parse.munch (\c -> isAlphaNum c || c == '_' || c == '-') - -- | A 'FlagAssignment' is a total or partial mapping of 'FlagName's to -- 'Bool' flag values. It represents the flags chosen by the user or -- discovered during configuration. For example @--flags=foo --flags=-bar@ @@ -311,7 +300,7 @@ dispFlagAssignment = Disp.hsep . map (Disp.text . showFlagValue) . unFlagAssignment -- | Parses a flag assignment. -parsecFlagAssignment :: ParsecParser FlagAssignment +parsecFlagAssignment :: CabalParsing m => m FlagAssignment parsecFlagAssignment = mkFlagAssignment <$> P.sepBy (onFlag <|> offFlag) P.skipSpaces1 where @@ -323,19 +312,6 @@ _ <- P.char '-' f <- parsec return (f, False) - --- | Parses a flag assignment. -parseFlagAssignment :: Parse.ReadP r FlagAssignment -parseFlagAssignment = mkFlagAssignment <$> - Parse.sepBy parseFlagValue Parse.skipSpaces1 - where - parseFlagValue = - (do Parse.optional (Parse.char '+') - f <- parse - return (f, True)) - +++ (do _ <- Parse.char '-' - f <- parse - return (f, False)) -- {-# DEPRECATED parseFlagAssignment "Use parsecFlagAssignment. This symbol will be removed in Cabal-3.0 (est. Mar 2019)." #-} -- ----------------------------------------------------------------------------- diff --git a/cabal/Cabal/Distribution/Types/GenericPackageDescription/Lens.hs b/cabal/Cabal/Distribution/Types/GenericPackageDescription/Lens.hs --- a/cabal/Cabal/Distribution/Types/GenericPackageDescription/Lens.hs +++ b/cabal/Cabal/Distribution/Types/GenericPackageDescription/Lens.hs @@ -11,6 +11,8 @@ import Distribution.Compat.Prelude import Distribution.Compat.Lens +import qualified Distribution.Types.GenericPackageDescription as T + -- We import types from their packages, so we can remove unused imports -- and have wider inter-module dependency graph import Distribution.Types.CondTree (CondTree) @@ -33,37 +35,37 @@ -- GenericPackageDescription ------------------------------------------------------------------------------- -condBenchmarks :: Lens' GenericPackageDescription [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)] -condBenchmarks f (GenericPackageDescription x1 x2 x3 x4 x5 x6 x7 x8) = fmap (\y1 -> GenericPackageDescription x1 x2 x3 x4 x5 x6 x7 y1) (f x8) -{-# INLINE condBenchmarks #-} - -condExecutables :: Lens' GenericPackageDescription [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)] -condExecutables f (GenericPackageDescription x1 x2 x3 x4 x5 x6 x7 x8) = fmap (\y1 -> GenericPackageDescription x1 x2 x3 x4 x5 y1 x7 x8) (f x6) -{-# INLINE condExecutables #-} +packageDescription :: Lens' GenericPackageDescription PackageDescription +packageDescription f s = fmap (\x -> s { T.packageDescription = x }) (f (T.packageDescription s)) +{-# INLINE packageDescription #-} -condForeignLibs :: Lens' GenericPackageDescription [(UnqualComponentName, CondTree ConfVar [Dependency] Distribution.Types.ForeignLib.ForeignLib)] -condForeignLibs f (GenericPackageDescription x1 x2 x3 x4 x5 x6 x7 x8) = fmap (\y1 -> GenericPackageDescription x1 x2 x3 x4 y1 x6 x7 x8) (f x5) -{-# INLINE condForeignLibs #-} +genPackageFlags :: Lens' GenericPackageDescription [Flag] +genPackageFlags f s = fmap (\x -> s { T.genPackageFlags = x }) (f (T.genPackageFlags s)) +{-# INLINE genPackageFlags #-} condLibrary :: Lens' GenericPackageDescription (Maybe (CondTree ConfVar [Dependency] Library)) -condLibrary f (GenericPackageDescription x1 x2 x3 x4 x5 x6 x7 x8) = fmap (\y1 -> GenericPackageDescription x1 x2 y1 x4 x5 x6 x7 x8) (f x3) +condLibrary f s = fmap (\x -> s { T.condLibrary = x }) (f (T.condLibrary s)) {-# INLINE condLibrary #-} -condSubLibraries :: Lens' GenericPackageDescription [(UnqualComponentName, CondTree ConfVar [Dependency] Library)] -condSubLibraries f (GenericPackageDescription x1 x2 x3 x4 x5 x6 x7 x8) = fmap (\y1 -> GenericPackageDescription x1 x2 x3 y1 x5 x6 x7 x8) (f x4) +condSubLibraries :: Lens' GenericPackageDescription [(UnqualComponentName,(CondTree ConfVar [Dependency] Library))] +condSubLibraries f s = fmap (\x -> s { T.condSubLibraries = x }) (f (T.condSubLibraries s)) {-# INLINE condSubLibraries #-} -condTestSuites :: Lens' GenericPackageDescription [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)] -condTestSuites f (GenericPackageDescription x1 x2 x3 x4 x5 x6 x7 x8) = fmap (\y1 -> GenericPackageDescription x1 x2 x3 x4 x5 x6 y1 x8) (f x7) -{-# INLINE condTestSuites #-} +condForeignLibs :: Lens' GenericPackageDescription [(UnqualComponentName,(CondTree ConfVar [Dependency] ForeignLib))] +condForeignLibs f s = fmap (\x -> s { T.condForeignLibs = x }) (f (T.condForeignLibs s)) +{-# INLINE condForeignLibs #-} -genPackageFlags :: Lens' GenericPackageDescription [Flag] -genPackageFlags f (GenericPackageDescription x1 x2 x3 x4 x5 x6 x7 x8) = fmap (\y1 -> GenericPackageDescription x1 y1 x3 x4 x5 x6 x7 x8) (f x2) -{-# INLINE genPackageFlags #-} +condExecutables :: Lens' GenericPackageDescription [(UnqualComponentName,(CondTree ConfVar [Dependency] Executable))] +condExecutables f s = fmap (\x -> s { T.condExecutables = x }) (f (T.condExecutables s)) +{-# INLINE condExecutables #-} -packageDescription :: Lens' GenericPackageDescription PackageDescription -packageDescription f (GenericPackageDescription x1 x2 x3 x4 x5 x6 x7 x8) = fmap (\y1 -> GenericPackageDescription y1 x2 x3 x4 x5 x6 x7 x8) (f x1) -{-# INLINE packageDescription #-} +condTestSuites :: Lens' GenericPackageDescription [(UnqualComponentName,(CondTree ConfVar [Dependency] TestSuite))] +condTestSuites f s = fmap (\x -> s { T.condTestSuites = x }) (f (T.condTestSuites s)) +{-# INLINE condTestSuites #-} + +condBenchmarks :: Lens' GenericPackageDescription [(UnqualComponentName,(CondTree ConfVar [Dependency] Benchmark))] +condBenchmarks f s = fmap (\x -> s { T.condBenchmarks = x }) (f (T.condBenchmarks s)) +{-# INLINE condBenchmarks #-} allCondTrees :: Applicative f diff --git a/cabal/Cabal/Distribution/Types/GivenComponent.hs b/cabal/Cabal/Distribution/Types/GivenComponent.hs new file mode 100644 --- /dev/null +++ b/cabal/Cabal/Distribution/Types/GivenComponent.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +module Distribution.Types.GivenComponent ( + GivenComponent(..) +) where + +import Distribution.Compat.Prelude + +import Distribution.Types.ComponentId +import Distribution.Types.LibraryName +import Distribution.Types.PackageName + +-- | A 'GivenComponent' represents a library depended on and explicitly +-- specified by the user/client with @--dependency@ +-- +-- It enables Cabal to know which 'ComponentId' to associate with a library +-- +-- @since 2.3.0.0 +data GivenComponent = + GivenComponent + { givenComponentPackage :: PackageName + , givenComponentName :: LibraryName -- --dependency is for libraries + -- only, not for any component + , givenComponentId :: ComponentId } + deriving (Generic, Read, Show, Eq, Typeable) + +instance Binary GivenComponent + diff --git a/cabal/Cabal/Distribution/Types/IncludeRenaming.hs b/cabal/Cabal/Distribution/Types/IncludeRenaming.hs --- a/cabal/Cabal/Distribution/Types/IncludeRenaming.hs +++ b/cabal/Cabal/Distribution/Types/IncludeRenaming.hs @@ -13,11 +13,8 @@ import Distribution.Types.ModuleRenaming import qualified Distribution.Compat.CharParsing as P -import Distribution.Compat.ReadP ((<++)) -import qualified Distribution.Compat.ReadP as Parse -import Distribution.Parsec.Class +import Distribution.Parsec import Distribution.Pretty -import Distribution.Text import Text.PrettyPrint (text, (<+>)) import qualified Text.PrettyPrint as Disp @@ -60,12 +57,6 @@ _ <- P.string "requires" P.spaces parsec - return (IncludeRenaming prov_rn req_rn) - -instance Text IncludeRenaming where - parse = do - prov_rn <- parse - req_rn <- (Parse.string "requires" >> Parse.skipSpaces >> parse) <++ return defaultRenaming -- Requirements don't really care if they're mentioned -- or not (since you can't thin a requirement.) But -- we have a little hack in Configure to combine diff --git a/cabal/Cabal/Distribution/Types/InstalledPackageInfo.hs b/cabal/Cabal/Distribution/Types/InstalledPackageInfo.hs --- a/cabal/Cabal/Distribution/Types/InstalledPackageInfo.hs +++ b/cabal/Cabal/Distribution/Types/InstalledPackageInfo.hs @@ -14,16 +14,17 @@ import Prelude () import Distribution.Backpack -import Distribution.Compat.Graph (IsNode (..)) +import Distribution.Compat.Graph (IsNode (..)) import Distribution.License import Distribution.ModuleName -import Distribution.Package hiding (installedUnitId) +import Distribution.Package hiding (installedUnitId) import Distribution.Types.AbiDependency import Distribution.Types.ExposedModule +import Distribution.Types.LibraryName +import Distribution.Types.LibraryVisibility import Distribution.Types.MungedPackageId import Distribution.Types.MungedPackageName -import Distribution.Types.UnqualComponentName -import Distribution.Version (nullVersion) +import Distribution.Version (nullVersion) import qualified Distribution.Package as Package import qualified Distribution.SPDX as SPDX @@ -38,8 +39,9 @@ -- these parts (sourcePackageId, installedUnitId) are -- exactly the same as PackageDescription sourcePackageId :: PackageId, - sourceLibName :: Maybe UnqualComponentName, + sourceLibName :: LibraryName, installedComponentId_ :: ComponentId, + libVisibility :: LibraryVisibility, installedUnitId :: UnitId, -- INVARIANT: if this package is definite, OpenModule's -- OpenUnitId directly records UnitId. If it is @@ -118,16 +120,13 @@ -- | Returns the munged package name, which we write into @name@ for -- compatibility with old versions of GHC. mungedPackageName :: InstalledPackageInfo -> MungedPackageName -mungedPackageName ipi = - computeCompatPackageName - (packageName ipi) - (sourceLibName ipi) +mungedPackageName ipi = MungedPackageName (packageName ipi) (sourceLibName ipi) emptyInstalledPackageInfo :: InstalledPackageInfo emptyInstalledPackageInfo = InstalledPackageInfo { sourcePackageId = PackageIdentifier (mkPackageName "") nullVersion, - sourceLibName = Nothing, + sourceLibName = LMainLibName, installedComponentId_ = mkComponentId "", installedUnitId = mkUnitId "", instantiatedWith = [], @@ -166,5 +165,6 @@ frameworks = [], haddockInterfaces = [], haddockHTMLs = [], - pkgRoot = Nothing + pkgRoot = Nothing, + libVisibility = LibraryVisibilityPrivate } diff --git a/cabal/Cabal/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs b/cabal/Cabal/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs --- a/cabal/Cabal/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs +++ b/cabal/Cabal/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs @@ -10,6 +10,7 @@ import Prelude () import Distribution.Backpack +import Distribution.CabalSpecVersion import Distribution.Compat.Lens (Lens', (&), (.~)) import Distribution.Compat.Newtype import Distribution.FieldGrammar @@ -17,11 +18,12 @@ import Distribution.License import Distribution.ModuleName import Distribution.Package -import Distribution.Parsec.Class +import Distribution.Parsec import Distribution.Parsec.Newtypes import Distribution.Pretty -import Distribution.Text +import Distribution.Types.LibraryVisibility import Distribution.Types.MungedPackageName +import Distribution.Types.LibraryName import Distribution.Types.UnqualComponentName import Distribution.Version @@ -56,23 +58,24 @@ ipiFieldGrammar = mkInstalledPackageInfo -- Deprecated fields <$> monoidalFieldAla "hugs-options" (alaList' FSep Token) unitedList - ^^^ deprecatedField' "hugs isn't supported anymore" - -- Very basic fields: name, version, package-name and lib-name + --- https://github.com/haskell/cabal/commit/40f3601e17024f07e0da8e64d3dd390177ce908b + ^^^ deprecatedSince CabalSpecV1_22 "hugs isn't supported anymore" + -- Very basic fields: name, version, package-name, lib-name and visibility <+> blurFieldGrammar basic basicFieldGrammar -- Basic fields <+> optionalFieldDef "id" L.installedUnitId (mkUnitId "") <+> optionalFieldDefAla "instantiated-with" InstWith L.instantiatedWith [] <+> optionalFieldDefAla "key" CompatPackageKey L.compatPackageKey "" <+> optionalFieldDefAla "license" SpecLicenseLenient L.license (Left SPDX.NONE) - <+> optionalFieldDefAla "copyright" FreeText L.copyright "" - <+> optionalFieldDefAla "maintainer" FreeText L.maintainer "" - <+> optionalFieldDefAla "author" FreeText L.author "" - <+> optionalFieldDefAla "stability" FreeText L.stability "" - <+> optionalFieldDefAla "homepage" FreeText L.homepage "" - <+> optionalFieldDefAla "package-url" FreeText L.pkgUrl "" - <+> optionalFieldDefAla "synopsis" FreeText L.synopsis "" - <+> optionalFieldDefAla "description" FreeText L.description "" - <+> optionalFieldDefAla "category" FreeText L.category "" + <+> freeTextFieldDef "copyright" L.copyright + <+> freeTextFieldDef "maintainer" L.maintainer + <+> freeTextFieldDef "author" L.author + <+> freeTextFieldDef "stability" L.stability + <+> freeTextFieldDef "homepage" L.homepage + <+> freeTextFieldDef "package-url" L.pkgUrl + <+> freeTextFieldDef "synopsis" L.synopsis + <+> freeTextFieldDef "description" L.description + <+> freeTextFieldDef "category" L.category -- Installed fields <+> optionalFieldDef "abi" L.abiHash (mkAbiHash "") <+> booleanFieldDef "indefinite" L.indefinite False @@ -104,10 +107,11 @@ -- _basicPkgName is not used -- setMaybePackageId says it can be no-op. (PackageIdentifier pn _basicVersion) - (mb_uqn <|> _basicLibName) + (combineLibraryName ln _basicLibName) (mkComponentId "") -- installedComponentId_, not in use + _basicLibVisibility where - (pn, mb_uqn) = decodeCompatPackageName _basicName + MungedPackageName pn ln = _basicName {-# SPECIALIZE ipiFieldGrammar :: FieldDescrs InstalledPackageInfo InstalledPackageInfo #-} {-# SPECIALIZE ipiFieldGrammar :: ParsecFieldGrammar InstalledPackageInfo InstalledPackageInfo #-} {-# SPECIALIZE ipiFieldGrammar :: PrettyFieldGrammar InstalledPackageInfo InstalledPackageInfo #-} @@ -120,6 +124,14 @@ -- Helper functions ------------------------------------------------------------------------------- +-- | Combine 'LibraryName'. in parsing we prefer value coming +-- from munged @name@ field over the @lib-name@. +-- +-- /Should/ be irrelevant. +combineLibraryName :: LibraryName -> LibraryName -> LibraryName +combineLibraryName l@(LSubLibName _) _ = l +combineLibraryName _ l = l + -- To maintain backwards-compatibility, we accept both comma/non-comma -- separated variants of this field. You SHOULD use the comma syntax if you -- use any new functions, although actually it's unambiguous due to a quirk @@ -127,45 +139,40 @@ showExposedModules :: [ExposedModule] -> Disp.Doc showExposedModules xs - | all isExposedModule xs = Disp.fsep (map disp xs) - | otherwise = Disp.fsep (Disp.punctuate Disp.comma (map disp xs)) + | all isExposedModule xs = Disp.fsep (map pretty xs) + | otherwise = Disp.fsep (Disp.punctuate Disp.comma (map pretty xs)) where isExposedModule (ExposedModule _ Nothing) = True isExposedModule _ = False --- | Returns @Just@ if the @name@ field of the IPI record would not contain --- the package name verbatim. This helps us avoid writing @package-name@ --- when it's redundant. -maybePackageName :: InstalledPackageInfo -> Maybe PackageName -maybePackageName ipi = - case sourceLibName ipi of - Nothing -> Nothing - Just _ -> Just (packageName ipi) - -- | Setter for the @package-name@ field. It should be acceptable for this -- to be a no-op. setMaybePackageName :: Maybe PackageName -> InstalledPackageInfo -> InstalledPackageInfo -setMaybePackageName Nothing ipi = ipi -setMaybePackageName (Just pn) ipi = ipi { - sourcePackageId=(sourcePackageId ipi){pkgName=pn} +setMaybePackageName Nothing ipi = ipi +setMaybePackageName (Just pn) ipi = ipi + { sourcePackageId = (sourcePackageId ipi) {pkgName=pn} } setMungedPackageName :: MungedPackageName -> InstalledPackageInfo -> InstalledPackageInfo -setMungedPackageName mpn ipi = - let (pn, mb_uqn) = decodeCompatPackageName mpn - in ipi { - sourcePackageId = (sourcePackageId ipi) {pkgName=pn}, - sourceLibName = mb_uqn - } +setMungedPackageName (MungedPackageName pn ln) ipi = ipi + { sourcePackageId = (sourcePackageId ipi) {pkgName=pn} + , sourceLibName = ln + } +--- | Returns @Just@ if the @name@ field of the IPI record would not contain +--- the package name verbatim. This helps us avoid writing @package-name@ +--- when it's redundant. +maybePackageName :: InstalledPackageInfo -> Maybe PackageName +maybePackageName ipi = case sourceLibName ipi of + LMainLibName -> Nothing + LSubLibName _ -> Just (packageName ipi) + ------------------------------------------------------------------------------- -- Auxiliary types ------------------------------------------------------------------------------- newtype ExposedModules = ExposedModules { getExposedModules :: [ExposedModule] } -instance Newtype ExposedModules [ExposedModule] where - pack = ExposedModules - unpack = getExposedModules +instance Newtype [ExposedModule] ExposedModules instance Parsec ExposedModules where parsec = ExposedModules <$> parsecOptCommaList parsec @@ -176,9 +183,7 @@ newtype CompatPackageKey = CompatPackageKey { getCompatPackageKey :: String } -instance Newtype CompatPackageKey String where - pack = CompatPackageKey - unpack = getCompatPackageKey +instance Newtype String CompatPackageKey instance Pretty CompatPackageKey where pretty = Disp.text . getCompatPackageKey @@ -190,9 +195,7 @@ newtype InstWith = InstWith { getInstWith :: [(ModuleName,OpenModule)] } -instance Newtype InstWith [(ModuleName, OpenModule)] where - pack = InstWith - unpack = getInstWith +instance Newtype [(ModuleName, OpenModule)] InstWith instance Pretty InstWith where pretty = dispOpenModuleSubst . Map.fromList . getInstWith @@ -204,22 +207,27 @@ -- | SPDX License expression or legacy license. Lenient parser, accepts either. newtype SpecLicenseLenient = SpecLicenseLenient { getSpecLicenseLenient :: Either SPDX.License License } -instance Newtype SpecLicenseLenient (Either SPDX.License License) where - pack = SpecLicenseLenient - unpack = getSpecLicenseLenient +instance Newtype (Either SPDX.License License) SpecLicenseLenient instance Parsec SpecLicenseLenient where parsec = fmap SpecLicenseLenient $ Left <$> P.try parsec <|> Right <$> parsec instance Pretty SpecLicenseLenient where - pretty = either pretty pretty . unpack + pretty = either pretty pretty . getSpecLicenseLenient +------------------------------------------------------------------------------- +-- Basic fields +------------------------------------------------------------------------------- +-- | This type is used to mangle fields as +-- in serialised textual representation +-- to the actual 'InstalledPackageInfo' fields. data Basic = Basic - { _basicName :: MungedPackageName - , _basicVersion :: Version - , _basicPkgName :: Maybe PackageName - , _basicLibName :: Maybe UnqualComponentName + { _basicName :: MungedPackageName + , _basicVersion :: Version + , _basicPkgName :: Maybe PackageName + , _basicLibName :: LibraryName + , _basicLibVisibility :: LibraryVisibility } basic :: Lens' InstalledPackageInfo Basic @@ -230,12 +238,14 @@ (packageVersion ipi) (maybePackageName ipi) (sourceLibName ipi) + (libVisibility ipi) - g (Basic n v pn ln) = ipi + g (Basic n v pn ln lv) = ipi & setMungedPackageName n & L.sourcePackageId . L.pkgVersion .~ v & setMaybePackageName pn & L.sourceLibName .~ ln + & L.libVisibility .~ lv basicName :: Lens' Basic MungedPackageName basicName f b = (\x -> b { _basicName = x }) <$> f (_basicName b) @@ -250,14 +260,38 @@ {-# INLINE basicPkgName #-} basicLibName :: Lens' Basic (Maybe UnqualComponentName) -basicLibName f b = (\x -> b { _basicLibName = x }) <$> f (_basicLibName b) +basicLibName f b = (\x -> b { _basicLibName = maybeToLibraryName x }) <$> + f (libraryNameString (_basicLibName b)) {-# INLINE basicLibName #-} +basicLibVisibility :: Lens' Basic LibraryVisibility +basicLibVisibility f b = (\x -> b { _basicLibVisibility = x }) <$> + f (_basicLibVisibility b) +{-# INLINE basicLibVisibility #-} + basicFieldGrammar :: (FieldGrammar g, Applicative (g Basic)) => g Basic Basic -basicFieldGrammar = Basic +basicFieldGrammar = mkBasic <$> optionalFieldDefAla "name" MQuoted basicName (mungedPackageName emptyInstalledPackageInfo) <*> optionalFieldDefAla "version" MQuoted basicVersion nullVersion <*> optionalField "package-name" basicPkgName <*> optionalField "lib-name" basicLibName + <+> optionalFieldDef "visibility" basicLibVisibility LibraryVisibilityPrivate + where + mkBasic n v pn ln lv = Basic n v pn ln' lv' + where + ln' = maybe LMainLibName LSubLibName ln + -- Older GHCs (<8.8) always report installed libraries as private + -- because their ghc-pkg builds with an older Cabal. + -- So we always set LibraryVisibilityPublic for main (unnamed) libs. + -- This can be removed once we stop supporting GHC<8.8, at the + -- condition that we keep marking main libraries as public when + -- registering them. + lv' = if + let MungedPackageName _ mln = n in + -- We need to check both because on ghc<8.2 ln' will always + -- be LMainLibName + ln' == LMainLibName && mln == LMainLibName + then LibraryVisibilityPublic + else lv diff --git a/cabal/Cabal/Distribution/Types/InstalledPackageInfo/Lens.hs b/cabal/Cabal/Distribution/Types/InstalledPackageInfo/Lens.hs --- a/cabal/Cabal/Distribution/Types/InstalledPackageInfo/Lens.hs +++ b/cabal/Cabal/Distribution/Types/InstalledPackageInfo/Lens.hs @@ -12,7 +12,8 @@ import Distribution.ModuleName (ModuleName) import Distribution.Package (AbiHash, ComponentId, PackageIdentifier, UnitId) import Distribution.Types.InstalledPackageInfo (AbiDependency, ExposedModule, InstalledPackageInfo) -import Distribution.Types.UnqualComponentName (UnqualComponentName) +import Distribution.Types.LibraryName (LibraryName) +import Distribution.Types.LibraryVisibility (LibraryVisibility) import qualified Distribution.SPDX as SPDX import qualified Distribution.Types.InstalledPackageInfo as T @@ -33,7 +34,7 @@ instantiatedWith f s = fmap (\x -> s { T.instantiatedWith = x }) (f (T.instantiatedWith s)) {-# INLINE instantiatedWith #-} -sourceLibName :: Lens' InstalledPackageInfo (Maybe UnqualComponentName) +sourceLibName :: Lens' InstalledPackageInfo LibraryName sourceLibName f s = fmap (\x -> s { T.sourceLibName = x }) (f (T.sourceLibName s)) {-# INLINE sourceLibName #-} @@ -180,4 +181,8 @@ pkgRoot :: Lens' InstalledPackageInfo (Maybe FilePath) pkgRoot f s = fmap (\x -> s { T.pkgRoot = x }) (f (T.pkgRoot s)) {-# INLINE pkgRoot #-} + +libVisibility :: Lens' InstalledPackageInfo LibraryVisibility +libVisibility f s = fmap (\x -> s { T.libVisibility = x }) (f (T.libVisibility s)) +{-# INLINE libVisibility #-} diff --git a/cabal/Cabal/Distribution/Types/LegacyExeDependency.hs b/cabal/Cabal/Distribution/Types/LegacyExeDependency.hs --- a/cabal/Cabal/Distribution/Types/LegacyExeDependency.hs +++ b/cabal/Cabal/Distribution/Types/LegacyExeDependency.hs @@ -7,15 +7,11 @@ import Distribution.Compat.Prelude import Prelude () -import Distribution.Parsec.Class -import Distribution.ParseUtils (parseMaybeQuoted) +import Distribution.Parsec import Distribution.Pretty -import Distribution.Text import Distribution.Version (VersionRange, anyVersion) import qualified Distribution.Compat.CharParsing as P -import Distribution.Compat.ReadP ((<++)) -import qualified Distribution.Compat.ReadP as Parse import Text.PrettyPrint (text, (<+>)) -- | Describes a legacy `build-tools`-style dependency on an executable @@ -48,18 +44,3 @@ component = do cs <- P.munch1 (\c -> isAlphaNum c || c == '+' || c == '_') if all isDigit cs then fail "invalid component" else return cs - -instance Text LegacyExeDependency where - parse = do name <- parseMaybeQuoted parseBuildToolName - Parse.skipSpaces - ver <- parse <++ return anyVersion - Parse.skipSpaces - return $ LegacyExeDependency name ver - where - -- like parsePackageName but accepts symbols in components - parseBuildToolName :: Parse.ReadP r String - parseBuildToolName = do ns <- Parse.sepBy1 component (Parse.char '-') - return (intercalate "-" ns) - where component = do - cs <- Parse.munch1 (\c -> isAlphaNum c || c == '+' || c == '_') - if all isDigit cs then Parse.pfail else return cs diff --git a/cabal/Cabal/Distribution/Types/Library.hs b/cabal/Cabal/Distribution/Types/Library.hs --- a/cabal/Cabal/Distribution/Types/Library.hs +++ b/cabal/Cabal/Distribution/Types/Library.hs @@ -7,25 +7,26 @@ emptyLibrary, explicitLibModules, libModulesAutogen, - libModules, ) where -import Prelude () import Distribution.Compat.Prelude +import Prelude () +import Distribution.ModuleName import Distribution.Types.BuildInfo +import Distribution.Types.LibraryVisibility import Distribution.Types.ModuleReexport -import Distribution.Types.UnqualComponentName -import Distribution.ModuleName +import Distribution.Types.LibraryName import qualified Distribution.Types.BuildInfo.Lens as L data Library = Library - { libName :: Maybe UnqualComponentName + { libName :: LibraryName , exposedModules :: [ModuleName] , reexportedModules :: [ModuleReexport] - , signatures :: [ModuleName] -- ^ What sigs need implementations? - , libExposed :: Bool -- ^ Is the lib to be exposed by default? + , signatures :: [ModuleName] -- ^ What sigs need implementations? + , libExposed :: Bool -- ^ Is the lib to be exposed by default? (i.e. whether its modules available in GHCi for example) + , libVisibility :: LibraryVisibility -- ^ Whether this multilib can be dependent from outside. , libBuildInfo :: BuildInfo } deriving (Generic, Show, Eq, Read, Typeable, Data) @@ -37,31 +38,41 @@ instance NFData Library where rnf = genericRnf +emptyLibrary :: Library +emptyLibrary = Library + { libName = LMainLibName + , exposedModules = mempty + , reexportedModules = mempty + , signatures = mempty + , libExposed = True + , libVisibility = mempty + , libBuildInfo = mempty + } + +-- | This instance is not good. +-- +-- We need it for 'PackageDescription.Configuration.addBuildableCondition'. +-- More correct method would be some kind of "create empty clone". +-- +-- More concretely, 'addBuildableCondition' will make `libVisibility = False` +-- libraries when `buildable: false`. This may cause problems. +-- instance Monoid Library where - mempty = Library { - libName = mempty, - exposedModules = mempty, - reexportedModules = mempty, - signatures = mempty, - libExposed = True, - libBuildInfo = mempty - } - mappend = (<>) + mempty = emptyLibrary + mappend = (<>) instance Semigroup Library where - a <> b = Library { - libName = combine libName, - exposedModules = combine exposedModules, - reexportedModules = combine reexportedModules, - signatures = combine signatures, - libExposed = libExposed a && libExposed b, -- so False propagates - libBuildInfo = combine libBuildInfo - } + a <> b = Library + { libName = combineLibraryName (libName a) (libName b) + , exposedModules = combine exposedModules + , reexportedModules = combine reexportedModules + , signatures = combine signatures + , libExposed = libExposed a && libExposed b -- so False propagates + , libVisibility = combine libVisibility + , libBuildInfo = combine libBuildInfo + } where combine field = field a `mappend` field b -emptyLibrary :: Library -emptyLibrary = mempty - -- | Get all the module names from the library (exposed and internal modules) -- which are explicitly listed in the package description which would -- need to be compiled. (This does not include reexports, which @@ -77,12 +88,10 @@ libModulesAutogen :: Library -> [ModuleName] libModulesAutogen lib = autogenModules (libBuildInfo lib) --- | Backwards-compatibility shim for 'explicitLibModules'. In most cases, --- you actually want 'allLibModules', which returns all modules that will --- actually be compiled, as opposed to those which are explicitly listed --- in the package description ('explicitLibModules'); unfortunately, the --- type signature for 'allLibModules' is incompatible since we need a --- 'ComponentLocalBuildInfo'. -{-# DEPRECATED libModules "If you want all modules that are built with a library, use 'allLibModules'. Otherwise, use 'explicitLibModules' for ONLY the modules explicitly mentioned in the package description. This symbol will be removed in Cabal-3.0 (est. Mar 2019)." #-} -libModules :: Library -> [ModuleName] -libModules = explicitLibModules +-- | Combine 'LibraryName'. in parsing we prefer value coming +-- from munged @name@ field over the @lib-name@. +-- +-- /Should/ be irrelevant. +combineLibraryName :: LibraryName -> LibraryName -> LibraryName +combineLibraryName l@(LSubLibName _) _ = l +combineLibraryName _ l = l diff --git a/cabal/Cabal/Distribution/Types/Library/Lens.hs b/cabal/Cabal/Distribution/Types/Library/Lens.hs --- a/cabal/Cabal/Distribution/Types/Library/Lens.hs +++ b/cabal/Cabal/Distribution/Types/Library/Lens.hs @@ -3,19 +3,20 @@ module Distribution.Types.Library.Lens, ) where -import Prelude () -import Distribution.Compat.Prelude import Distribution.Compat.Lens +import Distribution.Compat.Prelude +import Prelude () -import Distribution.ModuleName (ModuleName) -import Distribution.Types.BuildInfo (BuildInfo) -import Distribution.Types.Library (Library) -import Distribution.Types.ModuleReexport (ModuleReexport) -import Distribution.Types.UnqualComponentName (UnqualComponentName) +import Distribution.ModuleName (ModuleName) +import Distribution.Types.BuildInfo (BuildInfo) +import Distribution.Types.Library (Library) +import Distribution.Types.LibraryName (LibraryName) +import Distribution.Types.LibraryVisibility (LibraryVisibility) +import Distribution.Types.ModuleReexport (ModuleReexport) import qualified Distribution.Types.Library as T -libName :: Lens' Library (Maybe UnqualComponentName) +libName :: Lens' Library LibraryName libName f s = fmap (\x -> s { T.libName = x }) (f (T.libName s)) {-# INLINE libName #-} @@ -34,6 +35,10 @@ libExposed :: Lens' Library Bool libExposed f s = fmap (\x -> s { T.libExposed = x }) (f (T.libExposed s)) {-# INLINE libExposed #-} + +libVisibility :: Lens' Library LibraryVisibility +libVisibility f s = fmap (\x -> s { T.libVisibility = x }) (f (T.libVisibility s)) +{-# INLINE libVisibility #-} libBuildInfo :: Lens' Library BuildInfo libBuildInfo f s = fmap (\x -> s { T.libBuildInfo = x }) (f (T.libBuildInfo s)) diff --git a/cabal/Cabal/Distribution/Types/LibraryName.hs b/cabal/Cabal/Distribution/Types/LibraryName.hs new file mode 100644 --- /dev/null +++ b/cabal/Cabal/Distribution/Types/LibraryName.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} + +module Distribution.Types.LibraryName ( + LibraryName(..), + defaultLibName, + maybeToLibraryName, + showLibraryName, + libraryNameStanza, + libraryNameString, + -- * Pretty & Parse + prettyLibraryNameComponent, + parsecLibraryNameComponent, + ) where + +import Prelude () +import Distribution.Compat.Prelude + +import Distribution.Types.UnqualComponentName +import Distribution.Pretty +import Distribution.Parsec + +import qualified Distribution.Compat.CharParsing as P +import qualified Text.PrettyPrint as Disp + +data LibraryName = LMainLibName + | LSubLibName UnqualComponentName + deriving (Eq, Generic, Ord, Read, Show, Typeable, Data) + +instance Binary LibraryName +instance NFData LibraryName where rnf = genericRnf + +-- | Pretty print 'LibraryName' in build-target-ish syntax. +-- +-- /Note:/ there are no 'Pretty' or 'Parsec' instances, +-- as there's other way to represent 'LibraryName', namely as bare +-- 'UnqualComponentName'. +prettyLibraryNameComponent :: LibraryName -> Disp.Doc +prettyLibraryNameComponent LMainLibName = Disp.text "lib" +prettyLibraryNameComponent (LSubLibName str) = Disp.text "lib:" <<>> pretty str + +parsecLibraryNameComponent :: CabalParsing m => m LibraryName +parsecLibraryNameComponent = do + _ <- P.string "lib" + parseComposite <|> parseSingle + where + parseSingle = return LMainLibName + parseComposite = do + _ <- P.char ':' + LSubLibName <$> parsec + +defaultLibName :: LibraryName +defaultLibName = LMainLibName + +showLibraryName :: LibraryName -> String +showLibraryName LMainLibName = "library" +showLibraryName (LSubLibName name) = "library '" ++ prettyShow name ++ "'" + +libraryNameStanza :: LibraryName -> String +libraryNameStanza LMainLibName = "library" +libraryNameStanza (LSubLibName name) = "library " ++ prettyShow name + +libraryNameString :: LibraryName -> Maybe UnqualComponentName +libraryNameString LMainLibName = Nothing +libraryNameString (LSubLibName n) = Just n + +-- | Convert the 'UnqualComponentName' of a library into a +-- 'LibraryName'. +maybeToLibraryName :: Maybe UnqualComponentName -> LibraryName +maybeToLibraryName Nothing = LMainLibName +maybeToLibraryName (Just n) = LSubLibName n + diff --git a/cabal/Cabal/Distribution/Types/LibraryVisibility.hs b/cabal/Cabal/Distribution/Types/LibraryVisibility.hs new file mode 100644 --- /dev/null +++ b/cabal/Cabal/Distribution/Types/LibraryVisibility.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} + +module Distribution.Types.LibraryVisibility( + LibraryVisibility(..), +) where + +import Distribution.Compat.Prelude +import Prelude () + +import Distribution.Parsec +import Distribution.Pretty + +import qualified Distribution.Compat.CharParsing as P +import qualified Text.PrettyPrint as Disp + +-- | Multi-lib visibility +-- +-- @since 3.0.0.0 +-- +data LibraryVisibility + -- | Can be depenendent from other packages + = LibraryVisibilityPublic + -- | Internal library, default + | LibraryVisibilityPrivate + deriving (Generic, Show, Read, Eq, Typeable, Data) + +instance Pretty LibraryVisibility where + pretty LibraryVisibilityPublic = Disp.text "public" + pretty LibraryVisibilityPrivate = Disp.text "private" + +instance Parsec LibraryVisibility where + parsec = do + name <- P.munch1 isAlpha + case name of + "public" -> return LibraryVisibilityPublic + "private" -> return LibraryVisibilityPrivate + _ -> fail $ "Unknown visibility: " ++ name + +instance Binary LibraryVisibility +instance NFData LibraryVisibility where rnf = genericRnf + +instance Semigroup LibraryVisibility where + LibraryVisibilityPrivate <> LibraryVisibilityPrivate = LibraryVisibilityPrivate + _ <> _ = LibraryVisibilityPublic + +instance Monoid LibraryVisibility where + mempty = LibraryVisibilityPrivate + mappend = (<>) diff --git a/cabal/Cabal/Distribution/Types/LocalBuildInfo.hs b/cabal/Cabal/Distribution/Types/LocalBuildInfo.hs --- a/cabal/Cabal/Distribution/Types/LocalBuildInfo.hs +++ b/cabal/Cabal/Distribution/Types/LocalBuildInfo.hs @@ -46,11 +46,6 @@ withAllTargetsInBuildOrder, neededTargetsInBuildOrder, withNeededTargetsInBuildOrder, - - -- * Backwards compatibility. - - componentsConfigs, - externalPackageDeps, ) where import Prelude () @@ -60,7 +55,6 @@ import Distribution.Types.ComponentLocalBuildInfo import Distribution.Types.ComponentRequestedSpec import Distribution.Types.ComponentId -import Distribution.Types.MungedPackageId import Distribution.Types.PackageId import Distribution.Types.UnitId import Distribution.Types.TargetInfo @@ -73,8 +67,8 @@ import Distribution.Simple.Compiler import Distribution.Simple.PackageIndex import Distribution.Simple.Setup -import Distribution.Text import Distribution.System +import Distribution.Pretty import Distribution.Compat.Graph (Graph) import qualified Distribution.Compat.Graph as Graph @@ -146,6 +140,7 @@ withSharedLib :: Bool, -- ^Whether to build shared versions of libs. withStaticLib :: Bool, -- ^Whether to build static versions of libs (with all other libs rolled in) withDynExe :: Bool, -- ^Whether to link executables dynamically + withFullyStaticExe :: Bool, -- ^Whether to link executables fully statically withProfExe :: Bool, -- ^Whether to build executables for profiling. withProfLibDetail :: ProfDetailLevel, -- ^Level of automatic profile detail. withProfExeDetail :: ProfDetailLevel, -- ^Level of automatic profile detail. @@ -176,10 +171,10 @@ -- on the package ID. localComponentId :: LocalBuildInfo -> ComponentId localComponentId lbi = - case componentNameCLBIs lbi CLibName of + case componentNameCLBIs lbi (CLibName LMainLibName) of [LibComponentLocalBuildInfo { componentComponentId = cid }] -> cid - _ -> mkComponentId (display (localPackage lbi)) + _ -> mkComponentId (prettyShow (localPackage lbi)) -- | Extract the 'PackageIdentifier' of a 'LocalBuildInfo'. -- This is a "safe" use of 'localPkgDescr' @@ -191,7 +186,7 @@ -- the package ID. localUnitId :: LocalBuildInfo -> UnitId localUnitId lbi = - case componentNameCLBIs lbi CLibName of + case componentNameCLBIs lbi (CLibName LMainLibName) of [LibComponentLocalBuildInfo { componentUnitId = uid }] -> uid _ -> mkLegacyUnitId $ localPackage lbi @@ -201,10 +196,10 @@ -- on the package ID. localCompatPackageKey :: LocalBuildInfo -> String localCompatPackageKey lbi = - case componentNameCLBIs lbi CLibName of + case componentNameCLBIs lbi (CLibName LMainLibName) of [LibComponentLocalBuildInfo { componentCompatPackageKey = pk }] -> pk - _ -> display (localPackage lbi) + _ -> prettyShow (localPackage lbi) -- | Convenience function to generate a default 'TargetInfo' from a -- 'ComponentLocalBuildInfo'. The idea is to call this once, and then @@ -267,7 +262,7 @@ neededTargetsInBuildOrder' :: PackageDescription -> LocalBuildInfo -> [UnitId] -> [TargetInfo] neededTargetsInBuildOrder' pkg_descr lbi uids = case Graph.closure (componentGraph lbi) uids of - Nothing -> error $ "localBuildPlan: missing uids " ++ intercalate ", " (map display uids) + Nothing -> error $ "localBuildPlan: missing uids " ++ intercalate ", " (map prettyShow uids) Just clos -> map (mkTargetInfo pkg_descr lbi) (Graph.revTopSort (Graph.fromDistinctList clos)) -- | Execute @f@ for every 'TargetInfo' needed to build @uid@s, respecting @@ -305,32 +300,3 @@ withNeededTargetsInBuildOrder :: LocalBuildInfo -> [UnitId] -> (TargetInfo -> IO ()) -> IO () withNeededTargetsInBuildOrder lbi = withNeededTargetsInBuildOrder' (localPkgDescr lbi) lbi - -------------------------------------------------------------------------------- --- Backwards compatibility - -{-# DEPRECATED componentsConfigs "Use 'componentGraph' instead; you can get a list of 'ComponentLocalBuildInfo' with 'Distribution.Compat.Graph.toList'. There's not a good way to get the list of 'ComponentName's the 'ComponentLocalBuildInfo' depends on because this query doesn't make sense; the graph is indexed by 'UnitId' not 'ComponentName'. Given a 'UnitId' you can lookup the 'ComponentLocalBuildInfo' ('getCLBI') and then get the 'ComponentName' ('componentLocalName]). To be removed in Cabal 3.0" #-} -componentsConfigs :: LocalBuildInfo -> [(ComponentName, ComponentLocalBuildInfo, [ComponentName])] -componentsConfigs lbi = - [ (componentLocalName clbi, - clbi, - mapMaybe (fmap componentLocalName . flip Graph.lookup g) - (componentInternalDeps clbi)) - | clbi <- Graph.toList g ] - where - g = componentGraph lbi - --- | External package dependencies for the package as a whole. This is the --- union of the individual 'componentPackageDeps', less any internal deps. -{-# DEPRECATED externalPackageDeps "You almost certainly don't want this function, which agglomerates the dependencies of ALL enabled components. If you're using this to write out information on your dependencies, read off the dependencies directly from the actual component in question. To be removed in Cabal 3.0" #-} -externalPackageDeps :: LocalBuildInfo -> [(UnitId, MungedPackageId)] -externalPackageDeps lbi = - -- TODO: what about non-buildable components? - nub [ (ipkgid, pkgid) - | clbi <- Graph.toList (componentGraph lbi) - , (ipkgid, pkgid) <- componentPackageDeps clbi - , not (internal ipkgid) ] - where - -- True if this dependency is an internal one (depends on the library - -- defined in the same package). - internal ipkgid = any ((==ipkgid) . componentUnitId) (Graph.toList (componentGraph lbi)) diff --git a/cabal/Cabal/Distribution/Types/Mixin.hs b/cabal/Cabal/Distribution/Types/Mixin.hs --- a/cabal/Cabal/Distribution/Types/Mixin.hs +++ b/cabal/Cabal/Distribution/Types/Mixin.hs @@ -10,14 +10,12 @@ import Text.PrettyPrint ((<+>)) -import Distribution.Parsec.Class +import Distribution.Parsec import Distribution.Pretty -import Distribution.Text import Distribution.Types.IncludeRenaming import Distribution.Types.PackageName import qualified Distribution.Compat.CharParsing as P -import qualified Distribution.Compat.ReadP as Parse data Mixin = Mixin { mixinPackageName :: PackageName , mixinIncludeRenaming :: IncludeRenaming } @@ -36,10 +34,3 @@ P.spaces incl <- parsec return (Mixin mod_name incl) - -instance Text Mixin where - parse = do - pkg_name <- parse - Parse.skipSpaces - incl <- parse - return (Mixin pkg_name incl) diff --git a/cabal/Cabal/Distribution/Types/Module.hs b/cabal/Cabal/Distribution/Types/Module.hs --- a/cabal/Cabal/Distribution/Types/Module.hs +++ b/cabal/Cabal/Distribution/Types/Module.hs @@ -9,12 +9,10 @@ import Prelude () import Distribution.Compat.Prelude -import qualified Distribution.Compat.ReadP as Parse import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp import Distribution.Pretty -import Distribution.Parsec.Class -import Distribution.Text +import Distribution.Parsec import Distribution.Types.UnitId import Distribution.ModuleName @@ -41,13 +39,6 @@ uid <- parsec _ <- P.char ':' mod_name <- parsec - return (Module uid mod_name) - -instance Text Module where - parse = do - uid <- parse - _ <- Parse.char ':' - mod_name <- parse return (Module uid mod_name) instance NFData Module where diff --git a/cabal/Cabal/Distribution/Types/ModuleReexport.hs b/cabal/Cabal/Distribution/Types/ModuleReexport.hs --- a/cabal/Cabal/Distribution/Types/ModuleReexport.hs +++ b/cabal/Cabal/Distribution/Types/ModuleReexport.hs @@ -9,13 +9,11 @@ import Prelude () import Distribution.ModuleName -import Distribution.Parsec.Class +import Distribution.Parsec import Distribution.Pretty -import Distribution.Text import Distribution.Types.PackageName import qualified Distribution.Compat.CharParsing as P -import qualified Distribution.Compat.ReadP as Parse import Text.PrettyPrint ((<+>)) import qualified Text.PrettyPrint as Disp @@ -51,17 +49,3 @@ P.spaces parsec return (ModuleReexport mpkgname origname newname) - -instance Text ModuleReexport where - parse = do - mpkgname <- Parse.option Nothing $ do - pkgname <- parse - _ <- Parse.char ':' - return (Just pkgname) - origname <- parse - newname <- Parse.option origname $ do - Parse.skipSpaces - _ <- Parse.string "as" - Parse.skipSpaces - parse - return (ModuleReexport mpkgname origname newname) diff --git a/cabal/Cabal/Distribution/Types/ModuleRenaming.hs b/cabal/Cabal/Distribution/Types/ModuleRenaming.hs --- a/cabal/Cabal/Distribution/Types/ModuleRenaming.hs +++ b/cabal/Cabal/Distribution/Types/ModuleRenaming.hs @@ -1,5 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE NoMonoLocalBinds #-} module Distribution.Types.ModuleRenaming ( ModuleRenaming(..), @@ -8,19 +10,17 @@ isDefaultRenaming, ) where +import Distribution.CabalSpecVersion import Distribution.Compat.Prelude hiding (empty) import Prelude () import Distribution.ModuleName -import Distribution.Parsec.Class +import Distribution.Parsec import Distribution.Pretty -import Distribution.Text import qualified Data.Map as Map import qualified Data.Set as Set import qualified Distribution.Compat.CharParsing as P -import Distribution.Compat.ReadP ((<++)) -import qualified Distribution.Compat.ReadP as Parse import Text.PrettyPrint (hsep, parens, punctuate, text, (<+>), comma) -- | Renaming applied to the modules provided by a package. @@ -67,6 +67,8 @@ isDefaultRenaming DefaultRenaming = True isDefaultRenaming _ = False + + instance Binary ModuleRenaming where instance NFData ModuleRenaming where rnf = genericRnf @@ -84,57 +86,49 @@ | otherwise = pretty orig <+> text "as" <+> pretty new instance Parsec ModuleRenaming where - -- NB: try not necessary as the first token is obvious - parsec = P.choice [ parseRename, parseHiding, return DefaultRenaming ] + parsec = do + csv <- askCabalSpecVersion + if csv >= CabalSpecV3_0 + then moduleRenamingParsec parensLax lexemeParsec + else moduleRenamingParsec parensStrict parsec where - parseRename = do - rns <- P.between (P.char '(') (P.char ')') parseList - P.spaces - return (ModuleRenaming rns) - parseHiding = do - _ <- P.string "hiding" - P.spaces - hides <- P.between (P.char '(') (P.char ')') - (P.sepBy parsec (P.char ',' >> P.spaces)) - return (HidingRenaming hides) - parseList = - P.sepBy parseEntry (P.char ',' >> P.spaces) - parseEntry = do - orig <- parsec - P.spaces - P.option (orig, orig) $ do - _ <- P.string "as" - P.spaces - new <- parsec - P.spaces - return (orig, new) - + -- For cabal spec versions < 3.0 white spaces were not skipped + -- after the '(' and ')' tokens in the mixin field. This + -- parser checks the cabal file version and does the correct + -- skipping of spaces. + parensLax p = P.between (P.char '(' >> P.spaces) (P.char ')' >> P.spaces) p + parensStrict p = P.between (P.char '(' >> warnSpaces) (P.char ')') p + warnSpaces = P.optional $ + P.space *> fail "space after parenthesis, use cabal-version: 3.0 or higher" -instance Text ModuleRenaming where - parse = fmap ModuleRenaming parseRns - <++ parseHidingRenaming - <++ return DefaultRenaming - where parseRns = do - rns <- Parse.between (Parse.char '(') (Parse.char ')') parseList - Parse.skipSpaces - return rns - parseHidingRenaming = do - _ <- Parse.string "hiding" - Parse.skipSpaces - hides <- Parse.between (Parse.char '(') (Parse.char ')') - (Parse.sepBy parse (Parse.char ',' >> Parse.skipSpaces)) - return (HidingRenaming hides) - parseList = - Parse.sepBy parseEntry (Parse.char ',' >> Parse.skipSpaces) - parseEntry :: Parse.ReadP r (ModuleName, ModuleName) - parseEntry = do - orig <- parse - Parse.skipSpaces - (do _ <- Parse.string "as" - Parse.skipSpaces - new <- parse - Parse.skipSpaces - return (orig, new) - <++ - return (orig, orig)) +moduleRenamingParsec + :: CabalParsing m + => (forall a. m a -> m a) -- ^ between parens + -> m ModuleName -- ^ module name parser + -> m ModuleRenaming +moduleRenamingParsec bp mn = + -- NB: try not necessary as the first token is obvious + P.choice [ parseRename, parseHiding, return DefaultRenaming ] + where + cma = P.char ',' >> P.spaces + parseRename = do + rns <- bp parseList + P.spaces + return (ModuleRenaming rns) + parseHiding = do + _ <- P.string "hiding" + P.spaces -- space isn't strictly required as next is an open paren + hides <- bp (P.sepBy mn cma) + return (HidingRenaming hides) + parseList = + P.sepBy parseEntry cma + parseEntry = do + orig <- parsec + P.spaces + P.option (orig, orig) $ do + _ <- P.string "as" + P.skipSpaces1 -- require space after "as" + new <- parsec + P.spaces + return (orig, new) diff --git a/cabal/Cabal/Distribution/Types/MungedPackageId.hs b/cabal/Cabal/Distribution/Types/MungedPackageId.hs --- a/cabal/Cabal/Distribution/Types/MungedPackageId.hs +++ b/cabal/Cabal/Distribution/Types/MungedPackageId.hs @@ -1,24 +1,21 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveGeneric #-} module Distribution.Types.MungedPackageId ( MungedPackageId(..) , computeCompatPackageId ) where -import Prelude () import Distribution.Compat.Prelude +import Prelude () -import Distribution.Version - ( Version, nullVersion ) +import Distribution.Parsec +import Distribution.Pretty +import Distribution.Types.LibraryName +import Distribution.Types.MungedPackageName +import Distribution.Types.PackageId +import Distribution.Version (Version, nullVersion) -import qualified Distribution.Compat.ReadP as Parse import qualified Text.PrettyPrint as Disp -import Distribution.Compat.ReadP -import Distribution.Text -import Distribution.Types.PackageId -import Distribution.Types.UnqualComponentName -import Distribution.Types.MungedPackageName -- | A simple pair of a 'MungedPackageName' and 'Version'. 'MungedPackageName' is to -- 'MungedPackageId' as 'PackageName' is to 'PackageId'. See 'MungedPackageName' for more @@ -35,21 +32,51 @@ instance Binary MungedPackageId -instance Text MungedPackageId where - disp (MungedPackageId n v) - | v == nullVersion = disp n -- if no version, don't show version. - | otherwise = disp n <<>> Disp.char '-' <<>> disp v +-- | +-- +-- >>> prettyShow $ MungedPackageId (MungedPackageName "servant" LMainLibName) (mkVersion [1,2,3]) +-- "servant-1.2.3" +-- +-- >>> prettyShow $ MungedPackageId (MungedPackageName "servant" (LSubLibName "lackey")) (mkVersion [0,1,2]) +-- "z-servant-z-lackey-0.1.2" +-- +instance Pretty MungedPackageId where + pretty (MungedPackageId n v) + | v == nullVersion = pretty n -- if no version, don't show version. + | otherwise = pretty n <<>> Disp.char '-' <<>> pretty v - parse = do - n <- parse - v <- (Parse.char '-' >> parse) <++ return nullVersion - return (MungedPackageId n v) +-- | +-- +-- >>> simpleParsec "foo-bar-0" :: Maybe MungedPackageId +-- Just (MungedPackageId {mungedName = MungedPackageName (PackageName "foo-bar") LMainLibName, mungedVersion = mkVersion [0]}) +-- +-- >>> simpleParsec "foo-bar" :: Maybe MungedPackageId +-- Just (MungedPackageId {mungedName = MungedPackageName (PackageName "foo-bar") LMainLibName, mungedVersion = mkVersion []}) +-- +-- >>> simpleParsec "z-foo-bar-z-baz-0" :: Maybe MungedPackageId +-- Just (MungedPackageId {mungedName = MungedPackageName (PackageName "foo-bar") (LSubLibName (UnqualComponentName "baz")), mungedVersion = mkVersion [0]}) +-- +-- >>> simpleParsec "foo-bar-0-0" :: Maybe MungedPackageId +-- Nothing +-- +-- >>> simpleParsec "foo-bar.0" :: Maybe MungedPackageId +-- Nothing +-- +-- >>> simpleParsec "foo-bar.4-2" :: Maybe MungedPackageId +-- Nothing +-- +instance Parsec MungedPackageId where + parsec = do + PackageIdentifier pn v <- parsec + return $ MungedPackageId (decodeCompatPackageName pn) v instance NFData MungedPackageId where rnf (MungedPackageId name version) = rnf name `seq` rnf version --- | See docs for 'Distribution.Types.MungedPackageName.computeCompatPackageId'. this --- is a thin wrapper around that. -computeCompatPackageId :: PackageId -> Maybe UnqualComponentName -> MungedPackageId -computeCompatPackageId (PackageIdentifier pn vr) mb_uqn = MungedPackageId pn' vr - where pn' = computeCompatPackageName pn mb_uqn +computeCompatPackageId :: PackageId -> LibraryName -> MungedPackageId +computeCompatPackageId (PackageIdentifier pn vr) ln = + MungedPackageId (MungedPackageName pn ln) vr + +-- $setup +-- >>> :seti -XOverloadedStrings +-- >>> import Distribution.Types.Version diff --git a/cabal/Cabal/Distribution/Types/MungedPackageName.hs b/cabal/Cabal/Distribution/Types/MungedPackageName.hs --- a/cabal/Cabal/Distribution/Types/MungedPackageName.hs +++ b/cabal/Cabal/Distribution/Types/MungedPackageName.hs @@ -1,24 +1,22 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} module Distribution.Types.MungedPackageName - ( MungedPackageName, unMungedPackageName, mkMungedPackageName - , computeCompatPackageName + ( MungedPackageName (..) , decodeCompatPackageName + , encodeCompatPackageName ) where import Distribution.Compat.Prelude -import Distribution.Utils.ShortText import Prelude () -import Distribution.Parsec.Class -import Distribution.ParseUtils +import Distribution.Parsec import Distribution.Pretty -import Distribution.Text +import Distribution.Types.LibraryName import Distribution.Types.PackageName import Distribution.Types.UnqualComponentName -import qualified Distribution.Compat.ReadP as Parse -import qualified Text.PrettyPrint as Disp +import qualified Distribution.Compat.CharParsing as P +import qualified Text.PrettyPrint as Disp -- | A combination of a package and component name used in various legacy -- interfaces, chiefly bundled with a version as 'MungedPackageId'. It's generally @@ -28,44 +26,15 @@ -- -- Use 'mkMungedPackageName' and 'unMungedPackageName' to convert from/to a 'String'. -- --- @since 2.0.0.2 -newtype MungedPackageName = MungedPackageName ShortText - deriving (Generic, Read, Show, Eq, Ord, Typeable, Data) - --- | Convert 'MungedPackageName' to 'String' -unMungedPackageName :: MungedPackageName -> String -unMungedPackageName (MungedPackageName s) = fromShortText s - --- | Construct a 'MungedPackageName' from a 'String' --- --- 'mkMungedPackageName' is the inverse to 'unMungedPackageName' --- --- Note: No validations are performed to ensure that the resulting --- 'MungedPackageName' is valid +-- In @3.0.0.0@ representation was changed from opaque (string) to semantic representation. -- -- @since 2.0.0.2 -mkMungedPackageName :: String -> MungedPackageName -mkMungedPackageName = MungedPackageName . toShortText - --- | 'mkMungedPackageName' -- --- @since 2.0.0.2 -instance IsString MungedPackageName where - fromString = mkMungedPackageName +data MungedPackageName = MungedPackageName !PackageName !LibraryName + deriving (Generic, Read, Show, Eq, Ord, Typeable, Data) instance Binary MungedPackageName - -instance Pretty MungedPackageName where - pretty = Disp.text . unMungedPackageName - -instance Parsec MungedPackageName where - parsec = mkMungedPackageName <$> parsecUnqualComponentName - -instance Text MungedPackageName where - parse = mkMungedPackageName <$> parsePackageName - -instance NFData MungedPackageName where - rnf (MungedPackageName pkg) = rnf pkg +instance NFData MungedPackageName where rnf = genericRnf -- | Computes the package name for a library. If this is the public -- library, it will just be the original package name; otherwise, @@ -96,24 +65,68 @@ -- When we have the public library, the compat-pkg-name is just the -- package-name, no surprises there! -- -computeCompatPackageName :: PackageName -> Maybe UnqualComponentName -> MungedPackageName --- First handle the cases where we can just use the original 'PackageName'. --- This is for the PRIMARY library, and it is non-Backpack, or the --- indefinite package for us. -computeCompatPackageName pkg_name Nothing - = mkMungedPackageName $ unPackageName pkg_name -computeCompatPackageName pkg_name (Just uqn) - = mkMungedPackageName $ - "z-" ++ zdashcode (unPackageName pkg_name) ++ - "-z-" ++ zdashcode (unUnqualComponentName uqn) +-- >>> prettyShow $ MungedPackageName "servant" LMainLibName +-- "servant" +-- +-- >>> prettyShow $ MungedPackageName "servant" (LSubLibName "lackey") +-- "z-servant-z-lackey" +-- +instance Pretty MungedPackageName where + -- First handle the cases where we can just use the original 'PackageName'. + -- This is for the PRIMARY library, and it is non-Backpack, or the + -- indefinite package for us. + pretty = Disp.text . encodeCompatPackageName' -decodeCompatPackageName :: MungedPackageName -> (PackageName, Maybe UnqualComponentName) -decodeCompatPackageName m = - case unMungedPackageName m of - 'z':'-':rest | [([pn, cn], "")] <- Parse.readP_to_S parseZDashCode rest - -> (mkPackageName pn, Just (mkUnqualComponentName cn)) - s -> (mkPackageName s, Nothing) +-- | +-- +-- >>> simpleParsec "servant" :: Maybe MungedPackageName +-- Just (MungedPackageName (PackageName "servant") LMainLibName) +-- +-- >>> simpleParsec "z-servant-z-lackey" :: Maybe MungedPackageName +-- Just (MungedPackageName (PackageName "servant") (LSubLibName (UnqualComponentName "lackey"))) +-- +-- >>> simpleParsec "z-servant-zz" :: Maybe MungedPackageName +-- Just (MungedPackageName (PackageName "z-servant-zz") LMainLibName) +-- +instance Parsec MungedPackageName where + parsec = decodeCompatPackageName' <$> parsecUnqualComponentName +------------------------------------------------------------------------------- +-- ZDashCode conversions +------------------------------------------------------------------------------- + +-- | Intended for internal use only +-- +-- >>> decodeCompatPackageName "z-servant-z-lackey" +-- MungedPackageName (PackageName "servant") (LSubLibName (UnqualComponentName "lackey")) +-- +decodeCompatPackageName :: PackageName -> MungedPackageName +decodeCompatPackageName = decodeCompatPackageName' . unPackageName + +-- | Intended for internal use only +-- +-- >>> encodeCompatPackageName $ MungedPackageName "servant" (LSubLibName "lackey") +-- PackageName "z-servant-z-lackey" +-- +-- This is used in @cabal-install@ in the Solver. +-- May become obsolete as solver moves to per-component solving. +-- +encodeCompatPackageName :: MungedPackageName -> PackageName +encodeCompatPackageName = mkPackageName . encodeCompatPackageName' + +decodeCompatPackageName' :: String -> MungedPackageName +decodeCompatPackageName' m = + case m of + 'z':'-':rest | Right [pn, cn] <- explicitEitherParsec parseZDashCode rest + -> MungedPackageName (mkPackageName pn) (LSubLibName (mkUnqualComponentName cn)) + s -> MungedPackageName (mkPackageName s) LMainLibName + +encodeCompatPackageName' :: MungedPackageName -> String +encodeCompatPackageName' (MungedPackageName pn LMainLibName) = unPackageName pn +encodeCompatPackageName' (MungedPackageName pn (LSubLibName uqn)) = + "z-" ++ zdashcode (unPackageName pn) ++ + "-z-" ++ zdashcode (unUnqualComponentName uqn) + zdashcode :: String -> String zdashcode s = go s (Nothing :: Maybe Int) [] where go [] _ r = reverse r @@ -122,10 +135,9 @@ go ('z':z) (Just n) r = go z (Just (n+1)) ('z':r) go (c:z) _ r = go z Nothing (c:r) -parseZDashCode :: Parse.ReadP r [String] +parseZDashCode :: CabalParsing m => m [String] parseZDashCode = do - ns <- Parse.sepBy1 (Parse.many1 (Parse.satisfy (/= '-'))) (Parse.char '-') - Parse.eof + ns <- P.sepBy1 (some (P.satisfy (/= '-'))) (P.char '-') return (go ns) where go ns = case break (=="z") ns of @@ -139,3 +151,6 @@ unZ r = r paste :: [String] -> String paste = intercalate "-" . map unZ + +-- $setup +-- >>> :seti -XOverloadedStrings diff --git a/cabal/Cabal/Distribution/Types/PackageDescription.hs b/cabal/Cabal/Distribution/Types/PackageDescription.hs --- a/cabal/Cabal/Distribution/Types/PackageDescription.hs +++ b/cabal/Cabal/Distribution/Types/PackageDescription.hs @@ -32,7 +32,6 @@ specVersion', license, license', - descCabalVersion, buildType, emptyPackageDescription, hasPublicLib, @@ -190,18 +189,6 @@ license' :: Either SPDX.License License -> SPDX.License license' = either id licenseToSPDX --- | The range of versions of the Cabal tools that this package is intended to --- work with. --- --- This function is deprecated and should not be used for new purposes, only to --- support old packages that rely on the old interpretation. --- -descCabalVersion :: PackageDescription -> VersionRange -descCabalVersion pkg = case specVersionRaw pkg of - Left version -> orLaterVersion version - Right versionRange -> versionRange -{-# DEPRECATED descCabalVersion "Use specVersion instead. This symbol will be removed in Cabal-3.0 (est. Mar 2019)." #-} - -- | The effective @build-type@ after applying defaulting rules. -- -- The original @build-type@ value parsed is stored in the @@ -449,9 +436,8 @@ enabledComponents pkg enabled = filter (componentEnabled enabled) $ pkgBuildableComponents pkg lookupComponent :: PackageDescription -> ComponentName -> Maybe Component -lookupComponent pkg CLibName = fmap CLib (library pkg) -lookupComponent pkg (CSubLibName name) = - fmap CLib $ find ((Just name ==) . libName) (subLibraries pkg) +lookupComponent pkg (CLibName name) = + fmap CLib $ find ((name ==) . libName) (allLibraries pkg) lookupComponent pkg (CFLibName name) = fmap CFLib $ find ((name ==) . foreignLibName) (foreignLibs pkg) lookupComponent pkg (CExeName name) = diff --git a/cabal/Cabal/Distribution/Types/PackageDescription/Lens.hs b/cabal/Cabal/Distribution/Types/PackageDescription/Lens.hs --- a/cabal/Cabal/Distribution/Types/PackageDescription/Lens.hs +++ b/cabal/Cabal/Distribution/Types/PackageDescription/Lens.hs @@ -29,7 +29,6 @@ import Distribution.Types.SourceRepo (SourceRepo) import Distribution.Types.TestSuite (TestSuite, testModules) import Distribution.Types.TestSuite.Lens (testName, testBuildInfo) -import Distribution.Types.UnqualComponentName ( UnqualComponentName ) import Distribution.Version (Version, VersionRange) import qualified Distribution.SPDX as SPDX @@ -155,74 +154,65 @@ extraDocFiles f s = fmap (\x -> s { T.extraDocFiles = x }) (f (T.extraDocFiles s)) {-# INLINE extraDocFiles #-} +-- | @since 3.0.0.0 +allLibraries :: Traversal' PackageDescription Library +allLibraries f pd = mk <$> traverse f (T.library pd) <*> traverse f (T.subLibraries pd) + where + mk l ls = pd { T.library = l, T.subLibraries = ls } + -- | @since 2.4 componentModules :: Monoid r => ComponentName -> Getting r PackageDescription [ModuleName] componentModules cname = case cname of - CLibName -> library . traverse . getting explicitLibModules - CSubLibName name -> - componentModules' name subLibraries (libName . non "") explicitLibModules + CLibName name -> + componentModules' name allLibraries libName explicitLibModules CFLibName name -> - componentModules' name foreignLibs foreignLibName foreignLibModules + componentModules' name (foreignLibs . traverse) foreignLibName foreignLibModules CExeName name -> - componentModules' name executables exeName exeModules + componentModules' name (executables . traverse) exeName exeModules CTestName name -> - componentModules' name testSuites testName testModules + componentModules' name (testSuites . traverse) testName testModules CBenchName name -> - componentModules' name benchmarks benchmarkName benchmarkModules + componentModules' name (benchmarks . traverse) benchmarkName benchmarkModules where componentModules' - :: Monoid r - => UnqualComponentName - -> Traversal' PackageDescription [a] - -> Traversal' a UnqualComponentName + :: (Eq name, Monoid r) + => name + -> Traversal' PackageDescription a + -> Lens' a name -> (a -> [ModuleName]) -> Getting r PackageDescription [ModuleName] componentModules' name pdL nameL modules = pdL - . traverse . filtered ((== name) . view nameL) . getting modules - -- This are easily wrongly used, so we have them here locally only. - non :: Eq a => a -> Lens' (Maybe a) a - non x afb s = f <$> afb (fromMaybe x s) - where f y = if x == y then Nothing else Just y - filtered :: (a -> Bool) -> Traversal' a a filtered p f s = if p s then f s else pure s -- | @since 2.4 componentBuildInfo :: ComponentName -> Traversal' PackageDescription BuildInfo componentBuildInfo cname = case cname of - CLibName -> - library . traverse . libBuildInfo - CSubLibName name -> - componentBuildInfo' name subLibraries (libName . non "") libBuildInfo + CLibName name -> + componentBuildInfo' name allLibraries libName libBuildInfo CFLibName name -> - componentBuildInfo' name foreignLibs foreignLibName foreignLibBuildInfo + componentBuildInfo' name (foreignLibs . traverse) foreignLibName foreignLibBuildInfo CExeName name -> - componentBuildInfo' name executables exeName exeBuildInfo + componentBuildInfo' name (executables . traverse) exeName exeBuildInfo CTestName name -> - componentBuildInfo' name testSuites testName testBuildInfo + componentBuildInfo' name (testSuites . traverse) testName testBuildInfo CBenchName name -> - componentBuildInfo' name benchmarks benchmarkName benchmarkBuildInfo + componentBuildInfo' name (benchmarks . traverse) benchmarkName benchmarkBuildInfo where - componentBuildInfo' :: UnqualComponentName - -> Traversal' PackageDescription [a] - -> Traversal' a UnqualComponentName - -> Traversal' a BuildInfo - -> Traversal' PackageDescription BuildInfo + componentBuildInfo' :: Eq name + => name + -> Traversal' PackageDescription a + -> Lens' a name + -> Traversal' a BuildInfo + -> Traversal' PackageDescription BuildInfo componentBuildInfo' name pdL nameL biL = pdL - . traverse . filtered ((== name) . view nameL) . biL - - -- This are easily wrongly used, so we have them here locally only. - -- We have to repeat these, as everything is exported from this module. - non :: Eq a => a -> Lens' (Maybe a) a - non x afb s = f <$> afb (fromMaybe x s) - where f y = if x == y then Nothing else Just y filtered :: (a -> Bool) -> Traversal' a a filtered p f s = if p s then f s else pure s diff --git a/cabal/Cabal/Distribution/Types/PackageId.hs b/cabal/Cabal/Distribution/Types/PackageId.hs --- a/cabal/Cabal/Distribution/Types/PackageId.hs +++ b/cabal/Cabal/Distribution/Types/PackageId.hs @@ -1,27 +1,21 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} module Distribution.Types.PackageId ( PackageIdentifier(..) , PackageId ) where -import Prelude () import Distribution.Compat.Prelude - -import Distribution.Version - ( Version, nullVersion ) +import Prelude () -import qualified Distribution.Compat.ReadP as Parse -import qualified Distribution.Compat.CharParsing as P -import qualified Text.PrettyPrint as Disp -import Distribution.Compat.ReadP -import Distribution.Text -import Distribution.Parsec.Class - ( Parsec(..) ) +import Distribution.Parsec (Parsec (..), simpleParsec) import Distribution.Pretty import Distribution.Types.PackageName +import Distribution.Version (Version, nullVersion) +import qualified Distribution.Compat.CharParsing as P +import qualified Text.PrettyPrint as Disp + -- | Type alias so we can use the shorter name PackageId. type PackageId = PackageIdentifier @@ -40,15 +34,39 @@ | v == nullVersion = pretty n -- if no version, don't show version. | otherwise = pretty n <<>> Disp.char '-' <<>> pretty v -instance Text PackageIdentifier where - parse = do - n <- parse - v <- (Parse.char '-' >> parse) <++ return nullVersion - return (PackageIdentifier n v) - +-- | +-- +-- >>> simpleParsec "foo-bar-0" :: Maybe PackageIdentifier +-- Just (PackageIdentifier {pkgName = PackageName "foo-bar", pkgVersion = mkVersion [0]}) +-- +-- >>> simpleParsec "foo-bar" :: Maybe PackageIdentifier +-- Just (PackageIdentifier {pkgName = PackageName "foo-bar", pkgVersion = mkVersion []}) +-- +-- /Note:/ Stricter than 'Text' instance +-- +-- >>> simpleParsec "foo-bar-0-0" :: Maybe PackageIdentifier +-- Nothing +-- +-- >>> simpleParsec "foo-bar.0" :: Maybe PackageIdentifier +-- Nothing +-- +-- >>> simpleParsec "foo-bar.4-2" :: Maybe PackageIdentifier +-- Nothing +-- +-- >>> simpleParsec "1.2.3" :: Maybe PackageIdentifier +-- Nothing +-- instance Parsec PackageIdentifier where - parsec = PackageIdentifier <$> - parsec <*> (P.char '-' *> parsec <|> pure nullVersion) + parsec = do + xs' <- P.sepBy1 component (P.char '-') + (v, xs) <- case simpleParsec (last xs') of + Nothing -> return (nullVersion, xs') -- all components are version + Just v -> return (v, init xs') + if not (null xs) && all (\c -> all (/= '.') c && not (all isDigit c)) xs + then return $ PackageIdentifier (mkPackageName (intercalate "-" xs)) v + else fail "all digits or a dot in a portion of package name" + where + component = P.munch1 (\c -> isAlphaNum c || c == '.') instance NFData PackageIdentifier where rnf (PackageIdentifier name version) = rnf name `seq` rnf version diff --git a/cabal/Cabal/Distribution/Types/PackageName.hs b/cabal/Cabal/Distribution/Types/PackageName.hs --- a/cabal/Cabal/Distribution/Types/PackageName.hs +++ b/cabal/Cabal/Distribution/Types/PackageName.hs @@ -10,10 +10,8 @@ import Distribution.Utils.ShortText import qualified Text.PrettyPrint as Disp -import Distribution.ParseUtils -import Distribution.Text import Distribution.Pretty -import Distribution.Parsec.Class +import Distribution.Parsec -- | A package name. -- @@ -54,9 +52,6 @@ instance Parsec PackageName where parsec = mkPackageName <$> parsecUnqualComponentName - -instance Text PackageName where - parse = mkPackageName <$> parsePackageName instance NFData PackageName where rnf (PackageName pkg) = rnf pkg diff --git a/cabal/Cabal/Distribution/Types/PackageName/Magic.hs b/cabal/Cabal/Distribution/Types/PackageName/Magic.hs new file mode 100644 --- /dev/null +++ b/cabal/Cabal/Distribution/Types/PackageName/Magic.hs @@ -0,0 +1,20 @@ +-- | Magic 'PackageName's. +-- +-- @since 3.0.0.0 +module Distribution.Types.PackageName.Magic where + +import Distribution.Types.PackageId +import Distribution.Types.PackageName +import Distribution.Types.Version + +-- | Used as a placeholder in "Distribution.Backpack.ReadyComponent" +nonExistentPackageThisIsCabalBug :: PackageName +nonExistentPackageThisIsCabalBug = mkPackageName "nonexistent-package-this-is-a-cabal-bug" + +-- | Used by @cabal new-repl@ and @cabal new-run@ +fakePackageName :: PackageName +fakePackageName = mkPackageName "fake-package" + +-- | 'fakePackageName' with 'version0'. +fakePackageId :: PackageId +fakePackageId = PackageIdentifier fakePackageName version0 diff --git a/cabal/Cabal/Distribution/Types/PackageVersionConstraint.hs b/cabal/Cabal/Distribution/Types/PackageVersionConstraint.hs new file mode 100644 --- /dev/null +++ b/cabal/Cabal/Distribution/Types/PackageVersionConstraint.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +module Distribution.Types.PackageVersionConstraint + ( PackageVersionConstraint(..) + ) where + +import Distribution.Compat.Prelude +import Prelude () + +import Distribution.Parsec +import Distribution.Pretty +import Distribution.Types.PackageName +import Distribution.Types.VersionRange + +import qualified Distribution.Compat.CharParsing as P +import Text.PrettyPrint ((<+>)) + +-- | A version constraint on a package. Different from 'ExeDependency' and +-- 'Dependency' since it does not specify the need for a component, not even +-- the main library. +-- There are a few places in the codebase where 'Dependency' is used where +-- 'PackageVersionConstraint' should be used instead (#5570). +data PackageVersionConstraint = PackageVersionConstraint PackageName VersionRange + deriving (Generic, Read, Show, Eq, Typeable, Data) + +instance Binary PackageVersionConstraint +instance NFData PackageVersionConstraint where rnf = genericRnf + +instance Pretty PackageVersionConstraint where + pretty (PackageVersionConstraint name ver) = pretty name <+> pretty ver + +instance Parsec PackageVersionConstraint where + parsec = do + name <- parsec + P.spaces + ver <- parsec <|> return anyVersion + P.spaces + return (PackageVersionConstraint name ver) + diff --git a/cabal/Cabal/Distribution/Types/PkgconfigDependency.hs b/cabal/Cabal/Distribution/Types/PkgconfigDependency.hs --- a/cabal/Cabal/Distribution/Types/PkgconfigDependency.hs +++ b/cabal/Cabal/Distribution/Types/PkgconfigDependency.hs @@ -7,17 +7,13 @@ import Distribution.Compat.Prelude import Prelude () -import Distribution.Version (VersionRange, anyVersion) - import Distribution.Types.PkgconfigName +import Distribution.Types.PkgconfigVersionRange -import Distribution.Parsec.Class +import Distribution.Parsec import Distribution.Pretty -import Distribution.Text import qualified Distribution.Compat.CharParsing as P -import Distribution.Compat.ReadP ((<++)) -import qualified Distribution.Compat.ReadP as Parse import Text.PrettyPrint ((<+>)) -- | Describes a dependency on a pkg-config library @@ -25,7 +21,7 @@ -- @since 2.0.0.2 data PkgconfigDependency = PkgconfigDependency PkgconfigName - VersionRange + PkgconfigVersionRange deriving (Generic, Read, Show, Eq, Typeable, Data) instance Binary PkgconfigDependency @@ -39,12 +35,5 @@ parsec = do name <- parsec P.spaces - verRange <- parsec <|> pure anyVersion + verRange <- parsec <|> pure anyPkgconfigVersion pure $ PkgconfigDependency name verRange - -instance Text PkgconfigDependency where - parse = do name <- parse - Parse.skipSpaces - ver <- parse <++ return anyVersion - Parse.skipSpaces - return $ PkgconfigDependency name ver diff --git a/cabal/Cabal/Distribution/Types/PkgconfigName.hs b/cabal/Cabal/Distribution/Types/PkgconfigName.hs --- a/cabal/Cabal/Distribution/Types/PkgconfigName.hs +++ b/cabal/Cabal/Distribution/Types/PkgconfigName.hs @@ -10,11 +10,9 @@ import Distribution.Utils.ShortText import Distribution.Pretty -import Distribution.Parsec.Class -import Distribution.Text +import Distribution.Parsec import qualified Distribution.Compat.CharParsing as P -import qualified Distribution.Compat.ReadP as Parse import qualified Text.PrettyPrint as Disp -- | A pkg-config library name @@ -58,10 +56,6 @@ instance Parsec PkgconfigName where parsec = mkPkgconfigName <$> P.munch1 (\c -> isAlphaNum c || c `elem` "+-._") - -instance Text PkgconfigName where - parse = mkPkgconfigName - <$> Parse.munch1 (\c -> isAlphaNum c || c `elem` "+-._") instance NFData PkgconfigName where rnf (PkgconfigName pkg) = rnf pkg diff --git a/cabal/Cabal/Distribution/Types/PkgconfigVersion.hs b/cabal/Cabal/Distribution/Types/PkgconfigVersion.hs new file mode 100644 --- /dev/null +++ b/cabal/Cabal/Distribution/Types/PkgconfigVersion.hs @@ -0,0 +1,105 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +-- @since 3.0 +module Distribution.Types.PkgconfigVersion ( + PkgconfigVersion (..), + rpmvercmp, + ) where + +import Distribution.Compat.Prelude +import Prelude () + +import Distribution.Parsec +import Distribution.Pretty +import Distribution.Utils.Generic (isAsciiAlphaNum) + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BS8 +import qualified Distribution.Compat.CharParsing as P +import qualified Text.PrettyPrint as PP + +-- | @pkg-config@ versions. +-- +-- In fact, this can be arbitrary 'BS.ByteString', +-- but 'Parsec' instance is a little pickier. +-- +-- @since 3.0 +newtype PkgconfigVersion = PkgconfigVersion BS.ByteString + deriving (Generic, Read, Show, Typeable, Data) + +instance Eq PkgconfigVersion where + PkgconfigVersion a == PkgconfigVersion b = rpmvercmp a b == EQ + +instance Ord PkgconfigVersion where + PkgconfigVersion a `compare` PkgconfigVersion b = rpmvercmp a b + +instance Binary PkgconfigVersion +instance NFData PkgconfigVersion where rnf = genericRnf + +instance Pretty PkgconfigVersion where + pretty (PkgconfigVersion bs) = PP.text (BS8.unpack bs) + +instance Parsec PkgconfigVersion where + parsec = PkgconfigVersion . BS8.pack <$> P.munch1 predicate where + predicate c = isAsciiAlphaNum c || c == '.' || c == '-' + +------------------------------------------------------------------------------- +-- rmpvercmp - pure Haskell implementation +------------------------------------------------------------------------------- + +-- | Compare two version strings as @pkg-config@ would compare them. +-- +-- @since 3.0 +rpmvercmp :: BS.ByteString -> BS.ByteString -> Ordering +rpmvercmp a b = go0 (BS.unpack a) (BS.unpack b) + where + go0 :: [Word8] -> [Word8] -> Ordering + go0 xs ys = go1 (dropNonAlnum8 xs) (dropNonAlnum8 ys) + + go1 :: [Word8] -> [Word8] -> Ordering + go1 [] [] = EQ + go1 [] _ = LT + go1 _ [] = GT + go1 xs@(x:_) ys + | isDigit8 x = + let (xs1, xs2) = span isDigit8 xs + (ys1, ys2) = span isDigit8 ys + -- numeric segments are always newer than alpha segments + in if null ys1 + then GT + else compareInt xs1 ys1 <> go0 xs2 ys2 + + -- isAlpha + | otherwise = + let (xs1, xs2) = span isAlpha8 xs + (ys1, ys2) = span isAlpha8 ys + in if null ys1 + then LT + else compareStr xs1 ys1 <> go0 xs2 ys2 + +-- compare as numbers +compareInt :: [Word8] -> [Word8] -> Ordering +compareInt xs ys = + -- whichever number has more digits wins + compare (length xs') (length ys') <> + -- equal length: use per character compare, "strcmp" + compare xs' ys' + where + -- drop leading zeros + xs' = dropWhile (== 0x30) xs + ys' = dropWhile (== 0x30) ys + +-- strcmp +compareStr :: [Word8] -> [Word8] -> Ordering +compareStr = compare + +dropNonAlnum8 :: [Word8] -> [Word8] +dropNonAlnum8 = dropWhile (\w -> not (isDigit8 w || isAlpha8 w)) + +isDigit8 :: Word8 -> Bool +isDigit8 w = 0x30 <= w && w <= 0x39 + +isAlpha8 :: Word8 -> Bool +isAlpha8 w = (0x41 <= w && w <= 0x5A) || (0x61 <= w && w <= 0x7A) + + diff --git a/cabal/Cabal/Distribution/Types/PkgconfigVersionRange.hs b/cabal/Cabal/Distribution/Types/PkgconfigVersionRange.hs new file mode 100644 --- /dev/null +++ b/cabal/Cabal/Distribution/Types/PkgconfigVersionRange.hs @@ -0,0 +1,142 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +module Distribution.Types.PkgconfigVersionRange ( + PkgconfigVersionRange (..), + anyPkgconfigVersion, + isAnyPkgconfigVersion, + withinPkgconfigVersionRange, + -- * Internal + versionToPkgconfigVersion, + versionRangeToPkgconfigVersionRange, + ) where + +import Distribution.Compat.Prelude +import Prelude () + +import Distribution.CabalSpecVersion +import Distribution.Parsec +import Distribution.Pretty +import Distribution.Types.PkgconfigVersion +import Distribution.Types.Version +import Distribution.Types.VersionRange + +import qualified Data.ByteString.Char8 as BS8 +import qualified Distribution.Compat.CharParsing as P +import qualified Text.PrettyPrint as PP + +-- | @since 3.0 +data PkgconfigVersionRange + = PcAnyVersion + | PcThisVersion PkgconfigVersion -- = version + | PcLaterVersion PkgconfigVersion -- > version (NB. not >=) + | PcEarlierVersion PkgconfigVersion -- < version + | PcOrLaterVersion PkgconfigVersion -- >= version + | PcOrEarlierVersion PkgconfigVersion -- =< version + | PcUnionVersionRanges PkgconfigVersionRange PkgconfigVersionRange + | PcIntersectVersionRanges PkgconfigVersionRange PkgconfigVersionRange + deriving (Generic, Read, Show, Eq, Typeable, Data) + +instance Binary PkgconfigVersionRange +instance NFData PkgconfigVersionRange where rnf = genericRnf + +instance Pretty PkgconfigVersionRange where + pretty = pp 0 where + pp :: Int -> PkgconfigVersionRange -> PP.Doc + pp _ PcAnyVersion = PP.text "-any" + pp _ (PcThisVersion v) = PP.text "==" <<>> pretty v + pp _ (PcLaterVersion v) = PP.text ">" <<>> pretty v + pp _ (PcEarlierVersion v) = PP.text "<" <<>> pretty v + pp _ (PcOrLaterVersion v) = PP.text ">=" <<>> pretty v + pp _ (PcOrEarlierVersion v) = PP.text "<=" <<>> pretty v + + pp d (PcUnionVersionRanges v u) = parens (d >= 1) $ + pp 1 v PP.<+> PP.text "||" PP.<+> pp 0 u + pp d (PcIntersectVersionRanges v u) = parens (d >= 2) $ + pp 2 v PP.<+> PP.text "&&" PP.<+> pp 1 u + + parens True = PP.parens + parens False = id + +instance Parsec PkgconfigVersionRange where + -- note: the wildcard is used in some places, e.g + -- http://hackage.haskell.org/package/bindings-libzip-0.10.1/bindings-libzip.cabal + -- + -- however, in the presense of alphanumerics etc. lax version parser, + -- wildcard is ill-specified + + parsec = do + csv <- askCabalSpecVersion + if csv >= CabalSpecV3_0 + then pkgconfigParser + else versionRangeToPkgconfigVersionRange <$> versionRangeParser P.integral + +-- "modern" parser of @pkg-config@ package versions. +pkgconfigParser :: CabalParsing m => m PkgconfigVersionRange +pkgconfigParser = P.spaces >> expr where + -- every parser here eats trailing space + expr = do + ts <- term `P.sepByNonEmpty` (P.string "||" >> P.spaces) + return $ foldr1 PcUnionVersionRanges ts + + term = do + fs <- factor `P.sepByNonEmpty` (P.string "&&" >> P.spaces) + return $ foldr1 PcIntersectVersionRanges fs + + factor = parens expr <|> prim + + prim = do + op <- P.munch1 (`elem` "<>=^-") P. "operator" + case op of + "-" -> anyPkgconfigVersion <$ (P.string "any" *> P.spaces) + + "==" -> afterOp PcThisVersion + ">" -> afterOp PcLaterVersion + "<" -> afterOp PcEarlierVersion + ">=" -> afterOp PcOrLaterVersion + "<=" -> afterOp PcOrEarlierVersion + + _ -> P.unexpected $ "Unknown version operator " ++ show op + + afterOp f = do + P.spaces + v <- parsec + P.spaces + return (f v) + + parens = P.between + ((P.char '(' P. "opening paren") >> P.spaces) + (P.char ')' >> P.spaces) + +anyPkgconfigVersion :: PkgconfigVersionRange +anyPkgconfigVersion = PcAnyVersion + +-- | TODO: this is not precise, but used only to prettify output. +isAnyPkgconfigVersion :: PkgconfigVersionRange -> Bool +isAnyPkgconfigVersion = (== PcAnyVersion) + +withinPkgconfigVersionRange :: PkgconfigVersion -> PkgconfigVersionRange -> Bool +withinPkgconfigVersionRange v = go where + go PcAnyVersion = True + go (PcThisVersion u) = v == u + go (PcLaterVersion u) = v > u + go (PcEarlierVersion u) = v < u + go (PcOrLaterVersion u) = v >= u + go (PcOrEarlierVersion u) = v <= u + go (PcUnionVersionRanges a b) = go a || go b + go (PcIntersectVersionRanges a b) = go a && go b + +------------------------------------------------------------------------------- +-- Conversion +------------------------------------------------------------------------------- + +versionToPkgconfigVersion :: Version -> PkgconfigVersion +versionToPkgconfigVersion = PkgconfigVersion . BS8.pack . prettyShow + +versionRangeToPkgconfigVersionRange :: VersionRange -> PkgconfigVersionRange +versionRangeToPkgconfigVersionRange = foldVersionRange + anyPkgconfigVersion + (PcThisVersion . versionToPkgconfigVersion) + (PcLaterVersion . versionToPkgconfigVersion) + (PcEarlierVersion . versionToPkgconfigVersion) + PcUnionVersionRanges + PcIntersectVersionRanges diff --git a/cabal/Cabal/Distribution/Types/SourceRepo.hs b/cabal/Cabal/Distribution/Types/SourceRepo.hs --- a/cabal/Cabal/Distribution/Types/SourceRepo.hs +++ b/cabal/Cabal/Distribution/Types/SourceRepo.hs @@ -17,11 +17,9 @@ import Distribution.Utils.Generic (lowercase) import Distribution.Pretty -import Distribution.Parsec.Class -import Distribution.Text +import Distribution.Parsec import qualified Distribution.Compat.CharParsing as P -import qualified Distribution.Compat.ReadP as Parse import qualified Text.PrettyPrint as Disp -- ------------------------------------------------------------ @@ -151,9 +149,6 @@ instance Parsec RepoKind where parsec = classifyRepoKind <$> P.munch1 isIdent -instance Text RepoKind where - parse = fmap classifyRepoKind ident - classifyRepoKind :: String -> RepoKind classifyRepoKind name = case lowercase name of "head" -> RepoHead @@ -167,19 +162,13 @@ instance Parsec RepoType where parsec = classifyRepoType <$> P.munch1 isIdent -instance Text RepoType where - parse = fmap classifyRepoType ident - classifyRepoType :: String -> RepoType classifyRepoType s = fromMaybe (OtherRepoType s) $ lookup (lowercase s) repoTypeMap where repoTypeMap = [ (name, repoType') | repoType' <- knownRepoTypes - , name <- display repoType' : repoTypeAliases repoType' ] - -ident :: Parse.ReadP r String -ident = Parse.munch1 isIdent + , name <- prettyShow repoType' : repoTypeAliases repoType' ] isIdent :: Char -> Bool isIdent c = isAlphaNum c || c == '_' || c == '-' diff --git a/cabal/Cabal/Distribution/Types/TestType.hs b/cabal/Cabal/Distribution/Types/TestType.hs --- a/cabal/Cabal/Distribution/Types/TestType.hs +++ b/cabal/Cabal/Distribution/Types/TestType.hs @@ -10,9 +10,8 @@ import Distribution.Version import Prelude () -import Distribution.Parsec.Class +import Distribution.Parsec import Distribution.Pretty -import Distribution.Text import Text.PrettyPrint (char, text) -- | The \"test-type\" field in the test suite stanza. @@ -40,9 +39,3 @@ "exitcode-stdio" -> TestTypeExe ver "detailed" -> TestTypeLib ver _ -> TestTypeUnknown name ver - -instance Text TestType where - parse = stdParse $ \ver name -> case name of - "exitcode-stdio" -> TestTypeExe ver - "detailed" -> TestTypeLib ver - _ -> TestTypeUnknown name ver diff --git a/cabal/Cabal/Distribution/Types/UnitId.hs b/cabal/Cabal/Distribution/Types/UnitId.hs --- a/cabal/Cabal/Distribution/Types/UnitId.hs +++ b/cabal/Cabal/Distribution/Types/UnitId.hs @@ -11,18 +11,15 @@ , newSimpleUnitId , mkLegacyUnitId , getHSLibraryName - , InstalledPackageId -- backwards compat ) where import Prelude () import Distribution.Compat.Prelude import Distribution.Utils.ShortText -import qualified Distribution.Compat.ReadP as Parse import qualified Distribution.Compat.CharParsing as P import Distribution.Pretty -import Distribution.Parsec.Class -import Distribution.Text +import Distribution.Parsec import Distribution.Types.ComponentId import Distribution.Types.PackageId @@ -68,9 +65,6 @@ newtype UnitId = UnitId ShortText deriving (Generic, Read, Show, Eq, Ord, Typeable, Data, NFData) -{-# DEPRECATED InstalledPackageId "Use UnitId instead. This symbol will be removed in Cabal-3.0 (est. Mar 2019)." #-} -type InstalledPackageId = UnitId - instance Binary UnitId -- | The textual format for 'UnitId' coincides with the format @@ -85,9 +79,6 @@ instance Parsec UnitId where parsec = mkUnitId <$> P.munch1 (\c -> isAlphaNum c || c `elem` "-_.+") -instance Text UnitId where - parse = mkUnitId <$> Parse.munch1 (\c -> isAlphaNum c || c `elem` "-_.+") - -- | If you need backwards compatibility, consider using 'display' -- instead, which is supported by all versions of Cabal. -- @@ -111,17 +102,17 @@ -- | Make an old-style UnitId from a package identifier. -- Assumed to be for the public library mkLegacyUnitId :: PackageId -> UnitId -mkLegacyUnitId = newSimpleUnitId . mkComponentId . display +mkLegacyUnitId = newSimpleUnitId . mkComponentId . prettyShow -- | Returns library name prefixed with HS, suitable for filenames getHSLibraryName :: UnitId -> String -getHSLibraryName uid = "HS" ++ display uid +getHSLibraryName uid = "HS" ++ prettyShow uid -- | A 'UnitId' for a definite package. The 'DefUnitId' invariant says -- that a 'UnitId' identified this way is definite; i.e., it has no -- unfilled holes. newtype DefUnitId = DefUnitId { unDefUnitId :: UnitId } - deriving (Generic, Read, Show, Eq, Ord, Typeable, Data, Binary, NFData, Pretty, Text) + deriving (Generic, Read, Show, Eq, Ord, Typeable, Data, Binary, NFData, Pretty) -- Workaround for a GHC 8.0.1 bug, see -- https://github.com/haskell/cabal/issues/4793#issuecomment-334258288 diff --git a/cabal/Cabal/Distribution/Types/UnqualComponentName.hs b/cabal/Cabal/Distribution/Types/UnqualComponentName.hs --- a/cabal/Cabal/Distribution/Types/UnqualComponentName.hs +++ b/cabal/Cabal/Distribution/Types/UnqualComponentName.hs @@ -10,10 +10,8 @@ import Distribution.Utils.ShortText import Prelude () -import Distribution.Parsec.Class -import Distribution.ParseUtils (parsePackageName) +import Distribution.Parsec import Distribution.Pretty -import Distribution.Text import Distribution.Types.PackageName -- | An unqualified component name, for any kind of component. @@ -58,9 +56,6 @@ instance Parsec UnqualComponentName where parsec = mkUnqualComponentName <$> parsecUnqualComponentName -instance Text UnqualComponentName where - parse = mkUnqualComponentName <$> parsePackageName - instance NFData UnqualComponentName where rnf (UnqualComponentName pkg) = rnf pkg @@ -71,6 +66,10 @@ -- -- Useful in legacy situations where a package name may refer to an internal -- component, if one is defined with that name. +-- +-- 2018-12-21: These "legacy" situations are not legacy. +-- We can @build-depends@ on the internal library. However +-- Now dependency contains @Set LibraryName@, and we should use that. -- -- @since 2.0.0.2 packageNameToUnqualComponentName :: PackageName -> UnqualComponentName diff --git a/cabal/Cabal/Distribution/Types/Version.hs b/cabal/Cabal/Distribution/Types/Version.hs --- a/cabal/Cabal/Distribution/Types/Version.hs +++ b/cabal/Cabal/Distribution/Types/Version.hs @@ -10,25 +10,20 @@ alterVersion, version0, - -- ** Backwards compatibility - showVersion, - -- * Internal validVersion, + versionDigitParser, ) where import Data.Bits (shiftL, shiftR, (.&.), (.|.)) import Distribution.Compat.Prelude import Prelude () -import Distribution.CabalSpecVersion -import Distribution.Parsec.Class +import Distribution.Parsec import Distribution.Pretty -import Distribution.Text import qualified Data.Version as Base import qualified Distribution.Compat.CharParsing as P -import qualified Distribution.Compat.ReadP as Parse import qualified Text.PrettyPrint as Disp import qualified Text.Read as Read @@ -97,40 +92,29 @@ (map Disp.int $ versionNumbers ver)) instance Parsec Version where - parsec = do - digit <- digitParser <$> askCabalSpecVersion - mkVersion <$> P.sepBy1 digit (P.char '.') <* tags + parsec = mkVersion <$> P.sepBy1 versionDigitParser (P.char '.') <* tags where - digitParser v - | v >= CabalSpecV2_0 = P.integral - | otherwise = (some d >>= toNumber) P. "non-leading-zero integral" - where - toNumber :: CabalParsing m => [Int] -> m Int - toNumber [0] = return 0 - toNumber xs@(0:_) = do - parsecWarning PWTVersionLeadingZeros "Version digit with leading zero. Use cabal-version: 2.0 or later to write such versions. For more information see https://github.com/haskell/cabal/issues/5092" - return $ foldl' (\a b -> a * 10 + b) 0 xs - toNumber xs = return $ foldl' (\a b -> a * 10 + b) 0 xs - - d :: P.CharParsing m => m Int - d = f <$> P.satisfyRange '0' '9' - f c = ord c - ord '0' - tags = do ts <- many $ P.char '-' *> some (P.satisfy isAlphaNum) case ts of [] -> pure () (_ : _) -> parsecWarning PWTVersionTag "version with tags" -instance Text Version where - parse = do - branch <- Parse.sepBy1 parseNat (Parse.char '.') - -- allow but ignore tags: - _tags <- Parse.many (Parse.char '-' >> Parse.munch1 isAlphaNum) - return (mkVersion branch) - where - parseNat = read `fmap` Parse.munch1 isDigit +-- | An integral without leading zeroes. +-- +-- @since 3.0 +versionDigitParser :: CabalParsing m => m Int +versionDigitParser = (some d >>= toNumber) P. "version digit (integral without leading zeroes)" + where + toNumber :: CabalParsing m => [Int] -> m Int + toNumber [0] = return 0 + toNumber (0:_) = P.unexpected "Version digit with leading zero" + toNumber xs = return $ foldl' (\a b -> a * 10 + b) 0 xs + d :: P.CharParsing m => m Int + d = f <$> P.satisfyRange '0' '9' + f c = ord c - ord '0' + -- | Construct 'Version' from list of version number components. -- -- For instance, @mkVersion [3,2,1]@ constructs a 'Version' @@ -249,7 +233,3 @@ -- internal helper validVersion :: Version -> Bool validVersion v = v /= nullVersion && all (>=0) (versionNumbers v) - -showVersion :: Version -> String -showVersion = prettyShow -{-# DEPRECATED showVersion "Use prettyShow. This function will be removed in Cabal-3.0 (estimated Mar 2019)" #-} diff --git a/cabal/Cabal/Distribution/Types/VersionInterval.hs b/cabal/Cabal/Distribution/Types/VersionInterval.hs --- a/cabal/Cabal/Distribution/Types/VersionInterval.hs +++ b/cabal/Cabal/Distribution/Types/VersionInterval.hs @@ -28,6 +28,9 @@ import Distribution.Types.Version import Distribution.Types.VersionRange +-- NonEmpty +import qualified Prelude (foldr1) + ------------------------------------------------------------------------------- -- VersionRange ------------------------------------------------------------------------------- @@ -214,7 +217,7 @@ fromVersionIntervals :: VersionIntervals -> VersionRange fromVersionIntervals (VersionIntervals []) = noVersion fromVersionIntervals (VersionIntervals intervals) = - foldr1 unionVersionRanges [ interval l u | (l, u) <- intervals ] + Prelude.foldr1 unionVersionRanges [ interval l u | (l, u) <- intervals ] where interval (LowerBound v InclusiveBound) diff --git a/cabal/Cabal/Distribution/Types/VersionRange.hs b/cabal/Cabal/Distribution/Types/VersionRange.hs --- a/cabal/Cabal/Distribution/Types/VersionRange.hs +++ b/cabal/Cabal/Distribution/Types/VersionRange.hs @@ -1,12 +1,6 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveFoldable #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE FlexibleContexts #-} module Distribution.Types.VersionRange ( -- * Version ranges - VersionRange(..), + VersionRange, -- ** Constructing anyVersion, noVersion, @@ -39,214 +33,14 @@ wildcardUpperBound, majorUpperBound, isWildcardRange, + versionRangeParser, ) where import Distribution.Compat.Prelude import Distribution.Types.Version +import Distribution.Types.VersionRange.Internal import Prelude () -import Distribution.CabalSpecVersion -import Distribution.Parsec.Class -import Distribution.Pretty -import Distribution.Text -import Text.PrettyPrint ((<+>)) - -import qualified Distribution.Compat.CharParsing as P -import qualified Distribution.Compat.DList as DList -import qualified Distribution.Compat.ReadP as Parse -import qualified Text.PrettyPrint as Disp - -data VersionRange - = AnyVersion - | ThisVersion Version -- = version - | LaterVersion Version -- > version (NB. not >=) - | OrLaterVersion Version -- >= version - | EarlierVersion Version -- < version - | OrEarlierVersion Version -- <= version - | WildcardVersion Version -- == ver.* (same as >= ver && < ver+1) - | MajorBoundVersion Version -- @^>= ver@ (same as >= ver && < MAJ(ver)+1) - | UnionVersionRanges VersionRange VersionRange - | IntersectVersionRanges VersionRange VersionRange - | VersionRangeParens VersionRange -- just '(exp)' parentheses syntax - deriving (Data, Eq, Generic, Read, Show, Typeable) - -instance Binary VersionRange - -instance NFData VersionRange where rnf = genericRnf - -{-# DeprecateD AnyVersion - "Use 'anyVersion', 'foldVersionRange' or 'asVersionIntervals'" #-} -{-# DEPRECATED ThisVersion - "Use 'thisVersion', 'foldVersionRange' or 'asVersionIntervals'" #-} -{-# DEPRECATED LaterVersion - "Use 'laterVersion', 'foldVersionRange' or 'asVersionIntervals'" #-} -{-# DEPRECATED EarlierVersion - "Use 'earlierVersion', 'foldVersionRange' or 'asVersionIntervals'" #-} -{-# DEPRECATED WildcardVersion - "Use 'anyVersion', 'foldVersionRange' or 'asVersionIntervals'" #-} -{-# DEPRECATED UnionVersionRanges - "Use 'unionVersionRanges', 'foldVersionRange' or 'asVersionIntervals'" #-} -{-# DEPRECATED IntersectVersionRanges - "Use 'intersectVersionRanges', 'foldVersionRange' or 'asVersionIntervals'"#-} - --- | The version range @-any@. That is, a version range containing all --- versions. --- --- > withinRange v anyVersion = True --- -anyVersion :: VersionRange -anyVersion = AnyVersion - --- | The empty version range, that is a version range containing no versions. --- --- This can be constructed using any unsatisfiable version range expression, --- for example @> 1 && < 1@. --- --- > withinRange v noVersion = False --- -noVersion :: VersionRange -noVersion = IntersectVersionRanges (LaterVersion v) (EarlierVersion v) - where v = mkVersion [1] - --- | The version range @== v@ --- --- > withinRange v' (thisVersion v) = v' == v --- -thisVersion :: Version -> VersionRange -thisVersion = ThisVersion - --- | The version range @< v || > v@ --- --- > withinRange v' (notThisVersion v) = v' /= v --- -notThisVersion :: Version -> VersionRange -notThisVersion v = UnionVersionRanges (EarlierVersion v) (LaterVersion v) - --- | The version range @> v@ --- --- > withinRange v' (laterVersion v) = v' > v --- -laterVersion :: Version -> VersionRange -laterVersion = LaterVersion - --- | The version range @>= v@ --- --- > withinRange v' (orLaterVersion v) = v' >= v --- -orLaterVersion :: Version -> VersionRange -orLaterVersion = OrLaterVersion - --- | The version range @< v@ --- --- > withinRange v' (earlierVersion v) = v' < v --- -earlierVersion :: Version -> VersionRange -earlierVersion = EarlierVersion - --- | The version range @<= v@ --- --- > withinRange v' (orEarlierVersion v) = v' <= v --- -orEarlierVersion :: Version -> VersionRange -orEarlierVersion = OrEarlierVersion - --- | The version range @vr1 || vr2@ --- --- > withinRange v' (unionVersionRanges vr1 vr2) --- > = withinRange v' vr1 || withinRange v' vr2 --- -unionVersionRanges :: VersionRange -> VersionRange -> VersionRange -unionVersionRanges = UnionVersionRanges - --- | The version range @vr1 && vr2@ --- --- > withinRange v' (intersectVersionRanges vr1 vr2) --- > = withinRange v' vr1 && withinRange v' vr2 --- -intersectVersionRanges :: VersionRange -> VersionRange -> VersionRange -intersectVersionRanges = IntersectVersionRanges - --- | The version range @== v.*@. --- --- For example, for version @1.2@, the version range @== 1.2.*@ is the same as --- @>= 1.2 && < 1.3@ --- --- > withinRange v' (laterVersion v) = v' >= v && v' < upper v --- > where --- > upper (Version lower t) = Version (init lower ++ [last lower + 1]) t --- -withinVersion :: Version -> VersionRange -withinVersion = WildcardVersion - --- | The version range @^>= v@. --- --- For example, for version @1.2.3.4@, the version range @^>= 1.2.3.4@ is the same as --- @>= 1.2.3.4 && < 1.3@. --- --- Note that @^>= 1@ is equivalent to @>= 1 && < 1.1@. --- --- @since 2.0.0.2 -majorBoundVersion :: Version -> VersionRange -majorBoundVersion = MajorBoundVersion - --- | F-Algebra of 'VersionRange'. See 'cataVersionRange'. --- --- @since 2.2 -data VersionRangeF a - = AnyVersionF - | ThisVersionF Version -- = version - | LaterVersionF Version -- > version (NB. not >=) - | OrLaterVersionF Version -- >= version - | EarlierVersionF Version -- < version - | OrEarlierVersionF Version -- <= version - | WildcardVersionF Version -- == ver.* (same as >= ver && < ver+1) - | MajorBoundVersionF Version -- @^>= ver@ (same as >= ver && < MAJ(ver)+1) - | UnionVersionRangesF a a - | IntersectVersionRangesF a a - | VersionRangeParensF a - deriving (Data, Eq, Generic, Read, Show, Typeable, Functor, Foldable, Traversable) - --- | @since 2.2 -projectVersionRange :: VersionRange -> VersionRangeF VersionRange -projectVersionRange AnyVersion = AnyVersionF -projectVersionRange (ThisVersion v) = ThisVersionF v -projectVersionRange (LaterVersion v) = LaterVersionF v -projectVersionRange (OrLaterVersion v) = OrLaterVersionF v -projectVersionRange (EarlierVersion v) = EarlierVersionF v -projectVersionRange (OrEarlierVersion v) = OrEarlierVersionF v -projectVersionRange (WildcardVersion v) = WildcardVersionF v -projectVersionRange (MajorBoundVersion v) = MajorBoundVersionF v -projectVersionRange (UnionVersionRanges a b) = UnionVersionRangesF a b -projectVersionRange (IntersectVersionRanges a b) = IntersectVersionRangesF a b -projectVersionRange (VersionRangeParens a) = VersionRangeParensF a - --- | Fold 'VersionRange'. --- --- @since 2.2 -cataVersionRange :: (VersionRangeF a -> a) -> VersionRange -> a -cataVersionRange f = c where c = f . fmap c . projectVersionRange - --- | @since 2.2 -embedVersionRange :: VersionRangeF VersionRange -> VersionRange -embedVersionRange AnyVersionF = AnyVersion -embedVersionRange (ThisVersionF v) = ThisVersion v -embedVersionRange (LaterVersionF v) = LaterVersion v -embedVersionRange (OrLaterVersionF v) = OrLaterVersion v -embedVersionRange (EarlierVersionF v) = EarlierVersion v -embedVersionRange (OrEarlierVersionF v) = OrEarlierVersion v -embedVersionRange (WildcardVersionF v) = WildcardVersion v -embedVersionRange (MajorBoundVersionF v) = MajorBoundVersion v -embedVersionRange (UnionVersionRangesF a b) = UnionVersionRanges a b -embedVersionRange (IntersectVersionRangesF a b) = IntersectVersionRanges a b -embedVersionRange (VersionRangeParensF a) = VersionRangeParens a - --- | Unfold 'VersionRange'. --- --- @since 2.2 -anaVersionRange :: (a -> VersionRangeF a) -> a -> VersionRange -anaVersionRange g = a where a = embedVersionRange . fmap a . g - - -- | Fold over the basic syntactic structure of a 'VersionRange'. -- -- This provides a syntactic view of the expression defining the version range. @@ -286,14 +80,6 @@ (orLaterVersion v) (earlierVersion (majorUpperBound v)) --- | Refold 'VersionRange' --- --- @since 2.2 -hyloVersionRange :: (VersionRangeF VersionRange -> VersionRange) - -> (VersionRange -> VersionRangeF VersionRange) - -> VersionRange -> VersionRange -hyloVersionRange f g = h where h = f . fmap h . g - -- | Normalise 'VersionRange'. -- -- In particular collapse @(== v || > v)@ into @>= v@, and so on. @@ -351,214 +137,6 @@ where check (n:[]) (m:[]) | n+1 == m = True check (n:ns) (m:ms) | n == m = check ns ms check _ _ = False - --- | Compute next greater major version to be used as upper bound --- --- Example: @0.4.1@ produces the version @0.5@ which then can be used --- to construct a range @>= 0.4.1 && < 0.5@ --- --- @since 2.2 -majorUpperBound :: Version -> Version -majorUpperBound = alterVersion $ \numbers -> case numbers of - [] -> [0,1] -- should not happen - [m1] -> [m1,1] -- e.g. version '1' - (m1:m2:_) -> [m1,m2+1] - -------------------------------------------------------------------------------- --- Parsec & Pretty -------------------------------------------------------------------------------- - -instance Pretty VersionRange where - pretty = fst . cataVersionRange alg - where - alg AnyVersionF = (Disp.text "-any", 0 :: Int) - alg (ThisVersionF v) = (Disp.text "==" <<>> pretty v, 0) - alg (LaterVersionF v) = (Disp.char '>' <<>> pretty v, 0) - alg (OrLaterVersionF v) = (Disp.text ">=" <<>> pretty v, 0) - alg (EarlierVersionF v) = (Disp.char '<' <<>> pretty v, 0) - alg (OrEarlierVersionF v) = (Disp.text "<=" <<>> pretty v, 0) - alg (WildcardVersionF v) = (Disp.text "==" <<>> dispWild v, 0) - alg (MajorBoundVersionF v) = (Disp.text "^>=" <<>> pretty v, 0) - alg (UnionVersionRangesF (r1, p1) (r2, p2)) = - (punct 1 p1 r1 <+> Disp.text "||" <+> punct 2 p2 r2 , 2) - alg (IntersectVersionRangesF (r1, p1) (r2, p2)) = - (punct 0 p1 r1 <+> Disp.text "&&" <+> punct 1 p2 r2 , 1) - alg (VersionRangeParensF (r, _)) = - (Disp.parens r, 0) - - dispWild ver = - Disp.hcat (Disp.punctuate (Disp.char '.') (map Disp.int $ versionNumbers ver)) - <<>> Disp.text ".*" - - punct p p' | p < p' = Disp.parens - | otherwise = id - -instance Parsec VersionRange where - parsec = expr - where - expr = do P.spaces - t <- term - P.spaces - (do _ <- P.string "||" - P.spaces - e <- expr - return (unionVersionRanges t e) - <|> - return t) - term = do f <- factor - P.spaces - (do _ <- P.string "&&" - P.spaces - t <- term - return (intersectVersionRanges f t) - <|> - return f) - factor = parens expr <|> prim - - prim = do - op <- P.munch1 (`elem` "<>=^-") P. "operator" - case op of - "-" -> anyVersion <$ P.string "any" <|> P.string "none" *> noVersion' - - "==" -> do - P.spaces - (wild, v) <- verOrWild - pure $ (if wild then withinVersion else thisVersion) v - - _ -> do - P.spaces - (wild, v) <- verOrWild - when wild $ P.unexpected $ - "wild-card version after non-== operator: " ++ show op - case op of - ">=" -> pure $ orLaterVersion v - "<" -> pure $ earlierVersion v - "^>=" -> majorBoundVersion' v - "<=" -> pure $ orEarlierVersion v - ">" -> pure $ laterVersion v - _ -> fail $ "Unknown version operator " ++ show op - - -- Note: There are other features: - -- && and || since 1.8 - -- x.y.* (wildcard) since 1.6 - - -- -none version range is available since 1.22 - noVersion' = do - csv <- askCabalSpecVersion - if csv >= CabalSpecV1_22 - then pure noVersion - else fail $ unwords - [ "-none version range used." - , "To use this syntax the package needs to specify at least 'cabal-version: 1.22'." - , "Alternatively, if broader compatibility is important then use" - , "<0 or other empty range." - ] - - -- ^>= is available since 2.0 - majorBoundVersion' v = do - csv <- askCabalSpecVersion - if csv >= CabalSpecV2_0 - then pure $ majorBoundVersion v - else fail $ unwords - [ "major bounded version syntax (caret, ^>=) used." - , "To use this syntax the package need to specify at least 'cabal-version: 2.0'." - , "Alternatively, if broader compatibility is important then use:" - , prettyShow $ eliminateMajorBoundSyntax $ majorBoundVersion v - ] - where - eliminateMajorBoundSyntax = hyloVersionRange embed projectVersionRange - embed (MajorBoundVersionF u) = intersectVersionRanges - (orLaterVersion u) (earlierVersion (majorUpperBound u)) - embed vr = embedVersionRange vr - - -- either wildcard or normal version - verOrWild :: CabalParsing m => m (Bool, Version) - verOrWild = do - x <- P.integral - verLoop (DList.singleton x) - - -- trailing: wildcard (.y.*) or normal version (optional tags) (.y.z-tag) - verLoop :: CabalParsing m => DList.DList Int -> m (Bool, Version) - verLoop acc = verLoop' acc <|> (tags *> pure (False, mkVersion (DList.toList acc))) - - verLoop' :: CabalParsing m => DList.DList Int -> m (Bool, Version) - verLoop' acc = do - _ <- P.char '.' - let digit = P.integral >>= verLoop . DList.snoc acc - let wild = (True, mkVersion (DList.toList acc)) <$ P.char '*' - digit <|> wild - - parens p = P.between - ((P.char '(' P. "opening paren") >> P.spaces) - (P.char ')' >> P.spaces) - (do a <- p - P.spaces - return (VersionRangeParens a)) - - tags :: CabalParsing m => m () - tags = do - ts <- many $ P.char '-' *> some (P.satisfy isAlphaNum) - case ts of - [] -> pure () - (_ : _) -> parsecWarning PWTVersionTag "version with tags" - - -instance Text VersionRange where - parse = expr - where - expr = do Parse.skipSpaces - t <- term - Parse.skipSpaces - (do _ <- Parse.string "||" - Parse.skipSpaces - e <- expr - return (UnionVersionRanges t e) - Parse.+++ - return t) - term = do f <- factor - Parse.skipSpaces - (do _ <- Parse.string "&&" - Parse.skipSpaces - t <- term - return (IntersectVersionRanges f t) - Parse.+++ - return f) - factor = Parse.choice $ parens expr - : parseAnyVersion - : parseNoVersion - : parseWildcardRange - : map parseRangeOp rangeOps - parseAnyVersion = Parse.string "-any" >> return AnyVersion - parseNoVersion = Parse.string "-none" >> return noVersion - - parseWildcardRange = do - _ <- Parse.string "==" - Parse.skipSpaces - branch <- Parse.sepBy1 digits (Parse.char '.') - _ <- Parse.char '.' - _ <- Parse.char '*' - return (WildcardVersion (mkVersion branch)) - - parens p = Parse.between (Parse.char '(' >> Parse.skipSpaces) - (Parse.char ')' >> Parse.skipSpaces) - (do a <- p - Parse.skipSpaces - return (VersionRangeParens a)) - - digits = do - firstDigit <- Parse.satisfy isDigit - if firstDigit == '0' - then return 0 - else do rest <- Parse.munch isDigit - return (read (firstDigit : rest)) -- TODO: eradicateNoParse - - parseRangeOp (s,f) = Parse.string s >> Parse.skipSpaces >> fmap f parse - rangeOps = [ ("<", EarlierVersion), - ("<=", orEarlierVersion), - (">", LaterVersion), - (">=", orLaterVersion), - ("^>=", MajorBoundVersion), - ("==", ThisVersion) ] -- | Does the version range have an upper bound? -- diff --git a/cabal/Cabal/Distribution/Types/VersionRange/Internal.hs b/cabal/Cabal/Distribution/Types/VersionRange/Internal.hs new file mode 100644 --- /dev/null +++ b/cabal/Cabal/Distribution/Types/VersionRange/Internal.hs @@ -0,0 +1,433 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | The only purpose of this module is to prevent the export of +-- 'VersionRange' constructors from +-- 'Distribution.Types.VersionRange'. To avoid creating orphan +-- instances, a lot of related code had to be moved here too. + +module Distribution.Types.VersionRange.Internal + ( VersionRange(..) + , anyVersion, noVersion + , thisVersion, notThisVersion + , laterVersion, earlierVersion + , orLaterVersion, orEarlierVersion + , unionVersionRanges, intersectVersionRanges + , withinVersion + , majorBoundVersion + + , VersionRangeF(..) + , projectVersionRange + , embedVersionRange + , cataVersionRange + , anaVersionRange + , hyloVersionRange + , versionRangeParser + + , majorUpperBound + ) where + +import Distribution.Compat.Prelude +import Distribution.Types.Version +import Prelude () + +import Distribution.CabalSpecVersion +import Distribution.Parsec +import Distribution.Pretty +import Text.PrettyPrint ((<+>)) + +import qualified Distribution.Compat.CharParsing as P +import qualified Distribution.Compat.DList as DList +import qualified Text.PrettyPrint as Disp + +data VersionRange + = AnyVersion + | ThisVersion Version -- = version + | LaterVersion Version -- > version (NB. not >=) + | OrLaterVersion Version -- >= version + | EarlierVersion Version -- < version + | OrEarlierVersion Version -- <= version + | WildcardVersion Version -- == ver.* (same as >= ver && < ver+1) + | MajorBoundVersion Version -- @^>= ver@ (same as >= ver && < MAJ(ver)+1) + | UnionVersionRanges VersionRange VersionRange + | IntersectVersionRanges VersionRange VersionRange + | VersionRangeParens VersionRange -- just '(exp)' parentheses syntax + deriving ( Data, Eq, Generic, Read, Show, Typeable ) + +instance Binary VersionRange + +instance NFData VersionRange where rnf = genericRnf + +-- | The version range @-any@. That is, a version range containing all +-- versions. +-- +-- > withinRange v anyVersion = True +-- +anyVersion :: VersionRange +anyVersion = AnyVersion + +-- | The empty version range, that is a version range containing no versions. +-- +-- This can be constructed using any unsatisfiable version range expression, +-- for example @> 1 && < 1@. +-- +-- > withinRange v noVersion = False +-- +noVersion :: VersionRange +noVersion = IntersectVersionRanges (LaterVersion v) (EarlierVersion v) + where v = mkVersion [1] + +-- | The version range @== v@ +-- +-- > withinRange v' (thisVersion v) = v' == v +-- +thisVersion :: Version -> VersionRange +thisVersion = ThisVersion + +-- | The version range @< v || > v@ +-- +-- > withinRange v' (notThisVersion v) = v' /= v +-- +notThisVersion :: Version -> VersionRange +notThisVersion v = UnionVersionRanges (EarlierVersion v) (LaterVersion v) + +-- | The version range @> v@ +-- +-- > withinRange v' (laterVersion v) = v' > v +-- +laterVersion :: Version -> VersionRange +laterVersion = LaterVersion + +-- | The version range @>= v@ +-- +-- > withinRange v' (orLaterVersion v) = v' >= v +-- +orLaterVersion :: Version -> VersionRange +orLaterVersion = OrLaterVersion + +-- | The version range @< v@ +-- +-- > withinRange v' (earlierVersion v) = v' < v +-- +earlierVersion :: Version -> VersionRange +earlierVersion = EarlierVersion + +-- | The version range @<= v@ +-- +-- > withinRange v' (orEarlierVersion v) = v' <= v +-- +orEarlierVersion :: Version -> VersionRange +orEarlierVersion = OrEarlierVersion + +-- | The version range @vr1 || vr2@ +-- +-- > withinRange v' (unionVersionRanges vr1 vr2) +-- > = withinRange v' vr1 || withinRange v' vr2 +-- +unionVersionRanges :: VersionRange -> VersionRange -> VersionRange +unionVersionRanges = UnionVersionRanges + +-- | The version range @vr1 && vr2@ +-- +-- > withinRange v' (intersectVersionRanges vr1 vr2) +-- > = withinRange v' vr1 && withinRange v' vr2 +-- +intersectVersionRanges :: VersionRange -> VersionRange -> VersionRange +intersectVersionRanges = IntersectVersionRanges + +-- | The version range @== v.*@. +-- +-- For example, for version @1.2@, the version range @== 1.2.*@ is the same as +-- @>= 1.2 && < 1.3@ +-- +-- > withinRange v' (laterVersion v) = v' >= v && v' < upper v +-- > where +-- > upper (Version lower t) = Version (init lower ++ [last lower + 1]) t +-- +withinVersion :: Version -> VersionRange +withinVersion = WildcardVersion + +-- | The version range @^>= v@. +-- +-- For example, for version @1.2.3.4@, the version range @^>= 1.2.3.4@ +-- is the same as @>= 1.2.3.4 && < 1.3@. +-- +-- Note that @^>= 1@ is equivalent to @>= 1 && < 1.1@. +-- +-- @since 2.0.0.2 +majorBoundVersion :: Version -> VersionRange +majorBoundVersion = MajorBoundVersion + + +-- | F-Algebra of 'VersionRange'. See 'cataVersionRange'. +-- +-- @since 2.2 +data VersionRangeF a + = AnyVersionF + | ThisVersionF Version -- = version + | LaterVersionF Version -- > version (NB. not >=) + | OrLaterVersionF Version -- >= version + | EarlierVersionF Version -- < version + | OrEarlierVersionF Version -- <= version + | WildcardVersionF Version -- == ver.* (same as >= ver && < ver+1) + | MajorBoundVersionF Version -- @^>= ver@ (same as >= ver && < MAJ(ver)+1) + | UnionVersionRangesF a a + | IntersectVersionRangesF a a + | VersionRangeParensF a + deriving ( Data, Eq, Generic, Read, Show, Typeable + , Functor, Foldable, Traversable ) + +-- | @since 2.2 +projectVersionRange :: VersionRange -> VersionRangeF VersionRange +projectVersionRange AnyVersion = AnyVersionF +projectVersionRange (ThisVersion v) = ThisVersionF v +projectVersionRange (LaterVersion v) = LaterVersionF v +projectVersionRange (OrLaterVersion v) = OrLaterVersionF v +projectVersionRange (EarlierVersion v) = EarlierVersionF v +projectVersionRange (OrEarlierVersion v) = OrEarlierVersionF v +projectVersionRange (WildcardVersion v) = WildcardVersionF v +projectVersionRange (MajorBoundVersion v) = MajorBoundVersionF v +projectVersionRange (UnionVersionRanges a b) = UnionVersionRangesF a b +projectVersionRange (IntersectVersionRanges a b) = IntersectVersionRangesF a b +projectVersionRange (VersionRangeParens a) = VersionRangeParensF a + +-- | Fold 'VersionRange'. +-- +-- @since 2.2 +cataVersionRange :: (VersionRangeF a -> a) -> VersionRange -> a +cataVersionRange f = c where c = f . fmap c . projectVersionRange + +-- | @since 2.2 +embedVersionRange :: VersionRangeF VersionRange -> VersionRange +embedVersionRange AnyVersionF = AnyVersion +embedVersionRange (ThisVersionF v) = ThisVersion v +embedVersionRange (LaterVersionF v) = LaterVersion v +embedVersionRange (OrLaterVersionF v) = OrLaterVersion v +embedVersionRange (EarlierVersionF v) = EarlierVersion v +embedVersionRange (OrEarlierVersionF v) = OrEarlierVersion v +embedVersionRange (WildcardVersionF v) = WildcardVersion v +embedVersionRange (MajorBoundVersionF v) = MajorBoundVersion v +embedVersionRange (UnionVersionRangesF a b) = UnionVersionRanges a b +embedVersionRange (IntersectVersionRangesF a b) = IntersectVersionRanges a b +embedVersionRange (VersionRangeParensF a) = VersionRangeParens a + +-- | Unfold 'VersionRange'. +-- +-- @since 2.2 +anaVersionRange :: (a -> VersionRangeF a) -> a -> VersionRange +anaVersionRange g = a where a = embedVersionRange . fmap a . g + +-- | Refold 'VersionRange' +-- +-- @since 2.2 +hyloVersionRange :: (VersionRangeF VersionRange -> VersionRange) + -> (VersionRange -> VersionRangeF VersionRange) + -> VersionRange -> VersionRange +hyloVersionRange f g = h where h = f . fmap h . g + +------------------------------------------------------------------------------- +-- Parsec & Pretty +------------------------------------------------------------------------------- + +instance Pretty VersionRange where + pretty = fst . cataVersionRange alg + where + alg AnyVersionF = (Disp.text "-any", 0 :: Int) + alg (ThisVersionF v) = (Disp.text "==" <<>> pretty v, 0) + alg (LaterVersionF v) = (Disp.char '>' <<>> pretty v, 0) + alg (OrLaterVersionF v) = (Disp.text ">=" <<>> pretty v, 0) + alg (EarlierVersionF v) = (Disp.char '<' <<>> pretty v, 0) + alg (OrEarlierVersionF v) = (Disp.text "<=" <<>> pretty v, 0) + alg (WildcardVersionF v) = (Disp.text "==" <<>> dispWild v, 0) + alg (MajorBoundVersionF v) = (Disp.text "^>=" <<>> pretty v, 0) + alg (UnionVersionRangesF (r1, p1) (r2, p2)) = + (punct 1 p1 r1 <+> Disp.text "||" <+> punct 2 p2 r2 , 2) + alg (IntersectVersionRangesF (r1, p1) (r2, p2)) = + (punct 0 p1 r1 <+> Disp.text "&&" <+> punct 1 p2 r2 , 1) + alg (VersionRangeParensF (r, _)) = + (Disp.parens r, 0) + + dispWild ver = + Disp.hcat (Disp.punctuate (Disp.char '.') + (map Disp.int $ versionNumbers ver)) + <<>> Disp.text ".*" + + punct p p' | p < p' = Disp.parens + | otherwise = id + +instance Parsec VersionRange where + parsec = versionRangeParser versionDigitParser + +-- | 'VersionRange' parser parametrised by version digit parser +-- +-- - 'versionDigitParser' is used for all 'VersionRange'. +-- - 'P.integral' is used for backward-compat @pkgconfig-depends@ +-- versions, 'PkgConfigVersionRange'. +-- +-- @since 3.0 +versionRangeParser :: forall m. CabalParsing m => m Int -> m VersionRange +versionRangeParser digitParser = expr + where + expr = do P.spaces + t <- term + P.spaces + (do _ <- P.string "||" + P.spaces + e <- expr + return (unionVersionRanges t e) + <|> + return t) + term = do f <- factor + P.spaces + (do _ <- P.string "&&" + P.spaces + t <- term + return (intersectVersionRanges f t) + <|> + return f) + factor = parens expr <|> prim + + prim = do + op <- P.munch1 (`elem` "<>=^-") P. "operator" + case op of + "-" -> anyVersion <$ P.string "any" <|> P.string "none" *> noVersion' + + "==" -> do + P.spaces + (do (wild, v) <- verOrWild + pure $ (if wild then withinVersion else thisVersion) v + <|> + (verSet' thisVersion =<< verSet)) + + "^>=" -> do + P.spaces + (do (wild, v) <- verOrWild + when wild $ P.unexpected $ + "wild-card version after ^>= operator" + majorBoundVersion' v + <|> + (verSet' majorBoundVersion =<< verSet)) + + _ -> do + P.spaces + (wild, v) <- verOrWild + when wild $ P.unexpected $ + "wild-card version after non-== operator: " ++ show op + case op of + ">=" -> pure $ orLaterVersion v + "<" -> pure $ earlierVersion v + "<=" -> pure $ orEarlierVersion v + ">" -> pure $ laterVersion v + _ -> fail $ "Unknown version operator " ++ show op + + -- Note: There are other features: + -- && and || since 1.8 + -- x.y.* (wildcard) since 1.6 + + -- -none version range is available since 1.22 + noVersion' = do + csv <- askCabalSpecVersion + if csv >= CabalSpecV1_22 + then pure noVersion + else fail $ unwords + [ "-none version range used." + , "To use this syntax the package needs to specify at least 'cabal-version: 1.22'." + , "Alternatively, if broader compatibility is important then use" + , "<0 or other empty range." + ] + + -- ^>= is available since 2.0 + majorBoundVersion' v = do + csv <- askCabalSpecVersion + if csv >= CabalSpecV2_0 + then pure $ majorBoundVersion v + else fail $ unwords + [ "major bounded version syntax (caret, ^>=) used." + , "To use this syntax the package need to specify at least 'cabal-version: 2.0'." + , "Alternatively, if broader compatibility is important then use:" + , prettyShow $ eliminateMajorBoundSyntax $ majorBoundVersion v + ] + where + eliminateMajorBoundSyntax = hyloVersionRange embed projectVersionRange + embed (MajorBoundVersionF u) = intersectVersionRanges + (orLaterVersion u) (earlierVersion (majorUpperBound u)) + embed vr = embedVersionRange vr + + -- version set notation (e.g. "== { 0.0.1.0, 0.0.2.0, 0.1.0.0 }") + verSet' op vs = do + csv <- askCabalSpecVersion + if csv >= CabalSpecV3_0 + then pure $ foldr1 unionVersionRanges (fmap op vs) + else fail $ unwords + [ "version set syntax used." + , "To use this syntax the package needs to specify at least 'cabal-version: 3.0'." + , "Alternatively, if broader compatibility is important then use" + , "a series of single version constraints joined with the || operator:" + , prettyShow (foldr1 unionVersionRanges (fmap op vs)) + ] + + verSet :: CabalParsing m => m (NonEmpty Version) + verSet = do + _ <- P.char '{' + P.spaces + vs <- P.sepByNonEmpty (verPlain <* P.spaces) (P.char ',' *> P.spaces) + _ <- P.char '}' + pure vs + + -- a plain version without tags or wildcards + verPlain :: CabalParsing m => m Version + verPlain = mkVersion <$> P.sepBy1 digitParser (P.char '.') + + -- either wildcard or normal version + verOrWild :: CabalParsing m => m (Bool, Version) + verOrWild = do + x <- digitParser + verLoop (DList.singleton x) + + -- trailing: wildcard (.y.*) or normal version (optional tags) (.y.z-tag) + verLoop :: CabalParsing m => DList.DList Int -> m (Bool, Version) + verLoop acc = verLoop' acc + <|> (tags *> pure (False, mkVersion (DList.toList acc))) + + verLoop' :: CabalParsing m => DList.DList Int -> m (Bool, Version) + verLoop' acc = do + _ <- P.char '.' + let digit = digitParser >>= verLoop . DList.snoc acc + let wild = (True, mkVersion (DList.toList acc)) <$ P.char '*' + digit <|> wild + + parens p = P.between + ((P.char '(' P. "opening paren") >> P.spaces) + (P.char ')' >> P.spaces) + (do a <- p + P.spaces + return (VersionRangeParens a)) + + tags :: CabalParsing m => m () + tags = do + ts <- many $ P.char '-' *> some (P.satisfy isAlphaNum) + case ts of + [] -> pure () + (_ : _) -> parsecWarning PWTVersionTag "version with tags" + + +---------------------------- +-- Wildcard range utilities +-- + +-- | Compute next greater major version to be used as upper bound +-- +-- Example: @0.4.1@ produces the version @0.5@ which then can be used +-- to construct a range @>= 0.4.1 && < 0.5@ +-- +-- @since 2.2 +majorUpperBound :: Version -> Version +majorUpperBound = alterVersion $ \numbers -> case numbers of + [] -> [0,1] -- should not happen + [m1] -> [m1,1] -- e.g. version '1' + (m1:m2:_) -> [m1,m2+1] diff --git a/cabal/Cabal/Distribution/Utils/NubList.hs b/cabal/Cabal/Distribution/Utils/NubList.hs --- a/cabal/Cabal/Distribution/Utils/NubList.hs +++ b/cabal/Cabal/Distribution/Utils/NubList.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} module Distribution.Utils.NubList ( NubList -- opaque , toNubList -- smart construtor @@ -21,7 +22,7 @@ -- | NubList : A de-duplicated list that maintains the original order. newtype NubList a = NubList { fromNubList :: [a] } - deriving (Eq, Typeable) + deriving (Eq, Generic, Typeable) -- NubList assumes that nub retains the list order while removing duplicate -- elements (keeping the first occurence). Documentation for "Data.List.nub" diff --git a/cabal/Cabal/Distribution/Verbosity.hs b/cabal/Cabal/Distribution/Verbosity.hs --- a/cabal/Cabal/Distribution/Verbosity.hs +++ b/cabal/Cabal/Distribution/Verbosity.hs @@ -53,27 +53,24 @@ import Distribution.Compat.Prelude import Distribution.ReadE -import Distribution.Compat.ReadP import Data.List (elemIndex) import Data.Set (Set) +import Distribution.Parsec +import Distribution.Verbosity.Internal + import qualified Data.Set as Set +import qualified Distribution.Compat.CharParsing as P 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 @@ -90,11 +87,6 @@ instance Binary Verbosity -data VerbosityLevel = Silent | Normal | Verbose | Deafening - deriving (Generic, Show, Read, Eq, Ord, Enum, Bounded) - -instance Binary VerbosityLevel - -- We shouldn't print /anything/ unless an error occurs in silent mode silent :: Verbosity silent = mkVerbosity Silent @@ -150,40 +142,57 @@ intToVerbosity 3 = Just (mkVerbosity Deafening) intToVerbosity _ = Nothing -parseVerbosity :: ReadP r (Either Int Verbosity) -parseVerbosity = parseIntVerbosity <++ parseStringVerbosity +-- | 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 - parseIntVerbosity = fmap Left (readS_to_P reads) + parseIntVerbosity = fmap Left P.integral parseStringVerbosity = fmap Right $ do level <- parseVerbosityLevel - _ <- skipSpaces - extras <- sepBy parseExtra skipSpaces + _ <- P.spaces + extras <- many (parseExtra <* P.spaces) return (foldr (.) id extras (mkVerbosity level)) - parseVerbosityLevel = choice - [ string "silent" >> return Silent - , string "normal" >> return Normal - , string "verbose" >> return Verbose - , string "debug" >> return Deafening - , string "deafening" >> return Deafening + parseVerbosityLevel = P.choice + [ P.string "silent" >> return Silent + , P.string "normal" >> return Normal + , P.string "verbose" >> return Verbose + , P.string "debug" >> return Deafening + , P.string "deafening" >> return Deafening ] - parseExtra = char '+' >> choice - [ string "callsite" >> return verboseCallSite - , string "callstack" >> return verboseCallStack - , string "nowrap" >> return verboseNoWrap - , string "markoutput" >> return verboseMarkOutput - , string "timestamp" >> return verboseTimestamp + parseExtra = P.char '+' >> P.choice + [ P.string "callsite" >> return verboseCallSite + , P.string "callstack" >> return verboseCallStack + , P.string "nowrap" >> return verboseNoWrap + , P.string "markoutput" >> return verboseMarkOutput + , P.string "timestamp" >> return verboseTimestamp ] flagToVerbosity :: ReadE Verbosity -flagToVerbosity = ReadE $ \s -> - case readP_to_S (parseVerbosity >>= \r -> eof >> return r) s of - [(Left i, "")] -> - case intToVerbosity i of - Just v -> Right v - Nothing -> Left ("Bad verbosity: " ++ show i ++ - ". Valid values are 0..3") - [(Right v, "")] -> Right v - _ -> Left ("Can't parse verbosity " ++ s) +flagToVerbosity = parsecToReadE id $ do + e <- parsecVerbosity + case e of + Right v -> return v + Left i -> case intToVerbosity i of + Just v -> return v + Nothing -> fail $ "Bad verbosity: " ++ show i ++ ". Valid values are 0..3" showForCabal, showForGHC :: Verbosity -> String @@ -207,16 +216,6 @@ showForGHC v = maybe (error "unknown verbosity") show $ elemIndex v [silent,normal,__,verbose,deafening] where __ = silent -- this will be always ignored by elemIndex - -data VerbosityFlag - = VCallStack - | VCallSite - | VNoWrap - | VMarkOutput - | VTimestamp - deriving (Generic, Show, Read, Eq, Ord, Enum, Bounded) - -instance Binary VerbosityFlag -- | Turn on verbose call-site printing when we log. verboseCallSite :: Verbosity -> Verbosity diff --git a/cabal/Cabal/Distribution/Verbosity/Internal.hs b/cabal/Cabal/Distribution/Verbosity/Internal.hs new file mode 100644 --- /dev/null +++ b/cabal/Cabal/Distribution/Verbosity/Internal.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE DeriveGeneric #-} +module Distribution.Verbosity.Internal + ( VerbosityLevel(..) + , VerbosityFlag(..) + ) where + +import Prelude () +import Distribution.Compat.Prelude + +data VerbosityLevel = Silent | Normal | Verbose | Deafening + deriving (Generic, Show, Read, Eq, Ord, Enum, Bounded) + +instance Binary VerbosityLevel + +data VerbosityFlag + = VCallStack + | VCallSite + | VNoWrap + | VMarkOutput + | VTimestamp + deriving (Generic, Show, Read, Eq, Ord, Enum, Bounded) + +instance Binary VerbosityFlag diff --git a/cabal/Cabal/Distribution/Version.hs b/cabal/Cabal/Distribution/Version.hs --- a/cabal/Cabal/Distribution/Version.hs +++ b/cabal/Cabal/Distribution/Version.hs @@ -22,11 +22,8 @@ nullVersion, alterVersion, - -- ** Backwards compatibility - showVersion, - -- * Version ranges - VersionRange(..), + VersionRange, -- ** Constructing anyVersion, noVersion, @@ -38,7 +35,6 @@ invertVersionRange, withinVersion, majorBoundVersion, - betweenVersionsInclusive, -- ** Inspection withinRange, @@ -47,7 +43,6 @@ isSpecificVersion, simplifyVersionRange, foldVersionRange, - foldVersionRange', normaliseVersionRange, stripParensVersionRange, hasUpperBound, @@ -117,8 +112,8 @@ where isVersion0 :: Version -> Bool isVersion0 = (== mkVersion [0]) - + -- | This is the converse of 'isAnyVersion'. It check if the version range is -- empty, if there is no possible version that satisfies the version range. -- @@ -198,65 +193,3 @@ -- @(>= 0 && < 3) || (>= 4 && < 5)@. removeLowerBound :: VersionRange -> VersionRange removeLowerBound = fromVersionIntervals . relaxHeadInterval . toVersionIntervals - -------------------------------------------------------------------------------- --- Deprecated -------------------------------------------------------------------------------- - --- In practice this is not very useful because we normally use inclusive lower --- bounds and exclusive upper bounds. --- --- > withinRange v' (laterVersion v) = v' > v --- -betweenVersionsInclusive :: Version -> Version -> VersionRange -betweenVersionsInclusive v1 v2 = - intersectVersionRanges (orLaterVersion v1) (orEarlierVersion v2) - -{-# DEPRECATED betweenVersionsInclusive - "In practice this is not very useful because we normally use inclusive lower bounds and exclusive upper bounds" #-} - - - - --- | An extended variant of 'foldVersionRange' that also provides a view of the --- expression in which the syntactic sugar @\">= v\"@, @\"<= v\"@ and @\"== --- v.*\"@ is presented explicitly rather than in terms of the other basic --- syntax. --- -foldVersionRange' :: a -- ^ @\"-any\"@ version - -> (Version -> a) -- ^ @\"== v\"@ - -> (Version -> a) -- ^ @\"> v\"@ - -> (Version -> a) -- ^ @\"< v\"@ - -> (Version -> a) -- ^ @\">= v\"@ - -> (Version -> a) -- ^ @\"<= v\"@ - -> (Version -> Version -> a) -- ^ @\"== v.*\"@ wildcard. The - -- function is passed the - -- inclusive lower bound and the - -- exclusive upper bounds of the - -- range defined by the wildcard. - -> (Version -> Version -> a) -- ^ @\"^>= v\"@ major upper bound - -- The function is passed the - -- inclusive lower bound and the - -- exclusive major upper bounds - -- of the range defined by this - -- operator. - -> (a -> a -> a) -- ^ @\"_ || _\"@ union - -> (a -> a -> a) -- ^ @\"_ && _\"@ intersection - -> (a -> a) -- ^ @\"(_)\"@ parentheses - -> VersionRange -> a -foldVersionRange' anyv this later earlier orLater orEarlier - wildcard major union intersect parens = - cataVersionRange alg . normaliseVersionRange - where - alg AnyVersionF = anyv - alg (ThisVersionF v) = this v - alg (LaterVersionF v) = later v - alg (EarlierVersionF v) = earlier v - alg (OrLaterVersionF v) = orLater v - alg (OrEarlierVersionF v) = orEarlier v - alg (WildcardVersionF v) = wildcard v (wildcardUpperBound v) - alg (MajorBoundVersionF v) = major v (majorUpperBound v) - alg (UnionVersionRangesF v1 v2) = union v1 v2 - alg (IntersectVersionRangesF v1 v2) = intersect v1 v2 - alg (VersionRangeParensF v) = parens v -{-# DEPRECATED foldVersionRange' "Use cataVersionRange & normaliseVersionRange for more principled folding" #-} diff --git a/cabal/Cabal/Language/Haskell/Extension.hs b/cabal/Cabal/Language/Haskell/Extension.hs --- a/cabal/Cabal/Language/Haskell/Extension.hs +++ b/cabal/Cabal/Language/Haskell/Extension.hs @@ -19,7 +19,6 @@ Extension(..), KnownExtension(..), - knownExtensions, deprecatedExtensions, classifyExtension, ) where @@ -29,12 +28,10 @@ import Data.Array (Array, accumArray, bounds, Ix(inRange), (!)) -import Distribution.Parsec.Class +import Distribution.Parsec import Distribution.Pretty -import Distribution.Text import qualified Distribution.Compat.CharParsing as P -import qualified Distribution.Compat.ReadP as Parse import qualified Text.PrettyPrint as Disp -- ------------------------------------------------------------ @@ -74,11 +71,6 @@ instance Parsec Language where parsec = classifyLanguage <$> P.munch1 isAlphaNum -instance Text Language where - parse = do - lang <- Parse.munch1 isAlphaNum - return (classifyLanguage lang) - classifyLanguage :: String -> Language classifyLanguage = \str -> case lookup str langTable of Just lang -> lang @@ -316,6 +308,9 @@ -- * | GeneralizedNewtypeDeriving + -- Synonym for GeneralizedNewtypeDeriving added in GHC 8.6.1. + | GeneralisedNewtypeDeriving + -- | Enable the \"Trex\" extensible records system. -- -- * @@ -803,6 +798,10 @@ -- /strategy/. | DerivingStrategies + -- | Enable deriving instances via types of the same runtime representation. + -- Implies 'DerivingStrategies'. + | DerivingVia + -- | Enable the use of unboxed sum syntax. | UnboxedSums @@ -821,17 +820,17 @@ -- | Have @*@ refer to @Type@. | StarIsType + -- | Liberalises deriving to provide instances for empty data types. + -- + -- * + | EmptyDataDeriving + deriving (Generic, Show, Read, Eq, Ord, Enum, Bounded, Typeable, Data) instance Binary KnownExtension instance NFData KnownExtension where rnf = genericRnf -{-# DEPRECATED knownExtensions - "KnownExtension is an instance of Enum and Bounded, use those instead. This symbol will be removed in Cabal-3.0 (est. Mar 2019)." #-} -knownExtensions :: [KnownExtension] -knownExtensions = [minBound..maxBound] - -- | Extensions that have been deprecated, possibly paired with another -- extension that replaces it. -- @@ -855,22 +854,8 @@ instance Parsec Extension where parsec = classifyExtension <$> P.munch1 isAlphaNum -instance Text Extension where - parse = do - extension <- Parse.munch1 isAlphaNum - return (classifyExtension extension) - instance Pretty KnownExtension where pretty ke = Disp.text (show ke) - -instance Text KnownExtension where - parse = do - extension <- Parse.munch1 isAlphaNum - case classifyKnownExtension extension of - Just ke -> - return ke - Nothing -> - fail ("Can't parse " ++ show extension ++ " as KnownExtension") classifyExtension :: String -> Extension classifyExtension string diff --git a/cabal/Cabal/Makefile b/cabal/Cabal/Makefile --- a/cabal/Cabal/Makefile +++ b/cabal/Cabal/Makefile @@ -1,5 +1,4 @@ - -VERSION=2.4.1.0 +VERSION=3.1.0.0 #KIND=devel KIND=rc @@ -25,14 +24,9 @@ SDIST_STAMP=dist/Cabal-$(VERSION).tar.gz DISTLOC=dist/release DIST_STAMP=$(DISTLOC)/Cabal-$(VERSION).tar.gz -SPHINXCMD:=$(shell command -v sphinx-build2 2> /dev/null) -ifndef SPHINXCMD - SPHINXCMD:=$(shell command -v sphinx-build 2> /dev/null) -endif -ifndef SPHINXCMD - $(error "needs sphinx-build") -endif +# TODO: when we have sphinx-build2 ? +SPHINXCMD:=sphinx-build COMMA=, @@ -59,12 +53,16 @@ SPHINX_HTML_OUTDIR=dist/doc/users-guide -users-guide: $(USERGUIDE_STAMP) +users-guide: .python-sphinx-virtualenv $(USERGUIDE_STAMP) $(USERGUIDE_STAMP) : doc/*.rst mkdir -p $(SPHINX_HTML_OUTDIR) - $(SPHINXCMD) doc $(SPHINX_HTML_OUTDIR) + (. ./.python-sphinx-virtualenv/bin/activate && $(SPHINXCMD) doc $(SPHINX_HTML_OUTDIR)) docs: haddock users-guide + +.python-sphinx-virtualenv: + virtualenv .python-sphinx-virtualenv + (. ./.python-sphinx-virtualenv/bin/activate && pip install sphinx && pip install sphinx_rtd_theme) clean: rm -rf dist/ diff --git a/cabal/Cabal/doc/cabaldomain.py b/cabal/Cabal/doc/cabaldomain.py --- a/cabal/Cabal/doc/cabaldomain.py +++ b/cabal/Cabal/doc/cabaldomain.py @@ -8,13 +8,16 @@ Most directives have at least following optional arguments -`:since: 1.23` +`:since: 1.24` version of Cabal in which feature was added. -`:deprecated: 1.23` +`:deprecated: 1.24` `:deprecated:` - Feature was deprecatead, and optionally since which version. + Feature was deprecated, and optionally since which version. +`:removed: 3.0` + Feature was removed + `:synopsis: Short desc` Text used as short description on reference page. @@ -164,12 +167,14 @@ def __init__(self, since=None, deprecated=None, + removed=None, synopsis=None, title=None, section=None, index=0): self.since = since self.deprecated = deprecated + self.removed = removed self.synopsis = synopsis self.title = title self.section = section @@ -213,6 +218,7 @@ option_spec = { 'name': lambda x: x, 'deprecated': parse_deprecated, + 'removed': StrictVersion, 'since' : StrictVersion, 'synopsis' : lambda x:x, } @@ -259,6 +265,7 @@ meta = Meta(since=self.options.get('since'), deprecated=self.options.get('deprecated'), + removed=self.options.get('removed'), synopsis=self.options.get('synopsis'), index = num, title = title) @@ -274,6 +281,7 @@ option_spec = { 'noindex' : directives.flag, 'deprecated': parse_deprecated, + 'removed' : StrictVersion, 'since' : StrictVersion, 'synopsis' : lambda x:x } @@ -299,6 +307,7 @@ title = find_section_title(self.state.parent) return Meta(since=self.options.get('since'), deprecated=self.options.get('deprecated'), + removed=self.options.get('removed'), title=title, index = num, synopsis=self.options.get('synopsis')) @@ -409,6 +418,18 @@ field += field_body field_list.insert(0, field) + if self.cabal_meta.removed is not None: + field = nodes.field('') + field_name = nodes.field_name('Removed', 'Removed') + if isinstance(self.cabal_meta.removed, StrictVersion): + since = 'Cabal ' + str(self.cabal_meta.removed) + else: + since = '' + + field_body = nodes.field_body(since, nodes.paragraph(since, since)) + field += field_name + field += field_body + field_list.insert(0, field) return result class CabalPackageSection(CabalObject): @@ -459,6 +480,7 @@ option_spec = { 'noindex' : directives.flag, 'deprecated': parse_deprecated, + 'removed' : StrictVersion, 'since' : StrictVersion, 'synopsis' : lambda x:x } @@ -702,6 +724,11 @@ else: return 'deprecated' +def render_removed(deprecated, removed): + if isinstance(deprecated, StrictVersion): + return 'removed in: ' + str(removed) + '; deprecated since: '+str(deprecated) + else: + return 'removed in: ' + str(removed) def render_meta(meta): ''' @@ -709,6 +736,8 @@ Will render either deprecated or since info ''' + if meta.removed is not None: + return render_removed(meta.deprecated, meta.removed) if meta.deprecated is not None: return render_deprecated(meta.deprecated) elif meta.since is not None: @@ -826,7 +855,7 @@ 'cfg-fields', 'cfg-flags']: for name, (fn, _, _) in self.data[k].items(): if fn == docname: - del self.data[k][comname] + del self.data[k][name] try: del self.data['index-num'][docname] except KeyError: diff --git a/cabal/Cabal/doc/conf.py b/cabal/Cabal/doc/conf.py --- a/cabal/Cabal/doc/conf.py +++ b/cabal/Cabal/doc/conf.py @@ -13,7 +13,7 @@ sys.path.insert(0, os.path.abspath('.')) import cabaldomain -version = "2.4.1.0" +version = "3.1.0.0" extensions = ['sphinx.ext.extlinks', 'sphinx.ext.todo'] @@ -60,7 +60,7 @@ # The name for this set of Sphinx documents. If None, it defaults to # " v documentation". -html_title = "Cabal User's Guide" +html_title = "Cabal {} User's Guide".format(release) html_short_title = "Cabal %s User's Guide" % release html_logo = 'images/Cabal-dark.png' html_static_path = ['images'] @@ -115,7 +115,8 @@ # The name of an image file (relative to this directory) to place at the top of # the title page. -latex_logo = 'images/logo.pdf' +#latex_logo = 'images/logo.pdf' +latex_logo = 'images/Cabal-dark.png' # If true, show page references after internal links. latex_show_pagerefs = True @@ -217,4 +218,3 @@ # # Default python allows recursion depth of 1000 calls. sys.setrecursionlimit(10000) - diff --git a/cabal/Cabal/doc/developing-packages.rst b/cabal/Cabal/doc/developing-packages.rst --- a/cabal/Cabal/doc/developing-packages.rst +++ b/cabal/Cabal/doc/developing-packages.rst @@ -185,6 +185,27 @@ the same thing as ``base >= 4 && < 5``. Please refer to the documentation on the :pkg-field:`build-depends` field for more information. +Also, you can factor out shared ``build-depends`` (and other fields such +as ``ghc-options``) into a ``common`` stanza which you can ``import`` in +your libraries and executable sections. For example: + +:: + + common shared-properties + default-language: Haskell2010 + build-depends: + base == 4.* + ghc-options: + -Wall + + library + import: shared-properties + exposed-modules: + Proglet + +Note that the ``import`` **must** be the first thing in the stanza. For more +information see the `Common stanzas`_ section. + Building the package -------------------- @@ -241,7 +262,7 @@ be created in one place and be moved to a different computer and be usable in that different environment. There are a surprising number of details that have to be got right for this to work, and a good package -system helps to simply this process and make it reliable. +system helps to simplify this process and make it reliable. Packages come in two main flavours: libraries of reusable code, and complete programs. Libraries present a code interface, an API, while @@ -572,7 +593,7 @@ author: Dean Herington license: BSD3 license-file: LICENSE - cabal-version: >= 1.10 + cabal-version: 1.12 build-type: Simple library @@ -656,6 +677,8 @@ (see the section on `system-dependent parameters`_). A few packages require `more elaborate solutions `_. +.. _pkg-desc: + Package descriptions -------------------- @@ -700,7 +723,7 @@ - Tabs are *not* allowed as indentation characters due to a missing standard interpretation of tab width. -- To get a blank line in a field value, use an indented "``.``" +- Before Cabal 3.0, to get a blank line in a field value, use an indented "``.``" The syntax of the value depends on the field. Field types include: @@ -794,28 +817,27 @@ package-version = 1*DIGIT *("." 1*DIGIT) -.. pkg-field:: cabal-version: >= x.y - - The version of the Cabal specification that this package description - uses. The Cabal specification does slowly evolve, introducing new - features and occasionally changing the meaning of existing features. - By specifying which version of the spec you are using it enables - programs which process the package description to know what syntax - to expect and what each part means. +.. pkg-field:: cabal-version: x.y[.z] - For historical reasons this is always expressed using *>=* version - range syntax. No other kinds of version range make sense, in - particular upper bounds do not make sense. In future this field will - specify just a version number, rather than a version range. + The version of the Cabal specification that this package + description uses. The Cabal specification does slowly evolve (see + also :ref:`spec-history`), introducing new features and + occasionally changing the meaning of existing features. By + specifying which version of the specification you are using it + enables programs which process the package description to know + what syntax to expect and what each part means. The version number you specify will affect both compatibility and - behaviour. Most tools (including the Cabal library and cabal + behaviour. Most tools (including the Cabal library and the ``cabal`` program) understand a range of versions of the Cabal specification. Older tools will of course only work with older versions of the - Cabal specification. Most of the time, tools that are too old will - recognise this fact and produce a suitable error message. + Cabal specification that was known at the time. Most of the time, + tools that are too old will recognise this fact and produce a + suitable error message. Likewise, ``cabal check`` will tell you + whether the version number is sufficiently high for the features + you use in the package description. - As for behaviour, new versions of the Cabal spec can change the + As for behaviour, new versions of the Cabal specification can change the meaning of existing syntax. This means if you want to take advantage of the new meaning or behaviour then you must specify the newer Cabal version. Tools are expected to use the meaning and behaviour @@ -829,6 +851,40 @@ old syntax. Please consult the user's guide of an older Cabal version for a description of that syntax. + Starting with ``cabal-version: 2.2`` this field is only valid if + fully contained in the very first line of a package description + and ought to adhere to the ABNF_ grammar + + .. code-block:: abnf + + newstyle-spec-version-decl = "cabal-version" *WS ":" *WS newstyle-spec-version *WS + + newstyle-spec-version = NUM "." NUM [ "." NUM ] + + NUM = DIGIT0 / DIGITP 1*DIGIT0 + DIGIT0 = %x30-39 + DIGITP = %x31-39 + WS = %20 + + + .. note:: + + For package descriptions using a format prior to + ``cabal-version: 1.12`` the legacy syntax resembling a version + range syntax + + .. code-block:: cabal + + cabal-version: >= 1.10 + + needs to be used. + + This legacy syntax is supported up until ``cabal-version: >= + 2.0`` it is however strongly recommended to avoid using the + legacy syntax. See also :issue:`4899`. + + + .. pkg-field:: build-type: identifier :default: ``Custom`` or ``Simple`` @@ -882,17 +938,86 @@ For most packages, the build type ``Simple`` is sufficient. -.. pkg-field:: license: identifier +.. pkg-field:: license: SPDX expression - :default: ``AllRightsReserved`` + :default: ``NONE`` - The type of license under which this package is distributed. License - names are the constants of the - `License <../release/cabal-latest/doc/API/Cabal/Distribution-License.html#t:License>`__ - type. + The type of license under which this package is distributed. + Starting with ``cabal-version: 2.2`` the ``license`` field takes a + (case-sensitive) SPDX expression such as + + .. code-block:: cabal + + license: Apache-2.0 AND (MIT OR GPL-2.0-or-later) + + See `SPDX IDs: How to use `__ for more + examples of SPDX expressions. + + The version of the + `list of SPDX license identifiers `__ + is a function of the :pkg-field:`cabal-version` value as defined + in the following table: + + +--------------------------+--------------------+ + | Cabal specification | SPDX license list | + | version | version | + | | | + +==========================+====================+ + | ``cabal-version: 2.2`` | ``3.0 2017-12-28`` | + +--------------------------+--------------------+ + | ``cabal-version: 2.4`` | ``3.2 2018-07-10`` | + +--------------------------+--------------------+ + + **Pre-SPDX Legacy Identifiers** + + The license identifier in the table below are defined for + ``cabal-version: 2.0`` and previous versions of the Cabal + specification. + + +--------------------------+-----------------+ + | :pkg-field:`license` | Note | + | identifier | | + | | | + +==========================+=================+ + | ``GPL`` | | + | ``GPL-2`` | | + | ``GPL-3`` | | + +--------------------------+-----------------+ + | ``LGPL`` | | + | ``LGPL-2.1`` | | + | ``LGPL-3`` | | + +--------------------------+-----------------+ + | ``AGPL`` | since 1.18 | + | ``AGPL-3`` | | + +--------------------------+-----------------+ + | ``BSD2`` | since 1.20 | + +--------------------------+-----------------+ + | ``BSD3`` | | + +--------------------------+-----------------+ + | ``MIT`` | | + +--------------------------+-----------------+ + | ``ISC`` | since 1.22 | + +--------------------------+-----------------+ + | ``MPL-2.0`` | since 1.20 | + +--------------------------+-----------------+ + | ``Apache`` | | + | ``Apache-2.0`` | | + +--------------------------+-----------------+ + | ``PublicDomain`` | | + +--------------------------+-----------------+ + | ``AllRightsReserved`` | | + +--------------------------+-----------------+ + | ``OtherLicense`` | | + +--------------------------+-----------------+ + + .. pkg-field:: license-file: filename + + See :pkg-field:`license-files`. + .. pkg-field:: license-files: filename list + :since: 1.20 The name of a file(s) containing the precise copyright license for this package. The license file(s) will be installed with the @@ -979,8 +1104,24 @@ .. pkg-field:: tested-with: compiler list A list of compilers and versions against which the package has been - tested (or at least built). + tested (or at least built). The value of this field is not used by Cabal + and is rather intended as extra metadata for use by third party + tooling, such as e.g. CI tooling. + Here's a typical usage example + + :: + + tested-with: GHC == 8.6.3, GHC == 8.4.4, GHC == 8.2.2, GHC == 8.0.2, + GHC == 7.10.3, GHC == 7.8.4, GHC == 7.6.3, GHC == 7.4.2 + + which can (starting with Cabal 3.0) also be written using the more + concise set notation syntax + + :: + + tested-with: GHC == { 8.6.3, 8.4.4, 8.2.2, 8.0.2, 7.10.3, 7.8.4, 7.6.3, 7.4.2 } + .. pkg-field:: data-files: filename list A list of files to be installed for run-time use by the package. @@ -1047,6 +1188,7 @@ a limited form of ``*`` wildcards in file names. .. pkg-field:: extra-doc-files: filename list + :since: 1.18 A list of additional files to be included in source distributions, and also copied to the html directory when Haddock documentation is @@ -1113,6 +1255,16 @@ that use a flat module namespace or where it is known that the exposed modules would clash with other common modules. +.. pkg-field:: visibility: visibilty specifiers + + :since 3.0 + + :default: ``private`` for internal libraries. Cannot be set for public library. + + Cabal recognizes ``public`` and ``private`` here... + + Multiple public libraries... + .. pkg-field:: reexported-modules: exportlist :since: 1.22 @@ -1137,8 +1289,7 @@ Supported only in GHC 8.2 and later. A list of `module signatures `__ required by this package. - Module signatures are part of the - `Backpack `__ extension to + Module signatures are part of the Backpack_ extension to the Haskell module system. Packages that do not export any modules and only export required signatures @@ -1146,8 +1297,8 @@ `signature thinning `__. - + The library section may also contain build information fields (see the section on `build information`_). @@ -1324,7 +1475,7 @@ that. It will print a list of packages for which there is a new version on Hackage that is outside the version bound specified in the ``build-depends`` field. The ``outdated`` command can also be -configured to act on the freeze file (both old- and new-style) and +configured to act on the freeze file (both old- and v2-style) and ignore major (or all) version bumps on Hackage for a subset of dependencies. @@ -1334,15 +1485,17 @@ Read dependency version bounds from the freeze file (``cabal.config``) instead of the package description file (``$PACKAGENAME.cabal``). ``--v1-freeze-file`` is an alias for this flag starting in Cabal 2.4. -``--new-freeze-file`` - Read dependency version bounds from the new-style freeze file +``--v2-freeze-file`` + :since: 2.4 + + Read dependency version bounds from the v2-style freeze file (by default, ``cabal.project.freeze``) instead of the package - description file. ``--v2-freeze-file`` is an alias for this flag - starting in Cabal 2.4. + description file. ``--new-freeze-file`` is an alias for this flag + that can be used with pre-2.4 ``cabal``. ``--project-file`` *PROJECTFILE* :since: 2.4 - Read dependendency version bounds from the new-style freeze file + Read dependendency version bounds from the v2-style freeze file related to the named project file (i.e., ``$PROJECTFILE.freeze``) instead of the package desctription file. If multiple ``--project-file`` flags are provided, only the final one is considered. This flag @@ -1426,6 +1579,9 @@ :pkg-field:`hs-source-dirs`. Further, while the name of the file may vary, the module itself must be named ``Main``. + Starting with ``cabal-version: 1.18`` this field supports + specifying a C, C++, or objC source file as the main entry point. + .. pkg-field:: scope: token :since: 2.0 @@ -1996,6 +2152,25 @@ renaming in ``build-depends``; however, this support has since been removed and should not be used. + Starting with Cabal 3.0, a set notation for the ``==`` and ``^>=`` operator + is available. For instance, + + :: + + tested-with: GHC == 8.6.3, GHC == 8.4.4, GHC == 8.2.2, GHC == 8.0.2, + GHC == 7.10.3, GHC == 7.8.4, GHC == 7.6.3, GHC == 7.4.2 + + build-depends: network ^>= 2.6.3.6 || ^>= 2.7.0.2 || ^>= 2.8.0.0 || ^>= 3.0.1.0 + + can be then written in a more convenient and concise form + + :: + + tested-with: GHC == { 8.6.3, 8.4.4, 8.2.2, 8.0.2, 7.10.3, 7.8.4, 7.6.3, 7.4.2 } + + build-depends: network ^>= { 2.6.3.6, 2.7.0.2, 2.8.0.0, 3.0.1.0 } + + .. pkg-field:: other-modules: identifier list A list of modules used by the component but not exposed to users. @@ -2056,31 +2231,66 @@ :pkg-field:`other-extensions` declarations. .. pkg-field:: extensions: identifier list - :deprecated: + :deprecated: 1.12 + :removed: 3.0 Deprecated in favor of :pkg-field:`default-extensions`. .. pkg-field:: build-tool-depends: package:executable list :since: 2.0 - A list of Haskell programs needed to build this component. - Each is specified by the package containing the executable and the name of the executable itself, separated by a colon, and optionally followed by a version bound. - It is fine for the package to be the current one, in which case this is termed an *internal*, rather than *external* executable dependency. + A list of Haskell executables needed to build this component. Executables are provided + during the whole duration of the component, so this field can be used for executables + needed during :pkg-section:`test-suite` as well. - External dependencies can (and should) contain a version bound like conventional :pkg-field:`build-depends` dependencies. - Internal deps should not contain a version bound, as they will be always resolved within the same configuration of the package in the build plan. - Specifically, version bounds that include the package's version will be warned for being extraneous, and version bounds that exclude the package's version will raise an error for being impossible to follow. + Each is specified by the package containing the executable and the name of the + executable itself, separated by a colon, and optionally followed by a version bound. - Cabal can make sure that specified programs are built and on the ``PATH`` before building the component in question. - It will always do so for internal dependencies, and also do so for external dependencies when using Nix-style local builds. + All executables defined in the given Cabal file are termed as *internal* dependencies + as opposed to the rest which are *external* dependencies. - :pkg-field:`build-tool-depends` was added in Cabal 2.0, and it will - be ignored (with a warning) with old versions of Cabal. See - :pkg-field:`build-tools` for more information about backwards - compatibility. + Each of the two is handled differently: + 1. External dependencies can (and should) contain a version bound like conventional + :pkg-field:`build-depends` dependencies. + 2. Internal depenedencies should not contain a version bound, as they will be always + resolved within the same configuration of the package in the build plan. + Specifically, version bounds that include the package's version will be warned for + being extraneous, and version bounds that exclude the package's version will raise + an error for being impossible to follow. + + For example (1) using a test-suite to make sure README.md Haskell snippets are tested using + `markdown-unlit `__: + + :: + + build-tool-depends: markdown-unlit:markdown-unlit >= 0.5.0 && < 0.6 + + For example (2) using a test-suite to test executable behaviour in the same package: + + :: + + build-tool-depends: mypackage:executable + + Cabal tries to make sure that all specified programs are atomically built and prepended + on the ``$PATH`` shell variable before building the component in question, but can only do + so for Nix-style builds. Specifically: + + a) For Nix-style local builds, both internal and external dependencies. + b) For old-style builds, only for internal dependencies [#old-style-build-tool-depends]_. + It's up to the user to provide needed executables in this case under `$PATH.` + + + .. note:: + + :pkg-field:`build-tool-depends` was added in Cabal 2.0, and it will + be ignored (with a warning) with old versions of Cabal. See + :pkg-field:`build-tools` for more information about backwards + compatibility. + .. pkg-field:: build-tools: program list - :deprecated: + :deprecated: 2.0 + :removed: 3.0 Deprecated in favor of :pkg-field:`build-tool-depends`, but :ref:`see below for backwards compatibility information `. @@ -2107,7 +2317,7 @@ .. _buildtoolsbc: - **Backward Compatiblity** + **Backward Compatibility** Although this field is deprecated in favor of :pkg-field:`build-tool-depends`, there are some situations where you may prefer to use :pkg-field:`build-tools` in cases (1) and (2), as it is supported by more versions of Cabal. In case (3), :pkg-field:`build-tool-depends` is better for backwards-compatibility, as it will be ignored by old versions of Cabal; if you add the executable to :pkg-field:`build-tools`, a setup script built against old Cabal will choke. @@ -2268,6 +2478,7 @@ appropriately. .. pkg-field:: asm-sources: filename list + :since: 2.2 A list of assembly source files to be compiled and linked with the Haskell files. @@ -2292,14 +2503,24 @@ when the package is loaded with GHCi. .. pkg-field:: extra-bundled-libraries: token list + :since: 2.2 A list of libraries that are supposed to be copied from the build directory alongside the produced Haskell libraries. Note that you - are under the obligation to produce those lirbaries in the build + are under the obligation to produce those libraries in the build directory (e.g. via a custom setup). Libraries listed here will be included when ``copy``-ing packages and be listed in the - ``hs-libraries`` of the package configuration. + ``hs-libraries`` of the package configuration in the package database. + Library names must either be prefixed with "HS" or "C" and corresponding + library file names must match: + - Libraries with name "HS": + - `libHS.a` + - `libHS-ghc.*` + - Libraries with name "C": + - `libC.a` + - `lib.*` + .. pkg-field:: extra-lib-dirs: directory list A list of directories to search for libraries. @@ -2329,6 +2550,12 @@ command-line arguments with the :pkg-field:`cc-options` and the :pkg-field:`cxx-options` fields. +.. pkg-field:: asm-options: token list + :since: 2.2 + + Command-line arguments to be passed to the assembler when compiling + assembler code. See also :pkg-field:`asm-sources`. + .. pkg-field:: ld-options: token list Command-line arguments to be passed to the linker. Since the @@ -2346,10 +2573,11 @@ the system and to find the extra compilation and linker options needed to use the packages. - If you need to bind to a C library that supports ``pkg-config`` (use - ``pkg-config --list-all`` to find out if it is supported) then it is - much preferable to use this field rather than hard code options into - the other fields. + If you need to bind to a C library that supports ``pkg-config`` then + it is much preferable to use this field rather than hard code options + into the other fields. ``pkg-config --list-all`` will show you all + supported libraries. Depending on your system you may need to adjust + ``PKG_CONFIG_PATH``. .. pkg-field:: frameworks: token list @@ -2358,6 +2586,7 @@ is ignored on all other platforms. .. pkg-field:: extra-frameworks-dirs: directory list + :since: 1.24 On Darwin/MacOS X, a list of directories to search for frameworks. This entry is ignored on all other platforms. @@ -2376,7 +2605,7 @@ library build-depends: - foo >= 1.2.3 && < 1.3 + foo ^>= 1.2.3 mixins: foo @@ -2409,9 +2638,7 @@ if the provided renaming clause has whitespace after the opening parenthesis. This will be fixed in future versions of Cabal. - See issues `#5150 `__, - `#4864 `__, and - `#5293 `__. + See issues :issue:`5150`, :issue:`4864`, and :issue:`5293`. There can be multiple mixin entries for a given package, in effect creating multiple copies of the dependency: @@ -2441,10 +2668,9 @@ mixins: sigonly requires (SigOnly.SomeSig as AnotherSigOnly.SomeSig) - See the :pkg-field:`signatures` field for more details. + See the :pkg-field:`library:signatures` field for more details. - Mixin packages are part of the `Backpack - `__ extension to the + Mixin packages are part of the Backpack_ extension to the Haskell module system. The matching of the module signatures required by a @@ -2453,11 +2679,11 @@ the names of the signature and of the implementation are already the same, the matching is automatic. But when the names don't coincide, or we want to instantiate a signature in two different ways, adding mixin entries that - perform renamings becomes necessary. + perform renamings becomes necessary. .. Warning:: - Backpack has the limitation that implementation modules that instantiate + Backpack_ has the limitation that implementation modules that instantiate signatures required by a :pkg-field:`build-depends` dependency can't reside in the same component that has the dependency. They must reside in a different package dependency, or at least in a separate internal @@ -2823,7 +3049,7 @@ ghc-options: -Wall common test-deps - build-depends: tasty + build-depends: tasty ^>= 0.12.0.1 library import: deps @@ -2843,6 +3069,9 @@ - You can import multiple stanzas at once. Stanza names must be separated by commas. +- ``import`` must be the first field in a section. Since Cabal 3.0 imports + are also allowed inside conditionals. + .. Note:: The name `import` was chosen, because there is ``includes`` field. @@ -3002,6 +3231,11 @@ `this article `__ for more details. +As of Cabal library version 3.0, ``defaultMain*`` variants implement support +for response files. Custom ``Setup.hs`` files that do not use one of these +main functions are required to implement their own support, such as by using +``GHC.ResponseFile.getArgsWithResponseFiles``. + Declaring a ``custom-setup`` stanza also enables the generation of ``MIN_VERSION_package_(A,B,C)`` CPP macros for the Setup component. @@ -3041,7 +3275,7 @@ ``MIN_VERSION_package_(A,B,C)`` CPP macros inside ``Setup.hs`` scripts depends on the condition that either -- a ``custom-setup`` section has been declared (or ``cabal new-build`` is being +- a ``custom-setup`` section has been declared (or ``cabal v2-build`` is being used which injects an implicit hard-coded ``custom-setup`` stanza if it's missing), or - GHC 8.0 or later is used (which natively injects package version CPP macros) @@ -3094,8 +3328,8 @@ -Autogenerated modules ---------------------- +Autogenerated modules and includes +---------------------------------- Modules that are built automatically at setup, created with a custom setup script, must appear on :pkg-field:`other-modules` for the library, @@ -3112,7 +3346,7 @@ .. pkg-field:: autogen-modules: module list :since: 2.0 - .. TODO: document autogen-modules field + .. todo:: document autogen-modules field Right now :pkg-field:`executable:main-is` modules are not supported on :pkg-field:`autogen-modules`. @@ -3140,6 +3374,13 @@ autogen-modules: MyExeHelperModule +.. pkg-field:: autogen-includes: filename list + :since: 3.0 + + A list of header files from this package which are autogenerated + (e.g. by a ``configure`` script). Autogenerated header files are not + packaged by ``sdist`` command. + Accessing data files from package code -------------------------------------- @@ -3478,3 +3719,13 @@ .. include:: references.inc + +.. rubric:: Footnotes + +.. [#old-style-build-tool-depends] + + Some packages (ab)use :pkg-field:`build-depends` on old-style builds, but this has a few major drawbacks: + + - using Nix-style builds it's considered an error if you depend on a exe-only package via build-depends: the solver will refuse it. + - it may or may not place the executable on ``$PATH``. + - it does not ensure the correct version of the package is installed, so you might end up overwriting versions with each other. diff --git a/cabal/Cabal/doc/file-format-changelog.rst b/cabal/Cabal/doc/file-format-changelog.rst --- a/cabal/Cabal/doc/file-format-changelog.rst +++ b/cabal/Cabal/doc/file-format-changelog.rst @@ -1,9 +1,77 @@ -Cabal file format changelog -=========================== +.. _spec-history: -Changes in 2.4 --------------- +================================================== + Package Description Format Specification History +================================================== +:ref:`pkg-desc` need to specify the version of the +specification they need to be interpreted in via the +:pkg-field:`cabal-version` declaration. The following list describes +changes that occurred in each version of the cabal specification +relative to the respective preceding *published* version. + +.. note:: + + The sequence of specification version numbers is *not* + contiguous because it's synchronised with the version of the + ``Cabal`` library. As a consequence, only *even* versions are + considered proper published versions of the specification as *odd* + versions of the ``Cabal`` library denote unreleased development + branches which have no stability guarantee. + +``cabal-version: 3.0`` +---------------------- + +* Added the :pkg-field:`extra-dynamic-library-flavours` field to specify non-trivial + variants of dynamic flavours. It is :pkg-field:`extra-library-flavours` but for + shared libraries. Mainly useful for GHC's RTS library. + +* Free text fields (e.g. :pkg-field:`description`) preserve empty lines + and indentation. In other words, you don't need to add dots for blank lines. + +* License fields use identifiers from SPDX License List version + ``3.6 2019-07-10`` + +* Remove deprecated ``hs-source-dir``, :pkg-field:`extensions` and + :pkg-field:`build-tools` fields. + +* Common stanzas are now allowed also in the beginnning of conditional + sections. In other words, the following is valid + + :: + + library + import deps + + if flag(foo) + import foo-deps + +* Allow redundant leading or trailing commas in package fields with + optional commas, such as :pkg-field:`exposed-modules` + +* Require fields with optional commas to consistently omit or place + commas between elements. + +* Changed the behavior of :pkg-field:`extra-bundled-libraries` field. The naming convention + of dynamic library files (e.g. generated by a custom build script) has + changed. For library names prefixed with "C", the dynamic library file + name(s) must be of the form `lib.*` + instead of the old `libC-ghc.` + +* New set-notation syntax for ``==`` and ``^>=`` operators, see + :pkg-field:`build-depends` field documentation for examples. + +* Allow more whitespace in :pkg-field:`mixins` field + +* Wildcards are disallowed in :pkg-field:`pkgconfig-depends`, + Yet the pkgconfig format is relaxed to accept e.g. versions like ``1.1.0h``. + +* New :pkg-field:`autogen-includes` for specifying :pkg-field:`install-includes` + which are autogenerated (e.g. by a ``configure`` script). + +``cabal-version: 2.4`` +---------------------- + * Wildcard matching has been expanded. All previous wildcard expressions are still valid; some will match strictly more files than before. Specifically: @@ -77,7 +145,7 @@ * New CPP Macro ``CURRENT_PACKAGE_VERSION``. ``cabal-version: 1.24`` ----------------------- +----------------------- * New :pkg-section:`custom-setup` stanza and :pkg-field:`custom-setup:setup-depends` field added for specifying dependencies @@ -92,7 +160,7 @@ extra locations to find OS X frameworks. ``cabal-version: 1.22`` ----------------------- +----------------------- * New :pkg-field:`library:reexported-modules` field. @@ -102,7 +170,7 @@ * New :pkg-field:`license` type ``ISC`` added. ``cabal-version: 1.20`` ----------------------- +----------------------- * Add support for new :pkg-field:`license-files` field for declaring multiple license documents. @@ -112,7 +180,7 @@ * New :pkg-field:`license` types ``BSD2`` and ``MPL-2.0`` added. ``cabal-version: 1.18`` ----------------------- +----------------------- * Add support for new :pkg-field:`extra-doc-files` field for specifying extra file assets referenced by the Haddock @@ -126,7 +194,7 @@ * Add ``getSysconfDir`` operation to ``Paths_`` API. ``cabal-version: 1.16`` ----------------------- +----------------------- .. todo:: @@ -134,7 +202,7 @@ 1.12 and 1.18; ``cabal-version: 1.12`` ----------------------- +----------------------- * Change syntax of :pkg-field:`cabal-version` to support the new recommended ``cabal-version: x.y`` style diff --git a/cabal/Cabal/doc/hcar/.gitignore b/cabal/Cabal/doc/hcar/.gitignore new file mode 100644 --- /dev/null +++ b/cabal/Cabal/doc/hcar/.gitignore @@ -0,0 +1,5 @@ +*.out +*.aux +*.log +*.pdf +/auto diff --git a/cabal/Cabal/doc/hcar/Cabal-201604.tex b/cabal/Cabal/doc/hcar/Cabal-201604.tex new file mode 100644 --- /dev/null +++ b/cabal/Cabal/doc/hcar/Cabal-201604.tex @@ -0,0 +1,118 @@ +\documentclass[DIV16,twocolumn,10pt]{scrreprt} +\usepackage{paralist} +\usepackage{graphicx} +\usepackage[final]{hcar} + +%include polycode.fmt + +\begin{document} + +\begin{hcarentry}{Cabal} +\report{Mikhail Glushenkov} +\status{Active} +\participants{\href{https://github.com/haskell/cabal/graphs/contributors}{Cabal contributors}}% optional +\makeheader + +\subsubsection*{Background} + +Cabal is the standard packaging system for Haskell software. It specifies a +standard way in which Haskell libraries and applications can be packaged so that +it is easy for consumers to use them, or re-package them, regardless of the +Haskell implementation or installation platform. + +\texttt{cabal-install} is the command line interface for the Cabal and Hackage +system. It provides a command line program \texttt{cabal} which has sub-commands +for installing and managing Haskell packages. + +\subsubsection*{Recent Progress} + +We've just released versions 1.24 of Cabal and \texttt{cabal-install}. 1.24 +incorporates more than a thousand commits by +\href{https://gist.github.com/23Skidoo/62544d7e0352037749eec7344788831c}{89 + different contributors}. Main user-visible changes in this release are: + +\begin{itemize} +\item Nix-style local builds in \texttt{cabal-install} (so far only a technical + preview). See + \href{http://blog.ezyang.com/2016/05/announcing-cabal-new-build-nix-style-local-builds/}{this + post} by Edward Z. Yang for more details. +\item Integration of a new security scheme for Hackage based on + \href{https://theupdateframework.github.io/}{The Update Framework}. So far + this is not enabled by default, pending some changes on the Hackage side. See + \href{http://www.well-typed.com/blog/2015/08/hackage-security-beta/}{these} + \href{http://www.well-typed.com/blog/2015/07/hackage-security-alpha/}{three} + \href{http://www.well-typed.com/blog/2015/04/improving-hackage-security/}{posts} + by Edsko de Vries and Duncan Coutts for more information. +\item Support for specifying setup script dependencies in \texttt{.cabal} + files. See + \href{http://www.well-typed.com/blog/2015/07/cabal-setup-deps/}{this post by + Duncan Coutts} for more information. +\item Support for HTTPS downloads in \texttt{cabal-install}. HTTPS is now used + by default for downloads from Hackage. +\item \texttt{cabal upload} learned how to upload documentation to Hackage + (\texttt{cabal upload --doc}). +\item In related news, \texttt{cabal haddock} now can generate documentation + intended for uploading to Hackage (\texttt{cabal haddock + --for-hackage}). \texttt{cabal upload --doc} runs this command automatically + if the documentation for current package wasn't generated yet. +\item New \texttt{cabal-install} command: \texttt{gen-bounds}. See + \href{http://softwaresimply.blogspot.se/2015/08/cabal-gen-bounds-easy-generation-of.html}{here} + for more information. +\item It's now possible to limit the scope of \texttt{--allow-newer} to single + packages in the install plan, both on the command line and in the config + file. See \href{https://github.com/haskell/cabal/issues/2756}{here} for an + example. +\item New \texttt{cabal user-config} subcommand: \texttt{init}, which creates a + default \texttt{\textasciitilde{}/.cabal/config} file. +\item New config file field: \texttt{extra-framework-dirs} (extra locations to + find OS X frameworks in). +\item \texttt{cabal-install} solver + \href{https://github.com/haskell/cabal/pull/2873}{now takes information about + extensions and language flavours into account}. +\item New \texttt{cabal-install} option: + \href{https://github.com/haskell/cabal/pull/2578}{\texttt{--offline}}, which + prevents \texttt{cabal-install} from downloading anything from the Internet. +\item New \texttt{cabal upload} option + \href{https://github.com/haskell/cabal/pull/2506}{\texttt{-P}/\texttt{--password-command}} + for reading Hackage password from arbitrary program output. +\item Support for GHC 8 (NB: old versions of Cabal won't work with this version + of GHC). +\end{itemize} + +Full list of changes in Cabal 1.24 is available +\href{http://hackage.haskell.org/package/Cabal-1.24.0.0/changelog}{here}; full +list of changes in \texttt{cabal-install} 1.24 is available +\href{http://hackage.haskell.org/package/cabal-install-1.24.0.0/changelog}{here}. + +\subsubsection*{Looking Forward} + +We plan to make a new release of Cabal/\texttt{cabal-install} approximately 6 +months after 1.24 -- that is, in late October or early November 2016. Main +features that are currently targeted at 1.26 are: + +\begin{itemize} +\item Further work on nix-style local builds, perhaps making that code path the + default. +\item Enabling Hackage Security by default. +\item Native suport for + \href{https://github.com/haskell/cabal/pull/2540}{``foreign libraries''}: + Haskell libraries that are intended to be used by non-Haskell code. +\item New Parsec-based parser for \texttt{.cabal} files. +\end{itemize} + +We would like to encourage people considering contributing to take a look at +\href{https://github.com/haskell/cabal/issues/}{the bug tracker on GitHub}, take +part in discussions on tickets and pull requests, or submit their own. The bug +tracker is reasonably well maintained and it should be relatively clear to new +contributors what is in need of attention and which tasks are considered +relatively easy. For more in-depth discussion there is also the +\href{https://mail.haskell.org/mailman/listinfo/cabal-devel}{\texttt{cabal-devel}} +mailing list. + +\FurtherReading + Cabal homepage:\hfill\url{https://www.haskell.org/cabal/}\\ + Cabal on GitHub:\hfill\url{https://github.com/haskell/cabal} + +\end{hcarentry} + +\end{document} diff --git a/cabal/Cabal/doc/hcar/Cabal-201611.tex b/cabal/Cabal/doc/hcar/Cabal-201611.tex new file mode 100644 --- /dev/null +++ b/cabal/Cabal/doc/hcar/Cabal-201611.tex @@ -0,0 +1,140 @@ +% Cabal-MC.tex +\begin{hcarentry}{Cabal} +\label{cabal}%\label{hackage}\label{hackagedb}% +\report{Mikhail Glushenkov}%11/16 +\status{Stable, actively developed} +\makeheader + +\subsubsection*{Background} + +Cabal is the standard packaging system for Haskell software. It specifies a +standard way in which Haskell libraries and applications can be packaged so +that it is easy for consumers to use them, or re-package them, regardless of +the Haskell implementation or installation platform. + +\texttt{cabal-install} is the command line interface for the Cabal and Hackage +system. It provides a command line program \texttt{cabal} which has +sub-commands for installing and managing Haskell packages. + +\subsubsection*{Recent Progress} + +We've recently produced +\href{https://mail.haskell.org/pipermail/cabal-devel/2016-December/010384.html}{new + point releases} of Cabal/\texttt{cabal-install} from the 1.24 +branch. Among other things, Cabal 1.24.2.0 includes a +\href{https://ghc.haskell.org/trac/ghc/ticket/12479}{fix} necessary to +make soon-to-be-released GHC 8.0.2 work on macOS Sierra. + +Almost 1500 commits were made to the \texttt{master} branch by +\href{https://gist.github.com/23Skidoo/1a291fd56a18b51f415db5fbaff56ec6}{53 +different contributors} since the 1.24 release. Among the highlights are: + +\begin{compactitem} +\item + \href{http://cabal.readthedocs.io/en/latest/developing-packages.html#library}{Convenience, + or internal libraries} -- named libraries that are only intended + for use inside the package. A common use case is sharing code + between the test suite and the benchmark suite without exposing it + to the users of the package. + +\item Support for + \href{http://cabal.readthedocs.io/en/latest/developing-packages.html#foreign-libraries}{foreign + libraries}, which are Haskell libraries intended to be used by + foreign languages like C. Foreign libraries only work with GHC 7.8 + and later. + +\item Initial support for building Backpack packages. Backpack is an + exciting new project adding an ML-style module system to Haskell, + but on the package level. See + \href{https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst}{here} + and \href{http://blog.ezyang.com/category/haskell/backpack/}{here} + for a more thorough introduction to Backpack. + +\item \texttt{./Setup configure} now accepts an argument + \href{https://github.com/ghc-proposals/ghc-proposals/pull/4}{specifying + the component to be configured}. This is mainly an internal + change, but it means that \texttt{cabal-install} can now perform + component-level parallel builds (among other things). + +\item A lot of improvements in the \texttt{new-build} feature + (a.k.a. nix-style local builds). Git \texttt{HEAD} version of + \texttt{cabal-install} is now recommended if you use + \texttt{new-build}. For an introduction to \texttt{new-build}, see + \href{http://cabal.readthedocs.io/en/latest/nix-local-build-overview.html}{this + chapter} of the manual. + +\item Special support for the Nix package manager in + \texttt{cabal-install}. See + \href{http://cabal.readthedocs.io/en/latest/nix-integration.html}{here} + for more details. + +\item \texttt{cabal upload} now uploads a package candidate by + default. Use \texttt{cabal upload -{}-publish} to upload a final + version. \texttt{cabal upload -{}-check} has been removed in favour + of package candidates. + +\item + \href{http://cabal.readthedocs.io/en/latest/nix-local-build.html#cfg-field-index-state}{An + \texttt{-{}-index-state} flag} for requesting a specific version + of the package index. + +\item \href{https://github.com/haskell/cabal/pull/3818}{New \texttt{cabal reconfigure} command}, which re-runs + \texttt{configure} with most recently used flags. + +\item + \href{http://cabal.readthedocs.io/en/latest/developing-packages.html#autogenerated-modules}{New + \texttt{autogen-modules} field} for modules built automatically + (like \texttt{Paths\_PACKAGENAME}). + +\item + \href{http://cabal.readthedocs.io/en/latest/developing-packages.html#pkg-field-build-depends}{New + version range operator} \texttt{\^{}>=}, which is equivalent to + \texttt{>=} intersected with an automatically-inferred major version + bound. For example, \texttt{\^{}>= 2.0.3} is equivalent to \texttt{>= + 2.0.3 \&\& < 2.1}. + +\item + \href{http://cabal.readthedocs.io/en/latest/installing-packages.html#cmdoption-setup-configure--allow-newer}{An + \texttt{-{}-allow-older} flag}, dual to \texttt{-{}-allow-newer}. + +\item New Parsec-based parser for \texttt{.cabal} files + \href{https://github.com/haskell/cabal/pull/3602}{has been merged}, + but not enabled by default yet. + +\item \href{http://cabal.readthedocs.io/en/latest/}{The manual} has + been converted to reST/Sphinx format, improved and expanded. + +\item + \href{https://www.well-typed.com/blog/2015/08/hackage-security-beta/}{Hackage + Security} has been enabled by default. + +\item A lot of bug fixes and performance improvements. + +\end{compactitem} + +\subsubsection*{Looking Forward} + +The next Cabal/\texttt{cabal-install} versions will be released either +in early 2017, or simultaneously with GHC 8.2 (April/May 2017). Our +main focus at this stage is getting the \texttt{new-build} feature to +the state where it can be enabled by default, but there are many other +areas of Cabal that need work. + +We would like to encourage people considering contributing to take a +look at \href{https://github.com/haskell/cabal/issues/}{the bug + tracker on GitHub} and the +\href{https://github.com/haskell/cabal/wiki/Hackathon-2016}{Wiki}, +take part in discussions on tickets and pull requests, or submit their +own. The bug tracker is reasonably well maintained and it should be +relatively clear to new contributors what is in need of attention and +which tasks are considered relatively easy. For more in-depth +discussion there is also the +\href{https://mail.haskell.org/mailman/listinfo/cabal-devel}{\texttt{cabal-devel}} +mailing list. + +\FurtherReading +\begin{compactitem} +\item Cabal homepage:\hfill\url{https://www.haskell.org/cabal/}\\ +\item Cabal on GitHub:\hfill\url{https://github.com/haskell/cabal} +\end{compactitem} +\end{hcarentry} diff --git a/cabal/Cabal/doc/hcar/Cabal-201811.tex b/cabal/Cabal/doc/hcar/Cabal-201811.tex new file mode 100644 --- /dev/null +++ b/cabal/Cabal/doc/hcar/Cabal-201811.tex @@ -0,0 +1,121 @@ +% Cabal-MC.tex +\begin{hcarentry}{Cabal} +\label{cabal} +\label{hackage} +\label{hackagedb} +\report{Mikhail Glushenkov}%11/18 +\status{Stable, actively developed} +\makeheader + +\subsubsection*{Background} + +Cabal is the standard packaging system for Haskell software. It +specifies how Haskell libraries and applications can be packaged so +that it is easy for consumers to use them, or re-package them, +regardless of the Haskell implementation or installation platform. + +\texttt{cabal-install} is the command line interface for the Cabal and +Hackage system. It provides a program \texttt{cabal} which has +sub-commands for installing, managing, and developing Haskell packages. + +\subsubsection*{Recent Progress} + +We've recently produced the first releases of +Cabal/\texttt{cabal-install} from the 2.4 series. Bugfix releases from +the same branch are in the works at the time of writing and should be out soon. + +Almost 600 commits were made to the \texttt{master} branch by +\href{https://gist.github.com/23Skidoo/7f07c309776574039b9cc7e29cfaf069}{48 + different contributors} since the 2.2 release. Among the highlights +are: + +\begin{compactitem} + +\item Massive improvements to the + \href{https://cabal.readthedocs.io/en/latest/nix-local-build-overview.html#nix-style-local-builds}{\texttt{new-build} + feature} + \href{https://typedr.at/posts/what-i-did-on-my-summer-vacation/}{made + by Alexis Williams during GSoC 2018}, as well as many other + contributors. Among other things, \texttt{new-install}, + \texttt{new-sdist}, \texttt{new-clean}, and \texttt{new-update} + commands are now fully implemented, \texttt{new-repl} works outside + of projects, and \texttt{new-run} can now be used to run scripts + (either with \texttt{cabal new-run foo.hs} or in a shebang + interpreter mode). + +\item It's now possible + \href{https://cabal.readthedocs.io/en/latest/nix-local-build.html#specifying-packages-from-remote-version-control-locations}{to + specify packages from remote version control locations + (e.g. GitHub) in \texttt{cabal.project}} (as well as local/remote + tarballs). Work done by Duncan Coutts with the help of Alexis + Williams, \textbf{@quasicomputational}, and others. + +\item Improvements to the wildcard syntax: a + \href{https://cabal.readthedocs.io/en/latest/developing-packages.html#pkg-field-data-files}{limited + form of recursive matching} (\texttt{data-files:~audio/**/*.mp3}) + is now allowed. Work done by \textbf{@quasicomputational}. + +\item Lots of bug fixes and performance improvements. + +\end{compactitem} + +\subsubsection*{Looking Forward} + +We plan to make the next major Cabal/\texttt{cabal-install} release +(3.0) around the same time GHC 8.8 is going to be released (February +2019). Main features currently targeted at this milestone are: + +\begin{compactitem} + +\item \texttt{new-build} will become the default mode of + operation. Old-style commands will still be accessible under the + \texttt{v1-} prefix. + +\item Multiple public libraries feature implemented by Francesco + Gazzetta during GSoC 2018. This will allow to define more than one + public library in a single \texttt{.cabal} package, which is useful + for large projects such as \texttt{lens}, as well as Backpack-heavy + libraries. This + \href{https://github.com/haskell/cabal/pull/5526}{has already been + merged to \texttt{master}}; Francesco continues to polish and + improve the implementation in preparation for its initial release. + +\item A split of the Cabal library into a pure \texttt{cabal-lib-core} + part (parser and foundational data types) and an effectful + \texttt{cabal-lib-build} part (build system bits); likewise, the + constraint solver part of \texttt{cabal-install} will be + moved into its own library \texttt{cabal-lib-solver}, and the + \texttt{cabal-install} package renamed to \texttt{cabal}. + +\item A revamped homepage, rewritten user manual, and automated build + bots for producing binaries. Help in this area would be appreciated! + +\end{compactitem} + +We would like to encourage people considering contributing to take a +look at \href{https://github.com/haskell/cabal/issues/}{the bug + tracker on GitHub}, take part in discussions on tickets and pull +requests, or submit their own. The bug tracker is reasonably well +maintained and it should be fairly clear to new contributors what +is in need of attention and which tasks are considered relatively +easy. Additionally, +\href{https://github.com/haskell/cabal/wiki/ZuriHac-2018}{the list + of potential projects from the latest hackathon} and the tickets +marked +\href{https://github.com/haskell/cabal/issues?q=is\%3Aopen+is\%3Aissue+label\%3A\%22meta\%3A+easy\%22}{“easy”} +and +\href{https://github.com/haskell/cabal/issues?q=is\%3Aopen+is\%3Aissue+label\%3Anewcomer}{“newcomer”} +can be used as a source of ideas for what to work on. + +For more in-depth discussions there is also the +\href{https://mail.haskell.org/mailman/listinfo/cabal-devel}{\texttt{cabal-devel} + mailing list} and the +\href{http://ircbrowse.net/browse/hackage}{\texttt{\#hackage} IRC + channel on FreeNode}. + +\FurtherReading +\begin{compactitem} +\item Cabal homepage:\hfill\url{https://www.haskell.org/cabal/}\\ +\item Cabal on GitHub:\hfill\url{https://github.com/haskell/cabal} +\end{compactitem} +\end{hcarentry} diff --git a/cabal/Cabal/doc/hcar/hcar.sty b/cabal/Cabal/doc/hcar/hcar.sty new file mode 100644 --- /dev/null +++ b/cabal/Cabal/doc/hcar/hcar.sty @@ -0,0 +1,186 @@ +\ProvidesPackage{hcar} + +\newif\ifhcarfinal +\hcarfinalfalse +\DeclareOption{final}{\hcarfinaltrue} +\ProcessOptions + +\RequirePackage{keyval} +\RequirePackage{color} +\RequirePackage{array} + +\ifhcarfinal + \RequirePackage[T1]{fontenc} + \RequirePackage{lmodern} + \RequirePackage{tabularx} + \RequirePackage{booktabs} + \RequirePackage{framed} + \RequirePackage[obeyspaces,T1]{url} + \RequirePackage + [bookmarks=true,colorlinks=true, + urlcolor=urlcolor, + linkcolor=linkcolor, + breaklinks=true, + pdftitle={Haskell Communities and Activities Report}]% + {hyperref} +\else + \RequirePackage[obeyspaces]{url} +\fi +\urlstyle{sf} + +\definecolor{urlcolor}{rgb}{0.1,0.3,0} +\definecolor{linkcolor}{rgb}{0.3,0,0} +\definecolor{shadecolor}{rgb}{0.9,0.95,1}%{0.98,1.0,0.95} +\definecolor{framecolor}{gray}{0.9} +\definecolor{oldgray}{gray}{0.7} + +\newcommand{\Contact}{\subsubsection*{Contact}} +\newcommand{\FurtherReading}{\subsubsection*{Further reading}} +\newcommand{\FuturePlans}{\subsubsection*{Future plans}} +\newcommand{\WhatsNew}{\subsubsection*{What is new?}} + +\newcommand{\Separate}{\smallskip\noindent} +\newcommand{\FinalNote}{\smallskip\noindent} + +\newcommand{\urlpart}{\begingroup\urlstyle{sf}\Url} +\newcommand{\email}[1]{\href{mailto:\EMailRepl{#1}{ at }}{$\langle$\urlpart{#1}$\rangle$}} +\newcommand{\cref}[1]{($\rightarrow\,$\ref{#1})} + +\ifhcarfinal + \let\hcarshaded=\shaded + \let\endhcarshaded=\endshaded +\else + \newsavebox{\shadedbox} + \newlength{\shadedboxwidth} + \def\hcarshaded + {\begingroup + \setlength{\shadedboxwidth}{\linewidth}% + \addtolength{\shadedboxwidth}{-2\fboxsep}% + \begin{lrbox}{\shadedbox}% + \begin{minipage}{\shadedboxwidth}\ignorespaces} + \def\endhcarshaded + {\end{minipage}% + \end{lrbox}% + \noindent + \colorbox{shadecolor}{\usebox{\shadedbox}}% + \endgroup} +\fi + +\ifhcarfinal + \newenvironment{hcartabularx} + {\tabularx{\linewidth}{l>{\raggedleft}X}} + {\endtabularx} +\else + \newenvironment{hcartabularx} + {\begin{tabular}{@{}m{.3\linewidth}@{}>{\raggedleft}p{.7\linewidth}@{}}} + {\end{tabular}} +\fi + +\ifhcarfinal + \let\hcartoprule=\toprule + \let\hcarbottomrule=\bottomrule +\else + \let\hcartoprule=\hline + \let\hcarbottomrule=\hline +\fi + +\define@key{hcarentry}{chapter}[]{\let\level\chapter} +\define@key{hcarentry}{section}[]{\let\level\section} +\define@key{hcarentry}{subsection}[]{\let\level\subsection} +\define@key{hcarentry}{subsubsection}[]{\let\level\subsubsection} +\define@key{hcarentry}{level}{\let\level=#1} +%\define@key{hcarentry}{label}{\def\entrylabel{\label{#1}}} +\define@key{hcarentry}{new}[]% + {\let\startnew=\hcarshaded\let\stopnew=\endhcarshaded + \def\startupdated{\let\orig@addv\addvspace\let\addvspace\@gobble}% + \def\stopupdated{\let\addvspace\orig@addv}} +\define@key{hcarentry}{old}[]{\def\normalcolor{\color{oldgray}}\color{oldgray}}% +\define@key{hcarentry}{updated}[]% + {\def\startupdated + {\leavevmode\let\orig@addv\addvspace\let\addvspace\@gobble\hcarshaded}% + \def\stopupdated{\endhcarshaded\let\addvspace\orig@addv}} + +\def\@makeheadererror{\PackageError{hcar}{hcarentry without header}{}} + +\newenvironment{hcarentry}[2][]% +{\let\level\subsection + \let\startupdated=\empty\let\stopupdated=\empty + \let\startnew=\empty\let\stopnew=\empty +%\let\entrylabel=\empty + \global\let\@makeheaderwarning\@makeheadererror + \setkeys{hcarentry}{#1}% + \startnew\startupdated + \level{#2}% + % test: + \global\let\@currentlabel\@currentlabel +%\stopupdated + \let\report@\empty + \let\groupleaders@\empty + \let\members@\empty + \let\contributors@\empty + \let\participants@\empty + \let\developers@\empty + \let\maintainer@\empty + \let\status@\empty + \let\release@\empty + \let\portability@\empty + \let\entry@\empty}% +{\stopnew\@makeheaderwarning}% + +\renewcommand{\labelitemi}{$\circ$} +\settowidth{\leftmargini}{\labelitemi} +\addtolength{\leftmargini}{\labelsep} + +\newcommand*\MakeKey[2]% + {\expandafter\def\csname #1\endcsname##1% + {\expandafter\def\csname #1@\endcsname{\Key@{#2}{##1}}\ignorespaces}} +\MakeKey{report}{Report by:} +\MakeKey{status}{Status:} +\MakeKey{groupleaders}{Group leaders:} +\MakeKey{members}{Members:} +\MakeKey{contributors}{Contributors:} +\MakeKey{participants}{Participants:} +\MakeKey{developers}{Developers:} +\MakeKey{maintainer}{Maintainer:} +\MakeKey{release}{Current release:} +\MakeKey{portability}{Portability:} +\MakeKey{entry}{Entry:} + +\newcommand\Key@[2]{#1 & #2\tabularnewline} + +\newcommand\makeheader +{\smallskip + \begingroup + \sffamily + \small + \noindent + \let\ohrule\hrule + \def\hrule{\color{framecolor}\ohrule}% + \begin{hcartabularx} + \hline + \report@ + \groupleaders@ + \members@ + \participants@ + \developers@ + \contributors@ + \maintainer@ + \status@ + \release@ + \portability@ + \hcarbottomrule + \end{hcartabularx} + \endgroup + \stopupdated + \global\let\@makeheaderwarning\empty + \@afterindentfalse + \@xsect\smallskipamount} + +% columns/linebreaks, interchanged +\newcommand\NCi{&\let\NX\NCii}% +\newcommand\NCii{&\let\NX\NL}% +\newcommand\NL{\\\let\NX\NCi}% +\let\NX\NCi +\newcommand\hcareditor[1]{ (ed.)&\\} +\newcommand\hcarauthor[1]{#1\NX}% +\newcommand\hcareditors[1]{\multicolumn{3}{c}{#1 (eds.)}\\[2ex]} diff --git a/cabal/Cabal/doc/hcar/main.tex b/cabal/Cabal/doc/hcar/main.tex new file mode 100644 --- /dev/null +++ b/cabal/Cabal/doc/hcar/main.tex @@ -0,0 +1,11 @@ +\documentclass{article} + +\usepackage{hcar} +\usepackage{hyperref} +\usepackage{paralist} + +\begin{document} + +\input{Cabal-201811} + +\end{document} diff --git a/cabal/Cabal/doc/installing-packages.rst b/cabal/Cabal/doc/installing-packages.rst --- a/cabal/Cabal/doc/installing-packages.rst +++ b/cabal/Cabal/doc/installing-packages.rst @@ -15,6 +15,10 @@ $ cabal user-config update +You can change the location of the global configuration file by specifying +either ``--config-file=FILE`` on the command line or by setting the +``CABAL_CONFIG`` environment variable. + Most of the options in this configuration file are also available as command line arguments, and the corresponding documentation can be used to lookup their meaning. The created configuration file only specifies @@ -40,7 +44,7 @@ Repository specification ------------------------ -An important part of the configuration if the specification of the +An important part of the configuration is the specification of the repository. When ``cabal`` creates a default config file, it configures the repository to be the central Hackage server: @@ -478,8 +482,8 @@ detect and warn in this situation, but it is not perfect. In Cabal 2.0, support for a single positional argument was added to -``setup configure`` This makes Cabal configure a the specific component -to be configured. Specified names can be qualified with ``lib:`` or +``setup configure`` This makes Cabal configure the specific component to +be configured. Specified names can be qualified with ``lib:`` or ``exe:`` in case just a name is ambiguous (as would be the case for a package named ``p`` which has a library and an executable named ``p``.) This has the following effects: @@ -1156,14 +1160,28 @@ .. option:: --enable-executable-dynamic - Link executables dynamically. The executable's library dependencies - should be built as shared objects. This implies :option:`--enable-shared` + Link dependent Haskell libraries into executables dynamically. + The executable's library dependencies must have been + built as shared objects. This implies :option:`--enable-shared` unless :option:`--disable-shared` is explicitly specified. .. option:: --disable-executable-dynamic - (default) Link executables statically. + (default) Link dependent Haskell libraries into executables statically. + Non-Haskell (C) libraries are still linked dynamically, including libc, + so the result is still not a fully static executable + unless :option:`--enable-executable-static` is given. +.. option:: --enable-executable-static + + Build fully static executables. + This link all dependent libraries into executables statically, + including libc. + +.. option:: --disable-executable-static + + (default) Do not build fully static executables. + .. option:: --configure-option=str An extra option to an external ``configure`` script, if one is used @@ -1700,6 +1718,13 @@ give an extra option to the test executables. There is no need to quote options containing spaces because a single option is assumed, so options will not be split on spaces. + +.. option:: --test-wrapper=path + + The wrapper script/application used to setup and tear down the test + execution context. The text executable path and test arguments are + passed as arguments to the wrapper and it is expected that the wrapper + will return the test's return code, as well as a copy of stdout/stderr. .. _setup-sdist: diff --git a/cabal/Cabal/doc/nix-local-build-overview.rst b/cabal/Cabal/doc/nix-local-build-overview.rst --- a/cabal/Cabal/doc/nix-local-build-overview.rst +++ b/cabal/Cabal/doc/nix-local-build-overview.rst @@ -2,8 +2,8 @@ ====================== Nix-style local builds are a new build system implementation inspired by Nix. -The Nix-style local build system is commonly called "new-build" for short -after the ``cabal new-*`` family of commands that control it. However, those +The Nix-style local build system is commonly called "v2-build" for short +after the ``cabal v2-*`` family of commands that control it. However, those names are only temporary until Nix-style local builds become the default. This is expected to happen soon. For those who do not wish to use the new functionality, the classic project style will not be removed immediately, @@ -18,11 +18,11 @@ 1. Like sandboxed Cabal today, we build sets of independent local packages deterministically and independent of any global state. - new-build will never tell you that it can't build your package + v2-build will never tell you that it can't build your package because it would result in a "dangerous reinstall." Given a particular state of the Hackage index, your build is completely reproducible. For example, you no longer need to compile packages - with profiling ahead of time; just request profiling and new-build + with profiling ahead of time; just request profiling and v2-build will rebuild all its dependencies with profiling automatically. 2. Like non-sandboxed Cabal today, builds of external packages are diff --git a/cabal/Cabal/doc/nix-local-build.rst b/cabal/Cabal/doc/nix-local-build.rst --- a/cabal/Cabal/doc/nix-local-build.rst +++ b/cabal/Cabal/doc/nix-local-build.rst @@ -4,24 +4,26 @@ ========== Suppose that you are in a directory containing a single Cabal package -which you wish to build. You can configure and build it using Nix-style +which you wish to build (if you haven't set up a package yet check +out `developing packages `__ for +instructions). You can configure and build it using Nix-style local builds with this command (configuring is not necessary): :: - $ cabal new-build + $ cabal v2-build To open a GHCi shell with this package, use this command: :: - $ cabal new-repl + $ cabal v2-repl To run an executable defined in this package, use this command: :: - $ cabal new-run [executable args] + $ cabal v2-run [executable args] Developing multiple packages ---------------------------- @@ -49,29 +51,29 @@ :: - $ cabal new-build + $ cabal v2-build -To build a specific package, you can either run ``new-build`` from the +To build a specific package, you can either run ``v2-build`` from the directory of the package in question: :: $ cd cabal-install - $ cabal new-build + $ cabal v2-build or you can pass the name of the package as an argument to -``cabal new-build`` (this works in any subdirectory of the project): +``cabal v2-build`` (this works in any subdirectory of the project): :: - $ cabal new-build cabal-install + $ cabal v2-build cabal-install You can also specify a specific component of the package to build. For example, to build a test suite named ``package-tests``, use the command: :: - $ cabal new-build package-tests + $ cabal v2-build package-tests Targets can be qualified with package names. So to request ``package-tests`` *from* the ``Cabal`` package, use @@ -79,7 +81,7 @@ Unlike sandboxes, there is no need to setup a sandbox or ``add-source`` projects; just check in ``cabal.project`` to your repository and -``new-build`` will just work. +``v2-build`` will just work. Cookbook ======== @@ -92,14 +94,14 @@ profiling: True -Now, ``cabal new-build`` will automatically build all libraries and +Now, ``cabal v2-build`` will automatically build all libraries and executables with profiling. You can fine-tune the profiling settings for each package using :cfg-field:`profiling-detail`:: package p profiling-detail: toplevel-functions -Alternately, you can call ``cabal new-build --enable-profiling`` to +Alternately, you can call ``cabal v2-build --enable-profiling`` to temporarily build with profiling. How it works @@ -139,16 +141,16 @@ find that we already have this ID built, we can just use the already built version. -The global package store is ``~/.cabal/store`` (configurable via -global `store-dir` option); if you need to clear your store for +The global package store is ``~/.cabal/store`` (configurable via +global `store-dir` option); if you need to clear your store for whatever reason (e.g., to reclaim disk space or because the global -store is corrupted), deleting this directory is safe (``new-build`` +store is corrupted), deleting this directory is safe (``v2-build`` will just rebuild everything it needs on its next invocation). This split motivates some of the UI choices for Nix-style local build -commands. For example, flags passed to ``cabal new-build`` are only +commands. For example, flags passed to ``cabal v2-build`` are only applied to *local* packages, so that adding a flag to -``cabal new-build`` doesn't necessitate a rebuild of *every* transitive +``cabal v2-build`` doesn't necessitate a rebuild of *every* transitive dependency in the global package store. In cabal-install 2.0 and above, Nix-style local builds also take advantage of a @@ -163,10 +165,10 @@ Where are my build products? ---------------------------- -A major deficiency in the current implementation of new-build is that +A major deficiency in the current implementation of v2-build is that there is no programmatic way to access the location of build products. The location of the build products is intended to be an internal -implementation detail of new-build, but we also understand that many +implementation detail of v2-build, but we also understand that many unimplemented features can only be reasonably worked around by accessing build products directly. @@ -214,7 +216,7 @@ ``cabal-install`` does caching are an implementation detail and may change in the future, knowing what gets cached is helpful for understanding the performance characteristics of invocations to -``new-build``. The cached intermediate results are stored in +``v2-build``. The cached intermediate results are stored in ``dist-newstyle/cache``; this folder can be safely deleted to clear the cache. @@ -230,7 +232,7 @@ already available in the store.) ``source-hashes`` (binary) The hashes of all local source files. When all local source files of - a local package are unchanged, ``cabal new-build`` will skip + a local package are unchanged, ``cabal v2-build`` will skip invoking ``setup build`` entirely (saving us from a possibly expensive call to ``ghc --make``). The full list of source files participating in compilation are determined using @@ -274,24 +276,24 @@ We now give an in-depth description of all the commands, describing the arguments and flags they accept. -cabal new-configure +cabal v2-configure ------------------- -``cabal new-configure`` takes a set of arguments and writes a +``cabal v2-configure`` takes a set of arguments and writes a ``cabal.project.local`` file based on the flags passed to this command. -``cabal new-configure FLAGS; cabal new-build`` is roughly equivalent to -``cabal new-build FLAGS``, except that with ``new-configure`` the flags -are persisted to all subsequent calls to ``new-build``. +``cabal v2-configure FLAGS; cabal new-build`` is roughly equivalent to +``cabal v2-build FLAGS``, except that with ``new-configure`` the flags +are persisted to all subsequent calls to ``v2-build``. -``cabal new-configure`` is intended to be a convenient way to write out +``cabal v2-configure`` is intended to be a convenient way to write out a ``cabal.project.local`` for simple configurations; e.g., -``cabal new-configure -w ghc-7.8`` would ensure that all subsequent -builds with ``cabal new-build`` are performed with the compiler +``cabal v2-configure -w ghc-7.8`` would ensure that all subsequent +builds with ``cabal v2-build`` are performed with the compiler ``ghc-7.8``. For more complex configuration, we recommend writing the ``cabal.project.local`` file directly (or placing it in ``cabal.project``!) -``cabal new-configure`` inherits options from ``Cabal``. semantics: +``cabal v2-configure`` inherits options from ``Cabal``. semantics: - Any flag accepted by ``./Setup configure``. @@ -312,24 +314,24 @@ apply options to an external package, use a ``package`` stanza in a ``cabal.project`` file. -cabal new-update +cabal v2-update ---------------- -``cabal new-update`` updates the state of the package index. If the +``cabal v2-update`` updates the state of the package index. If the project contains multiple remote package repositories it will update the index of all of them (e.g. when using overlays). -Seom examples: +Some examples: :: - $ cabal new-update # update all remote repos - $ cabal new-update head.hackage # update only head.hackage + $ cabal v2-update # update all remote repos + $ cabal v2-update head.hackage # update only head.hackage -cabal new-build +cabal v2-build --------------- -``cabal new-build`` takes a set of targets and builds them. It +``cabal v2-build`` takes a set of targets and builds them. It automatically handles building and installing any dependencies of these targets. @@ -366,30 +368,30 @@ :: - $ cabal new-build lib:foo-pkg # build the library named foo-pkg - $ cabal new-build foo-pkg:foo-tests # build foo-tests in foo-pkg + $ cabal v2-build lib:foo-pkg # build the library named foo-pkg + $ cabal v2-build foo-pkg:foo-tests # build foo-tests in foo-pkg (There is also syntax for specifying module and file targets, but it doesn't currently do anything.) -Beyond a list of targets, ``cabal new-build`` accepts all the flags that -``cabal new-configure`` takes. Most of these flags are only taken into +Beyond a list of targets, ``cabal v2-build`` accepts all the flags that +``cabal v2-configure`` takes. Most of these flags are only taken into consideration when building local packages; however, some flags may cause extra store packages to be built (for example, ``--enable-profiling`` will automatically make sure profiling libraries for all transitive dependencies are built and installed.) -In addition ``cabal new-build`` accepts these flags: +In addition ``cabal v2-build`` accepts these flags: - ``--only-configure``: When given we will forgoe performing a full build and abort after running the configure phase of each target package. -cabal new-repl +cabal v2-repl -------------- -``cabal new-repl TARGET`` loads all of the modules of the target into -GHCi as interpreted bytecode. In addition to ``cabal new-build``'s flags, +``cabal v2-repl TARGET`` loads all of the modules of the target into +GHCi as interpreted bytecode. In addition to ``cabal v2-build``'s flags, it takes an additional ``--repl-options`` flag. To avoid ``ghci`` specific flags from triggering unneeded global rebuilds these @@ -399,8 +401,8 @@ specify these options to the invoked repl. (This flag also works on ``cabal repl`` and ``Setup repl`` on sufficiently new versions of Cabal.) -Currently, it is not supported to pass multiple targets to ``new-repl`` -(``new-repl`` will just successively open a separate GHCi session for +Currently, it is not supported to pass multiple targets to ``v2-repl`` +(``v2-repl`` will just successively open a separate GHCi session for each target.) It also provides a way to experiment with libraries without needing to download @@ -409,18 +411,18 @@ This command opens a REPL with the current default target loaded, and a version of the ``vector`` package matching that specification exposed. -:: +:: - $ cabal new-repl --build-depends "vector >= 0.12 && < 0.13" + $ cabal v2-repl --build-depends "vector >= 0.12 && < 0.13" Both of these commands do the same thing as the above, but only exposes ``base``, -``vector``, and the``vector`` package's transitive dependencies even if the user +``vector``, and the ``vector`` package's transitive dependencies even if the user is in a project context. :: - $ cabal new-repl --ignore-project --build-depends "vector >= 0.12 && < 0.13" - $ cabal new-repl --project='' --build-depends "vector >= 0.12 && < 0.13" + $ cabal v2-repl --ignore-project --build-depends "vector >= 0.12 && < 0.13" + $ cabal v2-repl --project='' --build-depends "vector >= 0.12 && < 0.13" This command would add ``vector``, but not (for example) ``primitive``, because it only includes the packages specified on the command line (and ``base``, which @@ -428,17 +430,17 @@ :: - $ cabal new-repl --build-depends vector --no-transitive-deps + $ cabal v2-repl --build-depends vector --no-transitive-deps -cabal new-run +cabal v2-run ------------- -``cabal new-run [TARGET [ARGS]]`` runs the executable specified by the +``cabal v2-run [TARGET [ARGS]]`` runs the executable specified by the target, which can be a component, a package or can be left blank, as long as it can uniquely identify an executable within the project. Tests and benchmarks are also treated as executables. -See `the new-build section <#cabal-new-build>`__ for the target syntax. +See `the v2-build section <#cabal-new-build>`__ for the target syntax. Except in the case of the empty target, the strings after it will be passed to the executable as arguments. @@ -449,9 +451,9 @@ :: - $ cabal new-run target -- -a -bcd --argument + $ cabal v2-run target -- -a -bcd --argument -'new-run' also supports running script files that use a certain format. With +'v2-run' also supports running script files that use a certain format. With a script that looks like: :: @@ -471,13 +473,13 @@ :: - $ cabal new-run script.hs - $ cabal new-run script.hs -- --arg1 # args are passed like this + $ cabal v2-run script.hs + $ cabal v2-run script.hs -- --arg1 # args are passed like this -cabal new-freeze +cabal v2-freeze ---------------- -``cabal new-freeze`` writes out a **freeze file** which records all of +``cabal v2-freeze`` writes out a **freeze file** which records all of the versions and flags which that are picked by the solver under the current index and flags. Default name of this file is ``cabal.project.freeze`` but in combination with a @@ -504,85 +506,95 @@ recommended: users often need to build against different versions of libraries than what you developed against. -cabal new-bench +cabal v2-bench --------------- -``cabal new-bench [TARGETS] [OPTIONS]`` runs the specified benchmarks +``cabal v2-bench [TARGETS] [OPTIONS]`` runs the specified benchmarks (all the benchmarks in the current package by default), first ensuring they are up to date. -cabal new-test +cabal v2-test -------------- -``cabal new-test [TARGETS] [OPTIONS]`` runs the specified test suites +``cabal v2-test [TARGETS] [OPTIONS]`` runs the specified test suites (all the test suites in the current package by default), first ensuring they are up to date. -cabal new-haddock +cabal v2-haddock ----------------- -``cabal new-haddock [FLAGS] [TARGET]`` builds Haddock documentation for +``cabal v2-haddock [FLAGS] [TARGET]`` builds Haddock documentation for the specified packages within the project. If a target is not a library :cfg-field:`haddock-benchmarks`, :cfg-field:`haddock-executables`, :cfg-field:`haddock-internal`, :cfg-field:`haddock-tests` will be implied as necessary. -cabal new-exec +cabal v2-exec --------------- -``cabal new-exec [FLAGS] [--] COMMAND [--] [ARGS]`` runs the specified command +``cabal v2-exec [FLAGS] [--] COMMAND [--] [ARGS]`` runs the specified command using the project's environment. That is, passing the right flags to compiler invocations and bringing the project's executables into scope. -cabal new-install +cabal v2-install ----------------- -``cabal new-install [FLAGS] PACKAGES`` builds the specified packages and -symlinks their executables in ``symlink-bindir`` (usually ``~/.cabal/bin``). +``cabal v2-install [FLAGS] PACKAGES`` builds the specified packages and +symlinks/copies their executables in ``installdir`` (usually ``~/.cabal/bin``). For example this command will build the latest ``cabal-install`` and symlink its ``cabal`` executable: :: - $ cabal new-install cabal-install + $ cabal v2-install cabal-install -In addition, it's possible to use ``cabal new-install`` to install components +In addition, it's possible to use ``cabal v2-install`` to install components of a local project. For example, with an up-to-date Git clone of the Cabal repository, this command will build cabal-install HEAD and symlink the ``cabal`` executable: :: - $ cabal new-install exe:cabal + $ cabal v2-install exe:cabal -It is also possible to "install" libraries using the ``--lib`` flag. For +Where symlinking is not possible (eg. on Windows), ``--install-method=copy`` +can be used: + +:: + + $ cabal v2-install exe:cabal --install-method=copy --installdir=~/bin + +Note that copied executables are not self-contained, since they might use +data-files from the store. + +It is also possible to "install" libraries using the ``--lib`` flag. For example, this command will build the latest Cabal library and install it: :: - $ cabal new-install --lib Cabal + $ cabal v2-install --lib Cabal This works by managing GHC environments. By default, it is writing to the global environment in ``~/.ghc/$ARCH-$OS-$GHCVER/environments/default``. -``new-install`` provides the ``--package-env`` flag to control which of +``v2-install`` provides the ``--package-env`` flag to control which of these environments is modified. This command will modify the environment file in the current directory: :: - $ cabal new-install --lib Cabal --package-env . + $ cabal v2-install --lib Cabal --package-env . -This command will modify the enviroment file in the ``~/foo`` directory: +This command will modify the environment file in the ``~/foo`` directory: :: - $ cabal new-install --lib Cabal --package-env foo/ + $ cabal v2-install --lib Cabal --package-env foo/ Do note that the results of the previous two commands will be overwritten by -the use of other new-style commands, so it is not reccomended to use them inside +the use of other v2-style commands, so it is not recommended to use them inside a project directory. This command will modify the environment in the "local.env" file in the @@ -590,13 +602,13 @@ :: - $ cabal new-install --lib Cabal --package-env local.env + $ cabal v2-install --lib Cabal --package-env local.env This command will modify the ``myenv`` named global environment: :: - $ cabal new-install --lib Cabal --package-env myenv + $ cabal v2-install --lib Cabal --package-env myenv If you wish to create a named environment file in the current directory where the name does not contain an extension, you must reference it as ``./myenv``. @@ -604,10 +616,10 @@ You can learn more about how to use these environments in `this section of the GHC manual `_. -cabal new-clean +cabal v2-clean --------------- -``cabal new-clean [FLAGS]`` cleans up the temporary files and build artifacts +``cabal v2-clean [FLAGS]`` cleans up the temporary files and build artifacts stored in the ``dist-newstyle`` folder. By default, it removes the entire folder, but it can also spare the configuration @@ -615,23 +627,19 @@ the build artefacts (``.hi``, ``.o`` along with any other temporary files generated by the compiler, along with the build output). -cabal new-sdist +cabal v2-sdist --------------- -``cabal new-sdist [FLAGS] [TARGETS]`` takes the crucial files needed to build ``TARGETS`` +``cabal v2-sdist [FLAGS] [TARGETS]`` takes the crucial files needed to build ``TARGETS`` and puts them into an archive format ready for upload to Hackage. These archives are stable and two archives of the same format built from the same source will hash to the same value. -``cabal new-sdist`` takes the following flags: +``cabal v2-sdist`` takes the following flags: - ``-l``, ``--list-only``: Rather than creating an archive, lists files that would be included. Output is to ``stdout`` by default. The file paths are relative to the project's root directory. -- ``--targz``: Output an archive in ``.tar.gz`` format. - -- ``--zip``: Output an archive in ``.zip`` format. - - ``-o``, ``--output-dir``: Sets the output dir, if a non-default one is desired. The default is ``dist-newstyle/sdist/``. ``--output-dir -`` will send output to ``stdout`` unless multiple archives are being created. @@ -639,9 +647,9 @@ - ``-z``, ``--null``: Only used with ``--list-only``. Separates filenames with a NUL byte instead of newlines. -``new-sdist`` is inherently incompatible with sdist hooks, not due to implementation but due +``v2-sdist`` is inherently incompatible with sdist hooks, not due to implementation but due to fundamental core invariants (same source code should result in the same tarball, byte for -byte) that must be satisfied for it to function correctly in the larger new-build ecosystem. +byte) that must be satisfied for it to function correctly in the larger v2-build ecosystem. ``autogen-modules`` is able to replace uses of the hooks to add generated modules, along with the custom publishing of Haddock documentation to Hackage. @@ -663,7 +671,7 @@ In general, the accepted field names coincide with the accepted command line flags that ``cabal install`` and other commands take. For example, -``cabal new-configure --enable-profiling`` will write out a project +``cabal v2-configure --enable-profiling`` will write out a project file with ``profiling: True``. The full configuration of a project is determined by combining the @@ -671,11 +679,11 @@ 1. ``~/.cabal/config`` (the user-wide global configuration) -2. ``cabal.project`` (the project configuratoin) +2. ``cabal.project`` (the project configuration) -3. ``cabal.project.freeze`` (the output of ``cabal new-freeze``) +3. ``cabal.project.freeze`` (the output of ``cabal v2-freeze``) -4. ``cabal.project.local`` (the output of ``cabal new-configure``) +4. ``cabal.project.local`` (the output of ``cabal v2-configure``) Specifying the local packages @@ -733,10 +741,8 @@ There is no command line variant of this field. -[STRIKEOUT:There is also a stanza ``source-repository-package`` for -specifying packages from an external version control.] (Not -implemented.) + All local packages are *vendored*, in the sense that if other packages (including external ones from Hackage) depend on a package with the name of a local package, the local package is preferentially used. This @@ -753,7 +759,7 @@ foo-helper/ # local package unix/ # vendored external package -All of these options support globs. ``cabal new-build`` has its own glob +All of these options support globs. ``cabal v2-build`` has its own glob format: - Anywhere in a path, as many times as you like, you can specify an @@ -769,6 +775,9 @@ Formally, the format described by the following BNF: +.. todo:: + convert globbing grammar to proper ABNF_ syntax + .. code-block:: abnf FilePathGlob ::= FilePathRoot FilePathGlobRel @@ -786,12 +795,43 @@ | "\\" [*{},] # escaped reserved character | "{" Glob "," ... "," Glob "}" # union (match any of these) + +Specifying Packages from Remote Version Control Locations +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Starting with Cabal 2.4, there is now a stanza +``source-repository-package`` for specifying packages from an external +version control which supports the following fields: + +- :pkg-field:`source-repository:type` +- :pkg-field:`source-repository:location` +- :pkg-field:`source-repository:tag` +- :pkg-field:`source-repository:subdir` + +A simple example is shown below: + +.. code-block:: cabal + + packages: . + + source-repository-package + type: git + location: https://github.com/hvr/HsYAML.git + tag: e70cf0c171c9a586b62b3f75d72f1591e4e6aaa1 + + source-repository-package + type: git + location: https://github.com/well-typed/cborg + tag: 3d274c14ca3077c3a081ba7ad57c5182da65c8c1 + subdir: cborg + Global configuration options ---------------------------- The following top-level configuration options are not specific to any package, and thus apply globally: + .. cfg-field:: verbose: nat --verbose=n, -vn :synopsis: Build verbosity level. @@ -861,7 +901,7 @@ .. option:: --store-dir=DIR Specifies the name of the directory of the global package store. - + Solver configuration options ---------------------------- @@ -874,7 +914,7 @@ Add extra constraints to the version bounds, flag settings, and other properties a solver can pick for a package. For example: - + :: constraints: bar == 2.1 @@ -909,7 +949,7 @@ dependency solver runtime. One way to use :cfg-field:`preferences` is to take a known working set of - constraints (e.g., via ``cabal new-freeze``) and record them as + constraints (e.g., via ``cabal v2-freeze``) and record them as preferences. In this case, the solver will first attempt to use this configuration, and if this violates hard constraints, it will try to find the minimal number of upgrades to satisfy the hard constraints @@ -1043,11 +1083,27 @@ index-state: @1474739268 -- ISO8601 UTC timestamp format example - -- This format is used by 'cabal new-configure' + -- This format is used by 'cabal v2-configure' -- for storing `--index-state` values. index-state: 2016-09-24T17:47:48Z +.. cfg-field:: reject-unconstrained-dependencies: all, none + --reject-unconstrained-dependencies=[all|none] + :synopsis: Restrict the solver to packages that have constraints on them. + + :default: none + :since: 2.6 + + By default, the dependency solver can include any package that it's + aware of in a build plan. If you wish to restrict the build plan to + a closed set of packages (e.g., from a freeze file), use this flag. + + When set to `all`, all non-local packages that aren't goals must be + explicitly constrained. When set to `none`, the solver will + consider all packages. + + Package configuration options ----------------------------- @@ -1120,7 +1176,7 @@ The command line variant of this flag is ``--flags``. There is also a shortened form ``-ffoo -f-bar``. - A common mistake is to say ``cabal new-build -fhans``, where + A common mistake is to say ``cabal v2-build -fhans``, where ``hans`` is a flag for a transitive dependency that is not in the local package; in this case, the flag will be silently ignored. If ``haskell-tor`` is the package you want this flag to apply to, try @@ -1145,7 +1201,7 @@ ``ghc-pkg`` in the same directory as the ``ghc`` directory. If this heuristic does not work, set :cfg-field:`with-hc-pkg` explicitly. - For inplace packages, ``cabal new-build`` maintains a separate build + For inplace packages, ``cabal v2-build`` maintains a separate build directory for each version of GHC, so you can maintain multiple build trees for different versions of GHC without clobbering each other. @@ -1319,7 +1375,7 @@ --enable-split-sections --disable-split-sections :synopsis: Use GHC's split sections feature. - :since: 2.1 + :since: 2.2 :default: False @@ -1368,7 +1424,8 @@ Not all Haskell implementations generate native binaries. For such implementations this option has no effect. - (TODO: Check what happens if you combine this with ``debug-info``.) + If ``debug-info`` is set explicitly then ``executable-stripping`` is set + to ``False`` as otherwise all the debug symbols will be stripped. The command line variant of this flag is ``--enable-executable-stripping`` and @@ -1378,12 +1435,15 @@ --enable-library-stripping --disable-library-stripping :synopsis: Strip installed libraries. - :since: 1.19 + :since: 1.20 When installing binary libraries, run the ``strip`` program on the binary, saving space on the file system. See also ``executable-stripping``. + If ``debug-info`` is set explicitly then ``library-stripping`` is set + to ``False`` as otherwise all the debug symbols will be stripped. + The command line variant of this flag is ``--enable-library-stripping`` and ``--disable-library-stripping``. @@ -1474,7 +1534,7 @@ .. cfg-field:: relocatable: --relocatable :synopsis: Build relocatable package. - :since: 1.21 + :since: 1.22 :default: False @@ -1495,9 +1555,22 @@ :default: False Roll this and all dependent libraries into a combined ``.a`` archive. - This uses GHCs ``-staticlib`` flag, which is avaiable for iOS and with + This uses GHCs ``-staticlib`` flag, which is available for iOS and with GHC 8.4 and later for other platforms as well. +.. cfg-field:: executable-static: boolean + --enable-executable-static + --disable-executable-static + :synopsis: Build fully static executables. + + + :default: False + + Build fully static executables. + This link all dependent libraries into executables statically, + including libc. + This passes ``-static`` and ``-optl=-static`` to GHC. + Foreign function interface options ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ @@ -1557,14 +1630,14 @@ --enable-profiling --disable-profiling :synopsis: Enable profiling builds. - :since: 1.21 + :since: 1.22 :default: False Build libraries and executables with profiling enabled (for compilers that support profiling as a separate mode). It is only necessary to specify :cfg-field:`profiling` for the specific package you - want to profile; ``cabal new-build`` will ensure that all of its + want to profile; ``cabal v2-build`` will ensure that all of its transitive dependencies are built with profiling enabled. To enable profiling for only libraries or executables, see @@ -1579,7 +1652,7 @@ .. cfg-field:: profiling-detail: level --profiling-detail=level :synopsis: Profiling detail level. - :since: 1.23 + :since: 1.24 Some compilers that support profiling, notably GHC, can allocate costs to different parts of the program and there are different @@ -1619,7 +1692,7 @@ .. cfg-field:: library-profiling-detail: level --library-profiling-detail=level :synopsis: Libraries profiling detail level. - :since: 1.23 + :since: 1.24 Like :cfg-field:`profiling-detail`, but applied only to libraries @@ -1644,7 +1717,7 @@ --enable-library-profiling --disable-library-profiling :synopsis: Build libraries with profiling enabled. - :since: 1.21 + :since: 1.22 :default: False @@ -1658,7 +1731,7 @@ --enable-executable-profiling --disable-executable-profiling :synopsis: Build executables with profiling enabled. - :since: 1.21 + :since: 1.22 :default: False @@ -1676,7 +1749,7 @@ --enable-coverage --disable-coverage :synopsis: Build with coverage enabled. - :since: 1.21 + :since: 1.22 :default: False @@ -1690,7 +1763,7 @@ .. cfg-field:: library-coverage: boolean --enable-library-coverage --disable-library-coverage - :since: 1.21 + :since: 1.22 :deprecated: :default: False @@ -1874,18 +1947,20 @@ Advanced global configuration options ------------------------------------- -.. cfg-field:: write-ghc-environment-files: always, never, or ghc-8.4.4+ - --write-ghc-enviroment-files=policy - :synopsis: Whether a ``.ghc.enviroment`` should be created after a successful build. +.. cfg-field:: write-ghc-environment-files: always, never, or ghc8.4.4+ + --write-ghc-environment-files=policy + :synopsis: Whether a ``.ghc.environment`` should be created after a successful build. - :default: ``ghc-8.4.4+`` + :default: ``never`` Whether a `GHC package environment file `_ should be created after a successful build. - Defaults to creating them only when compiling with GHC 8.4.4 and - older (GHC 8.4.4 `is the first version `_ that supports the - ``-package-env -`` option that allows ignoring the package + Since Cabal 3.0, defaults to ``never``. Before that, defaulted to + creating them only when compiling with GHC 8.4.4 and older (GHC + 8.4.4 `is the first version + `_ that supports + the ``-package-env -`` option that allows ignoring the package environment files). @@ -1991,13 +2066,13 @@ --max-backjumps=N :synopsis: Maximum number of solver backjumps. - :default: 2000 + :default: 4000 Maximum number of backjumps (backtracking multiple steps) allowed while solving. Set -1 to allow unlimited backtracking, and 0 to disable backtracking completely. - The command line variant of this field is ``--max-backjumps=2000``. + The command line variant of this field is ``--max-backjumps=4000``. .. cfg-field:: reorder-goals: boolean --reorder-goals @@ -2026,6 +2101,21 @@ The command line variant of this field is ``--(no-)count-conflicts``. + +.. cfg-field:: minimize-conflict-set: boolean + --minimize-conflict-set + --no-minimize-conflict-set + :synopsis: Try to improve the solver error message when there is no + solution. + + :default: False + + When there is no solution, try to improve the solver error message + by finding a minimal conflict set. This option may increase run + time significantly, so it is off by default. + + The command line variant of this field is + ``--(no-)minimize-conflict-set``. .. cfg-field:: strong-flags: boolean --strong-flags diff --git a/cabal/Cabal/doc/references.inc b/cabal/Cabal/doc/references.inc --- a/cabal/Cabal/doc/references.inc +++ b/cabal/Cabal/doc/references.inc @@ -22,3 +22,5 @@ .. _cpphs: http://projects.haskell.org/cpphs/ .. _ABNF: https://tools.ietf.org/html/rfc5234 + +.. _Backpack: https://ghc.haskell.org/trac/ghc/wiki/Backpack diff --git a/cabal/Makefile b/cabal/Makefile --- a/cabal/Makefile +++ b/cabal/Makefile @@ -2,27 +2,44 @@ .PHONY : gen-extra-source-files gen-extra-source-files-lib gen-extra-source-files-cli .PHONY : cabal-install-dev cabal-install-prod -LEXER_HS:=Cabal/Distribution/Parsec/Lexer.hs +LEXER_HS:=Cabal/Distribution/Fields/Lexer.hs SPDX_LICENSE_HS:=Cabal/Distribution/SPDX/LicenseId.hs SPDX_EXCEPTION_HS:=Cabal/Distribution/SPDX/LicenseExceptionId.hs +CABALBUILD := cabal new-build --enable-tests +CABALRUN := cabal new-run --enable-tests + +# default rules + all : exe lib -lexer : $(LEXER_HS) +lib : $(LEXER_HS) + $(CABALBUILD) Cabal:libs -spdx : $(SPDX_LICENSE_HS) $(SPDX_EXCEPTION_HS) +exe : $(LEXER_HS) + $(CABALBUILD) cabal-install:exes +# source generation: Lexer + +lexer : $(LEXER_HS) + $(LEXER_HS) : boot/Lexer.x alex --latin1 --ghc -o $@ $^ cat -s $@ > Lexer.tmp mv Lexer.tmp $@ +# source generation: SPDX + +spdx : $(SPDX_LICENSE_HS) $(SPDX_EXCEPTION_HS) + $(SPDX_LICENSE_HS) : boot/SPDX.LicenseId.template.hs cabal-dev-scripts/src/GenUtils.hs cabal-dev-scripts/src/GenSPDX.hs license-list-data/licenses-3.0.json license-list-data/licenses-3.2.json - cabal new-run --builddir=dist-newstyle-meta --project-file=cabal.project.meta gen-spdx -- boot/SPDX.LicenseId.template.hs license-list-data/licenses-3.0.json license-list-data/licenses-3.2.json $(SPDX_LICENSE_HS) + cabal new-run --builddir=dist-newstyle-meta --project-file=cabal.project.meta gen-spdx -- boot/SPDX.LicenseId.template.hs license-list-data/licenses-3.0.json license-list-data/licenses-3.2.json license-list-data/licenses-3.6.json $(SPDX_LICENSE_HS) $(SPDX_EXCEPTION_HS) : boot/SPDX.LicenseExceptionId.template.hs cabal-dev-scripts/src/GenUtils.hs cabal-dev-scripts/src/GenSPDXExc.hs license-list-data/exceptions-3.0.json license-list-data/exceptions-3.2.json - cabal new-run --builddir=dist-newstyle-meta --project-file=cabal.project.meta gen-spdx-exc -- boot/SPDX.LicenseExceptionId.template.hs license-list-data/exceptions-3.0.json license-list-data/exceptions-3.2.json $(SPDX_EXCEPTION_HS) + cabal new-run --builddir=dist-newstyle-meta --project-file=cabal.project.meta gen-spdx-exc -- boot/SPDX.LicenseExceptionId.template.hs license-list-data/exceptions-3.0.json license-list-data/exceptions-3.2.json license-list-data/exceptions-3.6.json $(SPDX_EXCEPTION_HS) +# cabal-install.cabal file generation + cabal-install-prod : cabal-install/cabal-install.cabal.pp runghc cabal-dev-scripts/src/Preprocessor.hs -o cabal-install/cabal-install.cabal cabal-install/cabal-install.cabal.pp git update-index --no-assume-unchanged cabal-install/cabal-install.cabal @@ -37,14 +54,7 @@ @echo "tell git to ignore changes to cabal-install.cabal:" @echo "git update-index --assume-unchanged cabal-install/cabal-install.cabal" -lib : $(LEXER_HS) - cabal new-build --enable-tests Cabal - -exe : $(LEXER_HS) - cabal new-build --enable-tests cabal-install - -doctest : - doctest --fast Cabal/Distribution Cabal/Language +# extra-source-files generation gen-extra-source-files : gen-extra-source-files-lib gen-extra-source-files-cli @@ -57,7 +67,41 @@ cabal new-run --builddir=dist-newstyle-meta --project-file=cabal.project.meta gen-extra-source-files -- $$(pwd)/cabal-install/cabal-install.cabal.pp $$(pwd)/cabal-install/cabal-install.cabal $(MAKE) cabal-install-prod +# ghcid + +ghcid-lib : + ghcid -c 'cabal new-repl Cabal' + +ghcid-cli : + ghcid -c 'cabal new-repl cabal-install' + +# doctests (relies on .ghc.environment files) + +doctest : + doctest --fast Cabal/Distribution Cabal/Language + +# tests + +check-tests : + $(CABALRUN) --enable-tests check-tests -- --cwd Cabal ${TEST} + +parser-tests : + $(CABALRUN) parser-tests -- --cwd Cabal ${TEST} + +parser-tests-accept : + $(CABALRUN) parser-tests -- --cwd Cabal --accept ${TEST} + +custom-setup-tests : + $(CABALRUN) custom-setup-tests -- + +hackage-parsec-tests : + $(CABALRUN) hackage-tests -- parsec +RTS -s -qg -I0 -A64M -N${THREADS} -RTS ${TEST} + +hackage-roundtrip-tests : + $(CABALRUN) hackage-tests -- roundtrip +RTS -s -qg -I0 -A64M -N${THREADS} -RTS ${TEST} + cabal-install-test: - cabal new-build -j3 all --disable-tests --disable-benchmarks + @which cabal-plan + $(CABALBUILD) -j3 cabal-tests cabal rm -rf .ghc.environment.* cd cabal-testsuite && `cabal-plan list-bin cabal-tests` --with-cabal=`cabal-plan list-bin cabal` --hide-successes -j3 ${TEST} diff --git a/cabal/README.md b/cabal/README.md --- a/cabal/README.md +++ b/cabal/README.md @@ -1,5 +1,7 @@ # Cabal [![Hackage version](https://img.shields.io/hackage/v/Cabal.svg?label=Hackage)](https://hackage.haskell.org/package/Cabal) [![Stackage version](https://www.stackage.org/package/Cabal/badge/lts?label=Stackage)](https://www.stackage.org/package/Cabal) [![Build Status](https://secure.travis-ci.org/haskell/cabal.svg?branch=master)](http://travis-ci.org/haskell/cabal) [![Windows build status](https://ci.appveyor.com/api/projects/status/github/haskell/cabal?branch=master&svg=true)](https://ci.appveyor.com/project/23Skidoo/cabal) [![Documentation Status](http://readthedocs.org/projects/cabal/badge/?version=latest)](http://cabal.readthedocs.io/en/latest/?badge=latest) + + This Cabal Git repository contains the following packages: * [Cabal](Cabal/README.md): the Cabal library package ([license](Cabal/LICENSE)) @@ -44,253 +46,4 @@ cabal-install $ ./bootstrap.sh # running ./bootstrap.sh from within in cabal-install folder. ~~~~ -For more details, and non-unix like systems, see the [README.md in cabal-install](cabal-install/README.md) - -Building Cabal for hacking --------------------------- - -The current recommended way of developing Cabal is to use the -`new-build` feature which [shipped in cabal-install-1.24](http://blog.ezyang.com/2016/05/announcing-cabal-new-build-nix-style-local-builds/). Assuming -that you have a sufficiently recent cabal-install (see above), -it is sufficient to run: - -~~~~ -cabal new-build cabal -~~~~ - -To build a local, development copy of cabal-install. The location -of your build products will vary depending on which version of -cabal-install you use to build; see the documentation section -[Where are my build products?](http://cabal.readthedocs.io/en/latest/nix-local-build.html#where-are-my-build-products) -to find the binary (or just run `find -type f -executable -name cabal`). - -Here are some other useful variations on the commands: - -~~~~ -cabal new-build Cabal # build library only -cabal new-build Cabal:unit-tests # build Cabal's unit test suite -cabal new-build cabal-tests # etc... -~~~~ - -**Dogfooding HEAD.** -Many of the core developers of Cabal dogfood `cabal-install` HEAD -when doing development on Cabal. This helps us identify bugs -which were missed by the test suite and easily experiment with new -features. - -The recommended workflow in this case is slightly different: you will -maintain two Cabal source trees: your production tree (built with a -released version of Cabal) which always tracks `master` and which you -update only when you want to move to a new version of Cabal to dogfood, -and your development tree (built with your production Cabal) that you -actually do development on. - -In more detail, suppose you have checkouts of Cabal at `~/cabal-prod` -and `~/cabal-dev`, and you have a release copy of cabal installed at -`/opt/cabal/2.4/bin/cabal`. First, build your production tree: - -~~~~ -cd ~/cabal-prod -/opt/cabal/2.4/bin/cabal new-build cabal -~~~~ - -This will produce a cabal binary (see also: [Where are my build products?](http://cabal.readthedocs.io/en/latest/nix-local-build.html#where-are-my-build-products) -). Add this binary to your PATH, -and then use it to build your development copy: - -~~~~ -cd ~/cabal-dev -cabal new-build cabal -~~~~ - -Running tests -------------- - -**Using Travis and AppVeyor.** -If you are not in a hurry, the most convenient way to run tests on Cabal -is to make a branch on GitHub and then open a pull request; our -continuous integration service on Travis and AppVeyor will build and -test your code. Title your PR with WIP so we know that it does not need -code review. - -Some tips for using Travis effectively: - -* Travis builds take a long time. Use them when you are pretty - sure everything is OK; otherwise, try to run relevant tests locally - first. - -* Watch over your jobs on the [Travis website](http://travis-ci.org). - If you know a build of yours is going to fail (because one job has - already failed), be nice to others and cancel the rest of the jobs, - so that other commits on the build queue can be processed. - -* If you want realtime notification when builds of your PRs finish, we have a [Slack team](https://haskell-cabal.slack.com/). To get issued an invite, fill in your email at [this sign up page](https://haskell-cabal.herokuapp.com). - -**How to debug a failing CI test.** -One of the annoying things about running tests on CI is when they -fail, there is often no easy way to further troubleshoot the broken -build. Here are some guidelines for debugging continuous integration -failures: - -1. Can you tell what the problem is by looking at the logs? The - `cabal-testsuite` tests run with `-v` logging by default, which - is dumped to the log upon failure; you may be able to figure out - what the problem is directly this way. - -2. Can you reproduce the problem by running the test locally? - See the next section for how to run the various test suites - on your local machine. - -3. Is the test failing only for a specific version of GHC, or - a specific operating system? If so, try reproducing the - problem on the specific configuration. - -4. Is the test failing on a Travis per-GHC build - ([for example](https://travis-ci.org/haskell-pushbot/cabal-binaries/builds/208128401))? - In this case, if you click on "Branch", you can get access to - the precise binaries that were built by Travis that are being - tested. If you have an Ubuntu system, you can download - the binaries and run them directly. - -5. Is the test failing on AppVeyor? Consider logging in via - Remote Desktop to the build VM: - https://www.appveyor.com/docs/how-to/rdp-to-build-worker/ - -If none of these let you reproduce, there might be some race condition -or continuous integration breakage; please file a bug. - -**Running tests locally.** -To run tests locally with `new-build`, you will need to know the -name of the test suite you want. Cabal and cabal-install have -several. Also, you'll want to read [Where are my build products?](http://cabal.readthedocs.io/en/latest/nix-local-build.html#where-are-my-build-products) - -The most important test suite is `cabal-testsuite`: most user-visible -changes to Cabal should come with a test in this framework. See -[cabal-testsuite/README.md](cabal-testsuite/README.md) for more -information about how to run tests and write new ones. Quick -start: use `cabal-tests` to run `Cabal` tests, and `cabal-tests ---with-cabal=/path/to/cabal` to run `cabal-install` tests -(don't forget `--with-cabal`! Your cabal-install tests won't -run without it). - -There are also other test suites: - -* `Cabal:unit-tests` are small, quick-running unit tests - on small pieces of functionality in Cabal. If you are working - on some utility functions in the Cabal library you should run this - test suite. - -* `cabal-install:unit-tests` are small, quick-running unit tests on - small pieces of functionality in cabal-install. If you are working - on some utility functions in cabal-install you should run this test - suite. - -* `cabal-install:solver-quickcheck` are QuickCheck tests on - cabal-install's dependency solver. If you are working - on the solver you should run this test suite. - -* `cabal-install:integration-tests2` are integration tests on some - top-level API functions inside the `cabal-install` source code. - -For these test executables, `-p` which applies a regex filter to the test -names. - -Conventions ------------ - -* Spaces, not tabs. - -* Try to follow style conventions of a file you are modifying, and - avoid gratuitous reformatting (it makes merges harder!) - -* Format your commit messages [in the standard way](https://chris.beams.io/posts/git-commit/#seven-rules). - -* A lot of Cabal does not have top-level comments. We are trying to - fix this. If you add new top-level definitions, please Haddock them; - and if you spend some time understanding what a function does, help - us out and add a comment. We'll try to remind you during code review. - -* If you do something tricky or non-obvious, add a comment. - -* If your commit only touches comments, you can use `[ci skip]` - anywhere in the body of the commit message to avoid needlessly - triggering the build bots. - -* For local imports (Cabal module importing Cabal module), import lists - are NOT required (although you may use them at your discretion.) For - third-party and standard library imports, please use either qualified imports - or explicit import lists. - -* You can use basically any GHC extension supported by a GHC in our - support window, except Template Haskell, which would cause - bootstrapping problems in the GHC compilation process. - -* Our GHC support window is five years for the Cabal library and three - years for cabal-install: that is, the Cabal library must be - buildable out-of-the-box with the dependencies that shipped with GHC - for at least five years. The Travis CI checks this, so most - developers submit a PR to see if their code works on all these - versions of GHC. `cabal-install` must also be buildable on all - supported GHCs, although it does not have to be buildable - out-of-the-box. Instead, the `cabal-install/bootstrap.sh` script - must be able to download and install all of the dependencies (this - is also checked by CI). Also, self-upgrade to the latest version - (i.e. `cabal install cabal-install`) must work with all versions of - `cabal-install` released during the last three years. - -* `Cabal` has its own Prelude, in `Distribution.Compat.Prelude`, - that provides a compatibility layer and exports some commonly - used additional functions. Use it in all new modules. - -* As far as possible, please do not use CPP. If you must use it, - try to put it in a `Compat` module, and minimize the amount of code - that is enclosed by CPP. For example, prefer: - ``` - f :: Int -> Int - #ifdef mingw32_HOST_OS - f = (+1) - #else - f = (+2) - #endif - ``` - - over: - ``` - #ifdef mingw32_HOST_OS - f :: Int -> Int - f = (+1) - #else - f :: Int -> Int - f = (+2) - #endif - ``` - -We like [this style guide][guide]. - -[guide]: https://github.com/tibbe/haskell-style-guide/blob/master/haskell-style.md - -Communicating -------------- - -There are a few main venues of communication: - -* Most developers subscribe to receive messages from [all issues](https://github.com/haskell/cabal/issues); issues can be used to [open discussion](https://github.com/haskell/cabal/issues?q=is%3Aissue+is%3Aopen+custom+label%3A%22type%3A+discussion%22). If you know someone who should hear about a message, CC them explicitly using the @username GitHub syntax. - -* For more organizational concerns, the [mailing - list](http://www.haskell.org/mailman/listinfo/cabal-devel) is used. - -* Many developers idle on `#hackage` on `irc.freenode.net` ([archives](http://ircbrowse.net/browse/hackage)). `#ghc` ([archives](http://ircbrowse.net/browse/ghc)) is also a decently good bet. - -Releases --------- - -Notes for how to make a release are at the -wiki page ["Making a release"](https://github.com/haskell/cabal/wiki/Making-a-release). -Currently, @23Skidoo, @rthomas, @tibbe and @dcoutts have access to -`haskell.org/cabal`, and @davean is the point of contact for getting -permissions. - -API Documentation ------------------ - -Auto-generated API documentation for the `master` branch of Cabal is automatically uploaded here: http://haskell.github.io/cabal-website/doc/html/Cabal/. +For more details, and non-unix like systems, see the [README.md in cabal-install](cabal-install/README.md) and [Contributing Guidelines](CONTRIBUTING.md). diff --git a/cabal/appveyor.yml b/cabal/appveyor.yml --- a/cabal/appveyor.yml +++ b/cabal/appveyor.yml @@ -1,3 +1,22 @@ +# We whitelist branches, as we don't really need to build dev-branches. +# Remember to add release branches, both here and to .travis.yml. +branches: + only: + - master + - "3.0" + - "2.4" + - "2.2" + - "2.0" + - "1.24" + - "1.22" + - "1.20" + - "1.18" + + +# Do not build feature branch with open Pull Requests +# prevents PR double builds as branch +skip_branch_with_pr: true + install: # Using '-y' and 'refreshenv' as a workaround to: # https://github.com/haskell/cabal/issues/3687 @@ -5,18 +24,19 @@ - choco install -y ghc --version 8.0.2 --ignore-dependencies - choco install -y cabal-head -pre - refreshenv - # See http://help.appveyor.com/discussions/problems/6312-curl-command-not-found#comment_42195491 - # NB: Do this after refreshenv, otherwise it will be clobbered! - - set PATH=%APPDATA%\cabal\bin;C:\Program Files\Git\cmd;C:\Program Files\Git\mingw64\bin;C:\msys64\usr\bin;%PATH% - cabal --version - cabal %CABOPTS% update - - cabal %CABOPTS% install happy alex + - cabal %CABOPTS% v1-install happy alex environment: global: CABOPTS: "--store-dir=C:\\SR" + # Remove cache, there is no button on the web + # https://www.appveyor.com/docs/build-cache/#skipping-cache-operations-for-specific-build + APPVEYOR_CACHE_SKIP_RESTORE: true cache: + - dist-newstyle - "C:\\sr" build_script: @@ -28,10 +48,11 @@ - cabal %CABOPTS% new-test Cabal - appveyor-retry cabal %CABOPTS% new-build exe:cabal exe:cabal-tests --only-dependencies - cabal %CABOPTS% new-build exe:cabal - - cabal %CABOPTS% new-run cabal-tests -- -j3 --with-cabal=dist-newstyle\build\x86_64-windows\ghc-8.0.2\cabal-install-2.4.1.0\x\cabal\build\cabal\cabal.exe + - cabal %CABOPTS% new-run cabal-tests -- -j3 --with-cabal=dist-newstyle\build\x86_64-windows\ghc-8.0.2\cabal-install-3.1.0.0\x\cabal\build\cabal\cabal.exe - appveyor-retry cabal %CABOPTS% new-build cabal-install:tests --only-dependencies - cd cabal-install - cabal %CABOPTS% new-run cabal-install:memory-usage-tests - cabal %CABOPTS% new-run cabal-install:solver-quickcheck - cabal %CABOPTS% new-run cabal-install:integration-tests2 - cabal %CABOPTS% new-run cabal-install:unit-tests -- --pattern "! (/FileMonitor/ || /VCS/ || /Get/)" + diff --git a/cabal/boot/Lexer.x b/cabal/boot/Lexer.x --- a/cabal/boot/Lexer.x +++ b/cabal/boot/Lexer.x @@ -1,7 +1,7 @@ { ----------------------------------------------------------------------------- -- | --- Module : Distribution.Parsec.Lexer +-- Module : Distribution.Fields.Lexer -- License : BSD3 -- -- Maintainer : cabal-devel@haskell.org @@ -14,7 +14,7 @@ {-# LANGUAGE PatternGuards #-} #endif {-# OPTIONS_GHC -fno-warn-unused-imports #-} -module Distribution.Parsec.Lexer +module Distribution.Fields.Lexer (ltest, lexToken, Token(..), LToken(..) ,bol_section, in_section, in_field_layout, in_field_braces ,mkLexState) where @@ -35,8 +35,8 @@ import qualified Prelude as Prelude import Distribution.Compat.Prelude -import Distribution.Parsec.LexerMonad -import Distribution.Parsec.Common (Position (..), incPos, retPos) +import Distribution.Fields.LexerMonad +import Distribution.Parsec.Position (Position (..), incPos, retPos) import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B.Char8 diff --git a/cabal/boot/SPDX.LicenseExceptionId.template.hs b/cabal/boot/SPDX.LicenseExceptionId.template.hs --- a/cabal/boot/SPDX.LicenseExceptionId.template.hs +++ b/cabal/boot/SPDX.LicenseExceptionId.template.hs @@ -12,10 +12,12 @@ import Prelude () import Distribution.Pretty -import Distribution.Parsec.Class +import Distribution.Parsec import Distribution.Utils.Generic (isAsciiAlphaNum) import Distribution.SPDX.LicenseListVersion +import qualified Data.Binary.Get as Binary +import qualified Data.Binary.Put as Binary import qualified Data.Map.Strict as Map import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp @@ -29,7 +31,13 @@ {{{ licenseIds }}} deriving (Eq, Ord, Enum, Bounded, Show, Read, Typeable, Data, Generic) -instance Binary LicenseExceptionId +instance Binary LicenseExceptionId where + put = Binary.putWord8 . fromIntegral . fromEnum + get = do + i <- Binary.getWord8 + if i > fromIntegral (fromEnum (maxBound :: LicenseExceptionId)) + then fail "Too large LicenseExceptionId tag" + else return (toEnum (fromIntegral i)) instance Pretty LicenseExceptionId where pretty = Disp.text . licenseExceptionId @@ -71,11 +79,15 @@ licenseExceptionIdList LicenseListVersion_3_2 = {{{licenseList_3_2}}} ++ bulkOfLicenses +licenseExceptionIdList LicenseListVersion_3_6 = +{{{licenseList_3_6}}} + ++ bulkOfLicenses -- | Create a 'LicenseExceptionId' from a 'String'. mkLicenseExceptionId :: LicenseListVersion -> String -> Maybe LicenseExceptionId mkLicenseExceptionId LicenseListVersion_3_0 s = Map.lookup s stringLookup_3_0 mkLicenseExceptionId LicenseListVersion_3_2 s = Map.lookup s stringLookup_3_2 +mkLicenseExceptionId LicenseListVersion_3_6 s = Map.lookup s stringLookup_3_6 stringLookup_3_0 :: Map String LicenseExceptionId stringLookup_3_0 = Map.fromList $ map (\i -> (licenseExceptionId i, i)) $ @@ -84,6 +96,10 @@ stringLookup_3_2 :: Map String LicenseExceptionId stringLookup_3_2 = Map.fromList $ map (\i -> (licenseExceptionId i, i)) $ licenseExceptionIdList LicenseListVersion_3_2 + +stringLookup_3_6 :: Map String LicenseExceptionId +stringLookup_3_6 = Map.fromList $ map (\i -> (licenseExceptionId i, i)) $ + licenseExceptionIdList LicenseListVersion_3_6 -- | License exceptions in all SPDX License lists bulkOfLicenses :: [LicenseExceptionId] diff --git a/cabal/boot/SPDX.LicenseId.template.hs b/cabal/boot/SPDX.LicenseId.template.hs --- a/cabal/boot/SPDX.LicenseId.template.hs +++ b/cabal/boot/SPDX.LicenseId.template.hs @@ -15,10 +15,12 @@ import Prelude () import Distribution.Pretty -import Distribution.Parsec.Class +import Distribution.Parsec import Distribution.Utils.Generic (isAsciiAlphaNum) import Distribution.SPDX.LicenseListVersion +import qualified Data.Binary.Get as Binary +import qualified Data.Binary.Put as Binary import qualified Data.Map.Strict as Map import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp @@ -32,7 +34,15 @@ {{{ licenseIds }}} deriving (Eq, Ord, Enum, Bounded, Show, Read, Typeable, Data, Generic) -instance Binary LicenseId +instance Binary LicenseId where + -- Word16 is encoded in big endianess + -- https://github.com/kolmodin/binary/blob/master/src/Data/Binary/Class.hs#L220-LL227 + put = Binary.putWord16be . fromIntegral . fromEnum + get = do + i <- Binary.getWord16be + if i > fromIntegral (fromEnum (maxBound :: LicenseId)) + then fail "Too large LicenseId tag" + else return (toEnum (fromIntegral i)) instance Pretty LicenseId where pretty = Disp.text . licenseId @@ -129,11 +139,15 @@ licenseIdList LicenseListVersion_3_2 = {{{licenseList_3_2}}} ++ bulkOfLicenses +licenseIdList LicenseListVersion_3_6 = +{{{licenseList_3_6}}} + ++ bulkOfLicenses -- | Create a 'LicenseId' from a 'String'. mkLicenseId :: LicenseListVersion -> String -> Maybe LicenseId mkLicenseId LicenseListVersion_3_0 s = Map.lookup s stringLookup_3_0 mkLicenseId LicenseListVersion_3_2 s = Map.lookup s stringLookup_3_2 +mkLicenseId LicenseListVersion_3_6 s = Map.lookup s stringLookup_3_6 stringLookup_3_0 :: Map String LicenseId stringLookup_3_0 = Map.fromList $ map (\i -> (licenseId i, i)) $ @@ -142,6 +156,10 @@ stringLookup_3_2 :: Map String LicenseId stringLookup_3_2 = Map.fromList $ map (\i -> (licenseId i, i)) $ licenseIdList LicenseListVersion_3_2 + +stringLookup_3_6 :: Map String LicenseId +stringLookup_3_6 = Map.fromList $ map (\i -> (licenseId i, i)) $ + licenseIdList LicenseListVersion_3_6 -- | Licenses in all SPDX License lists bulkOfLicenses :: [LicenseId] diff --git a/cabal/cabal-dev-scripts/cabal-dev-scripts.cabal b/cabal/cabal-dev-scripts/cabal-dev-scripts.cabal --- a/cabal/cabal-dev-scripts/cabal-dev-scripts.cabal +++ b/cabal/cabal-dev-scripts/cabal-dev-scripts.cabal @@ -16,8 +16,8 @@ main-is: GenExtraSourceFiles.hs hs-source-dirs: src build-depends: - base >=4.11 && <4.12, - Cabal >=2.2 && <2.5, + base >=4.10 && <4.13, + Cabal >=2.2 && <2.6, bytestring, directory, filepath, @@ -30,7 +30,7 @@ hs-source-dirs: src ghc-options: -Wall build-depends: - base >=4.11 && <4.12, + base >=4.10 && <4.13, aeson >=1.4.0.0 && <1.5, bytestring, containers, @@ -47,7 +47,7 @@ hs-source-dirs: src ghc-options: -Wall build-depends: - base >=4.11 && <4.12, + base >=4.10 && <4.13, aeson >=1.4.0.0 && <1.5, bytestring, containers, diff --git a/cabal/cabal-dev-scripts/src/GenSPDX.hs b/cabal/cabal-dev-scripts/src/GenSPDX.hs --- a/cabal/cabal-dev-scripts/src/GenSPDX.hs +++ b/cabal/cabal-dev-scripts/src/GenSPDX.hs @@ -1,11 +1,13 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} module Main (main) where -import Control.Lens hiding ((.=)) -import Data.Aeson (FromJSON (..), Value, eitherDecode, object, withObject, (.:), (.=)) -import Data.Foldable (for_) -import Data.Semigroup ((<>)) -import Data.Text (Text) +import Control.Lens hiding ((.=)) +import Data.Aeson (FromJSON (..), Value, eitherDecode, object, withObject, (.:), (.=)) +import Data.Foldable (for_) +import Data.List (sortOn) +import Data.Semigroup ((<>)) +import Data.Text (Text) +import Data.Traversable (for) import qualified Data.ByteString.Lazy as LBS import qualified Data.Set as Set @@ -17,7 +19,7 @@ import GenUtils -data Opts = Opts FilePath FilePath FilePath FilePath +data Opts = Opts FilePath (PerV FilePath) FilePath main :: IO () main = generate =<< O.execParser opts where @@ -27,8 +29,13 @@ ] parser :: O.Parser Opts - parser = Opts <$> template <*> licenses "3.0" <*> licenses "3.2" <*> output + parser = Opts <$> template <*> licensesAll <*> output + licensesAll = PerV + <$> licenses "3.0" + <*> licenses "3.2" + <*> licenses "3.5" + template = O.strArgument $ mconcat [ O.metavar "SPDX.LicenseId.template.hs" , O.help "Module template file" @@ -45,21 +52,19 @@ ] generate :: Opts -> IO () -generate (Opts tmplFile fn3_0 fn3_2 out) = do - LicenseList ls3_0 <- either fail pure . eitherDecode =<< LBS.readFile fn3_0 - LicenseList ls3_2 <- either fail pure . eitherDecode =<< LBS.readFile fn3_2 +generate (Opts tmplFile fns out) = do + lss <- for fns $ \fn -> either fail pure . eitherDecode =<< LBS.readFile fn template <- M.compileMustacheFile tmplFile - let (ws, rendered) = generate' ls3_0 ls3_2 template + let (ws, rendered) = generate' lss template for_ ws $ putStrLn . M.displayMustacheWarning TL.writeFile out (header <> "\n" <> rendered) putStrLn $ "Generated file " ++ out generate' - :: [License] -- SPDX 3.0 - -> [License] -- SPDX 3.2 + :: PerV LicenseList -> M.Template -> ([M.MustacheWarning], TL.Text) -generate' ls_3_0 ls_3_2 template = M.renderMustacheW template $ object +generate' lss template = M.renderMustacheW template $ object [ "licenseIds" .= licenseIds , "licenses" .= licenseValues , "licenseList_all" .= mkLicenseList (== allVers) @@ -67,12 +72,17 @@ (\vers -> vers /= allVers && Set.member SPDXLicenseListVersion_3_0 vers) , "licenseList_3_2" .= mkLicenseList (\vers -> vers /= allVers && Set.member SPDXLicenseListVersion_3_2 vers) + , "licenseList_3_6" .= mkLicenseList + (\vers -> vers /= allVers && Set.member SPDXLicenseListVersion_3_6 vers) ] where + PerV (LL ls_3_0) (LL ls_3_2) (LL ls_3_6) = lss + constructorNames :: [(Text, License, Set.Set SPDXLicenseListVersion)] constructorNames = map (\(l, tags) -> (toConstructorName $ licenseId l, l, tags)) $ combine licenseId $ \ver -> case ver of + SPDXLicenseListVersion_3_6 -> filterDeprecated ls_3_6 SPDXLicenseListVersion_3_2 -> filterDeprecated ls_3_2 SPDXLicenseListVersion_3_0 -> filterDeprecated ls_3_0 @@ -116,9 +126,10 @@ <*> obj .: "isOsiApproved" <*> obj .: "isDeprecatedLicenseId" -newtype LicenseList = LicenseList [License] +newtype LicenseList = LL [License] deriving (Show) instance FromJSON LicenseList where - parseJSON = withObject "License list" $ \obj -> LicenseList - <$> obj .: "licenses" + parseJSON = withObject "License list" $ \obj -> + LL . sortOn (OrdT . T.toLower . licenseId) + <$> obj .: "licenses" diff --git a/cabal/cabal-dev-scripts/src/GenSPDXExc.hs b/cabal/cabal-dev-scripts/src/GenSPDXExc.hs --- a/cabal/cabal-dev-scripts/src/GenSPDXExc.hs +++ b/cabal/cabal-dev-scripts/src/GenSPDXExc.hs @@ -1,23 +1,25 @@ {-# LANGUAGE OverloadedStrings #-} module Main (main) where -import Control.Lens hiding ((.=)) -import Data.Aeson (FromJSON (..), Value, eitherDecode, object, withObject, (.:), (.=)) -import Data.Foldable (for_) -import Data.Semigroup ((<>)) -import Data.Text (Text) +import Control.Lens hiding ((.=)) +import Data.Aeson (FromJSON (..), Value, eitherDecode, object, withObject, (.:), (.=)) +import Data.Foldable (for_) +import Data.List (sortOn) +import Data.Semigroup ((<>)) +import Data.Text (Text) +import Data.Traversable (for) import qualified Data.ByteString.Lazy as LBS +import qualified Data.Set as Set import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.IO as TL -import qualified Data.Set as Set import qualified Options.Applicative as O import qualified Text.Microstache as M import GenUtils -data Opts = Opts FilePath FilePath FilePath FilePath +data Opts = Opts FilePath (PerV FilePath) FilePath main :: IO () main = generate =<< O.execParser opts where @@ -27,8 +29,13 @@ ] parser :: O.Parser Opts - parser = Opts <$> template <*> licenses "3.0" <*> licenses "3.2" <*> output + parser = Opts <$> template <*> licensesAll <*> output + licensesAll = PerV + <$> licenses "3.0" + <*> licenses "3.2" + <*> licenses "3.5" + template = O.strArgument $ mconcat [ O.metavar "SPDX.LicenseExceptionId.template.hs" , O.help "Module template file" @@ -45,21 +52,19 @@ ] generate :: Opts -> IO () -generate (Opts tmplFile fn3_0 fn3_2 out) = do - LicenseList ls3_0 <- either fail pure . eitherDecode =<< LBS.readFile fn3_0 - LicenseList ls3_2 <- either fail pure . eitherDecode =<< LBS.readFile fn3_2 +generate (Opts tmplFile fns out) = do + lss <- for fns $ \fn -> either fail pure . eitherDecode =<< LBS.readFile fn template <- M.compileMustacheFile tmplFile - let (ws, rendered) = generate' ls3_0 ls3_2 template + let (ws, rendered) = generate' lss template for_ ws $ putStrLn . M.displayMustacheWarning TL.writeFile out (header <> "\n" <> rendered) putStrLn $ "Generated file " ++ out generate' - :: [License] -- SPDX 3.0 - -> [License] -- SPDX 3.2 + :: PerV LicenseList -> M.Template -> ([M.MustacheWarning], TL.Text) -generate' ls_3_0 ls_3_2 template = M.renderMustacheW template $ object +generate' lss template = M.renderMustacheW template $ object [ "licenseIds" .= licenseIds , "licenses" .= licenseValues , "licenseList_all" .= mkLicenseList (== allVers) @@ -67,12 +72,17 @@ (\vers -> vers /= allVers && Set.member SPDXLicenseListVersion_3_0 vers) , "licenseList_3_2" .= mkLicenseList (\vers -> vers /= allVers && Set.member SPDXLicenseListVersion_3_2 vers) + , "licenseList_3_6" .= mkLicenseList + (\vers -> vers /= allVers && Set.member SPDXLicenseListVersion_3_6 vers) ] where + PerV (LL ls_3_0) (LL ls_3_2) (LL ls_3_6) = lss + constructorNames :: [(Text, License, Set.Set SPDXLicenseListVersion)] constructorNames = map (\(l, tags) -> (toConstructorName $ licenseId l, l, tags)) $ combine licenseId $ \ver -> case ver of + SPDXLicenseListVersion_3_6 -> filterDeprecated ls_3_6 SPDXLicenseListVersion_3_2 -> filterDeprecated ls_3_2 SPDXLicenseListVersion_3_0 -> filterDeprecated ls_3_0 @@ -117,9 +127,10 @@ fixSpace '\n' = ' ' fixSpace c = c -newtype LicenseList = LicenseList [License] +newtype LicenseList = LL [License] deriving (Show) instance FromJSON LicenseList where - parseJSON = withObject "Exceptions list" $ \obj -> LicenseList - <$> obj .: "exceptions" + parseJSON = withObject "Exceptions list" $ \obj -> + LL . sortOn (OrdT . T.toLower . licenseId) + <$> obj .: "exceptions" diff --git a/cabal/cabal-dev-scripts/src/GenUtils.hs b/cabal/cabal-dev-scripts/src/GenUtils.hs --- a/cabal/cabal-dev-scripts/src/GenUtils.hs +++ b/cabal/cabal-dev-scripts/src/GenUtils.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module GenUtils where @@ -21,14 +24,36 @@ data SPDXLicenseListVersion = SPDXLicenseListVersion_3_0 | SPDXLicenseListVersion_3_2 + | SPDXLicenseListVersion_3_6 deriving (Eq, Ord, Show, Enum, Bounded) allVers :: Set.Set SPDXLicenseListVersion allVers = Set.fromList [minBound .. maxBound] prettyVer :: SPDXLicenseListVersion -> Text +prettyVer SPDXLicenseListVersion_3_6 = "SPDX License List 3.6" prettyVer SPDXLicenseListVersion_3_2 = "SPDX License List 3.2" prettyVer SPDXLicenseListVersion_3_0 = "SPDX License List 3.0" + +------------------------------------------------------------------------------- +-- Per version +------------------------------------------------------------------------------- + +data PerV a = PerV a a a + deriving (Functor, Foldable, Traversable) + +------------------------------------------------------------------------------- +-- Sorting +------------------------------------------------------------------------------- + +newtype OrdT = OrdT Text deriving (Eq) + +instance Ord OrdT where + compare (OrdT a) (OrdT b) + | a == b = EQ + | a `T.isPrefixOf` b = GT + | b `T.isPrefixOf` a = LT + | otherwise = compare a b ------------------------------------------------------------------------------- -- Commmons diff --git a/cabal/cabal-install/.gitignore b/cabal/cabal-install/.gitignore new file mode 100644 --- /dev/null +++ b/cabal/cabal-install/.gitignore @@ -0,0 +1,4 @@ +# ignore the downloaded and unpacked dependency packages +/*.cabal.hackage +/*-[0-9]*.tar.gz +/*-[0-9]*/ diff --git a/cabal/cabal-install/Distribution/Client/BuildReports/Anonymous.hs b/cabal/cabal-install/Distribution/Client/BuildReports/Anonymous.hs --- a/cabal/cabal-install/Distribution/Client/BuildReports/Anonymous.hs +++ b/cabal/cabal-install/Distribution/Client/BuildReports/Anonymous.hs @@ -47,16 +47,16 @@ ( OS, Arch ) import Distribution.Compiler ( CompilerId(..) ) -import qualified Distribution.Text as Text +import qualified Distribution.Deprecated.Text as Text ( Text(disp, parse) ) -import Distribution.ParseUtils +import Distribution.Deprecated.ParseUtils ( FieldDescr(..), ParseResult(..), Field(..) , simpleField, listField, ppFields, readFields , syntaxError, locatedErrorMsg ) import Distribution.Simple.Utils ( comparing ) -import qualified Distribution.Compat.ReadP as Parse +import qualified Distribution.Deprecated.ReadP as Parse ( ReadP, pfail, munch1, skipSpaces ) import qualified Text.PrettyPrint as Disp ( Doc, render, char, text ) diff --git a/cabal/cabal-install/Distribution/Client/BuildReports/Types.hs b/cabal/cabal-install/Distribution/Client/BuildReports/Types.hs --- a/cabal/cabal-install/Distribution/Client/BuildReports/Types.hs +++ b/cabal/cabal-install/Distribution/Client/BuildReports/Types.hs @@ -15,10 +15,10 @@ ReportLevel(..), ) where -import qualified Distribution.Text as Text +import qualified Distribution.Deprecated.Text as Text ( Text(..) ) -import qualified Distribution.Compat.ReadP as Parse +import qualified Distribution.Deprecated.ReadP as Parse ( pfail, munch1 ) import qualified Text.PrettyPrint as Disp ( text ) diff --git a/cabal/cabal-install/Distribution/Client/BuildReports/Upload.hs b/cabal/cabal-install/Distribution/Client/BuildReports/Upload.hs --- a/cabal/cabal-install/Distribution/Client/BuildReports/Upload.hs +++ b/cabal/cabal-install/Distribution/Client/BuildReports/Upload.hs @@ -23,7 +23,7 @@ ( () ) import qualified Distribution.Client.BuildReports.Anonymous as BuildReport import Distribution.Client.BuildReports.Anonymous (BuildReport) -import Distribution.Text (display) +import Distribution.Deprecated.Text (display) import Distribution.Verbosity (Verbosity) import Distribution.Simple.Utils (die') import Distribution.Client.HttpUtils diff --git a/cabal/cabal-install/Distribution/Client/Check.hs b/cabal/cabal-install/Distribution/Client/Check.hs --- a/cabal/cabal-install/Distribution/Client/Check.hs +++ b/cabal/cabal-install/Distribution/Client/Check.hs @@ -16,17 +16,20 @@ check ) where + import Distribution.Client.Compat.Prelude import Prelude () +import Distribution.Client.Utils.Parsec (renderParseError) import Distribution.PackageDescription (GenericPackageDescription) import Distribution.PackageDescription.Check import Distribution.PackageDescription.Configuration (flattenPackageDescription) import Distribution.PackageDescription.Parsec (parseGenericPackageDescription, runParseResult) -import Distribution.Parsec.Common (PWarning (..), showPError, showPWarning) +import Distribution.Parsec (PWarning (..), showPError, showPWarning) import Distribution.Simple.Utils (defaultPackageDesc, die', notice, warn) import Distribution.Verbosity (Verbosity) +import System.IO (hPutStr, stderr) import qualified Data.ByteString as BS import qualified System.Directory as Dir @@ -42,7 +45,8 @@ case result of Left (_, errors) -> do traverse_ (warn verbosity . showPError fpath) errors - die' verbosity $ "Failed parsing \"" ++ fpath ++ "\"." + hPutStr stderr $ renderParseError fpath bs errors warnings + die' verbosity "parse error" Right x -> return (warnings, x) -- | Note: must be called with the CWD set to the directory containing diff --git a/cabal/cabal-install/Distribution/Client/CmdBench.hs b/cabal/cabal-install/Distribution/Client/CmdBench.hs --- a/cabal/cabal-install/Distribution/Client/CmdBench.hs +++ b/cabal/cabal-install/Distribution/Client/CmdBench.hs @@ -20,10 +20,10 @@ ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags ) import qualified Distribution.Client.Setup as Client import Distribution.Simple.Setup - ( HaddockFlags, fromFlagOrDefault ) + ( HaddockFlags, TestFlags, fromFlagOrDefault ) import Distribution.Simple.Command ( CommandUI(..), usageAlternatives ) -import Distribution.Text +import Distribution.Deprecated.Text ( display ) import Distribution.Verbosity ( Verbosity, normal ) @@ -33,11 +33,11 @@ import Control.Monad (when) -benchCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) +benchCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) benchCommand = Client.installCommand { - commandName = "new-bench", + commandName = "v2-bench", commandSynopsis = "Run benchmarks", - commandUsage = usageAlternatives "new-bench" [ "[TARGETS] [FLAGS]" ], + commandUsage = usageAlternatives "v2-bench" [ "[TARGETS] [FLAGS]" ], commandDescription = Just $ \_ -> wrapText $ "Runs the specified benchmarks, first ensuring they are up to " ++ "date.\n\n" @@ -53,13 +53,13 @@ ++ "'cabal.project.local' and other files.", commandNotes = Just $ \pname -> "Examples:\n" - ++ " " ++ pname ++ " new-bench\n" + ++ " " ++ pname ++ " v2-bench\n" ++ " Run all the benchmarks in the package in the current directory\n" - ++ " " ++ pname ++ " new-bench pkgname\n" + ++ " " ++ pname ++ " v2-bench pkgname\n" ++ " Run all the benchmarks in the package named pkgname\n" - ++ " " ++ pname ++ " new-bench cname\n" + ++ " " ++ pname ++ " v2-bench cname\n" ++ " Run the benchmark named cname\n" - ++ " " ++ pname ++ " new-bench cname -O2\n" + ++ " " ++ pname ++ " v2-bench cname -O2\n" ++ " Run the benchmark built with '-O2' (including local libs used)\n\n" ++ cmdCommonHelpTextNewBuildBeta @@ -73,12 +73,12 @@ -- For more details on how this works, see the module -- "Distribution.Client.ProjectOrchestration" -- -benchAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) +benchAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) -> [String] -> GlobalFlags -> IO () -benchAction (configFlags, configExFlags, installFlags, haddockFlags) +benchAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags) targetStrings globalFlags = do - baseCtx <- establishProjectBaseContext verbosity cliConfig + baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand targetSelectors <- either (reportTargetSelectorProblems verbosity) return =<< readTargetSelectors (localPackages baseCtx) (Just BenchKind) targetStrings @@ -117,7 +117,9 @@ verbosity = fromFlagOrDefault normal (configVerbosity configFlags) cliConfig = commandLineFlagsToProjectConfig globalFlags configFlags configExFlags - installFlags haddockFlags + installFlags + mempty -- ClientInstallFlags, not needed here + haddockFlags testFlags -- | This defines what a 'TargetSelector' means for the @bench@ command. -- It selects the 'AvailableTarget's that the 'TargetSelector' refers to, diff --git a/cabal/cabal-install/Distribution/Client/CmdBuild.hs b/cabal/cabal-install/Distribution/Client/CmdBuild.hs --- a/cabal/cabal-install/Distribution/Client/CmdBuild.hs +++ b/cabal/cabal-install/Distribution/Client/CmdBuild.hs @@ -20,7 +20,8 @@ , liftOptions, yesNoOpt ) import qualified Distribution.Client.Setup as Client import Distribution.Simple.Setup - ( HaddockFlags, Flag(..), toFlag, fromFlag, fromFlagOrDefault ) + ( HaddockFlags, TestFlags + , Flag(..), toFlag, fromFlag, fromFlagOrDefault ) import Distribution.Simple.Command ( CommandUI(..), usageAlternatives, option ) import Distribution.Verbosity @@ -31,11 +32,14 @@ import qualified Data.Map as Map -buildCommand :: CommandUI (BuildFlags, (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)) +buildCommand :: + CommandUI + (BuildFlags, ( ConfigFlags, ConfigExFlags + , InstallFlags, HaddockFlags, TestFlags)) buildCommand = CommandUI { - commandName = "new-build", + commandName = "v2-build", commandSynopsis = "Compile targets within the project.", - commandUsage = usageAlternatives "new-build" [ "[TARGETS] [FLAGS]" ], + commandUsage = usageAlternatives "v2-build" [ "[TARGETS] [FLAGS]" ], commandDescription = Just $ \_ -> wrapText $ "Build one or more targets from within the project. The available " ++ "targets are the packages in the project as well as individual " @@ -50,16 +54,18 @@ ++ "'cabal.project.local' and other files.", commandNotes = Just $ \pname -> "Examples:\n" - ++ " " ++ pname ++ " new-build\n" - ++ " Build the package in the current directory or all packages in the project\n" - ++ " " ++ pname ++ " new-build pkgname\n" + ++ " " ++ pname ++ " v2-build\n" + ++ " Build the package in the current directory " + ++ "or all packages in the project\n" + ++ " " ++ pname ++ " v2-build pkgname\n" ++ " Build the package named pkgname in the project\n" - ++ " " ++ pname ++ " new-build ./pkgfoo\n" + ++ " " ++ pname ++ " v2-build ./pkgfoo\n" ++ " Build the package in the ./pkgfoo directory\n" - ++ " " ++ pname ++ " new-build cname\n" + ++ " " ++ pname ++ " v2-build cname\n" ++ " Build the component named cname in the project\n" - ++ " " ++ pname ++ " new-build cname --enable-profiling\n" - ++ " Build the component in profiling mode (including dependencies as needed)\n\n" + ++ " " ++ pname ++ " v2-build cname --enable-profiling\n" + ++ " Build the component in profiling mode " + ++ "(including dependencies as needed)\n\n" ++ cmdCommonHelpTextNewBuildBeta, commandDefaultFlags = @@ -95,10 +101,13 @@ -- For more details on how this works, see the module -- "Distribution.Client.ProjectOrchestration" -- -buildAction :: (BuildFlags, (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)) - -> [String] -> GlobalFlags -> IO () -buildAction (buildFlags, - (configFlags, configExFlags, installFlags, haddockFlags)) +buildAction :: + ( BuildFlags + , (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags)) + -> [String] -> GlobalFlags -> IO () +buildAction + ( buildFlags + , (configFlags, configExFlags, installFlags, haddockFlags, testFlags)) targetStrings globalFlags = do -- TODO: This flags defaults business is ugly let onlyConfigure = fromFlag (buildOnlyConfigure defaultBuildFlags @@ -107,10 +116,11 @@ | onlyConfigure = TargetActionConfigure | otherwise = TargetActionBuild - baseCtx <- establishProjectBaseContext verbosity cliConfig + baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand - targetSelectors <- either (reportTargetSelectorProblems verbosity) return - =<< readTargetSelectors (localPackages baseCtx) Nothing targetStrings + targetSelectors <- + either (reportTargetSelectorProblems verbosity) return + =<< readTargetSelectors (localPackages baseCtx) Nothing targetStrings buildCtx <- runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do @@ -147,14 +157,17 @@ verbosity = fromFlagOrDefault normal (configVerbosity configFlags) cliConfig = commandLineFlagsToProjectConfig globalFlags configFlags configExFlags - installFlags haddockFlags + installFlags + mempty -- ClientInstallFlags, not needed here + haddockFlags testFlags -- | This defines what a 'TargetSelector' means for the @bench@ command. -- It selects the 'AvailableTarget's that the 'TargetSelector' refers to, -- or otherwise classifies the problem. -- --- For the @build@ command select all components except non-buildable and disabled --- tests\/benchmarks, fail if there are no such components +-- For the @build@ command select all components except non-buildable +-- and disabled tests\/benchmarks, fail if there are no such +-- components -- selectPackageTargets :: TargetSelector -> [AvailableTarget k] -> Either TargetProblem [k] diff --git a/cabal/cabal-install/Distribution/Client/CmdClean.hs b/cabal/cabal-install/Distribution/Client/CmdClean.hs --- a/cabal/cabal-install/Distribution/Client/CmdClean.hs +++ b/cabal/cabal-install/Distribution/Client/CmdClean.hs @@ -49,7 +49,7 @@ cleanCommand :: CommandUI CleanFlags cleanCommand = CommandUI - { commandName = "new-clean" + { commandName = "v2-clean" , commandSynopsis = "Clean the package store and remove temporary files." , commandUsage = \pname -> "Usage: " ++ pname ++ " new-clean [FLAGS]\n" diff --git a/cabal/cabal-install/Distribution/Client/CmdConfigure.hs b/cabal/cabal-install/Distribution/Client/CmdConfigure.hs --- a/cabal/cabal-install/Distribution/Client/CmdConfigure.hs +++ b/cabal/cabal-install/Distribution/Client/CmdConfigure.hs @@ -16,7 +16,7 @@ import Distribution.Client.Setup ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags ) import Distribution.Simple.Setup - ( HaddockFlags, fromFlagOrDefault ) + ( HaddockFlags, TestFlags, fromFlagOrDefault ) import Distribution.Verbosity ( normal ) @@ -27,11 +27,11 @@ import qualified Distribution.Client.Setup as Client configureCommand :: CommandUI (ConfigFlags, ConfigExFlags - ,InstallFlags, HaddockFlags) + ,InstallFlags, HaddockFlags, TestFlags) configureCommand = Client.installCommand { - commandName = "new-configure", + commandName = "v2-configure", commandSynopsis = "Add extra project configuration", - commandUsage = usageAlternatives "new-configure" [ "[FLAGS]" ], + commandUsage = usageAlternatives "v2-configure" [ "[FLAGS]" ], commandDescription = Just $ \_ -> wrapText $ "Adjust how the project is built by setting additional package flags " ++ "and other flags.\n\n" @@ -40,28 +40,28 @@ ++ "file (or '$project_file.local', if '--project-file' is specified) " ++ "which extends the configuration from the 'cabal.project' file " ++ "(if any). This combination is used as the project configuration for " - ++ "all other commands (such as 'new-build', 'new-repl' etc) though it " + ++ "all other commands (such as 'v2-build', 'v2-repl' etc) though it " ++ "can be extended/overridden on a per-command basis.\n\n" - ++ "The new-configure command also checks that the project configuration " + ++ "The v2-configure command also checks that the project configuration " ++ "will work. In particular it checks that there is a consistent set of " ++ "dependencies for the project as a whole.\n\n" - ++ "The 'cabal.project.local' file persists across 'new-clean' but is " - ++ "overwritten on the next use of the 'new-configure' command. The " + ++ "The 'cabal.project.local' file persists across 'v2-clean' but is " + ++ "overwritten on the next use of the 'v2-configure' command. The " ++ "intention is that the 'cabal.project' file should be kept in source " ++ "control but the 'cabal.project.local' should not.\n\n" - ++ "It is never necessary to use the 'new-configure' command. It is " + ++ "It is never necessary to use the 'v2-configure' command. It is " ++ "merely a convenience in cases where you do not want to specify flags " - ++ "to 'new-build' (and other commands) every time and yet do not want " + ++ "to 'v2-build' (and other commands) every time and yet do not want " ++ "to alter the 'cabal.project' persistently.", commandNotes = Just $ \pname -> "Examples:\n" - ++ " " ++ pname ++ " new-configure --with-compiler ghc-7.10.3\n" + ++ " " ++ pname ++ " v2-configure --with-compiler ghc-7.10.3\n" ++ " Adjust the project configuration to use the given compiler\n" ++ " program and check the resulting configuration works.\n" - ++ " " ++ pname ++ " new-configure\n" + ++ " " ++ pname ++ " v2-configure\n" ++ " Reset the local configuration to empty and check the overall\n" ++ " project configuration works.\n\n" @@ -78,13 +78,13 @@ -- For more details on how this works, see the module -- "Distribution.Client.ProjectOrchestration" -- -configureAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) +configureAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) -> [String] -> GlobalFlags -> IO () -configureAction (configFlags, configExFlags, installFlags, haddockFlags) +configureAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags) _extraArgs globalFlags = do --TODO: deal with _extraArgs, since flags with wrong syntax end up there - baseCtx <- establishProjectBaseContext verbosity cliConfig + baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand -- Write out the @cabal.project.local@ so it gets picked up by the -- planning phase. If old config exists, then print the contents @@ -121,5 +121,7 @@ verbosity = fromFlagOrDefault normal (configVerbosity configFlags) cliConfig = commandLineFlagsToProjectConfig globalFlags configFlags configExFlags - installFlags haddockFlags + installFlags + mempty -- ClientInstallFlags, not needed here + haddockFlags testFlags diff --git a/cabal/cabal-install/Distribution/Client/CmdErrorMessages.hs b/cabal/cabal-install/Distribution/Client/CmdErrorMessages.hs --- a/cabal/cabal-install/Distribution/Client/CmdErrorMessages.hs +++ b/cabal/cabal-install/Distribution/Client/CmdErrorMessages.hs @@ -15,9 +15,11 @@ ( packageId, PackageName, packageName ) import Distribution.Types.ComponentName ( showComponentName ) +import Distribution.Types.LibraryName + ( LibraryName(..) ) import Distribution.Solver.Types.OptionalStanza ( OptionalStanza(..) ) -import Distribution.Text +import Distribution.Deprecated.Text ( display ) import Data.Maybe (isNothing) @@ -165,8 +167,8 @@ targetSelectorFilter TargetComponentUnknown{} = Nothing renderComponentName :: PackageName -> ComponentName -> String -renderComponentName pkgname CLibName = "library " ++ display pkgname -renderComponentName _ (CSubLibName name) = "library " ++ display name +renderComponentName pkgname (CLibName LMainLibName) = "library " ++ display pkgname +renderComponentName _ (CLibName (LSubLibName name)) = "library " ++ display name renderComponentName _ (CFLibName name) = "foreign library " ++ display name renderComponentName _ (CExeName name) = "executable " ++ display name renderComponentName _ (CTestName name) = "test suite " ++ display name @@ -303,6 +305,8 @@ ++ plural (listPlural targets') " is " " are " ++ "not available because the solver did not find a plan that " ++ "included the " ++ renderOptionalStanza Plural stanza + ++ ". Force the solver to enable this for all packages by adding the " + ++ "line 'tests: True' to the 'cabal.project.local' file." (TargetNotBuildable, _) -> renderListCommaAnd [ "the " ++ showComponentName availableTargetComponentName diff --git a/cabal/cabal-install/Distribution/Client/CmdExec.hs b/cabal/cabal-install/Distribution/Client/CmdExec.hs --- a/cabal/cabal-install/Distribution/Client/CmdExec.hs +++ b/cabal/cabal-install/Distribution/Client/CmdExec.hs @@ -4,7 +4,7 @@ -- Maintainer : cabal-devel@haskell.org -- Portability : portable -- --- Implementation of the 'new-exec' command for running an arbitrary executable +-- Implementation of the 'v2-exec' command for running an arbitrary executable -- in an environment suited to the part of the store built for a project. ------------------------------------------------------------------------------- @@ -31,6 +31,7 @@ import Distribution.Client.ProjectOrchestration ( ProjectBuildContext(..) , runProjectPreBuildPhase + , CurrentCommand(..) , establishProjectBaseContext , distDirLayout , commandLineFlagsToProjectConfig @@ -74,6 +75,7 @@ , GhcImplInfo(supportsPkgEnvFiles) ) import Distribution.Simple.Setup ( HaddockFlags + , TestFlags , fromFlagOrDefault ) import Distribution.Simple.Utils @@ -94,24 +96,24 @@ import qualified Data.Set as S import qualified Data.Map as M -execCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) +execCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) execCommand = CommandUI - { commandName = "new-exec" + { commandName = "v2-exec" , commandSynopsis = "Give a command access to the store." , commandUsage = \pname -> - "Usage: " ++ pname ++ " new-exec [FLAGS] [--] COMMAND [--] [ARGS]\n" + "Usage: " ++ pname ++ " v2-exec [FLAGS] [--] COMMAND [--] [ARGS]\n" , commandDescription = Just $ \pname -> wrapText $ "During development it is often useful to run build tasks and perform" ++ " one-off program executions to experiment with the behavior of build" ++ " tools. It is convenient to run these tools in the same way " ++ pname - ++ " itself would. The `" ++ pname ++ " new-exec` command provides a way to" + ++ " itself would. The `" ++ pname ++ " v2-exec` command provides a way to" ++ " do so.\n" ++ "\n" ++ "Compiler tools will be configured to see the same subset of the store" ++ " that builds would see. The PATH is modified to make all executables in" ++ " the dependency tree available (provided they have been built already)." ++ " Commands are also rewritten in the way cabal itself would. For" - ++ " example, `" ++ pname ++ " new-exec ghc` will consult the configuration" + ++ " example, `" ++ pname ++ " v2-exec ghc` will consult the configuration" ++ " to choose an appropriate version of ghc and to include any" ++ " ghc-specific flags requested." , commandNotes = Nothing @@ -119,12 +121,12 @@ , commandDefaultFlags = commandDefaultFlags Client.installCommand } -execAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) +execAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) -> [String] -> GlobalFlags -> IO () -execAction (configFlags, configExFlags, installFlags, haddockFlags) +execAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags) extraArgs globalFlags = do - baseCtx <- establishProjectBaseContext verbosity cliConfig + baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand -- To set up the environment, we'd like to select the libraries in our -- dependency tree that we've already built. So first we set up an install @@ -193,7 +195,9 @@ verbosity = fromFlagOrDefault normal (configVerbosity configFlags) cliConfig = commandLineFlagsToProjectConfig globalFlags configFlags configExFlags - installFlags haddockFlags + installFlags + mempty -- ClientInstallFlags, not needed here + haddockFlags testFlags withOverrides env args program = program { programOverrideEnv = programOverrideEnv program ++ env , programDefaultArgs = programDefaultArgs program ++ args} diff --git a/cabal/cabal-install/Distribution/Client/CmdFreeze.hs b/cabal/cabal-install/Distribution/Client/CmdFreeze.hs --- a/cabal/cabal-install/Distribution/Client/CmdFreeze.hs +++ b/cabal/cabal-install/Distribution/Client/CmdFreeze.hs @@ -33,7 +33,7 @@ import Distribution.Client.Setup ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags ) import Distribution.Simple.Setup - ( HaddockFlags, fromFlagOrDefault ) + ( HaddockFlags, TestFlags, fromFlagOrDefault ) import Distribution.Simple.Utils ( die', notice, wrapText ) import Distribution.Verbosity @@ -49,11 +49,11 @@ import qualified Distribution.Client.Setup as Client -freezeCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) +freezeCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) freezeCommand = Client.installCommand { - commandName = "new-freeze", + commandName = "v2-freeze", commandSynopsis = "Freeze dependencies.", - commandUsage = usageAlternatives "new-freeze" [ "[FLAGS]" ], + commandUsage = usageAlternatives "v2-freeze" [ "[FLAGS]" ], commandDescription = Just $ \_ -> wrapText $ "The project configuration is frozen so that it will be reproducible " ++ "in future.\n\n" @@ -62,23 +62,23 @@ ++ "the 'cabal.project.freeze' file (or '$project_file.freeze' if " ++ "'--project-file' is specified). This file extends the configuration " ++ "from the 'cabal.project' file and thus is used as the project " - ++ "configuration for all other commands (such as 'new-build', " - ++ "'new-repl' etc).\n\n" + ++ "configuration for all other commands (such as 'v2-build', " + ++ "'v2-repl' etc).\n\n" ++ "The freeze file can be kept in source control. To make small " ++ "adjustments it may be edited manually, or to make bigger changes " ++ "you may wish to delete the file and re-freeze. For more control, " - ++ "one approach is to try variations using 'new-build --dry-run' with " + ++ "one approach is to try variations using 'v2-build --dry-run' with " ++ "solver flags such as '--constraint=\"pkg < 1.2\"' and once you have " - ++ "a satisfactory solution to freeze it using the 'new-freeze' command " + ++ "a satisfactory solution to freeze it using the 'v2-freeze' command " ++ "with the same set of flags.", commandNotes = Just $ \pname -> "Examples:\n" - ++ " " ++ pname ++ " new-freeze\n" + ++ " " ++ pname ++ " v2-freeze\n" ++ " Freeze the configuration of the current project\n\n" - ++ " " ++ pname ++ " new-build --dry-run --constraint=\"aeson < 1\"\n" + ++ " " ++ pname ++ " v2-build --dry-run --constraint=\"aeson < 1\"\n" ++ " Check what a solution with the given constraints would look like\n" - ++ " " ++ pname ++ " new-freeze --constraint=\"aeson < 1\"\n" + ++ " " ++ pname ++ " v2-freeze --constraint=\"aeson < 1\"\n" ++ " Freeze a solution using the given constraints\n\n" ++ "Note: this command is part of the new project-based system (aka " @@ -99,9 +99,9 @@ -- For more details on how this works, see the module -- "Distribution.Client.ProjectOrchestration" -- -freezeAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) +freezeAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) -> [String] -> GlobalFlags -> IO () -freezeAction (configFlags, configExFlags, installFlags, haddockFlags) +freezeAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags) extraArgs globalFlags = do unless (null extraArgs) $ @@ -113,7 +113,7 @@ cabalDirLayout, projectConfig, localPackages - } <- establishProjectBaseContext verbosity cliConfig + } <- establishProjectBaseContext verbosity cliConfig OtherCommand (_, elaboratedPlan, _) <- rebuildInstallPlan verbosity @@ -130,7 +130,9 @@ verbosity = fromFlagOrDefault normal (configVerbosity configFlags) cliConfig = commandLineFlagsToProjectConfig globalFlags configFlags configExFlags - installFlags haddockFlags + installFlags + mempty -- ClientInstallFlags, not needed here + haddockFlags testFlags diff --git a/cabal/cabal-install/Distribution/Client/CmdHaddock.hs b/cabal/cabal-install/Distribution/Client/CmdHaddock.hs --- a/cabal/cabal-install/Distribution/Client/CmdHaddock.hs +++ b/cabal/cabal-install/Distribution/Client/CmdHaddock.hs @@ -20,7 +20,7 @@ ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags ) import qualified Distribution.Client.Setup as Client import Distribution.Simple.Setup - ( HaddockFlags(..), fromFlagOrDefault ) + ( HaddockFlags(..), TestFlags, fromFlagOrDefault ) import Distribution.Simple.Command ( CommandUI(..), usageAlternatives ) import Distribution.Verbosity @@ -32,11 +32,11 @@ haddockCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags - ,HaddockFlags) + ,HaddockFlags, TestFlags) haddockCommand = Client.installCommand { - commandName = "new-haddock", + commandName = "v2-haddock", commandSynopsis = "Build Haddock documentation", - commandUsage = usageAlternatives "new-haddock" [ "[FLAGS] TARGET" ], + commandUsage = usageAlternatives "v2-haddock" [ "[FLAGS] TARGET" ], commandDescription = Just $ \_ -> wrapText $ "Build Haddock documentation for the specified packages within the " ++ "project.\n\n" @@ -56,7 +56,7 @@ ++ "'cabal.project.local' and other files.", commandNotes = Just $ \pname -> "Examples:\n" - ++ " " ++ pname ++ " new-haddock pkgname" + ++ " " ++ pname ++ " v2-haddock pkgname" ++ " Build documentation for the package named pkgname\n\n" ++ cmdCommonHelpTextNewBuildBeta @@ -69,12 +69,12 @@ -- For more details on how this works, see the module -- "Distribution.Client.ProjectOrchestration" -- -haddockAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) +haddockAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) -> [String] -> GlobalFlags -> IO () -haddockAction (configFlags, configExFlags, installFlags, haddockFlags) +haddockAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags) targetStrings globalFlags = do - baseCtx <- establishProjectBaseContext verbosity cliConfig + baseCtx <- establishProjectBaseContext verbosity cliConfig HaddockCommand targetSelectors <- either (reportTargetSelectorProblems verbosity) return =<< readTargetSelectors (localPackages baseCtx) Nothing targetStrings @@ -111,7 +111,9 @@ verbosity = fromFlagOrDefault normal (configVerbosity configFlags) cliConfig = commandLineFlagsToProjectConfig globalFlags configFlags configExFlags - installFlags haddockFlags + installFlags + mempty -- ClientInstallFlags, not needed here + haddockFlags testFlags -- | This defines what a 'TargetSelector' means for the @haddock@ command. -- It selects the 'AvailableTarget's that the 'TargetSelector' refers to, @@ -153,7 +155,7 @@ isRequested _ LibKind = True -- isRequested _ SubLibKind = True --TODO: what about sublibs? - -- TODO/HACK, we encode some defaults here as new-haddock's logic; + -- TODO/HACK, we encode some defaults here as v2-haddock's logic; -- make sure this matches the defaults applied in -- "Distribution.Client.ProjectPlanning"; this may need more work -- to be done properly diff --git a/cabal/cabal-install/Distribution/Client/CmdInstall.hs b/cabal/cabal-install/Distribution/Client/CmdInstall.hs --- a/cabal/cabal-install/Distribution/Client/CmdInstall.hs +++ b/cabal/cabal-install/Distribution/Client/CmdInstall.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE ViewPatterns #-} -- | cabal-install CLI command: build -- @@ -20,14 +20,19 @@ import Prelude () import Distribution.Client.Compat.Prelude +import Distribution.Compat.Directory + ( doesPathExist ) import Distribution.Client.ProjectOrchestration import Distribution.Client.CmdErrorMessages import Distribution.Client.CmdSdist +import Distribution.Client.CmdInstall.ClientInstallFlags + import Distribution.Client.Setup ( GlobalFlags(..), ConfigFlags(..), ConfigExFlags, InstallFlags(..) - , configureExOptions, installOptions, liftOptions ) + , configureExOptions, haddockOptions, installOptions, testOptions + , configureOptions, liftOptions ) import Distribution.Solver.Types.ConstraintSource ( ConstraintSource(..) ) import Distribution.Client.Types @@ -46,11 +51,13 @@ , projectConfigDistDir, projectConfigConfigFile ) import Distribution.Simple.Program.Db ( userSpecifyPaths, userSpecifyArgss, defaultProgramDb - , modifyProgramSearchPath ) + , modifyProgramSearchPath, ProgramDb ) +import Distribution.Simple.BuildPaths + ( exeExtension ) import Distribution.Simple.Program.Find ( ProgramSearchPathEntry(..) ) import Distribution.Client.Config - ( getCabalDir ) + ( getCabalDir, loadConfig, SavedConfig(..) ) import qualified Distribution.Simple.PackageIndex as PI import Distribution.Solver.Types.PackageIndex ( lookupPackageName, searchByName ) @@ -67,38 +74,40 @@ import Distribution.Client.ProjectConfig ( readGlobalConfig, projectConfigWithBuilderRepoContext , resolveBuildTimeSettings, withProjectOrGlobalConfig ) +import Distribution.Client.ProjectPlanning + ( storePackageInstallDirs' ) +import qualified Distribution.Simple.InstallDirs as InstallDirs import Distribution.Client.DistDirLayout ( defaultDistDirLayout, DistDirLayout(..), mkCabalDirLayout , ProjectRoot(ProjectRootImplicit) - , storePackageDirectory, cabalStoreDirLayout + , cabalStoreDirLayout , CabalDirLayout(..), StoreDirLayout(..) ) import Distribution.Client.RebuildMonad ( runRebuild ) import Distribution.Client.InstallSymlink ( OverwritePolicy(..), symlinkBinary ) import Distribution.Simple.Setup - ( Flag(..), HaddockFlags, fromFlagOrDefault, flagToMaybe, toFlag - , trueArg, configureOptions, haddockOptions, flagToList ) + ( Flag(..), HaddockFlags, TestFlags, fromFlagOrDefault, flagToMaybe ) import Distribution.Solver.Types.SourcePackage ( SourcePackage(..) ) -import Distribution.ReadE - ( ReadE(..), succeedReadE ) import Distribution.Simple.Command - ( CommandUI(..), ShowOrParseArgs(..), OptionField(..) - , option, usageAlternatives, reqArg ) + ( CommandUI(..), OptionField(..), usageAlternatives ) import Distribution.Simple.Configure ( configCompilerEx ) import Distribution.Simple.Compiler - ( Compiler(..), CompilerId(..), CompilerFlavor(..) ) + ( Compiler(..), CompilerId(..), CompilerFlavor(..) + , PackageDBStack ) import Distribution.Simple.GHC ( ghcPlatformAndVersionString , GhcImplInfo(..), getImplInfo , GhcEnvironmentFileEntry(..) , renderGhcEnvironmentFile, readGhcEnvironmentFile, ParseErrorExc ) +import Distribution.System + ( Platform ) import Distribution.Types.UnitId ( UnitId ) import Distribution.Types.UnqualComponentName - ( UnqualComponentName, unUnqualComponentName ) + ( UnqualComponentName, unUnqualComponentName, mkUnqualComponentName ) import Distribution.Verbosity ( Verbosity, normal, lessVerbose ) import Distribution.Simple.Utils @@ -107,7 +116,7 @@ , ordNub ) import Distribution.Utils.Generic ( writeFileAtomic ) -import Distribution.Text +import Distribution.Deprecated.Text ( simpleParse ) import Distribution.Pretty ( prettyShow ) @@ -118,7 +127,7 @@ ( mapM, mapM_ ) import qualified Data.ByteString.Lazy.Char8 as BS import Data.Either - ( partitionEithers, isLeft ) + ( partitionEithers ) import Data.Ord ( comparing, Down(..) ) import qualified Data.Map as Map @@ -126,62 +135,24 @@ ( fromNubList ) import System.Directory ( getHomeDirectory, doesFileExist, createDirectoryIfMissing - , getTemporaryDirectory, makeAbsolute, doesDirectoryExist ) + , getTemporaryDirectory, makeAbsolute, doesDirectoryExist + , removeFile, removeDirectory, copyFile ) import System.FilePath - ( (), takeDirectory, takeBaseName ) + ( (), (<.>), takeDirectory, takeBaseName ) -data NewInstallFlags = NewInstallFlags - { ninstInstallLibs :: Flag Bool - , ninstEnvironmentPath :: Flag FilePath - , ninstOverwritePolicy :: Flag OverwritePolicy - } -defaultNewInstallFlags :: NewInstallFlags -defaultNewInstallFlags = NewInstallFlags - { ninstInstallLibs = toFlag False - , ninstEnvironmentPath = mempty - , ninstOverwritePolicy = toFlag NeverOverwrite - } - -newInstallOptions :: ShowOrParseArgs -> [OptionField NewInstallFlags] -newInstallOptions _ = - [ option [] ["lib"] - "Install libraries rather than executables from the target package." - ninstInstallLibs (\v flags -> flags { ninstInstallLibs = v }) - trueArg - , option [] ["package-env", "env"] - "Set the environment file that may be modified." - ninstEnvironmentPath (\pf flags -> flags { ninstEnvironmentPath = pf }) - (reqArg "ENV" (succeedReadE Flag) flagToList) - , option [] ["overwrite-policy"] - "How to handle already existing symlinks." - ninstOverwritePolicy (\v flags -> flags { ninstOverwritePolicy = v }) - $ reqArg - "always|never" - readOverwritePolicyFlag - showOverwritePolicyFlag - ] - where - readOverwritePolicyFlag = ReadE $ \case - "always" -> Right $ Flag AlwaysOverwrite - "never" -> Right $ Flag NeverOverwrite - policy -> Left $ "'" <> policy <> "' isn't a valid overwrite policy" - showOverwritePolicyFlag (Flag AlwaysOverwrite) = ["always"] - showOverwritePolicyFlag (Flag NeverOverwrite) = ["never"] - showOverwritePolicyFlag NoFlag = [] - installCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags - , HaddockFlags, NewInstallFlags + , HaddockFlags, TestFlags, ClientInstallFlags ) installCommand = CommandUI - { commandName = "new-install" + { commandName = "v2-install" , commandSynopsis = "Install packages." , commandUsage = usageAlternatives - "new-install" [ "[TARGETS] [FLAGS]" ] + "v2-install" [ "[TARGETS] [FLAGS]" ] , commandDescription = Just $ \_ -> wrapText $ "Installs one or more packages. This is done by installing them " - ++ "in the store and symlinking the executables in the directory " - ++ "specified by the --symlink-bindir flag (`~/.cabal/bin/` by default). " + ++ "in the store and symlinking/copying the executables in the directory " + ++ "specified by the --installdir flag (`~/.cabal/bin/` by default). " ++ "If you want the installed executables to be available globally, " ++ "make sure that the PATH environment variable contains that directory. " ++ "\n\n" @@ -190,12 +161,12 @@ ++ "the previously installed libraries. This is currently not implemented." , commandNotes = Just $ \pname -> "Examples:\n" - ++ " " ++ pname ++ " new-install\n" + ++ " " ++ pname ++ " v2-install\n" ++ " Install the package in the current directory\n" - ++ " " ++ pname ++ " new-install pkgname\n" + ++ " " ++ pname ++ " v2-install pkgname\n" ++ " Install the package named pkgname" ++ " (fetching it from hackage if necessary)\n" - ++ " " ++ pname ++ " new-install ./pkgfoo\n" + ++ " " ++ pname ++ " v2-install ./pkgfoo\n" ++ " Install the package in the ./pkgfoo directory\n" ++ cmdCommonHelpTextNewBuildBeta @@ -207,11 +178,13 @@ (filter ((`notElem` ["constraint", "dependency" , "exact-configuration"]) . optionName) $ configureOptions showOrParseArgs) - ++ liftOptions get2 set2 (configureExOptions showOrParseArgs ConstraintSourceCommandlineFlag) + ++ liftOptions get2 set2 (configureExOptions showOrParseArgs + ConstraintSourceCommandlineFlag) ++ liftOptions get3 set3 - -- hide "target-package-db" flag from the + -- hide "target-package-db" and "symlink-bindir" flags from the -- install options. - (filter ((`notElem` ["target-package-db"]) + -- "symlink-bindir" is obsoleted by "installdir" in ClientInstallFlags + (filter ((`notElem` ["target-package-db", "symlink-bindir"]) . optionName) $ installOptions showOrParseArgs) ++ liftOptions get4 set4 @@ -220,15 +193,18 @@ (filter ((`notElem` ["v", "verbose", "builddir"]) . optionName) $ haddockOptions showOrParseArgs) - ++ liftOptions get5 set5 (newInstallOptions showOrParseArgs) - , commandDefaultFlags = (mempty, mempty, mempty, mempty, defaultNewInstallFlags) + ++ liftOptions get5 set5 (testOptions showOrParseArgs) + ++ liftOptions get6 set6 (clientInstallOptions showOrParseArgs) + , commandDefaultFlags = ( mempty, mempty, mempty, mempty, mempty + , defaultClientInstallFlags ) } where - get1 (a,_,_,_,_) = a; set1 a (_,b,c,d,e) = (a,b,c,d,e) - get2 (_,b,_,_,_) = b; set2 b (a,_,c,d,e) = (a,b,c,d,e) - get3 (_,_,c,_,_) = c; set3 c (a,b,_,d,e) = (a,b,c,d,e) - get4 (_,_,_,d,_) = d; set4 d (a,b,c,_,e) = (a,b,c,d,e) - get5 (_,_,_,_,e) = e; set5 e (a,b,c,d,_) = (a,b,c,d,e) + get1 (a,_,_,_,_,_) = a; set1 a (_,b,c,d,e,f) = (a,b,c,d,e,f) + get2 (_,b,_,_,_,_) = b; set2 b (a,_,c,d,e,f) = (a,b,c,d,e,f) + get3 (_,_,c,_,_,_) = c; set3 c (a,b,_,d,e,f) = (a,b,c,d,e,f) + get4 (_,_,_,d,_,_) = d; set4 d (a,b,c,_,e,f) = (a,b,c,d,e,f) + get5 (_,_,_,_,e,_) = e; set5 e (a,b,c,d,_,f) = (a,b,c,d,e,f) + get6 (_,_,_,_,_,f) = f; set6 f (a,b,c,d,e,_) = (a,b,c,d,e,f) -- | The @install@ command actually serves four different needs. It installs: @@ -237,21 +213,25 @@ -- install command, except that now conflicts between separate runs of the -- command are impossible thanks to the store. -- Exes are installed in the store like a normal dependency, then they are --- symlinked uin the directory specified by --symlink-bindir. +-- symlinked/copied in the directory specified by --installdir. -- To do this we need a dummy projectBaseContext containing the targets as -- estra packages and using a temporary dist directory. -- * libraries -- Libraries install through a similar process, but using GHC environment --- files instead of symlinks. This means that 'new-install'ing libraries +-- files instead of symlinks. This means that 'v2-install'ing libraries -- only works on GHC >= 8.0. -- -- For more details on how this works, see the module -- "Distribution.Client.ProjectOrchestration" -- -installAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, NewInstallFlags) - -> [String] -> GlobalFlags -> IO () -installAction (configFlags, configExFlags, installFlags, haddockFlags, newInstallFlags) - targetStrings globalFlags = do +installAction + :: ( ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags + , ClientInstallFlags) + -> [String] -> GlobalFlags + -> IO () +installAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags + , clientInstallFlags' ) + targetStrings globalFlags = do -- We never try to build tests/benchmarks for remote packages. -- So we set them as disabled by default and error if they are explicitly -- enabled. @@ -262,35 +242,57 @@ die' verbosity $ "--enable-benchmarks was specified, but benchmarks can't " ++ "be enabled in a remote package" + -- We cannot use establishDummyProjectBaseContext to get these flags, since + -- it requires one of them as an argument. Normal establishProjectBaseContext + -- does not, and this is why this is done only for the install command + clientInstallFlags <- do + let configFileFlag = globalConfigFile globalFlags + savedConfig <- loadConfig verbosity configFileFlag + pure $ savedClientInstallFlags savedConfig `mappend` clientInstallFlags' + let + installLibs = fromFlagOrDefault False (cinstInstallLibs clientInstallFlags) + targetFilter = if installLibs then Just LibKind else Just ExeKind + targetStrings' = if null targetStrings then ["."] else targetStrings + withProject = do let verbosity' = lessVerbose verbosity -- First, we need to learn about what's available to be installed. - localBaseCtx <- establishProjectBaseContext verbosity' cliConfig + localBaseCtx <- establishProjectBaseContext verbosity' + cliConfig InstallCommand let localDistDirLayout = distDirLayout localBaseCtx - pkgDb <- projectConfigWithBuilderRepoContext verbosity' (buildSettings localBaseCtx) (getSourcePackages verbosity) + pkgDb <- projectConfigWithBuilderRepoContext verbosity' + (buildSettings localBaseCtx) (getSourcePackages verbosity) let - (targetStrings', packageIds) = partitionEithers . flip fmap targetStrings $ + (targetStrings'', packageIds) = + partitionEithers . + flip fmap targetStrings' $ \str -> case simpleParse str of Just (pkgId :: PackageId) | pkgVersion pkgId /= nullVersion -> Right pkgId - _ -> Left str - packageSpecifiers = flip fmap packageIds $ \case + _ -> Left str + packageSpecifiers = + flip fmap packageIds $ \case PackageIdentifier{..} | pkgVersion == nullVersion -> NamedPackage pkgName [] - | otherwise -> - NamedPackage pkgName [PackagePropertyVersion (thisVersion pkgVersion)] - packageTargets = flip TargetPackageNamed Nothing . pkgName <$> packageIds + | otherwise -> NamedPackage pkgName + [PackagePropertyVersion + (thisVersion pkgVersion)] + packageTargets = + flip TargetPackageNamed targetFilter . pkgName <$> packageIds if null targetStrings' then return (packageSpecifiers, packageTargets, projectConfig localBaseCtx) else do - targetSelectors <- either (reportTargetSelectorProblems verbosity) return - =<< readTargetSelectors (localPackages localBaseCtx) Nothing targetStrings' + targetSelectors <- + either (reportTargetSelectorProblems verbosity) return + =<< readTargetSelectors (localPackages localBaseCtx) + Nothing targetStrings'' - (specs, selectors) <- withInstallPlan verbosity' localBaseCtx $ \elaboratedPlan _ -> do + (specs, selectors) <- + withInstallPlan verbosity' localBaseCtx $ \elaboratedPlan _ -> do -- Split into known targets and hackage packages. (targets, hackageNames) <- case resolveTargets @@ -300,10 +302,10 @@ elaboratedPlan (Just pkgDb) targetSelectors of - Right targets -> do + Right targets -> -- Everything is a local dependency. return (targets, []) - Left errs -> do + Left errs -> do -- Not everything is local. let (errs', hackageNames) = partitionEithers . flip fmap errs $ \case @@ -321,7 +323,7 @@ , unlines (("- " ++) . unPackageName . fst <$> xs) ] _ -> return () - + when (not . null $ errs') $ reportTargetProblems verbosity errs' let @@ -330,10 +332,13 @@ | name `elem` hackageNames -> False TargetPackageNamed name _ | name `elem` hackageNames -> False - _ -> True + _ -> True - -- This can't fail, because all of the errors are removed (or we've given up). - targets <- either (reportTargetProblems verbosity) return $ resolveTargets + -- This can't fail, because all of the errors are + -- removed (or we've given up). + targets <- + either (reportTargetProblems verbosity) return $ + resolveTargets selectPackageTargets selectComponentTarget TargetProblemCommon @@ -347,16 +352,17 @@ planMap = InstallPlan.toMap elaboratedPlan targetIds = Map.keys targets - sdistize (SpecificSourcePackage spkg@SourcePackage{..}) = SpecificSourcePackage spkg' + sdistize (SpecificSourcePackage spkg@SourcePackage{..}) = + SpecificSourcePackage spkg' where - sdistPath = distSdistFile localDistDirLayout packageInfoId TargzFormat + sdistPath = distSdistFile localDistDirLayout packageInfoId spkg' = spkg { packageSource = LocalTarballPackage sdistPath } sdistize named = named local = sdistize <$> localPackages localBaseCtx gatherTargets :: UnitId -> TargetSelector - gatherTargets targetId = TargetPackageNamed pkgName Nothing + gatherTargets targetId = TargetPackageNamed pkgName targetFilter where Just targetUnit = Map.lookup targetId planMap PackageIdentifier{..} = packageId targetUnit @@ -365,33 +371,37 @@ hackagePkgs :: [PackageSpecifier UnresolvedSourcePackage] hackagePkgs = flip NamedPackage [] <$> hackageNames + hackageTargets :: [TargetSelector] - hackageTargets = flip TargetPackageNamed Nothing <$> hackageNames + hackageTargets = + flip TargetPackageNamed targetFilter <$> hackageNames createDirectoryIfMissing True (distSdistDirectory localDistDirLayout) unless (Map.null targets) $ mapM_ (\(SpecificSourcePackage pkg) -> packageToSdist verbosity - (distProjectRootDirectory localDistDirLayout) (Archive TargzFormat) - (distSdistFile localDistDirLayout (packageId pkg) TargzFormat) pkg + (distProjectRootDirectory localDistDirLayout) TarGzArchive + (distSdistFile localDistDirLayout (packageId pkg)) pkg ) (localPackages localBaseCtx) if null targets then return (hackagePkgs, hackageTargets) else return (local ++ hackagePkgs, targets' ++ hackageTargets) - return (specs ++ packageSpecifiers, selectors ++ packageTargets, projectConfig localBaseCtx) + return ( specs ++ packageSpecifiers + , selectors ++ packageTargets + , projectConfig localBaseCtx ) withoutProject globalConfig = do let parsePkg pkgName | Just (pkg :: PackageId) <- simpleParse pkgName = return pkg | otherwise = die' verbosity ("Invalid package ID: " ++ pkgName) - packageIds <- mapM parsePkg targetStrings - + packageIds <- mapM parsePkg targetStrings' + cabalDir <- getCabalDir - let + let projectConfig = globalConfig <> cliConfig ProjectConfigBuildOnly { @@ -411,10 +421,10 @@ projectConfig SourcePackageDb { packageIndex } <- projectConfigWithBuilderRepoContext - verbosity buildSettings + verbosity buildSettings (getSourcePackages verbosity) - for_ targetStrings $ \case + for_ targetStrings' $ \case name | null (lookupPackageName packageIndex (mkPackageName name)) , xs@(_:_) <- searchByName packageIndex name -> @@ -429,13 +439,15 @@ packageSpecifiers = flip fmap packageIds $ \case PackageIdentifier{..} | pkgVersion == nullVersion -> NamedPackage pkgName [] - | otherwise -> - NamedPackage pkgName [PackagePropertyVersion (thisVersion pkgVersion)] + | otherwise -> NamedPackage pkgName + [PackagePropertyVersion + (thisVersion pkgVersion)] packageTargets = flip TargetPackageNamed Nothing . pkgName <$> packageIds return (packageSpecifiers, packageTargets, projectConfig) - (specs, selectors, config) <- withProjectOrGlobalConfig verbosity globalConfigFlag - withProject withoutProject + (specs, selectors, config) <- + withProjectOrGlobalConfig verbosity globalConfigFlag + withProject withoutProject home <- getHomeDirectory let @@ -473,20 +485,21 @@ home ".ghc" ghcPlatformAndVersionString platform compilerVersion "environments" name localEnv dir = - dir ".ghc.environment." ++ ghcPlatformAndVersionString platform compilerVersion + dir + ".ghc.environment." <> ghcPlatformAndVersionString platform compilerVersion GhcImplInfo{ supportsPkgEnvFiles } = getImplInfo compiler -- Why? We know what the first part will be, we only care about the packages. filterEnvEntries = filter $ \case GhcEnvFilePackageId _ -> True - _ -> False + _ -> False - envFile <- case flagToMaybe (ninstEnvironmentPath newInstallFlags) of + envFile <- case flagToMaybe (cinstEnvironmentPath clientInstallFlags) of Just spec -- Is spec a bare word without any "pathy" content, then it refers to -- a named global environment. | takeBaseName spec == spec -> return (globalEnv spec) - | otherwise -> do + | otherwise -> do spec' <- makeAbsolute spec isDir <- doesDirectoryExist spec' if isDir @@ -495,7 +508,7 @@ then return (localEnv spec') -- Otherwise, treat it like a literal file path. else return spec' - Nothing -> return (globalEnv "default") + Nothing -> return (globalEnv "default") envFileExists <- doesFileExist envFile envEntries <- filterEnvEntries <$> if @@ -507,7 +520,8 @@ else return [] cabalDir <- getCabalDir - mstoreDir <- sequenceA $ makeAbsolute <$> flagToMaybe (globalStoreDir globalFlags) + mstoreDir <- + sequenceA $ makeAbsolute <$> flagToMaybe (globalStoreDir globalFlags) let mlogsDir = flagToMaybe (globalLogsDir globalFlags) cabalLayout = mkCabalDirLayout cabalDir mstoreDir mlogsDir @@ -515,7 +529,8 @@ installedIndex <- getInstalledPackages verbosity compiler packageDbs progDb' - let (envSpecs, envEntries') = environmentFileToSpecifiers installedIndex envEntries + let (envSpecs, envEntries') = + environmentFileToSpecifiers installedIndex envEntries -- Second, we need to use a fake project to let Cabal build the -- installables correctly. For that, we need a place to put a @@ -531,6 +546,7 @@ config tmpDir (envSpecs ++ specs) + InstallCommand buildCtx <- runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do @@ -561,91 +577,125 @@ printPlan verbosity baseCtx buildCtx buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx - -- Temporary fix for #5641 - when (any isLeft buildOutcomes) $ - warn verbosity $ "Some package(s) failed to build. " - <> "Try rerunning with -j1 if you can't see the error." runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes + -- Now that we built everything we can do the installation part. + -- First, figure out if / what parts we want to install: let dryRun = buildSettingDryRun $ buildSettings baseCtx - mkPkgBinDir = ( "bin") . - storePackageDirectory - (cabalStoreDirLayout $ cabalDirLayout baseCtx) - compilerId - installLibs = fromFlagOrDefault False (ninstInstallLibs newInstallFlags) - when (not installLibs && not dryRun) $ do - -- If there are exes, symlink them - let symlinkBindirUnknown = - "symlink-bindir is not defined. Set it in your cabal config file " - ++ "or use --symlink-bindir=" - symlinkBindir <- fromFlagOrDefault (die' verbosity symlinkBindirUnknown) - $ fmap makeAbsolute - $ projectConfigSymlinkBinDir - $ projectConfigBuildOnly - $ projectConfig $ baseCtx - createDirectoryIfMissingVerbose verbosity False symlinkBindir - warnIfNoExes verbosity buildCtx - let - doSymlink = symlinkBuiltPackage - verbosity - overwritePolicy - mkPkgBinDir symlinkBindir - in traverse_ doSymlink $ Map.toList $ targetsMap buildCtx - - when (installLibs && not dryRun) $ - if supportsPkgEnvFiles - then do - -- Why do we get it again? If we updated a globalPackage then we need - -- the new version. - installedIndex' <- getInstalledPackages verbosity compiler packageDbs progDb' - let - getLatest = fmap (head . snd) . take 1 . sortBy (comparing (Down . fst)) - . PI.lookupPackageName installedIndex' - globalLatest = concat (getLatest <$> globalPackages) - - baseEntries = - GhcEnvFileClearPackageDbStack : fmap GhcEnvFilePackageDb packageDbs - globalEntries = GhcEnvFilePackageId . installedUnitId <$> globalLatest - pkgEntries = ordNub $ - globalEntries - ++ envEntries' - ++ entriesForLibraryComponents (targetsMap buildCtx) - contents' = renderGhcEnvironmentFile (baseEntries ++ pkgEntries) - createDirectoryIfMissing True (takeDirectory envFile) - writeFileAtomic envFile (BS.pack contents') - else - warn verbosity $ - "The current compiler doesn't support safely installing libraries, " - ++ "so only executables will be available. (Library installation is " - ++ "supported on GHC 8.0+ only)" + -- Then, install! + when (not dryRun) $ + if installLibs + then installLibraries verbosity + buildCtx compiler packageDbs progDb envFile envEntries' + else installExes verbosity + baseCtx buildCtx platform compiler clientInstallFlags where configFlags' = disableTestsBenchsByDefault configFlags verbosity = fromFlagOrDefault normal (configVerbosity configFlags') cliConfig = commandLineFlagsToProjectConfig globalFlags configFlags' configExFlags - installFlags haddockFlags + installFlags clientInstallFlags' + haddockFlags testFlags globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig) - overwritePolicy = fromFlagOrDefault NeverOverwrite - $ ninstOverwritePolicy newInstallFlags +-- | Install any built exe by symlinking/copying it +-- we don't use BuildOutcomes because we also need the component names +installExes + :: Verbosity + -> ProjectBaseContext + -> ProjectBuildContext + -> Platform + -> Compiler + -> ClientInstallFlags + -> IO () +installExes verbosity baseCtx buildCtx platform compiler + clientInstallFlags = do + let storeDirLayout = cabalStoreDirLayout $ cabalDirLayout baseCtx + + mkUnitBinDir :: UnitId -> FilePath + mkUnitBinDir = + InstallDirs.bindir . + storePackageInstallDirs' storeDirLayout (compilerId compiler) + + mkExeName :: UnqualComponentName -> FilePath + mkExeName exe = unUnqualComponentName exe <.> exeExtension platform + installdirUnknown = + "installdir is not defined. Set it in your cabal config file " + ++ "or use --installdir=" + + installdir <- fromFlagOrDefault (die' verbosity installdirUnknown) $ + pure <$> cinstInstalldir clientInstallFlags + createDirectoryIfMissingVerbose verbosity False installdir + warnIfNoExes verbosity buildCtx + let + doInstall = installUnitExes + verbosity + overwritePolicy + mkUnitBinDir mkExeName + installdir installMethod + in traverse_ doInstall $ Map.toList $ targetsMap buildCtx + where + overwritePolicy = fromFlagOrDefault NeverOverwrite $ + cinstOverwritePolicy clientInstallFlags + installMethod = fromFlagOrDefault InstallMethodSymlink $ + cinstInstallMethod clientInstallFlags + +-- | Install any built library by adding it to the default ghc environment +installLibraries + :: Verbosity + -> ProjectBuildContext + -> Compiler + -> PackageDBStack + -> ProgramDb + -> FilePath -- ^ Environment file + -> [GhcEnvironmentFileEntry] + -> IO () +installLibraries verbosity buildCtx compiler + packageDbs programDb envFile envEntries = do + -- Why do we get it again? If we updated a globalPackage then we need + -- the new version. + installedIndex <- getInstalledPackages verbosity compiler packageDbs programDb + if supportsPkgEnvFiles $ getImplInfo compiler + then do + let + getLatest = fmap (head . snd) . take 1 . sortBy (comparing (Down . fst)) + . PI.lookupPackageName installedIndex + globalLatest = concat (getLatest <$> globalPackages) + + baseEntries = + GhcEnvFileClearPackageDbStack : fmap GhcEnvFilePackageDb packageDbs + globalEntries = GhcEnvFilePackageId . installedUnitId <$> globalLatest + pkgEntries = ordNub $ + globalEntries + ++ envEntries + ++ entriesForLibraryComponents (targetsMap buildCtx) + contents' = renderGhcEnvironmentFile (baseEntries ++ pkgEntries) + createDirectoryIfMissing True (takeDirectory envFile) + writeFileAtomic envFile (BS.pack contents') + else + warn verbosity $ + "The current compiler doesn't support safely installing libraries, " + ++ "so only executables will be available. (Library installation is " + ++ "supported on GHC 8.0+ only)" + warnIfNoExes :: Verbosity -> ProjectBuildContext -> IO () warnIfNoExes verbosity buildCtx = when noExes $ - warn verbosity $ "You asked to install executables, " - <> "but there are no executables in " - <> plural (listPlural selectors) "target" "targets" <> ": " - <> intercalate ", " (showTargetSelector <$> selectors) <> ". " - <> "Perhaps you want to use --lib " - <> "to install libraries instead." + warn verbosity $ + "You asked to install executables, but there are no executables in " + <> plural (listPlural selectors) "target" "targets" <> ": " + <> intercalate ", " (showTargetSelector <$> selectors) <> ". " + <> "Perhaps you want to use --lib to install libraries instead." where - targets = concat $ Map.elems $ targetsMap buildCtx + targets = concat $ Map.elems $ targetsMap buildCtx components = fst <$> targets - selectors = concatMap snd targets - noExes = null $ catMaybes $ exeMaybe <$> components + selectors = concatMap snd targets + noExes = null $ catMaybes $ exeMaybe <$> components + exeMaybe (ComponentTarget (CExeName exe) _) = Just exe - exeMaybe _ = Nothing + exeMaybe _ = Nothing globalPackages :: [PackageName] globalPackages = mkPackageName <$> @@ -656,13 +706,16 @@ , "bin-package-db" ] -environmentFileToSpecifiers :: PI.InstalledPackageIndex -> [GhcEnvironmentFileEntry] - -> ([PackageSpecifier a], [GhcEnvironmentFileEntry]) +environmentFileToSpecifiers + :: PI.InstalledPackageIndex -> [GhcEnvironmentFileEntry] + -> ([PackageSpecifier a], [GhcEnvironmentFileEntry]) environmentFileToSpecifiers ipi = foldMap $ \case (GhcEnvFilePackageId unitId) - | Just InstalledPackageInfo{ sourcePackageId = PackageIdentifier{..}, installedUnitId } + | Just InstalledPackageInfo + { sourcePackageId = PackageIdentifier{..}, installedUnitId } <- PI.lookupUnitId ipi unitId - , let pkgSpec = NamedPackage pkgName [PackagePropertyVersion (thisVersion pkgVersion)] + , let pkgSpec = NamedPackage pkgName + [PackagePropertyVersion (thisVersion pkgVersion)] -> if pkgName `elem` globalPackages then ([pkgSpec], []) else ([pkgSpec], [GhcEnvFilePackageId installedUnitId]) @@ -675,60 +728,94 @@ configFlags { configTests = Flag False <> configTests configFlags , configBenchmarks = Flag False <> configBenchmarks configFlags } --- | Symlink every exe from a package from the store to a given location -symlinkBuiltPackage :: Verbosity - -> OverwritePolicy -- ^ Whether to overwrite existing files - -> (UnitId -> FilePath) -- ^ A function to get an UnitId's - -- store directory - -> FilePath -- ^ Where to put the symlink - -> ( UnitId - , [(ComponentTarget, [TargetSelector])] ) - -> IO () -symlinkBuiltPackage verbosity overwritePolicy - mkSourceBinDir destDir - (pkg, components) = - traverse_ symlinkAndWarn exes +-- | Symlink/copy every exe from a package from the store to a given location +installUnitExes + :: Verbosity + -> OverwritePolicy -- ^ Whether to overwrite existing files + -> (UnitId -> FilePath) -- ^ A function to get an UnitId's + -- ^ store directory + -> (UnqualComponentName -> FilePath) -- ^ A function to get an + -- ^ exe's filename + -> FilePath + -> InstallMethod + -> ( UnitId + , [(ComponentTarget, [TargetSelector])] ) + -> IO () +installUnitExes verbosity overwritePolicy + mkSourceBinDir mkExeName + installdir installMethod + (unit, components) = + traverse_ installAndWarn exes where exes = catMaybes $ (exeMaybe . fst) <$> components exeMaybe (ComponentTarget (CExeName exe) _) = Just exe exeMaybe _ = Nothing - symlinkAndWarn exe = do - success <- symlinkBuiltExe + installAndWarn exe = do + success <- installBuiltExe verbosity overwritePolicy - (mkSourceBinDir pkg) destDir exe + (mkSourceBinDir unit) (mkExeName exe) + installdir installMethod let errorMessage = case overwritePolicy of - NeverOverwrite -> - "Path '" <> (destDir prettyShow exe) <> "' already exists. " - <> "Use --overwrite-policy=always to overwrite." - -- This shouldn't even be possible, but we keep it in case - -- symlinking logic changes - AlwaysOverwrite -> "Symlinking '" <> prettyShow exe <> "' failed." + NeverOverwrite -> + "Path '" <> (installdir prettyShow exe) <> "' already exists. " + <> "Use --overwrite-policy=always to overwrite." + -- This shouldn't even be possible, but we keep it in case + -- symlinking/copying logic changes + AlwaysOverwrite -> + case installMethod of + InstallMethodSymlink -> "Symlinking" + InstallMethodCopy -> + "Copying" <> " '" <> prettyShow exe <> "' failed." unless success $ die' verbosity errorMessage --- | Symlink a specific exe. -symlinkBuiltExe :: Verbosity -> OverwritePolicy - -> FilePath -> FilePath - -> UnqualComponentName - -> IO Bool -symlinkBuiltExe verbosity overwritePolicy sourceDir destDir exe = do - notice verbosity $ "Symlinking '" <> prettyShow exe <> "'" +-- | Install a specific exe. +installBuiltExe + :: Verbosity -> OverwritePolicy + -> FilePath -- ^ The directory where the built exe is located + -> FilePath -- ^ The exe's filename + -> FilePath -- ^ the directory where it should be installed + -> InstallMethod + -> IO Bool -- ^ Whether the installation was successful +installBuiltExe verbosity overwritePolicy + sourceDir exeName + installdir InstallMethodSymlink = do + notice verbosity $ "Symlinking '" <> exeName <> "'" symlinkBinary overwritePolicy - destDir + installdir sourceDir - exe - $ unUnqualComponentName exe + (mkUnqualComponentName exeName) + exeName +installBuiltExe verbosity overwritePolicy + sourceDir exeName + installdir InstallMethodCopy = do + notice verbosity $ "Copying '" <> exeName <> "'" + exists <- doesPathExist destination + case (exists, overwritePolicy) of + (True , NeverOverwrite ) -> pure False + (True , AlwaysOverwrite) -> remove >> copy + (False, _ ) -> copy + where + source = sourceDir exeName + destination = installdir exeName + remove = do + isDir <- doesDirectoryExist destination + if isDir + then removeDirectory destination + else removeFile destination + copy = copyFile source destination >> pure True -- | Create 'GhcEnvironmentFileEntry's for packages with exposed libraries. entriesForLibraryComponents :: TargetsMap -> [GhcEnvironmentFileEntry] entriesForLibraryComponents = Map.foldrWithKey' (\k v -> mappend (go k v)) [] where hasLib :: (ComponentTarget, [TargetSelector]) -> Bool - hasLib (ComponentTarget CLibName _, _) = True - hasLib (ComponentTarget (CSubLibName _) _, _) = True - hasLib _ = False + hasLib (ComponentTarget (CLibName _) _, _) = True + hasLib _ = False - go :: UnitId -> [(ComponentTarget, [TargetSelector])] -> [GhcEnvironmentFileEntry] + go :: UnitId + -> [(ComponentTarget, [TargetSelector])] + -> [GhcEnvironmentFileEntry] go unitId targets | any hasLib targets = [GhcEnvFilePackageId unitId] | otherwise = [] @@ -742,9 +829,10 @@ -- ^ Where to put the dist directory -> [PackageSpecifier UnresolvedSourcePackage] -- ^ The packages to be included in the project + -> CurrentCommand -> IO ProjectBaseContext -establishDummyProjectBaseContext verbosity cliConfig tmpDir localPackages = do - +establishDummyProjectBaseContext verbosity cliConfig tmpDir + localPackages currentCommand = do cabalDir <- getCabalDir -- Create the dist directories @@ -779,7 +867,8 @@ cabalDirLayout, projectConfig, localPackages, - buildSettings + buildSettings, + currentCommand } where mdistDirectory = flagToMaybe @@ -797,8 +886,9 @@ -- and disabled tests\/benchmarks, fail if there are no such -- components -- -selectPackageTargets :: TargetSelector - -> [AvailableTarget k] -> Either TargetProblem [k] +selectPackageTargets + :: TargetSelector + -> [AvailableTarget k] -> Either TargetProblem [k] selectPackageTargets targetSelector targets -- If there are any buildable targets then we select those @@ -830,8 +920,9 @@ -- -- For the @build@ command we just need the basic checks on being buildable etc. -- -selectComponentTarget :: SubComponentTarget - -> AvailableTarget k -> Either TargetProblem k +selectComponentTarget + :: SubComponentTarget + -> AvailableTarget k -> Either TargetProblem k selectComponentTarget subtarget = either (Left . TargetProblemCommon) Right . selectComponentTargetBasic subtarget diff --git a/cabal/cabal-install/Distribution/Client/CmdInstall/ClientInstallFlags.hs b/cabal/cabal-install/Distribution/Client/CmdInstall/ClientInstallFlags.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-install/Distribution/Client/CmdInstall/ClientInstallFlags.hs @@ -0,0 +1,105 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +module Distribution.Client.CmdInstall.ClientInstallFlags +( InstallMethod(..) +, ClientInstallFlags(..) +, defaultClientInstallFlags +, clientInstallOptions +) where + +import Distribution.Client.Compat.Prelude + +import Distribution.ReadE + ( ReadE(..), succeedReadE ) +import Distribution.Simple.Command + ( ShowOrParseArgs(..), OptionField(..), option, reqArg ) +import Distribution.Simple.Setup + ( Flag(..), trueArg, flagToList, toFlag ) + +import Distribution.Client.InstallSymlink + ( OverwritePolicy(..) ) + + +data InstallMethod = InstallMethodCopy + | InstallMethodSymlink + deriving (Eq, Show, Generic, Bounded, Enum) + +instance Binary InstallMethod + +data ClientInstallFlags = ClientInstallFlags + { cinstInstallLibs :: Flag Bool + , cinstEnvironmentPath :: Flag FilePath + , cinstOverwritePolicy :: Flag OverwritePolicy + , cinstInstallMethod :: Flag InstallMethod + , cinstInstalldir :: Flag FilePath + } deriving (Eq, Show, Generic) + +instance Monoid ClientInstallFlags where + mempty = gmempty + mappend = (<>) + +instance Semigroup ClientInstallFlags where + (<>) = gmappend + +instance Binary ClientInstallFlags + +defaultClientInstallFlags :: ClientInstallFlags +defaultClientInstallFlags = ClientInstallFlags + { cinstInstallLibs = toFlag False + , cinstEnvironmentPath = mempty + , cinstOverwritePolicy = mempty + , cinstInstallMethod = mempty + , cinstInstalldir = mempty + } + +clientInstallOptions :: ShowOrParseArgs -> [OptionField ClientInstallFlags] +clientInstallOptions _ = + [ option [] ["lib"] + "Install libraries rather than executables from the target package." + cinstInstallLibs (\v flags -> flags { cinstInstallLibs = v }) + trueArg + , option [] ["package-env", "env"] + "Set the environment file that may be modified." + cinstEnvironmentPath (\pf flags -> flags { cinstEnvironmentPath = pf }) + (reqArg "ENV" (succeedReadE Flag) flagToList) + , option [] ["overwrite-policy"] + "How to handle already existing symlinks." + cinstOverwritePolicy (\v flags -> flags { cinstOverwritePolicy = v }) + $ reqArg + "always|never" + readOverwritePolicyFlag + showOverwritePolicyFlag + , option [] ["install-method"] + "How to install the executables." + cinstInstallMethod (\v flags -> flags { cinstInstallMethod = v }) + $ reqArg + "copy|symlink" + readInstallMethodFlag + showInstallMethodFlag + , option [] ["installdir"] + "Where to install (by symlinking or copying) the executables in." + cinstInstalldir (\v flags -> flags { cinstInstalldir = v }) + $ reqArg "DIR" (succeedReadE Flag) flagToList + ] + +readOverwritePolicyFlag :: ReadE (Flag OverwritePolicy) +readOverwritePolicyFlag = ReadE $ \case + "always" -> Right $ Flag AlwaysOverwrite + "never" -> Right $ Flag NeverOverwrite + policy -> Left $ "'" <> policy <> "' isn't a valid overwrite policy" + +showOverwritePolicyFlag :: Flag OverwritePolicy -> [String] +showOverwritePolicyFlag (Flag AlwaysOverwrite) = ["always"] +showOverwritePolicyFlag (Flag NeverOverwrite) = ["never"] +showOverwritePolicyFlag NoFlag = [] + +readInstallMethodFlag :: ReadE (Flag InstallMethod) +readInstallMethodFlag = ReadE $ \case + "copy" -> Right $ Flag InstallMethodCopy + "symlink" -> Right $ Flag InstallMethodSymlink + method -> Left $ "'" <> method <> "' isn't a valid install-method" + +showInstallMethodFlag :: Flag InstallMethod -> [String] +showInstallMethodFlag (Flag InstallMethodCopy) = ["copy"] +showInstallMethodFlag (Flag InstallMethodSymlink) = ["symlink"] +showInstallMethodFlag NoFlag = [] diff --git a/cabal/cabal-install/Distribution/Client/CmdLegacy.hs b/cabal/cabal-install/Distribution/Client/CmdLegacy.hs --- a/cabal/cabal-install/Distribution/Client/CmdLegacy.hs +++ b/cabal/cabal-install/Distribution/Client/CmdLegacy.hs @@ -15,7 +15,7 @@ import qualified Distribution.Simple.Setup as Setup import Distribution.Simple.Command import Distribution.Simple.Utils - ( warn, wrapText ) + ( wrapText ) import Distribution.Verbosity ( Verbosity, normal ) @@ -24,28 +24,20 @@ import qualified Data.Text as T -- Tweaked versions of code from Main. -regularCmd :: (HasVerbosity flags) => CommandUI flags -> (flags -> [String] -> globals -> IO action) -> Bool -> CommandSpec (globals -> IO action) -regularCmd ui action shouldWarn = - CommandSpec ui ((flip commandAddAction) (\flags extra globals -> showWarning flags >> action flags extra globals)) NormalCommand - where - showWarning flags = if shouldWarn - then warn (verbosity flags) (deprecationNote (commandName ui) ++ "\n") - else return () +regularCmd :: (HasVerbosity flags) => CommandUI flags -> (flags -> [String] -> globals -> IO action) -> CommandSpec (globals -> IO action) +regularCmd ui action = + CommandSpec ui ((flip commandAddAction) (\flags extra globals -> action flags extra globals)) NormalCommand -wrapperCmd :: Monoid flags => CommandUI flags -> (flags -> Setup.Flag Verbosity) -> (flags -> Setup.Flag String) -> Bool -> CommandSpec (Client.GlobalFlags -> IO ()) -wrapperCmd ui verbosity' distPref shouldWarn = - CommandSpec ui (\ui' -> wrapperAction ui' verbosity' distPref shouldWarn) NormalCommand +wrapperCmd :: Monoid flags => CommandUI flags -> (flags -> Setup.Flag Verbosity) -> (flags -> Setup.Flag String) -> CommandSpec (Client.GlobalFlags -> IO ()) +wrapperCmd ui verbosity' distPref = + CommandSpec ui (\ui' -> wrapperAction ui' verbosity' distPref) NormalCommand -wrapperAction :: Monoid flags => CommandUI flags -> (flags -> Setup.Flag Verbosity) -> (flags -> Setup.Flag String) -> Bool -> Command (Client.GlobalFlags -> IO ()) -wrapperAction command verbosityFlag distPrefFlag shouldWarn = +wrapperAction :: Monoid flags => CommandUI flags -> (flags -> Setup.Flag Verbosity) -> (flags -> Setup.Flag String) -> Command (Client.GlobalFlags -> IO ()) +wrapperAction command verbosityFlag distPrefFlag = commandAddAction command { commandDefaultFlags = mempty } $ \flags extraArgs globalFlags -> do let verbosity' = Setup.fromFlagOrDefault normal (verbosityFlag flags) - if shouldWarn - then warn verbosity' (deprecationNote (commandName command) ++ "\n") - else return () - load <- try (loadConfigOrSandboxConfig verbosity' globalFlags) let config = either (\(SomeException _) -> mempty) snd load distPref <- findSavedDistPref config (distPrefFlag flags) @@ -73,6 +65,9 @@ instance (HasVerbosity a) => HasVerbosity (a, b, c, d) where verbosity (a, _, _, _) = verbosity a +instance (HasVerbosity a) => HasVerbosity (a, b, c, d, e) where + verbosity (a, _, _, _, _) = verbosity a + instance HasVerbosity Setup.BuildFlags where verbosity = verbosity . Setup.buildVerbosity @@ -108,17 +103,6 @@ -- -deprecationNote :: String -> String -deprecationNote cmd = wrapText $ - "The " ++ cmd ++ " command is a part of the legacy v1 style of cabal usage.\n\n" ++ - - "Please switch to using either the new project style and the new-" ++ cmd ++ - " command or the legacy v1-" ++ cmd ++ " alias as new-style projects will" ++ - " become the default in the next version of cabal-install. Please file a" ++ - " bug if you cannot replicate a working v1- use case with the new-style commands.\n\n" ++ - - "For more information, see: https://wiki.haskell.org/Cabal/NewBuild\n" - legacyNote :: String -> String legacyNote cmd = wrapText $ "The v1-" ++ cmd ++ " command is a part of the legacy v1 style of cabal usage.\n\n" ++ @@ -129,11 +113,9 @@ "For more information, see: https://wiki.haskell.org/Cabal/NewBuild\n" -toLegacyCmd :: (Bool -> CommandSpec (globals -> IO action)) -> [CommandSpec (globals -> IO action)] -toLegacyCmd mkSpec = [toDeprecated (mkSpec True), toLegacy (mkSpec False)] +toLegacyCmd :: CommandSpec (globals -> IO action) -> [CommandSpec (globals -> IO action)] +toLegacyCmd mkSpec = [toLegacy mkSpec] where - legacyMsg = T.unpack . T.replace "v1-" "" . T.pack - toLegacy (CommandSpec origUi@CommandUI{..} action type') = CommandSpec legUi action type' where legUi = origUi @@ -143,17 +125,6 @@ Nothing -> legacyNote commandName } - toDeprecated (CommandSpec origUi@CommandUI{..} action type') = CommandSpec depUi action type' - where - depUi = origUi - { commandName = legacyMsg commandName - , commandUsage = legacyMsg . commandUsage - , commandDescription = (legacyMsg .) <$> commandDescription - , commandNotes = Just $ \pname -> case commandNotes of - Just notes -> legacyMsg (notes pname) ++ "\n" ++ deprecationNote commandName - Nothing -> deprecationNote commandName - } - legacyCmd :: (HasVerbosity flags) => CommandUI flags -> (flags -> [String] -> globals -> IO action) -> [CommandSpec (globals -> IO action)] legacyCmd ui action = toLegacyCmd (regularCmd ui action) @@ -161,13 +132,22 @@ legacyWrapperCmd ui verbosity' distPref = toLegacyCmd (wrapperCmd ui verbosity' distPref) newCmd :: CommandUI flags -> (flags -> [String] -> globals -> IO action) -> [CommandSpec (globals -> IO action)] -newCmd origUi@CommandUI{..} action = [cmd v2Ui, cmd origUi] +newCmd origUi@CommandUI{..} action = [cmd defaultUi, cmd newUi, cmd origUi] where cmd ui = CommandSpec ui (flip commandAddAction action) NormalCommand - v2Msg = T.unpack . T.replace "new-" "v2-" . T.pack - v2Ui = origUi - { commandName = v2Msg commandName - , commandUsage = v2Msg . commandUsage - , commandDescription = (v2Msg .) <$> commandDescription - , commandNotes = (v2Msg .) <$> commandDescription + + newMsg = T.unpack . T.replace "v2-" "new-" . T.pack + newUi = origUi + { commandName = newMsg commandName + , commandUsage = newMsg . commandUsage + , commandDescription = (newMsg .) <$> commandDescription + , commandNotes = (newMsg .) <$> commandDescription + } + + defaultMsg = T.unpack . T.replace "v2-" "" . T.pack + defaultUi = origUi + { commandName = defaultMsg commandName + , commandUsage = defaultMsg . commandUsage + , commandDescription = (defaultMsg .) <$> commandDescription + , commandNotes = (defaultMsg .) <$> commandDescription } diff --git a/cabal/cabal-install/Distribution/Client/CmdRepl.hs b/cabal/cabal-install/Distribution/Client/CmdRepl.hs --- a/cabal/cabal-install/Distribution/Client/CmdRepl.hs +++ b/cabal/cabal-install/Distribution/Client/CmdRepl.hs @@ -45,16 +45,20 @@ import Distribution.Client.Types ( PackageLocation(..), PackageSpecifier(..), UnresolvedSourcePackage ) import Distribution.Simple.Setup - ( HaddockFlags, fromFlagOrDefault, replOptions + ( HaddockFlags, TestFlags, fromFlagOrDefault, replOptions , Flag(..), toFlag, trueArg, falseArg ) import Distribution.Simple.Command ( CommandUI(..), liftOption, usageAlternatives, option , ShowOrParseArgs, OptionField, reqArg ) +import Distribution.Compiler + ( CompilerFlavor(GHC) ) +import Distribution.Simple.Compiler + ( compilerCompatVersion ) import Distribution.Package ( Package(..), packageName, UnitId, installedUnitId ) import Distribution.PackageDescription.PrettyPrint -import Distribution.Parsec.Class - ( Parsec(..) ) +import Distribution.Parsec + ( Parsec(..), parsecCommaList ) import Distribution.Pretty ( prettyShow ) import Distribution.ReadE @@ -72,17 +76,19 @@ ( Dependency(..) ) import Distribution.Types.GenericPackageDescription ( emptyGenericPackageDescription ) +import Distribution.Types.LibraryName + ( LibraryName(..) ) import Distribution.Types.PackageDescription ( PackageDescription(..), emptyPackageDescription ) +import Distribution.Types.PackageName.Magic + ( fakePackageId ) import Distribution.Types.Library ( Library(..), emptyLibrary ) -import Distribution.Types.PackageId - ( PackageIdentifier(..) ) import Distribution.Types.Version - ( mkVersion, version0 ) + ( mkVersion ) import Distribution.Types.VersionRange ( anyVersion ) -import Distribution.Text +import Distribution.Deprecated.Text ( display ) import Distribution.Verbosity ( Verbosity, normal, lessVerbose ) @@ -96,7 +102,7 @@ import qualified Data.Map as Map import qualified Data.Set as Set import System.Directory - ( getTemporaryDirectory, removeDirectoryRecursive ) + ( getCurrentDirectory, getTemporaryDirectory, removeDirectoryRecursive ) import System.FilePath ( () ) @@ -133,19 +139,18 @@ where dependencyReadE :: ReadE [Dependency] dependencyReadE = - fmap pure $ - parsecToReadE - ("couldn't parse dependency: " ++) - parsec + parsecToReadE + ("couldn't parse dependency: " ++) + (parsecCommaList parsec) -replCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, ReplFlags, EnvFlags) +replCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags, ReplFlags, EnvFlags) replCommand = Client.installCommand { - commandName = "new-repl", + commandName = "v2-repl", commandSynopsis = "Open an interactive session for the given component.", - commandUsage = usageAlternatives "new-repl" [ "[TARGET] [FLAGS]" ], + commandUsage = usageAlternatives "v2-repl" [ "[TARGET] [FLAGS]" ], commandDescription = Just $ \_ -> wrapText $ "Open an interactive session for a component within the project. The " - ++ "available targets are the same as for the 'new-build' command: " + ++ "available targets are the same as for the 'v2-build' command: " ++ "individual components within packages in the project, including " ++ "libraries, executables, test-suites or benchmarks. Packages can " ++ "also be specified in which case the library component in the " @@ -158,45 +163,45 @@ ++ "'cabal.project.local' and other files.", commandNotes = Just $ \pname -> "Examples, open an interactive session:\n" - ++ " " ++ pname ++ " new-repl\n" + ++ " " ++ pname ++ " v2-repl\n" ++ " for the default component in the package in the current directory\n" - ++ " " ++ pname ++ " new-repl pkgname\n" + ++ " " ++ pname ++ " v2-repl pkgname\n" ++ " for the default component in the package named 'pkgname'\n" - ++ " " ++ pname ++ " new-repl ./pkgfoo\n" + ++ " " ++ pname ++ " v2-repl ./pkgfoo\n" ++ " for the default component in the package in the ./pkgfoo directory\n" - ++ " " ++ pname ++ " new-repl cname\n" + ++ " " ++ pname ++ " v2-repl cname\n" ++ " for the component named 'cname'\n" - ++ " " ++ pname ++ " new-repl pkgname:cname\n" + ++ " " ++ pname ++ " v2-repl pkgname:cname\n" ++ " for the component 'cname' in the package 'pkgname'\n\n" - ++ " " ++ pname ++ " new-repl --build-depends lens\n" + ++ " " ++ pname ++ " v2-repl --build-depends lens\n" ++ " add the latest version of the library 'lens' to the default component " ++ "(or no componentif there is no project present)\n" - ++ " " ++ pname ++ " new-repl --build-depends \"lens >= 4.15 && < 4.18\"\n" + ++ " " ++ pname ++ " v2-repl --build-depends \"lens >= 4.15 && < 4.18\"\n" ++ " add a version (constrained between 4.15 and 4.18) of the library 'lens' " ++ "to the default component (or no component if there is no project present)\n" ++ cmdCommonHelpTextNewBuildBeta, - commandDefaultFlags = (configFlags,configExFlags,installFlags,haddockFlags,[],defaultEnvFlags), + commandDefaultFlags = (configFlags,configExFlags,installFlags,haddockFlags,testFlags,[],defaultEnvFlags), commandOptions = \showOrParseArgs -> map liftOriginal (commandOptions Client.installCommand showOrParseArgs) ++ map liftReplOpts (replOptions showOrParseArgs) ++ map liftEnvOpts (envOptions showOrParseArgs) } where - (configFlags,configExFlags,installFlags,haddockFlags) = commandDefaultFlags Client.installCommand + (configFlags,configExFlags,installFlags,haddockFlags,testFlags) = commandDefaultFlags Client.installCommand liftOriginal = liftOption projectOriginal updateOriginal liftReplOpts = liftOption projectReplOpts updateReplOpts liftEnvOpts = liftOption projectEnvOpts updateEnvOpts - projectOriginal (a,b,c,d,_,_) = (a,b,c,d) - updateOriginal (a,b,c,d) (_,_,_,_,e,f) = (a,b,c,d,e,f) + projectOriginal (a,b,c,d,e,_,_) = (a,b,c,d,e) + updateOriginal (a,b,c,d,e) (_,_,_,_,_,f,g) = (a,b,c,d,e,f,g) - projectReplOpts (_,_,_,_,e,_) = e - updateReplOpts e (a,b,c,d,_,f) = (a,b,c,d,e,f) + projectReplOpts (_,_,_,_,_,f,_) = f + updateReplOpts f (a,b,c,d,e,_,g) = (a,b,c,d,e,f,g) - projectEnvOpts (_,_,_,_,_,f) = f - updateEnvOpts f (a,b,c,d,e,_) = (a,b,c,d,e,f) + projectEnvOpts (_,_,_,_,_,_,g) = g + updateEnvOpts g (a,b,c,d,e,f,_) = (a,b,c,d,e,f,g) -- | The @repl@ command is very much like @build@. It brings the install plan -- up to date, selects that part of the plan needed by the given or implicit @@ -209,16 +214,16 @@ -- For more details on how this works, see the module -- "Distribution.Client.ProjectOrchestration" -- -replAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, ReplFlags, EnvFlags) +replAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags, ReplFlags, EnvFlags) -> [String] -> GlobalFlags -> IO () -replAction (configFlags, configExFlags, installFlags, haddockFlags, replFlags, envFlags) +replAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags, replFlags, envFlags) targetStrings globalFlags = do let ignoreProject = fromFlagOrDefault False (envIgnoreProject envFlags) with = withProject cliConfig verbosity targetStrings without config = withoutProject (config <> cliConfig) verbosity targetStrings - (baseCtx, targetSelectors, finalizer) <- if ignoreProject + (baseCtx, targetSelectors, finalizer, replType) <- if ignoreProject then do globalConfig <- runRebuild "" $ readGlobalConfig verbosity globalConfigFlag without globalConfig @@ -255,7 +260,7 @@ -- In addition, to avoid a *third* trip through the solver, we are -- replicating the second half of 'runProjectPreBuildPhase' by hand -- here. - (buildCtx, replFlags') <- withInstallPlan verbosity baseCtx' $ + (buildCtx, replFlags'') <- withInstallPlan verbosity baseCtx' $ \elaboratedPlan elaboratedShared' -> do let ProjectBaseContext{..} = baseCtx' @@ -268,9 +273,6 @@ targets elaboratedPlan includeTransitive = fromFlagOrDefault True (envIncludeTransitive envFlags) - replFlags' = case originalComponent of - Just oci -> generateReplFlags includeTransitive elaboratedPlan' oci - Nothing -> [] pkgsBuildStatus <- rebuildTargetsDryRun distDirLayout elaboratedShared' elaboratedPlan' @@ -287,11 +289,27 @@ , pkgsBuildStatus , targetsMap = targets } - return (buildCtx, replFlags') + + ElaboratedSharedConfig { pkgConfigCompiler = compiler } = elaboratedShared' + + -- First version of GHC where GHCi supported the flag we need. + -- https://downloads.haskell.org/~ghc/7.6.1/docs/html/users_guide/release-7-6-1.html + minGhciScriptVersion = mkVersion [7, 6] + replFlags' = case originalComponent of + Just oci -> generateReplFlags includeTransitive elaboratedPlan' oci + Nothing -> [] + replFlags'' = case replType of + GlobalRepl scriptPath + | Just version <- compilerCompatVersion GHC compiler + , version >= minGhciScriptVersion -> ("-ghci-script" ++ scriptPath) : replFlags' + _ -> replFlags' + + return (buildCtx, replFlags'') + let buildCtx' = buildCtx { elaboratedShared = (elaboratedShared buildCtx) - { pkgConfigReplOptions = replFlags ++ replFlags' } + { pkgConfigReplOptions = replFlags ++ replFlags'' } } printPlan verbosity baseCtx' buildCtx' @@ -302,7 +320,9 @@ verbosity = fromFlagOrDefault normal (configVerbosity configFlags) cliConfig = commandLineFlagsToProjectConfig globalFlags configFlags configExFlags - installFlags haddockFlags + installFlags + mempty -- ClientInstallFlags, not needed here + haddockFlags testFlags globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig) validatedTargets elaboratedPlan targetSelectors = do @@ -332,16 +352,26 @@ } deriving (Show) -withProject :: ProjectConfig -> Verbosity -> [String] -> IO (ProjectBaseContext, [TargetSelector], IO ()) +-- | Tracks what type of GHCi instance we're creating. +data ReplType = ProjectRepl + | GlobalRepl FilePath -- ^ The 'FilePath' argument is path to a GHCi + -- script responsible for changing to the + -- correct directory. Only works on GHC geq + -- 7.6, though. 🙁 + deriving (Show, Eq) + +withProject :: ProjectConfig -> Verbosity -> [String] + -> IO (ProjectBaseContext, [TargetSelector], IO (), ReplType) withProject cliConfig verbosity targetStrings = do - baseCtx <- establishProjectBaseContext verbosity cliConfig + baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand targetSelectors <- either (reportTargetSelectorProblems verbosity) return =<< readTargetSelectors (localPackages baseCtx) (Just LibKind) targetStrings - return (baseCtx, targetSelectors, return ()) + return (baseCtx, targetSelectors, return (), ProjectRepl) -withoutProject :: ProjectConfig -> Verbosity -> [String] -> IO (ProjectBaseContext, [TargetSelector], IO ()) +withoutProject :: ProjectConfig -> Verbosity -> [String] + -> IO (ProjectBaseContext, [TargetSelector], IO (), ReplType) withoutProject config verbosity extraArgs = do unless (null extraArgs) $ die' verbosity $ "'repl' doesn't take any extra arguments when outside a project: " ++ unwords extraArgs @@ -370,23 +400,28 @@ { targetBuildDepends = [baseDep] , defaultLanguage = Just Haskell2010 } - baseDep = Dependency "base" anyVersion - pkgId = PackageIdentifier "fake-package" version0 + baseDep = Dependency "base" anyVersion (Set.singleton LMainLibName) + pkgId = fakePackageId writeGenericPackageDescription (tempDir "fake-package.cabal") genericPackageDescription + let ghciScriptPath = tempDir "setcwd.ghci" + cwd <- getCurrentDirectory + writeFile ghciScriptPath (":cd " ++ cwd) + baseCtx <- establishDummyProjectBaseContext verbosity config tempDir [SpecificSourcePackage sourcePackage] + OtherCommand let targetSelectors = [TargetPackage TargetExplicitNamed [pkgId] Nothing] finalizer = handleDoesNotExist () (removeDirectoryRecursive tempDir) - return (baseCtx, targetSelectors, finalizer) + return (baseCtx, targetSelectors, finalizer, GlobalRepl ghciScriptPath) addDepsToProjectTarget :: [Dependency] -> PackageId diff --git a/cabal/cabal-install/Distribution/Client/CmdRun.hs b/cabal/cabal-install/Distribution/Client/CmdRun.hs --- a/cabal/cabal-install/Distribution/Client/CmdRun.hs +++ b/cabal/cabal-install/Distribution/Client/CmdRun.hs @@ -9,7 +9,7 @@ -- * The @run@ CLI and action runCommand, runAction, - handleShebang, + handleShebang, validScript, -- * Internals exposed for testing TargetProblem(..), @@ -29,17 +29,17 @@ ( defaultGlobalFlags ) import qualified Distribution.Client.Setup as Client import Distribution.Simple.Setup - ( HaddockFlags, fromFlagOrDefault ) + ( HaddockFlags, TestFlags, fromFlagOrDefault ) import Distribution.Simple.Command ( CommandUI(..), usageAlternatives ) import Distribution.Types.ComponentName ( showComponentName ) -import Distribution.Text +import Distribution.Deprecated.Text ( display ) import Distribution.Verbosity ( Verbosity, normal ) import Distribution.Simple.Utils - ( wrapText, die', ordNub, info + ( wrapText, warn, die', ordNub, info , createTempDirectory, handleDoesNotExist ) import Distribution.Client.CmdInstall ( establishDummyProjectBaseContext ) @@ -73,12 +73,10 @@ ( executableFieldGrammar ) import Distribution.PackageDescription.PrettyPrint ( writeGenericPackageDescription ) -import Distribution.Parsec.Common +import Distribution.Parsec ( Position(..) ) -import Distribution.Parsec.ParseResult - ( ParseResult, parseString, parseFatalFailure ) -import Distribution.Parsec.Parser - ( readFields ) +import Distribution.Fields + ( ParseResult, parseString, parseFatalFailure, readFields ) import qualified Distribution.SPDX.License as SPDX import Distribution.Solver.Types.SourcePackage as SP ( SourcePackage(..) ) @@ -92,10 +90,10 @@ ( GenericPackageDescription(..), emptyGenericPackageDescription ) import Distribution.Types.PackageDescription ( PackageDescription(..), emptyPackageDescription ) -import Distribution.Types.PackageId - ( PackageIdentifier(..) ) import Distribution.Types.Version - ( mkVersion, version0 ) + ( mkVersion ) +import Distribution.Types.PackageName.Magic + ( fakePackageId ) import Language.Haskell.Extension ( Language(..) ) @@ -106,13 +104,14 @@ import System.Directory ( getTemporaryDirectory, removeDirectoryRecursive, doesFileExist ) import System.FilePath - ( () ) + ( (), isValid, isPathSeparator, takeExtension ) -runCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) + +runCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) runCommand = Client.installCommand { - commandName = "new-run", + commandName = "v2-run", commandSynopsis = "Run an executable.", - commandUsage = usageAlternatives "new-run" + commandUsage = usageAlternatives "v2-run" [ "[TARGET] [FLAGS] [-- EXECUTABLE_FLAGS]" ], commandDescription = Just $ \pname -> wrapText $ "Runs the specified executable-like component (an executable, a test, " @@ -134,18 +133,18 @@ ++ "'cabal.project.local' and other files.", commandNotes = Just $ \pname -> "Examples:\n" - ++ " " ++ pname ++ " new-run\n" + ++ " " ++ pname ++ " v2-run\n" ++ " Run the executable-like in the package in the current directory\n" - ++ " " ++ pname ++ " new-run foo-tool\n" + ++ " " ++ pname ++ " v2-run foo-tool\n" ++ " Run the named executable-like (in any package in the project)\n" - ++ " " ++ pname ++ " new-run pkgfoo:foo-tool\n" + ++ " " ++ pname ++ " v2-run pkgfoo:foo-tool\n" ++ " Run the executable-like 'foo-tool' in the package 'pkgfoo'\n" - ++ " " ++ pname ++ " new-run foo -O2 -- dothing --fooflag\n" + ++ " " ++ pname ++ " v2-run foo -O2 -- dothing --fooflag\n" ++ " Build with '-O2' and run the program, passing it extra arguments.\n\n" ++ cmdCommonHelpTextNewBuildBeta } - + -- | The @run@ command runs a specified executable-like component, building it -- first if necessary. The component can be either an executable, a test, -- or a benchmark. This is particularly useful for passing arguments to @@ -154,28 +153,30 @@ -- For more details on how this works, see the module -- "Distribution.Client.ProjectOrchestration" -- -runAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) +runAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) -> [String] -> GlobalFlags -> IO () -runAction (configFlags, configExFlags, installFlags, haddockFlags) +runAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags) targetStrings globalFlags = do globalTmp <- getTemporaryDirectory tempDir <- createTempDirectory globalTmp "cabal-repl." - + let - with = - establishProjectBaseContext verbosity cliConfig - without config = - establishDummyProjectBaseContext verbosity (config <> cliConfig) tempDir [] + with = + establishProjectBaseContext verbosity cliConfig OtherCommand + without config = + establishDummyProjectBaseContext verbosity (config <> cliConfig) tempDir [] OtherCommand baseCtx <- withProjectOrGlobalConfig verbosity globalConfigFlag with without let scriptOrError script err = do exists <- doesFileExist script + let pol | takeExtension script == ".lhs" = LiterateHaskell + | otherwise = PlainHaskell if exists - then BS.readFile script >>= handleScriptCase verbosity baseCtx tempDir + then BS.readFile script >>= handleScriptCase verbosity pol baseCtx tempDir else reportTargetSelectorProblems verbosity err - + (baseCtx', targetSelectors) <- readTargetSelectors (localPackages baseCtx) (Just ExeKind) (take 1 targetStrings) >>= \case @@ -187,7 +188,7 @@ | TargetString1 script <- t -> scriptOrError script err Left err -> reportTargetSelectorProblems verbosity err Right sels -> return (baseCtx, sels) - + buildCtx <- runProjectPreBuildPhase verbosity baseCtx' $ \elaboratedPlan -> do @@ -290,19 +291,43 @@ (distDirLayout baseCtx) elaboratedPlan } - + handleDoesNotExist () (removeDirectoryRecursive tempDir) where verbosity = fromFlagOrDefault normal (configVerbosity configFlags) cliConfig = commandLineFlagsToProjectConfig globalFlags configFlags configExFlags - installFlags haddockFlags + installFlags + mempty -- ClientInstallFlags, not needed here + haddockFlags testFlags globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig) -handleShebang :: String -> IO () -handleShebang script = - runAction (commandDefaultFlags runCommand) [script] defaultGlobalFlags +-- | Used by the main CLI parser as heuristic to decide whether @cabal@ was +-- invoked as a script interpreter, i.e. via +-- +-- > #! /usr/bin/env cabal +-- +-- or +-- +-- > #! /usr/bin/cabal +-- +-- As the first argument passed to `cabal` will be a filepath to the +-- script to be interpreted. +-- +-- See also 'handleShebang' +validScript :: String -> IO Bool +validScript script + | isValid script && any isPathSeparator script = doesFileExist script + | otherwise = return False +-- | Handle @cabal@ invoked as script interpreter, see also 'validScript' +-- +-- First argument is the 'FilePath' to the script to be executed; second +-- argument is a list of arguments to be passed to the script. +handleShebang :: FilePath -> [String] -> IO () +handleShebang script args = + runAction (commandDefaultFlags runCommand) (script:args) defaultGlobalFlags + parseScriptBlock :: BS.ByteString -> ParseResult Executable parseScriptBlock str = case readFields str of @@ -316,48 +341,84 @@ readScriptBlock :: Verbosity -> BS.ByteString -> IO Executable readScriptBlock verbosity = parseString parseScriptBlock verbosity "script block" -readScriptBlockFromScript :: Verbosity -> BS.ByteString -> IO (Executable, BS.ByteString) -readScriptBlockFromScript verbosity str = +readScriptBlockFromScript :: Verbosity -> PlainOrLiterate -> BS.ByteString -> IO (Executable, BS.ByteString) +readScriptBlockFromScript verbosity pol str = do + str' <- case extractScriptBlock pol str of + Left e -> die' verbosity $ "Failed extracting script block: " ++ e + Right x -> return x + when (BS.all isSpace str') $ warn verbosity "Empty script block" (\x -> (x, noShebang)) <$> readScriptBlock verbosity str' where - start = "{- cabal:" - end = "-}" + noShebang = BS.unlines . filter (not . BS.isPrefixOf "#!") . BS.lines $ str - str' = BS.unlines - . takeWhile (/= end) - . drop 1 . dropWhile (/= start) - $ lines' - - noShebang = BS.unlines - . filter ((/= "#!") . BS.take 2) - $ lines' +-- | Extract the first encountered script metadata block started end +-- terminated by the tokens +-- +-- * @{- cabal:@ +-- +-- * @-}@ +-- +-- appearing alone on lines (while tolerating trailing whitespace). +-- These tokens are not part of the 'Right' result. +-- +-- In case of missing or unterminated blocks a 'Left'-error is +-- returned. +extractScriptBlock :: PlainOrLiterate -> BS.ByteString -> Either String BS.ByteString +extractScriptBlock _pol str = goPre (BS.lines str) + where + isStartMarker = (== startMarker) . stripTrailSpace + isEndMarker = (== endMarker) . stripTrailSpace - lines' = BS.lines str + stripTrailSpace = fst . BS.spanEnd isSpace -handleScriptCase :: Verbosity - -> ProjectBaseContext - -> FilePath - -> BS.ByteString - -> IO (ProjectBaseContext, [TargetSelector]) -handleScriptCase verbosity baseCtx tempDir scriptContents = do - (executable, contents') <- readScriptBlockFromScript verbosity scriptContents - + -- before start marker + goPre ls = case dropWhile (not . isStartMarker) ls of + [] -> Left $ "`" ++ BS.unpack startMarker ++ "` start marker not found" + (_:ls') -> goBody [] ls' + + goBody _ [] = Left $ "`" ++ BS.unpack endMarker ++ "` end marker not found" + goBody acc (l:ls) + | isEndMarker l = Right $! BS.unlines $ reverse acc + | otherwise = goBody (l:acc) ls + + startMarker, endMarker :: BS.ByteString + startMarker = fromString "{- cabal:" + endMarker = fromString "-}" + +data PlainOrLiterate + = PlainHaskell + | LiterateHaskell + +handleScriptCase + :: Verbosity + -> PlainOrLiterate + -> ProjectBaseContext + -> FilePath + -> BS.ByteString + -> IO (ProjectBaseContext, [TargetSelector]) +handleScriptCase verbosity pol baseCtx tempDir scriptContents = do + (executable, contents') <- readScriptBlockFromScript verbosity pol scriptContents + -- We need to create a dummy package that lives in our dummy project. let + mainName = case pol of + PlainHaskell -> "Main.hs" + LiterateHaskell -> "Main.lhs" + sourcePackage = SourcePackage - { packageInfoId = pkgId - , SP.packageDescription = genericPackageDescription - , packageSource = LocalUnpackedPackage tempDir - , packageDescrOverride = Nothing + { packageInfoId = pkgId + , SP.packageDescription = genericPackageDescription + , packageSource = LocalUnpackedPackage tempDir + , packageDescrOverride = Nothing } - genericPackageDescription = emptyGenericPackageDescription + genericPackageDescription = emptyGenericPackageDescription { GPD.packageDescription = packageDescription - , condExecutables = [("script", CondNode executable' targetBuildDepends [])] + , condExecutables = [("script", CondNode executable' targetBuildDepends [])] } executable' = executable - { modulePath = "Main.hs" - , buildInfo = binfo - { defaultLanguage = + { modulePath = mainName + , buildInfo = binfo + { defaultLanguage = case defaultLanguage of just@(Just _) -> just Nothing -> Just Haskell2010 @@ -369,13 +430,13 @@ , specVersionRaw = Left (mkVersion [2, 2]) , licenseRaw = Left SPDX.NONE } - pkgId = PackageIdentifier "fake-package" version0 + pkgId = fakePackageId writeGenericPackageDescription (tempDir "fake-package.cabal") genericPackageDescription - BS.writeFile (tempDir "Main.hs") contents' + BS.writeFile (tempDir mainName) contents' let - baseCtx' = baseCtx + baseCtx' = baseCtx { localPackages = localPackages baseCtx ++ [SpecificSourcePackage sourcePackage] } targetSelectors = [TargetPackage TargetExplicitNamed [pkgId] Nothing] diff --git a/cabal/cabal-install/Distribution/Client/CmdSdist.hs b/cabal/cabal-install/Distribution/Client/CmdSdist.hs --- a/cabal/cabal-install/Distribution/Client/CmdSdist.hs +++ b/cabal/cabal-install/Distribution/Client/CmdSdist.hs @@ -1,25 +1,25 @@ -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE ViewPatterns #-} -module Distribution.Client.CmdSdist +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ViewPatterns #-} +module Distribution.Client.CmdSdist ( sdistCommand, sdistAction, packageToSdist , SdistFlags(..), defaultSdistFlags - , OutputFormat(..), ArchiveFormat(..) ) where + , OutputFormat(..)) where import Distribution.Client.CmdErrorMessages ( Plural(..), renderComponentKind ) import Distribution.Client.ProjectOrchestration - ( ProjectBaseContext(..), establishProjectBaseContext ) + ( ProjectBaseContext(..), CurrentCommand(..), establishProjectBaseContext ) import Distribution.Client.TargetSelector ( TargetSelector(..), ComponentKind , readTargetSelectors, reportTargetSelectorProblems ) import Distribution.Client.RebuildMonad ( runRebuild ) import Distribution.Client.Setup - ( ArchiveFormat(..), GlobalFlags(..) ) + ( GlobalFlags(..) ) import Distribution.Solver.Types.SourcePackage ( SourcePackage(..) ) import Distribution.Client.Types @@ -41,7 +41,7 @@ import Distribution.ReadE ( succeedReadE ) import Distribution.Simple.Command - ( CommandUI(..), option, choiceOpt, reqArg ) + ( CommandUI(..), option, reqArg ) import Distribution.Simple.PreProcess ( knownSuffixHandlers ) import Distribution.Simple.Setup @@ -51,7 +51,7 @@ import Distribution.Simple.SrcDist ( listPackageSources ) import Distribution.Simple.Utils - ( die', notice, withOutputMarker ) + ( die', notice, withOutputMarker, wrapText ) import Distribution.Types.ComponentName ( ComponentName, showComponentName ) import Distribution.Types.PackageName @@ -61,26 +61,23 @@ import qualified Codec.Archive.Tar as Tar import qualified Codec.Archive.Tar.Entry as Tar -import qualified Codec.Archive.Zip as Zip import qualified Codec.Compression.GZip as GZip import Control.Exception ( throwIO ) import Control.Monad - ( when, forM, forM_ ) + ( when, forM_ ) import Control.Monad.Trans ( liftIO ) import Control.Monad.State.Lazy ( StateT, modify, gets, evalStateT ) import Control.Monad.Writer.Lazy ( WriterT, tell, execWriterT ) -import Data.Bits - ( shiftL ) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BSL import Data.Either ( partitionEithers ) import Data.List - ( find, sortOn, nub, intercalate ) + ( find, sortOn, nub ) import qualified Data.Set as Set import System.Directory ( getCurrentDirectory, setCurrentDirectory @@ -90,11 +87,11 @@ sdistCommand :: CommandUI SdistFlags sdistCommand = CommandUI - { commandName = "new-sdist" + { commandName = "v2-sdist" , commandSynopsis = "Generate a source distribution file (.tar.gz)." , commandUsage = \pname -> - "Usage: " ++ pname ++ " new-sdist [FLAGS] [PACKAGES]\n" - , commandDescription = Just $ \_ -> + "Usage: " ++ pname ++ " v2-sdist [FLAGS] [PACKAGES]\n" + , commandDescription = Just $ \_ -> wrapText "Generates tarballs of project packages suitable for upload to Hackage." , commandNotes = Nothing , commandDefaultFlags = defaultSdistFlags @@ -116,16 +113,6 @@ "Separate the source files with NUL bytes rather than newlines." sdistNulSeparated (\v flags -> flags { sdistNulSeparated = v }) trueArg - , option [] ["archive-format"] - "Choose what type of archive to create. No effect if given with '--list-only'" - sdistArchiveFormat (\v flags -> flags { sdistArchiveFormat = v }) - (choiceOpt - [ (Flag TargzFormat, ([], ["targz"]), - "Produce a '.tar.gz' format archive (default and required for uploading to hackage)") - , (Flag ZipFormat, ([], ["zip"]), - "Produce a '.zip' format archive") - ] - ) , option ['o'] ["output-dir", "outputdir"] "Choose the output directory of this command. '-' sends all output to stdout" sdistOutputPath (\o flags -> flags { sdistOutputPath = o }) @@ -139,7 +126,6 @@ , sdistProjectFile :: Flag FilePath , sdistListSources :: Flag Bool , sdistNulSeparated :: Flag Bool - , sdistArchiveFormat :: Flag ArchiveFormat , sdistOutputPath :: Flag FilePath } @@ -150,7 +136,6 @@ , sdistProjectFile = mempty , sdistListSources = toFlag False , sdistNulSeparated = toFlag False - , sdistArchiveFormat = toFlag TargzFormat , sdistOutputPath = mempty } @@ -164,49 +149,47 @@ globalConfig = globalConfigFile globalFlags listSources = fromFlagOrDefault False sdistListSources nulSeparated = fromFlagOrDefault False sdistNulSeparated - archiveFormat = fromFlagOrDefault TargzFormat sdistArchiveFormat mOutputPath = flagToMaybe sdistOutputPath - + projectRoot <- either throwIO return =<< findProjectRoot Nothing mProjectFile let distLayout = defaultDistDirLayout projectRoot mDistDirectory dir <- getCurrentDirectory projectConfig <- runRebuild dir $ readProjectConfig verbosity globalConfig distLayout - baseCtx <- establishProjectBaseContext verbosity projectConfig + baseCtx <- establishProjectBaseContext verbosity projectConfig OtherCommand let localPkgs = localPackages baseCtx targetSelectors <- either (reportTargetSelectorProblems verbosity) return =<< readTargetSelectors localPkgs Nothing targetStrings - + mOutputPath' <- case mOutputPath of Just "-" -> return (Just "-") Just path -> Just <$> makeAbsolute path Nothing -> return Nothing - - let + + let format = if | listSources, nulSeparated -> SourceList '\0' | listSources -> SourceList '\n' - | otherwise -> Archive archiveFormat + | otherwise -> TarGzArchive ext = case format of - SourceList _ -> "list" - Archive TargzFormat -> "tar.gz" - Archive ZipFormat -> "zip" - + SourceList _ -> "list" + TarGzArchive -> "tar.gz" + outputPath pkg = case mOutputPath' of Just path | path == "-" -> "-" | otherwise -> path prettyShow (packageId pkg) <.> ext Nothing | listSources -> "-" - | otherwise -> distSdistFile distLayout (packageId pkg) archiveFormat + | otherwise -> distSdistFile distLayout (packageId pkg) createDirectoryIfMissing True (distSdistDirectory distLayout) - + case reifyTargetSelectors localPkgs targetSelectors of Left errs -> die' verbosity . unlines . fmap renderTargetProblem $ errs - Right pkgs - | length pkgs > 1, not listSources, Just "-" <- mOutputPath' -> + Right pkgs + | length pkgs > 1, not listSources, Just "-" <- mOutputPath' -> die' verbosity "Can't write multiple tarballs to standard output!" | otherwise -> mapM_ (\pkg -> packageToSdist verbosity (distProjectRootDirectory distLayout) format (outputPath pkg) pkg) pkgs @@ -215,7 +198,7 @@ deriving (Show, Eq) data OutputFormat = SourceList Char - | Archive ArchiveFormat + | TarGzArchive deriving (Show, Eq) packageToSdist :: Verbosity -> FilePath -> OutputFormat -> FilePath -> UnresolvedSourcePackage -> IO () @@ -230,17 +213,22 @@ RemoteTarballPackage {} -> death RepoTarballPackage {} -> death - let write = if outputFile == "-" - then putStr . withOutputMarker verbosity . BSL.unpack - else BSL.writeFile outputFile + let -- Write String to stdout or file, using the default TextEncoding. + write + | outputFile == "-" = putStr . withOutputMarker verbosity + | otherwise = writeFile outputFile + -- Write raw ByteString to stdout or file as it is, without encoding. + writeLBS + | outputFile == "-" = BSL.putStr + | otherwise = BSL.writeFile outputFile case dir0 of Left tgz -> do case format of - Archive TargzFormat -> do - write =<< BSL.readFile tgz + TarGzArchive -> do + writeLBS =<< BSL.readFile tgz when (outputFile /= "-") $ - notice verbosity $ "Wrote tarball sdist to " ++ outputFile ++ "\n" + notice verbosity $ "Wrote tarball sdist to " ++ outputFile ++ "\n" _ -> die' verbosity ("cannot convert tarball package to " ++ show format) Right dir -> do @@ -256,10 +244,10 @@ case format of SourceList nulSep -> do let prefix = makeRelative projectRootDir dir - write (BSL.pack . (++ [nulSep]) . intercalate [nulSep] . fmap ((prefix ) . snd) $ files) + write $ concat [prefix i ++ [nulSep] | (_, i) <- files] when (outputFile /= "-") $ notice verbosity $ "Wrote source list to " ++ outputFile ++ "\n" - Archive TargzFormat -> do + TarGzArchive -> do let entriesM :: StateT (Set.Set FilePath) (WriterT [Tar.Entry] IO) () entriesM = do let prefix = prettyShow (packageId pkg) @@ -298,29 +286,16 @@ -- after the epoch is during 2001-09-09, so that does -- nicely. See #5596. setModTime entry = entry { Tar.entryTime = 1000000000 } - write . normalize . GZip.compress . Tar.write $ fmap setModTime entries + writeLBS . normalize . GZip.compress . Tar.write $ fmap setModTime entries when (outputFile /= "-") $ notice verbosity $ "Wrote tarball sdist to " ++ outputFile ++ "\n" - Archive ZipFormat -> do - let prefix = prettyShow (packageId pkg) - entries <- forM files $ \(perm, file) -> do - let perm' = case perm of - -- -rwxr-xr-x - Exec -> 0o010755 `shiftL` 16 - -- -rw-r--r-- - NoExec -> 0o010644 `shiftL` 16 - contents <- BSL.readFile file - return $ (Zip.toEntry (prefix file) 0 contents) { Zip.eExternalFileAttributes = perm' } - let archive = foldr Zip.addEntryToArchive Zip.emptyArchive entries - write (Zip.fromArchive archive) - when (outputFile /= "-") $ - notice verbosity $ "Wrote zip sdist to " ++ outputFile ++ "\n" + setCurrentDirectory oldPwd -- reifyTargetSelectors :: [PackageSpecifier UnresolvedSourcePackage] -> [TargetSelector] -> Either [TargetProblem] [UnresolvedSourcePackage] -reifyTargetSelectors pkgs sels = +reifyTargetSelectors pkgs sels = case partitionEithers (foldMap go sels) of ([], sels') -> Right sels' (errs, _) -> Left errs @@ -332,7 +307,7 @@ getPkg pid = case find ((== pid) . packageId) pkgs' of Just pkg -> Right pkg Nothing -> error "The impossible happened: we have a reference to a local package that isn't in localPackages." - + go :: TargetSelector -> [Either TargetProblem UnresolvedSourcePackage] go (TargetPackage _ pids Nothing) = fmap getPkg pids go (TargetAllPackages Nothing) = Right <$> pkgs' @@ -359,4 +334,3 @@ renderTargetProblem (NonlocalPackageNotAllowed pname) = "The package " ++ unPackageName pname ++ " cannot be packaged for distribution, because it is not " ++ "local to this project." - diff --git a/cabal/cabal-install/Distribution/Client/CmdTest.hs b/cabal/cabal-install/Distribution/Client/CmdTest.hs --- a/cabal/cabal-install/Distribution/Client/CmdTest.hs +++ b/cabal/cabal-install/Distribution/Client/CmdTest.hs @@ -17,28 +17,31 @@ import Distribution.Client.CmdErrorMessages import Distribution.Client.Setup - ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags ) + ( GlobalFlags(..), ConfigFlags(..), ConfigExFlags, InstallFlags ) import qualified Distribution.Client.Setup as Client import Distribution.Simple.Setup - ( HaddockFlags, fromFlagOrDefault ) + ( HaddockFlags, TestFlags(..), fromFlagOrDefault ) import Distribution.Simple.Command ( CommandUI(..), usageAlternatives ) -import Distribution.Text +import Distribution.Simple.Flag + ( Flag(..) ) +import Distribution.Deprecated.Text ( display ) import Distribution.Verbosity ( Verbosity, normal ) import Distribution.Simple.Utils - ( wrapText, die' ) + ( notice, wrapText, die' ) import Control.Monad (when) +import qualified System.Exit (exitSuccess) -testCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) -testCommand = Client.installCommand { - commandName = "new-test", - commandSynopsis = "Run test-suites", - commandUsage = usageAlternatives "new-test" [ "[TARGETS] [FLAGS]" ], - commandDescription = Just $ \_ -> wrapText $ +testCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) +testCommand = Client.installCommand + { commandName = "v2-test" + , commandSynopsis = "Run test-suites" + , commandUsage = usageAlternatives "v2-test" [ "[TARGETS] [FLAGS]" ] + , commandDescription = Just $ \_ -> wrapText $ "Runs the specified test-suites, first ensuring they are up to " ++ "date.\n\n" @@ -53,22 +56,24 @@ ++ "'cabal.project.local' and other files.\n\n" ++ "To pass command-line arguments to a test suite, see the " - ++ "new-run command.", - commandNotes = Just $ \pname -> + ++ "v2-run command." + , commandNotes = Just $ \pname -> "Examples:\n" - ++ " " ++ pname ++ " new-test\n" + ++ " " ++ pname ++ " v2-test\n" ++ " Run all the test-suites in the package in the current directory\n" - ++ " " ++ pname ++ " new-test pkgname\n" + ++ " " ++ pname ++ " v2-test pkgname\n" ++ " Run all the test-suites in the package named pkgname\n" - ++ " " ++ pname ++ " new-test cname\n" + ++ " " ++ pname ++ " v2-test cname\n" ++ " Run the test-suite named cname\n" - ++ " " ++ pname ++ " new-test cname --enable-coverage\n" + ++ " " ++ pname ++ " v2-test cname --enable-coverage\n" ++ " Run the test-suite built with code coverage (including local libs used)\n\n" ++ cmdCommonHelpTextNewBuildBeta - } + } + + -- | The @test@ command is very much like @build@. It brings the install plan -- up to date, selects that part of the plan needed by the given or implicit -- test target(s) and then executes the plan. @@ -79,12 +84,12 @@ -- For more details on how this works, see the module -- "Distribution.Client.ProjectOrchestration" -- -testAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) +testAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) -> [String] -> GlobalFlags -> IO () -testAction (configFlags, configExFlags, installFlags, haddockFlags) +testAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags) targetStrings globalFlags = do - baseCtx <- establishProjectBaseContext verbosity cliConfig + baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand targetSelectors <- either (reportTargetSelectorProblems verbosity) return =<< readTargetSelectors (localPackages baseCtx) (Just TestKind) targetStrings @@ -100,7 +105,7 @@ -- Interpret the targets on the command line as test targets -- (as opposed to say build or haddock targets). - targets <- either (reportTargetProblems verbosity) return + targets <- either (reportTargetProblems verbosity failWhenNoTestSuites) return $ resolveTargets selectPackageTargets selectComponentTarget @@ -120,10 +125,13 @@ buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes where + failWhenNoTestSuites = testFailWhenNoTestSuites testFlags verbosity = fromFlagOrDefault normal (configVerbosity configFlags) cliConfig = commandLineFlagsToProjectConfig globalFlags configFlags configExFlags - installFlags haddockFlags + installFlags + mempty -- ClientInstallFlags, not needed here + haddockFlags testFlags -- | This defines what a 'TargetSelector' means for the @test@ command. -- It selects the 'AvailableTarget's that the 'TargetSelector' refers to, @@ -204,10 +212,26 @@ | TargetProblemIsSubComponent PackageId ComponentName SubComponentTarget deriving (Eq, Show) -reportTargetProblems :: Verbosity -> [TargetProblem] -> IO a -reportTargetProblems verbosity = - die' verbosity . unlines . map renderTargetProblem +reportTargetProblems :: Verbosity -> Flag Bool -> [TargetProblem] -> IO a +reportTargetProblems verbosity failWhenNoTestSuites problems = + case (failWhenNoTestSuites, problems) of + (Flag True, [TargetProblemNoTests _]) -> + die' verbosity problemsMessage + (_, [TargetProblemNoTests selector]) -> do + notice verbosity (renderAllowedNoTestsProblem selector) + System.Exit.exitSuccess + (_, _) -> die' verbosity problemsMessage + where + problemsMessage = unlines . map renderTargetProblem $ problems +-- | Unless @--test-fail-when-no-test-suites@ flag is passed, we don't +-- @die@ when the target problem is 'TargetProblemNoTests'. +-- Instead, we display a notice saying that no tests have run and +-- indicate how this behaviour was enabled. +renderAllowedNoTestsProblem :: TargetSelector -> String +renderAllowedNoTestsProblem selector = + "No tests to run for " ++ renderTargetSelector selector + renderTargetProblem :: TargetProblem -> String renderTargetProblem (TargetProblemCommon problem) = renderTargetProblemCommon "run" problem @@ -228,6 +252,7 @@ -> "The test command is for running test suites, but the target '" ++ showTargetSelector targetSelector ++ "' refers to " ++ renderTargetSelector targetSelector ++ "." + ++ "\n" ++ show targetSelector _ -> renderTargetProblemNoTargets "test" targetSelector diff --git a/cabal/cabal-install/Distribution/Client/CmdUpdate.hs b/cabal/cabal-install/Distribution/Client/CmdUpdate.hs --- a/cabal/cabal-install/Distribution/Client/CmdUpdate.hs +++ b/cabal/cabal-install/Distribution/Client/CmdUpdate.hs @@ -1,5 +1,9 @@ -{-# LANGUAGE CPP, LambdaCase, NamedFieldPuns, RecordWildCards, ViewPatterns, - TupleSections #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ViewPatterns #-} -- | cabal-install CLI command: update -- @@ -9,7 +13,7 @@ ) where import Prelude () -import Distribution.Client.Compat.Prelude +import Distribution.Client.Compat.Prelude import Distribution.Client.Compat.Directory ( setModificationTime ) @@ -32,7 +36,7 @@ , UpdateFlags, defaultUpdateFlags , RepoContext(..) ) import Distribution.Simple.Setup - ( HaddockFlags, fromFlagOrDefault ) + ( HaddockFlags, TestFlags, fromFlagOrDefault ) import Distribution.Simple.Utils ( die', notice, wrapText, writeFileAtomic, noticeNoWrap ) import Distribution.Verbosity @@ -41,11 +45,11 @@ import Distribution.Client.IndexUtils ( updateRepoIndexCache, Index(..), writeIndexTimestamp , currentIndexTimestamp, indexBaseName ) -import Distribution.Text +import Distribution.Deprecated.Text ( Text(..), display, simpleParse ) import Data.Maybe (fromJust) -import qualified Distribution.Compat.ReadP as ReadP +import qualified Distribution.Deprecated.ReadP as ReadP import qualified Text.PrettyPrint as Disp import Control.Monad (mapM, mapM_) @@ -60,23 +64,23 @@ import qualified Hackage.Security.Client as Sec updateCommand :: CommandUI ( ConfigFlags, ConfigExFlags - , InstallFlags, HaddockFlags ) + , InstallFlags, HaddockFlags, TestFlags ) updateCommand = Client.installCommand { - commandName = "new-update", + commandName = "v2-update", commandSynopsis = "Updates list of known packages.", - commandUsage = usageAlternatives "new-update" [ "[FLAGS] [REPOS]" ], + commandUsage = usageAlternatives "v2-update" [ "[FLAGS] [REPOS]" ], commandDescription = Just $ \_ -> wrapText $ "For all known remote repositories, download the package list.", commandNotes = Just $ \pname -> "REPO has the format [,] where index-state follows\n" ++ "the same format and syntax that is supported by the --index-state flag.\n\n" ++ "Examples:\n" - ++ " " ++ pname ++ " new-update\n" + ++ " " ++ pname ++ " v2-update\n" ++ " Download the package list for all known remote repositories.\n\n" - ++ " " ++ pname ++ " new-update hackage.haskell.org,@1474732068\n" - ++ " " ++ pname ++ " new-update hackage.haskell.org,2016-09-24T17:47:48Z\n" - ++ " " ++ pname ++ " new-update hackage.haskell.org,HEAD\n" - ++ " " ++ pname ++ " new-update hackage.haskell.org\n" + ++ " " ++ pname ++ " v2-update hackage.haskell.org,@1474732068\n" + ++ " " ++ pname ++ " v2-update hackage.haskell.org,2016-09-24T17:47:48Z\n" + ++ " " ++ pname ++ " v2-update hackage.haskell.org,HEAD\n" + ++ " " ++ pname ++ " v2-update hackage.haskell.org\n" ++ " Download hackage.haskell.org at a specific index state.\n\n" ++ " " ++ pname ++ " new update hackage.haskell.org head.hackage\n" ++ " Download hackage.haskell.org and head.hackage\n" @@ -110,12 +114,12 @@ name <- ReadP.manyTill (ReadP.satisfy (\c -> c /= ',')) ReadP.eof return (UpdateRequest name IndexStateHead) -updateAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) +updateAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) -> [String] -> GlobalFlags -> IO () -updateAction (configFlags, configExFlags, installFlags, haddockFlags) +updateAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags) extraArgs globalFlags = do projectConfig <- withProjectOrGlobalConfig verbosity globalConfigFlag - (projectConfig <$> establishProjectBaseContext verbosity cliConfig) + (projectConfig <$> establishProjectBaseContext verbosity cliConfig OtherCommand) (\globalConfig -> return $ globalConfig <> cliConfig) projectConfigWithSolverRepoContext verbosity @@ -127,7 +131,7 @@ parseArg s = case simpleParse s of Just r -> return r Nothing -> die' verbosity $ - "'new-update' unable to parse repo: \"" ++ s ++ "\"" + "'v2-update' unable to parse repo: \"" ++ s ++ "\"" updateRepoRequests <- mapM parseArg extraArgs unless (null updateRepoRequests) $ do @@ -135,7 +139,7 @@ unknownRepos = [r | (UpdateRequest r _) <- updateRepoRequests , not (r `elem` remoteRepoNames)] unless (null unknownRepos) $ - die' verbosity $ "'new-update' repo(s): \"" + die' verbosity $ "'v2-update' repo(s): \"" ++ intercalate "\", \"" unknownRepos ++ "\" can not be found in known remote repo(s): " ++ intercalate ", " remoteRepoNames @@ -168,7 +172,9 @@ verbosity = fromFlagOrDefault normal (configVerbosity configFlags) cliConfig = commandLineFlagsToProjectConfig globalFlags configFlags configExFlags - installFlags haddockFlags + installFlags + mempty -- ClientInstallFlags, not needed here + haddockFlags testFlags globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig) updateRepo :: Verbosity -> UpdateFlags -> RepoContext -> (Repo, IndexState) @@ -213,5 +219,5 @@ when (current_ts /= nullTimestamp) $ noticeNoWrap verbosity $ "To revert to previous state run:\n" ++ - " cabal new-update '" ++ remoteRepoName (repoRemote repo) + " cabal v2-update '" ++ remoteRepoName (repoRemote repo) ++ "," ++ display current_ts ++ "'\n" diff --git a/cabal/cabal-install/Distribution/Client/Compat/Prelude.hs b/cabal/cabal-install/Distribution/Client/Compat/Prelude.hs --- a/cabal/cabal-install/Distribution/Client/Compat/Prelude.hs +++ b/cabal/cabal-install/Distribution/Client/Compat/Prelude.hs @@ -3,7 +3,7 @@ -- | This module does two things: -- --- * Acts as a compatiblity layer, like @base-compat@. +-- * Acts as a compatibility layer, like @base-compat@. -- -- * Provides commonly used imports. -- @@ -13,10 +13,7 @@ module Distribution.Client.Compat.Prelude ( module Distribution.Compat.Prelude.Internal , Prelude.IO - , readMaybe ) where import Prelude (IO) import Distribution.Compat.Prelude.Internal hiding (IO) -import Text.Read - ( readMaybe ) diff --git a/cabal/cabal-install/Distribution/Client/Config.hs b/cabal/cabal-install/Distribution/Client/Config.hs --- a/cabal/cabal-install/Distribution/Client/Config.hs +++ b/cabal/cabal-install/Distribution/Client/Config.hs @@ -46,35 +46,49 @@ remoteRepoFields ) where +import Language.Haskell.Extension ( Language(Haskell2010) ) + +import Distribution.Deprecated.ViewAsFieldDescr + ( viewAsFieldDescr ) + import Distribution.Client.Types ( RemoteRepo(..), Username(..), Password(..), emptyRemoteRepo , AllowOlder(..), AllowNewer(..), RelaxDeps(..), isRelaxDeps ) import Distribution.Client.BuildReports.Types ( ReportLevel(..) ) +import qualified Distribution.Client.Init.Types as IT + ( InitFlags(..) ) import Distribution.Client.Setup ( GlobalFlags(..), globalCommand, defaultGlobalFlags , ConfigExFlags(..), configureExOptions, defaultConfigExFlags + , initOptions , InstallFlags(..), installOptions, defaultInstallFlags , UploadFlags(..), uploadCommand , ReportFlags(..), reportCommand , showRepo, parseRepo, readRepo ) +import Distribution.Client.CmdInstall.ClientInstallFlags + ( ClientInstallFlags(..), defaultClientInstallFlags + , clientInstallOptions ) import Distribution.Utils.NubList ( NubList, fromNubList, toNubList, overNubList ) +import Distribution.License + ( License(BSD3) ) import Distribution.Simple.Compiler ( DebugInfoLevel(..), OptimisationLevel(..) ) import Distribution.Simple.Setup ( ConfigFlags(..), configureOptions, defaultConfigFlags , HaddockFlags(..), haddockOptions, defaultHaddockFlags + , TestFlags(..), defaultTestFlags , installDirsOptions, optionDistPref , programDbPaths', programDbOptions , Flag(..), toFlag, flagToMaybe, fromFlagOrDefault ) import Distribution.Simple.InstallDirs ( InstallDirs(..), defaultInstallDirs , PathTemplate, toPathTemplate ) -import Distribution.ParseUtils - ( FieldDescr(..), liftField +import Distribution.Deprecated.ParseUtils + ( FieldDescr(..), liftField, runP , ParseResult(..), PError(..), PWarning(..) , locatedErrorMsg, showPWarning , readFields, warning, lineNo @@ -84,13 +98,12 @@ ( parseFields, ppFields, ppSection ) import Distribution.Client.HttpUtils ( isOldHackageURI ) -import qualified Distribution.ParseUtils as ParseUtils +import qualified Distribution.Deprecated.ParseUtils as ParseUtils ( Field(..) ) -import qualified Distribution.Text as Text +import qualified Distribution.Deprecated.Text as Text ( Text(..), display ) import Distribution.Simple.Command - ( CommandUI(commandOptions), commandDefaultFlags, ShowOrParseArgs(..) - , viewAsFieldDescr ) + ( CommandUI(commandOptions), commandDefaultFlags, ShowOrParseArgs(..) ) import Distribution.Simple.Program ( defaultProgramDb ) import Distribution.Simple.Utils @@ -99,6 +112,8 @@ ( CompilerFlavor(..), defaultCompilerFlavor ) import Distribution.Verbosity ( Verbosity, normal ) +import Distribution.Version + ( mkVersion ) import Distribution.Solver.Types.ConstraintSource @@ -108,7 +123,7 @@ ( fromMaybe ) import Control.Monad ( when, unless, foldM, liftM ) -import qualified Distribution.Compat.ReadP as Parse +import qualified Distribution.Deprecated.ReadP as Parse ( (<++), option ) import Distribution.Compat.Semigroup import qualified Text.PrettyPrint as Disp @@ -146,14 +161,17 @@ data SavedConfig = SavedConfig { savedGlobalFlags :: GlobalFlags, + savedInitFlags :: IT.InitFlags, savedInstallFlags :: InstallFlags, + savedClientInstallFlags :: ClientInstallFlags, savedConfigureFlags :: ConfigFlags, savedConfigureExFlags :: ConfigExFlags, savedUserInstallDirs :: InstallDirs (Flag PathTemplate), savedGlobalInstallDirs :: InstallDirs (Flag PathTemplate), savedUploadFlags :: UploadFlags, savedReportFlags :: ReportFlags, - savedHaddockFlags :: HaddockFlags + savedHaddockFlags :: HaddockFlags, + savedTestFlags :: TestFlags } deriving Generic instance Monoid SavedConfig where @@ -163,14 +181,17 @@ instance Semigroup SavedConfig where a <> b = SavedConfig { savedGlobalFlags = combinedSavedGlobalFlags, + savedInitFlags = combinedSavedInitFlags, savedInstallFlags = combinedSavedInstallFlags, + savedClientInstallFlags = combinedSavedClientInstallFlags, savedConfigureFlags = combinedSavedConfigureFlags, savedConfigureExFlags = combinedSavedConfigureExFlags, savedUserInstallDirs = combinedSavedUserInstallDirs, savedGlobalInstallDirs = combinedSavedGlobalInstallDirs, savedUploadFlags = combinedSavedUploadFlags, savedReportFlags = combinedSavedReportFlags, - savedHaddockFlags = combinedSavedHaddockFlags + savedHaddockFlags = combinedSavedHaddockFlags, + savedTestFlags = combinedSavedTestFlags } where -- This is ugly, but necessary. If we're mappending two config files, we @@ -243,6 +264,42 @@ combine = combine' savedGlobalFlags lastNonEmptyNL = lastNonEmptyNL' savedGlobalFlags + combinedSavedInitFlags = IT.InitFlags { + IT.applicationDirs = combineMonoid savedInitFlags IT.applicationDirs, + IT.author = combine IT.author, + IT.buildTools = combineMonoid savedInitFlags IT.buildTools, + IT.cabalVersion = combine IT.cabalVersion, + IT.category = combine IT.category, + IT.dependencies = combineMonoid savedInitFlags IT.dependencies, + IT.email = combine IT.email, + IT.exposedModules = combineMonoid savedInitFlags IT.exposedModules, + IT.extraSrc = combineMonoid savedInitFlags IT.extraSrc, + IT.homepage = combine IT.homepage, + IT.initHcPath = combine IT.initHcPath, + IT.initVerbosity = combine IT.initVerbosity, + IT.initializeTestSuite = combine IT.initializeTestSuite, + IT.interactive = combine IT.interactive, + IT.language = combine IT.language, + IT.license = combine IT.license, + IT.mainIs = combine IT.mainIs, + IT.minimal = combine IT.minimal, + IT.noComments = combine IT.noComments, + IT.otherExts = combineMonoid savedInitFlags IT.otherExts, + IT.otherModules = combineMonoid savedInitFlags IT.otherModules, + IT.overwrite = combine IT.overwrite, + IT.packageDir = combine IT.packageDir, + IT.packageName = combine IT.packageName, + IT.packageType = combine IT.packageType, + IT.quiet = combine IT.quiet, + IT.simpleProject = combine IT.simpleProject, + IT.sourceDirs = combineMonoid savedInitFlags IT.sourceDirs, + IT.synopsis = combine IT.synopsis, + IT.testDirs = combineMonoid savedInitFlags IT.testDirs, + IT.version = combine IT.version + } + where + combine = combine' savedInitFlags + combinedSavedInstallFlags = InstallFlags { installDocumentation = combine installDocumentation, installHaddockIndex = combine installHaddockIndex, @@ -251,10 +308,12 @@ installMaxBackjumps = combine installMaxBackjumps, installReorderGoals = combine installReorderGoals, installCountConflicts = combine installCountConflicts, + installMinimizeConflictSet = combine installMinimizeConflictSet, installIndependentGoals = combine installIndependentGoals, installShadowPkgs = combine installShadowPkgs, installStrongFlags = combine installStrongFlags, installAllowBootLibInstalls = combine installAllowBootLibInstalls, + installOnlyConstrained = combine installOnlyConstrained, installReinstall = combine installReinstall, installAvoidReinstalls = combine installAvoidReinstalls, installOverrideReinstall = combine installOverrideReinstall, @@ -280,6 +339,16 @@ combine = combine' savedInstallFlags lastNonEmptyNL = lastNonEmptyNL' savedInstallFlags + combinedSavedClientInstallFlags = ClientInstallFlags { + cinstInstallLibs = combine cinstInstallLibs, + cinstEnvironmentPath = combine cinstEnvironmentPath, + cinstOverwritePolicy = combine cinstOverwritePolicy, + cinstInstallMethod = combine cinstInstallMethod, + cinstInstalldir = combine cinstInstalldir + } + where + combine = combine' savedClientInstallFlags + combinedSavedConfigureFlags = ConfigFlags { configArgs = lastNonEmpty configArgs, configPrograms_ = configPrograms_ . savedConfigureFlags $ b, @@ -298,6 +367,7 @@ configSharedLib = combine configSharedLib, configStaticLib = combine configStaticLib, configDynExe = combine configDynExe, + configFullyStaticExe = combine configFullyStaticExe, configProfExe = combine configProfExe, configProfDetail = combine configProfDetail, configProfLibDetail = combine configProfLibDetail, @@ -345,7 +415,8 @@ configExactConfiguration = combine configExactConfiguration, configFlagError = combine configFlagError, configRelocatable = combine configRelocatable, - configUseResponseFiles = combine configUseResponseFiles + configUseResponseFiles = combine configUseResponseFiles, + configAllowDependingOnPrivateLibs = combine configAllowDependingOnPrivateLibs } where combine = combine' savedConfigureFlags @@ -425,7 +496,22 @@ combine = combine' savedHaddockFlags lastNonEmpty = lastNonEmpty' savedHaddockFlags + combinedSavedTestFlags = TestFlags { + testDistPref = combine testDistPref, + testVerbosity = combine testVerbosity, + testHumanLog = combine testHumanLog, + testMachineLog = combine testMachineLog, + testShowDetails = combine testShowDetails, + testKeepTix = combine testKeepTix, + testWrapper = combine testWrapper, + testFailWhenNoTestSuites = combine testFailWhenNoTestSuites, + testOptions = lastNonEmpty testOptions + } + where + combine = combine' savedTestFlags + lastNonEmpty = lastNonEmpty' savedTestFlags + -- -- * Default config -- @@ -465,11 +551,11 @@ -- initialSavedConfig :: IO SavedConfig initialSavedConfig = do - cacheDir <- defaultCacheDir - logsDir <- defaultLogsDir - worldFile <- defaultWorldFile - extraPath <- defaultExtraPath - symlinkPath <- defaultSymlinkPath + cacheDir <- defaultCacheDir + logsDir <- defaultLogsDir + worldFile <- defaultWorldFile + extraPath <- defaultExtraPath + installPath <- defaultInstallPath return mempty { savedGlobalFlags = mempty { globalCacheDir = toFlag cacheDir, @@ -482,8 +568,10 @@ savedInstallFlags = mempty { installSummaryFile = toNubList [toPathTemplate (logsDir "build.log")], installBuildReports= toFlag AnonymousReports, - installNumJobs = toFlag Nothing, - installSymlinkBinDir = toFlag symlinkPath + installNumJobs = toFlag Nothing + }, + savedClientInstallFlags = mempty { + cinstInstalldir = toFlag installPath } } @@ -523,8 +611,8 @@ dir <- getCabalDir return [dir "bin"] -defaultSymlinkPath :: IO FilePath -defaultSymlinkPath = do +defaultInstallPath :: IO FilePath +defaultInstallPath = do dir <- getCabalDir return (dir "bin") @@ -735,7 +823,16 @@ savedGlobalFlags = defaultGlobalFlags { globalRemoteRepos = toNubList [defaultRemoteRepo] }, + savedInitFlags = mempty { + IT.interactive = toFlag True, + IT.cabalVersion = toFlag (mkVersion [1,10]), + IT.language = toFlag Haskell2010, + IT.license = toFlag BSD3, + IT.sourceDirs = Nothing, + IT.applicationDirs = Nothing + }, savedInstallFlags = defaultInstallFlags, + savedClientInstallFlags= defaultClientInstallFlags, savedConfigureExFlags = defaultConfigExFlags { configAllowNewer = Just (AllowNewer mempty), configAllowOlder = Just (AllowOlder mempty) @@ -747,8 +844,8 @@ savedGlobalInstallDirs = fmap toFlag globalInstallDirs, savedUploadFlags = commandDefaultFlags uploadCommand, savedReportFlags = commandDefaultFlags reportCommand, - savedHaddockFlags = defaultHaddockFlags - + savedHaddockFlags = defaultHaddockFlags, + savedTestFlags = defaultTestFlags } conf1 <- extendToEffectiveConfig conf0 let globalFlagsConf1 = savedGlobalFlags conf1 @@ -858,6 +955,10 @@ (installOptions ParseArgs) ["dry-run", "only", "only-dependencies", "dependencies-only"] [] + ++ toSavedConfig liftClientInstallFlag + (clientInstallOptions ParseArgs) + [] [] + ++ toSavedConfig liftUploadFlag (commandOptions uploadCommand ParseArgs) ["verbose", "check", "documentation", "publish"] [] @@ -965,6 +1066,10 @@ liftInstallFlag = liftField savedInstallFlags (\flags conf -> conf { savedInstallFlags = flags }) +liftClientInstallFlag :: FieldDescr ClientInstallFlags -> FieldDescr SavedConfig +liftClientInstallFlag = liftField + savedClientInstallFlags (\flags conf -> conf { savedClientInstallFlags = flags }) + liftUploadFlag :: FieldDescr UploadFlags -> FieldDescr SavedConfig liftUploadFlag = liftField savedUploadFlags (\flags conf -> conf { savedUploadFlags = flags }) @@ -981,11 +1086,12 @@ fields <- readFields str let (knownSections, others) = partition isKnownSection fields config <- parse others - let user0 = savedUserInstallDirs config + let init0 = savedInitFlags config + user0 = savedUserInstallDirs config global0 = savedGlobalInstallDirs config - (remoteRepoSections0, haddockFlags, user, global, paths, args) <- + (remoteRepoSections0, haddockFlags, initFlags, user, global, paths, args) <- foldM parseSections - ([], savedHaddockFlags config, user0, global0, [], []) + ([], savedHaddockFlags config, init0, user0, global0, [], []) knownSections let remoteRepoSections = @@ -993,7 +1099,7 @@ . nubBy ((==) `on` remoteRepoName) $ remoteRepoSections0 - return config { + return . fixConfigMultilines $ config { savedGlobalFlags = (savedGlobalFlags config) { globalRemoteRepos = toNubList remoteRepoSections, -- the global extra prog path comes from the configure flag prog path @@ -1004,6 +1110,7 @@ configProgramArgs = args }, savedHaddockFlags = haddockFlags, + savedInitFlags = initFlags, savedUserInstallDirs = user, savedGlobalInstallDirs = global } @@ -1012,15 +1119,38 @@ isKnownSection (ParseUtils.Section _ "repository" _ _) = True isKnownSection (ParseUtils.F _ "remote-repo" _) = True isKnownSection (ParseUtils.Section _ "haddock" _ _) = True + isKnownSection (ParseUtils.Section _ "init" _ _) = True isKnownSection (ParseUtils.Section _ "install-dirs" _ _) = True isKnownSection (ParseUtils.Section _ "program-locations" _ _) = True isKnownSection (ParseUtils.Section _ "program-default-options" _ _) = True isKnownSection _ = False + -- attempt to split fields that can represent lists of paths into actual lists + -- on failure, leave the field untouched + splitMultiPath :: [String] -> [String] + splitMultiPath [s] = case runP 0 "" (parseOptCommaList parseTokenQ) s of + ParseOk _ res -> res + _ -> [s] + splitMultiPath xs = xs + + -- This is a fixup, pending a full config parser rewrite, to ensure that + -- config fields which can be comma seperated lists actually parse as comma seperated lists + fixConfigMultilines conf = conf { + savedConfigureFlags = + let scf = savedConfigureFlags conf + in scf { + configProgramPathExtra = toNubList $ splitMultiPath (fromNubList $ configProgramPathExtra scf) + , configExtraLibDirs = splitMultiPath (configExtraLibDirs scf) + , configExtraFrameworkDirs = splitMultiPath (configExtraFrameworkDirs scf) + , configExtraIncludeDirs = splitMultiPath (configExtraIncludeDirs scf) + , configConfigureArgs = splitMultiPath (configConfigureArgs scf) + } + } + parse = parseFields (configFieldDescriptions src ++ deprecatedFieldDescriptions) initial - parseSections (rs, h, u, g, p, a) + parseSections (rs, h, i, u, g, p, a) (ParseUtils.Section _ "repository" name fs) = do r' <- parseFields remoteRepoFields (emptyRemoteRepo name) fs when (remoteRepoKeyThreshold r' > length (remoteRepoRootKeys r')) $ @@ -1030,42 +1160,51 @@ && remoteRepoSecure r' /= Just True) $ warning $ "'root-keys' for repository " ++ show (remoteRepoName r') ++ " non-empty, but 'secure' not set to True." - return (r':rs, h, u, g, p, a) + return (r':rs, h, i, u, g, p, a) - parseSections (rs, h, u, g, p, a) + parseSections (rs, h, i, u, g, p, a) (ParseUtils.F lno "remote-repo" raw) = do let mr' = readRepo raw r' <- maybe (ParseFailed $ NoParse "remote-repo" lno) return mr' - return (r':rs, h, u, g, p, a) + return (r':rs, h, i, u, g, p, a) - parseSections accum@(rs, h, u, g, p, a) + parseSections accum@(rs, h, i, u, g, p, a) (ParseUtils.Section _ "haddock" name fs) | name == "" = do h' <- parseFields haddockFlagsFields h fs - return (rs, h', u, g, p, a) + return (rs, h', i, u, g, p, a) | otherwise = do warning "The 'haddock' section should be unnamed" return accum - parseSections accum@(rs, h, u, g, p, a) + + parseSections accum@(rs, h, i, u, g, p, a) + (ParseUtils.Section _ "init" name fs) + | name == "" = do i' <- parseFields initFlagsFields i fs + return (rs, h, i', u, g, p, a) + | otherwise = do + warning "The 'init' section should be unnamed" + return accum + + parseSections accum@(rs, h, i, u, g, p, a) (ParseUtils.Section _ "install-dirs" name fs) | name' == "user" = do u' <- parseFields installDirsFields u fs - return (rs, h, u', g, p, a) + return (rs, h, i, u', g, p, a) | name' == "global" = do g' <- parseFields installDirsFields g fs - return (rs, h, u, g', p, a) + return (rs, h, i, u, g', p, a) | otherwise = do warning "The 'install-paths' section should be for 'user' or 'global'" return accum where name' = lowercase name - parseSections accum@(rs, h, u, g, p, a) + parseSections accum@(rs, h, i, u, g, p, a) (ParseUtils.Section _ "program-locations" name fs) | name == "" = do p' <- parseFields withProgramsFields p fs - return (rs, h, u, g, p', a) + return (rs, h, i, u, g, p', a) | otherwise = do warning "The 'program-locations' section should be unnamed" return accum - parseSections accum@(rs, h, u, g, p, a) + parseSections accum@(rs, h, i, u, g, p, a) (ParseUtils.Section _ "program-default-options" name fs) | name == "" = do a' <- parseFields withProgramOptionsFields a fs - return (rs, h, u, g, p, a') + return (rs, h, i, u, g, p, a') | otherwise = do warning "The 'program-default-options' section should be unnamed" return accum @@ -1089,6 +1228,9 @@ $+$ ppSection "haddock" "" haddockFlagsFields (fmap savedHaddockFlags mcomment) (savedHaddockFlags vals) $+$ Disp.text "" + $+$ ppSection "init" "" initFlagsFields + (fmap savedInitFlags mcomment) (savedInitFlags vals) + $+$ Disp.text "" $+$ installDirsSection "user" savedUserInstallDirs $+$ Disp.text "" $+$ installDirsSection "global" savedGlobalInstallDirs @@ -1162,6 +1304,22 @@ , name `notElem` exclusions ] where exclusions = ["verbose", "builddir", "for-hackage"] + +-- | Fields for the 'init' section. +initFlagsFields :: [FieldDescr IT.InitFlags] +initFlagsFields = [ field + | opt <- initOptions ParseArgs + , let field = viewAsFieldDescr opt + name = fieldName field + , name `notElem` exclusions ] + where + exclusions = + ["author", "email", "quiet", "no-comments", "minimal", "overwrite", + "package-dir", "packagedir", "package-name", "version", "homepage", + "synopsis", "category", "extra-source-file", "lib", "exe", "libandexe", + "simple", "main-is", "expose-module", "exposed-modules", "extension", + "dependency", "build-tool", "with-compiler", + "verbose"] -- | Fields for the 'program-locations' section. withProgramsFields :: [FieldDescr [(String, FilePath)]] diff --git a/cabal/cabal-install/Distribution/Client/Configure.hs b/cabal/cabal-install/Distribution/Client/Configure.hs --- a/cabal/cabal-install/Distribution/Client/Configure.hs +++ b/cabal/cabal-install/Distribution/Client/Configure.hs @@ -63,7 +63,11 @@ import Distribution.Package ( Package(..), packageName, PackageId ) import Distribution.Types.Dependency - ( Dependency(..), thisPackageVersion ) + ( thisPackageVersion ) +import Distribution.Types.GivenComponent + ( GivenComponent(..) ) +import Distribution.Types.PackageVersionConstraint + ( PackageVersionConstraint(..) ) import qualified Distribution.PackageDescription as PkgDesc import Distribution.PackageDescription.Parsec ( readGenericPackageDescription ) @@ -77,7 +81,7 @@ , defaultPackageDesc ) import Distribution.System ( Platform ) -import Distribution.Text ( display ) +import Distribution.Deprecated.Text ( display ) import Distribution.Verbosity as Verbosity ( Verbosity ) @@ -254,7 +258,9 @@ -- Return the setup dependencies computed by the solver ReadyPackage cpkg <- mpkg return [ ( cid, srcid ) - | ConfiguredId srcid (Just PkgDesc.CLibName) cid <- CD.setupDeps (confPkgDeps cpkg) + | ConfiguredId srcid + (Just (PkgDesc.CLibName PkgDesc.LMainLibName)) cid + <- CD.setupDeps (confPkgDeps cpkg) ] -- | Warn if any constraints or preferences name packages that are not in the @@ -275,7 +281,7 @@ where unknownConstraints = filter (unknown . userConstraintPackageName . fst) $ configExConstraints flags - unknownPreferences = filter (unknown . \(Dependency name _) -> name) $ + unknownPreferences = filter (unknown . \(PackageVersionConstraint name _) -> name) $ configPreferences flags unknown pkg = null (lookupPackageName installedPkgIndex pkg) && not (elemByPackageName sourcePkgIndex pkg) @@ -322,7 +328,7 @@ . addPreferences -- preferences from the config file or command line [ PackageVersionPreference name ver - | Dependency name ver <- configPreferences configExFlags ] + | PackageVersionConstraint name ver <- configPreferences configExFlags ] . addConstraints -- version constraints from the config file or command line @@ -401,9 +407,11 @@ -- deps. In the end only one set gets passed to Setup.hs configure, -- depending on the Cabal version we are talking to. configConstraints = [ thisPackageVersion srcid - | ConfiguredId srcid (Just PkgDesc.CLibName) _uid <- CD.nonSetupDeps deps ], - configDependencies = [ (packageName srcid, uid) - | ConfiguredId srcid (Just PkgDesc.CLibName) uid <- CD.nonSetupDeps deps ], + | ConfiguredId srcid (Just (PkgDesc.CLibName PkgDesc.LMainLibName)) _uid + <- CD.nonSetupDeps deps ], + configDependencies = [ GivenComponent (packageName srcid) cname uid + | ConfiguredId srcid (Just (PkgDesc.CLibName cname)) uid + <- CD.nonSetupDeps deps ], -- Use '--exact-configuration' if supported. configExactConfiguration = toFlag True, configVerbosity = toFlag verbosity, diff --git a/cabal/cabal-install/Distribution/Client/Dependency.hs b/cabal/cabal-install/Distribution/Client/Dependency.hs --- a/cabal/cabal-install/Distribution/Client/Dependency.hs +++ b/cabal/cabal-install/Distribution/Client/Dependency.hs @@ -47,11 +47,13 @@ setPreferenceDefault, setReorderGoals, setCountConflicts, + setMinimizeConflictSet, setIndependentGoals, setAvoidReinstalls, setShadowPkgs, setStrongFlags, setAllowBootLibInstalls, + setOnlyConstrained, setMaxBackjumps, setEnableBackjumping, setSolveExecutables, @@ -102,7 +104,7 @@ ( comparing ) import Distribution.Simple.Setup ( asBool ) -import Distribution.Text +import Distribution.Deprecated.Text ( display ) import Distribution.Verbosity ( normal, Verbosity ) @@ -157,6 +159,7 @@ depResolverSourcePkgIndex :: PackageIndex.PackageIndex UnresolvedSourcePackage, depResolverReorderGoals :: ReorderGoals, depResolverCountConflicts :: CountConflicts, + depResolverMinimizeConflictSet :: MinimizeConflictSet, depResolverIndependentGoals :: IndependentGoals, depResolverAvoidReinstalls :: AvoidReinstalls, depResolverShadowPkgs :: ShadowPkgs, @@ -165,6 +168,10 @@ -- | Whether to allow base and its dependencies to be installed. depResolverAllowBootLibInstalls :: AllowBootLibInstalls, + -- | Whether to only allow explicitly constrained packages plus + -- goals or to allow any package. + depResolverOnlyConstrained :: OnlyConstrained, + depResolverMaxBackjumps :: Maybe Int, depResolverEnableBackjumping :: EnableBackjumping, -- | Whether or not to solve for dependencies on executables. @@ -190,11 +197,13 @@ ++ "\nstrategy: " ++ show (depResolverPreferenceDefault p) ++ "\nreorder goals: " ++ show (asBool (depResolverReorderGoals p)) ++ "\ncount conflicts: " ++ show (asBool (depResolverCountConflicts p)) + ++ "\nminimize conflict set: " ++ show (asBool (depResolverMinimizeConflictSet p)) ++ "\nindependent goals: " ++ show (asBool (depResolverIndependentGoals p)) ++ "\navoid reinstalls: " ++ show (asBool (depResolverAvoidReinstalls p)) ++ "\nshadow packages: " ++ show (asBool (depResolverShadowPkgs p)) ++ "\nstrong flags: " ++ show (asBool (depResolverStrongFlags p)) ++ "\nallow boot library installs: " ++ show (asBool (depResolverAllowBootLibInstalls p)) + ++ "\nonly constrained packages: " ++ show (depResolverOnlyConstrained p) ++ "\nmax backjumps: " ++ maybe "infinite" show (depResolverMaxBackjumps p) where @@ -245,11 +254,13 @@ depResolverSourcePkgIndex = sourcePkgIndex, depResolverReorderGoals = ReorderGoals False, depResolverCountConflicts = CountConflicts True, + depResolverMinimizeConflictSet = MinimizeConflictSet False, depResolverIndependentGoals = IndependentGoals False, depResolverAvoidReinstalls = AvoidReinstalls False, depResolverShadowPkgs = ShadowPkgs False, depResolverStrongFlags = StrongFlags False, depResolverAllowBootLibInstalls = AllowBootLibInstalls False, + depResolverOnlyConstrained = OnlyConstrainedNone, depResolverMaxBackjumps = Nothing, depResolverEnableBackjumping = EnableBackjumping True, depResolverSolveExecutables = SolveExecutables True, @@ -299,6 +310,12 @@ depResolverCountConflicts = count } +setMinimizeConflictSet :: MinimizeConflictSet -> DepResolverParams -> DepResolverParams +setMinimizeConflictSet minimize params = + params { + depResolverMinimizeConflictSet = minimize + } + setIndependentGoals :: IndependentGoals -> DepResolverParams -> DepResolverParams setIndependentGoals indep params = params { @@ -329,6 +346,12 @@ depResolverAllowBootLibInstalls = i } +setOnlyConstrained :: OnlyConstrained -> DepResolverParams -> DepResolverParams +setOnlyConstrained i params = + params { + depResolverOnlyConstrained = i + } + setMaxBackjumps :: Maybe Int -> DepResolverParams -> DepResolverParams setMaxBackjumps n params = params { @@ -459,8 +482,8 @@ relaxPackageDeps relKind RelaxDepsAll gpd = PD.transformAllBuildDepends relaxAll gpd where relaxAll :: Dependency -> Dependency - relaxAll (Dependency pkgName verRange) = - Dependency pkgName (removeBound relKind RelaxDepModNone verRange) + relaxAll (Dependency pkgName verRange cs) = + Dependency pkgName (removeBound relKind RelaxDepModNone verRange) cs relaxPackageDeps relKind (RelaxDepsSome depsToRelax0) gpd = PD.transformAllBuildDepends relaxSome gpd @@ -480,13 +503,13 @@ | otherwise -> Nothing relaxSome :: Dependency -> Dependency - relaxSome d@(Dependency depName verRange) + relaxSome d@(Dependency depName verRange cs) | Just relMod <- Map.lookup RelaxDepSubjectAll depsToRelax = -- a '*'-subject acts absorbing, for consistency with -- the 'Semigroup RelaxDeps' instance - Dependency depName (removeBound relKind relMod verRange) + Dependency depName (removeBound relKind relMod verRange) cs | Just relMod <- Map.lookup (RelaxDepSubjectPkg depName) depsToRelax = - Dependency depName (removeBound relKind relMod verRange) + Dependency depName (removeBound relKind relMod verRange) cs | otherwise = d -- no-op -- | Internal helper for 'relaxPackageDeps' @@ -612,7 +635,7 @@ -- | The policy used by all the standard commands, install, fetch, freeze etc --- (but not the new-build and related commands). +-- (but not the v2-build and related commands). -- -- It extends the 'basicInstallPolicy' with a policy on setup deps. -- @@ -632,7 +655,7 @@ mkDefaultSetupDeps :: UnresolvedSourcePackage -> Maybe [Dependency] mkDefaultSetupDeps srcpkg | affected = Just [Dependency (mkPackageName "Cabal") - (orLaterVersion $ mkVersion [1,24])] + (orLaterVersion $ mkVersion [1,24]) (Set.singleton PD.LMainLibName)] | otherwise = Nothing where gpkgdesc = packageDescription srcpkg @@ -732,9 +755,8 @@ Step (showDepResolverParams finalparams) $ fmap (validateSolverResult platform comp indGoals) - $ runSolver solver (SolverConfig reordGoals cntConflicts - indGoals noReinstalls - shadowing strFlags allowBootLibs maxBkjumps enableBj + $ runSolver solver (SolverConfig reordGoals cntConflicts minimize indGoals noReinstalls + shadowing strFlags allowBootLibs onlyConstrained_ maxBkjumps enableBj solveExes order verbosity (PruneAfterFirstSuccess False)) platform comp installedPkgIndex sourcePkgIndex pkgConfigDB preferences constraints targets @@ -747,11 +769,13 @@ sourcePkgIndex reordGoals cntConflicts + minimize indGoals noReinstalls shadowing strFlags allowBootLibs + onlyConstrained_ maxBkjumps enableBj solveExes @@ -929,10 +953,10 @@ packageSatisfiesDependency (PackageIdentifier name version) - (Dependency name' versionRange) = assert (name == name') $ + (Dependency name' versionRange _) = assert (name == name') $ version `withinRange` versionRange - dependencyName (Dependency name _) = name + dependencyName (Dependency name _ _) = name mergedDeps :: [MergeResult Dependency PackageId] mergedDeps = mergeDeps requiredDeps (CD.flatDeps specifiedDeps) @@ -991,9 +1015,10 @@ -> Either [ResolveNoDepsError] [UnresolvedSourcePackage] resolveWithoutDependencies (DepResolverParams targets constraints prefs defpref installedPkgIndex sourcePkgIndex - _reorderGoals _countConflicts _indGoals _avoidReinstalls - _shadowing _strFlags _maxBjumps _enableBj - _solveExes _allowBootLibInstalls _order _verbosity) = + _reorderGoals _countConflicts _minimizeConflictSet + _indGoals _avoidReinstalls _shadowing _strFlags + _maxBjumps _enableBj _solveExes + _allowBootLibInstalls _onlyConstrained _order _verbosity) = collectEithers $ map selectPackage (Set.toList targets) where selectPackage :: PackageName -> Either ResolveNoDepsError UnresolvedSourcePackage @@ -1004,9 +1029,9 @@ where -- Constraints requiredVersions = packageConstraints pkgname - pkgDependency = Dependency pkgname requiredVersions choices = PackageIndex.lookupDependency sourcePkgIndex - pkgDependency + pkgname + requiredVersions -- Preferences PackagePreferences preferredVersions preferInstalled _ diff --git a/cabal/cabal-install/Distribution/Client/Dependency/Types.hs b/cabal/cabal-install/Distribution/Client/Dependency/Types.hs --- a/cabal/cabal-install/Distribution/Client/Dependency/Types.hs +++ b/cabal/cabal-install/Distribution/Client/Dependency/Types.hs @@ -10,9 +10,9 @@ import Data.Char ( isAlpha, toLower ) -import qualified Distribution.Compat.ReadP as Parse +import qualified Distribution.Deprecated.ReadP as Parse ( pfail, munch1 ) -import Distribution.Text +import Distribution.Deprecated.Text ( Text(..) ) import Text.PrettyPrint diff --git a/cabal/cabal-install/Distribution/Client/DistDirLayout.hs b/cabal/cabal-install/Distribution/Client/DistDirLayout.hs --- a/cabal/cabal-install/Distribution/Client/DistDirLayout.hs +++ b/cabal/cabal-install/Distribution/Client/DistDirLayout.hs @@ -27,15 +27,14 @@ import Distribution.Package ( PackageId, ComponentId, UnitId ) -import Distribution.Client.Setup - ( ArchiveFormat(..) ) import Distribution.Compiler import Distribution.Simple.Compiler ( PackageDB(..), PackageDBStack, OptimisationLevel(..) ) -import Distribution.Text +import Distribution.Deprecated.Text import Distribution.Pretty ( prettyShow ) import Distribution.Types.ComponentName +import Distribution.Types.LibraryName import Distribution.System @@ -114,7 +113,7 @@ distPackageCacheDirectory :: DistDirParams -> FilePath, -- | The location that sdists are placed by default. - distSdistFile :: PackageId -> ArchiveFormat -> FilePath, + distSdistFile :: PackageId -> FilePath, distSdistDirectory :: FilePath, distTempDirectory :: FilePath, @@ -199,8 +198,8 @@ display (distParamPackageId params) (case distParamComponentName params of Nothing -> "" - Just CLibName -> "" - Just (CSubLibName name) -> "l" display name + Just (CLibName LMainLibName) -> "" + Just (CLibName (LSubLibName name)) -> "l" display name Just (CFLibName name) -> "f" display name Just (CExeName name) -> "x" display name Just (CTestName name) -> "t" display name @@ -226,12 +225,8 @@ distPackageCacheDirectory params = distBuildDirectory params "cache" distPackageCacheFile params name = distPackageCacheDirectory params name - distSdistFile pid format = distSdistDirectory prettyShow pid <.> ext - where - ext = case format of - TargzFormat -> "tar.gz" - ZipFormat -> "zip" - + distSdistFile pid = distSdistDirectory prettyShow pid <.> "tar.gz" + distSdistDirectory = distDirectory "sdist" distTempDirectory = distDirectory "tmp" diff --git a/cabal/cabal-install/Distribution/Client/Fetch.hs b/cabal/cabal-install/Distribution/Client/Fetch.hs --- a/cabal/cabal-install/Distribution/Client/Fetch.hs +++ b/cabal/cabal-install/Distribution/Client/Fetch.hs @@ -44,7 +44,7 @@ ( die', notice, debug ) import Distribution.System ( Platform ) -import Distribution.Text +import Distribution.Deprecated.Text ( display ) import Distribution.Verbosity ( Verbosity ) @@ -162,12 +162,16 @@ . setCountConflicts countConflicts + . setMinimizeConflictSet minimizeConflictSet + . setShadowPkgs shadowPkgs . setStrongFlags strongFlags . setAllowBootLibInstalls allowBootLibInstalls + . setOnlyConstrained onlyConstrained + . setSolverVerbosity verbosity . addConstraints @@ -195,11 +199,13 @@ reorderGoals = fromFlag (fetchReorderGoals fetchFlags) countConflicts = fromFlag (fetchCountConflicts fetchFlags) + minimizeConflictSet = fromFlag (fetchMinimizeConflictSet fetchFlags) independentGoals = fromFlag (fetchIndependentGoals fetchFlags) shadowPkgs = fromFlag (fetchShadowPkgs fetchFlags) strongFlags = fromFlag (fetchStrongFlags fetchFlags) maxBackjumps = fromFlag (fetchMaxBackjumps fetchFlags) allowBootLibInstalls = fromFlag (fetchAllowBootLibInstalls fetchFlags) + onlyConstrained = fromFlag (fetchOnlyConstrained fetchFlags) checkTarget :: Verbosity -> UserTarget -> IO () diff --git a/cabal/cabal-install/Distribution/Client/FetchUtils.hs b/cabal/cabal-install/Distribution/Client/FetchUtils.hs --- a/cabal/cabal-install/Distribution/Client/FetchUtils.hs +++ b/cabal/cabal-install/Distribution/Client/FetchUtils.hs @@ -41,7 +41,7 @@ ( PackageId, packageName, packageVersion ) import Distribution.Simple.Utils ( notice, info, debug, die' ) -import Distribution.Text +import Distribution.Deprecated.Text ( display ) import Distribution.Verbosity ( Verbosity, verboseUnmarkOutput ) diff --git a/cabal/cabal-install/Distribution/Client/Freeze.hs b/cabal/cabal-install/Distribution/Client/Freeze.hs --- a/cabal/cabal-install/Distribution/Client/Freeze.hs +++ b/cabal/cabal-install/Distribution/Client/Freeze.hs @@ -55,7 +55,7 @@ ( die', notice, debug, writeFileAtomic ) import Distribution.System ( Platform ) -import Distribution.Text +import Distribution.Deprecated.Text ( display ) import Distribution.Verbosity ( Verbosity ) @@ -175,12 +175,16 @@ . setCountConflicts countConflicts + . setMinimizeConflictSet minimizeConflictSet + . setShadowPkgs shadowPkgs . setStrongFlags strongFlags . setAllowBootLibInstalls allowBootLibInstalls + . setOnlyConstrained onlyConstrained + . setSolverVerbosity verbosity . addConstraints @@ -203,11 +207,13 @@ reorderGoals = fromFlag (freezeReorderGoals freezeFlags) countConflicts = fromFlag (freezeCountConflicts freezeFlags) + minimizeConflictSet = fromFlag (freezeMinimizeConflictSet freezeFlags) independentGoals = fromFlag (freezeIndependentGoals freezeFlags) shadowPkgs = fromFlag (freezeShadowPkgs freezeFlags) strongFlags = fromFlag (freezeStrongFlags freezeFlags) maxBackjumps = fromFlag (freezeMaxBackjumps freezeFlags) allowBootLibInstalls = fromFlag (freezeAllowBootLibInstalls freezeFlags) + onlyConstrained = fromFlag (freezeOnlyConstrained freezeFlags) -- | Remove all unneeded packages from an install plan. diff --git a/cabal/cabal-install/Distribution/Client/GenBounds.hs b/cabal/cabal-install/Distribution/Client/GenBounds.hs --- a/cabal/cabal-install/Distribution/Client/GenBounds.hs +++ b/cabal/cabal-install/Distribution/Client/GenBounds.hs @@ -45,13 +45,13 @@ ( tryFindPackageDesc ) import Distribution.System ( Platform ) -import Distribution.Text +import Distribution.Deprecated.Text ( display ) import Distribution.Verbosity ( Verbosity ) import Distribution.Version ( Version, alterVersion - , LowerBound(..), UpperBound(..), VersionRange(..), asVersionIntervals + , LowerBound(..), UpperBound(..), VersionRange, asVersionIntervals , orLaterVersion, earlierVersion, intersectVersionRanges ) import System.Directory ( getCurrentDirectory ) @@ -112,7 +112,7 @@ let cinfo = compilerInfo comp cwd <- getCurrentDirectory - path <- tryFindPackageDesc cwd + path <- tryFindPackageDesc verbosity cwd gpd <- readGenericPackageDescription verbosity path -- NB: We don't enable tests or benchmarks, since often they -- don't really have useful bounds. @@ -144,10 +144,10 @@ traverse_ (putStrLn . (++",") . showBounds padTo) thePkgs depName :: Dependency -> String - depName (Dependency pn _) = unPackageName pn + depName (Dependency pn _ _) = unPackageName pn depVersion :: Dependency -> VersionRange - depVersion (Dependency _ vr) = vr + depVersion (Dependency _ vr _) = vr -- | The message printed when some dependencies are found to be lacking proper -- PVP-mandated bounds. diff --git a/cabal/cabal-install/Distribution/Client/Get.hs b/cabal/cabal-install/Distribution/Client/Get.hs --- a/cabal/cabal-install/Distribution/Client/Get.hs +++ b/cabal/cabal-install/Distribution/Client/Get.hs @@ -24,7 +24,8 @@ import Prelude () import Distribution.Client.Compat.Prelude hiding (get) - +import Distribution.Compat.Directory + ( listDirectory ) import Distribution.Package ( PackageId, packageId, packageName ) import Distribution.Simple.Setup @@ -33,7 +34,7 @@ ( notice, die', info, writeFileAtomic ) import Distribution.Verbosity ( Verbosity ) -import Distribution.Text (display) +import Distribution.Deprecated.Text (display) import qualified Distribution.PackageDescription as PD import Distribution.Simple.Program ( programName ) @@ -162,12 +163,16 @@ -> PackageDescriptionOverride -> FilePath -> IO () unpackPackage verbosity prefix pkgid descOverride pkgPath = do - let pkgdirname = display pkgid - pkgdir = prefix pkgdirname - pkgdir' = addTrailingPathSeparator pkgdir + let pkgdirname = display pkgid + pkgdir = prefix pkgdirname + pkgdir' = addTrailingPathSeparator pkgdir + emptyDirectory directory = null <$> listDirectory directory existsDir <- doesDirectoryExist pkgdir - when existsDir $ die' verbosity $ - "The directory \"" ++ pkgdir' ++ "\" already exists, not unpacking." + when existsDir $ do + isEmpty <- emptyDirectory pkgdir + unless isEmpty $ + die' verbosity $ + "The directory \"" ++ pkgdir' ++ "\" already exists and is not empty, not unpacking." existsFile <- doesFileExist pkgdir when existsFile $ die' verbosity $ "A file \"" ++ pkgdir ++ "\" is in the way, not unpacking." diff --git a/cabal/cabal-install/Distribution/Client/Glob.hs b/cabal/cabal-install/Distribution/Client/Glob.hs --- a/cabal/cabal-install/Distribution/Client/Glob.hs +++ b/cabal/cabal-install/Distribution/Client/Glob.hs @@ -21,9 +21,9 @@ import Data.List (stripPrefix) import Control.Monad (mapM) -import Distribution.Text -import Distribution.Compat.ReadP (ReadP, (<++), (+++)) -import qualified Distribution.Compat.ReadP as Parse +import Distribution.Deprecated.Text +import Distribution.Deprecated.ReadP (ReadP, (<++), (+++)) +import qualified Distribution.Deprecated.ReadP as Parse import qualified Text.PrettyPrint as Disp import System.FilePath diff --git a/cabal/cabal-install/Distribution/Client/HttpUtils.hs b/cabal/cabal-install/Distribution/Client/HttpUtils.hs --- a/cabal/cabal-install/Distribution/Client/HttpUtils.hs +++ b/cabal/cabal-install/Distribution/Client/HttpUtils.hs @@ -36,6 +36,7 @@ import qualified Data.ByteString.Lazy.Char8 as BS import qualified Paths_cabal_install (version) import Distribution.Verbosity (Verbosity) +import Distribution.Pretty (prettyShow) import Distribution.Simple.Utils ( die', info, warn, debug, notice, writeFileAtomic , copyFileVerbose, withTempFile ) @@ -45,8 +46,6 @@ ( RemoteRepo(..) ) import Distribution.System ( buildOS, buildArch ) -import Distribution.Text - ( display ) import qualified System.FilePath.Posix as FilePath.Posix ( splitDirectories ) import System.FilePath @@ -72,6 +71,7 @@ import Numeric (showHex) import System.Random (randomRIO) import System.Exit (ExitCode(..)) +import Data.Version (showVersion) ------------------------------------------------------------------------------ @@ -269,7 +269,7 @@ configureTransport :: Verbosity -> [FilePath] -> Maybe String -> IO HttpTransport configureTransport verbosity extraPath (Just name) = - -- the user secifically selected a transport by name so we'll try and + -- the user specifically selected a transport by name so we'll try and -- configure that one case find (\(name',_,_,_) -> name' == name) supportedTransports of @@ -807,8 +807,8 @@ -- userAgent :: String -userAgent = concat [ "cabal-install/", display Paths_cabal_install.version - , " (", display buildOS, "; ", display buildArch, ")" +userAgent = concat [ "cabal-install/", showVersion Paths_cabal_install.version + , " (", prettyShow buildOS, "; ", prettyShow buildArch, ")" ] statusParseFail :: Verbosity -> URI -> String -> IO a diff --git a/cabal/cabal-install/Distribution/Client/IndexUtils.hs b/cabal/cabal-install/Distribution/Client/IndexUtils.hs --- a/cabal/cabal-install/Distribution/Client/IndexUtils.hs +++ b/cabal/cabal-install/Distribution/Client/IndexUtils.hs @@ -67,7 +67,7 @@ ( getInstalledPackages, getInstalledPackagesMonitorFiles ) import Distribution.Version ( Version, mkVersion, intersectVersionRanges ) -import Distribution.Text +import Distribution.Deprecated.Text ( display, simpleParse ) import Distribution.Simple.Utils ( die', warn, info ) @@ -198,7 +198,7 @@ -- it was at a particular time. -- -- TODO: Enhance to allow specifying per-repo 'IndexState's and also --- report back per-repo 'IndexStateInfo's (in order for @new-freeze@ +-- report back per-repo 'IndexStateInfo's (in order for @v2-freeze@ -- to access it) getSourcePackagesAtIndexState :: Verbosity -> RepoContext -> Maybe IndexState -> IO SourcePackageDb @@ -275,7 +275,7 @@ let (pkgs, prefs) = mconcat pkgss prefs' = Map.fromListWith intersectVersionRanges - [ (name, range) | Dependency name range <- prefs ] + [ (name, range) | Dependency name range _ <- prefs ] _ <- evaluate pkgs _ <- evaluate prefs' return SourcePackageDb { @@ -708,7 +708,7 @@ let srcpkg = mkPkg (BuildTreeRef refType (packageId pkg) pkg path blockno) accum srcpkgs (srcpkg:btrs) prefs entries - accum srcpkgs btrs prefs (CachePreference pref@(Dependency pn _) _ _ : entries) = + accum srcpkgs btrs prefs (CachePreference pref@(Dependency pn _ _) _ _ : entries) = accum srcpkgs btrs (Map.insert pn pref prefs) entries getEntryContent :: BlockNo -> IO ByteString @@ -871,7 +871,7 @@ = CachePackageId PackageId !BlockNo !Timestamp | CachePreference Dependency !BlockNo !Timestamp | CacheBuildTreeRef !BuildTreeRefType !BlockNo - -- NB: CacheBuildTreeRef is irrelevant for 01-index & new-build + -- NB: CacheBuildTreeRef is irrelevant for 01-index & v2-build deriving (Eq,Generic) instance NFData IndexCacheEntry where diff --git a/cabal/cabal-install/Distribution/Client/IndexUtils/Timestamp.hs b/cabal/cabal-install/Distribution/Client/IndexUtils/Timestamp.hs --- a/cabal/cabal-install/Distribution/Client/IndexUtils/Timestamp.hs +++ b/cabal/cabal-install/Distribution/Client/IndexUtils/Timestamp.hs @@ -32,14 +32,14 @@ import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) import Distribution.Compat.Binary -import qualified Distribution.Compat.ReadP as ReadP -import Distribution.Text +import qualified Distribution.Deprecated.ReadP as ReadP +import Distribution.Deprecated.Text import qualified Text.PrettyPrint as Disp import GHC.Generics (Generic) -- | UNIX timestamp (expressed in seconds since unix epoch, i.e. 1970). newtype Timestamp = TS Int64 -- Tar.EpochTime - deriving (Eq,Ord,Enum,NFData,Show) + deriving (Eq,Ord,Enum,NFData,Show,Generic) epochTimeToTimestamp :: Tar.EpochTime -> Maybe Timestamp epochTimeToTimestamp et diff --git a/cabal/cabal-install/Distribution/Client/Init.hs b/cabal/cabal-install/Distribution/Client/Init.hs --- a/cabal/cabal-install/Distribution/Client/Init.hs +++ b/cabal/cabal-install/Distribution/Client/Init.hs @@ -24,13 +24,15 @@ import Prelude () import Distribution.Client.Compat.Prelude hiding (empty) +import Distribution.Deprecated.ReadP (readP_to_E) + import System.IO ( hSetBuffering, stdout, BufferMode(..) ) import System.Directory ( getCurrentDirectory, doesDirectoryExist, doesFileExist, copyFile , getDirectoryContents, createDirectoryIfMissing ) import System.FilePath - ( (), (<.>), takeBaseName, equalFilePath ) + ( (), (<.>), takeBaseName, takeExtension, equalFilePath ) import Data.Time ( getCurrentTime, utcToLocalTime, toGregorian, localDay, getCurrentTimeZone ) @@ -39,6 +41,7 @@ import Data.Function ( on ) import qualified Data.Map as M +import qualified Data.Set as Set import Control.Monad ( (>=>), join, forM_, mapM, mapM_ ) import Control.Arrow @@ -53,9 +56,13 @@ ( Verbosity ) import Distribution.ModuleName ( ModuleName ) -- And for the Text instance +import qualified Distribution.ModuleName as ModuleName + ( fromString, toFilePath ) import Distribution.InstalledPackageInfo ( InstalledPackageInfo, exposed ) import qualified Distribution.Package as P +import Distribution.Types.LibraryName + ( LibraryName(..) ) import Language.Haskell.Extension ( Language(..) ) import Distribution.Client.Init.Types @@ -73,7 +80,7 @@ import qualified Distribution.SPDX as SPDX import Distribution.ReadE - ( runReadE, readP_to_E ) + ( runReadE ) import Distribution.Simple.Setup ( Flag(..), flagToMaybe ) import Distribution.Simple.Utils @@ -86,11 +93,11 @@ ( ProgramDb ) import Distribution.Simple.PackageIndex ( InstalledPackageIndex, moduleNameIndex ) -import Distribution.Text +import Distribution.Deprecated.Text ( display, Text(..) ) import Distribution.Pretty ( prettyShow ) -import Distribution.Parsec.Class +import Distribution.Parsec ( eitherParsec ) import Distribution.Solver.Types.PackageIndex @@ -124,8 +131,15 @@ _ -> writeLicense initFlags' writeSetupFile initFlags' writeChangeLog initFlags' - createSourceDirectories initFlags' + createDirectories (sourceDirs initFlags') + createLibHs initFlags' + createDirectories (applicationDirs initFlags') createMainHs initFlags' + -- If a test suite was requested and this is not an executable-only + -- package, then create the "test" directory. + when (eligibleForTestSuite initFlags') $ do + createDirectories (testDirs initFlags') + createTestHs initFlags' success <- writeCabalFile initFlags' when success $ generateWarnings initFlags' @@ -138,7 +152,9 @@ -- user. extendFlags :: InstalledPackageIndex -> SourcePackageDb -> InitFlags -> IO InitFlags extendFlags pkgIx sourcePkgDb = - getCabalVersion + getSimpleProject + >=> getLibOrExec + >=> getCabalVersion >=> getPackageName sourcePkgDb >=> getVersion >=> getLicense @@ -147,8 +163,10 @@ >=> getSynopsis >=> getCategory >=> getExtraSourceFiles - >=> getLibOrExec + >=> getAppDir >=> getSrcDir + >=> getGenTests + >=> getTestDir >=> getLanguage >=> getGenComments >=> getModulesBuildToolsAndDeps pkgIx @@ -178,6 +196,25 @@ [2,4] -> "2.4 (+ support for '**' globbing)" _ -> display v +-- | Ask if a simple project with sensible defaults should be created. +getSimpleProject :: InitFlags -> IO InitFlags +getSimpleProject flags = do + simpleProj <- return (flagToMaybe $ simpleProject flags) + ?>> maybePrompt flags + (promptYesNo + "Should I generate a simple project with sensible defaults" + (Just True)) + return $ case maybeToFlag simpleProj of + Flag True -> + flags { interactive = Flag False + , simpleProject = Flag True + , packageType = Flag LibraryAndExecutable + , cabalVersion = Flag (mkVersion [2,4]) + } + simpleProjFlag@_ -> + flags { simpleProject = simpleProjFlag } + + -- | Ask which version of the cabal spec to use. getCabalVersion :: InitFlags -> IO InitFlags getCabalVersion flags = do @@ -355,11 +392,13 @@ getLibOrExec :: InitFlags -> IO InitFlags getLibOrExec flags = do pkgType <- return (flagToMaybe $ packageType flags) - ?>> maybePrompt flags (either (const Library) id `fmap` + ?>> maybePrompt flags (either (const Executable) id `fmap` promptList "What does the package build" - [Library, Executable, LibraryAndExecutable] + [Executable, Library, LibraryAndExecutable] Nothing displayPackageType False) - ?>> return (Just Library) + ?>> return (Just Executable) + + -- If this package contains an executable, get the main file name. mainFile <- if pkgType == Just Library then return Nothing else getMainFile flags @@ -367,6 +406,7 @@ , mainIs = maybeToFlag mainFile } + -- | Try to guess the main file of the executable, and prompt the user to choose -- one of them. Top-level modules including the word 'Main' in the file name -- will be candidates, and shorter filenames will be preferred. @@ -383,6 +423,30 @@ defaultFile showCandidate True) ?>> return (fmap (either id id) defaultFile) +-- | Ask if a test suite should be generated for the library. +getGenTests :: InitFlags -> IO InitFlags +getGenTests flags = do + genTests <- return (flagToMaybe $ initializeTestSuite flags) + -- Only generate a test suite if the package contains a library. + ?>> if (packageType flags) == Flag Executable then return (Just False) else return Nothing + ?>> maybePrompt flags + (promptYesNo + "Should I generate a test suite for the library" + (Just True)) + return $ flags { initializeTestSuite = maybeToFlag genTests } + +-- | Ask for the test root directory. +getTestDir :: InitFlags -> IO InitFlags +getTestDir flags = do + dirs <- return (testDirs flags) + -- Only need testDirs when test suite generation is enabled. + ?>> if not (eligibleForTestSuite flags) then return (Just []) else return Nothing + ?>> fmap (fmap ((:[]) . either id id)) (maybePrompt + flags + (promptList "Test directory" ["test"] (Just "test") id True)) + + return $ flags { testDirs = dirs } + -- | Ask for the base language of the package. getLanguage :: InitFlags -> IO InitFlags getLanguage flags = do @@ -415,14 +479,47 @@ where promptMsg = "Add informative comments to each field in the cabal file (y/n)" --- | Ask for the source root directory. +-- | Ask for the application root directory. +getAppDir :: InitFlags -> IO InitFlags +getAppDir flags = do + appDirs <- return (applicationDirs flags) + -- No application dir if this is a 'Library'. + ?>> if (packageType flags) == Flag Library then return (Just []) else return Nothing + ?>> fmap (:[]) `fmap` guessAppDir flags + ?>> fmap (>>= fmap ((:[]) . either id id)) (maybePrompt + flags + (promptListOptional' + ("Application " ++ mainFile ++ "directory") + ["src-exe", "app"] id)) + + return $ flags { applicationDirs = appDirs } + + where + mainFile = case mainIs flags of + Flag mainPath -> "(" ++ mainPath ++ ") " + _ -> "" + +-- | Try to guess app directory. Could try harder; for the +-- moment just looks to see whether there is a directory called 'app'. +guessAppDir :: InitFlags -> IO (Maybe String) +guessAppDir flags = do + dir <- maybe getCurrentDirectory return . flagToMaybe $ packageDir flags + appIsDir <- doesDirectoryExist (dir "app") + return $ if appIsDir + then Just "app" + else Nothing + +-- | Ask for the source (library) root directory. getSrcDir :: InitFlags -> IO InitFlags getSrcDir flags = do srcDirs <- return (sourceDirs flags) + -- source dir if this is an 'Executable'. + ?>> if (packageType flags) == Flag Executable then return (Just []) else return Nothing ?>> fmap (:[]) `fmap` guessSourceDir flags ?>> fmap (>>= fmap ((:[]) . either id id)) (maybePrompt flags - (promptListOptional' "Source directory" ["src"] id)) + (promptListOptional' "Library source directory" + ["src", "lib", "src-lib"] id)) return $ flags { sourceDirs = srcDirs } @@ -473,7 +570,31 @@ exts <- return (otherExts flags) ?>> (return . Just . nub . concatMap extensions $ sourceFiles) - return $ flags { exposedModules = Just mods + -- If we're initializing a library and there were no modules discovered + -- then create an empty 'MyLib' module. + -- This gets a little tricky when 'sourceDirs' == 'applicationDirs' because + -- then the executable needs to set 'other-modules: MyLib' or else the build + -- fails. + let (finalModsList, otherMods) = case (packageType flags, mods) of + + -- For an executable leave things as they are. + (Flag Executable, _) -> (mods, otherModules flags) + + -- If a non-empty module list exists don't change anything. + (_, (_:_)) -> (mods, otherModules flags) + + -- Library only: 'MyLib' in 'other-modules' only. + (Flag Library, _) -> ([myLibModule], Nothing) + + -- For a 'LibraryAndExecutable' we need to have special handling. + -- If we don't have a module list (Nothing or empty), then create a Lib. + (_, []) -> + if sourceDirs flags == applicationDirs flags + then ([myLibModule], Just [myLibModule]) + else ([myLibModule], Nothing) + + return $ flags { exposedModules = Just finalModsList + , otherModules = otherMods , buildTools = tools , dependencies = deps , otherExts = exts @@ -527,13 +648,14 @@ toDep :: [P.PackageIdentifier] -> IO P.Dependency -- If only one version, easy. We change e.g. 0.4.2 into 0.4.* - toDep [pid] = return $ P.Dependency (P.pkgName pid) (pvpize desugar . P.pkgVersion $ pid) + toDep [pid] = return $ P.Dependency (P.pkgName pid) (pvpize desugar . P.pkgVersion $ pid) (Set.singleton LMainLibName) --TODO sublibraries -- Otherwise, choose the latest version and issue a warning. toDep pids = do message flags ("\nWarning: multiple versions of " ++ display (P.pkgName . head $ pids) ++ " provide " ++ display m ++ ", choosing the latest.") return $ P.Dependency (P.pkgName . head $ pids) (pvpize desugar . maximum . map P.pkgVersion $ pids) + (Set.singleton LMainLibName) --TODO take into account sublibraries -- | Given a version, return an API-compatible (according to PVP) version range. -- @@ -559,17 +681,23 @@ incVersion' m [] = replicate m 0 ++ [1] incVersion' m (v:vs) = v : incVersion' (m-1) vs +-- | Returns true if this package is eligible for test suite initialization. +eligibleForTestSuite :: InitFlags -> Bool +eligibleForTestSuite flags = + Flag True == initializeTestSuite flags + && Flag Executable /= packageType flags + --------------------------------------------------------------------------- -- Prompting/user interaction ------------------------------------------- --------------------------------------------------------------------------- --- | Run a prompt or not based on the nonInteractive flag of the +-- | Run a prompt or not based on the interactive flag of the -- InitFlags structure. maybePrompt :: InitFlags -> IO t -> IO (Maybe t) maybePrompt flags p = - case nonInteractive flags of - Flag True -> return Nothing - _ -> Just `fmap` p + case interactive flags of + Flag False -> return Nothing + _ -> Just `fmap` p -- | Create a prompt with optional default value that returns a -- String. @@ -776,19 +904,49 @@ moveExistingFile flags fileName writeFile fileName content --- | Create source directories, if they were given. -createSourceDirectories :: InitFlags -> IO () -createSourceDirectories flags = case sourceDirs flags of - Just dirs -> forM_ dirs (createDirectoryIfMissing True) - Nothing -> return () +-- | Create directories, if they were given, and don't already exist. +createDirectories :: Maybe [String] -> IO () +createDirectories mdirs = case mdirs of + Just dirs -> forM_ dirs (createDirectoryIfMissing True) + Nothing -> return () +-- | Create MyLib.hs file, if its the only module in the liste. +createLibHs :: InitFlags -> IO () +createLibHs flags = when ((exposedModules flags) == Just [myLibModule]) $ do + let modFilePath = ModuleName.toFilePath myLibModule ++ ".hs" + case sourceDirs flags of + Just (srcPath:_) -> writeLibHs flags (srcPath modFilePath) + _ -> writeLibHs flags modFilePath + +-- | Write a MyLib.hs file if it doesn't already exist. +writeLibHs :: InitFlags -> FilePath -> IO () +writeLibHs flags libPath = do + dir <- maybe getCurrentDirectory return (flagToMaybe $ packageDir flags) + let libFullPath = dir libPath + exists <- doesFileExist libFullPath + unless exists $ do + message flags $ "Generating " ++ libPath ++ "..." + writeFileSafe flags libFullPath myLibHs + +myLibModule :: ModuleName +myLibModule = ModuleName.fromString "MyLib" + +-- | Default MyLib.hs file. Used when no Lib.hs exists. +myLibHs :: String +myLibHs = unlines + [ "module MyLib (someFunc) where" + , "" + , "someFunc :: IO ()" + , "someFunc = putStrLn \"someFunc\"" + ] + -- | Create Main.hs, but only if we are init'ing an executable and -- the mainIs flag has been provided. createMainHs :: InitFlags -> IO () createMainHs flags = if hasMainHs flags then - case sourceDirs flags of - Just (srcPath:_) -> writeMainHs flags (srcPath mainFile) + case applicationDirs flags of + Just (appPath:_) -> writeMainHs flags (appPath mainFile) _ -> writeMainHs flags mainFile else return () where @@ -802,7 +960,7 @@ exists <- doesFileExist mainFullPath unless exists $ do message flags $ "Generating " ++ mainPath ++ "..." - writeFileSafe flags mainFullPath mainHs + writeFileSafe flags mainFullPath (mainHs flags) -- | Check that a main file exists. hasMainHs :: InitFlags -> Bool @@ -811,15 +969,68 @@ || packageType flags == Flag LibraryAndExecutable) _ -> False --- | Default Main.hs file. Used when no Main.hs exists. -mainHs :: String -mainHs = unlines - [ "module Main where" +-- | Default Main.(l)hs file. Used when no Main.(l)hs exists. +-- +-- If we are initializing a new 'LibraryAndExecutable' then import 'MyLib'. +mainHs :: InitFlags -> String +mainHs flags = (unlines . map prependPrefix) $ case packageType flags of + Flag LibraryAndExecutable -> + [ "module Main where" + , "" + , "import qualified MyLib (someFunc)" + , "" + , "main :: IO ()" + , "main = do" + , " putStrLn \"Hello, Haskell!\"" + , " MyLib.someFunc" + ] + _ -> + [ "module Main where" + , "" + , "main :: IO ()" + , "main = putStrLn \"Hello, Haskell!\"" + ] + where + prependPrefix "" = "" + prependPrefix line + | isLiterate = "> " ++ line + | otherwise = line + isLiterate = case mainIs flags of + Flag mainPath -> takeExtension mainPath == ".lhs" + _ -> False + +testFile :: String +testFile = "MyLibTest.hs" + +-- | Create MyLibTest.hs, but only if we are init'ing a library and +-- the initializeTestSuite flag has been set. +createTestHs :: InitFlags -> IO () +createTestHs flags = + when (eligibleForTestSuite flags) $ + case testDirs flags of + Just (testPath:_) -> writeTestHs flags (testPath testFile) + _ -> writeMainHs flags testFile + +--- | Write a test file. +writeTestHs :: InitFlags -> FilePath -> IO () +writeTestHs flags testPath = do + dir <- maybe getCurrentDirectory return (flagToMaybe $ packageDir flags) + let testFullPath = dir testPath + exists <- doesFileExist testFullPath + unless exists $ do + message flags $ "Generating " ++ testPath ++ "..." + writeFileSafe flags testFullPath testHs + +-- | Default MyLibTest.hs file. +testHs :: String +testHs = unlines + [ "module Main (main) where" , "" , "main :: IO ()" - , "main = putStrLn \"Hello, Haskell!\"" + , "main = putStrLn \"Test suite not yet implemented.\"" ] + -- | Move an existing file, if there is one, and the overwrite flag is -- not set. moveExistingFile :: InitFlags -> FilePath -> IO () @@ -934,6 +1145,8 @@ Flag Library -> libraryStanza Flag LibraryAndExecutable -> libraryStanza $+$ executableStanza _ -> empty + + , if eligibleForTestSuite c then testSuiteStanza else empty ] where specVer = fromMaybe defaultCabalVersion $ flagToMaybe (cabalVersion c) @@ -946,7 +1159,7 @@ generateBuildInfo :: BuildType -> InitFlags -> Doc generateBuildInfo buildType c' = vcat - [ fieldS "other-modules" (listField (otherModules c')) + [ fieldS "other-modules" (listField otherMods) (Just $ case buildType of LibBuild -> "Modules included in this library but not exported." ExecBuild -> "Modules included in this executable, other than Main.") @@ -956,11 +1169,13 @@ (Just "LANGUAGE extensions used by modules in this package.") True - , fieldS "build-depends" (listField (dependencies c')) + , fieldS "build-depends" ((++ myLibDep) <$> listField (dependencies c')) (Just "Other library packages from which modules are imported.") True - , fieldS "hs-source-dirs" (listFieldS (sourceDirs c')) + , fieldS "hs-source-dirs" (listFieldS (case buildType of + LibBuild -> sourceDirs c' + ExecBuild -> applicationDirs c')) (Just "Directories containing source files.") True @@ -972,7 +1187,20 @@ (Just "Base language which the package is written in.") True ] + -- Hack: Can't construct a 'Dependency' which is just 'packageName'(?). + where + myLibDep = if exposedModules c' == Just [myLibModule] && buildType == ExecBuild + then case packageName c' of + Flag pkgName -> ", " ++ P.unPackageName pkgName + _ -> "" + else "" + -- Only include 'MyLib' in 'other-modules' of the executable. + otherModsFromFlag = otherModules c' + otherMods = if buildType == LibBuild && otherModsFromFlag == Just [myLibModule] + then Nothing + else otherModsFromFlag + listField :: Text s => Maybe [s] -> Flag String listField = listFieldS . fmap (map display) @@ -1041,6 +1269,30 @@ , generateBuildInfo LibBuild c ]) + testSuiteStanza :: Doc + testSuiteStanza = text "\ntest-suite" <+> + text (maybe "" ((++"-test") . display) . flagToMaybe $ packageName c) $$ + nest 2 (vcat + [ field "default-language" (language c) + (Just "Base language which the package is written in.") + True + + , fieldS "type" (Flag "exitcode-stdio-1.0") + (Just "The interface type and version of the test suite.") + True + + , fieldS "hs-source-dirs" (listFieldS (testDirs c)) + (Just "The directory where the test specifications are found.") + True + + , fieldS "main-is" (Flag testFile) + (Just "The entrypoint to the test suite.") + True + + , fieldS "build-depends" (listField (dependencies c)) + (Just "Test dependencies.") + True + ]) -- | Generate warnings for missing fields etc. generateWarnings :: InitFlags -> IO () diff --git a/cabal/cabal-install/Distribution/Client/Init/Heuristics.hs b/cabal/cabal-install/Distribution/Client/Init/Heuristics.hs --- a/cabal/cabal-install/Distribution/Client/Init/Heuristics.hs +++ b/cabal/cabal-install/Distribution/Client/Init/Heuristics.hs @@ -23,7 +23,7 @@ import Prelude () import Distribution.Client.Compat.Prelude -import Distribution.Text (simpleParse) +import Distribution.Parsec (simpleParsec) import Distribution.Simple.Setup (Flag(..), flagToMaybe) import Distribution.ModuleName ( ModuleName, toFilePath ) @@ -147,7 +147,7 @@ where relRoot = makeRelative projectRoot srcRoot unqualModName = dropExtension entry - modName = simpleParse + modName = simpleParsec $ intercalate "." . reverse $ (unqualModName : hierarchy) ext = case takeExtension entry of '.':e -> e; e -> e scanRecursive parent hierarchy entry @@ -179,7 +179,7 @@ -- minimum. -- A poor man's LANGUAGE pragma parser. - exts = mapMaybe simpleParse + exts = mapMaybe simpleParsec . concatMap getPragmas . filter isLANGUAGEPragma . map fst @@ -205,7 +205,7 @@ where getModName :: [String] -> Maybe ModuleName getModName [] = Nothing getModName ("qualified":ws) = getModName ws - getModName (ms:_) = simpleParse ms + getModName (ms:_) = simpleParsec ms diff --git a/cabal/cabal-install/Distribution/Client/Init/Types.hs b/cabal/cabal-install/Distribution/Client/Init/Types.hs --- a/cabal/cabal-install/Distribution/Client/Init/Types.hs +++ b/cabal/cabal-install/Distribution/Client/Init/Types.hs @@ -28,8 +28,8 @@ import Language.Haskell.Extension ( Language(..), Extension ) import qualified Text.PrettyPrint as Disp -import qualified Distribution.Compat.ReadP as Parse -import Distribution.Text +import qualified Distribution.Deprecated.ReadP as Parse +import Distribution.Deprecated.Text import GHC.Generics ( Generic ) @@ -39,11 +39,12 @@ -- likely to want and/or that we are likely to be able to -- intelligently guess. data InitFlags = - InitFlags { nonInteractive :: Flag Bool + InitFlags { interactive :: Flag Bool , quiet :: Flag Bool , packageDir :: Flag FilePath , noComments :: Flag Bool , minimal :: Flag Bool + , simpleProject :: Flag Bool , packageName :: Flag P.PackageName , version :: Flag Version @@ -65,10 +66,14 @@ , otherModules :: Maybe [ModuleName] , otherExts :: Maybe [Extension] - , dependencies :: Maybe [P.Dependency] - , sourceDirs :: Maybe [String] - , buildTools :: Maybe [String] + , dependencies :: Maybe [P.Dependency] + , applicationDirs :: Maybe [String] + , sourceDirs :: Maybe [String] + , buildTools :: Maybe [String] + , initializeTestSuite :: Flag Bool + , testDirs :: Maybe [String] + , initHcPath :: Flag FilePath , initVerbosity :: Flag Verbosity @@ -81,7 +86,9 @@ -- not Flag [foo]. data BuildType = LibBuild | ExecBuild + deriving Eq +-- The type of package to initialize. data PackageType = Library | Executable | LibraryAndExecutable deriving (Show, Read, Eq) @@ -120,4 +127,3 @@ instance Text Category where disp = Disp.text . show parse = Parse.choice $ map (fmap read . Parse.string . show) [Codec .. ] -- TODO: eradicateNoParse - diff --git a/cabal/cabal-install/Distribution/Client/Install.hs b/cabal/cabal-install/Distribution/Client/Install.hs --- a/cabal/cabal-install/Distribution/Client/Install.hs +++ b/cabal/cabal-install/Distribution/Client/Install.hs @@ -32,6 +32,7 @@ import Prelude () import Distribution.Client.Compat.Prelude +import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map import qualified Data.Set as S import Control.Exception as Exception @@ -78,7 +79,8 @@ import Distribution.Client.Setup ( GlobalFlags(..), RepoContext(..) , ConfigFlags(..), configureCommand, filterConfigureFlags - , ConfigExFlags(..), InstallFlags(..) ) + , ConfigExFlags(..), InstallFlags(..) + , filterTestFlags ) import Distribution.Client.Config ( getCabalDir, defaultUserInstall ) import Distribution.Client.Sandbox.Timestamp @@ -123,12 +125,13 @@ import Distribution.Simple.Setup ( haddockCommand, HaddockFlags(..) , buildCommand, BuildFlags(..), emptyBuildFlags + , TestFlags , toFlag, fromFlag, fromFlagOrDefault, flagToMaybe, defaultDistPref ) import qualified Distribution.Simple.Setup as Cabal ( Flag(..) , copyCommand, CopyFlags(..), emptyCopyFlags , registerCommand, RegisterFlags(..), emptyRegisterFlags - , testCommand, TestFlags(..), emptyTestFlags ) + , testCommand, TestFlags(..) ) import Distribution.Simple.Utils ( createDirectoryIfMissingVerbose, comparing , writeFileAtomic, withUTF8FileContents ) @@ -142,7 +145,12 @@ , Package(..), HasMungedPackageId(..), HasUnitId(..) , UnitId ) import Distribution.Types.Dependency - ( Dependency(..), thisPackageVersion ) + ( thisPackageVersion ) +import Distribution.Types.GivenComponent + ( GivenComponent(..) ) +import Distribution.Pretty ( prettyShow ) +import Distribution.Types.PackageVersionConstraint + ( PackageVersionConstraint(..) ) import Distribution.Types.MungedPackageId import qualified Distribution.PackageDescription as PackageDescription import Distribution.PackageDescription @@ -151,8 +159,6 @@ , showFlagValue, diffFlagAssignment, nullFlagAssignment ) import Distribution.PackageDescription.Configuration ( finalizePD ) -import Distribution.ParseUtils - ( showPWarning ) import Distribution.Version ( Version, VersionRange, foldVersionRange ) import Distribution.Simple.Utils as Utils @@ -163,8 +169,6 @@ , tryCanonicalizePath, ProgressPhase(..), progressMessage ) import Distribution.System ( Platform, OS(Windows), buildOS, buildPlatform ) -import Distribution.Text - ( display ) import Distribution.Verbosity as Verbosity ( Verbosity, modifyVerbosity, normal, verbose ) import Distribution.Simple.BuildPaths ( exeExtension ) @@ -201,10 +205,11 @@ -> ConfigExFlags -> InstallFlags -> HaddockFlags + -> TestFlags -> [UserTarget] -> IO () install verbosity packageDBs repos comp platform progdb useSandbox mSandboxPkgInfo - globalFlags configFlags configExFlags installFlags haddockFlags + globalFlags configFlags configExFlags installFlags haddockFlags testFlags userTargets0 = do unless (installRootCmd installFlags == Cabal.NoFlag) $ @@ -233,7 +238,7 @@ args :: InstallArgs args = (packageDBs, repos, comp, platform, progdb, useSandbox, mSandboxPkgInfo, globalFlags, configFlags, configExFlags, - installFlags, haddockFlags) + installFlags, haddockFlags, testFlags) die'' message = die' verbosity (message ++ if isUseSandbox useSandbox then installFailedInSandbox else []) @@ -266,14 +271,15 @@ , ConfigFlags , ConfigExFlags , InstallFlags - , HaddockFlags ) + , HaddockFlags + , TestFlags ) -- | Make an install context given install arguments. makeInstallContext :: Verbosity -> InstallArgs -> Maybe [UserTarget] -> IO InstallContext makeInstallContext verbosity (packageDBs, repoCtxt, comp, _, progdb,_,_, - globalFlags, _, configExFlags, installFlags, _) mUserTargets = do + globalFlags, _, configExFlags, installFlags, _, _) mUserTargets = do let idxState = flagToMaybe (installIndexState installFlags) @@ -312,7 +318,7 @@ makeInstallPlan verbosity (_, _, comp, platform, _, _, mSandboxPkgInfo, _, configFlags, configExFlags, installFlags, - _) + _, _) (installedPkgIndex, sourcePkgDb, pkgConfigDb, _, pkgSpecifiers, _) = do @@ -328,7 +334,7 @@ -> SolverInstallPlan -> IO () processInstallPlan verbosity - args@(_,_, _, _, _, _, _, _, configFlags, _, installFlags, _) + args@(_,_, _, _, _, _, _, _, configFlags, _, installFlags, _, _) (installedPkgIndex, sourcePkgDb, _, userTargets, pkgSpecifiers, _) installPlan0 = do @@ -384,6 +390,8 @@ . setCountConflicts countConflicts + . setMinimizeConflictSet minimizeConflictSet + . setAvoidReinstalls avoidReinstalls . setShadowPkgs shadowPkgs @@ -392,6 +400,8 @@ . setAllowBootLibInstalls allowBootLibInstalls + . setOnlyConstrained onlyConstrained + . setSolverVerbosity verbosity . setPreferenceDefault (if upgradeDeps then PreferAllLatest @@ -403,7 +413,7 @@ . addPreferences -- preferences from the config file or command line [ PackageVersionPreference name ver - | Dependency name ver <- configPreferences configExFlags ] + | PackageVersionConstraint name ver <- configPreferences configExFlags ] . addConstraints -- version constraints from the config file or command line @@ -448,12 +458,14 @@ fromFlag (installReinstall installFlags) reorderGoals = fromFlag (installReorderGoals installFlags) countConflicts = fromFlag (installCountConflicts installFlags) + minimizeConflictSet = fromFlag (installMinimizeConflictSet installFlags) independentGoals = fromFlag (installIndependentGoals installFlags) avoidReinstalls = fromFlag (installAvoidReinstalls installFlags) shadowPkgs = fromFlag (installShadowPkgs installFlags) strongFlags = fromFlag (installStrongFlags installFlags) maxBackjumps = fromFlag (installMaxBackjumps installFlags) allowBootLibInstalls = fromFlag (installAllowBootLibInstalls installFlags) + onlyConstrained = fromFlag (installOnlyConstrained installFlags) upgradeDeps = fromFlag (installUpgradeDeps installFlags) onlyDeps = fromFlag (installOnlyDeps installFlags) @@ -479,9 +491,9 @@ "Cannot select only the dependencies (as requested by the " ++ "'--only-dependencies' flag), " ++ (case pkgids of - [pkgid] -> "the package " ++ display pkgid ++ " is " + [pkgid] -> "the package " ++ prettyShow pkgid ++ " is " _ -> "the packages " - ++ intercalate ", " (map display pkgids) ++ " are ") + ++ intercalate ", " (map prettyShow pkgids) ++ " are ") ++ "required by a dependency of one of the other targets." where pkgids = @@ -519,7 +531,7 @@ when nothingToInstall $ notice verbosity $ unlines $ "All the requested packages are already installed:" - : map (display . packageId) preExistingTargets + : map (prettyShow . packageId) preExistingTargets ++ ["Use --reinstall if you want to reinstall anyway."] let lPlan = @@ -566,7 +578,7 @@ then do (if dryRun || overrideReinstall then warn else die') verbosity $ unlines $ "The following packages are likely to be broken by the reinstalls:" - : map (display . mungedId) newBrokenPkgs + : map (prettyShow . mungedId) newBrokenPkgs ++ if overrideReinstall then if dryRun then [] else ["Continuing even though " ++ @@ -588,7 +600,7 @@ unless (null notFetched) $ die' verbosity $ "Can't download packages in offline mode. " ++ "Must download the following packages to proceed:\n" - ++ intercalate ", " (map display notFetched) + ++ intercalate ", " (map prettyShow notFetched) ++ "\nTry using 'cabal fetch'." where @@ -662,10 +674,10 @@ wouldWill | dryRun = "would" | otherwise = "will" - showPkg (pkg, _) = display (packageId pkg) ++ + showPkg (pkg, _) = prettyShow (packageId pkg) ++ showLatest (pkg) - showPkgAndReason (ReadyPackage pkg', pr) = display (packageId pkg') ++ + showPkgAndReason (ReadyPackage pkg', pr) = prettyShow (packageId pkg') ++ showLatest pkg' ++ showFlagAssignment (nonDefaultFlags pkg') ++ showStanzas (confPkgStanzas pkg') ++ @@ -682,7 +694,7 @@ showLatest pkg = case mLatestVersion of Just latestVersion -> if packageVersion pkg < latestVersion - then (" (latest: " ++ display latestVersion ++ ")") + then (" (latest: " ++ prettyShow latestVersion ++ ")") else "" Nothing -> "" where @@ -710,19 +722,24 @@ showFlagAssignment :: FlagAssignment -> String showFlagAssignment = concatMap ((' ' :) . showFlagValue) . unFlagAssignment - change (OnlyInLeft pkgid) = display pkgid ++ " removed" - change (InBoth pkgid pkgid') = display pkgid ++ " -> " - ++ display (mungedVersion pkgid') - change (OnlyInRight pkgid') = display pkgid' ++ " added" + change (OnlyInLeft pkgid) = prettyShow pkgid ++ " removed" + change (InBoth pkgid pkgid') = prettyShow pkgid ++ " -> " + ++ prettyShow (mungedVersion pkgid') + change (OnlyInRight pkgid') = prettyShow pkgid' ++ " added" showDep pkg | Just rdeps <- Map.lookup (packageId pkg) revDeps - = " (via: " ++ unwords (map display rdeps) ++ ")" + = " (via: " ++ unwords (map prettyShow rdeps) ++ ")" | otherwise = "" revDepGraphEdges :: [(PackageId, PackageId)] revDepGraphEdges = [ (rpid, packageId cpkg) | (ReadyPackage cpkg, _) <- plan - , ConfiguredId rpid (Just PackageDescription.CLibName) _ + , ConfiguredId + rpid + (Just + (PackageDescription.CLibName + PackageDescription.LMainLibName)) + _ <- CD.flatDeps (confPkgDeps cpkg) ] revDeps :: Map.Map PackageId [PackageId] @@ -738,7 +755,7 @@ -> IO () reportPlanningFailure verbosity (_, _, comp, platform, _, _, _ - ,_, configFlags, _, installFlags, _) + ,_, configFlags, _, installFlags, _, _) (_, sourcePkgDb, _, _, pkgSpecifiers, _) message = do @@ -756,7 +773,7 @@ unless (null buildReports) $ info verbosity $ "Solver failure will be reported for " - ++ intercalate "," (map display pkgids) + ++ intercalate "," (map prettyShow pkgids) -- Save reports BuildReports.storeLocal (compilerInfo comp) @@ -818,7 +835,7 @@ -> IO () postInstallActions verbosity (packageDBs, _, comp, platform, progdb, useSandbox, mSandboxPkgInfo - ,globalFlags, configFlags, _, installFlags, _) + ,globalFlags, configFlags, _, installFlags, _, _) targets installPlan buildOutcomes = do updateSandboxTimestampsFile verbosity useSandbox mSandboxPkgInfo @@ -859,7 +876,7 @@ -> [(BuildReports.BuildReport, Maybe Repo)] -> IO () storeDetailedBuildReports verbosity logsDir reports = sequence_ [ do dotCabal <- getCabalDir - let logFileName = display (BuildReports.package report) <.> "log" + let logFileName = prettyShow (BuildReports.package report) <.> "log" logFile = logsDir logFileName reportsDir = dotCabal "reports" remoteRepoName remoteRepo reportFile = reportsDir logFileName @@ -970,14 +987,14 @@ [(_, exe, path)] -> warn verbosity $ "could not create a symlink in " ++ bindir ++ " for " - ++ display exe ++ " because the file exists there already but is not " + ++ prettyShow exe ++ " because the file exists there already but is not " ++ "managed by cabal. You can create a symlink for this executable " ++ "manually if you wish. The executable file has been installed at " ++ path exes -> warn verbosity $ "could not create symlinks in " ++ bindir ++ " for " - ++ intercalate ", " [ display exe | (_, exe, _) <- exes ] + ++ intercalate ", " [ prettyShow exe | (_, exe, _) <- exes ] ++ " because the files exist there already and are not " ++ "managed by cabal. You can create symlinks for these executables " ++ "manually if you wish. The executable files have been installed at " @@ -993,11 +1010,11 @@ [] -> return () failed -> die' verbosity . unlines $ "Error: some packages failed to install:" - : [ display pkgid ++ printFailureReason reason + : [ prettyShow pkgid ++ printFailureReason reason | (pkgid, reason) <- failed ] where printFailureReason reason = case reason of - DependentFailed pkgid -> " depends on " ++ display pkgid + DependentFailed pkgid -> " depends on " ++ prettyShow pkgid ++ " which failed to install." DownloadFailed e -> " failed while downloading the package." ++ showException e @@ -1072,7 +1089,7 @@ -> IO BuildOutcomes performInstallations verbosity (packageDBs, repoCtxt, comp, platform, progdb, useSandbox, _, - globalFlags, configFlags, configExFlags, installFlags, haddockFlags) + globalFlags, configFlags, configExFlags, installFlags, haddockFlags, testFlags) installedPkgIndex installPlan = do -- With 'install -j' it can be a bit hard to tell whether a sandbox is used. @@ -1098,7 +1115,8 @@ (setupScriptOptions installedPkgIndex cacheLock rpkg) configFlags' - installFlags haddockFlags comp progdb + installFlags haddockFlags testFlags + comp progdb platform pkg rpkg pkgoverride mpath useLogFile where @@ -1198,9 +1216,9 @@ -- otherwise. printBuildResult :: PackageId -> UnitId -> BuildOutcome -> IO () printBuildResult pkgid uid buildOutcome = case buildOutcome of - (Right _) -> progressMessage verbosity ProgressCompleted (display pkgid) + (Right _) -> progressMessage verbosity ProgressCompleted (prettyShow pkgid) (Left _) -> do - notice verbosity $ "Failed to install " ++ display pkgid + notice verbosity $ "Failed to install " ++ prettyShow pkgid when (verbosity >= normal) $ case useLogFile of Nothing -> return () @@ -1234,16 +1252,21 @@ flags stanzas deps)) installPkg = installPkg configFlags { - configIPID = toFlag (display ipid), + configIPID = toFlag (prettyShow ipid), configConfigurationsFlags = flags, -- We generate the legacy constraints as well as the new style precise deps. -- In the end only one set gets passed to Setup.hs configure, depending on -- the Cabal version we are talking to. configConstraints = [ thisPackageVersion srcid - | ConfiguredId srcid (Just PackageDescription.CLibName) _ipid + | ConfiguredId + srcid + (Just + (PackageDescription.CLibName + PackageDescription.LMainLibName)) + _ipid <- CD.nonSetupDeps deps ], - configDependencies = [ (packageName srcid, dep_ipid) - | ConfiguredId srcid (Just PackageDescription.CLibName) dep_ipid + configDependencies = [ GivenComponent (packageName srcid) cname dep_ipid + | ConfiguredId srcid (Just (PackageDescription.CLibName cname)) dep_ipid <- CD.nonSetupDeps deps ], -- Use '--exact-configuration' if supported. configExactConfiguration = toFlag True, @@ -1311,10 +1334,10 @@ tmp <- getTemporaryDirectory withTempDirectory verbosity tmp "cabal-tmp" $ \tmpDirPath -> onFailure UnpackFailed $ do - let relUnpackedPath = display pkgid + let relUnpackedPath = prettyShow pkgid absUnpackedPath = tmpDirPath relUnpackedPath descFilePath = absUnpackedPath - display (packageName pkgid) <.> "cabal" + prettyShow (packageName pkgid) <.> "cabal" info verbosity $ "Extracting " ++ tarballPath ++ " to " ++ tmpDirPath ++ "..." extractTarGzFile tmpDirPath relUnpackedPath tarballPath @@ -1360,6 +1383,7 @@ -> ConfigFlags -> InstallFlags -> HaddockFlags + -> TestFlags -> Compiler -> ProgramDb -> Platform @@ -1371,16 +1395,16 @@ -> IO BuildOutcome installUnpackedPackage verbosity installLock numJobs scriptOptions - configFlags installFlags haddockFlags comp progdb + configFlags installFlags haddockFlags testFlags comp progdb platform pkg rpkg pkgoverride workingDir useLogFile = do -- Override the .cabal file if necessary case pkgoverride of Nothing -> return () Just pkgtxt -> do let descFilePath = fromMaybe "." workingDir - display (packageName pkgid) <.> "cabal" + prettyShow (packageName pkgid) <.> "cabal" info verbosity $ - "Updating " ++ display (packageName pkgid) <.> "cabal" + "Updating " ++ prettyShow (packageName pkgid) <.> "cabal" ++ " with the latest revision from the index." writeFileAtomic descFilePath pkgtxt @@ -1418,7 +1442,7 @@ -- Tests phase onFailure TestsFailed $ do when (testsEnabled && PackageDescription.hasTests pkg) $ - setup Cabal.testCommand testFlags mLogPath + setup Cabal.testCommand testFlags' mLogPath let testsResult | testsEnabled = TestsOk | otherwise = TestsNotTried @@ -1451,7 +1475,7 @@ uid = installedUnitId rpkg cinfo = compilerInfo comp buildCommand' = buildCommand progdb - dispname = display pkgid + dispname = prettyShow pkgid isParallelBuild = numJobs >= 2 noticeProgress phase = when isParallelBuild $ @@ -1468,7 +1492,7 @@ } testsEnabled = fromFlag (configTests configFlags) && fromFlagOrDefault False (installRunTests installFlags) - testFlags _ = Cabal.emptyTestFlags { + testFlags' = filterTestFlags testFlags { Cabal.testDistPref = configDistPref configFlags } copyFlags _ = Cabal.emptyCopyFlags { @@ -1482,7 +1506,7 @@ Cabal.regVerbosity = toFlag verbosity' } verbosity' = maybe verbosity snd useLogFile - tempTemplate name = name ++ "-" ++ display pkgid + tempTemplate name = name ++ "-" ++ prettyShow pkgid addDefaultInstallDirs :: ConfigFlags -> IO ConfigFlags addDefaultInstallDirs configFlags' = do @@ -1526,13 +1550,13 @@ readPkgConf pkgConfDir pkgConfFile = (withUTF8FileContents (pkgConfDir pkgConfFile) $ \pkgConfText -> case Installed.parseInstalledPackageInfo pkgConfText of - Installed.ParseFailed perror -> pkgConfParseFailed perror - Installed.ParseOk warns pkgConf -> do + Left perrors -> pkgConfParseFailed $ unlines $ NE.toList perrors + Right (warns, pkgConf) -> do unless (null warns) $ - warn verbosity $ unlines (map (showPWarning pkgConfFile) warns) + warn verbosity $ unlines warns return pkgConf) - pkgConfParseFailed :: Installed.PError -> IO a + pkgConfParseFailed :: String -> IO a pkgConfParseFailed perror = die' verbosity $ "Couldn't parse the output of 'setup register --gen-pkg-config':" ++ show perror @@ -1603,7 +1627,7 @@ [ InstallDirs.bindir absoluteDirs exeName <.> exeExtension buildPlatform | exe <- PackageDescription.executables pkg , PackageDescription.buildable (PackageDescription.buildInfo exe) - , let exeName = prefix ++ display (PackageDescription.exeName exe) ++ suffix + , let exeName = prefix ++ prettyShow (PackageDescription.exeName exe) ++ suffix prefix = substTemplate prefixTemplate suffix = substTemplate suffixTemplate ] where diff --git a/cabal/cabal-install/Distribution/Client/InstallPlan.hs b/cabal/cabal-install/Distribution/Client/InstallPlan.hs --- a/cabal/cabal-install/Distribution/Client/InstallPlan.hs +++ b/cabal/cabal-install/Distribution/Client/InstallPlan.hs @@ -79,7 +79,7 @@ , HasUnitId(..), UnitId ) import Distribution.Solver.Types.SolverPackage import Distribution.Client.JobControl -import Distribution.Text +import Distribution.Deprecated.Text import Text.PrettyPrint import qualified Distribution.Client.SolverInstallPlan as SolverInstallPlan import Distribution.Client.SolverInstallPlan (SolverInstallPlan) @@ -527,7 +527,7 @@ Cabal.NoFlag Cabal.NoFlag (packageId spkg) - PD.CLibName + (PD.CLibName PD.LMainLibName) (Just (map confInstId (CD.libraryDeps deps), solverPkgFlags spkg)), confPkgSource = solverPkgSource spkg, diff --git a/cabal/cabal-install/Distribution/Client/InstallSymlink.hs b/cabal/cabal-install/Distribution/Client/InstallSymlink.hs --- a/cabal/cabal-install/Distribution/Client/InstallSymlink.hs +++ b/cabal/cabal-install/Distribution/Client/InstallSymlink.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Client.InstallSymlink @@ -19,6 +20,9 @@ #ifdef mingw32_HOST_OS +import Distribution.Compat.Binary + ( Binary ) + import Distribution.Package (PackageIdentifier) import Distribution.Types.UnqualComponentName import Distribution.Client.InstallPlan (InstallPlan) @@ -27,10 +31,13 @@ import Distribution.Simple.Setup (ConfigFlags) import Distribution.Simple.Compiler import Distribution.System +import GHC.Generics (Generic) data OverwritePolicy = NeverOverwrite | AlwaysOverwrite - deriving (Show, Eq) + deriving (Show, Eq, Generic, Bounded, Enum) +instance Binary OverwritePolicy + symlinkBinaries :: Platform -> Compiler -> OverwritePolicy -> ConfigFlags @@ -47,6 +54,9 @@ #else +import Distribution.Compat.Binary + ( Binary ) + import Distribution.Client.Types ( ConfiguredPackage(..), BuildOutcomes ) import Distribution.Client.Setup @@ -74,7 +84,7 @@ ( Compiler, compilerInfo, CompilerInfo(..) ) import Distribution.System ( Platform ) -import Distribution.Text +import Distribution.Deprecated.Text ( display ) import System.Posix.Files @@ -93,9 +103,13 @@ ( assert ) import Data.Maybe ( catMaybes ) +import GHC.Generics + ( Generic ) data OverwritePolicy = NeverOverwrite | AlwaysOverwrite - deriving (Show, Eq) + deriving (Show, Eq, Generic, Bounded, Enum) + +instance Binary OverwritePolicy -- | We would like by default to install binaries into some location that is on -- the user's PATH. For per-user installations on Unix systems that basically diff --git a/cabal/cabal-install/Distribution/Client/List.hs b/cabal/cabal-install/Distribution/Client/List.hs --- a/cabal/cabal-install/Distribution/Client/List.hs +++ b/cabal/cabal-install/Distribution/Client/List.hs @@ -40,7 +40,7 @@ ( Version, mkVersion, versionNumbers, VersionRange, withinRange, anyVersion , intersectVersionRanges, simplifyVersionRange ) import Distribution.Verbosity (Verbosity) -import Distribution.Text +import Distribution.Deprecated.Text ( Text(disp), display ) import qualified Distribution.SPDX as SPDX @@ -231,9 +231,9 @@ selectedInstalledPkgs = InstalledPackageIndex.lookupDependency installedPkgIndex - (Dependency name verConstraint) + name verConstraint selectedSourcePkgs = PackageIndex.lookupDependency sourcePkgIndex - (Dependency name verConstraint) + name verConstraint selectedSourcePkg' = latestWithPref pref selectedSourcePkgs -- display a specific package version if the user diff --git a/cabal/cabal-install/Distribution/Client/Outdated.hs b/cabal/cabal-install/Distribution/Client/Outdated.hs --- a/cabal/cabal-install/Distribution/Client/Outdated.hs +++ b/cabal/cabal-install/Distribution/Client/Outdated.hs @@ -36,14 +36,14 @@ import Distribution.Simple.Utils (die', notice, debug, tryFindPackageDesc) import Distribution.System (Platform) -import Distribution.Text (display) +import Distribution.Deprecated.Text (display) import Distribution.Types.ComponentRequestedSpec (ComponentRequestedSpec(..)) import Distribution.Types.Dependency (Dependency(..), depPkgName, simplifyDependency) import Distribution.Verbosity (Verbosity, silent) import Distribution.Version - (Version, LowerBound(..), UpperBound(..) + (Version, VersionRange, LowerBound(..), UpperBound(..) ,asVersionIntervals, majorBoundVersion) import Distribution.PackageDescription.Parsec (readGenericPackageDescription) @@ -80,7 +80,7 @@ when (not newFreezeFile && isJust mprojectFile) $ die' verbosity $ - "--project-file must only be used with --new-freeze-file." + "--project-file must only be used with --v2-freeze-file." sourcePkgDb <- IndexUtils.getSourcePackages verbosity repoContext let pkgIndex = packageIndex sourcePkgDb @@ -107,7 +107,7 @@ then do when (not simpleOutput) $ notice verbosity "Outdated dependencies:" - for_ outdatedDeps $ \(d@(Dependency pn _), v) -> + for_ outdatedDeps $ \(d@(Dependency pn _ _), v) -> let outdatedDep = if simpleOutput then display pn else display d ++ " (latest: " ++ display v ++ ")" in notice verbosity outdatedDep @@ -149,7 +149,7 @@ depsFromPkgDesc :: Verbosity -> Compiler -> Platform -> IO [Dependency] depsFromPkgDesc verbosity comp platform = do cwd <- getCurrentDirectory - path <- tryFindPackageDesc cwd + path <- tryFindPackageDesc verbosity cwd gpd <- readGenericPackageDescription verbosity path let cinfo = compilerInfo comp epd = finalizePD mempty (ComponentRequestedSpec True True) @@ -179,10 +179,10 @@ mapMaybe isOutdated $ map simplifyDependency deps where isOutdated :: Dependency -> Maybe (Dependency, Version) - isOutdated dep + isOutdated dep@(Dependency pname vr _) | ignorePred (depPkgName dep) = Nothing | otherwise = - let this = map packageVersion $ lookupDependency pkgIndex dep + let this = map packageVersion $ lookupDependency pkgIndex pname vr latest = lookupLatest dep in (\v -> (dep, v)) `fmap` isOutdated' this latest @@ -195,17 +195,16 @@ in if this' < latest' then Just latest' else Nothing lookupLatest :: Dependency -> [Version] - lookupLatest dep + lookupLatest dep@(Dependency pname vr _) | minorPred (depPkgName dep) = - map packageVersion $ lookupDependency pkgIndex (relaxMinor dep) + map packageVersion $ lookupDependency pkgIndex pname (relaxMinor vr) | otherwise = map packageVersion $ lookupPackageName pkgIndex (depPkgName dep) - relaxMinor :: Dependency -> Dependency - relaxMinor (Dependency pn vr) = (Dependency pn vr') - where - vr' = let vis = asVersionIntervals vr - (LowerBound v0 _,upper) = last vis - in case upper of - NoUpperBound -> vr - UpperBound _v1 _ -> majorBoundVersion v0 + relaxMinor :: VersionRange -> VersionRange + relaxMinor vr = + let vis = asVersionIntervals vr + (LowerBound v0 _,upper) = last vis + in case upper of + NoUpperBound -> vr + UpperBound _v1 _ -> majorBoundVersion v0 diff --git a/cabal/cabal-install/Distribution/Client/PackageHash.hs b/cabal/cabal-install/Distribution/Client/PackageHash.hs --- a/cabal/cabal-install/Distribution/Client/PackageHash.hs +++ b/cabal/cabal-install/Distribution/Client/PackageHash.hs @@ -44,9 +44,10 @@ , ProfDetailLevel(..), showProfDetailLevel ) import Distribution.Simple.InstallDirs ( PathTemplate, fromPathTemplate ) -import Distribution.Text +import Distribution.Pretty (prettyShow) +import Distribution.Deprecated.Text ( display ) -import Distribution.Version +import Distribution.Types.PkgconfigVersion (PkgconfigVersion) import Distribution.Client.Types ( InstalledPackageId ) import qualified Distribution.Solver.Types.ComponentDeps as CD @@ -176,7 +177,7 @@ pkgHashPkgId :: PackageId, pkgHashComponent :: Maybe CD.Component, pkgHashSourceHash :: PackageSourceHash, - pkgHashPkgConfigDeps :: Set (PkgconfigName, Maybe Version), + pkgHashPkgConfigDeps :: Set (PkgconfigName, Maybe PkgconfigVersion), pkgHashDirectDeps :: Set InstalledPackageId, pkgHashOtherConfig :: PackageHashConfigInputs } @@ -194,6 +195,7 @@ pkgHashVanillaLib :: Bool, pkgHashSharedLib :: Bool, pkgHashDynExe :: Bool, + pkgHashFullyStaticExe :: Bool, pkgHashGHCiLib :: Bool, pkgHashProfLib :: Bool, pkgHashProfExe :: Bool, @@ -275,7 +277,7 @@ (intercalate ", " . map (\(pn, mb_v) -> display pn ++ case mb_v of Nothing -> "" - Just v -> " " ++ display v) + Just v -> " " ++ prettyShow v) . Set.toList) pkgHashPkgConfigDeps , entry "deps" (intercalate ", " . map display . Set.toList) pkgHashDirectDeps @@ -287,6 +289,7 @@ , opt "vanilla-lib" True display pkgHashVanillaLib , opt "shared-lib" False display pkgHashSharedLib , opt "dynamic-exe" False display pkgHashDynExe + , opt "fully-static-exe" False display pkgHashFullyStaticExe , opt "ghci-lib" False display pkgHashGHCiLib , opt "prof-lib" False display pkgHashProfLib , opt "prof-exe" False display pkgHashProfExe diff --git a/cabal/cabal-install/Distribution/Client/PackageUtils.hs b/cabal/cabal-install/Distribution/Client/PackageUtils.hs --- a/cabal/cabal-install/Distribution/Client/PackageUtils.hs +++ b/cabal/cabal-install/Distribution/Client/PackageUtils.hs @@ -14,16 +14,14 @@ externalBuildDepends, ) where -import Distribution.Package - ( packageVersion, packageName ) -import Distribution.Types.ComponentRequestedSpec - ( ComponentRequestedSpec ) +import Distribution.Package (packageName, packageVersion) +import Distribution.PackageDescription + (PackageDescription (..), enabledBuildDepends, libName) +import Distribution.Types.ComponentRequestedSpec (ComponentRequestedSpec) import Distribution.Types.Dependency +import Distribution.Types.LibraryName import Distribution.Types.UnqualComponentName -import Distribution.PackageDescription - ( PackageDescription(..), libName, enabledBuildDepends ) -import Distribution.Version - ( withinRange, isAnyVersion ) +import Distribution.Version (isAnyVersion, withinRange) -- | The list of dependencies that refer to external packages -- rather than internal package components. @@ -33,8 +31,8 @@ where -- True if this dependency is an internal one (depends on a library -- defined in the same package). - internal (Dependency depName versionRange) = + internal (Dependency depName versionRange _) = (depName == packageName pkg && packageVersion pkg `withinRange` versionRange) || - (Just (packageNameToUnqualComponentName depName) `elem` map libName (subLibraries pkg) && + (LSubLibName (packageNameToUnqualComponentName depName) `elem` map libName (subLibraries pkg) && isAnyVersion versionRange) diff --git a/cabal/cabal-install/Distribution/Client/ParseUtils.hs b/cabal/cabal-install/Distribution/Client/ParseUtils.hs --- a/cabal/cabal-install/Distribution/Client/ParseUtils.hs +++ b/cabal/cabal-install/Distribution/Client/ParseUtils.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ExistentialQuantification, NamedFieldPuns #-} +{-# LANGUAGE ExistentialQuantification, NamedFieldPuns, RankNTypes #-} ----------------------------------------------------------------------------- -- | @@ -24,6 +24,9 @@ SectionDescr(..), liftSection, + -- * FieldGrammar sections + FGSectionDescr(..), + -- * Parsing and printing flat config parseFields, ppFields, @@ -39,19 +42,35 @@ ) where -import Distribution.ParseUtils +import Distribution.Client.Compat.Prelude hiding (empty, get) +import Prelude () + +import Distribution.Deprecated.ParseUtils ( FieldDescr(..), ParseResult(..), warning, LineNo, lineNo , Field(..), liftField, readFieldsFlat ) +import Distribution.Deprecated.ViewAsFieldDescr + ( viewAsFieldDescr ) + import Distribution.Simple.Command - ( OptionField, viewAsFieldDescr ) + ( OptionField ) -import Control.Monad ( foldM ) import Text.PrettyPrint ( (<+>), ($+$) ) import qualified Data.Map as Map import qualified Text.PrettyPrint as Disp ( (<>), Doc, text, colon, vcat, empty, isEmpty, nest ) +-- For new parser stuff +import Distribution.CabalSpecVersion (cabalSpecLatest) +import Distribution.FieldGrammar (FieldGrammar, partitionFields, parseFieldGrammar) +import Distribution.Fields.ParseResult (runParseResult) +import Distribution.Parsec.Error (showPError) +import Distribution.Parsec.Position (Position (..)) +import Distribution.Parsec.Warning (showPWarning) +import Distribution.Simple.Utils (fromUTF8BS, toUTF8BS) +import qualified Distribution.Fields as F +import qualified Distribution.FieldGrammar as FG + ------------------------- -- FieldDescr utilities -- @@ -104,6 +123,15 @@ sectionEmpty :: b } +-- | 'FieldGrammar' section description +data FGSectionDescr a = forall s. FGSectionDescr + { fgSectionName :: String + , fgSectionGrammar :: forall g. (FieldGrammar g, Applicative (g s)) => g s s + -- todo: add subsections? + , fgSectionGet :: a -> [(String, s)] + , fgSectionSet :: LineNo -> String -> s -> a -> ParseResult a + } + -- | To help construction of config file descriptions in a modular way it is -- useful to define fields and sections on local types and then hoist them -- into the parent types when combining them in bigger descriptions. @@ -150,7 +178,7 @@ warning $ "Unrecognized stanza on line " ++ show (lineNo f) return accum --- | This is a customised version of the functions from Distribution.ParseUtils +-- | This is a customised version of the functions from Distribution.Deprecated.ParseUtils -- that also optionally print default values for empty fields as comments. -- ppFields :: [FieldDescr a] -> (Maybe a) -> a -> Disp.Doc @@ -188,13 +216,18 @@ -- | Much like 'parseFields' but it also allows subsections. The permitted -- subsections are given by a list of 'SectionDescr's. -- -parseFieldsAndSections :: [FieldDescr a] -> [SectionDescr a] -> a - -> [Field] -> ParseResult a -parseFieldsAndSections fieldDescrs sectionDescrs = +parseFieldsAndSections + :: [FieldDescr a] -- ^ field + -> [SectionDescr a] -- ^ legacy sections + -> [FGSectionDescr a] -- ^ FieldGrammar sections + -> a + -> [Field] -> ParseResult a +parseFieldsAndSections fieldDescrs sectionDescrs fgSectionDescrs = foldM setField where - fieldMap = Map.fromList [ (fieldName f, f) | f <- fieldDescrs ] - sectionMap = Map.fromList [ (sectionName s, s) | s <- sectionDescrs ] + fieldMap = Map.fromList [ (fieldName f, f) | f <- fieldDescrs ] + sectionMap = Map.fromList [ (sectionName s, s) | s <- sectionDescrs ] + fgSectionMap = Map.fromList [ (fgSectionName s, s) | s <- fgSectionDescrs ] setField a (F line name value) = case Map.lookup name fieldMap of @@ -205,10 +238,25 @@ return a setField a (Section line name param fields) = - case Map.lookup name sectionMap of - Just (SectionDescr _ fieldDescrs' sectionDescrs' _ set sectionEmpty) -> do - b <- parseFieldsAndSections fieldDescrs' sectionDescrs' sectionEmpty fields + case Left <$> Map.lookup name sectionMap <|> Right <$> Map.lookup name fgSectionMap of + Just (Left (SectionDescr _ fieldDescrs' sectionDescrs' _ set sectionEmpty)) -> do + b <- parseFieldsAndSections fieldDescrs' sectionDescrs' [] sectionEmpty fields set line param b a + Just (Right (FGSectionDescr _ grammar _getter setter)) -> do + let fields1 = mapMaybe convertField fields + (fields2, sections) = partitionFields fields1 + -- TODO: recurse into sections + for_ (concat sections) $ \(FG.MkSection (F.Name (Position line' _) name') _ _) -> + warning $ "Unrecognized section '" ++ fromUTF8BS name' + ++ "' on line " ++ show line' + case runParseResult $ parseFieldGrammar cabalSpecLatest fields2 grammar of + (warnings, Right b) -> do + for_ warnings $ \w -> warning $ showPWarning "???" w + setter line param b a + (warnings, Left (_, errs)) -> do + for_ warnings $ \w -> warning $ showPWarning "???" w + case errs of + err :| _errs -> fail $ showPError "???" err Nothing -> do warning $ "Unrecognized section '" ++ name ++ "' on line " ++ show line @@ -218,17 +266,31 @@ warning $ "Unrecognized stanza on line " ++ show (lineNo block) return accum +convertField :: Field -> Maybe (F.Field Position) +convertField (F line name str) = Just $ + F.Field (F.Name pos (toUTF8BS name)) [ F.FieldLine pos $ toUTF8BS str ] + where + pos = Position line 0 +-- arguments omitted +convertField (Section line name _arg fields) = Just $ + F.Section (F.Name pos (toUTF8BS name)) [] (mapMaybe convertField fields) + where + pos = Position line 0 +-- silently omitted. +convertField IfBlock {} = Nothing + + -- | Much like 'ppFields' but also pretty prints any subsections. Subsection -- are only shown if they are non-empty. -- -- Note that unlike 'ppFields', at present it does not support printing -- default values. If needed, adding such support would be quite reasonable. -- -ppFieldsAndSections :: [FieldDescr a] -> [SectionDescr a] -> a -> Disp.Doc -ppFieldsAndSections fieldDescrs sectionDescrs val = +ppFieldsAndSections :: [FieldDescr a] -> [SectionDescr a] -> [FGSectionDescr a] -> a -> Disp.Doc +ppFieldsAndSections fieldDescrs sectionDescrs fgSectionDescrs val = ppFields fieldDescrs Nothing val $+$ - Disp.vcat + Disp.vcat ( [ Disp.text "" $+$ sectionDoc | SectionDescr { sectionName, sectionGet, @@ -237,25 +299,58 @@ , (param, x) <- sectionGet val , let sectionDoc = ppSectionAndSubsections sectionName param - sectionFields sectionSubsections x + sectionFields sectionSubsections [] x , not (Disp.isEmpty sectionDoc) - ] + ] ++ + [ Disp.text "" $+$ sectionDoc + | FGSectionDescr { fgSectionName, fgSectionGrammar, fgSectionGet } <- fgSectionDescrs + , (param, x) <- fgSectionGet val + , let sectionDoc = ppFgSection fgSectionName param fgSectionGrammar x + , not (Disp.isEmpty sectionDoc) + ]) -- | Unlike 'ppSection' which has to be called directly, this gets used via -- 'ppFieldsAndSections' and so does not need to be exported. -- ppSectionAndSubsections :: String -> String - -> [FieldDescr a] -> [SectionDescr a] -> a -> Disp.Doc -ppSectionAndSubsections name arg fields sections cur + -> [FieldDescr a] -> [SectionDescr a] -> [FGSectionDescr a] -> a -> Disp.Doc +ppSectionAndSubsections name arg fields sections fgSections cur | Disp.isEmpty fieldsDoc = Disp.empty | otherwise = Disp.text name <+> argDoc $+$ (Disp.nest 2 fieldsDoc) where - fieldsDoc = showConfig fields sections cur + fieldsDoc = showConfig fields sections fgSections cur argDoc | arg == "" = Disp.empty | otherwise = Disp.text arg +-- | +-- +-- TODO: subsections +-- TODO: this should simply build 'PrettyField' +ppFgSection + :: String -- ^ section name + -> String -- ^ parameter + -> FG.PrettyFieldGrammar a a + -> a + -> Disp.Doc +ppFgSection secName arg grammar x + | null prettyFields = Disp.empty + | otherwise = + Disp.text secName <+> argDoc + $+$ (Disp.nest 2 fieldsDoc) + where + prettyFields = FG.prettyFieldGrammar cabalSpecLatest grammar x + argDoc | arg == "" = Disp.empty + | otherwise = Disp.text arg + + fieldsDoc = Disp.vcat + [ Disp.text fname' <<>> Disp.colon <<>> doc + | F.PrettyField _ fname doc <- prettyFields -- TODO: this skips sections + , let fname' = fromUTF8BS fname + ] + + ----------------------------------------------- -- Top level config file parsing and printing -- @@ -265,15 +360,15 @@ -- -- It accumulates the result on top of a given initial (typically empty) value. -- -parseConfig :: [FieldDescr a] -> [SectionDescr a] -> a +parseConfig :: [FieldDescr a] -> [SectionDescr a] -> [FGSectionDescr a] -> a -> String -> ParseResult a -parseConfig fieldDescrs sectionDescrs empty str = - parseFieldsAndSections fieldDescrs sectionDescrs empty +parseConfig fieldDescrs sectionDescrs fgSectionDescrs empty str = + parseFieldsAndSections fieldDescrs sectionDescrs fgSectionDescrs empty =<< readFieldsFlat str -- | Render a value in the config file syntax, based on a description of the -- configuration file in terms of its fields and sections. -- -showConfig :: [FieldDescr a] -> [SectionDescr a] -> a -> Disp.Doc +showConfig :: [FieldDescr a] -> [SectionDescr a] -> [FGSectionDescr a] -> a -> Disp.Doc showConfig = ppFieldsAndSections diff --git a/cabal/cabal-install/Distribution/Client/ProjectBuilding.hs b/cabal/cabal-install/Distribution/Client/ProjectBuilding.hs --- a/cabal/cabal-install/Distribution/Client/ProjectBuilding.hs +++ b/cabal/cabal-install/Distribution/Client/ProjectBuilding.hs @@ -1,8 +1,11 @@ -{-# LANGUAGE CPP, BangPatterns, RecordWildCards, NamedFieldPuns, - ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE NoMonoLocalBinds #-} -{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NoMonoLocalBinds #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} -- | -- @@ -62,14 +65,14 @@ import qualified Distribution.Client.Tar as Tar import Distribution.Client.Setup ( filterConfigureFlags, filterHaddockArgs - , filterHaddockFlags ) + , filterHaddockFlags, filterTestFlags ) import Distribution.Client.SourceFiles import Distribution.Client.SrcDist (allPackageSourceFiles) import Distribution.Client.Utils ( ProgressPhase(..), progressMessage, removeExistingFile ) import Distribution.Compat.Lens -import Distribution.Package hiding (InstalledPackageId, installedPackageId) +import Distribution.Package import qualified Distribution.PackageDescription as PD import Distribution.InstalledPackageInfo (InstalledPackageInfo) import qualified Distribution.InstalledPackageInfo as Installed @@ -81,17 +84,18 @@ import qualified Distribution.Simple.Setup as Cabal import Distribution.Simple.Command (CommandUI) import qualified Distribution.Simple.Register as Cabal -import Distribution.Simple.LocalBuildInfo (ComponentName(..)) +import Distribution.Simple.LocalBuildInfo + ( ComponentName(..), LibraryName(..) ) import Distribution.Simple.Compiler ( Compiler, compilerId, PackageDB(..) ) import Distribution.Simple.Utils import Distribution.Version import Distribution.Verbosity -import Distribution.Text -import Distribution.ParseUtils ( showPWarning ) +import Distribution.Pretty import Distribution.Compat.Graph (IsNode(..)) +import qualified Data.List.NonEmpty as NE import Data.Map (Map) import qualified Data.Map as Map import Data.Set (Set) @@ -233,7 +237,8 @@ case elabBuildStyle pkg of BuildAndInstall -> return (BuildStatusUnpack tarball) BuildInplaceOnly -> do - -- TODO: [nice to have] use a proper file monitor rather than this dir exists test + -- TODO: [nice to have] use a proper file monitor rather + -- than this dir exists test exists <- doesDirectoryExist srcdir if exists then dryRunLocalPkg pkg depsBuildStatus srcdir @@ -260,7 +265,8 @@ return (BuildStatusUpToDate buildResult) where packageFileMonitor = - newPackageFileMonitor shared distDirLayout (elabDistDirParams shared pkg) + newPackageFileMonitor shared distDirLayout + (elabDistDirParams shared pkg) -- | A specialised traversal over the packages in an install plan. @@ -308,7 +314,7 @@ Just BuildStatusUpToDate {} -> True Just _ -> False Nothing -> error $ "improveInstallPlanWithUpToDatePackages: " - ++ display (packageId pkg) ++ " not in status map" + ++ prettyShow (packageId pkg) ++ " not in status map" ----------------------------- @@ -410,7 +416,8 @@ -> IO (Either BuildStatusRebuild BuildResult) checkPackageFileMonitorChanged PackageFileMonitor{..} pkg srcdir depsBuildStatus = do - --TODO: [nice to have] some debug-level message about file changes, like rerunIfChanged + --TODO: [nice to have] some debug-level message about file + --changes, like rerunIfChanged configChanged <- checkFileMonitorChanged pkgFileMonitorConfig srcdir pkgconfig case configChanged of @@ -685,7 +692,8 @@ unpackTarballPhase tarball = withTarballLocalDirectory verbosity distDirLayout tarball - (packageId pkg) (elabDistDirParams sharedPackageConfig pkg) (elabBuildStyle pkg) + (packageId pkg) (elabDistDirParams sharedPackageConfig pkg) + (elabBuildStyle pkg) (elabPkgDescriptionOverride pkg) $ case elabBuildStyle pkg of @@ -703,7 +711,8 @@ buildInplace buildStatus srcdir builddir where - builddir = distBuildDirectory (elabDistDirParams sharedPackageConfig pkg) + builddir = distBuildDirectory + (elabDistDirParams sharedPackageConfig pkg) buildAndInstall srcdir builddir = buildAndInstallUnpackedPackage @@ -822,7 +831,7 @@ withTempDirectory verbosity tmpdir "src" $ \unpackdir -> do unpackPackageTarball verbosity tarball unpackdir pkgid pkgTextOverride - let srcdir = unpackdir display pkgid + let srcdir = unpackdir prettyShow pkgid builddir = srcdir "dist" buildPkg srcdir builddir @@ -833,7 +842,8 @@ let srcrootdir = distUnpackedSrcRootDirectory srcdir = distUnpackedSrcDirectory pkgid builddir = distBuildDirectory dparams - -- TODO: [nice to have] use a proper file monitor rather than this dir exists test + -- TODO: [nice to have] use a proper file monitor rather + -- than this dir exists test exists <- doesDirectoryExist srcdir unless exists $ do createDirectoryIfMissingVerbose verbosity True srcrootdir @@ -860,21 +870,22 @@ -- exists <- doesFileExist cabalFile unless exists $ - die' verbosity $ "Package .cabal file not found in the tarball: " ++ cabalFile + die' verbosity $ + "Package .cabal file not found in the tarball: " ++ cabalFile -- Overwrite the .cabal with the one from the index, when appropriate -- case pkgTextOverride of Nothing -> return () Just pkgtxt -> do - info verbosity $ "Updating " ++ display pkgname <.> "cabal" + info verbosity $ "Updating " ++ prettyShow pkgname <.> "cabal" ++ " with the latest revision from the index." writeFileAtomic cabalFile pkgtxt where cabalFile = parentdir pkgsubdir - display pkgname <.> "cabal" - pkgsubdir = display pkgid + prettyShow pkgname <.> "cabal" + pkgsubdir = prettyShow pkgid pkgname = packageName pkgid @@ -886,7 +897,8 @@ -- system, though we'll still need to keep this hack for older packages. -- moveTarballShippedDistDirectory :: Verbosity -> DistDirLayout - -> FilePath -> PackageId -> DistDirParams -> IO () + -> FilePath -> PackageId -> DistDirParams + -> IO () moveTarballShippedDistDirectory verbosity DistDirLayout{distBuildDirectory} parentdir pkgid dparams = do distDirExists <- doesDirectoryExist tarballDistDir @@ -896,7 +908,7 @@ --TODO: [nice to have] or perhaps better to copy, and use a file monitor renameDirectory tarballDistDir targetDistDir where - tarballDistDir = parentdir display pkgid "dist" + tarballDistDir = parentdir prettyShow pkgid "dist" targetDistDir = distBuildDirectory dparams @@ -927,15 +939,16 @@ plan rpkg@(ReadyPackage pkg) srcdir builddir = do - createDirectoryIfMissingVerbose verbosity True builddir + createDirectoryIfMissingVerbose verbosity True (srcdir builddir) initLogFile - --TODO: [code cleanup] deal consistently with talking to older Setup.hs versions, much like - -- we do for ghc, with a proper options type and rendering step - -- which will also let us call directly into the lib, rather than always - -- going via the lib's command line interface, which would also allow - -- passing data like installed packages, compiler, and program db for a - -- quicker configure. + --TODO: [code cleanup] deal consistently with talking to older + -- Setup.hs versions, much like we do for ghc, with a proper + -- options type and rendering step which will also let us + -- call directly into the lib, rather than always going via + -- the lib's command line interface, which would also allow + -- passing data like installed packages, compiler, and + -- program db for a quicker configure. --TODO: [required feature] docs and tests --TODO: [required feature] sudo re-exec @@ -968,21 +981,28 @@ -- Note that the copy command has put the files into -- @$tmpDir/$prefix@ so we need to return this dir so -- the store knows which dir will be the final store entry. - let prefix = normalise $ dropDrive (InstallDirs.prefix (elabInstallDirs pkg)) + let prefix = normalise $ + dropDrive (InstallDirs.prefix (elabInstallDirs pkg)) entryDir = tmpDirNormalised prefix LBS.writeFile (entryDir "cabal-hash.txt") (renderPackageHashInputs (packageHashInputs pkgshared pkg)) - -- Ensure that there are no files in `tmpDir`, that are not in `entryDir` - -- While this breaks the prefix-relocatable property of the lirbaries - -- it is necessary on macOS to stay under the load command limit of the - -- macOS mach-o linker. See also @PackageHash.hashedInstalledPackageIdVeryShort@. - -- We also normalise paths to ensure that there are no different representations - -- for the same path. Like / and \\ on windows under msys. - otherFiles <- filter (not . isPrefixOf entryDir) <$> listFilesRecursive tmpDirNormalised - -- here's where we could keep track of the installed files ourselves - -- if we wanted to by making a manifest of the files in the tmp dir + -- Ensure that there are no files in `tmpDir`, that are + -- not in `entryDir`. While this breaks the + -- prefix-relocatable property of the libraries, it is + -- necessary on macOS to stay under the load command limit + -- of the macOS mach-o linker. See also + -- @PackageHash.hashedInstalledPackageIdVeryShort@. + -- + -- We also normalise paths to ensure that there are no + -- different representations for the same path. Like / and + -- \\ on windows under msys. + otherFiles <- filter (not . isPrefixOf entryDir) <$> + listFilesRecursive tmpDirNormalised + -- Here's where we could keep track of the installed files + -- ourselves if we wanted to by making a manifest of the + -- files in the tmp dir. return (entryDir, otherFiles) where listFilesRecursive :: FilePath -> IO [FilePath] @@ -998,7 +1018,8 @@ registerPkg | not (elabRequiresRegistration pkg) = debug verbosity $ - "registerPkg: elab does NOT require registration for " ++ display uid + "registerPkg: elab does NOT require registration for " + ++ prettyShow uid | otherwise = do -- We register ourselves rather than via Setup.hs. We need to -- grab and modify the InstalledPackageInfo. We decide what @@ -1027,8 +1048,9 @@ -- final location ourselves, perhaps we ought to do some sanity checks on -- the image dir first. - -- TODO: [required eventually] note that for nix-style installations it is not necessary to do - -- the 'withWin32SelfUpgrade' dance, but it would be necessary for a + -- TODO: [required eventually] note that for nix-style + -- installations it is not necessary to do the + -- 'withWin32SelfUpgrade' dance, but it would be necessary for a -- shared bin dir. --TODO: [required feature] docs and test phases @@ -1049,10 +1071,10 @@ compid = compilerId compiler dispname = case elabPkgOrComp pkg of - ElabPackage _ -> display pkgid + ElabPackage _ -> prettyShow pkgid ++ " (all, legacy fallback)" - ElabComponent comp -> display pkgid - ++ " (" ++ maybe "custom" display (compComponentName comp) ++ ")" + ElabComponent comp -> prettyShow pkgid + ++ " (" ++ maybe "custom" prettyShow (compComponentName comp) ++ ")" noticeProgress phase = when isParallelBuild $ progressMessage verbosity phase dispname @@ -1096,14 +1118,16 @@ setup :: CommandUI flags -> (Version -> flags) -> IO () setup cmd flags = setup' cmd flags (const []) - setup' :: CommandUI flags -> (Version -> flags) -> (Version -> [String]) -> IO () + setup' :: CommandUI flags -> (Version -> flags) -> (Version -> [String]) + -> IO () setup' cmd flags args = withLogging $ \mLogFileHandle -> setupWrapper verbosity scriptOptions { useLoggingHandle = mLogFileHandle - , useExtraEnvOverrides = dataDirsEnvironmentForPlan distDirLayout plan } + , useExtraEnvOverrides = dataDirsEnvironmentForPlan + distDirLayout plan } (Just (elabPkgDescription pkg)) cmd flags args @@ -1138,12 +1162,12 @@ componentHasHaddocks :: ComponentTarget -> Bool componentHasHaddocks (ComponentTarget name _) = case name of - CLibName -> hasHaddocks - CSubLibName _ -> elabHaddockInternal && hasHaddocks - CFLibName _ -> elabHaddockForeignLibs && hasHaddocks - CExeName _ -> elabHaddockExecutables && hasHaddocks - CTestName _ -> elabHaddockTestSuites && hasHaddocks - CBenchName _ -> elabHaddockBenchmarks && hasHaddocks + CLibName LMainLibName -> hasHaddocks + CLibName (LSubLibName _) -> elabHaddockInternal && hasHaddocks + CFLibName _ -> elabHaddockForeignLibs && hasHaddocks + CExeName _ -> elabHaddockExecutables && hasHaddocks + CTestName _ -> elabHaddockTestSuites && hasHaddocks + CBenchName _ -> elabHaddockBenchmarks && hasHaddocks where hasHaddocks = not (null (elabPkgDescription ^. componentModules name)) @@ -1174,10 +1198,12 @@ buildStatus srcdir builddir = do - --TODO: [code cleanup] there is duplication between the distdirlayout and the builddir here - -- builddir is not enough, we also need the per-package cachedir + --TODO: [code cleanup] there is duplication between the + -- distdirlayout and the builddir here builddir is not + -- enough, we also need the per-package cachedir createDirectoryIfMissingVerbose verbosity True builddir - createDirectoryIfMissingVerbose verbosity True (distPackageCacheDirectory dparams) + createDirectoryIfMissingVerbose verbosity True + (distPackageCacheDirectory dparams) -- Configure phase -- @@ -1276,7 +1302,8 @@ when (haddockTarget == Cabal.ForHackage) $ do let dest = distDirectory name <.> "tar.gz" name = haddockDirName haddockTarget (elabPkgDescription pkg) - docDir = distBuildDirectory distDirLayout dparams "doc" "html" + docDir = distBuildDirectory distDirLayout dparams + "doc" "html" Tar.createTarGzFile dest docDir name notice verbosity $ "Documentation tarball created: " ++ dest @@ -1324,9 +1351,11 @@ whenReRegister action = case buildStatus of -- We registered the package already - BuildStatusBuild (Just _) _ -> info verbosity "whenReRegister: previously registered" + BuildStatusBuild (Just _) _ -> + info verbosity "whenReRegister: previously registered" -- There is nothing to register - _ | null (elabBuildTargets pkg) -> info verbosity "whenReRegister: nothing to register" + _ | null (elabBuildTargets pkg) -> + info verbosity "whenReRegister: nothing to register" | otherwise -> action configureCommand = Cabal.configureCommand defaultProgramDb @@ -1341,7 +1370,8 @@ buildArgs _ = setupHsBuildArgs pkg testCommand = Cabal.testCommand -- defaultProgramDb - testFlags _ = setupHsTestFlags pkg pkgshared + testFlags v = flip filterTestFlags v $ + setupHsTestFlags pkg pkgshared verbosity builddir testArgs _ = setupHsTestArgs pkg @@ -1374,7 +1404,8 @@ (Just (elabPkgDescription pkg)) cmd flags args - setup :: CommandUI flags -> (Version -> flags) -> (Version -> [String]) -> IO () + setup :: CommandUI flags -> (Version -> flags) -> (Version -> [String]) + -> IO () setup cmd flags args = setupWrapper verbosity scriptOptions @@ -1404,19 +1435,21 @@ readPkgConf "." pkgConfDest where - pkgConfParseFailed :: Installed.PError -> IO a + pkgConfParseFailed :: String -> IO a pkgConfParseFailed perror = - die' verbosity $ "Couldn't parse the output of 'setup register --gen-pkg-config':" - ++ show perror + die' verbosity $ + "Couldn't parse the output of 'setup register --gen-pkg-config':" + ++ show perror readPkgConf pkgConfDir pkgConfFile = do - (warns, ipkg) <- withUTF8FileContents (pkgConfDir pkgConfFile) $ \pkgConfStr -> + (warns, ipkg) <- + withUTF8FileContents (pkgConfDir pkgConfFile) $ \pkgConfStr -> case Installed.parseInstalledPackageInfo pkgConfStr of - Installed.ParseFailed perror -> pkgConfParseFailed perror - Installed.ParseOk warns ipkg -> return (warns, ipkg) + Left perrors -> pkgConfParseFailed $ unlines $ NE.toList perrors + Right (warns, ipkg) -> return (warns, ipkg) unless (null warns) $ - warn verbosity $ unlines (map (showPWarning pkgConfFile) warns) + warn verbosity $ unlines warns return ipkg diff --git a/cabal/cabal-install/Distribution/Client/ProjectConfig.hs b/cabal/cabal-install/Distribution/Client/ProjectConfig.hs --- a/cabal/cabal-install/Distribution/Client/ProjectConfig.hs +++ b/cabal/cabal-install/Distribution/Client/ProjectConfig.hs @@ -1,4 +1,9 @@ -{-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns, DeriveDataTypeable, LambdaCase #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} -- | Handling project configuration. -- @@ -74,6 +79,7 @@ import Distribution.Client.HttpUtils ( HttpTransport, configureTransport, transportCheckHttps , downloadURI ) +import Distribution.Client.Utils.Parsec (renderParseError) import Distribution.Solver.Types.SourcePackage import Distribution.Solver.Types.Settings @@ -82,17 +88,17 @@ import Distribution.Package ( PackageName, PackageId, packageId, UnitId ) -import Distribution.Types.Dependency +import Distribution.Types.PackageVersionConstraint + ( PackageVersionConstraint(..) ) import Distribution.System ( Platform ) import Distribution.Types.GenericPackageDescription ( GenericPackageDescription ) import Distribution.PackageDescription.Parsec ( parseGenericPackageDescription ) -import Distribution.Parsec.ParseResult - ( runParseResult ) -import Distribution.Parsec.Common as NewParser - ( PError, PWarning, showPWarning ) +import Distribution.Fields + ( runParseResult, PError, PWarning, showPWarning) +import Distribution.Pretty () import Distribution.Types.SourceRepo ( SourceRepo(..), RepoType(..), ) import Distribution.Simple.Compiler @@ -117,8 +123,8 @@ ( Verbosity, modifyVerbosity, verbose ) import Distribution.Version ( Version ) -import Distribution.Text -import Distribution.ParseUtils as OldParser +import Distribution.Deprecated.Text +import qualified Distribution.Deprecated.ParseUtils as OldParser ( ParseResult(..), locatedErrorMsg, showPWarning ) import qualified Codec.Archive.Tar as Tar @@ -130,8 +136,8 @@ import Control.Monad.Trans (liftIO) import Control.Exception import Data.Either -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as LBS +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS import qualified Data.Map as Map import Data.Set (Set) import qualified Data.Set as Set @@ -154,10 +160,10 @@ -- 'PackageName'. This returns the configuration that applies to all local -- packages plus any package-specific configuration for this package. -- -lookupLocalPackageConfig :: (Semigroup a, Monoid a) - => (PackageConfig -> a) - -> ProjectConfig - -> PackageName -> a +lookupLocalPackageConfig + :: (Semigroup a, Monoid a) + => (PackageConfig -> a) -> ProjectConfig -> PackageName + -> a lookupLocalPackageConfig field ProjectConfig { projectConfigLocalPackages, projectConfigSpecificPackage @@ -188,10 +194,10 @@ -- that doesn't have an http transport. And that avoids having to have access -- to the 'BuildTimeSettings' -- -projectConfigWithSolverRepoContext :: Verbosity - -> ProjectConfigShared - -> ProjectConfigBuildOnly - -> (RepoContext -> IO a) -> IO a +projectConfigWithSolverRepoContext + :: Verbosity -> ProjectConfigShared -> ProjectConfigBuildOnly + -> (RepoContext -> IO a) + -> IO a projectConfigWithSolverRepoContext verbosity ProjectConfigShared{..} ProjectConfigBuildOnly{..} = @@ -199,8 +205,10 @@ verbosity (fromNubList projectConfigRemoteRepos) (fromNubList projectConfigLocalRepos) - (fromFlagOrDefault (error "projectConfigWithSolverRepoContext: projectConfigCacheDir") - projectConfigCacheDir) + (fromFlagOrDefault + (error + "projectConfigWithSolverRepoContext: projectConfigCacheDir") + projectConfigCacheDir) (flagToMaybe projectConfigHttpTransport) (flagToMaybe projectConfigIgnoreExpiry) (fromNubList projectConfigProgPathExtra) @@ -235,8 +243,10 @@ | otherwise -> Just n solverSettingReorderGoals = fromFlag projectConfigReorderGoals solverSettingCountConflicts = fromFlag projectConfigCountConflicts + solverSettingMinimizeConflictSet = fromFlag projectConfigMinimizeConflictSet solverSettingStrongFlags = fromFlag projectConfigStrongFlags solverSettingAllowBootLibInstalls = fromFlag projectConfigAllowBootLibInstalls + solverSettingOnlyConstrained = fromFlag projectConfigOnlyConstrained solverSettingIndexState = flagToMaybe projectConfigIndexState solverSettingIndependentGoals = fromFlag projectConfigIndependentGoals --solverSettingShadowPkgs = fromFlag projectConfigShadowPkgs @@ -254,8 +264,10 @@ projectConfigMaxBackjumps = Flag defaultMaxBackjumps, projectConfigReorderGoals = Flag (ReorderGoals False), projectConfigCountConflicts = Flag (CountConflicts True), + projectConfigMinimizeConflictSet = Flag (MinimizeConflictSet False), projectConfigStrongFlags = Flag (StrongFlags False), projectConfigAllowBootLibInstalls = Flag (AllowBootLibInstalls False), + projectConfigOnlyConstrained = Flag OnlyConstrainedNone, projectConfigIndependentGoals = Flag (IndependentGoals False) --projectConfigShadowPkgs = Flag False, --projectConfigReinstall = Flag False, @@ -439,7 +451,7 @@ renderBadProjectRoot (BadProjectRootExplicitFile projectFile) = "The given project file '" ++ projectFile ++ "' does not exist." -withProjectOrGlobalConfig :: Verbosity +withProjectOrGlobalConfig :: Verbosity -> Flag FilePath -> IO a -> (ProjectConfig -> IO a) @@ -450,9 +462,9 @@ let res' = catch with $ \case - (BadPackageLocations prov locs) + (BadPackageLocations prov locs) | prov == Set.singleton Implicit - , let + , let isGlobErr (BadLocGlobEmptyMatch _) = True isGlobErr _ = False , any isGlobErr locs -> @@ -564,7 +576,7 @@ -- For the moment this is implemented in terms of parsers for legacy -- configuration types, plus a conversion. -- -parseProjectConfig :: String -> ParseResult ProjectConfig +parseProjectConfig :: String -> OldParser.ParseResult ProjectConfig parseProjectConfig content = convertLegacyProjectConfig <$> parseLegacyProjectConfig content @@ -610,14 +622,14 @@ monitorFiles [monitorFileHashed configFile] return (convertLegacyGlobalConfig config) -reportParseResult :: Verbosity -> String -> FilePath -> ParseResult a -> IO a -reportParseResult verbosity _filetype filename (ParseOk warnings x) = do +reportParseResult :: Verbosity -> String -> FilePath -> OldParser.ParseResult a -> IO a +reportParseResult verbosity _filetype filename (OldParser.ParseOk warnings x) = do unless (null warnings) $ let msg = unlines (map (OldParser.showPWarning filename) warnings) in warn verbosity msg return x -reportParseResult verbosity filetype filename (ParseFailed err) = - let (line, msg) = locatedErrorMsg err +reportParseResult verbosity filetype filename (OldParser.ParseFailed err) = + let (line, msg) = OldParser.locatedErrorMsg err in die' verbosity $ "Error parsing " ++ filetype ++ " " ++ filename ++ maybe "" (\n -> ':' : show n) line ++ ":\n" ++ msg @@ -636,7 +648,7 @@ | ProjectPackageLocalTarball FilePath | ProjectPackageRemoteTarball URI | ProjectPackageRemoteRepo SourceRepo - | ProjectPackageNamed Dependency + | ProjectPackageNamed PackageVersionConstraint deriving Show @@ -990,7 +1002,7 @@ let pkgsNamed = [ NamedPackage pkgname [PackagePropertyVersion verrange] - | ProjectPackageNamed (Dependency pkgname verrange) <- pkgLocations ] + | ProjectPackageNamed (PackageVersionConstraint pkgname verrange) <- pkgLocations ] return $ concat [ pkgsLocalDirectory @@ -1177,8 +1189,8 @@ entries <- liftIO $ getDirectoryContents packageDir --TODO: wrap exceptions case filter (\e -> takeExtension e == ".cabal") entries of - [] -> liftIO $ throwIO NoCabalFileFound - (_:_:_) -> liftIO $ throwIO MultipleCabalFilesFound + [] -> liftIO $ throwIO $ NoCabalFileFound packageDir + (_:_:_) -> liftIO $ throwIO $ MultipleCabalFilesFound packageDir [cabalFileName] -> do monitorFiles [monitorFileHashed cabalFilePath] liftIO $ fmap (mkSpecificSourcePackage location) @@ -1216,16 +1228,33 @@ -- | Errors reported upon failing to parse a @.cabal@ file. -- -data CabalFileParseError = - CabalFileParseError - FilePath - [PError] - (Maybe Version) -- We might discover the spec version the package needs - [PWarning] - deriving (Show, Typeable) +data CabalFileParseError = CabalFileParseError + FilePath -- ^ @.cabal@ file path + BS.ByteString -- ^ @.cabal@ file contents + (NonEmpty PError) -- ^ errors + (Maybe Version) -- ^ We might discover the spec version the package needs + [PWarning] -- ^ warnings + deriving (Typeable) +-- | Manual instance which skips file contentes +instance Show CabalFileParseError where + showsPrec d (CabalFileParseError fp _ es mv ws) = showParen (d > 10) + $ showString "CabalFileParseError" + . showChar ' ' . showsPrec 11 fp + . showChar ' ' . showsPrec 11 ("" :: String) + . showChar ' ' . showsPrec 11 es + . showChar ' ' . showsPrec 11 mv + . showChar ' ' . showsPrec 11 ws + instance Exception CabalFileParseError +#if MIN_VERSION_base(4,8,0) + where + displayException = renderCabalFileParseError +#endif +renderCabalFileParseError :: CabalFileParseError -> String +renderCabalFileParseError (CabalFileParseError filePath contents errors _ warnings) = + renderParseError filePath contents errors warnings -- | Wrapper for the @.cabal@ file parser. It reports warnings on higher -- verbosity levels and throws 'CabalFileParseError' on failure. @@ -1242,20 +1271,20 @@ return pkg (warnings, Left (mspecVersion, errors)) -> - throwIO $ CabalFileParseError pkgfilename errors mspecVersion warnings + throwIO $ CabalFileParseError pkgfilename content errors mspecVersion warnings where formatWarnings warnings = "The package description file " ++ pkgfilename ++ " has warnings: " - ++ unlines (map (NewParser.showPWarning pkgfilename) warnings) + ++ unlines (map (showPWarning pkgfilename) warnings) -- | When looking for a package's @.cabal@ file we can find none, or several, -- both of which are failures. -- -data CabalFileSearchFailure = - NoCabalFileFound - | MultipleCabalFilesFound +data CabalFileSearchFailure + = NoCabalFileFound FilePath + | MultipleCabalFilesFound FilePath deriving (Show, Typeable) instance Exception CabalFileSearchFailure @@ -1269,7 +1298,7 @@ extractTarballPackageCabalFile tarballFile = withBinaryFile tarballFile ReadMode $ \hnd -> do content <- LBS.hGetContents hnd - case extractTarballPackageCabalFilePure content of + case extractTarballPackageCabalFilePure tarballFile content of Left (Left e) -> throwIO e Left (Right e) -> throwIO e Right (fileName, fileContent) -> @@ -1278,11 +1307,12 @@ -- | Scan through a tar file stream and collect the @.cabal@ file, or fail. -- -extractTarballPackageCabalFilePure :: LBS.ByteString +extractTarballPackageCabalFilePure :: FilePath + -> LBS.ByteString -> Either (Either Tar.FormatError CabalFileSearchFailure) (FilePath, LBS.ByteString) -extractTarballPackageCabalFilePure = +extractTarballPackageCabalFilePure tarballFile = check . accumEntryMap . Tar.filterEntries isCabalFile @@ -1295,11 +1325,11 @@ check (Left (e, _m)) = Left (Left e) check (Right m) = case Map.elems m of - [] -> Left (Right NoCabalFileFound) + [] -> Left (Right $ NoCabalFileFound tarballFile) [file] -> case Tar.entryContent file of Tar.NormalFile content _ -> Right (Tar.entryPath file, content) - _ -> Left (Right NoCabalFileFound) - _files -> Left (Right MultipleCabalFilesFound) + _ -> Left (Right $ NoCabalFileFound tarballFile) + _files -> Left (Right $ MultipleCabalFilesFound tarballFile) isCabalFile e = case splitPath (Tar.entryPath e) of [ _dir, file] -> takeExtension file == ".cabal" diff --git a/cabal/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs b/cabal/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs --- a/cabal/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs @@ -23,6 +23,8 @@ import Prelude () import Distribution.Client.Compat.Prelude +import Distribution.Deprecated.ParseUtils (parseFlagAssignment) + import Distribution.Client.ProjectConfig.Types import Distribution.Client.Types ( RemoteRepo(..), emptyRemoteRepo @@ -31,14 +33,17 @@ import Distribution.Client.Config ( SavedConfig(..), remoteRepoFields ) +import Distribution.Client.CmdInstall.ClientInstallFlags + ( ClientInstallFlags(..), defaultClientInstallFlags + , clientInstallOptions ) + import Distribution.Solver.Types.ConstraintSource import Distribution.Package import Distribution.PackageDescription ( SourceRepo(..), RepoKind(..) - , dispFlagAssignment, parseFlagAssignment ) -import Distribution.Client.SourceRepoParse - ( sourceRepoFieldDescrs ) + , dispFlagAssignment ) +import Distribution.PackageDescription.FieldGrammar (sourceRepoFieldGrammar) import Distribution.Simple.Compiler ( OptimisationLevel(..), DebugInfoLevel(..) ) import Distribution.Simple.InstallDirs ( CopyDest (NoCopyDest) ) @@ -46,6 +51,7 @@ ( Flag(Flag), toFlag, fromFlagOrDefault , ConfigFlags(..), configureOptions , HaddockFlags(..), haddockOptions, defaultHaddockFlags + , TestFlags(..), testOptions', defaultTestFlags , programDbPaths', splitArgs ) import Distribution.Client.Setup @@ -63,23 +69,24 @@ import Distribution.Simple.LocalBuildInfo ( toPathTemplate, fromPathTemplate ) -import Distribution.Text -import qualified Distribution.Compat.ReadP as Parse -import Distribution.Compat.ReadP - ( ReadP, (+++), (<++) ) -import qualified Text.Read as Read +import Distribution.Deprecated.Text +import qualified Distribution.Deprecated.ReadP as Parse +import Distribution.Deprecated.ReadP + ( ReadP, (+++) ) import qualified Text.PrettyPrint as Disp import Text.PrettyPrint ( Doc, ($+$) ) -import qualified Distribution.ParseUtils as ParseUtils (field) -import Distribution.ParseUtils +import qualified Distribution.Deprecated.ParseUtils as ParseUtils (field) +import Distribution.Deprecated.ParseUtils ( ParseResult(..), PError(..), syntaxError, PWarning(..), warning - , simpleField, commaNewLineListField - , showToken ) + , simpleField, commaNewLineListField, newLineListField, parseTokenQ + , parseHaskellString, showToken ) import Distribution.Client.ParseUtils import Distribution.Simple.Command ( CommandUI(commandOptions), ShowOrParseArgs(..) , OptionField, option, reqArg' ) +import Distribution.Types.PackageVersionConstraint + ( PackageVersionConstraint ) import qualified Data.Map as Map ------------------------------------------------------------------ @@ -99,7 +106,7 @@ legacyPackages :: [String], legacyPackagesOptional :: [String], legacyPackagesRepo :: [SourceRepo], - legacyPackagesNamed :: [Dependency], + legacyPackagesNamed :: [PackageVersionConstraint], legacySharedConfig :: LegacySharedConfig, legacyAllConfig :: LegacyPackageConfig, @@ -117,7 +124,8 @@ data LegacyPackageConfig = LegacyPackageConfig { legacyConfigureFlags :: ConfigFlags, legacyInstallPkgFlags :: InstallFlags, - legacyHaddockFlags :: HaddockFlags + legacyHaddockFlags :: HaddockFlags, + legacyTestFlags :: TestFlags } deriving Generic instance Monoid LegacyPackageConfig where @@ -131,7 +139,8 @@ legacyGlobalFlags :: GlobalFlags, legacyConfigureShFlags :: ConfigFlags, legacyConfigureExFlags :: ConfigExFlags, - legacyInstallFlags :: InstallFlags + legacyInstallFlags :: InstallFlags, + legacyClientInstallFlags:: ClientInstallFlags } deriving Generic instance Monoid LegacySharedConfig where @@ -155,14 +164,18 @@ -- commandLineFlagsToProjectConfig :: GlobalFlags -> ConfigFlags -> ConfigExFlags - -> InstallFlags -> HaddockFlags + -> InstallFlags -> ClientInstallFlags + -> HaddockFlags + -> TestFlags -> ProjectConfig commandLineFlagsToProjectConfig globalFlags configFlags configExFlags - installFlags haddockFlags = + installFlags clientInstallFlags + haddockFlags testFlags = mempty { projectConfigBuildOnly = convertLegacyBuildOnlyFlags globalFlags configFlags - installFlags haddockFlags, + installFlags clientInstallFlags + haddockFlags testFlags, projectConfigShared = convertLegacyAllPackageFlags globalFlags configFlags configExFlags installFlags, @@ -171,7 +184,7 @@ } where (localConfig, allConfig) = splitConfig (convertLegacyPerPackageFlags - configFlags installFlags haddockFlags) + configFlags installFlags haddockFlags testFlags) -- split the package config (from command line arguments) into -- those applied to all packages and those to local only. -- @@ -209,13 +222,15 @@ SavedConfig { savedGlobalFlags = globalFlags, savedInstallFlags = installFlags, + savedClientInstallFlags= clientInstallFlags, savedConfigureFlags = configFlags, savedConfigureExFlags = configExFlags, savedUserInstallDirs = _, savedGlobalInstallDirs = _, savedUploadFlags = _, savedReportFlags = _, - savedHaddockFlags = haddockFlags + savedHaddockFlags = haddockFlags, + savedTestFlags = testFlags } = mempty { projectConfigBuildOnly = configBuildOnly, @@ -225,18 +240,21 @@ where --TODO: [code cleanup] eliminate use of default*Flags here and specify the -- defaults in the various resolve functions in terms of the new types. - configExFlags' = defaultConfigExFlags <> configExFlags - installFlags' = defaultInstallFlags <> installFlags - haddockFlags' = defaultHaddockFlags <> haddockFlags + configExFlags' = defaultConfigExFlags <> configExFlags + installFlags' = defaultInstallFlags <> installFlags + clientInstallFlags' = defaultClientInstallFlags <> clientInstallFlags + haddockFlags' = defaultHaddockFlags <> haddockFlags + testFlags' = defaultTestFlags <> testFlags configAllPackages = convertLegacyPerPackageFlags - configFlags installFlags' haddockFlags' + configFlags installFlags' haddockFlags' testFlags' configShared = convertLegacyAllPackageFlags globalFlags configFlags configExFlags' installFlags' configBuildOnly = convertLegacyBuildOnlyFlags globalFlags configFlags - installFlags' haddockFlags' + installFlags' clientInstallFlags' + haddockFlags' testFlags' -- | Convert the project config from the legacy types to the 'ProjectConfig' @@ -251,10 +269,11 @@ legacyPackagesRepo, legacyPackagesNamed, legacySharedConfig = LegacySharedConfig globalFlags configShFlags - configExFlags installSharedFlags, + configExFlags installSharedFlags + clientInstallFlags, legacyAllConfig, legacyLocalConfig = LegacyPackageConfig configFlags installPerPkgFlags - haddockFlags, + haddockFlags testFlags, legacySpecificConfig } = @@ -272,21 +291,23 @@ projectConfigSpecificPackage = fmap perPackage legacySpecificConfig } where - configAllPackages = convertLegacyPerPackageFlags g i h - where LegacyPackageConfig g i h = legacyAllConfig + configAllPackages = convertLegacyPerPackageFlags g i h t + where LegacyPackageConfig g i h t = legacyAllConfig configLocalPackages = convertLegacyPerPackageFlags configFlags installPerPkgFlags haddockFlags + testFlags configPackagesShared= convertLegacyAllPackageFlags globalFlags (configFlags <> configShFlags) configExFlags installSharedFlags configBuildOnly = convertLegacyBuildOnlyFlags globalFlags configShFlags - installSharedFlags haddockFlags + installSharedFlags clientInstallFlags + haddockFlags testFlags perPackage (LegacyPackageConfig perPkgConfigFlags perPkgInstallFlags - perPkgHaddockFlags) = + perPkgHaddockFlags perPkgTestFlags) = convertLegacyPerPackageFlags - perPkgConfigFlags perPkgInstallFlags perPkgHaddockFlags + perPkgConfigFlags perPkgInstallFlags perPkgHaddockFlags perPkgTestFlags -- | Helper used by other conversion functions that returns the @@ -341,11 +362,13 @@ --installUpgradeDeps = projectConfigUpgradeDeps, installReorderGoals = projectConfigReorderGoals, installCountConflicts = projectConfigCountConflicts, + installMinimizeConflictSet = projectConfigMinimizeConflictSet, installPerComponent = projectConfigPerComponent, installIndependentGoals = projectConfigIndependentGoals, --installShadowPkgs = projectConfigShadowPkgs, installStrongFlags = projectConfigStrongFlags, - installAllowBootLibInstalls = projectConfigAllowBootLibInstalls + installAllowBootLibInstalls = projectConfigAllowBootLibInstalls, + installOnlyConstrained = projectConfigOnlyConstrained } = installFlags @@ -354,8 +377,8 @@ -- 'PackageConfig' subset of the 'ProjectConfig'. -- convertLegacyPerPackageFlags :: ConfigFlags -> InstallFlags -> HaddockFlags - -> PackageConfig -convertLegacyPerPackageFlags configFlags installFlags haddockFlags = + -> TestFlags -> PackageConfig +convertLegacyPerPackageFlags configFlags installFlags haddockFlags testFlags = PackageConfig{..} where ConfigFlags { @@ -367,6 +390,7 @@ configSharedLib = packageConfigSharedLib, configStaticLib = packageConfigStaticLib, configDynExe = packageConfigDynExe, + configFullyStaticExe = packageConfigFullyStaticExe, configProfExe = packageConfigProfExe, configProf = packageConfigProf, configProfDetail = packageConfigProfDetail, @@ -419,18 +443,31 @@ haddockContents = packageConfigHaddockContents } = haddockFlags + TestFlags { + testHumanLog = packageConfigTestHumanLog, + testMachineLog = packageConfigTestMachineLog, + testShowDetails = packageConfigTestShowDetails, + testKeepTix = packageConfigTestKeepTix, + testWrapper = packageConfigTestWrapper, + testFailWhenNoTestSuites = packageConfigTestFailWhenNoTestSuites, + testOptions = packageConfigTestTestOptions + } = testFlags + -- | Helper used by other conversion functions that returns the -- 'ProjectConfigBuildOnly' subset of the 'ProjectConfig'. -- convertLegacyBuildOnlyFlags :: GlobalFlags -> ConfigFlags - -> InstallFlags -> HaddockFlags + -> InstallFlags -> ClientInstallFlags + -> HaddockFlags -> TestFlags -> ProjectConfigBuildOnly convertLegacyBuildOnlyFlags globalFlags configFlags - installFlags haddockFlags = + installFlags clientInstallFlags + haddockFlags _ = ProjectConfigBuildOnly{..} where + projectConfigClientInstallFlags = clientInstallFlags GlobalFlags { globalCacheDir = projectConfigCacheDir, globalLogsDir = projectConfigLogsDir, @@ -504,7 +541,8 @@ legacyGlobalFlags = globalFlags, legacyConfigureShFlags = configFlags, legacyConfigureExFlags = configExFlags, - legacyInstallFlags = installFlags + legacyInstallFlags = installFlags, + legacyClientInstallFlags = projectConfigClientInstallFlags } where globalFlags = GlobalFlags { @@ -555,10 +593,12 @@ installUpgradeDeps = mempty, --projectConfigUpgradeDeps, installReorderGoals = projectConfigReorderGoals, installCountConflicts = projectConfigCountConflicts, + installMinimizeConflictSet = projectConfigMinimizeConflictSet, installIndependentGoals = projectConfigIndependentGoals, installShadowPkgs = mempty, --projectConfigShadowPkgs, installStrongFlags = projectConfigStrongFlags, installAllowBootLibInstalls = projectConfigAllowBootLibInstalls, + installOnlyConstrained = projectConfigOnlyConstrained, installOnly = mempty, installOnlyDeps = projectConfigOnlyDeps, installIndexState = projectConfigIndexState, @@ -588,7 +628,8 @@ LegacyPackageConfig { legacyConfigureFlags = configFlags, legacyInstallPkgFlags= mempty, - legacyHaddockFlags = haddockFlags + legacyHaddockFlags = haddockFlags, + legacyTestFlags = mempty } where configFlags = ConfigFlags { @@ -606,6 +647,7 @@ configSharedLib = mempty, configStaticLib = mempty, configDynExe = mempty, + configFullyStaticExe = mempty, configProfExe = mempty, configProf = mempty, configProfDetail = mempty, @@ -643,7 +685,8 @@ configFlagError = mempty, --TODO: ??? configRelocatable = mempty, configDebugInfo = mempty, - configUseResponseFiles = mempty + configUseResponseFiles = mempty, + configAllowDependingOnPrivateLibs = mempty } haddockFlags = mempty { @@ -656,7 +699,8 @@ LegacyPackageConfig { legacyConfigureFlags = configFlags, legacyInstallPkgFlags = installFlags, - legacyHaddockFlags = haddockFlags + legacyHaddockFlags = haddockFlags, + legacyTestFlags = testFlags } where configFlags = ConfigFlags { @@ -674,6 +718,7 @@ configSharedLib = packageConfigSharedLib, configStaticLib = packageConfigStaticLib, configDynExe = packageConfigDynExe, + configFullyStaticExe = packageConfigFullyStaticExe, configProfExe = packageConfigProfExe, configProf = packageConfigProf, configProfDetail = packageConfigProfDetail, @@ -711,7 +756,8 @@ configFlagError = mempty, --TODO: ??? configRelocatable = packageConfigRelocatable, configDebugInfo = packageConfigDebugInfo, - configUseResponseFiles = mempty + configUseResponseFiles = mempty, + configAllowDependingOnPrivateLibs = mempty } installFlags = mempty { @@ -743,7 +789,19 @@ haddockArgs = mempty } + testFlags = TestFlags { + testDistPref = mempty, + testVerbosity = mempty, + testHumanLog = packageConfigTestHumanLog, + testMachineLog = packageConfigTestMachineLog, + testShowDetails = packageConfigTestShowDetails, + testKeepTix = packageConfigTestKeepTix, + testWrapper = packageConfigTestWrapper, + testFailWhenNoTestSuites = packageConfigTestFailWhenNoTestSuites, + testOptions = packageConfigTestTestOptions + } + ------------------------------------------------ -- Parsing and showing the project config file -- @@ -752,6 +810,7 @@ parseLegacyProjectConfig = parseConfig legacyProjectConfigFieldDescrs legacyPackageConfigSectionDescrs + legacyPackageConfigFGSectionDescrs mempty showLegacyProjectConfig :: LegacyProjectConfig -> String @@ -759,6 +818,7 @@ Disp.render $ showConfig legacyProjectConfigFieldDescrs legacyPackageConfigSectionDescrs + legacyPackageConfigFGSectionDescrs config $+$ Disp.text "" @@ -918,11 +978,18 @@ , "remote-build-reporting", "report-planning-failure" , "one-shot", "jobs", "keep-going", "offline", "per-component" -- solver flags: - , "max-backjumps", "reorder-goals", "count-conflicts", "independent-goals" - , "strong-flags" , "allow-boot-library-installs", "index-state" + , "max-backjumps", "reorder-goals", "count-conflicts" + , "minimize-conflict-set", "independent-goals" + , "strong-flags" , "allow-boot-library-installs", "reject-unconstrained-dependencies", "index-state" ] . commandOptionsToFields ) (installOptions ParseArgs) + ++ + ( liftFields + legacyClientInstallFlags + (\flags conf -> conf { legacyClientInstallFlags = flags }) + . commandOptionsToFields + ) (clientInstallOptions ParseArgs) where constraintSrc = ConstraintSourceProjectConfig "TODO" @@ -962,7 +1029,7 @@ [ "with-compiler", "with-hc-pkg" , "program-prefix", "program-suffix" , "library-vanilla", "library-profiling" - , "shared", "static", "executable-dynamic" + , "shared", "static", "executable-dynamic", "executable-static" , "profiling", "executable-profiling" , "profiling-detail", "library-profiling-detail" , "library-for-ghci", "split-objs", "split-sections" @@ -1014,7 +1081,25 @@ ] . commandOptionsToFields ) (haddockOptions ParseArgs) + ++ + ( liftFields + legacyTestFlags + (\flags conf -> conf { legacyTestFlags = flags }) + . mapFieldNames + prefixTest + . addFields + [ newLineListField "test-options" + (showTokenQ . fromPathTemplate) (fmap toPathTemplate parseTokenQ) + testOptions + (\v conf -> conf { testOptions = v }) + ] + . filterFields + [ "log", "machine-log", "show-details", "keep-tix-files" + , "fail-when-no-test-suites", "test-wrapper" ] + . commandOptionsToFields + ) (testOptions' ParseArgs) + where overrideFieldCompiler = simpleField "compiler" @@ -1077,11 +1162,18 @@ caseWarning = PWarning $ "The '" ++ name ++ "' field is case sensitive, use 'True' or 'False'.") + prefixTest name | "test-" `isPrefixOf` name = name + | otherwise = "test-" ++ name + +legacyPackageConfigFGSectionDescrs :: [FGSectionDescr LegacyProjectConfig] +legacyPackageConfigFGSectionDescrs = + [ packageRepoSectionDescr + ] + legacyPackageConfigSectionDescrs :: [SectionDescr LegacyProjectConfig] legacyPackageConfigSectionDescrs = - [ packageRepoSectionDescr - , packageSpecificOptionsSectionDescr + [ packageSpecificOptionsSectionDescr , liftSection legacyLocalConfig (\flags conf -> conf { legacyLocalConfig = flags }) @@ -1099,31 +1191,19 @@ remoteRepoSectionDescr ] -packageRepoSectionDescr :: SectionDescr LegacyProjectConfig -packageRepoSectionDescr = - SectionDescr { - sectionName = "source-repository-package", - sectionFields = sourceRepoFieldDescrs, - sectionSubsections = [], - sectionGet = map (\x->("", x)) - . legacyPackagesRepo, - sectionSet = +packageRepoSectionDescr :: FGSectionDescr LegacyProjectConfig +packageRepoSectionDescr = FGSectionDescr + { fgSectionName = "source-repository-package" + , fgSectionGrammar = sourceRepoFieldGrammar (RepoKindUnknown "unused") + , fgSectionGet = map (\x->("", x)) . legacyPackagesRepo + , fgSectionSet = \lineno unused pkgrepo projconf -> do unless (null unused) $ syntaxError lineno "the section 'source-repository-package' takes no arguments" return projconf { legacyPackagesRepo = legacyPackagesRepo projconf ++ [pkgrepo] - }, - sectionEmpty = SourceRepo { - repoKind = RepoThis, -- hopefully unused - repoType = Nothing, - repoLocation = Nothing, - repoModule = Nothing, - repoBranch = Nothing, - repoTag = Nothing, - repoSubdir = Nothing - } - } + } + } -- | The definitions of all the fields that can appear in the @package pkgfoo@ -- and @package *@ sections of the @cabal.project@-format files. @@ -1305,26 +1385,6 @@ -- Local field utils -- ---TODO: [code cleanup] all these utils should move to Distribution.ParseUtils --- either augmenting or replacing the ones there - ---TODO: [code cleanup] this is a different definition from listField, like --- commaNewLineListField it pretty prints on multiple lines -newLineListField :: String -> (a -> Doc) -> ReadP [a] a - -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b -newLineListField = listFieldWithSep Disp.sep - ---TODO: [code cleanup] local copy purely so we can use the fixed version --- of parseOptCommaList below -listFieldWithSep :: ([Doc] -> Doc) -> String -> (a -> Doc) -> ReadP [a] a - -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b -listFieldWithSep separator name showF readF get' set = - liftField get' set' $ - ParseUtils.field name showF' (parseOptCommaList readF) - where - set' xs b = set (get' b ++ xs) b - showF' = separator . map showF - -- | Parser combinator for simple fields which uses the field type's -- 'Monoid' instance for combining multiple occurences of the field. monoidField :: Monoid a => String -> (a -> Doc) -> ReadP a a @@ -1334,15 +1394,6 @@ where set' xs b = set (get' b `mappend` xs) b ---TODO: [code cleanup] local redefinition that should replace the version in --- D.ParseUtils. This version avoid parse ambiguity for list element parsers --- that have multiple valid parses of prefixes. -parseOptCommaList :: ReadP r a -> ReadP r [a] -parseOptCommaList p = Parse.sepBy p sep - where - -- The separator must not be empty or it introduces ambiguity - sep = (Parse.skipSpaces >> Parse.char ',' >> Parse.skipSpaces) - +++ (Parse.satisfy isSpace >> Parse.skipSpaces) --TODO: [code cleanup] local redefinition that should replace the version in -- D.ParseUtils called showFilePath. This version escapes "." and "--" which @@ -1353,19 +1404,6 @@ showTokenQ x@('.':[]) = Disp.text (show x) showTokenQ x = showToken x --- This is just a copy of parseTokenQ, using the fixed parseHaskellString -parseTokenQ :: ReadP r String -parseTokenQ = parseHaskellString - <++ Parse.munch1 (\x -> not (isSpace x) && x /= ',') - ---TODO: [code cleanup] use this to replace the parseHaskellString in --- Distribution.ParseUtils. It turns out Read instance for String accepts --- the ['a', 'b'] syntax, which we do not want. In particular it messes --- up any token starting with []. -parseHaskellString :: ReadP r String -parseHaskellString = - Parse.readS_to_P $ - Read.readPrec_to_S (do Read.String s <- Read.lexP; return s) 0 -- Handy util addFields :: [FieldDescr a] diff --git a/cabal/cabal-install/Distribution/Client/ProjectConfig/Types.hs b/cabal/cabal-install/Distribution/Client/ProjectConfig/Types.hs --- a/cabal/cabal-install/Distribution/Client/ProjectConfig/Types.hs +++ b/cabal/cabal-install/Distribution/Client/ProjectConfig/Types.hs @@ -33,12 +33,16 @@ import Distribution.Client.IndexUtils.Timestamp ( IndexState ) +import Distribution.Client.CmdInstall.ClientInstallFlags + ( ClientInstallFlags(..) ) + import Distribution.Solver.Types.Settings import Distribution.Solver.Types.ConstraintSource import Distribution.Package ( PackageName, PackageId, UnitId ) -import Distribution.Types.Dependency +import Distribution.Types.PackageVersionConstraint + ( PackageVersionConstraint ) import Distribution.Version ( Version ) import Distribution.System @@ -49,7 +53,7 @@ ( Compiler, CompilerFlavor , OptimisationLevel(..), ProfDetailLevel, DebugInfoLevel(..) ) import Distribution.Simple.Setup - ( Flag, HaddockTarget(..) ) + ( Flag, HaddockTarget(..), TestShowDetails(..) ) import Distribution.Simple.InstallDirs ( PathTemplate ) import Distribution.Utils.NubList @@ -106,7 +110,7 @@ projectPackagesRepo :: [SourceRepo], -- | Packages in this project from hackage repositories. - projectPackagesNamed :: [Dependency], + projectPackagesNamed :: [PackageVersionConstraint], -- See respective types for an explanation of what these -- values are about: @@ -148,7 +152,8 @@ projectConfigHttpTransport :: Flag String, projectConfigIgnoreExpiry :: Flag Bool, projectConfigCacheDir :: Flag FilePath, - projectConfigLogsDir :: Flag FilePath + projectConfigLogsDir :: Flag FilePath, + projectConfigClientInstallFlags :: ClientInstallFlags } deriving (Eq, Show, Generic) @@ -182,7 +187,7 @@ -- solver configuration projectConfigConstraints :: [(UserConstraint, ConstraintSource)], - projectConfigPreferences :: [Dependency], + projectConfigPreferences :: [PackageVersionConstraint], projectConfigCabalVersion :: Flag Version, --TODO: [required eventually] unused projectConfigSolver :: Flag PreSolver, projectConfigAllowOlder :: Maybe AllowOlder, @@ -192,8 +197,10 @@ projectConfigMaxBackjumps :: Flag Int, projectConfigReorderGoals :: Flag ReorderGoals, projectConfigCountConflicts :: Flag CountConflicts, + projectConfigMinimizeConflictSet :: Flag MinimizeConflictSet, projectConfigStrongFlags :: Flag StrongFlags, projectConfigAllowBootLibInstalls :: Flag AllowBootLibInstalls, + projectConfigOnlyConstrained :: Flag OnlyConstrained, projectConfigPerComponent :: Flag Bool, projectConfigIndependentGoals :: Flag IndependentGoals, @@ -239,6 +246,7 @@ packageConfigSharedLib :: Flag Bool, packageConfigStaticLib :: Flag Bool, packageConfigDynExe :: Flag Bool, + packageConfigFullyStaticExe :: Flag Bool, packageConfigProf :: Flag Bool, --TODO: [code cleanup] sort out packageConfigProfLib :: Flag Bool, -- this duplication packageConfigProfExe :: Flag Bool, -- and consistency @@ -263,6 +271,7 @@ packageConfigDebugInfo :: Flag DebugInfoLevel, packageConfigRunTests :: Flag Bool, --TODO: [required eventually] use this packageConfigDocumentation :: Flag Bool, --TODO: [required eventually] use this + -- Haddock options packageConfigHaddockHoogle :: Flag Bool, --TODO: [required eventually] use this packageConfigHaddockHtml :: Flag Bool, --TODO: [required eventually] use this packageConfigHaddockHtmlLocation :: Flag String, --TODO: [required eventually] use this @@ -276,7 +285,15 @@ packageConfigHaddockQuickJump :: Flag Bool, --TODO: [required eventually] use this packageConfigHaddockHscolourCss :: Flag FilePath, --TODO: [required eventually] use this packageConfigHaddockContents :: Flag PathTemplate, --TODO: [required eventually] use this - packageConfigHaddockForHackage :: Flag HaddockTarget + packageConfigHaddockForHackage :: Flag HaddockTarget, + -- Test options + packageConfigTestHumanLog :: Flag PathTemplate, + packageConfigTestMachineLog :: Flag PathTemplate, + packageConfigTestShowDetails :: Flag TestShowDetails, + packageConfigTestKeepTix :: Flag Bool, + packageConfigTestWrapper :: Flag FilePath, + packageConfigTestFailWhenNoTestSuites :: Flag Bool, + packageConfigTestTestOptions :: [PathTemplate] } deriving (Eq, Show, Generic) @@ -363,7 +380,7 @@ solverSettingRemoteRepos :: [RemoteRepo], -- ^ Available Hackage servers. solverSettingLocalRepos :: [FilePath], solverSettingConstraints :: [(UserConstraint, ConstraintSource)], - solverSettingPreferences :: [Dependency], + solverSettingPreferences :: [PackageVersionConstraint], solverSettingFlagAssignment :: FlagAssignment, -- ^ For all local packages solverSettingFlagAssignments :: Map PackageName FlagAssignment, solverSettingCabalVersion :: Maybe Version, --TODO: [required eventually] unused @@ -373,8 +390,10 @@ solverSettingMaxBackjumps :: Maybe Int, solverSettingReorderGoals :: ReorderGoals, solverSettingCountConflicts :: CountConflicts, + solverSettingMinimizeConflictSet :: MinimizeConflictSet, solverSettingStrongFlags :: StrongFlags, solverSettingAllowBootLibInstalls :: AllowBootLibInstalls, + solverSettingOnlyConstrained :: OnlyConstrained, solverSettingIndexState :: Maybe IndexState, solverSettingIndependentGoals :: IndependentGoals -- Things that only make sense for manual mode, not --local mode diff --git a/cabal/cabal-install/Distribution/Client/ProjectOrchestration.hs b/cabal/cabal-install/Distribution/Client/ProjectOrchestration.hs --- a/cabal/cabal-install/Distribution/Client/ProjectOrchestration.hs +++ b/cabal/cabal-install/Distribution/Client/ProjectOrchestration.hs @@ -41,6 +41,7 @@ -- module Distribution.Client.ProjectOrchestration ( -- * Discovery phase: what is in the project? + CurrentCommand(..), establishProjectBaseContext, ProjectBaseContext(..), BuildTimeSettings(..), @@ -135,7 +136,6 @@ import Distribution.Solver.Types.OptionalStanza import Distribution.Package - hiding (InstalledPackageId, installedPackageId) import Distribution.PackageDescription ( FlagAssignment, unFlagAssignment, showFlagValue , diffFlagAssignment ) @@ -152,7 +152,8 @@ import Distribution.Verbosity import Distribution.Version ( mkVersion ) -import Distribution.Text +import Distribution.Pretty + ( prettyShow ) import Distribution.Simple.Compiler ( compilerCompatVersion, showCompilerId , OptimisationLevel(..)) @@ -168,6 +169,11 @@ #endif +-- | Tracks what command is being executed, because we need to hide this somewhere +-- for cases that need special handling (usually for error reporting). +data CurrentCommand = InstallCommand | HaddockCommand | OtherCommand + deriving (Show, Eq) + -- | This holds the context of a project prior to solving: the content of the -- @cabal.project@ and all the local package @.cabal@ files. -- @@ -176,13 +182,15 @@ cabalDirLayout :: CabalDirLayout, projectConfig :: ProjectConfig, localPackages :: [PackageSpecifier UnresolvedSourcePackage], - buildSettings :: BuildTimeSettings + buildSettings :: BuildTimeSettings, + currentCommand :: CurrentCommand } establishProjectBaseContext :: Verbosity -> ProjectConfig + -> CurrentCommand -> IO ProjectBaseContext -establishProjectBaseContext verbosity cliConfig = do +establishProjectBaseContext verbosity cliConfig currentCommand = do cabalDir <- getCabalDir projectRoot <- either throwIO return =<< @@ -205,7 +213,8 @@ } = projectConfigShared projectConfig mlogsDir = Setup.flagToMaybe projectConfigLogsDir - mstoreDir <- sequenceA $ makeAbsolute <$> Setup.flagToMaybe projectConfigStoreDir + mstoreDir <- sequenceA $ makeAbsolute + <$> Setup.flagToMaybe projectConfigStoreDir let cabalDirLayout = mkCabalDirLayout cabalDir mstoreDir mlogsDir buildSettings = resolveBuildTimeSettings @@ -217,7 +226,8 @@ cabalDirLayout, projectConfig, localPackages, - buildSettings + buildSettings, + currentCommand } where mdistDirectory = Setup.flagToMaybe projectConfigDistDir @@ -403,7 +413,7 @@ $ projectConfig shouldWriteGhcEnvironment = - case fromFlagOrDefault WriteGhcEnvironmentFilesOnlyForGhc844AndNewer + case fromFlagOrDefault NeverWriteGhcEnvironmentFiles writeGhcEnvFilesPolicy of AlwaysWriteGhcEnvironmentFiles -> True @@ -421,7 +431,7 @@ -- Finally if there were any build failures then report them and throw -- an exception to terminate the program - dieOnBuildFailures verbosity elaboratedPlanToExecute buildOutcomes + dieOnBuildFailures verbosity currentCommand elaboratedPlanToExecute buildOutcomes -- Note that it is a deliberate design choice that the 'buildTargets' is -- not passed to phase 1, and the various bits of input config is not @@ -664,17 +674,19 @@ in (pname, cname')) availableTargetsByPackageIdAndComponentName where - unqualComponentName :: PackageName -> ComponentName -> UnqualComponentName + unqualComponentName :: + PackageName -> ComponentName -> UnqualComponentName unqualComponentName pkgname = fromMaybe (packageNameToUnqualComponentName pkgname) . componentNameString -- Add in all the empty packages. These do not appear in the - -- availableTargetsByComponent map, since that only contains components - -- so packages with no components are invisible from that perspective. - -- The empty packages need to be there for proper error reporting, so users - -- can select the empty package and then we can report that it is empty, - -- otherwise we falsely report there is no such package at all. + -- availableTargetsByComponent map, since that only contains + -- components, so packages with no components are invisible from + -- that perspective. The empty packages need to be there for + -- proper error reporting, so users can select the empty package + -- and then we can report that it is empty, otherwise we falsely + -- report there is no such package at all. availableTargetsEmptyPackages = Map.fromList [ (packageId pkg, []) @@ -684,9 +696,10 @@ ElabPackage _ -> null (pkgComponents (elabPkgDescription pkg)) ] - --TODO: [research required] what if the solution has multiple versions of this package? - -- e.g. due to setup deps or due to multiple independent sets of - -- packages being built (e.g. ghc + ghcjs in a project) + --TODO: [research required] what if the solution has multiple + -- versions of this package? + -- e.g. due to setup deps or due to multiple independent sets + -- of packages being built (e.g. ghc + ghcjs in a project) filterTargetsKind :: ComponentKind -> [AvailableTarget k] -> [AvailableTarget k] filterTargetsKind ckind = filterTargetsKindWith (== ckind) @@ -759,13 +772,22 @@ data TargetProblemCommon = TargetNotInProject PackageName | TargetAvailableInIndex PackageName - | TargetComponentNotProjectLocal PackageId ComponentName SubComponentTarget - | TargetComponentNotBuildable PackageId ComponentName SubComponentTarget - | TargetOptionalStanzaDisabledByUser PackageId ComponentName SubComponentTarget - | TargetOptionalStanzaDisabledBySolver PackageId ComponentName SubComponentTarget - | TargetProblemUnknownComponent PackageName - (Either UnqualComponentName ComponentName) + | TargetComponentNotProjectLocal + PackageId ComponentName SubComponentTarget + + | TargetComponentNotBuildable + PackageId ComponentName SubComponentTarget + + | TargetOptionalStanzaDisabledByUser + PackageId ComponentName SubComponentTarget + + | TargetOptionalStanzaDisabledBySolver + PackageId ComponentName SubComponentTarget + + | TargetProblemUnknownComponent + PackageName (Either UnqualComponentName ComponentName) + -- The target matching stuff only returns packages local to the project, -- so these lookups should never fail, but if 'resolveTargets' is called -- directly then of course it can. @@ -810,7 +832,8 @@ ProjectBaseContext { buildSettings = BuildTimeSettings{buildSettingDryRun}, projectConfig = ProjectConfig { - projectConfigLocalPackages = PackageConfig {packageConfigOptimization} + projectConfigLocalPackages = + PackageConfig {packageConfigOptimization} } } ProjectBuildContext { @@ -824,8 +847,9 @@ | otherwise = noticeNoWrap verbosity $ unlines $ - (showBuildProfile ++ "In order, the following " ++ wouldWill ++ " be built" ++ - ifNormal " (use -v for more details)" ++ ":") + (showBuildProfile ++ "In order, the following " + ++ wouldWill ++ " be built" + ++ ifNormal " (use -v for more details)" ++ ":") : map showPkgAndReason pkgs where @@ -844,8 +868,8 @@ showPkgAndReason (ReadyPackage elab) = " - " ++ (if verbosity >= deafening - then display (installedUnitId elab) - else display (packageId elab) + then prettyShow (installedUnitId elab) + else prettyShow (packageId elab) ) ++ (case elabPkgOrComp elab of ElabPackage pkg -> showTargets elab ++ ifVerbose (showStanzas pkg) @@ -858,17 +882,18 @@ " (" ++ showBuildStatus buildStatus ++ ")" showComp elab comp = - maybe "custom" display (compComponentName comp) ++ + maybe "custom" prettyShow (compComponentName comp) ++ if Map.null (elabInstantiatedWith elab) then "" else " with " ++ intercalate ", " -- TODO: Abbreviate the UnitIds - [ display k ++ "=" ++ display v + [ prettyShow k ++ "=" ++ prettyShow v | (k,v) <- Map.toList (elabInstantiatedWith elab) ] nonDefaultFlags :: ElaboratedConfiguredPackage -> FlagAssignment - nonDefaultFlags elab = elabFlagAssignment elab `diffFlagAssignment` elabFlagDefaults elab + nonDefaultFlags elab = + elabFlagAssignment elab `diffFlagAssignment` elabFlagDefaults elab showStanzas pkg = concat $ [ " *test" @@ -879,8 +904,10 @@ showTargets elab | null (elabBuildTargets elab) = "" | otherwise - = " (" ++ intercalate ", " [ showComponentTarget (packageId elab) t | t <- elabBuildTargets elab ] - ++ ")" + = " (" + ++ intercalate ", " [ showComponentTarget (packageId elab) t + | t <- elabBuildTargets elab ] + ++ ")" showFlagAssignment :: FlagAssignment -> String showFlagAssignment = concatMap ((' ' :) . showFlagValue) . unFlagAssignment @@ -897,8 +924,11 @@ -- rendering. nubFlag :: Eq a => a -> Setup.Flag a -> Setup.Flag a nubFlag x (Setup.Flag x') | x == x' = Setup.NoFlag - nubFlag _ f = f - (tryLibProfiling, tryExeProfiling) = computeEffectiveProfiling fullConfigureFlags + nubFlag _ f = f + + (tryLibProfiling, tryExeProfiling) = + computeEffectiveProfiling fullConfigureFlags + partialConfigureFlags = Mon.mempty { configProf = @@ -932,10 +962,12 @@ BuildReasonEphemeralTargets -> "ephemeral targets" BuildStatusUpToDate {} -> "up to date" -- doesn't happen - showMonitorChangedReason (MonitoredFileChanged file) = "file " ++ file ++ " changed" + showMonitorChangedReason (MonitoredFileChanged file) = + "file " ++ file ++ " changed" showMonitorChangedReason (MonitoredValueChanged _) = "value changed" - showMonitorChangedReason MonitorFirstRun = "first run" - showMonitorChangedReason MonitorCorruptCache = "cannot read state cache" + showMonitorChangedReason MonitorFirstRun = "first run" + showMonitorChangedReason MonitorCorruptCache = + "cannot read state cache" showBuildProfile = "Build profile: " ++ unwords [ "-w " ++ (showCompilerId . pkgConfigCompiler) elaboratedShared, @@ -948,9 +980,9 @@ -- | If there are build failures then report them and throw an exception. -- -dieOnBuildFailures :: Verbosity +dieOnBuildFailures :: Verbosity -> CurrentCommand -> ElaboratedInstallPlan -> BuildOutcomes -> IO () -dieOnBuildFailures verbosity plan buildOutcomes +dieOnBuildFailures verbosity currentCommand plan buildOutcomes | null failures = return () | isSimpleCase = exitFailure @@ -998,12 +1030,16 @@ ] dieIfNotHaddockFailure + | currentCommand == HaddockCommand = die' | all isHaddockFailure failuresClassification = warn | otherwise = die' where - isHaddockFailure (_, ShowBuildSummaryOnly (HaddocksFailed _) ) = True - isHaddockFailure (_, ShowBuildSummaryAndLog (HaddocksFailed _) _) = True - isHaddockFailure _ = False + isHaddockFailure + (_, ShowBuildSummaryOnly (HaddocksFailed _) ) = True + isHaddockFailure + (_, ShowBuildSummaryAndLog (HaddocksFailed _) _) = True + isHaddockFailure + _ = False classifyBuildFailure :: BuildFailure -> BuildFailurePresentation @@ -1023,10 +1059,10 @@ -- context which package failed. -- -- We generalise this rule as follows: - -- - if only one failure occurs, and it is in a single root package (ie a - -- package with nothing else depending on it) - -- - and that failure is of a kind that always reports enough detail - -- itself (e.g. ghc reporting errors on stdout) + -- - if only one failure occurs, and it is in a single root + -- package (i.e. a package with nothing else depending on it) + -- - and that failure is of a kind that always reports enough + -- detail itself (e.g. ghc reporting errors on stdout) -- - then we do not report additional error detail or context. -- isSimpleCase @@ -1034,6 +1070,7 @@ , [pkg] <- rootpkgs , installedUnitId pkg == pkgid , isFailureSelfExplanatory (buildFailureReason failure) + , currentCommand /= InstallCommand = True | otherwise = False @@ -1078,8 +1115,8 @@ BenchFailed _ -> "Benchmarks failed for " ++ pkgstr InstallFailed _ -> "Failed to build " ++ pkgstr DependentFailed depid - -> "Failed to build " ++ display (packageId pkg) - ++ " because it depends on " ++ display depid + -> "Failed to build " ++ prettyShow (packageId pkg) + ++ " because it depends on " ++ prettyShow depid ++ " which itself failed to build" where pkgstr = elabConfiguredName verbosity pkg @@ -1087,21 +1124,25 @@ then renderDependencyOf (installedUnitId pkg) else "" - renderFailureExtraDetail reason = - case reason of - ConfigureFailed _ -> " The failure occurred during the configure step." - InstallFailed _ -> " The failure occurred during the final install step." - _ -> "" + renderFailureExtraDetail (ConfigureFailed _) = + " The failure occurred during the configure step." + renderFailureExtraDetail (InstallFailed _) = + " The failure occurred during the final install step." + renderFailureExtraDetail _ = + "" renderDependencyOf pkgid = case ultimateDeps pkgid of [] -> "" - (p1:[]) -> " (which is required by " ++ elabPlanPackageName verbosity p1 ++ ")" - (p1:p2:[]) -> " (which is required by " ++ elabPlanPackageName verbosity p1 - ++ " and " ++ elabPlanPackageName verbosity p2 ++ ")" - (p1:p2:_) -> " (which is required by " ++ elabPlanPackageName verbosity p1 - ++ ", " ++ elabPlanPackageName verbosity p2 - ++ " and others)" + (p1:[]) -> + " (which is required by " ++ elabPlanPackageName verbosity p1 ++ ")" + (p1:p2:[]) -> + " (which is required by " ++ elabPlanPackageName verbosity p1 + ++ " and " ++ elabPlanPackageName verbosity p2 ++ ")" + (p1:p2:_) -> + " (which is required by " ++ elabPlanPackageName verbosity p1 + ++ ", " ++ elabPlanPackageName verbosity p2 + ++ " and others)" showException e = case fromException e of Just (ExitFailure 1) -> "" @@ -1136,9 +1177,10 @@ ++ " which may be because some part of it was killed " ++ "(i.e. SIGKILL). " ++ explanation where - explanation = "The typical reason for this is that there is not " - ++ "enough memory available (e.g. the OS killed a process " - ++ "using lots of memory)." + explanation = + "The typical reason for this is that there is not " + ++ "enough memory available (e.g. the OS killed a process " + ++ "using lots of memory)." #endif Just (ExitFailure n) -> " The build process terminated with exit code " ++ show n diff --git a/cabal/cabal-install/Distribution/Client/ProjectPlanOutput.hs b/cabal/cabal-install/Distribution/Client/ProjectPlanOutput.hs --- a/cabal/cabal-install/Distribution/Client/ProjectPlanOutput.hs +++ b/cabal/cabal-install/Distribution/Client/ProjectPlanOutput.hs @@ -40,7 +40,7 @@ ( getImplInfo, GhcImplInfo(supportsPkgEnvFiles) , GhcEnvironmentFileEntry(..), simpleGhcEnvironmentFile , writeGhcEnvironmentFile ) -import Distribution.Text +import Distribution.Deprecated.Text import qualified Distribution.Compat.Graph as Graph import Distribution.Compat.Graph (Graph, Node) import qualified Distribution.Compat.Binary as Binary diff --git a/cabal/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal/cabal-install/Distribution/Client/ProjectPlanning.hs --- a/cabal/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -62,7 +62,9 @@ -- * Path construction binDirectoryFor, - binDirectories + binDirectories, + storePackageInstallDirs, + storePackageInstallDirs' ) where import Prelude () @@ -108,10 +110,13 @@ import Distribution.Solver.Types.Settings import Distribution.ModuleName -import Distribution.Package hiding - (InstalledPackageId, installedPackageId) +import Distribution.Package import Distribution.Types.AnnotatedId import Distribution.Types.ComponentName +import Distribution.Types.LibraryName +import Distribution.Types.GivenComponent + (GivenComponent(..)) +import Distribution.Types.PackageVersionConstraint import Distribution.Types.PkgconfigDependency import Distribution.Types.UnqualComponentName import Distribution.System @@ -127,7 +132,7 @@ import Distribution.Simple.Program.Find import qualified Distribution.Simple.Setup as Cabal import Distribution.Simple.Setup - (Flag, toFlag, flagToMaybe, flagToList, fromFlagOrDefault) + (Flag(..), toFlag, flagToMaybe, flagToList, fromFlagOrDefault) import qualified Distribution.Simple.Configure as Cabal import qualified Distribution.Simple.LocalBuildInfo as Cabal import Distribution.Simple.LocalBuildInfo @@ -147,7 +152,7 @@ import Distribution.Simple.Utils import Distribution.Version import Distribution.Verbosity -import Distribution.Text +import Distribution.Deprecated.Text import qualified Distribution.Compat.Graph as Graph import Distribution.Compat.Graph(IsNode(..)) @@ -259,8 +264,7 @@ assert (elabBuildStyle == BuildInplaceOnly || case compComponentName of Nothing -> True - Just CLibName -> True - Just (CSubLibName _) -> True + Just (CLibName _) -> True Just (CExeName _) -> True -- This is interesting: there's no way to declare a dependency -- on a foreign library at the moment, but you may still want @@ -935,8 +939,9 @@ where - --TODO: [nice to have] disable multiple instances restriction in the solver, but then - -- make sure we can cope with that in the output. + --TODO: [nice to have] disable multiple instances restriction in + -- the solver, but then make sure we can cope with that in the + -- output. resolverParams = setMaxBackjumps solverSettingMaxBackjumps @@ -947,21 +952,28 @@ . setCountConflicts solverSettingCountConflicts - --TODO: [required eventually] should only be configurable for custom installs + . setMinimizeConflictSet solverSettingMinimizeConflictSet + + --TODO: [required eventually] should only be configurable for + --custom installs -- . setAvoidReinstalls solverSettingAvoidReinstalls - --TODO: [required eventually] should only be configurable for custom installs + --TODO: [required eventually] should only be configurable for + --custom installs -- . setShadowPkgs solverSettingShadowPkgs . setStrongFlags solverSettingStrongFlags . setAllowBootLibInstalls solverSettingAllowBootLibInstalls + . setOnlyConstrained solverSettingOnlyConstrained + . setSolverVerbosity verbosity - --TODO: [required eventually] decide if we need to prefer installed for - -- global packages, or prefer latest even for global packages. Perhaps - -- should be configurable but with a different name than "upgrade-dependencies". + --TODO: [required eventually] decide if we need to prefer + -- installed for global packages, or prefer latest even for + -- global packages. Perhaps should be configurable but with a + -- different name than "upgrade-dependencies". . setPreferenceDefault PreferLatestForSelected {-(if solverSettingUpgradeDeps then PreferAllLatest @@ -980,7 +992,7 @@ . addPreferences -- preferences from the config file or command line [ PackageVersionPreference name ver - | Dependency name ver <- solverSettingPreferences ] + | PackageVersionConstraint name ver <- solverSettingPreferences ] . addConstraints -- version constraints from the config file or command line @@ -1060,12 +1072,12 @@ -- current and past compilers; in fact recent lib:Cabal versions -- will warn when they encounter a too new or unknown GHC compiler -- version (c.f. #415). To avoid running into unsupported - -- configurations we encode the compatiblity matrix as lower + -- configurations we encode the compatibility matrix as lower -- bounds on lib:Cabal here (effectively corresponding to the -- respective major Cabal version bundled with the respective GHC -- release). -- - -- GHC 8.4 needs Cabal >= 2.4 + -- GHC 8.6 needs Cabal >= 2.4 -- GHC 8.4 needs Cabal >= 2.2 -- GHC 8.2 needs Cabal >= 2.0 -- GHC 8.0 needs Cabal >= 1.24 @@ -1347,7 +1359,7 @@ -- supported in per-package mode. If this is the case, we should -- give an error when this occurs. checkPerPackageOk comps reasons = do - let is_sublib (CSubLibName _) = True + let is_sublib (CLibName (LSubLibName _)) = True is_sublib _ = False when (any (matchElabPkg is_sublib) comps) $ dieProgress $ @@ -1576,7 +1588,7 @@ -- returns at most one result. elaborateLibSolverId :: (SolverId -> [ElaboratedPlanPackage]) -> SolverId -> [ElaboratedPlanPackage] - elaborateLibSolverId mapDep = filter (matchPlanPkg (== CLibName)) . mapDep + elaborateLibSolverId mapDep = filter (matchPlanPkg (== (CLibName LMainLibName))) . mapDep -- | Given an 'ElaboratedPlanPackage', return the paths to where the -- executables that this package represents would be installed. @@ -1631,7 +1643,7 @@ elabModuleShape = modShape } - modShape = case find (matchElabPkg (== CLibName)) comps of + modShape = case find (matchElabPkg (== (CLibName LMainLibName))) comps of Nothing -> emptyModuleShape Just e -> Ty.elabModuleShape e @@ -1671,10 +1683,9 @@ | Graph.N _ cn _ <- fromMaybe [] mb_closure ] where mb_closure = Graph.revClosure compGraph [ k | k <- Graph.keys compGraph, is_lib k ] - is_lib CLibName = True - -- NB: this case should not occur, because sub-libraries + -- NB: the sublib case should not occur, because sub-libraries -- are not supported without per-component builds - is_lib (CSubLibName _) = True + is_lib (CLibName _) = True is_lib _ = False buildComponentDeps f @@ -1809,6 +1820,7 @@ elabSharedLib = pkgid `Set.member` pkgsUseSharedLibrary elabStaticLib = perPkgOptionFlag pkgid False packageConfigStaticLib elabDynExe = perPkgOptionFlag pkgid False packageConfigDynExe + elabFullyStaticExe = perPkgOptionFlag pkgid False packageConfigFullyStaticExe elabGHCiLib = perPkgOptionFlag pkgid False packageConfigGHCiLib --TODO: [required feature] needs to default to enabled on windows still elabProfExe = perPkgOptionFlag pkgid False packageConfigProf @@ -1867,6 +1879,14 @@ elabHaddockHscolourCss = perPkgOptionMaybe pkgid packageConfigHaddockHscolourCss elabHaddockContents = perPkgOptionMaybe pkgid packageConfigHaddockContents + elabTestMachineLog = perPkgOptionMaybe pkgid packageConfigTestMachineLog + elabTestHumanLog = perPkgOptionMaybe pkgid packageConfigTestHumanLog + elabTestShowDetails = perPkgOptionMaybe pkgid packageConfigTestShowDetails + elabTestKeepTix = perPkgOptionFlag pkgid False packageConfigTestKeepTix + elabTestWrapper = perPkgOptionMaybe pkgid packageConfigTestWrapper + elabTestFailWhenNoTestSuites = perPkgOptionFlag pkgid False packageConfigTestFailWhenNoTestSuites + elabTestTestOptions = perPkgOptionList pkgid packageConfigTestTestOptions + perPkgOptionFlag :: PackageId -> a -> (PackageConfig -> Flag a) -> a perPkgOptionMaybe :: PackageId -> (PackageConfig -> Flag a) -> Maybe a perPkgOptionList :: PackageId -> (PackageConfig -> [a]) -> [a] @@ -2008,10 +2028,7 @@ -- | Get the appropriate 'ComponentName' which identifies an installed -- component. ipiComponentName :: IPI.InstalledPackageInfo -> ComponentName -ipiComponentName ipkg = - case IPI.sourceLibName ipkg of - Nothing -> CLibName - Just n -> (CSubLibName n) +ipiComponentName = CLibName . IPI.sourceLibName -- | Given a 'ElaboratedConfiguredPackage', report if it matches a -- 'ComponentName'. @@ -2214,6 +2231,41 @@ indefiniteComponent :: UnitId -> ComponentId -> InstM ElaboratedPlanPackage indefiniteComponent _uid cid + -- Only need Configured; this phase happens before improvement, so + -- there shouldn't be any Installed packages here. + | Just (InstallPlan.Configured epkg) <- Map.lookup cid cmap + , ElabComponent elab_comp <- elabPkgOrComp epkg + = do -- We need to do a little more processing of the includes: some + -- of them are fully definite even without substitution. We + -- want to build those too; see #5634. + -- + -- This code mimics similar code in Distribution.Backpack.ReadyComponent; + -- however, unlike the conversion from LinkedComponent to + -- ReadyComponent, this transformation is done *without* + -- changing the type in question; and what we are simply + -- doing is enforcing tighter invariants on the data + -- structure in question. The new invariant is that there + -- is no IndefFullUnitId in compLinkedLibDependencies that actually + -- has no holes. We couldn't specify this invariant when + -- we initially created the ElaboratedPlanPackage because + -- we have no way of actually refiying the UnitId into a + -- DefiniteUnitId (that's what substUnitId does!) + new_deps <- forM (compLinkedLibDependencies elab_comp) $ \uid -> + if Set.null (openUnitIdFreeHoles uid) + then fmap DefiniteUnitId (substUnitId Map.empty uid) + else return uid + return $ InstallPlan.Configured epkg { + elabPkgOrComp = ElabComponent elab_comp { + compLinkedLibDependencies = new_deps, + -- I think this is right: any new definite unit ids we + -- minted in the phase above need to be built before us. + -- Add 'em in. This doesn't remove any old dependencies + -- on the indefinite package; they're harmless. + compOrderLibDependencies = + ordNub $ compOrderLibDependencies elab_comp ++ + [unDefUnitId d | DefiniteUnitId d <- new_deps] + } + } | Just planpkg <- Map.lookup cid cmap = return planpkg | otherwise = error ("indefiniteComponent: " ++ display cid) @@ -2340,7 +2392,7 @@ AvailableTarget (UnitId, ComponentName))] availableInstalledTargets ipkg = let unitid = installedUnitId ipkg - cname = CLibName + cname = CLibName LMainLibName status = TargetBuildable (unitid, cname) TargetRequestedByDefault target = AvailableTarget (packageId ipkg) cname status False fake = False @@ -2446,7 +2498,7 @@ compComponentName elabComponent == Just cname ElabPackage _ -> case componentName component of - CLibName -> True + CLibName (LMainLibName) -> True CExeName _ -> True --TODO: what about sub-libs and foreign libs? _ -> False @@ -2829,7 +2881,7 @@ } where libTargetsRequiredForRevDeps = - [ ComponentTarget Cabal.defaultLibName WholeComponent + [ ComponentTarget (CLibName Cabal.defaultLibName) WholeComponent | installedUnitId elab `Set.member` hasReverseLibDeps ] exeTargetsRequiredForRevDeps = @@ -3008,9 +3060,9 @@ -- of other packages. SetupCustomImplicitDeps -> Just $ - [ Dependency depPkgname anyVersion + [ Dependency depPkgname anyVersion (Set.singleton LMainLibName) | depPkgname <- legacyCustomSetupPkgs compiler platform ] ++ - [ Dependency cabalPkgname cabalConstraint + [ Dependency cabalPkgname cabalConstraint (Set.singleton LMainLibName) | packageName pkg /= cabalPkgname ] where -- The Cabal dep is slightly special: @@ -3033,8 +3085,8 @@ -- external Setup.hs, it'll be one of the simple ones that only depends -- on Cabal and base. SetupNonCustomExternalLib -> - Just [ Dependency cabalPkgname cabalConstraint - , Dependency basePkgname anyVersion ] + Just [ Dependency cabalPkgname cabalConstraint (Set.singleton LMainLibName) + , Dependency basePkgname anyVersion (Set.singleton LMainLibName)] where cabalConstraint = orLaterVersion (PD.specVersion pkg) @@ -3135,7 +3187,7 @@ usePackageDB = elabSetupPackageDBStack, usePackageIndex = Nothing, useDependencies = [ (uid, srcid) - | ConfiguredId srcid (Just CLibName) uid + | ConfiguredId srcid (Just (CLibName LMainLibName)) uid <- elabSetupDependencies elab ], useDependenciesExclusive = True, useVersionMacros = elabSetupScriptStyle == SetupCustomExplicitDeps, @@ -3168,13 +3220,20 @@ -> CompilerId -> InstalledPackageId -> InstallDirs.InstallDirs FilePath -storePackageInstallDirs StoreDirLayout{ storePackageDirectory - , storeDirectory } - compid ipkgid = +storePackageInstallDirs storeDirLayout compid ipkgid = + storePackageInstallDirs' storeDirLayout compid $ newSimpleUnitId ipkgid + +storePackageInstallDirs' :: StoreDirLayout + -> CompilerId + -> UnitId + -> InstallDirs.InstallDirs FilePath +storePackageInstallDirs' StoreDirLayout{ storePackageDirectory + , storeDirectory } + compid unitid = InstallDirs.InstallDirs {..} where store = storeDirectory compid - prefix = storePackageDirectory compid (newSimpleUnitId ipkgid) + prefix = storePackageDirectory compid unitid bindir = prefix "bin" libdir = prefix "lib" libsubdir = "" @@ -3258,6 +3317,7 @@ configStaticLib = toFlag elabStaticLib configDynExe = toFlag elabDynExe + configFullyStaticExe = toFlag elabFullyStaticExe configGHCiLib = toFlag elabGHCiLib configProfExe = mempty configProfLib = toFlag elabProfLib @@ -3294,14 +3354,16 @@ -- NB: This does NOT use InstallPlan.depends, which includes executable -- dependencies which should NOT be fed in here (also you don't have -- enough info anyway) - configDependencies = [ (case mb_cn of - -- Special case for internal libraries - Just (CSubLibName uqn) - | packageId elab == srcid - -> mkPackageName (unUnqualComponentName uqn) - _ -> packageName srcid, - cid) - | ConfiguredId srcid mb_cn cid <- elabLibDependencies elab ] + configDependencies = [ GivenComponent + (packageName srcid) + ln + cid + | ConfiguredId srcid mb_cn cid <- elabLibDependencies elab + , let ln = case mb_cn + of Just (CLibName lname) -> lname + Just _ -> error "non-library dependency" + Nothing -> LMainLibName + ] configConstraints = case elabPkgOrComp of ElabPackage _ -> @@ -3328,6 +3390,9 @@ configUserInstall = mempty -- don't rely on defaults configPrograms_ = mempty -- never use, shouldn't exist configUseResponseFiles = mempty + -- TODO set to true when the solver can prevent private-library-deps by itself + -- (issue #6039) + configAllowDependingOnPrivateLibs = mempty setupHsConfigureArgs :: ElaboratedConfiguredPackage -> [String] @@ -3371,14 +3436,16 @@ -> Verbosity -> FilePath -> Cabal.TestFlags -setupHsTestFlags _ _ verbosity builddir = Cabal.TestFlags +setupHsTestFlags (ElaboratedConfiguredPackage{..}) _ verbosity builddir = Cabal.TestFlags { testDistPref = toFlag builddir , testVerbosity = toFlag verbosity - , testMachineLog = mempty - , testHumanLog = mempty - , testShowDetails = toFlag Cabal.Always - , testKeepTix = mempty - , testOptions = mempty + , testMachineLog = maybe mempty toFlag elabTestMachineLog + , testHumanLog = maybe mempty toFlag elabTestHumanLog + , testShowDetails = maybe (Flag Cabal.Always) toFlag elabTestShowDetails + , testKeepTix = toFlag elabTestKeepTix + , testWrapper = maybe mempty toFlag elabTestWrapper + , testFailWhenNoTestSuites = toFlag elabTestFailWhenNoTestSuites + , testOptions = elabTestTestOptions } setupHsTestArgs :: ElaboratedConfiguredPackage -> [String] @@ -3608,6 +3675,7 @@ pkgHashVanillaLib = elabVanillaLib, pkgHashSharedLib = elabSharedLib, pkgHashDynExe = elabDynExe, + pkgHashFullyStaticExe = elabFullyStaticExe, pkgHashGHCiLib = elabGHCiLib, pkgHashProfLib = elabProfLib, pkgHashProfExe = elabProfExe, diff --git a/cabal/cabal-install/Distribution/Client/ProjectPlanning/Types.hs b/cabal/cabal-install/Distribution/Client/ProjectPlanning/Types.hs --- a/cabal/cabal-install/Distribution/Client/ProjectPlanning/Types.hs +++ b/cabal/cabal-install/Distribution/Client/ProjectPlanning/Types.hs @@ -75,12 +75,12 @@ import Distribution.Backpack import Distribution.Backpack.ModuleShape +import Distribution.Pretty import Distribution.Verbosity -import Distribution.Text import Distribution.Types.ComponentRequestedSpec +import Distribution.Types.PkgconfigVersion import Distribution.Types.PackageDescription (PackageDescription(..)) import Distribution.Package - hiding (InstalledPackageId, installedPackageId) import Distribution.System import qualified Distribution.PackageDescription as Cabal import Distribution.InstalledPackageInfo (InstalledPackageInfo) @@ -89,10 +89,11 @@ import qualified Distribution.Simple.BuildTarget as Cabal import Distribution.Simple.Program import Distribution.ModuleName (ModuleName) -import Distribution.Simple.LocalBuildInfo (ComponentName(..)) +import Distribution.Simple.LocalBuildInfo + ( ComponentName(..), LibraryName(..) ) import qualified Distribution.Simple.InstallDirs as InstallDirs import Distribution.Simple.InstallDirs (PathTemplate) -import Distribution.Simple.Setup (HaddockTarget) +import Distribution.Simple.Setup (HaddockTarget, TestShowDetails) import Distribution.Version import qualified Distribution.Solver.Types.ComponentDeps as CD @@ -132,8 +133,8 @@ -- | User-friendly display string for an 'ElaboratedPlanPackage'. elabPlanPackageName :: Verbosity -> ElaboratedPlanPackage -> String elabPlanPackageName verbosity (PreExisting ipkg) - | verbosity <= normal = display (packageName ipkg) - | otherwise = display (installedUnitId ipkg) + | verbosity <= normal = prettyShow (packageName ipkg) + | otherwise = prettyShow (installedUnitId ipkg) elabPlanPackageName verbosity (Configured elab) = elabConfiguredName verbosity elab elabPlanPackageName verbosity (Installed elab) @@ -247,6 +248,7 @@ elabSharedLib :: Bool, elabStaticLib :: Bool, elabDynExe :: Bool, + elabFullyStaticExe :: Bool, elabGHCiLib :: Bool, elabProfLib :: Bool, elabProfExe :: Bool, @@ -287,6 +289,14 @@ elabHaddockHscolourCss :: Maybe FilePath, elabHaddockContents :: Maybe PathTemplate, + elabTestMachineLog :: Maybe PathTemplate, + elabTestHumanLog :: Maybe PathTemplate, + elabTestShowDetails :: Maybe TestShowDetails, + elabTestKeepTix :: Bool, + elabTestWrapper :: Maybe FilePath, + elabTestFailWhenNoTestSuites :: Bool, + elabTestTestOptions :: [PathTemplate], + -- Setup.hs related things: -- | One of four modes for how we build and interact with the Setup.hs @@ -391,8 +401,7 @@ -- single file is_lib_target (ComponentTarget cn WholeComponent) = is_lib cn is_lib_target _ = False - is_lib CLibName = True - is_lib (CSubLibName _) = True + is_lib (CLibName _) = True is_lib _ = False -- | Construct the environment needed for the data files to work. @@ -463,7 +472,7 @@ elabComponentName :: ElaboratedConfiguredPackage -> Maybe ComponentName elabComponentName elab = case elabPkgOrComp elab of - ElabPackage _ -> Just CLibName -- there could be more, but default this + ElabPackage _ -> Just $ CLibName LMainLibName -- there could be more, but default this ElabComponent comp -> compComponentName comp -- | A user-friendly descriptor for an 'ElaboratedConfiguredPackage'. @@ -475,11 +484,11 @@ ElabComponent comp -> case compComponentName comp of Nothing -> "setup from " - Just CLibName -> "" - Just cname -> display cname ++ " from ") - ++ display (packageId elab) + Just (CLibName LMainLibName) -> "" + Just cname -> prettyShow cname ++ " from ") + ++ prettyShow (packageId elab) | otherwise - = display (elabUnitId elab) + = prettyShow (elabUnitId elab) elabDistDirParams :: ElaboratedSharedConfig -> ElaboratedConfiguredPackage -> DistDirParams elabDistDirParams shared elab = DistDirParams { @@ -565,7 +574,7 @@ -- they are, need to do this differently ElabComponent _ -> [] -elabPkgConfigDependencies :: ElaboratedConfiguredPackage -> [(PkgconfigName, Maybe Version)] +elabPkgConfigDependencies :: ElaboratedConfiguredPackage -> [(PkgconfigName, Maybe PkgconfigVersion)] elabPkgConfigDependencies ElaboratedConfiguredPackage { elabPkgOrComp = ElabPackage pkg } = pkgPkgConfigDependencies pkg elabPkgConfigDependencies ElaboratedConfiguredPackage { elabPkgOrComp = ElabComponent comp } @@ -635,10 +644,16 @@ -- internal executables). compExeDependencies :: [ConfiguredId], -- | The @pkg-config@ dependencies of the component - compPkgConfigDependencies :: [(PkgconfigName, Maybe Version)], + compPkgConfigDependencies :: [(PkgconfigName, Maybe PkgconfigVersion)], -- | The paths all our executable dependencies will be installed -- to once they are installed. compExeDependencyPaths :: [(ConfiguredId, FilePath)], + -- | The UnitIds of the libraries (identifying elaborated packages/ + -- components) that must be built before this project. This + -- is used purely for ordering purposes. It can contain both + -- references to definite and indefinite packages; an indefinite + -- UnitId indicates that we must typecheck that indefinite package + -- before we can build this one. compOrderLibDependencies :: [UnitId] } deriving (Eq, Show, Generic) @@ -683,7 +698,7 @@ -- because Cabal library does not track per-component -- pkg-config depends; it always does them all at once. -- - pkgPkgConfigDependencies :: [(PkgconfigName, Maybe Version)], + pkgPkgConfigDependencies :: [(PkgconfigName, Maybe PkgconfigVersion)], -- | Which optional stanzas (ie testsuites, benchmarks) will actually -- be enabled during the package configure step. @@ -755,7 +770,7 @@ FileTarget fname -> Cabal.BuildTargetFile cname fname showTestComponentTarget :: PackageId -> ComponentTarget -> Maybe String -showTestComponentTarget _ (ComponentTarget (CTestName n) _) = Just $ display n +showTestComponentTarget _ (ComponentTarget (CTestName n) _) = Just $ prettyShow n showTestComponentTarget _ _ = Nothing isTestComponentTarget :: ComponentTarget -> Bool @@ -763,7 +778,7 @@ isTestComponentTarget _ = False showBenchComponentTarget :: PackageId -> ComponentTarget -> Maybe String -showBenchComponentTarget _ (ComponentTarget (CBenchName n) _) = Just $ display n +showBenchComponentTarget _ (ComponentTarget (CBenchName n) _) = Just $ prettyShow n showBenchComponentTarget _ _ = Nothing isBenchComponentTarget :: ComponentTarget -> Bool @@ -779,8 +794,8 @@ isExeComponentTarget _ = False isSubLibComponentTarget :: ComponentTarget -> Bool -isSubLibComponentTarget (ComponentTarget (CSubLibName _) _) = True -isSubLibComponentTarget _ = False +isSubLibComponentTarget (ComponentTarget (CLibName (LSubLibName _)) _) = True +isSubLibComponentTarget _ = False componentOptionalStanza :: CD.Component -> Maybe OptionalStanza componentOptionalStanza (CD.ComponentTest _) = Just TestStanzas diff --git a/cabal/cabal-install/Distribution/Client/Run.hs b/cabal/cabal-install/Distribution/Client/Run.hs --- a/cabal/cabal-install/Distribution/Client/Run.hs +++ b/cabal/cabal-install/Distribution/Client/Run.hs @@ -35,7 +35,7 @@ addLibraryPath) import Distribution.System (Platform (..)) import Distribution.Verbosity (Verbosity) -import Distribution.Text (display) +import Distribution.Deprecated.Text (display) import qualified Distribution.Simple.GHCJS as GHCJS diff --git a/cabal/cabal-install/Distribution/Client/Sandbox.hs b/cabal/cabal-install/Distribution/Client/Sandbox.hs --- a/cabal/cabal-install/Distribution/Client/Sandbox.hs +++ b/cabal/cabal-install/Distribution/Client/Sandbox.hs @@ -91,6 +91,7 @@ import Distribution.Simple.PreProcess ( knownSuffixHandlers ) import Distribution.Simple.Program ( ProgramDb ) import Distribution.Simple.Setup ( Flag(..), HaddockFlags(..) + , emptyTestFlags , fromFlagOrDefault, flagToMaybe ) import Distribution.Simple.SrcDist ( prepareTree ) import Distribution.Simple.Utils ( die', debug, notice, info, warn @@ -99,7 +100,7 @@ , createDirectoryIfMissingVerbose ) import Distribution.Package ( Package(..) ) import Distribution.System ( Platform ) -import Distribution.Text ( display ) +import Distribution.Deprecated.Text ( display ) import Distribution.Verbosity ( Verbosity ) import Distribution.Compat.Environment ( lookupEnv, setEnv ) import Distribution.Client.Compat.FilePerms ( setFileHidden ) @@ -684,7 +685,7 @@ ,comp, platform, progdb ,UseSandbox sandboxDir, Just sandboxPkgInfo ,globalFlags, configFlags, configExFlags, installFlags - ,haddockFlags) + ,haddockFlags, emptyTestFlags) -- This can actually be replaced by a call to 'install', but we use a -- lower-level API because of layer separation reasons. Additionally, we diff --git a/cabal/cabal-install/Distribution/Client/Sandbox/PackageEnvironment.hs b/cabal/cabal-install/Distribution/Client/Sandbox/PackageEnvironment.hs --- a/cabal/cabal-install/Distribution/Client/Sandbox/PackageEnvironment.hs +++ b/cabal/cabal-install/Distribution/Client/Sandbox/PackageEnvironment.hs @@ -52,7 +52,7 @@ , fromFlagOrDefault, toFlag, flagToMaybe ) import Distribution.Simple.Utils ( die', info, notice, warn, debug ) import Distribution.Solver.Types.ConstraintSource -import Distribution.ParseUtils ( FieldDescr(..), ParseResult(..) +import Distribution.Deprecated.ParseUtils ( FieldDescr(..), ParseResult(..) , commaListField, commaNewLineListField , liftField, lineNo, locatedErrorMsg , parseFilePathQ, readFields @@ -73,9 +73,9 @@ import Text.PrettyPrint ( ($+$) ) import qualified Text.PrettyPrint as Disp -import qualified Distribution.Compat.ReadP as Parse -import qualified Distribution.ParseUtils as ParseUtils ( Field(..) ) -import qualified Distribution.Text as Text +import qualified Distribution.Deprecated.ReadP as Parse +import qualified Distribution.Deprecated.ParseUtils as ParseUtils ( Field(..) ) +import qualified Distribution.Deprecated.Text as Text import GHC.Generics ( Generic ) diff --git a/cabal/cabal-install/Distribution/Client/Sandbox/Timestamp.hs b/cabal/cabal-install/Distribution/Client/Sandbox/Timestamp.hs --- a/cabal/cabal-install/Distribution/Client/Sandbox/Timestamp.hs +++ b/cabal/cabal-install/Distribution/Client/Sandbox/Timestamp.hs @@ -31,7 +31,7 @@ import Distribution.Compiler (CompilerId) import Distribution.Simple.Utils (debug, die', warn) import Distribution.System (Platform) -import Distribution.Text (display) +import Distribution.Deprecated.Text (display) import Distribution.Verbosity (Verbosity) import Distribution.Client.SrcDist (allPackageSourceFiles) diff --git a/cabal/cabal-install/Distribution/Client/Security/HTTP.hs b/cabal/cabal-install/Distribution/Client/Security/HTTP.hs --- a/cabal/cabal-install/Distribution/Client/Security/HTTP.hs +++ b/cabal/cabal-install/Distribution/Client/Security/HTTP.hs @@ -153,7 +153,7 @@ instance Pretty UnexpectedResponse where pretty (UnexpectedResponse uri code) = "Unexpected response " ++ show code - ++ "for " ++ show uri + ++ " for " ++ show uri #if MIN_VERSION_base(4,8,0) deriving instance Show UnexpectedResponse diff --git a/cabal/cabal-install/Distribution/Client/Setup.hs b/cabal/cabal-install/Distribution/Client/Setup.hs --- a/cabal/cabal-install/Distribution/Client/Setup.hs +++ b/cabal/cabal-install/Distribution/Client/Setup.hs @@ -18,14 +18,15 @@ module Distribution.Client.Setup ( globalCommand, GlobalFlags(..), defaultGlobalFlags , RepoContext(..), withRepoContext - , configureCommand, ConfigFlags(..), filterConfigureFlags + , configureCommand, ConfigFlags(..), configureOptions, filterConfigureFlags , configPackageDB', configCompilerAux' , configureExCommand, ConfigExFlags(..), defaultConfigExFlags , buildCommand, BuildFlags(..), BuildExFlags(..), SkipAddSourceDepsCheck(..) - , replCommand, testCommand, benchmarkCommand + , filterTestFlags + , replCommand, testCommand, benchmarkCommand, testOptions , configureExOptions, reconfigureCommand , installCommand, InstallFlags(..), installOptions, defaultInstallFlags - , filterHaddockArgs, filterHaddockFlags + , filterHaddockArgs, filterHaddockFlags, haddockOptions , defaultSolver, defaultMaxBackjumps , listCommand, ListFlags(..) , updateCommand, UpdateFlags(..), defaultUpdateFlags @@ -42,8 +43,8 @@ , uploadCommand, UploadFlags(..), IsCandidate(..) , reportCommand, ReportFlags(..) , runCommand - , initCommand, IT.InitFlags(..) - , sdistCommand, SDistFlags(..), SDistExFlags(..), ArchiveFormat(..) + , initCommand, initOptions, IT.InitFlags(..) + , sdistCommand, SDistFlags(..) , win32SelfUpgradeCommand, Win32SelfUpgradeFlags(..) , actAsSetupCommand, ActAsSetupFlags(..) , sandboxCommand, defaultSandboxLocation, SandboxFlags(..) @@ -68,6 +69,8 @@ import Prelude () import Distribution.Client.Compat.Prelude hiding (get) +import Distribution.Deprecated.ReadP (readP_to_E) + import Distribution.Client.Types ( Username(..), Password(..), RemoteRepo(..) , AllowNewer(..), AllowOlder(..), RelaxDeps(..) @@ -98,7 +101,7 @@ import qualified Distribution.Simple.Setup as Cabal import Distribution.Simple.Setup ( ConfigFlags(..), BuildFlags(..), ReplFlags - , TestFlags(..), BenchmarkFlags(..) + , TestFlags, BenchmarkFlags(..) , SDistFlags(..), HaddockFlags(..) , CleanFlags(..), DoctestFlags(..) , CopyFlags(..), RegisterFlags(..) @@ -113,18 +116,24 @@ import Distribution.Version ( Version, mkVersion, nullVersion, anyVersion, thisVersion ) import Distribution.Package - ( PackageIdentifier, PackageName, packageName, packageVersion ) + ( PackageName, PackageIdentifier, packageName, packageVersion ) import Distribution.Types.Dependency +import Distribution.Types.GivenComponent + ( GivenComponent(..) ) +import Distribution.Types.PackageVersionConstraint + ( PackageVersionConstraint(..) ) +import Distribution.Types.UnqualComponentName + ( unqualComponentNameToPackageName ) import Distribution.PackageDescription - ( BuildType(..), RepoKind(..) ) + ( BuildType(..), RepoKind(..), LibraryName(..) ) import Distribution.System ( Platform ) -import Distribution.Text +import Distribution.Deprecated.Text ( Text(..), display ) import Distribution.ReadE - ( ReadE(..), readP_to_E, succeedReadE ) -import qualified Distribution.Compat.ReadP as Parse + ( ReadE(..), succeedReadE ) +import qualified Distribution.Deprecated.ReadP as Parse ( ReadP, char, munch1, pfail, sepBy1, (+++) ) -import Distribution.ParseUtils +import Distribution.Deprecated.ParseUtils ( readPToMaybe ) import Distribution.Verbosity ( Verbosity, lessVerbose, normal, verboseNoFlags, verboseNoTimestamp ) @@ -137,6 +146,7 @@ import Data.List ( deleteFirstsBy ) +import qualified Data.Set as Set import System.FilePath ( () ) import Network.URI @@ -172,7 +182,6 @@ , "get" , "init" , "configure" - , "reconfigure" , "build" , "clean" , "run" @@ -186,12 +195,8 @@ , "freeze" , "gen-bounds" , "outdated" - , "doctest" , "haddock" , "hscolour" - , "copy" - , "register" - , "sandbox" , "exec" , "new-build" , "new-configure" @@ -247,10 +252,6 @@ addCmd n = case lookup n cmdDescs of Nothing -> "" Just d -> " " ++ align n ++ " " ++ d - addCmdCustom n d = case lookup n cmdDescs of -- make sure that the - -- command still exists. - Nothing -> "" - Just _ -> " " ++ align n ++ " " ++ d in "Commands:\n" ++ unlines ( @@ -285,17 +286,9 @@ , addCmd "freeze" , addCmd "gen-bounds" , addCmd "outdated" - , addCmd "doctest" , addCmd "haddock" , addCmd "hscolour" - , addCmd "copy" - , addCmd "register" - , addCmd "reconfigure" - , par - , startGroup "sandbox" - , addCmd "sandbox" , addCmd "exec" - , addCmdCustom "repl" "Open interpreter with access to sandbox packages." , par , startGroup "new-style projects (beta)" , addCmd "new-build" @@ -498,7 +491,7 @@ filterConfigureFlags flags cabalLibVersion -- NB: we expect the latest version to be the most common case, -- so test it first. - | cabalLibVersion >= mkVersion [2,1,0] = flags_latest + | cabalLibVersion >= mkVersion [2,5,0] = flags_latest -- The naming convention is that flags_version gives flags with -- all flags *introduced* in version eliminated. -- It is NOT the latest version of Cabal library that @@ -513,17 +506,39 @@ | cabalLibVersion < mkVersion [1,19,2] = flags_1_19_2 | cabalLibVersion < mkVersion [1,21,1] = flags_1_21_1 | cabalLibVersion < mkVersion [1,22,0] = flags_1_22_0 + | cabalLibVersion < mkVersion [1,22,1] = flags_1_22_1 | cabalLibVersion < mkVersion [1,23,0] = flags_1_23_0 | cabalLibVersion < mkVersion [1,25,0] = flags_1_25_0 | cabalLibVersion < mkVersion [2,1,0] = flags_2_1_0 - | otherwise = flags_latest + | cabalLibVersion < mkVersion [2,5,0] = flags_2_5_0 + | otherwise = error "the impossible just happened" -- see first guard where flags_latest = flags { -- Cabal >= 1.19.1 uses '--dependency' and does not need '--constraint'. + -- Note: this is not in the wrong place. configConstraints gets + -- repopulated in flags_1_19_1 but it needs to be set to empty for + -- newer versions first. configConstraints = [] } - flags_2_1_0 = flags_latest { + flags_2_5_0 = flags_latest { + -- Cabal < 2.5 does not understand --dependency=pkg:component=cid + -- (public sublibraries), so we convert it to the legacy + -- --dependency=pkg_or_internal_compoent=cid + configDependencies = + let convertToLegacyInternalDep (GivenComponent _ (LSubLibName cn) cid) = + Just $ GivenComponent + (unqualComponentNameToPackageName cn) + LMainLibName + cid + convertToLegacyInternalDep (GivenComponent pn LMainLibName cid) = + Just $ GivenComponent pn LMainLibName cid + in catMaybes $ convertToLegacyInternalDep <$> configDependencies flags + -- Cabal < 2.5 doesn't know about '--enable/disable-executable-static'. + , configFullyStaticExe = NoFlag + } + + flags_2_1_0 = flags_2_5_0 { -- Cabal < 2.1 doesn't know about -v +timestamp modifier configVerbosity = fmap verboseNoTimestamp (configVerbosity flags_latest) -- Cabal < 2.1 doesn't know about ---static @@ -558,6 +573,12 @@ , configProfLib = Flag tryLibProfiling } + -- Cabal == 1.22.0.* had a discontinuity (see #5946 or e9a8d48a3adce34d) + -- due to temporary amnesia of the --*-executable-profiling flags + flags_1_22_1 = flags_1_23_0 { configDebugInfo = NoFlag + , configProfExe = NoFlag + } + -- Cabal < 1.22 doesn't know about '--disable-debug-info'. flags_1_22_0 = flags_1_23_0 { configDebugInfo = NoFlag } @@ -615,7 +636,7 @@ data ConfigExFlags = ConfigExFlags { configCabalVersion :: Flag Version, configExConstraints :: [(UserConstraint, ConstraintSource)], - configPreferences :: [Dependency], + configPreferences :: [PackageVersionConstraint], configSolver :: Flag PreSolver, configAllowNewer :: Maybe AllowNewer, configAllowOlder :: Maybe AllowOlder, @@ -810,6 +831,37 @@ (<>) = gmappend -- ------------------------------------------------------------ +-- * Test flags +-- ------------------------------------------------------------ + +-- | Given some 'TestFlags' for the version of Cabal that +-- cabal-install was built with, and a target older 'Version' of +-- Cabal that we want to pass these flags to, convert the +-- flags into a form that will be accepted by the older +-- Setup script. Generally speaking, this just means filtering +-- out flags that the old Cabal library doesn't understand, but +-- in some cases it may also mean "emulating" a feature using +-- some more legacy flags. +filterTestFlags :: TestFlags -> Version -> TestFlags +filterTestFlags flags cabalLibVersion + -- NB: we expect the latest version to be the most common case, + -- so test it first. + | cabalLibVersion >= mkVersion [3,0,0] = flags_latest + -- The naming convention is that flags_version gives flags with + -- all flags *introduced* in version eliminated. + -- It is NOT the latest version of Cabal library that + -- these flags work for; version of introduction is a more + -- natural metric. + | cabalLibVersion < mkVersion [3,0,0] = flags_3_0_0 + | otherwise = error "the impossible just happened" -- see first guard + where + flags_latest = flags + flags_3_0_0 = flags_latest { + -- Cabal < 3.0 doesn't know about --test-wrapper + Cabal.testWrapper = NoFlag + } + +-- ------------------------------------------------------------ -- * Repl command -- ------------------------------------------------------------ @@ -945,10 +997,12 @@ fetchMaxBackjumps :: Flag Int, fetchReorderGoals :: Flag ReorderGoals, fetchCountConflicts :: Flag CountConflicts, + fetchMinimizeConflictSet :: Flag MinimizeConflictSet, fetchIndependentGoals :: Flag IndependentGoals, fetchShadowPkgs :: Flag ShadowPkgs, fetchStrongFlags :: Flag StrongFlags, fetchAllowBootLibInstalls :: Flag AllowBootLibInstalls, + fetchOnlyConstrained :: Flag OnlyConstrained, fetchTests :: Flag Bool, fetchBenchmarks :: Flag Bool, fetchVerbosity :: Flag Verbosity @@ -963,10 +1017,12 @@ fetchMaxBackjumps = Flag defaultMaxBackjumps, fetchReorderGoals = Flag (ReorderGoals False), fetchCountConflicts = Flag (CountConflicts True), + fetchMinimizeConflictSet = Flag (MinimizeConflictSet False), fetchIndependentGoals = Flag (IndependentGoals False), fetchShadowPkgs = Flag (ShadowPkgs False), fetchStrongFlags = Flag (StrongFlags False), fetchAllowBootLibInstalls = Flag (AllowBootLibInstalls False), + fetchOnlyConstrained = Flag OnlyConstrainedNone, fetchTests = toFlag False, fetchBenchmarks = toFlag False, fetchVerbosity = toFlag normal @@ -1023,10 +1079,12 @@ fetchMaxBackjumps (\v flags -> flags { fetchMaxBackjumps = v }) fetchReorderGoals (\v flags -> flags { fetchReorderGoals = v }) fetchCountConflicts (\v flags -> flags { fetchCountConflicts = v }) + fetchMinimizeConflictSet (\v flags -> flags { fetchMinimizeConflictSet = v }) fetchIndependentGoals (\v flags -> flags { fetchIndependentGoals = v }) fetchShadowPkgs (\v flags -> flags { fetchShadowPkgs = v }) fetchStrongFlags (\v flags -> flags { fetchStrongFlags = v }) fetchAllowBootLibInstalls (\v flags -> flags { fetchAllowBootLibInstalls = v }) + fetchOnlyConstrained (\v flags -> flags { fetchOnlyConstrained = v }) } @@ -1042,10 +1100,12 @@ freezeMaxBackjumps :: Flag Int, freezeReorderGoals :: Flag ReorderGoals, freezeCountConflicts :: Flag CountConflicts, + freezeMinimizeConflictSet :: Flag MinimizeConflictSet, freezeIndependentGoals :: Flag IndependentGoals, freezeShadowPkgs :: Flag ShadowPkgs, freezeStrongFlags :: Flag StrongFlags, freezeAllowBootLibInstalls :: Flag AllowBootLibInstalls, + freezeOnlyConstrained :: Flag OnlyConstrained, freezeVerbosity :: Flag Verbosity } @@ -1058,10 +1118,12 @@ freezeMaxBackjumps = Flag defaultMaxBackjumps, freezeReorderGoals = Flag (ReorderGoals False), freezeCountConflicts = Flag (CountConflicts True), + freezeMinimizeConflictSet = Flag (MinimizeConflictSet False), freezeIndependentGoals = Flag (IndependentGoals False), freezeShadowPkgs = Flag (ShadowPkgs False), freezeStrongFlags = Flag (StrongFlags False), freezeAllowBootLibInstalls = Flag (AllowBootLibInstalls False), + freezeOnlyConstrained = Flag OnlyConstrainedNone, freezeVerbosity = toFlag normal } @@ -1109,10 +1171,12 @@ freezeMaxBackjumps (\v flags -> flags { freezeMaxBackjumps = v }) freezeReorderGoals (\v flags -> flags { freezeReorderGoals = v }) freezeCountConflicts (\v flags -> flags { freezeCountConflicts = v }) + freezeMinimizeConflictSet (\v flags -> flags { freezeMinimizeConflictSet = v }) freezeIndependentGoals (\v flags -> flags { freezeIndependentGoals = v }) freezeShadowPkgs (\v flags -> flags { freezeShadowPkgs = v }) freezeStrongFlags (\v flags -> flags { freezeStrongFlags = v }) freezeAllowBootLibInstalls (\v flags -> flags { freezeAllowBootLibInstalls = v }) + freezeOnlyConstrained (\v flags -> flags { freezeOnlyConstrained = v }) } @@ -1201,7 +1265,7 @@ outdatedFreezeFile (\v flags -> flags { outdatedFreezeFile = v }) trueArg - ,option [] ["new-freeze-file", "v2-freeze-file"] + ,option [] ["v2-freeze-file", "new-freeze-file"] "Act on the new-style freeze file (default: cabal.project.freeze)" outdatedNewFreezeFile (\v flags -> flags { outdatedNewFreezeFile = v }) trueArg @@ -1303,13 +1367,13 @@ -- * Other commands -- ------------------------------------------------------------ -upgradeCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) +upgradeCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) upgradeCommand = configureCommand { commandName = "upgrade", commandSynopsis = "(command disabled, use install instead)", commandDescription = Nothing, commandUsage = usageFlagsOrPackages "upgrade", - commandDefaultFlags = (mempty, mempty, mempty, mempty), + commandDefaultFlags = (mempty, mempty, mempty, mempty, mempty), commandOptions = commandOptions installCommand } @@ -1677,10 +1741,12 @@ installMaxBackjumps :: Flag Int, installReorderGoals :: Flag ReorderGoals, installCountConflicts :: Flag CountConflicts, + installMinimizeConflictSet :: Flag MinimizeConflictSet, installIndependentGoals :: Flag IndependentGoals, installShadowPkgs :: Flag ShadowPkgs, installStrongFlags :: Flag StrongFlags, installAllowBootLibInstalls :: Flag AllowBootLibInstalls, + installOnlyConstrained :: Flag OnlyConstrained, installReinstall :: Flag Bool, installAvoidReinstalls :: Flag AvoidReinstalls, installOverrideReinstall :: Flag Bool, @@ -1693,6 +1759,8 @@ installLogFile :: Flag PathTemplate, installBuildReports :: Flag ReportLevel, installReportPlanningFailure :: Flag Bool, + -- Note: symlink-bindir is no longer used by v2-install and can be removed + -- when removing v1 commands installSymlinkBinDir :: Flag FilePath, installPerComponent :: Flag Bool, installOneShot :: Flag Bool, @@ -1722,10 +1790,12 @@ installMaxBackjumps = Flag defaultMaxBackjumps, installReorderGoals = Flag (ReorderGoals False), installCountConflicts = Flag (CountConflicts True), + installMinimizeConflictSet = Flag (MinimizeConflictSet False), installIndependentGoals= Flag (IndependentGoals False), installShadowPkgs = Flag (ShadowPkgs False), installStrongFlags = Flag (StrongFlags False), installAllowBootLibInstalls = Flag (AllowBootLibInstalls False), + installOnlyConstrained = Flag OnlyConstrainedNone, installReinstall = Flag False, installAvoidReinstalls = Flag (AvoidReinstalls False), installOverrideReinstall = Flag False, @@ -1752,7 +1822,7 @@ "$arch-$os-$compiler" "index.html") defaultMaxBackjumps :: Int -defaultMaxBackjumps = 2000 +defaultMaxBackjumps = 4000 defaultSolver :: PreSolver defaultSolver = AlwaysModular @@ -1760,7 +1830,7 @@ allSolvers :: String allSolvers = intercalate ", " (map display ([minBound .. maxBound] :: [PreSolver])) -installCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) +installCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) installCommand = CommandUI { commandName = "install", commandSynopsis = "Install packages.", @@ -1813,7 +1883,7 @@ ++ " " ++ (map (const ' ') pname) ++ " " ++ " Change installation destination\n", - commandDefaultFlags = (mempty, mempty, mempty, mempty), + commandDefaultFlags = (mempty, mempty, mempty, mempty, mempty), commandOptions = \showOrParseArgs -> liftOptions get1 set1 -- Note: [Hidden Flags] @@ -1831,12 +1901,14 @@ . optionName) $ installOptions showOrParseArgs) ++ liftOptions get4 set4 (haddockOptions showOrParseArgs) + ++ liftOptions get5 set5 (testOptions showOrParseArgs) } where - get1 (a,_,_,_) = a; set1 a (_,b,c,d) = (a,b,c,d) - get2 (_,b,_,_) = b; set2 b (a,_,c,d) = (a,b,c,d) - get3 (_,_,c,_) = c; set3 c (a,b,_,d) = (a,b,c,d) - get4 (_,_,_,d) = d; set4 d (a,b,c,_) = (a,b,c,d) + get1 (a,_,_,_,_) = a; set1 a (_,b,c,d,e) = (a,b,c,d,e) + get2 (_,b,_,_,_) = b; set2 b (a,_,c,d,e) = (a,b,c,d,e) + get3 (_,_,c,_,_) = c; set3 c (a,b,_,d,e) = (a,b,c,d,e) + get4 (_,_,_,d,_) = d; set4 d (a,b,c,_,e) = (a,b,c,d,e) + get5 (_,_,_,_,e) = e; set5 e (a,b,c,d,_) = (a,b,c,d,e) haddockCommand :: CommandUI HaddockFlags haddockCommand = Cabal.haddockCommand @@ -1880,13 +1952,28 @@ ,"hyperlink-source", "quickjump", "hscolour-css" ,"contents-location", "for-hackage"] ] + +testOptions :: ShowOrParseArgs -> [OptionField TestFlags] +testOptions showOrParseArgs + = [ opt { optionName = prefixTest name, + optionDescr = [ fmapOptFlags (\(_, lflags) -> ([], map prefixTest lflags)) descr + | descr <- optionDescr opt] } + | opt <- commandOptions Cabal.testCommand showOrParseArgs + , let name = optionName opt + , name `elem` ["log", "machine-log", "show-details", "keep-tix-files" + ,"fail-when-no-test-suites", "test-options", "test-option" + ,"test-wrapper"] + ] where - fmapOptFlags :: (OptFlags -> OptFlags) -> OptDescr a -> OptDescr a - fmapOptFlags modify (ReqArg d f p r w) = ReqArg d (modify f) p r w - fmapOptFlags modify (OptArg d f p r i w) = OptArg d (modify f) p r i w - fmapOptFlags modify (ChoiceOpt xs) = ChoiceOpt [(d, modify f, i, w) | (d, f, i, w) <- xs] - fmapOptFlags modify (BoolOpt d f1 f2 r w) = BoolOpt d (modify f1) (modify f2) r w + prefixTest name | "test-" `isPrefixOf` name = name + | otherwise = "test-" ++ name +fmapOptFlags :: (OptFlags -> OptFlags) -> OptDescr a -> OptDescr a +fmapOptFlags modify (ReqArg d f p r w) = ReqArg d (modify f) p r w +fmapOptFlags modify (OptArg d f p r i w) = OptArg d (modify f) p r i w +fmapOptFlags modify (ChoiceOpt xs) = ChoiceOpt [(d, modify f, i, w) | (d, f, i, w) <- xs] +fmapOptFlags modify (BoolOpt d f1 f2 r w) = BoolOpt d (modify f1) (modify f2) r w + installOptions :: ShowOrParseArgs -> [OptionField InstallFlags] installOptions showOrParseArgs = [ option "" ["documentation"] @@ -1916,10 +2003,12 @@ installMaxBackjumps (\v flags -> flags { installMaxBackjumps = v }) installReorderGoals (\v flags -> flags { installReorderGoals = v }) installCountConflicts (\v flags -> flags { installCountConflicts = v }) + installMinimizeConflictSet (\v flags -> flags { installMinimizeConflictSet = v }) installIndependentGoals (\v flags -> flags { installIndependentGoals = v }) installShadowPkgs (\v flags -> flags { installShadowPkgs = v }) installStrongFlags (\v flags -> flags { installStrongFlags = v }) - installAllowBootLibInstalls (\v flags -> flags { installAllowBootLibInstalls = v }) ++ + installAllowBootLibInstalls (\v flags -> flags { installAllowBootLibInstalls = v }) + installOnlyConstrained (\v flags -> flags { installOnlyConstrained = v }) ++ [ option [] ["reinstall"] "Install even if it means installing the same version again." @@ -2156,225 +2245,216 @@ commandUsage = \pname -> "Usage: " ++ pname ++ " init [FLAGS]\n", commandDefaultFlags = defaultInitFlags, - commandOptions = \_ -> - [ option ['n'] ["non-interactive"] - "Non-interactive mode." - IT.nonInteractive (\v flags -> flags { IT.nonInteractive = v }) - trueArg + commandOptions = initOptions + } - , option ['q'] ["quiet"] - "Do not generate log messages to stdout." - IT.quiet (\v flags -> flags { IT.quiet = v }) - trueArg +initOptions :: ShowOrParseArgs -> [OptionField IT.InitFlags] +initOptions _ = + [ option ['i'] ["interactive"] + "interactive mode." + IT.interactive (\v flags -> flags { IT.interactive = v }) + (boolOpt' (['i'], ["interactive"]) (['n'], ["non-interactive"])) - , option [] ["no-comments"] - "Do not generate explanatory comments in the .cabal file." - IT.noComments (\v flags -> flags { IT.noComments = v }) - trueArg + , option ['q'] ["quiet"] + "Do not generate log messages to stdout." + IT.quiet (\v flags -> flags { IT.quiet = v }) + trueArg - , option ['m'] ["minimal"] - "Generate a minimal .cabal file, that is, do not include extra empty fields. Also implies --no-comments." - IT.minimal (\v flags -> flags { IT.minimal = v }) - trueArg + , option [] ["no-comments"] + "Do not generate explanatory comments in the .cabal file." + IT.noComments (\v flags -> flags { IT.noComments = v }) + trueArg - , option [] ["overwrite"] - "Overwrite any existing .cabal, LICENSE, or Setup.hs files without warning." - IT.overwrite (\v flags -> flags { IT.overwrite = v }) - trueArg + , option ['m'] ["minimal"] + "Generate a minimal .cabal file, that is, do not include extra empty fields. Also implies --no-comments." + IT.minimal (\v flags -> flags { IT.minimal = v }) + trueArg - , option [] ["package-dir", "packagedir"] - "Root directory of the package (default = current directory)." - IT.packageDir (\v flags -> flags { IT.packageDir = v }) - (reqArgFlag "DIRECTORY") + , option [] ["overwrite"] + "Overwrite any existing .cabal, LICENSE, or Setup.hs files without warning." + IT.overwrite (\v flags -> flags { IT.overwrite = v }) + trueArg - , option ['p'] ["package-name"] - "Name of the Cabal package to create." - IT.packageName (\v flags -> flags { IT.packageName = v }) - (reqArg "PACKAGE" (readP_to_E ("Cannot parse package name: "++) - (toFlag `fmap` parse)) - (flagToList . fmap display)) + , option [] ["package-dir", "packagedir"] + "Root directory of the package (default = current directory)." + IT.packageDir (\v flags -> flags { IT.packageDir = v }) + (reqArgFlag "DIRECTORY") - , option [] ["version"] - "Initial version of the package." - IT.version (\v flags -> flags { IT.version = v }) - (reqArg "VERSION" (readP_to_E ("Cannot parse package version: "++) - (toFlag `fmap` parse)) - (flagToList . fmap display)) + , option ['p'] ["package-name"] + "Name of the Cabal package to create." + IT.packageName (\v flags -> flags { IT.packageName = v }) + (reqArg "PACKAGE" (readP_to_E ("Cannot parse package name: "++) + (toFlag `fmap` parse)) + (flagToList . fmap display)) - , option [] ["cabal-version"] - "Version of the Cabal specification." - IT.cabalVersion (\v flags -> flags { IT.cabalVersion = v }) - (reqArg "VERSION_RANGE" (readP_to_E ("Cannot parse Cabal specification version: "++) - (toFlag `fmap` parse)) - (flagToList . fmap display)) + , option [] ["version"] + "Initial version of the package." + IT.version (\v flags -> flags { IT.version = v }) + (reqArg "VERSION" (readP_to_E ("Cannot parse package version: "++) + (toFlag `fmap` parse)) + (flagToList . fmap display)) - , option ['l'] ["license"] - "Project license." - IT.license (\v flags -> flags { IT.license = v }) - (reqArg "LICENSE" (readP_to_E ("Cannot parse license: "++) - (toFlag `fmap` parse)) - (flagToList . fmap display)) + , option [] ["cabal-version"] + "Version of the Cabal specification." + IT.cabalVersion (\v flags -> flags { IT.cabalVersion = v }) + (reqArg "VERSION_RANGE" (readP_to_E ("Cannot parse Cabal specification version: "++) + (toFlag `fmap` parse)) + (flagToList . fmap display)) - , option ['a'] ["author"] - "Name of the project's author." - IT.author (\v flags -> flags { IT.author = v }) - (reqArgFlag "NAME") + , option ['l'] ["license"] + "Project license." + IT.license (\v flags -> flags { IT.license = v }) + (reqArg "LICENSE" (readP_to_E ("Cannot parse license: "++) + (toFlag `fmap` parse)) + (flagToList . fmap display)) - , option ['e'] ["email"] - "Email address of the maintainer." - IT.email (\v flags -> flags { IT.email = v }) - (reqArgFlag "EMAIL") + , option ['a'] ["author"] + "Name of the project's author." + IT.author (\v flags -> flags { IT.author = v }) + (reqArgFlag "NAME") - , option ['u'] ["homepage"] - "Project homepage and/or repository." - IT.homepage (\v flags -> flags { IT.homepage = v }) - (reqArgFlag "URL") + , option ['e'] ["email"] + "Email address of the maintainer." + IT.email (\v flags -> flags { IT.email = v }) + (reqArgFlag "EMAIL") - , option ['s'] ["synopsis"] - "Short project synopsis." - IT.synopsis (\v flags -> flags { IT.synopsis = v }) - (reqArgFlag "TEXT") + , option ['u'] ["homepage"] + "Project homepage and/or repository." + IT.homepage (\v flags -> flags { IT.homepage = v }) + (reqArgFlag "URL") - , option ['c'] ["category"] - "Project category." - IT.category (\v flags -> flags { IT.category = v }) - (reqArg' "CATEGORY" (\s -> toFlag $ maybe (Left s) Right (readMaybe s)) - (flagToList . fmap (either id show))) + , option ['s'] ["synopsis"] + "Short project synopsis." + IT.synopsis (\v flags -> flags { IT.synopsis = v }) + (reqArgFlag "TEXT") - , option ['x'] ["extra-source-file"] - "Extra source file to be distributed with tarball." - IT.extraSrc (\v flags -> flags { IT.extraSrc = v }) - (reqArg' "FILE" (Just . (:[])) - (fromMaybe [])) + , option ['c'] ["category"] + "Project category." + IT.category (\v flags -> flags { IT.category = v }) + (reqArg' "CATEGORY" (\s -> toFlag $ maybe (Left s) Right (readMaybe s)) + (flagToList . fmap (either id show))) - , option [] ["is-library"] - "Build a library." - IT.packageType (\v flags -> flags { IT.packageType = v }) - (noArg (Flag IT.Library)) + , option ['x'] ["extra-source-file"] + "Extra source file to be distributed with tarball." + IT.extraSrc (\v flags -> flags { IT.extraSrc = v }) + (reqArg' "FILE" (Just . (:[])) + (fromMaybe [])) - , option [] ["is-executable"] - "Build an executable." - IT.packageType - (\v flags -> flags { IT.packageType = v }) - (noArg (Flag IT.Executable)) + , option [] ["lib", "is-library"] + "Build a library." + IT.packageType (\v flags -> flags { IT.packageType = v }) + (noArg (Flag IT.Library)) - , option [] ["is-libandexe"] - "Build a library and an executable." - IT.packageType - (\v flags -> flags { IT.packageType = v }) - (noArg (Flag IT.LibraryAndExecutable)) + , option [] ["exe", "is-executable"] + "Build an executable." + IT.packageType + (\v flags -> flags { IT.packageType = v }) + (noArg (Flag IT.Executable)) - , option [] ["main-is"] - "Specify the main module." - IT.mainIs - (\v flags -> flags { IT.mainIs = v }) - (reqArgFlag "FILE") + , option [] ["libandexe", "is-libandexe"] + "Build a library and an executable." + IT.packageType + (\v flags -> flags { IT.packageType = v }) + (noArg (Flag IT.LibraryAndExecutable)) - , option [] ["language"] - "Specify the default language." - IT.language - (\v flags -> flags { IT.language = v }) - (reqArg "LANGUAGE" (readP_to_E ("Cannot parse language: "++) - (toFlag `fmap` parse)) - (flagToList . fmap display)) + , option [] ["tests"] + "Generate a test suite for the library." + IT.initializeTestSuite + (\v flags -> flags { IT.initializeTestSuite = v }) + trueArg - , option ['o'] ["expose-module"] - "Export a module from the package." - IT.exposedModules - (\v flags -> flags { IT.exposedModules = v }) - (reqArg "MODULE" (readP_to_E ("Cannot parse module name: "++) - ((Just . (:[])) `fmap` parse)) - (maybe [] (fmap display))) + , option [] ["test-dir"] + "Directory containing tests." + IT.testDirs (\v flags -> flags { IT.testDirs = v }) + (reqArg' "DIR" (Just . (:[])) + (fromMaybe [])) - , option [] ["extension"] - "Use a LANGUAGE extension (in the other-extensions field)." - IT.otherExts - (\v flags -> flags { IT.otherExts = v }) - (reqArg "EXTENSION" (readP_to_E ("Cannot parse extension: "++) - ((Just . (:[])) `fmap` parse)) - (maybe [] (fmap display))) + , option [] ["simple"] + "Create a simple project with sensible defaults." + IT.simpleProject + (\v flags -> flags { IT.simpleProject = v }) + trueArg - , option ['d'] ["dependency"] - "Package dependency." - IT.dependencies (\v flags -> flags { IT.dependencies = v }) - (reqArg "PACKAGE" (readP_to_E ("Cannot parse dependency: "++) - ((Just . (:[])) `fmap` parse)) - (maybe [] (fmap display))) + , option [] ["main-is"] + "Specify the main module." + IT.mainIs + (\v flags -> flags { IT.mainIs = v }) + (reqArgFlag "FILE") - , option [] ["source-dir", "sourcedir"] - "Directory containing package source." - IT.sourceDirs (\v flags -> flags { IT.sourceDirs = v }) - (reqArg' "DIR" (Just . (:[])) - (fromMaybe [])) + , option [] ["language"] + "Specify the default language." + IT.language + (\v flags -> flags { IT.language = v }) + (reqArg "LANGUAGE" (readP_to_E ("Cannot parse language: "++) + (toFlag `fmap` parse)) + (flagToList . fmap display)) - , option [] ["build-tool"] - "Required external build tool." - IT.buildTools (\v flags -> flags { IT.buildTools = v }) - (reqArg' "TOOL" (Just . (:[])) - (fromMaybe [])) + , option ['o'] ["expose-module"] + "Export a module from the package." + IT.exposedModules + (\v flags -> flags { IT.exposedModules = v }) + (reqArg "MODULE" (readP_to_E ("Cannot parse module name: "++) + ((Just . (:[])) `fmap` parse)) + (maybe [] (fmap display))) - -- NB: this is a bit of a transitional hack and will likely be - -- removed again if `cabal init` is migrated to the v2-* command - -- framework - , option "w" ["with-compiler"] - "give the path to a particular compiler" - IT.initHcPath (\v flags -> flags { IT.initHcPath = v }) - (reqArgFlag "PATH") + , option [] ["extension"] + "Use a LANGUAGE extension (in the other-extensions field)." + IT.otherExts + (\v flags -> flags { IT.otherExts = v }) + (reqArg "EXTENSION" (readP_to_E ("Cannot parse extension: "++) + ((Just . (:[])) `fmap` parse)) + (maybe [] (fmap display))) - , optionVerbosity IT.initVerbosity (\v flags -> flags { IT.initVerbosity = v }) - ] - } + , option ['d'] ["dependency"] + "Package dependency." + IT.dependencies (\v flags -> flags { IT.dependencies = v }) + (reqArg "PACKAGE" (readP_to_E ("Cannot parse dependency: "++) + ((Just . (:[])) `fmap` parse)) + (maybe [] (fmap display))) + , option [] ["application-dir"] + "Directory containing package application executable." + IT.applicationDirs (\v flags -> flags { IT.applicationDirs = v}) + (reqArg' "DIR" (Just . (:[])) + (fromMaybe [])) + + , option [] ["source-dir", "sourcedir"] + "Directory containing package library source." + IT.sourceDirs (\v flags -> flags { IT.sourceDirs = v }) + (reqArg' "DIR" (Just . (:[])) + (fromMaybe [])) + + , option [] ["build-tool"] + "Required external build tool." + IT.buildTools (\v flags -> flags { IT.buildTools = v }) + (reqArg' "TOOL" (Just . (:[])) + (fromMaybe [])) + + -- NB: this is a bit of a transitional hack and will likely be + -- removed again if `cabal init` is migrated to the v2-* command + -- framework + , option "w" ["with-compiler"] + "give the path to a particular compiler" + IT.initHcPath (\v flags -> flags { IT.initHcPath = v }) + (reqArgFlag "PATH") + + , optionVerbosity IT.initVerbosity (\v flags -> flags { IT.initVerbosity = v }) + ] + -- ------------------------------------------------------------ -- * SDist flags -- ------------------------------------------------------------ -- | Extra flags to @sdist@ beyond runghc Setup sdist -- -data SDistExFlags = SDistExFlags { - sDistFormat :: Flag ArchiveFormat - } - deriving (Show, Generic) - -data ArchiveFormat = TargzFormat | ZipFormat -- ... - deriving (Show, Eq) - -defaultSDistExFlags :: SDistExFlags -defaultSDistExFlags = SDistExFlags { - sDistFormat = Flag TargzFormat - } - -sdistCommand :: CommandUI (SDistFlags, SDistExFlags) +sdistCommand :: CommandUI SDistFlags sdistCommand = Cabal.sdistCommand { commandUsage = \pname -> "Usage: " ++ pname ++ " v1-sdist [FLAGS]\n", - commandDefaultFlags = (commandDefaultFlags Cabal.sdistCommand, defaultSDistExFlags), - commandOptions = \showOrParseArgs -> - liftOptions fst setFst (commandOptions Cabal.sdistCommand showOrParseArgs) - ++ liftOptions snd setSnd sdistExOptions + commandDefaultFlags = (commandDefaultFlags Cabal.sdistCommand) } - where - setFst a (_,b) = (a,b) - setSnd b (a,_) = (a,b) - sdistExOptions = - [option [] ["archive-format"] "archive-format" - sDistFormat (\v flags -> flags { sDistFormat = v }) - (choiceOpt - [ (Flag TargzFormat, ([], ["targz"]), - "Produce a '.tar.gz' format archive (default and required for uploading to hackage)") - , (Flag ZipFormat, ([], ["zip"]), - "Produce a '.zip' format archive") - ]) - ] -instance Monoid SDistExFlags where - mempty = gmempty - mappend = (<>) - -instance Semigroup SDistExFlags where - (<>) = gmappend - -- doctestCommand :: CommandUI DoctestFlags @@ -2723,6 +2803,7 @@ ] } + -- ------------------------------------------------------------ -- * GetOpt Utils -- ------------------------------------------------------------ @@ -2754,13 +2835,16 @@ -> (flags -> Flag Int ) -> (Flag Int -> flags -> flags) -> (flags -> Flag ReorderGoals) -> (Flag ReorderGoals -> flags -> flags) -> (flags -> Flag CountConflicts) -> (Flag CountConflicts -> flags -> flags) + -> (flags -> Flag MinimizeConflictSet) -> (Flag MinimizeConflictSet -> flags -> flags) -> (flags -> Flag IndependentGoals) -> (Flag IndependentGoals -> flags -> flags) -> (flags -> Flag ShadowPkgs) -> (Flag ShadowPkgs -> flags -> flags) -> (flags -> Flag StrongFlags) -> (Flag StrongFlags -> flags -> flags) -> (flags -> Flag AllowBootLibInstalls) -> (Flag AllowBootLibInstalls -> flags -> flags) + -> (flags -> Flag OnlyConstrained) -> (Flag OnlyConstrained -> flags -> flags) -> [OptionField flags] -optionSolverFlags showOrParseArgs getmbj setmbj getrg setrg getcc setcc getig setig - getsip setsip getstrfl setstrfl getib setib = +optionSolverFlags showOrParseArgs getmbj setmbj getrg setrg getcc setcc + getmc setmc getig setig getsip setsip getstrfl setstrfl + getib setib getoc setoc = [ option [] ["max-backjumps"] ("Maximum number of backjumps allowed while solving (default: " ++ show defaultMaxBackjumps ++ "). Use a negative number to enable unlimited backtracking. Use 0 to disable backtracking completely.") getmbj setmbj @@ -2776,6 +2860,13 @@ (fmap asBool . getcc) (setcc . fmap CountConflicts) (yesNoOpt showOrParseArgs) + , option [] ["minimize-conflict-set"] + ("When there is no solution, try to improve the error message by finding " + ++ "a minimal conflict set (default: false). May increase run time " + ++ "significantly.") + (fmap asBool . getmc) + (setmc . fmap MinimizeConflictSet) + (yesNoOpt showOrParseArgs) , option [] ["independent-goals"] "Treat several goals on the command line as independent. If several goals depend on the same package, different versions can be chosen." (fmap asBool . getig) @@ -2796,6 +2887,16 @@ (fmap asBool . getib) (setib . fmap AllowBootLibInstalls) (yesNoOpt showOrParseArgs) + , option [] ["reject-unconstrained-dependencies"] + "Require these packages to have constraints on them if they are to be selected (default: none)." + getoc + setoc + (reqArg "none|all" + (readP_to_E + (const "reject-unconstrained-dependencies must be 'none' or 'all'") + (toFlag `fmap` parse)) + (flagToList . fmap display)) + ] usageFlagsOrPackages :: String -> String -> String @@ -2828,8 +2929,8 @@ where pkgidToDependency :: PackageIdentifier -> Dependency pkgidToDependency p = case packageVersion p of - v | v == nullVersion -> Dependency (packageName p) anyVersion - | otherwise -> Dependency (packageName p) (thisVersion v) + v | v == nullVersion -> Dependency (packageName p) anyVersion (Set.singleton LMainLibName) + | otherwise -> Dependency (packageName p) (thisVersion v) (Set.singleton LMainLibName) showRepo :: RemoteRepo -> String showRepo repo = remoteRepoName repo ++ ":" diff --git a/cabal/cabal-install/Distribution/Client/SetupWrapper.hs b/cabal/cabal-install/Distribution/Client/SetupWrapper.hs --- a/cabal/cabal-install/Distribution/Client/SetupWrapper.hs +++ b/cabal/cabal-install/Distribution/Client/SetupWrapper.hs @@ -36,7 +36,6 @@ ( newSimpleUnitId, unsafeMkDefUnitId, ComponentId , PackageId, mkPackageName , PackageIdentifier(..), packageVersion, packageName ) -import Distribution.Types.Dependency import Distribution.PackageDescription ( GenericPackageDescription(packageDescription) , PackageDescription(..), specVersion, buildType @@ -97,7 +96,7 @@ import Distribution.ReadE import Distribution.System ( Platform(..), buildPlatform ) -import Distribution.Text +import Distribution.Deprecated.Text ( display ) import Distribution.Utils.NubList ( toNubListR ) @@ -128,11 +127,11 @@ -- | @Setup@ encapsulates the outcome of configuring a setup method to build a -- particular package. -data Setup = Setup { setupMethod :: SetupMethod +data Setup = Setup { setupMethod :: SetupMethod , setupScriptOptions :: SetupScriptOptions - , setupVersion :: Version - , setupBuildType :: BuildType - , setupPackage :: PackageDescription + , setupVersion :: Version + , setupBuildType :: BuildType + , setupPackage :: PackageDescription } -- | @SetupMethod@ represents one of the methods used to run Cabal commands. @@ -312,7 +311,7 @@ , setupPackage = pkg } where - getPkg = tryFindPackageDesc (fromMaybe "." (useWorkingDir options)) + getPkg = tryFindPackageDesc verbosity (fromMaybe "." (useWorkingDir options)) >>= readGenericPackageDescription verbosity >>= return . packageDescription @@ -719,10 +718,10 @@ return (packageVersion pkg, Nothing, options') installedCabalVersion options' compiler progdb = do index <- maybeGetInstalledPackages options' compiler progdb - let cabalDep = Dependency (mkPackageName "Cabal") - (useCabalVersion options') - options'' = options' { usePackageIndex = Just index } - case PackageIndex.lookupDependency index cabalDep of + let cabalDepName = mkPackageName "Cabal" + cabalDepVersion = useCabalVersion options' + options'' = options' { usePackageIndex = Just index } + case PackageIndex.lookupDependency index cabalDepName cabalDepVersion of [] -> die' verbosity $ "The package '" ++ display (packageName pkg) ++ "' requires Cabal library version " ++ display (useCabalVersion options) diff --git a/cabal/cabal-install/Distribution/Client/SolverInstallPlan.hs b/cabal/cabal-install/Distribution/Client/SolverInstallPlan.hs --- a/cabal/cabal-install/Distribution/Client/SolverInstallPlan.hs +++ b/cabal/cabal-install/Distribution/Client/SolverInstallPlan.hs @@ -55,7 +55,7 @@ ( PackageIdentifier(..), Package(..), PackageName , HasUnitId(..), PackageId, packageVersion, packageName ) import qualified Distribution.Solver.Types.ComponentDeps as CD -import Distribution.Text +import Distribution.Deprecated.Text ( display ) import Distribution.Client.Types diff --git a/cabal/cabal-install/Distribution/Client/SourceRepoParse.hs b/cabal/cabal-install/Distribution/Client/SourceRepoParse.hs --- a/cabal/cabal-install/Distribution/Client/SourceRepoParse.hs +++ b/cabal/cabal-install/Distribution/Client/SourceRepoParse.hs @@ -3,18 +3,19 @@ import Distribution.Client.Compat.Prelude import Prelude () +import Distribution.Deprecated.ParseUtils (FieldDescr (..), syntaxError) import Distribution.FieldGrammar.FieldDescrs (fieldDescrsToList) import Distribution.PackageDescription.FieldGrammar (sourceRepoFieldGrammar) -import Distribution.Parsec.Class (explicitEitherParsec) -import Distribution.ParseUtils (FieldDescr (..), syntaxError) -import Distribution.Types.SourceRepo (SourceRepo, RepoKind (..)) +import Distribution.Parsec (explicitEitherParsec) +import Distribution.Simple.Utils (fromUTF8BS) +import Distribution.Types.SourceRepo (RepoKind (..), SourceRepo) sourceRepoFieldDescrs :: [FieldDescr SourceRepo] sourceRepoFieldDescrs = map toDescr . fieldDescrsToList $ sourceRepoFieldGrammar (RepoKindUnknown "unused") where toDescr (name, pretty, parse) = FieldDescr - { fieldName = name + { fieldName = fromUTF8BS name , fieldGet = pretty , fieldSet = \lineNo str x -> either (syntaxError lineNo) return diff --git a/cabal/cabal-install/Distribution/Client/SrcDist.hs b/cabal/cabal-install/Distribution/Client/SrcDist.hs --- a/cabal/cabal-install/Distribution/Client/SrcDist.hs +++ b/cabal/cabal-install/Distribution/Client/SrcDist.hs @@ -24,16 +24,14 @@ ( readGenericPackageDescription ) import Distribution.Simple.Utils ( createDirectoryIfMissingVerbose, defaultPackageDesc - , warn, die', notice, withTempDirectory ) + , warn, notice, withTempDirectory ) import Distribution.Client.Setup - ( SDistFlags(..), SDistExFlags(..), ArchiveFormat(..) ) + ( SDistFlags(..) ) import Distribution.Simple.Setup ( Flag(..), sdistCommand, flagToList, fromFlag, fromFlagOrDefault , defaultSDistFlags ) import Distribution.Simple.BuildPaths ( srcPref) -import Distribution.Simple.Program (requireProgram, simpleProgram, programPath) -import Distribution.Simple.Program.Db (emptyProgramDb) -import Distribution.Text ( display ) +import Distribution.Deprecated.Text ( display ) import Distribution.Verbosity (Verbosity, normal, lessVerbose) import Distribution.Version (mkVersion, orLaterVersion, intersectVersionRanges) @@ -43,14 +41,12 @@ import System.FilePath ((), (<.>)) import Control.Monad (when, unless, liftM) -import System.Directory (doesFileExist, removeFile, canonicalizePath, getTemporaryDirectory) -import System.Process (runProcess, waitForProcess) -import System.Exit (ExitCode(..)) +import System.Directory (getTemporaryDirectory) import Control.Exception (IOException, evaluate) -- |Create a source distribution. -sdist :: SDistFlags -> SDistExFlags -> IO () -sdist flags exflags = do +sdist :: SDistFlags -> IO () +sdist flags = do pkg <- liftM flattenPackageDescription (readGenericPackageDescription verbosity =<< defaultPackageDesc verbosity) let withDir :: (FilePath -> IO a) -> IO a @@ -74,7 +70,7 @@ -- Unless we were given --list-sources or --output-directory ourselves, -- create an archive. when needMakeArchive $ - createArchive verbosity pkg tmpDir distPref + createTarGzArchive verbosity pkg tmpDir distPref when isOutDirectory $ notice verbosity $ "Source directory created: " ++ tmpTargetDir @@ -100,10 +96,6 @@ then orLaterVersion $ mkVersion [1,17,0] else orLaterVersion $ mkVersion [1,12,0] } - format = fromFlag (sDistFormat exflags) - createArchive = case format of - TargzFormat -> createTarGzArchive - ZipFormat -> createZipArchive tarBallName :: PackageDescription -> String tarBallName = display . packageId @@ -116,38 +108,6 @@ notice verbosity $ "Source tarball created: " ++ tarBallFilePath where tarBallFilePath = targetPref tarBallName pkg <.> "tar.gz" - --- | Create a zip archive from a tree of source files. -createZipArchive :: Verbosity -> PackageDescription -> FilePath -> FilePath - -> IO () -createZipArchive verbosity pkg tmpDir targetPref = do - let dir = tarBallName pkg - zipfile = targetPref dir <.> "zip" - (zipProg, _) <- requireProgram verbosity zipProgram emptyProgramDb - - -- zip has an annoying habit of updating the target rather than creating - -- it from scratch. While that might sound like an optimisation, it doesn't - -- remove files already in the archive that are no longer present in the - -- uncompressed tree. - alreadyExists <- doesFileExist zipfile - when alreadyExists $ removeFile zipfile - - -- We call zip with a different CWD, so have to make the path - -- absolute. Can't just use 'canonicalizePath zipfile' since this function - -- requires its argument to refer to an existing file. - zipfileAbs <- fmap ( dir <.> "zip") . canonicalizePath $ targetPref - - --TODO: use runProgramInvocation, but has to be able to set CWD - hnd <- runProcess (programPath zipProg) ["-q", "-r", zipfileAbs, dir] - (Just tmpDir) - Nothing Nothing Nothing Nothing - exitCode <- waitForProcess hnd - unless (exitCode == ExitSuccess) $ - die' verbosity $ "Generating the zip file failed " - ++ "(zip returned exit code " ++ show exitCode ++ ")" - notice verbosity $ "Source zip archive created: " ++ zipfile - where - zipProgram = simpleProgram "zip" -- | List all source files of a given add-source dependency. Exits with error if -- something is wrong (e.g. there is no .cabal file in the given directory). diff --git a/cabal/cabal-install/Distribution/Client/Store.hs b/cabal/cabal-install/Distribution/Client/Store.hs --- a/cabal/cabal-install/Distribution/Client/Store.hs +++ b/cabal/cabal-install/Distribution/Client/Store.hs @@ -34,7 +34,7 @@ import Distribution.Simple.Utils ( withTempDirectory, debug, info ) import Distribution.Verbosity -import Distribution.Text +import Distribution.Deprecated.Text import Data.Set (Set) import qualified Data.Set as Set diff --git a/cabal/cabal-install/Distribution/Client/TargetSelector.hs b/cabal/cabal-install/Distribution/Client/TargetSelector.hs --- a/cabal/cabal-install/Distribution/Client/TargetSelector.hs +++ b/cabal/cabal-install/Distribution/Client/TargetSelector.hs @@ -61,11 +61,11 @@ import Distribution.ModuleName ( ModuleName, toFilePath ) import Distribution.Simple.LocalBuildInfo - ( Component(..), ComponentName(..) + ( Component(..), ComponentName(..), LibraryName(..) , pkgComponents, componentName, componentBuildInfo ) import Distribution.Types.ForeignLib -import Distribution.Text +import Distribution.Deprecated.Text ( Text, display, simpleParse ) import Distribution.Simple.Utils ( die', lowercase, ordNub ) @@ -86,10 +86,10 @@ import Control.Arrow ((&&&)) import Control.Monad hiding ( mfilter ) -import qualified Distribution.Compat.ReadP as Parse -import Distribution.Compat.ReadP +import qualified Distribution.Deprecated.ReadP as Parse +import Distribution.Deprecated.ReadP ( (+++), (<++) ) -import Distribution.ParseUtils +import Distribution.Deprecated.ParseUtils ( readPToMaybe ) import System.FilePath as FilePath ( takeExtension, dropExtension @@ -102,6 +102,7 @@ import Text.EditDistance ( defaultEditCosts, restrictedDamerauLevenshteinDistance ) +import qualified Prelude (foldr1) -- ------------------------------------------------------------ -- * Target selector terms @@ -552,8 +553,7 @@ go (TargetPackageNamed _ (Just filter')) = kfilter == filter' go (TargetAllPackages (Just filter')) = kfilter == filter' go (TargetComponent _ cname _) - | CLibName <- cname = kfilter == LibKind - | CSubLibName _ <- cname = kfilter == LibKind + | CLibName _ <- cname = kfilter == LibKind | CFLibName _ <- cname = kfilter == FLibKind | CExeName _ <- cname = kfilter == ExeKind | CTestName _ <- cname = kfilter == TestKind @@ -931,8 +931,8 @@ , syntaxForm7MetaNamespacePackageKindComponentNamespaceFile pinfo ] where - ambiguousAlternatives = foldr1 AmbiguousAlternatives - shadowingAlternatives = foldr1 ShadowingAlternatives + ambiguousAlternatives = Prelude.foldr1 AmbiguousAlternatives + shadowingAlternatives = Prelude.foldr1 ShadowingAlternatives -- | Syntax: "all" to select all packages in the project @@ -1183,7 +1183,7 @@ KnownPackageName pn -> do m <- matchModuleNameUnknown str2 -- We assume the primary library component of the package: - return (TargetComponentUnknown pn (Right CLibName) (ModuleTarget m)) + return (TargetComponentUnknown pn (Right $ CLibName LMainLibName) (ModuleTarget m)) where render (TargetComponent p _c (ModuleTarget m)) = [TargetStringFileStatus2 (dispP p) noFileStatus (dispM m)] @@ -1228,7 +1228,7 @@ KnownPackageName pn -> let filepath = str2 in -- We assume the primary library component of the package: - return (TargetComponentUnknown pn (Right CLibName) (FileTarget filepath)) + return (TargetComponentUnknown pn (Right $ CLibName LMainLibName) (FileTarget filepath)) where render (TargetComponent p _c (FileTarget f)) = [TargetStringFileStatus2 (dispP p) noFileStatus f] @@ -1799,8 +1799,8 @@ componentStringName :: PackageName -> ComponentName -> ComponentStringName -componentStringName pkgname CLibName = display pkgname -componentStringName _ (CSubLibName name) = unUnqualComponentName name +componentStringName pkgname (CLibName LMainLibName) = display pkgname +componentStringName _ (CLibName (LSubLibName name)) = unUnqualComponentName name componentStringName _ (CFLibName name) = unUnqualComponentName name componentStringName _ (CExeName name) = unUnqualComponentName name componentStringName _ (CTestName name) = unUnqualComponentName name @@ -1859,8 +1859,7 @@ -- componentKind :: ComponentName -> ComponentKind -componentKind CLibName = LibKind -componentKind (CSubLibName _) = LibKind +componentKind (CLibName _) = LibKind componentKind (CFLibName _) = FLibKind componentKind (CExeName _) = ExeKind componentKind (CTestName _) = TestKind @@ -2390,8 +2389,8 @@ case ckind of LibKind | packageNameToUnqualComponentName pkgname == ucname - -> CLibName - | otherwise -> CSubLibName ucname + -> CLibName LMainLibName + | otherwise -> CLibName $ LSubLibName ucname FLibKind -> CFLibName ucname ExeKind -> CExeName ucname TestKind -> CTestName ucname diff --git a/cabal/cabal-install/Distribution/Client/Targets.hs b/cabal/cabal-install/Distribution/Client/Targets.hs --- a/cabal/cabal-install/Distribution/Client/Targets.hs +++ b/cabal/cabal-install/Distribution/Client/Targets.hs @@ -50,10 +50,13 @@ import Prelude () import Distribution.Client.Compat.Prelude +import Distribution.Deprecated.ParseUtils (parseFlagAssignment) + import Distribution.Package ( Package(..), PackageName, unPackageName, mkPackageName , PackageIdentifier(..), packageName, packageVersion ) import Distribution.Types.Dependency +import Distribution.Types.LibraryName import Distribution.Client.Types ( PackageLocation(..), ResolvedPkgLoc, UnresolvedSourcePackage , PackageSpecifier(..) ) @@ -75,10 +78,10 @@ ( RepoContext(..) ) import Distribution.PackageDescription - ( GenericPackageDescription, parseFlagAssignment, nullFlagAssignment ) + ( GenericPackageDescription, nullFlagAssignment) import Distribution.Version ( nullVersion, thisVersion, anyVersion, isAnyVersion ) -import Distribution.Text +import Distribution.Deprecated.Text ( Text(..), display ) import Distribution.Verbosity (Verbosity) import Distribution.Simple.Utils @@ -91,13 +94,14 @@ import Data.Either ( partitionEithers ) import qualified Data.Map as Map +import qualified Data.Set as Set import qualified Data.ByteString.Lazy as BS import qualified Distribution.Client.GZipUtils as GZipUtils import Control.Monad (mapM) -import qualified Distribution.Compat.ReadP as Parse -import Distribution.Compat.ReadP +import qualified Distribution.Deprecated.ReadP as Parse +import Distribution.Deprecated.ReadP ( (+++), (<++) ) -import Distribution.ParseUtils +import Distribution.Deprecated.ParseUtils ( readPToMaybe ) import System.FilePath ( takeExtension, dropExtension, takeDirectory, splitPath ) @@ -187,7 +191,7 @@ readUserTarget :: String -> IO (Either UserTargetProblem UserTarget) readUserTarget targetstr = case testNamedTargets targetstr of - Just (Dependency pkgn verrange) + Just (Dependency pkgn verrange _) | pkgn == mkPackageName "world" -> return $ if verrange == anyVersion then Right UserTargetWorld @@ -255,8 +259,8 @@ where pkgidToDependency :: PackageIdentifier -> Dependency pkgidToDependency p = case packageVersion p of - v | v == nullVersion -> Dependency (packageName p) anyVersion - | otherwise -> Dependency (packageName p) (thisVersion v) + v | v == nullVersion -> Dependency (packageName p) anyVersion (Set.singleton LMainLibName) + | otherwise -> Dependency (packageName p) (thisVersion v) (Set.singleton LMainLibName) reportUserTargetProblems :: Verbosity -> [UserTargetProblem] -> IO () @@ -376,7 +380,7 @@ -> IO [PackageTarget (PackageLocation ())] expandUserTarget verbosity worldFile userTarget = case userTarget of - UserTargetNamed (Dependency name vrange) -> + UserTargetNamed (Dependency name vrange _cs) -> let props = [ PackagePropertyVersion vrange | not (isAnyVersion vrange) ] in return [PackageTargetNamedFuzzy name props userTarget] @@ -385,7 +389,7 @@ worldPkgs <- World.getContents verbosity worldFile --TODO: should we warn if there are no world targets? return [ PackageTargetNamed name props userTarget - | World.WorldPkgInfo (Dependency name vrange) flags <- worldPkgs + | World.WorldPkgInfo (Dependency name vrange _) flags <- worldPkgs , let props = [ PackagePropertyVersion vrange | not (isAnyVersion vrange) ] ++ [ PackagePropertyFlags flags @@ -774,7 +778,7 @@ -- don't get an ambiguous parse from 'installed', -- 'source', etc. being regarded as flags. <++ - (Parse.skipSpaces1 >> parseFlagAssignment + (Parse.skipSpaces1 >> parseFlagAssignment >>= return . PackagePropertyFlags) -- Result diff --git a/cabal/cabal-install/Distribution/Client/Types.hs b/cabal/cabal-install/Distribution/Client/Types.hs --- a/cabal/cabal-install/Distribution/Client/Types.hs +++ b/cabal/cabal-install/Distribution/Client/Types.hs @@ -46,6 +46,8 @@ ( PackageName, mkPackageName ) import Distribution.Types.ComponentName ( ComponentName(..) ) +import Distribution.Types.LibraryName + ( LibraryName(..) ) import Distribution.Types.SourceRepo ( SourceRepo ) @@ -61,10 +63,10 @@ import Distribution.Solver.Types.PackageFixedDeps import Distribution.Solver.Types.SourcePackage import Distribution.Compat.Graph (IsNode(..)) -import qualified Distribution.Compat.ReadP as Parse -import Distribution.ParseUtils (parseOptCommaList) +import qualified Distribution.Deprecated.ReadP as Parse +import Distribution.Deprecated.ParseUtils (parseOptCommaList) import Distribution.Simple.Utils (ordNub) -import Distribution.Text (Text(..)) +import Distribution.Deprecated.Text (Text(..)) import Network.URI (URI(..), URIAuth(..), nullURI) import Control.Exception @@ -109,7 +111,7 @@ -- final configure process will be independent of the environment. -- -- 'ConfiguredPackage' is assumed to not support Backpack. Only the --- @new-build@ codepath supports Backpack. +-- @v2-build@ codepath supports Backpack. -- data ConfiguredPackage loc = ConfiguredPackage { confPkgId :: InstalledPackageId, @@ -129,7 +131,7 @@ -- 'ElaboratedPackage' and 'ElaboratedComponent'. -- instance HasConfiguredId (ConfiguredPackage loc) where - configuredId pkg = ConfiguredId (packageId pkg) (Just CLibName) (confPkgId pkg) + configuredId pkg = ConfiguredId (packageId pkg) (Just (CLibName LMainLibName)) (confPkgId pkg) -- 'ConfiguredPackage' is the legacy codepath, we are guaranteed -- to never have a nontrivial 'UnitId' @@ -181,7 +183,7 @@ packageId cpkg = packageId (confPkgSource cpkg) instance HasMungedPackageId (ConfiguredPackage loc) where - mungedId cpkg = computeCompatPackageId (packageId cpkg) Nothing + mungedId cpkg = computeCompatPackageId (packageId cpkg) LMainLibName -- Never has nontrivial UnitId instance HasUnitId (ConfiguredPackage loc) where @@ -595,8 +597,8 @@ -- ------------------------------------------------------------ -- | Whether 'v2-build' should write a .ghc.environment file after --- success. Possible values: 'always', 'never', 'ghc8.4.4+' (the --- default; GHC 8.4.4 is the earliest version that supports +-- success. Possible values: 'always', 'never' (the default), 'ghc8.4.4+' +-- (8.4.4 is the earliest version that supports -- '-package-env -'). data WriteGhcEnvironmentFilesPolicy = AlwaysWriteGhcEnvironmentFiles diff --git a/cabal/cabal-install/Distribution/Client/Update.hs b/cabal/cabal-install/Distribution/Client/Update.hs --- a/cabal/cabal-install/Distribution/Client/Update.hs +++ b/cabal/cabal-install/Distribution/Client/Update.hs @@ -33,7 +33,7 @@ ( newParallelJobControl, spawnJob, collectJob ) import Distribution.Client.Setup ( RepoContext(..), UpdateFlags(..) ) -import Distribution.Text +import Distribution.Deprecated.Text ( display ) import Distribution.Verbosity diff --git a/cabal/cabal-install/Distribution/Client/Upload.hs b/cabal/cabal-install/Distribution/Client/Upload.hs --- a/cabal/cabal-install/Distribution/Client/Upload.hs +++ b/cabal/cabal-install/Distribution/Client/Upload.hs @@ -9,13 +9,13 @@ import Distribution.Simple.Utils (notice, warn, info, die') import Distribution.Verbosity (Verbosity) -import Distribution.Text (display) +import Distribution.Deprecated.Text (display) import Distribution.Client.Config import qualified Distribution.Client.BuildReports.Anonymous as BuildReport import qualified Distribution.Client.BuildReports.Upload as BuildReport -import Network.URI (URI(uriPath)) +import Network.URI (URI(uriPath, uriAuthority), URIAuth(uriRegName)) import Network.HTTP (Header(..), HeaderName(..)) import System.IO (hFlush, stdout) @@ -52,6 +52,7 @@ [] -> die' verbosity "Cannot upload. No remote repositories are configured." rs -> remoteRepoTryUpgradeToHttps verbosity transport (last rs) let targetRepoURI = remoteRepoURI targetRepo + domain = maybe "Hackage" uriRegName $ uriAuthority targetRepoURI rootIfEmpty x = if null x then "/" else x uploadURI = targetRepoURI { uriPath = rootIfEmpty (uriPath targetRepoURI) FilePath.Posix. @@ -68,8 +69,8 @@ IsPublished -> "" ] } - Username username <- maybe promptUsername return mUsername - Password password <- maybe promptPassword return mPassword + Username username <- maybe (promptUsername domain) return mUsername + Password password <- maybe (promptPassword domain) return mPassword let auth = Just (username,password) forM_ paths $ \path -> do notice verbosity $ "Uploading " ++ path ++ "... " @@ -91,6 +92,7 @@ [] -> die' verbosity $ "Cannot upload. No remote repositories are configured." rs -> remoteRepoTryUpgradeToHttps verbosity transport (last rs) let targetRepoURI = remoteRepoURI targetRepo + domain = maybe "Hackage" uriRegName $ uriAuthority targetRepoURI rootIfEmpty x = if null x then "/" else x uploadURI = targetRepoURI { uriPath = rootIfEmpty (uriPath targetRepoURI) @@ -117,8 +119,8 @@ when (reverse reverseSuffix /= "docs.tar.gz" || null reversePkgid || head reversePkgid /= '-') $ die' verbosity "Expected a file name matching the pattern -docs.tar.gz" - Username username <- maybe promptUsername return mUsername - Password password <- maybe promptPassword return mPassword + Username username <- maybe (promptUsername domain) return mUsername + Password password <- maybe (promptPassword domain) return mPassword let auth = Just (username,password) headers = @@ -149,15 +151,15 @@ ++ show packageUri ++ "'." -promptUsername :: IO Username -promptUsername = do - putStr "Hackage username: " +promptUsername :: String -> IO Username +promptUsername domain = do + putStr $ domain ++ " username: " hFlush stdout fmap Username getLine -promptPassword :: IO Password -promptPassword = do - putStr "Hackage password: " +promptPassword :: String -> IO Password +promptPassword domain = do + putStr $ domain ++ " password: " hFlush stdout -- save/restore the terminal echoing status (no echoing for entering the password) passwd <- withoutInputEcho $ fmap Password getLine @@ -166,30 +168,32 @@ report :: Verbosity -> RepoContext -> Maybe Username -> Maybe Password -> IO () report verbosity repoCtxt mUsername mPassword = do - Username username <- maybe promptUsername return mUsername - Password password <- maybe promptPassword return mPassword - let auth = (username, password) - repos = repoContextRepos repoCtxt + let repos = repoContextRepos repoCtxt remoteRepos = mapMaybe maybeRepoRemote repos - forM_ remoteRepos $ \remoteRepo -> - do dotCabal <- getCabalDir - let srcDir = dotCabal "reports" remoteRepoName remoteRepo - -- We don't want to bomb out just because we haven't built any packages - -- from this repo yet. - srcExists <- doesDirectoryExist srcDir - when srcExists $ do - contents <- getDirectoryContents srcDir - forM_ (filter (\c -> takeExtension c ==".log") contents) $ \logFile -> - do inp <- readFile (srcDir logFile) - let (reportStr, buildLog) = read inp :: (String,String) -- TODO: eradicateNoParse - case BuildReport.parse reportStr of - Left errs -> warn verbosity $ "Errors: " ++ errs -- FIXME - Right report' -> - do info verbosity $ "Uploading report for " - ++ display (BuildReport.package report') - BuildReport.uploadReports verbosity repoCtxt auth - (remoteRepoURI remoteRepo) [(report', Just buildLog)] - return () + forM_ remoteRepos $ \remoteRepo -> do + let domain = maybe "Hackage" uriRegName $ uriAuthority (remoteRepoURI remoteRepo) + Username username <- maybe (promptUsername domain) return mUsername + Password password <- maybe (promptPassword domain) return mPassword + let auth = (username, password) + + dotCabal <- getCabalDir + let srcDir = dotCabal "reports" remoteRepoName remoteRepo + -- We don't want to bomb out just because we haven't built any packages + -- from this repo yet. + srcExists <- doesDirectoryExist srcDir + when srcExists $ do + contents <- getDirectoryContents srcDir + forM_ (filter (\c -> takeExtension c ==".log") contents) $ \logFile -> + do inp <- readFile (srcDir logFile) + let (reportStr, buildLog) = read inp :: (String,String) -- TODO: eradicateNoParse + case BuildReport.parse reportStr of + Left errs -> warn verbosity $ "Errors: " ++ errs -- FIXME + Right report' -> + do info verbosity $ "Uploading report for " + ++ display (BuildReport.package report') + BuildReport.uploadReports verbosity repoCtxt auth + (remoteRepoURI remoteRepo) [(report', Just buildLog)] + return () handlePackage :: HttpTransport -> Verbosity -> URI -> URI -> Auth -> IsCandidate -> FilePath -> IO () diff --git a/cabal/cabal-install/Distribution/Client/Utils/Parsec.hs b/cabal/cabal-install/Distribution/Client/Utils/Parsec.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-install/Distribution/Client/Utils/Parsec.hs @@ -0,0 +1,102 @@ +module Distribution.Client.Utils.Parsec ( + renderParseError, + ) where + +import Distribution.Client.Compat.Prelude +import Prelude () +import System.FilePath (normalise) + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BS8 + +import Distribution.Parsec (PError (..), PWarning (..), Position (..), showPos, zeroPos) +import Distribution.Simple.Utils (fromUTF8BS) + +-- | Render parse error highlighting the part of the input file. +renderParseError + :: FilePath + -> BS.ByteString + -> NonEmpty PError + -> [PWarning] + -> String +renderParseError filepath contents errors warnings = unlines $ + [ "Errors encountered when parsing cabal file " <> filepath <> ":" + ] + ++ renderedErrors + ++ renderedWarnings + where + filepath' = normalise filepath + + -- lines of the input file. 'lines' is taken, so they are called rows + -- contents, line number, whether it's empty line + rows :: [(String, Int, Bool)] + rows = zipWith f (BS8.lines contents) [1..] where + f bs i = let s = fromUTF8BS bs in (s, i, isEmptyOrComment s) + + rowsZipper = listToZipper rows + + isEmptyOrComment :: String -> Bool + isEmptyOrComment s = case dropWhile (== ' ') s of + "" -> True -- empty + ('-':'-':_) -> True -- comment + _ -> False + + renderedErrors = concatMap renderError errors + renderedWarnings = concatMap renderWarning warnings + + renderError :: PError -> [String] + renderError (PError pos@(Position row col) msg) + -- if position is 0:0, then it doesn't make sense to show input + -- looks like, Parsec errors have line-feed in them + | pos == zeroPos = msgs + | otherwise = msgs ++ formatInput row col + where + msgs = [ "", filepath' ++ ":" ++ showPos pos ++ ": error:", trimLF msg, "" ] + + renderWarning :: PWarning -> [String] + renderWarning (PWarning _ pos@(Position row col) msg) + | pos == zeroPos = msgs + | otherwise = msgs ++ formatInput row col + where + msgs = [ "", filepath' ++ ":" ++ showPos pos ++ ": warning:", trimLF msg, "" ] + + -- sometimes there are (especially trailing) newlines. + trimLF :: String -> String + trimLF = dropWhile (== '\n') . reverse . dropWhile (== '\n') . reverse + + -- format line: prepend the given line number + formatInput :: Int -> Int -> [String] + formatInput row col = case advance (row - 1) rowsZipper of + Zipper xs ys -> before ++ after where + before = case span (\(_, _, b) -> b) xs of + (_, []) -> [] + (zs, z : _) -> map formatInputLine $ z : reverse zs + + after = case ys of + [] -> [] + (z : _zs) -> + [ formatInputLine z -- error line + , " | " ++ replicate (col - 1) ' ' ++ "^" -- pointer: ^ + ] + -- do we need rows after? + -- ++ map formatInputLine (take 1 zs) -- one row after + + formatInputLine :: (String, Int, Bool) -> String + formatInputLine (str, row, _) = leftPadShow row ++ " | " ++ str + + -- hopefully we don't need to work with over 99999 lines .cabal files + -- at that point small glitches in error messages are hopefully fine. + leftPadShow :: Int -> String + leftPadShow n = let s = show n in replicate (5 - length s) ' ' ++ s + +data Zipper a = Zipper [a] [a] + +listToZipper :: [a] -> Zipper a +listToZipper = Zipper [] + +advance :: Int -> Zipper a -> Zipper a +advance n z@(Zipper xs ys) + | n <= 0 = z + | otherwise = case ys of + [] -> z + (y:ys') -> advance (n - 1) $ Zipper (y:xs) ys' diff --git a/cabal/cabal-install/Distribution/Client/World.hs b/cabal/cabal-install/Distribution/Client/World.hs --- a/cabal/cabal-install/Distribution/Client/World.hs +++ b/cabal/cabal-install/Distribution/Client/World.hs @@ -40,9 +40,9 @@ ( Verbosity ) import Distribution.Simple.Utils ( die', info, chattyTry, writeFileAtomic ) -import Distribution.Text +import Distribution.Deprecated.Text ( Text(..), display, simpleParse ) -import qualified Distribution.Compat.ReadP as Parse +import qualified Distribution.Deprecated.ReadP as Parse import Distribution.Compat.Exception ( catchIO ) import qualified Text.PrettyPrint as Disp @@ -74,8 +74,8 @@ -- | WorldPkgInfo values are considered equal if they refer to -- the same package, i.e., we don't care about differing versions or flags. equalUDep :: WorldPkgInfo -> WorldPkgInfo -> Bool -equalUDep (WorldPkgInfo (Dependency pkg1 _) _) - (WorldPkgInfo (Dependency pkg2 _) _) = pkg1 == pkg2 +equalUDep (WorldPkgInfo (Dependency pkg1 _ _) _) + (WorldPkgInfo (Dependency pkg2 _ _) _) = pkg1 == pkg2 -- | Modifies the world file by applying an update-function ('unionBy' -- for 'insert', 'deleteFirstsBy' for 'delete') to the given list of diff --git a/cabal/cabal-install/Distribution/Deprecated/ParseUtils.hs b/cabal/cabal-install/Distribution/Deprecated/ParseUtils.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-install/Distribution/Deprecated/ParseUtils.hs @@ -0,0 +1,724 @@ +{-# LANGUAGE CPP #-} +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Deprecated.ParseUtils +-- Copyright : (c) The University of Glasgow 2004 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Utilities for parsing 'PackageDescription' and 'InstalledPackageInfo'. +-- +-- The @.cabal@ file format is not trivial, especially with the introduction +-- of configurations and the section syntax that goes with that. This module +-- has a bunch of parsing functions that is used by the @.cabal@ parser and a +-- couple others. It has the parsing framework code and also little parsers for +-- many of the formats we get in various @.cabal@ file fields, like module +-- names, comma separated lists etc. + +-- This module is meant to be local-only to Distribution... + +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE Rank2Types #-} +module Distribution.Deprecated.ParseUtils ( + LineNo, PError(..), PWarning(..), locatedErrorMsg, syntaxError, warning, + runP, runE, ParseResult(..), catchParseError, parseFail, showPWarning, + Field(..), fName, lineNo, + FieldDescr(..), ppField, ppFields, readFields, readFieldsFlat, + showFields, showSingleNamedField, showSimpleSingleNamedField, + parseFields, parseFieldsFlat, + parseHaskellString, parseFilePathQ, parseTokenQ, parseTokenQ', + parseModuleNameQ, + parseFlagAssignment, + parseOptVersion, parsePackageName, + parseSepList, parseCommaList, parseOptCommaList, + showFilePath, showToken, showTestedWith, showFreeText, parseFreeText, + field, simpleField, listField, listFieldWithSep, spaceListField, + commaListField, commaListFieldWithSep, commaNewLineListField, newLineListField, + optsField, liftField, boolField, parseQuoted, parseMaybeQuoted, + readPToMaybe, + + UnrecFieldParser, warnUnrec, ignoreUnrec, + ) where + +import Distribution.Client.Compat.Prelude hiding (get) +import Prelude () + +import Distribution.Deprecated.ReadP as ReadP hiding (get) +import Distribution.Deprecated.Text + +import Distribution.Compat.Newtype +import Distribution.Compiler +import Distribution.ModuleName +import Distribution.Parsec.Newtypes (TestedWith (..)) +import Distribution.Pretty +import Distribution.ReadE +import Distribution.Utils.Generic +import Distribution.Version +import Distribution.PackageDescription (FlagAssignment, mkFlagAssignment) + +import Data.Tree as Tree (Tree (..), flatten) +import System.FilePath (normalise) +import Text.PrettyPrint + (Doc, Mode (..), colon, comma, fsep, hsep, isEmpty, mode, nest, punctuate, render, + renderStyle, sep, style, text, vcat, ($+$), (<+>)) +import qualified Text.Read as Read +import qualified Data.Map as Map + +import qualified Control.Monad.Fail as Fail + +-- ----------------------------------------------------------------------------- + +type LineNo = Int + +data PError = AmbiguousParse String LineNo + | NoParse String LineNo + | TabsError LineNo + | FromString String (Maybe LineNo) + deriving (Eq, Show) + +data PWarning = PWarning String + | UTFWarning LineNo String + deriving (Eq, Show) + +showPWarning :: FilePath -> PWarning -> String +showPWarning fpath (PWarning msg) = + normalise fpath ++ ": " ++ msg +showPWarning fpath (UTFWarning line fname) = + normalise fpath ++ ":" ++ show line + ++ ": Invalid UTF-8 text in the '" ++ fname ++ "' field." + +data ParseResult a = ParseFailed PError | ParseOk [PWarning] a + deriving Show + +instance Functor ParseResult where + fmap _ (ParseFailed err) = ParseFailed err + fmap f (ParseOk ws x) = ParseOk ws $ f x + +instance Applicative ParseResult where + pure = ParseOk [] + (<*>) = ap + + +instance Monad ParseResult where + return = pure + ParseFailed err >>= _ = ParseFailed err + ParseOk ws x >>= f = case f x of + ParseFailed err -> ParseFailed err + ParseOk ws' x' -> ParseOk (ws'++ws) x' + +#if !(MIN_VERSION_base(4,9,0)) + fail = parseResultFail +#elif !(MIN_VERSION_base(4,13,0)) + fail = Fail.fail +#endif + +instance Fail.MonadFail ParseResult where + fail = parseResultFail + +parseResultFail :: String -> ParseResult a +parseResultFail s = parseFail (FromString s Nothing) + + +catchParseError :: ParseResult a -> (PError -> ParseResult a) + -> ParseResult a +p@(ParseOk _ _) `catchParseError` _ = p +ParseFailed e `catchParseError` k = k e + +parseFail :: PError -> ParseResult a +parseFail = ParseFailed + +runP :: LineNo -> String -> ReadP a a -> String -> ParseResult a +runP line fieldname p s = + case [ x | (x,"") <- results ] of + [a] -> ParseOk (utf8Warnings line fieldname s) a + --TODO: what is this double parse thing all about? + -- Can't we just do the all isSpace test the first time? + [] -> case [ x | (x,ys) <- results, all isSpace ys ] of + [a] -> ParseOk (utf8Warnings line fieldname s) a + [] -> ParseFailed (NoParse fieldname line) + _ -> ParseFailed (AmbiguousParse fieldname line) + _ -> ParseFailed (AmbiguousParse fieldname line) + where results = readP_to_S p s + +runE :: LineNo -> String -> ReadE a -> String -> ParseResult a +runE line fieldname p s = + case runReadE p s of + Right a -> ParseOk (utf8Warnings line fieldname s) a + Left e -> syntaxError line $ + "Parse of field '" ++ fieldname ++ "' failed (" ++ e ++ "): " ++ s + +utf8Warnings :: LineNo -> String -> String -> [PWarning] +utf8Warnings line fieldname s = + take 1 [ UTFWarning n fieldname + | (n,l) <- zip [line..] (lines s) + , '\xfffd' `elem` l ] + +locatedErrorMsg :: PError -> (Maybe LineNo, String) +locatedErrorMsg (AmbiguousParse f n) = (Just n, + "Ambiguous parse in field '"++f++"'.") +locatedErrorMsg (NoParse f n) = (Just n, + "Parse of field '"++f++"' failed.") +locatedErrorMsg (TabsError n) = (Just n, "Tab used as indentation.") +locatedErrorMsg (FromString s n) = (n, s) + +syntaxError :: LineNo -> String -> ParseResult a +syntaxError n s = ParseFailed $ FromString s (Just n) + +tabsError :: LineNo -> ParseResult a +tabsError ln = ParseFailed $ TabsError ln + +warning :: String -> ParseResult () +warning s = ParseOk [PWarning s] () + +-- | Field descriptor. The parameter @a@ parameterizes over where the field's +-- value is stored in. +data FieldDescr a + = FieldDescr + { fieldName :: String + , fieldGet :: a -> Doc + , fieldSet :: LineNo -> String -> a -> ParseResult a + -- ^ @fieldSet n str x@ Parses the field value from the given input + -- string @str@ and stores the result in @x@ if the parse was + -- successful. Otherwise, reports an error on line number @n@. + } + +field :: String -> (a -> Doc) -> ReadP a a -> FieldDescr a +field name showF readF = + FieldDescr name showF (\line val _st -> runP line name readF val) + +-- Lift a field descriptor storing into an 'a' to a field descriptor storing +-- into a 'b'. +liftField :: (b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b +liftField get set (FieldDescr name showF parseF) + = FieldDescr name (showF . get) + (\line str b -> do + a <- parseF line str (get b) + return (set a b)) + +-- Parser combinator for simple fields. Takes a field name, a pretty printer, +-- a parser function, an accessor, and a setter, returns a FieldDescr over the +-- compoid structure. +simpleField :: String -> (a -> Doc) -> ReadP a a + -> (b -> a) -> (a -> b -> b) -> FieldDescr b +simpleField name showF readF get set + = liftField get set $ field name showF readF + +commaListFieldWithSep :: Separator -> String -> (a -> Doc) -> ReadP [a] a + -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b +commaListFieldWithSep separator name showF readF get set = + liftField get set' $ + field name showF' (parseCommaList readF) + where + set' xs b = set (get b ++ xs) b + showF' = separator . punctuate comma . map showF + +commaListField :: String -> (a -> Doc) -> ReadP [a] a + -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b +commaListField = commaListFieldWithSep fsep + +commaNewLineListField :: String -> (a -> Doc) -> ReadP [a] a + -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b +commaNewLineListField = commaListFieldWithSep sep + +spaceListField :: String -> (a -> Doc) -> ReadP [a] a + -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b +spaceListField name showF readF get set = + liftField get set' $ + field name showF' (parseSpaceList readF) + where + set' xs b = set (get b ++ xs) b + showF' = fsep . map showF + +-- this is a different definition from listField, like +-- commaNewLineListField it pretty prints on multiple lines +newLineListField :: String -> (a -> Doc) -> ReadP [a] a + -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b +newLineListField = listFieldWithSep sep + +listFieldWithSep :: Separator -> String -> (a -> Doc) -> ReadP [a] a + -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b +listFieldWithSep separator name showF readF get set = + liftField get set' $ + field name showF' (parseOptCommaList readF) + where + set' xs b = set (get b ++ xs) b + showF' = separator . map showF + +listField :: String -> (a -> Doc) -> ReadP [a] a + -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b +listField = listFieldWithSep fsep + +optsField :: String -> CompilerFlavor -> (b -> [(CompilerFlavor,[String])]) + -> ([(CompilerFlavor,[String])] -> b -> b) -> FieldDescr b +optsField name flavor get set = + liftField (fromMaybe [] . lookup flavor . get) + (\opts b -> set (reorder (update flavor opts (get b))) b) $ + field name showF (sepBy parseTokenQ' (munch1 isSpace)) + where + update _ opts l | all null opts = l --empty opts as if no opts + update f opts [] = [(f,opts)] + update f opts ((f',opts'):rest) + | f == f' = (f, opts' ++ opts) : rest + | otherwise = (f',opts') : update f opts rest + reorder = sortBy (comparing fst) + showF = hsep . map text + +-- TODO: this is a bit smelly hack. It's because we want to parse bool fields +-- liberally but not accept new parses. We cannot do that with ReadP +-- because it does not support warnings. We need a new parser framework! +boolField :: String -> (b -> Bool) -> (Bool -> b -> b) -> FieldDescr b +boolField name get set = liftField get set (FieldDescr name showF readF) + where + showF = text . show + readF line str _ + | str == "True" = ParseOk [] True + | str == "False" = ParseOk [] False + | lstr == "true" = ParseOk [caseWarning] True + | lstr == "false" = ParseOk [caseWarning] False + | otherwise = ParseFailed (NoParse name line) + where + lstr = lowercase str + caseWarning = PWarning $ + "The '" ++ name ++ "' field is case sensitive, use 'True' or 'False'." + +ppFields :: [FieldDescr a] -> a -> Doc +ppFields fields x = + vcat [ ppField name (getter x) | FieldDescr name getter _ <- fields ] +showFields :: [FieldDescr a] -> a -> String +showFields fields = render . ($+$ text "") . ppFields fields + +showSingleNamedField :: [FieldDescr a] -> String -> Maybe (a -> String) +showSingleNamedField fields f = + case [ get | (FieldDescr f' get _) <- fields, f' == f ] of + [] -> Nothing + (get:_) -> Just (render . ppField f . get) + +showSimpleSingleNamedField :: [FieldDescr a] -> String -> Maybe (a -> String) +showSimpleSingleNamedField fields f = + case [ get | (FieldDescr f' get _) <- fields, f' == f ] of + [] -> Nothing + (get:_) -> Just (renderStyle myStyle . get) + where myStyle = style { mode = LeftMode } + +parseFields :: [FieldDescr a] -> a -> String -> ParseResult a +parseFields fields initial str = + readFields str >>= accumFields fields initial + +parseFieldsFlat :: [FieldDescr a] -> a -> String -> ParseResult a +parseFieldsFlat fields initial str = + readFieldsFlat str >>= accumFields fields initial + +accumFields :: [FieldDescr a] -> a -> [Field] -> ParseResult a +accumFields fields = foldM setField + 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 + +-- | The type of a function which, given a name-value pair of an +-- unrecognized field, and the current structure being built, +-- decides whether to incorporate the unrecognized field +-- (by returning Just x, where x is a possibly modified version +-- of the structure being built), or not (by returning Nothing). +type UnrecFieldParser a = (String,String) -> a -> Maybe a + +-- | A default unrecognized field parser which simply returns Nothing, +-- i.e. ignores all unrecognized fields, so warnings will be generated. +warnUnrec :: UnrecFieldParser a +warnUnrec _ _ = Nothing + +-- | A default unrecognized field parser which silently (i.e. no +-- warnings will be generated) ignores unrecognized fields, by +-- returning the structure being built unmodified. +ignoreUnrec :: UnrecFieldParser a +ignoreUnrec _ = Just + +------------------------------------------------------------------------------ + +-- The data type for our three syntactic categories +data Field + = F LineNo String String + -- ^ A regular @: @ field + | Section LineNo String String [Field] + -- ^ A section with a name and possible parameter. The syntactic + -- structure is: + -- + -- @ + -- { + -- * + -- } + -- @ + | IfBlock LineNo String [Field] [Field] + -- ^ A conditional block with an optional else branch: + -- + -- @ + -- if { + -- * + -- } else { + -- * + -- } + -- @ + deriving (Show + ,Eq) -- for testing + +lineNo :: Field -> LineNo +lineNo (F n _ _) = n +lineNo (Section n _ _ _) = n +lineNo (IfBlock n _ _ _) = n + +fName :: Field -> String +fName (F _ n _) = n +fName (Section _ n _ _) = n +fName _ = error "fname: not a field or section" + +readFields :: String -> ParseResult [Field] +readFields input = ifelse + =<< traverse (mkField 0) + =<< mkTree tokens + + where ls = (lines . normaliseLineEndings) input + tokens = (concatMap tokeniseLine . trimLines) ls + +readFieldsFlat :: String -> ParseResult [Field] +readFieldsFlat input = traverse (mkField 0) + =<< mkTree tokens + where ls = (lines . normaliseLineEndings) input + tokens = (concatMap tokeniseLineFlat . trimLines) ls + +-- attach line number and determine indentation +trimLines :: [String] -> [(LineNo, Indent, HasTabs, String)] +trimLines ls = [ (lineno, indent, hastabs, trimTrailing l') + | (lineno, l) <- zip [1..] ls + , let (sps, l') = span isSpace l + indent = length sps + hastabs = '\t' `elem` sps + , validLine l' ] + where validLine ('-':'-':_) = False -- Comment + validLine [] = False -- blank line + validLine _ = True + +-- | We parse generically based on indent level and braces '{' '}'. To do that +-- we split into lines and then '{' '}' tokens and other spans within a line. +data Token = + -- | The 'Line' token is for bits that /start/ a line, eg: + -- + -- > "\n blah blah { blah" + -- + -- tokenises to: + -- + -- > [Line n 2 False "blah blah", OpenBracket, Span n "blah"] + -- + -- so lines are the only ones that can have nested layout, since they + -- have a known indentation level. + -- + -- eg: we can't have this: + -- + -- > if ... { + -- > } else + -- > other + -- + -- because other cannot nest under else, since else doesn't start a line + -- so cannot have nested layout. It'd have to be: + -- + -- > if ... { + -- > } + -- > else + -- > other + -- + -- but that's not so common, people would normally use layout or + -- brackets not both in a single @if else@ construct. + -- + -- > if ... { foo : bar } + -- > else + -- > other + -- + -- this is OK + Line LineNo Indent HasTabs String + | Span LineNo String -- ^ span in a line, following brackets + | OpenBracket LineNo | CloseBracket LineNo + +type Indent = Int +type HasTabs = Bool + +-- | Tokenise a single line, splitting on '{' '}' and the spans in between. +-- Also trims leading & trailing space on those spans within the line. +tokeniseLine :: (LineNo, Indent, HasTabs, String) -> [Token] +tokeniseLine (n0, i, t, l) = case split n0 l of + (Span _ l':ss) -> Line n0 i t l' :ss + cs -> cs + where split _ "" = [] + split n s = case span (\c -> c /='}' && c /= '{') s of + ("", '{' : s') -> OpenBracket n : split n s' + (w , '{' : s') -> mkspan n w (OpenBracket n : split n s') + ("", '}' : s') -> CloseBracket n : split n s' + (w , '}' : s') -> mkspan n w (CloseBracket n : split n s') + (w , _) -> mkspan n w [] + + mkspan n s ss | null s' = ss + | otherwise = Span n s' : ss + where s' = trimTrailing (trimLeading s) + +tokeniseLineFlat :: (LineNo, Indent, HasTabs, String) -> [Token] +tokeniseLineFlat (n0, i, t, l) + | null l' = [] + | otherwise = [Line n0 i t l'] + where + l' = trimTrailing (trimLeading l) + +trimLeading, trimTrailing :: String -> String +trimLeading = dropWhile isSpace +trimTrailing = dropWhileEndLE isSpace + + +type SyntaxTree = Tree (LineNo, HasTabs, String) + +-- | Parse the stream of tokens into a tree of them, based on indent \/ layout +mkTree :: [Token] -> ParseResult [SyntaxTree] +mkTree toks = + layout 0 [] toks >>= \(trees, trailing) -> case trailing of + [] -> return trees + OpenBracket n:_ -> syntaxError n "mismatched brackets, unexpected {" + CloseBracket n:_ -> syntaxError n "mismatched brackets, unexpected }" + -- the following two should never happen: + Span n l :_ -> syntaxError n $ "unexpected span: " ++ show l + Line n _ _ l :_ -> syntaxError n $ "unexpected line: " ++ show l + + +-- | Parse the stream of tokens into a tree of them, based on indent +-- This parse state expect to be in a layout context, though possibly +-- nested within a braces context so we may still encounter closing braces. +layout :: Indent -- ^ indent level of the parent\/previous line + -> [SyntaxTree] -- ^ accumulating param, trees in this level + -> [Token] -- ^ remaining tokens + -> ParseResult ([SyntaxTree], [Token]) + -- ^ collected trees on this level and trailing tokens +layout _ a [] = return (reverse a, []) +layout i a (s@(Line _ i' _ _):ss) | i' < i = return (reverse a, s:ss) +layout i a (Line n _ t l:OpenBracket n':ss) = do + (sub, ss') <- braces n' [] ss + layout i (Node (n,t,l) sub:a) ss' + +layout i a (Span n l:OpenBracket n':ss) = do + (sub, ss') <- braces n' [] ss + layout i (Node (n,False,l) sub:a) ss' + +-- look ahead to see if following lines are more indented, giving a sub-tree +layout i a (Line n i' t l:ss) = do + lookahead <- layout (i'+1) [] ss + case lookahead of + ([], _) -> layout i (Node (n,t,l) [] :a) ss + (ts, ss') -> layout i (Node (n,t,l) ts :a) ss' + +layout _ _ ( OpenBracket n :_) = syntaxError n "unexpected '{'" +layout _ a (s@(CloseBracket _):ss) = return (reverse a, s:ss) +layout _ _ ( Span n l : _) = syntaxError n $ "unexpected span: " + ++ show l + +-- | Parse the stream of tokens into a tree of them, based on explicit braces +-- This parse state expects to find a closing bracket. +braces :: LineNo -- ^ line of the '{', used for error messages + -> [SyntaxTree] -- ^ accumulating param, trees in this level + -> [Token] -- ^ remaining tokens + -> ParseResult ([SyntaxTree],[Token]) + -- ^ collected trees on this level and trailing tokens +braces m a (Line n _ t l:OpenBracket n':ss) = do + (sub, ss') <- braces n' [] ss + braces m (Node (n,t,l) sub:a) ss' + +braces m a (Span n l:OpenBracket n':ss) = do + (sub, ss') <- braces n' [] ss + braces m (Node (n,False,l) sub:a) ss' + +braces m a (Line n i t l:ss) = do + lookahead <- layout (i+1) [] ss + case lookahead of + ([], _) -> braces m (Node (n,t,l) [] :a) ss + (ts, ss') -> braces m (Node (n,t,l) ts :a) ss' + +braces m a (Span n l:ss) = braces m (Node (n,False,l) []:a) ss +braces _ a (CloseBracket _:ss) = return (reverse a, ss) +braces n _ [] = syntaxError n $ "opening brace '{'" + ++ "has no matching closing brace '}'" +braces _ _ (OpenBracket n:_) = syntaxError n "unexpected '{'" + +-- | Convert the parse tree into the Field AST +-- Also check for dodgy uses of tabs in indentation. +mkField :: Int -> SyntaxTree -> ParseResult Field +mkField d (Node (n,t,_) _) | d >= 1 && t = tabsError n +mkField d (Node (n,_,l) ts) = case span (\c -> isAlphaNum c || c == '-') l of + ([], _) -> syntaxError n $ "unrecognised field or section: " ++ show l + (name, rest) -> case trimLeading rest of + (':':rest') -> do let followingLines = concatMap Tree.flatten ts + tabs = not (null [()| (_,True,_) <- followingLines ]) + if tabs && d >= 1 + then tabsError n + else return $ F n (map toLower name) + (fieldValue rest' followingLines) + rest' -> do ts' <- traverse (mkField (d+1)) ts + return (Section n (map toLower name) rest' ts') + where fieldValue firstLine followingLines = + let firstLine' = trimLeading firstLine + followingLines' = map (\(_,_,s) -> stripDot s) followingLines + allLines | null firstLine' = followingLines' + | otherwise = firstLine' : followingLines' + in intercalate "\n" allLines + stripDot "." = "" + stripDot s = s + +-- | Convert if/then/else 'Section's to 'IfBlock's +ifelse :: [Field] -> ParseResult [Field] +ifelse [] = return [] +ifelse (Section n "if" cond thenpart + :Section _ "else" as elsepart:fs) + | null cond = syntaxError n "'if' with missing condition" + | null thenpart = syntaxError n "'then' branch of 'if' is empty" + | not (null as) = syntaxError n "'else' takes no arguments" + | null elsepart = syntaxError n "'else' branch of 'if' is empty" + | otherwise = do tp <- ifelse thenpart + ep <- ifelse elsepart + fs' <- ifelse fs + return (IfBlock n cond tp ep:fs') +ifelse (Section n "if" cond thenpart:fs) + | null cond = syntaxError n "'if' with missing condition" + | null thenpart = syntaxError n "'then' branch of 'if' is empty" + | otherwise = do tp <- ifelse thenpart + fs' <- ifelse fs + return (IfBlock n cond tp []:fs') +ifelse (Section n "else" _ _:_) = syntaxError n + "stray 'else' with no preceding 'if'" +ifelse (Section n s a fs':fs) = do fs'' <- ifelse fs' + fs''' <- ifelse fs + return (Section n s a fs'' : fs''') +ifelse (f:fs) = do fs' <- ifelse fs + return (f : fs') + +------------------------------------------------------------------------------ + +-- |parse a module name +parseModuleNameQ :: ReadP r ModuleName +parseModuleNameQ = parseMaybeQuoted parse + +parseFilePathQ :: ReadP r FilePath +parseFilePathQ = parseTokenQ + -- removed until normalise is no longer broken, was: + -- liftM normalise parseTokenQ + +betweenSpaces :: ReadP r a -> ReadP r a +betweenSpaces act = do skipSpaces + res <- act + skipSpaces + return res + +parseOptVersion :: ReadP r Version +parseOptVersion = parseMaybeQuoted ver + where ver :: ReadP r Version + ver = parse <++ return nullVersion + +-- urgh, we can't define optQuotes :: ReadP r a -> ReadP r a +-- because the "compat" version of ReadP isn't quite powerful enough. In +-- particular, the type of <++ is ReadP r r -> ReadP r a -> ReadP r a +-- Hence the trick above to make 'lic' polymorphic. + +-- Different than the naive version. it turns out Read instance for String accepts +-- the ['a', 'b'] syntax, which we do not want. In particular it messes +-- up any token starting with []. +parseHaskellString :: ReadP r String +parseHaskellString = + readS_to_P $ + Read.readPrec_to_S (do Read.String s <- Read.lexP; return s) 0 + +parseTokenQ :: ReadP r String +parseTokenQ = parseHaskellString <++ munch1 (\x -> not (isSpace x) && x /= ',') + +parseTokenQ' :: ReadP r String +parseTokenQ' = parseHaskellString <++ munch1 (not . isSpace) + +parseSepList :: ReadP r b + -> ReadP r a -- ^The parser for the stuff between commas + -> ReadP r [a] +parseSepList sepr p = sepBy p separator + where separator = betweenSpaces sepr + +parseSpaceList :: ReadP r a -- ^The parser for the stuff between commas + -> ReadP r [a] +parseSpaceList p = sepBy p skipSpaces + +parseCommaList :: ReadP r a -- ^The parser for the stuff between commas + -> ReadP r [a] +parseCommaList = parseSepList (ReadP.char ',') + +-- This version avoid parse ambiguity for list element parsers +-- that have multiple valid parses of prefixes. +parseOptCommaList :: ReadP r a -> ReadP r [a] +parseOptCommaList p = sepBy p localSep + where + -- The separator must not be empty or it introduces ambiguity + localSep = (skipSpaces >> char ',' >> skipSpaces) + +++ (satisfy isSpace >> skipSpaces) + +parseQuoted :: ReadP r a -> ReadP r a +parseQuoted = between (ReadP.char '"') (ReadP.char '"') + +parseMaybeQuoted :: (forall r. ReadP r a) -> ReadP r' a +parseMaybeQuoted p = parseQuoted p <++ p + +parseFreeText :: ReadP.ReadP s String +parseFreeText = ReadP.munch (const True) + +readPToMaybe :: ReadP a a -> String -> Maybe a +readPToMaybe p str = listToMaybe [ r | (r,s) <- readP_to_S p str + , all isSpace s ] + +ppField :: String -> Doc -> Doc +ppField name fielddoc + | isEmpty fielddoc = mempty + | name `elem` nestedFields = text name <<>> colon $+$ nest indentWith fielddoc + | otherwise = text name <<>> colon <+> fielddoc + where + indentWith = 4 + nestedFields = + [ "description" + , "build-depends" + , "data-files" + , "extra-source-files" + , "extra-tmp-files" + , "exposed-modules" + , "asm-sources" + , "cmm-sources" + , "c-sources" + , "js-sources" + , "extra-libraries" + , "includes" + , "install-includes" + , "other-modules" + , "autogen-modules" + , "depends" + ] + +parseFlagAssignment :: ReadP r FlagAssignment +parseFlagAssignment = mkFlagAssignment <$> + sepBy parseFlagValue skipSpaces1 + where + parseFlagValue = + (do optional (char '+') + f <- parse + return (f, True)) + +++ (do _ <- char '-' + f <- parse + return (f, False)) + +------------------------------------------------------------------------------- +-- Internal +------------------------------------------------------------------------------- + +showTestedWith :: (CompilerFlavor, VersionRange) -> Doc +showTestedWith = pretty . pack' TestedWith diff --git a/cabal/cabal-install/Distribution/Deprecated/ReadP.hs b/cabal/cabal-install/Distribution/Deprecated/ReadP.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-install/Distribution/Deprecated/ReadP.hs @@ -0,0 +1,480 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} +----------------------------------------------------------------------------- +-- | +-- +-- Module : Distribution.Deprecated.ReadP +-- Copyright : (c) The University of Glasgow 2002 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Portability : portable +-- +-- This is a library of parser combinators, originally written by Koen Claessen. +-- It parses all alternatives in parallel, so it never keeps hold of +-- the beginning of the input string, a common source of space leaks with +-- other parsers. The '(+++)' choice combinator is genuinely commutative; +-- it makes no difference which branch is \"shorter\". +-- +-- See also Koen's paper /Parallel Parsing Processes/ +-- (). +-- +-- This version of ReadP has been locally hacked to make it H98, by +-- Martin Sjögren +-- +-- The unit tests have been moved to UnitTest.Distribution.Deprecated.ReadP, by +-- Mark Lentczner +----------------------------------------------------------------------------- + +module Distribution.Deprecated.ReadP + ( + -- * The 'ReadP' type + ReadP, -- :: * -> *; instance Functor, Monad, MonadPlus + + -- * Primitive operations + get, -- :: ReadP Char + look, -- :: ReadP String + (+++), -- :: ReadP a -> ReadP a -> ReadP a + (<++), -- :: ReadP a -> ReadP a -> ReadP a + gather, -- :: ReadP a -> ReadP (String, a) + + -- * Other operations + pfail, -- :: ReadP a + eof, -- :: ReadP () + satisfy, -- :: (Char -> Bool) -> ReadP Char + char, -- :: Char -> ReadP Char + string, -- :: String -> ReadP String + munch, -- :: (Char -> Bool) -> ReadP String + munch1, -- :: (Char -> Bool) -> ReadP String + skipSpaces, -- :: ReadP () + skipSpaces1,-- :: ReadP () + choice, -- :: [ReadP a] -> ReadP a + count, -- :: Int -> ReadP a -> ReadP [a] + between, -- :: ReadP open -> ReadP close -> ReadP a -> ReadP a + option, -- :: a -> ReadP a -> ReadP a + optional, -- :: ReadP a -> ReadP () + many, -- :: ReadP a -> ReadP [a] + many1, -- :: ReadP a -> ReadP [a] + skipMany, -- :: ReadP a -> ReadP () + skipMany1, -- :: ReadP a -> ReadP () + sepBy, -- :: ReadP a -> ReadP sep -> ReadP [a] + sepBy1, -- :: ReadP a -> ReadP sep -> ReadP [a] + endBy, -- :: ReadP a -> ReadP sep -> ReadP [a] + endBy1, -- :: ReadP a -> ReadP sep -> ReadP [a] + chainr, -- :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a + chainl, -- :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a + chainl1, -- :: ReadP a -> ReadP (a -> a -> a) -> ReadP a + chainr1, -- :: ReadP a -> ReadP (a -> a -> a) -> ReadP a + manyTill, -- :: ReadP a -> ReadP end -> ReadP [a] + + -- * Running a parser + ReadS, -- :: *; = String -> [(a,String)] + readP_to_S, -- :: ReadP a -> ReadS a + readS_to_P, -- :: ReadS a -> ReadP a + readP_to_E, + + -- ** Internal + Parser, + ) + where + +import Prelude () +import Distribution.Client.Compat.Prelude hiding (many, get) + +import Control.Monad( replicateM, (>=>) ) + +import qualified Control.Monad.Fail as Fail + +import Distribution.CabalSpecVersion (cabalSpecLatest) +import qualified Distribution.Compat.CharParsing as P +import qualified Distribution.Parsec as P + +import Distribution.ReadE (ReadE (..)) + +infixr 5 +++, <++ + +-- --------------------------------------------------------------------------- +-- The P type +-- is representation type -- should be kept abstract + +data P s a + = Get (s -> P s a) + | Look ([s] -> P s a) + | Fail + | Result a (P s a) + | Final [(a,[s])] -- invariant: list is non-empty! + +-- Monad, MonadPlus + +instance Functor (P s) where + fmap = liftM + +instance Applicative (P s) where + pure x = Result x Fail + (<*>) = ap + +instance Monad (P s) where + return = pure + + (Get f) >>= k = Get (f >=> k) + (Look f) >>= k = Look (f >=> k) + Fail >>= _ = Fail + (Result x p) >>= k = k x `mplus` (p >>= k) + (Final r) >>= k = final [ys' | (x,s) <- r, ys' <- run (k x) s] + +#if !(MIN_VERSION_base(4,9,0)) + fail _ = Fail +#elif !(MIN_VERSION_base(4,13,0)) + fail = Fail.fail +#endif + +instance Fail.MonadFail (P s) where + fail _ = Fail + +instance Alternative (P s) where + empty = mzero + (<|>) = mplus + +instance MonadPlus (P s) where + mzero = Fail + + -- most common case: two gets are combined + Get f1 `mplus` Get f2 = Get (\c -> f1 c `mplus` f2 c) + + -- results are delivered as soon as possible + Result x p `mplus` q = Result x (p `mplus` q) + p `mplus` Result x q = Result x (p `mplus` q) + + -- fail disappears + Fail `mplus` p = p + p `mplus` Fail = p + + -- two finals are combined + -- final + look becomes one look and one final (=optimization) + -- final + sthg else becomes one look and one final + Final r `mplus` Final t = Final (r ++ t) + Final r `mplus` Look f = Look (\s -> Final (r ++ run (f s) s)) + Final r `mplus` p = Look (\s -> Final (r ++ run p s)) + Look f `mplus` Final r = Look (\s -> Final (run (f s) s ++ r)) + p `mplus` Final r = Look (\s -> Final (run p s ++ r)) + + -- two looks are combined (=optimization) + -- look + sthg else floats upwards + Look f `mplus` Look g = Look (\s -> f s `mplus` g s) + Look f `mplus` p = Look (\s -> f s `mplus` p) + p `mplus` Look f = Look (\s -> p `mplus` f s) + +-- --------------------------------------------------------------------------- +-- The ReadP type + +newtype Parser r s a = R ((a -> P s r) -> P s r) +type ReadP r a = Parser r Char a + +-- Functor, Monad, MonadPlus + +instance Functor (Parser r s) where + fmap h (R f) = R (\k -> f (k . h)) + +instance Applicative (Parser r s) where + pure x = R (\k -> k x) + (<*>) = ap + +instance s ~ Char => Alternative (Parser r s) where + empty = pfail + (<|>) = (+++) + +instance Monad (Parser r s) where + return = pure + R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k)) + +#if !(MIN_VERSION_base(4,9,0)) + fail _ = R (const Fail) +#elif !(MIN_VERSION_base(4,13,0)) + fail = Fail.fail +#endif + +instance Fail.MonadFail (Parser r s) where + fail _ = R (const Fail) + +instance s ~ Char => MonadPlus (Parser r s) where + mzero = pfail + mplus = (+++) + +-- --------------------------------------------------------------------------- +-- Operations over P + +final :: [(a,[s])] -> P s a +-- Maintains invariant for Final constructor +final [] = Fail +final r = Final r + +run :: P c a -> ([c] -> [(a, [c])]) +run (Get f) (c:s) = run (f c) s +run (Look f) s = run (f s) s +run (Result x p) s = (x,s) : run p s +run (Final r) _ = r +run _ _ = [] + +-- --------------------------------------------------------------------------- +-- Operations over ReadP + +get :: ReadP r Char +-- ^ Consumes and returns the next character. +-- Fails if there is no input left. +get = R Get + +look :: ReadP r String +-- ^ Look-ahead: returns the part of the input that is left, without +-- consuming it. +look = R Look + +pfail :: ReadP r a +-- ^ Always fails. +pfail = R (const Fail) + +eof :: ReadP r () +-- ^ Succeeds iff we are at the end of input +eof = do { s <- look + ; if null s then return () + else pfail } + +(+++) :: ReadP r a -> ReadP r a -> ReadP r a +-- ^ Symmetric choice. +R f1 +++ R f2 = R (\k -> f1 k `mplus` f2 k) + +(<++) :: ReadP a a -> ReadP r a -> ReadP r a +-- ^ Local, exclusive, left-biased choice: If left parser +-- locally produces any result at all, then right parser is +-- not used. +R f <++ q = + do s <- look + probe (f return) s 0 + where + probe (Get f') (c:s) n = probe (f' c) s (n+1 :: Int) + probe (Look f') s n = probe (f' s) s n + probe p@(Result _ _) _ n = discard n >> R (p >>=) + probe (Final r) _ _ = R (Final r >>=) + probe _ _ _ = q + + discard 0 = return () + discard n = get >> discard (n-1 :: Int) + +gather :: ReadP (String -> P Char r) a -> ReadP r (String, a) +-- ^ Transforms a parser into one that does the same, but +-- in addition returns the exact characters read. +-- IMPORTANT NOTE: 'gather' gives a runtime error if its first argument +-- is built using any occurrences of readS_to_P. +gather (R m) = + R (\k -> gath id (m (\a -> return (\s -> k (s,a))))) + where + gath l (Get f) = Get (\c -> gath (l.(c:)) (f c)) + gath _ Fail = Fail + gath l (Look f) = Look (gath l . f) + gath l (Result k p) = k (l []) `mplus` gath l p + gath _ (Final _) = error "do not use readS_to_P in gather!" + +-- --------------------------------------------------------------------------- +-- Derived operations + +satisfy :: (Char -> Bool) -> ReadP r Char +-- ^ Consumes and returns the next character, if it satisfies the +-- specified predicate. +satisfy p = do c <- get; if p c then return c else pfail + +char :: Char -> ReadP r Char +-- ^ Parses and returns the specified character. +char c = satisfy (c ==) + +string :: String -> ReadP r String +-- ^ Parses and returns the specified string. +string this = do s <- look; scan this s + where + scan [] _ = return this + scan (x:xs) (y:ys) | x == y = get >> scan xs ys + scan _ _ = pfail + +munch :: (Char -> Bool) -> ReadP r String +-- ^ Parses the first zero or more characters satisfying the predicate. +munch p = + do s <- look + scan s + where + scan (c:cs) | p c = do _ <- get; s <- scan cs; return (c:s) + scan _ = do return "" + +munch1 :: (Char -> Bool) -> ReadP r String +-- ^ Parses the first one or more characters satisfying the predicate. +munch1 p = + do c <- get + if p c then do s <- munch p; return (c:s) + else pfail + +choice :: [ReadP r a] -> ReadP r a +-- ^ Combines all parsers in the specified list. +choice [] = pfail +choice [p] = p +choice (p:ps) = p +++ choice ps + +skipSpaces :: ReadP r () +-- ^ Skips all whitespace. +skipSpaces = + do s <- look + skip s + where + skip (c:s) | isSpace c = do _ <- get; skip s + skip _ = do return () + +skipSpaces1 :: ReadP r () +-- ^ Like 'skipSpaces' but succeeds only if there is at least one +-- whitespace character to skip. +skipSpaces1 = satisfy isSpace >> skipSpaces + +count :: Int -> ReadP r a -> ReadP r [a] +-- ^ @ count n p @ parses @n@ occurrences of @p@ in sequence. A list of +-- results is returned. +count n p = replicateM n p + +between :: ReadP r open -> ReadP r close -> ReadP r a -> ReadP r a +-- ^ @ between open close p @ parses @open@, followed by @p@ and finally +-- @close@. Only the value of @p@ is returned. +between open close p = do _ <- open + x <- p + _ <- close + return x + +option :: a -> ReadP r a -> ReadP r a +-- ^ @option x p@ will either parse @p@ or return @x@ without consuming +-- any input. +option x p = p +++ return x + +optional :: ReadP r a -> ReadP r () +-- ^ @optional p@ optionally parses @p@ and always returns @()@. +optional p = (p >> return ()) +++ return () + +many :: ReadP r a -> ReadP r [a] +-- ^ Parses zero or more occurrences of the given parser. +many p = return [] +++ many1 p + +many1 :: ReadP r a -> ReadP r [a] +-- ^ Parses one or more occurrences of the given parser. +many1 p = liftM2 (:) p (many p) + +skipMany :: ReadP r a -> ReadP r () +-- ^ Like 'many', but discards the result. +skipMany p = many p >> return () + +skipMany1 :: ReadP r a -> ReadP r () +-- ^ Like 'many1', but discards the result. +skipMany1 p = p >> skipMany p + +sepBy :: ReadP r a -> ReadP r sep -> ReadP r [a] +-- ^ @sepBy p sep@ parses zero or more occurrences of @p@, separated by @sep@. +-- Returns a list of values returned by @p@. +sepBy p sep = sepBy1 p sep +++ return [] + +sepBy1 :: ReadP r a -> ReadP r sep -> ReadP r [a] +-- ^ @sepBy1 p sep@ parses one or more occurrences of @p@, separated by @sep@. +-- Returns a list of values returned by @p@. +sepBy1 p sep = liftM2 (:) p (many (sep >> p)) + +endBy :: ReadP r a -> ReadP r sep -> ReadP r [a] +-- ^ @endBy p sep@ parses zero or more occurrences of @p@, separated and ended +-- by @sep@. +endBy p sep = many (do x <- p ; _ <- sep ; return x) + +endBy1 :: ReadP r a -> ReadP r sep -> ReadP r [a] +-- ^ @endBy p sep@ parses one or more occurrences of @p@, separated and ended +-- by @sep@. +endBy1 p sep = many1 (do x <- p ; _ <- sep ; return x) + +chainr :: ReadP r a -> ReadP r (a -> a -> a) -> a -> ReadP r a +-- ^ @chainr p op x@ parses zero or more occurrences of @p@, separated by @op@. +-- Returns a value produced by a /right/ associative application of all +-- functions returned by @op@. If there are no occurrences of @p@, @x@ is +-- returned. +chainr p op x = chainr1 p op +++ return x + +chainl :: ReadP r a -> ReadP r (a -> a -> a) -> a -> ReadP r a +-- ^ @chainl p op x@ parses zero or more occurrences of @p@, separated by @op@. +-- Returns a value produced by a /left/ associative application of all +-- functions returned by @op@. If there are no occurrences of @p@, @x@ is +-- returned. +chainl p op x = chainl1 p op +++ return x + +chainr1 :: ReadP r a -> ReadP r (a -> a -> a) -> ReadP r a +-- ^ Like 'chainr', but parses one or more occurrences of @p@. +chainr1 p op = scan + where scan = p >>= rest + rest x = do f <- op + y <- scan + return (f x y) + +++ return x + +chainl1 :: ReadP r a -> ReadP r (a -> a -> a) -> ReadP r a +-- ^ Like 'chainl', but parses one or more occurrences of @p@. +chainl1 p op = p >>= rest + where rest x = do f <- op + y <- p + rest (f x y) + +++ return x + +manyTill :: ReadP r a -> ReadP [a] end -> ReadP r [a] +-- ^ @manyTill p end@ parses zero or more occurrences of @p@, until @end@ +-- succeeds. Returns a list of values returned by @p@. +manyTill p end = scan + where scan = (end >> return []) <++ (liftM2 (:) p scan) + +-- --------------------------------------------------------------------------- +-- Converting between ReadP and Read + +readP_to_S :: ReadP a a -> ReadS a +-- ^ Converts a parser into a Haskell ReadS-style function. +-- This is the main way in which you can \"run\" a 'ReadP' parser: +-- the expanded type is +-- @ readP_to_S :: ReadP a -> String -> [(a,String)] @ +readP_to_S (R f) = run (f return) + +readS_to_P :: ReadS a -> ReadP r a +-- ^ Converts a Haskell ReadS-style function into a parser. +-- Warning: This introduces local backtracking in the resulting +-- parser, and therefore a possible inefficiency. +readS_to_P r = + R (\k -> Look (\s -> final [bs'' | (a,s') <- r s, bs'' <- run (k a) s'])) + +------------------------------------------------------------------------------- +-- Instances +------------------------------------------------------------------------------- + +instance t ~ Char => P.Parsing (Parser r t) where + try = id + () = const + skipMany = skipMany + skipSome = skipMany1 + unexpected = const pfail + eof = eof + + -- TODO: we would like to have <++ here + notFollowedBy p = ((Just <$> p) +++ pure Nothing) + >>= maybe (pure ()) (P.unexpected . show) + +instance t ~ Char => P.CharParsing (Parser r t) where + satisfy = satisfy + char = char + notChar c = satisfy (/= c) + anyChar = get + string = string + +instance t ~ Char => P.CabalParsing (Parser r t) where + parsecWarning _ _ = pure () + askCabalSpecVersion = pure cabalSpecLatest + +------------------------------------------------------------------------------- +-- ReadE +------------------------------------------------------------------------------- + +readP_to_E :: (String -> String) -> ReadP a a -> ReadE a +readP_to_E err r = + ReadE $ \txt -> case [ p | (p, s) <- readP_to_S r txt + , all isSpace s ] + of [] -> Left (err txt) + (p:_) -> Right p diff --git a/cabal/cabal-install/Distribution/Deprecated/Text.hs b/cabal/cabal-install/Distribution/Deprecated/Text.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-install/Distribution/Deprecated/Text.hs @@ -0,0 +1,410 @@ +{-# LANGUAGE DefaultSignatures #-} +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Deprecated.Text +-- Copyright : Duncan Coutts 2007 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- classes. The difference is that it uses a modern pretty printer and parser +-- system and the format is not expected to be Haskell concrete syntax but +-- rather the external human readable representation used by Cabal. +-- +module Distribution.Deprecated.Text ( + Text(..), + defaultStyle, + display, + flatStyle, + simpleParse, + stdParse, + -- parse utils + parsePackageName, + ) where + +import Distribution.Client.Compat.Prelude +import Prelude (read) + +import Distribution.Deprecated.ReadP ((<++)) +import qualified Distribution.Deprecated.ReadP as Parse + +import Data.Functor.Identity (Identity (..)) +import Distribution.Parsec +import Distribution.Pretty +import qualified Text.PrettyPrint as Disp + +import qualified Data.Set as Set + +import Data.Version (Version (Version)) + +import qualified Distribution.Compiler as D +import qualified Distribution.License as D +import qualified Distribution.ModuleName as D +import qualified Distribution.Package as D +import qualified Distribution.PackageDescription as D +import qualified Distribution.Simple.Setup as D +import qualified Distribution.System as D +import qualified Distribution.Types.PackageVersionConstraint as D +import qualified Distribution.Types.SourceRepo as D +import qualified Distribution.Types.UnqualComponentName as D +import qualified Distribution.Version as D +import qualified Distribution.Types.VersionRange.Internal as D +import qualified Language.Haskell.Extension as E + +-- | /Note:/ this class will soon be deprecated. +-- It's not yet, so that we are @-Wall@ clean. +class Text a where + disp :: a -> Disp.Doc + default disp :: Pretty a => a -> Disp.Doc + disp = pretty + + parse :: Parse.ReadP r a + default parse :: Parsec a => Parse.ReadP r a + parse = parsec + +-- | Pretty-prints with the default style. +display :: Text a => a -> String +display = Disp.renderStyle defaultStyle . disp + +simpleParse :: Text a => String -> Maybe a +simpleParse str = case [ p | (p, s) <- Parse.readP_to_S parse str + , all isSpace s ] of + [] -> Nothing + (p:_) -> Just p + +stdParse :: Text ver => (ver -> String -> res) -> Parse.ReadP r res +stdParse f = do + cs <- Parse.sepBy1 component (Parse.char '-') + _ <- Parse.char '-' + ver <- parse + let name = intercalate "-" cs + return $! f ver (lowercase name) + where + component = do + cs <- Parse.munch1 isAlphaNum + if all isDigit cs then Parse.pfail else return cs + -- each component must contain an alphabetic character, to avoid + -- ambiguity in identifiers like foo-1 (the 1 is the version number). + +lowercase :: String -> String +lowercase = map toLower + +-- ----------------------------------------------------------------------------- +-- Instances for types from the base package + +instance Text Bool where + parse = Parse.choice [ (Parse.string "True" Parse.+++ + Parse.string "true") >> return True + , (Parse.string "False" Parse.+++ + Parse.string "false") >> return False ] + +instance Text Int where + parse = fmap negate (Parse.char '-' >> parseNat) Parse.+++ parseNat + +instance Text a => Text (Identity a) where + disp = disp . runIdentity + parse = fmap Identity parse + +-- | Parser for non-negative integers. +parseNat :: Parse.ReadP r Int +parseNat = read `fmap` Parse.munch1 isDigit -- TODO: eradicateNoParse + + +instance Text Version where + disp (Version branch _tags) -- Death to version tags!! + = Disp.hcat (Disp.punctuate (Disp.char '.') (map Disp.int branch)) + + parse = do + branch <- Parse.sepBy1 parseNat (Parse.char '.') + -- allow but ignore tags: + _tags <- Parse.many (Parse.char '-' >> Parse.munch1 isAlphaNum) + return (Version branch []) + +------------------------------------------------------------------------------- +-- Instances +------------------------------------------------------------------------------- + +instance Text D.Arch where + parse = fmap (D.classifyArch D.Strict) ident + +instance Text D.BuildType where + parse = do + name <- Parse.munch1 isAlphaNum + case name of + "Simple" -> return D.Simple + "Configure" -> return D.Configure + "Custom" -> return D.Custom + "Make" -> return D.Make + "Default" -> return D.Custom + _ -> fail ("unknown build-type: '" ++ name ++ "'") + +instance Text D.CompilerFlavor where + parse = do + comp <- Parse.munch1 isAlphaNum + when (all isDigit comp) Parse.pfail + return (D.classifyCompilerFlavor comp) + +instance Text D.CompilerId where + parse = do + flavour <- parse + version <- (Parse.char '-' >> parse) Parse.<++ return D.nullVersion + return (D.CompilerId flavour version) + +instance Text D.ComponentId where + parse = D.mkComponentId `fmap` Parse.munch1 abi_char + where abi_char c = isAlphaNum c || c `elem` "-_." + +instance Text D.DefUnitId where + parse = D.unsafeMkDefUnitId `fmap` parse + +instance Text D.UnitId where + parse = D.mkUnitId <$> Parse.munch1 (\c -> isAlphaNum c || c `elem` "-_.+") + +instance Text D.Dependency where + parse = do name <- parse + Parse.skipSpaces + libs <- Parse.option [D.LMainLibName] + $ (Parse.char ':' *>) + $ pure <$> parseLib name <|> parseMultipleLibs name + Parse.skipSpaces + ver <- parse Parse.<++ return D.anyVersion + Parse.skipSpaces + return $ D.Dependency name ver $ Set.fromList libs + where makeLib pn ln | D.unPackageName pn == ln = D.LMainLibName + | otherwise = D.LSubLibName $ D.mkUnqualComponentName ln + parseLib pn = makeLib pn <$> parsecUnqualComponentName + parseMultipleLibs pn = Parse.between (Parse.char '{' *> Parse.skipSpaces) + (Parse.skipSpaces <* Parse.char '}') + $ parsecCommaList $ parseLib pn + + +instance Text E.Extension where + parse = do + extension <- Parse.munch1 isAlphaNum + return (E.classifyExtension extension) + +instance Text D.FlagName where + -- Note: we don't check that FlagName doesn't have leading dash, + -- cabal check will do that. + parse = D.mkFlagName . lowercase <$> parse' + where + parse' = (:) <$> lead <*> rest + lead = Parse.satisfy (\c -> isAlphaNum c || c == '_') + rest = Parse.munch (\c -> isAlphaNum c || c == '_' || c == '-') + +instance Text D.HaddockTarget where + parse = Parse.choice [ Parse.string "for-hackage" >> return D.ForHackage + , Parse.string "for-development" >> return D.ForDevelopment] + +instance Text E.Language where + parse = do + lang <- Parse.munch1 isAlphaNum + return (E.classifyLanguage lang) + +instance Text D.License where + parse = do + name <- Parse.munch1 (\c -> isAlphaNum c && c /= '-') + version <- Parse.option Nothing (Parse.char '-' >> fmap Just parse) + return $! case (name, version :: Maybe D.Version) of + ("GPL", _ ) -> D.GPL version + ("LGPL", _ ) -> D.LGPL version + ("AGPL", _ ) -> D.AGPL version + ("BSD2", Nothing) -> D.BSD2 + ("BSD3", Nothing) -> D.BSD3 + ("BSD4", Nothing) -> D.BSD4 + ("ISC", Nothing) -> D.ISC + ("MIT", Nothing) -> D.MIT + ("MPL", Just version') -> D.MPL version' + ("Apache", _ ) -> D.Apache version + ("PublicDomain", Nothing) -> D.PublicDomain + ("AllRightsReserved", Nothing) -> D.AllRightsReserved + ("OtherLicense", Nothing) -> D.OtherLicense + _ -> D.UnknownLicense $ name ++ + maybe "" (('-':) . display) version + +instance Text D.Module where + parse = do + uid <- parse + _ <- Parse.char ':' + mod_name <- parse + return (D.Module uid mod_name) + +instance Text D.ModuleName where + parse = do + ms <- Parse.sepBy1 component (Parse.char '.') + return (D.fromComponents ms) + + where + component = do + c <- Parse.satisfy isUpper + cs <- Parse.munch validModuleChar + return (c:cs) + +instance Text D.OS where + parse = fmap (D.classifyOS D.Compat) ident + +instance Text D.PackageVersionConstraint where + parse = do name <- parse + Parse.skipSpaces + ver <- parse Parse.<++ return D.anyVersion + Parse.skipSpaces + return (D.PackageVersionConstraint name ver) + +instance Text D.PkgconfigName where + parse = D.mkPkgconfigName + <$> Parse.munch1 (\c -> isAlphaNum c || c `elem` "+-._") + +instance Text D.Platform where + -- TODO: there are ambigious platforms like: `arch-word-os` + -- which could be parsed as + -- * Platform "arch-word" "os" + -- * Platform "arch" "word-os" + -- We could support that preferring variants 'OtherOS' or 'OtherArch' + -- + -- For now we split into arch and os parts on the first dash. + parse = do + arch <- parseDashlessArch + _ <- Parse.char '-' + os <- parse + return (D.Platform arch os) + where + parseDashlessArch :: Parse.ReadP r D.Arch + parseDashlessArch = fmap (D.classifyArch D.Strict) dashlessIdent + + dashlessIdent :: Parse.ReadP r String + dashlessIdent = liftM2 (:) firstChar rest + where firstChar = Parse.satisfy isAlpha + rest = Parse.munch (\c -> isAlphaNum c || c == '_') + +instance Text D.RepoKind where + parse = fmap D.classifyRepoKind ident + +instance Text D.RepoType where + parse = fmap D.classifyRepoType ident + +instance Text D.UnqualComponentName where + parse = D.mkUnqualComponentName <$> parsePackageName + +instance Text D.PackageIdentifier where + parse = do + n <- parse + v <- (Parse.char '-' >> parse) <++ return D.nullVersion + return (D.PackageIdentifier n v) + +instance Text D.PackageName where + parse = D.mkPackageName <$> parsePackageName + +instance Text D.Version where + parse = do + branch <- Parse.sepBy1 parseNat (Parse.char '.') + -- allow but ignore tags: + _tags <- Parse.many (Parse.char '-' >> Parse.munch1 isAlphaNum) + return (D.mkVersion branch) + +instance Text D.VersionRange where + parse = expr + where + expr = do Parse.skipSpaces + t <- term + Parse.skipSpaces + (do _ <- Parse.string "||" + Parse.skipSpaces + e <- expr + return (D.unionVersionRanges t e) + Parse.+++ + return t) + term = do f <- factor + Parse.skipSpaces + (do _ <- Parse.string "&&" + Parse.skipSpaces + t <- term + return (D.intersectVersionRanges f t) + Parse.+++ + return f) + factor = Parse.choice $ parens expr + : parseAnyVersion + : parseNoVersion + : parseWildcardRange + : map parseRangeOp rangeOps + parseAnyVersion = Parse.string "-any" >> return D.anyVersion + parseNoVersion = Parse.string "-none" >> return D.noVersion + + parseWildcardRange = do + _ <- Parse.string "==" + Parse.skipSpaces + branch <- Parse.sepBy1 digits (Parse.char '.') + _ <- Parse.char '.' + _ <- Parse.char '*' + return (D.withinVersion (D.mkVersion branch)) + + parens p = Parse.between (Parse.char '(' >> Parse.skipSpaces) + (Parse.char ')' >> Parse.skipSpaces) + (do a <- p + Parse.skipSpaces + return (D.VersionRangeParens a)) + digits = do + firstDigit <- Parse.satisfy isDigit + if firstDigit == '0' + then return 0 + else do rest <- Parse.munch isDigit + return (read (firstDigit : rest)) -- TODO: eradicateNoParse + + parseRangeOp (s,f) = Parse.string s >> Parse.skipSpaces >> fmap f parse + rangeOps = [ ("<", D.earlierVersion), + ("<=", D.orEarlierVersion), + (">", D.laterVersion), + (">=", D.orLaterVersion), + ("^>=", D.majorBoundVersion), + ("==", D.thisVersion) ] + +------------------------------------------------------------------------------- +-- ParseUtils +------------------------------------------------------------------------------- + +parsePackageName :: Parse.ReadP r String +parsePackageName = do + ns <- Parse.sepBy1 component (Parse.char '-') + return $ intercalate "-" ns + where + component = do + cs <- Parse.munch1 isAlphaNum + if all isDigit cs then Parse.pfail else return cs + -- each component must contain an alphabetic character, to avoid + -- ambiguity in identifiers like foo-1 (the 1 is the version number). + + +ident :: Parse.ReadP r String +ident = liftM2 (:) firstChar rest + where firstChar = Parse.satisfy isAlpha + rest = Parse.munch (\c -> isAlphaNum c || c == '_' || c == '-') + +validModuleChar :: Char -> Bool +validModuleChar c = isAlphaNum c || c == '_' || c == '\'' + +------------------------------------------------------------------------------- +-- Rest of instances, we don't seem to need +------------------------------------------------------------------------------- + +-- instance Text D.AbiDependency +-- instance Text D.AbiHash +-- instance Text D.AbiTa +-- instance Text D.BenchmarkType +-- instance Text D.ExecutableScope +-- instance Text D.ExeDependency +-- instance Text D.ExposedModule +-- instance Text D.ForeignLibOption +-- instance Text D.ForeignLibType +-- instance Text D.IncludeRenaming +-- instance Text D.KnownExtension +-- instance Text D.LegacyExeDependency +-- instance Text D.LibVersionInfo +-- instance Text D.License +-- instance Text D.Mixin +-- instance Text D.ModuleReexport +-- instance Text D.ModuleRenaming +-- instance Text D.MungedPackageName +-- instance Text D.OpenModule +-- instance Text D.OpenUnitId +-- instance Text D.PackageVersionConstraint +-- instance Text D.PkgconfigDependency +-- instance Text D.TestType diff --git a/cabal/cabal-install/Distribution/Deprecated/ViewAsFieldDescr.hs b/cabal/cabal-install/Distribution/Deprecated/ViewAsFieldDescr.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-install/Distribution/Deprecated/ViewAsFieldDescr.hs @@ -0,0 +1,85 @@ +module Distribution.Deprecated.ViewAsFieldDescr ( + viewAsFieldDescr + ) where + +import Distribution.Client.Compat.Prelude hiding (get) +import Prelude () + +import Distribution.Parsec (parsec) +import Distribution.Pretty +import Distribution.ReadE (parsecToReadE) +import Distribution.Simple.Command +import Text.PrettyPrint (cat, comma, punctuate, text) +import Text.PrettyPrint as PP (empty) + +import Distribution.Deprecated.ParseUtils (FieldDescr (..), runE, syntaxError) + +-- | to view as a FieldDescr, we sort the list of interfaces (Req > Bool > +-- Choice > Opt) and consider only the first one. +viewAsFieldDescr :: OptionField a -> FieldDescr a +viewAsFieldDescr (OptionField _n []) = + error "Distribution.command.viewAsFieldDescr: unexpected" +viewAsFieldDescr (OptionField n dd) = FieldDescr n get set + + where + optDescr = head $ sortBy cmp dd + + cmp :: OptDescr a -> OptDescr a -> Ordering + ReqArg{} `cmp` ReqArg{} = EQ + ReqArg{} `cmp` _ = GT + BoolOpt{} `cmp` ReqArg{} = LT + BoolOpt{} `cmp` BoolOpt{} = EQ + BoolOpt{} `cmp` _ = GT + ChoiceOpt{} `cmp` ReqArg{} = LT + ChoiceOpt{} `cmp` BoolOpt{} = LT + ChoiceOpt{} `cmp` ChoiceOpt{} = EQ + ChoiceOpt{} `cmp` _ = GT + OptArg{} `cmp` OptArg{} = EQ + OptArg{} `cmp` _ = LT + +-- get :: a -> Doc + get t = case optDescr of + ReqArg _ _ _ _ ppr -> + (cat . punctuate comma . map text . ppr) t + + OptArg _ _ _ _ _ ppr -> + case ppr t of [] -> PP.empty + (Nothing : _) -> text "True" + (Just a : _) -> text a + + ChoiceOpt alts -> + fromMaybe PP.empty $ listToMaybe + [ text lf | (_,(_,lf:_), _,enabled) <- alts, enabled t] + + BoolOpt _ _ _ _ enabled -> (maybe PP.empty pretty . enabled) t + +-- set :: LineNo -> String -> a -> ParseResult a + set line val a = + case optDescr of + ReqArg _ _ _ readE _ -> ($ a) `liftM` runE line n readE val + -- We parse for a single value instead of a + -- list, as one can't really implement + -- parseList :: ReadE a -> ReadE [a] with + -- the current ReadE definition + ChoiceOpt{} -> + case getChoiceByLongFlag optDescr val of + Just f -> return (f a) + _ -> syntaxError line val + + BoolOpt _ _ _ setV _ -> (`setV` a) `liftM` runE line n (parsecToReadE ("" ++) parsec) val + + OptArg _ _ _ readE _ _ -> ($ a) `liftM` runE line n readE val + -- Optional arguments are parsed just like + -- required arguments here; we don't + -- provide a method to set an OptArg field + -- to the default value. + +getChoiceByLongFlag :: OptDescr a -> String -> Maybe (a -> a) +getChoiceByLongFlag (ChoiceOpt alts) val = listToMaybe + [ set | (_,(_sf,lf:_), set, _) <- alts + , lf == val] + +getChoiceByLongFlag _ _ = + error "Distribution.command.getChoiceByLongFlag: expected a choice option" + + diff --git a/cabal/cabal-install/Distribution/Solver/Compat/Prelude.hs b/cabal/cabal-install/Distribution/Solver/Compat/Prelude.hs --- a/cabal/cabal-install/Distribution/Solver/Compat/Prelude.hs +++ b/cabal/cabal-install/Distribution/Solver/Compat/Prelude.hs @@ -3,7 +3,7 @@ -- | This module does two things: -- --- * Acts as a compatiblity layer, like @base-compat@. +-- * Acts as a compatibility layer, like @base-compat@. -- -- * Provides commonly used imports. -- diff --git a/cabal/cabal-install/Distribution/Solver/Modular.hs b/cabal/cabal-install/Distribution/Solver/Modular.hs --- a/cabal/cabal-install/Distribution/Solver/Modular.hs +++ b/cabal/cabal-install/Distribution/Solver/Modular.hs @@ -1,5 +1,8 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} + module Distribution.Solver.Modular - ( modularResolver, SolverConfig(..), PruneAfterFirstSuccess(..)) where + ( modularResolver, SolverConfig(..), PruneAfterFirstSuccess(..) ) where -- Here, we try to map between the external cabal-install solver -- interface and the internal interface that the solver actually @@ -13,7 +16,7 @@ import Distribution.Solver.Compat.Prelude import qualified Data.Map as M -import Data.Set (Set) +import Data.Set (Set, isSubsetOf) import Data.Ord import Distribution.Compat.Graph ( IsNode(..) ) @@ -30,9 +33,10 @@ import Distribution.Solver.Modular.IndexConversion ( convPIs ) import Distribution.Solver.Modular.Log - ( SolverFailure(..), logToProgress ) + ( SolverFailure(..), displayLogMessages ) import Distribution.Solver.Modular.Package ( PN ) +import Distribution.Solver.Modular.RetryLog import Distribution.Solver.Modular.Solver ( SolverConfig(..), PruneAfterFirstSuccess(..), solve ) import Distribution.Solver.Types.DependencyResolver @@ -46,6 +50,8 @@ import Distribution.Solver.Types.Variable import Distribution.System ( Platform(..) ) +import Distribution.Simple.Setup + ( BooleanFlag(..) ) import Distribution.Simple.Utils ( ordNubBy ) import Distribution.Verbosity @@ -80,16 +86,17 @@ -- -- When there is no solution, we produce the error message by rerunning the -- solver but making it prefer the goals from the final conflict set from the --- first run. We also set the backjump limit to 0, so that the log stops at the --- first backjump and is relatively short. Preferring goals from the final --- conflict set increases the probability that the log to the first backjump --- contains package, flag, and stanza choices that are relevant to the final --- failure. The solver shouldn't need to choose any packages that aren't in the --- final conflict set. (For every variable in the final conflict set, the final --- conflict set should also contain the variable that introduced that variable. --- The solver can then follow that chain of variables in reverse order from the --- user target to the conflict.) However, it is possible that the conflict set --- contains unnecessary variables. +-- first run (or a subset of the final conflict set with +-- --minimize-conflict-set). We also set the backjump limit to 0, so that the +-- log stops at the first backjump and is relatively short. Preferring goals +-- from the final conflict set increases the probability that the log to the +-- first backjump contains package, flag, and stanza choices that are relevant +-- to the final failure. The solver shouldn't need to choose any packages that +-- aren't in the final conflict set. (For every variable in the final conflict +-- set, the final conflict set should also contain the variable that introduced +-- that variable. The solver can then follow that chain of variables in reverse +-- order from the user target to the conflict.) However, it is possible that the +-- conflict set contains unnecessary variables. -- -- Producing an error message when the solver reaches the backjump limit is more -- complicated. There is no final conflict set, so we create one for the minimal @@ -116,33 +123,53 @@ -> Set PN -> Progress String String (Assignment, RevDepMap) solve' sc cinfo idx pkgConfigDB pprefs gcs pns = - foldProgress Step (uncurry createErrorMsg) Done (runSolver printFullLog sc) + toProgress $ retry (runSolver printFullLog sc) createErrorMsg where runSolver :: Bool -> SolverConfig - -> Progress String (SolverFailure, String) (Assignment, RevDepMap) + -> RetryLog String SolverFailure (Assignment, RevDepMap) runSolver keepLog sc' = - logToProgress keepLog (solverVerbosity sc') (maxBackjumps sc') $ + displayLogMessages keepLog $ solve sc' cinfo idx pkgConfigDB pprefs gcs pns - createErrorMsg :: SolverFailure -> String - -> Progress String String (Assignment, RevDepMap) - createErrorMsg (ExhaustiveSearch cs _) msg = - Fail $ rerunSolverForErrorMsg cs ++ msg - createErrorMsg BackjumpLimitReached msg = - Step ("Backjump limit reached. Rerunning dependency solver to generate " + createErrorMsg :: SolverFailure + -> RetryLog String String (Assignment, RevDepMap) + createErrorMsg failure@(ExhaustiveSearch cs cm) = + if asBool $ minimizeConflictSet sc + then continueWith ("Found no solution after exhaustively searching the " + ++ "dependency tree. Rerunning the dependency solver " + ++ "to minimize the conflict set ({" + ++ showConflictSet cs ++ "}).") $ + retry (tryToMinimizeConflictSet (runSolver printFullLog) sc cs cm) $ + \case + ExhaustiveSearch cs' cm' -> + fromProgress $ Fail $ + rerunSolverForErrorMsg cs' + ++ finalErrorMsg sc (ExhaustiveSearch cs' cm') + BackjumpLimitReached -> + fromProgress $ Fail $ + "Reached backjump limit while trying to minimize the " + ++ "conflict set to create a better error message. " + ++ "Original error message:\n" + ++ rerunSolverForErrorMsg cs + ++ finalErrorMsg sc failure + else fromProgress $ Fail $ + rerunSolverForErrorMsg cs ++ finalErrorMsg sc failure + createErrorMsg failure@BackjumpLimitReached = + continueWith + ("Backjump limit reached. Rerunning dependency solver to generate " ++ "a final conflict set for the search tree containing the " ++ "first backjump.") $ - foldProgress Step (f . fst) Done $ - runSolver printFullLog - sc { pruneAfterFirstSuccess = PruneAfterFirstSuccess True } - where - f :: SolverFailure -> Progress String String (Assignment, RevDepMap) - f (ExhaustiveSearch cs _) = Fail $ rerunSolverForErrorMsg cs ++ msg - f BackjumpLimitReached = - -- This case is possible when the number of goals involved in - -- conflicts is greater than the backjump limit. - Fail $ msg ++ "Failed to generate a summarized dependency solver " - ++ "log due to low backjump limit." + retry (runSolver printFullLog sc { pruneAfterFirstSuccess = PruneAfterFirstSuccess True }) $ + \case + ExhaustiveSearch cs _ -> + fromProgress $ Fail $ + rerunSolverForErrorMsg cs ++ finalErrorMsg sc failure + BackjumpLimitReached -> + -- This case is possible when the number of goals involved in + -- conflicts is greater than the backjump limit. + fromProgress $ Fail $ finalErrorMsg sc failure + ++ "Failed to generate a summarized dependency solver " + ++ "log due to low backjump limit." rerunSolverForErrorMsg :: ConflictSet -> String rerunSolverForErrorMsg cs = @@ -155,21 +182,158 @@ -- original goal order. goalOrder' = preferGoalsFromConflictSet cs <> fromMaybe mempty (goalOrder sc) - in unlines ("Could not resolve dependencies:" : messages (runSolver True sc')) + in unlines ("Could not resolve dependencies:" : messages (toProgress (runSolver True sc'))) printFullLog = solverVerbosity sc >= verbose messages :: Progress step fail done -> [step] messages = foldProgress (:) (const []) (const []) +-- | Try to remove variables from the given conflict set to create a minimal +-- conflict set. +-- +-- Minimal means that no proper subset of the conflict set is also a conflict +-- set, though there may be other possible conflict sets with fewer variables. +-- This function minimizes the input by trying to remove one variable at a time. +-- It only makes one pass over the variables, so it runs the solver at most N +-- times when given a conflict set of size N. Only one pass is necessary, +-- because every superset of a conflict set is also a conflict set, meaning that +-- failing to remove variable X from a conflict set in one step means that X +-- cannot be removed from any subset of that conflict set in a subsequent step. +-- +-- Example steps: +-- +-- Start with {A, B, C}. +-- Try to remove A from {A, B, C} and fail. +-- Try to remove B from {A, B, C} and succeed. +-- Try to remove C from {A, C} and fail. +-- Return {A, C} +-- +-- This function can fail for two reasons: +-- +-- 1. The solver can reach the backjump limit on any run. In this case the +-- returned RetryLog ends with BackjumpLimitReached. +-- TODO: Consider applying the backjump limit to all solver runs combined, +-- instead of each individual run. For example, 10 runs with 10 backjumps +-- each should count as 100 backjumps. +-- 2. Since this function works by rerunning the solver, it is possible for the +-- solver to add new unnecessary variables to the conflict set. This function +-- discards the result from any run that adds new variables to the conflict +-- set, but the end result may not be completely minimized. +tryToMinimizeConflictSet :: forall a . (SolverConfig -> RetryLog String SolverFailure a) + -> SolverConfig + -> ConflictSet + -> ConflictMap + -> RetryLog String SolverFailure a +tryToMinimizeConflictSet runSolver sc cs cm = + foldl (\r v -> retryNoSolution r $ tryToRemoveOneVar v) + (fromProgress $ Fail $ ExhaustiveSearch cs cm) + (CS.toList cs) + where + -- This function runs the solver and makes it prefer goals in the following + -- order: + -- + -- 1. variables in 'smallestKnownCS', excluding 'v' + -- 2. 'v' + -- 3. all other variables + -- + -- If 'v' is not necessary, then the solver will find that there is no + -- solution before starting to solve for 'v', and the new final conflict set + -- will be very likely to not contain 'v'. If 'v' is necessary, the solver + -- will most likely need to try solving for 'v' before finding that there is + -- no solution, and the new final conflict set will still contain 'v'. + -- However, this method isn't perfect, because it is possible for the solver + -- to add new unnecessary variables to the conflict set on any run. This + -- function prevents the conflict set from growing by checking that the new + -- conflict set is a subset of the old one and falling back to using the old + -- conflict set when that check fails. + tryToRemoveOneVar :: Var QPN + -> ConflictSet + -> ConflictMap + -> RetryLog String SolverFailure a + tryToRemoveOneVar v smallestKnownCS smallestKnownCM + -- Check whether v is still present, because it may have already been + -- removed in a previous solver rerun. + | not (v `CS.member` smallestKnownCS) = + fromProgress $ Fail $ ExhaustiveSearch smallestKnownCS smallestKnownCM + | otherwise = + continueWith ("Trying to remove variable " ++ varStr ++ " from the " + ++ "conflict set.") $ + retry (runSolver sc') $ \case + err@(ExhaustiveSearch cs' _) + | CS.toSet cs' `isSubsetOf` CS.toSet smallestKnownCS -> + let msg = if not $ CS.member v cs' + then "Successfully removed " ++ varStr ++ " from " + ++ "the conflict set." + else "Failed to remove " ++ varStr ++ " from the " + ++ "conflict set." + in -- Use the new conflict set, even if v wasn't removed, + -- because other variables may have been removed. + failWith (msg ++ " Continuing with " ++ showCS cs' ++ ".") err + | otherwise -> + failWith ("Failed to find a smaller conflict set. The new " + ++ "conflict set is not a subset of the previous " + ++ "conflict set: " ++ showCS cs') $ + ExhaustiveSearch smallestKnownCS smallestKnownCM + BackjumpLimitReached -> + failWith ("Reached backjump limit while minimizing conflict set.") + BackjumpLimitReached + where + varStr = "\"" ++ showVar v ++ "\"" + showCS cs' = "{" ++ showConflictSet cs' ++ "}" + + sc' = sc { goalOrder = Just goalOrder' } + + goalOrder' = + preferGoalsFromConflictSet (v `CS.delete` smallestKnownCS) + <> preferGoal v + <> fromMaybe mempty (goalOrder sc) + + -- Like 'retry', except that it only applies the input function when the + -- backjump limit has not been reached. + retryNoSolution :: RetryLog step SolverFailure done + -> (ConflictSet -> ConflictMap -> RetryLog step SolverFailure done) + -> RetryLog step SolverFailure done + retryNoSolution lg f = retry lg $ \case + ExhaustiveSearch cs' cm' -> f cs' cm' + BackjumpLimitReached -> fromProgress (Fail BackjumpLimitReached) + -- | Goal ordering that chooses goals contained in the conflict set before -- other goals. preferGoalsFromConflictSet :: ConflictSet -> Variable QPN -> Variable QPN -> Ordering -preferGoalsFromConflictSet cs = - comparing $ \v -> not $ CS.member (toVar v) cs - where - toVar :: Variable QPN -> Var QPN - toVar (PackageVar qpn) = P qpn - toVar (FlagVar qpn fn) = F (FN qpn fn) - toVar (StanzaVar qpn sn) = S (SN qpn sn) +preferGoalsFromConflictSet cs = comparing $ \v -> not $ CS.member (toVar v) cs + +-- | Goal ordering that chooses the given goal first. +preferGoal :: Var QPN -> Variable QPN -> Variable QPN -> Ordering +preferGoal preferred = comparing $ \v -> toVar v /= preferred + +toVar :: Variable QPN -> Var QPN +toVar (PackageVar qpn) = P qpn +toVar (FlagVar qpn fn) = F (FN qpn fn) +toVar (StanzaVar qpn sn) = S (SN qpn sn) + +finalErrorMsg :: SolverConfig -> SolverFailure -> String +finalErrorMsg sc failure = + case failure of + ExhaustiveSearch cs cm -> + "After searching the rest of the dependency tree exhaustively, " + ++ "these were the goals I've had most trouble fulfilling: " + ++ showCS cm cs + ++ flagSuggestion + where + showCS = if solverVerbosity sc > normal + then CS.showCSWithFrequency + else CS.showCSSortedByFrequency + flagSuggestion = + -- Don't suggest --minimize-conflict-set if the conflict set is + -- already small, because it is unlikely to be reduced further. + if CS.size cs > 3 && not (asBool (minimizeConflictSet sc)) + then "\nTry running with --minimize-conflict-set to improve the " + ++ "error message." + else "" + BackjumpLimitReached -> + "Backjump limit reached (" ++ currlimit (maxBackjumps sc) ++ + "change with --max-backjumps or try to run with --reorder-goals).\n" + where currlimit (Just n) = "currently " ++ show n ++ ", " + currlimit Nothing = "" diff --git a/cabal/cabal-install/Distribution/Solver/Modular/Builder.hs b/cabal/cabal-install/Distribution/Solver/Modular/Builder.hs --- a/cabal/cabal-install/Distribution/Solver/Modular/Builder.hs +++ b/cabal/cabal-install/Distribution/Solver/Modular/Builder.hs @@ -24,6 +24,7 @@ import Data.Set as S import Prelude hiding (sequence, mapM) +import qualified Distribution.Solver.Modular.ConflictSet as CS import Distribution.Solver.Modular.Dependency import Distribution.Solver.Modular.Flag import Distribution.Solver.Modular.Index @@ -143,13 +144,8 @@ -- For a package, we look up the instances available in the global info, -- and then handle each instance in turn. addChildren bs@(BS { rdeps = rdm, index = idx, next = OneGoal (PkgGoal qpn@(Q _ pn) gr) }) = - -- If the package does not exist in the index, we construct an emty PChoiceF node for it - -- After all, we have no choices here. Alternatively, we could immediately construct - -- a Fail node here, but that would complicate the construction of conflict sets. - -- We will probably want to give this case special treatment when generating error - -- messages though. case M.lookup pn idx of - Nothing -> PChoiceF qpn rdm gr (W.fromList []) + Nothing -> FailF (varToConflictSet (P qpn) `CS.union` goalReasonToCS gr) UnknownPackage Just pis -> PChoiceF qpn rdm gr (W.fromList (L.map (\ (i, info) -> ([], POption i Nothing, bs { next = Instance qpn info })) (M.toList pis))) diff --git a/cabal/cabal-install/Distribution/Solver/Modular/ConflictSet.hs b/cabal/cabal-install/Distribution/Solver/Modular/ConflictSet.hs --- a/cabal/cabal-install/Distribution/Solver/Modular/ConflictSet.hs +++ b/cabal/cabal-install/Distribution/Solver/Modular/ConflictSet.hs @@ -18,12 +18,15 @@ , showCSSortedByFrequency , showCSWithFrequency -- Set-like operations + , toSet , toList , union , unions , insert + , delete , empty , singleton + , size , member , filter , fromList @@ -98,6 +101,9 @@ Set-like operations -------------------------------------------------------------------------------} +toSet :: ConflictSet -> Set (Var QPN) +toSet = conflictSetToSet + toList :: ConflictSet -> [Var QPN] toList = S.toList . conflictSetToSet @@ -137,6 +143,11 @@ #endif } +delete :: Var QPN -> ConflictSet -> ConflictSet +delete var cs = CS { + conflictSetToSet = S.delete var (conflictSetToSet cs) + } + empty :: #ifdef DEBUG_CONFLICT_SETS (?loc :: CallStack) => @@ -160,6 +171,9 @@ , conflictSetOrigin = Node ?loc [] #endif } + +size :: ConflictSet -> Int +size = S.size . conflictSetToSet member :: Var QPN -> ConflictSet -> Bool member var = S.member var . conflictSetToSet diff --git a/cabal/cabal-install/Distribution/Solver/Modular/Dependency.hs b/cabal/cabal-install/Distribution/Solver/Modular/Dependency.hs --- a/cabal/cabal-install/Distribution/Solver/Modular/Dependency.hs +++ b/cabal/cabal-install/Distribution/Solver/Modular/Dependency.hs @@ -52,6 +52,7 @@ import Distribution.Solver.Types.ComponentDeps (Component(..)) import Distribution.Solver.Types.PackagePath +import Distribution.Types.PkgconfigVersionRange import Distribution.Types.UnqualComponentName {------------------------------------------------------------------------------- @@ -117,7 +118,7 @@ data Dep qpn = Dep (PkgComponent qpn) CI -- ^ dependency on a package component | Ext Extension -- ^ dependency on a language extension | Lang Language -- ^ dependency on a language version - | Pkg PkgconfigName VR -- ^ dependency on a pkg-config package + | Pkg PkgconfigName PkgconfigVersionRange -- ^ dependency on a pkg-config package deriving Functor -- | An exposed component within a package. This type is used to represent diff --git a/cabal/cabal-install/Distribution/Solver/Modular/Explore.hs b/cabal/cabal-install/Distribution/Solver/Modular/Explore.hs --- a/cabal/cabal-install/Distribution/Solver/Modular/Explore.hs +++ b/cabal/cabal-install/Distribution/Solver/Modular/Explore.hs @@ -1,9 +1,7 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} -module Distribution.Solver.Modular.Explore - ( backjump - , backjumpAndExplore - ) where +module Distribution.Solver.Modular.Explore (backjumpAndExplore) where import qualified Distribution.Solver.Types.Progress as P @@ -54,40 +52,51 @@ combine :: forall a . (ExploreState -> ConflictSetLog a) -> (ConflictSet -> ExploreState -> ConflictSetLog a) -> ConflictSet -> ExploreState -> ConflictSetLog a - combine x f csAcc es = retry (x es) next + combine x f csAcc es = retryNoSolution (x es) next where - next :: IntermediateFailure -> ConflictSetLog a - next BackjumpLimit = fromProgress (P.Fail BackjumpLimit) - next (NoSolution !cs es') - | enableBj && not (var `CS.member` cs) = skipLoggingBackjump cs es' - | otherwise = f (csAcc `CS.union` cs) es' + next :: ConflictSet -> ExploreState -> ConflictSetLog a + next !cs es' = if enableBj && not (var `CS.member` cs) + then skipLoggingBackjump cs es' + else f (csAcc `CS.union` cs) es' -- This function represents the option to not choose a value for this goal. avoidGoal :: ConflictSet -> ExploreState -> ConflictSetLog a avoidGoal cs !es = - logBackjump (cs `CS.union` lastCS) $ + logBackjump mbj (cs `CS.union` lastCS) $ -- Use 'lastCS' below instead of 'cs' since we do not want to -- double-count the additionally accumulated conflicts. es { esConflictMap = updateCM lastCS (esConflictMap es) } - logBackjump :: ConflictSet -> ExploreState -> ConflictSetLog a - logBackjump cs es = - failWith (Failure cs Backjump) $ - if reachedBjLimit (esBackjumps es) - then BackjumpLimit - else NoSolution cs es { esBackjumps = esBackjumps es + 1 } - where - reachedBjLimit = case mbj of - Nothing -> const False - Just limit -> (== limit) - -- The solver does not count or log backjumps at levels where the conflict -- set does not contain the current variable. Otherwise, there would be many -- consecutive log messages about backjumping with the same conflict set. skipLoggingBackjump :: ConflictSet -> ExploreState -> ConflictSetLog a skipLoggingBackjump cs es = fromProgress $ P.Fail (NoSolution cs es) +-- | Creates a failing ConflictSetLog representing a backjump. It inserts a +-- "backjumping" message, checks whether the backjump limit has been reached, +-- and increments the backjump count. +logBackjump :: Maybe Int -> ConflictSet -> ExploreState -> ConflictSetLog a +logBackjump mbj cs es = + failWith (Failure cs Backjump) $ + if reachedBjLimit (esBackjumps es) + then BackjumpLimit + else NoSolution cs es { esBackjumps = esBackjumps es + 1 } + where + reachedBjLimit = case mbj of + Nothing -> const False + Just limit -> (== limit) + +-- | Like 'retry', except that it only applies the input function when the +-- backjump limit has not been reached. +retryNoSolution :: ConflictSetLog a + -> (ConflictSet -> ExploreState -> ConflictSetLog a) + -> ConflictSetLog a +retryNoSolution lg f = retry lg $ \case + BackjumpLimit -> fromProgress (P.Fail BackjumpLimit) + NoSolution cs es -> f cs es + -- | The state that is read and written while exploring the search tree. data ExploreState = ES { esConflictMap :: !ConflictMap @@ -138,14 +147,15 @@ exploreLog :: Maybe Int -> EnableBackjumping -> CountConflicts -> Tree Assignment QGoalReason -> ConflictSetLog (Assignment, RevDepMap) -exploreLog mbj enableBj (CountConflicts countConflicts) t = cata go t initES +exploreLog mbj enableBj (CountConflicts countConflicts) t = para go t initES where getBestGoal' :: P.PSQ (Goal QPN) a -> ConflictMap -> (Goal QPN, a) getBestGoal' | countConflicts = \ ts cm -> getBestGoal cm ts | otherwise = \ ts _ -> getFirstGoal ts - go :: TreeF Assignment QGoalReason (ExploreState -> ConflictSetLog (Assignment, RevDepMap)) + go :: TreeF Assignment QGoalReason + (ExploreState -> ConflictSetLog (Assignment, RevDepMap), Tree Assignment QGoalReason) -> (ExploreState -> ConflictSetLog (Assignment, RevDepMap)) go (FailF c fr) = \ !es -> let es' = es { esConflictMap = updateCM c (esConflictMap es) } @@ -155,20 +165,29 @@ backjump mbj enableBj (P qpn) (avoidSet (P qpn) gr) $ -- try children in order, W.mapWithKey -- when descending ... (\ k r es -> tryWith (TryP qpn k) (r es)) - ts + (fmap fst ts) go (FChoiceF qfn _ gr _ _ _ ts) = backjump mbj enableBj (F qfn) (avoidSet (F qfn) gr) $ -- try children in order, W.mapWithKey -- when descending ... (\ k r es -> tryWith (TryF qfn k) (r es)) - ts + (fmap fst ts) go (SChoiceF qsn _ gr _ ts) = backjump mbj enableBj (S qsn) (avoidSet (S qsn) gr) $ -- try children in order, W.mapWithKey -- when descending ... (\ k r es -> tryWith (TryS qsn k) (r es)) - ts + (fmap fst ts) go (GoalChoiceF _ ts) = \ es -> - let (k, v) = getBestGoal' ts (esConflictMap es) - in continueWith (Next k) (v es) + let (k, (v, tree)) = getBestGoal' ts (esConflictMap es) + in continueWith (Next k) $ + -- Goal choice nodes are normally not counted as backjumps, since the + -- solver always explores exactly one choice, which means that the + -- backjump from the goal choice would be redundant with the backjump + -- from the PChoice, FChoice, or SChoice below. The one case where the + -- backjump is not redundant is when the chosen goal is a failure node, + -- so we log a backjump in that case. + case tree of + Fail _ _ -> retryNoSolution (v es) $ logBackjump mbj + _ -> v es initES = ES { esConflictMap = M.empty diff --git a/cabal/cabal-install/Distribution/Solver/Modular/IndexConversion.hs b/cabal/cabal-install/Distribution/Solver/Modular/IndexConversion.hs --- a/cabal/cabal-install/Distribution/Solver/Modular/IndexConversion.hs +++ b/cabal/cabal-install/Distribution/Solver/Modular/IndexConversion.hs @@ -86,7 +86,7 @@ convId ipi = (pn, I ver $ Inst $ IPI.installedUnitId ipi) where MungedPackageId mpn ver = mungedId ipi -- HACK. See Note [Index conversion with internal libraries] - pn = mkPackageName (unMungedPackageName mpn) + pn = encodeCompatPackageName mpn -- | Convert a single installed package into the solver-specific format. convIP :: SI.InstalledPackageIndex -> InstalledPackageInfo -> (PN, I, PInfo) @@ -100,7 +100,7 @@ (pn, i) = convId ipi -- 'sourceLibName' is unreliable, but for now we only really use this for -- primary libs anyways - comp = componentNameToComponent $ libraryComponentName $ sourceLibName ipi + comp = componentNameToComponent $ CLibName $ sourceLibName ipi -- TODO: Installed packages should also store their encapsulations! -- Note [Index conversion with internal libraries] @@ -335,7 +335,7 @@ -- | Convenience function to delete a 'Dependency' if it's -- for a 'PN' that isn't actually real. filterIPNs :: IPNs -> Dependency -> Maybe Dependency -filterIPNs ipns d@(Dependency pn _) +filterIPNs ipns d@(Dependency pn _ _) | S.notMember pn ipns = Just d | otherwise = Nothing @@ -562,7 +562,7 @@ -- | Convert a Cabal dependency on a library to a solver-specific dependency. convLibDep :: DependencyReason PN -> Dependency -> LDep PN -convLibDep dr (Dependency pn vr) = LDep dr $ Dep (PkgComponent pn ExposedLib) (Constrained vr) +convLibDep dr (Dependency pn vr _) = LDep dr $ Dep (PkgComponent pn ExposedLib) (Constrained vr) -- | Convert a Cabal dependency on an executable (build-tools) to a solver-specific dependency. convExeDep :: DependencyReason PN -> ExeDependency -> LDep PN diff --git a/cabal/cabal-install/Distribution/Solver/Modular/Log.hs b/cabal/cabal-install/Distribution/Solver/Modular/Log.hs --- a/cabal/cabal-install/Distribution/Solver/Modular/Log.hs +++ b/cabal/cabal-install/Distribution/Solver/Modular/Log.hs @@ -1,5 +1,5 @@ module Distribution.Solver.Modular.Log - ( logToProgress + ( displayLogMessages , SolverFailure(..) ) where @@ -10,47 +10,22 @@ import Distribution.Solver.Modular.Dependency import Distribution.Solver.Modular.Message -import qualified Distribution.Solver.Modular.ConflictSet as CS import Distribution.Solver.Modular.RetryLog -import Distribution.Verbosity -- | Information about a dependency solver failure. data SolverFailure = ExhaustiveSearch ConflictSet ConflictMap | BackjumpLimitReached --- | Postprocesses a log file. When the dependency solver fails to find a --- solution, the log ends with a SolverFailure and a message describing the --- failure. This function discards all log messages and avoids calling --- 'showMessages' if the log isn't needed (specified by 'keepLog'), for --- efficiency. -logToProgress :: Bool - -> Verbosity - -> Maybe Int - -> RetryLog Message SolverFailure a - -> Progress String (SolverFailure, String) a -logToProgress keepLog verbosity mbj lg = +-- | Postprocesses a log file. This function discards all log messages and +-- avoids calling 'showMessages' if the log isn't needed (specified by +-- 'keepLog'), for efficiency. +displayLogMessages :: Bool + -> RetryLog Message SolverFailure a + -> RetryLog String SolverFailure a +displayLogMessages keepLog lg = fromProgress $ if keepLog then showMessages progress else foldProgress (const id) Fail Done progress where - progress = - -- Convert the RetryLog to a Progress (with toProgress) as late as - -- possible, to take advantage of efficient updates at failures. - toProgress $ - mapFailure (\failure -> (failure, finalErrorMsg failure)) lg - - finalErrorMsg :: SolverFailure -> String - finalErrorMsg (ExhaustiveSearch cs cm) = - "After searching the rest of the dependency tree exhaustively, " - ++ "these were the goals I've had most trouble fulfilling: " - ++ showCS cm cs - where - showCS = if verbosity > normal - then CS.showCSWithFrequency - else CS.showCSSortedByFrequency - finalErrorMsg BackjumpLimitReached = - "Backjump limit reached (" ++ currlimit mbj ++ - "change with --max-backjumps or try to run with --reorder-goals).\n" - where currlimit (Just n) = "currently " ++ show n ++ ", " - currlimit Nothing = "" + progress = toProgress lg diff --git a/cabal/cabal-install/Distribution/Solver/Modular/Message.hs b/cabal/cabal-install/Distribution/Solver/Modular/Message.hs --- a/cabal/cabal-install/Distribution/Solver/Modular/Message.hs +++ b/cabal/cabal-install/Distribution/Solver/Modular/Message.hs @@ -8,7 +8,7 @@ import qualified Data.List as L import Prelude hiding (pi) -import Distribution.Text -- from Cabal +import Distribution.Pretty (prettyShow) -- from Cabal import Distribution.Solver.Modular.Dependency import Distribution.Solver.Modular.Flag @@ -53,10 +53,8 @@ (atLevel l $ "rejecting: " ++ showQSNBool qsn b ++ showFR c fr) (go l ms) go !l (Step (Next (Goal (P _ ) gr)) (Step (TryP qpn' i) ms@(Step Enter (Step (Next _) _)))) = (atLevel l $ "trying: " ++ showQPNPOpt qpn' i ++ showGR gr) (go l ms) - go !l (Step (Next (Goal (P qpn) gr)) ms@(Step (Failure _c Backjump) _)) = + go !l (Step (Next (Goal (P qpn) gr)) (Step (Failure _c UnknownPackage) ms)) = (atLevel l $ "unknown package: " ++ showQPN qpn ++ showGR gr) $ go l ms - go !l (Step (Next (Goal (P qpn) gr)) (Step (Failure c fr) ms)) = - (atLevel l $ showPackageGoal qpn gr) $ (atLevel l $ showFailure c fr) (go l ms) -- standard display go !l (Step Enter ms) = go (l+1) ms go !l (Step Leave ms) = go (l-1) ms @@ -104,9 +102,9 @@ showGR (DependencyGoal dr) = " (dependency of " ++ showDependencyReason dr ++ ")" showFR :: ConflictSet -> FailReason -> String -showFR _ (UnsupportedExtension ext) = " (conflict: requires " ++ display ext ++ ")" -showFR _ (UnsupportedLanguage lang) = " (conflict: requires " ++ display lang ++ ")" -showFR _ (MissingPkgconfigPackage pn vr) = " (conflict: pkg-config package " ++ display pn ++ display vr ++ ", not found in the pkg-config database)" +showFR _ (UnsupportedExtension ext) = " (conflict: requires " ++ prettyShow ext ++ ")" +showFR _ (UnsupportedLanguage lang) = " (conflict: requires " ++ prettyShow lang ++ ")" +showFR _ (MissingPkgconfigPackage pn vr) = " (conflict: pkg-config package " ++ prettyShow pn ++ prettyShow vr ++ ", not found in the pkg-config database)" showFR _ (NewPackageDoesNotMatchExistingConstraint d) = " (conflict: " ++ showConflictingDep d ++ ")" showFR _ (ConflictingConstraints d1 d2) = " (conflict: " ++ L.intercalate ", " (L.map showConflictingDep [d1, d2]) ++ ")" showFR _ (NewPackageIsMissingRequiredComponent comp dr) = " (does not contain " ++ showExposedComponent comp ++ ", which is required by " ++ showDependencyReason dr ++ ")" @@ -115,9 +113,11 @@ showFR _ (PackageRequiresUnbuildableComponent qpn comp) = " (requires " ++ showExposedComponent comp ++ " from " ++ showQPN qpn ++ ", but the component is not buildable in the current environment)" showFR _ CannotInstall = " (only already installed instances can be used)" showFR _ CannotReinstall = " (avoiding to reinstall a package with same version but new dependencies)" +showFR _ NotExplicit = " (not a user-provided goal nor mentioned as a constraint, but reject-unconstrained-dependencies was set)" showFR _ Shadowed = " (shadowed by another installed package with same version)" showFR _ Broken = " (package is broken)" -showFR _ (GlobalConstraintVersion vr src) = " (" ++ constraintSource src ++ " requires " ++ display vr ++ ")" +showFR _ UnknownPackage = " (unknown package)" +showFR _ (GlobalConstraintVersion vr src) = " (" ++ constraintSource src ++ " requires " ++ prettyShow vr ++ ")" showFR _ (GlobalConstraintInstalled src) = " (" ++ constraintSource src ++ " requires installed instance)" showFR _ (GlobalConstraintSource src) = " (" ++ constraintSource src ++ " requires source instance)" showFR _ (GlobalConstraintFlag src) = " (" ++ constraintSource src ++ " requires opposite flag selection)" @@ -126,7 +126,7 @@ showFR _ MultipleInstances = " (multiple instances)" showFR c (DependenciesNotLinked msg) = " (dependencies not linked: " ++ msg ++ "; conflict set: " ++ showConflictSet c ++ ")" showFR c CyclicDependencies = " (cyclic dependencies; conflict set: " ++ showConflictSet c ++ ")" -showFR _ (UnsupportedSpecVer ver) = " (unsupported spec-version " ++ display ver ++ ")" +showFR _ (UnsupportedSpecVer ver) = " (unsupported spec-version " ++ prettyShow ver ++ ")" -- The following are internal failures. They should not occur. In the -- interest of not crashing unnecessarily, we still just print an error -- message though. diff --git a/cabal/cabal-install/Distribution/Solver/Modular/Package.hs b/cabal/cabal-install/Distribution/Solver/Modular/Package.hs --- a/cabal/cabal-install/Distribution/Solver/Modular/Package.hs +++ b/cabal/cabal-install/Distribution/Solver/Modular/Package.hs @@ -21,7 +21,7 @@ import Data.List as L import Distribution.Package -- from Cabal -import Distribution.Text (display) +import Distribution.Deprecated.Text (display) import Distribution.Solver.Modular.Version import Distribution.Solver.Types.PackagePath diff --git a/cabal/cabal-install/Distribution/Solver/Modular/Preference.hs b/cabal/cabal-install/Distribution/Solver/Modular/Preference.hs --- a/cabal/cabal-install/Distribution/Solver/Modular/Preference.hs +++ b/cabal/cabal-install/Distribution/Solver/Modular/Preference.hs @@ -13,6 +13,7 @@ , preferPackagePreferences , preferReallyEasyGoalChoices , requireInstalled + , onlyConstrained , sortGoals , pruneAfterFirstSuccess ) where @@ -336,6 +337,15 @@ notReinstall _ _ x = x go x = x + +-- | Require all packages to be mentioned in a constraint or as a goal. +onlyConstrained :: (PN -> Bool) -> Tree d QGoalReason -> Tree d QGoalReason +onlyConstrained p = trav go + where + go (PChoiceF v@(Q _ pn) _ gr _) | not (p pn) + = FailF (varToConflictSet (P v) `CS.union` goalReasonToCS gr) NotExplicit + go x + = x -- | Sort all goals using the provided function. sortGoals :: (Variable QPN -> Variable QPN -> Ordering) -> Tree d c -> Tree d c diff --git a/cabal/cabal-install/Distribution/Solver/Modular/Solver.hs b/cabal/cabal-install/Distribution/Solver/Modular/Solver.hs --- a/cabal/cabal-install/Distribution/Solver/Modular/Solver.hs +++ b/cabal/cabal-install/Distribution/Solver/Modular/Solver.hs @@ -45,7 +45,7 @@ #ifdef DEBUG_TRACETREE import qualified Distribution.Solver.Modular.ConflictSet as CS import qualified Distribution.Solver.Modular.WeightedPSQ as W -import qualified Distribution.Text as T +import qualified Distribution.Deprecated.Text as T import Debug.Trace.Tree (gtraceJson) import Debug.Trace.Tree.Simple @@ -57,11 +57,13 @@ data SolverConfig = SolverConfig { reorderGoals :: ReorderGoals, countConflicts :: CountConflicts, + minimizeConflictSet :: MinimizeConflictSet, independentGoals :: IndependentGoals, avoidReinstalls :: AvoidReinstalls, shadowPkgs :: ShadowPkgs, strongFlags :: StrongFlags, allowBootLibInstalls :: AllowBootLibInstalls, + onlyConstrained :: OnlyConstrained, maxBackjumps :: Maybe Int, enableBackjumping :: EnableBackjumping, solveExecutables :: SolveExecutables, @@ -129,9 +131,19 @@ prunePhase = (if asBool (avoidReinstalls sc) then P.avoidReinstalls (const True) else id) . (if asBool (allowBootLibInstalls sc) then id - else P.requireInstalled (`elem` nonInstallable)) + else P.requireInstalled (`elem` nonInstallable)) . + (case onlyConstrained sc of + OnlyConstrainedAll -> + P.onlyConstrained pkgIsExplicit + OnlyConstrainedNone -> + id) buildPhase = traceTree "build.json" id $ buildTree idx (independentGoals sc) (S.toList userGoals) + + allExplicit = M.keysSet userConstraints `S.union` userGoals + + pkgIsExplicit :: PN -> Bool + pkgIsExplicit pn = S.member pn allExplicit -- packages that can never be installed or upgraded -- If you change this enumeration, make sure to update the list in diff --git a/cabal/cabal-install/Distribution/Solver/Modular/Tree.hs b/cabal/cabal-install/Distribution/Solver/Modular/Tree.hs --- a/cabal/cabal-install/Distribution/Solver/Modular/Tree.hs +++ b/cabal/cabal-install/Distribution/Solver/Modular/Tree.hs @@ -31,6 +31,7 @@ import Distribution.Solver.Types.ConstraintSource import Distribution.Solver.Types.Flag import Distribution.Solver.Types.PackagePath +import Distribution.Types.PkgconfigVersionRange import Language.Haskell.Extension (Extension, Language) type Weight = Double @@ -97,7 +98,7 @@ data FailReason = UnsupportedExtension Extension | UnsupportedLanguage Language - | MissingPkgconfigPackage PkgconfigName VR + | MissingPkgconfigPackage PkgconfigName PkgconfigVersionRange | NewPackageDoesNotMatchExistingConstraint ConflictingDep | ConflictingConstraints ConflictingDep ConflictingDep | NewPackageIsMissingRequiredComponent ExposedComponent (DependencyReason QPN) @@ -106,8 +107,10 @@ | PackageRequiresUnbuildableComponent QPN ExposedComponent | CannotInstall | CannotReinstall + | NotExplicit | Shadowed | Broken + | UnknownPackage | GlobalConstraintVersion VR ConstraintSource | GlobalConstraintInstalled ConstraintSource | GlobalConstraintSource ConstraintSource diff --git a/cabal/cabal-install/Distribution/Solver/Modular/Validate.hs b/cabal/cabal-install/Distribution/Solver/Modular/Validate.hs --- a/cabal/cabal-install/Distribution/Solver/Modular/Validate.hs +++ b/cabal/cabal-install/Distribution/Solver/Modular/Validate.hs @@ -37,6 +37,7 @@ import Distribution.Solver.Types.PackagePath import Distribution.Solver.Types.PkgConfigDb (PkgConfigDb, pkgConfigPkgIsPresent) +import Distribution.Types.PkgconfigVersionRange #ifdef DEBUG_CONFLICT_SETS import GHC.Stack (CallStack) @@ -96,7 +97,7 @@ data ValidateState = VS { supportedExt :: Extension -> Bool, supportedLang :: Language -> Bool, - presentPkgs :: PkgconfigName -> VR -> Bool, + presentPkgs :: PkgconfigName -> PkgconfigVersionRange -> Bool, index :: Index, -- Saved, scoped, dependencies. Every time 'validate' makes a package choice, @@ -382,7 +383,7 @@ -- or the successfully extended assignment. extend :: (Extension -> Bool) -- ^ is a given extension supported -> (Language -> Bool) -- ^ is a given language supported - -> (PkgconfigName -> VR -> Bool) -- ^ is a given pkg-config requirement satisfiable + -> (PkgconfigName -> PkgconfigVersionRange -> Bool) -- ^ is a given pkg-config requirement satisfiable -> [LDep QPN] -> PPreAssignment -> Either Conflict PPreAssignment diff --git a/cabal/cabal-install/Distribution/Solver/Modular/Version.hs b/cabal/cabal-install/Distribution/Solver/Modular/Version.hs --- a/cabal/cabal-install/Distribution/Solver/Modular/Version.hs +++ b/cabal/cabal-install/Distribution/Solver/Modular/Version.hs @@ -12,7 +12,7 @@ ) where import qualified Distribution.Version as CV -- from Cabal -import Distribution.Text -- from Cabal +import Distribution.Deprecated.Text -- from Cabal -- | Preliminary type for versions. type Ver = CV.Version diff --git a/cabal/cabal-install/Distribution/Solver/Types/ComponentDeps.hs b/cabal/cabal-install/Distribution/Solver/Types/ComponentDeps.hs --- a/cabal/cabal-install/Distribution/Solver/Types/ComponentDeps.hs +++ b/cabal/cabal-install/Distribution/Solver/Types/ComponentDeps.hs @@ -44,6 +44,7 @@ import Data.Foldable (fold) import qualified Distribution.Types.ComponentName as CN +import qualified Distribution.Types.LibraryName as LN {------------------------------------------------------------------------------- Types @@ -90,12 +91,12 @@ instance Binary a => Binary (ComponentDeps a) componentNameToComponent :: CN.ComponentName -> Component -componentNameToComponent (CN.CLibName) = ComponentLib -componentNameToComponent (CN.CSubLibName s) = ComponentSubLib s -componentNameToComponent (CN.CFLibName s) = ComponentFLib s -componentNameToComponent (CN.CExeName s) = ComponentExe s -componentNameToComponent (CN.CTestName s) = ComponentTest s -componentNameToComponent (CN.CBenchName s) = ComponentBench s +componentNameToComponent (CN.CLibName LN.LMainLibName) = ComponentLib +componentNameToComponent (CN.CLibName (LN.LSubLibName s)) = ComponentSubLib s +componentNameToComponent (CN.CFLibName s) = ComponentFLib s +componentNameToComponent (CN.CExeName s) = ComponentExe s +componentNameToComponent (CN.CTestName s) = ComponentTest s +componentNameToComponent (CN.CBenchName s) = ComponentBench s {------------------------------------------------------------------------------- Construction @@ -118,9 +119,9 @@ -- | Zip two 'ComponentDeps' together by 'Component', using 'mempty' -- as the neutral element when a 'Component' is present only in one. -zip :: (Monoid a, Monoid b) => ComponentDeps a -> ComponentDeps b -> ComponentDeps (a, b) -{- TODO/FIXME: Once we can expect containers>=0.5, switch to the more efficient version below: - +zip + :: (Monoid a, Monoid b) + => ComponentDeps a -> ComponentDeps b -> ComponentDeps (a, b) zip (ComponentDeps d1) (ComponentDeps d2) = ComponentDeps $ Map.mergeWithKey @@ -128,15 +129,6 @@ (fmap (\a -> (a, mempty))) (fmap (\b -> (mempty, b))) d1 d2 - --} -zip (ComponentDeps d1) (ComponentDeps d2) = - ComponentDeps $ - Map.unionWith - mappend - (Map.map (\a -> (a, mempty)) d1) - (Map.map (\b -> (mempty, b)) d2) - -- | Keep only selected components (and their associated deps info). filterDeps :: (Component -> a -> Bool) -> ComponentDeps a -> ComponentDeps a diff --git a/cabal/cabal-install/Distribution/Solver/Types/InstSolverPackage.hs b/cabal/cabal-install/Distribution/Solver/Types/InstSolverPackage.hs --- a/cabal/cabal-install/Distribution/Solver/Types/InstSolverPackage.hs +++ b/cabal/cabal-install/Distribution/Solver/Types/InstSolverPackage.hs @@ -9,7 +9,6 @@ import Distribution.Solver.Types.SolverId import Distribution.Types.MungedPackageId import Distribution.Types.PackageId -import Distribution.Types.PackageName import Distribution.Types.MungedPackageName import Distribution.InstalledPackageInfo (InstalledPackageInfo) import GHC.Generics (Generic) @@ -29,7 +28,7 @@ packageId i = -- HACK! See Note [Index conversion with internal libraries] let MungedPackageId mpn v = mungedId i - in PackageIdentifier (mkPackageName (unMungedPackageName mpn)) v + in PackageIdentifier (encodeCompatPackageName mpn) v instance HasMungedPackageId InstSolverPackage where mungedId = mungedId . instSolverPkgIPI diff --git a/cabal/cabal-install/Distribution/Solver/Types/PackageConstraint.hs b/cabal/cabal-install/Distribution/Solver/Types/PackageConstraint.hs --- a/cabal/cabal-install/Distribution/Solver/Types/PackageConstraint.hs +++ b/cabal/cabal-install/Distribution/Solver/Types/PackageConstraint.hs @@ -22,16 +22,18 @@ import Distribution.Package (PackageName) import Distribution.PackageDescription (FlagAssignment, dispFlagAssignment) import Distribution.Types.Dependency (Dependency(..)) +import Distribution.Types.LibraryName (LibraryName(..)) import Distribution.Version (VersionRange, simplifyVersionRange) import Distribution.Solver.Compat.Prelude ((<<>>)) import Distribution.Solver.Types.OptionalStanza import Distribution.Solver.Types.PackagePath -import Distribution.Text (disp, flatStyle) +import Distribution.Deprecated.Text (disp, flatStyle) import GHC.Generics (Generic) import Text.PrettyPrint ((<+>)) import qualified Text.PrettyPrint as Disp +import qualified Data.Set as Set -- | Determines to what packages and in what contexts a @@ -142,7 +144,7 @@ packageConstraintToDependency (PackageConstraint scope prop) = toDep prop where toDep (PackagePropertyVersion vr) = - Just $ Dependency (scopeToPackageName scope) vr + Just $ Dependency (scopeToPackageName scope) vr (Set.singleton LMainLibName) toDep (PackagePropertyInstalled) = Nothing toDep (PackagePropertySource) = Nothing toDep (PackagePropertyFlags _) = Nothing diff --git a/cabal/cabal-install/Distribution/Solver/Types/PackageIndex.hs b/cabal/cabal-install/Distribution/Solver/Types/PackageIndex.hs --- a/cabal/cabal-install/Distribution/Solver/Types/PackageIndex.hs +++ b/cabal/cabal-install/Distribution/Solver/Types/PackageIndex.hs @@ -55,12 +55,12 @@ import Distribution.Package ( PackageName, unPackageName, PackageIdentifier(..) , Package(..), packageName, packageVersion ) -import Distribution.Types.Dependency import Distribution.Version - ( withinRange ) + ( VersionRange, withinRange ) import Distribution.Simple.Utils ( lowercase, comparing ) +import qualified Prelude (foldr1) -- | The collection of information about packages from one or more 'PackageDB's. -- @@ -86,7 +86,7 @@ mappend = (<>) --save one mappend with empty in the common case: mconcat [] = mempty - mconcat xs = foldr1 mappend xs + mconcat xs = Prelude.foldr1 mappend xs instance Binary pkg => Binary (PackageIndex pkg) @@ -210,10 +210,10 @@ delete name (\pkg -> packageName pkg == name) -- | Removes all packages satisfying this dependency from the index. --- -deleteDependency :: Package pkg => Dependency -> PackageIndex pkg +deleteDependency :: Package pkg + => PackageName -> VersionRange -> PackageIndex pkg -> PackageIndex pkg -deleteDependency (Dependency name verstionRange) = +deleteDependency name verstionRange = delete name (\pkg -> packageVersion pkg `withinRange` verstionRange) -- @@ -269,8 +269,11 @@ -- We get back any number of versions of the specified package name, all -- satisfying the version range constraint. -- -lookupDependency :: Package pkg => PackageIndex pkg -> Dependency -> [pkg] -lookupDependency index (Dependency name versionRange) = +lookupDependency :: Package pkg + => PackageIndex pkg + -> PackageName -> VersionRange + -> [pkg] +lookupDependency index name versionRange = [ pkg | pkg <- lookup index name , packageName pkg == name , packageVersion pkg `withinRange` versionRange ] diff --git a/cabal/cabal-install/Distribution/Solver/Types/PackagePath.hs b/cabal/cabal-install/Distribution/Solver/Types/PackagePath.hs --- a/cabal/cabal-install/Distribution/Solver/Types/PackagePath.hs +++ b/cabal/cabal-install/Distribution/Solver/Types/PackagePath.hs @@ -10,7 +10,7 @@ ) where import Distribution.Package -import Distribution.Text +import Distribution.Deprecated.Text import qualified Text.PrettyPrint as Disp import Distribution.Solver.Compat.Prelude ((<<>>)) diff --git a/cabal/cabal-install/Distribution/Solver/Types/PkgConfigDb.hs b/cabal/cabal-install/Distribution/Solver/Types/PkgConfigDb.hs --- a/cabal/cabal-install/Distribution/Solver/Types/PkgConfigDb.hs +++ b/cabal/cabal-install/Distribution/Solver/Types/PkgConfigDb.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Solver.Types.PkgConfigDb @@ -20,33 +20,27 @@ , getPkgConfigDbDirs ) where -import Prelude () import Distribution.Solver.Compat.Prelude - -import Control.Exception (IOException, handle) -import qualified Data.Map as M -import Data.Version (parseVersion) -import Text.ParserCombinators.ReadP (readP_to_S) -import System.FilePath (splitSearchPath) +import Prelude () -import Distribution.Package - ( PkgconfigName, mkPkgconfigName ) -import Distribution.Verbosity - ( Verbosity ) -import Distribution.Version - ( Version, mkVersion', VersionRange, withinRange ) +import Control.Exception (IOException, handle) +import qualified Data.Map as M +import System.FilePath (splitSearchPath) -import Distribution.Compat.Environment - ( lookupEnv ) +import Distribution.Compat.Environment (lookupEnv) +import Distribution.Package (PkgconfigName, mkPkgconfigName) +import Distribution.Parsec import Distribution.Simple.Program - ( ProgramDb, pkgConfigProgram, getProgramOutput, requireProgram ) -import Distribution.Simple.Utils - ( info ) + (ProgramDb, getProgramOutput, pkgConfigProgram, requireProgram) +import Distribution.Simple.Utils (info) +import Distribution.Types.PkgconfigVersion +import Distribution.Types.PkgconfigVersionRange +import Distribution.Verbosity (Verbosity) -- | The list of packages installed in the system visible to -- @pkg-config@. This is an opaque datatype, to be constructed with -- `readPkgConfigDb` and queried with `pkgConfigPkgPresent`. -data PkgConfigDb = PkgConfigDb (M.Map PkgconfigName (Maybe Version)) +data PkgConfigDb = PkgConfigDb (M.Map PkgconfigName (Maybe PkgconfigVersion)) -- ^ If an entry is `Nothing`, this means that the -- package seems to be present, but we don't know the -- exact version (because parsing of the version @@ -84,22 +78,17 @@ pkgConfigDbFromList :: [(String, String)] -> PkgConfigDb pkgConfigDbFromList pairs = (PkgConfigDb . M.fromList . map convert) pairs where - convert :: (String, String) -> (PkgconfigName, Maybe Version) - convert (n,vs) = (mkPkgconfigName n, - case (reverse . readP_to_S parseVersion) vs of - (v, "") : _ -> Just (mkVersion' v) - _ -> Nothing -- Version not (fully) - -- understood. - ) + convert :: (String, String) -> (PkgconfigName, Maybe PkgconfigVersion) + convert (n,vs) = (mkPkgconfigName n, simpleParsec vs) -- | Check whether a given package range is satisfiable in the given -- @pkg-config@ database. -pkgConfigPkgIsPresent :: PkgConfigDb -> PkgconfigName -> VersionRange -> Bool +pkgConfigPkgIsPresent :: PkgConfigDb -> PkgconfigName -> PkgconfigVersionRange -> Bool pkgConfigPkgIsPresent (PkgConfigDb db) pn vr = case M.lookup pn db of Nothing -> False -- Package not present in the DB. Just Nothing -> True -- Package present, but version unknown. - Just (Just v) -> withinRange v vr + Just (Just v) -> withinPkgconfigVersionRange v vr -- If we could not read the pkg-config database successfully we allow -- the check to succeed. The plan found by the solver may fail to be -- executed later on, but we have no grounds for rejecting the plan at @@ -111,7 +100,7 @@ -- @Nothing@ indicates the package is not in the database, while -- @Just Nothing@ indicates that the package is in the database, -- but its version is not known. -pkgConfigDbPkgVersion :: PkgConfigDb -> PkgconfigName -> Maybe (Maybe Version) +pkgConfigDbPkgVersion :: PkgConfigDb -> PkgconfigName -> Maybe (Maybe PkgconfigVersion) pkgConfigDbPkgVersion (PkgConfigDb db) pn = M.lookup pn db -- NB: Since the solver allows solving to succeed if there is -- NoPkgConfigDb, we should report that we *guess* that there diff --git a/cabal/cabal-install/Distribution/Solver/Types/Settings.hs b/cabal/cabal-install/Distribution/Solver/Types/Settings.hs --- a/cabal/cabal-install/Distribution/Solver/Types/Settings.hs +++ b/cabal/cabal-install/Distribution/Solver/Types/Settings.hs @@ -3,10 +3,12 @@ module Distribution.Solver.Types.Settings ( ReorderGoals(..) , IndependentGoals(..) + , MinimizeConflictSet(..) , AvoidReinstalls(..) , ShadowPkgs(..) , StrongFlags(..) , AllowBootLibInstalls(..) + , OnlyConstrained(..) , EnableBackjumping(..) , CountConflicts(..) , SolveExecutables(..) @@ -14,14 +16,22 @@ import Distribution.Simple.Setup ( BooleanFlag(..) ) import Distribution.Compat.Binary (Binary(..)) +import Distribution.Pretty ( Pretty(pretty) ) +import Distribution.Deprecated.Text ( Text(parse) ) import GHC.Generics (Generic) +import qualified Distribution.Deprecated.ReadP as Parse +import qualified Text.PrettyPrint as PP + newtype ReorderGoals = ReorderGoals Bool deriving (BooleanFlag, Eq, Generic, Show) newtype CountConflicts = CountConflicts Bool deriving (BooleanFlag, Eq, Generic, Show) +newtype MinimizeConflictSet = MinimizeConflictSet Bool + deriving (BooleanFlag, Eq, Generic, Show) + newtype IndependentGoals = IndependentGoals Bool deriving (BooleanFlag, Eq, Generic, Show) @@ -37,6 +47,13 @@ newtype AllowBootLibInstalls = AllowBootLibInstalls Bool deriving (BooleanFlag, Eq, Generic, Show) +-- | Should we consider all packages we know about, or only those that +-- have constraints explicitly placed on them or which are goals? +data OnlyConstrained + = OnlyConstrainedNone + | OnlyConstrainedAll + deriving (Eq, Generic, Show) + newtype EnableBackjumping = EnableBackjumping Bool deriving (BooleanFlag, Eq, Generic, Show) @@ -46,8 +63,21 @@ instance Binary ReorderGoals instance Binary CountConflicts instance Binary IndependentGoals +instance Binary MinimizeConflictSet instance Binary AvoidReinstalls instance Binary ShadowPkgs instance Binary StrongFlags instance Binary AllowBootLibInstalls +instance Binary OnlyConstrained instance Binary SolveExecutables + +instance Pretty OnlyConstrained where + pretty OnlyConstrainedAll = PP.text "all" + pretty OnlyConstrainedNone = PP.text "none" + +instance Text OnlyConstrained where + parse = Parse.choice + [ Parse.string "all" >> return OnlyConstrainedAll + , Parse.string "none" >> return OnlyConstrainedNone + ] + diff --git a/cabal/cabal-install/README.md b/cabal/cabal-install/README.md --- a/cabal/cabal-install/README.md +++ b/cabal/cabal-install/README.md @@ -73,7 +73,7 @@ the setting in the config file; for example, you could use the following: - symlink-bindir: $HOME/bin + installdir: $HOME/bin Quick start on Windows systems diff --git a/cabal/cabal-install/bash-completion/cabal b/cabal/cabal-install/bash-completion/cabal --- a/cabal/cabal-install/bash-completion/cabal +++ b/cabal/cabal-install/bash-completion/cabal @@ -1,45 +1,185 @@ +#!/bin/bash + +################################################## + # cabal command line completion +# # Copyright 2007-2008 "Lennart Kolmodin" -# "Duncan Coutts" +# "Duncan Coutts" +# Copyright 2019- "Sam Boosalis" # +# Compatibility — Bash 3. +# +# OSX won't update Bash 3 (last updated circa 2009) to Bash 4, +# and we'd like this completion script to work on both Linux and Mac. +# +# For example, OSX Yosemite (released circa 2014) ships with Bash 3: +# +# $ echo $BASH_VERSION +# 3.2 +# +# While Ubuntu LTS 14.04 (a.k.a. Trusty, also released circa 2016) +# ships with the latest version, Bash 4 (updated circa 2016): +# +# $ echo $BASH_VERSION +# 4.3 +# + +# Testing +# +# (1) Invoke « shellcheck » +# +# * source: « https://github.com/koalaman/shellcheck » +# * run: « shellcheck ./cabal-install/bash-completion/cabal » +# +# (2) Interpret via Bash 3 +# +# * source: « https://ftp.gnu.org/gnu/bash/bash-3.2.tar.gz » +# * run: « bash --noprofile --norc --posix ./cabal-install/bash-completion/cabal » +# +# + +################################################## +# Dependencies: + +command -v cabal >/dev/null +command -v grep >/dev/null +command -v sed >/dev/null + +################################################## + +# List project-specific (/ internal) packages: +# +# + +function _cabal_list_packages () +( + shopt -s nullglob + + local CabalFiles + CabalFiles=( ./*.cabal ./*/*.cabal ./*/*/*.cabal ) + + for FILE in "${CabalFiles[@]}" + do + + BASENAME=$(basename "$FILE") + PACKAGE="${BASENAME%.cabal}" + + echo "$PACKAGE" + + done | sort | uniq +) + +# NOTES +# +# [1] « "${string%suffix}" » strips « suffix » from « string », +# in pure Bash. +# +# [2] « done | sort | uniq » removes duplicates from the output of the for-loop. +# + +################################################## + # List cabal targets by type, pass: -# - test-suite for test suites -# - benchmark for benchmarks -# - executable for executables -# - executable|test-suite|benchmark for the three -_cabal_list() -{ - for f in ./*.cabal; do - grep -Ei "^[[:space:]]*($1)[[:space:]]" "$f" | - sed -e "s/.* \([^ ]*\).*/\1/" - done -} +# +# - ‹test-suite› for test suites +# - ‹benchmark› for benchmarks +# - ‹executable› for executables +# - ‹library› for internal libraries +# - ‹foreign-library› for foreign libraries +# - nothing for all components. +# +function _cabal_list_targets () +( + shopt -s nullglob + + # ^ NOTE « _cabal_list_targets » must be a subshell to temporarily enable « nullglob ». + # hence, « function _ () ( ... ) » over « function _ () { ... } ». + # without « nullglob », if a glob-pattern fails, it becomes a literal + # (i.e. the string with an asterix, rather than an empty string). + + CabalComponent=${1:-library|executable|test-suite|benchmark|foreign-library} + + local CabalFiles + CabalFiles=( ./*.cabal ./*/*.cabal ./*/*/*.cabal ) + + for FILE in "${CabalFiles[@]}" + do + + grep -E -i "^[[:space:]]*($CabalComponent)[[:space:]]" "$FILE" 2>/dev/null | sed -e "s/.* \([^ ]*\).*/\1/" | sed -e '/^$/d' + + done | sort | uniq +) + +# NOTES +# +# [1] in « sed '/^$/d' »: +# +# * « d » is the sed command to delete a line. +# * « ^$ » is a regular expression matching only a blank line +# (i.e. a line start followed by a line end). +# +# dropping blank lines is necessary to ignore public « library » stanzas, +# while still matching private « library _ » stanzas. +# +# [2] +# + +#TODO# rm duplicate components and qualify with « PACKAGE: » (from basename): +# +# $ .. | sort | uniq + +################################################## + # List possible targets depending on the command supplied as parameter. The # ideal option would be to implement this via --list-options on cabal directly. # This is a temporary workaround. -_cabal_targets() + +function _cabal_targets () + { - # If command ($*) contains build, repl, test or bench completes with - # targets of according type. - local comp - for comp in "$@"; do - [ "$comp" == new-build ] && _cabal_list "executable|test-suite|benchmark" && break - [ "$comp" == build ] && _cabal_list "executable|test-suite|benchmark" && break - [ "$comp" == repl ] && _cabal_list "executable|test-suite|benchmark" && break - [ "$comp" == run ] && _cabal_list "executable" && break - [ "$comp" == test ] && _cabal_list "test-suite" && break - [ "$comp" == bench ] && _cabal_list "benchmark" && break + local Completion + + for Completion in "$@"; do + + [ "$Completion" == new-build ] && _cabal_list_targets && break + [ "$Completion" == new-repl ] && _cabal_list_targets && break + [ "$Completion" == new-run ] && _cabal_list_targets "executable" && break + [ "$Completion" == new-test ] && _cabal_list_targets "test-suite" && break + [ "$Completion" == new-bench ] && _cabal_list_targets "benchmark" && break + [ "$Completion" == new-haddock ] && _cabal_list_targets && break + + [ "$Completion" == new-install ] && _cabal_list_targets "executable" && break + # ^ Only complete for local packages (not all 1000s of remote packages). + + [ "$Completion" == build ] && _cabal_list_targets "executable|test-suite|benchmark" && break + [ "$Completion" == repl ] && _cabal_list_targets "executable|test-suite|benchmark" && break + [ "$Completion" == run ] && _cabal_list_targets "executable" && break + [ "$Completion" == test ] && _cabal_list_targets "test-suite" && break + [ "$Completion" == bench ] && _cabal_list_targets "benchmark" && break + done } +# NOTES +# +# [1] « $@ » will be the full command-line (so far). +# +# [2] +# + +################################################## + # List possible subcommands of a cabal subcommand. # # In example "sandbox" is a cabal subcommand that itself has subcommands. Since # "cabal --list-options" doesn't work in such cases we have to get the list # using other means. -_cabal_subcommands() + +function _cabal_subcommands () + { local word for word in "$@"; do @@ -54,7 +194,10 @@ done } -__cabal_has_doubledash () +################################################## + +function __cabal_has_doubledash () + { local c=1 # Ignore the last word, because it is replaced anyways. @@ -70,25 +213,34 @@ return 1 } -_cabal() + +################################################## + +function _cabal () + { # no completion past cabal arguments. __cabal_has_doubledash && return # get the word currently being completed - local cur - cur=${COMP_WORDS[$COMP_CWORD]} + local CurrentWord + CurrentWord=${COMP_WORDS[$COMP_CWORD]} # create a command line to run - local cmd + local CommandLine # copy all words the user has entered - cmd=( ${COMP_WORDS[@]} ) + CommandLine=( "${COMP_WORDS[@]}" ) # replace the current word with --list-options - cmd[${COMP_CWORD}]="--list-options" + CommandLine[${COMP_CWORD}]="--list-options" # the resulting completions should be put into this array - COMPREPLY=( $( compgen -W "$( eval "${cmd[@]}" 2>/dev/null ) $( _cabal_targets "${cmd[@]}" ) $( _cabal_subcommands "${COMP_WORDS[@]}" )" -- "$cur" ) ) + COMPREPLY=( $( compgen -W "$( eval "${CommandLine[@]}" 2>/dev/null ) $( _cabal_targets "${CommandLine[@]}" ) $( _cabal_subcommands "${COMP_WORDS[@]}" )" -- "$CurrentWord" ) ) } + +# abc="a b c" +# { IFS=" " read -a ExampleArray <<< "$abc"; echo ${ExampleArray[@]}; echo ${!ExampleArray[@]}; } + +################################################## complete -F _cabal -o default cabal diff --git a/cabal/cabal-install/bootstrap.sh b/cabal/cabal-install/bootstrap.sh --- a/cabal/cabal-install/bootstrap.sh +++ b/cabal/cabal-install/bootstrap.sh @@ -34,7 +34,7 @@ GZIP_PROGRAM="${GZIP_PROGRAM:-gzip}" # The variable SCOPE_OF_INSTALLATION can be set on the command line to -# use/install the libaries needed to build cabal-install to a custom package +# use/install the libraries needed to build cabal-install to a custom package # database instead of the user or global package database. # # Example: @@ -137,6 +137,9 @@ "--no-doc") NO_DOCUMENTATION=1 shift;; + "--no-install") + NO_INSTALL=1 + shift;; "-j"|"--jobs") shift # check if there is another argument which doesn't start with - or -- @@ -221,8 +224,8 @@ # >= 2.6.0.2 && < 2.7 NETWORK_VER="2.7.0.0"; NETWORK_VER_REGEXP="2\.[0-7]\." # >= 2.0 && < 2.7 -CABAL_VER="2.4.1.0"; CABAL_VER_REGEXP="2\.4\.[1-9]" - # >= 2.4.1.0 && < 2.5 +CABAL_VER="3.1.0.0"; CABAL_VER_REGEXP="3\.1\.[0-9]" + # >= 2.5 && < 2.6 TRANS_VER="0.5.5.0"; TRANS_VER_REGEXP="0\.[45]\." # >= 0.2.* && < 0.6 MTL_VER="2.2.2"; MTL_VER_REGEXP="[2]\." @@ -276,6 +279,7 @@ echo "Checking installed packages for ghc-${GHC_VER}..." ${GHC_PKG} list --global ${SCOPE_OF_INSTALLATION} > ghc-pkg.list || die "running '${GHC_PKG} list' failed" +trap "rm ghc-pkg.list" EXIT # Will we need to install this package, or is a suitable version installed? need_pkg () { @@ -297,11 +301,14 @@ if need_pkg ${PKG} ${VER_MATCH} then - if [ -r "${PKG}-${VER}.tar.gz" ] + if [ -d "${PKG}-${VER}" ] then - echo "${PKG}-${VER} will be installed from local tarball." + echo "${PKG}-${VER} will be installed from local directory." + elif [ -r "${PKG}-${VER}.tar.gz" ] + then + echo "${PKG}-${VER} will be installed from local tarball." else - echo "${PKG}-${VER} will be downloaded and installed." + echo "${PKG}-${VER} will be downloaded and installed." fi else echo "${PKG} is already installed and the version is ok." @@ -348,6 +355,8 @@ } install_pkg () { + [ ${NO_INSTALL} ] && return 0 + PKG=$1 VER=$2 @@ -397,14 +406,19 @@ if need_pkg ${PKG} ${VER_MATCH} then echo - if [ -r "${PKG}-${VER}.tar.gz" ] + if [ -d "${PKG}-${VER}" ] then - echo "Using local tarball for ${PKG}-${VER}." + echo "Using local directory for ${PKG}-${VER}." else + if [ -r "${PKG}-${VER}.tar.gz" ] + then + echo "Using local tarball for ${PKG}-${VER}." + else echo "Downloading ${PKG}-${VER}..." fetch_pkg ${PKG} ${VER} + fi + unpack_pkg "${PKG}" "${VER}" fi - unpack_pkg "${PKG}" "${VER}" (cd "${PKG}-${VER}" && install_pkg ${PKG} ${VER}) fi } @@ -501,12 +515,13 @@ install_pkg "cabal-install" +[ ${NO_INSTALL} ] && exit 0 # Use the newly built cabal to turn the prefix/package database into a # legit cabal sandbox. This works because 'cabal sandbox init' will # reuse the already existing package database and other files if they # are in the expected locations. -[ ! -z "$SANDBOX" ] && $SANDBOX/bin/cabal sandbox init --sandbox $SANDBOX +[ ! -z "$SANDBOX" ] && $SANDBOX/bin/cabal v1-sandbox init --sandbox $SANDBOX echo echo "===========================================" @@ -525,12 +540,10 @@ echo "By default cabal will install programs to $HOME/.cabal/bin" echo "If you do not want to add this directory to your PATH then you can" echo "change the setting in the config file, for example you could use:" - echo "symlink-bindir: $HOME/bin" + echo "installdir: $HOME/bin" else echo "Sorry, something went wrong." echo "The 'cabal' executable was not successfully installed into" echo "$CABAL_BIN/" fi echo - -rm ghc-pkg.list diff --git a/cabal/cabal-install/cabal-install.cabal b/cabal/cabal-install/cabal-install.cabal --- a/cabal/cabal-install/cabal-install.cabal +++ b/cabal/cabal-install/cabal-install.cabal @@ -4,7 +4,7 @@ -- To update this file, edit 'cabal-install.cabal.pp' and run -- 'make cabal-install-prod' in the project's root folder. Name: cabal-install -Version: 2.4.1.0 +Version: 3.1.0.0 Synopsis: The command-line interface for Cabal and Hackage. Description: The \'cabal\' command-line program simplifies the process of managing @@ -16,7 +16,7 @@ License-File: LICENSE Author: Cabal Development Team (see AUTHORS file) Maintainer: Cabal Development Team -Copyright: 2003-2018, Cabal Development Team +Copyright: 2003-2019, Cabal Development Team Category: Distribution Build-type: Custom Extra-Source-Files: @@ -146,6 +146,13 @@ extra-libraries: bsd hs-source-dirs: . other-modules: + -- this modules are moved from Cabal + -- they are needed for as long until cabal-install moves to parsec parser + Distribution.Deprecated.ParseUtils + Distribution.Deprecated.ReadP + Distribution.Deprecated.Text + Distribution.Deprecated.ViewAsFieldDescr + Distribution.Client.BuildReports.Anonymous Distribution.Client.BuildReports.Storage Distribution.Client.BuildReports.Types @@ -161,6 +168,7 @@ Distribution.Client.CmdFreeze Distribution.Client.CmdHaddock Distribution.Client.CmdInstall + Distribution.Client.CmdInstall.ClientInstallFlags Distribution.Client.CmdRepl Distribution.Client.CmdRun Distribution.Client.CmdTest @@ -243,6 +251,7 @@ Distribution.Client.Utils Distribution.Client.Utils.Assertion Distribution.Client.Utils.Json + Distribution.Client.Utils.Parsec Distribution.Client.VCS Distribution.Client.Win32SelfUpgrade Distribution.Client.World @@ -303,7 +312,7 @@ base16-bytestring >= 0.1.1 && < 0.2, binary >= 0.7.3 && < 0.9, bytestring >= 0.10.6.0 && < 0.11, - Cabal >= 2.4.1.0 && < 2.5, + Cabal == 3.1.*, containers >= 0.5.6.2 && < 0.7, cryptohash-sha256 >= 0.11 && < 0.12, deepseq >= 1.4.1.1 && < 1.5, @@ -311,11 +320,11 @@ echo >= 0.1.3 && < 0.2, edit-distance >= 0.2.2 && < 0.3, filepath >= 1.4.0.0 && < 1.5, - hashable >= 1.0 && < 1.3, + hashable >= 1.0 && < 1.4, HTTP >= 4000.1.5 && < 4000.4, mtl >= 2.0 && < 2.3, network-uri >= 2.6.0.2 && < 2.7, - network >= 2.6 && < 2.9, + network >= 2.6 && < 3.2, pretty >= 1.1 && < 1.2, process >= 1.2.3.0 && < 1.7, random >= 1 && < 1.2, @@ -325,9 +334,12 @@ zlib >= 0.5.3 && < 0.7, hackage-security >= 0.5.2.2 && < 0.6, text >= 1.2.3 && < 1.3, - zip-archive >= 0.3.2.5 && < 0.4, parsec >= 3.1.13.0 && < 3.2 + if !impl(ghc >= 8.0) + build-depends: fail == 4.9.* + build-depends: semigroups >= 0.18.3 && <0.20 + if flag(native-dns) if os(windows) build-depends: windns >= 0.1.0 && < 0.2 @@ -337,7 +349,7 @@ if os(windows) build-depends: Win32 >= 2 && < 3 else - build-depends: unix >= 2.5 && < 2.8 + build-depends: unix >= 2.5 && < 2.9 if flag(debug-expensive-assertions) cpp-options: -DDEBUG_EXPENSIVE_ASSERTIONS diff --git a/cabal/cabal-install/cabal-install.cabal.pp b/cabal/cabal-install/cabal-install.cabal.pp --- a/cabal/cabal-install/cabal-install.cabal.pp +++ b/cabal/cabal-install/cabal-install.cabal.pp @@ -10,7 +10,7 @@ -- To update this file, edit 'cabal-install.cabal.pp' and run -- 'make cabal-install-prod' in the project's root folder. Name: cabal-install -Version: 2.4.1.0 +Version: 3.1.0.0 # # NOTE: when updating build-depends, don't forget to update version regexps in bootstrap.sh. # @@ -22,7 +22,7 @@ base16-bytestring >= 0.1.1 && < 0.2, binary >= 0.7.3 && < 0.9, bytestring >= 0.10.6.0 && < 0.11, - Cabal >= 2.4.1.0 && < 2.5, + Cabal == 3.1.*, containers >= 0.5.6.2 && < 0.7, cryptohash-sha256 >= 0.11 && < 0.12, deepseq >= 1.4.1.1 && < 1.5, @@ -30,11 +30,11 @@ echo >= 0.1.3 && < 0.2, edit-distance >= 0.2.2 && < 0.3, filepath >= 1.4.0.0 && < 1.5, - hashable >= 1.0 && < 1.3, + hashable >= 1.0 && < 1.4, HTTP >= 4000.1.5 && < 4000.4, mtl >= 2.0 && < 2.3, network-uri >= 2.6.0.2 && < 2.7, - network >= 2.6 && < 2.9, + network >= 2.6 && < 3.2, pretty >= 1.1 && < 1.2, process >= 1.2.3.0 && < 1.7, random >= 1 && < 1.2, @@ -44,9 +44,12 @@ zlib >= 0.5.3 && < 0.7, hackage-security >= 0.5.2.2 && < 0.6, text >= 1.2.3 && < 1.3, - zip-archive >= 0.3.2.5 && < 0.4, parsec >= 3.1.13.0 && < 3.2 + if !impl(ghc >= 8.0) + build-depends: fail == 4.9.* + build-depends: semigroups >= 0.18.3 && <0.20 + if flag(native-dns) if os(windows) build-depends: windns >= 0.1.0 && < 0.2 @@ -56,7 +59,7 @@ if os(windows) build-depends: Win32 >= 2 && < 3 else - build-depends: unix >= 2.5 && < 2.8 + build-depends: unix >= 2.5 && < 2.9 %enddef %def CABAL_COMPONENTCOMMON default-language: Haskell2010 @@ -72,6 +75,13 @@ %else other-modules: %endif + -- this modules are moved from Cabal + -- they are needed for as long until cabal-install moves to parsec parser + Distribution.Deprecated.ParseUtils + Distribution.Deprecated.ReadP + Distribution.Deprecated.Text + Distribution.Deprecated.ViewAsFieldDescr + Distribution.Client.BuildReports.Anonymous Distribution.Client.BuildReports.Storage Distribution.Client.BuildReports.Types @@ -87,6 +97,7 @@ Distribution.Client.CmdFreeze Distribution.Client.CmdHaddock Distribution.Client.CmdInstall + Distribution.Client.CmdInstall.ClientInstallFlags Distribution.Client.CmdRepl Distribution.Client.CmdRun Distribution.Client.CmdTest @@ -169,6 +180,7 @@ Distribution.Client.Utils Distribution.Client.Utils.Assertion Distribution.Client.Utils.Json + Distribution.Client.Utils.Parsec Distribution.Client.VCS Distribution.Client.Win32SelfUpgrade Distribution.Client.World @@ -253,7 +265,7 @@ License-File: LICENSE Author: Cabal Development Team (see AUTHORS file) Maintainer: Cabal Development Team -Copyright: 2003-2018, Cabal Development Team +Copyright: 2003-2019, Cabal Development Team Category: Distribution %if CABAL_FLAG_LIB Build-type: Simple @@ -436,6 +448,7 @@ UnitTests.Distribution.Client.ArbitraryInstances UnitTests.Distribution.Client.FileMonitor UnitTests.Distribution.Client.Get + UnitTests.Distribution.Client.GenericInstances UnitTests.Distribution.Client.GZipUtils UnitTests.Distribution.Client.Glob UnitTests.Distribution.Client.IndexUtils.Timestamp @@ -447,6 +460,7 @@ UnitTests.Distribution.Client.Store UnitTests.Distribution.Client.Tar UnitTests.Distribution.Client.Targets + UnitTests.Distribution.Client.TreeDiffInstances UnitTests.Distribution.Client.UserConfig UnitTests.Distribution.Client.VCS UnitTests.Distribution.Solver.Modular.Builder @@ -462,7 +476,7 @@ cpp-options: -DMONOLITHIC build-depends: - Cabal == 2.4.*, + Cabal == 3.1.*, cabal-install-solver-dsl, QuickCheck >= 2.8.2, array, @@ -484,6 +498,7 @@ tasty >= 1.1.0.3 && < 1.2, tasty-hunit >= 0.10, tasty-quickcheck, + tree-diff, time, zlib %endif @@ -506,12 +521,14 @@ UnitTests.Distribution.Client.Targets UnitTests.Distribution.Client.FileMonitor UnitTests.Distribution.Client.Get + UnitTests.Distribution.Client.GenericInstances UnitTests.Distribution.Client.Glob UnitTests.Distribution.Client.GZipUtils UnitTests.Distribution.Client.Sandbox UnitTests.Distribution.Client.Sandbox.Timestamp UnitTests.Distribution.Client.Store UnitTests.Distribution.Client.Tar + UnitTests.Distribution.Client.TreeDiffInstances UnitTests.Distribution.Client.UserConfig UnitTests.Distribution.Client.ProjectConfig UnitTests.Distribution.Client.JobControl @@ -542,12 +559,13 @@ tar, time, zlib, - network-uri, + network-uri < 2.6.2.0, network, tasty >= 1.1.0.3 && < 1.2, tasty-hunit >= 0.10, tasty-quickcheck, tagged, + tree-diff, QuickCheck >= 2.8.2 ghc-options: -threaded diff --git a/cabal/cabal-install/changelog b/cabal/cabal-install/changelog --- a/cabal/cabal-install/changelog +++ b/cabal/cabal-install/changelog @@ -1,5 +1,45 @@ -*-change-log-*- +3.1.0.0 (current development version) + +3.0.0.0 TBD + * Parses comma-seperated lists for extra-prog-path, extra-lib-dirs, extra-framework-dirs, + and extra-include-dirs as actual lists. (#5420) + * `v2-repl` no longer changes directory to a randomized temporary folder + when used outside of a project. (#5544) + * `install-method` and `overwrite-policy` in `.cabal/config` now actually work. (#5942) + * `v2-install` now reports the error when a package fails to build. (#5641) + * `v2-install` now has a default when called in a project (#5978, #6014, #6092) + * '--write-ghc-environment-files' now defaults to 'never' (#4242) + * Fix `sdist`'s output when sent to stdout. (#5874) + * Allow a list of dependencies to be provided for `repl --build-depends`. (#5845) + * Legacy commands are now only accessible with the `v1-` prefixes, and the `v2-` + commands are the new default. Accordingly, the next version of Cabal will be + the start of the 3.x version series. (#5800) + * New solver flag: '--reject-unconstrained-dependencies'. (#2568) + * Ported old-style test options to the new-style commands (#5455). + * Improved error messages for cabal file parse errors. (#5710) + * Removed support for `.zip` format source distributions (#5755) + * Add "simple project" initialization option. (#5707) + * Add '--minimize-conflict-set' flag to try to improve the solver's + error message, but with an increase in run time. (#5647) + * v2-test now succeeds when there are no test suites. (#5435) + * Add '--lib', '--exe', and '--libandexe' shorthands to init. (#5759) + * init now generates valid `Main.lhs` files. (#5577) + * Init improvements: add flag '--application-dir', and when creating + a library also create a MyLib.hs module. (#5740) + * Add support for generating test-suite via cabal init. (#5761) + * Increase `max-backjumps` default from 2000 to 4000. + * Make v2-install/new-install-specific flags configurable in + ~/.cabal/config + * Add --installdir and --install-method=copy flags to v2-install + that make it possible to copy the executable instead of symlinking it + * --symlink-bindir no longer controls the symlinking directory of + v2-install (installdir controls both symlinking and copying now) + * Add --test-wrapper that allows a prebuild script to set the test environment. + * Add filterTestFlags: filter test-wrapper for Cabal < 3.0.0. + * Cabal now only builds the minimum of a package for `v2-install` (#5754, #6091) + 2.4.1.0 Mikhail Glushenkov November 2018 * Add message to alert user to potential package casing errors. (#5635) * new-clean no longer deletes dist-newstyle/src with `-s`. (#5699) @@ -11,9 +51,9 @@ * Register monolithic packages installed into the store due to a build-tool dependency if they also happen to contain a buildable public lib. (#5379,#5604) - * Fixed a Windows bug where cabal-install tried to copy files - after moving them (#5631). - * 'cabal v2-repl' now works for indefinite (in the Backpack sense) components. (#5619) + * Fixed a Windows bug where cabal-install tried to copy files + after moving them (#5631). + * 'cabal v2-repl' now works for indefinite (in the Backpack sense) components. (#5619) * Set data dir environment variable for tarballs and remote repos (#5469) * Fix monolithic inplace build tool PATH (#5633) * 'cabal init' now supports '-w'/'--with-compiler' flag (#4936, #5654) @@ -148,7 +188,7 @@ * Paths_ autogen modules now compile when `RebindableSyntax` or `OverloadedStrings` is used in `default-extensions`. [stack#3789](https://github.com/commercialhaskell/stack/issues/3789) - * `getDataDir` and other `Paths_autogen` functions now work correctly + * getDataDir` and other `Paths_autogen` functions now work correctly when compiling a custom `Setup.hs` script using `new-build` (#5164). 2.0.0.1 Mikhail Glushenkov December 2017 diff --git a/cabal/cabal-install/main/Main.hs b/cabal/cabal-install/main/Main.hs --- a/cabal/cabal-install/main/Main.hs +++ b/cabal/cabal-install/main/Main.hs @@ -39,7 +39,7 @@ , ReportFlags(..), reportCommand , runCommand , InitFlags(initVerbosity, initHcPath), initCommand - , SDistFlags(..), SDistExFlags(..), sdistCommand + , SDistFlags(..), sdistCommand , Win32SelfUpgradeFlags(..), win32SelfUpgradeCommand , ActAsSetupFlags(..), actAsSetupCommand , SandboxFlags(..), sandboxCommand @@ -80,7 +80,6 @@ import qualified Distribution.Client.List as List ( list, info ) - import qualified Distribution.Client.CmdConfigure as CmdConfigure import qualified Distribution.Client.CmdUpdate as CmdUpdate import qualified Distribution.Client.CmdBuild as CmdBuild @@ -142,9 +141,7 @@ import Distribution.Client.Manpage (manpage) import qualified Distribution.Client.Win32SelfUpgrade as Win32SelfUpgrade import Distribution.Client.Utils (determineNumJobs -#if defined(mingw32_HOST_OS) ,relaxEncodingErrors -#endif ) import Distribution.Package (packageId) @@ -186,19 +183,18 @@ ( Version, mkVersion, orLaterVersion ) import qualified Paths_cabal_install (version) +import Distribution.Compat.ResponseFile import System.Environment (getArgs, getProgName) import System.Exit (exitFailure, exitSuccess) import System.FilePath ( dropExtension, splitExtension - , takeExtension, (), (<.>)) + , takeExtension, (), (<.>) ) import System.IO ( BufferMode(LineBuffering), hSetBuffering -#ifdef mingw32_HOST_OS - , stderr -#endif - , stdout ) + , stderr, stdout ) import System.Directory (doesFileExist, getCurrentDirectory) import Data.Monoid (Any(..)) import Control.Exception (SomeException(..), try) import Control.Monad (mapM_) +import Data.Version (showVersion) #ifdef MONOLITHIC import qualified UnitTests @@ -230,21 +226,19 @@ -- Enable line buffering so that we can get fast feedback even when piped. -- This is especially important for CI and build systems. hSetBuffering stdout LineBuffering - -- The default locale encoding for Windows CLI is not UTF-8 and printing - -- Unicode characters to it will fail unless we relax the handling of encoding - -- errors when writing to stderr and stdout. -#ifdef mingw32_HOST_OS + -- If the locale encoding for CLI doesn't support all Unicode characters, + -- printing to it may fail unless we relax the handling of encoding errors + -- when writing to stderr and stdout. relaxEncodingErrors stdout relaxEncodingErrors stderr -#endif - getArgs >>= mainWorker + (args0, args1) <- break (== "--") <$> getArgs + mainWorker =<< (++ args1) <$> expandResponse args0 mainWorker :: [String] -> IO () mainWorker args = do - validScript <- - if null args - then return False - else doesFileExist (last args) + hasScript <- if not (null args) + then CmdRun.validScript (head args) + else return False topHandler $ case commandsRun (globalCommand commands) commands args of @@ -259,8 +253,8 @@ -> printNumericVersion CommandHelp help -> printCommandHelp help CommandList opts -> printOptionsList opts - CommandErrors errs - | validScript -> CmdRun.handleShebang (last args) + CommandErrors errs + | hasScript -> CmdRun.handleShebang (head args) (tail args) | otherwise -> printErrors errs CommandReadyToGo action -> do globalFlags' <- updateSandboxConfigFileFlag globalFlags @@ -282,9 +276,9 @@ ++ "defaults if you run 'cabal update'." printOptionsList = putStr . unlines printErrors errs = dieNoVerbosity $ intercalate "\n" errs - printNumericVersion = putStrLn $ display Paths_cabal_install.version + printNumericVersion = putStrLn $ showVersion Paths_cabal_install.version printVersion = putStrLn $ "cabal-install version " - ++ display Paths_cabal_install.version + ++ showVersion Paths_cabal_install.version ++ "\ncompiled using version " ++ display cabalVersion ++ " of the Cabal library " @@ -323,9 +317,9 @@ , newCmd CmdTest.testCommand CmdTest.testAction , newCmd CmdBench.benchCommand CmdBench.benchAction , newCmd CmdExec.execCommand CmdExec.execAction - , newCmd CmdClean.cleanCommand CmdClean.cleanAction + , newCmd CmdClean.cleanCommand CmdClean.cleanAction , newCmd CmdSdist.sdistCommand CmdSdist.sdistAction - + , legacyCmd configureExCommand configureAction , legacyCmd updateCommand updateAction , legacyCmd buildCommand buildAction @@ -560,9 +554,9 @@ either (const onNoPkgDesc) (const onPkgDesc) pkgDesc -installAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) +installAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) -> [String] -> Action -installAction (configFlags, _, installFlags, _) _ globalFlags +installAction (configFlags, _, installFlags, _, _) _ globalFlags | fromFlagOrDefault False (installOnly installFlags) = do let verb = fromFlagOrDefault normal (configVerbosity configFlags) (useSandbox, config) <- loadConfigOrSandboxConfig verb globalFlags @@ -574,7 +568,7 @@ installCommand (const mempty) (const []) installAction - (configFlags, configExFlags, installFlags, haddockFlags) + (configFlags, configExFlags, installFlags, haddockFlags, testFlags) extraArgs globalFlags = do let verb = fromFlagOrDefault normal (configVerbosity configFlags) (useSandbox, config) <- updateInstallDirs (configUserInstall configFlags) @@ -593,7 +587,7 @@ -- TODO: It'd be nice if 'cabal install' picked up the '-w' flag passed to -- 'configure' when run inside a sandbox. Right now, running -- - -- $ cabal sandbox init && cabal configure -w /path/to/ghc + -- \$ cabal sandbox init && cabal configure -w /path/to/ghc -- && cabal build && cabal install -- -- performs the compilation twice unless you also pass -w to 'install'. @@ -610,6 +604,9 @@ haddockFlags' = defaultHaddockFlags `mappend` savedHaddockFlags config `mappend` haddockFlags { haddockDistPref = toFlag dist } + testFlags' = Cabal.defaultTestFlags `mappend` + savedTestFlags config `mappend` + testFlags { testDistPref = toFlag dist } globalFlags' = savedGlobalFlags config `mappend` globalFlags (comp, platform, progdb) <- configCompilerAux' configFlags' -- TODO: Redesign ProgramDB API to prevent such problems as #2241 in the @@ -646,7 +643,7 @@ comp platform progdb' useSandbox mSandboxPkgInfo globalFlags' configFlags'' configExFlags' - installFlags' haddockFlags' + installFlags' haddockFlags' testFlags' targets where @@ -888,9 +885,9 @@ withRepoContext verbosity globalFlags' $ \repoContext -> update verbosity updateFlags repoContext -upgradeAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) +upgradeAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) -> [String] -> Action -upgradeAction (configFlags, _, _, _) _ _ = die' verbosity $ +upgradeAction (configFlags, _, _, _, _) _ _ = die' verbosity $ "Use the 'cabal install' command instead of 'cabal upgrade'.\n" ++ "You can install the latest version of a package using 'cabal install'. " ++ "The 'cabal upgrade' command has been removed because people found it " @@ -1051,7 +1048,7 @@ let verbosity = fromFlag verbosityFlag path <- case extraArgs of [] -> do cwd <- getCurrentDirectory - tryFindPackageDesc cwd + tryFindPackageDesc verbosity cwd (p:_) -> return p pkgDesc <- readGenericPackageDescription verbosity path -- Uses 'writeFileAtomic' under the hood. @@ -1070,16 +1067,15 @@ ++ package ++ "' or 'cabal sandbox hc-pkg -- unregister " ++ package ++ "'." -sdistAction :: (SDistFlags, SDistExFlags) -> [String] -> Action -sdistAction (sdistFlags, sdistExFlags) extraArgs globalFlags = do +sdistAction :: SDistFlags -> [String] -> Action +sdistAction sdistFlags extraArgs globalFlags = do let verbosity = fromFlag (sDistVerbosity sdistFlags) unless (null extraArgs) $ die' verbosity $ "'sdist' doesn't take any extra arguments: " ++ unwords extraArgs load <- try (loadConfigOrSandboxConfig verbosity globalFlags) let config = either (\(SomeException _) -> mempty) snd load distPref <- findSavedDistPref config (sDistDistPref sdistFlags) - let sdistFlags' = sdistFlags { sDistDistPref = toFlag distPref } - sdist sdistFlags' sdistExFlags + sdist sdistFlags { sDistDistPref = toFlag distPref } reportAction :: ReportFlags -> [String] -> Action reportAction reportFlags extraArgs globalFlags = do @@ -1146,6 +1142,7 @@ let configFlags = savedConfigureFlags config `mappend` -- override with `--with-compiler` from CLI if available mempty { configHcPath = initHcPath initFlags } + let initFlags' = savedInitFlags config `mappend` initFlags let globalFlags' = savedGlobalFlags config `mappend` globalFlags (comp, _, progdb) <- configCompilerAux' configFlags withRepoContext verbosity globalFlags' $ \repoContext -> @@ -1154,7 +1151,7 @@ repoContext comp progdb - initFlags + initFlags' sandboxAction :: SandboxFlags -> [String] -> Action sandboxAction sandboxFlags extraArgs globalFlags = do @@ -1225,7 +1222,7 @@ win32SelfUpgradeAction :: Win32SelfUpgradeFlags -> [String] -> Action win32SelfUpgradeAction selfUpgradeFlags (pid:path:_extraArgs) _globalFlags = do let verbosity = fromFlag (win32SelfUpgradeVerbosity selfUpgradeFlags) - Win32SelfUpgrade.deleteOldExeFile verbosity (read pid) path -- TODO: eradicateNoParse + Win32SelfUpgrade.deleteOldExeFile verbosity (fromMaybe (error $ "panic! read pid=" ++ show pid) $ readMaybe pid) path -- TODO: eradicateNoParse win32SelfUpgradeAction _ _ _ = return () -- | Used as an entry point when cabal-install needs to invoke itself diff --git a/cabal/cabal-install/solver-dsl/UnitTests/Distribution/Solver/Modular/DSL.hs b/cabal/cabal-install/solver-dsl/UnitTests/Distribution/Solver/Modular/DSL.hs --- a/cabal/cabal-install/solver-dsl/UnitTests/Distribution/Solver/Modular/DSL.hs +++ b/cabal/cabal-install/solver-dsl/UnitTests/Distribution/Solver/Modular/DSL.hs @@ -44,6 +44,7 @@ import Control.Arrow (second) import Data.Either (partitionEithers) import qualified Data.Map as Map +import qualified Data.Set as Set -- Cabal import qualified Distribution.Compiler as C @@ -56,6 +57,8 @@ import qualified Distribution.Types.ForeignLib as C import qualified Distribution.Types.LegacyExeDependency as C import qualified Distribution.Types.PkgconfigDependency as C +import qualified Distribution.Types.PkgconfigVersion as C +import qualified Distribution.Types.PkgconfigVersionRange as C import qualified Distribution.Types.UnqualComponentName as C import qualified Distribution.Types.CondTree as C import qualified Distribution.PackageDescription as C @@ -533,7 +536,7 @@ , C.pkgconfigDepends = [ C.PkgconfigDependency n' v' | (n,v) <- pcpkgs , let n' = C.mkPkgconfigName n - , let v' = C.thisVersion (mkSimpleVersion v) ] + , let v' = C.PcThisVersion (mkSimplePkgconfigVersion v) ] } in C.CondNode { C.condTreeData = bi -- Necessary for language extensions @@ -545,7 +548,7 @@ } mkDirect :: (ExamplePkgName, C.VersionRange) -> C.Dependency - mkDirect (dep, vr) = C.Dependency (C.mkPackageName dep) vr + mkDirect (dep, vr) = C.Dependency (C.mkPackageName dep) vr (Set.singleton C.LMainLibName) mkFlagged :: (ExampleFlagName, Dependencies, Dependencies) -> DependencyComponent C.BuildInfo @@ -587,6 +590,9 @@ mkSimpleVersion :: ExamplePkgVersion -> C.Version mkSimpleVersion n = C.mkVersion [n, 0, 0] +mkSimplePkgconfigVersion :: ExamplePkgVersion -> C.PkgconfigVersion +mkSimplePkgconfigVersion = C.versionToPkgconfigVersion . mkSimpleVersion + mkVersionRange :: ExamplePkgVersion -> ExamplePkgVersion -> C.VersionRange mkVersionRange v1 v2 = C.intersectVersionRanges (C.orLaterVersion $ mkSimpleVersion v1) @@ -645,9 +651,11 @@ -> [ExamplePkgName] -> Maybe Int -> CountConflicts + -> MinimizeConflictSet -> IndependentGoals -> ReorderGoals -> AllowBootLibInstalls + -> OnlyConstrained -> EnableBackjumping -> SolveExecutables -> Maybe (Variable P.QPN -> Variable P.QPN -> Ordering) @@ -656,8 +664,9 @@ -> C.Verbosity -> EnableAllTests -> Progress String String CI.SolverInstallPlan.SolverInstallPlan -exResolve db exts langs pkgConfigDb targets mbj countConflicts indepGoals - reorder allowBootLibInstalls enableBj solveExes goalOrder constraints +exResolve db exts langs pkgConfigDb targets mbj countConflicts + minimizeConflictSet indepGoals reorder allowBootLibInstalls + onlyConstrained enableBj solveExes goalOrder constraints prefs verbosity enableAllTests = resolveDependencies C.buildPlatform compiler pkgConfigDb Modular params where @@ -682,10 +691,12 @@ $ addConstraints (fmap toLpc enableTests) $ addPreferences (fmap toPref prefs) $ setCountConflicts countConflicts + $ setMinimizeConflictSet minimizeConflictSet $ setIndependentGoals indepGoals $ setReorderGoals reorder $ setMaxBackjumps mbj $ setAllowBootLibInstalls allowBootLibInstalls + $ setOnlyConstrained onlyConstrained $ setEnableBackjumping enableBj $ setSolveExecutables solveExes $ setGoalOrder goalOrder diff --git a/cabal/cabal-install/tests/IntegrationTests2.hs b/cabal/cabal-install/tests/IntegrationTests2.hs --- a/cabal/cabal-install/tests/IntegrationTests2.hs +++ b/cabal/cabal-install/tests/IntegrationTests2.hs @@ -216,8 +216,8 @@ do Right ts <- readTargetSelectors' [ "p", "lib:p", "p:lib:p", ":pkg:p:lib:p" , "lib:q", "q:lib:q", ":pkg:q:lib:q" ] - ts @?= replicate 4 (TargetComponent "p-0.1" CLibName WholeComponent) - ++ replicate 3 (TargetComponent "q-0.1" CLibName WholeComponent) + ts @?= replicate 4 (TargetComponent "p-0.1" (CLibName LMainLibName) WholeComponent) + ++ replicate 3 (TargetComponent "q-0.1" (CLibName LMainLibName) WholeComponent) reportSubCase "module" do Right ts <- readTargetSelectors' @@ -226,8 +226,8 @@ , "pexe:PMain" -- p:P or q:QQ would be ambiguous here , "qexe:QMain" -- package p vs component p ] - ts @?= replicate 4 (TargetComponent "p-0.1" CLibName (ModuleTarget "P")) - ++ replicate 4 (TargetComponent "q-0.1" CLibName (ModuleTarget "QQ")) + ts @?= replicate 4 (TargetComponent "p-0.1" (CLibName LMainLibName) (ModuleTarget "P")) + ++ replicate 4 (TargetComponent "q-0.1" (CLibName LMainLibName) (ModuleTarget "QQ")) ++ [ TargetComponent "p-0.1" (CExeName "pexe") (ModuleTarget "PMain") , TargetComponent "q-0.1" (CExeName "qexe") (ModuleTarget "QMain") ] @@ -239,8 +239,8 @@ , "q/QQ.hs", "q:QQ.lhs", "lib:q:QQ.hsc", "q:q:QQ.hsc", ":pkg:q:lib:q:file:QQ.y" ] - ts @?= replicate 5 (TargetComponent "p-0.1" CLibName (FileTarget "P")) - ++ replicate 5 (TargetComponent "q-0.1" CLibName (FileTarget "QQ")) + ts @?= replicate 5 (TargetComponent "p-0.1" (CLibName LMainLibName) (FileTarget "P")) + ++ replicate 5 (TargetComponent "q-0.1" (CLibName LMainLibName) (FileTarget "QQ")) -- Note there's a bit of an inconsistency here: for the single-part -- syntax the target has to point to a file that exists, whereas for -- all the other forms we don't require that. @@ -624,7 +624,7 @@ TargetDisabledBySolver True , AvailableTarget "p-0.1" (CExeName "buildable-false") TargetNotBuildable True - , AvailableTarget "p-0.1" CLibName + , AvailableTarget "p-0.1" (CLibName LMainLibName) TargetNotBuildable True ] , mkTargetPackage "p-0.1" ) @@ -645,7 +645,7 @@ CmdBuild.selectComponentTarget CmdBuild.TargetProblemCommon [ mkTargetPackage "p-0.1" ] - [ ("p-0.1-inplace", CLibName) + [ ("p-0.1-inplace", (CLibName LMainLibName)) , ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark") , ("p-0.1-inplace-a-testsuite", CTestName "a-testsuite") , ("p-0.1-inplace-an-exe", CExeName "an-exe") @@ -667,7 +667,7 @@ CmdBuild.selectComponentTarget CmdBuild.TargetProblemCommon [ mkTargetPackage "p-0.1" ] - [ ("p-0.1-inplace", CLibName) + [ ("p-0.1-inplace", (CLibName LMainLibName)) , ("p-0.1-inplace-an-exe", CExeName "an-exe") , ("p-0.1-inplace-libp", CFLibName "libp") ] @@ -699,9 +699,9 @@ CmdRepl.selectComponentTarget CmdRepl.TargetProblemCommon [ ( flip CmdRepl.TargetProblemMatchesMultiple - [ AvailableTarget "p-0.1" CLibName + [ AvailableTarget "p-0.1" (CLibName LMainLibName) (TargetBuildable () TargetRequestedByDefault) True - , AvailableTarget "q-0.1" CLibName + , AvailableTarget "q-0.1" (CLibName LMainLibName) (TargetBuildable () TargetRequestedByDefault) True ] , mkTargetAllPackages ) @@ -758,7 +758,7 @@ CmdRepl.selectComponentTarget CmdRepl.TargetProblemCommon [ ( flip CmdRepl.TargetProblemNoneEnabled - [ AvailableTarget "p-0.1" CLibName TargetNotBuildable True ] + [ AvailableTarget "p-0.1" (CLibName LMainLibName) TargetNotBuildable True ] , mkTargetPackage "p-0.1" ) ] @@ -805,7 +805,7 @@ CmdRepl.selectComponentTarget CmdRepl.TargetProblemCommon [ TargetPackage TargetExplicitNamed ["p-0.1"] Nothing ] - [ ("p-0.1-inplace", CLibName) ] + [ ("p-0.1-inplace", (CLibName LMainLibName)) ] -- When we select the package with an explicit filter then we get those -- components even though we did not explicitly enable tests/benchmarks assertProjectDistinctTargets @@ -960,8 +960,8 @@ CmdTest.selectComponentTarget CmdTest.TargetProblemCommon $ [ ( const (CmdTest.TargetProblemComponentNotTest - "p-0.1" CLibName) - , mkTargetComponent "p-0.1" CLibName ) + "p-0.1" (CLibName LMainLibName)) + , mkTargetComponent "p-0.1" (CLibName LMainLibName) ) , ( const (CmdTest.TargetProblemComponentNotTest "p-0.1" (CExeName "an-exe")) @@ -981,7 +981,7 @@ | (cname, modname) <- [ (CTestName "a-testsuite", "TestModule") , (CBenchName "a-benchmark", "BenchModule") , (CExeName "an-exe", "ExeModule") - , (CLibName, "P") + , ((CLibName LMainLibName), "P") ] ] ++ [ ( const (CmdTest.TargetProblemIsSubComponent @@ -1067,8 +1067,8 @@ CmdBench.selectComponentTarget CmdBench.TargetProblemCommon $ [ ( const (CmdBench.TargetProblemComponentNotBenchmark - "p-0.1" CLibName) - , mkTargetComponent "p-0.1" CLibName ) + "p-0.1" (CLibName LMainLibName)) + , mkTargetComponent "p-0.1" (CLibName LMainLibName) ) , ( const (CmdBench.TargetProblemComponentNotBenchmark "p-0.1" (CExeName "an-exe")) @@ -1088,7 +1088,7 @@ | (cname, modname) <- [ (CTestName "a-testsuite", "TestModule") , (CBenchName "a-benchmark", "BenchModule") , (CExeName "an-exe", "ExeModule") - , (CLibName, "P") + , ((CLibName LMainLibName), "P") ] ] ++ [ ( const (CmdBench.TargetProblemIsSubComponent @@ -1119,7 +1119,7 @@ TargetDisabledBySolver True , AvailableTarget "p-0.1" (CExeName "buildable-false") TargetNotBuildable True - , AvailableTarget "p-0.1" CLibName + , AvailableTarget "p-0.1" (CLibName LMainLibName) TargetNotBuildable True ] , mkTargetPackage "p-0.1" ) @@ -1146,7 +1146,7 @@ CmdHaddock.selectComponentTarget CmdHaddock.TargetProblemCommon [ mkTargetPackage "p-0.1" ] - [ ("p-0.1-inplace", CLibName) + [ ("p-0.1-inplace", (CLibName LMainLibName)) , ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark") , ("p-0.1-inplace-a-testsuite", CTestName "a-testsuite") , ("p-0.1-inplace-an-exe", CExeName "an-exe") @@ -1163,7 +1163,7 @@ CmdHaddock.selectComponentTarget CmdHaddock.TargetProblemCommon [ mkTargetPackage "p-0.1" ] - [ ("p-0.1-inplace", CLibName) ] + [ ("p-0.1-inplace", (CLibName LMainLibName)) ] reportSubCase "requested component kinds" -- When we selecting the package with an explicit filter then it does not @@ -1350,7 +1350,7 @@ && compilerVersion (pkgConfigCompiler sharedConfig) < mkVersion [7,10]) $ do (plan1, res1) <- executePlan plan0 - (pkg1, _) <- expectPackageInstalled plan1 res1 pkgidA + pkg1 <- expectPackageInstalled plan1 res1 pkgidA elabSetupScriptStyle pkg1 @?= SetupCustomExplicitDeps hasDefaultSetupDeps pkg1 @?= Just False marker1 <- readFile (basedir testdir1 "marker") @@ -1361,7 +1361,7 @@ when (compilerVersion (pkgConfigCompiler sharedConfig) < mkVersion [8,2]) $ do reportSubCase (show SetupCustomImplicitDeps) (plan2, res2) <- executePlan =<< planProject testdir2 config - (pkg2, _) <- expectPackageInstalled plan2 res2 pkgidA + pkg2 <- expectPackageInstalled plan2 res2 pkgidA elabSetupScriptStyle pkg2 @?= SetupCustomImplicitDeps hasDefaultSetupDeps pkg2 @?= Just True marker2 <- readFile (basedir testdir2 "marker") @@ -1370,7 +1370,7 @@ reportSubCase (show SetupNonCustomInternalLib) (plan3, res3) <- executePlan =<< planProject testdir3 config - (pkg3, _) <- expectPackageInstalled plan3 res3 pkgidA + pkg3 <- expectPackageInstalled plan3 res3 pkgidA elabSetupScriptStyle pkg3 @?= SetupNonCustomInternalLib {- --TODO: the SetupNonCustomExternalLib case is hard to test since it @@ -1380,7 +1380,7 @@ -- default Setup.hs. reportSubCase (show SetupNonCustomExternalLib) (plan4, res4) <- executePlan =<< planProject testdir4 config - (pkg4, _) <- expectPackageInstalled plan4 res4 pkgidA + pkg4 <- expectPackageInstalled plan4 res4 pkgidA pkgSetupScriptStyle pkg4 @?= SetupNonCustomExternalLib -} where @@ -1657,12 +1657,16 @@ (_, buildResult) -> unexpectedBuildResult "Configured" planpkg buildResult expectPackageInstalled :: ElaboratedInstallPlan -> BuildOutcomes -> PackageId - -> IO (ElaboratedConfiguredPackage, BuildResult) + -> IO ElaboratedConfiguredPackage expectPackageInstalled plan buildOutcomes pkgid = do planpkg <- expectPlanPackage plan pkgid case (planpkg, InstallPlan.lookupBuildOutcome planpkg buildOutcomes) of - (InstallPlan.Configured pkg, Just (Right result)) - -> return (pkg, result) + (InstallPlan.Configured pkg, Just (Right _result)) -- result isn't used by any test + -> return pkg + -- package can be installed in the global .store! + -- (when installing from tarball!) + (InstallPlan.Installed pkg, Nothing) + -> return pkg (_, buildResult) -> unexpectedBuildResult "Installed" planpkg buildResult expectPackageFailed :: ElaboratedInstallPlan -> BuildOutcomes -> PackageId @@ -1686,7 +1690,8 @@ (Nothing, InstallPlan.Configured{}) -> "Configured" (Just (Right _), InstallPlan.Configured{}) -> "Installed" (Just (Left _), InstallPlan.Configured{}) -> "Failed" - _ -> "Impossible!" + (Nothing, InstallPlan.Installed{}) -> "Installed globally" + _ -> "Impossible! " ++ show buildResult ++ show planpkg expectPlanPackage :: ElaboratedInstallPlan -> PackageId -> IO ElaboratedPlanPackage diff --git a/cabal/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs b/cabal/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs --- a/cabal/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs +++ b/cabal/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs @@ -21,7 +21,11 @@ import Control.Monad import Distribution.Version +import Distribution.Types.VersionRange.Internal import Distribution.Types.Dependency +import Distribution.Types.PackageVersionConstraint +import Distribution.Types.UnqualComponentName +import Distribution.Types.LibraryName import Distribution.Package import Distribution.System import Distribution.Verbosity @@ -120,8 +124,24 @@ packageChars = filter isAlphaNum ['\0'..'\127'] instance Arbitrary Dependency where - arbitrary = Dependency <$> arbitrary <*> arbitrary + arbitrary = Dependency + <$> arbitrary + <*> arbitrary + <*> fmap getNonMEmpty arbitrary +instance Arbitrary PackageVersionConstraint where + arbitrary = PackageVersionConstraint <$> arbitrary <*> arbitrary + +instance Arbitrary UnqualComponentName where + -- same rules as package names + arbitrary = packageNameToUnqualComponentName <$> arbitrary + +instance Arbitrary LibraryName where + arbitrary = + elements + =<< sequenceA [ LSubLibName <$> arbitrary + , pure LMainLibName ] + instance Arbitrary OS where arbitrary = elements knownOSs @@ -155,7 +175,9 @@ instance Arbitrary PathTemplate where arbitrary = toPathTemplate <$> arbitraryShortToken - shrink t = [ toPathTemplate s | s <- shrink (show t), not (null s) ] + shrink t = [ toPathTemplate s + | s <- shrink (fromPathTemplate t) + , not (null s) ] newtype NonMEmpty a = NonMEmpty { getNonMEmpty :: a } diff --git a/cabal/cabal-install/tests/UnitTests/Distribution/Client/FileMonitor.hs b/cabal/cabal-install/tests/UnitTests/Distribution/Client/FileMonitor.hs --- a/cabal/cabal-install/tests/UnitTests/Distribution/Client/FileMonitor.hs +++ b/cabal/cabal-install/tests/UnitTests/Distribution/Client/FileMonitor.hs @@ -1,5 +1,7 @@ module UnitTests.Distribution.Client.FileMonitor (tests) where +import Distribution.Deprecated.Text (simpleParse) + import Control.Monad import Control.Exception import Control.Concurrent (threadDelay) @@ -9,7 +11,6 @@ import Prelude hiding (writeFile) import qualified Prelude as IO (writeFile) -import Distribution.Text (simpleParse) import Distribution.Compat.Binary import Distribution.Simple.Utils (withTempDirectory) import Distribution.Verbosity (silent) diff --git a/cabal/cabal-install/tests/UnitTests/Distribution/Client/GenericInstances.hs b/cabal/cabal-install/tests/UnitTests/Distribution/Client/GenericInstances.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-install/tests/UnitTests/Distribution/Client/GenericInstances.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module UnitTests.Distribution.Client.GenericInstances () where + +import Network.URI +import GHC.Generics + +deriving instance Generic URIAuth diff --git a/cabal/cabal-install/tests/UnitTests/Distribution/Client/Glob.hs b/cabal/cabal-install/tests/UnitTests/Distribution/Client/Glob.hs --- a/cabal/cabal-install/tests/UnitTests/Distribution/Client/Glob.hs +++ b/cabal/cabal-install/tests/UnitTests/Distribution/Client/Glob.hs @@ -8,8 +8,8 @@ #endif import Data.Char import Data.List -import Distribution.Text (display, parse, simpleParse) -import Distribution.Compat.ReadP +import Distribution.Deprecated.Text (display, parse, simpleParse) +import Distribution.Deprecated.ReadP import Distribution.Client.Glob import UnitTests.Distribution.Client.ArbitraryInstances diff --git a/cabal/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils/Timestamp.hs b/cabal/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils/Timestamp.hs --- a/cabal/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils/Timestamp.hs +++ b/cabal/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils/Timestamp.hs @@ -1,6 +1,6 @@ module UnitTests.Distribution.Client.IndexUtils.Timestamp (tests) where -import Distribution.Text +import Distribution.Deprecated.Text import Data.Time import Data.Time.Clock.POSIX diff --git a/cabal/cabal-install/tests/UnitTests/Distribution/Client/InstallPlan.hs b/cabal/cabal-install/tests/UnitTests/Distribution/Client/InstallPlan.hs --- a/cabal/cabal-install/tests/UnitTests/Distribution/Client/InstallPlan.hs +++ b/cabal/cabal-install/tests/UnitTests/Distribution/Client/InstallPlan.hs @@ -245,8 +245,8 @@ -- It generates a DAG based on ranks of nodes. Nodes in each rank can only -- have edges to nodes in subsequent ranks. -- --- The generator is paramterised by a generator for the number of ranks and --- the number of nodes within each rank. It is also paramterised by the +-- The generator is parametrised by a generator for the number of ranks and +-- the number of nodes within each rank. It is also parametrised by the -- chance that each node in each rank will have an edge from each node in -- each previous rank. Thus a higher chance will produce a more densely -- connected graph. diff --git a/cabal/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs b/cabal/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs --- a/cabal/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs +++ b/cabal/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs @@ -11,21 +11,25 @@ import qualified Data.Map as Map import Data.List +import Distribution.Deprecated.ParseUtils +import Distribution.Deprecated.Text as Text +import qualified Distribution.Deprecated.ReadP as Parse + import Distribution.Package import Distribution.PackageDescription hiding (Flag) import Distribution.Compiler import Distribution.Version -import Distribution.ParseUtils -import Distribution.Text as Text import Distribution.Simple.Compiler import Distribution.Simple.Setup import Distribution.Simple.InstallDirs -import qualified Distribution.Compat.ReadP as Parse import Distribution.Simple.Utils import Distribution.Simple.Program.Types import Distribution.Simple.Program.Db +import Distribution.Types.PackageVersionConstraint import Distribution.Client.Types +import Distribution.Client.CmdInstall.ClientInstallFlags +import Distribution.Client.InstallSymlink import Distribution.Client.Dependency.Types import Distribution.Client.BuildReports.Types import Distribution.Client.Targets @@ -41,7 +45,10 @@ import Distribution.Client.ProjectConfig.Legacy import UnitTests.Distribution.Client.ArbitraryInstances +import UnitTests.Distribution.Client.TreeDiffInstances () +import Data.TreeDiff.Class +import Data.TreeDiff.QuickCheck import Test.Tasty import Test.Tasty.QuickCheck @@ -89,24 +96,25 @@ -- Round trip: conversion to/from legacy types -- -roundtrip :: Eq a => (a -> b) -> (b -> a) -> a -> Bool +roundtrip :: (Eq a, ToExpr a) => (a -> b) -> (b -> a) -> a -> Property roundtrip f f_inv x = - (f_inv . f) x == x + let y = f x + in f_inv y `ediffEq` x -- no counterexample with y, as they not have ToExpr -roundtrip_legacytypes :: ProjectConfig -> Bool +roundtrip_legacytypes :: ProjectConfig -> Property roundtrip_legacytypes = roundtrip convertToLegacyProjectConfig convertLegacyProjectConfig -prop_roundtrip_legacytypes_all :: ProjectConfig -> Bool +prop_roundtrip_legacytypes_all :: ProjectConfig -> Property prop_roundtrip_legacytypes_all config = roundtrip_legacytypes config { projectConfigProvenance = mempty } -prop_roundtrip_legacytypes_packages :: ProjectConfig -> Bool +prop_roundtrip_legacytypes_packages :: ProjectConfig -> Property prop_roundtrip_legacytypes_packages config = roundtrip_legacytypes config { @@ -117,22 +125,22 @@ projectConfigSpecificPackage = mempty } -prop_roundtrip_legacytypes_buildonly :: ProjectConfigBuildOnly -> Bool +prop_roundtrip_legacytypes_buildonly :: ProjectConfigBuildOnly -> Property prop_roundtrip_legacytypes_buildonly config = roundtrip_legacytypes mempty { projectConfigBuildOnly = config } -prop_roundtrip_legacytypes_shared :: ProjectConfigShared -> Bool +prop_roundtrip_legacytypes_shared :: ProjectConfigShared -> Property prop_roundtrip_legacytypes_shared config = roundtrip_legacytypes mempty { projectConfigShared = config } -prop_roundtrip_legacytypes_local :: PackageConfig -> Bool +prop_roundtrip_legacytypes_local :: PackageConfig -> Property prop_roundtrip_legacytypes_local config = roundtrip_legacytypes mempty { projectConfigLocalPackages = config } -prop_roundtrip_legacytypes_specific :: Map PackageName PackageConfig -> Bool +prop_roundtrip_legacytypes_specific :: Map PackageName PackageConfig -> Property prop_roundtrip_legacytypes_specific config = roundtrip_legacytypes mempty { projectConfigSpecificPackage = MapMappend config } @@ -142,18 +150,18 @@ -- Round trip: printing and parsing config -- -roundtrip_printparse :: ProjectConfig -> Bool +roundtrip_printparse :: ProjectConfig -> Property roundtrip_printparse config = case (fmap convertLegacyProjectConfig . parseLegacyProjectConfig . showLegacyProjectConfig . convertToLegacyProjectConfig) config of - ParseOk _ x -> x == config { projectConfigProvenance = mempty } - _ -> False + ParseOk _ x -> x `ediffEq` config { projectConfigProvenance = mempty } + ParseFailed err -> counterexample (show err) False -prop_roundtrip_printparse_all :: ProjectConfig -> Bool +prop_roundtrip_printparse_all :: ProjectConfig -> Property prop_roundtrip_printparse_all config = roundtrip_printparse config { projectConfigBuildOnly = @@ -166,8 +174,8 @@ prop_roundtrip_printparse_packages :: [PackageLocationString] -> [PackageLocationString] -> [SourceRepo] - -> [Dependency] - -> Bool + -> [PackageVersionConstraint] + -> Property prop_roundtrip_printparse_packages pkglocstrs1 pkglocstrs2 repos named = roundtrip_printparse mempty { @@ -177,7 +185,7 @@ projectPackagesNamed = named } -prop_roundtrip_printparse_buildonly :: ProjectConfigBuildOnly -> Bool +prop_roundtrip_printparse_buildonly :: ProjectConfigBuildOnly -> Property prop_roundtrip_printparse_buildonly config = roundtrip_printparse mempty { @@ -193,7 +201,7 @@ projectConfigDryRun = mempty } -prop_roundtrip_printparse_shared :: ProjectConfigShared -> Bool +prop_roundtrip_printparse_shared :: ProjectConfigShared -> Property prop_roundtrip_printparse_shared config = roundtrip_printparse mempty { @@ -216,7 +224,7 @@ } -prop_roundtrip_printparse_local :: PackageConfig -> Bool +prop_roundtrip_printparse_local :: PackageConfig -> Property prop_roundtrip_printparse_local config = roundtrip_printparse mempty { @@ -224,7 +232,7 @@ } prop_roundtrip_printparse_specific :: Map PackageName (NonMEmpty PackageConfig) - -> Bool + -> Property prop_roundtrip_printparse_specific config = roundtrip_printparse mempty { @@ -252,14 +260,18 @@ prop_roundtrip_printparse_RelaxedDep rdep = runReadP Text.parse (Text.display rdep) == Just rdep -prop_roundtrip_printparse_RelaxDeps :: RelaxDeps -> Bool +prop_roundtrip_printparse_RelaxDeps :: RelaxDeps -> Property prop_roundtrip_printparse_RelaxDeps rdep = - runReadP Text.parse (Text.display rdep) == Just rdep + counterexample (Text.display rdep) $ + runReadP Text.parse (Text.display rdep) `ediffEq` Just rdep -prop_roundtrip_printparse_RelaxDeps' :: RelaxDeps -> Bool +prop_roundtrip_printparse_RelaxDeps' :: RelaxDeps -> Property prop_roundtrip_printparse_RelaxDeps' rdep = - runReadP Text.parse (go $ Text.display rdep) == Just rdep + counterexample rdep' $ + runReadP Text.parse rdep' `ediffEq` Just rdep where + rdep' = go (Text.display rdep) + -- replace 'all' tokens by '*' go :: String -> String go [] = [] @@ -342,6 +354,21 @@ braces s = "{" ++ s ++ "}" +instance Arbitrary OverwritePolicy where + arbitrary = arbitraryBoundedEnum + +instance Arbitrary InstallMethod where + arbitrary = arbitraryBoundedEnum + +instance Arbitrary ClientInstallFlags where + arbitrary = + ClientInstallFlags + <$> arbitrary + <*> arbitraryFlag arbitraryShortToken + <*> arbitrary + <*> arbitrary + <*> arbitraryFlag arbitraryShortToken + instance Arbitrary ProjectConfigBuildOnly where arbitrary = ProjectConfigBuildOnly @@ -362,6 +389,7 @@ <*> arbitrary <*> (fmap getShortToken <$> arbitrary) <*> (fmap getShortToken <$> arbitrary) + <*> arbitrary where arbitraryNumJobs = fmap (fmap getPositive) <$> arbitrary @@ -381,7 +409,8 @@ , projectConfigHttpTransport = x13 , projectConfigIgnoreExpiry = x14 , projectConfigCacheDir = x15 - , projectConfigLogsDir = x16 } = + , projectConfigLogsDir = x16 + , projectConfigClientInstallFlags = x17 } = [ ProjectConfigBuildOnly { projectConfigVerbosity = x00' , projectConfigDryRun = x01' , projectConfigOnlyDeps = x02' @@ -398,14 +427,17 @@ , projectConfigHttpTransport = x13 , projectConfigIgnoreExpiry = x14' , projectConfigCacheDir = x15 - , projectConfigLogsDir = x16 } + , projectConfigLogsDir = x16 + , projectConfigClientInstallFlags = x17' } | ((x00', x01', x02', x03', x04'), (x05', x06', x07', x08', x09'), - (x10', x11', x12', x14')) + (x10', x11', x12', x14'), + ( x17' )) <- shrink ((x00, x01, x02, x03, x04), (x05, x06, x07, x08, preShrink_NumJobs x09), - (x10, x11, x12, x14)) + (x10, x11, x12, x14), + ( x17 )) ] where preShrink_NumJobs = fmap (fmap Positive) @@ -431,6 +463,7 @@ <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary @@ -460,13 +493,15 @@ , projectConfigMaxBackjumps = x16 , projectConfigReorderGoals = x17 , projectConfigCountConflicts = x18 - , projectConfigStrongFlags = x19 - , projectConfigAllowBootLibInstalls = x20 - , projectConfigPerComponent = x21 - , projectConfigIndependentGoals = x22 - , projectConfigConfigFile = x23 - , projectConfigProgPathExtra = x24 - , projectConfigStoreDir = x25 } = + , projectConfigMinimizeConflictSet = x19 + , projectConfigStrongFlags = x20 + , projectConfigAllowBootLibInstalls = x21 + , projectConfigOnlyConstrained = x22 + , projectConfigPerComponent = x23 + , projectConfigIndependentGoals = x24 + , projectConfigConfigFile = x25 + , projectConfigProgPathExtra = x26 + , projectConfigStoreDir = x27 } = [ ProjectConfigShared { projectConfigDistDir = x00' , projectConfigProjectFile = x01' , projectConfigHcFlavor = x02' @@ -486,24 +521,26 @@ , projectConfigMaxBackjumps = x16' , projectConfigReorderGoals = x17' , projectConfigCountConflicts = x18' - , projectConfigStrongFlags = x19' - , projectConfigAllowBootLibInstalls = x20' - , projectConfigPerComponent = x21' - , projectConfigIndependentGoals = x22' - , projectConfigConfigFile = x23' - , projectConfigProgPathExtra = x24' - , projectConfigStoreDir = x25' } + , projectConfigMinimizeConflictSet = x19' + , projectConfigStrongFlags = x20' + , projectConfigAllowBootLibInstalls = x21' + , projectConfigOnlyConstrained = x22' + , projectConfigPerComponent = x23' + , projectConfigIndependentGoals = x24' + , projectConfigConfigFile = x25' + , projectConfigProgPathExtra = x26' + , projectConfigStoreDir = x27' } | ((x00', x01', x02', x03', x04'), (x05', x06', x07', x08', x09'), (x10', x11', x12', x13', x14', x15'), - (x16', x17', x18', x19', x20'), - x21', x22', x23', x24', x25') + (x16', x17', x18', x19', x20', x21'), + x22', x23', x24', x25', x26', x27') <- shrink ((x00, x01, x02, fmap NonEmpty x03, fmap NonEmpty x04), (x05, x06, x07, x08, preShrink_Constraints x09), (x10, x11, x12, x13, x14, x15), - (x16, x17, x18, x19, x20), - x21, x22, x23, x24, x25) + (x16, x17, x18, x19, x20, x21), + x22, x23, x24, x25, x26, x27) ] where preShrink_Constraints = map fst @@ -532,6 +569,7 @@ <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> shortListOf 5 arbitraryShortToken @@ -558,6 +596,13 @@ <*> arbitraryFlag arbitraryShortToken <*> arbitrary <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitraryFlag arbitraryShortToken + <*> arbitrary + <*> shortListOf 5 arbitrary where arbitraryProgramName :: Gen String arbitraryProgramName = @@ -572,6 +617,7 @@ , packageConfigSharedLib = x05 , packageConfigStaticLib = x42 , packageConfigDynExe = x06 + , packageConfigFullyStaticExe = x50 , packageConfigProf = x07 , packageConfigProfLib = x08 , packageConfigProfExe = x09 @@ -609,7 +655,14 @@ , packageConfigHaddockQuickJump = x43 , packageConfigHaddockHscolourCss = x39 , packageConfigHaddockContents = x40 - , packageConfigHaddockForHackage = x41 } = + , packageConfigHaddockForHackage = x41 + , packageConfigTestHumanLog = x44 + , packageConfigTestMachineLog = x45 + , packageConfigTestShowDetails = x46 + , packageConfigTestKeepTix = x47 + , packageConfigTestWrapper = x48 + , packageConfigTestFailWhenNoTestSuites = x49 + , packageConfigTestTestOptions = x51 } = [ PackageConfig { packageConfigProgramPaths = postShrink_Paths x00' , packageConfigProgramArgs = postShrink_Args x01' , packageConfigProgramPathExtra = x02' @@ -618,6 +671,7 @@ , packageConfigSharedLib = x05' , packageConfigStaticLib = x42' , packageConfigDynExe = x06' + , packageConfigFullyStaticExe = x50' , packageConfigProf = x07' , packageConfigProfLib = x08' , packageConfigProfExe = x09' @@ -655,19 +709,27 @@ , packageConfigHaddockQuickJump = x43' , packageConfigHaddockHscolourCss = fmap getNonEmpty x39' , packageConfigHaddockContents = x40' - , packageConfigHaddockForHackage = x41' } + , packageConfigHaddockForHackage = x41' + , packageConfigTestHumanLog = x44' + , packageConfigTestMachineLog = x45' + , packageConfigTestShowDetails = x46' + , packageConfigTestKeepTix = x47' + , packageConfigTestWrapper = x48' + , packageConfigTestFailWhenNoTestSuites = x49' + , packageConfigTestTestOptions = x51' } | (((x00', x01', x02', x03', x04'), - (x05', x42', x06', x07', x08', x09'), + (x05', x42', x06', x50', x07', x08', x09'), (x10', x11', x12', x13', x14'), (x15', x16', x17', x18', x19')), ((x20', x20_1', x21', x22', x23', x24'), (x25', x26', x27', x28', x29'), (x30', x31', x32', (x33', x33_1'), x34'), (x35', x36', x37', x38', x43', x39'), - (x40', x41'))) + (x40', x41'), + (x44', x45', x46', x47', x48', x49', x51'))) <- shrink (((preShrink_Paths x00, preShrink_Args x01, x02, x03, x04), - (x05, x42, x06, x07, x08, x09), + (x05, x42, x06, x50, x07, x08, x09), (x10, x11, map NonEmpty x12, x13, x14), (x15, map NonEmpty x16, map NonEmpty x17, @@ -677,7 +739,8 @@ (x25, x26, x27, x28, x29), (x30, x31, x32, (x33, x33_1), x34), (x35, x36, fmap NonEmpty x37, x38, x43, fmap NonEmpty x39), - (x40, x41))) + (x40, x41), + (x44, x45, x46, x47, x48, x49, x51))) ] where preShrink_Paths = Map.map NonEmpty @@ -696,15 +759,20 @@ instance Arbitrary HaddockTarget where arbitrary = elements [ForHackage, ForDevelopment] +instance Arbitrary TestShowDetails where + arbitrary = arbitraryBoundedEnum + instance Arbitrary SourceRepo where - arbitrary = (SourceRepo RepoThis + arbitrary = (SourceRepo kind <$> arbitrary <*> (fmap getShortToken <$> arbitrary) <*> (fmap getShortToken <$> arbitrary) <*> (fmap getShortToken <$> arbitrary) <*> (fmap getShortToken <$> arbitrary) <*> (fmap getShortToken <$> arbitrary)) - `suchThat` (/= emptySourceRepo RepoThis) + `suchThat` (/= emptySourceRepo kind) + where + kind = RepoKindUnknown "unused" shrink (SourceRepo _ x1 x2 x3 x4 x5 x6) = [ repo @@ -805,6 +873,9 @@ instance Arbitrary CountConflicts where arbitrary = CountConflicts <$> arbitrary +instance Arbitrary MinimizeConflictSet where + arbitrary = MinimizeConflictSet <$> arbitrary + instance Arbitrary IndependentGoals where arbitrary = IndependentGoals <$> arbitrary @@ -813,6 +884,11 @@ instance Arbitrary AllowBootLibInstalls where arbitrary = AllowBootLibInstalls <$> arbitrary + +instance Arbitrary OnlyConstrained where + arbitrary = oneof [ pure OnlyConstrainedAll + , pure OnlyConstrainedNone + ] instance Arbitrary AllowNewer where arbitrary = AllowNewer <$> arbitrary diff --git a/cabal/cabal-install/tests/UnitTests/Distribution/Client/Targets.hs b/cabal/cabal-install/tests/UnitTests/Distribution/Client/Targets.hs --- a/cabal/cabal-install/tests/UnitTests/Distribution/Client/Targets.hs +++ b/cabal/cabal-install/tests/UnitTests/Distribution/Client/Targets.hs @@ -5,12 +5,13 @@ import Distribution.Client.Targets (UserQualifier(..) ,UserConstraintScope(..) ,UserConstraint(..), readUserConstraint) -import Distribution.Compat.ReadP (readP_to_S) import Distribution.Package (mkPackageName) import Distribution.PackageDescription (mkFlagName, mkFlagAssignment) import Distribution.Version (anyVersion, thisVersion, mkVersion) -import Distribution.ParseUtils (parseCommaList) -import Distribution.Text (parse) + +import Distribution.Deprecated.ReadP (readP_to_S) +import Distribution.Deprecated.ParseUtils (parseCommaList) +import Distribution.Deprecated.Text (parse) import Distribution.Solver.Types.PackageConstraint (PackageProperty(..)) import Distribution.Solver.Types.OptionalStanza (OptionalStanza(..)) diff --git a/cabal/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs b/cabal/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs @@ -0,0 +1,106 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module UnitTests.Distribution.Client.TreeDiffInstances () where + +import Distribution.Compiler +import Distribution.Simple.Compiler + ( ProfDetailLevel, OptimisationLevel, DebugInfoLevel ) +import Distribution.Simple.Flag +import Distribution.Simple.InstallDirs +import Distribution.Simple.InstallDirs.Internal +import Distribution.Simple.Setup (HaddockTarget, TestShowDetails) +import Distribution.Types.GenericPackageDescription (FlagName, FlagAssignment) +import Distribution.Types.PackageId +import Distribution.Types.PackageName +import Distribution.Types.PackageVersionConstraint +import Distribution.Types.SourceRepo +import Distribution.Types.Version +import Distribution.Types.VersionRange.Internal +import Distribution.Utils.NubList +import Distribution.Utils.ShortText +import Distribution.Verbosity +import Distribution.Verbosity.Internal + +import Distribution.Solver.Types.ConstraintSource +import Distribution.Solver.Types.OptionalStanza +import Distribution.Solver.Types.PackageConstraint +import Distribution.Solver.Types.Settings + +import Distribution.Client.BuildReports.Types +import Distribution.Client.CmdInstall.ClientInstallFlags +import Distribution.Client.Dependency.Types +import Distribution.Client.IndexUtils.Timestamp +import Distribution.Client.InstallSymlink +import Distribution.Client.ProjectConfig.Types +import Distribution.Client.Targets +import Distribution.Client.Types + +import UnitTests.Distribution.Client.GenericInstances () + +import Network.URI +import Data.TreeDiff.Class + +instance (ToExpr k, ToExpr v) => ToExpr (MapMappend k v) +instance (ToExpr k, ToExpr v) => ToExpr (MapLast k v) +instance (ToExpr a) => ToExpr (NubList a) +instance (ToExpr a) => ToExpr (Flag a) + +instance ToExpr AllowBootLibInstalls +instance ToExpr AllowNewer +instance ToExpr AllowOlder +instance ToExpr ClientInstallFlags +instance ToExpr CompilerFlavor +instance ToExpr ConstraintSource +instance ToExpr CountConflicts +instance ToExpr DebugInfoLevel +instance ToExpr FlagAssignment +instance ToExpr FlagName where toExpr = defaultExprViaShow +instance ToExpr HaddockTarget +instance ToExpr IndependentGoals +instance ToExpr IndexState +instance ToExpr InstallMethod +instance ToExpr MinimizeConflictSet +instance ToExpr OnlyConstrained +instance ToExpr OptimisationLevel +instance ToExpr OptionalStanza +instance ToExpr OverwritePolicy +instance ToExpr PackageConfig +instance ToExpr PackageIdentifier +instance ToExpr PackageName where toExpr = defaultExprViaShow +instance ToExpr PackageProperty +instance ToExpr PackageVersionConstraint +instance ToExpr PathComponent +instance ToExpr PathTemplate +instance ToExpr PathTemplateVariable +instance ToExpr PreSolver +instance ToExpr ProfDetailLevel +instance ToExpr ProjectConfig +instance ToExpr ProjectConfigBuildOnly +instance ToExpr ProjectConfigProvenance +instance ToExpr ProjectConfigShared +instance ToExpr RelaxDepMod +instance ToExpr RelaxDepScope +instance ToExpr RelaxDepSubject +instance ToExpr RelaxDeps +instance ToExpr RelaxedDep +instance ToExpr RemoteRepo +instance ToExpr ReorderGoals +instance ToExpr RepoKind +instance ToExpr RepoType +instance ToExpr ReportLevel +instance ToExpr ShortText +instance ToExpr SourceRepo +instance ToExpr StrongFlags +instance ToExpr TestShowDetails +instance ToExpr Timestamp +instance ToExpr URI +instance ToExpr URIAuth +instance ToExpr UserConstraint +instance ToExpr UserConstraintScope +instance ToExpr UserQualifier +instance ToExpr Verbosity +instance ToExpr VerbosityFlag +instance ToExpr VerbosityLevel +instance ToExpr Version where toExpr = defaultExprViaShow +instance ToExpr VersionRange +instance ToExpr WriteGhcEnvironmentFilesPolicy diff --git a/cabal/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL/TestCaseUtils.hs b/cabal/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL/TestCaseUtils.hs --- a/cabal/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL/TestCaseUtils.hs +++ b/cabal/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL/TestCaseUtils.hs @@ -4,8 +4,10 @@ SolverTest , SolverResult(..) , maxBackjumps + , minimizeConflictSet , independentGoals , allowBootLibInstalls + , onlyConstrained , disableBackjumping , disableSolveExecutables , goalOrder @@ -52,6 +54,10 @@ maxBackjumps :: Maybe Int -> SolverTest -> SolverTest maxBackjumps mbj test = test { testMaxBackjumps = mbj } +minimizeConflictSet :: SolverTest -> SolverTest +minimizeConflictSet test = + test { testMinimizeConflictSet = MinimizeConflictSet True } + -- | Combinator to turn on --independent-goals behavior, i.e. solve -- for the goals as if we were solving for each goal independently. independentGoals :: SolverTest -> SolverTest @@ -61,6 +67,10 @@ allowBootLibInstalls test = test { testAllowBootLibInstalls = AllowBootLibInstalls True } +onlyConstrained :: SolverTest -> SolverTest +onlyConstrained test = + test { testOnlyConstrained = OnlyConstrainedAll } + disableBackjumping :: SolverTest -> SolverTest disableBackjumping test = test { testEnableBackjumping = EnableBackjumping False } @@ -95,8 +105,10 @@ , testTargets :: [String] , testResult :: SolverResult , testMaxBackjumps :: Maybe Int + , testMinimizeConflictSet :: MinimizeConflictSet , testIndepGoals :: IndependentGoals , testAllowBootLibInstalls :: AllowBootLibInstalls + , testOnlyConstrained :: OnlyConstrained , testEnableBackjumping :: EnableBackjumping , testSolveExecutables :: SolveExecutables , testGoalOrder :: Maybe [ExampleVar] @@ -189,8 +201,10 @@ , testTargets = targets , testResult = result , testMaxBackjumps = Nothing + , testMinimizeConflictSet = MinimizeConflictSet False , testIndepGoals = IndependentGoals False , testAllowBootLibInstalls = AllowBootLibInstalls False + , testOnlyConstrained = OnlyConstrainedNone , testEnableBackjumping = EnableBackjumping True , testSolveExecutables = SolveExecutables True , testGoalOrder = Nothing @@ -209,9 +223,10 @@ testCase testLabel $ do let progress = exResolve testDb testSupportedExts testSupportedLangs testPkgConfigDb testTargets - testMaxBackjumps (CountConflicts True) testIndepGoals + testMaxBackjumps (CountConflicts True) + testMinimizeConflictSet testIndepGoals (ReorderGoals False) testAllowBootLibInstalls - testEnableBackjumping testSolveExecutables + testOnlyConstrained testEnableBackjumping testSolveExecutables (sortGoals <$> testGoalOrder) testConstraints testSoftConstraints testVerbosity testEnableAllTests printMsg msg = when showSolverLog $ putStrLn msg diff --git a/cabal/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs b/cabal/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs --- a/cabal/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs +++ b/cabal/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs @@ -143,8 +143,9 @@ -- The backjump limit prevents individual tests from using -- too much time and memory. (Just defaultMaxBackjumps) - countConflicts indep reorder (AllowBootLibInstalls False) - enableBj (SolveExecutables True) (unVarOrdering <$> goalOrder) + countConflicts (MinimizeConflictSet False) indep reorder + (AllowBootLibInstalls False) OnlyConstrainedNone enableBj + (SolveExecutables True) (unVarOrdering <$> goalOrder) (testConstraints test) (testPreferences test) normal (EnableAllTests False) diff --git a/cabal/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs b/cabal/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs --- a/cabal/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs +++ b/cabal/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs @@ -152,6 +152,24 @@ , runTest $ allowBootLibInstalls $ mkTest dbBase "Install base with --allow-boot-library-installs" ["base"] $ solverSuccess [("base", 1), ("ghc-prim", 1), ("integer-gmp", 1), ("integer-simple", 1)] ] + , testGroup "reject-unconstrained" [ + runTest $ onlyConstrained $ mkTest db12 "missing syb" ["E"] $ + solverFailure (isInfixOf "not a user-provided goal") + , runTest $ onlyConstrained $ mkTest db12 "all goals" ["E", "syb"] $ + solverSuccess [("E", 1), ("syb", 2)] + , runTest $ onlyConstrained $ mkTest db17 "backtracking" ["A", "B"] $ + solverSuccess [("A", 2), ("B", 1)] + , runTest $ onlyConstrained $ mkTest db17 "failure message" ["A"] $ + solverFailure $ isInfixOf $ + "Could not resolve dependencies:\n" + ++ "[__0] trying: A-3.0.0 (user goal)\n" + ++ "[__1] next goal: C (dependency of A)\n" + ++ "[__1] fail (not a user-provided goal nor mentioned as a constraint, " + ++ "but reject-unconstrained-dependencies was set)\n" + ++ "[__1] fail (backjumping, conflict set: A, C)\n" + ++ "After searching the rest of the dependency tree exhaustively, " + ++ "these were the goals I've had most trouble fulfilling: A, C, B" + ] , testGroup "Cycles" [ runTest $ mkTest db14 "simpleCycle1" ["A"] anySolverFailure , runTest $ mkTest db14 "simpleCycle2" ["A", "B"] anySolverFailure @@ -427,6 +445,10 @@ "Backjump limit reached (currently 1, change with --max-backjumps " ++ "or try to run with --reorder-goals).\n" ++ "Failed to generate a summarized dependency solver log due to low backjump limit." + , testMinimizeConflictSet + "minimize conflict set with --minimize-conflict-set" + , testNoMinimizeConflictSet + "show original conflict set with --no-minimize-conflict-set" ] ] where @@ -867,7 +889,7 @@ -- | Detect a cycle between a package and its setup script. -- --- This type of cycle can easily occur when new-build adds default setup +-- This type of cycle can easily occur when v2-build adds default setup -- dependencies to packages without custom-setup stanzas. For example, cabal -- adds 'time' as a setup dependency for 'time'. The solver should detect the -- cycle when it attempts to link the setup and non-setup instances of the @@ -954,6 +976,20 @@ , Right $ exAv "E" 1 [] ] + +-- Try to get the solver to backtrack while satisfying +-- reject-unconstrained-dependencies: both the first and last versions of A +-- require packages outside the closed set, so it will have to try the +-- middle one. +db17 :: ExampleDb +db17 = [ + Right $ exAv "A" 1 [ExAny "C"] + , Right $ exAv "A" 2 [ExAny "B"] + , Right $ exAv "A" 3 [ExAny "C"] + , Right $ exAv "B" 1 [] + , Right $ exAv "C" 1 [ExAny "B"] + ] + -- | This test checks that when the solver discovers a constraint on a -- package's version after choosing to link that package, it can backtrack to -- try alternative versions for the linked-to package. See pull request #3327. @@ -1386,6 +1422,80 @@ goals :: [ExampleVar] goals = [P QualNone pkg | pkg <- ["A", "B", "C", "D"]] +dbMinimizeConflictSet :: ExampleDb +dbMinimizeConflictSet = [ + Right $ exAv "A" 3 [ExFix "B" 2, ExFix "C" 1, ExFix "D" 2] + , Right $ exAv "A" 2 [ExFix "B" 1, ExFix "C" 2, ExFix "D" 2] + , Right $ exAv "A" 1 [ExFix "B" 1, ExFix "C" 1, ExFix "D" 2] + , Right $ exAv "B" 1 [] + , Right $ exAv "C" 1 [] + , Right $ exAv "D" 1 [] + ] + +-- | Test that the solver can find a minimal conflict set with +-- --minimize-conflict-set. In the first run, the goal order causes the solver +-- to find that A-3 conflicts with B, A-2 conflicts with C, and A-1 conflicts +-- with D. The full log should show that the original final conflict set is +-- {A, B, C, D}. Then the solver should be able to reduce the conflict set to +-- {A, D}, since all versions of A conflict with D. The summarized log should +-- only mention A and D. +testMinimizeConflictSet :: String -> TestTree +testMinimizeConflictSet testName = + runTest $ minimizeConflictSet $ goalOrder goals $ setVerbose $ + mkTest dbMinimizeConflictSet testName ["A"] $ + SolverResult checkFullLog (Left (== expectedMsg)) + where + checkFullLog :: [String] -> Bool + checkFullLog = containsInOrder [ + "[__0] fail (backjumping, conflict set: A, B, C, D)" + , "Found no solution after exhaustively searching the dependency tree. " + ++ "Rerunning the dependency solver to minimize the conflict set ({A, B, C, D})." + , "Trying to remove variable \"A\" from the conflict set." + , "Failed to remove \"A\" from the conflict set. Continuing with {A, B, C, D}." + , "Trying to remove variable \"B\" from the conflict set." + , "Successfully removed \"B\" from the conflict set. Continuing with {A, C, D}." + , "Trying to remove variable \"C\" from the conflict set." + , "Successfully removed \"C\" from the conflict set. Continuing with {A, D}." + , "Trying to remove variable \"D\" from the conflict set." + , "Failed to remove \"D\" from the conflict set. Continuing with {A, D}." + ] + + expectedMsg = + "Could not resolve dependencies:\n" + ++ "[__0] trying: A-3.0.0 (user goal)\n" + ++ "[__1] next goal: D (dependency of A)\n" + ++ "[__1] rejecting: D-1.0.0 (conflict: A => D==2.0.0)\n" + ++ "[__1] fail (backjumping, conflict set: A, D)\n" + ++ "After searching the rest of the dependency tree exhaustively, these " + ++ "were the goals I've had most trouble fulfilling: A (7), D (6)" + + goals :: [ExampleVar] + goals = [P QualNone pkg | pkg <- ["A", "B", "C", "D"]] + +-- | This test uses the same packages and goal order as testMinimizeConflictSet, +-- but it doesn't set --minimize-conflict-set. The solver should print the +-- original final conflict set and the conflict between A and B. It should also +-- suggest rerunning with --minimize-conflict-set. +testNoMinimizeConflictSet :: String -> TestTree +testNoMinimizeConflictSet testName = + runTest $ goalOrder goals $ setVerbose $ + mkTest dbMinimizeConflictSet testName ["A"] $ + solverFailure (== expectedMsg) + where + expectedMsg = + "Could not resolve dependencies:\n" + ++ "[__0] trying: A-3.0.0 (user goal)\n" + ++ "[__1] next goal: B (dependency of A)\n" + ++ "[__1] rejecting: B-1.0.0 (conflict: A => B==2.0.0)\n" + ++ "[__1] fail (backjumping, conflict set: A, B)\n" + ++ "After searching the rest of the dependency tree exhaustively, " + ++ "these were the goals I've had most trouble fulfilling: " + ++ "A (7), B (2), C (2), D (2)\n" + ++ "Try running with --minimize-conflict-set to improve the error message." + + goals :: [ExampleVar] + goals = [P QualNone pkg | pkg <- ["A", "B", "C", "D"]] + {------------------------------------------------------------------------------- Simple databases for the illustrations for the backjumping blog post -------------------------------------------------------------------------------} @@ -1668,3 +1778,12 @@ Right $ exAv "A" 2 [ExFix "warp" 1] `withExe` ExExe "warp" [ExAny "A"], Right $ exAv "B" 2 [ExAny "A", ExAny "warp"] ] + +-- | Returns true if the second list contains all elements of the first list, in +-- order. +containsInOrder :: Eq a => [a] -> [a] -> Bool +containsInOrder [] _ = True +containsInOrder _ [] = False +containsInOrder (x:xs) (y:ys) + | x == y = containsInOrder xs ys + | otherwise = containsInOrder (x:xs) ys diff --git a/cabal/cabal-testsuite/PackageTests/AllowNewer/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/AllowNewer/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/AllowNewer/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/AllowNewer/cabal.test.hs @@ -2,26 +2,26 @@ import qualified Test.Cabal.Prelude as P -- See #4332, dep solving output is not deterministic main = cabalTest . recordMode DoNotRecord $ do - fails $ cabal "new-build" [] - cabal "new-build" ["--allow-newer"] - fails $ cabal "new-build" ["--allow-newer=baz,quux"] - cabal "new-build" ["--allow-newer=base", "--allow-newer=baz,quux"] - cabal "new-build" ["--allow-newer=bar", "--allow-newer=base,baz" + fails $ cabal "v2-build" [] + cabal "v2-build" ["--allow-newer"] + fails $ cabal "v2-build" ["--allow-newer=baz,quux"] + cabal "v2-build" ["--allow-newer=base", "--allow-newer=baz,quux"] + cabal "v2-build" ["--allow-newer=bar", "--allow-newer=base,baz" ,"--allow-newer=quux"] - fails $ cabal "new-build" ["--enable-tests"] - cabal "new-build" ["--enable-tests", "--allow-newer"] - fails $ cabal "new-build" ["--enable-benchmarks"] - cabal "new-build" ["--enable-benchmarks", "--allow-newer"] - fails $ cabal "new-build" ["--enable-benchmarks", "--enable-tests"] - cabal "new-build" ["--enable-benchmarks", "--enable-tests" + fails $ cabal "v2-build" ["--enable-tests"] + cabal "v2-build" ["--enable-tests", "--allow-newer"] + fails $ cabal "v2-build" ["--enable-benchmarks"] + cabal "v2-build" ["--enable-benchmarks", "--allow-newer"] + fails $ cabal "v2-build" ["--enable-benchmarks", "--enable-tests"] + cabal "v2-build" ["--enable-benchmarks", "--enable-tests" ,"--allow-newer"] - fails $ cabal "new-build" ["--allow-newer=Foo:base"] - fails $ cabal "new-build" ["--allow-newer=Foo:base" + fails $ cabal "v2-build" ["--allow-newer=Foo:base"] + fails $ cabal "v2-build" ["--allow-newer=Foo:base" ,"--enable-tests", "--enable-benchmarks"] - cabal "new-build" ["--allow-newer=AllowNewer:base"] - cabal "new-build" ["--allow-newer=AllowNewer:base" + cabal "v2-build" ["--allow-newer=AllowNewer:base"] + cabal "v2-build" ["--allow-newer=AllowNewer:base" ,"--allow-newer=Foo:base"] - cabal "new-build" ["--allow-newer=AllowNewer:base" + cabal "v2-build" ["--allow-newer=AllowNewer:base" ,"--allow-newer=Foo:base" ,"--enable-tests", "--enable-benchmarks"] where diff --git a/cabal/cabal-testsuite/PackageTests/AllowOlder/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/AllowOlder/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/AllowOlder/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/AllowOlder/cabal.test.hs @@ -2,26 +2,26 @@ import qualified Test.Cabal.Prelude as P -- See #4332, dep solving output is not deterministic main = cabalTest . recordMode DoNotRecord $ do - fails $ cabal "new-build" [] - cabal "new-build" ["--allow-older"] - fails $ cabal "new-build" ["--allow-older=baz,quux"] - cabal "new-build" ["--allow-older=base", "--allow-older=baz,quux"] - cabal "new-build" ["--allow-older=bar", "--allow-older=base,baz" + fails $ cabal "v2-build" [] + cabal "v2-build" ["--allow-older"] + fails $ cabal "v2-build" ["--allow-older=baz,quux"] + cabal "v2-build" ["--allow-older=base", "--allow-older=baz,quux"] + cabal "v2-build" ["--allow-older=bar", "--allow-older=base,baz" ,"--allow-older=quux"] - fails $ cabal "new-build" ["--enable-tests"] - cabal "new-build" ["--enable-tests", "--allow-older"] - fails $ cabal "new-build" ["--enable-benchmarks"] - cabal "new-build" ["--enable-benchmarks", "--allow-older"] - fails $ cabal "new-build" ["--enable-benchmarks", "--enable-tests"] - cabal "new-build" ["--enable-benchmarks", "--enable-tests" + fails $ cabal "v2-build" ["--enable-tests"] + cabal "v2-build" ["--enable-tests", "--allow-older"] + fails $ cabal "v2-build" ["--enable-benchmarks"] + cabal "v2-build" ["--enable-benchmarks", "--allow-older"] + fails $ cabal "v2-build" ["--enable-benchmarks", "--enable-tests"] + cabal "v2-build" ["--enable-benchmarks", "--enable-tests" ,"--allow-older"] - fails $ cabal "new-build" ["--allow-older=Foo:base"] - fails $ cabal "new-build" ["--allow-older=Foo:base" + fails $ cabal "v2-build" ["--allow-older=Foo:base"] + fails $ cabal "v2-build" ["--allow-older=Foo:base" ,"--enable-tests", "--enable-benchmarks"] - cabal "new-build" ["--allow-older=AllowOlder:base"] - cabal "new-build" ["--allow-older=AllowOlder:base" + cabal "v2-build" ["--allow-older=AllowOlder:base"] + cabal "v2-build" ["--allow-older=AllowOlder:base" ,"--allow-older=Foo:base"] - cabal "new-build" ["--allow-older=AllowOlder:base" + cabal "v2-build" ["--allow-older=AllowOlder:base" ,"--allow-older=Foo:base" ,"--enable-tests", "--enable-benchmarks"] where diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-external-target.out b/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-external-target.out --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-external-target.out +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-external-target.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-external-target.test.hs b/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-external-target.test.hs --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-external-target.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-external-target.test.hs @@ -3,4 +3,4 @@ main = cabalTest $ do skipUnless =<< ghcVersionIs (>= mkVersion [8,1]) withProjectFile "cabal.external.project" $ do - cabal "new-build" ["mylib"] + cabal "v2-build" ["mylib"] diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-external.out b/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-external.out --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-external.out +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-external.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-external.test.hs b/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-external.test.hs --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-external.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-external.test.hs @@ -3,7 +3,7 @@ main = cabalTest $ do skipUnless =<< ghcVersionIs (>= mkVersion [8,1]) withProjectFile "cabal.external.project" $ do - cabal "new-build" ["exe"] + cabal "v2-build" ["exe"] withPlan $ do r <- runPlanExe' "exe" "exe" [] assertOutputContains "minemysql minepostgresql" r diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal-target.out b/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal-target.out --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal-target.out +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal-target.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal-target.test.hs b/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal-target.test.hs --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal-target.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal-target.test.hs @@ -3,4 +3,4 @@ main = cabalTest $ do skipUnless =<< ghcVersionIs (>= mkVersion [8,1]) withProjectFile "cabal.internal.project" $ do - cabal "new-build" ["mylib"] + cabal "v2-build" ["mylib"] diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.out b/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.out --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.out +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: @@ -34,9 +34,11 @@ Database = Includes2-0.1.0.0-inplace-postgresql:Database.PostgreSQL for Includes2-0.1.0.0.. Configuring library for Includes2-0.1.0.0.. +Warning: The package has an extraneous version range for a dependency on an internal library: Includes2 -any && ==0.1.0.0 && ==0.1.0.0 && ==0.1.0.0. This version range includes the current package but isn't needed as the current package's library will always be used. Preprocessing library for Includes2-0.1.0.0.. Building library for Includes2-0.1.0.0.. Configuring executable 'exe' for Includes2-0.1.0.0.. +Warning: The package has an extraneous version range for a dependency on an internal library: Includes2 -any && ==0.1.0.0. This version range includes the current package but isn't needed as the current package's library will always be used. Preprocessing executable 'exe' for Includes2-0.1.0.0.. Building executable 'exe' for Includes2-0.1.0.0.. # Includes2 exe diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.test.hs b/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.test.hs --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.test.hs @@ -3,7 +3,7 @@ main = cabalTest $ do skipUnless =<< ghcVersionIs (>= mkVersion [8,1]) withProjectFile "cabal.internal.project" $ do - cabal "new-build" ["exe"] + cabal "v2-build" ["exe"] withPlan $ do r <- runPlanExe' "Includes2" "exe" [] assertOutputContains "minemysql minepostgresql" r diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-external.out b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-external.out --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-external.out +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-external.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-external.test.hs b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-external.test.hs --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-external.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-external.test.hs @@ -3,7 +3,7 @@ main = cabalTest $ do skipUnless =<< ghcVersionIs (>= mkVersion [8,1]) withProjectFile "cabal.external.project" $ do - cabal "new-build" ["exe"] + cabal "v2-build" ["exe"] withPlan $ do r <- runPlanExe' "exe" "exe" [] assertOutputContains "fromList [(0,2),(2,4)]" r diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-internal.out b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-internal.out --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-internal.out +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-internal.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-internal.test.hs b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-internal.test.hs --- a/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-internal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Includes3/cabal-internal.test.hs @@ -3,7 +3,7 @@ main = cabalTest $ do skipUnless =<< ghcVersionIs (>= mkVersion [8,1]) withProjectFile "cabal.internal.project" $ do - cabal "new-build" ["exe"] + cabal "v2-build" ["exe"] withPlan $ do r <- runPlanExe' "Includes3" "exe" [] assertOutputContains "fromList [(0,2),(2,4)]" r diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Reexport2/cabal.out b/cabal/cabal-testsuite/PackageTests/Backpack/Reexport2/cabal.out --- a/cabal/cabal-testsuite/PackageTests/Backpack/Reexport2/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Reexport2/cabal.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Error: Problem with module re-exports: diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/Reexport2/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/Backpack/Reexport2/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/Backpack/Reexport2/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Backpack/Reexport2/cabal.test.hs @@ -1,5 +1,5 @@ import Test.Cabal.Prelude main = cabalTest $ do - r <- fails $ cabal' "new-build" [] + r <- fails $ cabal' "v2-build" [] assertOutputContains "Asdf" r assertOutputContains "Reexport2" r diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/T5634/Go.hs b/cabal/cabal-testsuite/PackageTests/Backpack/T5634/Go.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Backpack/T5634/Go.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE TemplateHaskell #-} +module Go where +import THFuns + +thfun ''Int diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/T5634/T5634.cabal b/cabal/cabal-testsuite/PackageTests/Backpack/T5634/T5634.cabal new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Backpack/T5634/T5634.cabal @@ -0,0 +1,22 @@ +name: th-backpack-failure +version: 1.0 +build-type: Simple +cabal-version: >= 2.0 + +library + build-depends: base, impl, sig-with-th + hs-source-dirs: . + mixins: sig-with-th requires (Sig as Impl) + signatures: Unused + exposed-modules: Go + +library sig-with-th + build-depends: base + hs-source-dirs: sig-with-th + signatures: Sig + exposed-modules: THFuns + +library impl + build-depends: base + hs-source-dirs: impl + exposed-modules: Impl diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/T5634/Unused.hsig b/cabal/cabal-testsuite/PackageTests/Backpack/T5634/Unused.hsig new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Backpack/T5634/Unused.hsig @@ -0,0 +1,1 @@ +signature Unused where diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/T5634/impl/Impl.hs b/cabal/cabal-testsuite/PackageTests/Backpack/T5634/impl/Impl.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Backpack/T5634/impl/Impl.hs @@ -0,0 +1,1 @@ +module Impl where diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/T5634/setup.cabal.out b/cabal/cabal-testsuite/PackageTests/Backpack/T5634/setup.cabal.out new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Backpack/T5634/setup.cabal.out @@ -0,0 +1,17 @@ +# Setup configure +Resolving dependencies... +Configuring th-backpack-failure-1.0... +Warning: Packages using 'cabal-version: >= 1.10' must specify the 'default-language' field for each component (e.g. Haskell98 or Haskell2010). If a component uses different languages in different modules then list the other ones in the 'other-languages' field. +# Setup build +Preprocessing library 'sig-with-th' for th-backpack-failure-1.0.. +Building library 'sig-with-th' instantiated with Sig = +for th-backpack-failure-1.0.. +Preprocessing library 'impl' for th-backpack-failure-1.0.. +Building library 'impl' for th-backpack-failure-1.0.. +Preprocessing library 'sig-with-th' for th-backpack-failure-1.0.. +Building library 'sig-with-th' instantiated with + Sig = th-backpack-failure-1.0-impl:Impl +for th-backpack-failure-1.0.. +Preprocessing library for th-backpack-failure-1.0.. +Building library instantiated with Unused = +for th-backpack-failure-1.0.. diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/T5634/setup.out b/cabal/cabal-testsuite/PackageTests/Backpack/T5634/setup.out new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Backpack/T5634/setup.out @@ -0,0 +1,16 @@ +# Setup configure +Configuring th-backpack-failure-1.0... +Warning: Packages using 'cabal-version: >= 1.10' must specify the 'default-language' field for each component (e.g. Haskell98 or Haskell2010). If a component uses different languages in different modules then list the other ones in the 'other-languages' field. +# Setup build +Preprocessing library 'sig-with-th' for th-backpack-failure-1.0.. +Building library 'sig-with-th' instantiated with Sig = +for th-backpack-failure-1.0.. +Preprocessing library 'impl' for th-backpack-failure-1.0.. +Building library 'impl' for th-backpack-failure-1.0.. +Preprocessing library 'sig-with-th' for th-backpack-failure-1.0.. +Building library 'sig-with-th' instantiated with + Sig = th-backpack-failure-1.0-impl:Impl +for th-backpack-failure-1.0.. +Preprocessing library for th-backpack-failure-1.0.. +Building library instantiated with Unused = +for th-backpack-failure-1.0.. diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/T5634/setup.test.hs b/cabal/cabal-testsuite/PackageTests/Backpack/T5634/setup.test.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Backpack/T5634/setup.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude +main = setupAndCabalTest $ do + skipUnless =<< ghcVersionIs (>= mkVersion [8,1]) + setup "configure" [] + setup "build" [] diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/T5634/sig-with-th/Sig.hsig b/cabal/cabal-testsuite/PackageTests/Backpack/T5634/sig-with-th/Sig.hsig new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Backpack/T5634/sig-with-th/Sig.hsig @@ -0,0 +1,1 @@ +signature Sig where diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/T5634/sig-with-th/THFuns.hs b/cabal/cabal-testsuite/PackageTests/Backpack/T5634/sig-with-th/THFuns.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Backpack/T5634/sig-with-th/THFuns.hs @@ -0,0 +1,2 @@ +module THFuns where +thfun _ = return [] diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/Main.hs b/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/Main.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/Main.hs @@ -0,0 +1,2 @@ +import Q +main = print out diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/bkpcabal01.cabal b/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/bkpcabal01.cabal new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/bkpcabal01.cabal @@ -0,0 +1,36 @@ +cabal-version: 2.0 +name: bkpcabal01 +version: 0.1.0.0 +description: This test also exists in GHC's test-suite under the same name + and was ported over to cabal's testsuite as it exposed a + regression (see #5929) +license: BSD3 +author: Edward Z. Yang +maintainer: ezyang@cs.stanford.edu +build-type: Simple + +library impl + exposed-modules: H, I + build-depends: base + hs-source-dirs: impl + default-language: Haskell2010 + +library p + exposed-modules: P + signatures: H + hs-source-dirs: p + build-depends: base + default-language: Haskell2010 + +library q + exposed-modules: Q + signatures: I + hs-source-dirs: q + build-depends: p, impl, base + mixins: impl (H) + default-language: Haskell2010 + +executable exe + main-is: Main.hs + build-depends: base, q, impl + default-language: Haskell2010 diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/cabal.out b/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/cabal.out new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/cabal.out @@ -0,0 +1,34 @@ +# cabal v2-build +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - bkpcabal01-0.1.0.0 (lib:impl) (first run) + - bkpcabal01-0.1.0.0 (lib:p) (first run) + - bkpcabal01-0.1.0.0 (lib:p with H=bkpcabal01-0.1.0.0-inplace-impl:H) (first run) + - bkpcabal01-0.1.0.0 (lib:q) (first run) + - bkpcabal01-0.1.0.0 (lib:q with I=bkpcabal01-0.1.0.0-inplace-impl:I) (first run) + - bkpcabal01-0.1.0.0 (exe:exe) (first run) +Configuring library 'impl' for bkpcabal01-0.1.0.0.. +Preprocessing library 'impl' for bkpcabal01-0.1.0.0.. +Building library 'impl' for bkpcabal01-0.1.0.0.. +Configuring library 'p' for bkpcabal01-0.1.0.0.. +Preprocessing library 'p' for bkpcabal01-0.1.0.0.. +Building library 'p' instantiated with H = +for bkpcabal01-0.1.0.0.. +Configuring library 'p' instantiated with H = bkpcabal01-0.1.0.0-inplace-impl:H +for bkpcabal01-0.1.0.0.. +Preprocessing library 'p' for bkpcabal01-0.1.0.0.. +Building library 'p' instantiated with H = bkpcabal01-0.1.0.0-inplace-impl:H +for bkpcabal01-0.1.0.0.. +Configuring library 'q' for bkpcabal01-0.1.0.0.. +Preprocessing library 'q' for bkpcabal01-0.1.0.0.. +Building library 'q' instantiated with I = +for bkpcabal01-0.1.0.0.. +Configuring library 'q' instantiated with I = bkpcabal01-0.1.0.0-inplace-impl:I +for bkpcabal01-0.1.0.0.. +Preprocessing library 'q' for bkpcabal01-0.1.0.0.. +Building library 'q' instantiated with I = bkpcabal01-0.1.0.0-inplace-impl:I +for bkpcabal01-0.1.0.0.. +Configuring executable 'exe' for bkpcabal01-0.1.0.0.. +Preprocessing executable 'exe' for bkpcabal01-0.1.0.0.. +Building executable 'exe' for bkpcabal01-0.1.0.0.. diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/cabal.project b/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/cabal.project new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/cabal.project @@ -0,0 +1,1 @@ +packages: . diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/cabal.test.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude +main = cabalTest $ do + -- GHC 8.2.2 had a regression ("unknown package: hole"), see also #4908 + skipUnless =<< ghcVersionIs (\v -> v >= mkVersion [8,2] && v /= mkVersion [8,2,2]) + cabal "v2-build" ["all"] diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/impl/H.hs b/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/impl/H.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/impl/H.hs @@ -0,0 +1,2 @@ +module H where +x = True diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/impl/I.hs b/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/impl/I.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/impl/I.hs @@ -0,0 +1,1 @@ +module I where diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/p/H.hsig b/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/p/H.hsig new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/p/H.hsig @@ -0,0 +1,2 @@ +signature H where +x :: Bool diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/p/P.hs b/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/p/P.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/p/P.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE CPP #-} +module P where +import H +y = x diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/q/I.hsig b/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/q/I.hsig new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/q/I.hsig @@ -0,0 +1,1 @@ +signature I where diff --git a/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/q/Q.hs b/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/q/Q.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Backpack/bkpcabal01/q/Q.hs @@ -0,0 +1,3 @@ +module Q where +import P +out = y diff --git a/cabal/cabal-testsuite/PackageTests/BuildDeps/DepCycle/cabal.out b/cabal/cabal-testsuite/PackageTests/BuildDeps/DepCycle/cabal.out --- a/cabal/cabal-testsuite/PackageTests/BuildDeps/DepCycle/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/BuildDeps/DepCycle/cabal.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Error: Dependency cycle between the following components: diff --git a/cabal/cabal-testsuite/PackageTests/BuildDeps/DepCycle/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/BuildDeps/DepCycle/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/BuildDeps/DepCycle/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/BuildDeps/DepCycle/cabal.test.hs @@ -1,6 +1,6 @@ import Test.Cabal.Prelude main = cabalTest $ do - r <- fails $ cabal' "new-build" [] + r <- fails $ cabal' "v2-build" [] assertOutputContains "cycl" r -- match cyclic or cycle assertOutputContains "bar" r assertOutputContains "foo" r diff --git a/cabal/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary1/cabal.out b/cabal/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary1/cabal.out --- a/cabal/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary1/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary1/cabal.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: diff --git a/cabal/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary1/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary1/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary1/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary1/cabal.test.hs @@ -1,3 +1,3 @@ import Test.Cabal.Prelude main = cabalTest $ do - cabal "new-build" ["lemon"] + cabal "v2-build" ["lemon"] diff --git a/cabal/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackage/use-local-version-of-package.out b/cabal/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackage/use-local-version-of-package.out --- a/cabal/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackage/use-local-version-of-package.out +++ b/cabal/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackage/use-local-version-of-package.out @@ -1,6 +1,6 @@ # cabal v1-update Downloading the latest package list from test-local-repo -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: @@ -10,7 +10,7 @@ Building executable 'my-exe' for pkg-1.0.. # pkg my-exe local pkg-1.0 -# cabal new-build +# cabal v2-build Resolving dependencies... cabal: Could not resolve dependencies: [__0] next goal: pkg (user goal) diff --git a/cabal/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackage/use-local-version-of-package.test.hs b/cabal/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackage/use-local-version-of-package.test.hs --- a/cabal/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackage/use-local-version-of-package.test.hs +++ b/cabal/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackage/use-local-version-of-package.test.hs @@ -1,15 +1,15 @@ import Test.Cabal.Prelude --- Test that "cabal new-build pkg" builds the local pkg-1.0, which has an exe +-- Test that "cabal v2-build pkg" builds the local pkg-1.0, which has an exe -- that prints a unique message. It should not build 1.0 or 2.0 from the -- repository. main = cabalTest $ withRepo "repo" $ do - cabal "new-build" ["pkg"] + cabal "v2-build" ["pkg"] withPlan $ do r <- runPlanExe' "pkg" "my-exe" [] assertOutputContains "local pkg-1.0" r -- cabal shouldn't build a package from the repo, even when given a constraint -- that only matches a non-local package. - r <- fails $ cabal' "new-build" ["pkg", "--constraint=pkg==2.0"] + r <- fails $ cabal' "v2-build" ["pkg", "--constraint=pkg==2.0"] assertOutputContains "rejecting: pkg-2.0" r diff --git a/cabal/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackageForSetup/use-local-package-as-setup-dep.out b/cabal/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackageForSetup/use-local-package-as-setup-dep.out --- a/cabal/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackageForSetup/use-local-package-as-setup-dep.out +++ b/cabal/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackageForSetup/use-local-package-as-setup-dep.out @@ -1,6 +1,6 @@ # cabal v1-update Downloading the latest package list from test-local-repo -# cabal new-build +# cabal v2-build Resolving dependencies... cabal: Could not resolve dependencies: [__0] trying: pkg-1.0 (user goal) diff --git a/cabal/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackageForSetup/use-local-package-as-setup-dep.test.hs b/cabal/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackageForSetup/use-local-package-as-setup-dep.test.hs --- a/cabal/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackageForSetup/use-local-package-as-setup-dep.test.hs +++ b/cabal/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackageForSetup/use-local-package-as-setup-dep.test.hs @@ -14,12 +14,12 @@ cabalTest $ do skipUnless =<< hasNewBuildCompatBootCabal withRepo "repo" $ do - fails $ cabalG ["--store-dir=" ++ storeDir] "new-build" ["pkg:my-exe", "--dry-run"] + fails $ cabalG ["--store-dir=" ++ storeDir] "v2-build" ["pkg:my-exe", "--dry-run"] -- Disabled recording because whether or not we get -- detailed information for the build of my-exe depends -- on whether or not the Cabal library version is recent -- enough - r1 <- recordMode DoNotRecord $ cabalG' ["--store-dir=" ++ storeDir] "new-build" ["pkg:my-exe", "--independent-goals"] + r1 <- recordMode DoNotRecord $ cabalG' ["--store-dir=" ++ storeDir] "v2-build" ["pkg:my-exe", "--independent-goals"] assertOutputContains "Setup.hs: setup-dep from project" r1 withPlan $ do r2 <- runPlanExe' "pkg" "my-exe" [] diff --git a/cabal/cabal-testsuite/PackageTests/BuildToolDepends/setup.out b/cabal/cabal-testsuite/PackageTests/BuildToolDepends/setup.out --- a/cabal/cabal-testsuite/PackageTests/BuildToolDepends/setup.out +++ b/cabal/cabal-testsuite/PackageTests/BuildToolDepends/setup.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: diff --git a/cabal/cabal-testsuite/PackageTests/BuildToolDepends/setup.test.hs b/cabal/cabal-testsuite/PackageTests/BuildToolDepends/setup.test.hs --- a/cabal/cabal-testsuite/PackageTests/BuildToolDepends/setup.test.hs +++ b/cabal/cabal-testsuite/PackageTests/BuildToolDepends/setup.test.hs @@ -1,4 +1,4 @@ import Test.Cabal.Prelude -- Test build-tool-depends between two packages main = cabalTest $ do - cabal "new-build" ["client"] + cabal "v2-build" ["client"] diff --git a/cabal/cabal-testsuite/PackageTests/BuildTools/External/cabal.out b/cabal/cabal-testsuite/PackageTests/BuildTools/External/cabal.out --- a/cabal/cabal-testsuite/PackageTests/BuildTools/External/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/BuildTools/External/cabal.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: diff --git a/cabal/cabal-testsuite/PackageTests/BuildTools/External/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/BuildTools/External/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/BuildTools/External/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/BuildTools/External/cabal.test.hs @@ -2,4 +2,4 @@ -- Test legacy `build-tools` dependency on external package -- We use one of the hard-coded names to accomplish this main = cabalTest $ do - cabal "new-build" ["client"] + cabal "v2-build" ["client"] diff --git a/cabal/cabal-testsuite/PackageTests/BuildTools/Internal/cabal.out b/cabal/cabal-testsuite/PackageTests/BuildTools/Internal/cabal.out --- a/cabal/cabal-testsuite/PackageTests/BuildTools/Internal/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/BuildTools/Internal/cabal.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: @@ -12,5 +12,6 @@ Preprocessing library for foo-0.1.0.0.. Building library for foo-0.1.0.0.. Configuring executable 'hello-world' for foo-0.1.0.0.. +Warning: The package has an extraneous version range for a dependency on an internal library: foo -any && ==0.1.0.0. This version range includes the current package but isn't needed as the current package's library will always be used. Preprocessing executable 'hello-world' for foo-0.1.0.0.. Building executable 'hello-world' for foo-0.1.0.0.. diff --git a/cabal/cabal-testsuite/PackageTests/BuildTools/Internal/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/BuildTools/Internal/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/BuildTools/Internal/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/BuildTools/Internal/cabal.test.hs @@ -1,4 +1,4 @@ import Test.Cabal.Prelude -- Test leacy `build-tools` dependency on internal library main = cabalTest $ do - cabal "new-build" ["foo", "hello-world"] + cabal "v2-build" ["foo", "hello-world"] diff --git a/cabal/cabal-testsuite/PackageTests/CaretOperator/setup.test.hs b/cabal/cabal-testsuite/PackageTests/CaretOperator/setup.test.hs --- a/cabal/cabal-testsuite/PackageTests/CaretOperator/setup.test.hs +++ b/cabal/cabal-testsuite/PackageTests/CaretOperator/setup.test.hs @@ -22,7 +22,7 @@ let Just gotLib = library (localPkgDescr lbi) bi = libBuildInfo gotLib assertEqual "defaultLanguage" (Just Haskell2010) (defaultLanguage bi) - forM_ (targetBuildDepends bi) $ \(Dependency pn vr) -> + forM_ (targetBuildDepends bi) $ \(Dependency pn vr _) -> when (pn == mkPackageName "pretty") $ assertEqual "targetBuildDepends/pretty" vr (majorBoundVersion (mkVersion [1,1,1,0])) diff --git a/cabal/cabal-testsuite/PackageTests/Check/DifferentGhcOptions/cabal.out b/cabal/cabal-testsuite/PackageTests/Check/DifferentGhcOptions/cabal.out new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Check/DifferentGhcOptions/cabal.out @@ -0,0 +1,8 @@ +# cabal check +Warning: The following warnings are likely to affect your build negatively: +Warning: 'ghc-shared-options: -hide-package' is never needed. Cabal hides all packages. +Warning: The following errors will cause portability problems on other environments: +Warning: 'ghc-options: -fasm' is unnecessary and will not work on CPU architectures other than x86, x86-64, ppc or sparc. +Warning: 'ghc-prof-options: -fhpc' is not not necessary. Use the configure flag --enable-coverage instead. +Warning: 'ghc-shared-options: -Wall -Werror' makes the package very easy to break with future GHC versions because new GHC versions often add new warnings. Use just 'ghc-shared-options: -Wall' instead. Alternatively, if you want to use this, make it conditional based on a Cabal configuration flag (with 'manual: True' and 'default: False') and enable that flag during development. +Warning: Hackage would reject this package. diff --git a/cabal/cabal-testsuite/PackageTests/Check/DifferentGhcOptions/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/Check/DifferentGhcOptions/cabal.test.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Check/DifferentGhcOptions/cabal.test.hs @@ -0,0 +1,2 @@ +import Test.Cabal.Prelude +main = cabalTest $ fails $ cabal "check" [] diff --git a/cabal/cabal-testsuite/PackageTests/Check/DifferentGhcOptions/pkg.cabal b/cabal/cabal-testsuite/PackageTests/Check/DifferentGhcOptions/pkg.cabal new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Check/DifferentGhcOptions/pkg.cabal @@ -0,0 +1,15 @@ +cabal-version: 2.2 +name: pkg +version: 0 +category: example +maintainer: none@example.com +synopsis: synopsis +description: description +license: BSD-3-Clause + +library + exposed-modules: Foo + default-language: Haskell2010 + ghc-options: -fasm + ghc-prof-options: -fhpc + ghc-shared-options: -hide-package -Wall -Werror diff --git a/cabal/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit-fail.out b/cabal/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit-fail.out --- a/cabal/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit-fail.out +++ b/cabal/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit-fail.out @@ -9,5 +9,5 @@ Registering library 'sublib' for Lib-0.1.0.0.. # Setup configure Configuring executable 'exe' for Lib-0.1.0.0.. -setup: Encountered missing dependencies: +setup: Encountered missing or private dependencies: sublib -any diff --git a/cabal/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit.test.hs b/cabal/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit.test.hs --- a/cabal/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit.test.hs +++ b/cabal/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit.test.hs @@ -5,6 +5,6 @@ base_id <- getIPID "base" setup_install ["sublib", "--cid", "sublib-0.1-abc"] setup_install [ "exe", "--exact-configuration" - , "--dependency", "sublib=sublib-0.1-abc" + , "--dependency", "sublib:sublib=sublib-0.1-abc" , "--dependency", "base=" ++ base_id ] runExe' "exe" [] >>= assertOutputContains "OK" diff --git a/cabal/cabal-testsuite/PackageTests/CustomDep/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/CustomDep/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/CustomDep/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/CustomDep/cabal.test.hs @@ -9,4 +9,4 @@ recordMode DoNotRecord $ do -- TODO: Hack, delete me withEnvFilter (`notElem` ["HOME", "CABAL_DIR"]) $ do - cabal "new-build" ["all"] + cabal "v2-build" ["all"] diff --git a/cabal/cabal-testsuite/PackageTests/CustomPlain/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/CustomPlain/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/CustomPlain/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/CustomPlain/cabal.test.hs @@ -8,4 +8,4 @@ withEnvFilter (`notElem` ["HOME", "CABAL_DIR"]) $ do -- On -v2, we don't have vQuiet set, which suppressed -- the error - cabal "new-build" ["-v1"] + cabal "v2-build" ["-v1"] diff --git a/cabal/cabal-testsuite/PackageTests/CustomSegfault/cabal.out b/cabal/cabal-testsuite/PackageTests/CustomSegfault/cabal.out --- a/cabal/cabal-testsuite/PackageTests/CustomSegfault/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/CustomSegfault/cabal.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: diff --git a/cabal/cabal-testsuite/PackageTests/CustomSegfault/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/CustomSegfault/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/CustomSegfault/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/CustomSegfault/cabal.test.hs @@ -3,4 +3,4 @@ -- TODO: this test ought to work on Windows too skipUnless =<< isLinux skipUnless =<< ghcVersionIs (>= mkVersion [7,8]) - fails $ cabal' "new-build" [] >>= assertOutputContains "SIGSEGV" + fails $ cabal' "v2-build" [] >>= assertOutputContains "SIGSEGV" diff --git a/cabal/cabal-testsuite/PackageTests/CustomWithoutCabal/cabal.out b/cabal/cabal-testsuite/PackageTests/CustomWithoutCabal/cabal.out --- a/cabal/cabal-testsuite/PackageTests/CustomWithoutCabal/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/CustomWithoutCabal/cabal.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: diff --git a/cabal/cabal-testsuite/PackageTests/CustomWithoutCabal/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/CustomWithoutCabal/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/CustomWithoutCabal/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/CustomWithoutCabal/cabal.test.hs @@ -2,7 +2,7 @@ main = cabalTest $ do -- This package has explicit setup dependencies that do not include Cabal. - -- new-build should try to build it, but configure should fail because + -- v2-build should try to build it, but configure should fail because -- Setup.hs just prints an error message and exits. - r <- fails $ cabal' "new-build" ["custom-setup-without-cabal"] + r <- fails $ cabal' "v2-build" ["custom-setup-without-cabal"] assertOutputContains "My custom Setup" r diff --git a/cabal/cabal-testsuite/PackageTests/CustomWithoutCabalDefaultMain/cabal.out b/cabal/cabal-testsuite/PackageTests/CustomWithoutCabalDefaultMain/cabal.out --- a/cabal/cabal-testsuite/PackageTests/CustomWithoutCabalDefaultMain/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/CustomWithoutCabalDefaultMain/cabal.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: diff --git a/cabal/cabal-testsuite/PackageTests/CustomWithoutCabalDefaultMain/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/CustomWithoutCabalDefaultMain/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/CustomWithoutCabalDefaultMain/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/CustomWithoutCabalDefaultMain/cabal.test.hs @@ -3,9 +3,9 @@ -- This package has explicit setup dependencies that do not include Cabal. -- Compilation should fail because Setup.hs imports Distribution.Simple. - r <- fails $ cabal' "new-build" ["custom-setup-without-cabal-defaultMain"] + r <- fails $ cabal' "v2-build" ["custom-setup-without-cabal-defaultMain"] assertRegex "Should not have been able to import Cabal" - "(Could not find module|Could not load module|Failed to load interface for).*Distribution\\.Simple" r + "(Could not (find|load) module|Failed to load interface for).*Distribution\\.Simple" r {- -- TODO: With GHC 8.2, this no longer is displayed -- When using --with-ghc, this message is not necessarily output diff --git a/cabal/cabal-testsuite/PackageTests/Exec/cabal.out b/cabal/cabal-testsuite/PackageTests/Exec/cabal.out --- a/cabal/cabal-testsuite/PackageTests/Exec/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/Exec/cabal.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: diff --git a/cabal/cabal-testsuite/PackageTests/Exec/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/Exec/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/Exec/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Exec/cabal.test.hs @@ -2,5 +2,5 @@ main = cabalTest $ do -- NB: cabal-version: >= 1.2 in my.cabal means we exercise -- the non per-component code path - cabal "new-build" ["my-executable"] + cabal "v2-build" ["my-executable"] withPlan $ runPlanExe "my" "my-executable" [] diff --git a/cabal/cabal-testsuite/PackageTests/Exec/sandbox-hc-pkg.test.hs b/cabal/cabal-testsuite/PackageTests/Exec/sandbox-hc-pkg.test.hs --- a/cabal/cabal-testsuite/PackageTests/Exec/sandbox-hc-pkg.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Exec/sandbox-hc-pkg.test.hs @@ -1,7 +1,8 @@ import Test.Cabal.Prelude import Data.Maybe -import System.Directory +import Distribution.Compat.Directory import Control.Monad.IO.Class + main = cabalTest $ do withPackageDb $ do withSandbox $ do @@ -21,5 +22,5 @@ -- TODO: Ugh. Test abstractions leaking -- through " --sandbox-config-file " ++ show (testSandboxConfigFile env) ++ - " sandbox hc-pkg list"] + " v1-sandbox hc-pkg list"] >>= assertOutputContains "my-0.1" diff --git a/cabal/cabal-testsuite/PackageTests/ExecModern/cabal.out b/cabal/cabal-testsuite/PackageTests/ExecModern/cabal.out --- a/cabal/cabal-testsuite/PackageTests/ExecModern/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/ExecModern/cabal.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: diff --git a/cabal/cabal-testsuite/PackageTests/ExecModern/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/ExecModern/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/ExecModern/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/ExecModern/cabal.test.hs @@ -2,5 +2,5 @@ main = cabalTest $ do -- NB: cabal-version: >= 1.2 in my.cabal means we exercise -- the non per-component code path - cabal "new-build" ["my-executable"] + cabal "v2-build" ["my-executable"] withPlan $ runPlanExe "my" "my-executable" [] diff --git a/cabal/cabal-testsuite/PackageTests/InternalLibraries/Executable/setup-static.test.hs b/cabal/cabal-testsuite/PackageTests/InternalLibraries/Executable/setup-static.test.hs --- a/cabal/cabal-testsuite/PackageTests/InternalLibraries/Executable/setup-static.test.hs +++ b/cabal/cabal-testsuite/PackageTests/InternalLibraries/Executable/setup-static.test.hs @@ -29,7 +29,7 @@ lbi <- liftIO $ getPersistBuildConfig dist_dir let pkg_descr = localPkgDescr lbi compiler_id = compilerId (compiler lbi) - cname = CSubLibName $ mkUnqualComponentName "foo-internal" + cname = CLibName $ LSubLibName $ mkUnqualComponentName "foo-internal" [target] = componentNameTargets' pkg_descr lbi cname uid = componentUnitId (targetCLBI target) InstallDirs{libdir=dir,dynlibdir=dyndir} = diff --git a/cabal/cabal-testsuite/PackageTests/InternalLibraries/cabal-per-package.out b/cabal/cabal-testsuite/PackageTests/InternalLibraries/cabal-per-package.out --- a/cabal/cabal-testsuite/PackageTests/InternalLibraries/cabal-per-package.out +++ b/cabal/cabal-testsuite/PackageTests/InternalLibraries/cabal-per-package.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Error: Internal libraries only supported with per-component builds. diff --git a/cabal/cabal-testsuite/PackageTests/InternalLibraries/cabal-per-package.test.hs b/cabal/cabal-testsuite/PackageTests/InternalLibraries/cabal-per-package.test.hs --- a/cabal/cabal-testsuite/PackageTests/InternalLibraries/cabal-per-package.test.hs +++ b/cabal/cabal-testsuite/PackageTests/InternalLibraries/cabal-per-package.test.hs @@ -1,3 +1,3 @@ import Test.Cabal.Prelude main = cabalTest $ do - fails $ cabal "new-build" ["--disable-per-component", "p"] + fails $ cabal "v2-build" ["--disable-per-component", "p"] diff --git a/cabal/cabal-testsuite/PackageTests/InternalLibraries/cabal.out b/cabal/cabal-testsuite/PackageTests/InternalLibraries/cabal.out --- a/cabal/cabal-testsuite/PackageTests/InternalLibraries/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/InternalLibraries/cabal.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: diff --git a/cabal/cabal-testsuite/PackageTests/InternalLibraries/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/InternalLibraries/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/InternalLibraries/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/InternalLibraries/cabal.test.hs @@ -1,3 +1,3 @@ import Test.Cabal.Prelude main = cabalTest $ do - cabal "new-build" ["p"] + cabal "v2-build" ["p"] diff --git a/cabal/cabal-testsuite/PackageTests/InternalVersions/BuildDependsExtra/setup.cabal.out b/cabal/cabal-testsuite/PackageTests/InternalVersions/BuildDependsExtra/setup.cabal.out --- a/cabal/cabal-testsuite/PackageTests/InternalVersions/BuildDependsExtra/setup.cabal.out +++ b/cabal/cabal-testsuite/PackageTests/InternalVersions/BuildDependsExtra/setup.cabal.out @@ -1,3 +1,16 @@ # Setup configure Resolving dependencies... Configuring build-depends-extra-version-0.1.0.0... +Warning: The package has an extraneous version range for a dependency on an internal library: build-depends-extra-version >=0.0.0.1. This version range includes the current package but isn't needed as the current package's library will always be used. +# Setup sdist +Distribution quality errors: +The package has an extraneous version range for a dependency on an internal library: build-depends-extra-version >=0.0.0.1. This version range includes the current package but isn't needed as the current package's library will always be used. +Distribution quality warnings: +No 'maintainer' field. +No 'description' field. +A 'license-file' is not specified. +Note: the public hackage server would reject this package. +Building source dist for build-depends-extra-version-0.1.0.0... +Preprocessing library for build-depends-extra-version-0.1.0.0.. +Preprocessing executable 'bar' for build-depends-extra-version-0.1.0.0.. +Source tarball created: setup.cabal.dist/work/dist/build-depends-extra-version-0.1.0.0.tar.gz diff --git a/cabal/cabal-testsuite/PackageTests/InternalVersions/BuildDependsExtra/setup.out b/cabal/cabal-testsuite/PackageTests/InternalVersions/BuildDependsExtra/setup.out --- a/cabal/cabal-testsuite/PackageTests/InternalVersions/BuildDependsExtra/setup.out +++ b/cabal/cabal-testsuite/PackageTests/InternalVersions/BuildDependsExtra/setup.out @@ -1,2 +1,15 @@ # Setup configure Configuring build-depends-extra-version-0.1.0.0... +Warning: The package has an extraneous version range for a dependency on an internal library: build-depends-extra-version >=0.0.0.1. This version range includes the current package but isn't needed as the current package's library will always be used. +# Setup sdist +Distribution quality errors: +The package has an extraneous version range for a dependency on an internal library: build-depends-extra-version >=0.0.0.1. This version range includes the current package but isn't needed as the current package's library will always be used. +Distribution quality warnings: +No 'maintainer' field. +No 'description' field. +A 'license-file' is not specified. +Note: the public hackage server would reject this package. +Building source dist for build-depends-extra-version-0.1.0.0... +Preprocessing library for build-depends-extra-version-0.1.0.0.. +Preprocessing executable 'bar' for build-depends-extra-version-0.1.0.0.. +Source tarball created: setup.dist/work/dist/build-depends-extra-version-0.1.0.0.tar.gz diff --git a/cabal/cabal-testsuite/PackageTests/InternalVersions/BuildDependsExtra/setup.test.hs b/cabal/cabal-testsuite/PackageTests/InternalVersions/BuildDependsExtra/setup.test.hs --- a/cabal/cabal-testsuite/PackageTests/InternalVersions/BuildDependsExtra/setup.test.hs +++ b/cabal/cabal-testsuite/PackageTests/InternalVersions/BuildDependsExtra/setup.test.hs @@ -2,7 +2,5 @@ -- Test unneed version bound on internal build-tools deps main = setupAndCabalTest $ do setup' "configure" [] - -- Hack alert: had to squelch this warning because of #5119. --- assertOutputContains "extraneous version range" --- =<< setup' "sdist" [] - return () + assertOutputContains "extraneous version range" + =<< setup' "sdist" [] diff --git a/cabal/cabal-testsuite/PackageTests/MultipleLibraries/cabal.out b/cabal/cabal-testsuite/PackageTests/MultipleLibraries/cabal.out new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/MultipleLibraries/cabal.out @@ -0,0 +1,12 @@ +# cabal v2-build +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - d-0.1.0.0 (lib:privatelib) (first run) + - p-0.1.0.0 (lib) (first run) +Configuring library 'privatelib' for d-0.1.0.0.. +Preprocessing library 'privatelib' for d-0.1.0.0.. +Building library 'privatelib' for d-0.1.0.0.. +Configuring library for p-0.1.0.0.. +cabal: Encountered missing or private dependencies: + d : {privatelib} ==0.1.0.0 diff --git a/cabal/cabal-testsuite/PackageTests/MultipleLibraries/cabal.project b/cabal/cabal-testsuite/PackageTests/MultipleLibraries/cabal.project new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/MultipleLibraries/cabal.project @@ -0,0 +1,4 @@ +packages: + d + p + diff --git a/cabal/cabal-testsuite/PackageTests/MultipleLibraries/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/MultipleLibraries/cabal.test.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/MultipleLibraries/cabal.test.hs @@ -0,0 +1,4 @@ +import Test.Cabal.Prelude +main = cabalTest $ + void $ fails (cabal' "v2-build" ["p"]) + diff --git a/cabal/cabal-testsuite/PackageTests/MultipleLibraries/d/d.cabal b/cabal/cabal-testsuite/PackageTests/MultipleLibraries/d/d.cabal new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/MultipleLibraries/d/d.cabal @@ -0,0 +1,12 @@ +cabal-version: 3.0 +name: d +version: 0.1.0.0 + +-- See issue #6038 +library + default-language: Haskell2010 + +library privatelib + visibility: private + default-language: Haskell2010 + diff --git a/cabal/cabal-testsuite/PackageTests/MultipleLibraries/p/p.cabal b/cabal/cabal-testsuite/PackageTests/MultipleLibraries/p/p.cabal new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/MultipleLibraries/p/p.cabal @@ -0,0 +1,8 @@ +cabal-version: 3.0 +name: p +version: 0.1.0.0 + +library + build-depends: d:privatelib + default-language: Haskell2010 + diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdBench/MultipleBenchmarks/cabal.out b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdBench/MultipleBenchmarks/cabal.out --- a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdBench/MultipleBenchmarks/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdBench/MultipleBenchmarks/cabal.out @@ -1,4 +1,4 @@ -# cabal new-bench +# cabal v2-bench Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: @@ -9,7 +9,7 @@ Running 1 benchmarks... Benchmark foo: RUNNING... Benchmark foo: FINISH -# cabal new-bench +# cabal v2-bench Build profile: -w ghc- -O1 In order, the following will be built: - MultipleBenchmarks-1.0 (bench:bar) (first run) diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdBench/MultipleBenchmarks/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdBench/MultipleBenchmarks/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdBench/MultipleBenchmarks/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdBench/MultipleBenchmarks/cabal.test.hs @@ -1,10 +1,10 @@ import Test.Cabal.Prelude main = cabalTest $ do - res1 <- cabal' "new-bench" ["foo"] + res1 <- cabal' "v2-bench" ["foo"] assertOutputContains "Hello Foo" res1 assertOutputDoesNotContain "Hello Bar" res1 - res2 <- cabal' "new-bench" ["all"] + res2 <- cabal' "v2-bench" ["all"] assertOutputContains "Hello Foo" res2 assertOutputContains "Hello Bar" res2 diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdExec/GhcInvocation/cabal.out b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdExec/GhcInvocation/cabal.out --- a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdExec/GhcInvocation/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdExec/GhcInvocation/cabal.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: @@ -6,4 +6,4 @@ Configuring library for inplace-dep-1.0.. Preprocessing library for inplace-dep-1.0.. Building library for inplace-dep-1.0.. -# cabal new-exec +# cabal v2-exec diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdExec/GhcInvocation/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdExec/GhcInvocation/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdExec/GhcInvocation/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdExec/GhcInvocation/cabal.test.hs @@ -1,14 +1,14 @@ import Test.Cabal.Prelude import System.Directory-- (getDirectoryContents, removeFile) main = cabalTest $ do - cabal "new-build" ["inplace-dep"] + cabal "v2-build" ["inplace-dep"] env <- getTestEnv liftIO $ removeEnvFiles $ testSourceDir env -- we don't want existing env files to interfere -- Drop the compiled executable into the temporary directory, to avoid cluttering the tree. If compilation succeeds, we've tested what we need to! tmpdir <- fmap testTmpDir getTestEnv let dest = tmpdir "a.out" - cabal "new-exec" ["ghc", "--", "Main.hs", "-o", dest] - -- TODO external (store) deps, once new-install is working + cabal "v2-exec" ["ghc", "--", "Main.hs", "-o", dest] + -- TODO external (store) deps, once v2-install is working -- copy-pasted from D.C.CmdClean. removeEnvFiles :: FilePath -> IO () diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdExec/RunExe/cabal.out b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdExec/RunExe/cabal.out --- a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdExec/RunExe/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdExec/RunExe/cabal.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: @@ -6,4 +6,4 @@ Configuring executable 'foo' for RunExe-1.0.. Preprocessing executable 'foo' for RunExe-1.0.. Building executable 'foo' for RunExe-1.0.. -# cabal new-exec +# cabal v2-exec diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdExec/RunExe/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdExec/RunExe/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdExec/RunExe/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdExec/RunExe/cabal.test.hs @@ -1,5 +1,5 @@ import Test.Cabal.Prelude main = cabalTest $ do - cabal "new-build" [] - cabal' "new-exec" ["foo"] >>= assertOutputContains "Hello World" + cabal "v2-build" [] + cabal' "v2-exec" ["foo"] >>= assertOutputContains "Hello World" diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Datafiles/cabal.out b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Datafiles/cabal.out --- a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Datafiles/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Datafiles/cabal.out @@ -1,4 +1,4 @@ -# cabal new-run +# cabal v2-run Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: @@ -6,7 +6,7 @@ Configuring executable 'foo' for foo-1.0.. Preprocessing executable 'foo' for foo-1.0.. Building executable 'foo' for foo-1.0.. -# cabal new-run +# cabal v2-run Build profile: -w ghc- -O1 In order, the following will be built: - foo-1.0 (lib) (first run) diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Datafiles/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Datafiles/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Datafiles/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Datafiles/cabal.test.hs @@ -1,5 +1,5 @@ import Test.Cabal.Prelude main = cabalTest $ do - cabal' "new-run" ["foo"] >>= assertOutputContains "Hello World" - cabal' "new-run" ["bar"] >>= assertOutputContains "Hello World" + cabal' "v2-run" ["foo"] >>= assertOutputContains "Hello World" + cabal' "v2-run" ["bar"] >>= assertOutputContains "Hello World" diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ExeAndLib/cabal.out b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ExeAndLib/cabal.out --- a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ExeAndLib/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ExeAndLib/cabal.out @@ -1,4 +1,4 @@ -# cabal new-run +# cabal v2-run Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: @@ -6,5 +6,5 @@ Configuring executable 'foo' for ExeAndLib-1.0.. Preprocessing executable 'foo' for ExeAndLib-1.0.. Building executable 'foo' for ExeAndLib-1.0.. -# cabal new-run +# cabal v2-run cabal: The run command is for running executables, but the target 'ExeAndLib' refers to the library ExeAndLib from the package ExeAndLib-1.0. diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ExeAndLib/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ExeAndLib/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ExeAndLib/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ExeAndLib/cabal.test.hs @@ -2,7 +2,7 @@ import Control.Monad ( (>=>) ) main = cabalTest $ do -- the exe - cabal' "new-run" ["foo"] >>= assertOutputContains "Hello World" + cabal' "v2-run" ["foo"] >>= assertOutputContains "Hello World" -- the lib - fails (cabal' "new-run" ["ExeAndLib"]) >>= assertOutputDoesNotContain "Hello World" + fails (cabal' "v2-run" ["ExeAndLib"]) >>= assertOutputDoesNotContain "Hello World" diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ExitCodePropagation/cabal.out b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ExitCodePropagation/cabal.out --- a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ExitCodePropagation/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ExitCodePropagation/cabal.out @@ -1,4 +1,4 @@ -# cabal new-run +# cabal v2-run Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ExitCodePropagation/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ExitCodePropagation/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ExitCodePropagation/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ExitCodePropagation/cabal.test.hs @@ -2,5 +2,5 @@ import Control.Monad ( (>=>) ) import System.Exit (ExitCode(ExitFailure)) main = cabalTest $ - fails (cabal' "new-run" ["foo"]) >>= assertExitCode (ExitFailure 42) + fails (cabal' "v2-run" ["foo"]) >>= assertExitCode (ExitFailure 42) diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/MultipleExes/cabal.out b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/MultipleExes/cabal.out --- a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/MultipleExes/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/MultipleExes/cabal.out @@ -1,4 +1,4 @@ -# cabal new-run +# cabal v2-run Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: @@ -6,16 +6,16 @@ Configuring executable 'foo' for MultipleExes-1.0.. Preprocessing executable 'foo' for MultipleExes-1.0.. Building executable 'foo' for MultipleExes-1.0.. -# cabal new-run +# cabal v2-run Build profile: -w ghc- -O1 In order, the following will be built: - MultipleExes-1.0 (exe:bar) (first run) Configuring executable 'bar' for MultipleExes-1.0.. Preprocessing executable 'bar' for MultipleExes-1.0.. Building executable 'bar' for MultipleExes-1.0.. -# cabal new-run +# cabal v2-run Up to date -# cabal new-run +# cabal v2-run cabal: The run command is for running a single executable at once. The target '' refers to the package MultipleExes-1.0 which includes the executable 'foo' and the executable 'bar'. -# cabal new-run +# cabal v2-run cabal: The run command is for running a single executable at once. The target 'MultipleExes' refers to the package MultipleExes-1.0 which includes the executable 'foo' and the executable 'bar'. diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/MultipleExes/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/MultipleExes/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/MultipleExes/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/MultipleExes/cabal.test.hs @@ -2,10 +2,10 @@ main = cabalTest $ do -- some ways of explicitly specifying an exe - cabal' "new-run" ["foo"] >>= assertOutputContains "Hello Foo" - cabal' "new-run" ["exe:bar"] >>= assertOutputContains "Hello Bar" - cabal' "new-run" ["MultipleExes:foo"] >>= assertOutputContains "Hello Foo" + cabal' "v2-run" ["foo"] >>= assertOutputContains "Hello Foo" + cabal' "v2-run" ["exe:bar"] >>= assertOutputContains "Hello Bar" + cabal' "v2-run" ["MultipleExes:foo"] >>= assertOutputContains "Hello Foo" -- there are multiple exes in ... - fails (cabal' "new-run" []) >>= assertOutputDoesNotContain "Hello" -- in the same project - fails (cabal' "new-run" ["MultipleExes"]) >>= assertOutputDoesNotContain "Hello" -- in the same package + fails (cabal' "v2-run" []) >>= assertOutputDoesNotContain "Hello" -- in the same project + fails (cabal' "v2-run" ["MultipleExes"]) >>= assertOutputDoesNotContain "Hello" -- in the same package diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/MultiplePackages/cabal.out b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/MultiplePackages/cabal.out --- a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/MultiplePackages/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/MultiplePackages/cabal.out @@ -1,4 +1,4 @@ -# cabal new-run +# cabal v2-run Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: @@ -6,32 +6,32 @@ Configuring executable 'bar-exe' for bar-1.0.. Preprocessing executable 'bar-exe' for bar-1.0.. Building executable 'bar-exe' for bar-1.0.. -# cabal new-run +# cabal v2-run Up to date -# cabal new-run +# cabal v2-run Build profile: -w ghc- -O1 In order, the following will be built: - foo-1.0 (exe:foo-exe) (first run) Configuring executable 'foo-exe' for foo-1.0.. Preprocessing executable 'foo-exe' for foo-1.0.. Building executable 'foo-exe' for foo-1.0.. -# cabal new-run +# cabal v2-run Build profile: -w ghc- -O1 In order, the following will be built: - bar-1.0 (exe:foo-exe) (first run) Configuring executable 'foo-exe' for bar-1.0.. Preprocessing executable 'foo-exe' for bar-1.0.. Building executable 'foo-exe' for bar-1.0.. -# cabal new-run +# cabal v2-run cabal: No targets given and there is no package in the current directory. Use the target 'all' for all packages in the project or specify packages or components by name or location. See 'cabal build --help' for more details on target options. -# cabal new-run +# cabal v2-run cabal: The run command is for running a single executable at once. The target 'bar' refers to the package bar-1.0 which includes the executable 'foo-exe' and the executable 'bar-exe'. -# cabal new-run +# cabal v2-run cabal: Ambiguous target 'foo-exe'. It could be: bar:foo-exe (component) foo:foo-exe (component) -# cabal new-run +# cabal v2-run cabal: Unknown target 'foo:bar-exe'. The package foo has no component 'bar-exe'. diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/MultiplePackages/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/MultiplePackages/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/MultiplePackages/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/MultiplePackages/cabal.test.hs @@ -2,14 +2,14 @@ main = cabalTest $ do -- some ways of specifying an exe without ambiguities - cabal' "new-run" ["bar-exe"] >>= assertOutputContains "Hello bar:bar-exe" - cabal' "new-run" ["bar:bar-exe"] >>= assertOutputContains "Hello bar:bar-exe" - cabal' "new-run" ["foo:foo-exe"] >>= assertOutputContains "Hello foo:foo-exe" - cabal' "new-run" ["bar:foo-exe"] >>= assertOutputContains "Hello bar:foo-exe" + cabal' "v2-run" ["bar-exe"] >>= assertOutputContains "Hello bar:bar-exe" + cabal' "v2-run" ["bar:bar-exe"] >>= assertOutputContains "Hello bar:bar-exe" + cabal' "v2-run" ["foo:foo-exe"] >>= assertOutputContains "Hello foo:foo-exe" + cabal' "v2-run" ["bar:foo-exe"] >>= assertOutputContains "Hello bar:foo-exe" -- there are multiple exes ... - fails (cabal' "new-run" []) >>= assertOutputDoesNotContain "Hello" -- in the same project - fails (cabal' "new-run" ["bar"]) >>= assertOutputDoesNotContain "Hello" -- in the same package - fails (cabal' "new-run" ["foo-exe"]) >>= assertOutputDoesNotContain "Hello" -- with the same name + fails (cabal' "v2-run" []) >>= assertOutputDoesNotContain "Hello" -- in the same project + fails (cabal' "v2-run" ["bar"]) >>= assertOutputDoesNotContain "Hello" -- in the same package + fails (cabal' "v2-run" ["foo-exe"]) >>= assertOutputDoesNotContain "Hello" -- with the same name -- invalid exes - fails (cabal' "new-run" ["foo:bar-exe"]) >>= assertOutputDoesNotContain "Hello" -- does not exist + fails (cabal' "v2-run" ["foo:bar-exe"]) >>= assertOutputDoesNotContain "Hello" -- does not exist diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.out b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.out new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.out @@ -0,0 +1,8 @@ +# cabal v2-run +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - fake-package-0 (exe:script) (first run) +Configuring executable 'script' for fake-package-0.. +Preprocessing executable 'script' for fake-package-0.. +Building executable 'script' for fake-package-0.. diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.project b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.project new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.project @@ -0,0 +1,1 @@ +packages: . diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.test.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +main = cabalTest $ do + res <- cabal' "v2-run" ["script.hs"] + assertOutputContains "Hello World" res diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/script.cabal b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/script.cabal new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/script.cabal @@ -0,0 +1,4 @@ +name: script +version: 1.0 +build-type: Simple +cabal-version: >= 1.10 diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/script.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/script.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/script.hs @@ -0,0 +1,11 @@ +#! /usr/bin/env cabal +{- cabal: +build-depends: base >= 4.3 && <5 +-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ScopedTypeVariables #-} + +import Prelude + +main :: IO () +main = putStrLn "Hello World" diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.out b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.out new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.out @@ -0,0 +1,8 @@ +# cabal v2-run +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - fake-package-0 (exe:script) (first run) +Configuring executable 'script' for fake-package-0.. +Preprocessing executable 'script' for fake-package-0.. +Building executable 'script' for fake-package-0.. diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.project b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.project new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.project @@ -0,0 +1,1 @@ +packages: . diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.test.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +main = cabalTest $ do + res <- cabal' "v2-run" ["script.lhs"] + assertOutputContains "Hello World" res diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/script.cabal b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/script.cabal new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/script.cabal @@ -0,0 +1,4 @@ +name: script +version: 1.0 +build-type: Simple +cabal-version: >= 1.10 diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/script.lhs b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/script.lhs new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/script.lhs @@ -0,0 +1,18 @@ +\iffalse +{- cabal: +build-depends: base >= 4.3 && <5 +-} +\fi +\documentclass{article} +\begin{document} +\begin{code} + +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ScopedTypeVariables #-} + +import Prelude + +main :: IO () +main = putStrLn "Hello World" +\end{code} +\end{document} diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Single/cabal.out b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Single/cabal.out --- a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Single/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Single/cabal.out @@ -1,4 +1,4 @@ -# cabal new-run +# cabal v2-run Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: @@ -6,14 +6,14 @@ Configuring executable 'foo' for Single-1.0.. Preprocessing executable 'foo' for Single-1.0.. Building executable 'foo' for Single-1.0.. -# cabal new-run +# cabal v2-run Up to date -# cabal new-run +# cabal v2-run Up to date -# cabal new-run +# cabal v2-run Up to date -# cabal new-run +# cabal v2-run Up to date -# cabal new-run +# cabal v2-run cabal: Cannot run the package bar, it is not in this project (either directly or indirectly). If you want to add it to the project then edit the cabal.project file. diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Single/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Single/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Single/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CmdRun/Single/cabal.test.hs @@ -3,12 +3,12 @@ main = cabalTest $ do -- Some different ways of calling an executable that should all work -- on a single-exe single-package project - mapM_ (cabal' "new-run" >=> assertOutputContains "Hello World") + mapM_ (cabal' "v2-run" >=> assertOutputContains "Hello World") [ ["foo"] , ["Single"] , [] , ["Single:foo"] , ["exe:foo"] ] -- non-existent exe - fails (cabal' "new-run" ["bar"]) >>= assertOutputDoesNotContain "Hello World" + fails (cabal' "v2-run" ["bar"]) >>= assertOutputDoesNotContain "Hello World" diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CustomSetup/LocalPackageWithCustomSetup/build-local-package-with-custom-setup.test.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/CustomSetup/LocalPackageWithCustomSetup/build-local-package-with-custom-setup.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewBuild/CustomSetup/LocalPackageWithCustomSetup/build-local-package-with-custom-setup.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CustomSetup/LocalPackageWithCustomSetup/build-local-package-with-custom-setup.test.hs @@ -6,7 +6,7 @@ cabalTest $ do skipUnless =<< hasNewBuildCompatBootCabal withRepo "repo" $ do - r <- recordMode DoNotRecord $ cabalG' ["--store-dir=" ++ storeDir] "new-build" ["pkg"] + r <- recordMode DoNotRecord $ cabalG' ["--store-dir=" ++ storeDir] "v2-build" ["pkg"] -- pkg's setup script should print out a message that it imported from -- setup-dep: assertOutputContains "pkg Setup.hs: setup-dep-2.0" r diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/CustomSetup/RemotePackageWithCustomSetup/build-package-from-repo-with-custom-setup.test.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/CustomSetup/RemotePackageWithCustomSetup/build-package-from-repo-with-custom-setup.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewBuild/CustomSetup/RemotePackageWithCustomSetup/build-package-from-repo-with-custom-setup.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/CustomSetup/RemotePackageWithCustomSetup/build-package-from-repo-with-custom-setup.test.hs @@ -10,7 +10,7 @@ skipUnless =<< hasNewBuildCompatBootCabal withRepo "repo" $ do - r1 <- recordMode DoNotRecord $ cabalG' ["--store-dir=" ++ storeDir] "new-build" ["pkg:my-exe"] + r1 <- recordMode DoNotRecord $ cabalG' ["--store-dir=" ++ storeDir] "v2-build" ["pkg:my-exe"] -- remote-pkg's setup script should print out a message that it imported from -- remote-setup-dep: assertOutputContains "remote-pkg Setup.hs: remote-setup-dep-3.0" r1 diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/MonitorCabalFiles/cabal.out b/cabal/cabal-testsuite/PackageTests/NewBuild/MonitorCabalFiles/cabal.out --- a/cabal/cabal-testsuite/PackageTests/NewBuild/MonitorCabalFiles/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/MonitorCabalFiles/cabal.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: @@ -6,7 +6,7 @@ Configuring executable 'q' for q-0.1.0.0.. Preprocessing executable 'q' for q-0.1.0.0.. Building executable 'q' for q-0.1.0.0.. -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/MonitorCabalFiles/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/MonitorCabalFiles/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewBuild/MonitorCabalFiles/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/MonitorCabalFiles/cabal.test.hs @@ -2,7 +2,7 @@ main = cabalTest $ do withSourceCopy . withDelay $ do copySourceFileTo "q/q-broken.cabal.in" "q/q.cabal" - fails $ cabal "new-build" ["q"] + fails $ cabal "v2-build" ["q"] delay copySourceFileTo "q/q-fixed.cabal.in" "q/q.cabal" - cabal "new-build" ["q"] + cabal "v2-build" ["q"] diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/T3460/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/T3460/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewBuild/T3460/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/T3460/cabal.test.hs @@ -2,4 +2,4 @@ main = cabalTest $ do -- Parallel flag means output of this test is nondeterministic recordMode DoNotRecord $ - cabal "new-build" ["-j", "T3460"] + cabal "v2-build" ["-j", "T3460"] diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/T3827/cabal.out b/cabal/cabal-testsuite/PackageTests/NewBuild/T3827/cabal.out --- a/cabal/cabal-testsuite/PackageTests/NewBuild/T3827/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/T3827/cabal.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/T3827/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/T3827/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewBuild/T3827/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/T3827/cabal.test.hs @@ -1,3 +1,3 @@ import Test.Cabal.Prelude main = cabalTest $ do - cabal "new-build" ["exe:q"] + cabal "v2-build" ["exe:q"] diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/T3978/cabal.out b/cabal/cabal-testsuite/PackageTests/NewBuild/T3978/cabal.out --- a/cabal/cabal-testsuite/PackageTests/NewBuild/T3978/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/T3978/cabal.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... cabal: Could not resolve dependencies: [__0] trying: p-1.0 (user goal) diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/T3978/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/T3978/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewBuild/T3978/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/T3978/cabal.test.hs @@ -1,3 +1,3 @@ import Test.Cabal.Prelude main = cabalTest $ do - fails $ cabal "new-build" ["q"] + fails $ cabal "v2-build" ["q"] diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/T4017/cabal.out b/cabal/cabal-testsuite/PackageTests/NewBuild/T4017/cabal.out --- a/cabal/cabal-testsuite/PackageTests/NewBuild/T4017/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/T4017/cabal.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/T4017/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/T4017/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewBuild/T4017/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/T4017/cabal.test.hs @@ -1,3 +1,3 @@ import Test.Cabal.Prelude main = cabalTest $ do - cabal "new-build" ["q"] + cabal "v2-build" ["q"] diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/T4288/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/T4288/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewBuild/T4288/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/T4288/cabal.test.hs @@ -8,7 +8,7 @@ -- on, even though Cabal is only a transitive dependency. main = cabalTest $ do skipUnless =<< hasNewBuildCompatBootCabal - r <- recordMode DoNotRecord $ cabal' "new-build" ["T4288"] + r <- recordMode DoNotRecord $ cabal' "v2-build" ["T4288"] assertOutputContains "This is setup-helper-1.0." r assertOutputContains ("In order, the following will be built: " diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/T4375/cabal.out b/cabal/cabal-testsuite/PackageTests/NewBuild/T4375/cabal.out --- a/cabal/cabal-testsuite/PackageTests/NewBuild/T4375/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/T4375/cabal.out @@ -1,6 +1,6 @@ # cabal v1-update Downloading the latest package list from test-local-repo -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/T4375/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/T4375/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewBuild/T4375/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/T4375/cabal.test.hs @@ -9,4 +9,4 @@ -- we had the full Hackage index, we'd try it.) skipUnless =<< ghcVersionIs (< mkVersion [8,1]) withRepo "repo" $ do - cabalG ["--store-dir=" ++ storeDir] "new-build" ["a"] + cabalG ["--store-dir=" ++ storeDir] "v2-build" ["a"] diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/T4405/cabal.out b/cabal/cabal-testsuite/PackageTests/NewBuild/T4405/cabal.out --- a/cabal/cabal-testsuite/PackageTests/NewBuild/T4405/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/T4405/cabal.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: @@ -10,5 +10,5 @@ Configuring library for q-1.0.. Preprocessing library for q-1.0.. Building library for q-1.0.. -# cabal new-build +# cabal v2-build Up to date diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/T4405/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/T4405/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewBuild/T4405/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/T4405/cabal.test.hs @@ -1,4 +1,4 @@ import Test.Cabal.Prelude main = cabalTest $ do - cabal "new-build" ["q"] - cabal "new-build" ["q"] + cabal "v2-build" ["q"] + cabal "v2-build" ["q"] diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/T4450/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/T4450/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewBuild/T4450/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/T4450/cabal.test.hs @@ -3,5 +3,5 @@ skipUnless =<< hasNewBuildCompatBootCabal -- Custom Setups inconsistently report output depending -- on your boot GHC. - recordMode DoNotRecord $ cabal "new-build" ["foo"] - recordMode DoNotRecord $ cabal "new-build" ["dep"] + recordMode DoNotRecord $ cabal "v2-build" ["foo"] + recordMode DoNotRecord $ cabal "v2-build" ["dep"] diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/T4477/cabal.out b/cabal/cabal-testsuite/PackageTests/NewBuild/T4477/cabal.out --- a/cabal/cabal-testsuite/PackageTests/NewBuild/T4477/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/T4477/cabal.out @@ -1,4 +1,4 @@ -# cabal new-run +# cabal v2-run Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/T4477/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/T4477/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewBuild/T4477/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/T4477/cabal.test.hs @@ -1,3 +1,3 @@ import Test.Cabal.Prelude main = cabalTest $ do - cabal' "new-run" ["foo"] >>= assertOutputContains "Hello World" + cabal' "v2-run" ["foo"] >>= assertOutputContains "Hello World" diff --git a/cabal/cabal-testsuite/PackageTests/NewBuild/T5164/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewBuild/T5164/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewBuild/T5164/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewBuild/T5164/cabal.test.hs @@ -1,4 +1,4 @@ import Test.Cabal.Prelude main = cabalTest $ do - r1 <- recordMode DoNotRecord $ cabal' "new-build" ["all"] + r1 <- recordMode DoNotRecord $ cabal' "v2-build" ["all"] assertOutputContains "Example data file" r1 diff --git a/cabal/cabal-testsuite/PackageTests/NewConfigure/LocalConfigOverwrite/cabal.out b/cabal/cabal-testsuite/PackageTests/NewConfigure/LocalConfigOverwrite/cabal.out --- a/cabal/cabal-testsuite/PackageTests/NewConfigure/LocalConfigOverwrite/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/NewConfigure/LocalConfigOverwrite/cabal.out @@ -1,4 +1,4 @@ -# cabal new-configure +# cabal v2-configure 'cabal.project.local' file already exists. Now overwriting it. Resolving dependencies... Build profile: -w ghc- -O1 diff --git a/cabal/cabal-testsuite/PackageTests/NewConfigure/LocalConfigOverwrite/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewConfigure/LocalConfigOverwrite/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewConfigure/LocalConfigOverwrite/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewConfigure/LocalConfigOverwrite/cabal.test.hs @@ -2,5 +2,5 @@ main = cabalTest $ withSourceCopy $ do - r <- cabal' "new-configure" [] + r <- cabal' "v2-configure" [] assertOutputContains "Now overwriting it" r diff --git a/cabal/cabal-testsuite/PackageTests/NewFreeze/BuildTools/new_freeze.out b/cabal/cabal-testsuite/PackageTests/NewFreeze/BuildTools/new_freeze.out --- a/cabal/cabal-testsuite/PackageTests/NewFreeze/BuildTools/new_freeze.out +++ b/cabal/cabal-testsuite/PackageTests/NewFreeze/BuildTools/new_freeze.out @@ -1,6 +1,6 @@ # cabal v1-update Downloading the latest package list from test-local-repo -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following would be built: @@ -8,10 +8,10 @@ - my-build-tool-dep-3.0 (exe:my-build-tool) (requires download & build) - my-library-dep-1.0 (lib) (requires download & build) - my-local-package-1.0 (lib) (first run) -# cabal new-freeze +# cabal v2-freeze Resolving dependencies... Wrote freeze file: /new_freeze.dist/source/cabal.project.freeze -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following would be built: diff --git a/cabal/cabal-testsuite/PackageTests/NewFreeze/BuildTools/new_freeze.test.hs b/cabal/cabal-testsuite/PackageTests/NewFreeze/BuildTools/new_freeze.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewFreeze/BuildTools/new_freeze.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewFreeze/BuildTools/new_freeze.test.hs @@ -2,7 +2,7 @@ import Control.Monad.IO.Class import System.Directory --- Test that 'cabal new-freeze' works with multiple versions of a build tool +-- Test that 'cabal v2-freeze' works with multiple versions of a build tool -- dependency. -- -- The repository contains versions 1.0, 2.0, and 3.0 of the build tool. There @@ -11,10 +11,10 @@ -- of the build tool when there are no constraints. main = cabalTest $ withSourceCopy $ do withRepo "repo" $ do - cabal' "new-build" ["--dry-run"] >>= assertUsesLatestBuildTool + cabal' "v2-build" ["--dry-run"] >>= assertUsesLatestBuildTool -- Force the project to use versions 1.0 and 2.0 of the build tool. - cabal "new-freeze" ["--constraint=any.my-build-tool-dep < 3"] + cabal "v2-freeze" ["--constraint=any.my-build-tool-dep < 3"] cwd <- fmap testCurrentDir getTestEnv let freezeFile = cwd "cabal.project.freeze" @@ -33,7 +33,7 @@ -- cabal should be able to find an install plan that fits the constraints -- from the freeze file. - cabal' "new-build" ["--dry-run"] >>= assertDoesNotUseLatestBuildTool + cabal' "v2-build" ["--dry-run"] >>= assertDoesNotUseLatestBuildTool where assertUsesLatestBuildTool out = do assertOutputContains "my-build-tool-dep-3.0 (exe:my-build-tool)" out diff --git a/cabal/cabal-testsuite/PackageTests/NewFreeze/Flags/new_freeze.out b/cabal/cabal-testsuite/PackageTests/NewFreeze/Flags/new_freeze.out --- a/cabal/cabal-testsuite/PackageTests/NewFreeze/Flags/new_freeze.out +++ b/cabal/cabal-testsuite/PackageTests/NewFreeze/Flags/new_freeze.out @@ -1,16 +1,16 @@ # cabal v1-update Downloading the latest package list from test-local-repo -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following would be built: - true-dep-1.0 (lib) (requires download & build) - my-library-dep-1.0 (lib) (requires download & build) - my-local-package-1.0 (lib) (first run) -# cabal new-freeze +# cabal v2-freeze Resolving dependencies... Wrote freeze file: /new_freeze.dist/source/cabal.project.freeze -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following would be built: diff --git a/cabal/cabal-testsuite/PackageTests/NewFreeze/Flags/new_freeze.test.hs b/cabal/cabal-testsuite/PackageTests/NewFreeze/Flags/new_freeze.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewFreeze/Flags/new_freeze.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewFreeze/Flags/new_freeze.test.hs @@ -3,14 +3,14 @@ import Data.Char import System.Directory --- Test that 'cabal new-freeze' freezes flag choices. my-local-package depends +-- Test that 'cabal v2-freeze' freezes flag choices. my-local-package depends -- on my-library-dep. my-library-dep has a flag, my-flag, which defaults to -- true. main = cabalTest $ withSourceCopy $ withRepo "repo" $ do - cabal' "new-build" ["--dry-run"] >>= assertDependencyFlagChoice True + cabal' "v2-build" ["--dry-run"] >>= assertDependencyFlagChoice True - cabal "new-freeze" ["--constraint=my-library-dep -my-flag"] + cabal "v2-freeze" ["--constraint=my-library-dep -my-flag"] cwd <- fmap testCurrentDir getTestEnv let freezeFile = cwd "cabal.project.freeze" @@ -23,7 +23,7 @@ -- cabal should be able to find an install plan that fits the constraints -- from the freeze file. - cabal' "new-build" ["--dry-run"] >>= assertDependencyFlagChoice False + cabal' "v2-build" ["--dry-run"] >>= assertDependencyFlagChoice False where -- my-library-dep's flag controls whether it depends on true-dep or -- false-dep, so this function uses the dependency to infer the flag choice. diff --git a/cabal/cabal-testsuite/PackageTests/NewFreeze/FreezeFile/new_freeze.out b/cabal/cabal-testsuite/PackageTests/NewFreeze/FreezeFile/new_freeze.out --- a/cabal/cabal-testsuite/PackageTests/NewFreeze/FreezeFile/new_freeze.out +++ b/cabal/cabal-testsuite/PackageTests/NewFreeze/FreezeFile/new_freeze.out @@ -1,15 +1,15 @@ # cabal v1-update Downloading the latest package list from test-local-repo -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following would be built: - my-library-dep-2.0 (lib) (requires download & build) - my-local-package-1.0 (exe:my-exe) (first run) -# cabal new-freeze +# cabal v2-freeze Resolving dependencies... Wrote freeze file: /new_freeze.dist/source/cabal.project.freeze -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: @@ -22,13 +22,13 @@ Configuring executable 'my-exe' for my-local-package-1.0.. Preprocessing executable 'my-exe' for my-local-package-1.0.. Building executable 'my-exe' for my-local-package-1.0.. -# cabal new-freeze +# cabal v2-freeze Wrote freeze file: /new_freeze.dist/source/cabal.project.freeze -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following would be built: - my-library-dep-2.0 (lib) (requires download & build) - my-local-package-1.0 (exe:my-exe) (configuration changed) -# cabal new-freeze +# cabal v2-freeze Wrote freeze file: /new_freeze.dist/source/cabal.project.freeze diff --git a/cabal/cabal-testsuite/PackageTests/NewFreeze/FreezeFile/new_freeze.test.hs b/cabal/cabal-testsuite/PackageTests/NewFreeze/FreezeFile/new_freeze.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewFreeze/FreezeFile/new_freeze.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewFreeze/FreezeFile/new_freeze.test.hs @@ -3,7 +3,7 @@ import Data.Char import System.Directory --- Test for 'cabal new-freeze' with only a single library dependency. +-- Test for 'cabal v2-freeze' with only a single library dependency. -- my-local-package depends on my-library-dep, which has versions 1.0 and 2.0. main = withShorterPathForNewBuildStore $ \storeDir -> cabalTest $ withSourceCopy $ @@ -13,11 +13,11 @@ shouldNotExist freezeFile - -- new-build should choose the latest version for the dependency. - cabalG' ["--store-dir=" ++ storeDir] "new-build" ["--dry-run"] >>= assertUsesLatestDependency + -- v2-build should choose the latest version for the dependency. + cabalG' ["--store-dir=" ++ storeDir] "v2-build" ["--dry-run"] >>= assertUsesLatestDependency -- Freeze a dependency on the older version. - cabalG ["--store-dir=" ++ storeDir] "new-freeze" ["--constraint=my-library-dep==1.0"] + cabalG ["--store-dir=" ++ storeDir] "v2-freeze" ["--constraint=my-library-dep==1.0"] -- The file should constrain the dependency, but not the local package. shouldExist freezeFile @@ -26,21 +26,21 @@ -- cabal should be able to build the package using the constraint from the -- freeze file. - cabalG' ["--store-dir=" ++ storeDir] "new-build" [] >>= assertDoesNotUseLatestDependency + cabalG' ["--store-dir=" ++ storeDir] "v2-build" [] >>= assertDoesNotUseLatestDependency - -- Re-running new-freeze should not change the constraints, because cabal + -- Re-running v2-freeze should not change the constraints, because cabal -- should use the existing freeze file when choosing the new install plan. - cabalG ["--store-dir=" ++ storeDir] "new-freeze" [] + cabalG ["--store-dir=" ++ storeDir] "v2-freeze" [] assertFileDoesContain freezeFile "any.my-library-dep ==1.0" -- cabal should choose the latest version again after the freeze file is -- removed. liftIO $ removeFile freezeFile - cabalG' ["--store-dir=" ++ storeDir] "new-build" ["--dry-run"] >>= assertUsesLatestDependency + cabalG' ["--store-dir=" ++ storeDir] "v2-build" ["--dry-run"] >>= assertUsesLatestDependency - -- Re-running new-freeze with no constraints or freeze file should constrain + -- Re-running v2-freeze with no constraints or freeze file should constrain -- the dependency to the latest version. - cabalG ["--store-dir=" ++ storeDir] "new-freeze" [] + cabalG ["--store-dir=" ++ storeDir] "v2-freeze" [] assertFileDoesContain freezeFile "any.my-library-dep ==2.0" assertFileDoesNotContain freezeFile "my-local-package" where diff --git a/cabal/cabal-testsuite/PackageTests/NewHaddock/Fails/Example.hs b/cabal/cabal-testsuite/PackageTests/NewHaddock/Fails/Example.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/NewHaddock/Fails/Example.hs @@ -0,0 +1,6 @@ +module Example where + +import Prelude + +example :: Int +example = False diff --git a/cabal/cabal-testsuite/PackageTests/NewHaddock/Fails/cabal.out b/cabal/cabal-testsuite/PackageTests/NewHaddock/Fails/cabal.out new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/NewHaddock/Fails/cabal.out @@ -0,0 +1,15 @@ +# cabal v2-build +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - example-1.0 (lib) (first run) +Configuring library for example-1.0.. +Preprocessing library for example-1.0.. +Building library for example-1.0.. +# cabal v2-haddock +Build profile: -w ghc- -O1 +In order, the following will be built: + - example-1.0 (lib) (first run) +Preprocessing library for example-1.0.. +Running Haddock on library for example-1.0.. +cabal: Failed to build documentation for example-1.0-inplace. diff --git a/cabal/cabal-testsuite/PackageTests/NewHaddock/Fails/cabal.project b/cabal/cabal-testsuite/PackageTests/NewHaddock/Fails/cabal.project new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/NewHaddock/Fails/cabal.project @@ -0,0 +1,1 @@ +packages: . diff --git a/cabal/cabal-testsuite/PackageTests/NewHaddock/Fails/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewHaddock/Fails/cabal.test.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/NewHaddock/Fails/cabal.test.hs @@ -0,0 +1,6 @@ +import Test.Cabal.Prelude +import System.Exit (ExitCode (..)) + +main = cabalTest $ do + fails $ cabal "v2-build" ["example"] + fails $ cabal "v2-haddock" ["example"] diff --git a/cabal/cabal-testsuite/PackageTests/NewHaddock/Fails/example.cabal b/cabal/cabal-testsuite/PackageTests/NewHaddock/Fails/example.cabal new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/NewHaddock/Fails/example.cabal @@ -0,0 +1,9 @@ +name: example +version: 1.0 +build-type: Simple +cabal-version: >=1.10 + +library + default-language: Haskell2010 + build-depends: base + exposed-modules: Example diff --git a/cabal/cabal-testsuite/PackageTests/NewSdist/DeterministicTrivial/deterministic.out b/cabal/cabal-testsuite/PackageTests/NewSdist/DeterministicTrivial/deterministic.out --- a/cabal/cabal-testsuite/PackageTests/NewSdist/DeterministicTrivial/deterministic.out +++ b/cabal/cabal-testsuite/PackageTests/NewSdist/DeterministicTrivial/deterministic.out @@ -1,2 +1,2 @@ -# cabal new-sdist +# cabal v2-sdist Wrote tarball sdist to /dist-newstyle/sdist/deterministic-0.tar.gz diff --git a/cabal/cabal-testsuite/PackageTests/NewSdist/DeterministicTrivial/deterministic.test.hs b/cabal/cabal-testsuite/PackageTests/NewSdist/DeterministicTrivial/deterministic.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewSdist/DeterministicTrivial/deterministic.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewSdist/DeterministicTrivial/deterministic.test.hs @@ -6,7 +6,7 @@ ( () ) main = cabalTest $ do - cabal "new-sdist" ["deterministic"] + cabal "v2-sdist" ["deterministic"] env <- getTestEnv let dir = testCurrentDir env knownSdist = dir "deterministic-0.tar.gz" diff --git a/cabal/cabal-testsuite/PackageTests/NewSdist/Globbing/cabal.out b/cabal/cabal-testsuite/PackageTests/NewSdist/Globbing/cabal.out --- a/cabal/cabal-testsuite/PackageTests/NewSdist/Globbing/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/NewSdist/Globbing/cabal.out @@ -1,4 +1,4 @@ -# cabal new-sdist +# cabal v2-sdist a/Main.hs a/a.cabal a/doc/index.html diff --git a/cabal/cabal-testsuite/PackageTests/NewSdist/Globbing/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewSdist/Globbing/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewSdist/Globbing/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewSdist/Globbing/cabal.test.hs @@ -1,4 +1,4 @@ import Test.Cabal.Prelude main = cabalTest $ withSourceCopy $ do - cabal "new-sdist" ["a", "--list-only"] + cabal "v2-sdist" ["a", "--list-only"] diff --git a/cabal/cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/many-data-files.out b/cabal/cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/many-data-files.out --- a/cabal/cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/many-data-files.out +++ b/cabal/cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/many-data-files.out @@ -1,2 +1,2 @@ -# cabal new-sdist +# cabal v2-sdist Wrote tarball sdist to /many-data-files.dist/source/dist-newstyle/sdist/many-data-files-0.tar.gz diff --git a/cabal/cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/many-data-files.test.hs b/cabal/cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/many-data-files.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/many-data-files.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/many-data-files.test.hs @@ -13,5 +13,5 @@ liftIO $ createDirectoryIfMissing False (cwd "data") forM_ [1 .. n + 100] $ \i -> liftIO $ BS.writeFile (cwd "data" ("data-file-" ++ show i) <.> "txt") (BS.pack "a data file\n") - cabal "new-sdist" ["many-data-files"] + cabal "v2-sdist" ["many-data-files"] Nothing -> skip diff --git a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all-output-dir.out b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all-output-dir.out --- a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all-output-dir.out +++ b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all-output-dir.out @@ -1,3 +1,3 @@ -# cabal new-sdist +# cabal v2-sdist Wrote tarball sdist to /all-output-dir.dist/source/archives/a-0.1.tar.gz Wrote tarball sdist to /all-output-dir.dist/source/archives/b-0.1.tar.gz diff --git a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all-output-dir.test.hs b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all-output-dir.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all-output-dir.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all-output-dir.test.hs @@ -3,7 +3,7 @@ main = cabalTest $ withSourceCopy $ do cwd <- fmap testCurrentDir getTestEnv liftIO $ createDirectoryIfMissing False $ cwd "archives" - cabal "new-sdist" ["all", "--output-dir", "archives"] + cabal "v2-sdist" ["all", "--output-dir", "archives"] shouldNotExist $ cwd "dist-newstyle/sdist/a-0.1.tar.gz" shouldNotExist $ cwd "dist-newstyle/sdist/b-0.1.tar.gz" shouldExist $ cwd "archives/a-0.1.tar.gz" diff --git a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all-test-sute.out b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all-test-sute.out --- a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all-test-sute.out +++ b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all-test-sute.out @@ -1,2 +1,2 @@ -# cabal new-sdist +# cabal v2-sdist cabal: It is not possible to package only the test suites from a package for distribution. Only entire packages may be packaged for distribution. diff --git a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all-test-sute.test.hs b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all-test-sute.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all-test-sute.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all-test-sute.test.hs @@ -1,6 +1,6 @@ import Test.Cabal.Prelude main = cabalTest $ withSourceCopy $ do cwd <- fmap testCurrentDir getTestEnv - fails $ cabal "new-sdist" ["all:tests"] + fails $ cabal "v2-sdist" ["all:tests"] shouldNotExist $ cwd "dist-newstyle/sdist/a-0.1.tar.gz" shouldNotExist $ cwd "dist-newstyle/sdist/b-0.1.tar.gz" diff --git a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all.out b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all.out --- a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all.out +++ b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all.out @@ -1,3 +1,3 @@ -# cabal new-sdist +# cabal v2-sdist Wrote tarball sdist to /all.dist/source/dist-newstyle/sdist/a-0.1.tar.gz Wrote tarball sdist to /all.dist/source/dist-newstyle/sdist/b-0.1.tar.gz diff --git a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all.test.hs b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all.test.hs @@ -1,6 +1,6 @@ import Test.Cabal.Prelude main = cabalTest $ withSourceCopy $ do cwd <- fmap testCurrentDir getTestEnv - cabal "new-sdist" ["all"] + cabal "v2-sdist" ["all"] shouldExist $ cwd "dist-newstyle/sdist/a-0.1.tar.gz" shouldExist $ cwd "dist-newstyle/sdist/b-0.1.tar.gz" diff --git a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/list-sources-output-dir.out b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/list-sources-output-dir.out --- a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/list-sources-output-dir.out +++ b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/list-sources-output-dir.out @@ -1,3 +1,3 @@ -# cabal new-sdist +# cabal v2-sdist Wrote source list to /list-sources-output-dir.dist/source/lists/a-0.1.list Wrote source list to /list-sources-output-dir.dist/source/lists/b-0.1.list diff --git a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/list-sources-output-dir.test.hs b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/list-sources-output-dir.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/list-sources-output-dir.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/list-sources-output-dir.test.hs @@ -4,6 +4,6 @@ main = cabalTest $ withSourceCopy $ do cwd <- fmap testCurrentDir getTestEnv liftIO $ createDirectoryIfMissing False $ cwd "lists" - cabal "new-sdist" ["all", "--list-only", "--output-dir", "lists"] + cabal "v2-sdist" ["all", "--list-only", "--output-dir", "lists"] assertFindInFile (normalise "a/a.cabal") (cwd "lists/a-0.1.list") assertFindInFile (normalise "b/b.cabal") (cwd "lists/b-0.1.list") diff --git a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-archive-to-stdout.out b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-archive-to-stdout.out --- a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-archive-to-stdout.out +++ b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-archive-to-stdout.out @@ -1,2 +1,2 @@ -# cabal new-sdist +# cabal v2-sdist cabal: Can't write multiple tarballs to standard output! diff --git a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-archive-to-stdout.test.hs b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-archive-to-stdout.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-archive-to-stdout.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-archive-to-stdout.test.hs @@ -1,6 +1,6 @@ import Test.Cabal.Prelude main = cabalTest $ withSourceCopy $ do cwd <- fmap testCurrentDir getTestEnv - fails $ cabal "new-sdist" ["a", "b", "--output-dir", "-"] + fails $ cabal "v2-sdist" ["a", "b", "--output-dir", "-"] shouldNotExist $ cwd "dist-newstyle/sdist/a-0.1.tar.gz" shouldNotExist $ cwd "dist-newstyle/sdist/b-0.1.tar.gz" diff --git a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-list-sources.out b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-list-sources.out --- a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-list-sources.out +++ b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-list-sources.out @@ -1,4 +1,4 @@ -# cabal new-sdist +# cabal v2-sdist a/Main.hs a/Test.hs a/a.cabal diff --git a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-list-sources.test.hs b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-list-sources.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-list-sources.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-list-sources.test.hs @@ -1,4 +1,4 @@ import Test.Cabal.Prelude import Data.List main = cabalTest $ withSourceCopy $ - cabal "new-sdist" ["a", "b", "--list-only"] + cabal "v2-sdist" ["a", "b", "--list-only"] diff --git a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-target.out b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-target.out --- a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-target.out +++ b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-target.out @@ -1,3 +1,3 @@ -# cabal new-sdist +# cabal v2-sdist Wrote tarball sdist to /multi-target.dist/source/dist-newstyle/sdist/a-0.1.tar.gz Wrote tarball sdist to /multi-target.dist/source/dist-newstyle/sdist/b-0.1.tar.gz diff --git a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-target.test.hs b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-target.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-target.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-target.test.hs @@ -1,6 +1,6 @@ import Test.Cabal.Prelude main = cabalTest $ withSourceCopy $ do cwd <- fmap testCurrentDir getTestEnv - cabal "new-sdist" ["a", "b"] + cabal "v2-sdist" ["a", "b"] shouldExist $ cwd "dist-newstyle/sdist/a-0.1.tar.gz" shouldExist $ cwd "dist-newstyle/sdist/b-0.1.tar.gz" diff --git a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/target-remote-package.out b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/target-remote-package.out --- a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/target-remote-package.out +++ b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/target-remote-package.out @@ -1,2 +1,2 @@ -# cabal new-sdist +# cabal v2-sdist cabal: The package base cannot be packaged for distribution, because it is not local to this project. diff --git a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/target-remote-package.test.hs b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/target-remote-package.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/target-remote-package.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/target-remote-package.test.hs @@ -1,5 +1,5 @@ import Test.Cabal.Prelude main = cabalTest $ withSourceCopy $ do cwd <- fmap testCurrentDir getTestEnv - fails $ cabal "new-sdist" ["a", "base"] + fails $ cabal "v2-sdist" ["a", "base"] shouldNotExist $ cwd "dist-newstyle/sdist/a-0.1.tar.gz" diff --git a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/valid-and-test-suite.out b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/valid-and-test-suite.out --- a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/valid-and-test-suite.out +++ b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/valid-and-test-suite.out @@ -1,2 +1,2 @@ -# cabal new-sdist +# cabal v2-sdist cabal: The component test suite 'a-tests' cannot be packaged for distribution on its own. Only entire packages may be packaged for distribution. diff --git a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/valid-and-test-suite.test.hs b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/valid-and-test-suite.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/valid-and-test-suite.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewSdist/MultiTarget/valid-and-test-suite.test.hs @@ -1,6 +1,6 @@ import Test.Cabal.Prelude main = cabalTest $ withSourceCopy $ do cwd <- fmap testCurrentDir getTestEnv - fails $ cabal "new-sdist" ["a", "b", "a-tests"] + fails $ cabal "v2-sdist" ["a", "b", "a-tests"] shouldNotExist $ cwd "dist-newstyle/sdist/a-0.1.tar.gz" shouldNotExist $ cwd "dist-newstyle/sdist/b-0.1.tar.gz" diff --git a/cabal/cabal-testsuite/PackageTests/NewSdist/NullTerminated/cabal.out b/cabal/cabal-testsuite/PackageTests/NewSdist/NullTerminated/cabal.out Binary files a/cabal/cabal-testsuite/PackageTests/NewSdist/NullTerminated/cabal.out and b/cabal/cabal-testsuite/PackageTests/NewSdist/NullTerminated/cabal.out differ diff --git a/cabal/cabal-testsuite/PackageTests/NewSdist/NullTerminated/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/NewSdist/NullTerminated/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/NewSdist/NullTerminated/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/NewSdist/NullTerminated/cabal.test.hs @@ -1,4 +1,4 @@ import Test.Cabal.Prelude import Data.List main = cabalTest $ - cabal "new-sdist" ["--list-only", "--null"] + cabal "v2-sdist" ["--list-only", "--null"] diff --git a/cabal/cabal-testsuite/PackageTests/Outdated/outdated-project-file.out b/cabal/cabal-testsuite/PackageTests/Outdated/outdated-project-file.out --- a/cabal/cabal-testsuite/PackageTests/Outdated/outdated-project-file.out +++ b/cabal/cabal-testsuite/PackageTests/Outdated/outdated-project-file.out @@ -7,4 +7,4 @@ Outdated dependencies: base ==3.0.3.2 (latest: 4.0.0.0) # cabal outdated -cabal: --project-file must only be used with --new-freeze-file. +cabal: --project-file must only be used with --v2-freeze-file. diff --git a/cabal/cabal-testsuite/PackageTests/Outdated/outdated-project-file.test.hs b/cabal/cabal-testsuite/PackageTests/Outdated/outdated-project-file.test.hs --- a/cabal/cabal-testsuite/PackageTests/Outdated/outdated-project-file.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Outdated/outdated-project-file.test.hs @@ -1,13 +1,13 @@ import Test.Cabal.Prelude main = cabalTest $ withRepo "repo" $ do - res <- cabal' "outdated" ["--new-freeze-file", "--project-file", "variant.project"] + res <- cabal' "outdated" ["--v2-freeze-file", "--project-file", "variant.project"] assertOutputContains "base" res assertOutputDoesNotContain "template-haskell" res -- Test last-one-wins behaviour. - res <- cabal' "outdated" ["--new-freeze-file", "--project-file", "cabal.project", "--project-file", "variant.project"] + res <- cabal' "outdated" ["--v2-freeze-file", "--project-file", "cabal.project", "--project-file", "variant.project"] assertOutputContains "base" res assertOutputDoesNotContain "template-haskell" res - -- Test for erroring on --project-file without --new-freeze-file + -- Test for erroring on --project-file without --v2-freeze-file fails $ cabal "outdated" ["--project-file", "variant.project"] diff --git a/cabal/cabal-testsuite/PackageTests/Outdated/outdated_freeze.test.hs b/cabal/cabal-testsuite/PackageTests/Outdated/outdated_freeze.test.hs --- a/cabal/cabal-testsuite/PackageTests/Outdated/outdated_freeze.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Outdated/outdated_freeze.test.hs @@ -1,6 +1,6 @@ import Test.Cabal.Prelude main = cabalTest $ withRepo "repo" - $ forM_ ["--new-freeze-file", "--freeze-file"] $ \arg -> do + $ forM_ ["--v2-freeze-file", "--freeze-file"] $ \arg -> do cabal' "outdated" [arg] >>= (\out -> do diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T3436/cabal.out b/cabal/cabal-testsuite/PackageTests/Regression/T3436/cabal.out --- a/cabal/cabal-testsuite/PackageTests/Regression/T3436/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/Regression/T3436/cabal.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T3932/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/Regression/T3932/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/Regression/T3932/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Regression/T3932/cabal.test.hs @@ -1,7 +1,7 @@ import Test.Cabal.Prelude main = cabalTest $ -- This repository contains a Cabal-1.18.0.0 option, which would - -- normally would satisfy the repository, except for new-build's + -- normally would satisfy the repository, except for v2-build's -- extra constraint that setup Cabal must be 1.20. If we don't -- have a choice like this available, the unsatisfied constraint -- won't be reported. @@ -11,5 +11,5 @@ withRepo "repo" $ do -- Don't record because output wobbles based on installed database. recordMode DoNotRecord $ do - fails (cabal' "new-build" []) >>= + fails (cabal' "v2-build" []) >>= assertOutputContains "Setup.hs requires >=" diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T4154/install-time-with-constraint.out b/cabal/cabal-testsuite/PackageTests/Regression/T4154/install-time-with-constraint.out --- a/cabal/cabal-testsuite/PackageTests/Regression/T4154/install-time-with-constraint.out +++ b/cabal/cabal-testsuite/PackageTests/Regression/T4154/install-time-with-constraint.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following would be built: diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T4154/install-time-with-constraint.test.hs b/cabal/cabal-testsuite/PackageTests/Regression/T4154/install-time-with-constraint.test.hs --- a/cabal/cabal-testsuite/PackageTests/Regression/T4154/install-time-with-constraint.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Regression/T4154/install-time-with-constraint.test.hs @@ -5,13 +5,13 @@ -- building its setup script with the installed Cabal, which depends on the -- installed time, even though the installed time doesn't fit the constraint. main = cabalTest $ do - cabal "new-build" ["time", "--constraint=time==99999", "--dry-run"] + cabal "v2-build" ["time", "--constraint=time==99999", "--dry-run"] -- Temporarily disabled recording here because output is not stable recordMode DoNotRecord $ do -- Constraining all uses of 'time' fails because the installed 'time' -- doesn't fit the constraint. - r <- fails $ cabal' "new-build" ["time", "--constraint=any.time==99999", "--dry-run"] + r <- fails $ cabal' "v2-build" ["time", "--constraint=any.time==99999", "--dry-run"] assertRegex "Expected cabal to reject the setup dependency on the installed time" ("rejecting: time:setup.time-[0-9.]*/installed-[^[:space:]]* " ++ "\\(constraint from command line flag requires ==99999\\)") diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T4202/cabal.out b/cabal/cabal-testsuite/PackageTests/Regression/T4202/cabal.out --- a/cabal/cabal-testsuite/PackageTests/Regression/T4202/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/Regression/T4202/cabal.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: @@ -10,13 +10,13 @@ Configuring executable 'qexe' for q-1.0.. Preprocessing executable 'qexe' for q-1.0.. Building executable 'qexe' for q-1.0.. -# cabal new-build +# cabal v2-build Build profile: -w ghc- -O1 In order, the following will be built: - p-1.0 (lib) (file P.hs changed) Preprocessing library for p-1.0.. Building library for p-1.0.. -# cabal new-build +# cabal v2-build Build profile: -w ghc- -O1 In order, the following will be built: - q-1.0 (exe:qexe) (file /cabal.dist/work/dist/build//ghc-/p-1.0/cache/build changed) diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T4202/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/Regression/T4202/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/Regression/T4202/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Regression/T4202/cabal.test.hs @@ -2,11 +2,11 @@ main = cabalTest $ withSourceCopy . withDelay $ do writeSourceFile ("p/P.hs") "module P where\np = \"AAA\"" - cabal "new-build" ["p","q"] + cabal "v2-build" ["p","q"] delay writeSourceFile ("p/P.hs") "module P where\np = \"BBB\"" - cabal "new-build" ["p"] - cabal "new-build" ["q"] + cabal "v2-build" ["p"] + cabal "v2-build" ["q"] withPlan $ runPlanExe' "q" "qexe" [] >>= assertOutputContains "BBB" diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T4291/dependee/Dependee.hs b/cabal/cabal-testsuite/PackageTests/Regression/T4291/dependee/Dependee.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Regression/T4291/dependee/Dependee.hs @@ -0,0 +1,1 @@ +module Dependee where diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T4291/dependee/dependee.cabal b/cabal/cabal-testsuite/PackageTests/Regression/T4291/dependee/dependee.cabal new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Regression/T4291/dependee/dependee.cabal @@ -0,0 +1,11 @@ +name: dependee +version: 0.1.0.0 +author: Zejun Wu +maintainer: watashi@watashi.ws +build-type: Simple +cabal-version: >=2.0 + +library + build-depends: base + default-language: Haskell2010 + exposed-modules: Dependee diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T4291/depender/depender.cabal b/cabal/cabal-testsuite/PackageTests/Regression/T4291/depender/depender.cabal new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Regression/T4291/depender/depender.cabal @@ -0,0 +1,10 @@ +name: depender +version: 0.1.0.0 +author: Zejun Wu +maintainer: watashi@watashi.ws +build-type: Simple +cabal-version: >=2.0 + +library + build-depends: base, dependee + default-language: Haskell2010 diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T4291/setup.cabal.out b/cabal/cabal-testsuite/PackageTests/Regression/T4291/setup.cabal.out new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Regression/T4291/setup.cabal.out @@ -0,0 +1,20 @@ +# Setup configure +Resolving dependencies... +Configuring dependee-0.1.0.0... +# Setup build +Preprocessing library for dependee-0.1.0.0.. +Building library for dependee-0.1.0.0.. +# Setup copy +Installing library in +# Setup register +Registering library for dependee-0.1.0.0.. +# Setup configure +Resolving dependencies... +Configuring depender-0.1.0.0... +# Setup build +Preprocessing library for depender-0.1.0.0.. +Building library for depender-0.1.0.0.. +# Setup copy +Installing library in +# Setup register +Registering library for depender-0.1.0.0.. diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T4291/setup.out b/cabal/cabal-testsuite/PackageTests/Regression/T4291/setup.out new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Regression/T4291/setup.out @@ -0,0 +1,18 @@ +# Setup configure +Configuring dependee-0.1.0.0... +# Setup build +Preprocessing library for dependee-0.1.0.0.. +Building library for dependee-0.1.0.0.. +# Setup copy +Installing library in +# Setup register +Registering library for dependee-0.1.0.0.. +# Setup configure +Configuring depender-0.1.0.0... +# Setup build +Preprocessing library for depender-0.1.0.0.. +Building library for depender-0.1.0.0.. +# Setup copy +Installing library in +# Setup register +Registering library for depender-0.1.0.0.. diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T4291/setup.test.hs b/cabal/cabal-testsuite/PackageTests/Regression/T4291/setup.test.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Regression/T4291/setup.test.hs @@ -0,0 +1,17 @@ +import Data.List (isPrefixOf) +import Test.Cabal.Prelude + +-- Test that checkRelocate doesn't fail when library directory of dependee +-- contains '..' +main = setupAndCabalTest $ withPackageDb $ do + skipIf =<< isWindows + skipUnless =<< ghcVersionIs (>= mkVersion [7,6]) + env <- getTestEnv + let pkgroot = takeDirectory $ testPackageDbDir env + prefix = testTmpDir env "prefix" + assertBool "we need a prefix that is not under pkgroot for this test" $ + not $ pkgroot `isPrefixOf` prefix + withDirectory "dependee" $ + setup_install ["--enable-relocatable", "--prefix", prefix] + withDirectory "depender" $ + setup_install ["--enable-relocatable", "--prefix", prefix] diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T4720/cabal.out b/cabal/cabal-testsuite/PackageTests/Regression/T4720/cabal.out --- a/cabal/cabal-testsuite/PackageTests/Regression/T4720/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/Regression/T4720/cabal.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T4720/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/Regression/T4720/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/Regression/T4720/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Regression/T4720/cabal.test.hs @@ -1,3 +1,3 @@ import Test.Cabal.Prelude main = cabalTest $ do - cabal "new-build" ["test"] + cabal "v2-build" ["test"] diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T4986/cabal.out b/cabal/cabal-testsuite/PackageTests/Regression/T4986/cabal.out --- a/cabal/cabal-testsuite/PackageTests/Regression/T4986/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/Regression/T4986/cabal.out @@ -1,4 +1,4 @@ -# cabal new-configure +# cabal v2-configure Resolving dependencies... Build profile: -w ghc- -O1 In order, the following would be built: diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T4986/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/Regression/T4986/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/Regression/T4986/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Regression/T4986/cabal.test.hs @@ -1,4 +1,4 @@ import Test.Cabal.Prelude main = cabalTest $ withSourceCopy $ - cabal "new-configure" [] + cabal "v2-configure" [] diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T5309/cabal.out b/cabal/cabal-testsuite/PackageTests/Regression/T5309/cabal.out --- a/cabal/cabal-testsuite/PackageTests/Regression/T5309/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/Regression/T5309/cabal.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: @@ -12,9 +12,10 @@ Preprocessing executable 'exe-no-lib' for T5309-1.0.0.0.. Building executable 'exe-no-lib' for T5309-1.0.0.0.. Configuring executable 'exe-with-lib' for T5309-1.0.0.0.. +Warning: The package has an extraneous version range for a dependency on an internal library: T5309 -any && ==1.0.0.0, T5309 -any && ==1.0.0.0, T5309 -any && ==1.0.0.0. This version range includes the current package but isn't needed as the current package's library will always be used. Preprocessing executable 'exe-with-lib' for T5309-1.0.0.0.. Building executable 'exe-with-lib' for T5309-1.0.0.0.. -# cabal new-test +# cabal v2-test Build profile: -w ghc- -O1 In order, the following will be built: - T5309-1.0.0.0 (test:test-no-lib) (first run) @@ -28,6 +29,7 @@ Test suite logged to: /cabal.dist/work/./dist/build//ghc-/T5309-1.0.0.0/t/test-no-lib/test/T5309-1.0.0.0-test-no-lib.log 1 of 1 test suites (1 of 1 test cases) passed. Configuring test suite 'test-with-lib' for T5309-1.0.0.0.. +Warning: The package has an extraneous version range for a dependency on an internal library: T5309 -any && ==1.0.0.0, T5309 -any && ==1.0.0.0, T5309 -any && ==1.0.0.0. This version range includes the current package but isn't needed as the current package's library will always be used. Preprocessing test suite 'test-with-lib' for T5309-1.0.0.0.. Building test suite 'test-with-lib' for T5309-1.0.0.0.. Running 1 test suites... @@ -35,7 +37,7 @@ Test suite test-with-lib: PASS Test suite logged to: /cabal.dist/work/./dist/build//ghc-/T5309-1.0.0.0/t/test-with-lib/test/T5309-1.0.0.0-test-with-lib.log 1 of 1 test suites (1 of 1 test cases) passed. -# cabal new-bench +# cabal v2-bench Build profile: -w ghc- -O1 In order, the following will be built: - T5309-1.0.0.0 (bench:bench-no-lib) (first run) @@ -47,6 +49,7 @@ Benchmark bench-no-lib: RUNNING... Benchmark bench-no-lib: FINISH Configuring benchmark 'bench-with-lib' for T5309-1.0.0.0.. +Warning: The package has an extraneous version range for a dependency on an internal library: T5309 -any && ==1.0.0.0, T5309 -any && ==1.0.0.0, T5309 -any && ==1.0.0.0. This version range includes the current package but isn't needed as the current package's library will always be used. Preprocessing benchmark 'bench-with-lib' for T5309-1.0.0.0.. Building benchmark 'bench-with-lib' for T5309-1.0.0.0.. Running 1 benchmarks... diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T5309/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/Regression/T5309/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/Regression/T5309/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Regression/T5309/cabal.test.hs @@ -1,5 +1,5 @@ import Test.Cabal.Prelude main = cabalTest $ do - cabal "new-build" ["all"] - cabal "new-test" ["all"] - cabal "new-bench" ["all"] + cabal "v2-build" ["all"] + cabal "v2-test" ["all"] + cabal "v2-bench" ["all"] diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T5386/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/Regression/T5386/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/Regression/T5386/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Regression/T5386/cabal.test.hs @@ -2,4 +2,4 @@ -- See #4332, dep solving output is not deterministic main = cabalTest . recordMode DoNotRecord $ withSourceCopyDir "9" $ -- Note: we bundle the configure script so no need to autoreconf while building - cabal "new-build" ["all"] + cabal "v2-build" ["all"] diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T5409/use-different-versions-of-dependency-for-library-and-build-tool.test.hs b/cabal/cabal-testsuite/PackageTests/Regression/T5409/use-different-versions-of-dependency-for-library-and-build-tool.test.hs --- a/cabal/cabal-testsuite/PackageTests/Regression/T5409/use-different-versions-of-dependency-for-library-and-build-tool.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Regression/T5409/use-different-versions-of-dependency-for-library-and-build-tool.test.hs @@ -7,7 +7,7 @@ -- as a preprocessor to insert the executable's version number into the source -- code. Then the pkg executable prints out both versions. -- --- Issue #5409 caused new-build to use the same instance of build-tool-pkg for +-- Issue #5409 caused v2-build to use the same instance of build-tool-pkg for -- the build-depends and build-tool-depends dependencies, even though it -- violated the version constraints. main = withShorterPathForNewBuildStore $ \storeDir -> @@ -15,7 +15,7 @@ skipUnless =<< hasNewBuildCompatBootCabal withRepo "repo" $ do r1 <- recordMode DoNotRecord $ - cabalG' ["--store-dir=" ++ storeDir] "new-build" ["pkg:my-exe"] + cabalG' ["--store-dir=" ++ storeDir] "v2-build" ["pkg:my-exe"] let msg = "In order, the following will be built:" ++ " - build-tool-pkg-1 (lib) (requires download & build)" ++ " - build-tool-pkg-2 (lib) (requires download & build)" -- dependency of build-tool-exe diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T5677/cabal.out b/cabal/cabal-testsuite/PackageTests/Regression/T5677/cabal.out --- a/cabal/cabal-testsuite/PackageTests/Regression/T5677/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/Regression/T5677/cabal.out @@ -1,4 +1,4 @@ -# cabal new-build +# cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: @@ -24,5 +24,6 @@ Building library instantiated with Sig = impl-0-inplace:Sig for prog-0.. Configuring executable 'prog' for prog-0.. +Warning: The package has an extraneous version range for a dependency on an internal library: prog -any && ==0. This version range includes the current package but isn't needed as the current package's library will always be used. Preprocessing executable 'prog' for prog-0.. Building executable 'prog' for prog-0.. diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T5677/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/Regression/T5677/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/Regression/T5677/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/Regression/T5677/cabal.test.hs @@ -2,5 +2,4 @@ main = cabalTest $ do -- -Wmissing-export-lists is new in 8.4. skipUnless =<< ghcVersionIs (>= mkVersion [8,3]) - cabal "new-build" ["all"] - + cabal "v2-build" ["all"] diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T6125/Main.hs b/cabal/cabal-testsuite/PackageTests/Regression/T6125/Main.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Regression/T6125/Main.hs @@ -0,0 +1,1 @@ +main = return () diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T6125/data/foo/bar.html b/cabal/cabal-testsuite/PackageTests/Regression/T6125/data/foo/bar.html new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Regression/T6125/data/foo/bar.html @@ -0,0 +1,1 @@ +Some random data. diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T6125/myprog.cabal b/cabal/cabal-testsuite/PackageTests/Regression/T6125/myprog.cabal new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Regression/T6125/myprog.cabal @@ -0,0 +1,9 @@ +cabal-version: 2.4 +name: myprog +version: 0 +data-files: data/**/*.html + +executable myprog + build-depends: base + main-is: Main.hs + default-language: Haskell2010 diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T6125/setup.cabal.out b/cabal/cabal-testsuite/PackageTests/Regression/T6125/setup.cabal.out new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Regression/T6125/setup.cabal.out @@ -0,0 +1,9 @@ +# Setup configure +Resolving dependencies... +Configuring myprog-0... +# Setup build +Preprocessing executable 'myprog' for myprog-0.. +Building executable 'myprog' for myprog-0.. +# Setup copy +Installing executable myprog in +Warning: The directory /setup.cabal.dist/usr/bin is not in the system search path. diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T6125/setup.out b/cabal/cabal-testsuite/PackageTests/Regression/T6125/setup.out new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Regression/T6125/setup.out @@ -0,0 +1,8 @@ +# Setup configure +Configuring myprog-0... +# Setup build +Preprocessing executable 'myprog' for myprog-0.. +Building executable 'myprog' for myprog-0.. +# Setup copy +Installing executable myprog in +Warning: The directory /setup.dist/usr/bin is not in the system search path. diff --git a/cabal/cabal-testsuite/PackageTests/Regression/T6125/setup.test.hs b/cabal/cabal-testsuite/PackageTests/Regression/T6125/setup.test.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/Regression/T6125/setup.test.hs @@ -0,0 +1,6 @@ +import Test.Cabal.Prelude +main = setupAndCabalTest $ do + withPackageDb $ do + setup "configure" [] + setup "build" ["myprog"] + setup "copy" ["myprog"] diff --git a/cabal/cabal-testsuite/PackageTests/RequireExplicit/FlagInProject/a.cabal b/cabal/cabal-testsuite/PackageTests/RequireExplicit/FlagInProject/a.cabal new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/RequireExplicit/FlagInProject/a.cabal @@ -0,0 +1,7 @@ +cabal-version: 2.2 +name: a +version: 0 + +library + build-depends: + some-lib diff --git a/cabal/cabal-testsuite/PackageTests/RequireExplicit/FlagInProject/cabal.project b/cabal/cabal-testsuite/PackageTests/RequireExplicit/FlagInProject/cabal.project new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/RequireExplicit/FlagInProject/cabal.project @@ -0,0 +1,3 @@ +packages: + ./ +reject-unconstrained-dependencies: all diff --git a/cabal/cabal-testsuite/PackageTests/RequireExplicit/FlagInProject/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/RequireExplicit/FlagInProject/cabal.test.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/RequireExplicit/FlagInProject/cabal.test.hs @@ -0,0 +1,6 @@ +import Test.Cabal.Prelude +-- See #4332, dep solving output is not deterministic +main = cabalTest . recordMode DoNotRecord $ withRepo "../repo" $ do + -- other-lib is a dependency, but it's not listed in cabal.project + res <- fails $ cabal' "v2-build" ["all", "--dry-run"] + assertOutputContains "not a user-provided goal" res diff --git a/cabal/cabal-testsuite/PackageTests/RequireExplicit/MultiPkg/a/a.cabal b/cabal/cabal-testsuite/PackageTests/RequireExplicit/MultiPkg/a/a.cabal new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/RequireExplicit/MultiPkg/a/a.cabal @@ -0,0 +1,8 @@ +cabal-version: 2.2 +name: a +version: 0 + +library + build-depends: + some-lib, + b diff --git a/cabal/cabal-testsuite/PackageTests/RequireExplicit/MultiPkg/b/b.cabal b/cabal/cabal-testsuite/PackageTests/RequireExplicit/MultiPkg/b/b.cabal new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/RequireExplicit/MultiPkg/b/b.cabal @@ -0,0 +1,10 @@ +cabal-version: 2.2 +name: b +version: 0 + +library + build-tool-depends: + some-exe:some-exe -any + build-depends: + some-lib, + other-lib diff --git a/cabal/cabal-testsuite/PackageTests/RequireExplicit/MultiPkg/cabal.project b/cabal/cabal-testsuite/PackageTests/RequireExplicit/MultiPkg/cabal.project new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/RequireExplicit/MultiPkg/cabal.project @@ -0,0 +1,6 @@ +packages: + ./a + ./b + +constraints: + some-lib -any diff --git a/cabal/cabal-testsuite/PackageTests/RequireExplicit/MultiPkg/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/RequireExplicit/MultiPkg/cabal.test.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/RequireExplicit/MultiPkg/cabal.test.hs @@ -0,0 +1,16 @@ +import Test.Cabal.Prelude +-- See #4332, dep solving output is not deterministic +main = cabalTest . recordMode DoNotRecord $ withRepo "../repo" $ do + -- other-lib is a dependency of b, but it's not listed in cabal.project + res <- fails $ cabal' "v2-build" ["all", "--dry-run", "--reject-unconstrained-dependencies", "all", "--constraint", "some-exe -any"] + assertOutputContains "not a user-provided goal" res + + -- and some-exe is a build-tool dependency of b, again not listed + res <- fails $ cabal' "v2-build" ["all", "--dry-run", "--reject-unconstrained-dependencies", "all", "--constraint", "other-lib -any"] + assertOutputContains "not a user-provided goal" res + + -- everything's listed, good to go + cabal "v2-build" ["all", "--dry-run", "--reject-unconstrained-dependencies", "all", "--constraint", "other-lib -any", "--constraint", "some-exe -any"] + + -- a depends on b, but b is a local dependency, so it gets a pass + cabal "v2-build" ["a", "--dry-run", "--reject-unconstrained-dependencies", "all", "--constraint", "other-lib -any", "--constraint", "some-exe -any"] diff --git a/cabal/cabal-testsuite/PackageTests/RequireExplicit/repo/other-lib-1.0/other-lib.cabal b/cabal/cabal-testsuite/PackageTests/RequireExplicit/repo/other-lib-1.0/other-lib.cabal new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/RequireExplicit/repo/other-lib-1.0/other-lib.cabal @@ -0,0 +1,7 @@ +cabal-version: 2.2 +name: other-lib +version: 1.0 + +library + exposed-modules: + Foo diff --git a/cabal/cabal-testsuite/PackageTests/RequireExplicit/repo/some-exe-1.0/some-exe.cabal b/cabal/cabal-testsuite/PackageTests/RequireExplicit/repo/some-exe-1.0/some-exe.cabal new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/RequireExplicit/repo/some-exe-1.0/some-exe.cabal @@ -0,0 +1,6 @@ +cabal-version: 2.2 +name: some-exe +version: 1.0 + +executable some-exe + main-is: Foo.hs diff --git a/cabal/cabal-testsuite/PackageTests/RequireExplicit/repo/some-lib-1.0/some-lib.cabal b/cabal/cabal-testsuite/PackageTests/RequireExplicit/repo/some-lib-1.0/some-lib.cabal new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/PackageTests/RequireExplicit/repo/some-lib-1.0/some-lib.cabal @@ -0,0 +1,7 @@ +cabal-version: 2.2 +name: some-lib +version: 1.0 + +library + exposed-modules: + Foo diff --git a/cabal/cabal-testsuite/PackageTests/SPDX/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/SPDX/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/SPDX/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/SPDX/cabal.test.hs @@ -3,4 +3,4 @@ recordMode DoNotRecord $ do -- TODO: Hack; see also CustomDep/cabal.test.hs withEnvFilter (/= "HOME") $ do - cabal "new-build" ["all"] + cabal "v2-build" ["all"] diff --git a/cabal/cabal-testsuite/PackageTests/SimpleDefault/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/SimpleDefault/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/SimpleDefault/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/SimpleDefault/cabal.test.hs @@ -3,4 +3,4 @@ recordMode DoNotRecord $ do -- TODO: Hack; see also CustomDep/cabal.test.hs withEnvFilter (/= "HOME") $ do - cabal "new-build" ["all"] + cabal "v2-build" ["all"] diff --git a/cabal/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/cabal-with-hpc.multitest.hs b/cabal/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/cabal-with-hpc.multitest.hs --- a/cabal/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/cabal-with-hpc.multitest.hs +++ b/cabal/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/cabal-with-hpc.multitest.hs @@ -36,7 +36,7 @@ not hpcOk || (not hasShared && (exeDyn || shared)) || (not hasProfiled && (libProf || exeProf)) - unless skip $ cabal "new-test" args + unless skip $ cabal "v2-test" args where choose4 :: [a] -> [(a, a, a, a)] choose4 xs = liftM4 (,,,) xs xs xs xs diff --git a/cabal/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/cabal.out b/cabal/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/cabal.out --- a/cabal/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/cabal.out @@ -1,4 +1,4 @@ -# cabal new-test +# cabal v2-test Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: @@ -9,6 +9,7 @@ Preprocessing library for my-0.1.. Building library for my-0.1.. Configuring test suite 'test-Short' for my-0.1.. +Warning: The package has an extraneous version range for a dependency on an internal library: my -any && ==0.1, my -any && ==0.1. This version range includes the current package but isn't needed as the current package's library will always be used. Preprocessing test suite 'test-Short' for my-0.1.. Building test suite 'test-Short' for my-0.1.. Running 1 test suites... @@ -17,6 +18,7 @@ Test suite logged to: /cabal.dist/work/./dist/build//ghc-/my-0.1/t/test-Short/test/my-0.1-test-Short.log 1 of 1 test suites (1 of 1 test cases) passed. Configuring test suite 'test-Foo' for my-0.1.. +Warning: The package has an extraneous version range for a dependency on an internal library: my -any && ==0.1, my -any && ==0.1. This version range includes the current package but isn't needed as the current package's library will always be used. Preprocessing test suite 'test-Foo' for my-0.1.. Building test suite 'test-Foo' for my-0.1.. Running 1 test suites... diff --git a/cabal/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/cabal.test.hs @@ -1,4 +1,4 @@ import Test.Cabal.Prelude main = cabalTest $ do - cabal "new-test" [] + cabal "v2-test" [] diff --git a/cabal/cabal-testsuite/PackageTests/UserConfig/cabal.out b/cabal/cabal-testsuite/PackageTests/UserConfig/cabal.out --- a/cabal/cabal-testsuite/PackageTests/UserConfig/cabal.out +++ b/cabal/cabal-testsuite/PackageTests/UserConfig/cabal.out @@ -6,3 +6,9 @@ Writing default configuration to /cabal.dist/cabal-config # cabal user-config Writing default configuration to /cabal.dist/cabal-config2 +# cabal user-config +Renaming /cabal.dist/cabal-config to /cabal.dist/cabal-config.backup. +Writing merged config to /cabal.dist/cabal-config. +# cabal user-config +Renaming /cabal.dist/cabal-config to /cabal.dist/cabal-config.backup. +Writing merged config to /cabal.dist/cabal-config. diff --git a/cabal/cabal-testsuite/PackageTests/UserConfig/cabal.test.hs b/cabal/cabal-testsuite/PackageTests/UserConfig/cabal.test.hs --- a/cabal/cabal-testsuite/PackageTests/UserConfig/cabal.test.hs +++ b/cabal/cabal-testsuite/PackageTests/UserConfig/cabal.test.hs @@ -11,3 +11,7 @@ withEnv [("CABAL_CONFIG", Just conf2)] $ do cabal "user-config" ["init"] shouldExist conf2 + cabalG ["--config-file", conf] "user-config" ["update", "-f", "-a", "extra-prog-path: foo", "-a", "extra-prog-path: bar"] + assertFileDoesContain conf "foo,bar" + cabalG ["--config-file", conf] "user-config" ["update", "-f", "-a", "extra-prog-path: foo, bar"] + assertFileDoesContain conf "foo,bar" diff --git a/cabal/cabal-testsuite/Setup.hs b/cabal/cabal-testsuite/Setup.hs --- a/cabal/cabal-testsuite/Setup.hs +++ b/cabal/cabal-testsuite/Setup.hs @@ -1,10 +1,78 @@ +{-# LANGUAGE Haskell2010 #-} +module Main (main) where + +import Distribution.Backpack import Distribution.Simple +import Distribution.Simple.BuildPaths +import Distribution.Simple.LocalBuildInfo +import Distribution.Simple.Setup +import Distribution.Simple.Utils +import Distribution.Types.LocalBuildInfo +import Distribution.Types.ModuleRenaming +import Distribution.Types.UnqualComponentName + +import System.Directory +import System.FilePath + main :: IO () -main = defaultMain +main = defaultMainWithHooks simpleUserHooks + { buildHook = \pkg lbi hooks flags -> do + generateScriptEnvModule lbi flags + buildHook simpleUserHooks pkg lbi hooks flags + } --- Although this looks like the Simple build type, it is in fact vital that --- we use this Setup.hs because we need to compile against the very same --- version of the Cabal library that the test suite will be compiled --- against. When this happens, it will mean that we'll be able to --- read the LocalBuildInfo of our build environment, which we will --- subsequently use to make decisions about PATHs etc. Important! +generateScriptEnvModule :: LocalBuildInfo -> BuildFlags -> IO () +generateScriptEnvModule lbi flags = do + lbiPackageDbStack <- mapM canonicalizePackageDB (withPackageDB lbi) + + createDirectoryIfMissing True moduledir + rewriteFileEx verbosity (moduledir "ScriptEnv0.hs") $ unlines + [ "module Test.Cabal.ScriptEnv0 where" + , "" + , "import Distribution.Simple" + , "import Distribution.System (Platform(..), Arch(..), OS(..))" + , "import Distribution.Types.ModuleRenaming" + , "import Distribution.Simple.Program.Db" + , "import Distribution.Backpack (OpenUnitId)" + , "import Data.Map (fromList)" + , "" + , "lbiPackageDbStack :: PackageDBStack" + , "lbiPackageDbStack = " ++ show lbiPackageDbStack + , "" + , "lbiPlatform :: Platform" + , "lbiPlatform = " ++ show (hostPlatform lbi) + , "" + , "lbiCompiler :: Compiler" + , "lbiCompiler = " ++ show (compiler lbi) + , "" + , "lbiPackages :: [(OpenUnitId, ModuleRenaming)]" + , "lbiPackages = read " ++ show (show (cabalTestsPackages lbi)) + , "" + , "lbiProgramDb :: ProgramDb" + , "lbiProgramDb = read " ++ show (show (withPrograms lbi)) + , "" + , "lbiWithSharedLib :: Bool" + , "lbiWithSharedLib = " ++ show (withSharedLib lbi) + ] + where + verbosity = fromFlagOrDefault minBound (buildVerbosity flags) + moduledir = libAutogenDir "Test" "Cabal" + -- fixme: use component-specific folder + libAutogenDir = autogenPackageModulesDir lbi + +-- | Convert package database into absolute path, so that +-- if we change working directories in a subprocess we get the correct database. +canonicalizePackageDB :: PackageDB -> IO PackageDB +canonicalizePackageDB (SpecificPackageDB path) + = SpecificPackageDB `fmap` canonicalizePath path +canonicalizePackageDB x = return x + +-- | Compute the set of @-package-id@ flags which would be passed when +-- building the public library. Assumes that the public library is +-- non-Backpack. +cabalTestsPackages :: LocalBuildInfo -> [(OpenUnitId, ModuleRenaming)] +cabalTestsPackages lbi = + case componentNameCLBIs lbi (CExeName (mkUnqualComponentName "cabal-tests")) of + [clbi] -> -- [ (unUnitId $ unDefUnitId duid,rn) | (DefiniteUnitId duid, rn) <- componentIncludes clbi ] + componentIncludes clbi + _ -> error "cabalTestsPackages" diff --git a/cabal/cabal-testsuite/Setup.simple.hs b/cabal/cabal-testsuite/Setup.simple.hs new file mode 100644 --- /dev/null +++ b/cabal/cabal-testsuite/Setup.simple.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Distribution.Simple + +main :: IO () +main = defaultMain diff --git a/cabal/cabal-testsuite/Test/Cabal/Monad.hs b/cabal/cabal-testsuite/Test/Cabal/Monad.hs --- a/cabal/cabal-testsuite/Test/Cabal/Monad.hs +++ b/cabal/cabal-testsuite/Test/Cabal/Monad.hs @@ -66,8 +66,7 @@ import Distribution.Simple.Program.Db import Distribution.Simple.Program import Distribution.Simple.Configure - ( getPersistBuildConfig, configCompilerEx ) -import Distribution.Types.LocalBuildInfo + ( configCompilerEx ) import Distribution.Version import Distribution.Text import Distribution.Package @@ -240,20 +239,19 @@ script_base = dropExtensions script_filename -- Canonicalize this so that it is stable across working directory changes script_dir <- canonicalizePath script_dir0 - lbi <- getPersistBuildConfig dist_dir let verbosity = normal -- TODO: configurable - senv <- mkScriptEnv verbosity lbi + senv <- mkScriptEnv verbosity -- Add test suite specific programs let program_db0 = addKnownPrograms ([gitProgram, hackageRepoToolProgram, cabalProgram, diffProgram] ++ builtinPrograms) - (withPrograms lbi) + (runnerProgramDb senv) -- Reconfigure according to user flags let cargs = testCommonArgs args -- Reconfigure GHC (comp, platform, program_db2) <- case argGhcPath cargs of - Nothing -> return (compiler lbi, hostPlatform lbi, program_db0) + Nothing -> return (runnerCompiler senv, runnerPlatform senv, program_db0) Just ghc_path -> do -- All the things that get updated paths from -- configCompilerEx. The point is to make sure @@ -274,7 +272,7 @@ -- we don't pay for things we don't need. A bit difficult -- to do in the current design. configCompilerEx - (Just (compilerFlavor (compiler lbi))) + (Just (compilerFlavor (runnerCompiler senv))) (Just ghc_path) Nothing program_db1 @@ -294,7 +292,7 @@ let db_stack = case argGhcPath (testCommonArgs args) of - Nothing -> withPackageDB lbi + Nothing -> runnerPackageDbStack senv -- NB: canonicalized -- Can't use the build package db stack since they -- are all for the wrong versions! TODO: Make -- this configurable @@ -311,9 +309,9 @@ testVerbosity = verbosity, testMtimeChangeDelay = Nothing, testScriptEnv = senv, - testSetupPath = dist_dir "setup" "setup", + testSetupPath = dist_dir "build" "setup" "setup", testSkipSetupTests = argSkipSetupTests (testCommonArgs args), - testHaveCabalShared = withSharedLib lbi, + testHaveCabalShared = runnerWithSharedLib senv, testEnvironment = -- Try to avoid Unicode output [ ("LC_ALL", Just "C") diff --git a/cabal/cabal-testsuite/Test/Cabal/Plan.hs b/cabal/cabal-testsuite/Test/Cabal/Plan.hs --- a/cabal/cabal-testsuite/Test/Cabal/Plan.hs +++ b/cabal/cabal-testsuite/Test/Cabal/Plan.hs @@ -6,7 +6,8 @@ planDistDir, ) where -import Distribution.Text +import Distribution.Parsec (simpleParsec) +import Distribution.Pretty (prettyShow) import Distribution.Types.ComponentName import Distribution.Package import qualified Data.Text as Text @@ -61,7 +62,7 @@ instance FromJSON ComponentName where parseJSON (String t) = - case simpleParse s of + case simpleParsec s of Nothing -> fail ("could not parse component-name: " ++ s) Just r -> return r where s = Text.unpack t @@ -71,11 +72,11 @@ planDistDir plan pkg_name cname = case concatMap p (planInstallPlan plan) of [x] -> x - [] -> error $ "planDistDir: component " ++ display cname - ++ " of package " ++ display pkg_name ++ " either does not" + [] -> error $ "planDistDir: component " ++ prettyShow cname + ++ " of package " ++ prettyShow pkg_name ++ " either does not" ++ " exist in the install plan or does not have a dist-dir" - _ -> error $ "planDistDir: found multiple copies of component " ++ display cname - ++ " of package " ++ display pkg_name ++ " in install plan" + _ -> error $ "planDistDir: found multiple copies of component " ++ prettyShow cname + ++ " of package " ++ prettyShow pkg_name ++ " in install plan" where p APreExisting = [] p AConfiguredGlobal = [] diff --git a/cabal/cabal-testsuite/Test/Cabal/Prelude.hs b/cabal/cabal-testsuite/Test/Cabal/Prelude.hs --- a/cabal/cabal-testsuite/Test/Cabal/Prelude.hs +++ b/cabal/cabal-testsuite/Test/Cabal/Prelude.hs @@ -161,11 +161,11 @@ defaultRecordMode RecordMarked $ do recordHeader ["Setup", cmd] if testCabalInstallAsSetup env - then + then -- `cabal` and `Setup` no longer have the same interface. -- A bit of fettling is required to hide this fact. - let - legacyCmds = + let + legacyCmds = [ "build" , "configure" , "repl" @@ -188,7 +188,8 @@ full_args' = if a `elem` legacyCmds then ("v1-" ++ a) : as else a:as in runProgramM cabalProgram full_args' else do - pdfile <- liftIO $ tryFindPackageDesc (testCurrentDir env prefix) + pdfile <- liftIO $ tryFindPackageDesc (testVerbosity env) + (testCurrentDir env prefix) pdesc <- liftIO $ readGenericPackageDescription (testVerbosity env) pdfile if buildType (packageDescription pdesc) == Simple then runM (testSetupPath env) full_args @@ -294,8 +295,8 @@ | cmd `elem` ["v1-update", "outdated", "user-config", "manpage", "v1-freeze", "check"] = [ ] -- new-build commands are affected by testCabalProjectFile - | cmd == "new-sdist" = [ "--project-file", testCabalProjectFile env ] - | "new-" `isPrefixOf` cmd + | cmd == "v2-sdist" = [ "--project-file", testCabalProjectFile env ] + | "v2-" `isPrefixOf` cmd = [ "--builddir", testDistDir env , "--project-file", testCabalProjectFile env , "-j1" ] @@ -354,9 +355,11 @@ withPlan :: TestM a -> TestM a withPlan m = do env0 <- getTestEnv - Just plan <- JSON.decode `fmap` - liftIO (BSL.readFile (testDistDir env0 "cache" "plan.json")) - withReaderT (\env -> env { testPlan = Just plan }) m + let filepath = testDistDir env0 "cache" "plan.json" + mplan <- JSON.eitherDecode `fmap` liftIO (BSL.readFile filepath) + case mplan of + Left err -> fail $ "withPlan: cannot decode plan " ++ err + Right plan -> withReaderT (\env -> env { testPlan = Just plan }) m -- | Run an executable from a package. Requires 'withPlan' to have -- been run so that we can find the dist dir. diff --git a/cabal/cabal-testsuite/Test/Cabal/Script.hs b/cabal/cabal-testsuite/Test/Cabal/Script.hs --- a/cabal/cabal-testsuite/Test/Cabal/Script.hs +++ b/cabal/cabal-testsuite/Test/Cabal/Script.hs @@ -9,13 +9,10 @@ ) where import Test.Cabal.Run +import Test.Cabal.ScriptEnv0 import Distribution.Backpack import Distribution.Types.ModuleRenaming -import Distribution.Types.LocalBuildInfo -import Distribution.Types.ComponentLocalBuildInfo -import Distribution.Types.ComponentName -import Distribution.Types.UnqualComponentName import Distribution.Utils.NubList import Distribution.Simple.Program.Db import Distribution.Simple.Program.Builtin @@ -26,9 +23,9 @@ import Distribution.System import Distribution.Simple.Setup (Flag(..)) -import System.Directory import qualified Data.Monoid as M + -- | The runner environment, which contains all of the important -- parameters for invoking GHC. Mostly subset of 'LocalBuildInfo'. data ScriptEnv = ScriptEnv @@ -38,8 +35,11 @@ , runnerPlatform :: Platform , runnerCompiler :: Compiler , runnerPackages :: [(OpenUnitId, ModuleRenaming)] + , runnerWithSharedLib :: Bool } +{- + -- | Convert package database into absolute path, so that -- if we change working directories in a subprocess we get the correct database. canonicalizePackageDB :: PackageDB -> IO PackageDB @@ -47,30 +47,23 @@ = SpecificPackageDB `fmap` canonicalizePath path canonicalizePackageDB x = return x +-} + -- | Create a 'ScriptEnv' from a 'LocalBuildInfo' configured with -- the GHC that we want to use. -mkScriptEnv :: Verbosity -> LocalBuildInfo -> IO ScriptEnv -mkScriptEnv verbosity lbi = do - package_db <- mapM canonicalizePackageDB (withPackageDB lbi) +mkScriptEnv :: Verbosity -> IO ScriptEnv +mkScriptEnv verbosity = return $ ScriptEnv { runnerVerbosity = verbosity - , runnerProgramDb = withPrograms lbi - , runnerPackageDbStack = package_db - , runnerPlatform = hostPlatform lbi - , runnerCompiler = compiler lbi + , runnerProgramDb = lbiProgramDb + , runnerPackageDbStack = lbiPackageDbStack + , runnerPlatform = lbiPlatform + , runnerCompiler = lbiCompiler -- NB: the set of packages available to test.hs scripts will COINCIDE -- with the dependencies on the cabal-testsuite library - , runnerPackages = cabalTestsPackages lbi + , runnerPackages = lbiPackages + , runnerWithSharedLib = lbiWithSharedLib } - --- | Compute the set of @-package-id@ flags which would be passed when --- building the public library. Assumes that the public library is --- non-Backpack. -cabalTestsPackages :: LocalBuildInfo -> [(OpenUnitId, ModuleRenaming)] -cabalTestsPackages lbi = - case componentNameCLBIs lbi (CExeName (mkUnqualComponentName "cabal-tests")) of - [clbi] -> componentIncludes clbi - _ -> error "cabalTestsPackages" -- | Run a script with 'runghc', under the 'ScriptEnv'. runghc :: ScriptEnv -> Maybe FilePath -> [(String, Maybe String)] diff --git a/cabal/cabal-testsuite/Test/Cabal/Server.hs b/cabal/cabal-testsuite/Test/Cabal/Server.hs --- a/cabal/cabal-testsuite/Test/Cabal/Server.hs +++ b/cabal/cabal-testsuite/Test/Cabal/Server.hs @@ -254,9 +254,15 @@ #else pid <- withProcessHandle (serverProcessHandle s0) $ \ph -> case ph of +#if MIN_VERSION_process(1,2,0) OpenHandle x -> return (show x) -- TODO: handle OpenExtHandle? _ -> return (serverProcessId s0) +#else + OpenHandle x -> return (ph, show x) + -- TODO: handle OpenExtHandle? + _ -> return (ph, serverProcessId s0) +#endif #endif let s = s0 { serverProcessId = pid } -- We will read/write a line at a time, including for diff --git a/cabal/cabal-testsuite/cabal-testsuite.cabal b/cabal/cabal-testsuite/cabal-testsuite.cabal --- a/cabal/cabal-testsuite/cabal-testsuite.cabal +++ b/cabal/cabal-testsuite/cabal-testsuite.cabal @@ -1,7 +1,8 @@ +cabal-version: 2.2 name: cabal-testsuite -version: 2.4.1.0 -copyright: 2003-2018, Cabal Development Team (see AUTHORS file) -license: BSD3 +version: 3.1.0.0 +copyright: 2003-2019, Cabal Development Team (see AUTHORS file) +license: BSD-3-Clause license-file: LICENSE author: Cabal Development Team maintainer: cabal-devel@haskell.org @@ -11,7 +12,6 @@ description: This package defines a shared test suite for Cabal and cabal-install. category: Distribution -cabal-version: >=1.10 build-type: Custom extra-source-files: @@ -22,7 +22,19 @@ location: https://github.com/haskell/cabal/ subdir: cabal-testsuite +common shared + default-language: Haskell2010 + + build-depends: + , base >= 4.6 && <4.13 + -- this needs to match the in-tree lib:Cabal version + , Cabal == 3.1.0.0 + + ghc-options: -Wall -fwarn-tabs + library + import: shared + exposed-modules: Test.Cabal.Workdir Test.Cabal.Script @@ -32,48 +44,63 @@ Test.Cabal.Server Test.Cabal.Monad Test.Cabal.CheckArMetadata + + other-modules: + Test.Cabal.ScriptEnv0 + autogen-modules: + Test.Cabal.ScriptEnv0 + build-depends: - aeson ==1.4.*, - attoparsec, - async, - base, - bytestring, - transformers, - optparse-applicative >=0.14 && <0.15, - process, - directory, - filepath, - regex-compat-tdfa, - regex-tdfa, - temporary, - text, - cryptohash-sha256, - base16-bytestring, - Cabal >= 2.3 - ghc-options: -Wall -fwarn-tabs + , aeson ^>= 1.4.2.0 + , async ^>= 2.2.1 + , attoparsec ^>= 0.13.2.2 + , base16-bytestring ^>= 0.1.1.6 + , bytestring ^>= 0.10.0.2 + , containers ^>= 0.5.0.0 || ^>= 0.6.0.1 + , cryptohash-sha256 ^>= 0.11.101.0 + , directory ^>= 1.2.0.1 || ^>= 1.3.0.0 + , exceptions ^>= 0.10.0 + , filepath ^>= 1.3.0.1 || ^>= 1.4.0.0 + , optparse-applicative ^>= 0.14.3.0 + , process ^>= 1.1.0.2 || ^>= 1.2.0.0 || ^>= 1.4.2.0 || ^>= 1.6.1.0 + , regex-compat-tdfa ^>= 0.95.1.4 + , regex-tdfa ^>= 1.2.3.1 + , temporary ^>= 1.3 + , text ^>= 1.2.3.1 + , transformers ^>= 0.3.0.0 || ^>= 0.4.2.0 || ^>= 0.5.2.0 + if !os(windows) - build-depends: unix, exceptions + build-depends: + , unix ^>= 2.6.0.0 || ^>= 2.7.0.0 else - build-depends: Win32 - default-language: Haskell2010 + build-depends: + , Win32 executable cabal-tests + import: shared main-is: cabal-tests.hs hs-source-dirs: main - ghc-options: -threaded -Wall -fwarn-tabs + ghc-options: -threaded build-depends: - async, - base, - Cabal == 2.4.1.0, - clock, - filepath, - process, - optparse-applicative, - cabal-testsuite, - transformers, - exceptions - default-language: Haskell2010 + , cabal-testsuite + -- cosntraints inherited via lib:cabal-testsuite component + , async + , exceptions + , filepath + , optparse-applicative + , process + , transformers + -- dependencies specific to exe:cabal-tests + , clock ^>= 0.7.2 + build-tool-depends: cabal-testsuite:setup + +-- this executable is needed by lib:cabal-testsuite +executable setup + import: shared + main-is: Setup.simple.hs + custom-setup - setup-depends: Cabal == 2.4.1.0, - base + -- we only depend on even stable releases of lib:Cabal + setup-depends: Cabal == 2.2.* || == 2.4.* || == 3.0.* || ==3.1.*, + base, filepath, directory diff --git a/cabal/cabal-testsuite/main/cabal-tests.hs b/cabal/cabal-testsuite/main/cabal-tests.hs --- a/cabal/cabal-testsuite/main/cabal-tests.hs +++ b/cabal/cabal-testsuite/main/cabal-tests.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE NondecreasingIndentation #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -8,7 +9,6 @@ import Test.Cabal.Monad import Distribution.Verbosity (normal, verbose, Verbosity) -import Distribution.Simple.Configure (getPersistBuildConfig) import Distribution.Simple.Utils (getDirectoryContentsRecursive) import Options.Applicative @@ -20,14 +20,26 @@ import qualified Control.Exception as E import GHC.Conc (numCapabilities) import Data.List -import Data.Monoid (mempty, (<>)) import Text.Printf import qualified System.Clock as Clock import System.IO import System.FilePath import System.Exit -import System.Process (callProcess, showCommandForUser) +import System.Process ( +#if MIN_VERSION_process(1,2,0) + callProcess, +#else + proc, createProcess, waitForProcess, terminateProcess, +#endif + showCommandForUser) +#if !MIN_VERSION_base(4,12,0) +import Data.Monoid ((<>)) +#endif +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid (mempty) +#endif + -- | Record for arguments that can be passed to @cabal-tests@ executable. data MainArgs = MainArgs { mainArgThreads :: Int, @@ -97,10 +109,8 @@ Nothing -> guessDistDir when (verbosity >= verbose) $ hPutStrLn stderr $ "Using dist dir: " ++ dist_dir - lbi <- getPersistBuildConfig dist_dir - -- Get ready to go! - senv <- mkScriptEnv verbosity lbi + senv <- mkScriptEnv verbosity let runTest runner path = runner Nothing [] path $ ["--builddir", dist_dir, path] ++ renderCommonArgs (mainCommonArgs args) @@ -298,3 +308,20 @@ t <- Clock.getTime Clock.Monotonic let ns = realToFrac $ Clock.toNanoSecs t return $ ns / 10 ^ (9 :: Int) + +------------------------------------------------------------------------------- +-- compat +------------------------------------------------------------------------------- + +#if !MIN_VERSION_process(1,2,0) +callProcess :: FilePath -> [String] -> IO () +callProcess cmd args = do + exit_code <- bracket (createProcess (proc cmd args)) cleanupProcess + $ \(_, _, _, ph) -> waitForProcess ph + case exit_code of + ExitSuccess -> return () + ExitFailure r -> fail $ "processFailedException " ++ show (cmd, args, r) + where + cleanupProcess (_, _, _, ph) = terminateProcess ph + +#endif diff --git a/cabal/cabal.project b/cabal/cabal.project --- a/cabal/cabal.project +++ b/cabal/cabal.project @@ -1,8 +1,14 @@ -packages: Cabal/ cabal-testsuite/ cabal-install/ solver-benchmarks/ pretty-show-1.6.16/ -constraints: unix >= 2.7.1.0 +packages: Cabal/ cabal-testsuite/ cabal-install/ solver-benchmarks/ -- Uncomment to allow picking up extra local unpacked deps: --optional-packages: */ + +-- Remove after hackage-repo-tool release +allow-newer: + hackage-repo-tool:optparse-applicative + +allow-newer: + hackage-security:Cabal program-options -- So us hackers get all the assertion failures early: diff --git a/cabal/cabal.project.local.travis b/cabal/cabal.project.local.travis --- a/cabal/cabal.project.local.travis +++ b/cabal/cabal.project.local.travis @@ -16,5 +16,17 @@ package Cabal ghc-options: -Werror -fno-warn-orphans +constraints: + binary installed, + bytestring installed, + containers installed, + deepseq installed, + directory installed, + filepath installed, + pretty installed, + process installed, + time installed, + unix installed + package cabal-install ghc-options: -Werror diff --git a/cabal/cabal.project.travis b/cabal/cabal.project.travis new file mode 100644 --- /dev/null +++ b/cabal/cabal.project.travis @@ -0,0 +1,20 @@ +-- Force error messages to be better +-- Parallel new-build error messages are non-existent. +-- Turn off parallelization to get good errors. +jobs: 1 + +-- We vendor a copy of hackage-repo-tool so that we can +-- build it reliably. If we eventually get new-install +-- in the bootstrap, this can go away. +optional-packages: hackage-repo-tool-*/ +-- hackage-repo-tool has upper bound on Cabal +allow-newer: hackage-repo-tool:Cabal, hackage-repo-tool:time, hackage-repo-tool:directory + +-- The -fno-warn-orphans is a hack to make Cabal-1.24 +-- build properly (unfortunately the flags here get applied +-- to the dependencies too!) +package Cabal + ghc-options: -Werror -fno-warn-orphans + +package cabal-install + ghc-options: -Werror diff --git a/cabal/cabal.project.travis.libonly b/cabal/cabal.project.travis.libonly --- a/cabal/cabal.project.travis.libonly +++ b/cabal/cabal.project.travis.libonly @@ -3,7 +3,6 @@ -- only lib:Cabal. packages: Cabal/ cabal-testsuite/ -constraints: unix >= 2.7.1.0 -- Uncomment to allow picking up extra local unpacked deps: --optional-packages: */ diff --git a/cabal/cabal.project.validate b/cabal/cabal.project.validate --- a/cabal/cabal.project.validate +++ b/cabal/cabal.project.validate @@ -1,5 +1,7 @@ packages: Cabal/ cabal-testsuite/ cabal-install/ +write-ghc-environment-files: never + package Cabal ghc-options: -Werror -fno-ignore-asserts package cabal-testsuite diff --git a/cabal/cabal.project.validate.libonly b/cabal/cabal.project.validate.libonly new file mode 100644 --- /dev/null +++ b/cabal/cabal.project.validate.libonly @@ -0,0 +1,8 @@ +packages: Cabal/ cabal-testsuite/ + +write-ghc-environment-files: never + +package Cabal + ghc-options: -Werror -fno-ignore-asserts +package cabal-testsuite + ghc-options: -Werror -fno-ignore-asserts diff --git a/cabal/license-list-data/exceptions-3.6.json b/cabal/license-list-data/exceptions-3.6.json new file mode 100644 --- /dev/null +++ b/cabal/license-list-data/exceptions-3.6.json @@ -0,0 +1,408 @@ +{ + "licenseListVersion": "3.6", + "releaseDate": "2019-07-10", + "exceptions": [ + { + "reference": "./Libtool-exception.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Libtool-exception.json", + "referenceNumber": "1", + "name": "Libtool Exception", + "seeAlso": [ + "http://git.savannah.gnu.org/cgit/libtool.git/tree/m4/libtool.m4" + ], + "licenseExceptionId": "Libtool-exception" + }, + { + "reference": "./Linux-syscall-note.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Linux-syscall-note.json", + "referenceNumber": "2", + "name": "Linux Syscall Note", + "seeAlso": [ + "https://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux.git/tree/COPYING" + ], + "licenseExceptionId": "Linux-syscall-note" + }, + { + "reference": "./Autoconf-exception-3.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Autoconf-exception-3.0.json", + "referenceNumber": "3", + "name": "Autoconf exception 3.0", + "seeAlso": [ + "http://www.gnu.org/licenses/autoconf-exception-3.0.html" + ], + "licenseExceptionId": "Autoconf-exception-3.0" + }, + { + "reference": "./OCCT-exception-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/OCCT-exception-1.0.json", + "referenceNumber": "4", + "name": "Open CASCADE Exception 1.0", + "seeAlso": [ + "http://www.opencascade.com/content/licensing" + ], + "licenseExceptionId": "OCCT-exception-1.0" + }, + { + "reference": "./openvpn-openssl-exception.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/openvpn-openssl-exception.json", + "referenceNumber": "5", + "name": "OpenVPN OpenSSL Exception", + "seeAlso": [ + "http://openvpn.net/index.php/license.html" + ], + "licenseExceptionId": "openvpn-openssl-exception" + }, + { + "reference": "./gnu-javamail-exception.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/gnu-javamail-exception.json", + "referenceNumber": "6", + "name": "GNU JavaMail exception", + "seeAlso": [ + "http://www.gnu.org/software/classpathx/javamail/javamail.html" + ], + "licenseExceptionId": "gnu-javamail-exception" + }, + { + "reference": "./OpenJDK-assembly-exception-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/OpenJDK-assembly-exception-1.0.json", + "referenceNumber": "7", + "name": "OpenJDK Assembly exception 1.0", + "seeAlso": [ + "http://openjdk.java.net/legal/assembly-exception.html" + ], + "licenseExceptionId": "OpenJDK-assembly-exception-1.0" + }, + { + "reference": "./Bison-exception-2.2.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Bison-exception-2.2.json", + "referenceNumber": "8", + "name": "Bison exception 2.2", + "seeAlso": [ + "http://git.savannah.gnu.org/cgit/bison.git/tree/data/yacc.c?id\u003d193d7c7054ba7197b0789e14965b739162319b5e#n141" + ], + "licenseExceptionId": "Bison-exception-2.2" + }, + { + "reference": "./i2p-gpl-java-exception.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/i2p-gpl-java-exception.json", + "referenceNumber": "9", + "name": "i2p GPL+Java Exception", + "seeAlso": [ + "http://geti2p.net/en/get-involved/develop/licenses#java_exception" + ], + "licenseExceptionId": "i2p-gpl-java-exception" + }, + { + "reference": "./Universal-FOSS-exception-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Universal-FOSS-exception-1.0.json", + "referenceNumber": "10", + "name": "Universal FOSS Exception, Version 1.0", + "seeAlso": [ + "https://oss.oracle.com/licenses/universal-foss-exception/" + ], + "licenseExceptionId": "Universal-FOSS-exception-1.0" + }, + { + "reference": "./Qt-LGPL-exception-1.1.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Qt-LGPL-exception-1.1.json", + "referenceNumber": "11", + "name": "Qt LGPL exception 1.1", + "seeAlso": [ + "http://code.qt.io/cgit/qt/qtbase.git/tree/LGPL_EXCEPTION.txt" + ], + "licenseExceptionId": "Qt-LGPL-exception-1.1" + }, + { + "reference": "./389-exception.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/389-exception.json", + "referenceNumber": "12", + "name": "389 Directory Server Exception", + "seeAlso": [ + "http://directory.fedoraproject.org/wiki/GPL_Exception_License_Text" + ], + "licenseExceptionId": "389-exception" + }, + { + "reference": "./Classpath-exception-2.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Classpath-exception-2.0.json", + "referenceNumber": "13", + "name": "Classpath exception 2.0", + "seeAlso": [ + "http://www.gnu.org/software/classpath/license.html", + "https://fedoraproject.org/wiki/Licensing/GPL_Classpath_Exception" + ], + "licenseExceptionId": "Classpath-exception-2.0" + }, + { + "reference": "./Fawkes-Runtime-exception.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Fawkes-Runtime-exception.json", + "referenceNumber": "14", + "name": "Fawkes Runtime Exception", + "seeAlso": [ + "http://www.fawkesrobotics.org/about/license/" + ], + "licenseExceptionId": "Fawkes-Runtime-exception" + }, + { + "reference": "./PS-or-PDF-font-exception-20170817.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/PS-or-PDF-font-exception-20170817.json", + "referenceNumber": "15", + "name": "PS/PDF font exception (2017-08-17)", + "seeAlso": [ + "https://github.com/ArtifexSoftware/urw-base35-fonts/blob/65962e27febc3883a17e651cdb23e783668c996f/LICENSE" + ], + "licenseExceptionId": "PS-or-PDF-font-exception-20170817" + }, + { + "reference": "./Qt-GPL-exception-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Qt-GPL-exception-1.0.json", + "referenceNumber": "16", + "name": "Qt GPL exception 1.0", + "seeAlso": [ + "http://code.qt.io/cgit/qt/qtbase.git/tree/LICENSE.GPL3-EXCEPT" + ], + "licenseExceptionId": "Qt-GPL-exception-1.0" + }, + { + "reference": "./LZMA-exception.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/LZMA-exception.json", + "referenceNumber": "17", + "name": "LZMA exception", + "seeAlso": [ + "http://nsis.sourceforge.net/Docs/AppendixI.html#I.6" + ], + "licenseExceptionId": "LZMA-exception" + }, + { + "reference": "./freertos-exception-2.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/freertos-exception-2.0.json", + "referenceNumber": "18", + "name": "FreeRTOS Exception 2.0", + "seeAlso": [ + "https://web.archive.org/web/20060809182744/http://www.freertos.org/a00114.html" + ], + "licenseExceptionId": "freertos-exception-2.0" + }, + { + "reference": "./Qwt-exception-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Qwt-exception-1.0.json", + "referenceNumber": "19", + "name": "Qwt exception 1.0", + "seeAlso": [ + "http://qwt.sourceforge.net/qwtlicense.html" + ], + "licenseExceptionId": "Qwt-exception-1.0" + }, + { + "reference": "./CLISP-exception-2.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CLISP-exception-2.0.json", + "referenceNumber": "20", + "name": "CLISP exception 2.0", + "seeAlso": [ + "http://sourceforge.net/p/clisp/clisp/ci/default/tree/COPYRIGHT" + ], + "licenseExceptionId": "CLISP-exception-2.0" + }, + { + "reference": "./FLTK-exception.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/FLTK-exception.json", + "referenceNumber": "21", + "name": "FLTK exception", + "seeAlso": [ + "http://www.fltk.org/COPYING.php" + ], + "licenseExceptionId": "FLTK-exception" + }, + { + "reference": "./Bootloader-exception.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Bootloader-exception.json", + "referenceNumber": "22", + "name": "Bootloader Distribution Exception", + "seeAlso": [ + "https://github.com/pyinstaller/pyinstaller/blob/develop/COPYING.txt" + ], + "licenseExceptionId": "Bootloader-exception" + }, + { + "reference": "./Nokia-Qt-exception-1.1.html", + "isDeprecatedLicenseId": true, + "detailsUrl": "http://spdx.org/licenses/Nokia-Qt-exception-1.1.json", + "referenceNumber": "23", + "name": "Nokia Qt LGPL exception 1.1", + "seeAlso": [ + "https://www.keepassx.org/dev/projects/keepassx/repository/revisions/b8dfb9cc4d5133e0f09cd7533d15a4f1c19a40f2/entry/LICENSE.NOKIA-LGPL-EXCEPTION" + ], + "licenseExceptionId": "Nokia-Qt-exception-1.1" + }, + { + "reference": "./LLVM-exception.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/LLVM-exception.json", + "referenceNumber": "24", + "name": "LLVM Exception", + "seeAlso": [ + "http://llvm.org/foundation/relicensing/LICENSE.txt" + ], + "licenseExceptionId": "LLVM-exception" + }, + { + "reference": "./WxWindows-exception-3.1.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/WxWindows-exception-3.1.json", + "referenceNumber": "25", + "name": "WxWindows Library Exception 3.1", + "seeAlso": [ + "http://www.opensource.org/licenses/WXwindows" + ], + "licenseExceptionId": "WxWindows-exception-3.1" + }, + { + "reference": "./DigiRule-FOSS-exception.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/DigiRule-FOSS-exception.json", + "referenceNumber": "26", + "name": "DigiRule FOSS License Exception", + "seeAlso": [ + "http://www.digirulesolutions.com/drupal/foss" + ], + "licenseExceptionId": "DigiRule-FOSS-exception" + }, + { + "reference": "./Swift-exception.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Swift-exception.json", + "referenceNumber": "27", + "name": "Swift Exception", + "seeAlso": [ + "https://swift.org/LICENSE.txt", + "https://github.com/apple/swift-package-manager/blob/7ab2275f447a5eb37497ed63a9340f8a6d1e488b/LICENSE.txt#L205" + ], + "licenseExceptionId": "Swift-exception" + }, + { + "reference": "./GCC-exception-3.1.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/GCC-exception-3.1.json", + "referenceNumber": "28", + "name": "GCC Runtime Library exception 3.1", + "seeAlso": [ + "http://www.gnu.org/licenses/gcc-exception-3.1.html" + ], + "licenseExceptionId": "GCC-exception-3.1" + }, + { + "reference": "./eCos-exception-2.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/eCos-exception-2.0.json", + "referenceNumber": "29", + "name": "eCos exception 2.0", + "seeAlso": [ + "http://ecos.sourceware.org/license-overview.html" + ], + "licenseExceptionId": "eCos-exception-2.0" + }, + { + "reference": "./Autoconf-exception-2.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Autoconf-exception-2.0.json", + "referenceNumber": "30", + "name": "Autoconf exception 2.0", + "seeAlso": [ + "http://ac-archive.sourceforge.net/doc/copyright.html", + "http://ftp.gnu.org/gnu/autoconf/autoconf-2.59.tar.gz" + ], + "licenseExceptionId": "Autoconf-exception-2.0" + }, + { + "reference": "./GPL-CC-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/GPL-CC-1.0.json", + "referenceNumber": "31", + "name": "GPL Cooperation Commitment 1.0", + "seeAlso": [ + "https://github.com/gplcc/gplcc/blob/master/Project/COMMITMENT", + "https://gplcc.github.io/gplcc/Project/README-PROJECT.html" + ], + "licenseExceptionId": "GPL-CC-1.0" + }, + { + "reference": "./Font-exception-2.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Font-exception-2.0.json", + "referenceNumber": "32", + "name": "Font exception 2.0", + "seeAlso": [ + "http://www.gnu.org/licenses/gpl-faq.html#FontException" + ], + "licenseExceptionId": "Font-exception-2.0" + }, + { + "reference": "./u-boot-exception-2.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/u-boot-exception-2.0.json", + "referenceNumber": "33", + "name": "U-Boot exception 2.0", + "seeAlso": [ + "http://git.denx.de/?p\u003du-boot.git;a\u003dblob;f\u003dLicenses/Exceptions" + ], + "licenseExceptionId": "u-boot-exception-2.0" + }, + { + "reference": "./GCC-exception-2.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/GCC-exception-2.0.json", + "referenceNumber": "34", + "name": "GCC Runtime Library exception 2.0", + "seeAlso": [ + "https://gcc.gnu.org/git/?p\u003dgcc.git;a\u003dblob;f\u003dgcc/libgcc1.c;h\u003d762f5143fc6eed57b6797c82710f3538aa52b40b;hb\u003dcb143a3ce4fb417c68f5fa2691a1b1b1053dfba9#l10" + ], + "licenseExceptionId": "GCC-exception-2.0" + }, + { + "reference": "./mif-exception.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/mif-exception.json", + "referenceNumber": "35", + "name": "Macros and Inline Functions Exception", + "seeAlso": [ + "http://www.scs.stanford.edu/histar/src/lib/cppsup/exception", + "http://dev.bertos.org/doxygen/", + "https://www.threadingbuildingblocks.org/licensing" + ], + "licenseExceptionId": "mif-exception" + }, + { + "reference": "./OCaml-LGPL-linking-exception.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/OCaml-LGPL-linking-exception.json", + "referenceNumber": "36", + "name": "OCaml LGPL Linking Exception", + "seeAlso": [ + "https://caml.inria.fr/ocaml/license.en.html" + ], + "licenseExceptionId": "OCaml-LGPL-linking-exception" + } + ] +} diff --git a/cabal/license-list-data/licenses-3.6.json b/cabal/license-list-data/licenses-3.6.json new file mode 100644 --- /dev/null +++ b/cabal/license-list-data/licenses-3.6.json @@ -0,0 +1,4974 @@ +{ + "licenseListVersion": "3.6", + "licenses": [ + { + "reference": "./0BSD.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/0BSD.json", + "referenceNumber": "319", + "name": "BSD Zero Clause License", + "licenseId": "0BSD", + "seeAlso": [ + "http://landley.net/toybox/license.html" + ], + "isOsiApproved": true + }, + { + "reference": "./AAL.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/AAL.json", + "referenceNumber": "21", + "name": "Attribution Assurance License", + "licenseId": "AAL", + "seeAlso": [ + "https://opensource.org/licenses/attribution" + ], + "isOsiApproved": true + }, + { + "reference": "./ADSL.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/ADSL.json", + "referenceNumber": "19", + "name": "Amazon Digital Services License", + "licenseId": "ADSL", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/AmazonDigitalServicesLicense" + ], + "isOsiApproved": false + }, + { + "reference": "./AFL-1.1.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/AFL-1.1.json", + "referenceNumber": "118", + "name": "Academic Free License v1.1", + "licenseId": "AFL-1.1", + "seeAlso": [ + "http://opensource.linux-mirror.org/licenses/afl-1.1.txt", + "http://wayback.archive.org/web/20021004124254/http://www.opensource.org/licenses/academic.php" + ], + "isOsiApproved": true + }, + { + "reference": "./AFL-1.2.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/AFL-1.2.json", + "referenceNumber": "136", + "name": "Academic Free License v1.2", + "licenseId": "AFL-1.2", + "seeAlso": [ + "http://opensource.linux-mirror.org/licenses/afl-1.2.txt", + "http://wayback.archive.org/web/20021204204652/http://www.opensource.org/licenses/academic.php" + ], + "isOsiApproved": true + }, + { + "reference": "./AFL-2.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/AFL-2.0.json", + "referenceNumber": "115", + "name": "Academic Free License v2.0", + "licenseId": "AFL-2.0", + "seeAlso": [ + "http://wayback.archive.org/web/20060924134533/http://www.opensource.org/licenses/afl-2.0.txt" + ], + "isOsiApproved": true + }, + { + "reference": "./AFL-2.1.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/AFL-2.1.json", + "referenceNumber": "251", + "name": "Academic Free License v2.1", + "licenseId": "AFL-2.1", + "seeAlso": [ + "http://opensource.linux-mirror.org/licenses/afl-2.1.txt" + ], + "isOsiApproved": true + }, + { + "reference": "./AFL-3.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/AFL-3.0.json", + "referenceNumber": "216", + "name": "Academic Free License v3.0", + "licenseId": "AFL-3.0", + "seeAlso": [ + "http://www.rosenlaw.com/AFL3.0.htm", + "https://opensource.org/licenses/afl-3.0" + ], + "isOsiApproved": true + }, + { + "reference": "./AGPL-1.0.html", + "isDeprecatedLicenseId": true, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/AGPL-1.0.json", + "referenceNumber": "335", + "name": "Affero General Public License v1.0", + "licenseId": "AGPL-1.0", + "seeAlso": [ + "http://www.affero.org/oagpl.html" + ], + "isOsiApproved": false + }, + { + "reference": "./AGPL-1.0-only.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/AGPL-1.0-only.json", + "referenceNumber": "384", + "name": "Affero General Public License v1.0 only", + "licenseId": "AGPL-1.0-only", + "seeAlso": [ + "http://www.affero.org/oagpl.html" + ], + "isOsiApproved": false + }, + { + "reference": "./AGPL-1.0-or-later.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/AGPL-1.0-or-later.json", + "referenceNumber": "332", + "name": "Affero General Public License v1.0 or later", + "licenseId": "AGPL-1.0-or-later", + "seeAlso": [ + "http://www.affero.org/oagpl.html" + ], + "isOsiApproved": false + }, + { + "reference": "./AGPL-3.0.html", + "isDeprecatedLicenseId": true, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/AGPL-3.0.json", + "referenceNumber": "229", + "name": "GNU Affero General Public License v3.0", + "licenseId": "AGPL-3.0", + "seeAlso": [ + "https://www.gnu.org/licenses/agpl.txt", + "https://opensource.org/licenses/AGPL-3.0" + ], + "isOsiApproved": true + }, + { + "reference": "./AGPL-3.0-only.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/AGPL-3.0-only.json", + "referenceNumber": "95", + "name": "GNU Affero General Public License v3.0 only", + "licenseId": "AGPL-3.0-only", + "seeAlso": [ + "https://www.gnu.org/licenses/agpl.txt", + "https://opensource.org/licenses/AGPL-3.0" + ], + "isOsiApproved": true + }, + { + "reference": "./AGPL-3.0-or-later.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/AGPL-3.0-or-later.json", + "referenceNumber": "155", + "name": "GNU Affero General Public License v3.0 or later", + "licenseId": "AGPL-3.0-or-later", + "seeAlso": [ + "https://www.gnu.org/licenses/agpl.txt", + "https://opensource.org/licenses/AGPL-3.0" + ], + "isOsiApproved": true + }, + { + "reference": "./AMDPLPA.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/AMDPLPA.json", + "referenceNumber": "33", + "name": "AMD\u0027s plpa_map.c License", + "licenseId": "AMDPLPA", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/AMD_plpa_map_License" + ], + "isOsiApproved": false + }, + { + "reference": "./AML.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/AML.json", + "referenceNumber": "148", + "name": "Apple MIT License", + "licenseId": "AML", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Apple_MIT_License" + ], + "isOsiApproved": false + }, + { + "reference": "./AMPAS.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/AMPAS.json", + "referenceNumber": "191", + "name": "Academy of Motion Picture Arts and Sciences BSD", + "licenseId": "AMPAS", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/BSD#AMPASBSD" + ], + "isOsiApproved": false + }, + { + "reference": "./ANTLR-PD.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/ANTLR-PD.json", + "referenceNumber": "395", + "name": "ANTLR Software Rights Notice", + "licenseId": "ANTLR-PD", + "seeAlso": [ + "http://www.antlr2.org/license.html" + ], + "isOsiApproved": false + }, + { + "reference": "./APAFML.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/APAFML.json", + "referenceNumber": "195", + "name": "Adobe Postscript AFM License", + "licenseId": "APAFML", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/AdobePostscriptAFM" + ], + "isOsiApproved": false + }, + { + "reference": "./APL-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/APL-1.0.json", + "referenceNumber": "252", + "name": "Adaptive Public License 1.0", + "licenseId": "APL-1.0", + "seeAlso": [ + "https://opensource.org/licenses/APL-1.0" + ], + "isOsiApproved": true + }, + { + "reference": "./APSL-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/APSL-1.0.json", + "referenceNumber": "354", + "name": "Apple Public Source License 1.0", + "licenseId": "APSL-1.0", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Apple_Public_Source_License_1.0" + ], + "isOsiApproved": true + }, + { + "reference": "./APSL-1.1.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/APSL-1.1.json", + "referenceNumber": "324", + "name": "Apple Public Source License 1.1", + "licenseId": "APSL-1.1", + "seeAlso": [ + "http://www.opensource.apple.com/source/IOSerialFamily/IOSerialFamily-7/APPLE_LICENSE" + ], + "isOsiApproved": true + }, + { + "reference": "./APSL-1.2.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/APSL-1.2.json", + "referenceNumber": "34", + "name": "Apple Public Source License 1.2", + "licenseId": "APSL-1.2", + "seeAlso": [ + "http://www.samurajdata.se/opensource/mirror/licenses/apsl.php" + ], + "isOsiApproved": true + }, + { + "reference": "./APSL-2.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/APSL-2.0.json", + "referenceNumber": "109", + "name": "Apple Public Source License 2.0", + "licenseId": "APSL-2.0", + "seeAlso": [ + "http://www.opensource.apple.com/license/apsl/" + ], + "isOsiApproved": true + }, + { + "reference": "./Abstyles.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Abstyles.json", + "referenceNumber": "80", + "name": "Abstyles License", + "licenseId": "Abstyles", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Abstyles" + ], + "isOsiApproved": false + }, + { + "reference": "./Adobe-2006.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Adobe-2006.json", + "referenceNumber": "285", + "name": "Adobe Systems Incorporated Source Code License Agreement", + "licenseId": "Adobe-2006", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/AdobeLicense" + ], + "isOsiApproved": false + }, + { + "reference": "./Adobe-Glyph.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Adobe-Glyph.json", + "referenceNumber": "107", + "name": "Adobe Glyph List License", + "licenseId": "Adobe-Glyph", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/MIT#AdobeGlyph" + ], + "isOsiApproved": false + }, + { + "reference": "./Afmparse.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Afmparse.json", + "referenceNumber": "42", + "name": "Afmparse License", + "licenseId": "Afmparse", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Afmparse" + ], + "isOsiApproved": false + }, + { + "reference": "./Aladdin.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Aladdin.json", + "referenceNumber": "258", + "name": "Aladdin Free Public License", + "licenseId": "Aladdin", + "seeAlso": [ + "http://pages.cs.wisc.edu/~ghost/doc/AFPL/6.01/Public.htm" + ], + "isOsiApproved": false + }, + { + "reference": "./Apache-1.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/Apache-1.0.json", + "referenceNumber": "237", + "name": "Apache License 1.0", + "licenseId": "Apache-1.0", + "seeAlso": [ + "http://www.apache.org/licenses/LICENSE-1.0" + ], + "isOsiApproved": false + }, + { + "reference": "./Apache-1.1.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/Apache-1.1.json", + "referenceNumber": "84", + "name": "Apache License 1.1", + "licenseId": "Apache-1.1", + "seeAlso": [ + "http://apache.org/licenses/LICENSE-1.1", + "https://opensource.org/licenses/Apache-1.1" + ], + "isOsiApproved": true + }, + { + "reference": "./Apache-2.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/Apache-2.0.json", + "referenceNumber": "26", + "name": "Apache License 2.0", + "licenseId": "Apache-2.0", + "seeAlso": [ + "http://www.apache.org/licenses/LICENSE-2.0", + "https://opensource.org/licenses/Apache-2.0" + ], + "isOsiApproved": true + }, + { + "reference": "./Artistic-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Artistic-1.0.json", + "referenceNumber": "165", + "name": "Artistic License 1.0", + "licenseId": "Artistic-1.0", + "seeAlso": [ + "https://opensource.org/licenses/Artistic-1.0" + ], + "isOsiApproved": true + }, + { + "reference": "./Artistic-1.0-Perl.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Artistic-1.0-Perl.json", + "referenceNumber": "377", + "name": "Artistic License 1.0 (Perl)", + "licenseId": "Artistic-1.0-Perl", + "seeAlso": [ + "http://dev.perl.org/licenses/artistic.html" + ], + "isOsiApproved": true + }, + { + "reference": "./Artistic-1.0-cl8.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Artistic-1.0-cl8.json", + "referenceNumber": "13", + "name": "Artistic License 1.0 w/clause 8", + "licenseId": "Artistic-1.0-cl8", + "seeAlso": [ + "https://opensource.org/licenses/Artistic-1.0" + ], + "isOsiApproved": true + }, + { + "reference": "./Artistic-2.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/Artistic-2.0.json", + "referenceNumber": "189", + "name": "Artistic License 2.0", + "licenseId": "Artistic-2.0", + "seeAlso": [ + "http://www.perlfoundation.org/artistic_license_2_0", + "https://opensource.org/licenses/artistic-license-2.0" + ], + "isOsiApproved": true + }, + { + "reference": "./BSD-1-Clause.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/BSD-1-Clause.json", + "referenceNumber": "358", + "name": "BSD 1-Clause License", + "licenseId": "BSD-1-Clause", + "seeAlso": [ + "https://svnweb.freebsd.org/base/head/include/ifaddrs.h?revision\u003d326823" + ], + "isOsiApproved": false + }, + { + "reference": "./BSD-2-Clause.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/BSD-2-Clause.json", + "referenceNumber": "325", + "name": "BSD 2-Clause \"Simplified\" License", + "licenseId": "BSD-2-Clause", + "seeAlso": [ + "https://opensource.org/licenses/BSD-2-Clause" + ], + "isOsiApproved": true + }, + { + "reference": "./BSD-2-Clause-FreeBSD.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/BSD-2-Clause-FreeBSD.json", + "referenceNumber": "121", + "name": "BSD 2-Clause FreeBSD License", + "licenseId": "BSD-2-Clause-FreeBSD", + "seeAlso": [ + "http://www.freebsd.org/copyright/freebsd-license.html" + ], + "isOsiApproved": false + }, + { + "reference": "./BSD-2-Clause-NetBSD.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/BSD-2-Clause-NetBSD.json", + "referenceNumber": "381", + "name": "BSD 2-Clause NetBSD License", + "licenseId": "BSD-2-Clause-NetBSD", + "seeAlso": [ + "http://www.netbsd.org/about/redistribution.html#default" + ], + "isOsiApproved": false + }, + { + "reference": "./BSD-2-Clause-Patent.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/BSD-2-Clause-Patent.json", + "referenceNumber": "169", + "name": "BSD-2-Clause Plus Patent License", + "licenseId": "BSD-2-Clause-Patent", + "seeAlso": [ + "https://opensource.org/licenses/BSDplusPatent" + ], + "isOsiApproved": true + }, + { + "reference": "./BSD-3-Clause.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/BSD-3-Clause.json", + "referenceNumber": "270", + "name": "BSD 3-Clause \"New\" or \"Revised\" License", + "licenseId": "BSD-3-Clause", + "seeAlso": [ + "https://opensource.org/licenses/BSD-3-Clause" + ], + "isOsiApproved": true + }, + { + "reference": "./BSD-3-Clause-Attribution.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/BSD-3-Clause-Attribution.json", + "referenceNumber": "39", + "name": "BSD with attribution", + "licenseId": "BSD-3-Clause-Attribution", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/BSD_with_Attribution" + ], + "isOsiApproved": false + }, + { + "reference": "./BSD-3-Clause-Clear.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/BSD-3-Clause-Clear.json", + "referenceNumber": "212", + "name": "BSD 3-Clause Clear License", + "licenseId": "BSD-3-Clause-Clear", + "seeAlso": [ + "http://labs.metacarta.com/license-explanation.html#license" + ], + "isOsiApproved": false + }, + { + "reference": "./BSD-3-Clause-LBNL.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/BSD-3-Clause-LBNL.json", + "referenceNumber": "337", + "name": "Lawrence Berkeley National Labs BSD variant license", + "licenseId": "BSD-3-Clause-LBNL", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/LBNLBSD" + ], + "isOsiApproved": true + }, + { + "reference": "./BSD-3-Clause-No-Nuclear-License.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/BSD-3-Clause-No-Nuclear-License.json", + "referenceNumber": "12", + "name": "BSD 3-Clause No Nuclear License", + "licenseId": "BSD-3-Clause-No-Nuclear-License", + "seeAlso": [ + "http://download.oracle.com/otn-pub/java/licenses/bsd.txt?AuthParam\u003d1467140197_43d516ce1776bd08a58235a7785be1cc" + ], + "isOsiApproved": false + }, + { + "reference": "./BSD-3-Clause-No-Nuclear-License-2014.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/BSD-3-Clause-No-Nuclear-License-2014.json", + "referenceNumber": "137", + "name": "BSD 3-Clause No Nuclear License 2014", + "licenseId": "BSD-3-Clause-No-Nuclear-License-2014", + "seeAlso": [ + "https://java.net/projects/javaeetutorial/pages/BerkeleyLicense" + ], + "isOsiApproved": false + }, + { + "reference": "./BSD-3-Clause-No-Nuclear-Warranty.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/BSD-3-Clause-No-Nuclear-Warranty.json", + "referenceNumber": "44", + "name": "BSD 3-Clause No Nuclear Warranty", + "licenseId": "BSD-3-Clause-No-Nuclear-Warranty", + "seeAlso": [ + "https://jogamp.org/git/?p\u003dgluegen.git;a\u003dblob_plain;f\u003dLICENSE.txt" + ], + "isOsiApproved": false + }, + { + "reference": "./BSD-3-Clause-Open-MPI.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/BSD-3-Clause-Open-MPI.json", + "referenceNumber": "349", + "name": "BSD 3-Clause Open MPI variant", + "licenseId": "BSD-3-Clause-Open-MPI", + "seeAlso": [ + "https://www.open-mpi.org/community/license.php", + "http://www.netlib.org/lapack/LICENSE.txt" + ], + "isOsiApproved": false + }, + { + "reference": "./BSD-4-Clause.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/BSD-4-Clause.json", + "referenceNumber": "162", + "name": "BSD 4-Clause \"Original\" or \"Old\" License", + "licenseId": "BSD-4-Clause", + "seeAlso": [ + "http://directory.fsf.org/wiki/License:BSD_4Clause" + ], + "isOsiApproved": false + }, + { + "reference": "./BSD-4-Clause-UC.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/BSD-4-Clause-UC.json", + "referenceNumber": "203", + "name": "BSD-4-Clause (University of California-Specific)", + "licenseId": "BSD-4-Clause-UC", + "seeAlso": [ + "http://www.freebsd.org/copyright/license.html" + ], + "isOsiApproved": false + }, + { + "reference": "./BSD-Protection.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/BSD-Protection.json", + "referenceNumber": "119", + "name": "BSD Protection License", + "licenseId": "BSD-Protection", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/BSD_Protection_License" + ], + "isOsiApproved": false + }, + { + "reference": "./BSD-Source-Code.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/BSD-Source-Code.json", + "referenceNumber": "308", + "name": "BSD Source Code Attribution", + "licenseId": "BSD-Source-Code", + "seeAlso": [ + "https://github.com/robbiehanson/CocoaHTTPServer/blob/master/LICENSE.txt" + ], + "isOsiApproved": false + }, + { + "reference": "./BSL-1.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/BSL-1.0.json", + "referenceNumber": "224", + "name": "Boost Software License 1.0", + "licenseId": "BSL-1.0", + "seeAlso": [ + "http://www.boost.org/LICENSE_1_0.txt", + "https://opensource.org/licenses/BSL-1.0" + ], + "isOsiApproved": true + }, + { + "reference": "./Bahyph.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Bahyph.json", + "referenceNumber": "366", + "name": "Bahyph License", + "licenseId": "Bahyph", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Bahyph" + ], + "isOsiApproved": false + }, + { + "reference": "./Barr.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Barr.json", + "referenceNumber": "333", + "name": "Barr License", + "licenseId": "Barr", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Barr" + ], + "isOsiApproved": false + }, + { + "reference": "./Beerware.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Beerware.json", + "referenceNumber": "17", + "name": "Beerware License", + "licenseId": "Beerware", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Beerware", + "https://people.freebsd.org/~phk/" + ], + "isOsiApproved": false + }, + { + "reference": "./BitTorrent-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/BitTorrent-1.0.json", + "referenceNumber": "218", + "name": "BitTorrent Open Source License v1.0", + "licenseId": "BitTorrent-1.0", + "seeAlso": [ + "http://sources.gentoo.org/cgi-bin/viewvc.cgi/gentoo-x86/licenses/BitTorrent?r1\u003d1.1\u0026r2\u003d1.1.1.1\u0026diff_format\u003ds" + ], + "isOsiApproved": false + }, + { + "reference": "./BitTorrent-1.1.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/BitTorrent-1.1.json", + "referenceNumber": "179", + "name": "BitTorrent Open Source License v1.1", + "licenseId": "BitTorrent-1.1", + "seeAlso": [ + "http://directory.fsf.org/wiki/License:BitTorrentOSL1.1" + ], + "isOsiApproved": false + }, + { + "reference": "./BlueOak-1.0.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/BlueOak-1.0.0.json", + "referenceNumber": "23", + "name": "Blue Oak Model License 1.0.0", + "licenseId": "BlueOak-1.0.0", + "seeAlso": [ + "https://blueoakcouncil.org/license/1.0.0" + ], + "isOsiApproved": false + }, + { + "reference": "./Borceux.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Borceux.json", + "referenceNumber": "311", + "name": "Borceux license", + "licenseId": "Borceux", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Borceux" + ], + "isOsiApproved": false + }, + { + "reference": "./CATOSL-1.1.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CATOSL-1.1.json", + "referenceNumber": "262", + "name": "Computer Associates Trusted Open Source License 1.1", + "licenseId": "CATOSL-1.1", + "seeAlso": [ + "https://opensource.org/licenses/CATOSL-1.1" + ], + "isOsiApproved": true + }, + { + "reference": "./CC-BY-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-1.0.json", + "referenceNumber": "128", + "name": "Creative Commons Attribution 1.0 Generic", + "licenseId": "CC-BY-1.0", + "seeAlso": [ + "https://creativecommons.org/licenses/by/1.0/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-2.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-2.0.json", + "referenceNumber": "232", + "name": "Creative Commons Attribution 2.0 Generic", + "licenseId": "CC-BY-2.0", + "seeAlso": [ + "https://creativecommons.org/licenses/by/2.0/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-2.5.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-2.5.json", + "referenceNumber": "129", + "name": "Creative Commons Attribution 2.5 Generic", + "licenseId": "CC-BY-2.5", + "seeAlso": [ + "https://creativecommons.org/licenses/by/2.5/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-3.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-3.0.json", + "referenceNumber": "256", + "name": "Creative Commons Attribution 3.0 Unported", + "licenseId": "CC-BY-3.0", + "seeAlso": [ + "https://creativecommons.org/licenses/by/3.0/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-4.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/CC-BY-4.0.json", + "referenceNumber": "330", + "name": "Creative Commons Attribution 4.0 International", + "licenseId": "CC-BY-4.0", + "seeAlso": [ + "https://creativecommons.org/licenses/by/4.0/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-NC-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-NC-1.0.json", + "referenceNumber": "130", + "name": "Creative Commons Attribution Non Commercial 1.0 Generic", + "licenseId": "CC-BY-NC-1.0", + "seeAlso": [ + "https://creativecommons.org/licenses/by-nc/1.0/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-NC-2.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-NC-2.0.json", + "referenceNumber": "244", + "name": "Creative Commons Attribution Non Commercial 2.0 Generic", + "licenseId": "CC-BY-NC-2.0", + "seeAlso": [ + "https://creativecommons.org/licenses/by-nc/2.0/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-NC-2.5.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-NC-2.5.json", + "referenceNumber": "1", + "name": "Creative Commons Attribution Non Commercial 2.5 Generic", + "licenseId": "CC-BY-NC-2.5", + "seeAlso": [ + "https://creativecommons.org/licenses/by-nc/2.5/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-NC-3.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-NC-3.0.json", + "referenceNumber": "255", + "name": "Creative Commons Attribution Non Commercial 3.0 Unported", + "licenseId": "CC-BY-NC-3.0", + "seeAlso": [ + "https://creativecommons.org/licenses/by-nc/3.0/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-NC-4.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-NC-4.0.json", + "referenceNumber": "186", + "name": "Creative Commons Attribution Non Commercial 4.0 International", + "licenseId": "CC-BY-NC-4.0", + "seeAlso": [ + "https://creativecommons.org/licenses/by-nc/4.0/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-NC-ND-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-NC-ND-1.0.json", + "referenceNumber": "59", + "name": "Creative Commons Attribution Non Commercial No Derivatives 1.0 Generic", + "licenseId": "CC-BY-NC-ND-1.0", + "seeAlso": [ + "https://creativecommons.org/licenses/by-nd-nc/1.0/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-NC-ND-2.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-NC-ND-2.0.json", + "referenceNumber": "36", + "name": "Creative Commons Attribution Non Commercial No Derivatives 2.0 Generic", + "licenseId": "CC-BY-NC-ND-2.0", + "seeAlso": [ + "https://creativecommons.org/licenses/by-nc-nd/2.0/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-NC-ND-2.5.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-NC-ND-2.5.json", + "referenceNumber": "158", + "name": "Creative Commons Attribution Non Commercial No Derivatives 2.5 Generic", + "licenseId": "CC-BY-NC-ND-2.5", + "seeAlso": [ + "https://creativecommons.org/licenses/by-nc-nd/2.5/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-NC-ND-3.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-NC-ND-3.0.json", + "referenceNumber": "48", + "name": "Creative Commons Attribution Non Commercial No Derivatives 3.0 Unported", + "licenseId": "CC-BY-NC-ND-3.0", + "seeAlso": [ + "https://creativecommons.org/licenses/by-nc-nd/3.0/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-NC-ND-4.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-NC-ND-4.0.json", + "referenceNumber": "281", + "name": "Creative Commons Attribution Non Commercial No Derivatives 4.0 International", + "licenseId": "CC-BY-NC-ND-4.0", + "seeAlso": [ + "https://creativecommons.org/licenses/by-nc-nd/4.0/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-NC-SA-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-NC-SA-1.0.json", + "referenceNumber": "178", + "name": "Creative Commons Attribution Non Commercial Share Alike 1.0 Generic", + "licenseId": "CC-BY-NC-SA-1.0", + "seeAlso": [ + "https://creativecommons.org/licenses/by-nc-sa/1.0/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-NC-SA-2.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-NC-SA-2.0.json", + "referenceNumber": "81", + "name": "Creative Commons Attribution Non Commercial Share Alike 2.0 Generic", + "licenseId": "CC-BY-NC-SA-2.0", + "seeAlso": [ + "https://creativecommons.org/licenses/by-nc-sa/2.0/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-NC-SA-2.5.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-NC-SA-2.5.json", + "referenceNumber": "62", + "name": "Creative Commons Attribution Non Commercial Share Alike 2.5 Generic", + "licenseId": "CC-BY-NC-SA-2.5", + "seeAlso": [ + "https://creativecommons.org/licenses/by-nc-sa/2.5/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-NC-SA-3.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-NC-SA-3.0.json", + "referenceNumber": "22", + "name": "Creative Commons Attribution Non Commercial Share Alike 3.0 Unported", + "licenseId": "CC-BY-NC-SA-3.0", + "seeAlso": [ + "https://creativecommons.org/licenses/by-nc-sa/3.0/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-NC-SA-4.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-NC-SA-4.0.json", + "referenceNumber": "47", + "name": "Creative Commons Attribution Non Commercial Share Alike 4.0 International", + "licenseId": "CC-BY-NC-SA-4.0", + "seeAlso": [ + "https://creativecommons.org/licenses/by-nc-sa/4.0/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-ND-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-ND-1.0.json", + "referenceNumber": "50", + "name": "Creative Commons Attribution No Derivatives 1.0 Generic", + "licenseId": "CC-BY-ND-1.0", + "seeAlso": [ + "https://creativecommons.org/licenses/by-nd/1.0/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-ND-2.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-ND-2.0.json", + "referenceNumber": "287", + "name": "Creative Commons Attribution No Derivatives 2.0 Generic", + "licenseId": "CC-BY-ND-2.0", + "seeAlso": [ + "https://creativecommons.org/licenses/by-nd/2.0/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-ND-2.5.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-ND-2.5.json", + "referenceNumber": "68", + "name": "Creative Commons Attribution No Derivatives 2.5 Generic", + "licenseId": "CC-BY-ND-2.5", + "seeAlso": [ + "https://creativecommons.org/licenses/by-nd/2.5/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-ND-3.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-ND-3.0.json", + "referenceNumber": "393", + "name": "Creative Commons Attribution No Derivatives 3.0 Unported", + "licenseId": "CC-BY-ND-3.0", + "seeAlso": [ + "https://creativecommons.org/licenses/by-nd/3.0/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-ND-4.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-ND-4.0.json", + "referenceNumber": "132", + "name": "Creative Commons Attribution No Derivatives 4.0 International", + "licenseId": "CC-BY-ND-4.0", + "seeAlso": [ + "https://creativecommons.org/licenses/by-nd/4.0/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-SA-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-SA-1.0.json", + "referenceNumber": "322", + "name": "Creative Commons Attribution Share Alike 1.0 Generic", + "licenseId": "CC-BY-SA-1.0", + "seeAlso": [ + "https://creativecommons.org/licenses/by-sa/1.0/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-SA-2.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-SA-2.0.json", + "referenceNumber": "142", + "name": "Creative Commons Attribution Share Alike 2.0 Generic", + "licenseId": "CC-BY-SA-2.0", + "seeAlso": [ + "https://creativecommons.org/licenses/by-sa/2.0/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-SA-2.5.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-SA-2.5.json", + "referenceNumber": "306", + "name": "Creative Commons Attribution Share Alike 2.5 Generic", + "licenseId": "CC-BY-SA-2.5", + "seeAlso": [ + "https://creativecommons.org/licenses/by-sa/2.5/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-SA-3.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-BY-SA-3.0.json", + "referenceNumber": "394", + "name": "Creative Commons Attribution Share Alike 3.0 Unported", + "licenseId": "CC-BY-SA-3.0", + "seeAlso": [ + "https://creativecommons.org/licenses/by-sa/3.0/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-BY-SA-4.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/CC-BY-SA-4.0.json", + "referenceNumber": "32", + "name": "Creative Commons Attribution Share Alike 4.0 International", + "licenseId": "CC-BY-SA-4.0", + "seeAlso": [ + "https://creativecommons.org/licenses/by-sa/4.0/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CC-PDDC.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CC-PDDC.json", + "referenceNumber": "371", + "name": "Creative Commons Public Domain Dedication and Certification", + "licenseId": "CC-PDDC", + "seeAlso": [ + "https://creativecommons.org/licenses/publicdomain/" + ], + "isOsiApproved": false + }, + { + "reference": "./CC0-1.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/CC0-1.0.json", + "referenceNumber": "213", + "name": "Creative Commons Zero v1.0 Universal", + "licenseId": "CC0-1.0", + "seeAlso": [ + "https://creativecommons.org/publicdomain/zero/1.0/legalcode" + ], + "isOsiApproved": false + }, + { + "reference": "./CDDL-1.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/CDDL-1.0.json", + "referenceNumber": "138", + "name": "Common Development and Distribution License 1.0", + "licenseId": "CDDL-1.0", + "seeAlso": [ + "https://opensource.org/licenses/cddl1" + ], + "isOsiApproved": true + }, + { + "reference": "./CDDL-1.1.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CDDL-1.1.json", + "referenceNumber": "376", + "name": "Common Development and Distribution License 1.1", + "licenseId": "CDDL-1.1", + "seeAlso": [ + "http://glassfish.java.net/public/CDDL+GPL_1_1.html", + "https://javaee.github.io/glassfish/LICENSE" + ], + "isOsiApproved": false + }, + { + "reference": "./CDLA-Permissive-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CDLA-Permissive-1.0.json", + "referenceNumber": "250", + "name": "Community Data License Agreement Permissive 1.0", + "licenseId": "CDLA-Permissive-1.0", + "seeAlso": [ + "https://cdla.io/permissive-1-0" + ], + "isOsiApproved": false + }, + { + "reference": "./CDLA-Sharing-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CDLA-Sharing-1.0.json", + "referenceNumber": "310", + "name": "Community Data License Agreement Sharing 1.0", + "licenseId": "CDLA-Sharing-1.0", + "seeAlso": [ + "https://cdla.io/sharing-1-0" + ], + "isOsiApproved": false + }, + { + "reference": "./CECILL-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CECILL-1.0.json", + "referenceNumber": "223", + "name": "CeCILL Free Software License Agreement v1.0", + "licenseId": "CECILL-1.0", + "seeAlso": [ + "http://www.cecill.info/licences/Licence_CeCILL_V1-fr.html" + ], + "isOsiApproved": false + }, + { + "reference": "./CECILL-1.1.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CECILL-1.1.json", + "referenceNumber": "300", + "name": "CeCILL Free Software License Agreement v1.1", + "licenseId": "CECILL-1.1", + "seeAlso": [ + "http://www.cecill.info/licences/Licence_CeCILL_V1.1-US.html" + ], + "isOsiApproved": false + }, + { + "reference": "./CECILL-2.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/CECILL-2.0.json", + "referenceNumber": "352", + "name": "CeCILL Free Software License Agreement v2.0", + "licenseId": "CECILL-2.0", + "seeAlso": [ + "http://www.cecill.info/licences/Licence_CeCILL_V2-en.html" + ], + "isOsiApproved": false + }, + { + "reference": "./CECILL-2.1.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CECILL-2.1.json", + "referenceNumber": "120", + "name": "CeCILL Free Software License Agreement v2.1", + "licenseId": "CECILL-2.1", + "seeAlso": [ + "http://www.cecill.info/licences/Licence_CeCILL_V2.1-en.html" + ], + "isOsiApproved": true + }, + { + "reference": "./CECILL-B.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/CECILL-B.json", + "referenceNumber": "340", + "name": "CeCILL-B Free Software License Agreement", + "licenseId": "CECILL-B", + "seeAlso": [ + "http://www.cecill.info/licences/Licence_CeCILL-B_V1-en.html" + ], + "isOsiApproved": false + }, + { + "reference": "./CECILL-C.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/CECILL-C.json", + "referenceNumber": "77", + "name": "CeCILL-C Free Software License Agreement", + "licenseId": "CECILL-C", + "seeAlso": [ + "http://www.cecill.info/licences/Licence_CeCILL-C_V1-en.html" + ], + "isOsiApproved": false + }, + { + "reference": "./CERN-OHL-1.1.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CERN-OHL-1.1.json", + "referenceNumber": "341", + "name": "CERN Open Hardware License v1.1", + "licenseId": "CERN-OHL-1.1", + "seeAlso": [ + "https://www.ohwr.org/project/licenses/wikis/cern-ohl-v1.1" + ], + "isOsiApproved": false + }, + { + "reference": "./CERN-OHL-1.2.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CERN-OHL-1.2.json", + "referenceNumber": "3", + "name": "CERN Open Hardware Licence v1.2", + "licenseId": "CERN-OHL-1.2", + "seeAlso": [ + "https://www.ohwr.org/project/licenses/wikis/cern-ohl-v1.2" + ], + "isOsiApproved": false + }, + { + "reference": "./CNRI-Jython.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CNRI-Jython.json", + "referenceNumber": "94", + "name": "CNRI Jython License", + "licenseId": "CNRI-Jython", + "seeAlso": [ + "http://www.jython.org/license.html" + ], + "isOsiApproved": false + }, + { + "reference": "./CNRI-Python.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CNRI-Python.json", + "referenceNumber": "45", + "name": "CNRI Python License", + "licenseId": "CNRI-Python", + "seeAlso": [ + "https://opensource.org/licenses/CNRI-Python" + ], + "isOsiApproved": true + }, + { + "reference": "./CNRI-Python-GPL-Compatible.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CNRI-Python-GPL-Compatible.json", + "referenceNumber": "202", + "name": "CNRI Python Open Source GPL Compatible License Agreement", + "licenseId": "CNRI-Python-GPL-Compatible", + "seeAlso": [ + "http://www.python.org/download/releases/1.6.1/download_win/" + ], + "isOsiApproved": false + }, + { + "reference": "./CPAL-1.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/CPAL-1.0.json", + "referenceNumber": "170", + "name": "Common Public Attribution License 1.0", + "licenseId": "CPAL-1.0", + "seeAlso": [ + "https://opensource.org/licenses/CPAL-1.0" + ], + "isOsiApproved": true + }, + { + "reference": "./CPL-1.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/CPL-1.0.json", + "referenceNumber": "172", + "name": "Common Public License 1.0", + "licenseId": "CPL-1.0", + "seeAlso": [ + "https://opensource.org/licenses/CPL-1.0" + ], + "isOsiApproved": true + }, + { + "reference": "./CPOL-1.02.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CPOL-1.02.json", + "referenceNumber": "28", + "name": "Code Project Open License 1.02", + "licenseId": "CPOL-1.02", + "seeAlso": [ + "http://www.codeproject.com/info/cpol10.aspx" + ], + "isOsiApproved": false + }, + { + "reference": "./CUA-OPL-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CUA-OPL-1.0.json", + "referenceNumber": "365", + "name": "CUA Office Public License v1.0", + "licenseId": "CUA-OPL-1.0", + "seeAlso": [ + "https://opensource.org/licenses/CUA-OPL-1.0" + ], + "isOsiApproved": true + }, + { + "reference": "./Caldera.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Caldera.json", + "referenceNumber": "108", + "name": "Caldera License", + "licenseId": "Caldera", + "seeAlso": [ + "http://www.lemis.com/grog/UNIX/ancient-source-all.pdf" + ], + "isOsiApproved": false + }, + { + "reference": "./ClArtistic.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/ClArtistic.json", + "referenceNumber": "271", + "name": "Clarified Artistic License", + "licenseId": "ClArtistic", + "seeAlso": [ + "http://gianluca.dellavedova.org/2011/01/03/clarified-artistic-license/", + "http://www.ncftp.com/ncftp/doc/LICENSE.txt" + ], + "isOsiApproved": false + }, + { + "reference": "./Condor-1.1.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/Condor-1.1.json", + "referenceNumber": "307", + "name": "Condor Public License v1.1", + "licenseId": "Condor-1.1", + "seeAlso": [ + "http://research.cs.wisc.edu/condor/license.html#condor", + "http://web.archive.org/web/20111123062036/http://research.cs.wisc.edu/condor/license.html#condor" + ], + "isOsiApproved": false + }, + { + "reference": "./Crossword.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Crossword.json", + "referenceNumber": "363", + "name": "Crossword License", + "licenseId": "Crossword", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Crossword" + ], + "isOsiApproved": false + }, + { + "reference": "./CrystalStacker.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/CrystalStacker.json", + "referenceNumber": "168", + "name": "CrystalStacker License", + "licenseId": "CrystalStacker", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing:CrystalStacker?rd\u003dLicensing/CrystalStacker" + ], + "isOsiApproved": false + }, + { + "reference": "./Cube.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Cube.json", + "referenceNumber": "370", + "name": "Cube License", + "licenseId": "Cube", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Cube" + ], + "isOsiApproved": false + }, + { + "reference": "./D-FSL-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/D-FSL-1.0.json", + "referenceNumber": "182", + "name": "Deutsche Freie Software Lizenz", + "licenseId": "D-FSL-1.0", + "seeAlso": [ + "http://www.dipp.nrw.de/d-fsl/lizenzen/", + "http://www.dipp.nrw.de/d-fsl/index_html/lizenzen/de/D-FSL-1_0_de.txt", + "http://www.dipp.nrw.de/d-fsl/index_html/lizenzen/en/D-FSL-1_0_en.txt", + "https://www.hbz-nrw.de/produkte/open-access/lizenzen/dfsl", + "https://www.hbz-nrw.de/produkte/open-access/lizenzen/dfsl/deutsche-freie-software-lizenz", + "https://www.hbz-nrw.de/produkte/open-access/lizenzen/dfsl/german-free-software-license", + "https://www.hbz-nrw.de/produkte/open-access/lizenzen/dfsl/D-FSL-1_0_de.txt/at_download/file", + "https://www.hbz-nrw.de/produkte/open-access/lizenzen/dfsl/D-FSL-1_0_en.txt/at_download/file" + ], + "isOsiApproved": false + }, + { + "reference": "./DOC.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/DOC.json", + "referenceNumber": "160", + "name": "DOC License", + "licenseId": "DOC", + "seeAlso": [ + "http://www.cs.wustl.edu/~schmidt/ACE-copying.html" + ], + "isOsiApproved": false + }, + { + "reference": "./DSDP.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/DSDP.json", + "referenceNumber": "141", + "name": "DSDP License", + "licenseId": "DSDP", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/DSDP" + ], + "isOsiApproved": false + }, + { + "reference": "./Dotseqn.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Dotseqn.json", + "referenceNumber": "390", + "name": "Dotseqn License", + "licenseId": "Dotseqn", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Dotseqn" + ], + "isOsiApproved": false + }, + { + "reference": "./ECL-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/ECL-1.0.json", + "referenceNumber": "396", + "name": "Educational Community License v1.0", + "licenseId": "ECL-1.0", + "seeAlso": [ + "https://opensource.org/licenses/ECL-1.0" + ], + "isOsiApproved": true + }, + { + "reference": "./ECL-2.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/ECL-2.0.json", + "referenceNumber": "298", + "name": "Educational Community License v2.0", + "licenseId": "ECL-2.0", + "seeAlso": [ + "https://opensource.org/licenses/ECL-2.0" + ], + "isOsiApproved": true + }, + { + "reference": "./EFL-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/EFL-1.0.json", + "referenceNumber": "150", + "name": "Eiffel Forum License v1.0", + "licenseId": "EFL-1.0", + "seeAlso": [ + "http://www.eiffel-nice.org/license/forum.txt", + "https://opensource.org/licenses/EFL-1.0" + ], + "isOsiApproved": true + }, + { + "reference": "./EFL-2.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/EFL-2.0.json", + "referenceNumber": "161", + "name": "Eiffel Forum License v2.0", + "licenseId": "EFL-2.0", + "seeAlso": [ + "http://www.eiffel-nice.org/license/eiffel-forum-license-2.html", + "https://opensource.org/licenses/EFL-2.0" + ], + "isOsiApproved": true + }, + { + "reference": "./EPL-1.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/EPL-1.0.json", + "referenceNumber": "214", + "name": "Eclipse Public License 1.0", + "licenseId": "EPL-1.0", + "seeAlso": [ + "http://www.eclipse.org/legal/epl-v10.html", + "https://opensource.org/licenses/EPL-1.0" + ], + "isOsiApproved": true + }, + { + "reference": "./EPL-2.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/EPL-2.0.json", + "referenceNumber": "134", + "name": "Eclipse Public License 2.0", + "licenseId": "EPL-2.0", + "seeAlso": [ + "https://www.eclipse.org/legal/epl-2.0", + "https://www.opensource.org/licenses/EPL-2.0" + ], + "isOsiApproved": true + }, + { + "reference": "./EUDatagrid.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/EUDatagrid.json", + "referenceNumber": "192", + "name": "EU DataGrid Software License", + "licenseId": "EUDatagrid", + "seeAlso": [ + "http://eu-datagrid.web.cern.ch/eu-datagrid/license.html", + "https://opensource.org/licenses/EUDatagrid" + ], + "isOsiApproved": true + }, + { + "reference": "./EUPL-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/EUPL-1.0.json", + "referenceNumber": "173", + "name": "European Union Public License 1.0", + "licenseId": "EUPL-1.0", + "seeAlso": [ + "http://ec.europa.eu/idabc/en/document/7330.html", + "http://ec.europa.eu/idabc/servlets/Doc027f.pdf?id\u003d31096" + ], + "isOsiApproved": false + }, + { + "reference": "./EUPL-1.1.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/EUPL-1.1.json", + "referenceNumber": "92", + "name": "European Union Public License 1.1", + "licenseId": "EUPL-1.1", + "seeAlso": [ + "https://joinup.ec.europa.eu/software/page/eupl/licence-eupl", + "https://joinup.ec.europa.eu/sites/default/files/custom-page/attachment/eupl1.1.-licence-en_0.pdf", + "https://opensource.org/licenses/EUPL-1.1" + ], + "isOsiApproved": true + }, + { + "reference": "./EUPL-1.2.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/EUPL-1.2.json", + "referenceNumber": "387", + "name": "European Union Public License 1.2", + "licenseId": "EUPL-1.2", + "seeAlso": [ + "https://joinup.ec.europa.eu/page/eupl-text-11-12", + "https://joinup.ec.europa.eu/sites/default/files/custom-page/attachment/eupl_v1.2_en.pdf", + "https://joinup.ec.europa.eu/sites/default/files/inline-files/EUPL%20v1_2%20EN(1).txt", + "http://eur-lex.europa.eu/legal-content/EN/TXT/HTML/?uri\u003dCELEX:32017D0863", + "https://opensource.org/licenses/EUPL-1.1" + ], + "isOsiApproved": true + }, + { + "reference": "./Entessa.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Entessa.json", + "referenceNumber": "99", + "name": "Entessa Public License v1.0", + "licenseId": "Entessa", + "seeAlso": [ + "https://opensource.org/licenses/Entessa" + ], + "isOsiApproved": true + }, + { + "reference": "./ErlPL-1.1.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/ErlPL-1.1.json", + "referenceNumber": "157", + "name": "Erlang Public License v1.1", + "licenseId": "ErlPL-1.1", + "seeAlso": [ + "http://www.erlang.org/EPLICENSE" + ], + "isOsiApproved": false + }, + { + "reference": "./Eurosym.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Eurosym.json", + "referenceNumber": "113", + "name": "Eurosym License", + "licenseId": "Eurosym", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Eurosym" + ], + "isOsiApproved": false + }, + { + "reference": "./FSFAP.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/FSFAP.json", + "referenceNumber": "114", + "name": "FSF All Permissive License", + "licenseId": "FSFAP", + "seeAlso": [ + "https://www.gnu.org/prep/maintain/html_node/License-Notices-for-Other-Files.html" + ], + "isOsiApproved": false + }, + { + "reference": "./FSFUL.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/FSFUL.json", + "referenceNumber": "193", + "name": "FSF Unlimited License", + "licenseId": "FSFUL", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/FSF_Unlimited_License" + ], + "isOsiApproved": false + }, + { + "reference": "./FSFULLR.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/FSFULLR.json", + "referenceNumber": "43", + "name": "FSF Unlimited License (with License Retention)", + "licenseId": "FSFULLR", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/FSF_Unlimited_License#License_Retention_Variant" + ], + "isOsiApproved": false + }, + { + "reference": "./FTL.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/FTL.json", + "referenceNumber": "240", + "name": "Freetype Project License", + "licenseId": "FTL", + "seeAlso": [ + "http://freetype.fis.uniroma2.it/FTL.TXT", + "http://git.savannah.gnu.org/cgit/freetype/freetype2.git/tree/docs/FTL.TXT" + ], + "isOsiApproved": false + }, + { + "reference": "./Fair.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Fair.json", + "referenceNumber": "297", + "name": "Fair License", + "licenseId": "Fair", + "seeAlso": [ + "http://fairlicense.org/", + "https://opensource.org/licenses/Fair" + ], + "isOsiApproved": true + }, + { + "reference": "./Frameworx-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Frameworx-1.0.json", + "referenceNumber": "389", + "name": "Frameworx Open License 1.0", + "licenseId": "Frameworx-1.0", + "seeAlso": [ + "https://opensource.org/licenses/Frameworx-1.0" + ], + "isOsiApproved": true + }, + { + "reference": "./FreeImage.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/FreeImage.json", + "referenceNumber": "277", + "name": "FreeImage Public License v1.0", + "licenseId": "FreeImage", + "seeAlso": [ + "http://freeimage.sourceforge.net/freeimage-license.txt" + ], + "isOsiApproved": false + }, + { + "reference": "./GFDL-1.1.html", + "isDeprecatedLicenseId": true, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/GFDL-1.1.json", + "referenceNumber": "98", + "name": "GNU Free Documentation License v1.1", + "licenseId": "GFDL-1.1", + "seeAlso": [ + "https://www.gnu.org/licenses/old-licenses/fdl-1.1.txt" + ], + "isOsiApproved": false + }, + { + "reference": "./GFDL-1.1-only.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/GFDL-1.1-only.json", + "referenceNumber": "102", + "name": "GNU Free Documentation License v1.1 only", + "licenseId": "GFDL-1.1-only", + "seeAlso": [ + "https://www.gnu.org/licenses/old-licenses/fdl-1.1.txt" + ], + "isOsiApproved": false + }, + { + "reference": "./GFDL-1.1-or-later.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/GFDL-1.1-or-later.json", + "referenceNumber": "348", + "name": "GNU Free Documentation License v1.1 or later", + "licenseId": "GFDL-1.1-or-later", + "seeAlso": [ + "https://www.gnu.org/licenses/old-licenses/fdl-1.1.txt" + ], + "isOsiApproved": false + }, + { + "reference": "./GFDL-1.2.html", + "isDeprecatedLicenseId": true, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/GFDL-1.2.json", + "referenceNumber": "197", + "name": "GNU Free Documentation License v1.2", + "licenseId": "GFDL-1.2", + "seeAlso": [ + "https://www.gnu.org/licenses/old-licenses/fdl-1.2.txt" + ], + "isOsiApproved": false + }, + { + "reference": "./GFDL-1.2-only.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/GFDL-1.2-only.json", + "referenceNumber": "236", + "name": "GNU Free Documentation License v1.2 only", + "licenseId": "GFDL-1.2-only", + "seeAlso": [ + "https://www.gnu.org/licenses/old-licenses/fdl-1.2.txt" + ], + "isOsiApproved": false + }, + { + "reference": "./GFDL-1.2-or-later.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/GFDL-1.2-or-later.json", + "referenceNumber": "215", + "name": "GNU Free Documentation License v1.2 or later", + "licenseId": "GFDL-1.2-or-later", + "seeAlso": [ + "https://www.gnu.org/licenses/old-licenses/fdl-1.2.txt" + ], + "isOsiApproved": false + }, + { + "reference": "./GFDL-1.3.html", + "isDeprecatedLicenseId": true, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/GFDL-1.3.json", + "referenceNumber": "112", + "name": "GNU Free Documentation License v1.3", + "licenseId": "GFDL-1.3", + "seeAlso": [ + "https://www.gnu.org/licenses/fdl-1.3.txt" + ], + "isOsiApproved": false + }, + { + "reference": "./GFDL-1.3-only.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/GFDL-1.3-only.json", + "referenceNumber": "69", + "name": "GNU Free Documentation License v1.3 only", + "licenseId": "GFDL-1.3-only", + "seeAlso": [ + "https://www.gnu.org/licenses/fdl-1.3.txt" + ], + "isOsiApproved": false + }, + { + "reference": "./GFDL-1.3-or-later.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/GFDL-1.3-or-later.json", + "referenceNumber": "4", + "name": "GNU Free Documentation License v1.3 or later", + "licenseId": "GFDL-1.3-or-later", + "seeAlso": [ + "https://www.gnu.org/licenses/fdl-1.3.txt" + ], + "isOsiApproved": false + }, + { + "reference": "./GL2PS.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/GL2PS.json", + "referenceNumber": "124", + "name": "GL2PS License", + "licenseId": "GL2PS", + "seeAlso": [ + "http://www.geuz.org/gl2ps/COPYING.GL2PS" + ], + "isOsiApproved": false + }, + { + "reference": "./GPL-1.0.html", + "isDeprecatedLicenseId": true, + "detailsUrl": "http://spdx.org/licenses/GPL-1.0.json", + "referenceNumber": "79", + "name": "GNU General Public License v1.0 only", + "licenseId": "GPL-1.0", + "seeAlso": [ + "https://www.gnu.org/licenses/old-licenses/gpl-1.0-standalone.html" + ], + "isOsiApproved": false + }, + { + "reference": "./GPL-1.0+.html", + "isDeprecatedLicenseId": true, + "detailsUrl": "http://spdx.org/licenses/GPL-1.0+.json", + "referenceNumber": "175", + "name": "GNU General Public License v1.0 or later", + "licenseId": "GPL-1.0+", + "seeAlso": [ + "https://www.gnu.org/licenses/old-licenses/gpl-1.0-standalone.html" + ], + "isOsiApproved": false + }, + { + "reference": "./GPL-1.0-only.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/GPL-1.0-only.json", + "referenceNumber": "15", + "name": "GNU General Public License v1.0 only", + "licenseId": "GPL-1.0-only", + "seeAlso": [ + "https://www.gnu.org/licenses/old-licenses/gpl-1.0-standalone.html" + ], + "isOsiApproved": false + }, + { + "reference": "./GPL-1.0-or-later.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/GPL-1.0-or-later.json", + "referenceNumber": "357", + "name": "GNU General Public License v1.0 or later", + "licenseId": "GPL-1.0-or-later", + "seeAlso": [ + "https://www.gnu.org/licenses/old-licenses/gpl-1.0-standalone.html" + ], + "isOsiApproved": false + }, + { + "reference": "./GPL-2.0.html", + "isDeprecatedLicenseId": true, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/GPL-2.0.json", + "referenceNumber": "147", + "name": "GNU General Public License v2.0 only", + "licenseId": "GPL-2.0", + "seeAlso": [ + "https://www.gnu.org/licenses/old-licenses/gpl-2.0-standalone.html", + "https://opensource.org/licenses/GPL-2.0" + ], + "isOsiApproved": true + }, + { + "reference": "./GPL-2.0+.html", + "isDeprecatedLicenseId": true, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/GPL-2.0+.json", + "referenceNumber": "75", + "name": "GNU General Public License v2.0 or later", + "licenseId": "GPL-2.0+", + "seeAlso": [ + "https://www.gnu.org/licenses/old-licenses/gpl-2.0-standalone.html", + "https://opensource.org/licenses/GPL-2.0" + ], + "isOsiApproved": true + }, + { + "reference": "./GPL-2.0-only.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/GPL-2.0-only.json", + "referenceNumber": "233", + "name": "GNU General Public License v2.0 only", + "licenseId": "GPL-2.0-only", + "seeAlso": [ + "https://www.gnu.org/licenses/old-licenses/gpl-2.0-standalone.html", + "https://opensource.org/licenses/GPL-2.0" + ], + "isOsiApproved": true + }, + { + "reference": "./GPL-2.0-or-later.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/GPL-2.0-or-later.json", + "referenceNumber": "56", + "name": "GNU General Public License v2.0 or later", + "licenseId": "GPL-2.0-or-later", + "seeAlso": [ + "https://www.gnu.org/licenses/old-licenses/gpl-2.0-standalone.html", + "https://opensource.org/licenses/GPL-2.0" + ], + "isOsiApproved": true + }, + { + "reference": "./GPL-2.0-with-GCC-exception.html", + "isDeprecatedLicenseId": true, + "detailsUrl": "http://spdx.org/licenses/GPL-2.0-with-GCC-exception.json", + "referenceNumber": "117", + "name": "GNU General Public License v2.0 w/GCC Runtime Library exception", + "licenseId": "GPL-2.0-with-GCC-exception", + "seeAlso": [ + "https://gcc.gnu.org/git/?p\u003dgcc.git;a\u003dblob;f\u003dgcc/libgcc1.c;h\u003d762f5143fc6eed57b6797c82710f3538aa52b40b;hb\u003dcb143a3ce4fb417c68f5fa2691a1b1b1053dfba9#l10" + ], + "isOsiApproved": false + }, + { + "reference": "./GPL-2.0-with-autoconf-exception.html", + "isDeprecatedLicenseId": true, + "detailsUrl": "http://spdx.org/licenses/GPL-2.0-with-autoconf-exception.json", + "referenceNumber": "355", + "name": "GNU General Public License v2.0 w/Autoconf exception", + "licenseId": "GPL-2.0-with-autoconf-exception", + "seeAlso": [ + "http://ac-archive.sourceforge.net/doc/copyright.html" + ], + "isOsiApproved": false + }, + { + "reference": "./GPL-2.0-with-bison-exception.html", + "isDeprecatedLicenseId": true, + "detailsUrl": "http://spdx.org/licenses/GPL-2.0-with-bison-exception.json", + "referenceNumber": "378", + "name": "GNU General Public License v2.0 w/Bison exception", + "licenseId": "GPL-2.0-with-bison-exception", + "seeAlso": [ + "http://git.savannah.gnu.org/cgit/bison.git/tree/data/yacc.c?id\u003d193d7c7054ba7197b0789e14965b739162319b5e#n141" + ], + "isOsiApproved": false + }, + { + "reference": "./GPL-2.0-with-classpath-exception.html", + "isDeprecatedLicenseId": true, + "detailsUrl": "http://spdx.org/licenses/GPL-2.0-with-classpath-exception.json", + "referenceNumber": "60", + "name": "GNU General Public License v2.0 w/Classpath exception", + "licenseId": "GPL-2.0-with-classpath-exception", + "seeAlso": [ + "https://www.gnu.org/software/classpath/license.html" + ], + "isOsiApproved": false + }, + { + "reference": "./GPL-2.0-with-font-exception.html", + "isDeprecatedLicenseId": true, + "detailsUrl": "http://spdx.org/licenses/GPL-2.0-with-font-exception.json", + "referenceNumber": "375", + "name": "GNU General Public License v2.0 w/Font exception", + "licenseId": "GPL-2.0-with-font-exception", + "seeAlso": [ + "https://www.gnu.org/licenses/gpl-faq.html#FontException" + ], + "isOsiApproved": false + }, + { + "reference": "./GPL-3.0.html", + "isDeprecatedLicenseId": true, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/GPL-3.0.json", + "referenceNumber": "242", + "name": "GNU General Public License v3.0 only", + "licenseId": "GPL-3.0", + "seeAlso": [ + "https://www.gnu.org/licenses/gpl-3.0-standalone.html", + "https://opensource.org/licenses/GPL-3.0" + ], + "isOsiApproved": true + }, + { + "reference": "./GPL-3.0+.html", + "isDeprecatedLicenseId": true, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/GPL-3.0+.json", + "referenceNumber": "73", + "name": "GNU General Public License v3.0 or later", + "licenseId": "GPL-3.0+", + "seeAlso": [ + "https://www.gnu.org/licenses/gpl-3.0-standalone.html", + "https://opensource.org/licenses/GPL-3.0" + ], + "isOsiApproved": true + }, + { + "reference": "./GPL-3.0-only.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/GPL-3.0-only.json", + "referenceNumber": "206", + "name": "GNU General Public License v3.0 only", + "licenseId": "GPL-3.0-only", + "seeAlso": [ + "https://www.gnu.org/licenses/gpl-3.0-standalone.html", + "https://opensource.org/licenses/GPL-3.0" + ], + "isOsiApproved": true + }, + { + "reference": "./GPL-3.0-or-later.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/GPL-3.0-or-later.json", + "referenceNumber": "196", + "name": "GNU General Public License v3.0 or later", + "licenseId": "GPL-3.0-or-later", + "seeAlso": [ + "https://www.gnu.org/licenses/gpl-3.0-standalone.html", + "https://opensource.org/licenses/GPL-3.0" + ], + "isOsiApproved": true + }, + { + "reference": "./GPL-3.0-with-GCC-exception.html", + "isDeprecatedLicenseId": true, + "detailsUrl": "http://spdx.org/licenses/GPL-3.0-with-GCC-exception.json", + "referenceNumber": "221", + "name": "GNU General Public License v3.0 w/GCC Runtime Library exception", + "licenseId": "GPL-3.0-with-GCC-exception", + "seeAlso": [ + "https://www.gnu.org/licenses/gcc-exception-3.1.html" + ], + "isOsiApproved": true + }, + { + "reference": "./GPL-3.0-with-autoconf-exception.html", + "isDeprecatedLicenseId": true, + "detailsUrl": "http://spdx.org/licenses/GPL-3.0-with-autoconf-exception.json", + "referenceNumber": "235", + "name": "GNU General Public License v3.0 w/Autoconf exception", + "licenseId": "GPL-3.0-with-autoconf-exception", + "seeAlso": [ + "https://www.gnu.org/licenses/autoconf-exception-3.0.html" + ], + "isOsiApproved": false + }, + { + "reference": "./Giftware.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Giftware.json", + "referenceNumber": "369", + "name": "Giftware License", + "licenseId": "Giftware", + "seeAlso": [ + "http://liballeg.org/license.html#allegro-4-the-giftware-license" + ], + "isOsiApproved": false + }, + { + "reference": "./Glide.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Glide.json", + "referenceNumber": "374", + "name": "3dfx Glide License", + "licenseId": "Glide", + "seeAlso": [ + "http://www.users.on.net/~triforce/glidexp/COPYING.txt" + ], + "isOsiApproved": false + }, + { + "reference": "./Glulxe.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Glulxe.json", + "referenceNumber": "93", + "name": "Glulxe License", + "licenseId": "Glulxe", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Glulxe" + ], + "isOsiApproved": false + }, + { + "reference": "./HPND.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/HPND.json", + "referenceNumber": "264", + "name": "Historical Permission Notice and Disclaimer", + "licenseId": "HPND", + "seeAlso": [ + "https://opensource.org/licenses/HPND" + ], + "isOsiApproved": true + }, + { + "reference": "./HPND-sell-variant.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/HPND-sell-variant.json", + "referenceNumber": "145", + "name": "Historical Permission Notice and Disclaimer - sell variant", + "licenseId": "HPND-sell-variant", + "seeAlso": [ + "https://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux.git/tree/net/sunrpc/auth_gss/gss_generic_token.c?h\u003dv4.19" + ], + "isOsiApproved": false + }, + { + "reference": "./HaskellReport.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/HaskellReport.json", + "referenceNumber": "122", + "name": "Haskell Language Report License", + "licenseId": "HaskellReport", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Haskell_Language_Report_License" + ], + "isOsiApproved": false + }, + { + "reference": "./IBM-pibs.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/IBM-pibs.json", + "referenceNumber": "207", + "name": "IBM PowerPC Initialization and Boot Software", + "licenseId": "IBM-pibs", + "seeAlso": [ + "http://git.denx.de/?p\u003du-boot.git;a\u003dblob;f\u003darch/powerpc/cpu/ppc4xx/miiphy.c;h\u003d297155fdafa064b955e53e9832de93bfb0cfb85b;hb\u003d9fab4bf4cc077c21e43941866f3f2c196f28670d" + ], + "isOsiApproved": false + }, + { + "reference": "./ICU.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/ICU.json", + "referenceNumber": "194", + "name": "ICU License", + "licenseId": "ICU", + "seeAlso": [ + "http://source.icu-project.org/repos/icu/icu/trunk/license.html" + ], + "isOsiApproved": false + }, + { + "reference": "./IJG.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/IJG.json", + "referenceNumber": "55", + "name": "Independent JPEG Group License", + "licenseId": "IJG", + "seeAlso": [ + "http://dev.w3.org/cvsweb/Amaya/libjpeg/Attic/README?rev\u003d1.2" + ], + "isOsiApproved": false + }, + { + "reference": "./IPA.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/IPA.json", + "referenceNumber": "312", + "name": "IPA Font License", + "licenseId": "IPA", + "seeAlso": [ + "https://opensource.org/licenses/IPA" + ], + "isOsiApproved": true + }, + { + "reference": "./IPL-1.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/IPL-1.0.json", + "referenceNumber": "31", + "name": "IBM Public License v1.0", + "licenseId": "IPL-1.0", + "seeAlso": [ + "https://opensource.org/licenses/IPL-1.0" + ], + "isOsiApproved": true + }, + { + "reference": "./ISC.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/ISC.json", + "referenceNumber": "110", + "name": "ISC License", + "licenseId": "ISC", + "seeAlso": [ + "https://www.isc.org/downloads/software-support-policy/isc-license/", + "https://opensource.org/licenses/ISC" + ], + "isOsiApproved": true + }, + { + "reference": "./ImageMagick.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/ImageMagick.json", + "referenceNumber": "231", + "name": "ImageMagick License", + "licenseId": "ImageMagick", + "seeAlso": [ + "http://www.imagemagick.org/script/license.php" + ], + "isOsiApproved": false + }, + { + "reference": "./Imlib2.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/Imlib2.json", + "referenceNumber": "257", + "name": "Imlib2 License", + "licenseId": "Imlib2", + "seeAlso": [ + "http://trac.enlightenment.org/e/browser/trunk/imlib2/COPYING", + "https://git.enlightenment.org/legacy/imlib2.git/tree/COPYING" + ], + "isOsiApproved": false + }, + { + "reference": "./Info-ZIP.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Info-ZIP.json", + "referenceNumber": "104", + "name": "Info-ZIP License", + "licenseId": "Info-ZIP", + "seeAlso": [ + "http://www.info-zip.org/license.html" + ], + "isOsiApproved": false + }, + { + "reference": "./Intel.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/Intel.json", + "referenceNumber": "167", + "name": "Intel Open Source License", + "licenseId": "Intel", + "seeAlso": [ + "https://opensource.org/licenses/Intel" + ], + "isOsiApproved": true + }, + { + "reference": "./Intel-ACPI.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Intel-ACPI.json", + "referenceNumber": "88", + "name": "Intel ACPI Software License Agreement", + "licenseId": "Intel-ACPI", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Intel_ACPI_Software_License_Agreement" + ], + "isOsiApproved": false + }, + { + "reference": "./Interbase-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Interbase-1.0.json", + "referenceNumber": "83", + "name": "Interbase Public License v1.0", + "licenseId": "Interbase-1.0", + "seeAlso": [ + "https://web.archive.org/web/20060319014854/http://info.borland.com/devsupport/interbase/opensource/IPL.html" + ], + "isOsiApproved": false + }, + { + "reference": "./JPNIC.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/JPNIC.json", + "referenceNumber": "105", + "name": "Japan Network Information Center License", + "licenseId": "JPNIC", + "seeAlso": [ + "https://gitlab.isc.org/isc-projects/bind9/blob/master/COPYRIGHT#L366" + ], + "isOsiApproved": false + }, + { + "reference": "./JSON.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/JSON.json", + "referenceNumber": "372", + "name": "JSON License", + "licenseId": "JSON", + "seeAlso": [ + "http://www.json.org/license.html" + ], + "isOsiApproved": false + }, + { + "reference": "./JasPer-2.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/JasPer-2.0.json", + "referenceNumber": "239", + "name": "JasPer License", + "licenseId": "JasPer-2.0", + "seeAlso": [ + "http://www.ece.uvic.ca/~mdadams/jasper/LICENSE" + ], + "isOsiApproved": false + }, + { + "reference": "./LAL-1.2.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/LAL-1.2.json", + "referenceNumber": "380", + "name": "Licence Art Libre 1.2", + "licenseId": "LAL-1.2", + "seeAlso": [ + "http://artlibre.org/licence/lal/licence-art-libre-12/" + ], + "isOsiApproved": false + }, + { + "reference": "./LAL-1.3.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/LAL-1.3.json", + "referenceNumber": "156", + "name": "Licence Art Libre 1.3", + "licenseId": "LAL-1.3", + "seeAlso": [ + "http://artlibre.org/" + ], + "isOsiApproved": false + }, + { + "reference": "./LGPL-2.0.html", + "isDeprecatedLicenseId": true, + "detailsUrl": "http://spdx.org/licenses/LGPL-2.0.json", + "referenceNumber": "268", + "name": "GNU Library General Public License v2 only", + "licenseId": "LGPL-2.0", + "seeAlso": [ + "https://www.gnu.org/licenses/old-licenses/lgpl-2.0-standalone.html" + ], + "isOsiApproved": true + }, + { + "reference": "./LGPL-2.0+.html", + "isDeprecatedLicenseId": true, + "detailsUrl": "http://spdx.org/licenses/LGPL-2.0+.json", + "referenceNumber": "52", + "name": "GNU Library General Public License v2 or later", + "licenseId": "LGPL-2.0+", + "seeAlso": [ + "https://www.gnu.org/licenses/old-licenses/lgpl-2.0-standalone.html" + ], + "isOsiApproved": true + }, + { + "reference": "./LGPL-2.0-only.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/LGPL-2.0-only.json", + "referenceNumber": "276", + "name": "GNU Library General Public License v2 only", + "licenseId": "LGPL-2.0-only", + "seeAlso": [ + "https://www.gnu.org/licenses/old-licenses/lgpl-2.0-standalone.html" + ], + "isOsiApproved": true + }, + { + "reference": "./LGPL-2.0-or-later.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/LGPL-2.0-or-later.json", + "referenceNumber": "217", + "name": "GNU Library General Public License v2 or later", + "licenseId": "LGPL-2.0-or-later", + "seeAlso": [ + "https://www.gnu.org/licenses/old-licenses/lgpl-2.0-standalone.html" + ], + "isOsiApproved": true + }, + { + "reference": "./LGPL-2.1.html", + "isDeprecatedLicenseId": true, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/LGPL-2.1.json", + "referenceNumber": "166", + "name": "GNU Lesser General Public License v2.1 only", + "licenseId": "LGPL-2.1", + "seeAlso": [ + "https://www.gnu.org/licenses/old-licenses/lgpl-2.1-standalone.html", + "https://opensource.org/licenses/LGPL-2.1" + ], + "isOsiApproved": true + }, + { + "reference": "./LGPL-2.1+.html", + "isDeprecatedLicenseId": true, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/LGPL-2.1+.json", + "referenceNumber": "64", + "name": "GNU Library General Public License v2.1 or later", + "licenseId": "LGPL-2.1+", + "seeAlso": [ + "https://www.gnu.org/licenses/old-licenses/lgpl-2.1-standalone.html", + "https://opensource.org/licenses/LGPL-2.1" + ], + "isOsiApproved": true + }, + { + "reference": "./LGPL-2.1-only.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/LGPL-2.1-only.json", + "referenceNumber": "2", + "name": "GNU Lesser General Public License v2.1 only", + "licenseId": "LGPL-2.1-only", + "seeAlso": [ + "https://www.gnu.org/licenses/old-licenses/lgpl-2.1-standalone.html", + "https://opensource.org/licenses/LGPL-2.1" + ], + "isOsiApproved": true + }, + { + "reference": "./LGPL-2.1-or-later.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/LGPL-2.1-or-later.json", + "referenceNumber": "338", + "name": "GNU Lesser General Public License v2.1 or later", + "licenseId": "LGPL-2.1-or-later", + "seeAlso": [ + "https://www.gnu.org/licenses/old-licenses/lgpl-2.1-standalone.html", + "https://opensource.org/licenses/LGPL-2.1" + ], + "isOsiApproved": true + }, + { + "reference": "./LGPL-3.0.html", + "isDeprecatedLicenseId": true, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/LGPL-3.0.json", + "referenceNumber": "210", + "name": "GNU Lesser General Public License v3.0 only", + "licenseId": "LGPL-3.0", + "seeAlso": [ + "https://www.gnu.org/licenses/lgpl-3.0-standalone.html", + "https://opensource.org/licenses/LGPL-3.0" + ], + "isOsiApproved": true + }, + { + "reference": "./LGPL-3.0+.html", + "isDeprecatedLicenseId": true, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/LGPL-3.0+.json", + "referenceNumber": "152", + "name": "GNU Lesser General Public License v3.0 or later", + "licenseId": "LGPL-3.0+", + "seeAlso": [ + "https://www.gnu.org/licenses/lgpl-3.0-standalone.html", + "https://opensource.org/licenses/LGPL-3.0" + ], + "isOsiApproved": true + }, + { + "reference": "./LGPL-3.0-only.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/LGPL-3.0-only.json", + "referenceNumber": "254", + "name": "GNU Lesser General Public License v3.0 only", + "licenseId": "LGPL-3.0-only", + "seeAlso": [ + "https://www.gnu.org/licenses/lgpl-3.0-standalone.html", + "https://opensource.org/licenses/LGPL-3.0" + ], + "isOsiApproved": true + }, + { + "reference": "./LGPL-3.0-or-later.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/LGPL-3.0-or-later.json", + "referenceNumber": "301", + "name": "GNU Lesser General Public License v3.0 or later", + "licenseId": "LGPL-3.0-or-later", + "seeAlso": [ + "https://www.gnu.org/licenses/lgpl-3.0-standalone.html", + "https://opensource.org/licenses/LGPL-3.0" + ], + "isOsiApproved": true + }, + { + "reference": "./LGPLLR.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/LGPLLR.json", + "referenceNumber": "103", + "name": "Lesser General Public License For Linguistic Resources", + "licenseId": "LGPLLR", + "seeAlso": [ + "http://www-igm.univ-mlv.fr/~unitex/lgpllr.html" + ], + "isOsiApproved": false + }, + { + "reference": "./LPL-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/LPL-1.0.json", + "referenceNumber": "89", + "name": "Lucent Public License Version 1.0", + "licenseId": "LPL-1.0", + "seeAlso": [ + "https://opensource.org/licenses/LPL-1.0" + ], + "isOsiApproved": true + }, + { + "reference": "./LPL-1.02.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/LPL-1.02.json", + "referenceNumber": "131", + "name": "Lucent Public License v1.02", + "licenseId": "LPL-1.02", + "seeAlso": [ + "http://plan9.bell-labs.com/plan9/license.html", + "https://opensource.org/licenses/LPL-1.02" + ], + "isOsiApproved": true + }, + { + "reference": "./LPPL-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/LPPL-1.0.json", + "referenceNumber": "259", + "name": "LaTeX Project Public License v1.0", + "licenseId": "LPPL-1.0", + "seeAlso": [ + "http://www.latex-project.org/lppl/lppl-1-0.txt" + ], + "isOsiApproved": false + }, + { + "reference": "./LPPL-1.1.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/LPPL-1.1.json", + "referenceNumber": "309", + "name": "LaTeX Project Public License v1.1", + "licenseId": "LPPL-1.1", + "seeAlso": [ + "http://www.latex-project.org/lppl/lppl-1-1.txt" + ], + "isOsiApproved": false + }, + { + "reference": "./LPPL-1.2.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/LPPL-1.2.json", + "referenceNumber": "392", + "name": "LaTeX Project Public License v1.2", + "licenseId": "LPPL-1.2", + "seeAlso": [ + "http://www.latex-project.org/lppl/lppl-1-2.txt" + ], + "isOsiApproved": false + }, + { + "reference": "./LPPL-1.3a.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/LPPL-1.3a.json", + "referenceNumber": "305", + "name": "LaTeX Project Public License v1.3a", + "licenseId": "LPPL-1.3a", + "seeAlso": [ + "http://www.latex-project.org/lppl/lppl-1-3a.txt" + ], + "isOsiApproved": false + }, + { + "reference": "./LPPL-1.3c.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/LPPL-1.3c.json", + "referenceNumber": "326", + "name": "LaTeX Project Public License v1.3c", + "licenseId": "LPPL-1.3c", + "seeAlso": [ + "http://www.latex-project.org/lppl/lppl-1-3c.txt", + "https://opensource.org/licenses/LPPL-1.3c" + ], + "isOsiApproved": true + }, + { + "reference": "./Latex2e.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Latex2e.json", + "referenceNumber": "283", + "name": "Latex2e License", + "licenseId": "Latex2e", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Latex2e" + ], + "isOsiApproved": false + }, + { + "reference": "./Leptonica.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Leptonica.json", + "referenceNumber": "159", + "name": "Leptonica License", + "licenseId": "Leptonica", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Leptonica" + ], + "isOsiApproved": false + }, + { + "reference": "./LiLiQ-P-1.1.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/LiLiQ-P-1.1.json", + "referenceNumber": "379", + "name": "Licence Libre du Québec – Permissive version 1.1", + "licenseId": "LiLiQ-P-1.1", + "seeAlso": [ + "https://forge.gouv.qc.ca/licence/fr/liliq-v1-1/", + "http://opensource.org/licenses/LiLiQ-P-1.1" + ], + "isOsiApproved": true + }, + { + "reference": "./LiLiQ-R-1.1.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/LiLiQ-R-1.1.json", + "referenceNumber": "286", + "name": "Licence Libre du Québec – Réciprocité version 1.1", + "licenseId": "LiLiQ-R-1.1", + "seeAlso": [ + "https://www.forge.gouv.qc.ca/participez/licence-logicielle/licence-libre-du-quebec-liliq-en-francais/licence-libre-du-quebec-reciprocite-liliq-r-v1-1/", + "http://opensource.org/licenses/LiLiQ-R-1.1" + ], + "isOsiApproved": true + }, + { + "reference": "./LiLiQ-Rplus-1.1.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/LiLiQ-Rplus-1.1.json", + "referenceNumber": "139", + "name": "Licence Libre du Québec – Réciprocité forte version 1.1", + "licenseId": "LiLiQ-Rplus-1.1", + "seeAlso": [ + "https://www.forge.gouv.qc.ca/participez/licence-logicielle/licence-libre-du-quebec-liliq-en-francais/licence-libre-du-quebec-reciprocite-forte-liliq-r-v1-1/", + "http://opensource.org/licenses/LiLiQ-Rplus-1.1" + ], + "isOsiApproved": true + }, + { + "reference": "./Libpng.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Libpng.json", + "referenceNumber": "101", + "name": "libpng License", + "licenseId": "Libpng", + "seeAlso": [ + "http://www.libpng.org/pub/png/src/libpng-LICENSE.txt" + ], + "isOsiApproved": false + }, + { + "reference": "./Linux-OpenIB.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Linux-OpenIB.json", + "referenceNumber": "5", + "name": "Linux Kernel Variant of OpenIB.org license", + "licenseId": "Linux-OpenIB", + "seeAlso": [ + "https://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux.git/tree/drivers/infiniband/core/sa.h" + ], + "isOsiApproved": false + }, + { + "reference": "./MIT.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/MIT.json", + "referenceNumber": "201", + "name": "MIT License", + "licenseId": "MIT", + "seeAlso": [ + "https://opensource.org/licenses/MIT" + ], + "isOsiApproved": true + }, + { + "reference": "./MIT-0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/MIT-0.json", + "referenceNumber": "6", + "name": "MIT No Attribution", + "licenseId": "MIT-0", + "seeAlso": [ + "https://github.com/aws/mit-0", + "https://romanrm.net/mit-zero", + "https://github.com/awsdocs/aws-cloud9-user-guide/blob/master/LICENSE-SAMPLECODE" + ], + "isOsiApproved": true + }, + { + "reference": "./MIT-CMU.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/MIT-CMU.json", + "referenceNumber": "9", + "name": "CMU License", + "licenseId": "MIT-CMU", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing:MIT?rd\u003dLicensing/MIT#CMU_Style", + "https://github.com/python-pillow/Pillow/blob/fffb426092c8db24a5f4b6df243a8a3c01fb63cd/LICENSE" + ], + "isOsiApproved": false + }, + { + "reference": "./MIT-advertising.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/MIT-advertising.json", + "referenceNumber": "8", + "name": "Enlightenment License (e16)", + "licenseId": "MIT-advertising", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/MIT_With_Advertising" + ], + "isOsiApproved": false + }, + { + "reference": "./MIT-enna.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/MIT-enna.json", + "referenceNumber": "25", + "name": "enna License", + "licenseId": "MIT-enna", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/MIT#enna" + ], + "isOsiApproved": false + }, + { + "reference": "./MIT-feh.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/MIT-feh.json", + "referenceNumber": "38", + "name": "feh License", + "licenseId": "MIT-feh", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/MIT#feh" + ], + "isOsiApproved": false + }, + { + "reference": "./MITNFA.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/MITNFA.json", + "referenceNumber": "294", + "name": "MIT +no-false-attribs license", + "licenseId": "MITNFA", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/MITNFA" + ], + "isOsiApproved": false + }, + { + "reference": "./MPL-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/MPL-1.0.json", + "referenceNumber": "49", + "name": "Mozilla Public License 1.0", + "licenseId": "MPL-1.0", + "seeAlso": [ + "http://www.mozilla.org/MPL/MPL-1.0.html", + "https://opensource.org/licenses/MPL-1.0" + ], + "isOsiApproved": true + }, + { + "reference": "./MPL-1.1.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/MPL-1.1.json", + "referenceNumber": "304", + "name": "Mozilla Public License 1.1", + "licenseId": "MPL-1.1", + "seeAlso": [ + "http://www.mozilla.org/MPL/MPL-1.1.html", + "https://opensource.org/licenses/MPL-1.1" + ], + "isOsiApproved": true + }, + { + "reference": "./MPL-2.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/MPL-2.0.json", + "referenceNumber": "234", + "name": "Mozilla Public License 2.0", + "licenseId": "MPL-2.0", + "seeAlso": [ + "http://www.mozilla.org/MPL/2.0/", + "https://opensource.org/licenses/MPL-2.0" + ], + "isOsiApproved": true + }, + { + "reference": "./MPL-2.0-no-copyleft-exception.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/MPL-2.0-no-copyleft-exception.json", + "referenceNumber": "303", + "name": "Mozilla Public License 2.0 (no copyleft exception)", + "licenseId": "MPL-2.0-no-copyleft-exception", + "seeAlso": [ + "http://www.mozilla.org/MPL/2.0/", + "https://opensource.org/licenses/MPL-2.0" + ], + "isOsiApproved": true + }, + { + "reference": "./MS-PL.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/MS-PL.json", + "referenceNumber": "336", + "name": "Microsoft Public License", + "licenseId": "MS-PL", + "seeAlso": [ + "http://www.microsoft.com/opensource/licenses.mspx", + "https://opensource.org/licenses/MS-PL" + ], + "isOsiApproved": true + }, + { + "reference": "./MS-RL.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/MS-RL.json", + "referenceNumber": "280", + "name": "Microsoft Reciprocal License", + "licenseId": "MS-RL", + "seeAlso": [ + "http://www.microsoft.com/opensource/licenses.mspx", + "https://opensource.org/licenses/MS-RL" + ], + "isOsiApproved": true + }, + { + "reference": "./MTLL.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/MTLL.json", + "referenceNumber": "181", + "name": "Matrix Template Library License", + "licenseId": "MTLL", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Matrix_Template_Library_License" + ], + "isOsiApproved": false + }, + { + "reference": "./MakeIndex.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/MakeIndex.json", + "referenceNumber": "187", + "name": "MakeIndex License", + "licenseId": "MakeIndex", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/MakeIndex" + ], + "isOsiApproved": false + }, + { + "reference": "./MirOS.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/MirOS.json", + "referenceNumber": "299", + "name": "MirOS License", + "licenseId": "MirOS", + "seeAlso": [ + "https://opensource.org/licenses/MirOS" + ], + "isOsiApproved": true + }, + { + "reference": "./Motosoto.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Motosoto.json", + "referenceNumber": "317", + "name": "Motosoto License", + "licenseId": "Motosoto", + "seeAlso": [ + "https://opensource.org/licenses/Motosoto" + ], + "isOsiApproved": true + }, + { + "reference": "./Multics.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Multics.json", + "referenceNumber": "63", + "name": "Multics License", + "licenseId": "Multics", + "seeAlso": [ + "https://opensource.org/licenses/Multics" + ], + "isOsiApproved": true + }, + { + "reference": "./Mup.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Mup.json", + "referenceNumber": "353", + "name": "Mup License", + "licenseId": "Mup", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Mup" + ], + "isOsiApproved": false + }, + { + "reference": "./NASA-1.3.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/NASA-1.3.json", + "referenceNumber": "87", + "name": "NASA Open Source Agreement 1.3", + "licenseId": "NASA-1.3", + "seeAlso": [ + "http://ti.arc.nasa.gov/opensource/nosa/", + "https://opensource.org/licenses/NASA-1.3" + ], + "isOsiApproved": true + }, + { + "reference": "./NBPL-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/NBPL-1.0.json", + "referenceNumber": "361", + "name": "Net Boolean Public License v1", + "licenseId": "NBPL-1.0", + "seeAlso": [ + "http://www.openldap.org/devel/gitweb.cgi?p\u003dopenldap.git;a\u003dblob;f\u003dLICENSE;hb\u003d37b4b3f6cc4bf34e1d3dec61e69914b9819d8894" + ], + "isOsiApproved": false + }, + { + "reference": "./NCSA.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/NCSA.json", + "referenceNumber": "58", + "name": "University of Illinois/NCSA Open Source License", + "licenseId": "NCSA", + "seeAlso": [ + "http://otm.illinois.edu/uiuc_openSource", + "https://opensource.org/licenses/NCSA" + ], + "isOsiApproved": true + }, + { + "reference": "./NGPL.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/NGPL.json", + "referenceNumber": "71", + "name": "Nethack General Public License", + "licenseId": "NGPL", + "seeAlso": [ + "https://opensource.org/licenses/NGPL" + ], + "isOsiApproved": true + }, + { + "reference": "./NLOD-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/NLOD-1.0.json", + "referenceNumber": "209", + "name": "Norwegian Licence for Open Government Data", + "licenseId": "NLOD-1.0", + "seeAlso": [ + "http://data.norge.no/nlod/en/1.0" + ], + "isOsiApproved": false + }, + { + "reference": "./NLPL.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/NLPL.json", + "referenceNumber": "344", + "name": "No Limit Public License", + "licenseId": "NLPL", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/NLPL" + ], + "isOsiApproved": false + }, + { + "reference": "./NOSL.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/NOSL.json", + "referenceNumber": "383", + "name": "Netizen Open Source License", + "licenseId": "NOSL", + "seeAlso": [ + "http://bits.netizen.com.au/licenses/NOSL/nosl.txt" + ], + "isOsiApproved": false + }, + { + "reference": "./NPL-1.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/NPL-1.0.json", + "referenceNumber": "328", + "name": "Netscape Public License v1.0", + "licenseId": "NPL-1.0", + "seeAlso": [ + "http://www.mozilla.org/MPL/NPL/1.0/" + ], + "isOsiApproved": false + }, + { + "reference": "./NPL-1.1.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/NPL-1.1.json", + "referenceNumber": "185", + "name": "Netscape Public License v1.1", + "licenseId": "NPL-1.1", + "seeAlso": [ + "http://www.mozilla.org/MPL/NPL/1.1/" + ], + "isOsiApproved": false + }, + { + "reference": "./NPOSL-3.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/NPOSL-3.0.json", + "referenceNumber": "222", + "name": "Non-Profit Open Software License 3.0", + "licenseId": "NPOSL-3.0", + "seeAlso": [ + "https://opensource.org/licenses/NOSL3.0" + ], + "isOsiApproved": true + }, + { + "reference": "./NRL.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/NRL.json", + "referenceNumber": "53", + "name": "NRL License", + "licenseId": "NRL", + "seeAlso": [ + "http://web.mit.edu/network/isakmp/nrllicense.html" + ], + "isOsiApproved": false + }, + { + "reference": "./NTP.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/NTP.json", + "referenceNumber": "261", + "name": "NTP License", + "licenseId": "NTP", + "seeAlso": [ + "https://opensource.org/licenses/NTP" + ], + "isOsiApproved": true + }, + { + "reference": "./Naumen.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Naumen.json", + "referenceNumber": "278", + "name": "Naumen Public License", + "licenseId": "Naumen", + "seeAlso": [ + "https://opensource.org/licenses/Naumen" + ], + "isOsiApproved": true + }, + { + "reference": "./Net-SNMP.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Net-SNMP.json", + "referenceNumber": "284", + "name": "Net-SNMP License", + "licenseId": "Net-SNMP", + "seeAlso": [ + "http://net-snmp.sourceforge.net/about/license.html" + ], + "isOsiApproved": false + }, + { + "reference": "./NetCDF.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/NetCDF.json", + "referenceNumber": "46", + "name": "NetCDF license", + "licenseId": "NetCDF", + "seeAlso": [ + "http://www.unidata.ucar.edu/software/netcdf/copyright.html" + ], + "isOsiApproved": false + }, + { + "reference": "./Newsletr.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Newsletr.json", + "referenceNumber": "279", + "name": "Newsletr License", + "licenseId": "Newsletr", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Newsletr" + ], + "isOsiApproved": false + }, + { + "reference": "./Nokia.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/Nokia.json", + "referenceNumber": "327", + "name": "Nokia Open Source License", + "licenseId": "Nokia", + "seeAlso": [ + "https://opensource.org/licenses/nokia" + ], + "isOsiApproved": true + }, + { + "reference": "./Noweb.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Noweb.json", + "referenceNumber": "364", + "name": "Noweb License", + "licenseId": "Noweb", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Noweb" + ], + "isOsiApproved": false + }, + { + "reference": "./Nunit.html", + "isDeprecatedLicenseId": true, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/Nunit.json", + "referenceNumber": "288", + "name": "Nunit License", + "licenseId": "Nunit", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Nunit" + ], + "isOsiApproved": false + }, + { + "reference": "./OCCT-PL.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/OCCT-PL.json", + "referenceNumber": "282", + "name": "Open CASCADE Technology Public License", + "licenseId": "OCCT-PL", + "seeAlso": [ + "http://www.opencascade.com/content/occt-public-license" + ], + "isOsiApproved": false + }, + { + "reference": "./OCLC-2.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/OCLC-2.0.json", + "referenceNumber": "111", + "name": "OCLC Research Public License 2.0", + "licenseId": "OCLC-2.0", + "seeAlso": [ + "http://www.oclc.org/research/activities/software/license/v2final.htm", + "https://opensource.org/licenses/OCLC-2.0" + ], + "isOsiApproved": true + }, + { + "reference": "./ODC-By-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/ODC-By-1.0.json", + "referenceNumber": "144", + "name": "Open Data Commons Attribution License v1.0", + "licenseId": "ODC-By-1.0", + "seeAlso": [ + "https://opendatacommons.org/licenses/by/1.0/" + ], + "isOsiApproved": false + }, + { + "reference": "./ODbL-1.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/ODbL-1.0.json", + "referenceNumber": "246", + "name": "ODC Open Database License v1.0", + "licenseId": "ODbL-1.0", + "seeAlso": [ + "http://www.opendatacommons.org/licenses/odbl/1.0/" + ], + "isOsiApproved": false + }, + { + "reference": "./OFL-1.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/OFL-1.0.json", + "referenceNumber": "153", + "name": "SIL Open Font License 1.0", + "licenseId": "OFL-1.0", + "seeAlso": [ + "http://scripts.sil.org/cms/scripts/page.php?item_id\u003dOFL10_web" + ], + "isOsiApproved": false + }, + { + "reference": "./OFL-1.1.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/OFL-1.1.json", + "referenceNumber": "315", + "name": "SIL Open Font License 1.1", + "licenseId": "OFL-1.1", + "seeAlso": [ + "http://scripts.sil.org/cms/scripts/page.php?item_id\u003dOFL_web", + "https://opensource.org/licenses/OFL-1.1" + ], + "isOsiApproved": true + }, + { + "reference": "./OGL-UK-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/OGL-UK-1.0.json", + "referenceNumber": "116", + "name": "Open Government Licence v1.0", + "licenseId": "OGL-UK-1.0", + "seeAlso": [ + "http://www.nationalarchives.gov.uk/doc/open-government-licence/version/1/" + ], + "isOsiApproved": false + }, + { + "reference": "./OGL-UK-2.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/OGL-UK-2.0.json", + "referenceNumber": "289", + "name": "Open Government Licence v2.0", + "licenseId": "OGL-UK-2.0", + "seeAlso": [ + "http://www.nationalarchives.gov.uk/doc/open-government-licence/version/2/" + ], + "isOsiApproved": false + }, + { + "reference": "./OGL-UK-3.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/OGL-UK-3.0.json", + "referenceNumber": "226", + "name": "Open Government Licence v3.0", + "licenseId": "OGL-UK-3.0", + "seeAlso": [ + "http://www.nationalarchives.gov.uk/doc/open-government-licence/version/3/" + ], + "isOsiApproved": false + }, + { + "reference": "./OGTSL.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/OGTSL.json", + "referenceNumber": "125", + "name": "Open Group Test Suite License", + "licenseId": "OGTSL", + "seeAlso": [ + "http://www.opengroup.org/testing/downloads/The_Open_Group_TSL.txt", + "https://opensource.org/licenses/OGTSL" + ], + "isOsiApproved": true + }, + { + "reference": "./OLDAP-1.1.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/OLDAP-1.1.json", + "referenceNumber": "97", + "name": "Open LDAP Public License v1.1", + "licenseId": "OLDAP-1.1", + "seeAlso": [ + "http://www.openldap.org/devel/gitweb.cgi?p\u003dopenldap.git;a\u003dblob;f\u003dLICENSE;hb\u003d806557a5ad59804ef3a44d5abfbe91d706b0791f" + ], + "isOsiApproved": false + }, + { + "reference": "./OLDAP-1.2.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/OLDAP-1.2.json", + "referenceNumber": "190", + "name": "Open LDAP Public License v1.2", + "licenseId": "OLDAP-1.2", + "seeAlso": [ + "http://www.openldap.org/devel/gitweb.cgi?p\u003dopenldap.git;a\u003dblob;f\u003dLICENSE;hb\u003d42b0383c50c299977b5893ee695cf4e486fb0dc7" + ], + "isOsiApproved": false + }, + { + "reference": "./OLDAP-1.3.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/OLDAP-1.3.json", + "referenceNumber": "106", + "name": "Open LDAP Public License v1.3", + "licenseId": "OLDAP-1.3", + "seeAlso": [ + "http://www.openldap.org/devel/gitweb.cgi?p\u003dopenldap.git;a\u003dblob;f\u003dLICENSE;hb\u003de5f8117f0ce088d0bd7a8e18ddf37eaa40eb09b1" + ], + "isOsiApproved": false + }, + { + "reference": "./OLDAP-1.4.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/OLDAP-1.4.json", + "referenceNumber": "30", + "name": "Open LDAP Public License v1.4", + "licenseId": "OLDAP-1.4", + "seeAlso": [ + "http://www.openldap.org/devel/gitweb.cgi?p\u003dopenldap.git;a\u003dblob;f\u003dLICENSE;hb\u003dc9f95c2f3f2ffb5e0ae55fe7388af75547660941" + ], + "isOsiApproved": false + }, + { + "reference": "./OLDAP-2.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/OLDAP-2.0.json", + "referenceNumber": "266", + "name": "Open LDAP Public License v2.0 (or possibly 2.0A and 2.0B)", + "licenseId": "OLDAP-2.0", + "seeAlso": [ + "http://www.openldap.org/devel/gitweb.cgi?p\u003dopenldap.git;a\u003dblob;f\u003dLICENSE;hb\u003dcbf50f4e1185a21abd4c0a54d3f4341fe28f36ea" + ], + "isOsiApproved": false + }, + { + "reference": "./OLDAP-2.0.1.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/OLDAP-2.0.1.json", + "referenceNumber": "350", + "name": "Open LDAP Public License v2.0.1", + "licenseId": "OLDAP-2.0.1", + "seeAlso": [ + "http://www.openldap.org/devel/gitweb.cgi?p\u003dopenldap.git;a\u003dblob;f\u003dLICENSE;hb\u003db6d68acd14e51ca3aab4428bf26522aa74873f0e" + ], + "isOsiApproved": false + }, + { + "reference": "./OLDAP-2.1.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/OLDAP-2.1.json", + "referenceNumber": "154", + "name": "Open LDAP Public License v2.1", + "licenseId": "OLDAP-2.1", + "seeAlso": [ + "http://www.openldap.org/devel/gitweb.cgi?p\u003dopenldap.git;a\u003dblob;f\u003dLICENSE;hb\u003db0d176738e96a0d3b9f85cb51e140a86f21be715" + ], + "isOsiApproved": false + }, + { + "reference": "./OLDAP-2.2.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/OLDAP-2.2.json", + "referenceNumber": "362", + "name": "Open LDAP Public License v2.2", + "licenseId": "OLDAP-2.2", + "seeAlso": [ + "http://www.openldap.org/devel/gitweb.cgi?p\u003dopenldap.git;a\u003dblob;f\u003dLICENSE;hb\u003d470b0c18ec67621c85881b2733057fecf4a1acc3" + ], + "isOsiApproved": false + }, + { + "reference": "./OLDAP-2.2.1.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/OLDAP-2.2.1.json", + "referenceNumber": "339", + "name": "Open LDAP Public License v2.2.1", + "licenseId": "OLDAP-2.2.1", + "seeAlso": [ + "http://www.openldap.org/devel/gitweb.cgi?p\u003dopenldap.git;a\u003dblob;f\u003dLICENSE;hb\u003d4bc786f34b50aa301be6f5600f58a980070f481e" + ], + "isOsiApproved": false + }, + { + "reference": "./OLDAP-2.2.2.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/OLDAP-2.2.2.json", + "referenceNumber": "199", + "name": "Open LDAP Public License 2.2.2", + "licenseId": "OLDAP-2.2.2", + "seeAlso": [ + "http://www.openldap.org/devel/gitweb.cgi?p\u003dopenldap.git;a\u003dblob;f\u003dLICENSE;hb\u003ddf2cc1e21eb7c160695f5b7cffd6296c151ba188" + ], + "isOsiApproved": false + }, + { + "reference": "./OLDAP-2.3.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/OLDAP-2.3.json", + "referenceNumber": "164", + "name": "Open LDAP Public License v2.3", + "licenseId": "OLDAP-2.3", + "seeAlso": [ + "http://www.openldap.org/devel/gitweb.cgi?p\u003dopenldap.git;a\u003dblob;f\u003dLICENSE;hb\u003dd32cf54a32d581ab475d23c810b0a7fbaf8d63c3" + ], + "isOsiApproved": false + }, + { + "reference": "./OLDAP-2.4.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/OLDAP-2.4.json", + "referenceNumber": "66", + "name": "Open LDAP Public License v2.4", + "licenseId": "OLDAP-2.4", + "seeAlso": [ + "http://www.openldap.org/devel/gitweb.cgi?p\u003dopenldap.git;a\u003dblob;f\u003dLICENSE;hb\u003dcd1284c4a91a8a380d904eee68d1583f989ed386" + ], + "isOsiApproved": false + }, + { + "reference": "./OLDAP-2.5.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/OLDAP-2.5.json", + "referenceNumber": "183", + "name": "Open LDAP Public License v2.5", + "licenseId": "OLDAP-2.5", + "seeAlso": [ + "http://www.openldap.org/devel/gitweb.cgi?p\u003dopenldap.git;a\u003dblob;f\u003dLICENSE;hb\u003d6852b9d90022e8593c98205413380536b1b5a7cf" + ], + "isOsiApproved": false + }, + { + "reference": "./OLDAP-2.6.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/OLDAP-2.6.json", + "referenceNumber": "61", + "name": "Open LDAP Public License v2.6", + "licenseId": "OLDAP-2.6", + "seeAlso": [ + "http://www.openldap.org/devel/gitweb.cgi?p\u003dopenldap.git;a\u003dblob;f\u003dLICENSE;hb\u003d1cae062821881f41b73012ba816434897abf4205" + ], + "isOsiApproved": false + }, + { + "reference": "./OLDAP-2.7.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/OLDAP-2.7.json", + "referenceNumber": "123", + "name": "Open LDAP Public License v2.7", + "licenseId": "OLDAP-2.7", + "seeAlso": [ + "http://www.openldap.org/devel/gitweb.cgi?p\u003dopenldap.git;a\u003dblob;f\u003dLICENSE;hb\u003d47c2415c1df81556eeb39be6cad458ef87c534a2" + ], + "isOsiApproved": false + }, + { + "reference": "./OLDAP-2.8.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/OLDAP-2.8.json", + "referenceNumber": "37", + "name": "Open LDAP Public License v2.8", + "licenseId": "OLDAP-2.8", + "seeAlso": [ + "http://www.openldap.org/software/release/license.html" + ], + "isOsiApproved": false + }, + { + "reference": "./OML.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/OML.json", + "referenceNumber": "65", + "name": "Open Market License", + "licenseId": "OML", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Open_Market_License" + ], + "isOsiApproved": false + }, + { + "reference": "./OPL-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/OPL-1.0.json", + "referenceNumber": "343", + "name": "Open Public License v1.0", + "licenseId": "OPL-1.0", + "seeAlso": [ + "http://old.koalateam.com/jackaroo/OPL_1_0.TXT", + "https://fedoraproject.org/wiki/Licensing/Open_Public_License" + ], + "isOsiApproved": false + }, + { + "reference": "./OSET-PL-2.1.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/OSET-PL-2.1.json", + "referenceNumber": "291", + "name": "OSET Public License version 2.1", + "licenseId": "OSET-PL-2.1", + "seeAlso": [ + "http://www.osetfoundation.org/public-license", + "https://opensource.org/licenses/OPL-2.1" + ], + "isOsiApproved": true + }, + { + "reference": "./OSL-1.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/OSL-1.0.json", + "referenceNumber": "85", + "name": "Open Software License 1.0", + "licenseId": "OSL-1.0", + "seeAlso": [ + "https://opensource.org/licenses/OSL-1.0" + ], + "isOsiApproved": true + }, + { + "reference": "./OSL-1.1.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/OSL-1.1.json", + "referenceNumber": "334", + "name": "Open Software License 1.1", + "licenseId": "OSL-1.1", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/OSL1.1" + ], + "isOsiApproved": false + }, + { + "reference": "./OSL-2.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/OSL-2.0.json", + "referenceNumber": "20", + "name": "Open Software License 2.0", + "licenseId": "OSL-2.0", + "seeAlso": [ + "http://web.archive.org/web/20041020171434/http://www.rosenlaw.com/osl2.0.html" + ], + "isOsiApproved": true + }, + { + "reference": "./OSL-2.1.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/OSL-2.1.json", + "referenceNumber": "24", + "name": "Open Software License 2.1", + "licenseId": "OSL-2.1", + "seeAlso": [ + "http://web.archive.org/web/20050212003940/http://www.rosenlaw.com/osl21.htm", + "https://opensource.org/licenses/OSL-2.1" + ], + "isOsiApproved": true + }, + { + "reference": "./OSL-3.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/OSL-3.0.json", + "referenceNumber": "100", + "name": "Open Software License 3.0", + "licenseId": "OSL-3.0", + "seeAlso": [ + "https://web.archive.org/web/20120101081418/http://rosenlaw.com:80/OSL3.0.htm", + "https://opensource.org/licenses/OSL-3.0" + ], + "isOsiApproved": true + }, + { + "reference": "./OpenSSL.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/OpenSSL.json", + "referenceNumber": "249", + "name": "OpenSSL License", + "licenseId": "OpenSSL", + "seeAlso": [ + "http://www.openssl.org/source/license.html" + ], + "isOsiApproved": false + }, + { + "reference": "./PDDL-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/PDDL-1.0.json", + "referenceNumber": "14", + "name": "ODC Public Domain Dedication \u0026 License 1.0", + "licenseId": "PDDL-1.0", + "seeAlso": [ + "http://opendatacommons.org/licenses/pddl/1.0/" + ], + "isOsiApproved": false + }, + { + "reference": "./PHP-3.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/PHP-3.0.json", + "referenceNumber": "385", + "name": "PHP License v3.0", + "licenseId": "PHP-3.0", + "seeAlso": [ + "http://www.php.net/license/3_0.txt", + "https://opensource.org/licenses/PHP-3.0" + ], + "isOsiApproved": true + }, + { + "reference": "./PHP-3.01.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/PHP-3.01.json", + "referenceNumber": "316", + "name": "PHP License v3.01", + "licenseId": "PHP-3.01", + "seeAlso": [ + "http://www.php.net/license/3_01.txt" + ], + "isOsiApproved": false + }, + { + "reference": "./Parity-6.0.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Parity-6.0.0.json", + "referenceNumber": "91", + "name": "The Parity Public License 6.0.0", + "licenseId": "Parity-6.0.0", + "seeAlso": [ + "https://paritylicense.com/versions/6.0.0.html" + ], + "isOsiApproved": false + }, + { + "reference": "./Plexus.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Plexus.json", + "referenceNumber": "225", + "name": "Plexus Classworlds License", + "licenseId": "Plexus", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Plexus_Classworlds_License" + ], + "isOsiApproved": false + }, + { + "reference": "./PostgreSQL.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/PostgreSQL.json", + "referenceNumber": "247", + "name": "PostgreSQL License", + "licenseId": "PostgreSQL", + "seeAlso": [ + "http://www.postgresql.org/about/licence", + "https://opensource.org/licenses/PostgreSQL" + ], + "isOsiApproved": true + }, + { + "reference": "./Python-2.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/Python-2.0.json", + "referenceNumber": "35", + "name": "Python License 2.0", + "licenseId": "Python-2.0", + "seeAlso": [ + "https://opensource.org/licenses/Python-2.0" + ], + "isOsiApproved": true + }, + { + "reference": "./QPL-1.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/QPL-1.0.json", + "referenceNumber": "27", + "name": "Q Public License 1.0", + "licenseId": "QPL-1.0", + "seeAlso": [ + "http://doc.qt.nokia.com/3.3/license.html", + "https://opensource.org/licenses/QPL-1.0" + ], + "isOsiApproved": true + }, + { + "reference": "./Qhull.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Qhull.json", + "referenceNumber": "67", + "name": "Qhull License", + "licenseId": "Qhull", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Qhull" + ], + "isOsiApproved": false + }, + { + "reference": "./RHeCos-1.1.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/RHeCos-1.1.json", + "referenceNumber": "149", + "name": "Red Hat eCos Public License v1.1", + "licenseId": "RHeCos-1.1", + "seeAlso": [ + "http://ecos.sourceware.org/old-license.html" + ], + "isOsiApproved": false + }, + { + "reference": "./RPL-1.1.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/RPL-1.1.json", + "referenceNumber": "269", + "name": "Reciprocal Public License 1.1", + "licenseId": "RPL-1.1", + "seeAlso": [ + "https://opensource.org/licenses/RPL-1.1" + ], + "isOsiApproved": true + }, + { + "reference": "./RPL-1.5.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/RPL-1.5.json", + "referenceNumber": "227", + "name": "Reciprocal Public License 1.5", + "licenseId": "RPL-1.5", + "seeAlso": [ + "https://opensource.org/licenses/RPL-1.5" + ], + "isOsiApproved": true + }, + { + "reference": "./RPSL-1.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/RPSL-1.0.json", + "referenceNumber": "273", + "name": "RealNetworks Public Source License v1.0", + "licenseId": "RPSL-1.0", + "seeAlso": [ + "https://helixcommunity.org/content/rpsl", + "https://opensource.org/licenses/RPSL-1.0" + ], + "isOsiApproved": true + }, + { + "reference": "./RSA-MD.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/RSA-MD.json", + "referenceNumber": "82", + "name": "RSA Message-Digest License ", + "licenseId": "RSA-MD", + "seeAlso": [ + "http://www.faqs.org/rfcs/rfc1321.html" + ], + "isOsiApproved": false + }, + { + "reference": "./RSCPL.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/RSCPL.json", + "referenceNumber": "211", + "name": "Ricoh Source Code Public License", + "licenseId": "RSCPL", + "seeAlso": [ + "http://wayback.archive.org/web/20060715140826/http://www.risource.org/RPL/RPL-1.0A.shtml", + "https://opensource.org/licenses/RSCPL" + ], + "isOsiApproved": true + }, + { + "reference": "./Rdisc.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Rdisc.json", + "referenceNumber": "295", + "name": "Rdisc License", + "licenseId": "Rdisc", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Rdisc_License" + ], + "isOsiApproved": false + }, + { + "reference": "./Ruby.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/Ruby.json", + "referenceNumber": "263", + "name": "Ruby License", + "licenseId": "Ruby", + "seeAlso": [ + "http://www.ruby-lang.org/en/LICENSE.txt" + ], + "isOsiApproved": false + }, + { + "reference": "./SAX-PD.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/SAX-PD.json", + "referenceNumber": "140", + "name": "Sax Public Domain Notice", + "licenseId": "SAX-PD", + "seeAlso": [ + "http://www.saxproject.org/copying.html" + ], + "isOsiApproved": false + }, + { + "reference": "./SCEA.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/SCEA.json", + "referenceNumber": "16", + "name": "SCEA Shared Source License", + "licenseId": "SCEA", + "seeAlso": [ + "http://research.scea.com/scea_shared_source_license.html" + ], + "isOsiApproved": false + }, + { + "reference": "./SGI-B-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/SGI-B-1.0.json", + "referenceNumber": "90", + "name": "SGI Free Software License B v1.0", + "licenseId": "SGI-B-1.0", + "seeAlso": [ + "http://oss.sgi.com/projects/FreeB/SGIFreeSWLicB.1.0.html" + ], + "isOsiApproved": false + }, + { + "reference": "./SGI-B-1.1.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/SGI-B-1.1.json", + "referenceNumber": "241", + "name": "SGI Free Software License B v1.1", + "licenseId": "SGI-B-1.1", + "seeAlso": [ + "http://oss.sgi.com/projects/FreeB/" + ], + "isOsiApproved": false + }, + { + "reference": "./SGI-B-2.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/SGI-B-2.0.json", + "referenceNumber": "272", + "name": "SGI Free Software License B v2.0", + "licenseId": "SGI-B-2.0", + "seeAlso": [ + "http://oss.sgi.com/projects/FreeB/SGIFreeSWLicB.2.0.pdf" + ], + "isOsiApproved": false + }, + { + "reference": "./SHL-0.5.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/SHL-0.5.json", + "referenceNumber": "72", + "name": "Solderpad Hardware License v0.5", + "licenseId": "SHL-0.5", + "seeAlso": [ + "https://solderpad.org/licenses/SHL-0.5/" + ], + "isOsiApproved": false + }, + { + "reference": "./SHL-0.51.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/SHL-0.51.json", + "referenceNumber": "314", + "name": "Solderpad Hardware License, Version 0.51", + "licenseId": "SHL-0.51", + "seeAlso": [ + "https://solderpad.org/licenses/SHL-0.51/" + ], + "isOsiApproved": false + }, + { + "reference": "./SISSL.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/SISSL.json", + "referenceNumber": "74", + "name": "Sun Industry Standards Source License v1.1", + "licenseId": "SISSL", + "seeAlso": [ + "http://www.openoffice.org/licenses/sissl_license.html", + "https://opensource.org/licenses/SISSL" + ], + "isOsiApproved": true + }, + { + "reference": "./SISSL-1.2.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/SISSL-1.2.json", + "referenceNumber": "7", + "name": "Sun Industry Standards Source License v1.2", + "licenseId": "SISSL-1.2", + "seeAlso": [ + "http://gridscheduler.sourceforge.net/Gridengine_SISSL_license.html" + ], + "isOsiApproved": false + }, + { + "reference": "./SMLNJ.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/SMLNJ.json", + "referenceNumber": "296", + "name": "Standard ML of New Jersey License", + "licenseId": "SMLNJ", + "seeAlso": [ + "https://www.smlnj.org/license.html" + ], + "isOsiApproved": false + }, + { + "reference": "./SMPPL.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/SMPPL.json", + "referenceNumber": "127", + "name": "Secure Messaging Protocol Public License", + "licenseId": "SMPPL", + "seeAlso": [ + "https://github.com/dcblake/SMP/blob/master/Documentation/License.txt" + ], + "isOsiApproved": false + }, + { + "reference": "./SNIA.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/SNIA.json", + "referenceNumber": "230", + "name": "SNIA Public License 1.1", + "licenseId": "SNIA", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/SNIA_Public_License" + ], + "isOsiApproved": false + }, + { + "reference": "./SPL-1.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/SPL-1.0.json", + "referenceNumber": "54", + "name": "Sun Public License v1.0", + "licenseId": "SPL-1.0", + "seeAlso": [ + "https://opensource.org/licenses/SPL-1.0" + ], + "isOsiApproved": true + }, + { + "reference": "./SSPL-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/SSPL-1.0.json", + "referenceNumber": "356", + "name": "Server Side Public License, v 1", + "licenseId": "SSPL-1.0", + "seeAlso": [ + "https://www.mongodb.com/licensing/server-side-public-license" + ], + "isOsiApproved": false + }, + { + "reference": "./SWL.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/SWL.json", + "referenceNumber": "208", + "name": "Scheme Widget Library (SWL) Software License Agreement", + "licenseId": "SWL", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/SWL" + ], + "isOsiApproved": false + }, + { + "reference": "./Saxpath.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Saxpath.json", + "referenceNumber": "18", + "name": "Saxpath License", + "licenseId": "Saxpath", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Saxpath_License" + ], + "isOsiApproved": false + }, + { + "reference": "./Sendmail.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Sendmail.json", + "referenceNumber": "151", + "name": "Sendmail License", + "licenseId": "Sendmail", + "seeAlso": [ + "http://www.sendmail.com/pdfs/open_source/sendmail_license.pdf", + "https://web.archive.org/web/20160322142305/https://www.sendmail.com/pdfs/open_source/sendmail_license.pdf" + ], + "isOsiApproved": false + }, + { + "reference": "./Sendmail-8.23.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Sendmail-8.23.json", + "referenceNumber": "41", + "name": "Sendmail License 8.23", + "licenseId": "Sendmail-8.23", + "seeAlso": [ + "https://www.proofpoint.com/sites/default/files/sendmail-license.pdf", + "https://web.archive.org/web/20181003101040/https://www.proofpoint.com/sites/default/files/sendmail-license.pdf" + ], + "isOsiApproved": false + }, + { + "reference": "./SimPL-2.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/SimPL-2.0.json", + "referenceNumber": "184", + "name": "Simple Public License 2.0", + "licenseId": "SimPL-2.0", + "seeAlso": [ + "https://opensource.org/licenses/SimPL-2.0" + ], + "isOsiApproved": true + }, + { + "reference": "./Sleepycat.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/Sleepycat.json", + "referenceNumber": "290", + "name": "Sleepycat License", + "licenseId": "Sleepycat", + "seeAlso": [ + "https://opensource.org/licenses/Sleepycat" + ], + "isOsiApproved": true + }, + { + "reference": "./Spencer-86.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Spencer-86.json", + "referenceNumber": "313", + "name": "Spencer License 86", + "licenseId": "Spencer-86", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Henry_Spencer_Reg-Ex_Library_License" + ], + "isOsiApproved": false + }, + { + "reference": "./Spencer-94.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Spencer-94.json", + "referenceNumber": "29", + "name": "Spencer License 94", + "licenseId": "Spencer-94", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Henry_Spencer_Reg-Ex_Library_License" + ], + "isOsiApproved": false + }, + { + "reference": "./Spencer-99.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Spencer-99.json", + "referenceNumber": "386", + "name": "Spencer License 99", + "licenseId": "Spencer-99", + "seeAlso": [ + "http://www.opensource.apple.com/source/tcl/tcl-5/tcl/generic/regfronts.c" + ], + "isOsiApproved": false + }, + { + "reference": "./StandardML-NJ.html", + "isDeprecatedLicenseId": true, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/StandardML-NJ.json", + "referenceNumber": "219", + "name": "Standard ML of New Jersey License", + "licenseId": "StandardML-NJ", + "seeAlso": [ + "http://www.smlnj.org//license.html" + ], + "isOsiApproved": false + }, + { + "reference": "./SugarCRM-1.1.3.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/SugarCRM-1.1.3.json", + "referenceNumber": "292", + "name": "SugarCRM Public License v1.1.3", + "licenseId": "SugarCRM-1.1.3", + "seeAlso": [ + "http://www.sugarcrm.com/crm/SPL" + ], + "isOsiApproved": false + }, + { + "reference": "./TAPR-OHL-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/TAPR-OHL-1.0.json", + "referenceNumber": "267", + "name": "TAPR Open Hardware License v1.0", + "licenseId": "TAPR-OHL-1.0", + "seeAlso": [ + "https://www.tapr.org/OHL" + ], + "isOsiApproved": false + }, + { + "reference": "./TCL.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/TCL.json", + "referenceNumber": "265", + "name": "TCL/TK License", + "licenseId": "TCL", + "seeAlso": [ + "http://www.tcl.tk/software/tcltk/license.html", + "https://fedoraproject.org/wiki/Licensing/TCL" + ], + "isOsiApproved": false + }, + { + "reference": "./TCP-wrappers.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/TCP-wrappers.json", + "referenceNumber": "274", + "name": "TCP Wrappers License", + "licenseId": "TCP-wrappers", + "seeAlso": [ + "http://rc.quest.com/topics/openssh/license.php#tcpwrappers" + ], + "isOsiApproved": false + }, + { + "reference": "./TMate.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/TMate.json", + "referenceNumber": "253", + "name": "TMate Open Source License", + "licenseId": "TMate", + "seeAlso": [ + "http://svnkit.com/license.html" + ], + "isOsiApproved": false + }, + { + "reference": "./TORQUE-1.1.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/TORQUE-1.1.json", + "referenceNumber": "171", + "name": "TORQUE v2.5+ Software License v1.1", + "licenseId": "TORQUE-1.1", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/TORQUEv1.1" + ], + "isOsiApproved": false + }, + { + "reference": "./TOSL.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/TOSL.json", + "referenceNumber": "360", + "name": "Trusster Open Source License", + "licenseId": "TOSL", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/TOSL" + ], + "isOsiApproved": false + }, + { + "reference": "./TU-Berlin-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/TU-Berlin-1.0.json", + "referenceNumber": "373", + "name": "Technische Universitaet Berlin License 1.0", + "licenseId": "TU-Berlin-1.0", + "seeAlso": [ + "https://github.com/swh/ladspa/blob/7bf6f3799fdba70fda297c2d8fd9f526803d9680/gsm/COPYRIGHT" + ], + "isOsiApproved": false + }, + { + "reference": "./TU-Berlin-2.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/TU-Berlin-2.0.json", + "referenceNumber": "391", + "name": "Technische Universitaet Berlin License 2.0", + "licenseId": "TU-Berlin-2.0", + "seeAlso": [ + "https://github.com/CorsixTH/deps/blob/fd339a9f526d1d9c9f01ccf39e438a015da50035/licences/libgsm.txt" + ], + "isOsiApproved": false + }, + { + "reference": "./UPL-1.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/UPL-1.0.json", + "referenceNumber": "205", + "name": "Universal Permissive License v1.0", + "licenseId": "UPL-1.0", + "seeAlso": [ + "https://opensource.org/licenses/UPL" + ], + "isOsiApproved": true + }, + { + "reference": "./Unicode-DFS-2015.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Unicode-DFS-2015.json", + "referenceNumber": "11", + "name": "Unicode License Agreement - Data Files and Software (2015)", + "licenseId": "Unicode-DFS-2015", + "seeAlso": [ + "https://web.archive.org/web/20151224134844/http://unicode.org/copyright.html" + ], + "isOsiApproved": false + }, + { + "reference": "./Unicode-DFS-2016.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Unicode-DFS-2016.json", + "referenceNumber": "382", + "name": "Unicode License Agreement - Data Files and Software (2016)", + "licenseId": "Unicode-DFS-2016", + "seeAlso": [ + "http://www.unicode.org/copyright.html" + ], + "isOsiApproved": false + }, + { + "reference": "./Unicode-TOU.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Unicode-TOU.json", + "referenceNumber": "70", + "name": "Unicode Terms of Use", + "licenseId": "Unicode-TOU", + "seeAlso": [ + "http://www.unicode.org/copyright.html" + ], + "isOsiApproved": false + }, + { + "reference": "./Unlicense.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/Unlicense.json", + "referenceNumber": "293", + "name": "The Unlicense", + "licenseId": "Unlicense", + "seeAlso": [ + "http://unlicense.org/" + ], + "isOsiApproved": false + }, + { + "reference": "./VOSTROM.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/VOSTROM.json", + "referenceNumber": "228", + "name": "VOSTROM Public License for Open Source", + "licenseId": "VOSTROM", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/VOSTROM" + ], + "isOsiApproved": false + }, + { + "reference": "./VSL-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/VSL-1.0.json", + "referenceNumber": "180", + "name": "Vovida Software License v1.0", + "licenseId": "VSL-1.0", + "seeAlso": [ + "https://opensource.org/licenses/VSL-1.0" + ], + "isOsiApproved": true + }, + { + "reference": "./Vim.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/Vim.json", + "referenceNumber": "133", + "name": "Vim License", + "licenseId": "Vim", + "seeAlso": [ + "http://vimdoc.sourceforge.net/htmldoc/uganda.html" + ], + "isOsiApproved": false + }, + { + "reference": "./W3C.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/W3C.json", + "referenceNumber": "351", + "name": "W3C Software Notice and License (2002-12-31)", + "licenseId": "W3C", + "seeAlso": [ + "http://www.w3.org/Consortium/Legal/2002/copyright-software-20021231.html", + "https://opensource.org/licenses/W3C" + ], + "isOsiApproved": true + }, + { + "reference": "./W3C-19980720.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/W3C-19980720.json", + "referenceNumber": "323", + "name": "W3C Software Notice and License (1998-07-20)", + "licenseId": "W3C-19980720", + "seeAlso": [ + "http://www.w3.org/Consortium/Legal/copyright-software-19980720.html" + ], + "isOsiApproved": false + }, + { + "reference": "./W3C-20150513.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/W3C-20150513.json", + "referenceNumber": "51", + "name": "W3C Software Notice and Document License (2015-05-13)", + "licenseId": "W3C-20150513", + "seeAlso": [ + "https://www.w3.org/Consortium/Legal/2015/copyright-software-and-document" + ], + "isOsiApproved": false + }, + { + "reference": "./WTFPL.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/WTFPL.json", + "referenceNumber": "368", + "name": "Do What The F*ck You Want To Public License", + "licenseId": "WTFPL", + "seeAlso": [ + "http://sam.zoy.org/wtfpl/COPYING" + ], + "isOsiApproved": false + }, + { + "reference": "./Watcom-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Watcom-1.0.json", + "referenceNumber": "177", + "name": "Sybase Open Watcom Public License 1.0", + "licenseId": "Watcom-1.0", + "seeAlso": [ + "https://opensource.org/licenses/Watcom-1.0" + ], + "isOsiApproved": true + }, + { + "reference": "./Wsuipa.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Wsuipa.json", + "referenceNumber": "135", + "name": "Wsuipa License", + "licenseId": "Wsuipa", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Wsuipa" + ], + "isOsiApproved": false + }, + { + "reference": "./X11.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/X11.json", + "referenceNumber": "188", + "name": "X11 License", + "licenseId": "X11", + "seeAlso": [ + "http://www.xfree86.org/3.3.6/COPYRIGHT2.html#3" + ], + "isOsiApproved": false + }, + { + "reference": "./XFree86-1.1.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/XFree86-1.1.json", + "referenceNumber": "243", + "name": "XFree86 License 1.1", + "licenseId": "XFree86-1.1", + "seeAlso": [ + "http://www.xfree86.org/current/LICENSE4.html" + ], + "isOsiApproved": false + }, + { + "reference": "./XSkat.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/XSkat.json", + "referenceNumber": "96", + "name": "XSkat License", + "licenseId": "XSkat", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/XSkat_License" + ], + "isOsiApproved": false + }, + { + "reference": "./Xerox.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Xerox.json", + "referenceNumber": "163", + "name": "Xerox License", + "licenseId": "Xerox", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Xerox" + ], + "isOsiApproved": false + }, + { + "reference": "./Xnet.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Xnet.json", + "referenceNumber": "388", + "name": "X.Net License", + "licenseId": "Xnet", + "seeAlso": [ + "https://opensource.org/licenses/Xnet" + ], + "isOsiApproved": true + }, + { + "reference": "./YPL-1.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/YPL-1.0.json", + "referenceNumber": "174", + "name": "Yahoo! Public License v1.0", + "licenseId": "YPL-1.0", + "seeAlso": [ + "http://www.zimbra.com/license/yahoo_public_license_1.0.html" + ], + "isOsiApproved": false + }, + { + "reference": "./YPL-1.1.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/YPL-1.1.json", + "referenceNumber": "57", + "name": "Yahoo! Public License v1.1", + "licenseId": "YPL-1.1", + "seeAlso": [ + "http://www.zimbra.com/license/yahoo_public_license_1.1.html" + ], + "isOsiApproved": false + }, + { + "reference": "./ZPL-1.1.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/ZPL-1.1.json", + "referenceNumber": "359", + "name": "Zope Public License 1.1", + "licenseId": "ZPL-1.1", + "seeAlso": [ + "http://old.zope.org/Resources/License/ZPL-1.1" + ], + "isOsiApproved": false + }, + { + "reference": "./ZPL-2.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/ZPL-2.0.json", + "referenceNumber": "78", + "name": "Zope Public License 2.0", + "licenseId": "ZPL-2.0", + "seeAlso": [ + "http://old.zope.org/Resources/License/ZPL-2.0", + "https://opensource.org/licenses/ZPL-2.0" + ], + "isOsiApproved": true + }, + { + "reference": "./ZPL-2.1.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/ZPL-2.1.json", + "referenceNumber": "345", + "name": "Zope Public License 2.1", + "licenseId": "ZPL-2.1", + "seeAlso": [ + "http://old.zope.org/Resources/ZPL/" + ], + "isOsiApproved": false + }, + { + "reference": "./Zed.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Zed.json", + "referenceNumber": "248", + "name": "Zed License", + "licenseId": "Zed", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Zed" + ], + "isOsiApproved": false + }, + { + "reference": "./Zend-2.0.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/Zend-2.0.json", + "referenceNumber": "198", + "name": "Zend License v2.0", + "licenseId": "Zend-2.0", + "seeAlso": [ + "https://web.archive.org/web/20130517195954/http://www.zend.com/license/2_00.txt" + ], + "isOsiApproved": false + }, + { + "reference": "./Zimbra-1.3.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/Zimbra-1.3.json", + "referenceNumber": "40", + "name": "Zimbra Public License v1.3", + "licenseId": "Zimbra-1.3", + "seeAlso": [ + "http://web.archive.org/web/20100302225219/http://www.zimbra.com/license/zimbra-public-license-1-3.html" + ], + "isOsiApproved": false + }, + { + "reference": "./Zimbra-1.4.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/Zimbra-1.4.json", + "referenceNumber": "238", + "name": "Zimbra Public License v1.4", + "licenseId": "Zimbra-1.4", + "seeAlso": [ + "http://www.zimbra.com/legal/zimbra-public-license-1-4" + ], + "isOsiApproved": false + }, + { + "reference": "./Zlib.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/Zlib.json", + "referenceNumber": "320", + "name": "zlib License", + "licenseId": "Zlib", + "seeAlso": [ + "http://www.zlib.net/zlib_license.html", + "https://opensource.org/licenses/Zlib" + ], + "isOsiApproved": true + }, + { + "reference": "./blessing.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/blessing.json", + "referenceNumber": "331", + "name": "SQLite Blessing", + "licenseId": "blessing", + "seeAlso": [ + "https://www.sqlite.org/src/artifact/e33a4df7e32d742a?ln\u003d4-9", + "https://sqlite.org/src/artifact/df5091916dbb40e6" + ], + "isOsiApproved": false + }, + { + "reference": "./bzip2-1.0.5.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/bzip2-1.0.5.json", + "referenceNumber": "200", + "name": "bzip2 and libbzip2 License v1.0.5", + "licenseId": "bzip2-1.0.5", + "seeAlso": [ + "http://bzip.org/1.0.5/bzip2-manual-1.0.5.html" + ], + "isOsiApproved": false + }, + { + "reference": "./bzip2-1.0.6.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/bzip2-1.0.6.json", + "referenceNumber": "302", + "name": "bzip2 and libbzip2 License v1.0.6", + "licenseId": "bzip2-1.0.6", + "seeAlso": [ + "https://github.com/asimonov-im/bzip2/blob/master/LICENSE" + ], + "isOsiApproved": false + }, + { + "reference": "./copyleft-next-0.3.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/copyleft-next-0.3.0.json", + "referenceNumber": "176", + "name": "copyleft-next 0.3.0", + "licenseId": "copyleft-next-0.3.0", + "seeAlso": [ + "https://github.com/copyleft-next/copyleft-next/blob/master/Releases/copyleft-next-0.3.0" + ], + "isOsiApproved": false + }, + { + "reference": "./copyleft-next-0.3.1.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/copyleft-next-0.3.1.json", + "referenceNumber": "347", + "name": "copyleft-next 0.3.1", + "licenseId": "copyleft-next-0.3.1", + "seeAlso": [ + "https://github.com/copyleft-next/copyleft-next/blob/master/Releases/copyleft-next-0.3.1" + ], + "isOsiApproved": false + }, + { + "reference": "./curl.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/curl.json", + "referenceNumber": "260", + "name": "curl License", + "licenseId": "curl", + "seeAlso": [ + "https://github.com/bagder/curl/blob/master/COPYING" + ], + "isOsiApproved": false + }, + { + "reference": "./diffmark.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/diffmark.json", + "referenceNumber": "367", + "name": "diffmark license", + "licenseId": "diffmark", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/diffmark" + ], + "isOsiApproved": false + }, + { + "reference": "./dvipdfm.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/dvipdfm.json", + "referenceNumber": "143", + "name": "dvipdfm License", + "licenseId": "dvipdfm", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/dvipdfm" + ], + "isOsiApproved": false + }, + { + "reference": "./eCos-2.0.html", + "isDeprecatedLicenseId": true, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/eCos-2.0.json", + "referenceNumber": "329", + "name": "eCos license version 2.0", + "licenseId": "eCos-2.0", + "seeAlso": [ + "https://www.gnu.org/licenses/ecos-license.html" + ], + "isOsiApproved": false + }, + { + "reference": "./eGenix.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/eGenix.json", + "referenceNumber": "204", + "name": "eGenix.com Public License 1.1.0", + "licenseId": "eGenix", + "seeAlso": [ + "http://www.egenix.com/products/eGenix.com-Public-License-1.1.0.pdf", + "https://fedoraproject.org/wiki/Licensing/eGenix.com_Public_License_1.1.0" + ], + "isOsiApproved": false + }, + { + "reference": "./gSOAP-1.3b.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/gSOAP-1.3b.json", + "referenceNumber": "346", + "name": "gSOAP Public License v1.3b", + "licenseId": "gSOAP-1.3b", + "seeAlso": [ + "http://www.cs.fsu.edu/~engelen/license.html" + ], + "isOsiApproved": false + }, + { + "reference": "./gnuplot.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/gnuplot.json", + "referenceNumber": "10", + "name": "gnuplot License", + "licenseId": "gnuplot", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Gnuplot" + ], + "isOsiApproved": false + }, + { + "reference": "./iMatix.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/iMatix.json", + "referenceNumber": "342", + "name": "iMatix Standard Function Library Agreement", + "licenseId": "iMatix", + "seeAlso": [ + "http://legacy.imatix.com/html/sfl/sfl4.htm#license" + ], + "isOsiApproved": false + }, + { + "reference": "./libpng-2.0.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/libpng-2.0.json", + "referenceNumber": "76", + "name": "PNG Reference Library version 2", + "licenseId": "libpng-2.0", + "seeAlso": [ + "http://www.libpng.org/pub/png/src/libpng-LICENSE.txt" + ], + "isOsiApproved": false + }, + { + "reference": "./libtiff.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/libtiff.json", + "referenceNumber": "220", + "name": "libtiff License", + "licenseId": "libtiff", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/libtiff" + ], + "isOsiApproved": false + }, + { + "reference": "./mpich2.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/mpich2.json", + "referenceNumber": "318", + "name": "mpich2 License", + "licenseId": "mpich2", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/MIT" + ], + "isOsiApproved": false + }, + { + "reference": "./psfrag.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/psfrag.json", + "referenceNumber": "245", + "name": "psfrag License", + "licenseId": "psfrag", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/psfrag" + ], + "isOsiApproved": false + }, + { + "reference": "./psutils.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/psutils.json", + "referenceNumber": "126", + "name": "psutils License", + "licenseId": "psutils", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/psutils" + ], + "isOsiApproved": false + }, + { + "reference": "./wxWindows.html", + "isDeprecatedLicenseId": true, + "detailsUrl": "http://spdx.org/licenses/wxWindows.json", + "referenceNumber": "86", + "name": "wxWindows Library License", + "licenseId": "wxWindows", + "seeAlso": [ + "https://opensource.org/licenses/WXwindows" + ], + "isOsiApproved": false + }, + { + "reference": "./xinetd.html", + "isDeprecatedLicenseId": false, + "isFsfLibre": true, + "detailsUrl": "http://spdx.org/licenses/xinetd.json", + "referenceNumber": "146", + "name": "xinetd License", + "licenseId": "xinetd", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/Xinetd_License" + ], + "isOsiApproved": false + }, + { + "reference": "./xpp.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/xpp.json", + "referenceNumber": "275", + "name": "XPP License", + "licenseId": "xpp", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/xpp" + ], + "isOsiApproved": false + }, + { + "reference": "./zlib-acknowledgement.html", + "isDeprecatedLicenseId": false, + "detailsUrl": "http://spdx.org/licenses/zlib-acknowledgement.json", + "referenceNumber": "321", + "name": "zlib/libpng License with Acknowledgement", + "licenseId": "zlib-acknowledgement", + "seeAlso": [ + "https://fedoraproject.org/wiki/Licensing/ZlibWithAcknowledgement" + ], + "isOsiApproved": false + } + ], + "releaseDate": "2019-07-10" +} diff --git a/cabal/pretty-show-1.6.16/CHANGELOG b/cabal/pretty-show-1.6.16/CHANGELOG deleted file mode 100644 --- a/cabal/pretty-show-1.6.16/CHANGELOG +++ /dev/null @@ -1,41 +0,0 @@ -Changes in 1.6.16 - * Fixes to accomodate GHC 8.4 - -Changes in 1.6.13 - * Parse things like and as constructors - -Changes in 1.6.12 - * Treat reserved operators as infix constructors (best effort kind of thing) - -Changes in 1.6.11 - * Add `pPrint`, which is `putStrLn . ppShow` - -Changes in 1.6.10 - * Increase the precedence of unary minus - -Changes in 1.6.9 - * Relax parsing of atoms, so that we can support things like the show - instance of StdGen (e.g., [ 123 45, 786 10 ]) - -Changes in 1.6.8.2: - * Correct license in srouce files. - -Changes in 1.6.8.1: - * Correct the 'License' field in the Cabal file to match the license (MIT) - -Changes in 1.6.8: - * Move source-repository pragma to top-level. - -Changes in 1.6.5: - * Rename CHANGES to CHANGELOG to work with hackage. - -Changes in 1.6.4: - * Drop dependency on happy >= 1.19 - -Changes in 1.6.3: - * Add Safe Haskell annotations - * Add CHANGES file - * Add generated parser to package again. We do this, because otherwise - the package fails to build on systems that do not have `happy`. - This is a bit questionable, but hopefully it won't be too much of - a problem. diff --git a/cabal/pretty-show-1.6.16/LICENSE b/cabal/pretty-show-1.6.16/LICENSE deleted file mode 100644 --- a/cabal/pretty-show-1.6.16/LICENSE +++ /dev/null @@ -1,19 +0,0 @@ -Copyright (c) 2008 Iavor S. Diatchki - -Permission is hereby granted, free of charge, to any person obtaining a copy of -this software and associated documentation files (the "Software"), to deal in -the Software without restriction, including without limitation the rights to -use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies -of the Software, and to permit persons to whom the Software is furnished to do -so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included in all -copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -SOFTWARE. diff --git a/cabal/pretty-show-1.6.16/Setup.lhs b/cabal/pretty-show-1.6.16/Setup.lhs deleted file mode 100644 --- a/cabal/pretty-show-1.6.16/Setup.lhs +++ /dev/null @@ -1,8 +0,0 @@ -#! /usr/bin/env runhaskell - -> module Main (main) where -> -> import Distribution.Simple (defaultMain) -> -> main :: IO () -> main = defaultMain diff --git a/cabal/pretty-show-1.6.16/Text/Show/Html.hs b/cabal/pretty-show-1.6.16/Text/Show/Html.hs deleted file mode 100644 --- a/cabal/pretty-show-1.6.16/Text/Show/Html.hs +++ /dev/null @@ -1,211 +0,0 @@ -{-# LANGUAGE Safe #-} -module Text.Show.Html - ( HtmlOpts(..), defaultHtmlOpts - , valToHtml, valToHtmlPage, htmlPage - , Html(..) - ) where - -import Text.Show.Value -import Prelude hiding (span) - --- | Make an Html page representing the given value. -valToHtmlPage :: HtmlOpts -> Value -> String -valToHtmlPage opts = htmlPage opts . valToHtml opts - --- | Options on how to generate Html (more to come). -data HtmlOpts = HtmlOpts - { dataDir :: FilePath -- ^ Path for extra files. If empty, we look in - -- directory `style`, relative to document. - , wideListWidth :: Int -- ^ Max. number of columns in wide lists. - } deriving Show - --- | Default options. -defaultHtmlOpts :: HtmlOpts -defaultHtmlOpts = HtmlOpts - { dataDir = "" - , wideListWidth = 80 - } - --- | Convert a value into an Html fragment. -valToHtml :: HtmlOpts -> Value -> Html -valToHtml opts = loop - where - loop val = - case val of - Con con [] -> span "con" (text con) - Con con vs -> tallRecord con (map conLab vs) (map loop vs) - Rec con fs -> tallRecord con (map fst fs) (map (loop . snd) fs) - Tuple vs -> wideTuple (map loop vs) - - InfixCons v ms -> - table "infix tallRecord" - [ tr $ (th "label" 1 (text " ") :) - $ map td $ loop v : [ h | (op,u) <- ms - , h <- [ text op, loop u ] - ] - ] - - List [] -> span "list" (text "[]") - List vs@(v : vs1) -> - case v of - - Con c fs - | all (isCon c) vs1 -> recordList c (map conLab fs) - [ map loop xs | Con _ xs <- vs ] - | otherwise -> tallList $ map (loop) vs - - Rec c fs - | all (isRec c) vs1 -> recordList c (map fst fs) - [ map (loop . snd) xs | Rec _ xs <- vs ] - | otherwise -> tallList $ map (loop) vs - - Tuple fs -> tupleList (length fs) - [ map (loop) xs | Tuple xs <- vs ] - - List {} -> tallList $ map loop vs - - Neg {} -> wideList (wideListWidth opts) $ map loop vs - Ratio {} -> wideList (wideListWidth opts) $ map loop vs - Integer {} -> wideList (wideListWidth opts) $ map loop vs - Float {} -> wideList (wideListWidth opts) $ map loop vs - Char {} -> wideList (wideListWidth opts) $ map loop vs - String {} -> tallList $ map loop vs - InfixCons {} -> tallList $ map loop vs - - Neg v -> - case v of - Integer txt -> span "integer" $ text ('-' : txt) - Float txt -> span "float" $ text ('-' : txt) - _ -> neg (loop v) - - Ratio v1 v2 -> ratio (loop v1) (loop v2) - Integer txt -> span "integer" (text txt) - Float txt -> span "float" (text txt) - Char txt -> span "char" (text txt) - String txt -> span "string" (text txt) - - conLab _ = " " - - isCon c (Con d _) = c == d - isCon _ _ = False - - isRec c (Rec d _) = c == d - isRec _ _ = False - - -neg :: Html -> Html -neg e = table "negate" [ tr [td (text "-"), td e] ] - -ratio :: Html -> Html -> Html -ratio e1 e2 = table "ratio" [ tr [ td' "numerator" e1 ], tr [td e2] ] - -wideTuple :: [Html] -> Html -wideTuple els = table "wideTuple" [ tr $ map td els ] - -tallTuple :: [Html] -> Html -tallTuple els = table "tallTuple" $ map (tr . return . td) els - -tallRecord :: Name -> [Name] -> [Html] -> Html -tallRecord con labs els = table "tallRecord" $ topHs : zipWith row labs els - where - topHs = tr [ th "con" 2 (text con) ] - row l e = tr [ th "label" 1 (text l), td e ] - -recordList :: Name -> [Name] -> [[Html]] -> Html -recordList con labs els = table "recordList" $ topHs : zipWith row [0..] els - where - topHs = tr $ th "con" 1 (text con) : map (th "label" 1 . text) labs - row n es = tr $ th "ix" 1 (int n) : map td es - -tupleList :: Int -> [[Html]] -> Html -tupleList n els = recordList " " (replicate n " ") els - -tallList :: [Html] -> Html -tallList els = table "tallList" $ top : zipWith row [0..] els - where - top = tr [ th "con" 2 (text " ")] - row n e = tr [ th "ix" 1 (int n), td e ] - -wideList :: Int -> [Html] -> Html -wideList w els = table "wideList" $ topHs : zipWith row [0..] (chop els) - where - elNum = length els - pad = elNum > w - - chop [] = [] - chop xs = let (as,bs) = splitAt w xs - in take w (as ++ if pad then repeat empty else []) : chop bs - - topHs = tr $ th "con" 1 (text " ") : map (th "label" 1 . int) - [ 0 .. min elNum w - 1 ] - row n es = tr $ (th "ix" 1 (int (n*w))) : map td es - --------------------------------------------------------------------------------- -newtype Html = Html { exportHtml :: String } - -table :: String -> [Html] -> Html -table cl body = Html $ "" ++ - concatMap exportHtml body ++ - "
" - -tr :: [Html] -> Html -tr body = Html $ "" ++ concatMap exportHtml body ++ "" - -th :: String -> Int -> Html -> Html -th cl n body = Html $ "" ++ - exportHtml body ++ - "" - -td :: Html -> Html -td body = Html $ "" ++ exportHtml body ++ "" - -td' :: String -> Html -> Html -td' cl body = Html $ "" ++ - exportHtml body ++ - "" - -span :: String -> Html -> Html -span cl body = Html $ "" ++ - exportHtml body ++ - "" - -empty :: Html -empty = Html "" - -int :: Int -> Html -int = Html . show - -text :: String -> Html -text = Html . concatMap esc - where - esc '<' = "<" - esc '>' = ">" - esc '&' = "&" - esc ' ' = " " - esc c = [c] - --- | Wrap an Html fragment to make an Html page. -htmlPage :: HtmlOpts -> Html -> String -htmlPage opts body = - unlines - [ "" - , "" - , "" - , "" - , "" - , "" - , exportHtml body - , "" - , "" - ] - where - -- XXX: slashes on Windows? - dir = case dataDir opts of - "" -> "" - d -> d ++ "/" - jquery = dir ++ "style/jquery.js" - pjs = dir ++ "style/pretty-show.js" - pstyle = dir ++ "style/pretty-show.css" - - diff --git a/cabal/pretty-show-1.6.16/Text/Show/Parser.y b/cabal/pretty-show-1.6.16/Text/Show/Parser.y deleted file mode 100644 --- a/cabal/pretty-show-1.6.16/Text/Show/Parser.y +++ /dev/null @@ -1,130 +0,0 @@ -{ --- We use these options because Happy generates code with a lot of warnings. -{-# LANGUAGE Trustworthy #-} -module Text.Show.Parser (parseValue) where - -import Text.Show.Value -import Language.Haskell.Lexer -} - -%token - - '=' { (Reservedop, (_,"=")) } - '(' { (Special, (_,"(")) } - ')' { (Special, (_,")")) } - '{' { (Special, (_,"{")) } - '}' { (Special, (_,"}")) } - '[' { (Special, (_,"[")) } - ']' { (Special, (_,"]")) } - '<' { (Varsym, (_,"<")) } - '>' { (Varsym, (_,">")) } - ',' { (Special, (_,",")) } - '-' { (Varsym, (_,"-")) } - '%' { (Varsym, (_,"%")) } - '`' { (Special, (_,"`")) } - - INT { (IntLit, (_,$$)) } - FLOAT { (FloatLit, (_,$$)) } - STRING { (StringLit, (_,$$)) } - CHAR { (CharLit, (_,$$)) } - - VARID { (Varid, (_,$$)) } - QVARID { (Qvarid, (_,$$)) } - VARSYM { (Varsym, (_,$$)) } - QVARSYM { (Qvarsym, (_,$$)) } - CONID { (Conid, (_,$$)) } - QCONID { (Qconid, (_,$$)) } - CONSYM { (Consym, (_,$$)) } - QCONSYM { (Qconsym, (_,$$)) } - RESOP { (Reservedop, (_,$$)) } - - -%monad { Maybe } { (>>=) } { return } -%name parseValue value -%tokentype { PosToken } - - -%% - -value :: { Value } - : value '%' app_value { Ratio $1 $3 } - | app_value { $1 } - | app_value list1(infixelem) { InfixCons $1 $2 } - -infixelem :: { (String,Value) } - : infixcon app_value { ($1,$2) } - -app_value :: { Value } - : list1(avalue) { mkValue $1 } - - -avalue :: { Value } - : '(' value ')' { $2 } - | '[' sep(value,',') ']' { List $2 } - | '(' tuple ')' { Tuple $2 } - | con '{' sep(field,',') '}' { Rec $1 $3 } - | con { Con $1 [] } - | INT { Integer $1 } - | FLOAT { Float $1 } - | STRING { String $1 } - | CHAR { Char $1 } - | '-' avalue { Neg $2 } - -con :: { String } - : CONID { $1 } - | QCONID { $1 } - | prefix(CONSYM) { $1 } - | prefix(QCONSYM) { $1 } - -- to support things like "fromList x" - | VARID { $1 } - | QVARID { $1 } - | prefix(VARSYM) { $1 } - | prefix(QVARSYM) { $1 } - | '<' VARID '>' { "<" ++ $2 ++ ">" } -- note: looses space - | '<' CONID '>' { "<" ++ $2 ++ ">" } -- ditto - -infixcon :: { String } - : CONSYM { $1 } - | QCONSYM { $1 } - | '`' CONID '`' { backtick $2 } - | '`' QCONID '`' { backtick $2 } - | RESOP { $1 } - -field :: { (Name,Value) } - : VARID '=' value { ($1,$3) } - -tuple :: { [Value] } - : { [] } - | value ',' sep1(value,',') { $1 : $3 } - --- Common Rule Patterns -------------------------------------------------------- -prefix(p) : '(' p ')' { "(" ++ $2 ++ ")" } - -sep1(p,q) : p list(snd(q,p)) { $1 : $2 } -sep(p,q) : sep1(p,q) { $1 } - | { [] } - -snd(p,q) : p q { $2 } - -list1(p) : rev_list1(p) { reverse $1 } -list(p) : list1(p) { $1 } - | { [] } - -rev_list1(p) : p { [$1] } - | rev_list1(p) p { $2 : $1 } - - - -{ -backtick :: String -> String -backtick s = "`" ++ s ++ "`" - -happyError :: [PosToken] -> Maybe a -happyError ((_,(p,_)) : _) = Nothing -- error ("Parser error at: " ++ show p) -happyError [] = Nothing -- error ("Parser error at EOF") - -mkValue :: [Value] -> Value -mkValue [v] = v -mkValue (Con x [] : vs) = Con x vs -mkValue vs = Con "" vs -} diff --git a/cabal/pretty-show-1.6.16/Text/Show/Pretty.hs b/cabal/pretty-show-1.6.16/Text/Show/Pretty.hs deleted file mode 100644 --- a/cabal/pretty-show-1.6.16/Text/Show/Pretty.hs +++ /dev/null @@ -1,186 +0,0 @@ --------------------------------------------------------------------------------- --- | --- Module : Text.Show.Pretty --- Copyright : (c) Iavor S. Diatchki 2009 --- License : MIT --- --- Maintainer : iavor.diatchki@gmail.com --- Stability : provisional --- Portability : Haskell 98 --- --- Functions for human-readable derived 'Show' instances. --------------------------------------------------------------------------------- - -{-# LANGUAGE CPP #-} -{-# LANGUAGE Safe #-} -module Text.Show.Pretty - ( -- * Generic representation of values - Value(..), Name - , valToStr - , valToDoc - , valToHtmlPage - - -- * Values using the 'Show' class - , parseValue, reify, ppDoc, ppShow, pPrint - - , -- * Working with listlike ("foldable") collections - ppDocList, ppShowList, pPrintList - - -- * Values using the 'PrettyVal' class - , dumpDoc, dumpStr, PrettyVal(..) - - -- * Rendering values to Html - , valToHtml, HtmlOpts(..), defaultHtmlOpts, htmlPage, Html(..) - - -- * Get location of data files - , getDataDir - - -- * Deprecated - , ppValue - ) where - -import Text.PrettyPrint -import qualified Text.Show.Parser as P -import Text.Show.Value -import Text.Show.PrettyVal -import Text.Show.Html -import Data.Foldable(Foldable,toList) -import Language.Haskell.Lexer(rmSpace,lexerPass0) -import Paths_pretty_show (getDataDir) - -#if MIN_VERSION_base(4,11,0) -import Prelude hiding ( (<>) ) -#else -import Prelude -#endif - -{-# DEPRECATED ppValue "Please use `valToDoc` instead." #-} -ppValue :: Value -> Doc -ppValue = valToDoc - -reify :: Show a => a -> Maybe Value -reify = parseValue . show - -parseValue :: String -> Maybe Value -parseValue = P.parseValue . rmSpace . lexerPass0 - --- | Convert a generic value into a pretty 'String', if possible. -ppShow :: Show a => a -> String -ppShow = show . ppDoc - --- | Pretty print something that may be converted to a list as a list. --- Each entry is on a separate line, which means that we don't do clever --- pretty printing, and so this works well for large strucutures. -ppShowList :: (Foldable f, Show a) => f a -> String -ppShowList = show . ppDocList - --- | Try to show a value, prettily. If we do not understand the value, then we --- just use its standard 'Show' instance. -ppDoc :: Show a => a -> Doc -ppDoc a = case parseValue txt of - Just v -> valToDoc v - Nothing -> text txt - where txt = show a - --- | Pretty print something that may be converted to a list as a list. --- Each entry is on a separate line, which means that we don't do clever --- pretty printing, and so this works well for large strucutures. -ppDocList :: (Foldable f, Show a) => f a -> Doc -ppDocList = blockWith vcat '[' ']' . map ppDoc . toList - --- | Pretty print a generic value to stdout. This is particularly useful in the --- GHCi interactive environment. -pPrint :: Show a => a -> IO () -pPrint = putStrLn . ppShow - --- | Pretty print something that may be converted to a list as a list. --- Each entry is on a separate line, which means that we don't do clever --- pretty printing, and so this works well for large strucutures. -pPrintList :: (Foldable f, Show a) => f a -> IO () -pPrintList = putStrLn . ppShowList - --- | Render a value in the 'PrettyVal' class to a 'Doc'. --- The benefit of this function is that 'PrettyVal' instances may --- be derived automatically using generics. -dumpDoc :: PrettyVal a => a -> Doc -dumpDoc = valToDoc . prettyVal - --- | Render a value in the 'PrettyVal' class to a 'String'. --- The benefit of this function is that 'PrettyVal' instances may --- be derived automatically using generics. -dumpStr :: PrettyVal a => a -> String -dumpStr = show . dumpDoc - - --- | Pretty print a generic value. Our intention is that the result is --- equivalent to the 'Show' instance for the original value, except possibly --- easier to understand by a human. -valToStr :: Value -> String -valToStr = show . valToDoc - --- | Pretty print a generic value. Our intention is that the result is --- equivalent to the 'Show' instance for the original value, except possibly --- easier to understand by a human. -valToDoc :: Value -> Doc -valToDoc val = case val of - Con c vs -> ppCon c vs - InfixCons v1 cvs -> hang_sep (go v1 cvs) - where - go v [] = [ppInfixAtom v] - go v ((n,v2):cvs') = (ppInfixAtom v <+> text n):go v2 cvs' - - hang_sep [] = empty - hang_sep (x:xs) = hang x 2 (sep xs) - -- hang (ppInfixAtom v1) 2 (sep [ text n <+> ppInfixAtom v | (n,v) <- cvs ]) - Rec c fs -> hang (text c) 2 $ block '{' '}' (map ppField fs) - where ppField (x,v) = hang (text x <+> char '=') 2 (valToDoc v) - - List vs -> block '[' ']' (map valToDoc vs) - Tuple vs -> block '(' ')' (map valToDoc vs) - Neg v -> char '-' <> ppAtom v - Ratio x y -> hang (ppAtom x <+> text "%") 2 (ppAtom y) - Integer x -> text x - Float x -> text x - Char x -> text x - String x -> text x - - --- Private --------------------------------------------------------------------- - -ppAtom :: Value -> Doc -ppAtom v - | isAtom v = valToDoc v - | otherwise = parens (valToDoc v) - -ppInfixAtom :: Value -> Doc -ppInfixAtom v - | isInfixAtom v = valToDoc v - | otherwise = parens (valToDoc v) - -ppCon :: Name -> [Value] -> Doc -ppCon "" vs = sep (map ppAtom vs) -ppCon c vs = hang (text c) 2 (sep (map ppAtom vs)) - -isAtom :: Value -> Bool -isAtom (Con _ (_:_)) = False -isAtom (InfixCons {}) = False -isAtom (Ratio {}) = False -isAtom (Neg {}) = False -isAtom _ = True - --- Don't put parenthesis around constructors in infix chains -isInfixAtom :: Value -> Bool -isInfixAtom (InfixCons {}) = False -isInfixAtom (Ratio {}) = False -isInfixAtom (Neg {}) = False -isInfixAtom _ = True - -block :: Char -> Char -> [Doc] -> Doc -block = blockWith sep - -blockWith :: ([Doc] -> Doc) -> Char -> Char -> [Doc] -> Doc -blockWith _ a b [] = char a <> char b -blockWith f a b (d:ds) = f $ - (char a <+> d) : [ char ',' <+> x | x <- ds ] ++ [ char b ] - - diff --git a/cabal/pretty-show-1.6.16/Text/Show/PrettyVal.hs b/cabal/pretty-show-1.6.16/Text/Show/PrettyVal.hs deleted file mode 100644 --- a/cabal/pretty-show-1.6.16/Text/Show/PrettyVal.hs +++ /dev/null @@ -1,130 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE Safe #-} -#ifndef NO_GENERICS -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE FlexibleInstances, FlexibleContexts #-} -{-# LANGUAGE DefaultSignatures #-} -#endif -module Text.Show.PrettyVal ( PrettyVal(prettyVal) ) where - -import Text.Show.Value - -#ifndef NO_GENERICS -import Data.Ratio -import Data.Word -import Data.Int -import GHC.Generics -#endif - --- | A class for types that may be reified into a value. --- Instances of this class may be derived automatically, --- for datatypes that support `Generics`. -class PrettyVal a where - prettyVal :: a -> Value - listValue :: [a] -> Value - -#ifndef NO_GENERICS - - default prettyVal :: (GDump (Rep a), Generic a) => a -> Value - prettyVal = oneVal . gdump . from - - default listValue :: [a] -> Value - listValue = List . map prettyVal - - -class GDump f where - gdump :: f a -> [(Name,Value)] - -instance GDump U1 where - gdump U1 = [] - -instance (GDump f, GDump g) => GDump (f :*: g) where - gdump (xs :*: ys) = gdump xs ++ gdump ys - -instance (GDump f, GDump g) => GDump (f :+: g) where - gdump (L1 x) = gdump x - gdump (R1 x) = gdump x - -instance PrettyVal a => GDump (K1 t a) where - gdump (K1 x) = [ ("", prettyVal x) ] - -instance (GDump f, Datatype d) => GDump (M1 D d f) where - gdump (M1 x) = gdump x - -instance (GDump f, Constructor c) => GDump (M1 C c f) where - gdump c@(M1 x) - | conIsRecord c = [ ("", Rec name (gdump x)) ] - | isTuple name = [ ("", Tuple (map snd (gdump x))) ] - | otherwise = [ ("", Con name (map snd (gdump x))) ] - - where - name = conName c - - isTuple ('(' : cs) = case span (== ',') cs of - (_,")") -> True - _ -> False - isTuple _ = False - -instance (GDump f, Selector s) => GDump (M1 S s f) where - gdump it@(M1 x) = repeat (selName it) `zip` map snd (gdump x) - -oneVal :: [(Name,Value)] -> Value -oneVal x = - case x of - [ ("",v) ] -> v - fs | all (null . fst) fs -> Con "?" (map snd fs) - | otherwise -> Rec "?" fs - - -mkNum :: (Ord a, Num a, Show a) => (String -> Value) -> a -> Value -mkNum c x - | x >= 0 = c (show x) - | otherwise = Neg (c (show (negate x))) - -instance PrettyVal Int where prettyVal = mkNum Integer -instance PrettyVal Integer where prettyVal = mkNum Integer -instance PrettyVal Float where prettyVal x = Float (show x) -instance PrettyVal Double where prettyVal x = Float (show x) - -instance PrettyVal Word8 where prettyVal x = Integer (show x) -instance PrettyVal Word16 where prettyVal x = Integer (show x) -instance PrettyVal Word32 where prettyVal x = Integer (show x) -instance PrettyVal Word64 where prettyVal x = Integer (show x) - -instance PrettyVal Int8 where prettyVal = mkNum Integer -instance PrettyVal Int16 where prettyVal = mkNum Integer -instance PrettyVal Int32 where prettyVal = mkNum Integer -instance PrettyVal Int64 where prettyVal = mkNum Integer - -instance PrettyVal Char where - prettyVal x = Char (show x) - listValue xs = String xs - -instance PrettyVal a => PrettyVal [a] where - prettyVal xs = listValue xs - -instance (PrettyVal a, Integral a) => PrettyVal (Ratio a) where - prettyVal r = Ratio (prettyVal (numerator r)) (prettyVal (denominator r)) - -instance (PrettyVal a1, PrettyVal a2) => PrettyVal (a1,a2) -instance (PrettyVal a1, PrettyVal a2, PrettyVal a3) => PrettyVal (a1,a2,a3) -instance (PrettyVal a1, PrettyVal a2, PrettyVal a3, - PrettyVal a4) => PrettyVal (a1,a2,a3,a4) - -instance (PrettyVal a1, PrettyVal a2, PrettyVal a3, - PrettyVal a4, PrettyVal a5) => PrettyVal (a1,a2,a3,a4,a5) - -instance (PrettyVal a1, PrettyVal a2, PrettyVal a3, - PrettyVal a4, PrettyVal a5, PrettyVal a6) => PrettyVal (a1,a2,a3,a4,a5,a6) - -instance (PrettyVal a1, PrettyVal a2, PrettyVal a3, - PrettyVal a4, PrettyVal a5, PrettyVal a6, PrettyVal a7) - => PrettyVal (a1,a2,a3,a4,a5,a6,a7) - -instance PrettyVal Bool -instance PrettyVal Ordering -instance PrettyVal a => PrettyVal (Maybe a) -instance (PrettyVal a, PrettyVal b) => PrettyVal (Either a b) - -#endif - diff --git a/cabal/pretty-show-1.6.16/Text/Show/Value.hs b/cabal/pretty-show-1.6.16/Text/Show/Value.hs deleted file mode 100644 --- a/cabal/pretty-show-1.6.16/Text/Show/Value.hs +++ /dev/null @@ -1,41 +0,0 @@ --------------------------------------------------------------------------------- --- | --- Module : Text.Show.Value --- Copyright : (c) Iavor S. Diatchki 2009 --- License : MIT --- --- Maintainer : iavor.diatchki@gmail.com --- Stability : provisional --- Portability : Haskell 98 --- --- Generic representation of Showable values. --------------------------------------------------------------------------------- - -{-# LANGUAGE Safe #-} -module Text.Show.Value ( Name, Value(..) ) where - --- | A name. -type Name = String - --- | Generic Haskell values. --- 'NaN' and 'Infinity' are represented as constructors. --- The 'String' in the literals is the text for the literals \"as is\". --- --- A chain of infix constructors means that they appeared in the input string --- without parentheses, i.e --- --- @1 :+: 2 :*: 3@ is represented with @InfixCons 1 [(":+:",2),(":*:",3)]@, whereas --- --- @1 :+: (2 :*: 3)@ is represented with @InfixCons 1 [(":+:",InfixCons 2 [(":*:",3)])]@. -data Value = Con Name [Value] -- ^ Data constructor - | InfixCons Value [(Name,Value)] -- ^ Infix data constructor chain - | Rec Name [ (Name,Value) ] -- ^ Record value - | Tuple [Value] -- ^ Tuple - | List [Value] -- ^ List - | Neg Value -- ^ Negated value - | Ratio Value Value -- ^ Rational - | Integer String -- ^ Non-negative integer - | Float String -- ^ Non-negative floating num. - | Char String -- ^ Character - | String String -- ^ String - deriving (Eq,Show) diff --git a/cabal/pretty-show-1.6.16/bin/ppsh.hs b/cabal/pretty-show-1.6.16/bin/ppsh.hs deleted file mode 100644 --- a/cabal/pretty-show-1.6.16/bin/ppsh.hs +++ /dev/null @@ -1,44 +0,0 @@ -import Text.Show.Pretty -import System.Environment -import System.IO(hPutStrLn,stderr) - -main :: IO () -main = - do as <- getArgs - case as of - ["--test"] -> interactLn (show . selftest1) - - ["--html"] -> - do txt <- getContents - case parseValue txt of - Just v -> - do dir <- getDataDir - let opts = defaultHtmlOpts { dataDir = dir } - putStrLn (valToHtmlPage opts v) - Nothing -> hPutStrLn stderr "Failed to parse value." - - [] -> interactLn $ \s -> case parseValue s of - Just v -> show (valToDoc v) - Nothing -> s - _ -> hPutStrLn stderr $ unlines - [ "usage: ppsh < showed_value > pretty_value" - , " --html Generate HTML." - , " --test Self test: True means we passed." - ] - - -interactLn :: (String -> String) -> IO () -interactLn f = interact f >> putStrLn "" - -selftest :: Value -> Bool -selftest v = case parseValue $ show $ valToDoc v of - Just v1 -> v1 == v - Nothing -> False - -selftest1 :: String -> Bool -selftest1 txt = case parseValue txt of - Just v -> selftest v - Nothing -> True - - - diff --git a/cabal/pretty-show-1.6.16/pretty-show.cabal b/cabal/pretty-show-1.6.16/pretty-show.cabal deleted file mode 100644 --- a/cabal/pretty-show-1.6.16/pretty-show.cabal +++ /dev/null @@ -1,73 +0,0 @@ -name: pretty-show -version: 1.6.16 -category: Text - -synopsis: Tools for working with derived `Show` instances and generic - inspection of values. -description: - We provide a library and an executable for working with derived 'Show' - instances. By using the library, we can parse derived 'Show' instances into a - generic data structure. The @ppsh@ tool uses the library to produce - human-readable versions of 'Show' instances, which can be quite handy for - debugging Haskell programs. We can also render complex generic values into - an interactive Html page, for easier examination. - -license: MIT -license-file: LICENSE -author: Iavor S. Diatchki -maintainer: iavor.diatchki@gmail.com - -homepage: http://wiki.github.com/yav/pretty-show - -cabal-version: >= 1.8 -build-type: Simple - -tested-with: GHC == 7.10.3 - GHC == 8.0.2 - GHC == 8.2.2 - -data-files: - style/jquery.js - style/jquery-src.js - style/pretty-show.js - style/pretty-show.css - -extra-source-files: - CHANGELOG - -library - exposed-modules: - Text.Show.Pretty - other-modules: - Text.Show.Html - Text.Show.Parser - Text.Show.Value - Text.Show.PrettyVal - Paths_pretty_show - build-depends: - array >= 0.2 && < 2, - base >= 4.5 && < 5, - haskell-lexer >= 1 && < 2, - pretty >= 1 && < 2, - filepath, - ghc-prim - ghc-options: -Wall -O2 - if impl(ghc < 7.4) - cpp-options: -DNO_GENERICS - build-tools: happy - -executable ppsh - main-is: ppsh.hs - other-modules: Paths_pretty_show - - hs-source-dirs: bin - build-depends: - base >= 4.5 && < 5, - pretty-show - ghc-options: -Wall - -source-repository head - type: git - location: https://github.com/yav/pretty-show.git - - diff --git a/cabal/pretty-show-1.6.16/style/jquery-src.js b/cabal/pretty-show-1.6.16/style/jquery-src.js deleted file mode 100644 --- a/cabal/pretty-show-1.6.16/style/jquery-src.js +++ /dev/null @@ -1,10337 +0,0 @@ -/*! - * jQuery JavaScript Library v1.11.0 - * http://jquery.com/ - * - * Includes Sizzle.js - * http://sizzlejs.com/ - * - * Copyright 2005, 2014 jQuery Foundation, Inc. and other contributors - * Released under the MIT license - * http://jquery.org/license - * - * Date: 2014-01-23T21:02Z - */ - -(function( global, factory ) { - - if ( typeof module === "object" && typeof module.exports === "object" ) { - // For CommonJS and CommonJS-like environments where a proper window is present, - // execute the factory and get jQuery - // For environments that do not inherently posses a window with a document - // (such as Node.js), expose a jQuery-making factory as module.exports - // This accentuates the need for the creation of a real window - // e.g. var jQuery = require("jquery")(window); - // See ticket #14549 for more info - module.exports = global.document ? - factory( global, true ) : - function( w ) { - if ( !w.document ) { - throw new Error( "jQuery requires a window with a document" ); - } - return factory( w ); - }; - } else { - factory( global ); - } - -// Pass this if window is not defined yet -}(typeof window !== "undefined" ? window : this, function( window, noGlobal ) { - -// Can't do this because several apps including ASP.NET trace -// the stack via arguments.caller.callee and Firefox dies if -// you try to trace through "use strict" call chains. (#13335) -// Support: Firefox 18+ -// - -var deletedIds = []; - -var slice = deletedIds.slice; - -var concat = deletedIds.concat; - -var push = deletedIds.push; - -var indexOf = deletedIds.indexOf; - -var class2type = {}; - -var toString = class2type.toString; - -var hasOwn = class2type.hasOwnProperty; - -var trim = "".trim; - -var support = {}; - - - -var - version = "1.11.0", - - // Define a local copy of jQuery - jQuery = function( selector, context ) { - // The jQuery object is actually just the init constructor 'enhanced' - // Need init if jQuery is called (just allow error to be thrown if not included) - return new jQuery.fn.init( selector, context ); - }, - - // Make sure we trim BOM and NBSP (here's looking at you, Safari 5.0 and IE) - rtrim = /^[\s\uFEFF\xA0]+|[\s\uFEFF\xA0]+$/g, - - // Matches dashed string for camelizing - rmsPrefix = /^-ms-/, - rdashAlpha = /-([\da-z])/gi, - - // Used by jQuery.camelCase as callback to replace() - fcamelCase = function( all, letter ) { - return letter.toUpperCase(); - }; - -jQuery.fn = jQuery.prototype = { - // The current version of jQuery being used - jquery: version, - - constructor: jQuery, - - // Start with an empty selector - selector: "", - - // The default length of a jQuery object is 0 - length: 0, - - toArray: function() { - return slice.call( this ); - }, - - // Get the Nth element in the matched element set OR - // Get the whole matched element set as a clean array - get: function( num ) { - return num != null ? - - // Return a 'clean' array - ( num < 0 ? this[ num + this.length ] : this[ num ] ) : - - // Return just the object - slice.call( this ); - }, - - // Take an array of elements and push it onto the stack - // (returning the new matched element set) - pushStack: function( elems ) { - - // Build a new jQuery matched element set - var ret = jQuery.merge( this.constructor(), elems ); - - // Add the old object onto the stack (as a reference) - ret.prevObject = this; - ret.context = this.context; - - // Return the newly-formed element set - return ret; - }, - - // Execute a callback for every element in the matched set. - // (You can seed the arguments with an array of args, but this is - // only used internally.) - each: function( callback, args ) { - return jQuery.each( this, callback, args ); - }, - - map: function( callback ) { - return this.pushStack( jQuery.map(this, function( elem, i ) { - return callback.call( elem, i, elem ); - })); - }, - - slice: function() { - return this.pushStack( slice.apply( this, arguments ) ); - }, - - first: function() { - return this.eq( 0 ); - }, - - last: function() { - return this.eq( -1 ); - }, - - eq: function( i ) { - var len = this.length, - j = +i + ( i < 0 ? len : 0 ); - return this.pushStack( j >= 0 && j < len ? [ this[j] ] : [] ); - }, - - end: function() { - return this.prevObject || this.constructor(null); - }, - - // For internal use only. - // Behaves like an Array's method, not like a jQuery method. - push: push, - sort: deletedIds.sort, - splice: deletedIds.splice -}; - -jQuery.extend = jQuery.fn.extend = function() { - var src, copyIsArray, copy, name, options, clone, - target = arguments[0] || {}, - i = 1, - length = arguments.length, - deep = false; - - // Handle a deep copy situation - if ( typeof target === "boolean" ) { - deep = target; - - // skip the boolean and the target - target = arguments[ i ] || {}; - i++; - } - - // Handle case when target is a string or something (possible in deep copy) - if ( typeof target !== "object" && !jQuery.isFunction(target) ) { - target = {}; - } - - // extend jQuery itself if only one argument is passed - if ( i === length ) { - target = this; - i--; - } - - for ( ; i < length; i++ ) { - // Only deal with non-null/undefined values - if ( (options = arguments[ i ]) != null ) { - // Extend the base object - for ( name in options ) { - src = target[ name ]; - copy = options[ name ]; - - // Prevent never-ending loop - if ( target === copy ) { - continue; - } - - // Recurse if we're merging plain objects or arrays - if ( deep && copy && ( jQuery.isPlainObject(copy) || (copyIsArray = jQuery.isArray(copy)) ) ) { - if ( copyIsArray ) { - copyIsArray = false; - clone = src && jQuery.isArray(src) ? src : []; - - } else { - clone = src && jQuery.isPlainObject(src) ? src : {}; - } - - // Never move original objects, clone them - target[ name ] = jQuery.extend( deep, clone, copy ); - - // Don't bring in undefined values - } else if ( copy !== undefined ) { - target[ name ] = copy; - } - } - } - } - - // Return the modified object - return target; -}; - -jQuery.extend({ - // Unique for each copy of jQuery on the page - expando: "jQuery" + ( version + Math.random() ).replace( /\D/g, "" ), - - // Assume jQuery is ready without the ready module - isReady: true, - - error: function( msg ) { - throw new Error( msg ); - }, - - noop: function() {}, - - // See test/unit/core.js for details concerning isFunction. - // Since version 1.3, DOM methods and functions like alert - // aren't supported. They return false on IE (#2968). - isFunction: function( obj ) { - return jQuery.type(obj) === "function"; - }, - - isArray: Array.isArray || function( obj ) { - return jQuery.type(obj) === "array"; - }, - - isWindow: function( obj ) { - /* jshint eqeqeq: false */ - return obj != null && obj == obj.window; - }, - - isNumeric: function( obj ) { - // parseFloat NaNs numeric-cast false positives (null|true|false|"") - // ...but misinterprets leading-number strings, particularly hex literals ("0x...") - // subtraction forces infinities to NaN - return obj - parseFloat( obj ) >= 0; - }, - - isEmptyObject: function( obj ) { - var name; - for ( name in obj ) { - return false; - } - return true; - }, - - isPlainObject: function( obj ) { - var key; - - // Must be an Object. - // Because of IE, we also have to check the presence of the constructor property. - // Make sure that DOM nodes and window objects don't pass through, as well - if ( !obj || jQuery.type(obj) !== "object" || obj.nodeType || jQuery.isWindow( obj ) ) { - return false; - } - - try { - // Not own constructor property must be Object - if ( obj.constructor && - !hasOwn.call(obj, "constructor") && - !hasOwn.call(obj.constructor.prototype, "isPrototypeOf") ) { - return false; - } - } catch ( e ) { - // IE8,9 Will throw exceptions on certain host objects #9897 - return false; - } - - // Support: IE<9 - // Handle iteration over inherited properties before own properties. - if ( support.ownLast ) { - for ( key in obj ) { - return hasOwn.call( obj, key ); - } - } - - // Own properties are enumerated firstly, so to speed up, - // if last one is own, then all properties are own. - for ( key in obj ) {} - - return key === undefined || hasOwn.call( obj, key ); - }, - - type: function( obj ) { - if ( obj == null ) { - return obj + ""; - } - return typeof obj === "object" || typeof obj === "function" ? - class2type[ toString.call(obj) ] || "object" : - typeof obj; - }, - - // Evaluates a script in a global context - // Workarounds based on findings by Jim Driscoll - // http://weblogs.java.net/blog/driscoll/archive/2009/09/08/eval-javascript-global-context - globalEval: function( data ) { - if ( data && jQuery.trim( data ) ) { - // We use execScript on Internet Explorer - // We use an anonymous function so that context is window - // rather than jQuery in Firefox - ( window.execScript || function( data ) { - window[ "eval" ].call( window, data ); - } )( data ); - } - }, - - // Convert dashed to camelCase; used by the css and data modules - // Microsoft forgot to hump their vendor prefix (#9572) - camelCase: function( string ) { - return string.replace( rmsPrefix, "ms-" ).replace( rdashAlpha, fcamelCase ); - }, - - nodeName: function( elem, name ) { - return elem.nodeName && elem.nodeName.toLowerCase() === name.toLowerCase(); - }, - - // args is for internal usage only - each: function( obj, callback, args ) { - var value, - i = 0, - length = obj.length, - isArray = isArraylike( obj ); - - if ( args ) { - if ( isArray ) { - for ( ; i < length; i++ ) { - value = callback.apply( obj[ i ], args ); - - if ( value === false ) { - break; - } - } - } else { - for ( i in obj ) { - value = callback.apply( obj[ i ], args ); - - if ( value === false ) { - break; - } - } - } - - // A special, fast, case for the most common use of each - } else { - if ( isArray ) { - for ( ; i < length; i++ ) { - value = callback.call( obj[ i ], i, obj[ i ] ); - - if ( value === false ) { - break; - } - } - } else { - for ( i in obj ) { - value = callback.call( obj[ i ], i, obj[ i ] ); - - if ( value === false ) { - break; - } - } - } - } - - return obj; - }, - - // Use native String.trim function wherever possible - trim: trim && !trim.call("\uFEFF\xA0") ? - function( text ) { - return text == null ? - "" : - trim.call( text ); - } : - - // Otherwise use our own trimming functionality - function( text ) { - return text == null ? - "" : - ( text + "" ).replace( rtrim, "" ); - }, - - // results is for internal usage only - makeArray: function( arr, results ) { - var ret = results || []; - - if ( arr != null ) { - if ( isArraylike( Object(arr) ) ) { - jQuery.merge( ret, - typeof arr === "string" ? - [ arr ] : arr - ); - } else { - push.call( ret, arr ); - } - } - - return ret; - }, - - inArray: function( elem, arr, i ) { - var len; - - if ( arr ) { - if ( indexOf ) { - return indexOf.call( arr, elem, i ); - } - - len = arr.length; - i = i ? i < 0 ? Math.max( 0, len + i ) : i : 0; - - for ( ; i < len; i++ ) { - // Skip accessing in sparse arrays - if ( i in arr && arr[ i ] === elem ) { - return i; - } - } - } - - return -1; - }, - - merge: function( first, second ) { - var len = +second.length, - j = 0, - i = first.length; - - while ( j < len ) { - first[ i++ ] = second[ j++ ]; - } - - // Support: IE<9 - // Workaround casting of .length to NaN on otherwise arraylike objects (e.g., NodeLists) - if ( len !== len ) { - while ( second[j] !== undefined ) { - first[ i++ ] = second[ j++ ]; - } - } - - first.length = i; - - return first; - }, - - grep: function( elems, callback, invert ) { - var callbackInverse, - matches = [], - i = 0, - length = elems.length, - callbackExpect = !invert; - - // Go through the array, only saving the items - // that pass the validator function - for ( ; i < length; i++ ) { - callbackInverse = !callback( elems[ i ], i ); - if ( callbackInverse !== callbackExpect ) { - matches.push( elems[ i ] ); - } - } - - return matches; - }, - - // arg is for internal usage only - map: function( elems, callback, arg ) { - var value, - i = 0, - length = elems.length, - isArray = isArraylike( elems ), - ret = []; - - // Go through the array, translating each of the items to their new values - if ( isArray ) { - for ( ; i < length; i++ ) { - value = callback( elems[ i ], i, arg ); - - if ( value != null ) { - ret.push( value ); - } - } - - // Go through every key on the object, - } else { - for ( i in elems ) { - value = callback( elems[ i ], i, arg ); - - if ( value != null ) { - ret.push( value ); - } - } - } - - // Flatten any nested arrays - return concat.apply( [], ret ); - }, - - // A global GUID counter for objects - guid: 1, - - // Bind a function to a context, optionally partially applying any - // arguments. - proxy: function( fn, context ) { - var args, proxy, tmp; - - if ( typeof context === "string" ) { - tmp = fn[ context ]; - context = fn; - fn = tmp; - } - - // Quick check to determine if target is callable, in the spec - // this throws a TypeError, but we will just return undefined. - if ( !jQuery.isFunction( fn ) ) { - return undefined; - } - - // Simulated bind - args = slice.call( arguments, 2 ); - proxy = function() { - return fn.apply( context || this, args.concat( slice.call( arguments ) ) ); - }; - - // Set the guid of unique handler to the same of original handler, so it can be removed - proxy.guid = fn.guid = fn.guid || jQuery.guid++; - - return proxy; - }, - - now: function() { - return +( new Date() ); - }, - - // jQuery.support is not used in Core but other projects attach their - // properties to it so it needs to exist. - support: support -}); - -// Populate the class2type map -jQuery.each("Boolean Number String Function Array Date RegExp Object Error".split(" "), function(i, name) { - class2type[ "[object " + name + "]" ] = name.toLowerCase(); -}); - -function isArraylike( obj ) { - var length = obj.length, - type = jQuery.type( obj ); - - if ( type === "function" || jQuery.isWindow( obj ) ) { - return false; - } - - if ( obj.nodeType === 1 && length ) { - return true; - } - - return type === "array" || length === 0 || - typeof length === "number" && length > 0 && ( length - 1 ) in obj; -} -var Sizzle = -/*! - * Sizzle CSS Selector Engine v1.10.16 - * http://sizzlejs.com/ - * - * Copyright 2013 jQuery Foundation, Inc. and other contributors - * Released under the MIT license - * http://jquery.org/license - * - * Date: 2014-01-13 - */ -(function( window ) { - -var i, - support, - Expr, - getText, - isXML, - compile, - outermostContext, - sortInput, - hasDuplicate, - - // Local document vars - setDocument, - document, - docElem, - documentIsHTML, - rbuggyQSA, - rbuggyMatches, - matches, - contains, - - // Instance-specific data - expando = "sizzle" + -(new Date()), - preferredDoc = window.document, - dirruns = 0, - done = 0, - classCache = createCache(), - tokenCache = createCache(), - compilerCache = createCache(), - sortOrder = function( a, b ) { - if ( a === b ) { - hasDuplicate = true; - } - return 0; - }, - - // General-purpose constants - strundefined = typeof undefined, - MAX_NEGATIVE = 1 << 31, - - // Instance methods - hasOwn = ({}).hasOwnProperty, - arr = [], - pop = arr.pop, - push_native = arr.push, - push = arr.push, - slice = arr.slice, - // Use a stripped-down indexOf if we can't use a native one - indexOf = arr.indexOf || function( elem ) { - var i = 0, - len = this.length; - for ( ; i < len; i++ ) { - if ( this[i] === elem ) { - return i; - } - } - return -1; - }, - - booleans = "checked|selected|async|autofocus|autoplay|controls|defer|disabled|hidden|ismap|loop|multiple|open|readonly|required|scoped", - - // Regular expressions - - // Whitespace characters http://www.w3.org/TR/css3-selectors/#whitespace - whitespace = "[\\x20\\t\\r\\n\\f]", - // http://www.w3.org/TR/css3-syntax/#characters - characterEncoding = "(?:\\\\.|[\\w-]|[^\\x00-\\xa0])+", - - // Loosely modeled on CSS identifier characters - // An unquoted value should be a CSS identifier http://www.w3.org/TR/css3-selectors/#attribute-selectors - // Proper syntax: http://www.w3.org/TR/CSS21/syndata.html#value-def-identifier - identifier = characterEncoding.replace( "w", "w#" ), - - // Acceptable operators http://www.w3.org/TR/selectors/#attribute-selectors - attributes = "\\[" + whitespace + "*(" + characterEncoding + ")" + whitespace + - "*(?:([*^$|!~]?=)" + whitespace + "*(?:(['\"])((?:\\\\.|[^\\\\])*?)\\3|(" + identifier + ")|)|)" + whitespace + "*\\]", - - // Prefer arguments quoted, - // then not containing pseudos/brackets, - // then attribute selectors/non-parenthetical expressions, - // then anything else - // These preferences are here to reduce the number of selectors - // needing tokenize in the PSEUDO preFilter - pseudos = ":(" + characterEncoding + ")(?:\\(((['\"])((?:\\\\.|[^\\\\])*?)\\3|((?:\\\\.|[^\\\\()[\\]]|" + attributes.replace( 3, 8 ) + ")*)|.*)\\)|)", - - // Leading and non-escaped trailing whitespace, capturing some non-whitespace characters preceding the latter - rtrim = new RegExp( "^" + whitespace + "+|((?:^|[^\\\\])(?:\\\\.)*)" + whitespace + "+$", "g" ), - - rcomma = new RegExp( "^" + whitespace + "*," + whitespace + "*" ), - rcombinators = new RegExp( "^" + whitespace + "*([>+~]|" + whitespace + ")" + whitespace + "*" ), - - rattributeQuotes = new RegExp( "=" + whitespace + "*([^\\]'\"]*?)" + whitespace + "*\\]", "g" ), - - rpseudo = new RegExp( pseudos ), - ridentifier = new RegExp( "^" + identifier + "$" ), - - matchExpr = { - "ID": new RegExp( "^#(" + characterEncoding + ")" ), - "CLASS": new RegExp( "^\\.(" + characterEncoding + ")" ), - "TAG": new RegExp( "^(" + characterEncoding.replace( "w", "w*" ) + ")" ), - "ATTR": new RegExp( "^" + attributes ), - "PSEUDO": new RegExp( "^" + pseudos ), - "CHILD": new RegExp( "^:(only|first|last|nth|nth-last)-(child|of-type)(?:\\(" + whitespace + - "*(even|odd|(([+-]|)(\\d*)n|)" + whitespace + "*(?:([+-]|)" + whitespace + - "*(\\d+)|))" + whitespace + "*\\)|)", "i" ), - "bool": new RegExp( "^(?:" + booleans + ")$", "i" ), - // For use in libraries implementing .is() - // We use this for POS matching in `select` - "needsContext": new RegExp( "^" + whitespace + "*[>+~]|:(even|odd|eq|gt|lt|nth|first|last)(?:\\(" + - whitespace + "*((?:-\\d)?\\d*)" + whitespace + "*\\)|)(?=[^-]|$)", "i" ) - }, - - rinputs = /^(?:input|select|textarea|button)$/i, - rheader = /^h\d$/i, - - rnative = /^[^{]+\{\s*\[native \w/, - - // Easily-parseable/retrievable ID or TAG or CLASS selectors - rquickExpr = /^(?:#([\w-]+)|(\w+)|\.([\w-]+))$/, - - rsibling = /[+~]/, - rescape = /'|\\/g, - - // CSS escapes http://www.w3.org/TR/CSS21/syndata.html#escaped-characters - runescape = new RegExp( "\\\\([\\da-f]{1,6}" + whitespace + "?|(" + whitespace + ")|.)", "ig" ), - funescape = function( _, escaped, escapedWhitespace ) { - var high = "0x" + escaped - 0x10000; - // NaN means non-codepoint - // Support: Firefox - // Workaround erroneous numeric interpretation of +"0x" - return high !== high || escapedWhitespace ? - escaped : - high < 0 ? - // BMP codepoint - String.fromCharCode( high + 0x10000 ) : - // Supplemental Plane codepoint (surrogate pair) - String.fromCharCode( high >> 10 | 0xD800, high & 0x3FF | 0xDC00 ); - }; - -// Optimize for push.apply( _, NodeList ) -try { - push.apply( - (arr = slice.call( preferredDoc.childNodes )), - preferredDoc.childNodes - ); - // Support: Android<4.0 - // Detect silently failing push.apply - arr[ preferredDoc.childNodes.length ].nodeType; -} catch ( e ) { - push = { apply: arr.length ? - - // Leverage slice if possible - function( target, els ) { - push_native.apply( target, slice.call(els) ); - } : - - // Support: IE<9 - // Otherwise append directly - function( target, els ) { - var j = target.length, - i = 0; - // Can't trust NodeList.length - while ( (target[j++] = els[i++]) ) {} - target.length = j - 1; - } - }; -} - -function Sizzle( selector, context, results, seed ) { - var match, elem, m, nodeType, - // QSA vars - i, groups, old, nid, newContext, newSelector; - - if ( ( context ? context.ownerDocument || context : preferredDoc ) !== document ) { - setDocument( context ); - } - - context = context || document; - results = results || []; - - if ( !selector || typeof selector !== "string" ) { - return results; - } - - if ( (nodeType = context.nodeType) !== 1 && nodeType !== 9 ) { - return []; - } - - if ( documentIsHTML && !seed ) { - - // Shortcuts - if ( (match = rquickExpr.exec( selector )) ) { - // Speed-up: Sizzle("#ID") - if ( (m = match[1]) ) { - if ( nodeType === 9 ) { - elem = context.getElementById( m ); - // Check parentNode to catch when Blackberry 4.6 returns - // nodes that are no longer in the document (jQuery #6963) - if ( elem && elem.parentNode ) { - // Handle the case where IE, Opera, and Webkit return items - // by name instead of ID - if ( elem.id === m ) { - results.push( elem ); - return results; - } - } else { - return results; - } - } else { - // Context is not a document - if ( context.ownerDocument && (elem = context.ownerDocument.getElementById( m )) && - contains( context, elem ) && elem.id === m ) { - results.push( elem ); - return results; - } - } - - // Speed-up: Sizzle("TAG") - } else if ( match[2] ) { - push.apply( results, context.getElementsByTagName( selector ) ); - return results; - - // Speed-up: Sizzle(".CLASS") - } else if ( (m = match[3]) && support.getElementsByClassName && context.getElementsByClassName ) { - push.apply( results, context.getElementsByClassName( m ) ); - return results; - } - } - - // QSA path - if ( support.qsa && (!rbuggyQSA || !rbuggyQSA.test( selector )) ) { - nid = old = expando; - newContext = context; - newSelector = nodeType === 9 && selector; - - // qSA works strangely on Element-rooted queries - // We can work around this by specifying an extra ID on the root - // and working up from there (Thanks to Andrew Dupont for the technique) - // IE 8 doesn't work on object elements - if ( nodeType === 1 && context.nodeName.toLowerCase() !== "object" ) { - groups = tokenize( selector ); - - if ( (old = context.getAttribute("id")) ) { - nid = old.replace( rescape, "\\$&" ); - } else { - context.setAttribute( "id", nid ); - } - nid = "[id='" + nid + "'] "; - - i = groups.length; - while ( i-- ) { - groups[i] = nid + toSelector( groups[i] ); - } - newContext = rsibling.test( selector ) && testContext( context.parentNode ) || context; - newSelector = groups.join(","); - } - - if ( newSelector ) { - try { - push.apply( results, - newContext.querySelectorAll( newSelector ) - ); - return results; - } catch(qsaError) { - } finally { - if ( !old ) { - context.removeAttribute("id"); - } - } - } - } - } - - // All others - return select( selector.replace( rtrim, "$1" ), context, results, seed ); -} - -/** - * Create key-value caches of limited size - * @returns {Function(string, Object)} Returns the Object data after storing it on itself with - * property name the (space-suffixed) string and (if the cache is larger than Expr.cacheLength) - * deleting the oldest entry - */ -function createCache() { - var keys = []; - - function cache( key, value ) { - // Use (key + " ") to avoid collision with native prototype properties (see Issue #157) - if ( keys.push( key + " " ) > Expr.cacheLength ) { - // Only keep the most recent entries - delete cache[ keys.shift() ]; - } - return (cache[ key + " " ] = value); - } - return cache; -} - -/** - * Mark a function for special use by Sizzle - * @param {Function} fn The function to mark - */ -function markFunction( fn ) { - fn[ expando ] = true; - return fn; -} - -/** - * Support testing using an element - * @param {Function} fn Passed the created div and expects a boolean result - */ -function assert( fn ) { - var div = document.createElement("div"); - - try { - return !!fn( div ); - } catch (e) { - return false; - } finally { - // Remove from its parent by default - if ( div.parentNode ) { - div.parentNode.removeChild( div ); - } - // release memory in IE - div = null; - } -} - -/** - * Adds the same handler for all of the specified attrs - * @param {String} attrs Pipe-separated list of attributes - * @param {Function} handler The method that will be applied - */ -function addHandle( attrs, handler ) { - var arr = attrs.split("|"), - i = attrs.length; - - while ( i-- ) { - Expr.attrHandle[ arr[i] ] = handler; - } -} - -/** - * Checks document order of two siblings - * @param {Element} a - * @param {Element} b - * @returns {Number} Returns less than 0 if a precedes b, greater than 0 if a follows b - */ -function siblingCheck( a, b ) { - var cur = b && a, - diff = cur && a.nodeType === 1 && b.nodeType === 1 && - ( ~b.sourceIndex || MAX_NEGATIVE ) - - ( ~a.sourceIndex || MAX_NEGATIVE ); - - // Use IE sourceIndex if available on both nodes - if ( diff ) { - return diff; - } - - // Check if b follows a - if ( cur ) { - while ( (cur = cur.nextSibling) ) { - if ( cur === b ) { - return -1; - } - } - } - - return a ? 1 : -1; -} - -/** - * Returns a function to use in pseudos for input types - * @param {String} type - */ -function createInputPseudo( type ) { - return function( elem ) { - var name = elem.nodeName.toLowerCase(); - return name === "input" && elem.type === type; - }; -} - -/** - * Returns a function to use in pseudos for buttons - * @param {String} type - */ -function createButtonPseudo( type ) { - return function( elem ) { - var name = elem.nodeName.toLowerCase(); - return (name === "input" || name === "button") && elem.type === type; - }; -} - -/** - * Returns a function to use in pseudos for positionals - * @param {Function} fn - */ -function createPositionalPseudo( fn ) { - return markFunction(function( argument ) { - argument = +argument; - return markFunction(function( seed, matches ) { - var j, - matchIndexes = fn( [], seed.length, argument ), - i = matchIndexes.length; - - // Match elements found at the specified indexes - while ( i-- ) { - if ( seed[ (j = matchIndexes[i]) ] ) { - seed[j] = !(matches[j] = seed[j]); - } - } - }); - }); -} - -/** - * Checks a node for validity as a Sizzle context - * @param {Element|Object=} context - * @returns {Element|Object|Boolean} The input node if acceptable, otherwise a falsy value - */ -function testContext( context ) { - return context && typeof context.getElementsByTagName !== strundefined && context; -} - -// Expose support vars for convenience -support = Sizzle.support = {}; - -/** - * Detects XML nodes - * @param {Element|Object} elem An element or a document - * @returns {Boolean} True iff elem is a non-HTML XML node - */ -isXML = Sizzle.isXML = function( elem ) { - // documentElement is verified for cases where it doesn't yet exist - // (such as loading iframes in IE - #4833) - var documentElement = elem && (elem.ownerDocument || elem).documentElement; - return documentElement ? documentElement.nodeName !== "HTML" : false; -}; - -/** - * Sets document-related variables once based on the current document - * @param {Element|Object} [doc] An element or document object to use to set the document - * @returns {Object} Returns the current document - */ -setDocument = Sizzle.setDocument = function( node ) { - var hasCompare, - doc = node ? node.ownerDocument || node : preferredDoc, - parent = doc.defaultView; - - // If no document and documentElement is available, return - if ( doc === document || doc.nodeType !== 9 || !doc.documentElement ) { - return document; - } - - // Set our document - document = doc; - docElem = doc.documentElement; - - // Support tests - documentIsHTML = !isXML( doc ); - - // Support: IE>8 - // If iframe document is assigned to "document" variable and if iframe has been reloaded, - // IE will throw "permission denied" error when accessing "document" variable, see jQuery #13936 - // IE6-8 do not support the defaultView property so parent will be undefined - if ( parent && parent !== parent.top ) { - // IE11 does not have attachEvent, so all must suffer - if ( parent.addEventListener ) { - parent.addEventListener( "unload", function() { - setDocument(); - }, false ); - } else if ( parent.attachEvent ) { - parent.attachEvent( "onunload", function() { - setDocument(); - }); - } - } - - /* Attributes - ---------------------------------------------------------------------- */ - - // Support: IE<8 - // Verify that getAttribute really returns attributes and not properties (excepting IE8 booleans) - support.attributes = assert(function( div ) { - div.className = "i"; - return !div.getAttribute("className"); - }); - - /* getElement(s)By* - ---------------------------------------------------------------------- */ - - // Check if getElementsByTagName("*") returns only elements - support.getElementsByTagName = assert(function( div ) { - div.appendChild( doc.createComment("") ); - return !div.getElementsByTagName("*").length; - }); - - // Check if getElementsByClassName can be trusted - support.getElementsByClassName = rnative.test( doc.getElementsByClassName ) && assert(function( div ) { - div.innerHTML = "
"; - - // Support: Safari<4 - // Catch class over-caching - div.firstChild.className = "i"; - // Support: Opera<10 - // Catch gEBCN failure to find non-leading classes - return div.getElementsByClassName("i").length === 2; - }); - - // Support: IE<10 - // Check if getElementById returns elements by name - // The broken getElementById methods don't pick up programatically-set names, - // so use a roundabout getElementsByName test - support.getById = assert(function( div ) { - docElem.appendChild( div ).id = expando; - return !doc.getElementsByName || !doc.getElementsByName( expando ).length; - }); - - // ID find and filter - if ( support.getById ) { - Expr.find["ID"] = function( id, context ) { - if ( typeof context.getElementById !== strundefined && documentIsHTML ) { - var m = context.getElementById( id ); - // Check parentNode to catch when Blackberry 4.6 returns - // nodes that are no longer in the document #6963 - return m && m.parentNode ? [m] : []; - } - }; - Expr.filter["ID"] = function( id ) { - var attrId = id.replace( runescape, funescape ); - return function( elem ) { - return elem.getAttribute("id") === attrId; - }; - }; - } else { - // Support: IE6/7 - // getElementById is not reliable as a find shortcut - delete Expr.find["ID"]; - - Expr.filter["ID"] = function( id ) { - var attrId = id.replace( runescape, funescape ); - return function( elem ) { - var node = typeof elem.getAttributeNode !== strundefined && elem.getAttributeNode("id"); - return node && node.value === attrId; - }; - }; - } - - // Tag - Expr.find["TAG"] = support.getElementsByTagName ? - function( tag, context ) { - if ( typeof context.getElementsByTagName !== strundefined ) { - return context.getElementsByTagName( tag ); - } - } : - function( tag, context ) { - var elem, - tmp = [], - i = 0, - results = context.getElementsByTagName( tag ); - - // Filter out possible comments - if ( tag === "*" ) { - while ( (elem = results[i++]) ) { - if ( elem.nodeType === 1 ) { - tmp.push( elem ); - } - } - - return tmp; - } - return results; - }; - - // Class - Expr.find["CLASS"] = support.getElementsByClassName && function( className, context ) { - if ( typeof context.getElementsByClassName !== strundefined && documentIsHTML ) { - return context.getElementsByClassName( className ); - } - }; - - /* QSA/matchesSelector - ---------------------------------------------------------------------- */ - - // QSA and matchesSelector support - - // matchesSelector(:active) reports false when true (IE9/Opera 11.5) - rbuggyMatches = []; - - // qSa(:focus) reports false when true (Chrome 21) - // We allow this because of a bug in IE8/9 that throws an error - // whenever `document.activeElement` is accessed on an iframe - // So, we allow :focus to pass through QSA all the time to avoid the IE error - // See http://bugs.jquery.com/ticket/13378 - rbuggyQSA = []; - - if ( (support.qsa = rnative.test( doc.querySelectorAll )) ) { - // Build QSA regex - // Regex strategy adopted from Diego Perini - assert(function( div ) { - // Select is set to empty string on purpose - // This is to test IE's treatment of not explicitly - // setting a boolean content attribute, - // since its presence should be enough - // http://bugs.jquery.com/ticket/12359 - div.innerHTML = ""; - - // Support: IE8, Opera 10-12 - // Nothing should be selected when empty strings follow ^= or $= or *= - if ( div.querySelectorAll("[t^='']").length ) { - rbuggyQSA.push( "[*^$]=" + whitespace + "*(?:''|\"\")" ); - } - - // Support: IE8 - // Boolean attributes and "value" are not treated correctly - if ( !div.querySelectorAll("[selected]").length ) { - rbuggyQSA.push( "\\[" + whitespace + "*(?:value|" + booleans + ")" ); - } - - // Webkit/Opera - :checked should return selected option elements - // http://www.w3.org/TR/2011/REC-css3-selectors-20110929/#checked - // IE8 throws error here and will not see later tests - if ( !div.querySelectorAll(":checked").length ) { - rbuggyQSA.push(":checked"); - } - }); - - assert(function( div ) { - // Support: Windows 8 Native Apps - // The type and name attributes are restricted during .innerHTML assignment - var input = doc.createElement("input"); - input.setAttribute( "type", "hidden" ); - div.appendChild( input ).setAttribute( "name", "D" ); - - // Support: IE8 - // Enforce case-sensitivity of name attribute - if ( div.querySelectorAll("[name=d]").length ) { - rbuggyQSA.push( "name" + whitespace + "*[*^$|!~]?=" ); - } - - // FF 3.5 - :enabled/:disabled and hidden elements (hidden elements are still enabled) - // IE8 throws error here and will not see later tests - if ( !div.querySelectorAll(":enabled").length ) { - rbuggyQSA.push( ":enabled", ":disabled" ); - } - - // Opera 10-11 does not throw on post-comma invalid pseudos - div.querySelectorAll("*,:x"); - rbuggyQSA.push(",.*:"); - }); - } - - if ( (support.matchesSelector = rnative.test( (matches = docElem.webkitMatchesSelector || - docElem.mozMatchesSelector || - docElem.oMatchesSelector || - docElem.msMatchesSelector) )) ) { - - assert(function( div ) { - // Check to see if it's possible to do matchesSelector - // on a disconnected node (IE 9) - support.disconnectedMatch = matches.call( div, "div" ); - - // This should fail with an exception - // Gecko does not error, returns false instead - matches.call( div, "[s!='']:x" ); - rbuggyMatches.push( "!=", pseudos ); - }); - } - - rbuggyQSA = rbuggyQSA.length && new RegExp( rbuggyQSA.join("|") ); - rbuggyMatches = rbuggyMatches.length && new RegExp( rbuggyMatches.join("|") ); - - /* Contains - ---------------------------------------------------------------------- */ - hasCompare = rnative.test( docElem.compareDocumentPosition ); - - // Element contains another - // Purposefully does not implement inclusive descendent - // As in, an element does not contain itself - contains = hasCompare || rnative.test( docElem.contains ) ? - function( a, b ) { - var adown = a.nodeType === 9 ? a.documentElement : a, - bup = b && b.parentNode; - return a === bup || !!( bup && bup.nodeType === 1 && ( - adown.contains ? - adown.contains( bup ) : - a.compareDocumentPosition && a.compareDocumentPosition( bup ) & 16 - )); - } : - function( a, b ) { - if ( b ) { - while ( (b = b.parentNode) ) { - if ( b === a ) { - return true; - } - } - } - return false; - }; - - /* Sorting - ---------------------------------------------------------------------- */ - - // Document order sorting - sortOrder = hasCompare ? - function( a, b ) { - - // Flag for duplicate removal - if ( a === b ) { - hasDuplicate = true; - return 0; - } - - // Sort on method existence if only one input has compareDocumentPosition - var compare = !a.compareDocumentPosition - !b.compareDocumentPosition; - if ( compare ) { - return compare; - } - - // Calculate position if both inputs belong to the same document - compare = ( a.ownerDocument || a ) === ( b.ownerDocument || b ) ? - a.compareDocumentPosition( b ) : - - // Otherwise we know they are disconnected - 1; - - // Disconnected nodes - if ( compare & 1 || - (!support.sortDetached && b.compareDocumentPosition( a ) === compare) ) { - - // Choose the first element that is related to our preferred document - if ( a === doc || a.ownerDocument === preferredDoc && contains(preferredDoc, a) ) { - return -1; - } - if ( b === doc || b.ownerDocument === preferredDoc && contains(preferredDoc, b) ) { - return 1; - } - - // Maintain original order - return sortInput ? - ( indexOf.call( sortInput, a ) - indexOf.call( sortInput, b ) ) : - 0; - } - - return compare & 4 ? -1 : 1; - } : - function( a, b ) { - // Exit early if the nodes are identical - if ( a === b ) { - hasDuplicate = true; - return 0; - } - - var cur, - i = 0, - aup = a.parentNode, - bup = b.parentNode, - ap = [ a ], - bp = [ b ]; - - // Parentless nodes are either documents or disconnected - if ( !aup || !bup ) { - return a === doc ? -1 : - b === doc ? 1 : - aup ? -1 : - bup ? 1 : - sortInput ? - ( indexOf.call( sortInput, a ) - indexOf.call( sortInput, b ) ) : - 0; - - // If the nodes are siblings, we can do a quick check - } else if ( aup === bup ) { - return siblingCheck( a, b ); - } - - // Otherwise we need full lists of their ancestors for comparison - cur = a; - while ( (cur = cur.parentNode) ) { - ap.unshift( cur ); - } - cur = b; - while ( (cur = cur.parentNode) ) { - bp.unshift( cur ); - } - - // Walk down the tree looking for a discrepancy - while ( ap[i] === bp[i] ) { - i++; - } - - return i ? - // Do a sibling check if the nodes have a common ancestor - siblingCheck( ap[i], bp[i] ) : - - // Otherwise nodes in our document sort first - ap[i] === preferredDoc ? -1 : - bp[i] === preferredDoc ? 1 : - 0; - }; - - return doc; -}; - -Sizzle.matches = function( expr, elements ) { - return Sizzle( expr, null, null, elements ); -}; - -Sizzle.matchesSelector = function( elem, expr ) { - // Set document vars if needed - if ( ( elem.ownerDocument || elem ) !== document ) { - setDocument( elem ); - } - - // Make sure that attribute selectors are quoted - expr = expr.replace( rattributeQuotes, "='$1']" ); - - if ( support.matchesSelector && documentIsHTML && - ( !rbuggyMatches || !rbuggyMatches.test( expr ) ) && - ( !rbuggyQSA || !rbuggyQSA.test( expr ) ) ) { - - try { - var ret = matches.call( elem, expr ); - - // IE 9's matchesSelector returns false on disconnected nodes - if ( ret || support.disconnectedMatch || - // As well, disconnected nodes are said to be in a document - // fragment in IE 9 - elem.document && elem.document.nodeType !== 11 ) { - return ret; - } - } catch(e) {} - } - - return Sizzle( expr, document, null, [elem] ).length > 0; -}; - -Sizzle.contains = function( context, elem ) { - // Set document vars if needed - if ( ( context.ownerDocument || context ) !== document ) { - setDocument( context ); - } - return contains( context, elem ); -}; - -Sizzle.attr = function( elem, name ) { - // Set document vars if needed - if ( ( elem.ownerDocument || elem ) !== document ) { - setDocument( elem ); - } - - var fn = Expr.attrHandle[ name.toLowerCase() ], - // Don't get fooled by Object.prototype properties (jQuery #13807) - val = fn && hasOwn.call( Expr.attrHandle, name.toLowerCase() ) ? - fn( elem, name, !documentIsHTML ) : - undefined; - - return val !== undefined ? - val : - support.attributes || !documentIsHTML ? - elem.getAttribute( name ) : - (val = elem.getAttributeNode(name)) && val.specified ? - val.value : - null; -}; - -Sizzle.error = function( msg ) { - throw new Error( "Syntax error, unrecognized expression: " + msg ); -}; - -/** - * Document sorting and removing duplicates - * @param {ArrayLike} results - */ -Sizzle.uniqueSort = function( results ) { - var elem, - duplicates = [], - j = 0, - i = 0; - - // Unless we *know* we can detect duplicates, assume their presence - hasDuplicate = !support.detectDuplicates; - sortInput = !support.sortStable && results.slice( 0 ); - results.sort( sortOrder ); - - if ( hasDuplicate ) { - while ( (elem = results[i++]) ) { - if ( elem === results[ i ] ) { - j = duplicates.push( i ); - } - } - while ( j-- ) { - results.splice( duplicates[ j ], 1 ); - } - } - - // Clear input after sorting to release objects - // See https://github.com/jquery/sizzle/pull/225 - sortInput = null; - - return results; -}; - -/** - * Utility function for retrieving the text value of an array of DOM nodes - * @param {Array|Element} elem - */ -getText = Sizzle.getText = function( elem ) { - var node, - ret = "", - i = 0, - nodeType = elem.nodeType; - - if ( !nodeType ) { - // If no nodeType, this is expected to be an array - while ( (node = elem[i++]) ) { - // Do not traverse comment nodes - ret += getText( node ); - } - } else if ( nodeType === 1 || nodeType === 9 || nodeType === 11 ) { - // Use textContent for elements - // innerText usage removed for consistency of new lines (jQuery #11153) - if ( typeof elem.textContent === "string" ) { - return elem.textContent; - } else { - // Traverse its children - for ( elem = elem.firstChild; elem; elem = elem.nextSibling ) { - ret += getText( elem ); - } - } - } else if ( nodeType === 3 || nodeType === 4 ) { - return elem.nodeValue; - } - // Do not include comment or processing instruction nodes - - return ret; -}; - -Expr = Sizzle.selectors = { - - // Can be adjusted by the user - cacheLength: 50, - - createPseudo: markFunction, - - match: matchExpr, - - attrHandle: {}, - - find: {}, - - relative: { - ">": { dir: "parentNode", first: true }, - " ": { dir: "parentNode" }, - "+": { dir: "previousSibling", first: true }, - "~": { dir: "previousSibling" } - }, - - preFilter: { - "ATTR": function( match ) { - match[1] = match[1].replace( runescape, funescape ); - - // Move the given value to match[3] whether quoted or unquoted - match[3] = ( match[4] || match[5] || "" ).replace( runescape, funescape ); - - if ( match[2] === "~=" ) { - match[3] = " " + match[3] + " "; - } - - return match.slice( 0, 4 ); - }, - - "CHILD": function( match ) { - /* matches from matchExpr["CHILD"] - 1 type (only|nth|...) - 2 what (child|of-type) - 3 argument (even|odd|\d*|\d*n([+-]\d+)?|...) - 4 xn-component of xn+y argument ([+-]?\d*n|) - 5 sign of xn-component - 6 x of xn-component - 7 sign of y-component - 8 y of y-component - */ - match[1] = match[1].toLowerCase(); - - if ( match[1].slice( 0, 3 ) === "nth" ) { - // nth-* requires argument - if ( !match[3] ) { - Sizzle.error( match[0] ); - } - - // numeric x and y parameters for Expr.filter.CHILD - // remember that false/true cast respectively to 0/1 - match[4] = +( match[4] ? match[5] + (match[6] || 1) : 2 * ( match[3] === "even" || match[3] === "odd" ) ); - match[5] = +( ( match[7] + match[8] ) || match[3] === "odd" ); - - // other types prohibit arguments - } else if ( match[3] ) { - Sizzle.error( match[0] ); - } - - return match; - }, - - "PSEUDO": function( match ) { - var excess, - unquoted = !match[5] && match[2]; - - if ( matchExpr["CHILD"].test( match[0] ) ) { - return null; - } - - // Accept quoted arguments as-is - if ( match[3] && match[4] !== undefined ) { - match[2] = match[4]; - - // Strip excess characters from unquoted arguments - } else if ( unquoted && rpseudo.test( unquoted ) && - // Get excess from tokenize (recursively) - (excess = tokenize( unquoted, true )) && - // advance to the next closing parenthesis - (excess = unquoted.indexOf( ")", unquoted.length - excess ) - unquoted.length) ) { - - // excess is a negative index - match[0] = match[0].slice( 0, excess ); - match[2] = unquoted.slice( 0, excess ); - } - - // Return only captures needed by the pseudo filter method (type and argument) - return match.slice( 0, 3 ); - } - }, - - filter: { - - "TAG": function( nodeNameSelector ) { - var nodeName = nodeNameSelector.replace( runescape, funescape ).toLowerCase(); - return nodeNameSelector === "*" ? - function() { return true; } : - function( elem ) { - return elem.nodeName && elem.nodeName.toLowerCase() === nodeName; - }; - }, - - "CLASS": function( className ) { - var pattern = classCache[ className + " " ]; - - return pattern || - (pattern = new RegExp( "(^|" + whitespace + ")" + className + "(" + whitespace + "|$)" )) && - classCache( className, function( elem ) { - return pattern.test( typeof elem.className === "string" && elem.className || typeof elem.getAttribute !== strundefined && elem.getAttribute("class") || "" ); - }); - }, - - "ATTR": function( name, operator, check ) { - return function( elem ) { - var result = Sizzle.attr( elem, name ); - - if ( result == null ) { - return operator === "!="; - } - if ( !operator ) { - return true; - } - - result += ""; - - return operator === "=" ? result === check : - operator === "!=" ? result !== check : - operator === "^=" ? check && result.indexOf( check ) === 0 : - operator === "*=" ? check && result.indexOf( check ) > -1 : - operator === "$=" ? check && result.slice( -check.length ) === check : - operator === "~=" ? ( " " + result + " " ).indexOf( check ) > -1 : - operator === "|=" ? result === check || result.slice( 0, check.length + 1 ) === check + "-" : - false; - }; - }, - - "CHILD": function( type, what, argument, first, last ) { - var simple = type.slice( 0, 3 ) !== "nth", - forward = type.slice( -4 ) !== "last", - ofType = what === "of-type"; - - return first === 1 && last === 0 ? - - // Shortcut for :nth-*(n) - function( elem ) { - return !!elem.parentNode; - } : - - function( elem, context, xml ) { - var cache, outerCache, node, diff, nodeIndex, start, - dir = simple !== forward ? "nextSibling" : "previousSibling", - parent = elem.parentNode, - name = ofType && elem.nodeName.toLowerCase(), - useCache = !xml && !ofType; - - if ( parent ) { - - // :(first|last|only)-(child|of-type) - if ( simple ) { - while ( dir ) { - node = elem; - while ( (node = node[ dir ]) ) { - if ( ofType ? node.nodeName.toLowerCase() === name : node.nodeType === 1 ) { - return false; - } - } - // Reverse direction for :only-* (if we haven't yet done so) - start = dir = type === "only" && !start && "nextSibling"; - } - return true; - } - - start = [ forward ? parent.firstChild : parent.lastChild ]; - - // non-xml :nth-child(...) stores cache data on `parent` - if ( forward && useCache ) { - // Seek `elem` from a previously-cached index - outerCache = parent[ expando ] || (parent[ expando ] = {}); - cache = outerCache[ type ] || []; - nodeIndex = cache[0] === dirruns && cache[1]; - diff = cache[0] === dirruns && cache[2]; - node = nodeIndex && parent.childNodes[ nodeIndex ]; - - while ( (node = ++nodeIndex && node && node[ dir ] || - - // Fallback to seeking `elem` from the start - (diff = nodeIndex = 0) || start.pop()) ) { - - // When found, cache indexes on `parent` and break - if ( node.nodeType === 1 && ++diff && node === elem ) { - outerCache[ type ] = [ dirruns, nodeIndex, diff ]; - break; - } - } - - // Use previously-cached element index if available - } else if ( useCache && (cache = (elem[ expando ] || (elem[ expando ] = {}))[ type ]) && cache[0] === dirruns ) { - diff = cache[1]; - - // xml :nth-child(...) or :nth-last-child(...) or :nth(-last)?-of-type(...) - } else { - // Use the same loop as above to seek `elem` from the start - while ( (node = ++nodeIndex && node && node[ dir ] || - (diff = nodeIndex = 0) || start.pop()) ) { - - if ( ( ofType ? node.nodeName.toLowerCase() === name : node.nodeType === 1 ) && ++diff ) { - // Cache the index of each encountered element - if ( useCache ) { - (node[ expando ] || (node[ expando ] = {}))[ type ] = [ dirruns, diff ]; - } - - if ( node === elem ) { - break; - } - } - } - } - - // Incorporate the offset, then check against cycle size - diff -= last; - return diff === first || ( diff % first === 0 && diff / first >= 0 ); - } - }; - }, - - "PSEUDO": function( pseudo, argument ) { - // pseudo-class names are case-insensitive - // http://www.w3.org/TR/selectors/#pseudo-classes - // Prioritize by case sensitivity in case custom pseudos are added with uppercase letters - // Remember that setFilters inherits from pseudos - var args, - fn = Expr.pseudos[ pseudo ] || Expr.setFilters[ pseudo.toLowerCase() ] || - Sizzle.error( "unsupported pseudo: " + pseudo ); - - // The user may use createPseudo to indicate that - // arguments are needed to create the filter function - // just as Sizzle does - if ( fn[ expando ] ) { - return fn( argument ); - } - - // But maintain support for old signatures - if ( fn.length > 1 ) { - args = [ pseudo, pseudo, "", argument ]; - return Expr.setFilters.hasOwnProperty( pseudo.toLowerCase() ) ? - markFunction(function( seed, matches ) { - var idx, - matched = fn( seed, argument ), - i = matched.length; - while ( i-- ) { - idx = indexOf.call( seed, matched[i] ); - seed[ idx ] = !( matches[ idx ] = matched[i] ); - } - }) : - function( elem ) { - return fn( elem, 0, args ); - }; - } - - return fn; - } - }, - - pseudos: { - // Potentially complex pseudos - "not": markFunction(function( selector ) { - // Trim the selector passed to compile - // to avoid treating leading and trailing - // spaces as combinators - var input = [], - results = [], - matcher = compile( selector.replace( rtrim, "$1" ) ); - - return matcher[ expando ] ? - markFunction(function( seed, matches, context, xml ) { - var elem, - unmatched = matcher( seed, null, xml, [] ), - i = seed.length; - - // Match elements unmatched by `matcher` - while ( i-- ) { - if ( (elem = unmatched[i]) ) { - seed[i] = !(matches[i] = elem); - } - } - }) : - function( elem, context, xml ) { - input[0] = elem; - matcher( input, null, xml, results ); - return !results.pop(); - }; - }), - - "has": markFunction(function( selector ) { - return function( elem ) { - return Sizzle( selector, elem ).length > 0; - }; - }), - - "contains": markFunction(function( text ) { - return function( elem ) { - return ( elem.textContent || elem.innerText || getText( elem ) ).indexOf( text ) > -1; - }; - }), - - // "Whether an element is represented by a :lang() selector - // is based solely on the element's language value - // being equal to the identifier C, - // or beginning with the identifier C immediately followed by "-". - // The matching of C against the element's language value is performed case-insensitively. - // The identifier C does not have to be a valid language name." - // http://www.w3.org/TR/selectors/#lang-pseudo - "lang": markFunction( function( lang ) { - // lang value must be a valid identifier - if ( !ridentifier.test(lang || "") ) { - Sizzle.error( "unsupported lang: " + lang ); - } - lang = lang.replace( runescape, funescape ).toLowerCase(); - return function( elem ) { - var elemLang; - do { - if ( (elemLang = documentIsHTML ? - elem.lang : - elem.getAttribute("xml:lang") || elem.getAttribute("lang")) ) { - - elemLang = elemLang.toLowerCase(); - return elemLang === lang || elemLang.indexOf( lang + "-" ) === 0; - } - } while ( (elem = elem.parentNode) && elem.nodeType === 1 ); - return false; - }; - }), - - // Miscellaneous - "target": function( elem ) { - var hash = window.location && window.location.hash; - return hash && hash.slice( 1 ) === elem.id; - }, - - "root": function( elem ) { - return elem === docElem; - }, - - "focus": function( elem ) { - return elem === document.activeElement && (!document.hasFocus || document.hasFocus()) && !!(elem.type || elem.href || ~elem.tabIndex); - }, - - // Boolean properties - "enabled": function( elem ) { - return elem.disabled === false; - }, - - "disabled": function( elem ) { - return elem.disabled === true; - }, - - "checked": function( elem ) { - // In CSS3, :checked should return both checked and selected elements - // http://www.w3.org/TR/2011/REC-css3-selectors-20110929/#checked - var nodeName = elem.nodeName.toLowerCase(); - return (nodeName === "input" && !!elem.checked) || (nodeName === "option" && !!elem.selected); - }, - - "selected": function( elem ) { - // Accessing this property makes selected-by-default - // options in Safari work properly - if ( elem.parentNode ) { - elem.parentNode.selectedIndex; - } - - return elem.selected === true; - }, - - // Contents - "empty": function( elem ) { - // http://www.w3.org/TR/selectors/#empty-pseudo - // :empty is negated by element (1) or content nodes (text: 3; cdata: 4; entity ref: 5), - // but not by others (comment: 8; processing instruction: 7; etc.) - // nodeType < 6 works because attributes (2) do not appear as children - for ( elem = elem.firstChild; elem; elem = elem.nextSibling ) { - if ( elem.nodeType < 6 ) { - return false; - } - } - return true; - }, - - "parent": function( elem ) { - return !Expr.pseudos["empty"]( elem ); - }, - - // Element/input types - "header": function( elem ) { - return rheader.test( elem.nodeName ); - }, - - "input": function( elem ) { - return rinputs.test( elem.nodeName ); - }, - - "button": function( elem ) { - var name = elem.nodeName.toLowerCase(); - return name === "input" && elem.type === "button" || name === "button"; - }, - - "text": function( elem ) { - var attr; - return elem.nodeName.toLowerCase() === "input" && - elem.type === "text" && - - // Support: IE<8 - // New HTML5 attribute values (e.g., "search") appear with elem.type === "text" - ( (attr = elem.getAttribute("type")) == null || attr.toLowerCase() === "text" ); - }, - - // Position-in-collection - "first": createPositionalPseudo(function() { - return [ 0 ]; - }), - - "last": createPositionalPseudo(function( matchIndexes, length ) { - return [ length - 1 ]; - }), - - "eq": createPositionalPseudo(function( matchIndexes, length, argument ) { - return [ argument < 0 ? argument + length : argument ]; - }), - - "even": createPositionalPseudo(function( matchIndexes, length ) { - var i = 0; - for ( ; i < length; i += 2 ) { - matchIndexes.push( i ); - } - return matchIndexes; - }), - - "odd": createPositionalPseudo(function( matchIndexes, length ) { - var i = 1; - for ( ; i < length; i += 2 ) { - matchIndexes.push( i ); - } - return matchIndexes; - }), - - "lt": createPositionalPseudo(function( matchIndexes, length, argument ) { - var i = argument < 0 ? argument + length : argument; - for ( ; --i >= 0; ) { - matchIndexes.push( i ); - } - return matchIndexes; - }), - - "gt": createPositionalPseudo(function( matchIndexes, length, argument ) { - var i = argument < 0 ? argument + length : argument; - for ( ; ++i < length; ) { - matchIndexes.push( i ); - } - return matchIndexes; - }) - } -}; - -Expr.pseudos["nth"] = Expr.pseudos["eq"]; - -// Add button/input type pseudos -for ( i in { radio: true, checkbox: true, file: true, password: true, image: true } ) { - Expr.pseudos[ i ] = createInputPseudo( i ); -} -for ( i in { submit: true, reset: true } ) { - Expr.pseudos[ i ] = createButtonPseudo( i ); -} - -// Easy API for creating new setFilters -function setFilters() {} -setFilters.prototype = Expr.filters = Expr.pseudos; -Expr.setFilters = new setFilters(); - -function tokenize( selector, parseOnly ) { - var matched, match, tokens, type, - soFar, groups, preFilters, - cached = tokenCache[ selector + " " ]; - - if ( cached ) { - return parseOnly ? 0 : cached.slice( 0 ); - } - - soFar = selector; - groups = []; - preFilters = Expr.preFilter; - - while ( soFar ) { - - // Comma and first run - if ( !matched || (match = rcomma.exec( soFar )) ) { - if ( match ) { - // Don't consume trailing commas as valid - soFar = soFar.slice( match[0].length ) || soFar; - } - groups.push( (tokens = []) ); - } - - matched = false; - - // Combinators - if ( (match = rcombinators.exec( soFar )) ) { - matched = match.shift(); - tokens.push({ - value: matched, - // Cast descendant combinators to space - type: match[0].replace( rtrim, " " ) - }); - soFar = soFar.slice( matched.length ); - } - - // Filters - for ( type in Expr.filter ) { - if ( (match = matchExpr[ type ].exec( soFar )) && (!preFilters[ type ] || - (match = preFilters[ type ]( match ))) ) { - matched = match.shift(); - tokens.push({ - value: matched, - type: type, - matches: match - }); - soFar = soFar.slice( matched.length ); - } - } - - if ( !matched ) { - break; - } - } - - // Return the length of the invalid excess - // if we're just parsing - // Otherwise, throw an error or return tokens - return parseOnly ? - soFar.length : - soFar ? - Sizzle.error( selector ) : - // Cache the tokens - tokenCache( selector, groups ).slice( 0 ); -} - -function toSelector( tokens ) { - var i = 0, - len = tokens.length, - selector = ""; - for ( ; i < len; i++ ) { - selector += tokens[i].value; - } - return selector; -} - -function addCombinator( matcher, combinator, base ) { - var dir = combinator.dir, - checkNonElements = base && dir === "parentNode", - doneName = done++; - - return combinator.first ? - // Check against closest ancestor/preceding element - function( elem, context, xml ) { - while ( (elem = elem[ dir ]) ) { - if ( elem.nodeType === 1 || checkNonElements ) { - return matcher( elem, context, xml ); - } - } - } : - - // Check against all ancestor/preceding elements - function( elem, context, xml ) { - var oldCache, outerCache, - newCache = [ dirruns, doneName ]; - - // We can't set arbitrary data on XML nodes, so they don't benefit from dir caching - if ( xml ) { - while ( (elem = elem[ dir ]) ) { - if ( elem.nodeType === 1 || checkNonElements ) { - if ( matcher( elem, context, xml ) ) { - return true; - } - } - } - } else { - while ( (elem = elem[ dir ]) ) { - if ( elem.nodeType === 1 || checkNonElements ) { - outerCache = elem[ expando ] || (elem[ expando ] = {}); - if ( (oldCache = outerCache[ dir ]) && - oldCache[ 0 ] === dirruns && oldCache[ 1 ] === doneName ) { - - // Assign to newCache so results back-propagate to previous elements - return (newCache[ 2 ] = oldCache[ 2 ]); - } else { - // Reuse newcache so results back-propagate to previous elements - outerCache[ dir ] = newCache; - - // A match means we're done; a fail means we have to keep checking - if ( (newCache[ 2 ] = matcher( elem, context, xml )) ) { - return true; - } - } - } - } - } - }; -} - -function elementMatcher( matchers ) { - return matchers.length > 1 ? - function( elem, context, xml ) { - var i = matchers.length; - while ( i-- ) { - if ( !matchers[i]( elem, context, xml ) ) { - return false; - } - } - return true; - } : - matchers[0]; -} - -function condense( unmatched, map, filter, context, xml ) { - var elem, - newUnmatched = [], - i = 0, - len = unmatched.length, - mapped = map != null; - - for ( ; i < len; i++ ) { - if ( (elem = unmatched[i]) ) { - if ( !filter || filter( elem, context, xml ) ) { - newUnmatched.push( elem ); - if ( mapped ) { - map.push( i ); - } - } - } - } - - return newUnmatched; -} - -function setMatcher( preFilter, selector, matcher, postFilter, postFinder, postSelector ) { - if ( postFilter && !postFilter[ expando ] ) { - postFilter = setMatcher( postFilter ); - } - if ( postFinder && !postFinder[ expando ] ) { - postFinder = setMatcher( postFinder, postSelector ); - } - return markFunction(function( seed, results, context, xml ) { - var temp, i, elem, - preMap = [], - postMap = [], - preexisting = results.length, - - // Get initial elements from seed or context - elems = seed || multipleContexts( selector || "*", context.nodeType ? [ context ] : context, [] ), - - // Prefilter to get matcher input, preserving a map for seed-results synchronization - matcherIn = preFilter && ( seed || !selector ) ? - condense( elems, preMap, preFilter, context, xml ) : - elems, - - matcherOut = matcher ? - // If we have a postFinder, or filtered seed, or non-seed postFilter or preexisting results, - postFinder || ( seed ? preFilter : preexisting || postFilter ) ? - - // ...intermediate processing is necessary - [] : - - // ...otherwise use results directly - results : - matcherIn; - - // Find primary matches - if ( matcher ) { - matcher( matcherIn, matcherOut, context, xml ); - } - - // Apply postFilter - if ( postFilter ) { - temp = condense( matcherOut, postMap ); - postFilter( temp, [], context, xml ); - - // Un-match failing elements by moving them back to matcherIn - i = temp.length; - while ( i-- ) { - if ( (elem = temp[i]) ) { - matcherOut[ postMap[i] ] = !(matcherIn[ postMap[i] ] = elem); - } - } - } - - if ( seed ) { - if ( postFinder || preFilter ) { - if ( postFinder ) { - // Get the final matcherOut by condensing this intermediate into postFinder contexts - temp = []; - i = matcherOut.length; - while ( i-- ) { - if ( (elem = matcherOut[i]) ) { - // Restore matcherIn since elem is not yet a final match - temp.push( (matcherIn[i] = elem) ); - } - } - postFinder( null, (matcherOut = []), temp, xml ); - } - - // Move matched elements from seed to results to keep them synchronized - i = matcherOut.length; - while ( i-- ) { - if ( (elem = matcherOut[i]) && - (temp = postFinder ? indexOf.call( seed, elem ) : preMap[i]) > -1 ) { - - seed[temp] = !(results[temp] = elem); - } - } - } - - // Add elements to results, through postFinder if defined - } else { - matcherOut = condense( - matcherOut === results ? - matcherOut.splice( preexisting, matcherOut.length ) : - matcherOut - ); - if ( postFinder ) { - postFinder( null, results, matcherOut, xml ); - } else { - push.apply( results, matcherOut ); - } - } - }); -} - -function matcherFromTokens( tokens ) { - var checkContext, matcher, j, - len = tokens.length, - leadingRelative = Expr.relative[ tokens[0].type ], - implicitRelative = leadingRelative || Expr.relative[" "], - i = leadingRelative ? 1 : 0, - - // The foundational matcher ensures that elements are reachable from top-level context(s) - matchContext = addCombinator( function( elem ) { - return elem === checkContext; - }, implicitRelative, true ), - matchAnyContext = addCombinator( function( elem ) { - return indexOf.call( checkContext, elem ) > -1; - }, implicitRelative, true ), - matchers = [ function( elem, context, xml ) { - return ( !leadingRelative && ( xml || context !== outermostContext ) ) || ( - (checkContext = context).nodeType ? - matchContext( elem, context, xml ) : - matchAnyContext( elem, context, xml ) ); - } ]; - - for ( ; i < len; i++ ) { - if ( (matcher = Expr.relative[ tokens[i].type ]) ) { - matchers = [ addCombinator(elementMatcher( matchers ), matcher) ]; - } else { - matcher = Expr.filter[ tokens[i].type ].apply( null, tokens[i].matches ); - - // Return special upon seeing a positional matcher - if ( matcher[ expando ] ) { - // Find the next relative operator (if any) for proper handling - j = ++i; - for ( ; j < len; j++ ) { - if ( Expr.relative[ tokens[j].type ] ) { - break; - } - } - return setMatcher( - i > 1 && elementMatcher( matchers ), - i > 1 && toSelector( - // If the preceding token was a descendant combinator, insert an implicit any-element `*` - tokens.slice( 0, i - 1 ).concat({ value: tokens[ i - 2 ].type === " " ? "*" : "" }) - ).replace( rtrim, "$1" ), - matcher, - i < j && matcherFromTokens( tokens.slice( i, j ) ), - j < len && matcherFromTokens( (tokens = tokens.slice( j )) ), - j < len && toSelector( tokens ) - ); - } - matchers.push( matcher ); - } - } - - return elementMatcher( matchers ); -} - -function matcherFromGroupMatchers( elementMatchers, setMatchers ) { - var bySet = setMatchers.length > 0, - byElement = elementMatchers.length > 0, - superMatcher = function( seed, context, xml, results, outermost ) { - var elem, j, matcher, - matchedCount = 0, - i = "0", - unmatched = seed && [], - setMatched = [], - contextBackup = outermostContext, - // We must always have either seed elements or outermost context - elems = seed || byElement && Expr.find["TAG"]( "*", outermost ), - // Use integer dirruns iff this is the outermost matcher - dirrunsUnique = (dirruns += contextBackup == null ? 1 : Math.random() || 0.1), - len = elems.length; - - if ( outermost ) { - outermostContext = context !== document && context; - } - - // Add elements passing elementMatchers directly to results - // Keep `i` a string if there are no elements so `matchedCount` will be "00" below - // Support: IE<9, Safari - // Tolerate NodeList properties (IE: "length"; Safari: ) matching elements by id - for ( ; i !== len && (elem = elems[i]) != null; i++ ) { - if ( byElement && elem ) { - j = 0; - while ( (matcher = elementMatchers[j++]) ) { - if ( matcher( elem, context, xml ) ) { - results.push( elem ); - break; - } - } - if ( outermost ) { - dirruns = dirrunsUnique; - } - } - - // Track unmatched elements for set filters - if ( bySet ) { - // They will have gone through all possible matchers - if ( (elem = !matcher && elem) ) { - matchedCount--; - } - - // Lengthen the array for every element, matched or not - if ( seed ) { - unmatched.push( elem ); - } - } - } - - // Apply set filters to unmatched elements - matchedCount += i; - if ( bySet && i !== matchedCount ) { - j = 0; - while ( (matcher = setMatchers[j++]) ) { - matcher( unmatched, setMatched, context, xml ); - } - - if ( seed ) { - // Reintegrate element matches to eliminate the need for sorting - if ( matchedCount > 0 ) { - while ( i-- ) { - if ( !(unmatched[i] || setMatched[i]) ) { - setMatched[i] = pop.call( results ); - } - } - } - - // Discard index placeholder values to get only actual matches - setMatched = condense( setMatched ); - } - - // Add matches to results - push.apply( results, setMatched ); - - // Seedless set matches succeeding multiple successful matchers stipulate sorting - if ( outermost && !seed && setMatched.length > 0 && - ( matchedCount + setMatchers.length ) > 1 ) { - - Sizzle.uniqueSort( results ); - } - } - - // Override manipulation of globals by nested matchers - if ( outermost ) { - dirruns = dirrunsUnique; - outermostContext = contextBackup; - } - - return unmatched; - }; - - return bySet ? - markFunction( superMatcher ) : - superMatcher; -} - -compile = Sizzle.compile = function( selector, group /* Internal Use Only */ ) { - var i, - setMatchers = [], - elementMatchers = [], - cached = compilerCache[ selector + " " ]; - - if ( !cached ) { - // Generate a function of recursive functions that can be used to check each element - if ( !group ) { - group = tokenize( selector ); - } - i = group.length; - while ( i-- ) { - cached = matcherFromTokens( group[i] ); - if ( cached[ expando ] ) { - setMatchers.push( cached ); - } else { - elementMatchers.push( cached ); - } - } - - // Cache the compiled function - cached = compilerCache( selector, matcherFromGroupMatchers( elementMatchers, setMatchers ) ); - } - return cached; -}; - -function multipleContexts( selector, contexts, results ) { - var i = 0, - len = contexts.length; - for ( ; i < len; i++ ) { - Sizzle( selector, contexts[i], results ); - } - return results; -} - -function select( selector, context, results, seed ) { - var i, tokens, token, type, find, - match = tokenize( selector ); - - if ( !seed ) { - // Try to minimize operations if there is only one group - if ( match.length === 1 ) { - - // Take a shortcut and set the context if the root selector is an ID - tokens = match[0] = match[0].slice( 0 ); - if ( tokens.length > 2 && (token = tokens[0]).type === "ID" && - support.getById && context.nodeType === 9 && documentIsHTML && - Expr.relative[ tokens[1].type ] ) { - - context = ( Expr.find["ID"]( token.matches[0].replace(runescape, funescape), context ) || [] )[0]; - if ( !context ) { - return results; - } - selector = selector.slice( tokens.shift().value.length ); - } - - // Fetch a seed set for right-to-left matching - i = matchExpr["needsContext"].test( selector ) ? 0 : tokens.length; - while ( i-- ) { - token = tokens[i]; - - // Abort if we hit a combinator - if ( Expr.relative[ (type = token.type) ] ) { - break; - } - if ( (find = Expr.find[ type ]) ) { - // Search, expanding context for leading sibling combinators - if ( (seed = find( - token.matches[0].replace( runescape, funescape ), - rsibling.test( tokens[0].type ) && testContext( context.parentNode ) || context - )) ) { - - // If seed is empty or no tokens remain, we can return early - tokens.splice( i, 1 ); - selector = seed.length && toSelector( tokens ); - if ( !selector ) { - push.apply( results, seed ); - return results; - } - - break; - } - } - } - } - } - - // Compile and execute a filtering function - // Provide `match` to avoid retokenization if we modified the selector above - compile( selector, match )( - seed, - context, - !documentIsHTML, - results, - rsibling.test( selector ) && testContext( context.parentNode ) || context - ); - return results; -} - -// One-time assignments - -// Sort stability -support.sortStable = expando.split("").sort( sortOrder ).join("") === expando; - -// Support: Chrome<14 -// Always assume duplicates if they aren't passed to the comparison function -support.detectDuplicates = !!hasDuplicate; - -// Initialize against the default document -setDocument(); - -// Support: Webkit<537.32 - Safari 6.0.3/Chrome 25 (fixed in Chrome 27) -// Detached nodes confoundingly follow *each other* -support.sortDetached = assert(function( div1 ) { - // Should return 1, but returns 4 (following) - return div1.compareDocumentPosition( document.createElement("div") ) & 1; -}); - -// Support: IE<8 -// Prevent attribute/property "interpolation" -// http://msdn.microsoft.com/en-us/library/ms536429%28VS.85%29.aspx -if ( !assert(function( div ) { - div.innerHTML = ""; - return div.firstChild.getAttribute("href") === "#" ; -}) ) { - addHandle( "type|href|height|width", function( elem, name, isXML ) { - if ( !isXML ) { - return elem.getAttribute( name, name.toLowerCase() === "type" ? 1 : 2 ); - } - }); -} - -// Support: IE<9 -// Use defaultValue in place of getAttribute("value") -if ( !support.attributes || !assert(function( div ) { - div.innerHTML = ""; - div.firstChild.setAttribute( "value", "" ); - return div.firstChild.getAttribute( "value" ) === ""; -}) ) { - addHandle( "value", function( elem, name, isXML ) { - if ( !isXML && elem.nodeName.toLowerCase() === "input" ) { - return elem.defaultValue; - } - }); -} - -// Support: IE<9 -// Use getAttributeNode to fetch booleans when getAttribute lies -if ( !assert(function( div ) { - return div.getAttribute("disabled") == null; -}) ) { - addHandle( booleans, function( elem, name, isXML ) { - var val; - if ( !isXML ) { - return elem[ name ] === true ? name.toLowerCase() : - (val = elem.getAttributeNode( name )) && val.specified ? - val.value : - null; - } - }); -} - -return Sizzle; - -})( window ); - - - -jQuery.find = Sizzle; -jQuery.expr = Sizzle.selectors; -jQuery.expr[":"] = jQuery.expr.pseudos; -jQuery.unique = Sizzle.uniqueSort; -jQuery.text = Sizzle.getText; -jQuery.isXMLDoc = Sizzle.isXML; -jQuery.contains = Sizzle.contains; - - - -var rneedsContext = jQuery.expr.match.needsContext; - -var rsingleTag = (/^<(\w+)\s*\/?>(?:<\/\1>|)$/); - - - -var risSimple = /^.[^:#\[\.,]*$/; - -// Implement the identical functionality for filter and not -function winnow( elements, qualifier, not ) { - if ( jQuery.isFunction( qualifier ) ) { - return jQuery.grep( elements, function( elem, i ) { - /* jshint -W018 */ - return !!qualifier.call( elem, i, elem ) !== not; - }); - - } - - if ( qualifier.nodeType ) { - return jQuery.grep( elements, function( elem ) { - return ( elem === qualifier ) !== not; - }); - - } - - if ( typeof qualifier === "string" ) { - if ( risSimple.test( qualifier ) ) { - return jQuery.filter( qualifier, elements, not ); - } - - qualifier = jQuery.filter( qualifier, elements ); - } - - return jQuery.grep( elements, function( elem ) { - return ( jQuery.inArray( elem, qualifier ) >= 0 ) !== not; - }); -} - -jQuery.filter = function( expr, elems, not ) { - var elem = elems[ 0 ]; - - if ( not ) { - expr = ":not(" + expr + ")"; - } - - return elems.length === 1 && elem.nodeType === 1 ? - jQuery.find.matchesSelector( elem, expr ) ? [ elem ] : [] : - jQuery.find.matches( expr, jQuery.grep( elems, function( elem ) { - return elem.nodeType === 1; - })); -}; - -jQuery.fn.extend({ - find: function( selector ) { - var i, - ret = [], - self = this, - len = self.length; - - if ( typeof selector !== "string" ) { - return this.pushStack( jQuery( selector ).filter(function() { - for ( i = 0; i < len; i++ ) { - if ( jQuery.contains( self[ i ], this ) ) { - return true; - } - } - }) ); - } - - for ( i = 0; i < len; i++ ) { - jQuery.find( selector, self[ i ], ret ); - } - - // Needed because $( selector, context ) becomes $( context ).find( selector ) - ret = this.pushStack( len > 1 ? jQuery.unique( ret ) : ret ); - ret.selector = this.selector ? this.selector + " " + selector : selector; - return ret; - }, - filter: function( selector ) { - return this.pushStack( winnow(this, selector || [], false) ); - }, - not: function( selector ) { - return this.pushStack( winnow(this, selector || [], true) ); - }, - is: function( selector ) { - return !!winnow( - this, - - // If this is a positional/relative selector, check membership in the returned set - // so $("p:first").is("p:last") won't return true for a doc with two "p". - typeof selector === "string" && rneedsContext.test( selector ) ? - jQuery( selector ) : - selector || [], - false - ).length; - } -}); - - -// Initialize a jQuery object - - -// A central reference to the root jQuery(document) -var rootjQuery, - - // Use the correct document accordingly with window argument (sandbox) - document = window.document, - - // A simple way to check for HTML strings - // Prioritize #id over to avoid XSS via location.hash (#9521) - // Strict HTML recognition (#11290: must start with <) - rquickExpr = /^(?:\s*(<[\w\W]+>)[^>]*|#([\w-]*))$/, - - init = jQuery.fn.init = function( selector, context ) { - var match, elem; - - // HANDLE: $(""), $(null), $(undefined), $(false) - if ( !selector ) { - return this; - } - - // Handle HTML strings - if ( typeof selector === "string" ) { - if ( selector.charAt(0) === "<" && selector.charAt( selector.length - 1 ) === ">" && selector.length >= 3 ) { - // Assume that strings that start and end with <> are HTML and skip the regex check - match = [ null, selector, null ]; - - } else { - match = rquickExpr.exec( selector ); - } - - // Match html or make sure no context is specified for #id - if ( match && (match[1] || !context) ) { - - // HANDLE: $(html) -> $(array) - if ( match[1] ) { - context = context instanceof jQuery ? context[0] : context; - - // scripts is true for back-compat - // Intentionally let the error be thrown if parseHTML is not present - jQuery.merge( this, jQuery.parseHTML( - match[1], - context && context.nodeType ? context.ownerDocument || context : document, - true - ) ); - - // HANDLE: $(html, props) - if ( rsingleTag.test( match[1] ) && jQuery.isPlainObject( context ) ) { - for ( match in context ) { - // Properties of context are called as methods if possible - if ( jQuery.isFunction( this[ match ] ) ) { - this[ match ]( context[ match ] ); - - // ...and otherwise set as attributes - } else { - this.attr( match, context[ match ] ); - } - } - } - - return this; - - // HANDLE: $(#id) - } else { - elem = document.getElementById( match[2] ); - - // Check parentNode to catch when Blackberry 4.6 returns - // nodes that are no longer in the document #6963 - if ( elem && elem.parentNode ) { - // Handle the case where IE and Opera return items - // by name instead of ID - if ( elem.id !== match[2] ) { - return rootjQuery.find( selector ); - } - - // Otherwise, we inject the element directly into the jQuery object - this.length = 1; - this[0] = elem; - } - - this.context = document; - this.selector = selector; - return this; - } - - // HANDLE: $(expr, $(...)) - } else if ( !context || context.jquery ) { - return ( context || rootjQuery ).find( selector ); - - // HANDLE: $(expr, context) - // (which is just equivalent to: $(context).find(expr) - } else { - return this.constructor( context ).find( selector ); - } - - // HANDLE: $(DOMElement) - } else if ( selector.nodeType ) { - this.context = this[0] = selector; - this.length = 1; - return this; - - // HANDLE: $(function) - // Shortcut for document ready - } else if ( jQuery.isFunction( selector ) ) { - return typeof rootjQuery.ready !== "undefined" ? - rootjQuery.ready( selector ) : - // Execute immediately if ready is not present - selector( jQuery ); - } - - if ( selector.selector !== undefined ) { - this.selector = selector.selector; - this.context = selector.context; - } - - return jQuery.makeArray( selector, this ); - }; - -// Give the init function the jQuery prototype for later instantiation -init.prototype = jQuery.fn; - -// Initialize central reference -rootjQuery = jQuery( document ); - - -var rparentsprev = /^(?:parents|prev(?:Until|All))/, - // methods guaranteed to produce a unique set when starting from a unique set - guaranteedUnique = { - children: true, - contents: true, - next: true, - prev: true - }; - -jQuery.extend({ - dir: function( elem, dir, until ) { - var matched = [], - cur = elem[ dir ]; - - while ( cur && cur.nodeType !== 9 && (until === undefined || cur.nodeType !== 1 || !jQuery( cur ).is( until )) ) { - if ( cur.nodeType === 1 ) { - matched.push( cur ); - } - cur = cur[dir]; - } - return matched; - }, - - sibling: function( n, elem ) { - var r = []; - - for ( ; n; n = n.nextSibling ) { - if ( n.nodeType === 1 && n !== elem ) { - r.push( n ); - } - } - - return r; - } -}); - -jQuery.fn.extend({ - has: function( target ) { - var i, - targets = jQuery( target, this ), - len = targets.length; - - return this.filter(function() { - for ( i = 0; i < len; i++ ) { - if ( jQuery.contains( this, targets[i] ) ) { - return true; - } - } - }); - }, - - closest: function( selectors, context ) { - var cur, - i = 0, - l = this.length, - matched = [], - pos = rneedsContext.test( selectors ) || typeof selectors !== "string" ? - jQuery( selectors, context || this.context ) : - 0; - - for ( ; i < l; i++ ) { - for ( cur = this[i]; cur && cur !== context; cur = cur.parentNode ) { - // Always skip document fragments - if ( cur.nodeType < 11 && (pos ? - pos.index(cur) > -1 : - - // Don't pass non-elements to Sizzle - cur.nodeType === 1 && - jQuery.find.matchesSelector(cur, selectors)) ) { - - matched.push( cur ); - break; - } - } - } - - return this.pushStack( matched.length > 1 ? jQuery.unique( matched ) : matched ); - }, - - // Determine the position of an element within - // the matched set of elements - index: function( elem ) { - - // No argument, return index in parent - if ( !elem ) { - return ( this[0] && this[0].parentNode ) ? this.first().prevAll().length : -1; - } - - // index in selector - if ( typeof elem === "string" ) { - return jQuery.inArray( this[0], jQuery( elem ) ); - } - - // Locate the position of the desired element - return jQuery.inArray( - // If it receives a jQuery object, the first element is used - elem.jquery ? elem[0] : elem, this ); - }, - - add: function( selector, context ) { - return this.pushStack( - jQuery.unique( - jQuery.merge( this.get(), jQuery( selector, context ) ) - ) - ); - }, - - addBack: function( selector ) { - return this.add( selector == null ? - this.prevObject : this.prevObject.filter(selector) - ); - } -}); - -function sibling( cur, dir ) { - do { - cur = cur[ dir ]; - } while ( cur && cur.nodeType !== 1 ); - - return cur; -} - -jQuery.each({ - parent: function( elem ) { - var parent = elem.parentNode; - return parent && parent.nodeType !== 11 ? parent : null; - }, - parents: function( elem ) { - return jQuery.dir( elem, "parentNode" ); - }, - parentsUntil: function( elem, i, until ) { - return jQuery.dir( elem, "parentNode", until ); - }, - next: function( elem ) { - return sibling( elem, "nextSibling" ); - }, - prev: function( elem ) { - return sibling( elem, "previousSibling" ); - }, - nextAll: function( elem ) { - return jQuery.dir( elem, "nextSibling" ); - }, - prevAll: function( elem ) { - return jQuery.dir( elem, "previousSibling" ); - }, - nextUntil: function( elem, i, until ) { - return jQuery.dir( elem, "nextSibling", until ); - }, - prevUntil: function( elem, i, until ) { - return jQuery.dir( elem, "previousSibling", until ); - }, - siblings: function( elem ) { - return jQuery.sibling( ( elem.parentNode || {} ).firstChild, elem ); - }, - children: function( elem ) { - return jQuery.sibling( elem.firstChild ); - }, - contents: function( elem ) { - return jQuery.nodeName( elem, "iframe" ) ? - elem.contentDocument || elem.contentWindow.document : - jQuery.merge( [], elem.childNodes ); - } -}, function( name, fn ) { - jQuery.fn[ name ] = function( until, selector ) { - var ret = jQuery.map( this, fn, until ); - - if ( name.slice( -5 ) !== "Until" ) { - selector = until; - } - - if ( selector && typeof selector === "string" ) { - ret = jQuery.filter( selector, ret ); - } - - if ( this.length > 1 ) { - // Remove duplicates - if ( !guaranteedUnique[ name ] ) { - ret = jQuery.unique( ret ); - } - - // Reverse order for parents* and prev-derivatives - if ( rparentsprev.test( name ) ) { - ret = ret.reverse(); - } - } - - return this.pushStack( ret ); - }; -}); -var rnotwhite = (/\S+/g); - - - -// String to Object options format cache -var optionsCache = {}; - -// Convert String-formatted options into Object-formatted ones and store in cache -function createOptions( options ) { - var object = optionsCache[ options ] = {}; - jQuery.each( options.match( rnotwhite ) || [], function( _, flag ) { - object[ flag ] = true; - }); - return object; -} - -/* - * Create a callback list using the following parameters: - * - * options: an optional list of space-separated options that will change how - * the callback list behaves or a more traditional option object - * - * By default a callback list will act like an event callback list and can be - * "fired" multiple times. - * - * Possible options: - * - * once: will ensure the callback list can only be fired once (like a Deferred) - * - * memory: will keep track of previous values and will call any callback added - * after the list has been fired right away with the latest "memorized" - * values (like a Deferred) - * - * unique: will ensure a callback can only be added once (no duplicate in the list) - * - * stopOnFalse: interrupt callings when a callback returns false - * - */ -jQuery.Callbacks = function( options ) { - - // Convert options from String-formatted to Object-formatted if needed - // (we check in cache first) - options = typeof options === "string" ? - ( optionsCache[ options ] || createOptions( options ) ) : - jQuery.extend( {}, options ); - - var // Flag to know if list is currently firing - firing, - // Last fire value (for non-forgettable lists) - memory, - // Flag to know if list was already fired - fired, - // End of the loop when firing - firingLength, - // Index of currently firing callback (modified by remove if needed) - firingIndex, - // First callback to fire (used internally by add and fireWith) - firingStart, - // Actual callback list - list = [], - // Stack of fire calls for repeatable lists - stack = !options.once && [], - // Fire callbacks - fire = function( data ) { - memory = options.memory && data; - fired = true; - firingIndex = firingStart || 0; - firingStart = 0; - firingLength = list.length; - firing = true; - for ( ; list && firingIndex < firingLength; firingIndex++ ) { - if ( list[ firingIndex ].apply( data[ 0 ], data[ 1 ] ) === false && options.stopOnFalse ) { - memory = false; // To prevent further calls using add - break; - } - } - firing = false; - if ( list ) { - if ( stack ) { - if ( stack.length ) { - fire( stack.shift() ); - } - } else if ( memory ) { - list = []; - } else { - self.disable(); - } - } - }, - // Actual Callbacks object - self = { - // Add a callback or a collection of callbacks to the list - add: function() { - if ( list ) { - // First, we save the current length - var start = list.length; - (function add( args ) { - jQuery.each( args, function( _, arg ) { - var type = jQuery.type( arg ); - if ( type === "function" ) { - if ( !options.unique || !self.has( arg ) ) { - list.push( arg ); - } - } else if ( arg && arg.length && type !== "string" ) { - // Inspect recursively - add( arg ); - } - }); - })( arguments ); - // Do we need to add the callbacks to the - // current firing batch? - if ( firing ) { - firingLength = list.length; - // With memory, if we're not firing then - // we should call right away - } else if ( memory ) { - firingStart = start; - fire( memory ); - } - } - return this; - }, - // Remove a callback from the list - remove: function() { - if ( list ) { - jQuery.each( arguments, function( _, arg ) { - var index; - while ( ( index = jQuery.inArray( arg, list, index ) ) > -1 ) { - list.splice( index, 1 ); - // Handle firing indexes - if ( firing ) { - if ( index <= firingLength ) { - firingLength--; - } - if ( index <= firingIndex ) { - firingIndex--; - } - } - } - }); - } - return this; - }, - // Check if a given callback is in the list. - // If no argument is given, return whether or not list has callbacks attached. - has: function( fn ) { - return fn ? jQuery.inArray( fn, list ) > -1 : !!( list && list.length ); - }, - // Remove all callbacks from the list - empty: function() { - list = []; - firingLength = 0; - return this; - }, - // Have the list do nothing anymore - disable: function() { - list = stack = memory = undefined; - return this; - }, - // Is it disabled? - disabled: function() { - return !list; - }, - // Lock the list in its current state - lock: function() { - stack = undefined; - if ( !memory ) { - self.disable(); - } - return this; - }, - // Is it locked? - locked: function() { - return !stack; - }, - // Call all callbacks with the given context and arguments - fireWith: function( context, args ) { - if ( list && ( !fired || stack ) ) { - args = args || []; - args = [ context, args.slice ? args.slice() : args ]; - if ( firing ) { - stack.push( args ); - } else { - fire( args ); - } - } - return this; - }, - // Call all the callbacks with the given arguments - fire: function() { - self.fireWith( this, arguments ); - return this; - }, - // To know if the callbacks have already been called at least once - fired: function() { - return !!fired; - } - }; - - return self; -}; - - -jQuery.extend({ - - Deferred: function( func ) { - var tuples = [ - // action, add listener, listener list, final state - [ "resolve", "done", jQuery.Callbacks("once memory"), "resolved" ], - [ "reject", "fail", jQuery.Callbacks("once memory"), "rejected" ], - [ "notify", "progress", jQuery.Callbacks("memory") ] - ], - state = "pending", - promise = { - state: function() { - return state; - }, - always: function() { - deferred.done( arguments ).fail( arguments ); - return this; - }, - then: function( /* fnDone, fnFail, fnProgress */ ) { - var fns = arguments; - return jQuery.Deferred(function( newDefer ) { - jQuery.each( tuples, function( i, tuple ) { - var fn = jQuery.isFunction( fns[ i ] ) && fns[ i ]; - // deferred[ done | fail | progress ] for forwarding actions to newDefer - deferred[ tuple[1] ](function() { - var returned = fn && fn.apply( this, arguments ); - if ( returned && jQuery.isFunction( returned.promise ) ) { - returned.promise() - .done( newDefer.resolve ) - .fail( newDefer.reject ) - .progress( newDefer.notify ); - } else { - newDefer[ tuple[ 0 ] + "With" ]( this === promise ? newDefer.promise() : this, fn ? [ returned ] : arguments ); - } - }); - }); - fns = null; - }).promise(); - }, - // Get a promise for this deferred - // If obj is provided, the promise aspect is added to the object - promise: function( obj ) { - return obj != null ? jQuery.extend( obj, promise ) : promise; - } - }, - deferred = {}; - - // Keep pipe for back-compat - promise.pipe = promise.then; - - // Add list-specific methods - jQuery.each( tuples, function( i, tuple ) { - var list = tuple[ 2 ], - stateString = tuple[ 3 ]; - - // promise[ done | fail | progress ] = list.add - promise[ tuple[1] ] = list.add; - - // Handle state - if ( stateString ) { - list.add(function() { - // state = [ resolved | rejected ] - state = stateString; - - // [ reject_list | resolve_list ].disable; progress_list.lock - }, tuples[ i ^ 1 ][ 2 ].disable, tuples[ 2 ][ 2 ].lock ); - } - - // deferred[ resolve | reject | notify ] - deferred[ tuple[0] ] = function() { - deferred[ tuple[0] + "With" ]( this === deferred ? promise : this, arguments ); - return this; - }; - deferred[ tuple[0] + "With" ] = list.fireWith; - }); - - // Make the deferred a promise - promise.promise( deferred ); - - // Call given func if any - if ( func ) { - func.call( deferred, deferred ); - } - - // All done! - return deferred; - }, - - // Deferred helper - when: function( subordinate /* , ..., subordinateN */ ) { - var i = 0, - resolveValues = slice.call( arguments ), - length = resolveValues.length, - - // the count of uncompleted subordinates - remaining = length !== 1 || ( subordinate && jQuery.isFunction( subordinate.promise ) ) ? length : 0, - - // the master Deferred. If resolveValues consist of only a single Deferred, just use that. - deferred = remaining === 1 ? subordinate : jQuery.Deferred(), - - // Update function for both resolve and progress values - updateFunc = function( i, contexts, values ) { - return function( value ) { - contexts[ i ] = this; - values[ i ] = arguments.length > 1 ? slice.call( arguments ) : value; - if ( values === progressValues ) { - deferred.notifyWith( contexts, values ); - - } else if ( !(--remaining) ) { - deferred.resolveWith( contexts, values ); - } - }; - }, - - progressValues, progressContexts, resolveContexts; - - // add listeners to Deferred subordinates; treat others as resolved - if ( length > 1 ) { - progressValues = new Array( length ); - progressContexts = new Array( length ); - resolveContexts = new Array( length ); - for ( ; i < length; i++ ) { - if ( resolveValues[ i ] && jQuery.isFunction( resolveValues[ i ].promise ) ) { - resolveValues[ i ].promise() - .done( updateFunc( i, resolveContexts, resolveValues ) ) - .fail( deferred.reject ) - .progress( updateFunc( i, progressContexts, progressValues ) ); - } else { - --remaining; - } - } - } - - // if we're not waiting on anything, resolve the master - if ( !remaining ) { - deferred.resolveWith( resolveContexts, resolveValues ); - } - - return deferred.promise(); - } -}); - - -// The deferred used on DOM ready -var readyList; - -jQuery.fn.ready = function( fn ) { - // Add the callback - jQuery.ready.promise().done( fn ); - - return this; -}; - -jQuery.extend({ - // Is the DOM ready to be used? Set to true once it occurs. - isReady: false, - - // A counter to track how many items to wait for before - // the ready event fires. See #6781 - readyWait: 1, - - // Hold (or release) the ready event - holdReady: function( hold ) { - if ( hold ) { - jQuery.readyWait++; - } else { - jQuery.ready( true ); - } - }, - - // Handle when the DOM is ready - ready: function( wait ) { - - // Abort if there are pending holds or we're already ready - if ( wait === true ? --jQuery.readyWait : jQuery.isReady ) { - return; - } - - // Make sure body exists, at least, in case IE gets a little overzealous (ticket #5443). - if ( !document.body ) { - return setTimeout( jQuery.ready ); - } - - // Remember that the DOM is ready - jQuery.isReady = true; - - // If a normal DOM Ready event fired, decrement, and wait if need be - if ( wait !== true && --jQuery.readyWait > 0 ) { - return; - } - - // If there are functions bound, to execute - readyList.resolveWith( document, [ jQuery ] ); - - // Trigger any bound ready events - if ( jQuery.fn.trigger ) { - jQuery( document ).trigger("ready").off("ready"); - } - } -}); - -/** - * Clean-up method for dom ready events - */ -function detach() { - if ( document.addEventListener ) { - document.removeEventListener( "DOMContentLoaded", completed, false ); - window.removeEventListener( "load", completed, false ); - - } else { - document.detachEvent( "onreadystatechange", completed ); - window.detachEvent( "onload", completed ); - } -} - -/** - * The ready event handler and self cleanup method - */ -function completed() { - // readyState === "complete" is good enough for us to call the dom ready in oldIE - if ( document.addEventListener || event.type === "load" || document.readyState === "complete" ) { - detach(); - jQuery.ready(); - } -} - -jQuery.ready.promise = function( obj ) { - if ( !readyList ) { - - readyList = jQuery.Deferred(); - - // Catch cases where $(document).ready() is called after the browser event has already occurred. - // we once tried to use readyState "interactive" here, but it caused issues like the one - // discovered by ChrisS here: http://bugs.jquery.com/ticket/12282#comment:15 - if ( document.readyState === "complete" ) { - // Handle it asynchronously to allow scripts the opportunity to delay ready - setTimeout( jQuery.ready ); - - // Standards-based browsers support DOMContentLoaded - } else if ( document.addEventListener ) { - // Use the handy event callback - document.addEventListener( "DOMContentLoaded", completed, false ); - - // A fallback to window.onload, that will always work - window.addEventListener( "load", completed, false ); - - // If IE event model is used - } else { - // Ensure firing before onload, maybe late but safe also for iframes - document.attachEvent( "onreadystatechange", completed ); - - // A fallback to window.onload, that will always work - window.attachEvent( "onload", completed ); - - // If IE and not a frame - // continually check to see if the document is ready - var top = false; - - try { - top = window.frameElement == null && document.documentElement; - } catch(e) {} - - if ( top && top.doScroll ) { - (function doScrollCheck() { - if ( !jQuery.isReady ) { - - try { - // Use the trick by Diego Perini - // http://javascript.nwbox.com/IEContentLoaded/ - top.doScroll("left"); - } catch(e) { - return setTimeout( doScrollCheck, 50 ); - } - - // detach all dom ready events - detach(); - - // and execute any waiting functions - jQuery.ready(); - } - })(); - } - } - } - return readyList.promise( obj ); -}; - - -var strundefined = typeof undefined; - - - -// Support: IE<9 -// Iteration over object's inherited properties before its own -var i; -for ( i in jQuery( support ) ) { - break; -} -support.ownLast = i !== "0"; - -// Note: most support tests are defined in their respective modules. -// false until the test is run -support.inlineBlockNeedsLayout = false; - -jQuery(function() { - // We need to execute this one support test ASAP because we need to know - // if body.style.zoom needs to be set. - - var container, div, - body = document.getElementsByTagName("body")[0]; - - if ( !body ) { - // Return for frameset docs that don't have a body - return; - } - - // Setup - container = document.createElement( "div" ); - container.style.cssText = "border:0;width:0;height:0;position:absolute;top:0;left:-9999px;margin-top:1px"; - - div = document.createElement( "div" ); - body.appendChild( container ).appendChild( div ); - - if ( typeof div.style.zoom !== strundefined ) { - // Support: IE<8 - // Check if natively block-level elements act like inline-block - // elements when setting their display to 'inline' and giving - // them layout - div.style.cssText = "border:0;margin:0;width:1px;padding:1px;display:inline;zoom:1"; - - if ( (support.inlineBlockNeedsLayout = ( div.offsetWidth === 3 )) ) { - // Prevent IE 6 from affecting layout for positioned elements #11048 - // Prevent IE from shrinking the body in IE 7 mode #12869 - // Support: IE<8 - body.style.zoom = 1; - } - } - - body.removeChild( container ); - - // Null elements to avoid leaks in IE - container = div = null; -}); - - - - -(function() { - var div = document.createElement( "div" ); - - // Execute the test only if not already executed in another module. - if (support.deleteExpando == null) { - // Support: IE<9 - support.deleteExpando = true; - try { - delete div.test; - } catch( e ) { - support.deleteExpando = false; - } - } - - // Null elements to avoid leaks in IE. - div = null; -})(); - - -/** - * Determines whether an object can have data - */ -jQuery.acceptData = function( elem ) { - var noData = jQuery.noData[ (elem.nodeName + " ").toLowerCase() ], - nodeType = +elem.nodeType || 1; - - // Do not set data on non-element DOM nodes because it will not be cleared (#8335). - return nodeType !== 1 && nodeType !== 9 ? - false : - - // Nodes accept data unless otherwise specified; rejection can be conditional - !noData || noData !== true && elem.getAttribute("classid") === noData; -}; - - -var rbrace = /^(?:\{[\w\W]*\}|\[[\w\W]*\])$/, - rmultiDash = /([A-Z])/g; - -function dataAttr( elem, key, data ) { - // If nothing was found internally, try to fetch any - // data from the HTML5 data-* attribute - if ( data === undefined && elem.nodeType === 1 ) { - - var name = "data-" + key.replace( rmultiDash, "-$1" ).toLowerCase(); - - data = elem.getAttribute( name ); - - if ( typeof data === "string" ) { - try { - data = data === "true" ? true : - data === "false" ? false : - data === "null" ? null : - // Only convert to a number if it doesn't change the string - +data + "" === data ? +data : - rbrace.test( data ) ? jQuery.parseJSON( data ) : - data; - } catch( e ) {} - - // Make sure we set the data so it isn't changed later - jQuery.data( elem, key, data ); - - } else { - data = undefined; - } - } - - return data; -} - -// checks a cache object for emptiness -function isEmptyDataObject( obj ) { - var name; - for ( name in obj ) { - - // if the public data object is empty, the private is still empty - if ( name === "data" && jQuery.isEmptyObject( obj[name] ) ) { - continue; - } - if ( name !== "toJSON" ) { - return false; - } - } - - return true; -} - -function internalData( elem, name, data, pvt /* Internal Use Only */ ) { - if ( !jQuery.acceptData( elem ) ) { - return; - } - - var ret, thisCache, - internalKey = jQuery.expando, - - // We have to handle DOM nodes and JS objects differently because IE6-7 - // can't GC object references properly across the DOM-JS boundary - isNode = elem.nodeType, - - // Only DOM nodes need the global jQuery cache; JS object data is - // attached directly to the object so GC can occur automatically - cache = isNode ? jQuery.cache : elem, - - // Only defining an ID for JS objects if its cache already exists allows - // the code to shortcut on the same path as a DOM node with no cache - id = isNode ? elem[ internalKey ] : elem[ internalKey ] && internalKey; - - // Avoid doing any more work than we need to when trying to get data on an - // object that has no data at all - if ( (!id || !cache[id] || (!pvt && !cache[id].data)) && data === undefined && typeof name === "string" ) { - return; - } - - if ( !id ) { - // Only DOM nodes need a new unique ID for each element since their data - // ends up in the global cache - if ( isNode ) { - id = elem[ internalKey ] = deletedIds.pop() || jQuery.guid++; - } else { - id = internalKey; - } - } - - if ( !cache[ id ] ) { - // Avoid exposing jQuery metadata on plain JS objects when the object - // is serialized using JSON.stringify - cache[ id ] = isNode ? {} : { toJSON: jQuery.noop }; - } - - // An object can be passed to jQuery.data instead of a key/value pair; this gets - // shallow copied over onto the existing cache - if ( typeof name === "object" || typeof name === "function" ) { - if ( pvt ) { - cache[ id ] = jQuery.extend( cache[ id ], name ); - } else { - cache[ id ].data = jQuery.extend( cache[ id ].data, name ); - } - } - - thisCache = cache[ id ]; - - // jQuery data() is stored in a separate object inside the object's internal data - // cache in order to avoid key collisions between internal data and user-defined - // data. - if ( !pvt ) { - if ( !thisCache.data ) { - thisCache.data = {}; - } - - thisCache = thisCache.data; - } - - if ( data !== undefined ) { - thisCache[ jQuery.camelCase( name ) ] = data; - } - - // Check for both converted-to-camel and non-converted data property names - // If a data property was specified - if ( typeof name === "string" ) { - - // First Try to find as-is property data - ret = thisCache[ name ]; - - // Test for null|undefined property data - if ( ret == null ) { - - // Try to find the camelCased property - ret = thisCache[ jQuery.camelCase( name ) ]; - } - } else { - ret = thisCache; - } - - return ret; -} - -function internalRemoveData( elem, name, pvt ) { - if ( !jQuery.acceptData( elem ) ) { - return; - } - - var thisCache, i, - isNode = elem.nodeType, - - // See jQuery.data for more information - cache = isNode ? jQuery.cache : elem, - id = isNode ? elem[ jQuery.expando ] : jQuery.expando; - - // If there is already no cache entry for this object, there is no - // purpose in continuing - if ( !cache[ id ] ) { - return; - } - - if ( name ) { - - thisCache = pvt ? cache[ id ] : cache[ id ].data; - - if ( thisCache ) { - - // Support array or space separated string names for data keys - if ( !jQuery.isArray( name ) ) { - - // try the string as a key before any manipulation - if ( name in thisCache ) { - name = [ name ]; - } else { - - // split the camel cased version by spaces unless a key with the spaces exists - name = jQuery.camelCase( name ); - if ( name in thisCache ) { - name = [ name ]; - } else { - name = name.split(" "); - } - } - } else { - // If "name" is an array of keys... - // When data is initially created, via ("key", "val") signature, - // keys will be converted to camelCase. - // Since there is no way to tell _how_ a key was added, remove - // both plain key and camelCase key. #12786 - // This will only penalize the array argument path. - name = name.concat( jQuery.map( name, jQuery.camelCase ) ); - } - - i = name.length; - while ( i-- ) { - delete thisCache[ name[i] ]; - } - - // If there is no data left in the cache, we want to continue - // and let the cache object itself get destroyed - if ( pvt ? !isEmptyDataObject(thisCache) : !jQuery.isEmptyObject(thisCache) ) { - return; - } - } - } - - // See jQuery.data for more information - if ( !pvt ) { - delete cache[ id ].data; - - // Don't destroy the parent cache unless the internal data object - // had been the only thing left in it - if ( !isEmptyDataObject( cache[ id ] ) ) { - return; - } - } - - // Destroy the cache - if ( isNode ) { - jQuery.cleanData( [ elem ], true ); - - // Use delete when supported for expandos or `cache` is not a window per isWindow (#10080) - /* jshint eqeqeq: false */ - } else if ( support.deleteExpando || cache != cache.window ) { - /* jshint eqeqeq: true */ - delete cache[ id ]; - - // When all else fails, null - } else { - cache[ id ] = null; - } -} - -jQuery.extend({ - cache: {}, - - // The following elements (space-suffixed to avoid Object.prototype collisions) - // throw uncatchable exceptions if you attempt to set expando properties - noData: { - "applet ": true, - "embed ": true, - // ...but Flash objects (which have this classid) *can* handle expandos - "object ": "clsid:D27CDB6E-AE6D-11cf-96B8-444553540000" - }, - - hasData: function( elem ) { - elem = elem.nodeType ? jQuery.cache[ elem[jQuery.expando] ] : elem[ jQuery.expando ]; - return !!elem && !isEmptyDataObject( elem ); - }, - - data: function( elem, name, data ) { - return internalData( elem, name, data ); - }, - - removeData: function( elem, name ) { - return internalRemoveData( elem, name ); - }, - - // For internal use only. - _data: function( elem, name, data ) { - return internalData( elem, name, data, true ); - }, - - _removeData: function( elem, name ) { - return internalRemoveData( elem, name, true ); - } -}); - -jQuery.fn.extend({ - data: function( key, value ) { - var i, name, data, - elem = this[0], - attrs = elem && elem.attributes; - - // Special expections of .data basically thwart jQuery.access, - // so implement the relevant behavior ourselves - - // Gets all values - if ( key === undefined ) { - if ( this.length ) { - data = jQuery.data( elem ); - - if ( elem.nodeType === 1 && !jQuery._data( elem, "parsedAttrs" ) ) { - i = attrs.length; - while ( i-- ) { - name = attrs[i].name; - - if ( name.indexOf("data-") === 0 ) { - name = jQuery.camelCase( name.slice(5) ); - - dataAttr( elem, name, data[ name ] ); - } - } - jQuery._data( elem, "parsedAttrs", true ); - } - } - - return data; - } - - // Sets multiple values - if ( typeof key === "object" ) { - return this.each(function() { - jQuery.data( this, key ); - }); - } - - return arguments.length > 1 ? - - // Sets one value - this.each(function() { - jQuery.data( this, key, value ); - }) : - - // Gets one value - // Try to fetch any internally stored data first - elem ? dataAttr( elem, key, jQuery.data( elem, key ) ) : undefined; - }, - - removeData: function( key ) { - return this.each(function() { - jQuery.removeData( this, key ); - }); - } -}); - - -jQuery.extend({ - queue: function( elem, type, data ) { - var queue; - - if ( elem ) { - type = ( type || "fx" ) + "queue"; - queue = jQuery._data( elem, type ); - - // Speed up dequeue by getting out quickly if this is just a lookup - if ( data ) { - if ( !queue || jQuery.isArray(data) ) { - queue = jQuery._data( elem, type, jQuery.makeArray(data) ); - } else { - queue.push( data ); - } - } - return queue || []; - } - }, - - dequeue: function( elem, type ) { - type = type || "fx"; - - var queue = jQuery.queue( elem, type ), - startLength = queue.length, - fn = queue.shift(), - hooks = jQuery._queueHooks( elem, type ), - next = function() { - jQuery.dequeue( elem, type ); - }; - - // If the fx queue is dequeued, always remove the progress sentinel - if ( fn === "inprogress" ) { - fn = queue.shift(); - startLength--; - } - - if ( fn ) { - - // Add a progress sentinel to prevent the fx queue from being - // automatically dequeued - if ( type === "fx" ) { - queue.unshift( "inprogress" ); - } - - // clear up the last queue stop function - delete hooks.stop; - fn.call( elem, next, hooks ); - } - - if ( !startLength && hooks ) { - hooks.empty.fire(); - } - }, - - // not intended for public consumption - generates a queueHooks object, or returns the current one - _queueHooks: function( elem, type ) { - var key = type + "queueHooks"; - return jQuery._data( elem, key ) || jQuery._data( elem, key, { - empty: jQuery.Callbacks("once memory").add(function() { - jQuery._removeData( elem, type + "queue" ); - jQuery._removeData( elem, key ); - }) - }); - } -}); - -jQuery.fn.extend({ - queue: function( type, data ) { - var setter = 2; - - if ( typeof type !== "string" ) { - data = type; - type = "fx"; - setter--; - } - - if ( arguments.length < setter ) { - return jQuery.queue( this[0], type ); - } - - return data === undefined ? - this : - this.each(function() { - var queue = jQuery.queue( this, type, data ); - - // ensure a hooks for this queue - jQuery._queueHooks( this, type ); - - if ( type === "fx" && queue[0] !== "inprogress" ) { - jQuery.dequeue( this, type ); - } - }); - }, - dequeue: function( type ) { - return this.each(function() { - jQuery.dequeue( this, type ); - }); - }, - clearQueue: function( type ) { - return this.queue( type || "fx", [] ); - }, - // Get a promise resolved when queues of a certain type - // are emptied (fx is the type by default) - promise: function( type, obj ) { - var tmp, - count = 1, - defer = jQuery.Deferred(), - elements = this, - i = this.length, - resolve = function() { - if ( !( --count ) ) { - defer.resolveWith( elements, [ elements ] ); - } - }; - - if ( typeof type !== "string" ) { - obj = type; - type = undefined; - } - type = type || "fx"; - - while ( i-- ) { - tmp = jQuery._data( elements[ i ], type + "queueHooks" ); - if ( tmp && tmp.empty ) { - count++; - tmp.empty.add( resolve ); - } - } - resolve(); - return defer.promise( obj ); - } -}); -var pnum = (/[+-]?(?:\d*\.|)\d+(?:[eE][+-]?\d+|)/).source; - -var cssExpand = [ "Top", "Right", "Bottom", "Left" ]; - -var isHidden = function( elem, el ) { - // isHidden might be called from jQuery#filter function; - // in that case, element will be second argument - elem = el || elem; - return jQuery.css( elem, "display" ) === "none" || !jQuery.contains( elem.ownerDocument, elem ); - }; - - - -// Multifunctional method to get and set values of a collection -// The value/s can optionally be executed if it's a function -var access = jQuery.access = function( elems, fn, key, value, chainable, emptyGet, raw ) { - var i = 0, - length = elems.length, - bulk = key == null; - - // Sets many values - if ( jQuery.type( key ) === "object" ) { - chainable = true; - for ( i in key ) { - jQuery.access( elems, fn, i, key[i], true, emptyGet, raw ); - } - - // Sets one value - } else if ( value !== undefined ) { - chainable = true; - - if ( !jQuery.isFunction( value ) ) { - raw = true; - } - - if ( bulk ) { - // Bulk operations run against the entire set - if ( raw ) { - fn.call( elems, value ); - fn = null; - - // ...except when executing function values - } else { - bulk = fn; - fn = function( elem, key, value ) { - return bulk.call( jQuery( elem ), value ); - }; - } - } - - if ( fn ) { - for ( ; i < length; i++ ) { - fn( elems[i], key, raw ? value : value.call( elems[i], i, fn( elems[i], key ) ) ); - } - } - } - - return chainable ? - elems : - - // Gets - bulk ? - fn.call( elems ) : - length ? fn( elems[0], key ) : emptyGet; -}; -var rcheckableType = (/^(?:checkbox|radio)$/i); - - - -(function() { - var fragment = document.createDocumentFragment(), - div = document.createElement("div"), - input = document.createElement("input"); - - // Setup - div.setAttribute( "className", "t" ); - div.innerHTML = "
a"; - - // IE strips leading whitespace when .innerHTML is used - support.leadingWhitespace = div.firstChild.nodeType === 3; - - // Make sure that tbody elements aren't automatically inserted - // IE will insert them into empty tables - support.tbody = !div.getElementsByTagName( "tbody" ).length; - - // Make sure that link elements get serialized correctly by innerHTML - // This requires a wrapper element in IE - support.htmlSerialize = !!div.getElementsByTagName( "link" ).length; - - // Makes sure cloning an html5 element does not cause problems - // Where outerHTML is undefined, this still works - support.html5Clone = - document.createElement( "nav" ).cloneNode( true ).outerHTML !== "<:nav>"; - - // Check if a disconnected checkbox will retain its checked - // value of true after appended to the DOM (IE6/7) - input.type = "checkbox"; - input.checked = true; - fragment.appendChild( input ); - support.appendChecked = input.checked; - - // Make sure textarea (and checkbox) defaultValue is properly cloned - // Support: IE6-IE11+ - div.innerHTML = ""; - support.noCloneChecked = !!div.cloneNode( true ).lastChild.defaultValue; - - // #11217 - WebKit loses check when the name is after the checked attribute - fragment.appendChild( div ); - div.innerHTML = ""; - - // Support: Safari 5.1, iOS 5.1, Android 4.x, Android 2.3 - // old WebKit doesn't clone checked state correctly in fragments - support.checkClone = div.cloneNode( true ).cloneNode( true ).lastChild.checked; - - // Support: IE<9 - // Opera does not clone events (and typeof div.attachEvent === undefined). - // IE9-10 clones events bound via attachEvent, but they don't trigger with .click() - support.noCloneEvent = true; - if ( div.attachEvent ) { - div.attachEvent( "onclick", function() { - support.noCloneEvent = false; - }); - - div.cloneNode( true ).click(); - } - - // Execute the test only if not already executed in another module. - if (support.deleteExpando == null) { - // Support: IE<9 - support.deleteExpando = true; - try { - delete div.test; - } catch( e ) { - support.deleteExpando = false; - } - } - - // Null elements to avoid leaks in IE. - fragment = div = input = null; -})(); - - -(function() { - var i, eventName, - div = document.createElement( "div" ); - - // Support: IE<9 (lack submit/change bubble), Firefox 23+ (lack focusin event) - for ( i in { submit: true, change: true, focusin: true }) { - eventName = "on" + i; - - if ( !(support[ i + "Bubbles" ] = eventName in window) ) { - // Beware of CSP restrictions (https://developer.mozilla.org/en/Security/CSP) - div.setAttribute( eventName, "t" ); - support[ i + "Bubbles" ] = div.attributes[ eventName ].expando === false; - } - } - - // Null elements to avoid leaks in IE. - div = null; -})(); - - -var rformElems = /^(?:input|select|textarea)$/i, - rkeyEvent = /^key/, - rmouseEvent = /^(?:mouse|contextmenu)|click/, - rfocusMorph = /^(?:focusinfocus|focusoutblur)$/, - rtypenamespace = /^([^.]*)(?:\.(.+)|)$/; - -function returnTrue() { - return true; -} - -function returnFalse() { - return false; -} - -function safeActiveElement() { - try { - return document.activeElement; - } catch ( err ) { } -} - -/* - * Helper functions for managing events -- not part of the public interface. - * Props to Dean Edwards' addEvent library for many of the ideas. - */ -jQuery.event = { - - global: {}, - - add: function( elem, types, handler, data, selector ) { - var tmp, events, t, handleObjIn, - special, eventHandle, handleObj, - handlers, type, namespaces, origType, - elemData = jQuery._data( elem ); - - // Don't attach events to noData or text/comment nodes (but allow plain objects) - if ( !elemData ) { - return; - } - - // Caller can pass in an object of custom data in lieu of the handler - if ( handler.handler ) { - handleObjIn = handler; - handler = handleObjIn.handler; - selector = handleObjIn.selector; - } - - // Make sure that the handler has a unique ID, used to find/remove it later - if ( !handler.guid ) { - handler.guid = jQuery.guid++; - } - - // Init the element's event structure and main handler, if this is the first - if ( !(events = elemData.events) ) { - events = elemData.events = {}; - } - if ( !(eventHandle = elemData.handle) ) { - eventHandle = elemData.handle = function( e ) { - // Discard the second event of a jQuery.event.trigger() and - // when an event is called after a page has unloaded - return typeof jQuery !== strundefined && (!e || jQuery.event.triggered !== e.type) ? - jQuery.event.dispatch.apply( eventHandle.elem, arguments ) : - undefined; - }; - // Add elem as a property of the handle fn to prevent a memory leak with IE non-native events - eventHandle.elem = elem; - } - - // Handle multiple events separated by a space - types = ( types || "" ).match( rnotwhite ) || [ "" ]; - t = types.length; - while ( t-- ) { - tmp = rtypenamespace.exec( types[t] ) || []; - type = origType = tmp[1]; - namespaces = ( tmp[2] || "" ).split( "." ).sort(); - - // There *must* be a type, no attaching namespace-only handlers - if ( !type ) { - continue; - } - - // If event changes its type, use the special event handlers for the changed type - special = jQuery.event.special[ type ] || {}; - - // If selector defined, determine special event api type, otherwise given type - type = ( selector ? special.delegateType : special.bindType ) || type; - - // Update special based on newly reset type - special = jQuery.event.special[ type ] || {}; - - // handleObj is passed to all event handlers - handleObj = jQuery.extend({ - type: type, - origType: origType, - data: data, - handler: handler, - guid: handler.guid, - selector: selector, - needsContext: selector && jQuery.expr.match.needsContext.test( selector ), - namespace: namespaces.join(".") - }, handleObjIn ); - - // Init the event handler queue if we're the first - if ( !(handlers = events[ type ]) ) { - handlers = events[ type ] = []; - handlers.delegateCount = 0; - - // Only use addEventListener/attachEvent if the special events handler returns false - if ( !special.setup || special.setup.call( elem, data, namespaces, eventHandle ) === false ) { - // Bind the global event handler to the element - if ( elem.addEventListener ) { - elem.addEventListener( type, eventHandle, false ); - - } else if ( elem.attachEvent ) { - elem.attachEvent( "on" + type, eventHandle ); - } - } - } - - if ( special.add ) { - special.add.call( elem, handleObj ); - - if ( !handleObj.handler.guid ) { - handleObj.handler.guid = handler.guid; - } - } - - // Add to the element's handler list, delegates in front - if ( selector ) { - handlers.splice( handlers.delegateCount++, 0, handleObj ); - } else { - handlers.push( handleObj ); - } - - // Keep track of which events have ever been used, for event optimization - jQuery.event.global[ type ] = true; - } - - // Nullify elem to prevent memory leaks in IE - elem = null; - }, - - // Detach an event or set of events from an element - remove: function( elem, types, handler, selector, mappedTypes ) { - var j, handleObj, tmp, - origCount, t, events, - special, handlers, type, - namespaces, origType, - elemData = jQuery.hasData( elem ) && jQuery._data( elem ); - - if ( !elemData || !(events = elemData.events) ) { - return; - } - - // Once for each type.namespace in types; type may be omitted - types = ( types || "" ).match( rnotwhite ) || [ "" ]; - t = types.length; - while ( t-- ) { - tmp = rtypenamespace.exec( types[t] ) || []; - type = origType = tmp[1]; - namespaces = ( tmp[2] || "" ).split( "." ).sort(); - - // Unbind all events (on this namespace, if provided) for the element - if ( !type ) { - for ( type in events ) { - jQuery.event.remove( elem, type + types[ t ], handler, selector, true ); - } - continue; - } - - special = jQuery.event.special[ type ] || {}; - type = ( selector ? special.delegateType : special.bindType ) || type; - handlers = events[ type ] || []; - tmp = tmp[2] && new RegExp( "(^|\\.)" + namespaces.join("\\.(?:.*\\.|)") + "(\\.|$)" ); - - // Remove matching events - origCount = j = handlers.length; - while ( j-- ) { - handleObj = handlers[ j ]; - - if ( ( mappedTypes || origType === handleObj.origType ) && - ( !handler || handler.guid === handleObj.guid ) && - ( !tmp || tmp.test( handleObj.namespace ) ) && - ( !selector || selector === handleObj.selector || selector === "**" && handleObj.selector ) ) { - handlers.splice( j, 1 ); - - if ( handleObj.selector ) { - handlers.delegateCount--; - } - if ( special.remove ) { - special.remove.call( elem, handleObj ); - } - } - } - - // Remove generic event handler if we removed something and no more handlers exist - // (avoids potential for endless recursion during removal of special event handlers) - if ( origCount && !handlers.length ) { - if ( !special.teardown || special.teardown.call( elem, namespaces, elemData.handle ) === false ) { - jQuery.removeEvent( elem, type, elemData.handle ); - } - - delete events[ type ]; - } - } - - // Remove the expando if it's no longer used - if ( jQuery.isEmptyObject( events ) ) { - delete elemData.handle; - - // removeData also checks for emptiness and clears the expando if empty - // so use it instead of delete - jQuery._removeData( elem, "events" ); - } - }, - - trigger: function( event, data, elem, onlyHandlers ) { - var handle, ontype, cur, - bubbleType, special, tmp, i, - eventPath = [ elem || document ], - type = hasOwn.call( event, "type" ) ? event.type : event, - namespaces = hasOwn.call( event, "namespace" ) ? event.namespace.split(".") : []; - - cur = tmp = elem = elem || document; - - // Don't do events on text and comment nodes - if ( elem.nodeType === 3 || elem.nodeType === 8 ) { - return; - } - - // focus/blur morphs to focusin/out; ensure we're not firing them right now - if ( rfocusMorph.test( type + jQuery.event.triggered ) ) { - return; - } - - if ( type.indexOf(".") >= 0 ) { - // Namespaced trigger; create a regexp to match event type in handle() - namespaces = type.split("."); - type = namespaces.shift(); - namespaces.sort(); - } - ontype = type.indexOf(":") < 0 && "on" + type; - - // Caller can pass in a jQuery.Event object, Object, or just an event type string - event = event[ jQuery.expando ] ? - event : - new jQuery.Event( type, typeof event === "object" && event ); - - // Trigger bitmask: & 1 for native handlers; & 2 for jQuery (always true) - event.isTrigger = onlyHandlers ? 2 : 3; - event.namespace = namespaces.join("."); - event.namespace_re = event.namespace ? - new RegExp( "(^|\\.)" + namespaces.join("\\.(?:.*\\.|)") + "(\\.|$)" ) : - null; - - // Clean up the event in case it is being reused - event.result = undefined; - if ( !event.target ) { - event.target = elem; - } - - // Clone any incoming data and prepend the event, creating the handler arg list - data = data == null ? - [ event ] : - jQuery.makeArray( data, [ event ] ); - - // Allow special events to draw outside the lines - special = jQuery.event.special[ type ] || {}; - if ( !onlyHandlers && special.trigger && special.trigger.apply( elem, data ) === false ) { - return; - } - - // Determine event propagation path in advance, per W3C events spec (#9951) - // Bubble up to document, then to window; watch for a global ownerDocument var (#9724) - if ( !onlyHandlers && !special.noBubble && !jQuery.isWindow( elem ) ) { - - bubbleType = special.delegateType || type; - if ( !rfocusMorph.test( bubbleType + type ) ) { - cur = cur.parentNode; - } - for ( ; cur; cur = cur.parentNode ) { - eventPath.push( cur ); - tmp = cur; - } - - // Only add window if we got to document (e.g., not plain obj or detached DOM) - if ( tmp === (elem.ownerDocument || document) ) { - eventPath.push( tmp.defaultView || tmp.parentWindow || window ); - } - } - - // Fire handlers on the event path - i = 0; - while ( (cur = eventPath[i++]) && !event.isPropagationStopped() ) { - - event.type = i > 1 ? - bubbleType : - special.bindType || type; - - // jQuery handler - handle = ( jQuery._data( cur, "events" ) || {} )[ event.type ] && jQuery._data( cur, "handle" ); - if ( handle ) { - handle.apply( cur, data ); - } - - // Native handler - handle = ontype && cur[ ontype ]; - if ( handle && handle.apply && jQuery.acceptData( cur ) ) { - event.result = handle.apply( cur, data ); - if ( event.result === false ) { - event.preventDefault(); - } - } - } - event.type = type; - - // If nobody prevented the default action, do it now - if ( !onlyHandlers && !event.isDefaultPrevented() ) { - - if ( (!special._default || special._default.apply( eventPath.pop(), data ) === false) && - jQuery.acceptData( elem ) ) { - - // Call a native DOM method on the target with the same name name as the event. - // Can't use an .isFunction() check here because IE6/7 fails that test. - // Don't do default actions on window, that's where global variables be (#6170) - if ( ontype && elem[ type ] && !jQuery.isWindow( elem ) ) { - - // Don't re-trigger an onFOO event when we call its FOO() method - tmp = elem[ ontype ]; - - if ( tmp ) { - elem[ ontype ] = null; - } - - // Prevent re-triggering of the same event, since we already bubbled it above - jQuery.event.triggered = type; - try { - elem[ type ](); - } catch ( e ) { - // IE<9 dies on focus/blur to hidden element (#1486,#12518) - // only reproducible on winXP IE8 native, not IE9 in IE8 mode - } - jQuery.event.triggered = undefined; - - if ( tmp ) { - elem[ ontype ] = tmp; - } - } - } - } - - return event.result; - }, - - dispatch: function( event ) { - - // Make a writable jQuery.Event from the native event object - event = jQuery.event.fix( event ); - - var i, ret, handleObj, matched, j, - handlerQueue = [], - args = slice.call( arguments ), - handlers = ( jQuery._data( this, "events" ) || {} )[ event.type ] || [], - special = jQuery.event.special[ event.type ] || {}; - - // Use the fix-ed jQuery.Event rather than the (read-only) native event - args[0] = event; - event.delegateTarget = this; - - // Call the preDispatch hook for the mapped type, and let it bail if desired - if ( special.preDispatch && special.preDispatch.call( this, event ) === false ) { - return; - } - - // Determine handlers - handlerQueue = jQuery.event.handlers.call( this, event, handlers ); - - // Run delegates first; they may want to stop propagation beneath us - i = 0; - while ( (matched = handlerQueue[ i++ ]) && !event.isPropagationStopped() ) { - event.currentTarget = matched.elem; - - j = 0; - while ( (handleObj = matched.handlers[ j++ ]) && !event.isImmediatePropagationStopped() ) { - - // Triggered event must either 1) have no namespace, or - // 2) have namespace(s) a subset or equal to those in the bound event (both can have no namespace). - if ( !event.namespace_re || event.namespace_re.test( handleObj.namespace ) ) { - - event.handleObj = handleObj; - event.data = handleObj.data; - - ret = ( (jQuery.event.special[ handleObj.origType ] || {}).handle || handleObj.handler ) - .apply( matched.elem, args ); - - if ( ret !== undefined ) { - if ( (event.result = ret) === false ) { - event.preventDefault(); - event.stopPropagation(); - } - } - } - } - } - - // Call the postDispatch hook for the mapped type - if ( special.postDispatch ) { - special.postDispatch.call( this, event ); - } - - return event.result; - }, - - handlers: function( event, handlers ) { - var sel, handleObj, matches, i, - handlerQueue = [], - delegateCount = handlers.delegateCount, - cur = event.target; - - // Find delegate handlers - // Black-hole SVG instance trees (#13180) - // Avoid non-left-click bubbling in Firefox (#3861) - if ( delegateCount && cur.nodeType && (!event.button || event.type !== "click") ) { - - /* jshint eqeqeq: false */ - for ( ; cur != this; cur = cur.parentNode || this ) { - /* jshint eqeqeq: true */ - - // Don't check non-elements (#13208) - // Don't process clicks on disabled elements (#6911, #8165, #11382, #11764) - if ( cur.nodeType === 1 && (cur.disabled !== true || event.type !== "click") ) { - matches = []; - for ( i = 0; i < delegateCount; i++ ) { - handleObj = handlers[ i ]; - - // Don't conflict with Object.prototype properties (#13203) - sel = handleObj.selector + " "; - - if ( matches[ sel ] === undefined ) { - matches[ sel ] = handleObj.needsContext ? - jQuery( sel, this ).index( cur ) >= 0 : - jQuery.find( sel, this, null, [ cur ] ).length; - } - if ( matches[ sel ] ) { - matches.push( handleObj ); - } - } - if ( matches.length ) { - handlerQueue.push({ elem: cur, handlers: matches }); - } - } - } - } - - // Add the remaining (directly-bound) handlers - if ( delegateCount < handlers.length ) { - handlerQueue.push({ elem: this, handlers: handlers.slice( delegateCount ) }); - } - - return handlerQueue; - }, - - fix: function( event ) { - if ( event[ jQuery.expando ] ) { - return event; - } - - // Create a writable copy of the event object and normalize some properties - var i, prop, copy, - type = event.type, - originalEvent = event, - fixHook = this.fixHooks[ type ]; - - if ( !fixHook ) { - this.fixHooks[ type ] = fixHook = - rmouseEvent.test( type ) ? this.mouseHooks : - rkeyEvent.test( type ) ? this.keyHooks : - {}; - } - copy = fixHook.props ? this.props.concat( fixHook.props ) : this.props; - - event = new jQuery.Event( originalEvent ); - - i = copy.length; - while ( i-- ) { - prop = copy[ i ]; - event[ prop ] = originalEvent[ prop ]; - } - - // Support: IE<9 - // Fix target property (#1925) - if ( !event.target ) { - event.target = originalEvent.srcElement || document; - } - - // Support: Chrome 23+, Safari? - // Target should not be a text node (#504, #13143) - if ( event.target.nodeType === 3 ) { - event.target = event.target.parentNode; - } - - // Support: IE<9 - // For mouse/key events, metaKey==false if it's undefined (#3368, #11328) - event.metaKey = !!event.metaKey; - - return fixHook.filter ? fixHook.filter( event, originalEvent ) : event; - }, - - // Includes some event props shared by KeyEvent and MouseEvent - props: "altKey bubbles cancelable ctrlKey currentTarget eventPhase metaKey relatedTarget shiftKey target timeStamp view which".split(" "), - - fixHooks: {}, - - keyHooks: { - props: "char charCode key keyCode".split(" "), - filter: function( event, original ) { - - // Add which for key events - if ( event.which == null ) { - event.which = original.charCode != null ? original.charCode : original.keyCode; - } - - return event; - } - }, - - mouseHooks: { - props: "button buttons clientX clientY fromElement offsetX offsetY pageX pageY screenX screenY toElement".split(" "), - filter: function( event, original ) { - var body, eventDoc, doc, - button = original.button, - fromElement = original.fromElement; - - // Calculate pageX/Y if missing and clientX/Y available - if ( event.pageX == null && original.clientX != null ) { - eventDoc = event.target.ownerDocument || document; - doc = eventDoc.documentElement; - body = eventDoc.body; - - event.pageX = original.clientX + ( doc && doc.scrollLeft || body && body.scrollLeft || 0 ) - ( doc && doc.clientLeft || body && body.clientLeft || 0 ); - event.pageY = original.clientY + ( doc && doc.scrollTop || body && body.scrollTop || 0 ) - ( doc && doc.clientTop || body && body.clientTop || 0 ); - } - - // Add relatedTarget, if necessary - if ( !event.relatedTarget && fromElement ) { - event.relatedTarget = fromElement === event.target ? original.toElement : fromElement; - } - - // Add which for click: 1 === left; 2 === middle; 3 === right - // Note: button is not normalized, so don't use it - if ( !event.which && button !== undefined ) { - event.which = ( button & 1 ? 1 : ( button & 2 ? 3 : ( button & 4 ? 2 : 0 ) ) ); - } - - return event; - } - }, - - special: { - load: { - // Prevent triggered image.load events from bubbling to window.load - noBubble: true - }, - focus: { - // Fire native event if possible so blur/focus sequence is correct - trigger: function() { - if ( this !== safeActiveElement() && this.focus ) { - try { - this.focus(); - return false; - } catch ( e ) { - // Support: IE<9 - // If we error on focus to hidden element (#1486, #12518), - // let .trigger() run the handlers - } - } - }, - delegateType: "focusin" - }, - blur: { - trigger: function() { - if ( this === safeActiveElement() && this.blur ) { - this.blur(); - return false; - } - }, - delegateType: "focusout" - }, - click: { - // For checkbox, fire native event so checked state will be right - trigger: function() { - if ( jQuery.nodeName( this, "input" ) && this.type === "checkbox" && this.click ) { - this.click(); - return false; - } - }, - - // For cross-browser consistency, don't fire native .click() on links - _default: function( event ) { - return jQuery.nodeName( event.target, "a" ); - } - }, - - beforeunload: { - postDispatch: function( event ) { - - // Even when returnValue equals to undefined Firefox will still show alert - if ( event.result !== undefined ) { - event.originalEvent.returnValue = event.result; - } - } - } - }, - - simulate: function( type, elem, event, bubble ) { - // Piggyback on a donor event to simulate a different one. - // Fake originalEvent to avoid donor's stopPropagation, but if the - // simulated event prevents default then we do the same on the donor. - var e = jQuery.extend( - new jQuery.Event(), - event, - { - type: type, - isSimulated: true, - originalEvent: {} - } - ); - if ( bubble ) { - jQuery.event.trigger( e, null, elem ); - } else { - jQuery.event.dispatch.call( elem, e ); - } - if ( e.isDefaultPrevented() ) { - event.preventDefault(); - } - } -}; - -jQuery.removeEvent = document.removeEventListener ? - function( elem, type, handle ) { - if ( elem.removeEventListener ) { - elem.removeEventListener( type, handle, false ); - } - } : - function( elem, type, handle ) { - var name = "on" + type; - - if ( elem.detachEvent ) { - - // #8545, #7054, preventing memory leaks for custom events in IE6-8 - // detachEvent needed property on element, by name of that event, to properly expose it to GC - if ( typeof elem[ name ] === strundefined ) { - elem[ name ] = null; - } - - elem.detachEvent( name, handle ); - } - }; - -jQuery.Event = function( src, props ) { - // Allow instantiation without the 'new' keyword - if ( !(this instanceof jQuery.Event) ) { - return new jQuery.Event( src, props ); - } - - // Event object - if ( src && src.type ) { - this.originalEvent = src; - this.type = src.type; - - // Events bubbling up the document may have been marked as prevented - // by a handler lower down the tree; reflect the correct value. - this.isDefaultPrevented = src.defaultPrevented || - src.defaultPrevented === undefined && ( - // Support: IE < 9 - src.returnValue === false || - // Support: Android < 4.0 - src.getPreventDefault && src.getPreventDefault() ) ? - returnTrue : - returnFalse; - - // Event type - } else { - this.type = src; - } - - // Put explicitly provided properties onto the event object - if ( props ) { - jQuery.extend( this, props ); - } - - // Create a timestamp if incoming event doesn't have one - this.timeStamp = src && src.timeStamp || jQuery.now(); - - // Mark it as fixed - this[ jQuery.expando ] = true; -}; - -// jQuery.Event is based on DOM3 Events as specified by the ECMAScript Language Binding -// http://www.w3.org/TR/2003/WD-DOM-Level-3-Events-20030331/ecma-script-binding.html -jQuery.Event.prototype = { - isDefaultPrevented: returnFalse, - isPropagationStopped: returnFalse, - isImmediatePropagationStopped: returnFalse, - - preventDefault: function() { - var e = this.originalEvent; - - this.isDefaultPrevented = returnTrue; - if ( !e ) { - return; - } - - // If preventDefault exists, run it on the original event - if ( e.preventDefault ) { - e.preventDefault(); - - // Support: IE - // Otherwise set the returnValue property of the original event to false - } else { - e.returnValue = false; - } - }, - stopPropagation: function() { - var e = this.originalEvent; - - this.isPropagationStopped = returnTrue; - if ( !e ) { - return; - } - // If stopPropagation exists, run it on the original event - if ( e.stopPropagation ) { - e.stopPropagation(); - } - - // Support: IE - // Set the cancelBubble property of the original event to true - e.cancelBubble = true; - }, - stopImmediatePropagation: function() { - this.isImmediatePropagationStopped = returnTrue; - this.stopPropagation(); - } -}; - -// Create mouseenter/leave events using mouseover/out and event-time checks -jQuery.each({ - mouseenter: "mouseover", - mouseleave: "mouseout" -}, function( orig, fix ) { - jQuery.event.special[ orig ] = { - delegateType: fix, - bindType: fix, - - handle: function( event ) { - var ret, - target = this, - related = event.relatedTarget, - handleObj = event.handleObj; - - // For mousenter/leave call the handler if related is outside the target. - // NB: No relatedTarget if the mouse left/entered the browser window - if ( !related || (related !== target && !jQuery.contains( target, related )) ) { - event.type = handleObj.origType; - ret = handleObj.handler.apply( this, arguments ); - event.type = fix; - } - return ret; - } - }; -}); - -// IE submit delegation -if ( !support.submitBubbles ) { - - jQuery.event.special.submit = { - setup: function() { - // Only need this for delegated form submit events - if ( jQuery.nodeName( this, "form" ) ) { - return false; - } - - // Lazy-add a submit handler when a descendant form may potentially be submitted - jQuery.event.add( this, "click._submit keypress._submit", function( e ) { - // Node name check avoids a VML-related crash in IE (#9807) - var elem = e.target, - form = jQuery.nodeName( elem, "input" ) || jQuery.nodeName( elem, "button" ) ? elem.form : undefined; - if ( form && !jQuery._data( form, "submitBubbles" ) ) { - jQuery.event.add( form, "submit._submit", function( event ) { - event._submit_bubble = true; - }); - jQuery._data( form, "submitBubbles", true ); - } - }); - // return undefined since we don't need an event listener - }, - - postDispatch: function( event ) { - // If form was submitted by the user, bubble the event up the tree - if ( event._submit_bubble ) { - delete event._submit_bubble; - if ( this.parentNode && !event.isTrigger ) { - jQuery.event.simulate( "submit", this.parentNode, event, true ); - } - } - }, - - teardown: function() { - // Only need this for delegated form submit events - if ( jQuery.nodeName( this, "form" ) ) { - return false; - } - - // Remove delegated handlers; cleanData eventually reaps submit handlers attached above - jQuery.event.remove( this, "._submit" ); - } - }; -} - -// IE change delegation and checkbox/radio fix -if ( !support.changeBubbles ) { - - jQuery.event.special.change = { - - setup: function() { - - if ( rformElems.test( this.nodeName ) ) { - // IE doesn't fire change on a check/radio until blur; trigger it on click - // after a propertychange. Eat the blur-change in special.change.handle. - // This still fires onchange a second time for check/radio after blur. - if ( this.type === "checkbox" || this.type === "radio" ) { - jQuery.event.add( this, "propertychange._change", function( event ) { - if ( event.originalEvent.propertyName === "checked" ) { - this._just_changed = true; - } - }); - jQuery.event.add( this, "click._change", function( event ) { - if ( this._just_changed && !event.isTrigger ) { - this._just_changed = false; - } - // Allow triggered, simulated change events (#11500) - jQuery.event.simulate( "change", this, event, true ); - }); - } - return false; - } - // Delegated event; lazy-add a change handler on descendant inputs - jQuery.event.add( this, "beforeactivate._change", function( e ) { - var elem = e.target; - - if ( rformElems.test( elem.nodeName ) && !jQuery._data( elem, "changeBubbles" ) ) { - jQuery.event.add( elem, "change._change", function( event ) { - if ( this.parentNode && !event.isSimulated && !event.isTrigger ) { - jQuery.event.simulate( "change", this.parentNode, event, true ); - } - }); - jQuery._data( elem, "changeBubbles", true ); - } - }); - }, - - handle: function( event ) { - var elem = event.target; - - // Swallow native change events from checkbox/radio, we already triggered them above - if ( this !== elem || event.isSimulated || event.isTrigger || (elem.type !== "radio" && elem.type !== "checkbox") ) { - return event.handleObj.handler.apply( this, arguments ); - } - }, - - teardown: function() { - jQuery.event.remove( this, "._change" ); - - return !rformElems.test( this.nodeName ); - } - }; -} - -// Create "bubbling" focus and blur events -if ( !support.focusinBubbles ) { - jQuery.each({ focus: "focusin", blur: "focusout" }, function( orig, fix ) { - - // Attach a single capturing handler on the document while someone wants focusin/focusout - var handler = function( event ) { - jQuery.event.simulate( fix, event.target, jQuery.event.fix( event ), true ); - }; - - jQuery.event.special[ fix ] = { - setup: function() { - var doc = this.ownerDocument || this, - attaches = jQuery._data( doc, fix ); - - if ( !attaches ) { - doc.addEventListener( orig, handler, true ); - } - jQuery._data( doc, fix, ( attaches || 0 ) + 1 ); - }, - teardown: function() { - var doc = this.ownerDocument || this, - attaches = jQuery._data( doc, fix ) - 1; - - if ( !attaches ) { - doc.removeEventListener( orig, handler, true ); - jQuery._removeData( doc, fix ); - } else { - jQuery._data( doc, fix, attaches ); - } - } - }; - }); -} - -jQuery.fn.extend({ - - on: function( types, selector, data, fn, /*INTERNAL*/ one ) { - var type, origFn; - - // Types can be a map of types/handlers - if ( typeof types === "object" ) { - // ( types-Object, selector, data ) - if ( typeof selector !== "string" ) { - // ( types-Object, data ) - data = data || selector; - selector = undefined; - } - for ( type in types ) { - this.on( type, selector, data, types[ type ], one ); - } - return this; - } - - if ( data == null && fn == null ) { - // ( types, fn ) - fn = selector; - data = selector = undefined; - } else if ( fn == null ) { - if ( typeof selector === "string" ) { - // ( types, selector, fn ) - fn = data; - data = undefined; - } else { - // ( types, data, fn ) - fn = data; - data = selector; - selector = undefined; - } - } - if ( fn === false ) { - fn = returnFalse; - } else if ( !fn ) { - return this; - } - - if ( one === 1 ) { - origFn = fn; - fn = function( event ) { - // Can use an empty set, since event contains the info - jQuery().off( event ); - return origFn.apply( this, arguments ); - }; - // Use same guid so caller can remove using origFn - fn.guid = origFn.guid || ( origFn.guid = jQuery.guid++ ); - } - return this.each( function() { - jQuery.event.add( this, types, fn, data, selector ); - }); - }, - one: function( types, selector, data, fn ) { - return this.on( types, selector, data, fn, 1 ); - }, - off: function( types, selector, fn ) { - var handleObj, type; - if ( types && types.preventDefault && types.handleObj ) { - // ( event ) dispatched jQuery.Event - handleObj = types.handleObj; - jQuery( types.delegateTarget ).off( - handleObj.namespace ? handleObj.origType + "." + handleObj.namespace : handleObj.origType, - handleObj.selector, - handleObj.handler - ); - return this; - } - if ( typeof types === "object" ) { - // ( types-object [, selector] ) - for ( type in types ) { - this.off( type, selector, types[ type ] ); - } - return this; - } - if ( selector === false || typeof selector === "function" ) { - // ( types [, fn] ) - fn = selector; - selector = undefined; - } - if ( fn === false ) { - fn = returnFalse; - } - return this.each(function() { - jQuery.event.remove( this, types, fn, selector ); - }); - }, - - trigger: function( type, data ) { - return this.each(function() { - jQuery.event.trigger( type, data, this ); - }); - }, - triggerHandler: function( type, data ) { - var elem = this[0]; - if ( elem ) { - return jQuery.event.trigger( type, data, elem, true ); - } - } -}); - - -function createSafeFragment( document ) { - var list = nodeNames.split( "|" ), - safeFrag = document.createDocumentFragment(); - - if ( safeFrag.createElement ) { - while ( list.length ) { - safeFrag.createElement( - list.pop() - ); - } - } - return safeFrag; -} - -var nodeNames = "abbr|article|aside|audio|bdi|canvas|data|datalist|details|figcaption|figure|footer|" + - "header|hgroup|mark|meter|nav|output|progress|section|summary|time|video", - rinlinejQuery = / jQuery\d+="(?:null|\d+)"/g, - rnoshimcache = new RegExp("<(?:" + nodeNames + ")[\\s/>]", "i"), - rleadingWhitespace = /^\s+/, - rxhtmlTag = /<(?!area|br|col|embed|hr|img|input|link|meta|param)(([\w:]+)[^>]*)\/>/gi, - rtagName = /<([\w:]+)/, - rtbody = /\s*$/g, - - // We have to close these tags to support XHTML (#13200) - wrapMap = { - option: [ 1, "" ], - legend: [ 1, "
", "
" ], - area: [ 1, "", "" ], - param: [ 1, "", "" ], - thead: [ 1, "", "
" ], - tr: [ 2, "", "
" ], - col: [ 2, "", "
" ], - td: [ 3, "", "
" ], - - // IE6-8 can't serialize link, script, style, or any html5 (NoScope) tags, - // unless wrapped in a div with non-breaking characters in front of it. - _default: support.htmlSerialize ? [ 0, "", "" ] : [ 1, "X
", "
" ] - }, - safeFragment = createSafeFragment( document ), - fragmentDiv = safeFragment.appendChild( document.createElement("div") ); - -wrapMap.optgroup = wrapMap.option; -wrapMap.tbody = wrapMap.tfoot = wrapMap.colgroup = wrapMap.caption = wrapMap.thead; -wrapMap.th = wrapMap.td; - -function getAll( context, tag ) { - var elems, elem, - i = 0, - found = typeof context.getElementsByTagName !== strundefined ? context.getElementsByTagName( tag || "*" ) : - typeof context.querySelectorAll !== strundefined ? context.querySelectorAll( tag || "*" ) : - undefined; - - if ( !found ) { - for ( found = [], elems = context.childNodes || context; (elem = elems[i]) != null; i++ ) { - if ( !tag || jQuery.nodeName( elem, tag ) ) { - found.push( elem ); - } else { - jQuery.merge( found, getAll( elem, tag ) ); - } - } - } - - return tag === undefined || tag && jQuery.nodeName( context, tag ) ? - jQuery.merge( [ context ], found ) : - found; -} - -// Used in buildFragment, fixes the defaultChecked property -function fixDefaultChecked( elem ) { - if ( rcheckableType.test( elem.type ) ) { - elem.defaultChecked = elem.checked; - } -} - -// Support: IE<8 -// Manipulating tables requires a tbody -function manipulationTarget( elem, content ) { - return jQuery.nodeName( elem, "table" ) && - jQuery.nodeName( content.nodeType !== 11 ? content : content.firstChild, "tr" ) ? - - elem.getElementsByTagName("tbody")[0] || - elem.appendChild( elem.ownerDocument.createElement("tbody") ) : - elem; -} - -// Replace/restore the type attribute of script elements for safe DOM manipulation -function disableScript( elem ) { - elem.type = (jQuery.find.attr( elem, "type" ) !== null) + "/" + elem.type; - return elem; -} -function restoreScript( elem ) { - var match = rscriptTypeMasked.exec( elem.type ); - if ( match ) { - elem.type = match[1]; - } else { - elem.removeAttribute("type"); - } - return elem; -} - -// Mark scripts as having already been evaluated -function setGlobalEval( elems, refElements ) { - var elem, - i = 0; - for ( ; (elem = elems[i]) != null; i++ ) { - jQuery._data( elem, "globalEval", !refElements || jQuery._data( refElements[i], "globalEval" ) ); - } -} - -function cloneCopyEvent( src, dest ) { - - if ( dest.nodeType !== 1 || !jQuery.hasData( src ) ) { - return; - } - - var type, i, l, - oldData = jQuery._data( src ), - curData = jQuery._data( dest, oldData ), - events = oldData.events; - - if ( events ) { - delete curData.handle; - curData.events = {}; - - for ( type in events ) { - for ( i = 0, l = events[ type ].length; i < l; i++ ) { - jQuery.event.add( dest, type, events[ type ][ i ] ); - } - } - } - - // make the cloned public data object a copy from the original - if ( curData.data ) { - curData.data = jQuery.extend( {}, curData.data ); - } -} - -function fixCloneNodeIssues( src, dest ) { - var nodeName, e, data; - - // We do not need to do anything for non-Elements - if ( dest.nodeType !== 1 ) { - return; - } - - nodeName = dest.nodeName.toLowerCase(); - - // IE6-8 copies events bound via attachEvent when using cloneNode. - if ( !support.noCloneEvent && dest[ jQuery.expando ] ) { - data = jQuery._data( dest ); - - for ( e in data.events ) { - jQuery.removeEvent( dest, e, data.handle ); - } - - // Event data gets referenced instead of copied if the expando gets copied too - dest.removeAttribute( jQuery.expando ); - } - - // IE blanks contents when cloning scripts, and tries to evaluate newly-set text - if ( nodeName === "script" && dest.text !== src.text ) { - disableScript( dest ).text = src.text; - restoreScript( dest ); - - // IE6-10 improperly clones children of object elements using classid. - // IE10 throws NoModificationAllowedError if parent is null, #12132. - } else if ( nodeName === "object" ) { - if ( dest.parentNode ) { - dest.outerHTML = src.outerHTML; - } - - // This path appears unavoidable for IE9. When cloning an object - // element in IE9, the outerHTML strategy above is not sufficient. - // If the src has innerHTML and the destination does not, - // copy the src.innerHTML into the dest.innerHTML. #10324 - if ( support.html5Clone && ( src.innerHTML && !jQuery.trim(dest.innerHTML) ) ) { - dest.innerHTML = src.innerHTML; - } - - } else if ( nodeName === "input" && rcheckableType.test( src.type ) ) { - // IE6-8 fails to persist the checked state of a cloned checkbox - // or radio button. Worse, IE6-7 fail to give the cloned element - // a checked appearance if the defaultChecked value isn't also set - - dest.defaultChecked = dest.checked = src.checked; - - // IE6-7 get confused and end up setting the value of a cloned - // checkbox/radio button to an empty string instead of "on" - if ( dest.value !== src.value ) { - dest.value = src.value; - } - - // IE6-8 fails to return the selected option to the default selected - // state when cloning options - } else if ( nodeName === "option" ) { - dest.defaultSelected = dest.selected = src.defaultSelected; - - // IE6-8 fails to set the defaultValue to the correct value when - // cloning other types of input fields - } else if ( nodeName === "input" || nodeName === "textarea" ) { - dest.defaultValue = src.defaultValue; - } -} - -jQuery.extend({ - clone: function( elem, dataAndEvents, deepDataAndEvents ) { - var destElements, node, clone, i, srcElements, - inPage = jQuery.contains( elem.ownerDocument, elem ); - - if ( support.html5Clone || jQuery.isXMLDoc(elem) || !rnoshimcache.test( "<" + elem.nodeName + ">" ) ) { - clone = elem.cloneNode( true ); - - // IE<=8 does not properly clone detached, unknown element nodes - } else { - fragmentDiv.innerHTML = elem.outerHTML; - fragmentDiv.removeChild( clone = fragmentDiv.firstChild ); - } - - if ( (!support.noCloneEvent || !support.noCloneChecked) && - (elem.nodeType === 1 || elem.nodeType === 11) && !jQuery.isXMLDoc(elem) ) { - - // We eschew Sizzle here for performance reasons: http://jsperf.com/getall-vs-sizzle/2 - destElements = getAll( clone ); - srcElements = getAll( elem ); - - // Fix all IE cloning issues - for ( i = 0; (node = srcElements[i]) != null; ++i ) { - // Ensure that the destination node is not null; Fixes #9587 - if ( destElements[i] ) { - fixCloneNodeIssues( node, destElements[i] ); - } - } - } - - // Copy the events from the original to the clone - if ( dataAndEvents ) { - if ( deepDataAndEvents ) { - srcElements = srcElements || getAll( elem ); - destElements = destElements || getAll( clone ); - - for ( i = 0; (node = srcElements[i]) != null; i++ ) { - cloneCopyEvent( node, destElements[i] ); - } - } else { - cloneCopyEvent( elem, clone ); - } - } - - // Preserve script evaluation history - destElements = getAll( clone, "script" ); - if ( destElements.length > 0 ) { - setGlobalEval( destElements, !inPage && getAll( elem, "script" ) ); - } - - destElements = srcElements = node = null; - - // Return the cloned set - return clone; - }, - - buildFragment: function( elems, context, scripts, selection ) { - var j, elem, contains, - tmp, tag, tbody, wrap, - l = elems.length, - - // Ensure a safe fragment - safe = createSafeFragment( context ), - - nodes = [], - i = 0; - - for ( ; i < l; i++ ) { - elem = elems[ i ]; - - if ( elem || elem === 0 ) { - - // Add nodes directly - if ( jQuery.type( elem ) === "object" ) { - jQuery.merge( nodes, elem.nodeType ? [ elem ] : elem ); - - // Convert non-html into a text node - } else if ( !rhtml.test( elem ) ) { - nodes.push( context.createTextNode( elem ) ); - - // Convert html into DOM nodes - } else { - tmp = tmp || safe.appendChild( context.createElement("div") ); - - // Deserialize a standard representation - tag = (rtagName.exec( elem ) || [ "", "" ])[ 1 ].toLowerCase(); - wrap = wrapMap[ tag ] || wrapMap._default; - - tmp.innerHTML = wrap[1] + elem.replace( rxhtmlTag, "<$1>" ) + wrap[2]; - - // Descend through wrappers to the right content - j = wrap[0]; - while ( j-- ) { - tmp = tmp.lastChild; - } - - // Manually add leading whitespace removed by IE - if ( !support.leadingWhitespace && rleadingWhitespace.test( elem ) ) { - nodes.push( context.createTextNode( rleadingWhitespace.exec( elem )[0] ) ); - } - - // Remove IE's autoinserted from table fragments - if ( !support.tbody ) { - - // String was a , *may* have spurious - elem = tag === "table" && !rtbody.test( elem ) ? - tmp.firstChild : - - // String was a bare or - wrap[1] === "
" && !rtbody.test( elem ) ? - tmp : - 0; - - j = elem && elem.childNodes.length; - while ( j-- ) { - if ( jQuery.nodeName( (tbody = elem.childNodes[j]), "tbody" ) && !tbody.childNodes.length ) { - elem.removeChild( tbody ); - } - } - } - - jQuery.merge( nodes, tmp.childNodes ); - - // Fix #12392 for WebKit and IE > 9 - tmp.textContent = ""; - - // Fix #12392 for oldIE - while ( tmp.firstChild ) { - tmp.removeChild( tmp.firstChild ); - } - - // Remember the top-level container for proper cleanup - tmp = safe.lastChild; - } - } - } - - // Fix #11356: Clear elements from fragment - if ( tmp ) { - safe.removeChild( tmp ); - } - - // Reset defaultChecked for any radios and checkboxes - // about to be appended to the DOM in IE 6/7 (#8060) - if ( !support.appendChecked ) { - jQuery.grep( getAll( nodes, "input" ), fixDefaultChecked ); - } - - i = 0; - while ( (elem = nodes[ i++ ]) ) { - - // #4087 - If origin and destination elements are the same, and this is - // that element, do not do anything - if ( selection && jQuery.inArray( elem, selection ) !== -1 ) { - continue; - } - - contains = jQuery.contains( elem.ownerDocument, elem ); - - // Append to fragment - tmp = getAll( safe.appendChild( elem ), "script" ); - - // Preserve script evaluation history - if ( contains ) { - setGlobalEval( tmp ); - } - - // Capture executables - if ( scripts ) { - j = 0; - while ( (elem = tmp[ j++ ]) ) { - if ( rscriptType.test( elem.type || "" ) ) { - scripts.push( elem ); - } - } - } - } - - tmp = null; - - return safe; - }, - - cleanData: function( elems, /* internal */ acceptData ) { - var elem, type, id, data, - i = 0, - internalKey = jQuery.expando, - cache = jQuery.cache, - deleteExpando = support.deleteExpando, - special = jQuery.event.special; - - for ( ; (elem = elems[i]) != null; i++ ) { - if ( acceptData || jQuery.acceptData( elem ) ) { - - id = elem[ internalKey ]; - data = id && cache[ id ]; - - if ( data ) { - if ( data.events ) { - for ( type in data.events ) { - if ( special[ type ] ) { - jQuery.event.remove( elem, type ); - - // This is a shortcut to avoid jQuery.event.remove's overhead - } else { - jQuery.removeEvent( elem, type, data.handle ); - } - } - } - - // Remove cache only if it was not already removed by jQuery.event.remove - if ( cache[ id ] ) { - - delete cache[ id ]; - - // IE does not allow us to delete expando properties from nodes, - // nor does it have a removeAttribute function on Document nodes; - // we must handle all of these cases - if ( deleteExpando ) { - delete elem[ internalKey ]; - - } else if ( typeof elem.removeAttribute !== strundefined ) { - elem.removeAttribute( internalKey ); - - } else { - elem[ internalKey ] = null; - } - - deletedIds.push( id ); - } - } - } - } - } -}); - -jQuery.fn.extend({ - text: function( value ) { - return access( this, function( value ) { - return value === undefined ? - jQuery.text( this ) : - this.empty().append( ( this[0] && this[0].ownerDocument || document ).createTextNode( value ) ); - }, null, value, arguments.length ); - }, - - append: function() { - return this.domManip( arguments, function( elem ) { - if ( this.nodeType === 1 || this.nodeType === 11 || this.nodeType === 9 ) { - var target = manipulationTarget( this, elem ); - target.appendChild( elem ); - } - }); - }, - - prepend: function() { - return this.domManip( arguments, function( elem ) { - if ( this.nodeType === 1 || this.nodeType === 11 || this.nodeType === 9 ) { - var target = manipulationTarget( this, elem ); - target.insertBefore( elem, target.firstChild ); - } - }); - }, - - before: function() { - return this.domManip( arguments, function( elem ) { - if ( this.parentNode ) { - this.parentNode.insertBefore( elem, this ); - } - }); - }, - - after: function() { - return this.domManip( arguments, function( elem ) { - if ( this.parentNode ) { - this.parentNode.insertBefore( elem, this.nextSibling ); - } - }); - }, - - remove: function( selector, keepData /* Internal Use Only */ ) { - var elem, - elems = selector ? jQuery.filter( selector, this ) : this, - i = 0; - - for ( ; (elem = elems[i]) != null; i++ ) { - - if ( !keepData && elem.nodeType === 1 ) { - jQuery.cleanData( getAll( elem ) ); - } - - if ( elem.parentNode ) { - if ( keepData && jQuery.contains( elem.ownerDocument, elem ) ) { - setGlobalEval( getAll( elem, "script" ) ); - } - elem.parentNode.removeChild( elem ); - } - } - - return this; - }, - - empty: function() { - var elem, - i = 0; - - for ( ; (elem = this[i]) != null; i++ ) { - // Remove element nodes and prevent memory leaks - if ( elem.nodeType === 1 ) { - jQuery.cleanData( getAll( elem, false ) ); - } - - // Remove any remaining nodes - while ( elem.firstChild ) { - elem.removeChild( elem.firstChild ); - } - - // If this is a select, ensure that it displays empty (#12336) - // Support: IE<9 - if ( elem.options && jQuery.nodeName( elem, "select" ) ) { - elem.options.length = 0; - } - } - - return this; - }, - - clone: function( dataAndEvents, deepDataAndEvents ) { - dataAndEvents = dataAndEvents == null ? false : dataAndEvents; - deepDataAndEvents = deepDataAndEvents == null ? dataAndEvents : deepDataAndEvents; - - return this.map(function() { - return jQuery.clone( this, dataAndEvents, deepDataAndEvents ); - }); - }, - - html: function( value ) { - return access( this, function( value ) { - var elem = this[ 0 ] || {}, - i = 0, - l = this.length; - - if ( value === undefined ) { - return elem.nodeType === 1 ? - elem.innerHTML.replace( rinlinejQuery, "" ) : - undefined; - } - - // See if we can take a shortcut and just use innerHTML - if ( typeof value === "string" && !rnoInnerhtml.test( value ) && - ( support.htmlSerialize || !rnoshimcache.test( value ) ) && - ( support.leadingWhitespace || !rleadingWhitespace.test( value ) ) && - !wrapMap[ (rtagName.exec( value ) || [ "", "" ])[ 1 ].toLowerCase() ] ) { - - value = value.replace( rxhtmlTag, "<$1>" ); - - try { - for (; i < l; i++ ) { - // Remove element nodes and prevent memory leaks - elem = this[i] || {}; - if ( elem.nodeType === 1 ) { - jQuery.cleanData( getAll( elem, false ) ); - elem.innerHTML = value; - } - } - - elem = 0; - - // If using innerHTML throws an exception, use the fallback method - } catch(e) {} - } - - if ( elem ) { - this.empty().append( value ); - } - }, null, value, arguments.length ); - }, - - replaceWith: function() { - var arg = arguments[ 0 ]; - - // Make the changes, replacing each context element with the new content - this.domManip( arguments, function( elem ) { - arg = this.parentNode; - - jQuery.cleanData( getAll( this ) ); - - if ( arg ) { - arg.replaceChild( elem, this ); - } - }); - - // Force removal if there was no new content (e.g., from empty arguments) - return arg && (arg.length || arg.nodeType) ? this : this.remove(); - }, - - detach: function( selector ) { - return this.remove( selector, true ); - }, - - domManip: function( args, callback ) { - - // Flatten any nested arrays - args = concat.apply( [], args ); - - var first, node, hasScripts, - scripts, doc, fragment, - i = 0, - l = this.length, - set = this, - iNoClone = l - 1, - value = args[0], - isFunction = jQuery.isFunction( value ); - - // We can't cloneNode fragments that contain checked, in WebKit - if ( isFunction || - ( l > 1 && typeof value === "string" && - !support.checkClone && rchecked.test( value ) ) ) { - return this.each(function( index ) { - var self = set.eq( index ); - if ( isFunction ) { - args[0] = value.call( this, index, self.html() ); - } - self.domManip( args, callback ); - }); - } - - if ( l ) { - fragment = jQuery.buildFragment( args, this[ 0 ].ownerDocument, false, this ); - first = fragment.firstChild; - - if ( fragment.childNodes.length === 1 ) { - fragment = first; - } - - if ( first ) { - scripts = jQuery.map( getAll( fragment, "script" ), disableScript ); - hasScripts = scripts.length; - - // Use the original fragment for the last item instead of the first because it can end up - // being emptied incorrectly in certain situations (#8070). - for ( ; i < l; i++ ) { - node = fragment; - - if ( i !== iNoClone ) { - node = jQuery.clone( node, true, true ); - - // Keep references to cloned scripts for later restoration - if ( hasScripts ) { - jQuery.merge( scripts, getAll( node, "script" ) ); - } - } - - callback.call( this[i], node, i ); - } - - if ( hasScripts ) { - doc = scripts[ scripts.length - 1 ].ownerDocument; - - // Reenable scripts - jQuery.map( scripts, restoreScript ); - - // Evaluate executable scripts on first document insertion - for ( i = 0; i < hasScripts; i++ ) { - node = scripts[ i ]; - if ( rscriptType.test( node.type || "" ) && - !jQuery._data( node, "globalEval" ) && jQuery.contains( doc, node ) ) { - - if ( node.src ) { - // Optional AJAX dependency, but won't run scripts if not present - if ( jQuery._evalUrl ) { - jQuery._evalUrl( node.src ); - } - } else { - jQuery.globalEval( ( node.text || node.textContent || node.innerHTML || "" ).replace( rcleanScript, "" ) ); - } - } - } - } - - // Fix #11809: Avoid leaking memory - fragment = first = null; - } - } - - return this; - } -}); - -jQuery.each({ - appendTo: "append", - prependTo: "prepend", - insertBefore: "before", - insertAfter: "after", - replaceAll: "replaceWith" -}, function( name, original ) { - jQuery.fn[ name ] = function( selector ) { - var elems, - i = 0, - ret = [], - insert = jQuery( selector ), - last = insert.length - 1; - - for ( ; i <= last; i++ ) { - elems = i === last ? this : this.clone(true); - jQuery( insert[i] )[ original ]( elems ); - - // Modern browsers can apply jQuery collections as arrays, but oldIE needs a .get() - push.apply( ret, elems.get() ); - } - - return this.pushStack( ret ); - }; -}); - - -var iframe, - elemdisplay = {}; - -/** - * Retrieve the actual display of a element - * @param {String} name nodeName of the element - * @param {Object} doc Document object - */ -// Called only from within defaultDisplay -function actualDisplay( name, doc ) { - var elem = jQuery( doc.createElement( name ) ).appendTo( doc.body ), - - // getDefaultComputedStyle might be reliably used only on attached element - display = window.getDefaultComputedStyle ? - - // Use of this method is a temporary fix (more like optmization) until something better comes along, - // since it was removed from specification and supported only in FF - window.getDefaultComputedStyle( elem[ 0 ] ).display : jQuery.css( elem[ 0 ], "display" ); - - // We don't have any data stored on the element, - // so use "detach" method as fast way to get rid of the element - elem.detach(); - - return display; -} - -/** - * Try to determine the default display value of an element - * @param {String} nodeName - */ -function defaultDisplay( nodeName ) { - var doc = document, - display = elemdisplay[ nodeName ]; - - if ( !display ) { - display = actualDisplay( nodeName, doc ); - - // If the simple way fails, read from inside an iframe - if ( display === "none" || !display ) { - - // Use the already-created iframe if possible - iframe = (iframe || jQuery( "