Permalink
Browse files

Improve finding of packages installed in old GHC

Now we don't have to keep a list of non-GHC libraries that start with
"ghc-" updated, as we use the presence of a version number to
determine if the given directory is a GHC install.

Note that this won't work if there exists a package of the form
"ghc-3foo-3.6.3", as it is assumed that if the first character after
the "ghc-" (or "ghc-bin-") is a digit, then it is in fact the version
string and thus this is a GHC library directory.
  • Loading branch information...
1 parent 6aefddc commit 18b35a52c6918d73fcb71a6da049cb71f428748f @ivan-m ivan-m committed Nov 16, 2009
Showing with 28 additions and 17 deletions.
  1. +28 −17 Distribution/Gentoo/GHC.hs
View
@@ -42,7 +42,7 @@ import Data.Maybe(Maybe(..), maybe, fromJust)
import qualified Data.Map as Map
import Data.Map(Map)
import qualified Data.ByteString.Char8 as BS
-import System.FilePath((</>), takeExtension)
+import System.FilePath((</>), takeExtension, pathSeparator)
import System.Directory( canonicalizePath
, doesDirectoryExist
, findExecutable)
@@ -120,29 +120,40 @@ oldGhcPkgs = do putStrLn "\nSearching for packages installed with a \
-- Find packages installed by other versions of GHC in this possible
-- library directory.
-checkLibDir :: BSFilePath -> FilePath -> IO [Package]
+checkLibDir :: BSFilePath -> BSFilePath -> IO [Package]
checkLibDir thisGhc libDir = pkgsHaveContent (hasDirMatching wanted)
where
wanted dir = isValid dir && (not . isInvalid) dir
- isValid = BS.isPrefixOf (BS.pack $ libDir </> allowedDir)
- allowedDir = "ghc"
+ isValid = isGhcLibDir libDir
+
+ -- Invalid if it's this GHC
+ isInvalid = BS.isPrefixOf thisGhc
+
+-- A valid GHC library directory starting at libdir has a name of
+-- either "ghc" or "ghc-bin", then a hyphen and then a version number.
+isGhcLibDir :: BSFilePath -> BSFilePath -> Bool
+isGhcLibDir libdir dir = go ghcDirName || go ghcBinDirName
+ where
+ -- This is hacky because FilePath doesn't work on Bytestrings...
+ libdir' = BS.snoc libdir pathSeparator
+ ghcDirName = BS.pack "ghc"
+ ghcBinDirName = BS.pack "ghc-bin"
+
+ go dn = BS.isPrefixOf ghcDir dir
+ -- Any possible version starts with a digit
+ && isDigit (BS.index dir ghcDirLen)
+ where
+ ghcDir = flip BS.snoc '-' $ BS.append libdir' dn
+ ghcDirLen = BS.length ghcDir
- isInvalid dir = any (flip BS.isPrefixOf dir)
- $ thisGhc : map (BS.pack . (</>) libDir) disAllowedDirs
- -- Use a list here in case we have to add more later
- disAllowedDirs = map ("ghc-" ++)
- [ "events"
- , "mtl"
- , "paths"
- , "syb"
- ]
-- The possible places GHC could have installed lib directories
-libFronts :: [FilePath]
-libFronts = do loc <- ["usr", "opt" </> "ghc"]
- lib <- ["lib", "lib64"]
- return $ "/" </> loc </> lib
+libFronts :: [BSFilePath]
+libFronts = map BS.pack
+ $ do loc <- ["usr", "opt" </> "ghc"]
+ lib <- ["lib", "lib64"]
+ return $ "/" </> loc </> lib
-- -----------------------------------------------------------------------------

0 comments on commit 18b35a5

Please sign in to comment.