Hello community, here is the log from the commit of package ghc-cabal-helper for openSUSE:Factory checked in at 2015-09-30 05:53:08 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-cabal-helper (Old) and /work/SRC/openSUSE:Factory/.ghc-cabal-helper.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-cabal-helper" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-cabal-helper/ghc-cabal-helper.changes 2015-09-08 17:47:23.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-cabal-helper.new/ghc-cabal-helper.changes 2015-09-30 05:53:13.000000000 +0200 @@ -1,0 +2,5 @@ +Mon Sep 28 13:52:02 UTC 2015 - mimi.vx@gmail.com + +- update to 0.6.0.0 + +------------------------------------------------------------------- Old: ---- cabal-helper-0.5.2.0.tar.gz New: ---- cabal-helper-0.6.0.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-cabal-helper.spec ++++++ --- /var/tmp/diff_new_pack.27h2vp/_old 2015-09-30 05:53:13.000000000 +0200 +++ /var/tmp/diff_new_pack.27h2vp/_new 2015-09-30 05:53:13.000000000 +0200 @@ -19,7 +19,7 @@ %global pkg_name cabal-helper %bcond_with tests Name: ghc-cabal-helper -Version: 0.5.2.0 +Version: 0.6.0.0 Release: 0 Summary: Simple interface to some of Cabal's configuration state used by ghc-mod License: AGPL-3.0+ ++++++ cabal-helper-0.5.2.0.tar.gz -> cabal-helper-0.6.0.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cabal-helper-0.5.2.0/CabalHelper/Common.hs new/cabal-helper-0.6.0.0/CabalHelper/Common.hs --- old/cabal-helper-0.5.2.0/CabalHelper/Common.hs 2015-08-20 04:02:22.000000000 +0200 +++ new/cabal-helper-0.6.0.0/CabalHelper/Common.hs 2015-09-07 08:02:26.000000000 +0200 @@ -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 @@ -48,20 +50,6 @@ prog <- getProgName hPutStrLn stderr $ prog ++ ": " ++ str -align :: String -> String -> String -> String -align n an str = let - h:rest = lines str - [hm] = match n h - rest' = [ move (hm - rm) r | r <- rest, rm <- match an r] - in - unlines (h:rest') - where - match p str' = maybeToList $ - fst <$> find ((p `isPrefixOf`) . snd) ([0..] `zip` tails str') - move i str' | i > 0 = replicate i ' ' ++ str' - move i str' = drop i str' - - -- | @getCabalConfigHeader "dist/setup-config"@ returns the cabal version and -- compiler version getCabalConfigHeader :: FilePath -> IO (Maybe (Version, (ByteString, Version))) @@ -95,3 +83,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" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cabal-helper-0.5.2.0/CabalHelper/Compile.hs new/cabal-helper-0.6.0.0/CabalHelper/Compile.hs --- old/cabal-helper-0.5.2.0/CabalHelper/Compile.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/cabal-helper-0.6.0.0/CabalHelper/Compile.hs 2015-09-07 08:02:26.000000000 +0200 @@ -0,0 +1,375 @@ +-- 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 + +data Compile = Compile { + compCabalHelperSourceDir :: FilePath, + compCabalSourceDir :: Maybe FilePath, + compPackageDb :: Maybe FilePath, + compCabalVersion :: Version, + compPackageDeps :: [String] + } + +compileHelper :: Options -> Version -> FilePath -> FilePath -> IO (Either ExitCode FilePath) +compileHelper opts cabalVer projdir distdir = withHelperSources $ \chdir -> 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 + , Right <$> MaybeT (cachedExe cabalVer) + , compileSandbox chdir + , compileGlobal chdir + , cachedCabalPkg chdir + , MaybeT (Just <$> compilePrivatePkgDb chdir) + ] + mdb -> + run [ Right <$> MaybeT (cachedExe cabalVer) + , liftIO $ compileWithPkg chdir mdb cabalVer + ] + + 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 $ getPrivateCabalPkgDb 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 + +compile :: FilePath -> Options -> Compile -> IO (Either ExitCode FilePath) +compile distdir opts@Options {..} Compile {..} = do + cCabalSourceDir <- canonicalizePath `traverse` compCabalSourceDir + 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' compCabalVersion <$> canonicalizePath exedir + + vLog opts $ "outdir: " ++ outdir + vLog opts $ "exedir: " ++ exedir + + let Version (mj:mi:_) _ = compCabalVersion + 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="++) <$> compPackageDb, + map ("-i"++) $ nub $ ".":maybeToList cCabalSourceDir, + + if isNothing cCabalSourceDir + then [ "-hide-all-packages" + , "-package", "base" + , "-package", "containers" + , "-package", "directory" + , "-package", "filepath" + , "-package", "process" + , "-package", "bytestring" + , "-package", "ghc-prim" + ] + else [], + + concatMap (\p -> ["-package", p]) compPackageDeps, + [ "--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 compCabalHelperSourceDir) ghcProgram ghc_opts + return $ case rv of + ExitSuccess -> Right exe + e@(ExitFailure _) -> Left e + +exePath :: Version -> IO FilePath +exePath compCabalVersion = do + exePath' compCabalVersion <$> appDataDir + +exePath' :: Version-> FilePath -> FilePath +exePath' compCabalVersion outdir = + outdir </> "cabal-helper-" ++ showVersion version -- our ver + ++ "-Cabal-" ++ showVersion compCabalVersion + +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 compCabalVersion = do + exe <- exePath compCabalVersion + 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 <- getPrivateCabalPkgDb 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 <- getPrivateCabalPkgDb opts ver + exists <- doesDirectoryExist db + when (not exists) $ callProcessStderr Nothing ghcPkgProgram ["init", db] + return db + +getPrivateCabalPkgDb :: Options -> Version -> IO FilePath +getPrivateCabalPkgDb 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) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cabal-helper-0.5.2.0/CabalHelper/Data.hs new/cabal-helper-0.6.0.0/CabalHelper/Data.hs --- old/cabal-helper-0.5.2.0/CabalHelper/Data.hs 2015-08-20 04:02:22.000000000 +0200 +++ new/cabal-helper-0.6.0.0/CabalHelper/Data.hs 2015-09-07 08:02:26.000000000 +0200 @@ -41,5 +41,6 @@ [ ("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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cabal-helper-0.5.2.0/CabalHelper/Licenses.hs new/cabal-helper-0.6.0.0/CabalHelper/Licenses.hs --- old/cabal-helper-0.5.2.0/CabalHelper/Licenses.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/cabal-helper-0.6.0.0/CabalHelper/Licenses.hs 2015-09-07 08:02:26.000000000 +0200 @@ -0,0 +1,102 @@ +{-# LANGUAGE CPP #-} +module CabalHelper.Licenses where + +-- Copyright (c) 2014, Jasper Van der Jeugt <m@jaspervdj.be> + +-------------------------------------------------------------------------------- +import Control.Arrow ((***), (&&&)) +import Control.Monad (forM_, unless) +import Data.List (foldl', sort) +import Data.Maybe (catMaybes) +import Data.Version (Version) +import Data.Set (Set) +import qualified Data.Set as Set +import Distribution.InstalledPackageInfo (InstalledPackageInfo) +import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo +import qualified Distribution.License as Cabal +import qualified Distribution.Package as Cabal +import qualified Distribution.Simple.Configure as Cabal +import qualified Distribution.Simple.LocalBuildInfo as Cabal +import qualified Distribution.Simple.PackageIndex as Cabal +import qualified Distribution.Text as Cabal +import System.Directory (getDirectoryContents) +import System.Exit (exitFailure) +import System.FilePath (takeExtension) +import System.IO (hPutStrLn, stderr) + +-------------------------------------------------------------------------------- + +#if CABAL_MAJOR == 1 && CABAL_MINOR > 22 +type PackageIndex a = Cabal.PackageIndex (InstalledPackageInfo.InstalledPackageInfo) +#elif CABAL_MAJOR == 1 && CABAL_MINOR >= 22 +type PackageIndex a = Cabal.PackageIndex (InstalledPackageInfo.InstalledPackageInfo_ a) +#else +type PackageIndex a = Cabal.PackageIndex +#endif + +findTransitiveDependencies + :: PackageIndex a + -> Set Cabal.InstalledPackageId + -> Set Cabal.InstalledPackageId +findTransitiveDependencies pkgIdx set0 = go Set.empty (Set.toList set0) + where + go set [] = set + go set (q : queue) + | q `Set.member` set = go set queue + | otherwise = + case Cabal.lookupInstalledPackageId pkgIdx q of + Nothing -> + -- Not found can mean that the package still needs to be + -- installed (e.g. a component of the target cabal package). + -- We can ignore those. + go set queue + Just ipi -> + go (Set.insert q set) + (InstalledPackageInfo.depends ipi ++ queue) + + +-------------------------------------------------------------------------------- +getDependencyInstalledPackageIds + :: Cabal.LocalBuildInfo -> Set Cabal.InstalledPackageId +getDependencyInstalledPackageIds lbi = + findTransitiveDependencies (Cabal.installedPkgs lbi) $ + Set.fromList $ map fst $ Cabal.externalPackageDeps lbi + +-------------------------------------------------------------------------------- +getDependencyInstalledPackageInfos + :: Cabal.LocalBuildInfo -> [InstalledPackageInfo] +getDependencyInstalledPackageInfos lbi = catMaybes $ + map (Cabal.lookupInstalledPackageId pkgIdx) $ + Set.toList (getDependencyInstalledPackageIds lbi) + where + pkgIdx = Cabal.installedPkgs lbi + + +-------------------------------------------------------------------------------- +groupByLicense + :: [InstalledPackageInfo] + -> [(Cabal.License, [InstalledPackageInfo])] +groupByLicense = foldl' + (\assoc ipi -> insert (InstalledPackageInfo.license ipi) ipi assoc) [] + where + -- 'Cabal.License' doesn't have an 'Ord' instance so we need to use an + -- association list instead of 'Map'. The number of licenses probably won't + -- exceed 100 so I think we're alright. + insert :: Eq k => k -> v -> [(k, [v])] -> [(k, [v])] + insert k v [] = [(k, [v])] + insert k v ((k', vs) : kvs) + | k == k' = (k, v : vs) : kvs + | otherwise = (k', vs) : insert k v kvs + + +-------------------------------------------------------------------------------- +displayDependencyLicenseList + :: [(Cabal.License, [InstalledPackageInfo])] + -> [(String, [(String, Version)])] +displayDependencyLicenseList = + map (Cabal.display *** map (getName &&& getVersion)) + where + getName = + Cabal.display . Cabal.pkgName . InstalledPackageInfo.sourcePackageId + getVersion = + Cabal.pkgVersion . InstalledPackageInfo.sourcePackageId diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cabal-helper-0.5.2.0/CabalHelper/Log.hs new/cabal-helper-0.6.0.0/CabalHelper/Log.hs --- old/cabal-helper-0.5.2.0/CabalHelper/Log.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/cabal-helper-0.6.0.0/CabalHelper/Log.hs 2015-09-07 08:02:26.000000000 +0200 @@ -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 () diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cabal-helper-0.5.2.0/CabalHelper/Main.hs new/cabal-helper-0.6.0.0/CabalHelper/Main.hs --- old/cabal-helper-0.5.2.0/CabalHelper/Main.hs 2015-08-20 04:02:22.000000000 +0200 +++ new/cabal-helper-0.6.0.0/CabalHelper/Main.hs 2015-09-07 08:02:26.000000000 +0200 @@ -79,28 +79,31 @@ import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO) import Text.Printf +import CabalHelper.Licenses import CabalHelper.Sandbox import CabalHelper.Common -import CabalHelper.Types +import CabalHelper.Types hiding (Options(..)) usage = do prog <- getProgName - hPutStr stderr $ align "(" "|" ("Usage: " ++ prog ++ " " ++ usageMsg) + hPutStr stderr $ "Usage: " ++ prog ++ " " ++ usageMsg where usageMsg = "" - ++"DIST_DIR ( version\n" - ++" | print-lbi [--human]\n" - ++" | write-autogen-files\n" - ++" | compiler-version\n" - ++" | ghc-options [--with-inplace]\n" - ++" | ghc-src-options [--with-inplace]\n" - ++" | ghc-pkg-options [--with-inplace]\n" - ++" | ghc-merged-pkg-options [--with-inplace]\n" - ++" | ghc-lang-options [--with-inplace]\n" - ++" | package-db-stack\n" - ++" | entrypoints\n" - ++" | source-dirs\n" - ++" ) ...\n" + ++"PROJ_DIR DIST_DIR [--with-* ...] (\n" + ++" version\n" + ++" | print-lbi [--human]\n" + ++" | write-autogen-files\n" + ++" | compiler-version\n" + ++" | ghc-options [--with-inplace]\n" + ++" | ghc-src-options [--with-inplace]\n" + ++" | ghc-pkg-options [--with-inplace]\n" + ++" | ghc-merged-pkg-options [--with-inplace]\n" + ++" | ghc-lang-options [--with-inplace]\n" + ++" | package-db-stack\n" + ++" | entrypoints\n" + ++" | source-dirs\n" + ++" | licenses\n" + ++" ) ...\n" commands :: [String] commands = [ "print-bli" @@ -112,7 +115,8 @@ , "ghc-lang-options" , "package-db-stack" , "entrypoints" - , "source-dirs"] + , "source-dirs" + , "licenses"] main :: IO () main = do @@ -201,10 +205,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' @@ -239,6 +242,10 @@ res <- componentsMap lbi v distdir $$ \_ _ bi -> return $ hsSourceDirs bi return $ Just $ ChResponseCompList (res ++ [(ChSetupHsName, [])]) + "licenses":[] -> do + return $ Just $ ChResponseLicenses $ + displayDependencyLicenseList $ groupByLicense $ getDependencyInstalledPackageInfos lbi + "print-lbi":flags -> case flags of ["--human"] -> print lbi >> return Nothing @@ -375,7 +382,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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cabal-helper-0.5.2.0/CabalHelper/Types.hs new/cabal-helper-0.6.0.0/CabalHelper/Types.hs --- old/cabal-helper-0.5.2.0/CabalHelper/Types.hs 2015-08-20 04:02:22.000000000 +0200 +++ new/cabal-helper-0.6.0.0/CabalHelper/Types.hs 2015-09-07 08:02:26.000000000 +0200 @@ -37,6 +37,7 @@ | ChResponsePkgDbs [ChPkgDb] | ChResponseLbi String | ChResponseVersion String Version + | ChResponseLicenses [(String, [(String, Version)])] deriving (Eq, Ord, Read, Show, Generic) data ChEntrypoint = ChSetupEntrypoint -- ^ Almost like 'ChExeEntrypoint' but @@ -55,3 +56,15 @@ | ChPkgUser | ChPkgSpecific FilePath deriving (Eq, Ord, Read, Show, Generic) + +data Options = Options { + verbose :: Bool + , ghcProgram :: FilePath + , ghcPkgProgram :: FilePath + , cabalProgram :: FilePath + , cabalVersion :: Maybe Version + , cabalPkgDb :: Maybe FilePath +} + +defaultOptions :: Options +defaultOptions = Options False "ghc" "ghc-pkg" "cabal" Nothing Nothing diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cabal-helper-0.5.2.0/CabalHelper/Wrapper.hs new/cabal-helper-0.6.0.0/CabalHelper/Wrapper.hs --- old/cabal-helper-0.5.2.0/CabalHelper/Wrapper.hs 2015-08-20 04:02:22.000000000 +0200 +++ new/cabal-helper-0.6.0.0/CabalHelper/Wrapper.hs 2015-09-07 08:02:26.000000000 +0200 @@ -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,15 +37,15 @@ 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 prog <- getProgName - hPutStr stderr $ align "(" "|" ("Usage: " ++ prog ++ " " ++ usageMsg) + hPutStr stderr $ "Usage: " ++ prog ++ " " ++ usageMsg where usageMsg = "\ \( print-appdatadir\n\ @@ -60,18 +54,10 @@ \ [--with-ghc=GHC_PATH]\n\ \ [--with-ghc-pkg=GHC_PKG_PATH]\n\ \ [--with-cabal=CABAL_PATH]\n\ +\ [--with-cabal-version=VERSION]\n\ +\ [--with-cabal-pkg-db=PKG_DB]\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" $ @@ -85,6 +71,13 @@ , option "" ["with-cabal"] "cabal-install executable to use" $ reqArg "PROG" $ \p o -> o { cabalProgram = p } + + , option "" ["with-cabal-version"] "Cabal library version to use" $ + reqArg "VERSION" $ \p o -> o { cabalVersion = Just $ parseVer p } + + , option "" ["with-cabal-pkg-db"] "package database to look for Cabal library in" $ + reqArg "PKG_DB" $ \p o -> o { cabalPkgDb = Just p } + ] where option :: [Char] -> [String] -> String -> ArgDescr a -> OptDescr a @@ -132,342 +125,18 @@ \- Check first line of: %s\n\ \- Maybe try: $ cabal configure" cfgf Just (hdrCabalVersion, _) -> do - eexe <- compileHelper opts hdrCabalVersion projdir distdir - case eexe of - Left e -> exitWith e - Right exe -> - case args' of - "print-exe":_ -> putStrLn exe - _ -> do - (_,_,_,h) <- createProcess $ proc exe args - exitWith =<< waitForProcess h + case cabalVersion opts of + Just ver | hdrCabalVersion /= ver -> panic $ printf "\ +\Cabal version %s was requested setup configuration was\n\ +\written by version %s" (showVersion ver) (showVersion hdrCabalVersion) + _ -> do + eexe <- compileHelper opts hdrCabalVersion projdir distdir + case eexe of + Left e -> exitWith e + Right exe -> + case args' of + "print-exe":_ -> putStrLn exe + _ -> do + (_,_,_,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 () diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cabal-helper-0.5.2.0/Distribution/Helper.hs new/cabal-helper-0.6.0.0/Distribution/Helper.hs --- old/cabal-helper-0.5.2.0/Distribution/Helper.hs 2015-08-20 04:02:22.000000000 +0200 +++ new/cabal-helper-0.6.0.0/Distribution/Helper.hs 2015-09-07 08:02:26.000000000 +0200 @@ -14,17 +14,24 @@ -- 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 CPP, FlexibleContexts, ConstraintKinds #-} +{-# LANGUAGE CPP, RecordWildCards, FlexibleContexts, ConstraintKinds #-} {-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, DeriveGeneric #-} module Distribution.Helper ( Programs(..) + , defaultPrograms + , QueryEnv + , qeReadProcess + , qePrograms + , qeProjectDir + , qeDistDir + , qeCabalPkgDb + , qeCabalVer + , defaultQueryEnv -- * Running Queries , Query , runQuery - , runQuery' - , runQuery'' -- * Queries against Cabal\'s on disk state @@ -36,6 +43,7 @@ , ghcPkgOptions , ghcMergedPkgOptions , ghcLangOptions + , pkgLicenses -- * Result types , ChModuleName(..) @@ -67,7 +75,6 @@ import Control.Exception as E import Data.Char import Data.List -import Data.Default import Data.Version import Data.Typeable import Distribution.Simple.BuildPaths (exeExtension) @@ -81,7 +88,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. @@ -91,8 +98,45 @@ ghcPkgProgram :: FilePath } deriving (Eq, Ord, Show, Read, Generic, Typeable) -instance Default Programs where - def = Programs "cabal" "ghc" "ghc-pkg" +defaultPrograms :: Programs +defaultPrograms = Programs "cabal" "ghc" "ghc-pkg" + +data QueryEnv = QueryEnv { + -- | How to start the cabal-helper process. Useful if you need to + -- capture stderr output from the helper. + qeReadProcess :: FilePath -> [String] -> String -> IO String, + + qePrograms :: Programs, + + -- | Path to project directory, i.e. the one containing the + -- @project.cabal@ file + qeProjectDir :: FilePath, + + -- | Path to the @dist/@ directory + qeDistDir :: FilePath, + + -- | Where to look for the Cabal library when linking the helper + qeCabalPkgDb :: Maybe FilePath, + + -- | If @dist/setup-config@ wasn\'t written by this version of Cabal throw + -- an error + qeCabalVer :: Maybe Version + } + +defaultQueryEnv :: FilePath + -- ^ Path to project directory, i.e. the one containing the + -- @project.cabal@ file + -> FilePath + -- ^ Path to the @dist/@ directory + -> QueryEnv +defaultQueryEnv projdir distdir = QueryEnv { + qeReadProcess = readProcess + , qePrograms = defaultPrograms + , qeProjectDir = projdir + , qeDistDir = distdir + , qeCabalPkgDb = Nothing + , qeCabalVer = Nothing + } data SomeLocalBuildInfo = SomeLocalBuildInfo { slbiPackageDbStack :: [ChPkgDb], @@ -102,7 +146,8 @@ slbiGhcSrcOptions :: [(ChComponentName, [String])], slbiGhcPkgOptions :: [(ChComponentName, [String])], slbiGhcMergedPkgOptions :: [String], - slbiGhcLangOptions :: [(ChComponentName, [String])] + slbiGhcLangOptions :: [(ChComponentName, [String])], + slbiPkgLicenses :: [(String, [(String, Version)])] } deriving (Eq, Ord, Read, Show) -- | Caches helper executable result so it doesn't have to be run more than once @@ -112,54 +157,20 @@ (ReaderT QueryEnv m) a } deriving (Functor, Applicative, Monad, MonadIO) -data QueryEnv = QueryEnv { - _qeReadProcess :: FilePath -> [String] -> String -> IO String, - _qeProgs :: Programs, - _qeProjectDir :: FilePath, - _qeDistDir :: FilePath - } - type MonadQuery m = ( MonadIO m , MonadState (Maybe SomeLocalBuildInfo) m , MonadReader QueryEnv m) -run :: Monad m - => QueryEnv -> Maybe SomeLocalBuildInfo -> Query m a -> m a +run :: Monad m => QueryEnv -> Maybe SomeLocalBuildInfo -> Query m a -> m a run e s action = flip runReaderT e (flip evalStateT s (unQuery action)) -- | @runQuery query distdir@. Run a 'Query'. @distdir@ is where Cabal's -- @setup-config@ file is located. runQuery :: Monad m - => FilePath -- ^ Path to project directory, i.e. the one containing the - -- @project.cabal@ file - -> FilePath -- ^ Path to @dist/@ - -> Query m a - -> m a -runQuery pd dd action = run (QueryEnv readProcess def pd dd) Nothing action - -runQuery' :: Monad m - => Programs - -> FilePath -- ^ Path to project directory, i.e. the one containing the - -- @project.cabal@ file - -> FilePath -- ^ Path to @dist/@ - -> Query m a - -> m a -runQuery' progs pd dd action = - run (QueryEnv readProcess progs pd dd) Nothing action - -runQuery'' :: Monad m - => (FilePath -> [String] -> String -> IO String) - -- ^ How to start the cabal-helper process. Useful if you need to - -- capture stderr output from the helper. - -> Programs - -> FilePath -- ^ Path to project directory, i.e. the one containing the - -- @project.cabal@ file - -> FilePath -- ^ Path to @dist/@ + => QueryEnv -> Query m a -> m a -runQuery'' readProc progs pd dd action = - run (QueryEnv readProc progs pd dd) Nothing action - +runQuery qe action = run qe Nothing action getSlbi :: MonadQuery m => m SomeLocalBuildInfo getSlbi = do @@ -198,6 +209,9 @@ -- | Only language related options, i.e. @-XSomeExtension@ ghcLangOptions :: MonadIO m => Query m [(ChComponentName, [String])] +-- | Get the licenses of the packages the current project is linking against. +pkgLicenses :: MonadIO m => Query m [(String, [(String, Version)])] + packageDbStack = Query $ slbiPackageDbStack `liftM` getSlbi entrypoints = Query $ slbiEntrypoints `liftM` getSlbi sourceDirs = Query $ slbiSourceDirs `liftM` getSlbi @@ -206,6 +220,7 @@ ghcPkgOptions = Query $ slbiGhcPkgOptions `liftM` getSlbi ghcMergedPkgOptions = Query $ slbiGhcMergedPkgOptions `liftM` getSlbi ghcLangOptions = Query $ slbiGhcLangOptions `liftM` getSlbi +pkgLicenses = Query $ slbiPkgLicenses `liftM` getSlbi -- | Run @cabal configure@ reconfigure :: MonadIO m @@ -218,7 +233,7 @@ [ "--with-ghc=" ++ ghcProgram progs ] -- Only pass ghc-pkg if it was actually set otherwise we -- might break cabal's guessing logic - ++ if ghcPkgProgram progs /= ghcPkgProgram def + ++ if ghcPkgProgram progs /= "ghc-pkg" then [ "--with-ghc-pkg=" ++ ghcPkgProgram progs ] else [] ++ cabalOpts @@ -226,13 +241,17 @@ return () getSomeConfigState :: MonadQuery m => m SomeLocalBuildInfo -getSomeConfigState = ask >>= \(QueryEnv readProc progs projdir distdir) -> do - let progArgs = [ "--with-ghc=" ++ ghcProgram progs +getSomeConfigState = ask >>= \QueryEnv {..} -> do + let progs = qePrograms + projdir = qeProjectDir + distdir = qeDistDir + + progArgs = [ "--with-ghc=" ++ ghcProgram progs , "--with-ghc-pkg=" ++ ghcPkgProgram progs , "--with-cabal=" ++ cabalProgram progs ] - let args = [ "package-db-stack" + args = [ "package-db-stack" , "entrypoints" , "source-dirs" , "ghc-options" @@ -240,14 +259,15 @@ , "ghc-pkg-options" , "ghc-merged-pkg-options" , "ghc-lang-options" - ] ++ progArgs + , "licenses" + ] res <- liftIO $ do exe <- findLibexecExe "cabal-helper-wrapper" - out <- readProc exe (projdir:distdir:args) "" + out <- qeReadProcess exe (progArgs ++ projdir:distdir:args) "" evaluate (read out) `E.catch` \(SomeException _) -> error $ concat ["getSomeConfigState", ": ", exe, " " - , intercalate " " (map show $ distdir:args) + , intercalate " " (map show $ progArgs ++ projdir:distdir:args) , " (read failed)"] let [ Just (ChResponsePkgDbs pkgDbs), @@ -257,10 +277,12 @@ Just (ChResponseCompList ghcSrcOpts), Just (ChResponseCompList ghcPkgOpts), Just (ChResponseList ghcMergedPkgOpts), - Just (ChResponseCompList ghcLangOpts) ] = res + Just (ChResponseCompList ghcLangOpts), + Just (ChResponseLicenses pkgLics) + ] = res return $ SomeLocalBuildInfo - pkgDbs eps srcDirs ghcOpts ghcSrcOpts ghcPkgOpts ghcMergedPkgOpts ghcLangOpts + pkgDbs eps srcDirs ghcOpts ghcSrcOpts ghcPkgOpts ghcMergedPkgOpts ghcLangOpts pkgLics -- | Make sure the appropriate helper executable for the given project is -- installed and ready to run queries. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cabal-helper-0.5.2.0/cabal-helper.cabal new/cabal-helper-0.6.0.0/cabal-helper.cabal --- old/cabal-helper-0.5.2.0/cabal-helper.cabal 2015-08-20 04:02:22.000000000 +0200 +++ new/cabal-helper-0.6.0.0/cabal-helper.cabal 2015-09-07 08:02:26.000000000 +0200 @@ -1,5 +1,5 @@ name: cabal-helper -version: 0.5.2.0 +version: 0.6.0.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 @@ -35,6 +35,7 @@ build-type: Custom cabal-version: >=1.10 extra-source-files: CabalHelper/Main.hs + CabalHelper/Licenses.hs source-repository head type: git @@ -49,7 +50,6 @@ GHC-Options: -Wall Build-Depends: base >= 4.5 && < 5 , Cabal >= 1.14 && < 1.23 - , data-default , directory , filepath , transformers @@ -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,26 @@ , 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 + , directory + , filepath + , transformers + , mtl , process + , ghc-prim + , bytestring + , utf8-string + , template-haskell + , temporary \ No newline at end of file diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cabal-helper-0.5.2.0/tests/Spec.hs new/cabal-helper-0.6.0.0/tests/Spec.hs --- old/cabal-helper-0.5.2.0/tests/Spec.hs 2015-08-20 04:02:22.000000000 +0200 +++ new/cabal-helper-0.6.0.0/tests/Spec.hs 2015-09-07 08:02:26.000000000 +0200 @@ -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