diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,115 +1,2 @@ -{-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns #-} - -#ifndef MIN_VERSION_Cabal -#define MIN_VERSION_Cabal(x,y,z) 0 -#endif - -#if MIN_VERSION_Cabal(2,0,0) - --- https://github.com/haskell/cabal/pull/4501 is upstream in 2.0, yey import Distribution.Simple main = defaultMain - -#else - -import Distribution.Simple -import Distribution.Simple.Utils -import Distribution.Simple.Setup -import Distribution.Simple.Install -import Distribution.Simple.Register -import Distribution.Simple.BuildPaths -import qualified Distribution.Simple.InstallDirs as ID -import Distribution.Simple.LocalBuildInfo -import Distribution.Simple.Program -import Distribution.PackageDescription - -import Control.Applicative -- for GHC<7.10 -import Control.Monad -import Data.List -import Data.Maybe -import System.FilePath -import System.Directory (renameFile) - -main :: IO () -main = defaultMainWithHooks $ simpleUserHooks { - instHook = inst, - copyHook = copy, - buildHook = \pd lbi hooks flags -> (buildHook simpleUserHooks) pd (patchLibexecdir lbi) hooks flags, - hookedPrograms = [ simpleProgram "cabal" ] - } - -patchLibexecdir :: LocalBuildInfo -> LocalBuildInfo -patchLibexecdir lbi = let - idirtpl = installDirTemplates lbi - libexecdir' = toPathTemplate $ fromPathTemplate (libexecdir idirtpl) "$abi/$pkgid" - lbi' = lbi { installDirTemplates = idirtpl { libexecdir = libexecdir' } } - in - lbi' - --- mostly copypasta from 'defaultInstallHook' -inst :: - PackageDescription -> LocalBuildInfo -> UserHooks -> InstallFlags -> IO () -inst pd lbi _uf ifl = do - let copyFlags = defaultCopyFlags { - copyDistPref = installDistPref ifl, - copyDest = toFlag NoCopyDest, - copyVerbosity = installVerbosity ifl - } - xInstallTarget pd lbi copyFlags (\pd' lbi' -> install pd' lbi' copyFlags) - let registerFlags = defaultRegisterFlags { - regDistPref = installDistPref ifl, - regInPlace = installInPlace ifl, - regPackageDB = installPackageDB ifl, - regVerbosity = installVerbosity ifl - } - when (hasLibs pd) $ register pd lbi registerFlags - -copy :: PackageDescription -> LocalBuildInfo -> UserHooks -> CopyFlags -> IO () -copy pd lbi _uh cf = - xInstallTarget pd lbi cf (\pd' lbi' -> install pd' lbi' cf) - -xInstallTarget :: PackageDescription - -> LocalBuildInfo - -> CopyFlags - -> (PackageDescription -> LocalBuildInfo -> IO ()) - -> IO () -xInstallTarget pd lbi cf fn = do - let (extended, regular) = partition isExeScopePrivate (executables pd) - - let pd_regular = pd { executables = regular } - - _ <- flip mapM extended $ \exe -> do - - let pd_extended = onlyExePackageDesc [exe] pd - - fn pd_extended lbi - - let lbi' = patchLibexecdir lbi - copydest = fromFlag (copyDest cf) - verbosity = fromFlag (copyVerbosity cf) - InstallDirs { bindir, libexecdir } = absoluteInstallDirs pd lbi' copydest - progprefix = substPathTemplate (packageId pd) lbi (progPrefix lbi) - progsuffix = substPathTemplate (packageId pd) lbi (progSuffix lbi) - fixedExeBaseName = progprefix ++ exeName exe ++ progsuffix - - fixedExeFileName = bindir fixedExeBaseName <.> exeExtension - newExeFileName = libexecdir fixedExeBaseName <.> exeExtension - - createDirectoryIfMissingVerbose verbosity True libexecdir - renameFile fixedExeFileName newExeFileName - - fn pd_regular lbi - -isExeScopePrivate :: Executable -> Bool -isExeScopePrivate exe = - fromMaybe False $ (=="private") <$> lookup "x-scope" fields - where - fields = customFieldsBI $ buildInfo exe - -onlyExePackageDesc :: [Executable] -> PackageDescription -> PackageDescription -onlyExePackageDesc exes pd = emptyPackageDescription { - package = package pd - , executables = exes - } - -#endif diff --git a/cabal-helper.cabal b/cabal-helper.cabal --- a/cabal-helper.cabal +++ b/cabal-helper.cabal @@ -1,5 +1,5 @@ name: cabal-helper -version: 0.8.0.2 +version: 0.8.1.0 synopsis: Simple interface to some of Cabal's configuration state, mainly used by ghc-mod description: @@ -30,8 +30,8 @@ author: Daniel Gröber maintainer: dxld@darkboxed.org category: Distribution -build-type: Custom -cabal-version: >=1.14 +build-type: Simple +cabal-version: 2.0 extra-source-files: README.md src/CabalHelper/Runtime/*.hs @@ -62,12 +62,6 @@ type: git location: https://github.com/DanielG/cabal-helper.git -custom-setup - setup-depends: base - , Cabal < 2.1 && >= 2.0 || < 1.25 && >= 1.14 - , filepath < 1.5 - , directory < 1.4 - flag dev description: Build development components default: False @@ -86,6 +80,8 @@ -- -- Instantiate common some-name -- -- $ gawk -i inplace -f scripts/update-cabal-common-section-instantiations.awk cabal-helper.cabal +-- +-- FIXME: We can use Cabal 2.0 features now, yey! library default-language: Haskell2010 @@ -96,25 +92,24 @@ CabalHelper.Shared.InterfaceTypes CabalHelper.Shared.Sandbox Paths_cabal_helper + autogen-modules: Paths_cabal_helper + ghc-options: -Wall - build-depends: base < 5 && >= 4.5 - if os(windows) - build-depends: base >= 4.7 - build-depends: Cabal < 2.1 && >= 2.0 || < 1.26 && >= 1.14 - , directory < 1.4 && >= 1.1.0.2 - , filepath < 1.5 && >= 1.3.0.0 - , transformers < 0.6 && >= 0.3.0.0 - , mtl < 2.3 && >= 2.0 - , process < 1.7 && >= 1.1.0.1 + build-depends: base < 5 && >= 4.7 + build-depends: Cabal < 2.3 && >= 2.0 || < 1.26 && >= 1.14 + , cabal-plan < 0.4 && >= 0.3.0.0 + , containers < 1 && >= 0.5.5.1 + , directory < 1.4 && >= 1.2.1.0 + , filepath < 1.5 && >= 1.3.0.0 + , transformers < 0.6 && >= 0.3.0.0 + , mtl < 2.3 && >= 2.0 + , process < 1.7 && >= 1.1.0.1 if !os(windows) - build-depends: unix < 2.8 && >= 2.5.1.1 - build-depends: unix-compat < 0.6 && >= 0.4.3.1 - , semigroupoids < 5.3 && >= 5.2 - , ghc-prim + build-depends: unix < 2.8 && >= 2.5.1.1 + build-depends: unix-compat < 0.6 && >= 0.4.3.1 + , semigroupoids < 5.3 && >= 5.2 --- [Note ghc-prim] --- Exports GHC.Generics in GHC-7.4 executable cabal-helper-wrapper @@ -122,7 +117,6 @@ if flag(dev) ghc-options: -Wall scope: private - x-scope: private -- Common c-h-wrapper-fields -- See [Note test dependencies] default-language: Haskell2010 @@ -142,24 +136,22 @@ CabalHelper.Shared.Sandbox Paths_cabal_helper build-tool-depends: cabal-install:cabal - build-depends: base < 5 && >= 4.5 + build-depends: base < 5 && >= 4.7 if os(windows) build-depends: base >= 4.7 - build-depends: Cabal < 2.1 && >= 2.0 || < 1.26 && >= 1.14 + build-depends: Cabal < 2.3 && >= 2.0 || < 1.26 && >= 1.14 , bytestring < 0.11 && >= 0.9.2.1 - , directory < 1.4 && >= 1.1.0.2 - , exceptions < 0.9 && >= 0.8.3 + , directory < 1.4 && >= 1.2.1.0 , filepath < 1.5 && >= 1.3.0.0 , mtl < 2.3 && >= 2.0 , process < 1.7 && >= 1.1.0.1 - , template-haskell < 2.13 && >= 2.7.0.0 - , temporary < 1.3 && >= 1.2.0.4 + , template-haskell < 2.14 && >= 2.7.0.0 + , temporary < 1.3 && >= 1.2.1 , transformers < 0.6 && >= 0.3.0.0 if !os(windows) build-depends: unix < 2.8 && >= 2.5.1.1 build-depends: unix-compat < 0.6 && >= 0.4.3.1 , utf8-string < 1.1 && >= 1.0.1.1 - , ghc-prim build-tools: cabal @@ -188,24 +180,22 @@ CabalHelper.Shared.Sandbox Paths_cabal_helper build-tool-depends: cabal-install:cabal - build-depends: base < 5 && >= 4.5 + build-depends: base < 5 && >= 4.7 if os(windows) build-depends: base >= 4.7 - build-depends: Cabal < 2.1 && >= 2.0 || < 1.26 && >= 1.14 + build-depends: Cabal < 2.3 && >= 2.0 || < 1.26 && >= 1.14 , bytestring < 0.11 && >= 0.9.2.1 - , directory < 1.4 && >= 1.1.0.2 - , exceptions < 0.9 && >= 0.8.3 + , directory < 1.4 && >= 1.2.1.0 , filepath < 1.5 && >= 1.3.0.0 , mtl < 2.3 && >= 2.0 , process < 1.7 && >= 1.1.0.1 - , template-haskell < 2.13 && >= 2.7.0.0 - , temporary < 1.3 && >= 1.2.0.4 + , template-haskell < 2.14 && >= 2.7.0.0 + , temporary < 1.3 && >= 1.2.1 , transformers < 0.6 && >= 0.3.0.0 if !os(windows) build-depends: unix < 2.8 && >= 2.5.1.1 build-depends: unix-compat < 0.6 && >= 0.4.3.1 , utf8-string < 1.1 && >= 1.0.1.1 - , ghc-prim build-tools: cabal @@ -214,8 +204,8 @@ main-is: GhcSession.hs hs-source-dirs: tests ghc-options: -Wall - build-depends: base < 5 && >= 4.5 - , ghc < 8.3 && >= 7.4 + build-depends: base < 5 && >= 4.7 + , ghc < 8.5 && >= 7.8 , ghc-paths < 0.2 && >= 0.1.0.9 , cabal-helper @@ -237,24 +227,22 @@ CabalHelper.Shared.Sandbox Paths_cabal_helper build-tool-depends: cabal-install:cabal - build-depends: base < 5 && >= 4.5 + build-depends: base < 5 && >= 4.7 if os(windows) build-depends: base >= 4.7 - build-depends: Cabal < 2.1 && >= 2.0 || < 1.26 && >= 1.14 + build-depends: Cabal < 2.3 && >= 2.0 || < 1.26 && >= 1.14 , bytestring < 0.11 && >= 0.9.2.1 - , directory < 1.4 && >= 1.1.0.2 - , exceptions < 0.9 && >= 0.8.3 + , directory < 1.4 && >= 1.2.1.0 , filepath < 1.5 && >= 1.3.0.0 , mtl < 2.3 && >= 2.0 , process < 1.7 && >= 1.1.0.1 - , template-haskell < 2.13 && >= 2.7.0.0 - , temporary < 1.3 && >= 1.2.0.4 + , template-haskell < 2.14 && >= 2.7.0.0 + , temporary < 1.3 && >= 1.2.1 , transformers < 0.6 && >= 0.3.0.0 if !os(windows) build-depends: unix < 2.8 && >= 2.5.1.1 build-depends: unix-compat < 0.6 && >= 0.4.3.1 , utf8-string < 1.1 && >= 1.0.1.1 - , ghc-prim build-tools: cabal @@ -268,17 +256,16 @@ CabalHelper.Shared.InterfaceTypes CabalHelper.Shared.Sandbox - -- GHC 7.4 ships Cabal-1.14 which we can't compile with and since cabal can't - -- solve the component dependencies seperately in our case (because of too-old - -- cabal-install and build-type:custom) we can't build this on GHC 7.4 - if flag(dev) && impl(ghc >= 7.6) + -- This component is usually built at runtime by cabal-helper-wrapper but + -- during development it's convinient to build it via cabal + if flag(dev) buildable: True else buildable: False -- Common c-h-main-fields -- See [Note test dependencies] ghc-options: -Wall -fno-warn-unused-imports - build-depends: base < 5 && >= 4.5 + build-depends: base < 5 && >= 4.7 , Cabal , containers , bytestring diff --git a/lib/Distribution/Helper.hs b/lib/Distribution/Helper.hs --- a/lib/Distribution/Helper.hs +++ b/lib/Distribution/Helper.hs @@ -15,7 +15,8 @@ -- along with this program. If not, see . {-# LANGUAGE CPP, RecordWildCards, FlexibleContexts, ConstraintKinds, - GeneralizedNewtypeDeriving, DeriveDataTypeable, DeriveGeneric, DeriveFunctor + GeneralizedNewtypeDeriving, DeriveDataTypeable, DeriveGeneric, DeriveFunctor, + NamedFieldPuns, OverloadedStrings #-} {-| @@ -97,6 +98,7 @@ , module Data.Functor.Apply ) where +import Cabal.Plan import Control.Applicative import Control.Monad import Control.Monad.IO.Class @@ -106,8 +108,10 @@ import Data.Char import Data.List import Data.Maybe +import qualified Data.Map as Map import Data.Version import Data.Typeable +import Data.Function import Data.Functor.Apply import Distribution.Simple.BuildPaths (exeExtension) import System.Environment @@ -436,7 +440,7 @@ -- | Get the path to the sandbox package-db in a project getSandboxPkgDb :: (FilePath -> [String] -> String -> IO String) - -> FilePath + -> String -- ^ Cabal build platform, i.e. @buildPlatform@ -> Version -- ^ GHC version (@cProjectVersion@ is your friend) @@ -471,25 +475,76 @@ if exists then return exe else do - mdir <- tryFindCabalHelperTreeLibexecDir - case mdir of + mdir <- tryFindCabalHelperTreeDistDir + dir <- case mdir of Nothing -> - error $ throw $ LibexecNotFoundError exeName libexecdir + throwIO $ LibexecNotFoundError exeName libexecdir Just dir -> - return $ dir "dist" "build" exeName exeName + return dir -tryFindCabalHelperTreeLibexecDir :: IO (Maybe FilePath) -tryFindCabalHelperTreeLibexecDir = do - exe <- getExecutablePath' - dir <- case takeFileName exe of - "ghc" -> do -- we're probably in ghci; try CWD - getCurrentDirectory - _ -> - return $ (!!4) $ iterate takeDirectory exe - exists <- doesFileExist $ dir "cabal-helper.cabal" - return $ if exists - then Just dir - else Nothing + return $ dir "build" exeName exeName + +findPlanJson :: FilePath -> IO (Maybe FilePath) +findPlanJson base = + findFile (map ( "cache") $ parents base) "plan.json" + +parents :: FilePath -> [FilePath] +parents path = takeWhile (not . (`elem` ["", "."]) . dropDrive) dirs + where dirs = iterate takeDirectory path + +data DistDir = DistDir { ddType :: DistDirType, unDistDir :: FilePath } + deriving (Eq, Ord, Read, Show) +data DistDirType = NewBuildDist | OldBuildDist + deriving (Eq, Ord, Read, Show) + +tryFindCabalHelperTreeDistDir :: IO (Maybe FilePath) +tryFindCabalHelperTreeDistDir = do + exe <- canonicalizePath =<< getExecutablePath' + mplan <- findPlanJson exe + cwd <- getCurrentDirectory + + let candidates = sortBy (compare `on` ddType) $ concat + [ maybeToList $ DistDir NewBuildDist <$> mplan + , [ DistDir OldBuildDist $ (!!3) $ iterate takeDirectory exe ] + , if takeFileName exe == "ghc" -- we're probably in ghci; try CWD + then [ DistDir NewBuildDist $ cwd "dist-newstyle" + , DistDir NewBuildDist $ cwd "dist" + , DistDir OldBuildDist $ cwd "dist" + ] + else [] + ] + + distdirs + <- filterM isDistDir candidates + >>= mapM toOldBuildDistDir + + return $ fmap unDistDir $ join $ listToMaybe $ distdirs + +isCabalHelperSourceDir :: FilePath -> IO Bool +isCabalHelperSourceDir dir = + doesFileExist $ dir "cabal-helper.cabal" + +isDistDir :: DistDir -> IO Bool +isDistDir (DistDir NewBuildDist dir) = + doesFileExist (dir "cache" "plan.json") +isDistDir (DistDir OldBuildDist dir) = + doesFileExist (dir "setup-config") + +toOldBuildDistDir :: DistDir -> IO (Maybe DistDir) +toOldBuildDistDir (DistDir NewBuildDist dir) = do + PlanJson {pjUnits} <- decodePlanJson $ dir "cache" "plan.json" + let munit = find isCabalHelperUnit $ Map.elems pjUnits + return $ DistDir OldBuildDist <$> join ((\Unit { uDistDir = mdistdir } -> mdistdir) <$> munit) + where + isCabalHelperUnit + Unit { uPId = PkgId (PkgName n) _ + , uType = UnitTypeLocal + } | n == "cabal-helper" = True + isCabalHelperUnit _ = False +toOldBuildDistDir x = return $ Just x + + + libexecNotFoundError :: String -- ^ Name of the executable we were trying to -- find diff --git a/src/CabalHelper/Compiletime/Compile.hs b/src/CabalHelper/Compiletime/Compile.hs --- a/src/CabalHelper/Compiletime/Compile.hs +++ b/src/CabalHelper/Compiletime/Compile.hs @@ -36,10 +36,12 @@ import Data.Version import GHC.IO.Exception (IOErrorType(OtherError)) import Text.Printf +import Text.Read import System.Directory import System.FilePath import System.Process import System.Exit +import System.Environment import System.IO import System.IO.Error import System.IO.Temp @@ -452,15 +454,20 @@ SetupProgram {..} <- compileSetupHs opts db srcdir go $ callProcessStderr opts (Just srcdir) setupProgram where - parmake_opt - | Right ver <- ever, ver >= Version [1,20] [] = ["-j"] + parmake_opt :: Maybe Int -> [String] + parmake_opt nproc' + | Left _ <- ever = ["-j"++nproc] + | Right ver <- ever, ver >= Version [1,20] [] = ["-j"++nproc] | otherwise = [] + where + nproc = fromMaybe "" $ show <$> nproc' go :: ([String] -> IO ()) -> IO () go run = do run $ [ "configure", "--package-db", db, "--prefix", db "prefix" ] ++ withGHCProgramOptions opts - run $ [ "build" ] ++ parmake_opt + mnproc <- join . fmap readMaybe <$> lookupEnv "NPROC" + run $ [ "build" ] ++ parmake_opt mnproc run [ "copy" ] run [ "register" ] diff --git a/src/CabalHelper/Compiletime/Wrapper.hs b/src/CabalHelper/Compiletime/Wrapper.hs --- a/src/CabalHelper/Compiletime/Wrapper.hs +++ b/src/CabalHelper/Compiletime/Wrapper.hs @@ -35,7 +35,6 @@ import Distribution.System (buildPlatform) import Distribution.Text (display) import Distribution.Verbosity (silent, deafening) -import Distribution.PackageDescription.Parse (readPackageDescription) import Distribution.Package (packageName, packageVersion) import Paths_cabal_helper (version) diff --git a/src/CabalHelper/Runtime/Main.hs b/src/CabalHelper/Runtime/Main.hs --- a/src/CabalHelper/Runtime/Main.hs +++ b/src/CabalHelper/Runtime/Main.hs @@ -44,9 +44,6 @@ , BenchmarkInterface(..) , withLib ) -import Distribution.PackageDescription.Parse - ( readPackageDescription - ) import Distribution.PackageDescription.Configuration ( flattenPackageDescription ) @@ -195,6 +192,12 @@ import qualified Distribution.InstalledPackageInfo as Installed #endif +#if CH_MIN_VERSION_Cabal(2,2,0) +import Distribution.Types.GenericPackageDescription + ( unFlagAssignment + ) +#endif + import Control.Applicative ((<$>)) import Control.Arrow (first, second, (&&&)) import Control.Monad @@ -314,11 +317,23 @@ "config-flags":[] -> do return $ Just $ ChResponseFlags $ sort $ - map (first unFlagName) $ configConfigurationsFlags $ configFlags lbi + map (first unFlagName) +#if CH_MIN_VERSION_Cabal(2,2,0) + $ unFlagAssignment $ configConfigurationsFlags +#else + $ configConfigurationsFlags +#endif + $ configFlags lbi "non-default-config-flags":[] -> do let flagDefinitons = genPackageFlags gpd - flagAssgnments = configConfigurationsFlags $ configFlags lbi + flagAssgnments = +#if CH_MIN_VERSION_Cabal(2,2,0) + unFlagAssignment $ configConfigurationsFlags +#else + configConfigurationsFlags +#endif + $ configFlags lbi nonDefaultFlags = [ (flag_name, val) | MkFlag {flagName=(unFlagName -> flag_name'), flagDefault=def_val} <- flagDefinitons @@ -499,11 +514,7 @@ componentsMap lbi v distdir $ \c clbi bi -> let -#if CH_MIN_VERSION_Cabal(2,0,0) - outdir = componentBuildDir lbi clbi -#else outdir = componentOutDir lbi c -#endif (clbi', adopts) = case flags of _ | not inplaceFlag -> (clbi, mempty) ["--with-inplace"] -> (clbi, mempty) diff --git a/src/CabalHelper/Shared/Common.hs b/src/CabalHelper/Shared/Common.hs --- a/src/CabalHelper/Shared/Common.hs +++ b/src/CabalHelper/Shared/Common.hs @@ -19,9 +19,14 @@ License : AGPL-3 -} -{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-} +{-# LANGUAGE CPP, DeriveDataTypeable, OverloadedStrings #-} module CabalHelper.Shared.Common where +#ifdef MIN_VERSION_Cabal +#undef CH_MIN_VERSION_Cabal +#define CH_MIN_VERSION_Cabal MIN_VERSION_Cabal +#endif + import Control.Applicative import Control.Exception as E import Control.Monad @@ -33,6 +38,11 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS8 +#if CH_MIN_VERSION_Cabal(2,2,0) +import qualified Distribution.PackageDescription.Parsec as P +#else +import qualified Distribution.PackageDescription.Parse as P +#endif import System.Environment import System.IO import qualified System.Info @@ -130,3 +140,10 @@ reverse acc ++ r ++ drop (length n) h go acc (h:hs) = go (h:acc) hs go acc [] = reverse acc + + +#if CH_MIN_VERSION_Cabal(2,2,0) +readPackageDescription = P.readGenericPackageDescription +#else +readPackageDescription = P.readPackageDescription +#endif diff --git a/tests/CompileTest.hs b/tests/CompileTest.hs --- a/tests/CompileTest.hs +++ b/tests/CompileTest.hs @@ -30,11 +30,9 @@ (a,""):[] -> a _ -> error $ "Error parsing: " ++ show i -withinRange'CH :: Either HEAD Version -> VersionRange -> Bool +withinRange'CH :: Version -> VersionRange -> Bool withinRange'CH v r = - withinRange (fromDataVersion v') r - where - v' = either (const $ parseVer "1000000000") id v + withinRange (fromDataVersion v) r setupHOME :: IO () setupHOME = do @@ -47,7 +45,15 @@ main :: IO () main = do args <- getArgs + case args of + "list-versions":[] -> do + mapM_ print =<< (allCabalVersions <$> ghcVersion defaultOptions) + "list-versions":ghc_ver_str:[] -> + mapM_ print $ allCabalVersions (parseVer ghc_ver_str) + _ -> + test args +test args = do let action | null args = testAllCabalVersions | otherwise = testCabalVersions $ map parseVer' args @@ -62,73 +68,78 @@ parseVer' "HEAD" = Left HEAD parseVer' v = Right $ parseVer v -testAllCabalVersions :: IO () -testAllCabalVersions = do - let cabal_versions :: [Either HEAD Version] - cabal_versions = map parseVer' - -- "1.14.0" -- not supported at runtime - [ "1.16.0" - , "1.16.0.1" - , "1.16.0.2" - , "1.16.0.3" - , "1.18.0" - , "1.18.1" - , "1.18.1.1" - , "1.18.1.2" - , "1.18.1.3" - , "1.18.1.4" - , "1.18.1.5" - , "1.18.1.6" - , "1.18.1.7" - , "1.20.0.0" - , "1.20.0.1" - , "1.20.0.2" - , "1.20.0.3" - , "1.20.0.4" - , "1.22.0.0" - , "1.22.1.0" - , "1.22.1.1" - , "1.22.2.0" - , "1.22.3.0" - , "1.22.4.0" - , "1.22.5.0" - , "1.22.6.0" - , "1.22.7.0" - , "1.22.8.0" - , "1.24.0.0" - , "1.24.1.0" - , "1.24.2.0" - , "2.0.0.2" - , "2.0.1.0" - , "2.0.1.1" - , "HEAD" - ] +allCabalVersions :: Version -> [Version] +allCabalVersions ghc_ver = let + cabal_versions :: [Version] + cabal_versions = map parseVer + -- "1.14.0" -- not supported at runtime + [ "1.16.0" + , "1.16.0.1" + , "1.16.0.2" + , "1.16.0.3" + , "1.18.0" + , "1.18.1" + , "1.18.1.1" + , "1.18.1.2" + , "1.18.1.3" + , "1.18.1.4" + , "1.18.1.5" + , "1.18.1.6" + , "1.18.1.7" + , "1.20.0.0" + , "1.20.0.1" + , "1.20.0.2" + , "1.20.0.3" + , "1.20.0.4" + , "1.22.0.0" + , "1.22.1.0" + , "1.22.1.1" + , "1.22.2.0" + , "1.22.3.0" + , "1.22.4.0" + , "1.22.5.0" + , "1.22.6.0" + , "1.22.7.0" + , "1.22.8.0" + , "1.24.0.0" + , "1.24.1.0" + , "1.24.2.0" + , "2.0.0.2" + , "2.0.1.0" + , "2.0.1.1" + , "2.2.0.0" + , "2.2.0.1" + ] - ghc_ver <- ghcVersion defaultOptions + constraint :: VersionRange + constraint = + fromMaybe (snd $ last constraint_table) $ + fmap snd $ + find (and . (zipWith (==) `on` versionBranch) ghc_ver . fst) $ + constraint_table - let constraint :: VersionRange - constraint = - fromMaybe (snd $ last constraint_table) $ - fmap snd $ - find (and . (zipWith (==) `on` versionBranch) ghc_ver . fst) $ - constraint_table + constraint_table = + map (parseVer *** runReadP'Dist parse) $ + [ ("7.4" , ">= 1.14 && < 2") + , ("7.6" , ">= 1.16 && < 2") + , ("7.8" , ">= 1.18 && < 2") + , ("7.10" , ">= 1.22.2 && < 2") + , ("8.0.1", ">= 1.24 ") + , ("8.0.2", ">= 1.24.2 ") + , ("8.2.1", ">= 2.0.0.2 ") + , ("8.2.2", ">= 2.0.0.2 ") + , ("8.4.1", ">= 2.0.0.2 ") + , ("8.4.2", ">= 2.2.0.1 ") + ] + in + reverse $ filter (flip withinRange'CH constraint) cabal_versions - constraint_table = - map (parseVer *** runReadP'Dist parse) $ - [ ("7.4" , ">= 1.14 && < 2") - , ("7.6" , ">= 1.16 && < 2") - , ("7.8" , ">= 1.18 && < 2") - , ("7.10" , ">= 1.22.2 && < 2") - , ("8.0.1", ">= 1.24 ") - , ("8.0.2", ">= 1.24.2 ") - , ("8.2.1", ">= 2.0.0.2 ") - , ("8.2.2", ">= 2.0.0.2 ") - ] - relevant_cabal_versions = - reverse $ filter (flip withinRange'CH constraint) cabal_versions - - testCabalVersions relevant_cabal_versions +testAllCabalVersions :: IO () +testAllCabalVersions = do + ghc_ver <- ghcVersion defaultOptions + let relevant_cabal_versions = allCabalVersions ghc_ver + testCabalVersions $ map Right relevant_cabal_versions ++ [Left HEAD] testCabalVersions :: [Either HEAD Version] -> IO () testCabalVersions versions = do diff --git a/tests/GhcSession.hs b/tests/GhcSession.hs --- a/tests/GhcSession.hs +++ b/tests/GhcSession.hs @@ -1,10 +1,7 @@ -{-# LANGUAGE TupleSections, ScopedTypeVariables, CPP #-} +{-# LANGUAGE TupleSections, ScopedTypeVariables #-} module Main where import GHC -#if __GLASGOW_HASKELL__ <= 706 -import GhcMonad -#endif import GHC.Paths (libdir) import DynFlags @@ -19,7 +16,7 @@ import System.Directory import System.IO import System.IO.Temp -import System.Process (readProcess) +import System.Process (rawSystem, readProcess) import Distribution.Helper @@ -31,12 +28,13 @@ args <- getArgs topdir <- getCurrentDirectory res <- mapM (setup topdir test) $ case args of - [] -> [ ("tests/exelib" , parseVer "1.10") - , ("tests/exeintlib", parseVer "2.0") - , ("tests/fliblib" , parseVer "2.0") - , ("tests/bkpregex" , parseVer "2.0") + [] -> [ ("tests/exelib" , parseVer "1.10", parseVer "0") + , ("tests/exeintlib", parseVer "2.0", parseVer "0") + , ("tests/fliblib" , parseVer "2.0", parseVer "0") + , ("tests/bkpregex" , parseVer "2.0", parseVer "8.1") + -- min Cabal lib ver -^ min GHC ver -^ ] - xs -> map (,parseVer "0") xs + xs -> map (, parseVer "0", parseVer "0") xs if any (==False) $ concat res then exitFailure @@ -46,21 +44,29 @@ cabalInstallVersion = parseVer . trim <$> readProcess "cabal" ["--numeric-version"] "" +ghcVersion :: IO Version +ghcVersion = + parseVer . trim <$> readProcess "ghc" ["--numeric-version"] "" + cabalInstallBuiltinCabalVersion :: IO Version cabalInstallBuiltinCabalVersion = parseVer . trim <$> readProcess "cabal" ["act-as-setup", "--", "--numeric-version"] "" -setup :: FilePath -> (FilePath -> IO [Bool]) -> (FilePath, Version) -> IO [Bool] -setup topdir act (srcdir, min_cabal_ver) = do +setup :: FilePath -> (FilePath -> IO [Bool]) -> (FilePath, Version, Version) -> IO [Bool] +setup topdir act (srcdir, min_cabal_ver, min_ghc_ver) = do ci_ver <- cabalInstallVersion c_ver <- cabalInstallBuiltinCabalVersion + g_ver <- ghcVersion let mreason | (ci_ver < parseVer "1.24") = Just $ "cabal-install-" ++ showVersion ci_ver ++ " is too old" | c_ver < min_cabal_ver = Just $ "Cabal-" ++ showVersion c_ver ++ " < " ++ showVersion min_cabal_ver + | g_ver < min_ghc_ver = + Just $ "ghc-" ++ showVersion g_ver + ++ " < " ++ showVersion min_ghc_ver | otherwise = Nothing @@ -82,8 +88,7 @@ run :: String -> [String] -> IO () run x xs = do print $ x:xs - o <- readProcess x xs "" - putStrLn o + ExitSuccess <- rawSystem x xs return () test :: FilePath -> IO [Bool] @@ -116,11 +121,7 @@ E.handle (\(ec :: ExitCode) -> print ec >> return False) $ do -#if __GLASGOW_HASKELL__ <= 704 - defaultErrorHandler defaultLogAction $ do -#else defaultErrorHandler defaultFatalMessager defaultFlushOut $ do -#endif runGhc (Just libdir) $ do @@ -165,7 +166,6 @@ setTargets ts' _ <- load LoadAllTargets -#if __GLASGOW_HASKELL__ >= 706 when (nb == NoBuildOutput) $ do setContext $ case ep of ChLibEntrypoint ms ms' ss -> @@ -174,16 +174,9 @@ map (IIModule . mkModuleName . unChModuleName) $ ChModuleName "Main" : ms ChSetupEntrypoint -> map (IIModule . mkModuleName) ["Main"] -#endif - liftIO'CH $ print ExitSuccess + liftIO $ print ExitSuccess return True unChModuleName :: ChModuleName -> String unChModuleName (ChModuleName mn) = mn - -#if __GLASGOW_HASKELL__ <= 706 -liftIO'CH = GhcMonad.liftIO -#else -liftIO'CH = liftIO -#endif diff --git a/tests/LibexecTest.hs b/tests/LibexecTest.hs new file mode 100644 --- /dev/null +++ b/tests/LibexecTest.hs @@ -0,0 +1,37 @@ +import Control.Applicative +import Control.Monad +import Control.Exception as E +import Data.Char +import Data.List +import Data.Maybe +import Data.Version +import Data.Typeable +import System.Environment +import System.FilePath hiding ((<.>)) +import qualified System.FilePath as FP +import System.Directory +import System.IO.Unsafe +import Text.Printf +import GHC.Generics +import Prelude + +main = do + print =<< tryFindCabalHelperTreeLibexecDir + +tryFindCabalHelperTreeLibexecDir :: IO (Maybe FilePath) +tryFindCabalHelperTreeLibexecDir = do + exe <- getExecutablePath' + dir <- case takeFileName exe of + "ghc" -> do -- we're probably in ghci; try CWD + getCurrentDirectory + _ -> + return $ (!!4) $ iterate takeDirectory exe + + print ("dir", dir) + exists <- doesFileExist $ dir "cabal-helper.cabal" + return $ if exists + then Just dir + else Nothing + +getExecutablePath' :: IO FilePath +getExecutablePath' = getExecutablePath diff --git a/tests/bkpregex/bkpregex.cabal b/tests/bkpregex/bkpregex.cabal --- a/tests/bkpregex/bkpregex.cabal +++ b/tests/bkpregex/bkpregex.cabal @@ -1,7 +1,7 @@ name: bkpregex version: 0.1.0.0 build-type: Simple -cabal-version: >=2.0 +cabal-version: 2.0 library str-impls build-depends: base, bytestring