From 8d2dbc7ce3211725561bd419271ac4cabb8c7ae8 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Wed, 29 Nov 2017 22:36:25 +0200 Subject: Cleaning up --- cabal-helper.cabal | 74 ++++++++++++++++++++--------------------- src/CabalHelper/Runtime/Main.hs | 63 +++++++++++++++-------------------- tests/GhcSession.hs | 16 ++------- 3 files changed, 66 insertions(+), 87 deletions(-) diff --git a/cabal-helper.cabal b/cabal-helper.cabal index 468d10b..80002b3 100644 --- a/cabal-helper.cabal +++ b/cabal-helper.cabal @@ -125,44 +125,44 @@ executable cabal-helper-wrapper , utf8-string < 1.1 && >= 1.0.1.1 , ghc-prim --- test-suite compile-test --- default-language: Haskell2010 --- default-extensions: NondecreasingIndentation --- type: exitcode-stdio-1.0 --- main-is: CompileTest.hs --- hs-source-dirs: tests, src --- other-modules: --- CabalHelper.Compiletime.Compat.Environment --- CabalHelper.Compiletime.Compat.Version --- CabalHelper.Compiletime.Compile --- CabalHelper.Compiletime.Data --- CabalHelper.Compiletime.Log --- CabalHelper.Compiletime.Types --- CabalHelper.Shared.Common --- CabalHelper.Shared.Sandbox --- Paths_cabal_helper --- ghc-options: -Wall --- build-tools: cabal +test-suite compile-test + default-language: Haskell2010 + default-extensions: NondecreasingIndentation + type: exitcode-stdio-1.0 + main-is: CompileTest.hs + hs-source-dirs: tests, src + other-modules: + CabalHelper.Compiletime.Compat.Environment + CabalHelper.Compiletime.Compat.Version + CabalHelper.Compiletime.Compile + CabalHelper.Compiletime.Data + CabalHelper.Compiletime.Log + CabalHelper.Compiletime.Types + CabalHelper.Shared.Common + CabalHelper.Shared.Sandbox + Paths_cabal_helper + ghc-options: -Wall + build-tools: cabal --- -- Same as cabal-helper-wrapper --- 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 --- , bytestring < 0.11 && >= 0.9.2.1 --- , directory < 1.4 && >= 1.1.0.2 --- , exceptions < 0.9 && >= 0.8.3 --- , 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 --- , transformers < 0.6 && >= 0.3.0.0 --- if !os(windows) --- build-depends: unix < 2.8 && >= 2.5.1.1 --- build-depends: unix-compat < 0.5 && >= 0.4.3.1 --- , utf8-string < 1.1 && >= 1.0.1.1 --- , ghc-prim + -- Same as cabal-helper-wrapper + 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 + , bytestring < 0.11 && >= 0.9.2.1 + , directory < 1.4 && >= 1.1.0.2 + , exceptions < 0.9 && >= 0.8.3 + , 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 + , transformers < 0.6 && >= 0.3.0.0 + if !os(windows) + build-depends: unix < 2.8 && >= 2.5.1.1 + build-depends: unix-compat < 0.5 && >= 0.4.3.1 + , utf8-string < 1.1 && >= 1.0.1.1 + , ghc-prim test-suite ghc-session default-language: Haskell2010 diff --git a/src/CabalHelper/Runtime/Main.hs b/src/CabalHelper/Runtime/Main.hs index 99170fe..e8d6954 100644 --- a/src/CabalHelper/Runtime/Main.hs +++ b/src/CabalHelper/Runtime/Main.hs @@ -450,12 +450,6 @@ componentsMap lbi _v _distdir f = do reverse <$> readIORef lr --- componentOptions' :: (LocalBuildInfo, Verbosity, FilePath) --- -> Bool --- -> [String] --- -> (LocalBuildInfo -> Verbosity -> GhcOptions -> IO a) --- -> (GhcOptions -> GhcOptions) --- -> IO [(ChComponentName, a)] componentOptions' (lbi, v, distdir) inplaceFlag flags rf f = do let pd = localPkgDescr lbi includeDirs <- componentsMap lbi v distdir $ \_c clbi bi -> do @@ -463,7 +457,6 @@ componentOptions' (lbi, v, distdir) inplaceFlag flags rf f = do , (componentInternalDeps clbi, hsSourceDirs bi,componentIncludes clbi)) let includeDirMap = Map.fromList $ map snd includeDirs - -- putStrLn $ "componentGhcOptions':includeDirMap=" ++ show includeDirMap componentsMap lbi v distdir $ \c clbi bi -> do let outdir = componentOutDir lbi c @@ -474,15 +467,8 @@ componentOptions' (lbi, v, distdir) inplaceFlag flags rf f = do opts = componentGhcOptions normal lbi bi clbi' outdir opts' = f opts - -- putStrLn $ "componentGhcOptions':opts'=" ++ show opts' - -- putStrLn $ "************************componentGhcOptions':adopts=" ++ show (ghcOptSourcePath adopts) rf lbi v $ nubPackageFlags $ opts' `mappend` adopts -componentOptions :: (LocalBuildInfo, Verbosity, FilePath) - -> Bool - -> [String] - -> (GhcOptions -> GhcOptions) - -> IO [(ChComponentName, [String])] componentOptions (lbi, v, distdir) inplaceFlag flags f = componentOptions' (lbi, v, distdir) inplaceFlag flags renderGhcOptions' f @@ -508,45 +494,44 @@ removeInplaceDeps _v lbi pd clbi includeDirs = let let (ideps, deps) = partition (isInplaceDep lbi c) (componentPackageDeps c) (_, incs) = partition (isInplaceCompInc c) (componentIncludes c) - hasIdeps = not $ null ideps + hasIdeps' = not $ null ideps c' = c { componentPackageDeps = deps , componentInternalDeps = [] , componentIncludes = incs } - in (hasIdeps,c') + in (hasIdeps',c') + + cleanRecursiveOpts comp libbi libclbi = + let + -- libbi = libBuildInfo lib + liboutdir = componentOutDir lbi comp + (_,libclbi') = removeInplace libclbi + (extraIncludes,extraDeps') = recursiveIncludeDirs includeDirs (componentUnitId libclbi) + (_,extraDeps) = partition (isInplaceCompInc libclbi) extraDeps' + opts = (componentGhcOptions normal lbi libbi libclbi' liboutdir) { + ghcOptPackageDBs = [] + } + in + opts { ghcOptSourcePath = ghcOptSourcePath opts <> toNubListR extraIncludes + , ghcOptPackages = ghcOptPackages opts <> toNubListR extraDeps } + (hasIdeps,clbi') = removeInplace clbi libopts = case (getLibraryClbi pd lbi,getExeClbi pd lbi) of (Just (lib, libclbi),_) | hasIdeps -> let libbi = libBuildInfo lib - liboutdir = componentOutDir lbi (CLib lib) - (_,libclbi') = removeInplace libclbi - (extraIncludes,extraDeps') = recursiveIncludeDirs includeDirs (componentUnitId libclbi) - (_,extraDeps) = partition (isInplaceCompInc libclbi) extraDeps' - opts = (componentGhcOptions normal lbi libbi libclbi' liboutdir) { - ghcOptPackageDBs = [] - } in - opts { ghcOptSourcePath = ghcOptSourcePath opts <> toNubListR extraIncludes - , ghcOptPackages = ghcOptPackages opts <> toNubListR extraDeps } + cleanRecursiveOpts (CLib lib) libbi libclbi (_,Just (exe,execlbi)) | hasIdeps -> let exebi = buildInfo exe - exeoutdir = componentOutDir lbi (CExe exe) - (_,execlbi') = removeInplace execlbi - (extraIncludes,extraDeps') = recursiveIncludeDirs includeDirs (componentUnitId execlbi) - (_,extraDeps) = partition (isInplaceCompInc execlbi) extraDeps' - opts = (componentGhcOptions normal lbi exebi execlbi' exeoutdir) { - ghcOptPackageDBs = [] - } in - opts { ghcOptSourcePath = ghcOptSourcePath opts <> toNubListR extraIncludes - , ghcOptPackages = ghcOptPackages opts <> toNubListR extraDeps } + cleanRecursiveOpts (CExe exe) exebi execlbi _ -> mempty in (clbi', libopts) - -- in error $ "removeInplaceDeps:(clbi')=" ++ show (clbi' ) --- TODO: Is this valid? It assumes a tree, will never return for a graph + +#if CH_MIN_VERSION_Cabal(2,0,0) recursiveIncludeDirs :: Map.Map UnitId ([UnitId],[FilePath], [(OpenUnitId, ModuleRenaming)]) -> UnitId -> ([FilePath],[(OpenUnitId, ModuleRenaming)]) recursiveIncludeDirs includeDirs unit = go ([],[]) [unit] @@ -555,6 +540,7 @@ recursiveIncludeDirs includeDirs unit = go ([],[]) [unit] go (acp,acd) (u:us) = case Map.lookup u includeDirs of Nothing -> go (acp,acd) us Just (us',fps,pds) -> go (acp++fps,acd++pds) (us++us') +#endif initialBuildStepsForAllComponents distdir pd lbi v = initialBuildSteps distdir pd lbi v @@ -624,6 +610,10 @@ componentEntrypoints (CLib Library {..}) = ChLibEntrypoint (map gmModuleName exposedModules) (map gmModuleName $ otherModules libBuildInfo) +#if CH_MIN_VERSION_Cabal(2,0,0) +componentEntrypoints (CFLib (ForeignLib{..})) + = error $ "componentEntrypoints:Need to process ForeignLib Component" +#endif componentEntrypoints (CExe Executable {..}) = ChExeEntrypoint modulePath (map gmModuleName $ otherModules buildInfo) componentEntrypoints (CTest TestSuite { testInterface = TestSuiteExeV10 _ fp, ..}) @@ -646,7 +636,6 @@ isInplaceCompInc clbi (IndefFullUnitId _ _, _mmr) = False -- TODO: keep this for #if CH_MIN_VERSION_Cabal(2,0,0) isInplaceDep :: LocalBuildInfo -> ComponentLocalBuildInfo -> (UnitId, MungedPackageId) -> Bool isInplaceDep lbi clbi (uid, _mpid) = uid `elem` componentInternalDeps clbi --- isInplaceDep lbi clbi (uid, _mpid) = True #else isInplaceDep :: LocalBuildInfo -> (InstalledPackageId, PackageId) -> Bool # if CH_MIN_VERSION_Cabal(1,23,0) diff --git a/tests/GhcSession.hs b/tests/GhcSession.hs index f627cae..42193b9 100644 --- a/tests/GhcSession.hs +++ b/tests/GhcSession.hs @@ -27,9 +27,8 @@ main = do args <- getArgs topdir <- getCurrentDirectory res <- mapM (setup topdir test) $ case args of - [] -> [ - -- ("tests/exelib" , parseVer "1.10") - ("tests/exeintlib", parseVer "2.0") + [] -> [ ("tests/exelib" , parseVer "1.10") + , ("tests/exeintlib", parseVer "2.0") ] xs -> map (,parseVer "0") xs @@ -50,7 +49,6 @@ setup :: FilePath -> (FilePath -> IO [Bool]) -> (FilePath, Version) -> IO [Bool] setup topdir act (srcdir, min_cabal_ver) = do ci_ver <- cabalInstallVersion c_ver <- cabalInstallBuiltinCabalVersion - putStrLn $ "(ci_ver,c_ver)=" ++ show (ci_ver,c_ver) -- AZ-DEBUG let mreason | (ci_ver < parseVer "1.24") = Just $ "cabal-install-" ++ showVersion ci_ver ++ " is too old" @@ -65,9 +63,7 @@ setup topdir act (srcdir, min_cabal_ver) = do putStrLn $ "Skipping test '" ++ srcdir ++ "' because " ++ reason ++ "." return [] Nothing -> do - -- withSystemTempDirectory "cabal-helper.ghc-session.test" $ \dir -> do - let dir = "/tmp/xxx" - do + withSystemTempDirectory "cabal-helper.ghc-session.test" $ \dir -> do setCurrentDirectory $ topdir srcdir run "cabal" [ "sdist", "--output-dir", dir ] @@ -80,9 +76,7 @@ setup topdir act (srcdir, min_cabal_ver) = do run x xs = do print $ x:xs o <- readProcess x xs "" - putStrLn "=======================output============" -- AZ-DEBUG putStrLn o - putStrLn "=======================output-done=======" -- AZ-DEBUG return () test :: FilePath -> IO [Bool] @@ -91,9 +85,7 @@ test dir = do cs <- runQuery qe $ components $ (,,) <$> entrypoints <.> ghcOptions forM cs $ \(ep, opts, cn) -> do let sopts = intercalate " " $ map formatArg $ "ghc" : opts - putStrLn "======================= cn ============" -- AZ-DEBUG putStrLn $ "\n" ++ show cn ++ ": " ++ sopts - putStrLn "======================= cn done =======" -- AZ-DEBUG compileModule ep opts where formatArg x @@ -103,8 +95,6 @@ test dir = do compileModule :: ChEntrypoint -> [String] -> IO Bool compileModule ep opts = do - putStrLn $ "compileModule:ep=" ++ show ep - E.handle (\(ec :: ExitCode) -> print ec >> return False) $ do defaultErrorHandler defaultFatalMessager defaultFlushOut $ do -- cgit v1.2.3