Commit 9bf22f8f authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Make package searches ~100x faster but less featurefull

Instead of parsing every .cabal file in the package list (which is very slow)
We now just get the package name and version and do a case-insensitive
substring search on the package name. The output format remains unchanged.
So we no longer search inside package descriptions.
parent ff6bf5d9
......@@ -20,13 +20,13 @@ import Prelude hiding (catch)
import Control.Exception (catch, Exception(IOException))
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.ByteString.Lazy.Char8 (ByteString)
import System.FilePath ((</>), takeExtension)
import System.FilePath ((</>), takeExtension, splitDirectories, normalise)
import System.IO (hPutStrLn, stderr)
import System.IO.Error (isDoesNotExistError)
import Distribution.PackageDescription (parsePackageDescription, ParseResult(..))
import Distribution.Package (PackageIdentifier(..))
import Distribution.Version (readVersion)
getKnownPackages :: ConfigFlags -> IO [PkgInfo]
getKnownPackages cfg
......@@ -46,10 +46,19 @@ parseRepoIndex :: Repo -> ByteString -> [PkgInfo]
parseRepoIndex repo s =
do (hdr, content) <- readTarArchive s
if takeExtension (tarFileName hdr) == ".cabal"
then case parsePackageDescription (BS.unpack content) of
ParseOk _ descr -> return $ PkgInfo {
pkgRepo = repo,
pkgDesc = descr
}
_ -> error $ "Couldn't read cabal file " ++ show (tarFileName hdr)
else fail "Not a .cabal file"
\ No newline at end of file
then case splitDirectories (normalise (tarFileName hdr)) of
[pkgname,vers,_] ->
let descr = case parsePackageDescription (BS.unpack content) of
ParseOk _ d -> d
_ -> error $ "Couldn't read cabal file "
++ show (tarFileName hdr)
in case readVersion vers of
Just ver ->
return $ PkgInfo {
pkgInfoId = PackageIdentifier pkgname ver,
pkgRepo = repo,
pkgDesc = descr
}
_ -> []
_ -> []
else []
......@@ -162,4 +162,4 @@ installUnpackedPkg cfg comp globalArgs pkgId opts mpath
= do let cmdOps = mkPkgOps cfg comp pkgId cmd (globalArgs++opts)
message cfg verbose $
unwords ["setupWrapper", show (cmd:cmdOps), show mpath]
setupWrapper (cmd:cmdOps) mpath
\ No newline at end of file
setupWrapper (cmd:cmdOps) mpath
......@@ -30,29 +30,32 @@ list :: ConfigFlags -> [String] -> IO ()
list cfg pats = do
pkgs <- getKnownPackages cfg
let pkgs' | null pats = pkgs
| otherwise = nubBy samePackage (concatMap (findInPkgs pkgs) pats)
mapM_ doList (groupBy sameName (sortBy (comparing nameAndVersion) pkgs'))
where
| otherwise = nubBy samePackage (concatMap (findInPkgs pkgs) pats')
pats' = map lcase pats
putStrLn
. unlines
. map (showPkgVersions . map (packageDescription . pkgDesc))
. groupBy sameName
. sortBy (comparing nameAndVersion)
$ pkgs'
where
findInPkgs :: [PkgInfo] -> String -> [PkgInfo]
findInPkgs pkgs pat = let rx = mkRegexWithOpts pat False False in
filter (isJust . matchRegex rx . showInfo) pkgs
showInfo :: PkgInfo -> String
showInfo pkg = showPackageId (package d) ++ "\n" ++ synopsis d
where d = packageDescription (pkgDesc pkg)
nameAndVersion p = (map Char.toLower name, name, version)
where d = packageDescription (pkgDesc p)
name = pkgName (package d)
version = pkgVersion (package d)
findInPkgs pkgs pat =
filter (isInfixOf pat . lcase . pkgName . pkgInfoId) pkgs
lcase = map Char.toLower
nameAndVersion p = (lcase name, name, version)
where name = pkgName (pkgInfoId p)
version = pkgVersion (pkgInfoId p)
samePackage a b = nameAndVersion a == nameAndVersion b
sameName a b = pkgName (pkgInfoId a) == pkgName (pkgInfoId b)
doList :: [PkgInfo] -> IO ()
doList ps = do
putStr $ padTo 35 $ pkgName (package d) ++ " [" ++ concat (intersperse ", " versions) ++ "]"
putStrLn syn
where
info = last ps
d = packageDescription (pkgDesc info)
syn = synopsis d
versions = map (showVersion . pkgVersion . package . packageDescription . pkgDesc) ps
showPkgVersions :: [PackageDescription] -> String
showPkgVersions pkgs =
padTo 35 (pkgName (package pkg)
++ " [" ++ concat (intersperse ", " versions) ++ "] ")
++ synopsis pkg
where
pkg = last pkgs
versions = map (showVersion . pkgVersion . package) pkgs
padTo n s = s ++ (replicate (n - length s) ' ')
......@@ -15,21 +15,19 @@ module Hackage.Types where
import Distribution.Simple.Compiler (CompilerFlavor)
import Distribution.Simple.InstallDirs (InstallDirTemplates)
import Distribution.Package (PackageIdentifier)
import Distribution.PackageDescription (GenericPackageDescription, packageDescription, package)
import Distribution.PackageDescription (GenericPackageDescription)
import Distribution.Version (Dependency)
import Distribution.Verbosity
-- | We re-use @GenericPackageDescription@ and use the @package-url@
-- field to store the tarball URL.
data PkgInfo = PkgInfo {
pkgInfoId :: PackageIdentifier,
pkgRepo :: Repo,
pkgDesc :: GenericPackageDescription
}
deriving (Show)
pkgInfoId :: PkgInfo -> PackageIdentifier
pkgInfoId = package . packageDescription . pkgDesc
data Action
= FetchCmd
| InstallCmd
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment