debian 1.2 → 1.2.1
raw patch · 24 files changed
+321/−292 lines, 24 filesdep +bytestringdep +containersdep +prettysetup-changed
Dependencies added: bytestring, containers, pretty
Files
- Linspire/Debian/Control.hs +1/−5
- Linspire/Debian/Control/ByteString.hs +45/−58
- Linspire/Debian/Control/PrettyPrint.hs +2/−1
- Linspire/Debian/Control/String.hs +16/−14
- Linspire/Debian/Dependencies.hs +30/−30
- Linspire/Debian/Package.hs +6/−6
- Linspire/Debian/PackageDeprecated.hs +12/−12
- Linspire/Debian/Relation.hs +1/−6
- Linspire/Debian/Relation/ByteString.hs +2/−7
- Linspire/Debian/Relation/Common.hs +3/−3
- Linspire/Debian/Relation/String.hs +19/−15
- Linspire/Debian/SourcesList.hs +34/−35
- Linspire/Debian/Version.hs +3/−6
- Linspire/Debian/Version/Common.hs +27/−25
- Linspire/Debian/Version/String.hs +2/−1
- Setup.hs +12/−12
- copyright +26/−0
- debian.cabal +43/−36
- debian/changelog +7/−0
- debian/control +1/−1
- debian/rules +4/−3
- tests/Main.hs +7/−7
- tests/SourcesList.hs +4/−4
- tests/Versions.hs +14/−5
Linspire/Debian/Control.hs view
@@ -1,5 +1,5 @@ -- |A module for working with Debian control files <http://www.debian.org/doc/debian-policy/ch-controlfields.html>-module Linspire.Debian.Control +module Linspire.Debian.Control ( -- * Types Control'(..) , Paragraph'(..)@@ -22,8 +22,4 @@ , raiseFields ) where -import Control.Monad-import Data.List-import Text.ParserCombinators.Parsec-import System.IO import Linspire.Debian.Control.String
Linspire/Debian/Control/ByteString.hs view
@@ -21,20 +21,15 @@ import Control.Monad.State -import Data.Char(chr,ord) import Data.List import Data.Maybe import Data.Word -import Foreign.C.String (CString, CStringLen)-import Foreign.C.Types (CSize) import Foreign.ForeignPtr-import Foreign.Marshal.Array import Foreign.Ptr import Foreign.Storable (Storable(..)) import System.IO.Unsafe-import System.Environment import Text.ParserCombinators.Parsec.Error import Text.ParserCombinators.Parsec.Pos@@ -42,9 +37,9 @@ -- Third Party Modules import qualified Data.ByteString as B-import qualified Data.ByteString.Base as BB+import qualified Data.ByteString.Unsafe as BB import qualified Data.ByteString.Char8 as C-+import Data.ByteString.Internal import Linspire.Debian.Control.Common -- Local Modules@@ -100,13 +95,13 @@ endOfComment _ _ = False 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)@@ -115,15 +110,15 @@ -- 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))) (Just (cntl,_)) -> return (Right cntl)- parseControlFromHandle sourceName handle = + parseControlFromHandle sourcename handle = do c <- C.hGetContents handle case parse pControl c of- Nothing -> return (Left (newErrorMessage (Message ("Failed to parse " ++ sourceName)) (newPos sourceName 0 0)))+ Nothing -> return (Left (newErrorMessage (Message ("Failed to parse " ++ sourcename)) (newPos sourcename 0 0))) (Just (cntl,_)) -> return (Right cntl) lookupP fieldName (Paragraph fields) = let pFieldName = C.pack fieldName in@@ -133,7 +128,7 @@ where strip = C.dropWhile (flip elem " \t") {--main = +main = do [fp] <- getArgs C.readFile fp >>= \c -> maybe (putStrLn "failed.") (print . length . fst) (parse pControl c) -}@@ -142,9 +137,9 @@ -- | 'takeWhile', applied to a predicate @p@ and a ByteString @xs@, -- returns the longest prefix (possibly empty) of @xs@ of elements that -- satisfy @p@.-takeWhile2 :: (Word8 -> Maybe Word8 -> Bool) -> B.ByteString -> B.ByteString-takeWhile2 f ps = BB.unsafeTake (findIndex2OrEnd (\w1 w2 -> not (f w1 w2)) ps) ps-{-# INLINE takeWhile2 #-}+-- takeWhile2 :: (Word8 -> Maybe Word8 -> Bool) -> B.ByteString -> B.ByteString+-- takeWhile2 f ps = BB.unsafeTake (findIndex2OrEnd (\w1 w2 -> not (f w1 w2)) ps) ps+-- {-# INLINE takeWhile2 #-} break2 :: (Word8 -> Maybe Word8 -> Bool) -> B.ByteString -> Maybe (B.ByteString, B.ByteString) break2 p ps = case findIndex2OrEnd p ps of n -> Just (BB.unsafeTake n ps, BB.unsafeDrop n ps)@@ -157,7 +152,7 @@ -- of the string if no element is found, rather than Nothing. findIndex2OrEnd :: (Word8 -> Maybe Word8 -> Bool) -> B.ByteString -> Int-findIndex2OrEnd k (BB.PS x s l) = unsafePerformIO $ withForeignPtr x $ \f -> go (f `plusPtr` s) 0+findIndex2OrEnd k (PS x s l) = unsafePerformIO $ withForeignPtr x $ \f -> go (f `plusPtr` s) 0 where go a b | a `seq` b `seq` False = undefined go ptr n | n >= l = return l@@ -196,25 +191,17 @@ -- | The 'findIndex' function takes a predicate and a 'ByteString' and -- returns the index of the first element in the ByteString -- satisfying the predicate.-findIndex2 :: (Word8 -> Maybe Word8 -> Bool) -> B.ByteString -> Maybe Int-findIndex2 k (BB.PS x s l) = unsafePerformIO $ withForeignPtr x $ \f -> go (f `plusPtr` s) 0- where- go a b | a `seq` b `seq` False = undefined- go ptr n | n >= l = return Nothing- | otherwise = do w1 <- peek ptr- w2 <- if (n + 1 < l) then (peek (ptr `plusPtr` 1) >>= return . Just) else return Nothing- if k w1 w2- then return (Just n)- else go (ptr `plusPtr` 1) (n+1)-{-# INLINE findIndex2 #-}---- Copied from ByteStream because they are not exported--w2c :: Word8 -> Char-w2c = chr . fromIntegral--c2w :: Char -> Word8-c2w = fromIntegral . ord+-- findIndex2 :: (Word8 -> Maybe Word8 -> Bool) -> B.ByteString -> Maybe Int+-- findIndex2 k (PS x s l) = unsafePerformIO $ withForeignPtr x $ \f -> go (f `plusPtr` s) 0+-- where+-- go a b | a `seq` b `seq` False = undefined+-- go ptr n | n >= l = return Nothing+-- | otherwise = do w1 <- peek ptr+-- w2 <- if (n + 1 < l) then (peek (ptr `plusPtr` 1) >>= return . Just) else return Nothing+-- if k w1 w2+-- then return (Just n)+-- else go (ptr `plusPtr` 1) (n+1)+-- {-# INLINE findIndex2 #-} -- * Parser @@ -226,7 +213,7 @@ m2r :: Maybe a -> Result a m2r (Just a) = Ok a-m2r Nothing = Empty +m2r Nothing = Empty r2m :: Result a -> Maybe a r2m (Ok a) = Just a@@ -240,7 +227,7 @@ 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@@ -254,15 +241,15 @@ Empty -> p2 s o -> o )- + -- Parser (\s -> maybe (p2 s) (Just) (p1 s)) -pSucceed :: a -> Parser state a-pSucceed = return+-- pSucceed :: a -> Parser state a+-- pSucceed = return -pFail :: Parser state a-pFail = Parser (const Empty)+-- pFail :: Parser state a+-- pFail = Parser (const Empty) (<|>) :: Parser state a -> Parser state a -> Parser state a@@ -283,11 +270,11 @@ pChar c = satisfy ((==) c) -try :: Parser state a -> Parser state a-try (Parser p) =- Parser $ \bs -> case (p bs) of- Fail -> Empty- o -> o+-- try :: Parser state a -> Parser state a+-- try (Parser p) =+-- Parser $ \bs -> case (p bs) of+-- Fail -> Empty+-- o -> o pEOF :: Parser C.ByteString () pEOF =@@ -301,22 +288,22 @@ pTakeWhile f = Parser $ \bs -> Ok (B.span (\w -> f (w2c w)) bs) -pSkipWhile :: (Char -> Bool) -> Parser C.ByteString ()-pSkipWhile p =- Parser $ \bs -> Ok ((), C.dropWhile p bs)+-- pSkipWhile :: (Char -> Bool) -> Parser C.ByteString ()+-- pSkipWhile p =+-- 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))+ scan (\tl -> f (x:tl)) <|> 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)) ->+ o@(Ok (a, _)) -> if C.null a then Empty else o@@ -332,9 +319,9 @@ pSkipMany p = scan where scan = (p >> scan) <|> return ()- -pSkipMany1 :: Parser st a -> Parser st ()-pSkipMany1 p = p >> pSkipMany p++-- pSkipMany1 :: Parser st a -> Parser st ()+-- pSkipMany1 p = p >> pSkipMany p parse :: Parser state a -> state -> Maybe (a, state) parse p s = r2m ((unParser p) s)
Linspire/Debian/Control/PrettyPrint.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE TypeSynonymInstances #-} module Linspire.Debian.Control.PrettyPrint where import qualified Data.ByteString.Char8 as C@@ -15,7 +16,7 @@ ppField :: (ToText a) => Field' a -> Doc ppField (Field (n,v)) = totext n <> text ":" <> totext v-+ppField (Comment _) = error "ppField on Comments not defined." class ToText a where totext :: a -> Doc
Linspire/Debian/Control/String.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}+ module Linspire.Debian.Control.String ( -- * Types Control'(..)@@ -27,7 +29,7 @@ import System.IO import Linspire.Debian.Control.Common --- |This may have bad performance issues +-- |This may have bad performance issues instance Show (Control' String) where show (Control paragraph) = concat (intersperse "\n" (map show paragraph)) @@ -45,11 +47,11 @@ -- * ControlFunctions instance ControlFunctions String where- parseControlFromFile filepath = - parseFromFile pControl filepath - parseControlFromHandle sourceName handle = - hGetContents handle >>= return . parse pControl sourceName- lookupP fieldName (Paragraph paragraph) = + parseControlFromFile filepath =+ parseFromFile pControl filepath+ parseControlFromHandle sourcename handle =+ hGetContents handle >>= return . parse pControl sourcename+ lookupP fieldName (Paragraph paragraph) = find hasFieldName paragraph where hasFieldName (Field (fieldName',_)) = fieldName == fieldName' hasFieldName _ = False@@ -80,9 +82,9 @@ do c1 <- noneOf "#\n" fieldName <- many1 $ noneOf ":\n" char ':'- fieldValue <- many fcharfws+ fieldvalue <- many fcharfws (char '\n' >> return ()) <|> eof- return $ Field (c1 : fieldName, fieldValue)+ return $ Field (c1 : fieldName, fieldvalue) pComment :: ControlParser Field pComment =@@ -97,12 +99,12 @@ fchar :: ControlParser Char fchar = satisfy (/='\n') -fws :: ControlParser String-fws =- try $ do char '\n'- ws <- many1 (char ' ')- c <- many1 (satisfy (not . ((==) '\n')))- return $ '\n' : (ws ++ c)+-- fws :: ControlParser String+-- fws =+-- try $ do char '\n'+-- ws <- many1 (char ' ')+-- c <- many1 (satisfy (not . ((==) '\n')))+-- return $ '\n' : (ws ++ c) -- |We go with the assumption that 'blank lines' mean lines that -- consist of entirely of zero or more whitespace characters.
Linspire/Debian/Dependencies.hs view
@@ -1,7 +1,9 @@+{-# LANGUAGE TypeOperators, ScopedTypeVariables #-}+ module Linspire.Debian.Dependencies {- ( solve- , State + , State , binaryDepends , search , bj'@@ -12,13 +14,11 @@ import Data.List import Data.Maybe import Data.Tree-import qualified Data.Map as Map import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Char8 as C import Linspire.Debian.Control.ByteString-import Linspire.Debian.Control.PrettyPrint -- import qualified Linspire.Debian.Control as SC import Linspire.Debian.Relation.ByteString import Linspire.Debian.Package@@ -26,7 +26,7 @@ -- * Basic CSP Types and Functions -data Status +data Status = Remaining AndRelation | MissingDep Relation | Complete@@ -50,10 +50,10 @@ -- |TODO addProvides -- see DQL.Exec controlCSP :: Control -> Relations -> (Paragraph -> Relations) -> CSP Paragraph-controlCSP (Control paragraphs) rels depF =+controlCSP (Control paragraphs) rels depf = CSP { pnm = packageNameMap getName paragraphs , relations = rels- , depFunction = depF+ , depFunction = depf , conflicts = conflicts' , packageVersion = packageVersionParagraph }@@ -61,7 +61,7 @@ getName :: Paragraph -> String getName p = case lookupP "Package" p of Nothing -> error "Missing Package field" ; (Just (Field (_,n))) -> C.unpack (stripWS n) conflicts' :: Paragraph -> Relations- conflicts' p = + conflicts' p = case lookupP "Conflicts" p of Nothing -> [] Just (Field (_, c)) -> either (error . show) id (parseRelations c)@@ -71,7 +71,7 @@ do c' <- parseControlFromFile controlFile case c' of Left e -> error (show e)- Right control@(Control paragraphs) ->+ Right control@(Control _) -> case parseRelations relationStr of Left e -> error (show e) Right r ->@@ -82,18 +82,20 @@ let preDepends = case lookupP "Pre-Depends" p of Nothing -> []- Just (Field (_,pd)) -> + Just (Field (_,pd)) -> either (error . show) id (parseRelations pd) depends = case lookupP "Depends" p of Nothing -> []- Just (Field (_,pd)) -> + Just (Field (_,pd)) -> either (error . show) id (parseRelations pd) in preDepends ++ depends +sidPackages :: String sidPackages = "/var/lib/apt/lists/ftp.debian.org_debian_dists_unstable_main_binary-i386_Packages" +test :: String -> Labeler Paragraph -> IO () test rel labeler = testCSP sidPackages depF rel (mapM_ (\ (_,p) -> mapM_ (print . packageVersionParagraph) p ) . take 1 . search labeler) @@ -105,7 +107,7 @@ (Just (Field (_, name))) -> case lookupP "Version" p of Nothing -> error $ "Paragraph missing Version field"- (Just (Field (_, version))) -> (C.unpack (stripWS name), parseDebianVersion (C.unpack version))+ (Just (Field (_, vrsn))) -> (C.unpack (stripWS name), parseDebianVersion (C.unpack vrsn)) @@ -117,12 +119,12 @@ if name1 == name2 then version1 /= version2 else- any (conflict' (name1, version1)) (concat $ (conflicts csp) p2) || + any (conflict' (name1, version1)) (concat $ (conflicts csp) p2) || any (conflict' (name2, version2)) (concat $ (conflicts csp) p1)- + -- |JAS: deal with 'Provides' (can a package provide more than one package?) conflict' :: (String, DebianVersion) -> Relation -> Bool-conflict' (pName, pVersion) rel@(Rel pkgName mVersionReq _) =+conflict' (pName, pVersion) (Rel pkgName mVersionReq _) = (pName == pkgName) && (checkVersionReq mVersionReq (Just pVersion)) @@ -174,11 +176,10 @@ andRelation :: ([a],AndRelation) -> AndRelation -> [Tree (State a)] andRelation (candidates,[]) [] = [Node (Complete, candidates) []] andRelation (candidates,remaining) [] = andRelation (candidates, []) remaining- andRelation (candidates, remaining) (or:ors) =- orRelation (candidates, ors ++ remaining) or+ andRelation (candidates, remaining) (pr:prs) =+ orRelation (candidates, prs ++ remaining) pr orRelation :: ([a],AndRelation) -> OrRelation -> [Tree (State a)]- orRelation acc or =- concat (fmap (relation acc) or)+ orRelation acc pr = concat $ fmap (relation acc) pr relation :: ([a],AndRelation) -> Relation -> [Tree (State a)] relation acc@(candidates,_) rel = let packages = lookupPackageByRel (pnm csp) (packageVersion csp) rel in@@ -186,29 +187,28 @@ [] -> [Node (MissingDep rel, candidates) []] _ -> map (package acc) packages package :: ([a],AndRelation) -> a -> Tree (State a)- package (candidates, remaining) package =- if ((packageVersion csp) package) `elem` (map (packageVersion csp) candidates)+ package (candidates, remaining) pckg =+ if ((packageVersion csp) pckg) `elem` (map (packageVersion csp) candidates) then if null remaining then Node (Complete, candidates) [] else Node (Remaining remaining, candidates) (andRelation (candidates, []) remaining)- else Node (Remaining remaining, (package : candidates)) (andRelation ((package : candidates), remaining) ((depFunction csp) package))+ else Node (Remaining remaining, (pckg : candidates)) (andRelation ((pckg : candidates), remaining) ((depFunction csp) pckg)) -- |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 ??--- +-- want to find the lowest numbered (aka, earliest) inconsistency ?? earliestInconsistency :: CSP a -> State a -> Maybe ((String, DebianVersion), (String, DebianVersion)) earliestInconsistency _ (_,[]) = Nothing-earliestInconsistency _ (_,[p]) = Nothing+earliestInconsistency _ (_,[_]) = Nothing earliestInconsistency csp (_,(p:ps)) = case find ((conflict csp) p) (reverse ps) of Nothing -> Nothing (Just conflictingPackage) -> Just ((packageVersion csp) p, (packageVersion csp) conflictingPackage) --- * Conflict Set--type ConflictSet = ([(String, DebianVersion)],[Relation]) -- ^ conflicting packages and relations that require non-existant packages+-- * Conflict Se+-- ^ conflicting packages and relations that require non-existent packages+type ConflictSet = ([(String, DebianVersion)],[Relation]) isConflict :: ConflictSet -> Bool isConflict ([],[]) = False@@ -230,7 +230,7 @@ f s@(status,_) = case status of (MissingDep rel) -> (s, ([], [rel]))- _ -> + _ -> (s, case (earliestInconsistency csp) s of Nothing -> ([],[])@@ -251,7 +251,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 @@ -264,7 +264,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
Linspire/Debian/Package.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE ScopedTypeVariables #-} -- |Functions for dealing with source and binary packages in an abstract-way module Linspire.Debian.Package where @@ -8,7 +9,6 @@ -- Local Modules import Linspire.Debian.Version-import Linspire.Debian.Control import Linspire.Debian.Relation type PackageNameMap a = Map.Map String [a]@@ -32,22 +32,22 @@ -- |'findProvides' findProvides :: forall p. (p -> [PkgName]) -> [p] -> [(PkgName, p)]-findProvides providesf packages = foldl addProvides [] packages- where addProvides :: [(PkgName, p)] -> p -> [(PkgName, p)]- addProvides providesList package =+findProvides providesf packages = foldl addProvidesLocal [] packages+ where addProvidesLocal :: [(PkgName, p)] -> p -> [(PkgName, p)]+ addProvidesLocal providesList package = foldl (\pl pkgName -> (pkgName, package): pl) providesList (providesf package) -- |'lookupPackageByRel' returns all the packages that satisfy the specified relation -- TODO: Add architecture check lookupPackageByRel :: PackageNameMap a -> (a -> (String, DebianVersion)) -> Relation -> [a]-lookupPackageByRel pm packageVersionF (Rel pkgName mVerReq mArch) =+lookupPackageByRel pm packageVersionF (Rel pkgName mVerReq _) = case Map.lookup pkgName pm of Nothing -> [] Just packages -> filter filterVer packages where filterVer p = case mVerReq of Nothing -> True- Just verReq ->+ Just _ -> let (pName, pVersion) = packageVersionF p in if pName /= pkgName then False -- package is a virtual package, hence we can not do a version req
Linspire/Debian/PackageDeprecated.hs view
@@ -15,7 +15,7 @@ -- Simple Package Representation -- |A package with a name and list of dependencies-data Package +data Package = Package { pName :: String , pVersion :: Maybe DebianVersion , pDepends :: Relations@@ -33,11 +33,11 @@ -- |FIXME: we do not deal with Provides\/virtual packages yet paragraphToPackages :: Paragraph -> Package paragraphToPackages p =- Package { pName = + Package { pName = case lookupP "Package" p of Nothing -> error $ "Paragraph does not have Package field: " ++ (show p) Just (Field (_,a)) -> stripWS a- , pVersion = + , pVersion = case lookupP "Version" p of Nothing -> error $ "Version not found for " ++ show p Just (Field (_,a)) -> Just (parseDebianVersion (stripWS a))@@ -54,15 +54,15 @@ {- findProvides :: [Package] -> ProvidesMap findProvides packages = foldl addProvides Map.empty packages- where addProvides :: ProvidesMap -> Package -> ProvidesMap + where addProvides :: ProvidesMap -> Package -> ProvidesMap addProvides pm package = foldl (\m [(Rel pkgName Nothing Nothing)] -> Map.insertWith (++) pkgName [package] m) pm (pProvides package) -} findProvides :: [Package] -> [(PkgName, Package)]-findProvides packages = foldl addProvides [] packages- where addProvides :: [(PkgName, Package)] -> Package -> [(PkgName, Package)]- addProvides providesList package =+findProvides packages = foldl addprovides [] packages+ where addprovides :: [(PkgName, Package)] -> Package -> [(PkgName, Package)]+ addprovides providesList package = foldl (\pl [(Rel pkgName Nothing Nothing)] ->(pkgName, package): pl) providesList (pProvides package) -- |Architecture ?@@ -79,7 +79,7 @@ , pProvides = [] -- , pParagraph = Paragraph [] } ) : virtualPackages- mkDepend package = + mkDepend package = let name = pName package rel = fmap EEQ (pVersion package) in Rel name rel Nothing@@ -90,15 +90,15 @@ let provides = findProvides ps in foldl (\m (packageName, package) -> Map.insertWith (flip (++)) packageName [package] m) pnm provides -- ++ (makeVirtualPackages (findProvides ps))- + tryParseRel :: Maybe Field -> Relations tryParseRel Nothing = [] tryParseRel (Just (Field (_, relStr))) = either (error . show) id (parseRelations relStr) -} controlToPackageNameMap :: Control -> (Paragraph -> Package) -> PackageNameMap Package-controlToPackageNameMap (Control p) p2p = +controlToPackageNameMap (Control p) p2p = let packages = (map p2p p) in addProvides (map (\ (Rel pkgName _ _) -> pkgName) . concat . pProvides) packages (packageNameMap pName packages) @@ -108,14 +108,14 @@ -- |TODO: Add architecture check lookupPackageByRel :: PackageNameMap Package -> Relation -> [Package]-lookupPackageByRel pm (Rel pkgName mVerReq mArch) =+lookupPackageByRel pm (Rel pkgName mVerReq _) = case Map.lookup pkgName pm of Nothing -> [] Just packages -> filter filterVer packages where filterVer p = case mVerReq of Nothing -> True- Just verReq ->+ Just _ -> if (pName p) /= pkgName then False -- package is a virtual package, hence we can not do a version req else checkVersionReq mVerReq (pVersion p)
Linspire/Debian/Relation.hs view
@@ -13,12 +13,7 @@ -- * Relation Parser , RelParser , ParseRelations(..)- ) where ---- Standard GHC Modules--import Data.List-import Text.ParserCombinators.Parsec+ ) where -- Local Modules
Linspire/Debian/Relation/ByteString.hs view
@@ -13,28 +13,23 @@ -- * Relation Parser , RelParser , ParseRelations(..)- ) where + ) where -- Standard GHC Modules- import Data.List import Text.ParserCombinators.Parsec -- 3rd Party Modules- import qualified Data.ByteString.Char8 as C -- Local Modules--import Linspire.Debian.Relation.Common import Linspire.Debian.Relation.String-import Linspire.Debian.Version -- * ParseRelations -- For now we just wrap the string version instance ParseRelations C.ByteString where- parseRelations byteStr = + parseRelations byteStr = let str = C.unpack byteStr in case parse pRelations str str of Right relations -> Right (filter (/= []) relations)
Linspire/Debian/Relation/Common.hs view
@@ -33,7 +33,7 @@ name ++ maybe "" show ver ++ maybe "" show arch instance Ord Relation where- compare (Rel pkgName1 mVerReq1 mArch1) (Rel pkgName2 mVerReq2 mArch2) =+ compare (Rel pkgName1 mVerReq1 _) (Rel pkgName2 mVerReq2 _) = case compare pkgName1 pkgName2 of LT -> LT GT -> GT@@ -67,8 +67,8 @@ -- where two version requirements are equal. instance Ord VersionReq where compare r1 r2 =- if r1 == r2 - then EQ + if r1 == r2+ then EQ else case (r1, r2) of (EEQ v1, EEQ v2) -> compare v1 v2
Linspire/Debian/Relation/String.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE TypeSynonymInstances #-}+ -- |A module for working with debian relationships <http://www.debian.org/doc/debian-policy/ch-relationships.html> module Linspire.Debian.Relation.String ( -- * Types@@ -14,7 +16,7 @@ , RelParser , ParseRelations(..) , pRelations- ) where + ) where -- Standard GHC Modules @@ -29,7 +31,7 @@ -- * ParseRelations instance ParseRelations String where- parseRelations str = + parseRelations str = case parse pRelations str str of Right relations -> Right (filter (/= []) relations) x -> x@@ -44,6 +46,7 @@ pOrRelation :: RelParser OrRelation pOrRelation = sepBy pRelation (char '|') +whiteChar :: CharParser st Char whiteChar = oneOf [' ','\t','\n'] pRelation :: RelParser Relation@@ -62,42 +65,43 @@ skipMany whiteChar op <- pVerReq skipMany whiteChar- version <- many1 (noneOf [' ',')','\t','\n'])+ vrsn <- many1 (noneOf [' ',')','\t','\n']) skipMany whiteChar char ')'- return $ Just (op (parseDebianVersion version))+ return $ Just (op (parseDebianVersion vrsn)) <|> do return $ Nothing +pVerReq :: GenParser Char st (DebianVersion -> VersionReq) 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 ']'- return (Just (ArchExcept archs))- <|>- do archs <- pArchOnly- char ']'- return (Just (ArchOnly archs))- )+ char ']'+ return (Just (ArchExcept archs))+ <|>+ do archs <- pArchOnly+ char ']'+ return (Just (ArchOnly archs))+ ) <|> return Nothing
Linspire/Debian/SourcesList.hs view
@@ -1,13 +1,12 @@ module Linspire.Debian.SourcesList (DebSource(DebSource), SourceType(Deb, DebSrc),- parseSourceLine, -- String -> DebSource- parseSourcesList, -- String -> [DebSource]- quoteWords, -- String -> [String]- archFiles) -- FilePath -> Maybe String -> DebSource -> [FilePath]+ parseSourceLine, -- String -> DebSource+ parseSourcesList, -- String -> [DebSource]+ quoteWords, -- String -> [String]+ archFiles) -- FilePath -> Maybe String -> DebSource -> [FilePath] where -import Control.Exception import Data.List import Network.URI @@ -42,13 +41,13 @@ data SourceType = Deb | DebSrc deriving Eq- + instance Show SourceType where show Deb = "deb" show DebSrc = "deb-src" -data DebSource - = DebSource +data DebSource+ = DebSource { sourceType :: SourceType , sourceUri :: URI , sourceDist :: Either String (String, [String]) -- ^ Either (ExactPath) (Distribution, [Section])@@ -89,18 +88,18 @@ (w, (' ':rest)) -> w : (quoteWords' Nothing (dropWhile (==' ') rest)) (w, ('"':rest)) -> case break (== '"') rest of- (w',('"':rest)) ->- case quoteWords' Nothing rest of+ (w',('"':rst)) ->+ case quoteWords' Nothing rst of [] -> [w ++ w'] (w'':ws) -> ((w ++ w' ++ w''): ws)- (w',[]) -> error ("quoteWords: missing \" in the string: " ++ s)- (w, ('[':rest)) ->- case break (== ']') rest of- (w',(']':rest)) ->- case quoteWords' Nothing rest of+ (_,[]) -> error ("quoteWords: missing \" in the string: " ++ s)+ (w, ('[':rst)) ->+ case break (== ']') rst of+ (w',(']':rsts)) ->+ case quoteWords' Nothing rsts of [] -> [w ++ "[" ++ w' ++ "]"] (w'':ws) -> ((w ++ "[" ++ w' ++ "]" ++ w''): ws)- (w',[]) -> error ("quoteWords: missing ] in the string: " ++ s)+ (_,[]) -> error ("quoteWords: missing ] in the string: " ++ s) stripLine :: String -> String stripLine = takeWhile (/= '#') . dropWhile (== ' ')@@ -132,7 +131,7 @@ then error ("parseSourceLine: Dist is not an exact path, so at least one section is required on the line:\n" ++ str) else DebSource { sourceType = theType, sourceUri = theUri, sourceDist = Right (theDist, map unEscapeString sectionStrs) } _ -> error ("parseSourceLine: invalid line in sources.list:\n" ++ str)- + parseSourcesList :: String -> [DebSource] parseSourcesList = map parseSourceLine . sourceLines @@ -144,22 +143,22 @@ map (++ ("_binary-" ++ arch ++ "_Packages")) (archFiles' root deb) archFiles root Nothing deb@(DebSource DebSrc _ _) = map (++ "_source_Sources") (archFiles' root deb)-archFiles _ _ _ = [] -- error?+archFiles _ _ _ = [] -- error? archFiles' :: FilePath -> DebSource -> [FilePath] archFiles' root deb = let uri = sourceUri deb distro = sourceDist deb in- let scheme = uriScheme uri+ let schme = uriScheme uri auth = uriAuthority uri- path = uriPath uri in+ pth = uriPath uri in let userpass = maybe "" uriUserInfo auth reg = maybeOfString $ maybe "" uriRegName auth port = maybe "" uriPort auth in let (user, pass) = break (== ':') userpass in let user' = maybeOfString user pass' = maybeOfString pass in- let uriText = prefix scheme user' pass' reg port path in+ let uriText = prefix schme user' pass' reg port pth in -- what about dist? either (\ exact -> [root ++ (escapeURIString (/= '@') ("/var/lib/apt/lists/" ++ uriText ++ escape exact))]) (\ (dist, sections) ->@@ -173,18 +172,18 @@ where -- If user is given and password is not, the user name is -- added to the file name. Otherwise it is not. Really.- prefix "http:" (Just user) Nothing (Just host) port path =- user ++ host ++ port ++ escape path- prefix "http:" _ _ (Just host) port path =- host ++ port ++ escape path- prefix "ftp:" _ _ (Just host) _ path =- host ++ escape path- prefix "file:" Nothing Nothing Nothing "" path =- escape path- prefix "ssh:" (Just user) Nothing (Just host) port path =- user ++ host ++ port ++ escape path- prefix "ssh" _ _ (Just host) port path =- host ++ port ++ escape path+ prefix "http:" (Just user) Nothing (Just host) port pth =+ user ++ host ++ port ++ escape pth+ prefix "http:" _ _ (Just host) port pth =+ host ++ port ++ escape pth+ prefix "ftp:" _ _ (Just host) _ pth =+ host ++ escape pth+ prefix "file:" Nothing Nothing Nothing "" pth =+ escape pth+ prefix "ssh:" (Just user) Nothing (Just host) port pth =+ user ++ host ++ port ++ escape pth+ prefix "ssh" _ _ (Just host) port pth =+ host ++ port ++ escape pth prefix _ _ _ _ _ _ = error ("invalid DebSource: " ++ show deb) maybeOfString "" = Nothing maybeOfString s = Just s@@ -195,7 +194,7 @@ consperse sep items = concat (intersperse sep items) wordsBy :: Eq a => (a -> Bool) -> [a] -> [[a]]-wordsBy p s = +wordsBy p s = case (break p s) of- (s, []) -> [s]+ (t, []) -> [t] (h, t) -> h : wordsBy p (drop 1 t)
Linspire/Debian/Version.hs view
@@ -1,17 +1,14 @@ -- |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 Linspire.Debian.Version - (DebianVersion -- |Exported abstract because the internal representation is likely to change +module Linspire.Debian.Version+ (DebianVersion -- |Exported abstract because the internal representation is likely to change , parseDebianVersion , epoch , version , revision , buildDebianVersion , evr- ) where --import Data.Char-import Text.ParserCombinators.Parsec+ ) where import Linspire.Debian.Version.Common import Linspire.Debian.Version.String
Linspire/Debian/Version/Common.hs view
@@ -1,17 +1,16 @@ -- |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 Linspire.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 , ParseDebianVersion(..)- , evr -- DebianVersion -> (Maybe Int, String, Maybe String)+ , evr -- DebianVersion -> (Maybe Int, String, Maybe String) , epoch , version , revision , buildDebianVersion , parseDV- ) where + ) where -import qualified Control.Exception(try) import Data.Char import Text.ParserCombinators.Parsec import Text.Regex@@ -40,8 +39,8 @@ -- |We have to do this wackiness because ~ is less than the empty string compareNonNumeric :: [Char] -> [Char] -> Ordering compareNonNumeric "" "" = EQ-compareNonNumeric "" ('~':cs) = GT-compareNonNumeric ('~':cs) "" = LT+compareNonNumeric "" ('~':_) = GT+compareNonNumeric ('~':_) "" = LT compareNonNumeric "" _ = LT compareNonNumeric _ "" = GT compareNonNumeric (c1:cs1) (c2:cs2) =@@ -53,7 +52,7 @@ (NonNumeric s1 n1) == (NonNumeric s2 n2) = case compareNonNumeric s1 s2 of EQ -> n1 == n2- o -> False+ _ -> False instance Ord NonNumeric where compare (NonNumeric s1 n1) (NonNumeric s2 n2) =@@ -92,17 +91,17 @@ -- can currently happen. Are there any invalid version strings? -- Perhaps ones with underscore, or something? -showNN :: NonNumeric -> String-showNN (NonNumeric s n) = s ++ showN n+-- showNN :: NonNumeric -> String+-- showNN (NonNumeric s n) = s ++ showN n -showN :: Found Numeric -> String-showN (Found (Numeric n nn)) = show n ++ maybe "" showNN nn-showN (Simulated _) = "" +-- showN :: Found Numeric -> String+-- showN (Found (Numeric n nn)) = show n ++ maybe "" showNN nn+-- 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)@@ -110,8 +109,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))@@ -131,12 +130,12 @@ <|> return (Simulated (Numeric 0 Nothing)) -compareTest :: String -> String -> Ordering-compareTest str1 str2 =- let v1 = either (error . show) id $ parse parseDV str1 str1- v2 = either (error . show) id $ parse parseDV str2 str2- in - compare v1 v2+-- compareTest :: String -> String -> Ordering+-- compareTest str1 str2 =+-- let v1 = either (error . show) id $ parse parseDV str1 str1+-- v2 = either (error . show) id $ parse parseDV str2 str2+-- in+-- compare v1 v2 -- |Split a DebianVersion into its three components: epoch, version, -- revision. It is not safe to use the parsed version number for@@ -145,7 +144,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)@@ -154,15 +153,18 @@ -- I really don't think this can happen. _ -> error ("Invalid Debian Version String: " ++ s) +epoch :: DebianVersion -> Maybe Int epoch v = case evr v of (x, _, _) -> x+version :: DebianVersion -> String version v = case evr v of (_, x, _) -> x+revision :: DebianVersion -> Maybe String revision v = case evr v of (_, _, x) -> x -- Build a Debian version number from epoch, version, revision buildDebianVersion :: Maybe Int -> String -> Maybe String -> DebianVersion-buildDebianVersion epoch version revision =+buildDebianVersion epch vrsn rvsn = either (error . show) (DebianVersion str) $ parse parseDV str str where- str = (maybe "" (\ n -> show n ++ ":") epoch ++- version ++- maybe "" (\ s -> "-" ++ s) revision)+ str = (maybe "" (\ n -> show n ++ ":") epch +++ vrsn +++ maybe "" (\ s -> "-" ++ s) rvsn)
Linspire/Debian/Version/String.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE TypeSynonymInstances #-} module Linspire.Debian.Version.String ( ParseDebianVersion(..) ) where@@ -6,7 +7,7 @@ import Linspire.Debian.Version.Common import Linspire.Debian.Version.Internal- + instance ParseDebianVersion String where parseDebianVersion str = case parse parseDV str str of
Setup.hs view
@@ -1,21 +1,21 @@ #!/usr/bin/runhaskell -import Distribution.Simple-import Distribution.PackageDescription-import Distribution.Simple.LocalBuildInfo-import System.Exit-import System.Cmd-import System.Directory-import Control.Exception+import Distribution.Simple (defaultMainWithHooks, defaultUserHooks, runTests, Args())+import Distribution.PackageDescription (PackageDescription())+import Distribution.Simple.LocalBuildInfo (LocalBuildInfo())+import System.Exit (ExitCode())+import System.Cmd (system)+import System.Directory (getCurrentDirectory, setCurrentDirectory)+import Control.Exception (finally) withCurrentDirectory :: FilePath -> IO a -> IO a withCurrentDirectory path f = do- cur <- getCurrentDirectory- setCurrentDirectory path- finally f (setCurrentDirectory cur)+ cur <- getCurrentDirectory+ setCurrentDirectory path+ finally f (setCurrentDirectory cur) -runTestScript :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ExitCode-runTestScript args flag pd lbi = withCurrentDirectory "tests" (system "runhaskell Main.hs")+runTestScript :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ()+runTestScript args flag pd lbi = withCurrentDirectory "tests" (system "runhaskell Main.hs") >> return () main :: IO () main = defaultMainWithHooks defaultUserHooks{runTests = runTestScript}
+ copyright view
@@ -0,0 +1,26 @@+Copyright (c) 2006, Jeremy Shaw <jeremy@n-heptane.com>+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+3. The names of the author may not be used to endorse or promote+ products derived from this software without specific prior written+ permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY 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.
debian.cabal view
@@ -1,38 +1,45 @@-name: debian-version: 1.2-license: BSD3-license-file: debian/copyright-author: Jeremy Shaw-maintainer: Jeremy Shaw <jeremy@n-heptane.com>-stability: volitile-tested-with: GHC-build-depends: base, parsec, mtl, network, unix, regex-compat-synopsis: A set of modules for working with debian control files and packages-description: Modules for parsing debian control files, resolving- depedencies, comparing version numbers, and other useful stuff.-category: System-extensions: FlexibleInstances-ghc-options: -O2 -funbox-strict-fields-exposed-modules: - Linspire.Debian.Control,- Linspire.Debian.Control.Common,- Linspire.Debian.Control.String,- Linspire.Debian.Control.ByteString,- Linspire.Debian.Control.PrettyPrint,- Linspire.Debian.Dependencies,- Linspire.Debian.Package,- Linspire.Debian.PackageDeprecated,- Linspire.Debian.Relation,- Linspire.Debian.Relation.Common,- Linspire.Debian.Relation.String,- Linspire.Debian.Relation.ByteString,- Linspire.Debian.SourcesList,- Linspire.Debian.Version,- Linspire.Debian.Version.Common,- Linspire.Debian.Version.String,- Linspire.Debian.Version.ByteString+name: debian+version: 1.2.1+license: BSD3+license-file: copyright+author: Jeremy Shaw+maintainer: Jeremy Shaw <jeremy@n-heptane.com>+stability: obsolete+synopsis: A set of modules for working with Debian control files and packages+description: This version is very out of date and no longer+ supported. Get latest version from darcs for now.+ Modules for parsing Debian control files, resolving+ dependencies, comparing version numbers, and other+ useful stuff.+homepage: http://src.seereason.com/haskell-debian-3+category: System+tested-with: GHC==6.8.2+build-depends: base, containers, parsec, mtl, network, unix, regex-compat, bytestring, pretty+build-type: Custom++exposed-modules:+ Linspire.Debian.Control,+ Linspire.Debian.Control.Common,+ Linspire.Debian.Control.String,+ Linspire.Debian.Control.ByteString,+ Linspire.Debian.Control.PrettyPrint,+ Linspire.Debian.Dependencies,+ Linspire.Debian.Package,+ Linspire.Debian.PackageDeprecated,+ Linspire.Debian.Relation,+ Linspire.Debian.Relation.Common,+ Linspire.Debian.Relation.String,+ Linspire.Debian.Relation.ByteString,+ Linspire.Debian.SourcesList,+ Linspire.Debian.Version,+ Linspire.Debian.Version.Common,+ Linspire.Debian.Version.String,+ Linspire.Debian.Version.ByteString other-modules:- Linspire.Debian.Version.Internal+ Linspire.Debian.Version.Internal extra-source-files:- tests/Dependencies.hs tests/Main.hs tests/SourcesList.hs tests/Versions.hs debian/changelog - debian/compat debian/control debian/copyright debian/haskell-debian-doc.docs debian/rules+ tests/Dependencies.hs, tests/Main.hs, tests/SourcesList.hs, tests/Versions.hs, debian/changelog,+ debian/compat, debian/control, debian/copyright, debian/haskell-debian-doc.docs, debian/rules++extensions: FlexibleInstances, TypeSynonymInstances, TypeOperators, ScopedTypeVariables+ghc-options: -O2 -funbox-strict-fields -Wall
debian/changelog view
@@ -1,3 +1,10 @@+haskell-debian (1.2.1) unstable; urgency=low++ * Special release so that version on hackageDB works until we have time+ to upload 3.x.++ -- Jeremy Shaw <jeremy@n-heptane.com> Mon, 23 Jun 2008 12:45:20 -0700+ haskell-debian (1.2) unstable; urgency=low * Cleanup in preperation for upload to hackageDB
debian/control view
@@ -1,7 +1,7 @@ Source: haskell-debian Priority: optional Maintainer: Jeremy Shaw <jeremy.shaw@linspireinc.com>-Build-Depends: debhelper (>= 4.0.0), ghc6 (>= 6.4.1), haskell-devscripts (>= 0.5.11+DARCS), libghc6-cabal-dev (>=1.1.3), ghc6-prof, libghc6-network-dev, libghc6-hunit-dev, libghc6-mtl-dev+Build-Depends: debhelper (>= 4.0.0), ghc6 (>= 6.4.1), haskell-devscripts (>= 0.5.11+DARCS), ghc6-prof, libghc6-network-dev, libghc6-hunit-dev, libghc6-mtl-dev Build-Depends-Indep: haddock, hugs (>= 98.200503.08) Standards-Version: 3.7.2.1 Section: devel
debian/rules view
@@ -24,7 +24,7 @@ # Add here commands to clean up after the build process. if [ -x setup ] && [ -e .setup-config ] ; then ./setup clean ; fi rm -rf setup Setup.hi Setup.ho Setup.o .*config* dist html- make clean+ #make clean dh_clean @@ -48,8 +48,9 @@ dh_installdirs -i dh_haskell -i- ./Setup.hs test- ./Setup.hs haddock+ ./setup configure+ ./setup test+ ./setup haddock # Build architecture-independent files here. binary-indep: build-indep install-indep
tests/Main.hs view
@@ -2,13 +2,13 @@ import Test.HUnit import System.Exit+ import Versions import SourcesList -main =- do (c,st) <- runTestText putTextToShowS (TestList (versionTests ++ sourcesListTests))- putStrLn (st "")- case (failures c) + (errors c) of- 0 -> return ()- n -> exitFailure- +main :: IO ()+main = do (c,st) <- runTestText putTextToShowS (TestList (versionTests ++ sourcesListTests))+ putStrLn (st "")+ case (failures c) + (errors c) of+ 0 -> return ()+ _ -> exitFailure
tests/SourcesList.hs view
@@ -37,8 +37,8 @@ , "deb http://ftp.debian.org/whee space%20dist main" , "deb http://ftp.debian.org/whee dist space%20section" ]- invalidSourcesListStr1 = "deb http://pkg-kde.alioth.debian.org/kde-3.5.0/ ./ main contrib non-free # exact path with sections"- +-- invalidSourcesListStr1 = "deb http://pkg-kde.alioth.debian.org/kde-3.5.0/ ./ main contrib non-free # exact path with sections" -sourcesListTests =- [ testQuoteWords, testSourcesList ]++sourcesListTests :: [Test]+sourcesListTests = [testQuoteWords, testSourcesList]
tests/Versions.hs view
@@ -3,32 +3,35 @@ import Test.HUnit import Linspire.Debian.Version+import Linspire.Debian.Version.Common (ParseDebianVersion()) -- * Implicit Values +implicit1, implicit2, implicit3, implicit4, implicit5, implicit6, implicit7 :: Test implicit1 = TestCase (assertEqual "1.0 == 1.0-" EQ (compare (parseDebianVersion "1.0") (parseDebianVersion "1.0-"))) implicit2 = TestCase (assertEqual "1.0 == 1.0-0" EQ (compare (parseDebianVersion "1.0") (parseDebianVersion "1.0-0"))) -implicit3 = +implicit3 = TestCase (assertEqual "1.0 == 0:1.0-0" EQ (compare (parseDebianVersion "1.0") (parseDebianVersion "0:1.0-0"))) -implicit4 = +implicit4 = TestCase (assertEqual "1.0 == 1.0-" EQ (compare (parseDebianVersion "1.0") (parseDebianVersion "1.0-"))) -implicit5 = +implicit5 = TestCase (assertEqual "apple = apple0" EQ (compare (parseDebianVersion "apple") (parseDebianVersion "apple0"))) -implicit6 = +implicit6 = TestCase (assertEqual "apple = apple0-" EQ (compare (parseDebianVersion "apple") (parseDebianVersion "apple0-"))) -implicit7 = +implicit7 = TestCase (assertEqual "apple = apple0-0" EQ (compare (parseDebianVersion "apple") (parseDebianVersion "apple0-0"))) -- * epoch, version, revision +epoch1, epoch2, epoch3 :: Test epoch1 = TestCase (assertEqual "epoch 0:0" (Just 0) (epoch $ parseDebianVersion "0:0")) @@ -38,6 +41,7 @@ epoch3 = TestCase (assertEqual "epoch 1:0" (Just 1) (epoch $ parseDebianVersion "1:0")) +version1, version2, version3 :: Test version1 = TestCase (assertEqual "version apple" "apple" (version $ parseDebianVersion "apple")) @@ -47,6 +51,7 @@ version3 = TestCase (assertEqual "version apple1" "apple1" (version $ parseDebianVersion "apple1")) +revision1, revision2, revision3, revision4 :: Test revision1 = TestCase (assertEqual "revision 1.0" Nothing (revision $ parseDebianVersion "1.0")) @@ -62,8 +67,10 @@ -- * Ordering +compareV :: (ParseDebianVersion a1, ParseDebianVersion a) => a -> a1 -> Ordering compareV str1 str2 = compare (parseDebianVersion str1) (parseDebianVersion str2) +order1, order2 :: Test order1 = TestCase (assertEqual "1:1-1 > 0:1-1" GT (compareV "1:1-1" "0:1-1")) @@ -72,6 +79,7 @@ -- * Dashes in upstream version +dash1, dash2, zero1 :: Test dash1 = TestCase (assertEqual "version of upstream-version-revision" "upstream-version" (version (parseDebianVersion "upstream-version-revision"))) @@ -85,6 +93,7 @@ -- * Tests +versionTests :: [Test] versionTests = [ TestLabel "implicit1" implicit1 , TestLabel "implicit2" implicit2