packages feed

debian 3.81.3 → 3.83

raw patch · 14 files changed

+359/−60 lines, 14 filesdep +ListLikedep +ansi-wl-pprintdep +eitherdep ~basedep ~networkdep ~parsecsetup-changednew-component:exe:debian-testsPVP ok

version bump matches the API change (PVP)

Dependencies added: ListLike, ansi-wl-pprint, either, exceptions, template-haskell

Dependency ranges changed: base, network, parsec

API changes (from Hackage documentation)

+ Debian.Control: IOError :: [Loc] -> IOError -> ControlFileError
+ Debian.Control: MissingField :: [Loc] -> String -> ControlFileError
+ Debian.Control: NoBinaryParagraphs :: [Loc] -> ControlFileError
+ Debian.Control: NoParagraphs :: [Loc] -> ControlFileError
+ Debian.Control: ParseControlError :: [Loc] -> ParseError -> ControlFileError
+ Debian.Control: ParseRelationsError :: [Loc] -> ParseError -> ControlFileError
+ Debian.Control: class HasDebianControl a
+ Debian.Control: data ControlFileError
+ Debian.Control: debianBinaryPackageNames :: HasDebianControl a => a -> [BinPkgName]
+ Debian.Control: debianBinaryParagraphs :: HasDebianControl a => a -> [Paragraph' Text]
+ Debian.Control: debianBuildDeps :: HasDebianControl a => a -> Maybe Relations
+ Debian.Control: debianBuildDepsIndep :: HasDebianControl a => a -> Maybe Relations
+ Debian.Control: debianControl :: HasDebianControl a => a -> DebianControl
+ Debian.Control: debianPackageNames :: HasDebianControl a => a -> (SrcPkgName, [BinPkgName])
+ Debian.Control: debianPackageParagraphs :: HasDebianControl a => a -> (Paragraph' Text, [Paragraph' Text])
+ Debian.Control: debianRelations :: HasDebianControl a => String -> a -> Either ControlFileError (Maybe Relations)
+ Debian.Control: debianSourcePackageName :: HasDebianControl a => a -> SrcPkgName
+ Debian.Control: debianSourceParagraph :: HasDebianControl a => a -> Paragraph' Text
+ Debian.Control: field :: ControlFileError -> String
+ Debian.Control: ioError :: ControlFileError -> IOError
+ Debian.Control: locs :: ControlFileError -> [Loc]
+ Debian.Control: parseDebianControlFromFile :: FilePath -> IO (Either ControlFileError DebianControl)
+ Debian.Control: parseError :: ControlFileError -> ParseError
+ Debian.Control: unsafeDebianControl :: Control' Text -> DebianControl
+ Debian.Control: validateDebianControl :: MonadCatch m => Control' Text -> m (Either ControlFileError DebianControl)
+ Debian.Control.Policy: IOError :: [Loc] -> IOError -> ControlFileError
+ Debian.Control.Policy: MissingField :: [Loc] -> String -> ControlFileError
+ Debian.Control.Policy: NoBinaryParagraphs :: [Loc] -> ControlFileError
+ Debian.Control.Policy: NoParagraphs :: [Loc] -> ControlFileError
+ Debian.Control.Policy: ParseControlError :: [Loc] -> ParseError -> ControlFileError
+ Debian.Control.Policy: ParseRelationsError :: [Loc] -> ParseError -> ControlFileError
+ Debian.Control.Policy: class HasDebianControl a
+ Debian.Control.Policy: data ControlFileError
+ Debian.Control.Policy: data DebianControl
+ Debian.Control.Policy: debianBinaryPackageNames :: HasDebianControl a => a -> [BinPkgName]
+ Debian.Control.Policy: debianBinaryParagraphs :: HasDebianControl a => a -> [Paragraph' Text]
+ Debian.Control.Policy: debianBuildDeps :: HasDebianControl a => a -> Maybe Relations
+ Debian.Control.Policy: debianBuildDepsIndep :: HasDebianControl a => a -> Maybe Relations
+ Debian.Control.Policy: debianControl :: HasDebianControl a => a -> DebianControl
+ Debian.Control.Policy: debianPackageNames :: HasDebianControl a => a -> (SrcPkgName, [BinPkgName])
+ Debian.Control.Policy: debianPackageParagraphs :: HasDebianControl a => a -> (Paragraph' Text, [Paragraph' Text])
+ Debian.Control.Policy: debianRelations :: HasDebianControl a => String -> a -> Either ControlFileError (Maybe Relations)
+ Debian.Control.Policy: debianSourcePackageName :: HasDebianControl a => a -> SrcPkgName
+ Debian.Control.Policy: debianSourceParagraph :: HasDebianControl a => a -> Paragraph' Text
+ Debian.Control.Policy: field :: ControlFileError -> String
+ Debian.Control.Policy: instance Eq ControlFileError
+ Debian.Control.Policy: instance Exception ControlFileError
+ Debian.Control.Policy: instance HasControl (Control' Text)
+ Debian.Control.Policy: instance HasControl DebianControl
+ Debian.Control.Policy: instance HasDebianControl DebianControl
+ Debian.Control.Policy: instance Show (Control' Text)
+ Debian.Control.Policy: instance Show ControlFileError
+ Debian.Control.Policy: instance Show DebianControl
+ Debian.Control.Policy: instance Typeable ControlFileError
+ Debian.Control.Policy: ioError :: ControlFileError -> IOError
+ Debian.Control.Policy: locs :: ControlFileError -> [Loc]
+ Debian.Control.Policy: parseDebianControl :: MonadCatch m => String -> Text -> m (Either ControlFileError DebianControl)
+ Debian.Control.Policy: parseDebianControlFromFile :: FilePath -> IO (Either ControlFileError DebianControl)
+ Debian.Control.Policy: parseError :: ControlFileError -> ParseError
+ Debian.Control.Policy: unsafeDebianControl :: Control' Text -> DebianControl
+ Debian.Control.Policy: validateDebianControl :: MonadCatch m => Control' Text -> m (Either ControlFileError DebianControl)
+ Debian.GenBuildDeps: ReadyTarget :: a -> [a] -> [a] -> ReadyTarget a
+ Debian.GenBuildDeps: data ReadyTarget a
+ Debian.GenBuildDeps: other :: ReadyTarget a -> [a]
+ Debian.GenBuildDeps: ready :: ReadyTarget a -> a
+ Debian.GenBuildDeps: waiting :: ReadyTarget a -> [a]
+ Debian.Loc: __LOC__ :: Q Exp
+ Debian.Loc: instance Lift Loc
+ Debian.Loc: instance Show Loc
+ Debian.Loc: mapExn :: (MonadCatch m, Exception e) => m a -> (e -> e) -> m a
+ Debian.Pretty: display :: Pretty a => a -> String
- Debian.GenBuildDeps: buildDependencies :: Control' Text -> Either String DepInfo
+ Debian.GenBuildDeps: buildDependencies :: HasDebianControl control => control -> DepInfo
- Debian.GenBuildDeps: genDeps :: [FilePath] -> IO (Either String [DepInfo])
+ Debian.GenBuildDeps: genDeps :: [FilePath] -> IO [DepInfo]
- Debian.GenBuildDeps: getSourceOrder :: FilePath -> IO (Either String [SrcPkgName])
+ Debian.GenBuildDeps: getSourceOrder :: FilePath -> IO [SrcPkgName]

Files

Debian/Changes.hs view
@@ -51,7 +51,7 @@  -- |A changelog is a series of ChangeLogEntries data ChangeLogEntry =-    Entry { logPackage :: String+    Entry { logPackage :: String -- FIXME: Should be a SrcPkgName           , logVersion :: DebianVersion           , logDists :: [ReleaseName]           , logUrgency :: String
Debian/Control.hs view
@@ -26,6 +26,21 @@     , formatControl     , formatParagraph     , formatField+    -- * Policy classes and functions+    , P.HasDebianControl(..)+    , P.ControlFileError(..)+    , P.parseDebianControlFromFile+    , P.validateDebianControl+    , P.unsafeDebianControl+    , P.debianSourceParagraph+    , P.debianBinaryParagraphs+    , P.debianPackageParagraphs+    , P.debianPackageNames+    , P.debianSourcePackageName+    , P.debianBinaryPackageNames+    , P.debianRelations+    , P.debianBuildDeps+    , P.debianBuildDepsIndep     ) where  --import Control.Monad@@ -38,6 +53,7 @@ import Data.Text as T (Text, pack, concat) import qualified Debian.Control.Text as T import qualified Debian.Control.ByteString as B ()+import qualified Debian.Control.Policy as P import qualified Debian.Control.String as S  packParagraph :: S.Paragraph -> T.Paragraph
+ Debian/Control/Policy.hs view
@@ -0,0 +1,171 @@+{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts, FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses, ScopedTypeVariables, TemplateHaskell #-}+{-# OPTIONS_GHC -Wall #-}+-- | Access to things that Debian policy says should be in a valid+-- control file.  The pure functions will not throw ControlFileError+-- if they are operating on a DebianControl value returned by+-- validateDebianControl.  However, they might if they are created+-- using unsafeDebianControl.+module Debian.Control.Policy+    ( -- * Validated debian control file type+      DebianControl(unDebianControl)+    , validateDebianControl+    , unsafeDebianControl+    , parseDebianControlFromFile+    , parseDebianControl+    , ControlFileError(..)+    -- * Class of things that contain one DebianControl value+    , HasDebianControl(debianControl)+    -- * Pure functions that operate on validated control files+    , debianSourceParagraph+    , debianBinaryParagraphs+    , debianPackageParagraphs+    , debianPackageNames+    , debianSourcePackageName+    , debianBinaryPackageNames+    , debianRelations+    , debianBuildDeps+    , debianBuildDepsIndep+    ) where++import Control.Exception (Exception, throw)+import Control.Monad.Catch (MonadCatch, try)+import Data.Text (Text)+import Data.Typeable (Typeable)+import Data.ListLike (toList)+import Debian.Control.Common (Control'(..), Paragraph'(..), Field'(..), fieldValue, ControlFunctions(parseControlFromFile, parseControl))+import Debian.Control.Text ()+import Debian.Loc (mapExn, __LOC__)+import Debian.Pretty (pretty)+import Debian.Relation (SrcPkgName(..), BinPkgName(..), Relations, parseRelations)+import Debian.Relation.Text ()+import Language.Haskell.TH (Loc)+-- import qualified Debug.ShowPlease as Please+import GHC.IO.Exception (ioe_location)+import Text.Parsec.Error (ParseError)++-- | Opaque (constructor not exported) type to hold a validated Debian+-- Control File+data DebianControl = DebianControl {unDebianControl :: Control' Text}++instance Show DebianControl where+    show c = "(parseDebianControl \"\" " ++ show (show (pretty (unDebianControl c))) ++ ")"++instance Show (Control' Text) where+    show c = "(parseControl \"\" " ++ show (show (pretty c)) ++ ")"++-- | Validate and return a control file in an opaque wrapper.  May+-- throw a ControlFileError.  Currently we only verify that it has a+-- Source field in the first paragraph and one or more subsequent+-- paragraphs each with a Package field, and no syntax errors in the+-- build dependencies (though they may be absent.)+validateDebianControl :: MonadCatch m => Control' Text -> m (Either ControlFileError DebianControl)+validateDebianControl ctl =+    try (do _ <- return $ debianPackageNames (DebianControl ctl)+            _ <- return $ debianBuildDeps (DebianControl ctl)+            _ <- return $ debianBuildDepsIndep (DebianControl ctl)+            return ()) >>=+    return . either Left (\ _ -> Right $ DebianControl ctl)++unsafeDebianControl :: Control' Text -> DebianControl+unsafeDebianControl = DebianControl++parseDebianControl :: MonadCatch m => String -> Text -> m (Either ControlFileError DebianControl)+parseDebianControl sourceName s = either (return . Left . ParseControlError [$__LOC__]) validateDebianControl (parseControl sourceName s)++parseDebianControlFromFile :: FilePath -> IO (Either ControlFileError DebianControl)+parseDebianControlFromFile controlPath =+  try (parseControlFromFile controlPath) >>=+  either (return . Left . IOError [$__LOC__])+         (either (return . Left . ParseControlError [$__LOC__]) validateDebianControl)++-- | Class of things that contain a validated Debian control file.+class HasDebianControl a where+    debianControl :: a -> DebianControl++instance HasDebianControl DebianControl where+    debianControl = id++class HasControl a where+    control :: a -> Control' Text++instance HasControl (Control' Text) where+    control = id++instance HasControl DebianControl where+    control = unDebianControl++-- | Errors that control files might throw, with source file name and+-- line number generated by template haskell.+data ControlFileError+    = NoParagraphs        {locs :: [Loc]}+    | NoBinaryParagraphs  {locs :: [Loc]}+    | MissingField        {locs :: [Loc], field :: String}+    | ParseRelationsError {locs :: [Loc], parseError :: ParseError}+    | ParseControlError   {locs :: [Loc], parseError :: ParseError}+    | IOError             {locs :: [Loc], ioError :: IOError}+    deriving (Show, Typeable)++-- instance Please.Show ControlFileError where+--     show (IOError e) = "(IOError " ++ Please.show e ++ ")"+--     show (ParseRelationsError e) = "(ParseRelationsError " ++ Please.show e ++ ")"+--     show (ParseControlError e) = "(ParseControlError " ++ Please.show e ++ ")"+--     show x = show x++instance Exception ControlFileError++instance Eq ControlFileError where+    _ == _ = False++debianPackageParagraphs :: HasDebianControl a => a -> (Paragraph' Text, [Paragraph' Text])+debianPackageParagraphs ctl =+    case removeCommentParagraphs ctl of+      DebianControl (Control [_]) -> throw $ NoBinaryParagraphs [$__LOC__]+      DebianControl (Control []) -> throw $ NoParagraphs [$__LOC__]+      DebianControl (Control (sourceParagraph : binParagraphs)) -> (sourceParagraph, binParagraphs)++-- | Comment paragraphs are rare, but they happen.+removeCommentParagraphs :: HasDebianControl a => a -> DebianControl+removeCommentParagraphs c =+    DebianControl (Control (filter (not . isCommentParagraph) (unControl (unDebianControl (debianControl c)))))+    where+      isCommentParagraph (Paragraph fields) = all isCommentField fields+      isCommentField (Comment _) = True+      isCommentField _ = False++debianSourceParagraph :: HasDebianControl a => a -> Paragraph' Text+debianSourceParagraph = fst . debianPackageParagraphs++debianBinaryParagraphs :: HasDebianControl a => a -> [Paragraph' Text]+debianBinaryParagraphs = snd . debianPackageParagraphs++debianPackageNames :: HasDebianControl a => a -> (SrcPkgName, [BinPkgName])+debianPackageNames c =+  let (srcParagraph, binParagraphs) = debianPackageParagraphs c in+  (mapFieldValue (SrcPkgName . toList) "Source" srcParagraph, map (mapFieldValue (BinPkgName . toList) "Package") binParagraphs)++debianSourcePackageName :: HasDebianControl a => a -> SrcPkgName+debianSourcePackageName = fst . debianPackageNames++debianBinaryPackageNames :: HasDebianControl a => a -> [BinPkgName]+debianBinaryPackageNames = snd . debianPackageNames++debianBuildDepsIndep :: HasDebianControl a => a -> Maybe Relations+debianBuildDepsIndep ctl = either throw id $ debianRelations "Build-Depends-Indep" (debianControl ctl)++debianBuildDeps :: HasDebianControl a => a -> Maybe Relations+debianBuildDeps ctl = either throw id $ debianRelations "Build-Depends" (debianControl ctl)++-- | Version of fieldValue that may throw a ControlFileError.  We only+-- use this internally on fields that we already validated.+fieldValue' :: ControlFunctions text => String -> Paragraph' text -> text+fieldValue' fieldName paragraph = maybe (throw $ MissingField [$__LOC__] fieldName) id $ fieldValue fieldName paragraph++-- | This could access fields we haven't validated, so+-- it can return an error.  Additionally, the field might+-- be absent, in which case it returns Nothing.+debianRelations :: HasDebianControl a => String -> a -> Either ControlFileError (Maybe Relations)+debianRelations fieldName ctl = maybe (Right Nothing) (either (Left . ParseRelationsError [$__LOC__]) (Right . Just) . parseRelations) $ fieldValue fieldName (debianSourceParagraph ctl)++-- | Apply a function to the text from a named field in a control file paragraph.+mapFieldValue :: (Text -> a) -> String -> Paragraph' Text -> a+mapFieldValue f fieldName paragraph = f $ fieldValue' fieldName paragraph
Debian/Deb.hs view
@@ -4,7 +4,7 @@ import Control.Monad  import Debian.Control.Common-import System.Directory (canonicalizePath, getTemporaryDirectory)+import System.Directory (canonicalizePath) import System.Exit (ExitCode(..)) import System.Process (readProcessWithExitCode) import System.Unix.Directory (withTemporaryDirectory, withWorkingDirectory)
Debian/GenBuildDeps.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, RecordWildCards, ScopedTypeVariables #-}+{-# LANGUAGE 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.@@ -12,6 +12,7 @@     , oldRelaxDeps     -- * Using dependency info     , BuildableInfo(..)+    , ReadyTarget(..)     , buildable     , compareSource     -- * Obsolete?@@ -21,17 +22,20 @@     , getSourceOrder     ) where +import           Control.Applicative ((<$>))+import           Control.Exception (throw) import		 Control.Monad (filterM)-import		 Debian.Control-import           Data.Either import		 Data.Graph (Graph, Edge, buildG, topSort, reachable, transposeG, vertices, edges) import		 Data.List import qualified Data.Map as Map import		 Data.Maybe import qualified Data.Set as Set-import           Data.Text (Text, unpack)+import		 Debian.Control (parseControlFromFile)+import		 Debian.Control.Policy (HasDebianControl, ControlFileError(..), validateDebianControl, debianSourcePackageName, debianBinaryPackageNames, debianBuildDeps, debianBuildDepsIndep)+import           Debian.Loc (__LOC__, mapExn) import		 Debian.Relation import		 Debian.Relation.Text ()+import           Language.Haskell.TH (Loc) import		 System.Directory (getDirectoryContents, doesFileExist)  -- | This type describes the build dependencies of a source package.@@ -41,36 +45,15 @@     , binaryNames :: [BinPkgName]	-- ^ binary dependency names (is this a function of relations?)     } --- |Turn a list of eithers into an either of lists--- copied from Extra.Either-concatEithers :: [Either a b] -> Either [a] [b]-concatEithers xs =-    case partitionEithers xs of -      ([], rs) -> Right rs-      (ls, _) -> Left ls- -- |Return the dependency info for a source package with the given dependency relaxation. -- |According to debian policy, only the first paragraph in debian\/control can be a source package -- <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-sourcecontrolfiles>-buildDependencies :: Control' Text -> Either String DepInfo-buildDependencies (Control []) = error "Control file seems to be empty"-buildDependencies (Control (source:binaries)) =-    either (Left . concat) (\ rels -> Right (DepInfo {sourceName = sourcePackage, relations = rels, binaryNames = bins})) deps-    where-      sourcePackage = maybe (error "First Paragraph in control file lacks a Source field") (SrcPkgName . unpack) $ assoc "Source" source-      -- The raw list of build dependencies for this package-      deps = either Left (Right . concat) (concatEithers [buildDeps, buildDepsIndep])-      buildDeps =-          case assoc "Build-Depends" source of-            Just v -> either (\ e -> Left ("Error parsing Build-Depends for" ++ show sourcePackage ++ ": " ++ show e)) Right (parseRelations v)-            _ -> Right []-      buildDepsIndep =-          case assoc "Build-Depends-Indep" source of-            (Just v) -> either (\ e -> Left ("Error parsing Build-Depends-Indep for" ++ show sourcePackage ++ ": " ++ show e)) Right (parseRelations v)-            _ -> Right []-      bins = mapMaybe lookupPkgName binaries-      lookupPkgName :: Paragraph' Text -> Maybe BinPkgName-      lookupPkgName p = maybe Nothing (Just . BinPkgName . unpack) (assoc "Package" p)+buildDependencies :: HasDebianControl control => control -> DepInfo+buildDependencies control = do+  DepInfo { sourceName = debianSourcePackageName control+          , relations = concat [fromMaybe [] (debianBuildDeps control),+                                fromMaybe [] (debianBuildDepsIndep control)]+          , binaryNames = debianBinaryPackageNames control }  -- |Specifies build dependencies that should be ignored during the build -- decision.  If the pair is (BINARY, Nothing) it means the binary package@@ -261,25 +244,27 @@       checkPackageNameReq (Rel rPkgName _ _) bPkgName = rPkgName == bPkgName  -- |Return the dependency info for a list of control files.-genDeps :: [FilePath] -> IO (Either String [DepInfo])-genDeps controlFiles =-    mapM genDep' controlFiles >>=-    return . either (Left . concat) (Right . orderSource compareSource) . concatEithers+genDeps :: [FilePath] -> IO [DepInfo]+genDeps controlFiles = do+  orderSource compareSource <$> mapM genDep' controlFiles     where-      genDep' :: FilePath -> IO (Either String DepInfo)+      -- Parse the control file and extract the build dependencies+      genDep' :: FilePath -> IO DepInfo       genDep' controlPath = parseControlFromFile controlPath >>=-                            return . either (Left . show) buildDependencies+                            either (\ x -> throw (ParseRelationsError [$__LOC__] x))+                                   (\ x -> validateDebianControl x {- `mapExn` (pushLoc $__LOC__) -} >>= either throw (return . buildDependencies)) +-- pushLoc :: Loc -> ControlFileError -> ControlFileError+-- pushLoc loc e = e {locs = loc : locs e}+ -- |One example of how to tie the below functions together. In this -- case 'fp' is the path to a directory that contains a bunch of -- checked out source packages. The code will automatically look for -- debian\/control. It returns a list with the packages in the -- order they should be built.-getSourceOrder :: FilePath -> IO (Either String [SrcPkgName])+getSourceOrder :: FilePath -> IO [SrcPkgName] getSourceOrder fp =-    findControlFiles fp >>=-    genDeps >>=-    return . either Left (Right . map sourceName . orderSource compareSource)+    findControlFiles fp >>= genDeps >>= return . map sourceName     where       -- Return a list of the files that look like debian\/control.       findControlFiles :: FilePath -> IO [FilePath]@@ -287,7 +272,3 @@           getDirectoryContents root >>=           mapM (\ x -> return $ root ++ "/" ++ x ++ "/debian/control") >>=           filterM doesFileExist---assoc :: String -> Paragraph' Text -> Maybe Text-assoc name fields = maybe Nothing (\ (Field (_, v)) -> Just (stripWS v)) (lookupP name fields)
+ Debian/Loc.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE ScopedTypeVariables, StandaloneDeriving, TemplateHaskell #-}+module Debian.Loc where++import Control.Applicative+import Control.Exception (Exception, throw)+import Control.Monad.Catch (MonadCatch, catch)+import Language.Haskell.TH+import Language.Haskell.TH.Syntax++deriving instance Show Loc++instance Lift Loc where+    lift x = recConE 'Loc [ (,) <$> (pure 'loc_filename) <*> litE (stringL (loc_filename x))+                          , (,) <$> (pure 'loc_package) <*> litE (stringL (loc_package x))+                          , (,) <$> (pure 'loc_module) <*> litE (stringL (loc_module x))+                          , (,) <$> (pure 'loc_start) <*> [|($(litE (integerL (fromIntegral (fst (loc_start x))))),+                                                             $(litE (integerL (fromIntegral (snd (loc_start x)))))) :: (Int, Int)|]+                          , (,) <$> (pure 'loc_end) <*> [|($(litE (integerL (fromIntegral (fst (loc_end x))))),+                                                           $(litE (integerL (fromIntegral (snd (loc_end x)))))) :: (Int, Int)|] ]++__LOC__ :: Q Exp+__LOC__ = lift =<< location++mapExn :: forall e m a. (MonadCatch m, Exception e) => m a -> (e -> e) -> m a+mapExn task f = task `catch` (\ (e :: e) -> throw (f e))
Debian/Pretty.hs view
@@ -7,6 +7,7 @@     , vcat     , Pretty(pretty)     , render+    , display     , (<>)     ) where @@ -47,6 +48,9 @@  render :: Doc -> Text render = unDoc++display :: Pretty a => a -> String+display = unpack . unDoc . pretty  -- I'm keeping this for backwards compatibility, though it doesn't seem like -- a proper use of the Show class to me.
Setup.hs view
@@ -1,17 +1,19 @@ #!/usr/bin/runhaskell  import Distribution.Simple+import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(buildDir)) import Distribution.Simple.Program import System.Directory import System.Exit+import System.FilePath ((</>)) import System.Process  main = copyFile "debian/changelog" "changelog" >>        defaultMainWithHooks simpleUserHooks {-         postBuild = \ _ _ _ _ -> runTestScript-       , runTests = \ _ _ _ _ -> runTestScript+         postBuild = \ _ _ _ lbi -> runTestScript lbi+       , runTests = \ _ _ _ lbi -> runTestScript lbi        } -runTestScript =-    system "runhaskell Test/Main.hs" >>= \ code ->+runTestScript lbi =+    system (buildDir lbi </> "debian-tests/debian-tests") >>= \ code ->     if code == ExitSuccess then return () else error "Test Failure"
Test/Control.hs view
@@ -2,15 +2,19 @@ module Test.Control where  import Test.HUnit-import Data.List (intercalate) import Data.Monoid ((<>))-import Data.Text as T (Text, pack, intercalate)+import Data.Text as T (Text, intercalate) import Debian.Control-import Debian.Control.Common (unControl)+import Debian.Control.Policy import Debian.Control.Text ({- Pretty instances -}) import Debian.Pretty (pretty, render)+import Debian.Relation+import Debian.Version (parseDebianVersion)  deriving instance Eq (Control' Text)++instance Eq DebianControl where+    a == b = unDebianControl a == unDebianControl b -- deriving instance Show (Control' Text) -- deriving instance Show (Paragraph' Text) -- deriving instance Show (Field' Text)@@ -19,14 +23,27 @@ -- inter-paragraph newlines, or missing terminating newlines, would be -- good. controlTests =-    [ TestCase (assertEqual "pretty1" (show . pretty $ control) (either (error "parser failed") (show . pretty) (parseControl "debian/control" sample)))+    [ TestCase (assertEqual "pretty1" (Prelude.show . pretty $ control) (either (error "parser failed") (Prelude.show . pretty) (parseControl "debian/control" sample)))     , TestCase (assertEqual "pretty2" sample (render (pretty control)))     , TestCase (assertEqual "pretty3" (head paragraphs <> "\n") (render (pretty (head (unControl control)))))     -- The Pretty class instances are distinct implementations from     -- those in Debian.Control.PrettyPrint.  Not sure why, there is a     -- terse note about performance concerns.     , TestCase (assertEqual "pretty4" sample (render (pretty control)))-    , TestCase (assertEqual "pretty5" (head paragraphs <> "\n") (render (pretty (head (unControl control)))))  ]+    , TestCase (assertEqual "pretty5" (head paragraphs <> "\n") (render (pretty (head (unControl control)))))+    , TestCase (validateDebianControl control >>= \ vc -> assertEqual "policy1" (Right (unsafeDebianControl control)) vc) -- validate control file+    , TestCase (validateDebianControl control >>= \ vc -> assertEqual "policy2" (Right (Just builddeps)) (either Left (debianRelations "Build-Depends") vc)) -- parse build deps+    , TestCase (validateDebianControl control >>= \ vc -> assertEqual "policy3" (Right Nothing) (either Left (debianRelations "Foo") vc)) -- absent field+    , TestCase (parseDebianControlFromFile "Test/Control.hs" >>= \ vc ->+                assertEqual "policy4"+                            -- Exceptions have bogus Eq instances, so we need to show then compare.+                            "Left (ParseControlError {locs = [Loc {loc_filename = \"./Debian/Control/Policy.hs\", loc_package = \"main\", loc_module = \"Debian.Control.Policy\", loc_start = (79,54), loc_end = (79,62)}], parseError = \"Test/Control.hs\" (line 0, column 0):\nFailed to parse Test/Control.hs})"+                            (show (either Left (either Left Right . debianRelations "Foo") vc)))+    , TestCase (parseDebianControlFromFile "nonexistant" >>= \ vc ->+                assertEqual "policy5"+                            "Left (IOError {locs = [Loc {loc_filename = \"./Debian/Control/Policy.hs\", loc_package = \"main\", loc_module = \"Debian.Control.Policy\", loc_start = (78,36), loc_end = (78,44)}], ioError = nonexistant: openBinaryFile: does not exist (No such file or directory)})"+                            (show (either Left (debianRelations "Foo") (vc :: Either ControlFileError DebianControl))))+    ]  -- | These paragraphs have no terminating newlines.  They are added -- where appropriate to the expected test results.@@ -37,6 +54,40 @@       "Package: libghc-debian-prof\nArchitecture: any\nDepends: ${haskell:Depends}\n  , ${shlibs:Depends}\n  , ${misc:Depends}\nRecommends: ${haskell:Recommends}\nSuggests: ${haskell:Suggests}\nProvides: ${haskell:Provides}\nDescription: Profiling library for working with the Debian package system\n This package provides a library for the Haskell programming language,\n compiled for profiling.\n See http://www.haskell.org/ for more information on Haskell.\n .\n This library includes modules covering almost every aspect of the Debian\n packaging system, including low level data types such as version numbers\n and dependency relations, on up to the types necessary for computing and\n installing build dependencies, building source and binary packages,\n and inserting them into a repository.\n .\n This package contains the profiling libraries compiled for GHC 6.",       "Package: libghc-debian-doc\nSection: doc\nArchitecture: all\nDepends: ${misc:Depends}, ${haskell:Depends}\nRecommends: ${haskell:Recommends}\nSuggests: ${haskell:Suggests}\nDescription: Documentation for Debian package system library\n This package provides the documentation for a library for the Haskell\n programming language.\n See http://www.haskell.org/ for more information on Haskell.\n .\n This library includes modules covering almost every aspect of the Debian\n packaging system, including low level data types such as version numbers\n and dependency relations, on up to the types necessary for computing and\n installing build dependencies, building source and binary packages,\n and inserting them into a repository.\n .\n This package contains the library documentation.",       "Package: haskell-debian-utils\nSection: devel\nArchitecture: any\nDepends: ghc, ${misc:Depends}, ${shlibs:Depends}\nRecommends: apt-file\nDescription: Various helpers to work with Debian packages\n This package contains tools shipped with the Haskell library \8220debian\8221:\n .\n   * fakechanges:\n     Sometimes you have the .debs, .dsc, .tar.gz, .diff.gz, etc from a package\n     build, but not the .changes file. This package lets you create a fake\n     .changes file in case you need one.\n .\n   * debian-report:\n     Analyze Debian repositories and generate reports about their contents and\n     relations. For example, a list of all packages in a distribution that are\n     trumped by another distribution.\n .\n   * cabal-debian:\n     Tool for creating debianizations of Haskell packages based on the .cabal\n     file.  If apt-file is installed it will use it to discover what is the\n     debian package name of a C library.\n .\n   * apt-get-build-depends:\n     Tool which will parse the Build-Depends{-Indep} lines from debian/control\n     and apt-get install the required packages" ]++-- The parsed build dependencies+builddeps :: Relations+builddeps = [[Rel (BinPkgName {unBinPkgName = "debhelper"}) (Just (GRE (Debian.Version.parseDebianVersion ("7" :: String)))) Nothing],+             [Rel (BinPkgName {unBinPkgName = "cdbs"}) Nothing Nothing],+             [Rel (BinPkgName {unBinPkgName = "haskell-devscripts"}) (Just (GRE (Debian.Version.parseDebianVersion ("0.7" :: String)))) Nothing],+             [Rel (BinPkgName {unBinPkgName = "ghc"}) Nothing Nothing],+             [Rel (BinPkgName {unBinPkgName = "ghc-prof"}) Nothing Nothing],+             [Rel (BinPkgName {unBinPkgName = "libghc-hunit-dev"}) Nothing Nothing],+             [Rel (BinPkgName {unBinPkgName = "libghc-hunit-prof"}) Nothing Nothing],+             [Rel (BinPkgName {unBinPkgName = "libghc-mtl-dev"}) Nothing Nothing],+             [Rel (BinPkgName {unBinPkgName = "libghc-mtl-prof"}) Nothing Nothing],+             [Rel (BinPkgName {unBinPkgName = "libghc-parsec3-dev"}) Nothing Nothing],+             [Rel (BinPkgName {unBinPkgName = "libghc-parsec3-prof"}) Nothing Nothing],+             [Rel (BinPkgName {unBinPkgName = "libghc-pretty-class-dev"}) Nothing Nothing],+             [Rel (BinPkgName {unBinPkgName = "libghc-pretty-class-prof"}) Nothing Nothing],+             [Rel (BinPkgName {unBinPkgName = "libghc-process-extras-dev"}) (Just (GRE (Debian.Version.parseDebianVersion ("0.4" :: String)))) Nothing],+             [Rel (BinPkgName {unBinPkgName = "libghc-process-extras-prof"}) (Just (GRE (Debian.Version.parseDebianVersion ("0.4" :: String)))) Nothing],+             [Rel (BinPkgName {unBinPkgName = "libghc-regex-compat-dev"}) Nothing Nothing],+             [Rel (BinPkgName {unBinPkgName = "libghc-regex-compat-prof"}) Nothing Nothing],+             [Rel (BinPkgName {unBinPkgName = "libghc-regex-tdfa-dev"}) (Just (GRE (Debian.Version.parseDebianVersion ("1.1.3" :: String)))) Nothing],+             [Rel (BinPkgName {unBinPkgName = "libghc-regex-tdfa-prof"}) Nothing Nothing],+             [Rel (BinPkgName {unBinPkgName = "libghc-bzlib-dev"}) (Just (GRE (Debian.Version.parseDebianVersion ("0.5.0.0-4" :: String)))) Nothing],+             [Rel (BinPkgName {unBinPkgName = "libghc-bzlib-prof"}) Nothing Nothing],+             [Rel (BinPkgName {unBinPkgName = "libghc-haxml-prof"}) (Just (GRE (Debian.Version.parseDebianVersion ("1:1.20" :: String)))) Nothing],+             [Rel (BinPkgName {unBinPkgName = "libghc-unixutils-dev"}) (Just (GRE (Debian.Version.parseDebianVersion ("1.50" :: String)))) Nothing],+             [Rel (BinPkgName {unBinPkgName = "libghc-unixutils-prof"}) (Just (GRE (Debian.Version.parseDebianVersion ("1.50" :: String)))) Nothing],+             [Rel (BinPkgName {unBinPkgName = "libghc-zlib-dev"}) Nothing Nothing],+             [Rel (BinPkgName {unBinPkgName = "libghc-zlib-prof"}) Nothing Nothing],+             [Rel (BinPkgName {unBinPkgName = "libghc-network-dev"}) (Just (GRE (Debian.Version.parseDebianVersion ("2.4" :: String)))) Nothing],+             [Rel (BinPkgName {unBinPkgName = "libghc-network-prof"}) (Just (GRE (Debian.Version.parseDebianVersion ("2.4" :: String)))) Nothing],+             [Rel (BinPkgName {unBinPkgName = "libghc-utf8-string-dev"}) Nothing Nothing],+             [Rel (BinPkgName {unBinPkgName = "libghc-utf8-string-prof"}) Nothing Nothing],+             [Rel (BinPkgName {unBinPkgName = "libcrypto++-dev"}) Nothing Nothing]]  sample :: Text sample = T.intercalate "\n\n" paragraphs <> "\n"
Test/Main.hs view
@@ -1,6 +1,5 @@ module Main where -import Data.List (intercalate) import Test.HUnit import System.Exit import Test.Changes@@ -16,7 +15,7 @@        putStrLn (st "")        case (failures c) + (errors c) of          0 -> return ()-         n -> exitFailure+         _ -> exitFailure  -- | I was converting from one pretty printing package to another and -- was unclear how this should work.
changelog view
@@ -1,3 +1,21 @@+haskell-debian (3.83) unstable; urgency=low++  * Add a Loc value to the ControlFileError type, the template+    haskell location where the exception was created.++ -- David Fox <dsf@seereason.com>  Thu, 07 Aug 2014 13:54:27 -0700++haskell-debian (3.82) unstable; urgency=low++  * Add Debian.Control.Policy which has knowledge of specific fields, such+    as Source and Package, which are expected to be present in a debian+    control file.+  * Replace a 3-tuple in Debian.GenBuildDeps with a record named+    ReadyTargets.+  * Add Debian.Pretty.display :: Pretty a => a -> String++ -- David Fox <dsf@seereason.com>  Wed, 06 Aug 2014 06:13:15 -0700+ haskell-debian (3.81.3) unstable; urgency=low    * Remove spurious dependency on Cabal.
debian.cabal view
@@ -1,5 +1,5 @@ Name:           debian-Version:        3.81.3+Version:        3.83 License:        BSD3 License-File:   debian/copyright Author:         David Fox <dsf@seereason.com>, Jeremy Shaw <jeremy@seereason.com>, Clifford Beshers <beshers@seereason.com>@@ -27,9 +27,12 @@    bzlib,    containers,    directory,+   either,+   exceptions,    filepath,    HaXml >= 1.20,    HUnit,+   ListLike,    mtl,    network >= 2.4,    old-locale,@@ -38,6 +41,7 @@    pureMD5,    regex-compat,    regex-tdfa,+   template-haskell,    text,    time,    unix,@@ -60,11 +64,13 @@         Debian.Control,         Debian.Control.Common,         Debian.Control.ByteString,+        Debian.Control.Policy,         Debian.Control.String,         Debian.Control.Text,         Debian.Deb,         Debian.Extra.Files,         Debian.GenBuildDeps,+        Debian.Loc,         Debian.Pretty,         Debian.Relation,         Debian.Relation.ByteString,@@ -114,6 +120,15 @@  Build-Depends: base, debian, process  ghc-options: -threaded -W -O2  Extensions:           ExistentialQuantification CPP++Executable debian-tests+ Main-is: Test/Main.hs+ ghc-options: -threaded -W -O2+ Build-Depends: ansi-wl-pprint, base, bytestring, containers, debian, directory, exceptions, HUnit, ListLike, mtl, network, parsec, process, regex-compat, regex-tdfa, template-haskell, text, utf8-string+ if flag(listlike)+   build-depends: process-listlike+ else+   build-depends: process-extras  source-repository head   type:     darcs
debian/changelog view
@@ -1,3 +1,21 @@+haskell-debian (3.83) unstable; urgency=low++  * Add a Loc value to the ControlFileError type, the template+    haskell location where the exception was created.++ -- David Fox <dsf@seereason.com>  Thu, 07 Aug 2014 13:54:27 -0700++haskell-debian (3.82) unstable; urgency=low++  * Add Debian.Control.Policy which has knowledge of specific fields, such+    as Source and Package, which are expected to be present in a debian+    control file.+  * Replace a 3-tuple in Debian.GenBuildDeps with a record named+    ReadyTargets.+  * Add Debian.Pretty.display :: Pretty a => a -> String++ -- David Fox <dsf@seereason.com>  Wed, 06 Aug 2014 06:13:15 -0700+ haskell-debian (3.81.3) unstable; urgency=low    * Remove spurious dependency on Cabal.
debian/copyright view
@@ -38,4 +38,3 @@ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.-