Fix parsing "$topdir" in package config

[ghc-hetmet.git] / utils / ghc-pkg / Main.hs

diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index 8b8210d..52b7914 100644 (file)
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -104,6 +104,8 @@ data Flag
   | FlagForceFiles
   | FlagAutoGHCiLibs
   | FlagExpandEnvVars
   | FlagForceFiles
   | FlagAutoGHCiLibs
   | FlagExpandEnvVars

+  | FlagExpandPkgroot
+  | FlagNoExpandPkgroot

   | FlagSimpleOutput
   | FlagNamesOnly
   | FlagIgnoreCase
   | FlagSimpleOutput
   | FlagNamesOnly
   | FlagIgnoreCase

@@ -131,6 +133,10 @@ flags = [
         "automatically build libs for GHCi (with register)",
   Option [] ["expand-env-vars"] (NoArg FlagExpandEnvVars)
         "expand environment variables (${name}-style) in input package descriptions",
         "automatically build libs for GHCi (with register)",
   Option [] ["expand-env-vars"] (NoArg FlagExpandEnvVars)
         "expand environment variables (${name}-style) in input package descriptions",

+  Option [] ["expand-pkgroot"] (NoArg FlagExpandPkgroot)
+        "expand ${pkgroot}-relative paths to absolute in output package descriptions",
+  Option [] ["no-expand-pkgroot"] (NoArg FlagNoExpandPkgroot)
+        "preserve ${pkgroot}-relative paths in output package descriptions",

   Option ['?'] ["help"] (NoArg FlagHelp)
         "display this help and exit",
   Option ['V'] ["version"] (NoArg FlagVersion)
   Option ['?'] ["help"] (NoArg FlagHelp)
         "display this help and exit",
   Option ['V'] ["version"] (NoArg FlagVersion)

@@ -280,6 +286,11 @@ runit verbosity cli nonopts = do
           | otherwise                   = NoForce
         auto_ghci_libs = FlagAutoGHCiLibs `elem` cli
         expand_env_vars= FlagExpandEnvVars `elem` cli
           | otherwise                   = NoForce
         auto_ghci_libs = FlagAutoGHCiLibs `elem` cli
         expand_env_vars= FlagExpandEnvVars `elem` cli

+        mexpand_pkgroot= foldl' accumExpandPkgroot Nothing cli
+          where accumExpandPkgroot _ FlagExpandPkgroot   = Just True
+                accumExpandPkgroot _ FlagNoExpandPkgroot = Just False
+                accumExpandPkgroot x _                   = x
+                

         splitFields fields = unfoldr splitComma (',':fields)
           where splitComma "" = Nothing
                 splitComma fs = Just $ break (==',') (tail fs)
         splitFields fields = unfoldr splitComma (',':fields)
           where splitComma "" = Nothing
                 splitComma fs = Just $ break (==',') (tail fs)

@@ -348,23 +359,24 @@ runit verbosity cli nonopts = do
     ["latest", pkgid_str] -> do
         pkgid <- readGlobPkgId pkgid_str
         latestPackage verbosity cli pkgid
     ["latest", pkgid_str] -> do
         pkgid <- readGlobPkgId pkgid_str
         latestPackage verbosity cli pkgid

-    ["describe", pkgid_str] ->
-        case substringCheck pkgid_str of
-          Nothing -> do pkgid <- readGlobPkgId pkgid_str
-                        describePackage verbosity cli (Id pkgid)
-          Just m -> describePackage verbosity cli (Substring pkgid_str m)
-    ["field", pkgid_str, fields] ->
-        case substringCheck pkgid_str of
-          Nothing -> do pkgid <- readGlobPkgId pkgid_str
-                        describeField verbosity cli (Id pkgid) 
-                                      (splitFields fields)
-          Just m -> describeField verbosity cli (Substring pkgid_str m)
-                                      (splitFields fields)
+    ["describe", pkgid_str] -> do
+        pkgarg <- case substringCheck pkgid_str of
+          Nothing -> liftM Id (readGlobPkgId pkgid_str)
+          Just m  -> return (Substring pkgid_str m)
+        describePackage verbosity cli pkgarg (fromMaybe False mexpand_pkgroot)
+        
+    ["field", pkgid_str, fields] -> do
+        pkgarg <- case substringCheck pkgid_str of
+          Nothing -> liftM Id (readGlobPkgId pkgid_str)
+          Just m  -> return (Substring pkgid_str m)
+        describeField verbosity cli pkgarg
+                      (splitFields fields) (fromMaybe True mexpand_pkgroot)
+

     ["check"] -> do
         checkConsistency verbosity cli
 
     ["dump"] -> do
     ["check"] -> do
         checkConsistency verbosity cli
 
     ["dump"] -> do

-        dumpPackages verbosity cli
+        dumpPackages verbosity cli (fromMaybe False mexpand_pkgroot)

 
     ["recache"] -> do
         recache verbosity cli
 
     ["recache"] -> do
         recache verbosity cli

@@ -410,8 +422,16 @@ globVersion = Version{ versionBranch=[], versionTags=["*"] }
 --      list, describe, field
 
 data PackageDB 
 --      list, describe, field
 
 data PackageDB 

-  = PackageDB { location :: FilePath,
-                packages :: [InstalledPackageInfo] }
+  = PackageDB {
+      location, locationAbsolute :: !FilePath,
+      -- We need both possibly-relative and definately-absolute package
+      -- db locations. This is because the relative location is used as
+      -- an identifier for the db, so it is important we do not modify it.
+      -- On the other hand we need the absolute path in a few places
+      -- particularly in relation to the ${pkgroot} stuff.
+      
+      packages :: [InstalledPackageInfo]
+    }

 
 type PackageDBStack = [PackageDB]
         -- A stack of package databases.  Convention: head is the topmost
 
 type PackageDBStack = [PackageDB]
         -- A stack of package databases.  Convention: head is the topmost

@@ -530,7 +550,8 @@ getPkgDatabases verbosity modify use_cache expand_vars my_flags = do
 
   db_stack  <- sequence
     [ do db <- readParseDatabase verbosity mb_user_conf use_cache db_path
 
   db_stack  <- sequence
     [ do db <- readParseDatabase verbosity mb_user_conf use_cache db_path

-         if expand_vars then mungePackageDBPaths top_dir db else return db
+         if expand_vars then return (mungePackageDBPaths top_dir db)
+                        else return db

     | db_path <- final_stack ]
 
   let flag_db_stack = [ db | db_name <- flag_db_names,
     | db_path <- final_stack ]
 
   let flag_db_stack = [ db | db_name <- flag_db_names,

@@ -557,13 +578,13 @@ readParseDatabase :: Verbosity
 readParseDatabase verbosity mb_user_conf use_cache path
   -- the user database (only) is allowed to be non-existent
   | Just (user_conf,False) <- mb_user_conf, path == user_conf
 readParseDatabase verbosity mb_user_conf use_cache path
   -- the user database (only) is allowed to be non-existent
   | Just (user_conf,False) <- mb_user_conf, path == user_conf

-  = return PackageDB { location = path, packages = [] }
+  = mkPackageDB []

   | otherwise
   = do e <- tryIO $ getDirectoryContents path
        case e of
          Left _   -> do
               pkgs <- parseMultiPackageConf verbosity path
   | otherwise
   = do e <- tryIO $ getDirectoryContents path
        case e of
          Left _   -> do
               pkgs <- parseMultiPackageConf verbosity path

-              return PackageDB{ location = path, packages = pkgs }              
+              mkPackageDB pkgs

          Right fs
            | not use_cache -> ignore_cache
            | otherwise -> do
          Right fs
            | not use_cache -> ignore_cache
            | otherwise -> do

@@ -581,7 +602,7 @@ readParseDatabase verbosity mb_user_conf use_cache path
                         putStrLn ("using cache: " ++ cache)
                      pkgs <- myReadBinPackageDB cache
                      let pkgs' = map convertPackageInfoIn pkgs
                         putStrLn ("using cache: " ++ cache)
                      pkgs <- myReadBinPackageDB cache
                      let pkgs' = map convertPackageInfoIn pkgs

-                     return PackageDB { location = path, packages = pkgs' }
+                     mkPackageDB pkgs'

                   | otherwise -> do
                      when (verbosity >= Normal) $ do
                         warn ("WARNING: cache is out of date: " ++ cache)
                   | otherwise -> do
                      when (verbosity >= Normal) $ do
                         warn ("WARNING: cache is out of date: " ++ cache)

@@ -592,7 +613,15 @@ readParseDatabase verbosity mb_user_conf use_cache path
                      let confs = filter (".conf" `isSuffixOf`) fs
                      pkgs <- mapM (parseSingletonPackageConf verbosity) $
                                    map (path </>) confs
                      let confs = filter (".conf" `isSuffixOf`) fs
                      pkgs <- mapM (parseSingletonPackageConf verbosity) $
                                    map (path </>) confs

-                     return PackageDB { location = path, packages = pkgs }
+                     mkPackageDB pkgs
+  where
+    mkPackageDB pkgs = do
+      path_abs <- absolutePath path
+      return PackageDB {
+        location = path,
+        locationAbsolute = path_abs,
+        packages = pkgs
+      }

 
 -- read the package.cache file strictly, to work around a problem with
 -- bytestring 0.9.0.x (fixed in 0.9.1.x) where the file wasn't closed
 
 -- read the package.cache file strictly, to work around a problem with
 -- bytestring 0.9.0.x (fixed in 0.9.1.x) where the file wasn't closed

@@ -618,19 +647,21 @@ parseMultiPackageConf verbosity file = do
 parseSingletonPackageConf :: Verbosity -> FilePath -> IO InstalledPackageInfo
 parseSingletonPackageConf verbosity file = do
   when (verbosity > Normal) $ putStrLn ("reading package config: " ++ file)
 parseSingletonPackageConf :: Verbosity -> FilePath -> IO InstalledPackageInfo
 parseSingletonPackageConf verbosity file = do
   when (verbosity > Normal) $ putStrLn ("reading package config: " ++ file)

-  readUTF8File file >>= parsePackageInfo
+  readUTF8File file >>= fmap fst . parsePackageInfo

 
 cachefilename :: FilePath
 cachefilename = "package.cache"
 
 
 cachefilename :: FilePath
 cachefilename = "package.cache"
 

-mungePackageDBPaths :: FilePath -> PackageDB -> IO PackageDB
-mungePackageDBPaths top_dir db@PackageDB { packages = pkgs } = do
+mungePackageDBPaths :: FilePath -> PackageDB -> PackageDB
+mungePackageDBPaths top_dir db@PackageDB { packages = pkgs } =
+    db { packages = map (mungePackagePaths top_dir pkgroot) pkgs }
+  where
+    pkgroot = takeDirectory (locationAbsolute db)    

     -- It so happens that for both styles of package db ("package.conf"
     -- files and "package.conf.d" dirs) the pkgroot is the parent directory
     -- ${pkgroot}/package.conf  or  ${pkgroot}/package.conf.d/
     -- It so happens that for both styles of package db ("package.conf"
     -- files and "package.conf.d" dirs) the pkgroot is the parent directory
     -- ${pkgroot}/package.conf  or  ${pkgroot}/package.conf.d/

-    pkgroot <- absolutePath (takeDirectory (location db))
-    return db { packages = map (mungePackagePaths top_dir pkgroot) pkgs }

 
 

+-- TODO: This code is duplicated in compiler/main/Packages.lhs

 mungePackagePaths :: FilePath -> FilePath
                   -> InstalledPackageInfo -> InstalledPackageInfo
 -- Perform path/URL variable substitution as per the Cabal ${pkgroot} spec
 mungePackagePaths :: FilePath -> FilePath
                   -> InstalledPackageInfo -> InstalledPackageInfo
 -- Perform path/URL variable substitution as per the Cabal ${pkgroot} spec

@@ -648,36 +679,38 @@ mungePackagePaths top_dir pkgroot pkg =
       libraryDirs = munge_paths (libraryDirs pkg),
       frameworkDirs = munge_paths (frameworkDirs pkg),
       haddockInterfaces = munge_paths (haddockInterfaces pkg),
       libraryDirs = munge_paths (libraryDirs pkg),
       frameworkDirs = munge_paths (frameworkDirs pkg),
       haddockInterfaces = munge_paths (haddockInterfaces pkg),

-      haddockHTMLs = munge_urls (haddockHTMLs pkg)
+                     -- haddock-html is allowed to be either a URL or a file
+      haddockHTMLs = munge_paths (munge_urls (haddockHTMLs pkg))

     }
   where
     munge_paths = map munge_path
     munge_urls  = map munge_url
 
     munge_path p
     }
   where
     munge_paths = map munge_path
     munge_urls  = map munge_url
 
     munge_path p

-      | Just p' <- stripVarPrefix "${pkgroot}" sp = pkgroot </> p'
-      | Just p' <- stripVarPrefix "$topdir"    sp = top_dir </> p'
-      | otherwise                                 = p
-      where
-        sp = splitPath p
+      | Just p' <- stripVarPrefix "${pkgroot}" p = pkgroot ++ p'
+      | Just p' <- stripVarPrefix "$topdir"    p = top_dir ++ p'
+      | otherwise                                = p

 
     munge_url p
 
     munge_url p

-      | Just p' <- stripVarPrefix "${pkgrooturl}" sp = toUrlPath pkgroot p'
-      | Just p' <- stripVarPrefix "$httptopdir"   sp = toUrlPath top_dir p'
-      | otherwise                                    = p
-      where
-        sp = splitPath p
+      | Just p' <- stripVarPrefix "${pkgrooturl}" p = toUrlPath pkgroot p'
+      | Just p' <- stripVarPrefix "$httptopdir"   p = toUrlPath top_dir p'
+      | otherwise                                   = p

 
     toUrlPath r p = "file:///"
                  -- URLs always use posix style '/' separators:
 
     toUrlPath r p = "file:///"
                  -- URLs always use posix style '/' separators:

-                 ++ FilePath.Posix.joinPath (r : FilePath.splitDirectories p)
-
-    stripVarPrefix var (root:path')
-      | Just [sep] <- stripPrefix var root
-      , isPathSeparator sep
-      = Just (joinPath path')
+                 ++ FilePath.Posix.joinPath
+                        (r : -- We need to drop a leading "/" or "\\"
+                             -- if there is one:
+                             dropWhile (all isPathSeparator)
+                                       (FilePath.splitDirectories p))

 
 

-    stripVarPrefix _ _ = Nothing
+    -- We could drop the separator here, and then use </> above. However,
+    -- by leaving it in and using ++ we keep the same path separator
+    -- rather than letting FilePath change it to use \ as the separator
+    stripVarPrefix var path = case stripPrefix var path of
+                              Just [] -> Just []
+                              Just cs@(c : _) | isPathSeparator c -> Just cs
+                              _ -> Nothing

 
 
 -- -----------------------------------------------------------------------------
 
 
 -- -----------------------------------------------------------------------------

@@ -690,7 +723,11 @@ initPackageDB filename verbosity _flags = do
   when b1 eexist
   b2 <- doesDirectoryExist filename
   when b2 eexist
   when b1 eexist
   b2 <- doesDirectoryExist filename
   when b2 eexist

-  changeDB verbosity [] PackageDB{ location = filename, packages = [] }
+  filename_abs <- absolutePath filename
+  changeDB verbosity [] PackageDB {
+                          location = filename, locationAbsolute = filename_abs,
+                          packages = []
+                        }

 
 -- -----------------------------------------------------------------------------
 -- Registering
 
 -- -----------------------------------------------------------------------------
 -- Registering

@@ -730,10 +767,14 @@ registerPackage input verbosity my_flags auto_ghci_libs expand_env_vars update f
   expanded <- if expand_env_vars then expandEnvVars s force
                                  else return s
 
   expanded <- if expand_env_vars then expandEnvVars s force
                                  else return s
 

-  pkg <- parsePackageInfo expanded
+  (pkg, ws) <- parsePackageInfo expanded

   when (verbosity >= Normal) $
       putStrLn "done."
 
   when (verbosity >= Normal) $
       putStrLn "done."
 

+  -- report any warnings from the parse phase
+  _ <- reportValidateErrors [] ws
+         (display (sourcePackageId pkg) ++ ": Warning: ") Nothing
+

   -- validate the expanded pkg, but register the unexpanded
   pkgroot <- absolutePath (takeDirectory to_modify)
   let top_dir = takeDirectory (location (last db_stack))
   -- validate the expanded pkg, but register the unexpanded
   pkgroot <- absolutePath (takeDirectory to_modify)
   let top_dir = takeDirectory (location (last db_stack))

@@ -752,10 +793,13 @@ registerPackage input verbosity my_flags auto_ghci_libs expand_env_vars update f
 
 parsePackageInfo
         :: String
 
 parsePackageInfo
         :: String

-        -> IO InstalledPackageInfo
+        -> IO (InstalledPackageInfo, [ValidateWarning])

 parsePackageInfo str =
   case parseInstalledPackageInfo str of
 parsePackageInfo str =
   case parseInstalledPackageInfo str of

-    ParseOk _warns ok -> return ok
+    ParseOk warnings ok -> return (ok, ws)
+      where
+        ws = [ msg | PWarning msg <- warnings
+                   , not ("Unrecognized field pkgroot" `isPrefixOf` msg) ]

     ParseFailed err -> case locatedErrorMsg err of
                            (Nothing, s) -> die s
                            (Just l, s) -> die (show l ++ ": " ++ s)
     ParseFailed err -> case locatedErrorMsg err of
                            (Nothing, s) -> die s
                            (Just l, s) -> die (show l ++ ": " ++ s)

@@ -1005,24 +1049,33 @@ latestPackage verbosity my_flags pkgid = do
 -- -----------------------------------------------------------------------------
 -- Describe
 
 -- -----------------------------------------------------------------------------
 -- Describe
 

-describePackage :: Verbosity -> [Flag] -> PackageArg -> IO ()
-describePackage verbosity my_flags pkgarg = do
+describePackage :: Verbosity -> [Flag] -> PackageArg -> Bool -> IO ()
+describePackage verbosity my_flags pkgarg expand_pkgroot = do

   (_, _, flag_db_stack) <- 
   (_, _, flag_db_stack) <- 

-      getPkgDatabases verbosity False True{-use cache-} True{-expand vars-} my_flags
-  ps <- findPackages flag_db_stack pkgarg
-  doDump ps
+      getPkgDatabases verbosity False True{-use cache-} expand_pkgroot my_flags
+  dbs <- findPackagesByDB flag_db_stack pkgarg
+  doDump expand_pkgroot [ (pkg, locationAbsolute db)
+                        | (db, pkgs) <- dbs, pkg <- pkgs ]

 
 

-dumpPackages :: Verbosity -> [Flag] -> IO ()
-dumpPackages verbosity my_flags = do
+dumpPackages :: Verbosity -> [Flag] -> Bool -> IO ()
+dumpPackages verbosity my_flags expand_pkgroot = do

   (_, _, flag_db_stack) <- 
   (_, _, flag_db_stack) <- 

-     getPkgDatabases verbosity False True{-use cache-} False{-expand vars-} my_flags
-  doDump (allPackagesInStack flag_db_stack)
+     getPkgDatabases verbosity False True{-use cache-} expand_pkgroot my_flags
+  doDump expand_pkgroot [ (pkg, locationAbsolute db)
+                        | db <- flag_db_stack, pkg <- packages db ]

 
 

-doDump :: [InstalledPackageInfo] -> IO ()
-doDump pkgs = do
+doDump :: Bool -> [(InstalledPackageInfo, FilePath)] -> IO ()
+doDump expand_pkgroot pkgs = do

   -- fix the encoding to UTF-8, since this is an interchange format
   hSetEncoding stdout utf8
   -- fix the encoding to UTF-8, since this is an interchange format
   hSetEncoding stdout utf8

-  mapM_ putStrLn . intersperse "---" . map showInstalledPackageInfo $ pkgs
+  putStrLn $
+    intercalate "---\n"
+    [ if expand_pkgroot
+        then showInstalledPackageInfo pkg
+        else showInstalledPackageInfo pkg ++ pkgrootField
+    | (pkg, pkgloc) <- pkgs
+    , let pkgroot      = takeDirectory pkgloc
+          pkgrootField = "pkgroot: " ++ pkgroot ++ "\n" ]

 
 -- PackageId is can have globVersion for the version
 findPackages :: PackageDBStack -> PackageArg -> IO [InstalledPackageInfo]
 
 -- PackageId is can have globVersion for the version
 findPackages :: PackageDBStack -> PackageArg -> IO [InstalledPackageInfo]

@@ -1061,10 +1114,10 @@ compPkgIdVer p1 p2 = pkgVersion p1 `compare` pkgVersion p2
 -- -----------------------------------------------------------------------------
 -- Field
 
 -- -----------------------------------------------------------------------------
 -- Field
 

-describeField :: Verbosity -> [Flag] -> PackageArg -> [String] -> IO ()
-describeField verbosity my_flags pkgarg fields = do
+describeField :: Verbosity -> [Flag] -> PackageArg -> [String] -> Bool -> IO ()
+describeField verbosity my_flags pkgarg fields expand_pkgroot = do

   (_, _, flag_db_stack) <- 
   (_, _, flag_db_stack) <- 

-      getPkgDatabases verbosity False True{-use cache-} True{-expand vars-} my_flags
+      getPkgDatabases verbosity False True{-use cache-} expand_pkgroot my_flags

   fns <- toFields fields
   ps <- findPackages flag_db_stack pkgarg
   mapM_ (selectFields fns) ps
   fns <- toFields fields
   ps <- findPackages flag_db_stack pkgarg
   mapM_ (selectFields fns) ps

@@ -1274,6 +1327,9 @@ checkPackageConfig pkg db_stack auto_ghci_libs update = do
   mapM_ (checkDir False "import-dirs")  (importDirs pkg)
   mapM_ (checkDir True  "library-dirs") (libraryDirs pkg)
   mapM_ (checkDir True  "include-dirs") (includeDirs pkg)
   mapM_ (checkDir False "import-dirs")  (importDirs pkg)
   mapM_ (checkDir True  "library-dirs") (libraryDirs pkg)
   mapM_ (checkDir True  "include-dirs") (includeDirs pkg)

+  mapM_ (checkDir True  "framework-dirs") (frameworkDirs pkg)
+  mapM_ (checkFile   True "haddock-interfaces") (haddockInterfaces pkg)
+  mapM_ (checkDirURL True "haddock-html")       (haddockHTMLs pkg)

   checkModules pkg
   mapM_ (checkHSLib (libraryDirs pkg) auto_ghci_libs) (hsLibraries pkg)
   -- ToDo: check these somehow?
   checkModules pkg
   mapM_ (checkHSLib (libraryDirs pkg) auto_ghci_libs) (hsLibraries pkg)
   -- ToDo: check these somehow?

@@ -1325,18 +1381,34 @@ checkDuplicates db_stack pkg update = do
         "Package " ++ display pkgid ++
         " overlaps with: " ++ unwords (map display dups)
 
         "Package " ++ display pkgid ++
         " overlaps with: " ++ unwords (map display dups)
 

-checkDir :: Bool -> String -> FilePath -> Validate ()
-checkDir warn_only thisfield d
-   -- Note: we don't check for $topdir/${pkgroot} here. We relies on these
+checkDir, checkFile, checkDirURL :: Bool -> String -> FilePath -> Validate ()
+checkDir  = checkPath False True
+checkFile = checkPath False False
+checkDirURL = checkPath True True
+
+checkPath :: Bool -> Bool -> Bool -> String -> FilePath -> Validate ()
+checkPath url_ok is_dir warn_only thisfield d
+ | url_ok && ("http://"  `isPrefixOf` d
+           || "https://" `isPrefixOf` d) = return ()
+
+ | url_ok
+ , Just d' <- stripPrefix "file://" d
+ = checkPath False is_dir warn_only thisfield d'
+
+   -- Note: we don't check for $topdir/${pkgroot} here. We rely on these

    -- variables having been expanded already, see mungePackagePaths.
 
  | isRelative d = verror ForceFiles $
    -- variables having been expanded already, see mungePackagePaths.
 
  | isRelative d = verror ForceFiles $

-                     thisfield ++ ": " ++ d ++ " is a relative path"
+                     thisfield ++ ": " ++ d ++ " is a relative path which "
+                  ++ "makes no sense (as there is nothing for it to be "
+                  ++ "relative to). You can make paths relative to the "
+                  ++ "package database itself by using ${pkgroot}."

         -- relative paths don't make any sense; #4134
  | otherwise = do
         -- relative paths don't make any sense; #4134
  | otherwise = do

-   there <- liftIO $ doesDirectoryExist d
+   there <- liftIO $ if is_dir then doesDirectoryExist d else doesFileExist d

    when (not there) $
    when (not there) $

-       let msg = thisfield ++ ": " ++ d ++ " doesn't exist or isn't a directory"
+       let msg = thisfield ++ ": " ++ d ++ " doesn't exist or isn't a "
+                                        ++ if is_dir then "directory" else "file"

        in
        if warn_only 
           then vwarn msg
        in
        if warn_only 
           then vwarn msg

@@ -1375,10 +1447,7 @@ doesFileExistOnPath file path = go path
                        if b then return (Just p) else go ps
 
 doesFileExistIn :: String -> String -> IO Bool
                        if b then return (Just p) else go ps
 
 doesFileExistIn :: String -> String -> IO Bool

-doesFileExistIn lib d
- | "$topdir"     `isPrefixOf` d = return True
- | "$httptopdir" `isPrefixOf` d = return True
- | otherwise                = doesFileExist (d </> lib)
+doesFileExistIn lib d = doesFileExist (d </> lib)

 
 checkModules :: InstalledPackageInfo -> Validate ()
 checkModules pkg = do
 
 checkModules :: InstalledPackageInfo -> Validate ()
 checkModules pkg = do