rpm (empty) → 0.0.1
raw patch · 7 files changed
+540/−0 lines, 7 filesdep +HUnitdep +HaXmldep +QuickChecksetup-changed
Dependencies added: HUnit, HaXml, QuickCheck, base, directory, filepath, process, test-framework, test-framework-hunit, test-framework-quickcheck
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- System/Rpm/Combinators.hs +151/−0
- System/Rpm/Info.hs +166/−0
- System/Rpm/Xml.hs +56/−0
- rpm.cabal +90/−0
- test/RunTest.hs +45/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2010, Eric Stolten++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * 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.++ * Neither the name of Eric Stolten nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 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 COPYRIGHT+OWNER 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ System/Rpm/Combinators.hs view
@@ -0,0 +1,151 @@+{-| + 'System.Rpm.Combinators' provides a mechanism for comparing+ attributes of an Rpm against some sort of specification.+-}++module System.Rpm.Combinators + (+ Rpm(..)+ , RpmP+ , zeroP+ , oneP+ , notP+ , (.==.)+ , (./=.)+ , (.<=.)+ , (.<.)+ , (.>=.)+ , (.>.)+ , (.&&.)+ , (.||.)+ -- * Example: Common Uses+ -- $exampleOfUse+ ) where++import System.Rpm.Info (RpmInfo(..))++type Rpm a = RpmInfo -> a+++{-| +A predicate type that takes an 'RpmInfo' datatype and returns a+value of Bool depending on its evaluation.+-}+type RpmP = Rpm Bool+++{-|+A standard lifting function.+-}+liftP :: (a -> a -> b) -- ^ The function to lift+ -> Rpm a -- ^ The field to extract from 'RpmInfo'+ -> a -- ^ Passed to the Second argument of the function+ -> Rpm b -- ^ The result wrapped in 'Rpm'++liftP f g val rpmInfo= g rpmInfo `f` val+++{-|+A more conventional lifting function.+-}+liftP2 :: (a -> b -> c) + -> Rpm a + -> Rpm b + -> Rpm c++liftP2 f g h rpmInfo = g rpmInfo `f` h rpmInfo+++{-| +The 'zeroP' combinator, much like the 'oneP' combinator, is more+for completeness than anything.+-}+zeroP :: RpmP -- ^ The constant combinator that always returns+ -- 'False' when run.+zeroP _ = False+++oneP :: RpmP -- ^ The constant combinator that always returns 'False'+ -- when run.+oneP _ = True+++(.==.) :: Eq a => Rpm a -- ^ Some field of 'RpmInfo'+ -> a -- ^ The value to check equality against+ -> RpmP +(.==.) = liftP (==)+++(./=.) :: Eq a => Rpm a -> a -> RpmP+(./=.) = liftP (/=)+++(.<=.) :: Ord a => Rpm a -> a -> RpmP+(.<=.) = liftP (<=)+++(.<.) :: Ord a => Rpm a -> a -> RpmP+(.<.) = liftP (<)+++(.>=.) :: Ord a => Rpm a -> a -> RpmP+(.>=.) = liftP (>=)+++(.>.) :: Ord a => Rpm a -> a -> RpmP+(.>.) = liftP (>)+++{-|+@notP@ is used to negate its 'RpmP' when run.+-}+notP :: RpmP -- ^ Predicate to negate+ -> RpmP -- ^ Negated predicate+notP p = not . p +++{-| +This is a logical combinator used for constructing more complex+sequences of combinators by requiring both predicates to be true.+-}+(.&&.) :: RpmP + -> RpmP + -> RpmP+(.&&.) = liftP2 (&&)+++{-| +This is a logical combinator used for constructing more complex+sequences of combinators by requiring one of the predicates to be true.+-}+(.||.) :: RpmP + -> RpmP + -> RpmP+(.||.) = liftP2 (||)++{-| $exampleOfUse+Example of use.++> main :: IO ()+> main = putStrLn "Hello"++-}++-- nameMatchesFilename :: RpmP+-- nameMatchesFilename rpmInfo = fileName .==. (name rpmInfo)++-- Then, to find where name doesn't match filename,+-- findAll (.!. nameMatchesFilename)+-- or, assertAll (nameMatchesFilename)+-- or, assertAll (buildHost .==. "my1.machine.org" .||. buildHost .==. "my2.machine.org")++-- Conditional predicate generation+-- ifThenElse :: RpmP -> RpmP -> RpmP+-- ifThenElse ( file `matchesP` "foo*" )+-- ( size .<=. 1234)+++-- assertEqual .!. (.!. zeroP) == zeroP+-- assertEqual (.!. zeroP) == oneP++
+ System/Rpm/Info.hs view
@@ -0,0 +1,166 @@+{-| ++ This module is mainly for internal purposes and these functions+ should not be called directly.+ -- Remove 'testName'+-}++module System.Rpm.Info + ( RpmInfo(..)+ , rpmInfoFromFile+ , rpmInfoFromXml+ ) where++import Text.XML.HaXml hiding (version)+import Text.XML.HaXml.Posn (Posn)++import System.Rpm.Xml (executeRpm2Xml)++data RpmInfo = RpmI {+ name :: String+ , buildHost :: String+ , buildTime :: Integer + , description :: String+ , summary :: String+ , size :: Integer+ , version :: String+ , release :: String+ } deriving(Show, Eq)++--------------------------------------------------------------------------------++runFilter :: CFilter i -- ^ Function like 'getName'+ -> [Content i] -- ^ Usually the children of the root element.+ -> [Maybe String] -- ^ The extracted text, if any.++runFilter f = map extractText . concatMap f+++{-| 'rpmFilter' is a function that creates a 'CFilter' that matches elements similar to:+ + @\<rpmTag name=QueryTag>++ \<TagType>\</TagType>++ \</rpmTag>@+ -}+rpmFilter :: String -- ^ Tag Name+ -> String -- ^ Tag Type+ -> CFilter i+rpmFilter tagName tagType c = (txt `o` children `o` tag tagType `o` children `o` attrval att `o` tag "rpmTag") c+ where+ att :: Attribute+ att = ("name", AttValue [Left tagName])+++{-| + getName is a filter for extracting string elements from tags with+ Name attributes. The other functions are typically the same+ unless otherwise noted. -}+getName :: CFilter i+getName = rpmFilter "Name" "string" +++getBuildHost :: CFilter i+getBuildHost = rpmFilter "Buildhost" "string"+++getBuildTime :: CFilter i+getBuildTime = rpmFilter "Buildtime" "integer"+++getDescription :: CFilter i+getDescription = rpmFilter "Description" "string"+++getSummary :: CFilter i+getSummary = rpmFilter "Summary" "string"+++getSize :: CFilter i+getSize = rpmFilter "Size" "integer"+++getVersion :: CFilter i+getVersion = rpmFilter "Version" "string"+++getRelease :: CFilter i+getRelease = rpmFilter "Release" "string"+++getURL :: CFilter i+getURL = rpmFilter "Url" "string"+++getArch :: CFilter i+getArch = rpmFilter "Arch" "string"+++getArchiveSize :: CFilter i+getArchiveSize = rpmFilter "Archivesize" "integer"++--------------------------------------------------------------------------------+getRpmInfo :: [Content i] + -> Maybe RpmInfo++getRpmInfo cs = do+ n <- extract getName+ s <- extract getSummary+ d <- extract getDescription+ bh <- extract getBuildHost+ bt <- extract getBuildTime+ sz <- extract getSize+ v <- extract getVersion+ r <- extract getRelease+ return RpmI { name = n+ , summary = s+ , description = d+ , buildHost = bh+ , size = read sz :: Integer+ , buildTime = read bt :: Integer+ , version = v+ , release = r }+ where+ extract f = let results = runFilter f cs in+ if null results+ then Nothing+ else head results+++rpmInfoFromFile :: FilePath -- ^ Path to a Rpm+ -> IO (Maybe RpmInfo)++rpmInfoFromFile file = do+ contents <- executeRpm2Xml file+ case contents of+ Just xml -> return (rpmInfoFromXml xml)+ Nothing -> return Nothing+++rpmInfoFromXml :: String -- ^ A string of XML containing information about a package.+ -> Maybe RpmInfo++rpmInfoFromXml xml = getRpmInfo (content xml)+ where content file = extractContent ( getRootElement file file) +++getRootElement :: String -- ^ Filename to report parsing errors for.+ -> String -- ^ String of XML Content+ -> Element Posn+getRootElement fileName xml = elt+ where Document _ _ elt _ = xmlParse xml fileName ++extractContent :: Element i -> [Content i]+extractContent (Elem _ _ c ) = c++extractText :: Content i -> Maybe String+extractText e = case e of+ CString _ n _ -> Just n+ _ -> Nothing++++++
+ System/Rpm/Xml.hs view
@@ -0,0 +1,56 @@+-- | This module is responsible for generating a XML representation of a Rpm.+module System.Rpm.Xml ( executeRpm2Xml ) where++import System.Exit+import System.Process++--------------------------------------------------------------------------------++type QueryTag = String+type QueryTags = [QueryTag]+type Xml = String++-- | 'executeRpm2Xml' takes a path to an RPM package and generates an+-- XML representation in the form of a string.+executeRpm2Xml :: FilePath -- ^ Path to RPM Package+ -> IO (Maybe String)+executeRpm2Xml file = do+ (statusCode, out, _ ) <- readProcessWithExitCode "rpm" ["-qp", "--qf", queryString queryTags, file] ""+ case statusCode of+ ExitSuccess -> return (Just $ (wrapRpmXml .tail . init) out)+ _ -> return Nothing++--------------------------------------------------------------------------------++-- | 'queryTags' is list of the query tags we wish to extract from our+-- rpm files.+queryTags :: QueryTags+queryTags = [ "NAME"+ , "BUILDHOST"+ , "BUILDTIME"+ , "DESCRIPTION"+ , "RELEASE"+ , "VERSION"+ , "SIZE"+ , "SUMMARY"+ , "URL"+ , "ARCH"+ , "ARCHIVESIZE"]++--------------------------------------------------------------------------------++queryString :: QueryTags -> String+queryString = quote . concatMap (\x -> "[%{" ++ x ++ ":xml}]")+ where quote :: String -> String+ quote xs = "\"" ++ xs ++ "\""++--------------------------------------------------------------------------------++wrapRpmXml :: Xml -> Xml+wrapRpmXml xml = "<rpm>" ++ xml ++ "</rpm>"++--------------------------------------------------------------------------------++++
+ rpm.cabal view
@@ -0,0 +1,90 @@+-- rpm.cabal auto-generated by cabal init. For additional options, see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.+-- The name of the package.+Name: rpm++-- The package version. See the Haskell package versioning policy+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for+-- standards guiding when and how versions should be incremented.+Version: 0.0.1++-- A short (one-line) description of the package.+Synopsis: Cozy little project to question unruly rpm packages.++-- A longer description of the package.+Description: RPM is a decent system for listing dependencies among packages. In its simplest form it works quite well. Dependency management can become troublesome if you have a system that provides numerous packages. Worse yet, if you provide many packages for many different versions of a software application. This library aims to provide a rich set of combinators to assert the validity of a collection of RPMs.++-- The license under which the package is released.+License: BSD3++-- The file containing the license text.+License-file: LICENSE++-- The package author(s).+Author: Eric Stolten++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer: stoltene2@gmail.com++-- A copyright notice.+-- Copyright: ++Category: System++Build-type: Simple++-- Extra files to be distributed with the package, such as examples or+-- a README.+-- Extra-source-files: ++-- Constraint on the version of Cabal needed to build this package.+Cabal-version: >=1.8++flag tests+ description: Build the tests+ default: False++flag hpc+ description: Use HPC for tests+ default: True++++Library+ -- Modules exported by the library.+ Exposed-modules: System.Rpm.Info, System.Rpm.Combinators, System.Rpm.Xml+ + -- Packages needed in order to build this package.+ Build-depends: base >= 4.0 && < 6, filepath >= 1.1.0.3, process >= 1.0.1.2,+ directory >= 1.0.1.0, HaXml >= 1.20.2+ + -- Modules not exported by this package.+ --Other-modules: ++++executable test-rpm+ main-is: RunTest.hs+ hs-source-dirs: test, . + if !flag(tests)+ buildable: False+ else+ if flag(hpc)+ ghc-options: -fhpc+ x-hpc: true+ ghc-options: -Wall + build-depends:+ base >= 4 && < 6,+ test-framework >= 0.3.0 && < 0.4,+ test-framework-quickcheck >= 0.2.4 && < 0.3,+ test-framework-hunit >= 0.2.4 && < 0.3,+ QuickCheck >= 1.2.0.0 && < 1.3,+ HUnit >= 1.2.2.1 && < 1.3,+ HaXml >= 1.20.2,+ filepath >= 1.1.0.3,+ process >= 1.0.1.2,+ directory >= 1.0.1.0+ other-modules: + System.Rpm.Combinators+
+ test/RunTest.hs view
@@ -0,0 +1,45 @@++import Test.Framework (defaultMain, testGroup)+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck (testProperty)++import CombinatorsTest+import InfoTest++++-- hpc markup --exclude=Main --exclude=CombinatorsTest --destdir=doc/hpc test-rpm++main :: IO ()+main = defaultMain tests++tests = [+ testGroup "Combinator Properties" + [ + testProperty "Multiplicative Identity" prop_MultiplicativeIdentity+ , testProperty "Additive Identity" prop_AdditiveIdentity+ , testProperty "Reflexive And with zeros" prop_ReflexiveAndZeros+ , testProperty "Reflexive And with ones" prop_ReflexiveAndOnes+ , testProperty "Commutativity of And" prop_CommuativeAnd+ , testProperty "Commutativity of Or" prop_CommuativeOr+ , testProperty "Associativity of Or" prop_AssociativeOr+ , testProperty "Associativity of And" prop_AssociativeAnd+ , testProperty "Distributivity of Or" prop_DistributiveOr+ , testProperty "Distributivity of And" prop_DistributiveAnd+ , testProperty ".>." prop_GreaterThan + , testProperty ".>=." prop_GreaterThanEq + , testProperty ".<." prop_LessThan + , testProperty ".<=." prop_LessThanEq + , testProperty ".<=. && .>." prop_LessThanEqAndGreaterThan + , testProperty "./=." prop_NotEqual+ , testProperty "notP" prop_Not+ , testProperty "notP again" prop_Not2+ , testProperty "notP again, again" prop_Not3+ , testProperty "notP notP" prop_Not4+ , testCase "Not all fields present." test_notAllFieldsPresent+ , testCase "Some empty tags" test_containsEmptyTags+ ]+ ]+++