diff --git a/Linspire/Debian/Control.hs b/Linspire/Debian/Control.hs --- a/Linspire/Debian/Control.hs +++ b/Linspire/Debian/Control.hs @@ -1,5 +1,5 @@ -- |A module for working with Debian control files -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 diff --git a/Linspire/Debian/Control/ByteString.hs b/Linspire/Debian/Control/ByteString.hs --- a/Linspire/Debian/Control/ByteString.hs +++ b/Linspire/Debian/Control/ByteString.hs @@ -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) diff --git a/Linspire/Debian/Control/PrettyPrint.hs b/Linspire/Debian/Control/PrettyPrint.hs --- a/Linspire/Debian/Control/PrettyPrint.hs +++ b/Linspire/Debian/Control/PrettyPrint.hs @@ -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 diff --git a/Linspire/Debian/Control/String.hs b/Linspire/Debian/Control/String.hs --- a/Linspire/Debian/Control/String.hs +++ b/Linspire/Debian/Control/String.hs @@ -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. diff --git a/Linspire/Debian/Dependencies.hs b/Linspire/Debian/Dependencies.hs --- a/Linspire/Debian/Dependencies.hs +++ b/Linspire/Debian/Dependencies.hs @@ -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 diff --git a/Linspire/Debian/Package.hs b/Linspire/Debian/Package.hs --- a/Linspire/Debian/Package.hs +++ b/Linspire/Debian/Package.hs @@ -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 diff --git a/Linspire/Debian/PackageDeprecated.hs b/Linspire/Debian/PackageDeprecated.hs --- a/Linspire/Debian/PackageDeprecated.hs +++ b/Linspire/Debian/PackageDeprecated.hs @@ -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) diff --git a/Linspire/Debian/Relation.hs b/Linspire/Debian/Relation.hs --- a/Linspire/Debian/Relation.hs +++ b/Linspire/Debian/Relation.hs @@ -13,12 +13,7 @@ -- * Relation Parser , RelParser , ParseRelations(..) - ) where - --- Standard GHC Modules - -import Data.List -import Text.ParserCombinators.Parsec + ) where -- Local Modules diff --git a/Linspire/Debian/Relation/ByteString.hs b/Linspire/Debian/Relation/ByteString.hs --- a/Linspire/Debian/Relation/ByteString.hs +++ b/Linspire/Debian/Relation/ByteString.hs @@ -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) diff --git a/Linspire/Debian/Relation/Common.hs b/Linspire/Debian/Relation/Common.hs --- a/Linspire/Debian/Relation/Common.hs +++ b/Linspire/Debian/Relation/Common.hs @@ -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 diff --git a/Linspire/Debian/Relation/String.hs b/Linspire/Debian/Relation/String.hs --- a/Linspire/Debian/Relation/String.hs +++ b/Linspire/Debian/Relation/String.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TypeSynonymInstances #-} + -- |A module for working with debian relationships 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 diff --git a/Linspire/Debian/SourcesList.hs b/Linspire/Debian/SourcesList.hs --- a/Linspire/Debian/SourcesList.hs +++ b/Linspire/Debian/SourcesList.hs @@ -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) diff --git a/Linspire/Debian/Version.hs b/Linspire/Debian/Version.hs --- a/Linspire/Debian/Version.hs +++ b/Linspire/Debian/Version.hs @@ -1,17 +1,14 @@ -- |A module for parsing, comparing, and (eventually) modifying debian version -- numbers. -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 diff --git a/Linspire/Debian/Version/Common.hs b/Linspire/Debian/Version/Common.hs --- a/Linspire/Debian/Version/Common.hs +++ b/Linspire/Debian/Version/Common.hs @@ -1,17 +1,16 @@ -- |A module for parsing, comparing, and (eventually) modifying debian version -- numbers. 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) diff --git a/Linspire/Debian/Version/String.hs b/Linspire/Debian/Version/String.hs --- a/Linspire/Debian/Version/String.hs +++ b/Linspire/Debian/Version/String.hs @@ -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 diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -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} diff --git a/copyright b/copyright new file mode 100644 --- /dev/null +++ b/copyright @@ -0,0 +1,26 @@ +Copyright (c) 2006, Jeremy Shaw +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. diff --git a/debian.cabal b/debian.cabal --- a/debian.cabal +++ b/debian.cabal @@ -1,38 +1,45 @@ -name: debian -version: 1.2 -license: BSD3 -license-file: debian/copyright -author: Jeremy Shaw -maintainer: Jeremy Shaw -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 +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 diff --git a/debian/changelog b/debian/changelog --- a/debian/changelog +++ b/debian/changelog @@ -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 Mon, 23 Jun 2008 12:45:20 -0700 + haskell-debian (1.2) unstable; urgency=low * Cleanup in preperation for upload to hackageDB diff --git a/debian/control b/debian/control --- a/debian/control +++ b/debian/control @@ -1,7 +1,7 @@ Source: haskell-debian Priority: optional Maintainer: Jeremy Shaw -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 diff --git a/debian/rules b/debian/rules --- a/debian/rules +++ b/debian/rules @@ -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 diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -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 diff --git a/tests/SourcesList.hs b/tests/SourcesList.hs --- a/tests/SourcesList.hs +++ b/tests/SourcesList.hs @@ -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] diff --git a/tests/Versions.hs b/tests/Versions.hs --- a/tests/Versions.hs +++ b/tests/Versions.hs @@ -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