[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36
John Goerzen
jgoerzen at complete.org
Fri Apr 23 15:21:08 UTC 2010
The following commit has been merged in the master branch:
commit 257e23f66ebca17377deb3fa40eb6af08b109741
Author: John Goerzen <jgoerzen at complete.org>
Date: Thu Dec 7 23:11:48 2006 +0100
UNDO: Removed split-off Debian stuff
diff --git a/MissingH.cabal b/MissingH.cabal
index b2b36f7..f4c1f41 100644
--- a/MissingH.cabal
+++ b/MissingH.cabal
@@ -38,6 +38,7 @@ Exposed-Modules: Data.String, System.IO.Utils, System.IO.Binary, Data.List.Utils
System.IO.HVFS.Utils,
System.IO.HVIO, System.IO.StatCompat, System.IO.WindowsCompat,
System.IO.PlafCompat, System.Posix.Consts,
+ System.Debian, System.Debian.ControlParser,
Data.MIME.Types,
System.Console.GetOpt.Utils
Extensions: ExistentialQuantification, OverlappingInstances,
diff --git a/src/System/Debian.hs b/src/System/Debian.hs
new file mode 100644
index 0000000..ff9dab8
--- /dev/null
+++ b/src/System/Debian.hs
@@ -0,0 +1,87 @@
+{- arch-tag: Debian Package utilities main file
+Copyright (C) 2004 John Goerzen <jgoerzen at complete.org>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+-}
+
+{- |
+ Module : System.Debian
+ Copyright : Copyright (C) 2004 John Goerzen
+ License : GNU GPL, version 2 or above
+
+ Maintainer : John Goerzen <jgoerzen at complete.org>
+ Stability : provisional
+ Portability: portable
+
+This module provides various helpful utilities for dealing with Debian
+files and programs.
+
+Written by John Goerzen, jgoerzen\@complete.org
+-}
+
+module System.Debian (-- * Control or Similar File Utilities
+ ControlFile,
+ -- * Version Number Utilities
+ DebVersion, compareDebVersion, checkDebVersion
+ )
+where
+import System.Cmd
+import System.Debian.ControlParser
+import System.Cmd.Utils
+import Data.String
+import System.IO.Unsafe
+import System.Exit
+
+{- | The type representing the contents of a Debian control file,
+or any control-like file (such as the output from apt-cache show, etc.) -}
+type ControlFile = [(String, String)]
+
+splitComma :: String -> [String]
+splitComma = map strip . split ","
+
+----------------------------------------------------------------------
+-- VERSION NUMBERS
+----------------------------------------------------------------------
+
+{- | The type representing a Debian version number. This type is an instance
+of 'Prelude.Ord', but you can also use 'compareDebVersion' if you prefer. -}
+data DebVersion = DebVersion String
+ deriving (Eq)
+instance Ord DebVersion where
+ compare (DebVersion v1) (DebVersion v2) =
+ {- This is OK since compareDebVersion should always be the same. -}
+ unsafePerformIO $ compareDebVersion v1 v2
+
+{- | Compare the versions of two packages. -}
+compareDebVersion :: String -> String -> IO Ordering
+compareDebVersion v1 v2 =
+ let runit op = checkDebVersion v1 op v2
+ in do islt <- runit "lt"
+ if islt
+ then return LT
+ else do isgt <- runit "gt"
+ if isgt
+ then return GT
+ else return EQ
+
+checkDebVersion :: String -- ^ Version 1
+ -> String -- ^ Operator
+ -> String -- ^ Version 2
+ -> IO Bool
+checkDebVersion v1 op v2 =
+ do ec <- rawSystem "dpkg" ["--compare-versions", v1, op, v2]
+ case ec of
+ ExitSuccess -> return True
+ ExitFailure _ -> return False
diff --git a/src/System/Debian/ControlParser.hs b/src/System/Debian/ControlParser.hs
new file mode 100644
index 0000000..1386c48
--- /dev/null
+++ b/src/System/Debian/ControlParser.hs
@@ -0,0 +1,95 @@
+{- arch-tag: Parser for Debian control file
+Copyright (C) 2004 John Goerzen <jgoerzen at complete.org>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+-}
+
+{- |
+ Module : System.Debian.ControlParser
+ Copyright : Copyright (C) 2004 John Goerzen
+ License : GNU GPL, version 2 or above
+
+ Maintainer : John Goerzen <jgoerzen at complete.org>
+ Stability : provisional
+ Portability: portable
+
+This module provides various helpful utilities for dealing with Debian
+files and programs.
+
+Written by John Goerzen, jgoerzen\@complete.org
+-}
+
+module System.Debian.ControlParser(control, depPart)
+ where
+import Text.ParserCombinators.Parsec
+import Data.String
+
+eol = (try (string "\r\n"))
+ <|> string "\n" <?> "EOL"
+
+extline = try (do char ' '
+ content <- many (noneOf "\r\n")
+ eol
+ return content
+ )
+
+entry = do key <- many1 (noneOf ":\r\n")
+ char ':'
+ val <- many (noneOf "\r\n")
+ eol
+ exts <- many extline
+ return (key, unlines ([val] ++ exts))
+
+{- | Main parser for the control file -}
+control :: CharParser a [(String, String)]
+control = do many header
+ retval <- many entry
+ return retval
+
+headerPGP = do string "-----BEGIN PGP"
+ manyTill (noneOf "\r\n") eol
+ return ()
+blankLine = do many (oneOf " \t")
+ eol
+ return ()
+headerHash = do string "Hash: "
+ manyTill (noneOf "\r\n") eol
+ return ()
+header = (try headerPGP) <|> (try blankLine) <|> (try headerHash)
+
+{- | Dependency parser.
+
+Returns (package name, Maybe version, arch list
+
+version is (operator, operand) -}
+depPart :: CharParser a (String, (Maybe (String, String)), [String])
+depPart = do packagename <- many1 (noneOf " (")
+ many (char ' ')
+ version <- (do char '('
+ op <- many1 (oneOf "<>=")
+ many (char ' ')
+ vers <- many1 (noneOf ") ")
+ many (char ' ')
+ char ')'
+ return $ Just (op, vers)
+ ) <|> return Nothing
+ many (char ' ')
+ archs <- (do char '['
+ t <- many1 (noneOf "]")
+ many (char ' ')
+ char ']'
+ return (split " " t)
+ ) <|> return []
+ return (packagename, version, archs)
--
haskell-testpack
More information about the Pkg-haskell-commits
mailing list