From f864a5eae8262752162c6b0d124aea4601ed9ac1 Mon Sep 17 00:00:00 2001 From: Daniel Gröber Date: Mon, 18 Sep 2017 01:23:22 +0200 Subject: Fix literally everything :) Sorry for the megacommit - Seperate modules into: - Compiletime, modules which are only used while building the package - Runtime, modues included in the wrapper binary to be compiled on the users machine at runtime - Shared, modues used in both contexts - Refactor runtime compilation - Completely revamp output paths - Don't chdir when invoking ghc - Require cabal-version 1.14 in cabal file --- tests/CompileTest.hs | 155 ++++++++++++++++++++++++++++++++++++++++++++++++++ tests/Spec.hs | 156 --------------------------------------------------- 2 files changed, 155 insertions(+), 156 deletions(-) create mode 100644 tests/CompileTest.hs delete mode 100644 tests/Spec.hs (limited to 'tests') diff --git a/tests/CompileTest.hs b/tests/CompileTest.hs new file mode 100644 index 0000000..eb10b76 --- /dev/null +++ b/tests/CompileTest.hs @@ -0,0 +1,155 @@ +import Distribution.Helper +import System.Environment.Extra (lookupEnv) +import System.Posix.Env (setEnv) +import System.Process +import System.Exit +import System.IO +import Data.List +import Data.Maybe +import Data.Version +import Data.Functor +import Data.Function +import qualified Distribution.Compat.ReadP as Dist +import Distribution.Version hiding (Version, showVersion) +import Distribution.Text +import Control.Exception as E +import Control.Arrow +import Control.Monad +import Prelude + +import CabalHelper.Compiletime.Compat.Version +import CabalHelper.Compiletime.Compile +import CabalHelper.Shared.Common +import CabalHelper.Shared.Types + +runReadP'Dist :: Dist.ReadP t t -> String -> t +runReadP'Dist p i = case filter ((=="") . snd) $ Dist.readP_to_S p i of + (a,""):[] -> a + _ -> error $ "Error parsing: " ++ show i + +withinRange'CH :: Either HEAD Version -> VersionRange -> Bool +withinRange'CH v r = + withinRange (fromDataVersion v') r + where + v' = either (const $ parseVer "1000000000") id v + +main :: IO () +main = do + flip (setEnv "HOME") True =<< fromMaybe "/tmp" <$> lookupEnv "TMPDIR" + _ <- rawSystem "cabal" ["update"] + + writeAutogenFiles' $ defaultQueryEnv "." "./dist" + + let parseVer' "HEAD" = Left HEAD + parseVer' v = Right $ parseVer v + + 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" + , "HEAD" + ] + + ghc_ver <- ghcVersion defaultOptions + + let constraint :: VersionRange + Just (_, constraint) = + find (and . (zipWith (==) `on` versionBranch) ghc_ver . fst) $ + 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", ">= 1.24.2 ") + ] + + relevant_cabal_versions = + reverse $ filter (flip withinRange'CH constraint) cabal_versions + + rvs <- forM relevant_cabal_versions $ \ver -> do + let sver = either show showVersion ver + hPutStrLn stderr $ "\n\n\n\n\n\n====== Compiling with Cabal-" ++ sver + compilePrivatePkgDb ver + + let printStatus (cv, rv) = putStrLn $ "- Cabal "++show cv++" "++status + where status = case rv of + Right _ -> + "suceeded" + Left rvc -> + "failed (exit code "++show rvc++")" + + let drvs = relevant_cabal_versions `zip` rvs + + mapM_ printStatus (relevant_cabal_versions `zip` rvs) + if any isLeft' $ map snd $ filter ((/=Left HEAD) . fst) drvs + then exitFailure + else exitSuccess + + where + isLeft' (Left _) = True + isLeft' (Right _) = False + +data HEAD = HEAD deriving (Eq, Show) + +compilePrivatePkgDb :: Either HEAD Version -> IO (Either ExitCode FilePath) +compilePrivatePkgDb (Left HEAD) = do + _ <- rawSystem "rm" [ "-r", "/tmp/.ghc-mod" ] + res <- (Right <$> installCabalHEAD defaultOptions { verbose = True }) + `E.catch` \(SomeException ex) -> return $ Left $ + "ERROR: Installing cabal HEAD failed: " ++ show ex + case res of + Left err -> do + hPutStrLn stderr err + return $ Left $ ExitFailure 1 + Right (db, commit) -> + compileWithPkg (Just db) (Left commit) +compilePrivatePkgDb (Right cabalVer) = do + _ <- rawSystem "rm" [ "-r", "/tmp/.ghc-mod" ] + db <- installCabal defaultOptions { verbose = True } cabalVer `E.catch` + \(SomeException _) -> do + errorInstallCabal cabalVer "dist" + compileWithPkg (Just db) (Right cabalVer) + +compileWithPkg :: Maybe FilePath + -> Either String Version + -> IO (Either ExitCode FilePath) +compileWithPkg mdb ver = + compile "dist" defaultOptions { verbose = True } $ + Compile Nothing mdb ver [cabalPkgId ver] + +cabalPkgId :: Either String Version -> String +cabalPkgId (Left _commitid) = "Cabal" +cabalPkgId (Right v) = "Cabal-" ++ showVersion v diff --git a/tests/Spec.hs b/tests/Spec.hs deleted file mode 100644 index 1487b82..0000000 --- a/tests/Spec.hs +++ /dev/null @@ -1,156 +0,0 @@ -import Distribution.Helper -import System.Environment.Extra (lookupEnv) -import System.Posix.Env (setEnv) -import System.Process -import System.Exit -import System.IO -import Data.List -import Data.Maybe -import Data.Version -import Data.Functor -import Data.Function -import qualified Distribution.Compat.ReadP as Dist -import Distribution.Version hiding (Version) -import Distribution.Text -import Control.Exception as E -import Control.Arrow -import Control.Monad -import Prelude - -import CabalHelper.Common -import CabalHelper.Compile -import CabalHelper.Compat.Version -import CabalHelper.Types - -runReadP'Dist :: Dist.ReadP t t -> String -> t -runReadP'Dist p i = case filter ((=="") . snd) $ Dist.readP_to_S p i of - (a,""):[] -> a - _ -> error $ "Error parsing: " ++ show i - -withinRange'CH :: Either HEAD Version -> VersionRange -> Bool -withinRange'CH v r = - withinRange (fromDataVersion v') r - where - v' = either (const $ parseVer "1000000000") id v - -main :: IO () -main = do - flip (setEnv "HOME") True =<< fromMaybe "/tmp" <$> lookupEnv "TMPDIR" - _ <- rawSystem "cabal" ["update"] - - writeAutogenFiles' $ defaultQueryEnv "." "./dist" - - let parseVer' "HEAD" = Left HEAD - parseVer' v = Right $ parseVer v - - 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" - , "HEAD" - ] - - ghc_ver <- ghcVersion defaultOptions - - let constraint :: VersionRange - Just (_, constraint) = - find (and . (zipWith (==) `on` versionBranch) ghc_ver . fst) $ - 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", ">= 1.24.2 ") - ] - - relevant_cabal_versions = - reverse $ filter (flip withinRange'CH constraint) cabal_versions - - rvs <- forM relevant_cabal_versions $ \ver -> do - let sver = either show showVersion ver - hPutStrLn stderr $ "\n\n\n\n\n\n====== Compiling with Cabal-" ++ sver - compilePrivatePkgDb ver - - let printStatus (cv, rv) = putStrLn $ "- Cabal "++show cv++" "++status - where status = case rv of - Right _ -> - "suceeded" - Left rvc -> - "failed (exit code "++show rvc++")" - - let drvs = relevant_cabal_versions `zip` rvs - - mapM_ printStatus (relevant_cabal_versions `zip` rvs) - if any isLeft' $ map snd $ filter ((/=Left HEAD) . fst) drvs - then exitFailure - else exitSuccess - - where - isLeft' (Left _) = True - isLeft' (Right _) = False - -data HEAD = HEAD deriving (Eq, Show) - -compilePrivatePkgDb :: Either HEAD Version -> IO (Either ExitCode FilePath) -compilePrivatePkgDb (Left HEAD) = do - _ <- rawSystem "rm" [ "-r", "/tmp/.ghc-mod" ] - res <- (Right <$> installCabalHEAD defaultOptions { verbose = True }) - `E.catch` \(SomeException ex) -> return $ Left $ - "ERROR: Installing cabal HEAD failed: " ++ show ex - case res of - Left err -> do - hPutStrLn stderr err - return $ Left $ ExitFailure 1 - Right (db, commit) -> - compileWithPkg "." (Just db) (Left commit) -compilePrivatePkgDb (Right cabalVer) = do - _ <- rawSystem "rm" [ "-r", "/tmp/.ghc-mod" ] - db <- installCabal defaultOptions { verbose = True } cabalVer `E.catch` - \(SomeException _) -> do - errorInstallCabal cabalVer "dist" - compileWithPkg "." (Just db) (Right cabalVer) - -compileWithPkg :: FilePath - -> Maybe FilePath - -> Either String Version - -> IO (Either ExitCode FilePath) -compileWithPkg chdir mdb ver = - compile "dist" defaultOptions { verbose = True } $ - Compile chdir Nothing mdb ver [cabalPkgId ver] - -cabalPkgId :: Either String Version -> String -cabalPkgId (Left _commitid) = "Cabal" -cabalPkgId (Right v) = "Cabal-" ++ showVersion v -- cgit v1.2.3