[Pkg-haskell-commits] [tools] 01/03: Improve binNMUs speed: Do a rough check before parsing relations.
Joachim Breitner
nomeata at moszumanska.debian.org
Tue Aug 26 23:56:30 UTC 2014
This is an automated email from the git hooks/post-receive script.
nomeata pushed a commit to branch master
in repository tools.
commit df0f12beab115f3cf96b692d8925ba9e9bd9d589
Author: Joachim Breitner <mail at joachim-breitner.de>
Date: Tue Aug 26 13:56:26 2014 -0700
Improve binNMUs speed: Do a rough check before parsing relations.
---
binNMUs.hs | 51 +++++++++++++++++++++++++++++++--------------------
1 file changed, 31 insertions(+), 20 deletions(-)
diff --git a/binNMUs.hs b/binNMUs.hs
index 7f1585e..f92915c 100644
--- a/binNMUs.hs
+++ b/binNMUs.hs
@@ -18,6 +18,7 @@ import Control.Arrow
import qualified Data.ByteString.Char8 as B
import Data.Time
import Control.Lens
+--import Control.Parallel.Strategies
import AcquireFile
@@ -66,7 +67,10 @@ data Binary = Binary
run :: Conf -> IO ()
run conf = do
printHeader conf
- cBinNMUs <- concat <$> mapM (getNMUs conf) (arches conf)
+ cBinNMUss <- mapM (getNMUs conf) (arches conf)
+ -- Parallelization, if required
+ --let cBinNMUs = concat (cBinNMUss `using` parList (evalList (evalTuple2 rseq rseq)))
+ let cBinNMUs = concat cBinNMUss
presentProblems cBinNMUs
presentBinNMUs cBinNMUs
@@ -260,13 +264,31 @@ acquirePackages conf url = do
case parseControl url s of
Left pe -> error $ show pe
Right c -> return $
- filter interesting $
- map parsePara $
+ mapMaybe parsePara $
unControl c
where
- parsePara :: Paragraph -> Binary
- parsePara p =
- Binary
+ parsePara :: Paragraph -> Maybe Binary
+ parsePara p = if likelyInteresting && interesting b then Just b else Nothing
+ where
+ reqField f = maybe (error $ printf "Missing field %s" f) B.unpack (fieldValue f p)
+ optField f = B.unpack <$> fieldValue f p
+
+ pkg = reqField "Package"
+ v = reqField "Version"
+
+ relField :: String -> Relations
+ relField f = case parseRelations $ fromMaybe B.empty (fieldValue f p) of
+ Left pe -> error $ printf "Failed to parse relations %s" (show pe)
+ Right rel -> rel
+
+ flatRels :: Relations -> [String]
+ flatRels = map (\(Rel (BinPkgName n) _ _) -> n) . join
+
+ likelyInteresting =
+ maybe False (isJust . matchRegex (roughRegex conf)) (optField "Depends") ||
+ maybe False (isJust . matchRegex (roughRegex conf)) (optField "Provides")
+
+ b = Binary
pkg
(maybe pkg (fst.splitSrc) (optField "Source"))
(reqField "Architecture")
@@ -274,19 +296,6 @@ acquirePackages conf url = do
(fromMaybe v (optField "Source" >>= snd . splitSrc))
(mapMaybe (parseVirtPackage conf) $ flatRels $ relField "Depends")
(mapMaybe (parseVirtPackage conf) $ flatRels $ relField "Provides")
- where reqField f = maybe (error $ printf "Missing field %s" f) B.unpack (fieldValue f p)
- optField f = B.unpack <$> fieldValue f p
-
- pkg = reqField "Package"
- v = reqField "Version"
-
- relField :: String -> Relations
- relField f = case parseRelations $ fromMaybe B.empty (fieldValue f p) of
- Left pe -> error $ printf "Failed to parse relations %s" (show pe)
- Right rel -> rel
-
- flatRels :: Relations -> [String]
- flatRels = map (\(Rel (BinPkgName n) _ _) -> n) . join
interesting :: Binary -> Bool
@@ -324,13 +333,15 @@ acquireFile' conf url = do
data Conf = Conf
{ arches :: [Arch]
, regex :: Regex
+ , roughRegex :: Regex
, regexS :: String -- A regex is not Show'able, so we need to keep the string
, offline :: Bool
, quiet :: Bool
}
mkConf :: [Arch] -> String -> Bool -> Bool -> Conf
-mkConf a r b1 b2 = Conf a (mkRegex r) r b1 b2
+mkConf a r b1 b2 =
+ Conf a (mkRegex ("^"++r++"$")) (mkRegex r) r b1 b2
parseArches :: String -> ReadM [Arch]
parseArches s =
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-haskell/tools.git
More information about the Pkg-haskell-commits
mailing list