cabal-helper 0.5.2.0 → 0.5.3.0
raw patch · 9 files changed
+498/−356 lines, 9 filesdep ~basedep ~bytestringdep ~data-defaultPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, bytestring, data-default, directory, filepath, mtl, process, template-haskell, temporary, transformers
API changes (from Hackage documentation)
Files
- CabalHelper/Common.hs +5/−0
- CabalHelper/Compile.hs +368/−0
- CabalHelper/Log.hs +14/−0
- CabalHelper/Main.hs +9/−5
- CabalHelper/Types.hs +10/−0
- CabalHelper/Wrapper.hs +2/−347
- Distribution/Helper.hs +1/−1
- cabal-helper.cabal +16/−3
- tests/Spec.hs +73/−0
CabalHelper/Common.hs view
@@ -30,6 +30,8 @@ import System.Environment import System.IO import System.Exit+import System.Directory+import System.FilePath import Text.ParserCombinators.ReadP import Prelude @@ -95,3 +97,6 @@ runReadP p i = case filter ((=="") . snd) $ readP_to_S p i of (a,""):[] -> a _ -> error $ "Error parsing: " ++ show i++appDataDir :: IO FilePath+appDataDir = (</> "cabal-helper") <$> getAppUserDataDirectory "ghc-mod"
+ CabalHelper/Compile.hs view
@@ -0,0 +1,368 @@+-- 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 RecordWildCards, FlexibleContexts #-}+module CabalHelper.Compile where++import Control.Applicative+import Control.Arrow+import Control.Exception as E+import Control.Monad+import Control.Monad.Trans.Maybe+import Control.Monad.IO.Class+import Data.Traversable+import Data.Char+import Data.List+import Data.Maybe+import Data.String+import Data.Version+import Text.Printf+import System.Directory+import System.FilePath+import System.Process+import System.Exit+import System.IO+import Prelude++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++compileHelper :: Options -> Version -> FilePath -> FilePath -> IO (Either ExitCode FilePath)+compileHelper opts cabalVer projdir distdir = withHelperSources $ \chdir -> do+ run [ compileCabalSource chdir -- 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+ , Right <$> MaybeT (cachedExe cabalVer)+ , compileSandbox chdir+ , compileGlobal chdir+ , cachedCabalPkg chdir+ , MaybeT (Just <$> compilePrivatePkgDb chdir)+ ]++ where+ run actions = fromJust <$> runMaybeT (msum actions)++ 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+ -- TODO: add option to let user specify custom package-db, relevant when+ -- using a Cabal compiled from git!++ ver <- MaybeT $ find (== cabalVer) <$> listCabalVersions opts+ vLog opts $ logMsg ++ "user/global package-db"+ liftIO $ compileWithPkg chdir Nothing ver++ -- | Check if this version is available in the project sandbox+ compileSandbox :: FilePath -> MaybeT IO (Either ExitCode FilePath)+ compileSandbox chdir = do+ sandbox <- MaybeT $ getSandboxPkgDb projdir (display buildPlatform) =<< ghcVersion opts+ ver <- MaybeT $ find (== cabalVer) <$> listCabalVersions' opts (Just sandbox)+ vLog opts $ logMsg ++ "sandbox package-db"+ liftIO $ compileWithPkg chdir (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+ db_exists <- liftIO $ cabalPkgDbExists opts cabalVer+ case db_exists of+ False -> mzero+ True -> do+ db <- liftIO $ cabalPkgDb opts cabalVer+ vLog opts $ logMsg ++ "private package-db in " ++ db+ liftIO $ compileWithPkg chdir (Just db) cabalVer++ -- | See if we're in a cabal source tree+ compileCabalSource :: FilePath -> MaybeT IO (Either ExitCode FilePath)+ compileCabalSource chdir = 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+ False -> mzero+ True -> liftIO $ do+ ver <- cabalFileVersion <$> readFile cabalFile+ vLog opts $ "compiling helper with local Cabal source tree"+ compileWithCabalTree chdir ver projdir++ -- | Compile the requested cabal version into an isolated package-db+ compilePrivatePkgDb :: FilePath -> IO (Either ExitCode FilePath)+ compilePrivatePkgDb chdir = 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 ver []++ compileWithPkg chdir mdb ver =+ compile distdir opts $ Compile chdir Nothing mdb ver [cabalPkgId ver]++ cabalPkgId v = "Cabal-" ++ showVersion v++data Compile = Compile {+ cabalHelperSourceDir :: FilePath,+ cabalSourceDir :: Maybe FilePath,+ packageDb :: Maybe FilePath,+ cabalVersion :: Version,+ packageDeps :: [String]+ }++compile :: FilePath -> Options -> Compile -> IO (Either ExitCode FilePath)+compile distdir opts@Options {..} Compile {..} = do+ cCabalSourceDir <- canonicalizePath `traverse` cabalSourceDir+ appdir <- appDataDir++ let outdir' = maybe appdir (const $ distdir </> "cabal-helper") cCabalSourceDir+ createDirectoryIfMissing True outdir'+ outdir <- canonicalizePath outdir'++ let exedir' = maybe outdir (const distdir) cCabalSourceDir+ createDirectoryIfMissing True exedir'+ exedir <- canonicalizePath exedir'+ exe <- exePath' cabalVersion <$> canonicalizePath exedir++ vLog opts $ "outdir: " ++ outdir+ vLog opts $ "exedir: " ++ exedir++ let Version (mj:mi:_) _ = cabalVersion+ let ghc_opts =+ concat [+ [ "-outputdir", outdir+ , "-o", exe+ , "-optP-DCABAL_HELPER=1"+ , "-optP-DCABAL_MAJOR=" ++ show mj+ , "-optP-DCABAL_MINOR=" ++ show mi+ ],+ maybeToList $ ("-package-conf="++) <$> packageDb,+ map ("-i"++) $ nub $ ".":maybeToList cCabalSourceDir,++ if isNothing cCabalSourceDir+ then [ "-hide-all-packages"+ , "-package", "base"+ , "-package", "directory"+ , "-package", "filepath"+ , "-package", "process"+ , "-package", "bytestring"+ , "-package", "ghc-prim"+ ]+ else [],++ concatMap (\p -> ["-package", p]) packageDeps,+ [ "--make", "CabalHelper/Main.hs" ]+ ]++ 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 cabalHelperSourceDir) ghcProgram ghc_opts+ return $ case rv of+ ExitSuccess -> Right exe+ e@(ExitFailure _) -> Left e++exePath :: Version -> IO FilePath+exePath cabalVersion = do+ exePath' cabalVersion <$> appDataDir++exePath' :: Version-> FilePath -> FilePath+exePath' cabalVersion outdir =+ outdir </> "cabal-helper-" ++ showVersion version -- our ver+ ++ "-Cabal-" ++ showVersion cabalVersion++callProcessStderr' :: Maybe FilePath -> FilePath -> [String] -> IO ExitCode+callProcessStderr' mwd exe args = do+ (_, _, _, h) <- createProcess (proc exe args) { std_out = UseHandle stderr+ , cwd = mwd }+ waitForProcess h++callProcessStderr :: Maybe FilePath -> FilePath -> [String] -> IO ()+callProcessStderr mwd exe args = do+ rv <- callProcessStderr' mwd exe args+ case rv of+ ExitSuccess -> return ()+ ExitFailure v -> processFailedException "callProcessStderr" exe args v++processFailedException :: String -> String -> [String] -> Int -> IO a+processFailedException fn exe args rv =+ panic $ concat [fn, ": ", exe, " "+ , intercalate " " (map show args)+ , " (exit " ++ show rv ++ ")"]++installCabal :: Options -> Version -> IO FilePath+installCabal opts ver = do+ appdir <- appDataDir+ let sver = showVersion ver+ hPutStr stderr $ printf "\+\cabal-helper-wrapper: Installing a private copy of Cabal because we couldn't\n\+\find the right version in your global/user package-db, this might take a\n\+\while but will only happen once per Cabal version you're using.\n\+\\n\+\If anything goes horribly wrong just delete this directory and try again:\n\+\ %s\n\+\\n\+\If you want to avoid this automatic installation altogether install\n\+\version %s of Cabal manually (into your user or global package-db):\n\+\ $ cabal install Cabal --constraint \"Cabal == %s\"\n\+\\n\+\Installing Cabal %s ...\n" appdir sver sver sver++ db <- createPkgDb opts ver+ cabalInstallVer <- cabalInstallVersion opts+ cabal_opts <- return $ concat+ [+ [ "--package-db=clear"+ , "--package-db=global"+ , "--package-db=" ++ db+ , "--prefix=" ++ db </> "prefix"+ , "--with-ghc=" ++ ghcProgram opts+ ]+ , if cabalInstallVer >= Version [1,20,0,0] []+ then ["--no-require-sandbox"]+ else []+ , if ghcPkgProgram opts /= ghcPkgProgram defaultOptions+ then [ "--with-ghc-pkg=" ++ ghcPkgProgram opts ]+ else []+ , [ "install", "Cabal", "--constraint"+ , "Cabal == " ++ showVersion ver ]+ ]++ vLog opts $ intercalate " " $ map (("\""++) . (++"\"")) $ cabalProgram opts:cabal_opts++ callProcessStderr (Just "/") (cabalProgram opts) cabal_opts+ hPutStrLn stderr "done"+ return db++errorInstallCabal :: Version -> FilePath -> a+errorInstallCabal cabalVer _distdir = panic $ printf "\+\Installing Cabal version %s failed.\n\+\\n\+\You have the following choices to fix this:\n\+\\n\+\- The easiest way to try and fix this is just reconfigure the project and try\n\+\ again:\n\+\ $ cabal clean && cabal configure\n\+\\n\+\- If that fails you can try to install the version of Cabal mentioned above\n\+\ into your global/user package-db somehow, you'll probably have to fix\n\+\ something otherwise it wouldn't have failed above:\n\+\ $ cabal install Cabal --constraint 'Cabal == %s'\n\+\\n\+\- If you're using `Build-Type: Simple`:\n\+\ - You can see if you can reinstall your cabal-install executable while\n\+\ having it linked to a version of Cabal that's available in you\n\+\ package-dbs or can be built automatically:\n\+\ $ ghc-pkg list | grep Cabal # find an available Cabal version\n\+\ Cabal-W.X.Y.Z\n\+\ $ cabal install cabal-install --constraint 'Cabal == W.X.*'\n\+\ Afterwards you'll have to reconfigure your project:\n\+\ $ cabal clean && cabal configure\n\+\\n\+\- If you're using `Build-Type: Custom`:\n\+\ - Have cabal-install rebuild your Setup.hs executable with a version of the\n\+\ Cabal library that you have available in your global/user package-db:\n\+\ $ cabal clean && cabal configure\n\+\ You might also have to install some version of the Cabal to do this:\n\+\ $ cabal install Cabal\n\+\\n" sver sver+ where+ sver = showVersion cabalVer++cachedExe :: Version -> IO (Maybe FilePath)+cachedExe cabalVersion = do+ exe <- exePath cabalVersion+ exists <- doesFileExist exe+ return $ if exists then Just exe else Nothing++listCabalVersions :: Options -> IO [Version]+listCabalVersions opts = listCabalVersions' opts Nothing++-- TODO: Include sandbox? Probably only relevant for build-type:custom projects.+listCabalVersions' :: Options -> Maybe FilePath -> IO [Version]+listCabalVersions' Options {..} mdb = do+ let mdbopt = ("--package-conf="++) <$> mdb+ opts = ["list", "--simple-output", "Cabal"] ++ maybeToList mdbopt++ catMaybes . map (fmap snd . parsePkgId . fromString) . words+ <$> readProcess ghcPkgProgram opts ""++cabalPkgDbExists :: Options -> Version -> IO Bool+cabalPkgDbExists opts ver = do+ db <- cabalPkgDb opts ver+ dexists <- doesDirectoryExist db+ case dexists of+ False -> return False+ True -> do+ vers <- listCabalVersions' opts (Just db)+ return $ ver `elem` vers+++ghcVersion :: Options -> IO Version+ghcVersion Options {..} = do+ parseVer . trim <$> readProcess ghcProgram ["--numeric-version"] ""++ghcPkgVersion :: Options -> IO Version+ghcPkgVersion Options {..} = do+ parseVer . trim . dropWhile (not . isDigit) <$> readProcess ghcPkgProgram ["--version"] ""++cabalInstallVersion :: Options -> IO Version+cabalInstallVersion Options {..} = do+ parseVer . trim <$> readProcess cabalProgram ["--numeric-version"] ""++trim :: String -> String+trim = dropWhileEnd isSpace++createPkgDb :: Options -> Version -> IO FilePath+createPkgDb opts@Options {..} ver = do+ db <- cabalPkgDb opts ver+ exists <- doesDirectoryExist db+ when (not exists) $ callProcessStderr Nothing ghcPkgProgram ["init", db]+ return db++cabalPkgDb :: Options -> Version -> IO FilePath+cabalPkgDb opts ver = do+ appdir <- appDataDir+ ghcVer <- ghcVersion opts+ return $ appdir </> "Cabal-" ++ showVersion ver ++ "-db-" ++ showVersion ghcVer++-- | Find @version: XXX@ delcaration in a cabal file+cabalFileVersion :: String -> Version+cabalFileVersion cabalFile =+ fromJust $ parseVer . extract <$> find ("version:" `isPrefixOf`) ls+ where+ ls = map (map toLower) $ lines cabalFile+ extract = dropWhile (/=':') >>> drop 1 >>> dropWhile isSpace >>> takeWhile (not . isSpace)
+ CabalHelper/Log.hs view
@@ -0,0 +1,14 @@+module CabalHelper.Log where++import Control.Monad+import Control.Monad.IO.Class+import Data.String+import System.IO+import Prelude++import CabalHelper.Types++vLog :: MonadIO m => Options -> String -> m ()+vLog Options { verbose = True } msg =+ liftIO $ hPutStrLn stderr msg+vLog _ _ = return ()
CabalHelper/Main.hs view
@@ -81,7 +81,7 @@ import CabalHelper.Sandbox import CabalHelper.Common-import CabalHelper.Types+import CabalHelper.Types hiding (Options(..)) usage = do prog <- getProgName@@ -201,10 +201,9 @@ ghcOptPackages = ghcOptPackages opts }) - let res' = res { ghcOptPackageDBs = withPackageDB lbi- , ghcOptHideAllPackages = Flag True- , ghcOptPackages = nub $ ghcOptPackages res- }+ let res' = nubPackageFlags $ res { ghcOptPackageDBs = withPackageDB lbi+ , ghcOptHideAllPackages = Flag True+ } Just . ChResponseList <$> renderGhcOptions' lbi v res' @@ -375,7 +374,12 @@ isInplaceDep :: (InstalledPackageId, PackageId) -> Bool isInplaceDep (ipid, pid) = inplacePackageId pid == ipid +#if CABAL_MAJOR == 1 && CABAL_MINOR >= 22+-- >= 1.22 uses NubListR+nubPackageFlags opts = opts+#else nubPackageFlags opts = opts { ghcOptPackages = nub $ ghcOptPackages opts }+#endif renderGhcOptions' lbi v opts = do #if CABAL_MAJOR == 1 && CABAL_MINOR < 20
CabalHelper/Types.hs view
@@ -55,3 +55,13 @@ | ChPkgUser | ChPkgSpecific FilePath deriving (Eq, Ord, Read, Show, Generic)++data Options = Options {+ verbose :: Bool+ , ghcProgram :: FilePath+ , ghcPkgProgram :: FilePath+ , cabalProgram :: FilePath+}++defaultOptions :: Options+defaultOptions = Options False "ghc" "ghc-pkg" "cabal"
CabalHelper/Wrapper.hs view
@@ -13,17 +13,11 @@ -- -- 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 Main where import Control.Applicative-import Control.Arrow-import Control.Exception as E import Control.Monad-import Control.Monad.Trans.Maybe-import Control.Monad.IO.Class-import Data.Traversable import Data.Char import Data.List import Data.Maybe@@ -43,10 +37,10 @@ import Distribution.Text (display) import Paths_cabal_helper (version)-import CabalHelper.Data import CabalHelper.Common import CabalHelper.GuessGhc-import CabalHelper.Sandbox (getSandboxPkgDb)+import CabalHelper.Compile+import CabalHelper.Types usage :: IO () usage = do@@ -62,16 +56,6 @@ \ [--with-cabal=CABAL_PATH]\n\ \ PROJ_DIR DIST_DIR ( print-exe | [CABAL_HELPER_ARGS...] ) )\n" -data Options = Options {- verbose :: Bool- , ghcProgram :: FilePath- , ghcPkgProgram :: FilePath- , cabalProgram :: FilePath-}--defaultOptions :: Options-defaultOptions = Options False "ghc" "ghc-pkg" "cabal"- globalArgSpec :: [OptDescr (Options -> Options)] globalArgSpec = [ option "" ["verbose"] "Be more verbose" $@@ -142,332 +126,3 @@ (_,_,_,h) <- createProcess $ proc exe args exitWith =<< waitForProcess h _ -> error "invalid command line"--appDataDir :: IO FilePath-appDataDir = (</> "cabal-helper") <$> getAppUserDataDirectory "ghc-mod"--compileHelper :: Options -> Version -> FilePath -> FilePath -> IO (Either ExitCode FilePath)-compileHelper opts cabalVer projdir distdir = withHelperSources $ \chdir -> do- run [ compileCabalSource chdir -- 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- , Right <$> MaybeT (cachedExe cabalVer)- , compileSandbox chdir- , compileGlobal chdir- , cachedCabalPkg chdir- , MaybeT (Just <$> compilePrivatePkgDb chdir)- ]-- where- run actions = fromJust <$> runMaybeT (msum actions)-- 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- -- TODO: add option to let user specify custom package-db, relevant when- -- using a Cabal compiled from git!-- ver <- MaybeT $ find (== cabalVer) <$> listCabalVersions opts- vLog opts $ logMsg ++ "user/global package-db"- liftIO $ compileWithPkg chdir Nothing ver-- -- | Check if this version is available in the project sandbox- compileSandbox :: FilePath -> MaybeT IO (Either ExitCode FilePath)- compileSandbox chdir = do- sandbox <- MaybeT $ getSandboxPkgDb projdir (display buildPlatform) =<< ghcVersion opts- ver <- MaybeT $ find (== cabalVer) <$> listCabalVersions' opts (Just sandbox)- vLog opts $ logMsg ++ "sandbox package-db"- liftIO $ compileWithPkg chdir (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- db_exists <- liftIO $ cabalPkgDbExists opts cabalVer- case db_exists of- False -> mzero- True -> do- db <- liftIO $ cabalPkgDb opts cabalVer- vLog opts $ logMsg ++ "private package-db in " ++ db- liftIO $ compileWithPkg chdir (Just db) cabalVer-- -- | See if we're in a cabal source tree- compileCabalSource :: FilePath -> MaybeT IO (Either ExitCode FilePath)- compileCabalSource chdir = 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- False -> mzero- True -> liftIO $ do- ver <- cabalFileVersion <$> readFile cabalFile- vLog opts $ "compiling helper with local Cabal source tree"- compileWithCabalTree chdir ver projdir-- -- | Compile the requested cabal version into an isolated package-db- compilePrivatePkgDb :: FilePath -> IO (Either ExitCode FilePath)- compilePrivatePkgDb chdir = 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 ver []-- compileWithPkg chdir mdb ver =- compile distdir opts $ Compile chdir Nothing mdb ver [cabalPkgId ver]-- cabalPkgId v = "Cabal-" ++ showVersion v--errorInstallCabal :: Version -> FilePath -> a-errorInstallCabal cabalVer _distdir = panic $ printf "\-\Installing Cabal version %s failed.\n\-\\n\-\You have the following choices to fix this:\n\-\\n\-\- The easiest way to try and fix this is just reconfigure the project and try\n\-\ again:\n\-\ $ cabal clean && cabal configure\n\-\\n\-\- If that fails you can try to install the version of Cabal mentioned above\n\-\ into your global/user package-db somehow, you'll probably have to fix\n\-\ something otherwise it wouldn't have failed above:\n\-\ $ cabal install Cabal --constraint 'Cabal == %s'\n\-\\n\-\- If you're using `Build-Type: Simple`:\n\-\ - You can see if you can reinstall your cabal-install executable while\n\-\ having it linked to a version of Cabal that's available in you\n\-\ package-dbs or can be built automatically:\n\-\ $ ghc-pkg list | grep Cabal # find an available Cabal version\n\-\ Cabal-W.X.Y.Z\n\-\ $ cabal install cabal-install --constraint 'Cabal == W.X.*'\n\-\ Afterwards you'll have to reconfigure your project:\n\-\ $ cabal clean && cabal configure\n\-\\n\-\- If you're using `Build-Type: Custom`:\n\-\ - Have cabal-install rebuild your Setup.hs executable with a version of the\n\-\ Cabal library that you have available in your global/user package-db:\n\-\ $ cabal clean && cabal configure\n\-\ You might also have to install some version of the Cabal to do this:\n\-\ $ cabal install Cabal\n\-\\n" sver sver- where- sver = showVersion cabalVer---data Compile = Compile {- cabalHelperSourceDir :: FilePath,- cabalSourceDir :: Maybe FilePath,- packageDb :: Maybe FilePath,- cabalVersion :: Version,- packageDeps :: [String]- }--compile :: FilePath -> Options -> Compile -> IO (Either ExitCode FilePath)-compile distdir opts@Options {..} Compile {..} = do- cCabalSourceDir <- canonicalizePath `traverse` cabalSourceDir- appdir <- appDataDir-- let outdir' = maybe appdir (const $ distdir </> "cabal-helper") cCabalSourceDir- createDirectoryIfMissing True outdir'- outdir <- canonicalizePath outdir'-- let exedir' = maybe outdir (const distdir) cCabalSourceDir- createDirectoryIfMissing True exedir'- exedir <- canonicalizePath exedir'- exe <- exePath' cabalVersion <$> canonicalizePath exedir-- vLog opts $ "outdir: " ++ outdir- vLog opts $ "exedir: " ++ exedir-- let Version (mj:mi:_) _ = cabalVersion- let ghc_opts =- concat [- [ "-outputdir", outdir- , "-o", exe- , "-optP-DCABAL_HELPER=1"- , "-optP-DCABAL_MAJOR=" ++ show mj- , "-optP-DCABAL_MINOR=" ++ show mi- ],- maybeToList $ ("-package-conf="++) <$> packageDb,- map ("-i"++) $ nub $ ".":maybeToList cCabalSourceDir,-- if isNothing cCabalSourceDir- then [ "-hide-all-packages"- , "-package", "base"- , "-package", "directory"- , "-package", "filepath"- , "-package", "process"- , "-package", "bytestring"- , "-package", "ghc-prim"- ]- else [],-- concatMap (\p -> ["-package", p]) packageDeps,- [ "--make", "CabalHelper/Main.hs" ]- ]-- 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 cabalHelperSourceDir) ghcProgram ghc_opts- return $ case rv of- ExitSuccess -> Right exe- e@(ExitFailure _) -> Left e--exePath :: Version -> IO FilePath-exePath cabalVersion = do- exePath' cabalVersion <$> appDataDir--exePath' :: Version-> FilePath -> FilePath-exePath' cabalVersion outdir =- outdir </> "cabal-helper-" ++ showVersion version -- our ver- ++ "-Cabal-" ++ showVersion cabalVersion--cachedExe :: Version -> IO (Maybe FilePath)-cachedExe cabalVersion = do- exe <- exePath cabalVersion- exists <- doesFileExist exe- return $ if exists then Just exe else Nothing--callProcessStderr' :: Maybe FilePath -> FilePath -> [String] -> IO ExitCode-callProcessStderr' mwd exe args = do- (_, _, _, h) <- createProcess (proc exe args) { std_out = UseHandle stderr- , cwd = mwd }- waitForProcess h--callProcessStderr :: Maybe FilePath -> FilePath -> [String] -> IO ()-callProcessStderr mwd exe args = do- rv <- callProcessStderr' mwd exe args- case rv of- ExitSuccess -> return ()- ExitFailure v -> processFailedException "callProcessStderr" exe args v--processFailedException :: String -> String -> [String] -> Int -> IO a-processFailedException fn exe args rv =- panic $ concat [fn, ": ", exe, " "- , intercalate " " (map show args)- , " (exit " ++ show rv ++ ")"]--installCabal :: Options -> Version -> IO FilePath-installCabal opts ver = do- appdir <- appDataDir- let sver = showVersion ver- hPutStr stderr $ printf "\-\cabal-helper-wrapper: Installing a private copy of Cabal because we couldn't\n\-\find the right version in your global/user package-db, this might take a\n\-\while but will only happen once per Cabal version you're using.\n\-\\n\-\If anything goes horribly wrong just delete this directory and try again:\n\-\ %s\n\-\\n\-\If you want to avoid this automatic installation altogether install\n\-\version %s of Cabal manually (into your user or global package-db):\n\-\ $ cabal install Cabal --constraint \"Cabal == %s\"\n\-\\n\-\Installing Cabal %s ...\n" appdir sver sver sver-- db <- createPkgDb opts ver- cabalInstallVer <- cabalInstallVersion opts- cabal_opts <- return $ concat- [- [ "--package-db=clear"- , "--package-db=global"- , "--package-db=" ++ db- , "--prefix=" ++ db </> "prefix"- , "--with-ghc=" ++ ghcProgram opts- ]- , if cabalInstallVer >= Version [1,20,0,0] []- then ["--no-require-sandbox"]- else []- , if ghcPkgProgram opts /= ghcPkgProgram defaultOptions- then [ "--with-ghc-pkg=" ++ ghcPkgProgram opts ]- else []- , [ "install", "Cabal", "--constraint"- , "Cabal == " ++ showVersion ver ]- ]-- vLog opts $ intercalate " " $ map (("\""++) . (++"\"")) $ cabalProgram opts:cabal_opts-- callProcessStderr (Just "/") (cabalProgram opts) cabal_opts- hPutStrLn stderr "done"- return db--ghcVersion :: Options -> IO Version-ghcVersion Options {..} = do- parseVer . trim <$> readProcess ghcProgram ["--numeric-version"] ""--ghcPkgVersion :: Options -> IO Version-ghcPkgVersion Options {..} = do- parseVer . trim . dropWhile (not . isDigit) <$> readProcess ghcPkgProgram ["--version"] ""--cabalInstallVersion :: Options -> IO Version-cabalInstallVersion Options {..} = do- parseVer . trim <$> readProcess cabalProgram ["--numeric-version"] ""--trim :: String -> String-trim = dropWhileEnd isSpace--createPkgDb :: Options -> Version -> IO FilePath-createPkgDb opts@Options {..} ver = do- db <- cabalPkgDb opts ver- exists <- doesDirectoryExist db- when (not exists) $ callProcessStderr Nothing ghcPkgProgram ["init", db]- return db--cabalPkgDb :: Options -> Version -> IO FilePath-cabalPkgDb opts ver = do- appdir <- appDataDir- ghcVer <- ghcVersion opts- return $ appdir </> "Cabal-" ++ showVersion ver ++ "-db-" ++ showVersion ghcVer--cabalPkgDbExists :: Options -> Version -> IO Bool-cabalPkgDbExists opts ver = do- db <- cabalPkgDb opts ver- dexists <- doesDirectoryExist db- case dexists of- False -> return False- True -> do- vers <- listCabalVersions' opts (Just db)- return $ ver `elem` vers--listCabalVersions :: Options -> IO [Version]-listCabalVersions opts = listCabalVersions' opts Nothing---- TODO: Include sandbox? Probably only relevant for build-type:custom projects.-listCabalVersions' :: Options -> Maybe FilePath -> IO [Version]-listCabalVersions' Options {..} mdb = do- let mdbopt = ("--package-conf="++) <$> mdb- opts = ["list", "--simple-output", "Cabal"] ++ maybeToList mdbopt-- catMaybes . map (fmap snd . parsePkgId . fromString) . words- <$> readProcess ghcPkgProgram opts ""---- | Find @version: XXX@ delcaration in a cabal file-cabalFileVersion :: String -> Version-cabalFileVersion cabalFile =- fromJust $ parseVer . extract <$> find ("version:" `isPrefixOf`) ls- where- ls = map (map toLower) $ lines cabalFile- extract = dropWhile (/=':') >>> drop 1 >>> dropWhile isSpace >>> takeWhile (not . isSpace)--vLog :: MonadIO m => Options -> String -> m ()-vLog Options { verbose = True } msg =- liftIO $ hPutStrLn stderr msg-vLog _ _ = return ()
Distribution/Helper.hs view
@@ -81,7 +81,7 @@ import Prelude import Paths_cabal_helper (getLibexecDir)-import CabalHelper.Types+import CabalHelper.Types hiding (Options(..)) import CabalHelper.Sandbox -- | Paths or names of various programs we need.
cabal-helper.cabal view
@@ -1,5 +1,5 @@ name: cabal-helper-version: 0.5.2.0+version: 0.5.3.0 synopsis: Simple interface to some of Cabal's configuration state used by ghc-mod description: @cabal-helper@ provides a library which wraps the internal use of@@ -66,6 +66,8 @@ CabalHelper.Common CabalHelper.GuessGhc CabalHelper.Data+ CabalHelper.Compile+ CabalHelper.Log GHC-Options: -Wall X-Install-Target: $libexecdir Build-Depends: base >= 4.5 && < 5@@ -78,16 +80,27 @@ , template-haskell , temporary , utf8-string-+ , ghc-prim Test-Suite spec Default-Language: Haskell2010 Type: exitcode-stdio-1.0 Main-Is: Spec.hs- Hs-Source-Dirs: tests+ Hs-Source-Dirs: tests, . GHC-Options: -Wall Build-Depends: base >= 4.5 && < 5 , cabal-helper , extra , unix+ , Cabal >= 1.14 && < 1.23+ , data-default+ , directory+ , filepath+ , transformers+ , mtl , process+ , ghc-prim+ , bytestring+ , utf8-string+ , template-haskell+ , temporary
tests/Spec.hs view
@@ -2,10 +2,83 @@ import System.Environment.Extra (lookupEnv) import System.Posix.Env (setEnv) import System.Process+import System.Exit import Data.Maybe+import Data.Version import Data.Functor+import Control.Exception as E+import Control.Arrow +import CabalHelper.Common+import CabalHelper.Compile+import CabalHelper.Types+ main :: IO () main = do flip (setEnv "HOME") True =<< fromMaybe "/tmp" <$> lookupEnv "TMPDIR" writeAutogenFiles readProcess "." "./dist"++ _ <- system "cabal update"++ let vers :: [(Version, [Version])]+ vers = map (parseVer *** map parseVer) [+ ("7.4", [ "1.14.0"+ ]),++ ("7.6", [ "1.16.0"+ , "1.16.0.1"+ , "1.16.0.2"+ , "1.16.0.3"+ ]),++ ("7.8", [+-- "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.20.0.0"+ , "1.20.0.1"+ , "1.20.0.2"+ , "1.20.0.3"+ , "1.22.0.0"+ , "1.22.1.0"+ , "1.22.1.1"+ ]),++ ("7.10", [+ "1.22.2.0"+ , "1.22.3.0"+ , "1.22.4.0"+ ])+ ]++ ghcVer <- ghcVersion defaultOptions++ let cabalVers = concat $ map snd $ dropWhile ((<ghcVer) . fst) vers++ rvs <- mapM compilePrivatePkgDb cabalVers++ if any isLeft' rvs+ then exitFailure+ else exitSuccess+ where+ isLeft' (Left _) = True+ isLeft' (Right _) = False++compilePrivatePkgDb :: Version -> IO (Either ExitCode FilePath)+compilePrivatePkgDb cabalVer = do+ db <- installCabal defaultOptions cabalVer `E.catch`+ \(SomeException _) -> errorInstallCabal cabalVer "dist"+ compileWithPkg "." (Just db) cabalVer++compileWithPkg :: FilePath -> Maybe FilePath -> Version -> IO (Either ExitCode FilePath)+compileWithPkg chdir mdb ver =+ compile "dist" defaultOptions $ Compile chdir Nothing mdb ver [cabalPkgId ver]++cabalPkgId :: Version -> String+cabalPkgId v = "Cabal-" ++ showVersion v