diff options
-rw-r--r-- | CabalHelper/Compiletime/Compat/Version.hs (renamed from CabalHelper/Compat/Version.hs) | 2 | ||||
-rw-r--r-- | CabalHelper/Compiletime/Compile.hs (renamed from CabalHelper/Compile.hs) | 193 | ||||
-rw-r--r-- | CabalHelper/Compiletime/Data.hs | 79 | ||||
-rw-r--r-- | CabalHelper/Compiletime/GuessGhc.hs (renamed from CabalHelper/GuessGhc.hs) | 2 | ||||
-rw-r--r-- | CabalHelper/Compiletime/Log.hs (renamed from CabalHelper/Log.hs) | 4 | ||||
-rw-r--r-- | CabalHelper/Compiletime/Wrapper.hs (renamed from CabalHelper/Wrapper.hs) | 22 | ||||
-rw-r--r-- | CabalHelper/Data.hs | 46 | ||||
-rw-r--r-- | CabalHelper/Runtime/Licenses.hs (renamed from CabalHelper/Licenses.hs) | 2 | ||||
-rw-r--r-- | CabalHelper/Runtime/Main.hs (renamed from CabalHelper/Main.hs) | 9 | ||||
-rw-r--r-- | CabalHelper/Shared/Common.hs (renamed from CabalHelper/Common.hs) | 2 | ||||
-rw-r--r-- | CabalHelper/Shared/Sandbox.hs (renamed from CabalHelper/Sandbox.hs) | 4 | ||||
-rw-r--r-- | CabalHelper/Shared/Types.hs (renamed from CabalHelper/Types.hs) | 2 | ||||
-rw-r--r-- | Distribution/Helper.hs | 8 | ||||
-rw-r--r-- | cabal-helper.cabal | 77 | ||||
-rw-r--r-- | tests/CompileTest.hs (renamed from tests/Spec.hs) | 21 |
15 files changed, 271 insertions, 202 deletions
diff --git a/CabalHelper/Compat/Version.hs b/CabalHelper/Compiletime/Compat/Version.hs index d2389aa..853aca5 100644 --- a/CabalHelper/Compat/Version.hs +++ b/CabalHelper/Compiletime/Compat/Version.hs @@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-} -module CabalHelper.Compat.Version +module CabalHelper.Compiletime.Compat.Version ( DataVersion , toDataVersion , fromDataVersion diff --git a/CabalHelper/Compile.hs b/CabalHelper/Compiletime/Compile.hs index b933a3b..8da3802 100644 --- a/CabalHelper/Compile.hs +++ b/CabalHelper/Compiletime/Compile.hs @@ -14,7 +14,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 #-} -module CabalHelper.Compile where +module CabalHelper.Compiletime.Compile where import Control.Applicative import Control.Arrow @@ -41,14 +41,13 @@ import Distribution.System (buildPlatform) import Distribution.Text (display) import Paths_cabal_helper (version) -import CabalHelper.Data -import CabalHelper.Common -import CabalHelper.Sandbox (getSandboxPkgDb) -import CabalHelper.Types -import CabalHelper.Log +import CabalHelper.Compiletime.Data +import CabalHelper.Compiletime.Log +import CabalHelper.Shared.Common +import CabalHelper.Shared.Sandbox (getSandboxPkgDb) +import CabalHelper.Shared.Types data Compile = Compile { - compCabalHelperSourceDir :: FilePath, compCabalSourceDir :: Maybe FilePath, compPackageDb :: Maybe FilePath, compCabalVersion :: Either String Version, @@ -56,23 +55,23 @@ data Compile = Compile { } compileHelper :: Options -> Version -> FilePath -> FilePath -> IO (Either ExitCode FilePath) -compileHelper opts cabalVer projdir distdir = withHelperSources $ \chdir -> do +compileHelper opts cabalVer projdir distdir = do case cabalPkgDb opts of Nothing -> run [ -- TODO: here ghc's caching fails and it always recompiles, probably -- because we write the sources to a tempdir and they always look -- newer than the Cabal sources, not sure if we can fix this - compileCabalSource chdir + compileCabalSource , Right <$> MaybeT (cachedExe cabalVer) - , compileSandbox chdir - , compileGlobal chdir - , cachedCabalPkg chdir - , MaybeT (Just <$> compilePrivatePkgDb chdir) + , compileSandbox + , compileGlobal + , cachedCabalPkg + , MaybeT (Just <$> compilePrivatePkgDb) ] mdb -> run [ Right <$> MaybeT (cachedExe cabalVer) - , liftIO $ compileWithPkg chdir mdb cabalVer + , liftIO $ compileWithPkg mdb cabalVer ] where @@ -80,93 +79,106 @@ compileHelper opts cabalVer projdir distdir = withHelperSources $ \chdir -> do logMsg = "compiling helper with Cabal from " - -- for relaxed deps: find (sameMajorVersionAs cabalVer) . reverse . sort -- | Check if this version is globally available - compileGlobal :: FilePath -> MaybeT IO (Either ExitCode FilePath) - compileGlobal chdir = do + compileGlobal :: MaybeT IO (Either ExitCode FilePath) + compileGlobal = do ver <- MaybeT $ find (== cabalVer) <$> listCabalVersions opts vLog opts $ logMsg ++ "user/global package-db" - liftIO $ compileWithPkg chdir Nothing ver + liftIO $ compileWithPkg Nothing ver -- | Check if this version is available in the project sandbox - compileSandbox :: FilePath -> MaybeT IO (Either ExitCode FilePath) - compileSandbox chdir = do + compileSandbox :: MaybeT IO (Either ExitCode FilePath) + compileSandbox = do sandbox <- MaybeT $ getSandboxPkgDb projdir (display buildPlatform) =<< ghcVersion opts ver <- MaybeT $ logSomeError opts "compileSandbox" $ find (== cabalVer) <$> listCabalVersions' opts (Just sandbox) vLog opts $ logMsg ++ "sandbox package-db" - liftIO $ compileWithPkg chdir (Just sandbox) ver + liftIO $ compileWithPkg (Just sandbox) ver -- | Check if we already compiled this version of cabal into a private -- package-db - cachedCabalPkg :: FilePath -> MaybeT IO (Either ExitCode FilePath) - cachedCabalPkg chdir = do + cachedCabalPkg :: MaybeT IO (Either ExitCode FilePath) + cachedCabalPkg = do db_exists <- liftIO $ cabalPkgDbExists opts cabalVer case db_exists of False -> mzero True -> do - db <- liftIO $ getPrivateCabalPkgDb opts (showVersion cabalVer) + db <- liftIO $ getPrivateCabalPkgDb opts (Right cabalVer) vLog opts $ logMsg ++ "private package-db in " ++ db - liftIO $ compileWithPkg chdir (Just db) cabalVer + liftIO $ compileWithPkg (Just db) cabalVer -- | See if we're in a cabal source tree - compileCabalSource :: FilePath -> MaybeT IO (Either ExitCode FilePath) - compileCabalSource chdir = do + compileCabalSource :: MaybeT IO (Either ExitCode FilePath) + compileCabalSource = do let cabalFile = projdir </> "Cabal.cabal" - isCabalMagicVer = cabalVer == Version [1,9999] [] cabalSrc <- liftIO $ doesFileExist cabalFile - - when isCabalMagicVer $ - vLog opts $ "cabal magic version (1.9999) found" - - when cabalSrc $ - vLog opts $ "directory above distdir looks like cabal source tree (Cabal.cabal exists)" - - case isCabalMagicVer || cabalSrc of + case cabalSrc of False -> mzero True -> liftIO $ do + vLog opts $ "directory above distdir looks like cabal source tree (Cabal.cabal exists)" ver <- cabalFileVersion <$> readFile cabalFile vLog opts $ "compiling helper with local Cabal source tree" - compileWithCabalTree chdir ver projdir + compileWithCabalTree ver projdir -- | Compile the requested cabal version into an isolated package-db - compilePrivatePkgDb :: FilePath -> IO (Either ExitCode FilePath) - compilePrivatePkgDb chdir = do + compilePrivatePkgDb :: IO (Either ExitCode FilePath) + compilePrivatePkgDb = do db <- installCabal opts cabalVer `E.catch` \(SomeException _) -> errorInstallCabal cabalVer distdir - compileWithPkg chdir (Just db) cabalVer - - compileWithCabalTree chdir ver srcDir = - compile distdir opts $ Compile chdir (Just srcDir) Nothing (Right ver) [] - - compileWithPkg chdir mdb ver = - compile distdir opts $ Compile chdir Nothing mdb (Right ver) [cabalPkgId ver] + compileWithPkg (Just db) cabalVer + + compileWithCabalTree ver srcDir = + compile distdir opts $ Compile { + compCabalSourceDir = Just srcDir, + compPackageDb = Nothing, + compCabalVersion = Right ver, + compPackageDeps = [] + } + + compileWithPkg mdb ver = + compile distdir opts $ Compile { + compCabalSourceDir = Nothing, + compPackageDb = mdb, + compCabalVersion = Right ver, + compPackageDeps = [cabalPkgId ver] + } cabalPkgId v = "Cabal-" ++ showVersion v compile :: FilePath -> Options -> Compile -> IO (Either ExitCode FilePath) compile distdir opts@Options {..} Compile {..} = do - cCabalSourceDir <- canonicalizePath `traverse` compCabalSourceDir + cnCabalSourceDir <- canonicalizePath `traverse` compCabalSourceDir appdir <- appDataDir - let outdir' = - maybe appdir (const $ distdir </> "cabal-helper") cCabalSourceDir - createDirectoryIfMissing True outdir' - outdir <- canonicalizePath outdir' + let (outdir, exedir, exe, mchsrcdir) = + case cnCabalSourceDir of + Nothing -> ( exeName compCabalVersion <.> "build" + , appdir + , appdir </> exeName compCabalVersion + , Nothing + ) + Just _ -> ( distdir </> "cabal-helper" + , distdir + , distdir </> "cabal-helper" </> "cabal-helper" + , Just $ distdir </> "cabal-helper" + ) - let exedir' = maybe outdir (const distdir) cCabalSourceDir - createDirectoryIfMissing True exedir' - exedir <- canonicalizePath exedir' - exe <- exePath' compCabalVersion <$> canonicalizePath exedir + createDirectoryIfMissing True outdir + createDirectoryIfMissing True exedir + withHelperSources mchsrcdir $ \compCabalHelperSourceDir -> do + + _ <- liftIO $ system $ "ls -lR " ++ compCabalHelperSourceDir + + vLog opts $ "sourcedir: " ++ compCabalHelperSourceDir vLog opts $ "outdir: " ++ outdir - vLog opts $ "exedir: " ++ exedir + vLog opts $ "exe: " ++ exe let (mj1:mj2:mi:_) = case compCabalVersion of - Left _commitid -> [1, 10000, 0] + Left _commitid -> [10000000, 0, 0] Right (Version vs _) -> vs let ghc_opts = concat [ [ "-outputdir", outdir @@ -178,9 +190,9 @@ compile distdir opts@Options {..} Compile {..} = do \|| (major1) == "++show mj1++" && (major2) == "++show mj2++" && (minor) <= "++show mi++")" ], maybeToList $ ("-package-conf="++) <$> compPackageDb, - map ("-i"++) $ nub $ ".":maybeToList cCabalSourceDir, + map ("-i"++) $ nub $ "":compCabalHelperSourceDir:maybeToList cnCabalSourceDir, - if isNothing cCabalSourceDir + if isNothing cnCabalSourceDir then [ "-hide-all-packages" , "-package", "base" , "-package", "containers" @@ -193,29 +205,29 @@ compile distdir opts@Options {..} Compile {..} = do else [], concatMap (\p -> ["-package", p]) compPackageDeps, - [ "--make", "CabalHelper/Main.hs" ] + [ "--make" + , compCabalHelperSourceDir</>"CabalHelper"</>"Runtime"</>"Main.hs" + ] ] - vLog opts $ intercalate " " $ map (("\""++) . (++"\"")) $ ghcProgram:ghc_opts + vLog opts $ intercalate " " $ map (("'"++) . (++"'")) $ ghcProgram:ghc_opts -- TODO: touch exe after, ghc doesn't do that if the input files didn't -- actually change - rv <- callProcessStderr' (Just compCabalHelperSourceDir) ghcProgram ghc_opts + rv <- callProcessStderr' Nothing ghcProgram ghc_opts return $ case rv of ExitSuccess -> Right exe e@(ExitFailure _) -> Left e -exePath :: Either String Version -> IO FilePath -exePath compCabalVersion = do - exePath' compCabalVersion <$> appDataDir - -exePath' :: Either String Version -> FilePath -> FilePath -exePath' (Left commitid) outdir = - outdir </> "cabal-helper-" ++ showVersion version -- our ver - ++ "-Cabal-HEAD-" ++ commitid -exePath' (Right compCabalVersion) outdir = - outdir </> "cabal-helper-" ++ showVersion version -- our ver - ++ "-Cabal-" ++ showVersion compCabalVersion +exeName :: Either String Version -> String +exeName (Left commitid) = intercalate "-" + [ "cabal-helper" ++ showVersion version -- our ver + , "CabalHEAD" ++ commitid + ] +exeName (Right compCabalVersion) = intercalate "-" + [ "cabal-helper" ++ showVersion version -- our ver + , "Cabal" ++ showVersion compCabalVersion + ] callProcessStderr' :: Maybe FilePath -> FilePath -> [String] -> IO ExitCode callProcessStderr' mwd exe args = do @@ -254,20 +266,20 @@ installCabal opts ver = do \\n\ \Installing Cabal %s ...\n" appdir sver sver sver - withSystemTempDirectory "cabal-helper" $ \tmpdir -> do + withSystemTempDirectory "cabal-helper-Cabal-source" $ \tmpdir -> do let mpatch :: Maybe (FilePath -> IO ()) mpatch = snd <$> find ((ver`elem`) . fst) patchyCabalVersions msrcdir <- sequenceA $ unpackPatchedCabal opts ver tmpdir <$> mpatch - db <- createPkgDb opts (showVersion ver) + db <- createPkgDb opts (Right ver) cabalInstall opts db (maybe (Right ver) Left msrcdir) return db installCabalHEAD :: Options -> IO (FilePath, String) installCabalHEAD opts = do - withSystemTempDirectory "cabal-helper" $ \tmpdir -> do + withSystemTempDirectory "cabal-helper-CabalHEAD-source" $ \tmpdir -> do (srcdir, commit) <- unpackCabalHEAD tmpdir - db <- createPkgDb opts commit + db <- createPkgDb opts (Left commit) cabalInstall opts db (Left srcdir) return (db, commit) @@ -423,9 +435,10 @@ errorInstallCabal cabalVer _distdir = panic $ printf "\ cachedExe :: Version -> IO (Maybe FilePath) cachedExe compCabalVersion = do - exe <- exePath (Right compCabalVersion) - exists <- doesFileExist exe - return $ if exists then Just exe else Nothing + appdir <- appDataDir + let exe = appdir </> exeName (Right compCabalVersion) + exists <- doesFileExist exe + return $ if exists then Just exe else Nothing listCabalVersions :: Options -> IO [Version] listCabalVersions opts = listCabalVersions' opts Nothing @@ -440,14 +453,14 @@ listCabalVersions' Options {..} mdb = do <$> readProcess ghcPkgProgram opts "" cabalPkgDbExists :: Options -> Version -> IO Bool -cabalPkgDbExists opts ver = do - db <- getPrivateCabalPkgDb opts (showVersion ver) +cabalPkgDbExists opts cabalVer = do + db <- getPrivateCabalPkgDb opts (Right cabalVer) dexists <- doesDirectoryExist db case dexists of False -> return False True -> do vers <- listCabalVersions' opts (Just db) - return $ ver `elem` vers + return $ cabalVer `elem` vers ghcVersion :: Options -> IO Version @@ -465,18 +478,20 @@ cabalInstallVersion Options {..} = do trim :: String -> String trim = dropWhileEnd isSpace -createPkgDb :: Options -> String -> IO FilePath -createPkgDb opts@Options {..} ver = do - db <- getPrivateCabalPkgDb opts ver +createPkgDb :: Options -> Either String Version -> IO FilePath +createPkgDb opts@Options {..} cabalVer = do + db <- getPrivateCabalPkgDb opts cabalVer exists <- doesDirectoryExist db when (not exists) $ callProcessStderr Nothing ghcPkgProgram ["init", db] return db -getPrivateCabalPkgDb :: Options -> String -> IO FilePath -getPrivateCabalPkgDb opts ver = do +getPrivateCabalPkgDb :: Options -> Either String Version -> IO FilePath +getPrivateCabalPkgDb opts cabalVer = do appdir <- appDataDir ghcVer <- ghcVersion opts - return $ appdir </> "Cabal-" ++ ver ++ "-db-" ++ showVersion ghcVer + return $ appdir </> exeName cabalVer ++ "-ghc" ++ showVersion ghcVer ++ ".package-db" + +-- "Cabal" ++ ver ++ "-ghc" ++ showVersion ghcVer -- | Find @version: XXX@ delcaration in a cabal file cabalFileVersion :: String -> Version diff --git a/CabalHelper/Compiletime/Data.hs b/CabalHelper/Compiletime/Data.hs new file mode 100644 index 0000000..f04c704 --- /dev/null +++ b/CabalHelper/Compiletime/Data.hs @@ -0,0 +1,79 @@ +-- cabal-helper: Simple interface to Cabal's configuration state +-- Copyright (C) 2015 Daniel Gröber <dxld ÄT darkboxed DOT org> +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU Affero General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU Affero General Public License for more details. +-- +-- 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 TemplateHaskell #-} +{-# OPTIONS_GHC -fforce-recomp #-} +module CabalHelper.Compiletime.Data where + +import Control.Monad +import Control.Monad.IO.Class +import Data.Functor +import Data.Time.Clock +import Data.Time.Clock.POSIX +import qualified Data.ByteString as BS +import qualified Data.ByteString.UTF8 as UTF8 +import Language.Haskell.TH +import System.Directory +import System.Environment +import System.FilePath +import System.IO.Temp +import Prelude + +withSystemTempDirectoryEnv :: String -> (FilePath -> IO b) -> IO b +withSystemTempDirectoryEnv tpl f = do + m <- liftIO $ lookupEnv "CABAL_HELPER_KEEP_SOURCEDIR" + case m of + Nothing -> withSystemTempDirectory tpl f + Just _ -> do + tmpdir <- getCanonicalTemporaryDirectory + f =<< createTempDirectory tmpdir tpl + +withHelperSources :: Maybe FilePath -> (FilePath -> IO a) -> IO a +withHelperSources mdir action = withDir mdir $ \dir -> do + let chdir = dir </> "CabalHelper" + liftIO $ do + createDirectoryIfMissing True $ chdir </> "Runtime" + createDirectoryIfMissing True $ chdir </> "Shared" + + let modtime = read + -- See https://reproducible-builds.org/specs/source-date-epoch/ + $(runIO $ do + msde <- lookupEnv "SOURCE_DATE_EPOCH" + let parse :: String -> POSIXTime + parse = fromInteger . read + utctime <- getCurrentTime + return $ LitE . StringL $ show $ + maybe utctime (posixSecondsToUTCTime . parse) msde) + + liftIO $ forM_ sourceFiles $ \(fn, src) -> do + let path = chdir </> fn + BS.writeFile path $ UTF8.fromString src + setModificationTime path modtime + + action dir + where + withDir (Just dir) = \f -> f dir + withDir Nothing = withSystemTempDirectoryEnv "cabal-helper-source" + + +sourceFiles :: [(FilePath, String)] +sourceFiles = + [ ("Runtime/Main.hs", $(LitE . StringL <$> runIO (UTF8.toString <$> BS.readFile "CabalHelper/Runtime/Main.hs"))) + , ("Runtime/Licenses.hs", $(LitE . StringL <$> runIO (UTF8.toString <$> BS.readFile "CabalHelper/Runtime/Licenses.hs"))) + , ("Shared/Common.hs", $(LitE . StringL <$> runIO (UTF8.toString <$> BS.readFile "CabalHelper/Shared/Common.hs"))) + , ("Shared/Sandbox.hs", $(LitE . StringL <$> runIO (UTF8.toString <$> BS.readFile "CabalHelper/Shared/Sandbox.hs"))) + , ("Shared/Types.hs", $(LitE . StringL <$> runIO (UTF8.toString <$> BS.readFile "CabalHelper/Shared/Types.hs"))) + ] diff --git a/CabalHelper/GuessGhc.hs b/CabalHelper/Compiletime/GuessGhc.hs index 8b0ebce..e1cf577 100644 --- a/CabalHelper/GuessGhc.hs +++ b/CabalHelper/Compiletime/GuessGhc.hs @@ -1,4 +1,4 @@ -module CabalHelper.GuessGhc (guessToolFromGhcPath) where +module CabalHelper.Compiletime.GuessGhc (guessToolFromGhcPath) where import Data.Maybe import Data.Char diff --git a/CabalHelper/Log.hs b/CabalHelper/Compiletime/Log.hs index bbc84a6..e4033f1 100644 --- a/CabalHelper/Log.hs +++ b/CabalHelper/Compiletime/Log.hs @@ -1,4 +1,4 @@ -module CabalHelper.Log where +module CabalHelper.Compiletime.Log where import Control.Monad import Control.Monad.IO.Class @@ -7,7 +7,7 @@ import Data.String import System.IO import Prelude -import CabalHelper.Types +import CabalHelper.Shared.Types vLog :: MonadIO m => Options -> String -> m () vLog Options { verbose = True } msg = diff --git a/CabalHelper/Wrapper.hs b/CabalHelper/Compiletime/Wrapper.hs index 5805f3f..d002886 100644 --- a/CabalHelper/Wrapper.hs +++ b/CabalHelper/Compiletime/Wrapper.hs @@ -39,11 +39,11 @@ import Distribution.PackageDescription.Parse (readPackageDescription) import Distribution.Package (packageName, packageVersion) import Paths_cabal_helper (version) -import CabalHelper.Common -import CabalHelper.GuessGhc -import CabalHelper.Compile -import CabalHelper.Types -import CabalHelper.Compat.Version +import CabalHelper.Compiletime.Compat.Version +import CabalHelper.Compiletime.Compile +import CabalHelper.Compiletime.GuessGhc +import CabalHelper.Shared.Common +import CabalHelper.Shared.Types usage :: IO () usage = do @@ -109,10 +109,17 @@ guessProgramPaths opts = do same f o o' = f o == f o' dopts = defaultOptions +overrideVerbosityEnvVar :: Options -> IO Options +overrideVerbosityEnvVar opts = do + x <- lookup "GHC_MOD_DEBUG" <$> getEnvironment + return $ case x of + Just _ -> opts { verbose = True } + Nothing -> opts + main :: IO () main = handlePanic $ do (opts', args) <- parseCommandArgs defaultOptions <$> getArgs - opts <- guessProgramPaths opts' + opts <- overrideVerbosityEnvVar =<< guessProgramPaths opts' case args of [] -> usage "help":[] -> usage @@ -121,7 +128,8 @@ main = handlePanic $ do "print-build-platform":[] -> putStrLn $ display buildPlatform projdir:_distdir:"package-id":[] -> do - v <- maybe silent (const deafening) . lookup "GHC_MOD_DEBUG" <$> getEnvironment + let v | verbose opts = deafening + | otherwise = silent -- ghc-mod will catch multiple cabal files existing before we get here [cfile] <- filter isCabalFile <$> getDirectoryContents projdir gpd <- readPackageDescription v (projdir </> cfile) diff --git a/CabalHelper/Data.hs b/CabalHelper/Data.hs deleted file mode 100644 index 2c3404a..0000000 --- a/CabalHelper/Data.hs +++ /dev/null @@ -1,46 +0,0 @@ --- cabal-helper: Simple interface to Cabal's configuration state --- Copyright (C) 2015 Daniel Gröber <dxld ÄT darkboxed DOT org> --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU Affero General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- (at your option) any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU Affero General Public License for more details. --- --- 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 TemplateHaskell #-} -{-# OPTIONS_GHC -fforce-recomp #-} -module CabalHelper.Data where - -import Control.Monad -import Data.Functor -import qualified Data.ByteString as BS -import qualified Data.ByteString.UTF8 as UTF8 -import Language.Haskell.TH -import System.FilePath -import System.Directory -import System.IO.Temp -import Prelude - -withHelperSources :: (FilePath -> IO a) -> IO a -withHelperSources action = withSystemTempDirectory "cabal-helper" $ \dir -> do - let chdir = dir </> "CabalHelper" - createDirectory chdir - forM_ sourceFiles $ \(fn, src) -> - BS.writeFile (chdir </> fn) $ UTF8.fromString src - action dir - -sourceFiles :: [(FilePath, String)] -sourceFiles = - [ ("Main.hs", $(LitE . StringL <$> runIO (UTF8.toString <$> BS.readFile "CabalHelper/Main.hs"))) - , ("Common.hs", $(LitE . StringL <$> runIO (UTF8.toString <$> BS.readFile "CabalHelper/Common.hs"))) - , ("Sandbox.hs", $(LitE . StringL <$> runIO (UTF8.toString <$> BS.readFile "CabalHelper/Sandbox.hs"))) - , ("Licenses.hs", $(LitE . StringL <$> runIO (UTF8.toString <$> BS.readFile "CabalHelper/Licenses.hs"))) - , ("Types.hs", $(LitE . StringL <$> runIO (UTF8.toString <$> BS.readFile "CabalHelper/Types.hs"))) - ] diff --git a/CabalHelper/Licenses.hs b/CabalHelper/Runtime/Licenses.hs index 55a1600..a1794ea 100644 --- a/CabalHelper/Licenses.hs +++ b/CabalHelper/Runtime/Licenses.hs @@ -5,7 +5,7 @@ #define CH_MIN_VERSION_Cabal MIN_VERSION_Cabal #endif -module CabalHelper.Licenses ( +module CabalHelper.Runtime.Licenses ( displayDependencyLicenseList , groupByLicense , getDependencyInstalledPackageInfos diff --git a/CabalHelper/Main.hs b/CabalHelper/Runtime/Main.hs index 4cd6000..570cf58 100644 --- a/CabalHelper/Main.hs +++ b/CabalHelper/Runtime/Main.hs @@ -120,10 +120,11 @@ import System.IO import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO) import Text.Printf -import CabalHelper.Licenses -import CabalHelper.Sandbox -import CabalHelper.Common -import CabalHelper.Types hiding (Options(..)) +import CabalHelper.Shared.Sandbox +import CabalHelper.Shared.Common +import CabalHelper.Shared.Types hiding (Options(..)) + +import CabalHelper.Runtime.Licenses usage = do prog <- getProgName diff --git a/CabalHelper/Common.hs b/CabalHelper/Shared/Common.hs index 37c217a..3d79f90 100644 --- a/CabalHelper/Common.hs +++ b/CabalHelper/Shared/Common.hs @@ -15,7 +15,7 @@ -- along with this program. If not, see <http://www.gnu.org/licenses/>. {-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-} -module CabalHelper.Common where +module CabalHelper.Shared.Common where import Control.Applicative import Control.Exception as E diff --git a/CabalHelper/Sandbox.hs b/CabalHelper/Shared/Sandbox.hs index fa413cc..3523edc 100644 --- a/CabalHelper/Sandbox.hs +++ b/CabalHelper/Shared/Sandbox.hs @@ -1,4 +1,4 @@ -module CabalHelper.Sandbox where +module CabalHelper.Shared.Sandbox where import Control.Applicative import Data.Char @@ -43,7 +43,7 @@ extractSandboxDbDir conf = extractValue <$> parse conf keyLen = length key parse = listToMaybe . filter (key `isPrefixOf`) . lines - extractValue = CabalHelper.Sandbox.dropWhileEnd isSpace . dropWhile isSpace . drop keyLen + extractValue = CabalHelper.Shared.Sandbox.dropWhileEnd isSpace . dropWhile isSpace . drop keyLen mightExist :: FilePath -> IO (Maybe FilePath) diff --git a/CabalHelper/Types.hs b/CabalHelper/Shared/Types.hs index a134f08..18d532b 100644 --- a/CabalHelper/Types.hs +++ b/CabalHelper/Shared/Types.hs @@ -15,7 +15,7 @@ -- along with this program. If not, see <http://www.gnu.org/licenses/>. {-# LANGUAGE DeriveGeneric, DeriveDataTypeable, DefaultSignatures #-} -module CabalHelper.Types where +module CabalHelper.Shared.Types where import GHC.Generics import Data.Version diff --git a/Distribution/Helper.hs b/Distribution/Helper.hs index 7f34b09..7bd76e9 100644 --- a/Distribution/Helper.hs +++ b/Distribution/Helper.hs @@ -96,8 +96,8 @@ import GHC.Generics import Prelude import Paths_cabal_helper (getLibexecDir) -import CabalHelper.Types hiding (Options(..)) -import CabalHelper.Sandbox +import CabalHelper.Shared.Types hiding (Options(..)) +import CabalHelper.Shared.Sandbox -- | Paths or names of various programs we need. data Programs = Programs { @@ -394,12 +394,12 @@ getSandboxPkgDb :: (FilePath -> [String] -> String -> IO String) -- ^ GHC version (@cProjectVersion@ is your friend) -> IO (Maybe FilePath) getSandboxPkgDb readProc = - CabalHelper.Sandbox.getSandboxPkgDb $ unsafePerformIO $ buildPlatform readProc + CabalHelper.Shared.Sandbox.getSandboxPkgDb $ unsafePerformIO $ buildPlatform readProc buildPlatform :: (FilePath -> [String] -> String -> IO String) -> IO String buildPlatform readProc = do exe <- findLibexecExe - CabalHelper.Sandbox.dropWhileEnd isSpace <$> readProc exe ["print-build-platform"] "" + CabalHelper.Shared.Sandbox.dropWhileEnd isSpace <$> readProc exe ["print-build-platform"] "" -- | This exception is thrown by all 'runQuery' functions if the internal -- wrapper executable cannot be found. You may catch this and present the user diff --git a/cabal-helper.cabal b/cabal-helper.cabal index 99d4200..64438c4 100644 --- a/cabal-helper.cabal +++ b/cabal-helper.cabal @@ -34,10 +34,9 @@ author: Daniel Gröber <dxld@darkboxed.org> maintainer: dxld@darkboxed.org category: Distribution build-type: Custom -cabal-version: >=1.10 +cabal-version: >=1.14 extra-source-files: README.md - CabalHelper/Main.hs - CabalHelper/Licenses.hs + CabalHelper/Runtime/*.hs source-repository head type: git @@ -54,11 +53,13 @@ custom-setup , transformers library - exposed-modules: Distribution.Helper - other-modules: Paths_cabal_helper - , CabalHelper.Types - , CabalHelper.Sandbox default-language: Haskell2010 + default-extensions: NondecreasingIndentation + exposed-modules: Distribution.Helper + other-modules: + CabalHelper.Shared.Sandbox + CabalHelper.Shared.Types + Paths_cabal_helper ghc-options: -Wall build-depends: base < 5 && >= 4.5 , Cabal < 2.1 && >= 2.0 || < 1.26 && >= 1.14 @@ -71,17 +72,19 @@ library executable cabal-helper-wrapper default-language: Haskell2010 + default-extensions: NondecreasingIndentation other-extensions: TemplateHaskell - main-is: CabalHelper/Wrapper.hs - other-modules: Paths_cabal_helper - CabalHelper.Types - CabalHelper.Common - CabalHelper.GuessGhc - CabalHelper.Data - CabalHelper.Compile - CabalHelper.Log - CabalHelper.Sandbox - CabalHelper.Compat.Version + main-is: CabalHelper/Compiletime/Wrapper.hs + other-modules: + CabalHelper.Compiletime.Compat.Version + CabalHelper.Compiletime.Compile + CabalHelper.Compiletime.Data + CabalHelper.Compiletime.GuessGhc + CabalHelper.Compiletime.Log + CabalHelper.Shared.Common + CabalHelper.Shared.Sandbox + CabalHelper.Shared.Types + Paths_cabal_helper ghc-options: -Wall scope: private x-scope: private @@ -89,34 +92,40 @@ executable cabal-helper-wrapper , 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 , transformers < 0.6 && >= 0.3.0.0 , mtl < 2.3 && >= 2.0 , process < 1.7 && >= 1.1.0.1 , temporary < 1.3 && >= 1.2.0.4 , utf8-string < 1.1 && >= 1.0.1.1 + , time < 1.9 && >= 1.8.0.3 , template-haskell , ghc-prim -test-suite spec +test-suite compile-test default-language: Haskell2010 + default-extensions: NondecreasingIndentation type: exitcode-stdio-1.0 - main-is: Spec.hs - other-modules: CabalHelper.Common - CabalHelper.Compile - CabalHelper.Data - CabalHelper.Log - CabalHelper.Sandbox - CabalHelper.Types + main-is: tests/CompileTest.hs + other-modules: + CabalHelper.Compiletime.Compat.Version + CabalHelper.Compiletime.Compile + CabalHelper.Compiletime.Data + CabalHelper.Compiletime.Log + CabalHelper.Shared.Common + CabalHelper.Shared.Sandbox + CabalHelper.Shared.Types Distribution.Helper Paths_cabal_helper - hs-source-dirs: tests, . + hs-source-dirs: . ghc-options: -Wall build-tools: cabal build-depends: base < 5 && >= 4.5 - , Cabal < 2.2 && >= 2.1 || < 1.26 && >= 1.14 + , bytestring < 0.11 && >= 0.9.2.1 + , 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 @@ -124,6 +133,7 @@ test-suite spec , process < 1.7 && >= 1.1.0.1 , temporary < 1.3 && >= 1.2.0.4 , utf8-string < 1.1 && >= 1.0.1.1 + , time < 1.9 && >= 1.8.0.3 -- additional test deps , extra < 1.6 && >= 1.4.10 @@ -131,21 +141,24 @@ test-suite spec , template-haskell , ghc-prim - , cabal-helper -- TODO: Use cabal_macros.h to replace -D flags by including it in -- CabalHelper.Data -- executable cabal-helper-main + default-language: Haskell2010 + default-extensions: NondecreasingIndentation if flag(dev) buildable: True else buildable: False - default-language: Haskell2010 - default-extensions: NondecreasingIndentation - main-is: CabalHelper/Main.hs + main-is: CabalHelper/Runtime/Main.hs other-modules: - ghc-options: -Wall -fno-warn-unused-imports -optP-DCABAL_MAJOR=1 -optP-DCABAL_MINOR=25 -optP-DCABAL_HELPER=1 -optP-DCABAL_HELPER_DEV=1 + CabalHelper.Runtime.Licenses + CabalHelper.Shared.Common + CabalHelper.Shared.Sandbox + CabalHelper.Shared.Types + ghc-options: -Wall -fno-warn-unused-imports build-depends: base , Cabal , containers diff --git a/tests/Spec.hs b/tests/CompileTest.hs index 1487b82..eb10b76 100644 --- a/tests/Spec.hs +++ b/tests/CompileTest.hs @@ -10,17 +10,17 @@ import Data.Version import Data.Functor import Data.Function import qualified Distribution.Compat.ReadP as Dist -import Distribution.Version hiding (Version) +import Distribution.Version hiding (Version, showVersion) 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 +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 @@ -135,21 +135,20 @@ compilePrivatePkgDb (Left HEAD) = do hPutStrLn stderr err return $ Left $ ExitFailure 1 Right (db, commit) -> - compileWithPkg "." (Just db) (Left 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 (Just db) (Right cabalVer) -compileWithPkg :: FilePath - -> Maybe FilePath +compileWithPkg :: Maybe FilePath -> Either String Version -> IO (Either ExitCode FilePath) -compileWithPkg chdir mdb ver = +compileWithPkg mdb ver = compile "dist" defaultOptions { verbose = True } $ - Compile chdir Nothing mdb ver [cabalPkgId ver] + Compile Nothing mdb ver [cabalPkgId ver] cabalPkgId :: Either String Version -> String cabalPkgId (Left _commitid) = "Cabal" |