debian 3.96 → 4.0.0
raw patch · 7 files changed
+21/−245 lines, 7 filesdep +temporarydep −HaXmldep −Unixutilsdep −prettyclassdep ~Cabaldep ~basedep ~directory
Dependencies added: temporary
Dependencies removed: HaXml, Unixutils, prettyclass
Dependency ranges changed: Cabal, base, directory, pretty
Files
- cbits/gwinsz.c +0/−9
- debian.cabal +8/−33
- debian/copyright +1/−0
- src/Debian/Control/ByteString.hs +8/−9
- src/Debian/Deb.hs +4/−4
- src/Debian/Report.hs +0/−88
- utils/Report.hs +0/−102
− cbits/gwinsz.c
@@ -1,9 +0,0 @@-#include <sys/ioctl.h>--unsigned long c_get_window_size(void) {- struct winsize w;- if (ioctl (0, TIOCGWINSZ, &w) >= 0)- return (w.ws_row << 16) + w.ws_col;- else- return 0x190050;-}
debian.cabal view
@@ -1,11 +1,11 @@ Name: debian-Version: 3.96+Version: 4.0.0 License: BSD3 License-File: debian/copyright Author: David Fox <dsf@seereason.com>, Jeremy Shaw <jeremy@seereason.com>, Clifford Beshers <beshers@seereason.com> Category: Debian-Maintainer: David Fox <dsf@seereason.com>-Homepage: https://github.com/ddssff/debian-haskell+Maintainer: Clint Adams <clint@debian.org>+Homepage: https://github.com/clinty/debian-haskell Build-Type: Simple Synopsis: Modules for working with the Debian package system Cabal-Version: >= 1.9@@ -20,11 +20,6 @@ Description: Get Network.URI from the network-uri package Default: True -flag pretty-new- Description: pretty-1.1.2 includes the Text.PrettyPrint.HughesPJClass module from prettyclass- Default: True- Manual: True- Library Hs-Source-Dirs: src Build-Depends:@@ -33,11 +28,10 @@ bzlib, Cabal, containers,- directory,+ directory >= 1.2.3.0, either, exceptions, filepath,- HaXml >= 1.20, hostname, HUnit, lens,@@ -45,6 +39,7 @@ mtl, old-locale, parsec >= 2 && <4,+ pretty >= 1.1.2, process, process-extras >= 0.2.0, pureMD5,@@ -54,22 +49,18 @@ SHA, syb, template-haskell,+ temporary, text, th-lift, th-orphans, time, unix,- Unixutils >= 1.52.4, utf8-string, zlib if flag(network-uri) Build-Depends: network-uri >= 2.6 else Build-Depends: network >= 2.4 && < 2.6- if flag(pretty-new)- Build-Depends: pretty >= 1.1.2- else- Build-Depends: pretty, prettyclass ghc-options: -Wall Exposed-modules:@@ -105,7 +96,6 @@ Debian.Version.Common, Debian.Version.String, Debian.Version.Text,- Debian.Report, Debian.TH, Debian.Time, Debian.URI,@@ -122,17 +112,6 @@ ghc-options: -threaded -W Extensions: ExistentialQuantification CPP -Executable debian-report- Hs-Source-Dirs: utils- Main-is: Report.hs- Build-Depends: base, debian, HaXml, unix- ghc-options: -threaded -W- C-Sources: cbits/gwinsz.c- Include-Dirs: cbits- Install-Includes: gwinsz.h- Extensions: ExistentialQuantification CPP- Build-Depends: pretty- Executable apt-get-build-depends Hs-Source-Dirs: utils Main-is: AptGetBuildDeps.hs@@ -144,13 +123,9 @@ Type: exitcode-stdio-1.0 Hs-Source-Dirs: Test Main-Is: Main.hs- Build-Depends: base, Cabal, debian, HUnit, parsec, regex-tdfa, text+ Build-Depends: base, Cabal, debian, HUnit, parsec, pretty >= 1.1.2, regex-tdfa, text Other-Modules: Changes Control Dependencies Paths_debian Versions- if flag(pretty-new)- Build-Depends: pretty >= 1.1.2- else- Build-Depends: pretty, prettyclass source-repository head type: git- location: https://github.com/ddssff/debian-haskell+ location: https://github.com/clinty/debian-haskell
debian/copyright view
@@ -8,6 +8,7 @@ Copyright (c) 2007, David Fox Copyright (c) 2007, Jeremy Shaw+Copyright 2019 Clint Adams All rights reserved.
src/Debian/Control/ByteString.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, FlexibleContexts, MultiParamTypeClasses, PackageImports, ScopedTypeVariables, TypeFamilies #-}+{-# LANGUAGE CPP, FlexibleContexts, MultiParamTypeClasses, PackageImports, ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-orphans #-} module Debian.Control.ByteString ( Control'(..)@@ -32,14 +32,13 @@ import Data.Word (Word8) import Data.List import qualified Data.ListLike as LL-import qualified Data.ListLike.String ()+import qualified Data.ListLike.String as LL import Text.ParserCombinators.Parsec.Error import Text.ParserCombinators.Parsec.Pos -- Third Party Modules -import qualified Data.ByteString as W import qualified Data.ByteString.Char8 as C import Debian.Control.Common hiding (protectFieldText')@@ -130,15 +129,15 @@ protectFieldText = protectFieldText' asString = C.unpack -protectFieldText' :: (a ~ C.ByteString, LL.ListLike a Word8, ControlFunctions a) => a -> a+protectFieldText' :: (LL.StringLike a, LL.ListLike a Word8) => ControlFunctions a => a -> a protectFieldText' s =- case C.lines s of+ case LL.lines s of [] -> LL.empty- (l : ls) -> dropWhileEnd (isSpace . chr . fromIntegral) $ C.unlines $ l : map protect ls+ (l : ls) -> dropWhileEnd (isSpace . chr . fromIntegral) $ LL.unlines $ l : map protect ls where- dropWhileEnd :: (a ~ W.ByteString, LL.ListLike a Word8) => (Word8 -> Bool) -> a -> a- dropWhileEnd func = LL.reverse . W.dropWhile func . LL.reverse -- foldr (\x xs -> if func x && LL.null xs then LL.empty else LL.cons x xs) empty- protect :: (LL.ListLike a Word8) => a -> a+ dropWhileEnd :: (LL.StringLike a, LL.ListLike a Word8) => (Word8 -> Bool) -> a -> a+ 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' isHorizSpace c = elem c (map ord' " \t")
src/Debian/Deb.hs view
@@ -4,16 +4,16 @@ import Control.Monad import Debian.Control.Common-import System.Directory (canonicalizePath)+import System.Directory (canonicalizePath, withCurrentDirectory) import System.Exit (ExitCode(..)) import System.Process (readProcessWithExitCode)-import System.Unix.Directory (withTemporaryDirectory, withWorkingDirectory)+import System.IO.Temp (withSystemTempDirectory) fields :: (ControlFunctions a) => FilePath -> IO (Control' a) fields debFP =- withTemporaryDirectory ("fields.XXXXXX") $ \tmpdir ->+ withSystemTempDirectory ("fields.XXXXXX") $ \tmpdir -> do debFP <- canonicalizePath debFP- withWorkingDirectory tmpdir $+ withCurrentDirectory tmpdir $ do (res, out, err) <- readProcessWithExitCode "ar" ["x",debFP,"control.tar.gz"] "" when (res /= ExitSuccess) (error $ "Dpkg.fields: " ++ show out ++ "\n" ++ show err ++ "\n" ++ show res) (res, out, err) <- readProcessWithExitCode "tar" ["xzf", "control.tar.gz", "./control"] ""
− src/Debian/Report.hs
@@ -1,88 +0,0 @@-module Debian.Report where--import Data.Maybe-import qualified Data.Map as M-import Data.Text as Text (Text, unpack)-import Debian.Apt.Index (Fetcher, Compression(..), update, controlFromIndex')-import Debian.Control.Text-import Debian.Sources-import Debian.Version-import Text.XML.HaXml (CFilter, mkElem, cdata)-import Text.XML.HaXml.Posn-import Text.PrettyPrint (render)---- * General Package Map Builders---- |create a map of (package name, extracted field) from a list of index files------ NOTE: we could merge all the files into a single control and then--- run packageMap over that. We currently do it one control file at a--- time to avoid having all the control files loaded in memory at--- once. However, I am not sure that property is actually occuring--- anyway. So, this should be revisited.-makePackageMap :: (Paragraph -> a) -> (a -> a -> a) -> [(FilePath, Compression)] -> IO (M.Map Text a)-makePackageMap _ _ [] = return M.empty-makePackageMap extractValue resolveConflict ((path, compression):is) =- do r <- controlFromIndex' compression path- case r of- (Left e) -> error (show e)- (Right c) ->- do let pm = packageMap extractValue resolveConflict c- pms <- makePackageMap extractValue resolveConflict is- return $ M.unionWith resolveConflict pm pms---- |create a map of (package name, max version) from a single control file-packageMap :: (Paragraph -> a) -> (a -> a -> a) -> Control' Text -> M.Map Text a-packageMap extractValue resolveConflict control =- M.fromListWith resolveConflict (map packageTuple (unControl control))- where- packageTuple paragraph = (fromJust $ fieldValue "Package" paragraph, extractValue paragraph)---- |extract the version number from a control paragraph-extractVersion :: Paragraph -> Maybe DebianVersion-extractVersion paragraph = fmap (parseDebianVersion' . unpack) $ fieldValue "Version" paragraph---- * Trump Report---- |compare two sources.list and find all the packages in the second that trump packages in the first--- see also: |trumpedMap|-trumped :: Fetcher -- ^ function for downloading package indexes- -> FilePath -- ^ cache directory to store index files in (must already exist)- -> 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)-trumped fetcher cacheDir arch sourcesA sourcesB =- do indexesA <- update fetcher cacheDir arch (filter isDebSrc sourcesA)- pmA <- makePackageMap (fromJust . extractVersion) max (map fromJust indexesA)- indexesB <- update fetcher cacheDir arch (filter isDebSrc sourcesB)- pmB <- makePackageMap (fromJust . extractVersion) max (map fromJust indexesB)- return (trumpedMap pmA pmB)- where- isDebSrc :: DebSource -> Bool- isDebSrc ds = _sourceType ds == DebSrc---- |calculate all the trumped packages-trumpedMap :: M.Map Text DebianVersion -- ^ package map a- -> M.Map Text DebianVersion -- ^ package map b- -> M.Map Text (DebianVersion, DebianVersion) -- ^ trumped packages (version a, version b)-trumpedMap pmA pmB =- M.foldrWithKey (checkTrumped pmB) M.empty pmA- where- checkTrumped pm package aVersion trumpedPM =- case M.lookup package pm of- (Just bVersion)- | bVersion > aVersion -> M.insert package (aVersion, bVersion) trumpedPM- _ -> trumpedPM---- |create <trumped /> XML element and children from a trumped Map-trumpedXML :: M.Map Text (DebianVersion, DebianVersion) -> CFilter Posn-trumpedXML trumpedMap' =- mkElem "trumped" (map mkTrumpedPackage (M.toAscList trumpedMap' ))- where- mkTrumpedPackage (package, (oldVersion, newVersion)) =- mkElem "trumpedPackage"- [ mkElem "package" [ cdata (unpack package) ]- , mkElem "oldVersion" [ cdata (render . prettyDebianVersion $ oldVersion) ]- , mkElem "newVersion" [ cdata (render . prettyDebianVersion $ newVersion) ]- ]
− utils/Report.hs
@@ -1,102 +0,0 @@-{-# LANGUAGE CPP, ForeignFunctionInterface, ScopedTypeVariables, TemplateHaskell #-}-module Main where--#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>))-#endif-import Control.Exception (try)-import Control.Monad-import Data.Maybe (fromMaybe)-import Debian.Apt.Methods-import Debian.Report-import Debian.Sources-import Debian.TH (here)-import Foreign.C.Types-import System.Environment (getArgs, getProgName)-import System.Exit (exitFailure)-import Text.XML.HaXml-import Text.XML.HaXml.Pretty (document)-import Text.XML.HaXml.Posn-import Text.PrettyPrint.HughesPJ-import System.IO-import System.Posix.Env----- * main--main :: IO ()-main =- do (sourcesAFP, sourcesBFP) <- parseArgs- let arch = "i386" -- not actually used for anything right now, could be when binary package list is enabled- cacheDir = "." -- FIXME: replace with tempdir later- sourcesA <- liftM (parseSourcesList [$here]) $ readFile sourcesAFP- sourcesB <- liftM (parseSourcesList [$here]) $ readFile sourcesBFP- trumpMap <- trumped (fetch emptyFetchCallbacks []) cacheDir arch sourcesA sourcesB- print (showXML "trump.xsl" (trumpedXML trumpMap))- where- showXML :: String -> CFilter Posn -> Doc- showXML styleSheet = document . mkDocument styleSheet . cfilterToElem- -- cliff says this is broken with regards to cdata- cfilterToElem :: CFilter Posn -> Element Posn- cfilterToElem f = case f (CString False "" noPos) of- [CElem e _] -> xmlEscape stdXmlEscaper e- [] -> error "RSS produced no output"- _ -> error "RSS produced more than one output"- -- <?xml-stylesheet type="text/xsl" href="cdcatalog.xsl"?>- mkDocument :: String -> Element Posn -> Document Posn- mkDocument styleSheet elem =- let xmlDecl = XMLDecl "1.0" (Just (EncodingDecl "utf-8")) (Just True)- prolog = Prolog (Just xmlDecl) [] Nothing [PI ("xml-stylesheet","type=\"text/xsl\" href=\""++styleSheet++"\"")]- -- symTable = []- in- Document prolog [] elem []---- * command-line helper functions--helpText :: String -> Doc-helpText progName =- (text "Usage:" <+> text progName <+> text "<old sources.list>" <+> text "<new sources.list>"$+$- text [] $+$- (fsep $ map text $ words $ "Find all the packages referenced by the second sources.list which trump packages find in the first sources.list.")- )--parseArgs :: IO (String, String)-parseArgs =- do args <- getArgs- case args of- [dista, distb] -> return (dista, distb)- _ -> exitWithHelp helpText- where- -- |exitFailure with nicely formatted help text on stderr- exitWithHelp :: (String -> Doc) -- ^ generate help text, the argument is the result of getProgName- -> IO a -- ^ no value is returned, this function always calls exitFailure- exitWithHelp helpText =- do progName <- getProgName- hPutStrLn stderr =<< renderWidth (helpText progName)- exitFailure- -- |render a Doc using the current terminal width- renderWidth :: Doc -> IO String- renderWidth doc =- do columns <- return . fromMaybe 80 =<< getWidth- return $ renderStyle (Style PageMode columns 1.0) doc--foreign import ccall "gwinsz.h c_get_window_size" c_get_window_size :: IO CLong---- get the number of rows and columns using ioctl (0, TIOCGWINSZ, &w)--- @see also: getWidth-getWinSize :: IO (Int,Int)-getWinSize = do (a,b) <- (`divMod` 65536) `fmap` c_get_window_size- return (fromIntegral b, fromIntegral a)---- get the number of colums.--- First tries getWinSize, if that returns 0, then try the COLUMNS--- shell variable.-getWidth :: IO (Maybe Int)-getWidth =- do (cols, _) <- getWinSize- case cols of- -- 0 -> return . fmap read =<< getEnv "COLUMNS"- 0 -> either (\(_ :: IOError) -> Nothing) (fmap read) <$> try (getEnv "COLUMNS")- _ -> return (Just cols)--