cabal-debian 4.39 → 5.0
raw patch · 7 files changed
+136/−279 lines, 7 filesdep +unliftiodep −Unixutilsdep −memoizedep −set-extra
Dependencies added: unliftio
Dependencies removed: Unixutils, memoize, set-extra
Files
- cabal-debian.cabal +3/−6
- src/Debian/Debianize/BuildDependencies.hs +23/−23
- src/Debian/Debianize/Bundled.hs +48/−70
- src/Debian/Debianize/CabalInfo.hs +1/−2
- src/Debian/Debianize/Finalize.hs +12/−13
- src/Debian/Debianize/InputCabal.hs +6/−9
- src/Debian/GHC.hs +43/−156
cabal-debian.cabal view
@@ -1,5 +1,5 @@ Name: cabal-debian-Version: 4.39+Version: 5.0 Copyright: Copyright (c) 2007-2014, David Fox, Jeremy Shaw; 2017-2019 Clint Adams License: BSD3 License-File: LICENSE@@ -168,7 +168,6 @@ hsemail, HUnit, lens,- memoize >= 0.7, mtl, network-uri, newtype-generics >= 0.4,@@ -177,11 +176,10 @@ process, pureMD5, regex-tdfa,- set-extra, syb, text, unix,- Unixutils >= 1.53,+ unliftio >= 0.2.8.0, utf8-string, optparse-applicative >= 0.11, ansi-wl-pprint == 0.6.*,@@ -232,8 +230,7 @@ debian >= 3.95, lens, mtl,- pretty >= 1.1.2,- Unixutils >= 1.53+ pretty >= 1.1.2 Test-Suite cabal-debian-tests Buildable: False
src/Debian/Debianize/BuildDependencies.hs view
@@ -10,6 +10,8 @@ import Control.Applicative ((<$>)) #endif import Control.Lens+import Control.Monad ((>=>))+import Control.Monad.IO.Class (liftIO) import Control.Monad.State (MonadState(get)) import Control.Monad.Trans (MonadIO) import Data.Char (isSpace, toLower)@@ -20,7 +22,7 @@ import Data.Monoid ((<>)) import Data.Set as Set (empty, fold, fromList, map, member, Set, singleton, toList, union) import Debian.Debianize.Prelude-import Debian.Debianize.BasicInfo (buildEnv, compilerFlavor, EnvSet(dependOS))+import Debian.Debianize.BasicInfo (compilerFlavor) import Debian.Debianize.Bundled (builtIn) import qualified Debian.Debianize.DebInfo as D import Debian.Debianize.DebianName (mkPkgName, mkPkgName')@@ -87,8 +89,7 @@ (mergeCabalDependencies $ concatMap Cabal.targetBuildDepends buildInfos) (mergeCabalDependencies $ mapMaybe convertLegacy $ concatMap buildTools buildInfos) (mergeCabalDependencies $ mapMaybe convertPkgconfig $ concatMap pkgconfigDepends buildInfos)- (concatMap extraLibs buildInfos) >>=- return {- . List.filter (not . selfDependency (Cabal.package pkgDesc)) -}+ (concatMap extraLibs buildInfos) where #if MIN_VERSION_Cabal(2,0,0) convertLegacy :: LegacyExeDependency -> Maybe Dependency@@ -108,9 +109,9 @@ [ExtraLibs (fixDeps atoms extraLibs')] fixDeps :: CabalInfo -> [String] -> Relations- fixDeps atoms xs =+ fixDeps atoms = concatMap (\ cab -> fromMaybe [[D.Rel (D.BinPkgName ("lib" ++ List.map toLower cab ++ "-dev")) Nothing Nothing]]- (Map.lookup cab (view (A.debInfo . D.extraLibMap) atoms))) xs+ (Map.lookup cab (view (A.debInfo . D.extraLibMap) atoms))) -- | Take the intersection of all the dependencies on a given package name mergeCabalDependencies :: [Dependency] -> [Dependency]@@ -156,9 +157,9 @@ bDeps <- use (A.debInfo . D.control . S.buildDepends) compat <- use (A.debInfo . D.compat)- let ghcdev = compilerPackageName hflavor B.Development+ ghcdev <- liftIO $ compilerPackageName hflavor B.Development+ ghcprof <- liftIO $ compilerPackageName hflavor B.Profiling let ghcrel = if member GHC hcs then maybe [] ((: []) . anyrel') ghcdev else []- let ghcprof = compilerPackageName hflavor B.Profiling let ghcrelprof = if prof then maybe [] ((: []) . anyrel') ghcprof else [] let xs = nub $ [maybe [] (\ n -> [D.Rel (D.BinPkgName "debhelper") (Just (D.GRE (parseDebianVersion' (show n)))) Nothing]) compat, [D.Rel (D.BinPkgName "haskell-devscripts-minimal") Nothing Nothing,@@ -208,7 +209,7 @@ bDeps <- use (A.debInfo . D.control . S.buildDependsIndep) libDeps <- allBuildDepends (maybe [] (return . libBuildInfo) (Cabal.library pkgDesc)) cDeps <- mapM docDependencies libDeps- let ghcdoc = compilerPackageName hc B.Documentation+ ghcdoc <- liftIO $ compilerPackageName hc B.Documentation let hcdocdep = if doc && member GHC hcs then maybe [] ((: []) . anyrel') ghcdoc else [] let xs = nub $ if doc && isJust (Cabal.library pkgDesc) then hcdocdep ++ bDeps ++ concat cDeps@@ -239,7 +240,7 @@ buildDependencies _ dep = case unboxDependency dep of Just (Dependency _name _ranges) ->- do mp <- get >>= return . view (A.debInfo . D.execMap)+ do mp <- view (A.debInfo . D.execMap) <$> get return $ concat $ adapt mp dep Nothing -> return []@@ -304,13 +305,13 @@ case isNoVersion range''' of True -> return Nothing False ->- foldVersionRange'+ Just <$> foldVersionRange' (return $ Rel' (D.Rel dname Nothing Nothing))- (\ v -> debianVersion' name v >>= \ dv -> return $ Rel' (D.Rel dname (Just (D.EEQ dv)) Nothing))- (\ v -> debianVersion' name v >>= \ dv -> return $ Rel' (D.Rel dname (Just (D.SGR dv)) Nothing))- (\ v -> debianVersion' name v >>= \ dv -> return $ Rel' (D.Rel dname (Just (D.SLT dv)) Nothing))- (\ v -> debianVersion' name v >>= \ dv -> return $ Rel' (D.Rel dname (Just (D.GRE dv)) Nothing))- (\ v -> debianVersion' name v >>= \ dv -> return $ Rel' (D.Rel dname (Just (D.LTE dv)) Nothing))+ (debianVersion' name >=> \ dv -> return $ Rel' (D.Rel dname (Just (D.EEQ dv)) Nothing))+ (debianVersion' name >=> \ dv -> return $ Rel' (D.Rel dname (Just (D.SGR dv)) Nothing))+ (debianVersion' name >=> \ dv -> return $ Rel' (D.Rel dname (Just (D.SLT dv)) Nothing))+ (debianVersion' name >=> \ dv -> return $ Rel' (D.Rel dname (Just (D.GRE dv)) Nothing))+ (debianVersion' name >=> \ dv -> return $ Rel' (D.Rel dname (Just (D.LTE dv)) Nothing)) #if MIN_VERSION_Cabal(2,0,0) (\ x y -> debianVersion' name x >>= \ dvx -> debianVersion' name y >>= \ dvy ->@@ -324,7 +325,7 @@ (\ x y -> x >>= \ x' -> y >>= \ y' -> return $ Or [x', y']) (\ x y -> x >>= \ x' -> y >>= \ y' -> return $ And [x', y']) id- range''' >>= return . Just+ range''' where -- Choose the simpler of the two range''' = canon (simpler range' range'')@@ -367,21 +368,20 @@ -> [D.Relation] -> CabalT m [D.Relation] doBundled typ name hc rels = do- let hcname = compilerPackageName hc typ- mapM (doRel hcname) rels >>= return . concat+ hcname <- liftIO $ compilerPackageName hc typ+ concat <$> mapM (doRel hcname) rels where -- If a library is built into the compiler, this is the debian -- package name the compiler will conflict with.- doRel :: Monad m => Maybe BinPkgName -> D.Relation -> CabalT m [D.Relation]+ doRel :: MonadIO m => Maybe BinPkgName -> D.Relation -> CabalT m [D.Relation] doRel hcname rel@(D.Rel dname req _) = do let comp = maybe [] (\x -> [D.Rel x Nothing Nothing]) hcname -- gver <- use ghcVersion- root <- use (A.debInfo . D.flags . buildEnv) >>= return . dependOS -- Look at what version of the package is provided by the compiler. atoms <- get -- What version of this package (if any) does the compiler provide?- let relInfo = builtIn hc root- pver = listToMaybe $ fmap (debianVersion'' atoms) (filter ((== name) . pkgName) relInfo)+ relInfo <- liftIO $ builtIn hc+ let pver = listToMaybe $ fmap (debianVersion'' atoms) (filter ((== name) . pkgName) relInfo) -- The name this library would have if it was in the compiler conflicts list. let naiveDebianName = mkPkgName hc name typ -- The compiler should appear in the build dependency@@ -423,7 +423,7 @@ canonical :: Rels a -> Rels a canonical (Rel' rel) = And [Or [Rel' rel]] canonical (And rels) = And $ concatMap (unAnd . canonical) rels-canonical (Or rels) = And . List.map Or $ sequence $ List.map (concat . List.map unOr . unAnd . canonical) $ rels+canonical (Or rels) = And . List.map Or $ mapM (concatMap unOr . unAnd . canonical) rels filterMissing :: Monad m => [[Relation]] -> CabalT m [[Relation]] filterMissing rels =
src/Debian/Debianize/Bundled.hs view
@@ -1,12 +1,12 @@ -- | Determine whether a specific version of a Haskell package is -- bundled with into this particular version of the given compiler. -- This is done by getting the "Provides" field from the output of--- "apt-cache showpkg ghc" (run in the appropriate changeroot) and+-- "apt-cache showpkg ghc" and -- converting the debian package names back to Cabal package names. -- *That* is done using the debianNameMap of CabalInfo, which is -- built using the mapCabal, splitCabal, and remapCabal functions. -{-# LANGUAGE CPP, FlexibleContexts, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell #-}+{-# LANGUAGE CPP, FlexibleContexts, ScopedTypeVariables #-} module Debian.Debianize.Bundled ( builtIn -- * Utilities@@ -23,12 +23,9 @@ #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>), (<*>)) #endif-import Control.DeepSeq (force, NFData) import Control.Exception (SomeException, try)-import Control.Monad.Catch (MonadMask)-import Control.Monad.Trans (MonadIO)+import Control.Monad ((<=<)) import Data.Char (isAlphaNum, toLower)-import Data.Function.Memoize (memoize2, memoize3) import Data.List (groupBy, intercalate, isPrefixOf, stripPrefix) import Data.Maybe (listToMaybe, mapMaybe) import Data.Set as Set (difference, fromList)@@ -49,12 +46,11 @@ #else import Distribution.Compiler (CompilerFlavor) #endif-import System.IO.Unsafe (unsafePerformIO) import System.Process (readProcess, showCommandForUser)-import System.Unix.Chroot (useEnv) import Test.HUnit (assertEqual, Test(TestList, TestCase)) import Text.ParserCombinators.ReadP (char, endBy1, munch1, ReadP, readP_to_S) import Text.Regex.TDFA ((=~))+import UnliftIO.Memoize (memoizeMVar, Memoized, runMemoized) #if MIN_VERSION_base(4,8,0) #if !MIN_VERSION_Cabal(2,0,0)@@ -78,10 +74,11 @@ -- This is done by looking for .conf files beneath a package.conf.d -- directory and parsing the name. (Probably better to actually read -- the .conf file.)-builtIn :: CompilerFlavor -> FilePath -> [PackageIdentifier]-builtIn hc root =- let Just hcname = (hcExecutablePath root hc >>= hcBinPkgName root) in- aptCacheProvides hcname root+builtIn :: CompilerFlavor -> IO [PackageIdentifier]+builtIn hc = do+ Just hep <- hcExecutablePath hc >>= runMemoized+ Just hcname <- hcBinPkgName hep >>= runMemoized+ runMemoized =<< aptCacheProvides hcname -- | Convert CompilerFlavor to an executable name in a way that works -- for at least the cases we are interested in. This might need to be@@ -90,95 +87,76 @@ hcExecutable = map toLower . show -- | Use which(1) to determine full path name to haskell compiler executable-hcExecutablePath :: FilePath -> CompilerFlavor -> Maybe FilePath-hcExecutablePath = memoize2 $ \root hc ->- listToMaybe $ lines $ unsafePerformIO $ chroot root (readProcess "which" [hcExecutable hc] "")+hcExecutablePath :: CompilerFlavor -> IO (Memoized (Maybe FilePath))+hcExecutablePath hc = memoizeMVar (listToMaybe . lines <$> readProcess "which" [hcExecutable hc] "") -hcVersion :: FilePath -> CompilerFlavor -> Maybe Version-hcVersion root hc =- let Just hcpath = hcExecutablePath root hc in- maybe Nothing parseVersion' $- listToMaybe $- lines $- unsafePerformIO . chroot root $- readProcess hcpath+hcVersion :: CompilerFlavor -> IO (Maybe Version)+hcVersion hc = do+ Just hcpath <- runMemoized =<< hcExecutablePath hc+ ver <- readProcess hcpath [case hc of #if MIN_VERSION_Cabal(1,22,0) GHCJS -> "--numeric-ghc-version" #endif _ -> "--numeric-version"] ""+ return $ maybe Nothing parseVersion' (listToMaybe (lines ver)) -- | Use dpkg -S to convert the executable path to a debian binary -- package name.-hcBinPkgName :: FilePath -> FilePath -> Maybe BinPkgName-hcBinPkgName = memoize2 $ \root path ->- let s = unsafePerformIO (chroot root (readProcess "dpkg" ["-S", path] "")) in- case map (takeWhile (/= ':')) (lines s) of+hcBinPkgName :: FilePath -> IO (Memoized (Maybe BinPkgName))+hcBinPkgName path = memoizeMVar $ do+ s <- readProcess "dpkg" ["-S", path] ""+ return $ case map (takeWhile (/= ':')) (lines s) of [] -> Nothing [name] -> Just (BinPkgName name) _ -> error $ "Unexpected output from " ++ showCommandForUser "dpkg" ["-S", path] ++ ": ++ " ++ show s -- | What built in libraries does this haskell compiler provide?-aptCacheProvides :: BinPkgName -> FilePath -> [PackageIdentifier]-aptCacheProvides = memoize2 aptCacheProvides'- where- aptCacheProvides' hcname root =- {-trace ("aptCacheProvides " ++ show hcname ++ " in " ++ root ++ " -> " ++ show pis)-}- packageIdentifiers root hcname+aptCacheProvides :: BinPkgName -> IO (Memoized [PackageIdentifier])+aptCacheProvides = memoizeMVar . packageIdentifiers -packageIdentifiers :: String -> BinPkgName -> [PackageIdentifier]-packageIdentifiers root hcname =- (mapMaybe parsePackageIdentifier' .- mapMaybe (dropRequiredSuffix ".conf") .- map last .- filter (elem "package.conf.d") .- map (groupBy (\a b -> (a == '/') == (b == '/')))) (binPkgFiles root hcname)+packageIdentifiers :: BinPkgName -> IO [PackageIdentifier]+packageIdentifiers hcname =+ mapMaybe parsePackageIdentifier' .+ mapMaybe (dropRequiredSuffix ".conf" . last) .+ filter (elem "package.conf.d") .+ map (groupBy (\a b -> (a == '/') == (b == '/'))) <$> binPkgFiles hcname dropRequiredSuffix :: String -> String -> Maybe String dropRequiredSuffix suff x = let (x', suff') = splitAt (length x - length suff) x in if suff == suff' then Just x' else Nothing -- | A list of the files in a binary deb-binPkgFiles :: String -> BinPkgName -> [FilePath]-binPkgFiles root hcname = lines $ unsafePerformIO (chroot root (readProcess "dpkg" ["-L", unBinPkgName hcname] ""))--{--takeBetween :: (a -> Bool) -> (a -> Bool) -> [a] -> [a]-takeBetween startPred endPred = takeWhile (not . endPred) . dropWhile startPred . dropWhile (not . startPred)--}+binPkgFiles :: BinPkgName -> IO [FilePath]+binPkgFiles hcname = lines <$> readProcess "dpkg" ["-L", unBinPkgName hcname] "" -aptCacheConflicts :: FilePath -> String -> DebianVersion -> [BinPkgName]-aptCacheConflicts root hcname ver =- either (\ _ -> []) (mapMaybe doLine . lines) (aptCacheDepends root hcname (show (prettyDebianVersion ver)))+aptCacheConflicts :: String -> DebianVersion -> IO [BinPkgName]+aptCacheConflicts hcname ver =+ either (const []) (mapMaybe doLine . lines) <$> (runMemoized =<< aptCacheDepends hcname (show (prettyDebianVersion ver))) where doLine s = case s =~ "^[ ]*Conflicts:[ ]*<(.*)>$" :: (String, String, String, [String]) of (_, _, _, [name]) -> Just (BinPkgName name) _ -> Nothing -aptCacheDepends :: FilePath -> String -> String -> Either SomeException String-aptCacheDepends =- memoize3 (\ root hcname ver -> unsafePerformIO (try (chroot root (readProcess "apt-cache" ["depends", hcname ++ "=" ++ ver] ""))))--aptVersions :: FilePath -> BinPkgName -> [DebianVersion]-aptVersions root hcname =- either (\ _ -> []) (map parseDebianVersion' . filter (/= "") . map (takeWhile (/= ' ')) . takeWhile (not . isPrefixOf "Reverse Depends:") . drop 1 . dropWhile (not . isPrefixOf "Versions:") . lines) (aptCacheShowPkg root hcname)--aptCacheShowPkg :: FilePath -> BinPkgName -> Either SomeException String-aptCacheShowPkg =- memoize2 (\ root hcname -> unsafePerformIO (try (chroot root (readProcess "apt-cache" ["showpkg", unBinPkgName hcname] ""))))+aptCacheDepends :: String -> String -> IO (Memoized (Either SomeException String))+aptCacheDepends hcname ver =+ memoizeMVar (try (readProcess "apt-cache" ["depends", hcname ++ "=" ++ ver] "")) +aptVersions :: BinPkgName -> IO [DebianVersion]+aptVersions =+ return . either (const []) (map parseDebianVersion' . filter (/= "") . map (takeWhile (/= ' ')) . takeWhile (not . isPrefixOf "Reverse Depends:") . drop 1 . dropWhile (not . isPrefixOf "Versions:") . lines) <=< (runMemoized <=< aptCacheShowPkg) -chroot :: (NFData a, MonadIO m, MonadMask m) => String -> m a -> m a-chroot "/" = id-chroot root = useEnv root (return . force)+aptCacheShowPkg :: BinPkgName -> IO (Memoized (Either SomeException String))+aptCacheShowPkg hcname =+ memoizeMVar (try (readProcess "apt-cache" ["showpkg", unBinPkgName hcname] "")) -- | A package identifier is a package name followed by a dash and -- then a version number. A package name, according to the cabal -- users guide "can use letters, numbers and hyphens, but not spaces." -- So be it. parsePackageIdentifier :: ReadP PackageIdentifier-parsePackageIdentifier = do+parsePackageIdentifier = #if MIN_VERSION_Cabal(2,0,0) makeId <$> ((,) <$> endBy1 (munch1 isAlphaNum) (char '-') <*> parseCabalVersion) where@@ -219,16 +197,16 @@ Nothing (parseMaybe parsePackageIdentifier "HUnit-1.2.3 ")) , TestCase $ do- ghc <- (head . lines) <$> readProcess "which" ["ghc"] ""+ ghc <- head . lines <$> readProcess "which" ["ghc"] "" let ver = fmap (takeWhile (/= '/')) (stripPrefix "/opt/ghc/" ghc)- let expected =- (Set.fromList+ acp <- runMemoized =<< aptCacheProvides (BinPkgName ("ghc" ++ maybe "" ("-" ++) ver))+ let expected = Set.fromList -- This is the package list for ghc-7.10.3 ["array", "base", "binary", "bin-package-db", "bytestring", "Cabal", "containers", "deepseq", "directory", "filepath", "ghc", "ghc-prim", "haskeline", "hoopl", "hpc", "integer-gmp", "pretty", "process",- "template-haskell", "terminfo", "time", "transformers", "unix", "xhtml"])- actual = Set.fromList (map (unPackageName . pkgName) (aptCacheProvides (BinPkgName ("ghc" ++ maybe "" ("-" ++) ver)) "/"))+ "template-haskell", "terminfo", "time", "transformers", "unix", "xhtml"]+ actual = Set.fromList (map (unPackageName . pkgName) acp) missing (Just "8.0.1") = Set.fromList ["bin-package-db"] missing (Just "8.0.2") = Set.fromList ["bin-package-db"] missing _ = mempty
src/Debian/Debianize/CabalInfo.hs view
@@ -38,7 +38,6 @@ import Distribution.Package (PackageName) import Distribution.PackageDescription as Cabal (PackageDescription(homepage)) import Prelude hiding (init, init, log, log, null)-import System.Unix.Mount (withProcAndSys) -- | Bits and pieces of information about the mapping from cabal package -- names and versions to debian package names and versions. In essence,@@ -77,7 +76,7 @@ -- 'CabalInfo' record. newCabalInfo :: (MonadIO m, MonadMask m{-, Functor m-}) => Flags -> m (Either String CabalInfo) newCabalInfo flags' =- withProcAndSys "/" $ inputCabalization flags' >>= either (return . Left) (\p -> Right <$> doPkgDesc p)+ inputCabalization flags' >>= either (return . Left) (\p -> Right <$> doPkgDesc p) where doPkgDesc pkgDesc = do copyrt <- liftIO $ defaultCopyrightDescription pkgDesc
src/Debian/Debianize/Finalize.hs view
@@ -28,7 +28,6 @@ import Data.Maybe (fromMaybe, isJust, fromJust) import Data.Monoid ((<>)) import Data.Set as Set (difference, filter, fold, fromList, insert, map, null, Set, singleton, toList, union, unions)-import Data.Set.Extra as Set (mapM_) import Data.Text as Text (intercalate, pack, Text, unlines, unpack) import Debian.Changes (ChangeLog(..), ChangeLogEntry(..)) import Debian.Codename (parseCodename)@@ -530,8 +529,7 @@ B.breaks .= [] B.builtUsing .= [] - unless (typ == B.Documentation) $ do- B.provides %= (anyrel "${haskell:Provides}" :)+ unless (typ == B.Documentation) $ B.provides %= (anyrel "${haskell:Provides}" :) -- | Add the library paragraphs for a particular compiler flavor. librarySpecs :: (Monad m) => PackageDescription -> CompilerFlavor -> CabalT m ()@@ -641,13 +639,13 @@ (A.debInfo . D.binaryDebDescription b . B.binarySection) .?= Just (MainSection "misc") binaryPackageRelations b B.Utilities -- Add the unassigned files to the utils packages- Set.mapM_ (\ (foo, bar) -> (A.debInfo . D.atomSet) %= (Set.insert $ D.InstallData b foo bar)) utilsDataMissing- Set.mapM_ (\ name -> (A.debInfo . D.atomSet) %= (Set.insert $ D.InstallCabalExec b name "usr/bin")) utilsExecMissing+ mapM_ (\ (foo, bar) -> (A.debInfo . D.atomSet) %= (Set.insert $ D.InstallData b foo bar)) utilsDataMissing+ mapM_ (\ name -> (A.debInfo . D.atomSet) %= (Set.insert $ D.InstallCabalExec b name "usr/bin")) utilsExecMissing where ename i = case D.sourceDir i of- (Nothing) -> D.execName i- (Just s) -> s </> D.execName i+ Nothing -> D.execName i+ Just s -> s </> D.execName i expandAtoms :: Monad m => CabalT m () -> CabalT m () expandAtoms goodies =@@ -694,7 +692,7 @@ expandInstallCabalExecs :: Monad m => FilePath -> CabalT m () expandInstallCabalExecs builddir = do hc <- use (A.debInfo . D.flags . compilerFlavor)- use (A.debInfo . D.atomSet) >>= Set.mapM_ (doAtom hc)+ use (A.debInfo . D.atomSet) >>= mapM_ (doAtom hc) where doAtom :: Monad m => CompilerFlavor -> D.Atom -> CabalT m () doAtom GHC (D.InstallCabalExec b name dest) = (A.debInfo . D.atomSet) %= (Set.insert $ D.Install b (builddir </> name </> name) dest)@@ -714,7 +712,7 @@ expandInstallCabalExecTo :: Monad m => FilePath -> CabalT m () expandInstallCabalExecTo builddir = do hc <- use (A.debInfo . D.flags . compilerFlavor)- use (A.debInfo . D.atomSet) >>= Set.mapM_ (doAtom hc)+ use (A.debInfo . D.atomSet) >>= mapM_ (doAtom hc) where doAtom :: Monad m => CompilerFlavor -> D.Atom -> CabalT m () doAtom GHC (D.InstallCabalExecTo b name dest) =@@ -774,11 +772,12 @@ finalizeRules = do DebBase b <- debianNameBase hc <- use (A.debInfo . D.flags . compilerFlavor)- let BinPkgName hcdeb = maybe (error "No compiler package") id (compilerPackageName hc B.Development)+ cpn <- liftIO $ compilerPackageName hc B.Development+ let BinPkgName hcdeb = fromMaybe (error "No compiler package") cpn (A.debInfo . D.rulesHead) .?= Just "#!/usr/bin/make -f" (A.debInfo . D.rulesSettings) %= (++ ["DEB_CABAL_PACKAGE = " <> pack b]) (A.debInfo . D.rulesSettings) %= (++ ["DEB_DEFAULT_COMPILER = " <> pack hcdeb])- flags <- (flagString . Set.toList) <$> use (A.debInfo . D.flags . cabalFlagAssignments)+ flags <- flagString . Set.toList <$> use (A.debInfo . D.flags . cabalFlagAssignments) unless (List.null flags) ((A.debInfo . D.rulesSettings) %= (++ ["DEB_SETUP_GHC_CONFIGURE_ARGS = " <> pack flags])) (A.debInfo . D.rulesIncludes) %= (++ ["include /usr/share/cdbs/1/rules/debhelper.mk", "include /usr/share/cdbs/1/class/hlibrary.mk"])@@ -809,7 +808,7 @@ flagString :: [(FlagName, Bool)] -> String #if MIN_VERSION_Cabal(2,0,0)-flagString = List.intercalate " " . List.map (\ (s, sense) -> "-f" ++ (if sense then "" else "-") ++ unFlagName s)+flagString = unwords . List.map (\ (s, sense) -> "-f" ++ (if sense then "" else "-") ++ unFlagName s) #else-flagString = List.intercalate " " . List.map (\ (FlagName s, sense) -> "-f" ++ (if sense then "" else "-") ++ s)+flagString = unwords . List.map (\ (FlagName s, sense) -> "-f" ++ (if sense then "" else "-") ++ s) #endif
src/Debian/Debianize/InputCabal.hs view
@@ -12,7 +12,7 @@ import Control.Applicative ((<$>)) #endif import Data.Set as Set (toList)-import Debian.Debianize.BasicInfo (Flags, buildEnv, dependOS, verbosity, compilerFlavor, cabalFlagAssignments)+import Debian.Debianize.BasicInfo (Flags, verbosity, compilerFlavor, cabalFlagAssignments) import Debian.Debianize.Prelude (intToVerbosity') #if MIN_VERSION_Cabal(1,22,0) import Debian.GHC (getCompilerInfo)@@ -51,7 +51,6 @@ import System.Exit (ExitCode(..)) import System.Posix.Files (setFileCreationMask) import System.Process (system)-import System.Unix.Mount (WithProcAndSys) #if !MIN_VERSION_Cabal(1,22,0) type CompilerInfo = CompilerId@@ -61,11 +60,11 @@ -- in particular, using the dependency environment in the EnvSet, find -- the newest available compiler of the requested compiler flavor and -- use that information load the configured PackageDescription.-inputCabalization :: forall m. (MonadIO m) => Flags -> WithProcAndSys m (Either String PackageDescription)+inputCabalization :: forall m. (MonadIO m) => Flags -> m (Either String PackageDescription) inputCabalization flags = getCompInfo flags >>= either (return . Left) (\cinfo -> Right <$> doCompInfo cinfo) where- doCompInfo :: CompilerInfo -> WithProcAndSys m PackageDescription+ doCompInfo :: CompilerInfo -> m PackageDescription doCompInfo cinfo = do -- Load a GenericPackageDescription from the current directory -- and from that create a finalized PackageDescription for the@@ -91,15 +90,13 @@ vb = intToVerbosity' $ view verbosity flags fs = view cabalFlagAssignments flags -getCompInfo :: MonadIO m => Flags -> WithProcAndSys m (Either String CompilerInfo)+getCompInfo :: MonadIO m => Flags -> m (Either String CompilerInfo) getCompInfo flags = #if MIN_VERSION_Cabal(1,22,0)- getCompilerInfo root (view compilerFlavor flags)+ getCompilerInfo (view compilerFlavor flags) #else- return $ newestAvailableCompilerId root (view compilerFlavor flags)+ return $ newestAvailableCompilerId (view compilerFlavor flags) #endif- where- root = dependOS $ view buildEnv flags -- | Run the package's configuration script. autoreconf :: Verbosity -> Cabal.PackageDescription -> IO ()
src/Debian/GHC.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, DeriveDataTypeable, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell #-}+{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables #-} {-# OPTIONS_GHC -Wall -fno-warn-orphans #-} module Debian.GHC ( withCompilerVersion@@ -9,11 +9,6 @@ -- , ghcNewestAvailableVersion' -- , ghcNewestAvailableVersion -- , compilerIdFromDebianVersion- , hvrCabalVersion- , hvrHappyVersion- , hvrAlexVersion- , hvrCompilerPATH- , isHVRCompilerPackage , withModifiedPATH -- , CompilerChoice(..), hcVendor, hcFlavor , compilerPackageName@@ -25,13 +20,12 @@ #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif-import Control.DeepSeq (force) import Control.Exception (SomeException, throw, try) import Control.Lens (_2, over)+import Control.Monad ((<=<)) import Control.Monad.Trans (MonadIO, liftIO) import Data.Char (isSpace, toLower, toUpper)-import Data.Function.Memoize (deriveMemoizable, Memoizable, memoize, memoize2, memoizeFinite)-import Data.List (intercalate, isPrefixOf)+import Data.List (intercalate) import Debian.Debianize.BinaryDebDescription (PackageType(..)) import Debian.Relation (BinPkgName(BinPkgName)) import Debian.Version (DebianVersion, parseDebianVersion')@@ -43,53 +37,20 @@ import Distribution.Pretty (prettyShow) import Distribution.Version (mkVersion', mkVersion, Version, versionNumbers) import Data.Version (parseVersion)-import Data.Word (Word64) #else-import Data.Function.Memoize (deriveMemoizable, memoize, memoize2) import Data.Version (showVersion, Version(..), parseVersion) #endif import System.Console.GetOpt (ArgDescr(ReqArg), OptDescr(..))-import System.Directory (doesDirectoryExist) import System.Environment (getEnv) import System.Exit (ExitCode(ExitFailure, ExitSuccess)) -- import System.IO (hPutStrLn, stderr) import System.IO.Error (isDoesNotExistError)-import System.IO.Unsafe (unsafePerformIO) import System.Process (readProcess, showCommandForUser, readProcessWithExitCode) import System.Posix.Env (setEnv)-import System.Unix.Chroot (useEnv, fchroot)-import System.Unix.Mount (WithProcAndSys) import Text.ParserCombinators.ReadP (readP_to_S) import Text.Read (readMaybe) import Text.Regex.TDFA ((=~))--#if MIN_VERSION_Cabal(2,0,0)-instance Memoizable Word64 where memoize = memoizeFinite-#endif-$(deriveMemoizable ''CompilerFlavor)-$(deriveMemoizable ''Version)-$(deriveMemoizable ''BinPkgName)---- | Up until now cabal-debian only worked with Debian's or Ubuntu's--- ghc debs, which have binary package names ghc, ghc-prof, ghc-doc,--- etc. This type is intended to add support for Herbert Valerio--- Riedel's (hvr's) repository of several different versions of ghc--- and supporting tools happy, alex and cabal. These have different--- binary package names, and the packages put the executables in--- different locations than the Debian (and Ubuntu) packages. This--- option is activated when a directory such as /opt/ghc/8.0.1/bin is--- present in $PATH and a ghc executable is found there.------ This function decides whether a deb name is that of one of--- debian/ubuntu's ghc packages or one of hvr's. If it is an hvr--- package it returns the version number embedded in its name.-isHVRCompilerPackage :: CompilerFlavor -> BinPkgName -> Maybe Version-isHVRCompilerPackage hc (BinPkgName name) =- case isPrefixOf prefix name of- True -> toVersion (takeWhile (/= '-') (drop (length prefix) name))- False -> Nothing- where- prefix = map toLower (show hc) ++ "-"+import UnliftIO.Memoize (memoizeMVar, runMemoized, Memoized) toVersion :: String -> Maybe Version toVersion s = case filter (all isSpace . snd) (readP_to_S parseVersion s) of@@ -100,56 +61,8 @@ #endif _ -> Nothing -withCompilerVersion :: FilePath -> CompilerFlavor -> (DebianVersion -> a) -> Either String a-withCompilerVersion root hc f = either Left (\v -> Right (f v)) (newestAvailableCompiler root hc)---- | Return the a string containing the PATH environment variable value--- suitable for using some version of ghc from hvr's compiler repo.-hvrCompilerPATH :: Version -> String -> String-hvrCompilerPATH v path0 =- intercalate ":" ["/opt/ghc/" ++ prettyShow v ++ "/bin",- "/opt/cabal/" ++ prettyShow (hvrCabalVersion v) ++ "/bin",- "/opt/happy/" ++ prettyShow (hvrHappyVersion v) ++ "/bin",- "/opt/alex/" ++ prettyShow (hvrAlexVersion v) ++ "/bin",- path0]---- | What version of Cabal goes with this version of GHC?-hvrCabalVersion :: Version -> Version-#if MIN_VERSION_Cabal(2,0,0)-hvrCabalVersion v =- case versionNumbers v of- (m : n : _) | (m == 7 && n <= 7) || m < 7 -> mkVersion [1,16]- (7 : n : _) | n <= 9 -> mkVersion [1,18]- (7 : _) -> mkVersion [1,22]- _ -> mkVersion [1,24]-#else-hvrCabalVersion (Version (m : n : _) _) | (m == 7 && n <= 7) || m < 7 = Version [1,16] []-hvrCabalVersion (Version (7 : n : _) _) | n <= 9 = Version [1,18] []-hvrCabalVersion (Version (7 : _) _) = Version [1,22] []-hvrCabalVersion _ = Version [1,24] []-#endif---- | What version of Happy goes with this version of GHC?-hvrHappyVersion :: Version -> Version-#if MIN_VERSION_Cabal(2,0,0)-hvrHappyVersion v =- case versionNumbers v of- (m : n : _) | (m == 7 && n <= 3) || m < 7 -> mkVersion [1,19,3]- (7 : n : _) | n <= 2 -> mkVersion [1,19,3]- _ -> mkVersion [1,19,5]-#else-hvrHappyVersion (Version (m : n : _) _) | (m == 7 && n <= 3) || m < 7 = Version [1,19,3] []-hvrHappyVersion (Version (7 : n : _) _) | n <= 2 = Version [1,19,3] []-hvrHappyVersion _ = Version [1,19,5] []-#endif---- | What version of Alex goes with this version of GHC?-hvrAlexVersion :: Version -> Version-#if MIN_VERSION_Cabal(2,0,0)-hvrAlexVersion _ = mkVersion [3,1,7]-#else-hvrAlexVersion _ = Version [3,1,7] []-#endif+withCompilerVersion :: CompilerFlavor -> (DebianVersion -> a) -> IO (Either String a)+withCompilerVersion hc f = newestAvailableCompiler hc >>= \nac -> return (fmap f nac) withModifiedPATH :: MonadIO m => (String -> String) -> m a -> m a withModifiedPATH f action = do@@ -163,68 +76,52 @@ return r -- | Memoized version of newestAvailable'-newestAvailable :: FilePath -> BinPkgName -> Either String DebianVersion-newestAvailable root pkg =- memoize2 f pkg root+newestAvailable :: BinPkgName -> IO (Memoized (Either String DebianVersion))+newestAvailable pkg = memoizeMVar (f pkg) where- f :: BinPkgName -> FilePath -> Either String DebianVersion- f pkg' root' = unsafePerformIO (newestAvailable' root' pkg')+ f :: BinPkgName -> IO (Either String DebianVersion)+ f = newestAvailable' --- | Look up the newest version of a deb available in the given changeroot.-newestAvailable' :: FilePath -> BinPkgName -> IO (Either String DebianVersion)-newestAvailable' root (BinPkgName name) = do- exists <- doesDirectoryExist root- case exists of- False -> return $ Left $ "newestAvailable: no such environment: " ++ show root- True -> do- versions <- try $ chroot root $- (readProcess "apt-cache" ["showpkg", name] "" >>=- return . dropWhile (/= "Versions: ") . lines) :: IO (Either SomeException [String])+-- | Look up the newest version of a deb available+newestAvailable' :: BinPkgName -> IO (Either String DebianVersion)+newestAvailable' (BinPkgName name) = do+ versions <- try $ dropWhile (/= "Versions: ") . lines <$> readProcess "apt-cache" ["showpkg", name] "" :: IO (Either SomeException [String]) case versions of- Left e -> return $ Left $ "newestAvailable failed in " ++ show root ++ ": " ++ show e+ Left e -> return $ Left $ "newestAvailable failed: " ++ show e Right (_ : versionLine : _) -> return . Right . parseDebianVersion' . takeWhile (/= ' ') $ versionLine Right x -> return $ Left $ "Unexpected result from apt-cache showpkg: " ++ show x- where- chroot "/" = id- chroot _ = useEnv root (return . force) -newestAvailableCompiler :: FilePath -> CompilerFlavor -> Either String DebianVersion-newestAvailableCompiler root hc = maybe (Left "No compiler package") (newestAvailable root) (compilerPackageName hc Development)+newestAvailableCompiler :: CompilerFlavor -> IO (Either String DebianVersion)+newestAvailableCompiler hc = maybe (return (Left "No compiler package")) (runMemoized <=< newestAvailable) =<< compilerPackageName hc Development -newestAvailableCompilerId :: FilePath -> CompilerFlavor -> Either String CompilerId-newestAvailableCompilerId root hc = either Left (Right . compilerIdFromDebianVersion hc) (newestAvailableCompiler root hc)+newestAvailableCompilerId :: CompilerFlavor -> IO (Either String CompilerId)+newestAvailableCompilerId hc = fmap (compilerIdFromDebianVersion hc) <$> newestAvailableCompiler hc {- -- | The IO portion of ghcVersion. For there to be no version of ghc -- available is an exceptional condition, it has been standard in -- Debian and Ubuntu for a long time.-ghcNewestAvailableVersion :: CompilerFlavor -> FilePath -> IO DebianVersion-ghcNewestAvailableVersion hc root = do- exists <- doesDirectoryExist root- when (not exists) (error $ "ghcVersion: no such environment: " ++ show root)+ghcNewestAvailableVersion :: CompilerFlavor -> IO DebianVersion+ghcNewestAvailableVersion hc = do versions <- try $ chroot $ (readProcess "apt-cache" ["showpkg", map toLower (show hc)] "" >>= return . dropWhile (/= "Versions: ") . lines) :: IO (Either SomeException [String]) case versions of- Left e -> error $ "ghcNewestAvailableVersion failed in " ++ show root ++ ": " ++ show e+ Left e -> error $ "ghcNewestAvailableVersion failed in: " ++ show e Right (_ : versionLine : _) -> return . parseDebianVersion . takeWhile (/= ' ') $ versionLine- _ -> error $ "No version of ghc available in " ++ show root- where- chroot = case root of- "/" -> id- _ -> useEnv root (return . force)+ _ -> error $ "No version of ghc available" -- | Memoize the CompilerId built for the newest available version of -- the compiler package so we don't keep running apt-cache showpkg -- over and over.-ghcNewestAvailableVersion' :: CompilerFlavor -> FilePath -> CompilerId-ghcNewestAvailableVersion' hc root =- memoize f (hc, root)+ghcNewestAvailableVersion' :: CompilerFlavor -> CompilerId+ghcNewestAvailableVersion' hc =+ memoize f hc where f :: (CompilerFlavor, FilePath) -> CompilerId- f (hc', root) = unsafePerformIO (g hc' root)- g hc root = do- ver <- ghcNewestAvailableVersion hc root+ f hc' = unsafePerformIO (g hc')+ g hc = do+ ver <- ghcNewestAvailableVersion hc let cid = compilerIdFromDebianVersion ver -- hPutStrLn stderr ("GHC Debian version: " ++ show ver ++ ", Compiler ID: " ++ show cid) return cid@@ -266,9 +163,10 @@ -- | Compute the compiler package names by finding out what package -- contains the corresponding executable.-compilerPackageName :: CompilerFlavor -> PackageType -> Maybe BinPkgName-compilerPackageName hc typ =- maybe Nothing (Just . finish) (compilerPackage hc)+compilerPackageName :: CompilerFlavor -> PackageType -> IO (Maybe BinPkgName)+compilerPackageName hc typ = do+ mcp <- compilerPackage hc+ return $ fmap finish mcp where finish (BinPkgName hcname) = let isDebian = map toLower (show hc) == hcname in@@ -286,27 +184,18 @@ (GHC, Profiling, _) -> BinPkgName (hcname ++ "-prof") _ -> BinPkgName hcname -compilerPackage :: CompilerFlavor -> Maybe BinPkgName-compilerPackage GHC = filePackage "ghc"+compilerPackage :: CompilerFlavor -> IO (Maybe BinPkgName)+compilerPackage GHC = filePackage "ghc" >>= runMemoized #if MIN_VERSION_Cabal(1,22,0)-compilerPackage GHCJS = filePackage "ghcjs"+compilerPackage GHCJS = filePackage "ghcjs" >>= runMemoized #endif compilerPackage x = error $ "compilerPackage - unsupported CompilerFlavor: " ++ show x -{--compilerExecutable :: CompilerFlavor -> String-compilerExecutable GHC = "ghc"-#if MIN_VERSION_Cabal(1,22,0)-compilerExecutable GHCJS = "ghcjs"-#endif-compilerExecutable x = error $ "compilerExecutable - unexpected flavor: " ++ show x--}--filePackage :: FilePath -> Maybe BinPkgName-filePackage = memoize f+filePackage :: FilePath -> IO (Memoized (Maybe BinPkgName))+filePackage = memoizeMVar . f where- f :: FilePath -> Maybe BinPkgName- f p = unsafePerformIO (which p >>= maybe (return Nothing) (\x -> package <$> readProcess "dpkg-query" ["-S", x] ""))+ f :: FilePath -> IO (Maybe BinPkgName)+ f p = which p >>= maybe (return Nothing) (\x -> package <$> readProcess "dpkg-query" ["-S", x] "") package :: String -> Maybe BinPkgName package s = case s =~ "^(.*): .*$" :: (String, String, String, [String]) of@@ -314,8 +203,7 @@ _ -> Nothing which :: String -> IO (Maybe FilePath)-which bin = do- (toPath . over _2 lines) <$> readProcessWithExitCode "which" [bin] ""+which bin = toPath . over _2 lines <$> readProcessWithExitCode "which" [bin] "" where toPath :: (ExitCode, [String], String) -> Maybe String toPath (ExitSuccess, [path], _) = Just path@@ -326,9 +214,8 @@ -- compiler into the chroot if necessary and ask it for its version -- number. This has the benefit of working for ghcjs, which doesn't -- make the base ghc version available in the version number.-getCompilerInfo :: MonadIO m => FilePath -> CompilerFlavor -> WithProcAndSys m (Either String CompilerInfo)-getCompilerInfo "/" flavor = liftIO $ getCompilerInfo' flavor-getCompilerInfo root flavor = liftIO $ fchroot root $ getCompilerInfo' flavor+getCompilerInfo :: MonadIO m => CompilerFlavor -> m (Either String CompilerInfo)+getCompilerInfo flavor = liftIO $ getCompilerInfo' flavor getCompilerInfo' :: CompilerFlavor -> IO (Either String CompilerInfo) getCompilerInfo' flavor = do