diff --git a/CabalHelper/Common.hs b/CabalHelper/Common.hs --- a/CabalHelper/Common.hs +++ b/CabalHelper/Common.hs @@ -50,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))) diff --git a/CabalHelper/Compile.hs b/CabalHelper/Compile.hs --- a/CabalHelper/Compile.hs +++ b/CabalHelper/Compile.hs @@ -46,19 +46,33 @@ 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 - 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) - ] + 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) @@ -95,7 +109,7 @@ case db_exists of False -> mzero True -> do - db <- liftIO $ cabalPkgDb opts cabalVer + db <- liftIO $ getPrivateCabalPkgDb opts cabalVer vLog opts $ logMsg ++ "private package-db in " ++ db liftIO $ compileWithPkg chdir (Just db) cabalVer @@ -134,17 +148,9 @@ 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 + cCabalSourceDir <- canonicalizePath `traverse` compCabalSourceDir appdir <- appDataDir let outdir' = maybe appdir (const $ distdir "cabal-helper") cCabalSourceDir @@ -154,12 +160,12 @@ let exedir' = maybe outdir (const distdir) cCabalSourceDir createDirectoryIfMissing True exedir' exedir <- canonicalizePath exedir' - exe <- exePath' cabalVersion <$> canonicalizePath exedir + exe <- exePath' compCabalVersion <$> canonicalizePath exedir vLog opts $ "outdir: " ++ outdir vLog opts $ "exedir: " ++ exedir - let Version (mj:mi:_) _ = cabalVersion + let Version (mj:mi:_) _ = compCabalVersion let ghc_opts = concat [ [ "-outputdir", outdir @@ -168,12 +174,13 @@ , "-optP-DCABAL_MAJOR=" ++ show mj , "-optP-DCABAL_MINOR=" ++ show mi ], - maybeToList $ ("-package-conf="++) <$> packageDb, + 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" @@ -182,7 +189,7 @@ ] else [], - concatMap (\p -> ["-package", p]) packageDeps, + concatMap (\p -> ["-package", p]) compPackageDeps, [ "--make", "CabalHelper/Main.hs" ] ] @@ -190,19 +197,19 @@ -- TODO: touch exe after, ghc doesn't do that if the input files didn't -- actually change - rv <- callProcessStderr' (Just cabalHelperSourceDir) ghcProgram ghc_opts + rv <- callProcessStderr' (Just compCabalHelperSourceDir) 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 compCabalVersion = do + exePath' compCabalVersion <$> appDataDir exePath' :: Version-> FilePath -> FilePath -exePath' cabalVersion outdir = +exePath' compCabalVersion outdir = outdir "cabal-helper-" ++ showVersion version -- our ver - ++ "-Cabal-" ++ showVersion cabalVersion + ++ "-Cabal-" ++ showVersion compCabalVersion callProcessStderr' :: Maybe FilePath -> FilePath -> [String] -> IO ExitCode callProcessStderr' mwd exe args = do @@ -303,8 +310,8 @@ sver = showVersion cabalVer cachedExe :: Version -> IO (Maybe FilePath) -cachedExe cabalVersion = do - exe <- exePath cabalVersion +cachedExe compCabalVersion = do + exe <- exePath compCabalVersion exists <- doesFileExist exe return $ if exists then Just exe else Nothing @@ -322,7 +329,7 @@ cabalPkgDbExists :: Options -> Version -> IO Bool cabalPkgDbExists opts ver = do - db <- cabalPkgDb opts ver + db <- getPrivateCabalPkgDb opts ver dexists <- doesDirectoryExist db case dexists of False -> return False @@ -348,13 +355,13 @@ createPkgDb :: Options -> Version -> IO FilePath createPkgDb opts@Options {..} ver = do - db <- cabalPkgDb opts ver + db <- getPrivateCabalPkgDb opts ver exists <- doesDirectoryExist db when (not exists) $ callProcessStderr Nothing ghcPkgProgram ["init", db] return db -cabalPkgDb :: Options -> Version -> IO FilePath -cabalPkgDb opts ver = do +getPrivateCabalPkgDb :: Options -> Version -> IO FilePath +getPrivateCabalPkgDb opts ver = do appdir <- appDataDir ghcVer <- ghcVersion opts return $ appdir "Cabal-" ++ showVersion ver ++ "-db-" ++ showVersion ghcVer diff --git a/CabalHelper/Data.hs b/CabalHelper/Data.hs --- a/CabalHelper/Data.hs +++ b/CabalHelper/Data.hs @@ -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 --git a/CabalHelper/Licenses.hs b/CabalHelper/Licenses.hs new file mode 100644 --- /dev/null +++ b/CabalHelper/Licenses.hs @@ -0,0 +1,102 @@ +{-# LANGUAGE CPP #-} +module CabalHelper.Licenses where + +-- Copyright (c) 2014, Jasper Van der Jeugt + +-------------------------------------------------------------------------------- +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 --git a/CabalHelper/Main.hs b/CabalHelper/Main.hs --- a/CabalHelper/Main.hs +++ b/CabalHelper/Main.hs @@ -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 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 @@ -237,6 +241,10 @@ "source-dirs":[] -> do 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 diff --git a/CabalHelper/Types.hs b/CabalHelper/Types.hs --- a/CabalHelper/Types.hs +++ b/CabalHelper/Types.hs @@ -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 @@ -61,7 +62,9 @@ , ghcProgram :: FilePath , ghcPkgProgram :: FilePath , cabalProgram :: FilePath + , cabalVersion :: Maybe Version + , cabalPkgDb :: Maybe FilePath } defaultOptions :: Options -defaultOptions = Options False "ghc" "ghc-pkg" "cabal" +defaultOptions = Options False "ghc" "ghc-pkg" "cabal" Nothing Nothing diff --git a/CabalHelper/Wrapper.hs b/CabalHelper/Wrapper.hs --- a/CabalHelper/Wrapper.hs +++ b/CabalHelper/Wrapper.hs @@ -45,7 +45,7 @@ usage :: IO () usage = do prog <- getProgName - hPutStr stderr $ align "(" "|" ("Usage: " ++ prog ++ " " ++ usageMsg) + hPutStr stderr $ "Usage: " ++ prog ++ " " ++ usageMsg where usageMsg = "\ \( print-appdatadir\n\ @@ -54,6 +54,8 @@ \ [--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" globalArgSpec :: [OptDescr (Options -> Options)] @@ -69,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 @@ -116,13 +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" diff --git a/Distribution/Helper.hs b/Distribution/Helper.hs --- a/Distribution/Helper.hs +++ b/Distribution/Helper.hs @@ -14,17 +14,24 @@ -- You should have received a copy of the GNU Affero General Public License -- along with this program. If not, see . -{-# 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) @@ -91,9 +98,46 @@ 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], slbiEntrypoints :: [(ChComponentName, ChEntrypoint)], @@ -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 --git a/cabal-helper.cabal b/cabal-helper.cabal --- a/cabal-helper.cabal +++ b/cabal-helper.cabal @@ -1,5 +1,5 @@ name: cabal-helper -version: 0.5.3.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 @@ -93,7 +93,6 @@ , extra , unix , Cabal >= 1.14 && < 1.23 - , data-default , directory , filepath , transformers