diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -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.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/System/Rpm/Combinators.hs b/System/Rpm/Combinators.hs
new file mode 100644
--- /dev/null
+++ b/System/Rpm/Combinators.hs
@@ -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
+
+
diff --git a/System/Rpm/Info.hs b/System/Rpm/Info.hs
new file mode 100644
--- /dev/null
+++ b/System/Rpm/Info.hs
@@ -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:
+
+ @\
+
+ \\
+
+ \@
+ -}
+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
+
+
+
+
+
+
diff --git a/System/Rpm/Xml.hs b/System/Rpm/Xml.hs
new file mode 100644
--- /dev/null
+++ b/System/Rpm/Xml.hs
@@ -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 = "" ++ xml ++ ""
+
+--------------------------------------------------------------------------------
+
+
+
+
diff --git a/rpm.cabal b/rpm.cabal
new file mode 100644
--- /dev/null
+++ b/rpm.cabal
@@ -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
+
diff --git a/test/RunTest.hs b/test/RunTest.hs
new file mode 100644
--- /dev/null
+++ b/test/RunTest.hs
@@ -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
+ ]
+ ]
+
+
+