diff options
| -rw-r--r-- | src/CabalHelper/Compiletime/Compile.hs | 108 | ||||
| -rw-r--r-- | src/CabalHelper/Compiletime/Log.hs | 2 | ||||
| -rw-r--r-- | src/CabalHelper/Compiletime/Types.hs | 12 | ||||
| -rw-r--r-- | src/CabalHelper/Compiletime/Wrapper.hs | 24 | ||||
| -rw-r--r-- | tests/CompileTest.hs | 20 |
5 files changed, 85 insertions, 81 deletions
diff --git a/src/CabalHelper/Compiletime/Compile.hs b/src/CabalHelper/Compiletime/Compile.hs index 06b27f0..b956932 100644 --- a/src/CabalHelper/Compiletime/Compile.hs +++ b/src/CabalHelper/Compiletime/Compile.hs @@ -12,7 +12,7 @@ -- -- You should have received a copy of the GNU Affero General Public License -- along with this program. If not, see <http://www.gnu.org/licenses/>. -{-# LANGUAGE RecordWildCards, FlexibleContexts #-} +{-# LANGUAGE RecordWildCards, FlexibleContexts, NamedFieldPuns #-} {-| Module : CabalHelper.Compiletime.Compile @@ -58,24 +58,24 @@ import CabalHelper.Shared.Sandbox (getSandboxPkgDb) data Compile = Compile { compCabalSourceDir :: Maybe CabalSourceDir, compPackageDb :: Maybe PackageDbDir, - compCabalVersion :: Either String Version, + compCabalVersion :: CabalVersion, compPackageDeps :: [String] } compileHelper :: Options -> Version -> FilePath -> FilePath -> IO (Either ExitCode FilePath) -compileHelper opts cabalVer projdir distdir = do - case cabalPkgDb opts of +compileHelper opts hdrCabalVersion projdir distdir = do + case oCabalPkgDb opts of Nothing -> run [ compileCabalSource - , Right <$> MaybeT (cachedExe cabalVer) + , Right <$> MaybeT (cachedExe (CabalVersion hdrCabalVersion)) , compileSandbox , compileGlobal , cachedCabalPkg , MaybeT (Just <$> compilePrivatePkgDb) ] mdb -> - run [ Right <$> MaybeT (cachedExe cabalVer) - , liftIO $ compileWithPkg mdb cabalVer + run [ Right <$> MaybeT (cachedExe (CabalVersion hdrCabalVersion)) + , liftIO $ compileWithPkg mdb hdrCabalVersion ] where @@ -83,12 +83,12 @@ compileHelper opts cabalVer projdir distdir = do logMsg = "compiling helper with Cabal from " --- for relaxed deps: find (sameMajorVersionAs cabalVer) . reverse . sort +-- for relaxed deps: find (sameMajorVersionAs hdrCabalVersion) . reverse . sort -- | Check if this version is globally available compileGlobal :: MaybeT IO (Either ExitCode FilePath) compileGlobal = do - ver <- MaybeT $ find (== cabalVer) <$> listCabalVersions opts + ver <- MaybeT $ find (== hdrCabalVersion) <$> listCabalVersions opts vLog opts $ logMsg ++ "user/global package-db" liftIO $ compileWithPkg Nothing ver @@ -99,7 +99,7 @@ compileHelper opts cabalVer projdir distdir = do mdb_path = getSandboxPkgDb projdir (display buildPlatform) =<< ghcVer sandbox <- PackageDbDir <$> MaybeT mdb_path ver <- MaybeT $ logIOError opts "compileSandbox" $ - find (== cabalVer) <$> listCabalVersions' opts (Just sandbox) + find (== hdrCabalVersion) <$> listCabalVersions' opts (Just sandbox) vLog opts $ logMsg ++ "sandbox package-db" liftIO $ compileWithPkg (Just sandbox) ver @@ -108,14 +108,14 @@ compileHelper opts cabalVer projdir distdir = do -- package-db cachedCabalPkg :: MaybeT IO (Either ExitCode FilePath) cachedCabalPkg = do - db_exists <- liftIO $ cabalVersionExistsInPkgDb opts cabalVer + db_exists <- liftIO $ cabalVersionExistsInPkgDb opts hdrCabalVersion case db_exists of False -> mzero True -> do db@(PackageDbDir db_path) - <- liftIO $ getPrivateCabalPkgDb opts (Right cabalVer) + <- liftIO $ getPrivateCabalPkgDb opts (CabalVersion hdrCabalVersion) vLog opts $ logMsg ++ "private package-db in " ++ db_path - liftIO $ compileWithPkg (Just db) cabalVer + liftIO $ compileWithPkg (Just db) hdrCabalVersion -- | See if we're in a cabal source tree compileCabalSource :: MaybeT IO (Either ExitCode FilePath) @@ -134,15 +134,15 @@ compileHelper opts cabalVer projdir distdir = do -- | Compile the requested cabal version into an isolated package-db compilePrivatePkgDb :: IO (Either ExitCode FilePath) compilePrivatePkgDb = do - db <- fst <$> installCabal opts (Right cabalVer) `E.catch` - \(SomeException _) -> errorInstallCabal cabalVer distdir - compileWithPkg (Just db) cabalVer + db <- fst <$> installCabal opts (Right hdrCabalVersion) `E.catch` + \(SomeException _) -> errorInstallCabal hdrCabalVersion distdir + compileWithPkg (Just db) hdrCabalVersion compileWithCabalTree ver srcDir = compile distdir opts $ Compile { compCabalSourceDir = Just srcDir, compPackageDb = Nothing, - compCabalVersion = Right ver, + compCabalVersion = CabalVersion ver, compPackageDeps = [] } @@ -150,7 +150,7 @@ compileHelper opts cabalVer projdir distdir = do compile distdir opts $ Compile { compCabalSourceDir = Nothing, compPackageDb = mdb, - compCabalVersion = Right ver, + compCabalVersion = CabalVersion ver, compPackageDeps = [cabalPkgId ver] } @@ -159,7 +159,7 @@ compileHelper opts cabalVer projdir distdir = do compile :: FilePath -> Options -> Compile -> IO (Either ExitCode FilePath) compile distdir opts@Options {..} Compile {..} = do cnCabalSourceDir - <- (canonicalizePath . cabalSourceDir) `traverse` compCabalSourceDir + <- (canonicalizePath . unCabalSourceDir) `traverse` compCabalSourceDir appdir <- appCacheDir let (outdir, exedir, exe, mchsrcdir) = @@ -185,8 +185,8 @@ compile distdir opts@Options {..} Compile {..} = do vLog opts $ "exe: " ++ exe let (mj1:mj2:mi:_) = case compCabalVersion of - Left _commitid -> [10000000, 0, 0] - Right (Version vs _) -> vs + CabalHEAD _commitid -> [10000000, 0, 0] + CabalVersion (Version vs _) -> vs let ghc_opts = concat [ [ "-outputdir", outdir , "-o", exe @@ -217,19 +217,23 @@ compile distdir opts@Options {..} Compile {..} = do ] ] - rv <- callProcessStderr' opts Nothing ghcProgram ghc_opts + rv <- callProcessStderr' opts Nothing oGhcProgram ghc_opts return $ case rv of ExitSuccess -> Right exe e@(ExitFailure _) -> Left e -exeName :: Either String Version -> String -exeName (Left commitid) = intercalate "-" +data CabalVersion + = CabalHEAD { cvCommitId :: String } + | CabalVersion { cabalVersion :: Version } + +exeName :: CabalVersion -> String +exeName (CabalHEAD commitid) = intercalate "-" [ "cabal-helper" ++ showVersion version -- our ver , "CabalHEAD" ++ commitid ] -exeName (Right compCabalVersion) = intercalate "-" +exeName CabalVersion {cabalVersion} = intercalate "-" [ "cabal-helper" ++ showVersion version -- our ver - , "Cabal" ++ showVersion compCabalVersion + , "Cabal" ++ showVersion cabalVersion ] callProcessStderr' @@ -265,7 +269,7 @@ formatProcessArg xs data HEAD = HEAD deriving (Eq, Show) -installCabal :: Options -> Either HEAD Version -> IO (PackageDbDir, Either String Version) +installCabal :: Options -> Either HEAD Version -> IO (PackageDbDir, CabalVersion) installCabal opts ever = do appdir <- appCacheDir let message ver = do @@ -285,20 +289,20 @@ installCabal opts ever = do \Installing Cabal %s ...\n" appdir sver sver sver withSystemTempDirectory "cabal-helper-Cabal-source" $ \tmpdir -> do - (srcdir, e_commit_ver) <- case ever of + (srcdir, cabalVer) <- case ever of Left HEAD -> do - second Left <$> unpackCabalHEAD tmpdir + second CabalHEAD <$> unpackCabalHEAD tmpdir Right ver -> do message ver let patch = fromMaybe nopCabalPatchDescription $ find ((ver`elem`) . cpdVersions) patchyCabalVersions - (,) <$> unpackPatchedCabal opts ver tmpdir patch <*> pure (Right ver) + (,) <$> unpackPatchedCabal opts ver tmpdir patch <*> pure (CabalVersion ver) - db <- createPkgDb opts e_commit_ver + db <- createPkgDb opts cabalVer runCabalInstall opts db srcdir ever - return (db, e_commit_ver) + return (db, cabalVer) {- TODO: If the Cabal version we want to install is less than or equal to one we @@ -329,13 +333,13 @@ runCabalInstall opts (PackageDbDir db) (CabalSourceDir srcdir) ever = do then ["--no-require-sandbox"] else [] , [ "install", srcdir ] - , if verbose opts + , if oVerbose opts then ["-v"] else [] , [ "--only-dependencies" ] ] - callProcessStderr opts (Just "/") (cabalProgram opts) cabal_opts + callProcessStderr opts (Just "/") (oCabalProgram opts) cabal_opts runSetupHs opts db srcdir ever civ @@ -343,9 +347,9 @@ runCabalInstall opts (PackageDbDir db) (CabalSourceDir srcdir) ever = do cabalOptions :: Options -> [String] cabalOptions opts = - concat [ [ "--with-ghc=" ++ ghcProgram opts ] - , if ghcPkgProgram opts /= ghcPkgProgram defaultOptions - then [ "--with-ghc-pkg=" ++ ghcPkgProgram opts ] + concat [ [ "--with-ghc=" ++ oGhcProgram opts ] + , if oGhcPkgProgram opts /= oGhcPkgProgram defaultOptions + then [ "--with-ghc-pkg=" ++ oGhcPkgProgram opts ] else [] ] @@ -358,7 +362,7 @@ runSetupHs -> IO () runSetupHs opts@Options {..} db srcdir ever CabalInstallVersion {..} | cabalInstallVer >= parseVer "1.24" = do - go $ \args -> callProcessStderr opts (Just srcdir) cabalProgram $ + go $ \args -> callProcessStderr opts (Just srcdir) oCabalProgram $ [ "act-as-setup", "--" ] ++ args | otherwise = do SetupProgram {..} <- compileSetupHs opts db srcdir @@ -388,7 +392,7 @@ compileSetupHs opts db srcdir = do file = srcdir </> "Setup" - callProcessStderr opts (Just srcdir) (ghcProgram opts) $ concat + callProcessStderr opts (Just srcdir) (oGhcProgram opts) $ concat [ [ "--make" , "-package-conf", db ] @@ -471,7 +475,7 @@ unpackPatchedCabal opts cabalVer tmpdir (CabalPatchDescription _ variant patch) return res data UnpackCabalVariant = Pristine | LatestRevision -newtype CabalSourceDir = CabalSourceDir { cabalSourceDir :: FilePath } +newtype CabalSourceDir = CabalSourceDir { unCabalSourceDir :: FilePath } unpackCabal :: Options -> Version -> FilePath -> UnpackCabalVariant -> IO CabalSourceDir unpackCabal opts cabalVer tmpdir variant = do @@ -479,7 +483,7 @@ unpackCabal opts cabalVer tmpdir variant = do dir = tmpdir </> cabal variant_opts = case variant of Pristine -> [ "--pristine" ]; _ -> [] args = [ "get", cabal ] ++ variant_opts - callProcessStderr opts (Just tmpdir) (cabalProgram opts) args + callProcessStderr opts (Just tmpdir) (oCabalProgram opts) args return $ CabalSourceDir dir unpackCabalHEAD :: FilePath -> IO (CabalSourceDir, String) @@ -533,10 +537,10 @@ errorInstallCabal cabalVer _distdir = panicIO $ printf "\ where sver = showVersion cabalVer -cachedExe :: Version -> IO (Maybe FilePath) -cachedExe compCabalVersion = do +cachedExe :: CabalVersion -> IO (Maybe FilePath) +cachedExe ver = do appdir <- appCacheDir - let exe = appdir </> exeName (Right compCabalVersion) + let exe = appdir </> exeName ver exists <- doesFileExist exe return $ if exists then Just exe else Nothing @@ -550,11 +554,11 @@ listCabalVersions' Options {..} mdb = do opts = ["list", "--simple-output", "Cabal"] ++ maybeToList mdbopt catMaybes . map (fmap snd . parsePkgId . fromString) . words - <$> readProcess ghcPkgProgram opts "" + <$> readProcess oGhcPkgProgram opts "" cabalVersionExistsInPkgDb :: Options -> Version -> IO Bool cabalVersionExistsInPkgDb opts cabalVer = do - db@(PackageDbDir db_path) <- getPrivateCabalPkgDb opts (Right cabalVer) + db@(PackageDbDir db_path) <- getPrivateCabalPkgDb opts (CabalVersion cabalVer) exists <- doesDirectoryExist db_path case exists of False -> return False @@ -564,26 +568,26 @@ cabalVersionExistsInPkgDb opts cabalVer = do ghcVersion :: Options -> IO Version ghcVersion Options {..} = do - parseVer . trim <$> readProcess ghcProgram ["--numeric-version"] "" + parseVer . trim <$> readProcess oGhcProgram ["--numeric-version"] "" ghcPkgVersion :: Options -> IO Version ghcPkgVersion Options {..} = do - parseVer . trim . dropWhile (not . isDigit) <$> readProcess ghcPkgProgram ["--version"] "" + parseVer . trim . dropWhile (not . isDigit) <$> readProcess oGhcPkgProgram ["--version"] "" newtype CabalInstallVersion = CabalInstallVersion { cabalInstallVer :: Version } cabalInstallVersion :: Options -> IO CabalInstallVersion cabalInstallVersion Options {..} = do CabalInstallVersion . parseVer . trim - <$> readProcess cabalProgram ["--numeric-version"] "" + <$> readProcess oCabalProgram ["--numeric-version"] "" -createPkgDb :: Options -> Either String Version -> IO PackageDbDir +createPkgDb :: Options -> CabalVersion -> IO PackageDbDir createPkgDb opts@Options {..} cabalVer = do db@(PackageDbDir db_path) <- getPrivateCabalPkgDb opts cabalVer exists <- doesDirectoryExist db_path - when (not exists) $ callProcessStderr opts Nothing ghcPkgProgram ["init", db_path] + when (not exists) $ callProcessStderr opts Nothing oGhcPkgProgram ["init", db_path] return db -getPrivateCabalPkgDb :: Options -> Either String Version -> IO PackageDbDir +getPrivateCabalPkgDb :: Options -> CabalVersion -> IO PackageDbDir getPrivateCabalPkgDb opts cabalVer = do appdir <- appCacheDir ghcVer <- ghcVersion opts diff --git a/src/CabalHelper/Compiletime/Log.hs b/src/CabalHelper/Compiletime/Log.hs index a75f8b7..4c9a5c5 100644 --- a/src/CabalHelper/Compiletime/Log.hs +++ b/src/CabalHelper/Compiletime/Log.hs @@ -33,7 +33,7 @@ import Prelude import CabalHelper.Compiletime.Types vLog :: MonadIO m => Options -> String -> m () -vLog Options { verbose = True } msg = +vLog Options { oVerbose = True } msg = liftIO $ hPutStrLn stderr msg vLog _ _ = return () diff --git a/src/CabalHelper/Compiletime/Types.hs b/src/CabalHelper/Compiletime/Types.hs index bfe9b7c..cf36e49a 100644 --- a/src/CabalHelper/Compiletime/Types.hs +++ b/src/CabalHelper/Compiletime/Types.hs @@ -26,12 +26,12 @@ module CabalHelper.Compiletime.Types where import Data.Version data Options = Options { - verbose :: Bool - , ghcProgram :: FilePath - , ghcPkgProgram :: FilePath - , cabalProgram :: FilePath - , cabalVersion :: Maybe Version - , cabalPkgDb :: Maybe PackageDbDir + oVerbose :: Bool + , oGhcProgram :: FilePath + , oGhcPkgProgram :: FilePath + , oCabalProgram :: FilePath + , oCabalVersion :: Maybe Version + , oCabalPkgDb :: Maybe PackageDbDir } newtype PackageDbDir = PackageDbDir { packageDbDir :: FilePath } diff --git a/src/CabalHelper/Compiletime/Wrapper.hs b/src/CabalHelper/Compiletime/Wrapper.hs index 6713944..c667f7d 100644 --- a/src/CabalHelper/Compiletime/Wrapper.hs +++ b/src/CabalHelper/Compiletime/Wrapper.hs @@ -65,22 +65,22 @@ usage = do globalArgSpec :: [OptDescr (Options -> Options)] globalArgSpec = [ option "" ["verbose"] "Be more verbose" $ - NoArg $ \o -> o { verbose = True } + NoArg $ \o -> o { oVerbose = True } , option "" ["with-ghc"] "GHC executable to use" $ - reqArg "PROG" $ \p o -> o { ghcProgram = p } + reqArg "PROG" $ \p o -> o { oGhcProgram = p } , option "" ["with-ghc-pkg"] "ghc-pkg executable to use (only needed when guessing from GHC path fails)" $ - reqArg "PROG" $ \p o -> o { ghcPkgProgram = p } + reqArg "PROG" $ \p o -> o { oGhcPkgProgram = p } , option "" ["with-cabal"] "cabal-install executable to use" $ - reqArg "PROG" $ \p o -> o { cabalProgram = p } + reqArg "PROG" $ \p o -> o { oCabalProgram = p } , option "" ["with-cabal-version"] "Cabal library version to use" $ - reqArg "VERSION" $ \p o -> o { cabalVersion = Just $ parseVer p } + reqArg "VERSION" $ \p o -> o { oCabalVersion = Just $ parseVer p } , option "" ["with-cabal-pkg-db"] "package database to look for Cabal library in" $ - reqArg "PKG_DB" $ \p o -> o { cabalPkgDb = Just (PackageDbDir p) } + reqArg "PKG_DB" $ \p o -> o { oCabalPkgDb = Just (PackageDbDir p) } ] where @@ -99,11 +99,11 @@ parseCommandArgs opts argv guessProgramPaths :: Options -> IO Options guessProgramPaths opts = do - if not (same ghcProgram opts dopts) && same ghcPkgProgram opts dopts + if not (same oGhcProgram opts dopts) && same oGhcPkgProgram opts dopts then do - mghcPkg <- guessToolFromGhcPath "ghc-pkg" (ghcProgram opts) + mghcPkg <- guessToolFromGhcPath "ghc-pkg" (oGhcProgram opts) return opts { - ghcPkgProgram = fromMaybe (ghcPkgProgram opts) mghcPkg + oGhcPkgProgram = fromMaybe (oGhcPkgProgram opts) mghcPkg } else return opts where @@ -114,7 +114,7 @@ overrideVerbosityEnvVar :: Options -> IO Options overrideVerbosityEnvVar opts = do x <- lookup "CABAL_HELPER_DEBUG" <$> getEnvironment return $ case x of - Just _ -> opts { verbose = True } + Just _ -> opts { oVerbose = True } Nothing -> opts main :: IO () @@ -130,7 +130,7 @@ main = handlePanic $ do "print-build-platform":[] -> putStrLn $ display buildPlatform projdir:_distdir:"package-id":[] -> do - let v | verbose opts = deafening + let v | oVerbose opts = deafening | otherwise = silent -- ghc-mod will catch multiple cabal files existing before we get here [cfile] <- filter isCabalFile <$> getDirectoryContents projdir @@ -147,7 +147,7 @@ main = handlePanic $ do \- Check first line of: %s\n\ \- Maybe try: $ cabal configure" cfgf Just (hdrCabalVersion, _) -> do - case cabalVersion opts of + case oCabalVersion opts of Just ver | hdrCabalVersion /= ver -> panic $ printf "\ \Cabal version %s was requested but setup configuration was\n\ \written by version %s" (showVersion ver) (showVersion hdrCabalVersion) diff --git a/tests/CompileTest.hs b/tests/CompileTest.hs index cc9c85a..89f79fa 100644 --- a/tests/CompileTest.hs +++ b/tests/CompileTest.hs @@ -129,21 +129,21 @@ main = do compilePrivatePkgDb :: Either HEAD Version -> IO (Either ExitCode FilePath) compilePrivatePkgDb eCabalVer = do - res <- E.try $ installCabal defaultOptions { verbose = True } eCabalVer + res <- E.try $ installCabal defaultOptions { oVerbose = True } eCabalVer case res of - Right (db, e_commit_ver) -> - compileWithPkg (Just db) e_commit_ver + Right (db, cabalVer) -> + compileWithPkg (Just db) cabalVer Left (ioe :: IOException) -> do print ioe return $ Left (ExitFailure 1) compileWithPkg :: Maybe PackageDbDir - -> Either String Version + -> CabalVersion -> IO (Either ExitCode FilePath) -compileWithPkg mdb eCabalVer = - compile "/does-not-exist" defaultOptions { verbose = True } $ - Compile Nothing mdb eCabalVer [cabalPkgId eCabalVer] +compileWithPkg mdb cabalVer = + compile "/does-not-exist" defaultOptions { oVerbose = True } $ + Compile Nothing mdb cabalVer [cabalPkgId cabalVer] -cabalPkgId :: Either String Version -> String -cabalPkgId (Left _commitid) = "Cabal" -cabalPkgId (Right v) = "Cabal-" ++ showVersion v +cabalPkgId :: CabalVersion -> String +cabalPkgId (CabalHEAD _commitid) = "Cabal" +cabalPkgId (CabalVersion v) = "Cabal-" ++ showVersion v |