diff options
| -rw-r--r-- | scripts/ci/steps/30-build.sh | 3 | ||||
| -rw-r--r-- | src/CabalHelper/Compiletime/Compile.hs | 203 | ||||
| -rw-r--r-- | tests/CompileTest.hs | 13 |
3 files changed, 122 insertions, 97 deletions
diff --git a/scripts/ci/steps/30-build.sh b/scripts/ci/steps/30-build.sh index 1dbaad7..8e71aa3 100644 --- a/scripts/ci/steps/30-build.sh +++ b/scripts/ci/steps/30-build.sh @@ -1,3 +1,4 @@ -cabal --sandbox-config="$sandbox_config" configure --builddir="$build_dir" --enable-tests +# -fdev enables building the helper "main" exe directly and enables more warnings +cabal --sandbox-config="$sandbox_config" configure --builddir="$build_dir" --enable-tests -fdev cabal --sandbox-config="$sandbox_config" build --builddir="$build_dir" cabal --sandbox-config="$sandbox_config" haddock --builddir="$build_dir" diff --git a/src/CabalHelper/Compiletime/Compile.hs b/src/CabalHelper/Compiletime/Compile.hs index 7af3cf1..94563fb 100644 --- a/src/CabalHelper/Compiletime/Compile.hs +++ b/src/CabalHelper/Compiletime/Compile.hs @@ -57,7 +57,8 @@ import CabalHelper.Shared.Sandbox (getSandboxPkgDb) data Compile = CompileWithCabalSource - { compCabalSourceDir :: CabalSourceDir + { compCabalSourceDir :: CabalSourceDir + , compCabalSourceVersion :: Version } | CompileWithCabalPackage { compPackageDb :: Maybe PackageDbDir @@ -80,36 +81,44 @@ data CompilationProductScope = CPSGlobal | CPSProject compileHelper :: Options -> Version -> FilePath -> FilePath -> IO (Either ExitCode FilePath) compileHelper opts hdrCabalVersion projdir distdir = do - case oCabalPkgDb opts of - Nothing -> - run [ compileCabalSource - , Right <$> MaybeT (cachedExe (CabalVersion hdrCabalVersion)) - , compileSandbox - , compileGlobal - , compileWithCachedCabalPkg - , MaybeT (Just <$> compilePrivatePkgDb) - ] - mdb -> - run [ Right <$> MaybeT (cachedExe (CabalVersion hdrCabalVersion)) - , liftIO $ compileWithPkg mdb hdrCabalVersion CPSProject - ] + Just (prepare, comp) <- runMaybeT $ msum $ + case oCabalPkgDb opts of + Nothing -> + [ compileCabalSource + , compileSandbox + , compileGlobal + , MaybeT $ Just <$> compileWithCabalInPrivatePkgDb + ] + Just db -> + [ return $ (return (), compileWithPkg (Just db) hdrCabalVersion CPSProject) + ] - where - run actions = fromJust <$> runMaybeT (msum actions) + appdir <- appCacheDir - logMsg = "compiling helper with Cabal from " + let cp@CompPaths {compExePath} = compPaths appdir distdir comp + exists <- doesFileExist compExePath + if exists + then do + vLog opts $ "helper already compiled, using exe: "++compExePath + return (Right compExePath) + else do + vLog opts $ "helper exe does not exist, compiling"++compExePath + prepare >> compile comp cp opts + + where + logMsg = "using helper compiled with Cabal from " -- for relaxed deps: find (sameMajorVersionAs hdrCabalVersion) . reverse . sort -- | Check if this version is globally available - compileGlobal :: MaybeT IO (Either ExitCode FilePath) + compileGlobal :: MaybeT IO (IO (), Compile) compileGlobal = do ver <- MaybeT $ find (== hdrCabalVersion) <$> listCabalVersions opts vLog opts $ logMsg ++ "user/global package-db" - liftIO $ compileWithPkg Nothing ver CPSGlobal + return $ (return (), compileWithPkg Nothing ver CPSGlobal) -- | Check if this version is available in the project sandbox - compileSandbox :: MaybeT IO (Either ExitCode FilePath) + compileSandbox :: MaybeT IO (IO (), Compile) compileSandbox = do let ghcVer = ghcVersion opts mdb_path = getSandboxPkgDb projdir (display buildPlatform) =<< ghcVer @@ -117,64 +126,64 @@ compileHelper opts hdrCabalVersion projdir distdir = do ver <- MaybeT $ logIOError opts "compileSandbox" $ find (== hdrCabalVersion) <$> listCabalVersions' opts (Just sandbox) vLog opts $ logMsg ++ "sandbox package-db" - liftIO $ compileWithPkg (Just sandbox) ver CPSProject - - - -- | Check if we already compiled this version of cabal into a private - -- package-db - compileWithCachedCabalPkg :: MaybeT IO (Either ExitCode FilePath) - compileWithCachedCabalPkg = do - db_exists <- liftIO $ cabalVersionExistsInPkgDb opts hdrCabalVersion - case db_exists of - False -> mzero - True -> do - db@(PackageDbDir db_path) - <- liftIO $ getPrivateCabalPkgDb opts (CabalVersion hdrCabalVersion) - vLog opts $ logMsg ++ "private package-db in " ++ db_path - liftIO $ compileWithPkg (Just db) hdrCabalVersion CPSGlobal + return $ (return (), compileWithPkg (Just sandbox) ver CPSProject) + + -- | Compile the requested Cabal version into an isolated package-db if it's + -- not there already + compileWithCabalInPrivatePkgDb :: IO (IO (), Compile) + compileWithCabalInPrivatePkgDb = do + db@(PackageDbDir db_path) + <- getPrivateCabalPkgDb opts (CabalVersion hdrCabalVersion) + vLog opts $ logMsg ++ "private package-db in " ++ db_path + return (prepare db, compileWithPkg (Just db) hdrCabalVersion CPSGlobal) + where + prepare db = do + db_exists <- liftIO $ cabalVersionExistsInPkgDb opts hdrCabalVersion db + when (not db_exists) $ + void $ installCabal opts (Right hdrCabalVersion) `E.catch` + \(SomeException _) -> errorInstallCabal hdrCabalVersion distdir -- | See if we're in a cabal source tree - compileCabalSource :: MaybeT IO (Either ExitCode FilePath) + compileCabalSource :: MaybeT IO (IO (), Compile) compileCabalSource = do let cabalFile = projdir </> "Cabal.cabal" cabalSrc <- liftIO $ doesFileExist cabalFile let projdir' = CabalSourceDir projdir case cabalSrc of False -> mzero - True -> liftIO $ do + True -> do vLog opts $ "projdir looks like Cabal source tree (Cabal.cabal exists)" - -- ver <- cabalFileVersion <$> readFile cabalFile - vLog opts $ "compiling helper with local Cabal source tree" - compileWithCabalSource projdir' - - -- | Compile the requested cabal version into an isolated package-db - compilePrivatePkgDb :: IO (Either ExitCode FilePath) - compilePrivatePkgDb = do - db <- fst <$> installCabal opts (Right hdrCabalVersion) `E.catch` - \(SomeException _) -> errorInstallCabal hdrCabalVersion distdir - compileWithPkg (Just db) hdrCabalVersion CPSGlobal - - compileWithCabalSource srcDir = - compile CompileWithCabalSource - { compCabalSourceDir = srcDir - } distdir opts + cf <- liftIO $ readFile cabalFile + let buildType = cabalFileBuildType cf + ver = cabalFileVersion cf + + case buildType of + "simple" -> do + vLog opts $ "Cabal source tree is build-type:simple, moving on" + mzero + "custom" -> do + vLog opts $ "compiling helper with local Cabal source tree" + return $ (return (), compileWithCabalSource projdir' ver) + _ -> error $ "compileCabalSource: unknown build-type: '"++buildType++"'" + + compileWithCabalSource srcDir ver = + CompileWithCabalSource + { compCabalSourceDir = srcDir + , compCabalSourceVersion = ver + } compileWithPkg mdb ver target = - compile CompileWithCabalPackage - { compPackageDb = mdb - , compCabalVersion = CabalVersion ver - , compPackageDeps = [cabalPkgId ver] - , compProductTarget = target - } distdir opts + CompileWithCabalPackage + { compPackageDb = mdb + , compCabalVersion = CabalVersion ver + , compPackageDeps = [cabalPkgId ver] + , compProductTarget = target + } cabalPkgId v = "Cabal-" ++ showVersion v -compile :: Compile -> FilePath -> Options -> IO (Either ExitCode FilePath) -compile comp distdir opts@Options {..} = do - appdir <- appCacheDir - - let paths@CompPaths {..} = compPaths appdir distdir comp - +compile :: Compile -> CompPaths -> Options -> IO (Either ExitCode FilePath) +compile comp paths@CompPaths {..} opts@Options {..} = do createDirectoryIfMissing True compOutDir createHelperSources compSrcDir @@ -210,6 +219,7 @@ data GhcInvocation = GhcInvocation , giIncludeDirs :: [FilePath] , giHideAllPackages :: Bool , giPackages :: [String] + , giWarningFlags :: [String] , giInputs :: [String] } @@ -220,13 +230,17 @@ compGhcInvocation comp CompPaths {..} = GhcInvocation { giIncludeDirs = [compSrcDir, unCabalSourceDir compCabalSourceDir] , giPackageDBs = [] + , giHideAllPackages = False , giPackages = [] + , giCPPOptions = cppOptions compCabalSourceVersion + ++ [cabalVersionMacro compCabalSourceVersion] , .. } CompileWithCabalPackage {..} -> GhcInvocation { giIncludeDirs = [compSrcDir] , giPackageDBs = maybeToList compPackageDb + , giHideAllPackages = True , giPackages = [ "base" , "containers" @@ -236,31 +250,37 @@ compGhcInvocation comp CompPaths {..} = , "bytestring" , "ghc-prim" ] ++ compPackageDeps + , giCPPOptions = cppOptions (unCabalVersion compCabalVersion) , .. } where - (mj1:mj2:mi:_) = - case compCabalVersion comp of - CabalHEAD _commit -> [10000000, 0, 0] - CabalVersion (Version vs _) -> vs + + unCabalVersion (CabalVersion ver) = ver + unCabalVersion (CabalHEAD _) = Version [10000000, 0, 0] [] + + cppOptions cabalVer = + [ "-DCABAL_HELPER=1" + , cabalMinVersionMacro cabalVer + ] giOutDir = compOutDir giOutput = compExePath - giCPPOptions = - [ "-DCABAL_HELPER=1" - , minVersionMacro (mj1,mj2,mi) - ] - giHideAllPackages = True + giWarningFlags = [ "-w" ] -- no point in bothering end users with warnings giInputs = [compSrcDir</>"CabalHelper"</>"Runtime"</>"Main.hs"] +cabalVersionMacro :: Version -> String +cabalVersionMacro (Version vs _) = + "-DCABAL_VERSION="++intercalate "," (map show vs) -minVersionMacro :: (Int, Int, Int) -> String -minVersionMacro (mj1,mj2,mi) = +cabalMinVersionMacro :: Version -> String +cabalMinVersionMacro (Version (mj1:mj2:mi:_) _) = "-DCH_MIN_VERSION_Cabal(major1,major2,minor)=\ \( (major1) < "++show mj1++" \ \|| (major1) == "++show mj1++" && (major2) < "++show mj2++" \ \|| (major1) == "++show mj1++" && (major2) == "++show mj2++" && (minor) <= "++show mi++ ")" +cabalMinVersionMacro _ = + error "cabalMinVersionMacro: Version must have at least 3 components" invokeGhc :: Options -> GhcInvocation -> IO (Either ExitCode FilePath) invokeGhc opts@Options {..} GhcInvocation {..} = do @@ -273,6 +293,7 @@ invokeGhc opts@Options {..} GhcInvocation {..} = do , map ("-i"++) $ nub $ "" : giIncludeDirs , if giHideAllPackages then ["-hide-all-packages"] else [] , concatMap (\p -> ["-package", p]) giPackages + , giWarningFlags , ["--make"] , giInputs ] @@ -391,7 +412,7 @@ runCabalInstall opts (PackageDbDir db) (CabalSourceDir srcdir) ever = do , "--package-db=" ++ db , "--prefix=" ++ db </> "prefix" ] - , cabalOptions opts + , withGHCProgramOptions opts , if cabalInstallVer >= Version [1,20,0,0] [] then ["--no-require-sandbox"] else [] @@ -408,8 +429,8 @@ runCabalInstall opts (PackageDbDir db) (CabalSourceDir srcdir) ever = do hPutStrLn stderr "done" -cabalOptions :: Options -> [String] -cabalOptions opts = +withGHCProgramOptions :: Options -> [String] +withGHCProgramOptions opts = concat [ [ "--with-ghc=" ++ oGhcProgram opts ] , if oGhcPkgProgram opts /= oGhcPkgProgram defaultOptions then [ "--with-ghc-pkg=" ++ oGhcPkgProgram opts ] @@ -437,7 +458,8 @@ runSetupHs opts@Options {..} db srcdir ever CabalInstallVersion {..} go :: ([String] -> IO ()) -> IO () go run = do - run $ [ "configure", "--package-db", db, "--prefix", db </> "prefix" ] ++ cabalOptions opts + run $ [ "configure", "--package-db", db, "--prefix", db </> "prefix" ] + ++ withGHCProgramOptions opts run $ [ "build" ] ++ parmake_opt run [ "copy" ] run [ "register" ] @@ -600,13 +622,6 @@ errorInstallCabal cabalVer _distdir = panicIO $ printf "\ where sver = showVersion cabalVer -cachedExe :: CabalVersion -> IO (Maybe FilePath) -cachedExe ver = do - appdir <- appCacheDir - let exe = appdir </> exeName ver - exists <- doesFileExist exe - return $ if exists then Just exe else Nothing - listCabalVersions :: Options -> IO [Version] listCabalVersions opts = listCabalVersions' opts Nothing @@ -619,9 +634,8 @@ listCabalVersions' Options {..} mdb = do catMaybes . map (fmap snd . parsePkgId . fromString) . words <$> readProcess oGhcPkgProgram opts "" -cabalVersionExistsInPkgDb :: Options -> Version -> IO Bool -cabalVersionExistsInPkgDb opts cabalVer = do - db@(PackageDbDir db_path) <- getPrivateCabalPkgDb opts (CabalVersion cabalVer) +cabalVersionExistsInPkgDb :: Options -> Version -> PackageDbDir -> IO Bool +cabalVersionExistsInPkgDb opts cabalVer db@(PackageDbDir db_path) = do exists <- doesDirectoryExist db_path case exists of False -> return False @@ -663,8 +677,15 @@ getPrivateCabalPkgDb opts cabalVer = do -- | Find @version: XXX@ delcaration in a cabal file cabalFileVersion :: String -> Version -cabalFileVersion cabalFile = - fromJust $ parseVer . extract <$> find ("version:" `isPrefixOf`) ls +cabalFileVersion = parseVer . cabalFileTopField "version" + +-- | Find @build-type: XXX@ delcaration in a cabal file +cabalFileBuildType :: String -> String +cabalFileBuildType = cabalFileTopField "build-type" + +cabalFileTopField :: String -> String -> String +cabalFileTopField field cabalFile = value where + Just value = extract <$> find ((field++":") `isPrefixOf`) ls ls = map (map toLower) $ lines cabalFile extract = dropWhile (/=':') >>> drop 1 >>> dropWhile isSpace >>> takeWhile (not . isSpace) diff --git a/tests/CompileTest.hs b/tests/CompileTest.hs index e65de8d..dbc033b 100644 --- a/tests/CompileTest.hs +++ b/tests/CompileTest.hs @@ -161,18 +161,21 @@ compilePrivatePkgDb eCabalVer = do res <- E.try $ installCabal defaultOptions { oVerbose = True } eCabalVer case res of Right (db, cabalVer) -> - compileWithPkg (Just db) cabalVer + compileWithPkg db cabalVer Left (ioe :: IOException) -> do print ioe return $ Left (ExitFailure 1) -compileWithPkg :: Maybe PackageDbDir +compileWithPkg :: PackageDbDir -> CabalVersion -> IO (Either ExitCode FilePath) -compileWithPkg mdb cabalVer = +compileWithPkg db cabalVer = do + appdir <- appCacheDir + let comp = + CompileWithCabalPackage (Just db) cabalVer [cabalPkgId cabalVer] CPSGlobal compile - (CompileWithCabalPackage mdb cabalVer [cabalPkgId cabalVer] CPSGlobal) - "/does-not-exist" + comp + (compPaths appdir (error "compile-test: distdir not available") comp) defaultOptions { oVerbose = True } |