cabal-debian 4.24.6 → 4.24.8
raw patch · 41 files changed
+343/−567 lines, 41 filesdep ~Diffdep ~memoizedep ~prettyPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: Diff, memoize, pretty
API changes (from Hackage documentation)
- Data.Algorithm.Diff.Context: contextDiff :: Eq a => Int -> [a] -> [a] -> [[Diff [a]]]
- Data.Algorithm.Diff.Context: groups :: Eq a => (a -> a -> Bool) -> [a] -> [[a]]
- Data.Algorithm.Diff.Pretty: prettyChange :: (c -> Doc) -> Diff [c] -> [Doc]
- Data.Algorithm.Diff.Pretty: prettyDiff :: Doc -> Doc -> (c -> Doc) -> [[Diff [c]]] -> Doc
- Data.Algorithm.Diff.Pretty: prettyHunk :: (c -> Doc) -> [Diff [c]] -> [Doc]
- Debian.Debianize.BasicInfo: SubstVar :: DebType -> DebAction
- Debian.Debianize.Output: doDebianizeAction :: (MonadIO m, Functor m) => DebianT m ()
- Debian.Debianize.SubstVars: instance Eq Dependency_
- Debian.Debianize.SubstVars: instance Show Dependency_
- Debian.Debianize.SubstVars: substvars :: (MonadIO m, Functor m) => DebType -> CabalT m ()
+ Debian.Debianize.Output: finishDebianization :: (MonadIO m, Functor m) => StateT CabalInfo m ()
Files
- CabalDebian.hs +11/−51
- Tests.hs +5/−6
- cabal-debian.cabal +31/−20
- changelog +22/−0
- debian-haskell/Debian/Apt/Dependencies.hs +7/−7
- debian-haskell/Debian/Apt/Index.hs +12/−12
- debian-haskell/Debian/Apt/Methods.hs +3/−3
- debian-haskell/Debian/Changes.hs +14/−14
- debian-haskell/Debian/Control.hs +1/−1
- debian-haskell/Debian/Control/ByteString.hs +35/−16
- debian-haskell/Debian/Control/Common.hs +2/−2
- debian-haskell/Debian/Control/String.hs +5/−5
- debian-haskell/Debian/Extra/Files.hs +3/−3
- debian-haskell/Debian/GenBuildDeps.hs +15/−13
- debian-haskell/Debian/Relation/ByteString.hs +1/−1
- debian-haskell/Debian/Relation/Common.hs +4/−4
- debian-haskell/Debian/Relation/String.hs +12/−12
- debian-haskell/Debian/Relation/Text.hs +1/−1
- debian-haskell/Debian/Report.hs +1/−1
- debian-haskell/Debian/Sources.hs +1/−1
- debian-haskell/Debian/Time.hs +9/−6
- debian-haskell/Debian/UTF8.hs +3/−0
- debian-haskell/Debian/Util/FakeChanges.hs +12/−12
- debian-haskell/Debian/Version.hs +3/−3
- debian-haskell/Debian/Version/ByteString.hs +1/−1
- debian-haskell/Debian/Version/Common.hs +7/−7
- debian-haskell/Debian/Version/Text.hs +1/−1
- debian/changelog +14/−0
- src/Data/Algorithm/Diff/Context.hs +0/−60
- src/Data/Algorithm/Diff/Pretty.hs +0/−29
- src/Debian/Debianize.hs +1/−1
- src/Debian/Debianize/BasicInfo.hs +1/−7
- src/Debian/Debianize/Bundled.hs +1/−1
- src/Debian/Debianize/CabalInfo.hs +3/−7
- src/Debian/Debianize/Files.hs +1/−1
- src/Debian/Debianize/InputCabal.hs +20/−20
- src/Debian/Debianize/InputDebian.hs +2/−2
- src/Debian/Debianize/Options.hs +1/−1
- src/Debian/Debianize/Output.hs +29/−9
- src/Debian/Debianize/SubstVars.hs +0/−223
- src/Debian/GHC.hs +48/−3
CabalDebian.hs view
@@ -1,56 +1,16 @@-{-# LANGUAGE ScopedTypeVariables #-}--- | This is the main function of the cabal-debian executable. This--- is generally run by the autobuilder to debianize packages that--- don't have any custom debianization code in Setup.hs. This is a--- less flexible and powerful method than calling the debianize--- function directly, many sophisticated configuration options cannot--- be accessed using the command line interface.--import Control.Category ((.))-import Control.Lens (view)-import Control.Monad.State (get)-import Control.Monad.Trans (MonadIO, liftIO)-import Data.List as List (unlines)-import Debian.Debianize.BasicInfo (DebAction(Debianize, SubstVar, Usage), debAction, newFlags)-import Debian.Debianize.CabalInfo (newCabalInfo, debInfo)-import Debian.Debianize.DebInfo (flags)+import Control.Monad.State (evalStateT)+import Debian.Debianize.BasicInfo (newFlags)+import Debian.Debianize.CabalInfo (newCabalInfo) import Debian.Debianize.Details (debianDefaults) import Debian.Debianize.Finalize (debianize)-import Debian.Debianize.Monad (CabalT, evalCabalT, liftCabal)-import Debian.Debianize.Options (options)-import Debian.Debianize.Output (doDebianizeAction)-import Debian.Debianize.SubstVars (substvars)-import Prelude hiding (unlines, writeFile, init, (.))-import System.Console.GetOpt (OptDescr, usageInfo)-import System.Environment (getProgName)+import Debian.Debianize.Output (finishDebianization) main :: IO ()-main = cabalDebianMain debianDefaults---- | The main function for the cabal-debian executable.-cabalDebianMain :: (MonadIO m, Functor m) => CabalT m () -> m ()-cabalDebianMain init =- -- This picks up the options required to decide what action we are- -- taking. Much of this will be repeated in the call to debianize.- do atoms <- liftIO $ newFlags >>= newCabalInfo- evalCabalT (do debianize init- action <- get >>= return . view (debInfo . flags . debAction)- finish action) atoms+main = newFlags >>= newCabalInfo >>= evalStateT cabalDebian where- finish :: forall m. (MonadIO m, Functor m) => DebAction -> CabalT m ()- finish (SubstVar debType) = substvars debType- finish Debianize = liftCabal doDebianizeAction- finish Usage = do- progName <- liftIO getProgName- let info = unlines [ "Typical usage is to cd to the top directory of the package's unpacked source and run: "- , ""- , " " ++ progName ++ " --maintainer 'Maintainer Name <maintainer@email>'."- , ""- , "This will read the package's cabal file and any existing debian/changelog file and"- , "deduce what it can about the debianization, then it will create or modify files in"- , "the debian subdirectory. Note that it will not remove any files in debian, and"- , "these could affect the operation of the debianization in unknown ways. For this"- , "reason I recommend either using a pristine unpacked directory each time, or else"- , "using a revision control system to revert the package to a known state before running."- , "The following additional options are available:" ]- liftIO $ putStrLn (usageInfo info (options :: [OptDescr (CabalT m ())]))+ cabalDebian = do+ -- Read and inspect the cabal info to compute the debianization+ debianize debianDefaults+ -- Write, compare, or validate the resulting debianization,+ -- or print usage message, depending on options.+ finishDebianization
Tests.hs view
@@ -8,8 +8,7 @@ import OldLens (getL, setL) import Control.Applicative ((<$>))-import Data.Algorithm.Diff.Context (contextDiff)-import Data.Algorithm.Diff.Pretty (prettyDiff)+import Data.Algorithm.DiffContext (getContextDiff, prettyContextDiff) import Data.Function (on) import Data.List (sortBy) import Data.Map as Map (differenceWithKey, intersectionWithKey)@@ -703,15 +702,15 @@ prettyChange (Deleted p _) = text "Deleted: " <> pPrint p <> text "\n" prettyChange (Created p b) = text "Created: " <> pPrint p <> text "\n" <>- prettyDiff (text ("old" </> p)) (text ("new" </> p)) (text . unpack)+ prettyContextDiff (text ("old" </> p)) (text ("new" </> p)) (text . unpack) -- We use split here instead of lines so we can -- detect whether the file has a final newline -- character.- (contextDiff 2 mempty (split (== '\n') b))+ (getContextDiff 2 mempty (split (== '\n') b)) prettyChange (Modified p a b) = text "Modified: " <> pPrint p <> text "\n" <>- prettyDiff (text ("old" </> p)) (text ("new" </> p)) (text . unpack)- (contextDiff 2 (split (== '\n') a) (split (== '\n') b))+ prettyContextDiff (text ("old" </> p)) (text ("new" </> p)) (text . unpack)+ (getContextDiff 2 (split (== '\n') a) (split (== '\n') b)) sortBinaryDebs :: DebianT IO () sortBinaryDebs = (D.control . S.binaryPackages) %= sortBy (compare `on` getL B.package)
cabal-debian.cabal view
@@ -1,5 +1,5 @@ Name: cabal-debian-Version: 4.24.6+Version: 4.24.8 Copyright: Copyright (c) 2007-2014, David Fox, Jeremy Shaw License: BSD3 License-File: LICENSE@@ -145,6 +145,10 @@ Default: False Manual: True +flag pretty-112+ Description: prettyclass was merged into pretty-1.1.2+ Default: True+ Source-Repository head type: git location: https://github.com/ddssff/cabal-debian@@ -158,18 +162,16 @@ containers, data-default, deepseq,- Diff,+ Diff >= 0.3.1, directory, filepath, hsemail, HUnit, lens,- memoize,+ memoize >= 0.7, mtl, network-uri, parsec >= 3,- pretty,- prettyclass, process, pureMD5, regex-tdfa,@@ -180,8 +182,6 @@ Unixutils, utf8-string Exposed-Modules:- Data.Algorithm.Diff.Context- Data.Algorithm.Diff.Pretty Debian.GHC Debian.Policy Distribution.Version.Invert@@ -207,12 +207,15 @@ Debian.Debianize.Output Debian.Debianize.Prelude Debian.Debianize.SourceDebDescription- Debian.Debianize.SubstVars Debian.Debianize.VersionSplits OldLens Paths_cabal_debian Other-Modules: Debian.Orphans+ if flag(pretty-112)+ Build-Depends: pretty >= 1.1.2+ else+ Build-Depends: pretty < 1.1.2, prettyclass if flag(local-debian) Hs-Source-Dirs: debian-haskell Build-Depends:@@ -270,17 +273,25 @@ Build-depends: debian >= 3.87 Executable cabal-debian- Hs-Source-Dirs: .- Main-is: CabalDebian.hs- ghc-options: -threaded -Wall -O2- Build-Depends: base, cabal-debian, Cabal >= 1.18, lens, mtl, pretty- if !flag(local-debian)- Build-Depends: debian >= 3.87+ Hs-Source-Dirs: .+ Main-is: CabalDebian.hs+ ghc-options: -threaded -Wall -O2+ Build-Depends: base, cabal-debian, Cabal >= 1.18, lens, mtl, pretty+ if flag(pretty-112)+ Build-Depends: pretty >= 1.1.2+ else+ Build-Depends: pretty < 1.1.2, prettyclass+ if !flag(local-debian)+ Build-Depends: debian >= 3.87 Executable cabal-debian-tests- Hs-Source-Dirs: .- Main-is: Tests.hs- ghc-options: -threaded -Wall -O2- Build-Depends: base, cabal-debian, Cabal >= 1.18, containers, filepath, hsemail, HUnit, lens, prettyclass, process, text- if !flag(local-debian)- Build-Depends: debian >= 3.87+ Hs-Source-Dirs: .+ Main-is: Tests.hs+ ghc-options: -threaded -Wall -O2+ Build-Depends: base, cabal-debian, Cabal >= 1.18, containers, Diff >= 0.3.1, filepath, hsemail, HUnit, lens, process, text+ if flag(pretty-112)+ Build-Depends: pretty >= 1.1.2+ else+ Build-Depends: pretty < 1.1.2, prettyclass+ if !flag(local-debian)+ Build-Depends: debian >= 3.87
changelog view
@@ -1,3 +1,25 @@+haskell-cabal-debian (4.24.8) unstable; urgency=low++ * use ghcjs --numeric-ghc-version to set the compilerInfoCompat field+ of CompilerInfo. This makes cabal file directives like impl(ghc >= 7.9)+ work for ghcjs packages.++ -- David Fox <dsf@seereason.com> Sun, 29 Mar 2015 12:38:33 -0700++haskell-cabal-debian (4.24.7) unstable; urgency=low++ * Remove the Data.Algorithm.Diff modules, they have moved into Diff-0.3.1++ -- David Fox <dsf@seereason.com> Tue, 24 Mar 2015 16:51:29 -0700++haskell-cabal-debian (4.24.6) unstable; urgency=low++ * Use build dependency haskell-devscripts >= 0.8 for unofficial, >= 0.9+ for official.+ * Straighten out the test suite options: --no-tests, --no-run-tests++ -- David Fox <dsf@seereason.com> Mon, 23 Mar 2015 11:31:14 -0700+ haskell-cabal-debian (4.24.5) unstable; urgency=low * Patch from Dmitry Bogatov for filling in debian/copyright fields
debian-haskell/Debian/Apt/Dependencies.hs view
@@ -3,7 +3,7 @@ module Debian.Apt.Dependencies {- ( solve- , State + , State , binaryDepends , search , bj'@@ -27,7 +27,7 @@ -- * Basic CSP Types and Functions -data Status +data Status = Remaining AndRelation | MissingDep Relation | Complete@@ -87,13 +87,13 @@ let preDepends = case lookupP "Pre-Depends" p of Nothing -> []- Just (Field (_,pd)) -> + Just (Field (_,pd)) -> either (error . show) id (parseRelations pd) Just (Comment _) -> error "depF" depends = case lookupP "Depends" p of Nothing -> []- Just (Field (_,pd)) -> + Just (Field (_,pd)) -> either (error . show) id (parseRelations pd) Just (Comment _) -> error "depF" in@@ -207,7 +207,7 @@ -- |earliestInconsistency does what it sounds like -- the 'reverse as' is because the vars are order high to low, but we -- want to find the lowest numbered (aka, eariest) inconsistency ??--- +-- earliestInconsistency :: CSP a -> State a -> Maybe ((BinPkgName, DebianVersion), (BinPkgName, DebianVersion)) earliestInconsistency _ (_,[]) = Nothing earliestInconsistency _ (_,[_p]) = Nothing@@ -262,7 +262,7 @@ | isConflict cs = mkTree (s, cs) ts -- | isConflict cs' = mkTree (s, cs') [] -- prevent space leak | otherwise = mkTree (s, cs') ts- where cs' = + where cs' = let set = combine csp (map label ts) [] in set `seq` set -- prevent space leak @@ -275,7 +275,7 @@ | (not (lastvar `elem` c)) && null m = cs | null c && null m = ([],[]) -- is this case ever used? | otherwise = combine csp ns ((c, m):acc)- where lastvar = + where lastvar = let (_,(p:_)) = s in (packageVersion csp) p
debian-haskell/Debian/Apt/Index.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, OverloadedStrings, ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-orphans #-} module Debian.Apt.Index ( update@@ -52,7 +52,7 @@ = BZ2 | GZ | Uncompressed deriving (Read, Show, Eq, Ord, Enum, Bounded) -data CheckSums +data CheckSums = CheckSums { md5sum :: Maybe String , sha1 :: Maybe String , sha256 :: Maybe String@@ -66,10 +66,10 @@ -- A good choice might be a partially parameterized call to -- 'Debian.Apt.Methods.fetch' type Fetcher =- URI -> -- remote URI- FilePath -> -- local file name- Maybe UTCTime -> -- optional time stamp for local file- IO Bool -- True on success, False on failure+ URI -> -- remote URI+ FilePath -> -- local file name+ Maybe UTCTime -> -- optional time stamp for local file+ IO Bool -- True on success, False on failure -- |update - similar to apt-get update @@ -78,12 +78,12 @@ -- in \/var\/lib\/apt\/lists. You can almost use this function instead of -- calling apt-get update. However there are a few key differences: -- 1. apt-get update also updates the binary cache files--- 2. apt-get update uses the partial directory and lock file in\ /var\/lib\/apt\/lists +-- 2. apt-get update uses the partial directory and lock file in\ /var\/lib\/apt\/lists -- 3. apt-get update downloads the Release and Release.gpg files update :: Fetcher -- ^ function that will do actually downloading -> FilePath -- ^ download indexes to the directory (must already exist) -> String -- ^ binary architecture- -> [DebSource] -- ^ sources.list + -> [DebSource] -- ^ sources.list -> IO [Maybe (FilePath, Compression)] -- ^ (basename of index file, compression status) update fetcher basePath arch sourcesList = mapM (uncurry $ fetchIndex fetcher) (map (\(uri, fp, _) -> (uri, (basePath </> fp))) (concatMap (indexURIs arch) sourcesList))@@ -126,7 +126,7 @@ (release, sections) = either (error $ "indexURIs: support not implemented for exact path: " ++ render (pPrint debSource)) id (sourceDist debSource) --- |return a tuple for the section +-- |return a tuple for the section -- - the URI to the uncompressed index file -- - the basename that apt-get uses for the downloaded index -- FIXME: support for Release and Release.gpg@@ -204,7 +204,7 @@ combine = (\x y -> sortBy (compare `on` snd) (x ++ y)) {- with t@(_,_,fp) m =- let (un, compression) = + let (un, compression) = in M.insertWith -}@@ -238,7 +238,7 @@ do indexes' <- mapM (filterExists distDir) (filter (isType iType) indexes) return $ map (head . snd) (filter (not . List.null . snd) indexes') where- isType iType (fp, _) = iType `isSuffixOf` fp + isType iType (fp, _) = iType `isSuffixOf` fp {- findIndexes' :: FilePath -> String -> [FileTuple] -> IO [(FileTuple, Compression)]@@ -268,7 +268,7 @@ indexesInRelease :: (FilePath -> Bool) -> Control' Text -- ^ A release file- -> [(CheckSums, Integer, FilePath)] -- ^ + -> [(CheckSums, Integer, FilePath)] -- ^ indexesInRelease filterp (Control [p]) = let md5sums = case md5sumField p of
debian-haskell/Debian/Apt/Methods.hs view
@@ -138,13 +138,13 @@ | a == "Pipeline" = c { pipeline = parseTrueFalse v } | a == "Send-Config" = c { sendConfig = parseTrueFalse v } | a == "Needs-Cleanup" = c { needsCleanup = parseTrueFalse v }- | a == "Local-Only" = c { localOnly = parseTrueFalse v }+ | a == "Local-Only" = c { localOnly = parseTrueFalse v } | otherwise = error $ "unknown capability: " ++ show (a,v) defaultCapabilities = Capabilities { version = "" , singleInstance = False- , preScan = False- , pipeline = False+ , preScan = False+ , pipeline = False , sendConfig = False , needsCleanup = False , localOnly = False
debian-haskell/Debian/Changes.hs view
@@ -31,14 +31,14 @@ -- |A file generated by dpkg-buildpackage describing the result of a -- package build data ChangesFile =- Changes { changeDir :: FilePath -- ^ The full pathname of the directory holding the .changes file.- , changePackage :: String -- ^ The package name parsed from the .changes file name- , changeVersion :: DebianVersion -- ^ The version number parsed from the .changes file name- , changeRelease :: ReleaseName -- ^ The Distribution field of the .changes file- , changeArch :: Arch -- ^ The architecture parsed from the .changes file name- , changeInfo :: S.Paragraph' Text -- ^ The contents of the .changes file- , changeEntry :: ChangeLogEntry -- ^ The value of the Changes field of the .changes file- , changeFiles :: [ChangedFileSpec] -- ^ The parsed value of the Files attribute+ Changes { changeDir :: FilePath -- ^ The full pathname of the directory holding the .changes file.+ , changePackage :: String -- ^ The package name parsed from the .changes file name+ , changeVersion :: DebianVersion -- ^ The version number parsed from the .changes file name+ , changeRelease :: ReleaseName -- ^ The Distribution field of the .changes file+ , changeArch :: Arch -- ^ The architecture parsed from the .changes file name+ , changeInfo :: S.Paragraph' Text -- ^ The contents of the .changes file+ , changeEntry :: ChangeLogEntry -- ^ The value of the Changes field of the .changes file+ , changeFiles :: [ChangedFileSpec] -- ^ The parsed value of the Files attribute } deriving (Eq, Read, Show) -- |An entry in the list of files generated by the build.@@ -162,7 +162,7 @@ must be preceded by exactly one space. The maintainer details and the date must be separated by exactly two spaces. -The entire changelog must be encoded in UTF-8. +The entire changelog must be encoded in UTF-8. -} -- | Parse the entries of a debian changelog and verify they are all@@ -190,11 +190,11 @@ case matchRegexAll entryRE text of Nothing -> Failure ["Parse error in changelog:\n" ++ show text] Just ("", _, remaining, [_, name, version, dists, urgency, _, details, _, _, _, _, _, who, date, _]) ->- Success (Entry name + Success (Entry name (parseDebianVersion version) (map parseReleaseName . words $ dists) urgency- details+ details who date, remaining)@@ -208,11 +208,11 @@ case text =~ entryRE :: MatchResult String of x | mrSubList x == [] -> Left ["Parse error in " ++ show text] MR {mrAfter = after, mrSubList = [_, name, ver, dists, urgency, _, details, _, _, who, _, date, _]} ->- Right (Entry name + Right (Entry name (parseDebianVersion ver) (map parseReleaseName . words $ dists) urgency- (" " ++ unpack (strip (pack details)) ++ "\n")+ (" " ++ unpack (strip (pack details)) ++ "\n") (take (length who - 2) who) date, after)@@ -254,7 +254,7 @@ (parseDebianVersion ver) (map parseReleaseName . words $ dists) urgency- details+ details "" "" MR {mrSubList = x} -> error $ "Unexpected match: " ++ show x where
debian-haskell/Debian/Control.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -- |A module for working with Debian control files <http://www.debian.org/doc/debian-policy/ch-controlfields.html>-module Debian.Control +module Debian.Control ( -- * Types Control'(..) , Paragraph'(..)
debian-haskell/Debian/Control/ByteString.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, PackageImports, ScopedTypeVariables #-}+{-# LANGUAGE CPP, FlexibleContexts, MultiParamTypeClasses, PackageImports, ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-orphans #-} module Debian.Control.ByteString ( Control'(..)@@ -21,6 +21,10 @@ -- Standard GHC modules +#if !MIN_VERSION_base(4,8,0)+import Control.Applicative (Applicative(..))+#endif+import Control.Applicative (Alternative(..)) import qualified Control.Exception as E import "mtl" Control.Monad.State @@ -89,13 +93,13 @@ else Ok (Comment text, bs') pParagraph :: ControlParser Paragraph-pParagraph = +pParagraph = do f <- pMany1 (pComment <|> pField) pSkipMany (pChar '\n') return (Paragraph f) pControl :: ControlParser Control-pControl = +pControl = do pSkipMany (pChar '\n') c <- pMany pParagraph return (Control c)@@ -104,7 +108,7 @@ -- parseControlFromFile :: FilePath -> IO (Either String Control) instance ControlFunctions C.ByteString where- parseControlFromFile fp = + parseControlFromFile fp = do c <- C.readFile fp case parse pControl c of Nothing -> return (Left (newErrorMessage (Message ("Failed to parse " ++ fp)) (newPos fp 0 0)))@@ -135,13 +139,13 @@ dropWhileEnd func = LL.reverse . LL.dropWhile func . LL.reverse -- foldr (\x xs -> if func x && LL.null xs then LL.empty else LL.cons x xs) empty protect :: (LL.StringLike a, LL.ListLike a Word8) => a -> a protect l = maybe LL.empty (\ c -> if isHorizSpace c then l else LL.cons (ord' ' ' :: Word8) l) (LL.find (const True :: Word8 -> Bool) l)- isSpace' = isSpace . chr'+ -- isSpace' = isSpace . chr' isHorizSpace c = elem c (map ord' " \t") ord' = fromIntegral . ord- chr' = chr . fromIntegral+ -- chr' = chr . fromIntegral {--main = +main = do [fp] <- getArgs C.readFile fp >>= \c -> maybe (putStrLn "failed.") (print . length . fst) (parse pControl c) -}@@ -168,13 +172,32 @@ newtype Parser state a = Parser { unParser :: (state -> Result (a, state)) } +instance Functor (Parser state) where+ fmap f m =+ Parser $ \ state ->+ let r = (unParser m) state in+ case r of+ Ok (a,state') -> Ok (f a,state')+ Empty -> Empty+ Fail -> Fail++instance Applicative (Parser state) where+ pure = return+ (<*>) = ap++instance Alternative (Parser state) where+ empty =+ Parser $ \state ->+ (unParser mzero) state+ (<|>) = mplus+ instance Monad (Parser state) where return a = Parser (\s -> Ok (a,s)) m >>= f = Parser $ \state -> let r = (unParser m) state in case r of- Ok (a,state') -> + Ok (a,state') -> case unParser (f a) $ state' of Empty -> Fail o -> o@@ -188,7 +211,7 @@ Empty -> p2 s o -> o )- + -- Parser (\s -> maybe (p2 s) (Just) (p1 s)) @@ -199,10 +222,6 @@ _pFail = Parser (const Empty) -(<|>) :: Parser state a -> Parser state a -> Parser state a-(<|>) = mplus-- satisfy :: (Char -> Bool) -> Parser C.ByteString Char satisfy f = Parser $ \bs ->@@ -236,14 +255,14 @@ Parser $ \bs -> Ok ((), C.dropWhile p bs) pMany :: Parser st a -> Parser st [a]-pMany p +pMany p = scan id where scan f = do x <- p scan (\tail -> f (x:tail)) <|> return (f []) -notEmpty :: Parser st C.ByteString -> Parser st C.ByteString +notEmpty :: Parser st C.ByteString -> Parser st C.ByteString notEmpty (Parser p) = Parser $ \s -> case p s of o@(Ok (a, _s)) ->@@ -262,7 +281,7 @@ pSkipMany p = scan where scan = (p >> scan) <|> return ()- + _pSkipMany1 :: Parser st a -> Parser st () _pSkipMany1 p = p >> pSkipMany p
debian-haskell/Debian/Control/Common.hs view
@@ -169,7 +169,7 @@ result <- parseControlFromHandle cmd outh either (return . Left . show) (finish handle) result where- finish handle control = + finish handle control = do exitCode <- waitForProcess handle case exitCode of@@ -185,7 +185,7 @@ md5sumField p = case fieldValue "MD5Sum" p of m@(Just _) -> m- Nothing -> + Nothing -> case fieldValue "Md5Sum" p of m@(Just _) -> m Nothing -> fieldValue "MD5sum" p
debian-haskell/Debian/Control/String.hs view
@@ -40,14 +40,14 @@ -- * ControlFunctions instance ControlFunctions String where- parseControlFromFile filepath = - parseFromFile pControl filepath - parseControlFromHandle sourceName handle = + parseControlFromFile filepath =+ parseFromFile pControl filepath+ parseControlFromHandle sourceName handle = E.try (hGetContents handle) >>= either (\ (e :: E.SomeException) -> error ("parseControlFromHandle String: Failure parsing " ++ sourceName ++ ": " ++ show e)) (return . parseControl sourceName)- parseControl sourceName c = + parseControl sourceName c = parse pControl sourceName c- lookupP fieldName (Paragraph paragraph) = + lookupP fieldName (Paragraph paragraph) = find (hasFieldName (map toLower fieldName)) paragraph where hasFieldName name (Field (fieldName',_)) = name == map toLower fieldName' hasFieldName _ _ = False
debian-haskell/Debian/Extra/Files.hs view
@@ -9,9 +9,9 @@ import System.IO (hPutStr, hClose, openBinaryTempFile) withTemporaryFile :: MonadIO m- => (FilePath -> m a) -- ^ The function we want to pass a FilePath to- -> String -- ^ The text that the file should contain- -> m a -- ^ The function's return value+ => (FilePath -> m a) -- ^ The function we want to pass a FilePath to+ -> String -- ^ The text that the file should contain+ -> m a -- ^ The function's return value withTemporaryFile f text = do path <- liftIO writeTemporaryFile result <- f path
debian-haskell/Debian/GenBuildDeps.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts, OverloadedStrings, RecordWildCards, ScopedTypeVariables, TemplateHaskell #-}+{-# LANGUAGE CPP, FlexibleContexts, OverloadedStrings, RecordWildCards, ScopedTypeVariables, TemplateHaskell #-} -- |Figure out the dependency relation between debianized source -- directories. The code to actually solve these dependency relations -- for a particular set of binary packages is in Debian.Repo.Dependency.@@ -23,27 +23,29 @@ , getSourceOrder ) where +#if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>))+#endif import Control.Exception (throw)-import Control.Monad (filterM)-import Data.Graph (Graph, Edge, Vertex, buildG, topSort, reachable, transposeG, edges, scc)-import Data.List+import Control.Monad (filterM)+import Data.Graph (Graph, Edge, Vertex, buildG, topSort, reachable, transposeG, edges, scc)+import Data.List import qualified Data.Map as Map-import Data.Maybe+import Data.Maybe import qualified Data.Set as Set import Data.Tree as Tree (Tree(Node, rootLabel, subForest))-import Debian.Control (parseControlFromFile)-import Debian.Control.Policy (HasDebianControl, DebianControl, ControlFileError(..), validateDebianControl, debianSourcePackageName, debianBinaryPackageNames, debianBuildDeps, debianBuildDepsIndep)+import Debian.Control (parseControlFromFile)+import Debian.Control.Policy (HasDebianControl, DebianControl, ControlFileError(..), validateDebianControl, debianSourcePackageName, debianBinaryPackageNames, debianBuildDeps, debianBuildDepsIndep) import Debian.Loc (__LOC__)-import Debian.Relation-import Debian.Relation.Text ()-import System.Directory (getDirectoryContents, doesFileExist)+import Debian.Relation+import Debian.Relation.Text ()+import System.Directory (getDirectoryContents, doesFileExist) -- | This type describes the build dependencies of a source package. data DepInfo = DepInfo {- sourceName :: SrcPkgName -- ^ source package name- , relations :: Relations -- ^ dependency relations- , binaryNames :: [BinPkgName] -- ^ binary dependency names (is this a function of relations?)+ sourceName :: SrcPkgName -- ^ source package name+ , relations :: Relations -- ^ dependency relations+ , binaryNames :: [BinPkgName] -- ^ binary dependency names (is this a function of relations?) } deriving Show instance Eq DepInfo where
debian-haskell/Debian/Relation/ByteString.hs view
@@ -13,7 +13,7 @@ -- * Relation Parser , RelParser , ParseRelations(..)- ) where + ) where import qualified Data.ByteString.Char8 as C
debian-haskell/Debian/Relation/Common.hs view
@@ -59,10 +59,10 @@ instance Ord Relation where compare (Rel pkgName1 mVerReq1 _mArch1) (Rel pkgName2 mVerReq2 _mArch2) =- case compare pkgName1 pkgName2 of- LT -> LT- GT -> GT- EQ -> compare mVerReq1 mVerReq2+ case compare pkgName1 pkgName2 of+ LT -> LT+ GT -> GT+ EQ -> compare mVerReq1 mVerReq2 data ArchitectureReq = ArchOnly (Set Arch)
debian-haskell/Debian/Relation/String.hs view
@@ -52,7 +52,7 @@ -- are omitted and it is possible to parse relations without them. pRelations :: RelParser Relations pRelations = do -- rel <- sepBy pOrRelation (char ',')- rel <- many pOrRelation+ rel <- many pOrRelation eof return rel @@ -92,34 +92,34 @@ pVerReq = do char '<' (do char '<' <|> char ' ' <|> char '\t'- return $ SLT+ return $ SLT <|> do char '='- return $ LTE)+ return $ LTE) <|> do string "=" return $ EEQ <|> do char '>' (do char '='- return $ GRE+ return $ GRE <|> do char '>' <|> char ' ' <|> char '\t'- return $ SGR)+ return $ SGR) pMaybeArch :: RelParser (Maybe ArchitectureReq) pMaybeArch = do char '[' (do archs <- pArchExcept- char ']'+ char ']' skipMany whiteChar- return (Just (ArchExcept (fromList . map parseArchExcept $ archs)))- <|>- do archs <- pArchOnly- char ']'+ return (Just (ArchExcept (fromList . map parseArchExcept $ archs)))+ <|>+ do archs <- pArchOnly+ char ']' skipMany whiteChar- return (Just (ArchOnly (fromList . map parseArch $ archs)))- )+ return (Just (ArchOnly (fromList . map parseArch $ archs)))+ ) <|> return Nothing
debian-haskell/Debian/Relation/Text.hs view
@@ -13,7 +13,7 @@ -- * Relation Parser , RelParser , ParseRelations(..)- ) where + ) where import qualified Data.Text as T
debian-haskell/Debian/Report.hs view
@@ -48,7 +48,7 @@ -- see also: |trumpedMap| trumped :: Fetcher -- ^ function for downloading package indexes -> FilePath -- ^ cache directory to store index files in (must already exist)- -> String -- ^ binary architecture + -> String -- ^ binary architecture -> [DebSource] -- ^ sources.list a -> [DebSource] -- ^ sources.list b -> IO (M.Map Text (DebianVersion, DebianVersion)) -- ^ a map of trumped package names to (version a, version b)
debian-haskell/Debian/Sources.hs view
@@ -89,7 +89,7 @@ quoteWords' :: String -> [String] quoteWords' [] = [] quoteWords' str =- case break (flip elem " [\"") str of+ case break (flip elem (" [\"" :: String)) str of ([],[]) -> [] (w, []) -> [w] (w, (' ':rest)) -> w : (quoteWords' (dropWhile (==' ') rest))
debian-haskell/Debian/Time.hs view
@@ -1,24 +1,27 @@+{-# LANGUAGE CPP #-} module Debian.Time where import Data.Time-import Data.Time.Clock.POSIX+#if !MIN_VERSION_time(1,5,0) import System.Locale (defaultTimeLocale)+#endif+import Data.Time.Clock.POSIX import System.Posix.Types -- * Time Helper Functions -rfc822DateFormat :: String-rfc822DateFormat = "%a, %d %b %Y %T %z"+rfc822DateFormat' :: String+rfc822DateFormat' = "%a, %d %b %Y %T %z" epochTimeToUTCTime :: EpochTime -> UTCTime epochTimeToUTCTime = posixSecondsToUTCTime . fromIntegral . fromEnum formatTimeRFC822 :: (FormatTime t) => t -> String-formatTimeRFC822 = formatTime defaultTimeLocale rfc822DateFormat+formatTimeRFC822 = formatTime defaultTimeLocale rfc822DateFormat' parseTimeRFC822 :: (ParseTime t) => String -> Maybe t-parseTimeRFC822 = parseTime defaultTimeLocale rfc822DateFormat+parseTimeRFC822 = parseTime defaultTimeLocale rfc822DateFormat' getCurrentLocalRFC822Time :: IO String-getCurrentLocalRFC822Time = getCurrentTime >>= utcToLocalZonedTime >>= return . formatTime defaultTimeLocale rfc822DateFormat+getCurrentLocalRFC822Time = getCurrentTime >>= utcToLocalZonedTime >>= return . formatTime defaultTimeLocale rfc822DateFormat'
debian-haskell/Debian/UTF8.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | There are old index files that have funky characters like 'ø' -- that are not properly UTF8 encoded. As far as I can tell, these -- files are otherwise plain ascii, so just naivelyinsert the@@ -7,7 +8,9 @@ , readFile ) where +#if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>))+#endif import qualified Data.ByteString.Char8 as B (concat) import qualified Data.ByteString.Lazy.Char8 as L (ByteString, readFile, toChunks) import Data.Char (chr)
debian-haskell/Debian/Util/FakeChanges.hs view
@@ -32,8 +32,8 @@ | VersionMismatch [Maybe String] deriving (Read, Show, Eq, Typeable, Data) -data Files - = Files { dsc :: Maybe (FilePath, Paragraph) +data Files+ = Files { dsc :: Maybe (FilePath, Paragraph) , debs :: [(FilePath, Paragraph)] , tar :: Maybe FilePath , diff :: Maybe FilePath@@ -42,12 +42,12 @@ fakeChanges :: [FilePath] -> IO (FilePath, String) fakeChanges fps = do files <- loadFiles fps- let version = getVersion files+ let version = getVersion files source = getSource files maintainer = getMaintainer files arches = getArches files binArch = getBinArch files- dist = "unstable"+ dist = "unstable" urgency = "low" (invalid, binaries) = unzipEithers $ map (debNameSplit . fst) (debs files) when (not . null $ invalid) (error $ "Some .deb names are invalid: " ++ show invalid)@@ -119,9 +119,9 @@ debSource (deb,p) = case (fieldValue "Source" p) of (Just v) -> v- Nothing -> + Nothing -> case fieldValue "Package" p of- (Just v) -> v + (Just v) -> v Nothing -> error $ "Could not find Source or Package field in " ++ deb @@ -165,7 +165,7 @@ mkFileLine fp | ".deb" `isSuffixOf` fp = do sum <- L.readFile fp >>= return . show . MD5.md5- size <- liftM fileSize $ getFileStatus fp + size <- liftM fileSize $ getFileStatus fp (Control (p:_)) <- Deb.fields fp return $ concat [ " ", sum, " ", show size, " ", fromMaybe "unknown" (fieldValue "Section" p), " " , fromMaybe "optional" (fieldValue "Priority" p), " ", (takeBaseName fp)@@ -176,7 +176,7 @@ return $ concat [ " ", sum, " ", show size, " ", "unknown", " " , "optional"," ", (takeBaseName fp) ]- + -- more implementations can be found at: -- http://www.google.com/codesearch?hl=en&lr=&q=%22%5BEither+a+b%5D+-%3E+%28%5Ba%5D%2C%5Bb%5D%29%22&btnG=Search unzipEithers :: [Either a b] -> ([a],[b])@@ -191,8 +191,8 @@ case (takeFileName fp) =~ "^(.*)_(.*)_(.*).deb$" of [[_, name, version, arch]] -> Right (name, version, arch) _ -> Left fp- + loadFiles :: [FilePath] -> IO Files loadFiles files = let (dscs', files'') = partition (isSuffixOf ".dsc") files'@@ -213,7 +213,7 @@ -- if (not . null $ errors) then throwDyn errors else return (debs, listToMaybe dscs, listToMaybe tars, listToMaybe diffs) where loadDsc :: FilePath -> IO (FilePath, Paragraph)- loadDsc dsc' = + loadDsc dsc' = do res <- parseControlFromFile dsc' case res of (Left e) -> error $ "Error parsing " ++ dsc' ++ "\n" ++ show e@@ -229,7 +229,7 @@ getUploader :: IO String getUploader =- do debFullName <- + do debFullName <- do dfn <- try (getEnv "DEBFULLNAME") case dfn of (Right n) -> return n@@ -240,7 +240,7 @@ (Left (_ :: SomeException)) -> error $ "Could not determine user name, neither DEBFULLNAME nor USER enviroment variables were set." emailAddr <- do eml <- try (getEnv "DEBEMAIL")- case eml of + case eml of (Right e) -> return e (Left (_ :: SomeException)) -> do eml' <- try (getEnv "EMAIL")
debian-haskell/Debian/Version.hs view
@@ -1,7 +1,7 @@ -- |A module for parsing, comparing, and (eventually) modifying debian version -- numbers. <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Version>-module Debian.Version - (DebianVersion -- |Exported abstract because the internal representation is likely to change +module Debian.Version+ (DebianVersion -- |Exported abstract because the internal representation is likely to change , prettyDebianVersion , parseDebianVersion , epoch@@ -9,7 +9,7 @@ , revision , buildDebianVersion , evr- ) where + ) where import Debian.Version.Common import Debian.Version.String ()
debian-haskell/Debian/Version/ByteString.hs view
@@ -9,7 +9,7 @@ import Debian.Version.Common import Debian.Version.Internal- + instance ParseDebianVersion C.ByteString where parseDebianVersion byteStr = let str = C.unpack byteStr in
debian-haskell/Debian/Version/Common.hs view
@@ -3,10 +3,10 @@ {-# LANGUAGE FlexibleInstances #-} {-# OPTIONS -fno-warn-orphans -fno-warn-unused-do-bind #-} module Debian.Version.Common- ( DebianVersion -- |Exported abstract because the internal representation is likely to change + ( DebianVersion -- |Exported abstract because the internal representation is likely to change , prettyDebianVersion , ParseDebianVersion(..)- , evr -- DebianVersion -> (Maybe Int, String, Maybe String)+ , evr -- DebianVersion -> (Maybe Int, String, Maybe String) , epoch , version , revision@@ -106,13 +106,13 @@ showN :: Found Numeric -> String showN (Found (Numeric n nn)) = show n ++ maybe "" showNN nn-showN (Simulated _) = "" +showN (Simulated _) = "" -} parseDV :: CharParser () (Found Int, NonNumeric, Found NonNumeric) parseDV = do skipMany $ oneOf " \t"- e <- parseEpoch + e <- parseEpoch upstreamVersion <- parseNonNumeric True True debianRevision <- option (Simulated (NonNumeric "" (Simulated (Numeric 0 Nothing)))) (char '-' >> parseNonNumeric True False >>= return . Found) return (e, upstreamVersion, debianRevision)@@ -120,8 +120,8 @@ parseEpoch :: CharParser () (Found Int) parseEpoch = option (Simulated 0) (try (many1 digit >>= \d -> char ':' >> return (Found (read d))))- + parseNonNumeric :: Bool -> Bool -> CharParser () NonNumeric parseNonNumeric zeroOk upstream = do nn <- (if zeroOk then many else many1) ((noneOf "-0123456789") <|> (if upstream then upstreamDash else pzero))@@ -146,7 +146,7 @@ compareTest str1 str2 = let v1 = either (error . show) id $ parse parseDV str1 str1 v2 = either (error . show) id $ parse parseDV str2 str2- in + in compare v1 v2 -} @@ -157,7 +157,7 @@ evr (DebianVersion s _) = let re = mkRegex "^(([0-9]+):)?(([^-]*)|((.*)-([^-]*)))$" in -- ( ) ( ( ))- -- ( e ) ( v ) (v2) ( r )+ -- ( e ) ( v ) (v2) ( r ) case matchRegex re s of Just ["", _, _, v, "", _, _] -> (Nothing, v, Nothing) Just ["", _, _, _, _, v, r] -> (Nothing, v, Just r)
debian-haskell/Debian/Version/Text.hs view
@@ -9,7 +9,7 @@ import Debian.Version.Common import Debian.Version.Internal- + instance ParseDebianVersion T.Text where parseDebianVersion text = let str = T.unpack text in
debian/changelog view
@@ -1,3 +1,17 @@+haskell-cabal-debian (4.24.8) unstable; urgency=low++ * use ghcjs --numeric-ghc-version to set the compilerInfoCompat field+ of CompilerInfo. This makes cabal file directives like impl(ghc >= 7.9)+ work for ghcjs packages.++ -- David Fox <dsf@seereason.com> Sun, 29 Mar 2015 12:38:33 -0700++haskell-cabal-debian (4.24.7) unstable; urgency=low++ * Remove the Data.Algorithm.Diff modules, they have moved into Diff-0.3.1++ -- David Fox <dsf@seereason.com> Tue, 24 Mar 2015 16:51:29 -0700+ haskell-cabal-debian (4.24.6) unstable; urgency=low * Use build dependency haskell-devscripts >= 0.8 for unofficial, >= 0.9
− src/Data/Algorithm/Diff/Context.hs
@@ -1,60 +0,0 @@-module Data.Algorithm.Diff.Context- ( contextDiff- , groups- ) where--import Data.Algorithm.Diff (Diff(..), getGroupedDiff)---- | Do a grouped diff and then turn it into a list of hunks, where--- each hunk is a grouped diff with at most N elements of common--- context around each one.-contextDiff :: Eq a => Int -> [a] -> [a] -> [[Diff [a]]]-contextDiff context a b =- group $ swap $ trimTail $ trimHead $ concatMap split $ getGroupedDiff a b- where- -- Split common runs longer than 2N elements, keeping first and- -- last N lines.- split (Both xs ys) =- case length xs of- n | n > (2 * context) -> [Both (take context xs) (take context ys), Both (drop (n - context) xs) (drop (n - context) ys)]- _ -> [Both xs ys]- split x = [x]- -- If split created a a pair of Both's at the beginning or end- -- of the diff, remove the outermost.- trimHead [] = []- trimHead [Both _ _] = []- trimHead [Both _ _, Both _ _] = []- trimHead (Both _ _ : x@(Both _ _) : more) = x : more- trimHead xs = trimTail xs- trimTail [x@(Both _ _), Both _ _] = [x]- trimTail (x : more) = x : trimTail more- trimTail [] = []- -- If we see Second before First swap them so that the deletions- -- appear before the additions.- swap (x@(Second _) : y@(First _) : xs) = y : x : swap xs- swap (x : xs) = x : swap xs- swap [] = []- -- Split the list wherever we see adjacent Both constructors- group xs =- groups (\ x y -> not (isBoth x && isBoth y)) xs- where- isBoth (Both _ _) = True- isBoth _ = False---- | Group the elements whose adjacent pairs satisfy the predicate.--- Differs from groupBy because the predicate does not have to define--- a total ordering.-groups :: Eq a => (a -> a -> Bool) -> [a] -> [[a]]-groups f xs =- filter (/= []) $ reverse (groups' [[]] xs)- where- -- Predicate satisfied, add x to the current group r and recurse with y at head- groups' (r : rs) (x : y : xs') | f x y = groups' ((x : r) : rs) (y : xs')- -- Predicate not satisfied, add x to current group and start a new group containing y- groups' (r : rs) (x : y : xs') = groups' ([y] : reverse (x : r) : rs) xs'- -- Last element, add it to the current group- groups' (r : rs) [y] = reverse (y : r) : rs- -- Nothing left, return result- groups' rs [] = rs- -- This won't happen, groups' is always called with a non-empty list in the first argument- groups' [] (_ : _) = error "groups"
− src/Data/Algorithm/Diff/Pretty.hs
@@ -1,29 +0,0 @@-{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}-module Data.Algorithm.Diff.Pretty- ( prettyDiff- , prettyHunk- , prettyChange- ) where--import Data.Algorithm.Diff (Diff(..))-import Data.Monoid ((<>))-import Text.PrettyPrint (Doc, text, empty, hcat)---- | Pretty print a list of hunks.-prettyDiff :: forall c. Doc -> Doc -> (c -> Doc) -> [[Diff [c]]] -> Doc-prettyDiff _ _ _ [] = empty-prettyDiff old new prettyElem hunks =- hcat . map (<> text "\n") $ (text "--- " <> old :- text "+++ " <> new :- concatMap (prettyHunk prettyElem) hunks)---- | Pretty print a hunk of adjacent changes-prettyHunk :: (c -> Doc) -> [Diff [c]] -> [Doc]-prettyHunk prettyElem hunk =- text "@@" : concatMap (prettyChange prettyElem) hunk---- | Pretty print a single change (e.g. a line of a text file)-prettyChange :: (c -> Doc) -> Diff [c] -> [Doc]-prettyChange prettyElem (Both ts _) = map (\ l -> text " " <> prettyElem l) ts-prettyChange prettyElem (First ts) = map (\ l -> text "-" <> prettyElem l) ts-prettyChange prettyElem (Second ts) = map (\ l -> text "+" <> prettyElem l) ts
src/Debian/Debianize.hs view
@@ -186,7 +186,7 @@ import Debian.Debianize.InputCabal (inputCabalization) import Debian.Debianize.Monad (CabalM, CabalT, evalCabalM, evalCabalT, execCabalM, execCabalT, runCabalM, runCabalT, DebianT, execDebianT, evalDebianT, liftCabal) import Debian.Debianize.Options (compileArgs)-import Debian.Debianize.Output (compareDebianization, describeDebianization, doDebianizeAction, runDebianizeScript, validateDebianization, writeDebianization)+import Debian.Debianize.Output (compareDebianization, describeDebianization, finishDebianization, runDebianizeScript, validateDebianization, writeDebianization) import Debian.Debianize.Prelude ((%=), (+++=), (++=), (+=), buildDebVersionMap, debOfFile, dpkgFileMap, withCurrentDirectory, (~=), (~?=)) import Debian.Debianize.SourceDebDescription import Debian.Debianize.VersionSplits (DebBase(DebBase))
src/Debian/Debianize/BasicInfo.hs view
@@ -80,7 +80,7 @@ , buildOS :: FilePath -- ^ An environment where we have built a package } deriving (Eq, Ord, Show, Data, Typeable) -data DebAction = Usage | Debianize | SubstVar DebType deriving (Read, Show, Eq, Ord, Data, Typeable)+data DebAction = Usage | Debianize deriving (Read, Show, Eq, Ord, Data, Typeable) -- | A redundant data type, too lazy to expunge. data DebType = Dev | Prof | Doc deriving (Eq, Ord, Read, Show, Data, Typeable)@@ -124,12 +124,6 @@ , "Distribution.PackageDescription.Configuration when loading the cabal file."]), Option "" ["debianize"] (NoArg (debAction ~= Debianize)) "Deprecated - formerly used to get what is now the normal benavior.",- Option "" ["substvar"] (ReqArg (\ name -> debAction ~= (SubstVar (read' (\ s -> error $ "substvar: " ++ show s) name))) "Doc, Prof, or Dev")- (unlines [ "With this option no debianization is generated. Instead, the list"- , "of dependencies required for the dev, prof or doc package (depending"- , "on the argument) is printed to standard output. These can be added"- , "to the appropriate substvars file. (This is an option whose use case"- , "is lost in the mists of time.)"]), Option "" ["buildenvdir"] (ReqArg (\ s -> buildEnv ~= EnvSet {cleanOS = s </> "clean", dependOS = s </> "depend", buildOS = s </> "build"}) "PATH") "Directory containing the three build environments, clean, depend, and build.", Option "f" ["cabal-flags"] (ReqArg (\ s -> cabalFlagAssignments %= (Set.union (fromList (flagList s)))) "FLAG FLAG ...")
src/Debian/Debianize/Bundled.hs view
@@ -1,7 +1,7 @@ -- | Determine whether a specific version of a Haskell package is -- bundled with into this particular version of the given compiler. -{-# LANGUAGE CPP, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell #-} module Debian.Debianize.Bundled ( builtIn -- * Utilities
src/Debian/Debianize/CabalInfo.hs view
@@ -17,31 +17,27 @@ , newCabalInfo ) where -import OldLens (access)- import Control.Category ((.)) import Control.Lens.TH (makeLenses)-import Control.Monad (unless, when) import Control.Monad.State (execStateT) import Control.Monad.Trans (liftIO) import Data.Generics (Data, Typeable)-import Data.List as List (null) import Data.Map as Map (Map) import Data.Monoid (Monoid(..)) import Data.Text as Text (null, pack, strip) import Debian.Debianize.BasicInfo (Flags)-import Debian.Debianize.DebInfo as D (control, copyright, DebInfo, makeDebInfo, enableTests, runTests, rulesSettings)+import Debian.Debianize.DebInfo as D (control, copyright, DebInfo, makeDebInfo) import Debian.Debianize.BinaryDebDescription (Canonical(canonical)) import Debian.Debianize.CopyrightDescription (defaultCopyrightDescription) import Debian.Debianize.InputCabal (inputCabalization)-import Debian.Debianize.Prelude ((~=), (%=))+import Debian.Debianize.Prelude ((~=)) import Debian.Debianize.SourceDebDescription as S (homepage) import Debian.Debianize.VersionSplits (VersionSplits) import Debian.Orphans () import Debian.Relation (BinPkgName) import Debian.Version (DebianVersion) import Distribution.Package (PackageName)-import Distribution.PackageDescription as Cabal (PackageDescription(homepage, testSuites))+import Distribution.PackageDescription as Cabal (PackageDescription(homepage)) import Prelude hiding ((.), init, init, log, log, null) -- This enormous record is a mistake - instead it should be an Atom
src/Debian/Debianize/Files.hs view
@@ -1,6 +1,6 @@ -- | Convert a Debianization into a list of files that can then be -- written out.-{-# LANGUAGE CPP, FlexibleInstances, OverloadedStrings, ScopedTypeVariables, TupleSections #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances, OverloadedStrings, ScopedTypeVariables, TupleSections #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Debian.Debianize.Files ( debianizationFileMap
src/Debian/Debianize/InputCabal.hs view
@@ -12,7 +12,11 @@ import Data.Set as Set (Set, toList) import Debian.Debianize.BasicInfo (Flags, buildEnv, dependOS, verbosity, compilerFlavor, cabalFlagAssignments) import Debian.Debianize.Prelude (intToVerbosity')+#if MIN_VERSION_Cabal(1,22,0)+import Debian.GHC (getCompilerInfo)+#else import Debian.GHC (newestAvailableCompilerId)+#endif import Debian.Orphans () #if MIN_VERSION_Cabal(1,22,0) import Distribution.Compiler (AbiTag(NoAbiTag), unknownCompilerInfo)@@ -39,30 +43,26 @@ inputCabalization :: Flags -> IO PackageDescription inputCabalization flags = do let root = dependOS $ getL buildEnv flags- let cid = newestAvailableCompilerId root (getL compilerFlavor flags)- ePkgDesc <- inputCabalization' (intToVerbosity' $ getL verbosity flags) (getL cabalFlagAssignments flags) cid+ let vb = intToVerbosity' $ getL verbosity flags+ fs = getL cabalFlagAssignments flags+ -- Load a GenericPackageDescription from the current directory and+ -- from that create a finalized PackageDescription for the given+ -- CompilerId.+ genPkgDesc <- defaultPackageDesc vb >>= readPackageDescription vb+#if MIN_VERSION_Cabal(1,22,0)+ cinfo <- getCompilerInfo root (getL compilerFlavor flags)+#else+ let cinfo = newestAvailableCompilerId root (getL compilerFlavor flags)+#endif+ let finalized = finalizePackageDescription (toList fs) (const True) (Platform buildArch Cabal.buildOS) cinfo [] genPkgDesc+ ePkgDesc <- either (return . Left)+ (\ (pkgDesc, _) -> do bracket (setFileCreationMask 0o022) setFileCreationMask $ \ _ -> autoreconf vb pkgDesc+ return (Right pkgDesc))+ finalized either (\ deps -> getCurrentDirectory >>= \ here -> error $ "Missing dependencies in cabal package at " ++ here ++ ": " ++ show deps) return ePkgDesc---- | Load a GenericPackageDescription from the current directory and--- from that create a finalized PackageDescription for the given--- CompilerId.-inputCabalization' :: Verbosity -> Set (FlagName, Bool) -> CompilerId -> IO (Either [Dependency] PackageDescription)-inputCabalization' vb flags cid = do- genPkgDesc <- defaultPackageDesc vb >>= readPackageDescription vb- let cid' =-#if MIN_VERSION_Cabal(1,22,0)- unknownCompilerInfo cid NoAbiTag-#else- cid-#endif- let finalized = finalizePackageDescription (toList flags) (const True) (Platform buildArch Cabal.buildOS) cid' [] genPkgDesc- either (return . Left)- (\ (pkgDesc, _) -> do bracket (setFileCreationMask 0o022) setFileCreationMask $ \ _ -> autoreconf vb pkgDesc- return (Right pkgDesc))- finalized -- | Run the package's configuration script. autoreconf :: Verbosity -> Cabal.PackageDescription -> IO ()
src/Debian/Debianize/InputDebian.hs view
@@ -1,5 +1,5 @@ -- | Read an existing Debianization from a directory file.-{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances, OverloadedStrings, ScopedTypeVariables, TypeSynonymInstances #-}+{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances, ScopedTypeVariables, TypeSynonymInstances #-} {-# OPTIONS_GHC -Wall -fno-warn-orphans #-} module Debian.Debianize.InputDebian ( inputDebianization@@ -203,7 +203,7 @@ inputCabalInfo _ path | elem path ["control"] = return () inputCabalInfo debian name@"source/format" = liftIO (readFile (debian </> name)) >>= \ text -> either (warning +=) ((sourceFormat ~=) . Just) (readSourceFormat text) inputCabalInfo debian name@"watch" = liftIO (readFile (debian </> name)) >>= \ text -> watch ~= Just text-inputCabalInfo debian name@"rules" = liftIO (readFile (debian </> name)) >>= \ text -> rulesHead ~= (Just $ strip text <> "\n")+inputCabalInfo debian name@"rules" = liftIO (readFile (debian </> name)) >>= \ text -> rulesHead ~= (Just $ strip text <> pack "\n") inputCabalInfo debian name@"compat" = liftIO (readFile (debian </> name)) >>= \ text -> compat ~= Just (read' (\ s -> error $ "compat: " ++ show s) (unpack text)) inputCabalInfo debian name@"copyright" = liftIO (readFile (debian </> name)) >>= \ text -> copyright ~= Just (readCopyrightDescription text) inputCabalInfo debian name@"changelog" =
src/Debian/Debianize/Options.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, RankNTypes #-}+{-# LANGUAGE FlexibleContexts, RankNTypes #-} module Debian.Debianize.Options ( options , compileArgs
src/Debian/Debianize/Output.hs view
@@ -6,7 +6,7 @@ {-# OPTIONS -Wall -fno-warn-name-shadowing -fno-warn-orphans #-} module Debian.Debianize.Output- ( doDebianizeAction+ ( finishDebianization , runDebianizeScript , writeDebianization , describeDebianization@@ -18,26 +18,30 @@ import Control.Category ((.)) import Control.Exception as E (throw)-import Control.Monad.State (get)+import Control.Lens (zoom)+import Control.Monad.State (get, StateT) import Control.Monad.Trans (liftIO, MonadIO)-import Data.Algorithm.Diff.Context (contextDiff)-import Data.Algorithm.Diff.Pretty (prettyDiff)+import Data.Algorithm.DiffContext (getContextDiff, prettyContextDiff)+import Data.List (unlines) import Data.Map as Map (elems, toList) import Data.Maybe (fromMaybe) import Data.Text as Text (split, Text, unpack) import Debian.Changes (ChangeLog(..), ChangeLogEntry(..))-import Debian.Debianize.BasicInfo (dryRun, validate)+import Debian.Debianize.BasicInfo (DebAction(Usage), debAction, dryRun, validate)+import Debian.Debianize.CabalInfo (CabalInfo, debInfo) import qualified Debian.Debianize.DebInfo as D import Debian.Debianize.Files (debianizationFileMap) import Debian.Debianize.InputDebian (inputDebianization) import Debian.Debianize.Monad (DebianT, evalDebianT)-import Debian.Debianize.Options (putEnvironmentArgs)+import Debian.Debianize.Options (options, putEnvironmentArgs) import Debian.Debianize.Prelude (indent, replaceFile, zipMaps) import Debian.Debianize.BinaryDebDescription as B (canonical, package) import qualified Debian.Debianize.SourceDebDescription as S import Debian.Pretty (ppShow, ppPrint) import Prelude hiding ((.), unlines, writeFile)+import System.Console.GetOpt (OptDescr, usageInfo) import System.Directory (createDirectoryIfMissing, doesFileExist, getPermissions, Permissions(executable), setPermissions)+import System.Environment (getProgName) import System.Exit (ExitCode(ExitSuccess)) import System.FilePath ((</>), takeDirectory) import System.IO (hPutStrLn, stderr)@@ -70,10 +74,13 @@ -- | Depending on the options in @atoms@, either validate, describe, -- or write the generated debianization.-doDebianizeAction :: (MonadIO m, Functor m) => DebianT m ()-doDebianizeAction =+finishDebianization :: forall m. (MonadIO m, Functor m) => StateT CabalInfo m ()+finishDebianization = zoom debInfo $ do new <- get case () of+ _ | getL (D.flags . debAction) new == Usage ->+ do progName <- liftIO getProgName+ liftIO $ putStrLn (usageInfo (usageHeader progName) (options :: [OptDescr (StateT CabalInfo m ())])) _ | getL (D.flags . validate) new -> do inputDebianization old <- get@@ -84,6 +91,19 @@ diff <- liftIO $ compareDebianization old new liftIO $ putStr ("Debianization (dry run):\n" ++ diff) _ -> writeDebianization+ where+ usageHeader progName =+ unlines [ "Typical usage is to cd to the top directory of the package's unpacked source and run: "+ , ""+ , " " ++ progName ++ " --maintainer 'Maintainer Name <maintainer@email>'."+ , ""+ , "This will read the package's cabal file and any existing debian/changelog file and"+ , "deduce what it can about the debianization, then it will create or modify files in"+ , "the debian subdirectory. Note that it will not remove any files in debian, and"+ , "these could affect the operation of the debianization in unknown ways. For this"+ , "reason I recommend either using a pristine unpacked directory each time, or else"+ , "using a revision control system to revert the package to a known state before running."+ , "The following additional options are available:" ] -- | Write the files of the debianization @d@ to ./debian writeDebianization :: (MonadIO m, Functor m) => DebianT m ()@@ -116,7 +136,7 @@ doFile path (Just o) (Just n) = if o == n then Nothing -- Just (path ++ ": Unchanged\n")- else Just (show (prettyDiff (text ("old" </> path)) (text ("new" </> path)) (text . unpack) (contextDiff 2 (split (== '\n') o) (split (== '\n') n))))+ else Just (show (prettyContextDiff (text ("old" </> path)) (text ("new" </> path)) (text . unpack) (getContextDiff 2 (split (== '\n') o) (split (== '\n') n)))) doFile _path Nothing Nothing = error "Internal error in zipMaps" -- | Make sure the new debianization matches the existing
− src/Debian/Debianize/SubstVars.hs
@@ -1,223 +0,0 @@-{-# LANGUAGE CPP, ScopedTypeVariables, TupleSections, TypeSynonymInstances #-}-{-# OPTIONS -Wall -fno-warn-name-shadowing #-}---- | Support for generating Debianization from Cabal data.--module Debian.Debianize.SubstVars- ( substvars- ) where--import OldLens (access, getL, modL)--import Control.Category ((.))-import Control.Exception (SomeException, try)-import Control.Monad (foldM)-import Control.Monad.Reader (ReaderT(runReaderT))-import Control.Monad.State (get)-import Control.Monad.Trans (lift, liftIO, MonadIO)-import Data.List (intercalate, isPrefixOf, isSuffixOf, nub, partition, unlines)-import Data.List as List (map)-import qualified Data.Map as Map (insert, lookup, Map)-import Data.Maybe (catMaybes, fromMaybe, listToMaybe)-import qualified Data.Set as Set (member, Set)-import Data.Text (pack)-import Debian.Control (Control'(unControl), ControlFunctions(lookupP, parseControl, stripWS), Field'(Field))-import Debian.Debianize.BasicInfo (DebType(..), dryRun)-import qualified Debian.Debianize.DebInfo as D (flags, extraLibMap, missingDependencies)-import Debian.Debianize.Monad (CabalT)-import Debian.Debianize.Prelude ((!), buildDebVersionMap, cond, DebMap, debOfFile, diffFile, dpkgFileMap, modifyM, replaceFile, showDeps)-import qualified Debian.Debianize.CabalInfo as A (CabalInfo, debInfo, packageDescription, packageInfo, PackageInfo(PackageInfo, cabalName, devDeb, docDeb, profDeb))-import Debian.Orphans ()-import Debian.Pretty (ppShow)-import Debian.Relation (BinPkgName(BinPkgName), Relation, Relations)-import qualified Debian.Relation as D (BinPkgName(BinPkgName), ParseRelations(parseRelations), Relation(Rel), Relations, VersionReq(GRE))-import Distribution.Compiler (buildCompilerId)-import Distribution.Package (Dependency(..), PackageName(PackageName))-import Distribution.PackageDescription as Cabal (allBuildInfo, buildTools, extraLibs, PackageDescription(..), pkgconfigDepends)-import Distribution.Simple.Utils (die)-import Distribution.Text (display)-import Prelude hiding ((.), unlines)-import System.Directory (doesDirectoryExist, getDirectoryContents)-import System.FilePath ((</>))---- | Expand the contents of the .substvars file for a library package.--- Each cabal package corresponds to a directory <name>-<version>,--- either in /usr/lib or in /usr/lib/haskell-packages/ghc/lib. In--- that directory is a compiler subdirectory such as ghc-6.8.2. In--- the ghc subdirectory is one or two library files of the form--- libHS<name>-<version>.a and libHS<name>-<version>_p.a. We can--- determine the debian package names by running dpkg -S on these--- names, or examining the /var/lib/dpkg/info/\*.list files. From--- these we can determine the source package name, and from that the--- documentation package name.-substvars :: (MonadIO m, Functor m) =>- DebType -- ^ The type of deb we want to write substvars for - Dev, Prof, or Doc- -> CabalT m ()-substvars debType =- do debVersions <- liftIO buildDebVersionMap- modifyM (liftIO . libPaths debVersions)- control <- liftIO $ readFile "debian/control" >>= either (error . show) return . parseControl "debian/control"- substvars' debType control--substvars' :: (MonadIO m, Functor m) => DebType -> Control' String -> CabalT m ()-substvars' debType control =- get >>= return . getL A.packageInfo >>= \ info ->- cabalDependencies >>= \ cabalDeps ->- case (missingBuildDeps info cabalDeps, path) of- -- There should already be a .substvars file produced by dh_haskell_prep,- -- keep the relations listed there. They will contain something like this:- -- libghc-cabal-debian-prof.substvars:- -- haskell:Depends=ghc-prof (<< 6.8.2-999), ghc-prof (>= 6.8.2), libghc-cabal-debian-dev (= 0.4)- -- libghc-cabal-debian-dev.substvars:- -- haskell:Depends=ghc (<< 6.8.2-999), ghc (>= 6.8.2)- -- haskell-cabal-debian-doc.substvars:- -- haskell:Depends=ghc-doc, haddock (>= 2.1.0), haddock (<< 2.1.0-999)- ([], Just path') ->- do old <- liftIO $ readFile path'- deps <- debDeps debType control- new <- addDeps old deps- dry <- get >>= return . getL (A.debInfo . D.flags . dryRun)- liftIO (diffFile path' (pack new) >>= maybe (putStrLn ("cabal-debian substvars: No updates found for " ++ show path'))- (\ diff -> if dry then putStr diff else replaceFile path' new))- ([], Nothing) -> return ()- (missing, _) ->- liftIO $ die ("These debian packages need to be added to the build dependency list so the required cabal " ++- "packages are available:\n " ++ intercalate "\n " (map (ppShow . fst) missing) ++- "\nIf this is an obsolete package you may need to withdraw the old versions from the\n" ++- "upstream repository, and uninstall and purge it from your local system.")- where- addDeps old deps =- case partition (isPrefixOf "haskell:Depends=") (lines old) of- ([], other) -> filterMissing deps >>= \ deps' -> return $ unlines (("haskell:Depends=" ++ showDeps deps') : other)- (hdeps, more) ->- case deps of- [] -> return $ unlines (hdeps ++ more)- _ -> filterMissing deps >>= \ deps' -> return $ unlines (map (++ (", " ++ showDeps deps')) hdeps ++ more)- path = fmap (\ (D.BinPkgName x) -> "debian/" ++ x ++ ".substvars") name- name = debNameFromType control debType- -- We must have build dependencies on the profiling and documentation packages- -- of all the cabal packages.- missingBuildDeps info cabalDeps =- let requiredDebs =- concat (map (\ (Dependency name _) ->- case Map.lookup name info of- Just info' ->- let prof = maybe (A.devDeb info') Just (A.profDeb info') in- let doc = A.docDeb info' in- catMaybes [prof, doc]- Nothing -> []) cabalDeps) in- filter (not . (`elem` buildDepNames) . fst) requiredDebs- buildDepNames :: [D.BinPkgName]- buildDepNames = concat (map (map (\ (D.Rel s _ _) -> s)) buildDeps)- buildDeps :: D.Relations- buildDeps = (either (error . show) id . D.parseRelations $ bd) ++ (either (error . show) id . D.parseRelations $ bdi)- --sourceName = maybe (error "Invalid control file") (\ (Field (_, s)) -> stripWS s) (lookupP "Source" (head (unControl control)))- bd = maybe "" (\ (Field (_a, b)) -> stripWS b) . lookupP "Build-Depends" . head . unControl $ control- bdi = maybe "" (\ (Field (_a, b)) -> stripWS b) . lookupP "Build-Depends-Indep" . head . unControl $ control--libPaths :: DebMap -> A.CabalInfo -> IO A.CabalInfo-libPaths debVersions atoms =- do a <- getDirPaths "/usr/lib"- b <- getDirPaths ("/usr/lib/haskell-packages" </> display buildCompilerId </> "lib")- -- Build a map from names of installed debs to version numbers- dpkgFileMap >>= runReaderT (foldM (packageInfo' debVersions) atoms (a ++ b))- where- getDirPaths path = try (getDirectoryContents path) >>= return . map (\ x -> (path, x)) . either (\ (_ :: SomeException) -> []) id--packageInfo' :: DebMap -> A.CabalInfo -> (FilePath, String) -> ReaderT (Map.Map FilePath (Set.Set D.BinPkgName)) IO A.CabalInfo-packageInfo' debVersions atoms (d, f) =- case parseNameVersion f of- Nothing -> return atoms- Just (p, v) -> lift (doesDirectoryExist (d </> f </> cdir)) >>= cond (return atoms) (info (p, v))- where- parseNameVersion s =- case (break (== '-') (reverse s)) of- (_a, "") -> Nothing- (a, b) -> Just (reverse (tail b), reverse a)- cdir = display buildCompilerId- info (p, v) =- do dev <- debOfFile ("^" ++ d </> p ++ "-" ++ v </> cdir </> "libHS" ++ p ++ "-" ++ v ++ ".a$")- prof <- debOfFile ("^" ++ d </> p ++ "-" ++ v </> cdir </> "libHS" ++ p ++ "-" ++ v ++ "_p.a$")- doc <- debOfFile ("/" ++ p ++ ".haddock$")- return $ modL A.packageInfo (Map.insert- (PackageName p)- (A.PackageInfo { A.cabalName = PackageName p- , A.devDeb = maybe Nothing (\ x -> Just (x, debVersions ! x)) dev- , A.profDeb = maybe Nothing (\ x -> Just (x, debVersions ! x)) prof- , A.docDeb = maybe Nothing (\ x -> Just (x, debVersions ! x)) doc })) atoms--data Dependency_- = BuildDepends Dependency- | BuildTools Dependency- | PkgConfigDepends Dependency- | ExtraLibs Relations- deriving (Eq, Show)--unboxDependency :: Dependency_ -> Maybe Dependency-unboxDependency (BuildDepends d) = Just d-unboxDependency (BuildTools d) = Just d-unboxDependency (PkgConfigDepends d) = Just d-unboxDependency (ExtraLibs _) = Nothing -- Dependency (PackageName d) anyVersion---- Make a list of the debian devel packages corresponding to cabal packages--- which are build dependencies-debDeps :: (MonadIO m, Functor m) => DebType -> Control' String -> CabalT m D.Relations-debDeps debType control =- do info <- get >>= return . getL A.packageInfo- cabalDeps <- cabalDependencies- return $ interdependencies ++ otherdependencies info cabalDeps- where- interdependencies =- case debType of- Prof -> maybe [] (\ name -> [[D.Rel name Nothing Nothing]]) (debNameFromType control Dev)- _ -> []- otherdependencies info cabalDeps =- catMaybes (map (\ (Dependency name _) ->- case Map.lookup name info of- Just p -> maybe Nothing- (\ (s, v) -> Just [D.Rel s (Just (D.GRE v)) Nothing])- (case debType of- Dev -> A.devDeb p- Prof -> A.profDeb p- Doc -> A.docDeb p)- Nothing -> Nothing) cabalDeps)--cabalDependencies :: (MonadIO m, Functor m) => CabalT m [Dependency]-cabalDependencies =- do pkgDesc <- access A.packageDescription- atoms <- get- return $ catMaybes $ map unboxDependency $- allBuildDepends atoms- (Cabal.buildDepends pkgDesc)- (concatMap buildTools . allBuildInfo $ pkgDesc)- (concatMap pkgconfigDepends . allBuildInfo $ pkgDesc)- (concatMap extraLibs . allBuildInfo $ pkgDesc)---- |Debian packages don't have per binary package build dependencies,--- so we just gather them all up here.-allBuildDepends :: A.CabalInfo -> [Dependency] -> [Dependency] -> [Dependency] -> [String] -> [Dependency_]-allBuildDepends atoms buildDepends buildTools pkgconfigDepends extraLibs =- nub $ map BuildDepends buildDepends ++- map BuildTools buildTools ++- map PkgConfigDepends pkgconfigDepends ++- map ExtraLibs (fixDeps extraLibs)- where- fixDeps :: [String] -> [Relations]- fixDeps xs = map (\ cab -> fromMaybe [[D.Rel (D.BinPkgName ("lib" ++ cab ++ "-dev")) Nothing Nothing]]- (Map.lookup cab (getL (A.debInfo . D.extraLibMap) atoms))) xs---- | Given a control file and a DebType, look for the binary deb with--- the corresponding suffix and return its name.-debNameFromType :: Control' String -> DebType -> Maybe BinPkgName-debNameFromType control debType =- case debType of- Dev -> fmap BinPkgName $ listToMaybe (filter (isSuffixOf "-dev") debNames)- Prof -> fmap BinPkgName $ listToMaybe (filter (isSuffixOf "-prof") debNames)- Doc -> fmap BinPkgName $ listToMaybe (filter (isSuffixOf "-doc") debNames)- where- debNames = map (\ (Field (_, s)) -> stripWS s) (catMaybes (map (lookupP "Package") (tail (unControl control))))--filterMissing :: Monad m => [[Relation]] -> CabalT m [[Relation]]-filterMissing rels =- do missing <- get >>= return . getL (A.debInfo . D.missingDependencies)- return $ filter (/= []) (List.map (filter (\ (D.Rel name _ _) -> not (Set.member name missing))) rels)
src/Debian/GHC.hs view
@@ -10,6 +10,9 @@ -- , ghcNewestAvailableVersion -- , compilerIdFromDebianVersion , compilerPackageName+#if MIN_VERSION_Cabal(1,22,0)+ , getCompilerInfo+#endif ) where import Control.DeepSeq (force)@@ -18,16 +21,21 @@ import Data.Char ({-isSpace, toLower,-} toUpper) import Data.Function.Memoize (deriveMemoizable, memoize2) import Data.Maybe (fromMaybe)-import Data.Version (showVersion, Version(Version))+import Data.Version (showVersion, Version(Version), parseVersion) import Debian.Debianize.BinaryDebDescription (PackageType(..)) import Debian.Relation (BinPkgName(BinPkgName)) import Debian.Version (DebianVersion, parseDebianVersion) import Distribution.Compiler (CompilerFlavor(..), CompilerId(CompilerId))+#if MIN_VERSION_Cabal(1,22,0)+import Distribution.Compiler (CompilerInfo(..), unknownCompilerInfo, AbiTag(NoAbiTag))+#endif import System.Console.GetOpt (ArgDescr(ReqArg), OptDescr(..)) import System.Directory (doesDirectoryExist)+import System.Exit (ExitCode(ExitFailure)) import System.IO.Unsafe (unsafePerformIO)-import System.Process (readProcess)-import System.Unix.Chroot (useEnv)+import System.Process (readProcess, showCommandForUser, readProcessWithExitCode)+import System.Unix.Chroot (useEnv, fchroot)+import Text.ParserCombinators.ReadP (readP_to_S) import Text.Read (readMaybe) $(deriveMemoizable ''CompilerFlavor)@@ -145,3 +153,40 @@ compilerPackageName GHCJS _ = BinPkgName "ghcjs" -- whatevs #endif compilerPackageName x _ = error $ "Unsupported compiler flavor: " ++ show x++#if MIN_VERSION_Cabal(1,22,0)+-- | IO based alternative to newestAvailableCompilerId - install the+-- 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.+--+-- Assumes the compiler executable is already installed in the root+-- environment.+getCompilerInfo :: FilePath -> CompilerFlavor -> IO CompilerInfo+getCompilerInfo "/" flavor = do+{-+ (code, _, _) <- readProcessWithExitCode "apt-get" ["install", compilerDebName] ""+ case code of+ ExitFailure n -> error $ "Failure " ++ show n ++ " installing compiler flavor " ++ show flavor+ _ -> return ()+-}+ compilerId <- runVersionCommand >>= toCompilerId flavor+ compilerCompat <- case flavor of+ GHCJS -> readProcessWithExitCode "ghcjs" ["--numeric-ghc-version"] "" >>= toCompilerId GHC >>= return . Just . (: [])+ _ -> return Nothing+ return $ (unknownCompilerInfo compilerId NoAbiTag) {compilerInfoCompat = compilerCompat}+ where+ runVersionCommand :: IO (ExitCode, String, String)+ runVersionCommand = readProcessWithExitCode versionCommand ["--numeric-version"] ""+ versionCommand = case flavor of GHC -> "ghc"; GHCJS -> "ghcjs"; _ -> error $ "Flavor " ++ show flavor++ toCompilerId :: CompilerFlavor -> (ExitCode, String, String) -> IO CompilerId+ toCompilerId _ (ExitFailure n, _, err) =+ error $ showCommandForUser versionCommand ["--numeric-version"] ++ " -> " ++ show n ++ ", stderr: " ++ show err+ toCompilerId flavor' (_, out, _) =+ case filter ((== "\n") . snd) (readP_to_S parseVersion out) of+ [(v, _)] -> return $ CompilerId flavor' v+ _ -> error $ "Parse failure for version string: " ++ show out++getCompilerInfo root flavor = fchroot root $ getCompilerInfo "/" flavor+#endif