Improve the "could not find module" error message
[ghc.git] / compiler / main / Finder.lhs
1 %
2 % (c) The University of Glasgow, 2000-2006
3 %
4 \section[Finder]{Module Finder}
5
6 \begin{code}
7 module Finder (
8     flushFinderCaches,
9     FindResult(..),
10     findImportedModule,
11     findExactModule,
12     findHomeModule,
13     mkHomeModLocation,
14     mkHomeModLocation2,
15     addHomeModuleToFinder,
16     uncacheModule,
17     mkStubPaths,
18
19     findObjectLinkableMaybe,
20     findObjectLinkable,
21
22     cannotFindModule,
23     cannotFindInterface,
24   ) where
25
26 #include "HsVersions.h"
27
28 import Module
29 import HscTypes
30 import Packages
31 import FastString
32 import Util
33 import PrelNames        ( gHC_PRIM )
34 import DynFlags         ( DynFlags(..), isOneShot, GhcMode(..) )
35 import Outputable
36 import FiniteMap
37 import UniqFM
38 import Maybes           ( expectJust )
39
40 import DATA_IOREF       ( IORef, writeIORef, readIORef, modifyIORef )
41
42 import Data.List
43 import System.Directory
44 import System.IO
45 import Control.Monad
46 import Time             ( ClockTime )
47
48
49 type FileExt = String   -- Filename extension
50 type BaseName = String  -- Basename of file
51
52 -- -----------------------------------------------------------------------------
53 -- The Finder
54
55 -- The Finder provides a thin filesystem abstraction to the rest of
56 -- the compiler.  For a given module, it can tell you where the
57 -- source, interface, and object files for that module live.
58
59 -- It does *not* know which particular package a module lives in.  Use
60 -- Packages.lookupModuleInAllPackages for that.
61
62 -- -----------------------------------------------------------------------------
63 -- The finder's cache
64
65 -- remove all the home modules from the cache; package modules are
66 -- assumed to not move around during a session.
67 flushFinderCaches :: HscEnv -> IO ()
68 flushFinderCaches hsc_env = do
69   writeIORef fc_ref emptyUFM
70   flushModLocationCache this_pkg mlc_ref
71  where
72         this_pkg = thisPackage (hsc_dflags hsc_env)
73         fc_ref = hsc_FC hsc_env
74         mlc_ref = hsc_MLC hsc_env
75
76 flushModLocationCache :: PackageId -> IORef ModLocationCache -> IO ()
77 flushModLocationCache this_pkg ref = do
78   fm <- readIORef ref
79   writeIORef ref $! filterFM is_ext fm
80   return ()
81   where is_ext mod _ | modulePackageId mod /= this_pkg = True
82                      | otherwise = False
83
84 addToFinderCache       ref key val = modifyIORef ref $ \c -> addToUFM c key val
85 addToModLocationCache  ref key val = modifyIORef ref $ \c -> addToFM c key val
86
87 removeFromFinderCache      ref key = modifyIORef ref $ \c -> delFromUFM c key
88 removeFromModLocationCache ref key = modifyIORef ref $ \c -> delFromFM c key
89
90 lookupFinderCache ref key = do 
91    c <- readIORef ref
92    return $! lookupUFM c key
93
94 lookupModLocationCache ref key = do
95    c <- readIORef ref
96    return $! lookupFM c key
97
98 -- -----------------------------------------------------------------------------
99 -- The two external entry points
100
101 -- | Locate a module that was imported by the user.  We have the
102 -- module's name, and possibly a package name.  Without a package
103 -- name, this function will use the search path and the known exposed
104 -- packages to find the module, if a package is specified then only
105 -- that package is searched for the module.
106
107 findImportedModule :: HscEnv -> ModuleName -> Maybe PackageId -> IO FindResult
108 findImportedModule hsc_env mod_name mb_pkgid =
109   case mb_pkgid of
110         Nothing                    -> unqual_import
111         Just pkg | pkg == this_pkg -> home_import
112                  | otherwise       -> pkg_import pkg
113   where
114     dflags = hsc_dflags hsc_env
115     this_pkg = thisPackage dflags
116
117     home_import     = findHomeModule hsc_env mod_name
118
119     pkg_import pkg  = findPackageModule hsc_env (mkModule pkg mod_name)
120                         -- ToDo: this isn't quite right, the module we want
121                         -- might actually be in another package, but re-exposed
122                         -- ToDo: should return NotFoundInPackage if
123                         -- the module isn't exposed by the package.
124
125     unqual_import   = home_import 
126                         `orIfNotFound`
127                       findExposedPackageModule hsc_env mod_name
128
129 -- | Locate a specific 'Module'.  The purpose of this function is to
130 -- create a 'ModLocation' for a given 'Module', that is to find out
131 -- where the files associated with this module live.  It is used when
132 -- reading the interface for a module mentioned by another interface, 
133 -- for example (a "system import").
134
135 findExactModule :: HscEnv -> Module -> IO FindResult
136 findExactModule hsc_env mod =
137    let dflags = hsc_dflags hsc_env in
138    if modulePackageId mod == thisPackage dflags
139         then findHomeModule hsc_env (moduleName mod)
140         else findPackageModule hsc_env mod
141
142 -- -----------------------------------------------------------------------------
143 -- Helpers
144
145 this `orIfNotFound` or_this = do
146   res <- this
147   case res of
148     NotFound here _ -> do
149         res2 <- or_this
150         case res2 of
151            NotFound or_here pkg -> return (NotFound (here ++ or_here) pkg)
152            _other -> return res2
153     _other -> return res
154
155
156 homeSearchCache :: HscEnv -> ModuleName -> IO FindResult -> IO FindResult
157 homeSearchCache hsc_env mod_name do_this = do
158   m <- lookupFinderCache (hsc_FC hsc_env) mod_name
159   case m of 
160     Just result -> return result
161     Nothing     -> do
162         result <- do_this
163         addToFinderCache (hsc_FC hsc_env) mod_name result
164         case result of
165            Found loc mod -> addToModLocationCache (hsc_MLC hsc_env) mod loc
166            _other        -> return ()
167         return result
168
169 findExposedPackageModule :: HscEnv -> ModuleName -> IO FindResult
170 findExposedPackageModule hsc_env mod_name
171         -- not found in any package:
172   | null found = return (NotFound [] Nothing)
173         -- found in just one exposed package:
174   | [(pkg_conf, _)] <- found_exposed
175         = let pkgid = mkPackageId (package pkg_conf) in      
176           findPackageModule_ hsc_env (mkModule pkgid mod_name) pkg_conf
177         -- not found in any exposed package, report how it was hidden:
178   | null found_exposed, ((pkg_conf, exposed_mod):_) <- found
179         = let pkgid = mkPackageId (package pkg_conf) in
180           if not (exposed_mod)
181                 then return (ModuleHidden pkgid)
182                 else return (PackageHidden pkgid)
183   | otherwise
184         = return (FoundMultiple (map (mkPackageId.package.fst) found_exposed))
185   where
186         dflags = hsc_dflags hsc_env
187         found = lookupModuleInAllPackages dflags mod_name
188         found_exposed = filter is_exposed found
189         is_exposed (pkg_conf,exposed_mod) = exposed pkg_conf && exposed_mod
190
191
192 modLocationCache :: HscEnv -> Module -> IO FindResult -> IO FindResult
193 modLocationCache hsc_env mod do_this = do
194   mb_loc <- lookupModLocationCache mlc mod
195   case mb_loc of
196      Just loc -> return (Found loc mod)
197      Nothing  -> do
198         result <- do_this
199         case result of
200             Found loc mod -> addToModLocationCache (hsc_MLC hsc_env) mod loc
201             _other -> return ()
202         return result
203   where
204     mlc = hsc_MLC hsc_env
205
206 addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module
207 addHomeModuleToFinder hsc_env mod_name loc = do
208   let mod = mkModule (thisPackage (hsc_dflags hsc_env)) mod_name
209   addToFinderCache (hsc_FC hsc_env) mod_name (Found loc mod)
210   addToModLocationCache (hsc_MLC hsc_env) mod loc
211   return mod
212
213 uncacheModule :: HscEnv -> ModuleName -> IO ()
214 uncacheModule hsc_env mod = do
215   let this_pkg = thisPackage (hsc_dflags hsc_env)
216   removeFromFinderCache (hsc_FC hsc_env) mod
217   removeFromModLocationCache (hsc_MLC hsc_env) (mkModule this_pkg mod)
218
219 -- -----------------------------------------------------------------------------
220 --      The internal workers
221
222 -- | Search for a module in the home package only.
223 findHomeModule :: HscEnv -> ModuleName -> IO FindResult
224 findHomeModule hsc_env mod_name =
225    homeSearchCache hsc_env mod_name $
226    let 
227      dflags = hsc_dflags hsc_env
228      home_path = importPaths dflags
229      hisuf = hiSuf dflags
230      mod = mkModule (thisPackage dflags) mod_name
231
232      source_exts = 
233       [ ("hs",   mkHomeModLocationSearched dflags mod_name "hs")
234       , ("lhs",  mkHomeModLocationSearched dflags mod_name "lhs")
235       ]
236      
237      hi_exts = [ (hisuf,                mkHiOnlyModLocation dflags hisuf)
238                , (addBootSuffix hisuf,  mkHiOnlyModLocation dflags hisuf)
239                ]
240      
241         -- In compilation manager modes, we look for source files in the home
242         -- package because we can compile these automatically.  In one-shot
243         -- compilation mode we look for .hi and .hi-boot files only.
244      exts | isOneShot (ghcMode dflags) = hi_exts
245           | otherwise                  = source_exts
246    in
247    searchPathExts home_path mod exts
248
249
250 -- | Search for a module in external packages only.
251 findPackageModule :: HscEnv -> Module -> IO FindResult
252 findPackageModule hsc_env mod = do
253   let
254         dflags = hsc_dflags hsc_env
255         pkg_id = modulePackageId mod
256         pkg_map = pkgIdMap (pkgState dflags)
257   --
258   case lookupPackage pkg_map pkg_id of
259      Nothing -> return (NoPackage pkg_id)
260      Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf
261       
262 findPackageModule_ hsc_env mod pkg_conf = 
263   modLocationCache hsc_env mod $
264
265   -- special case for GHC.Prim; we won't find it in the filesystem.
266   if mod == gHC_PRIM 
267         then return (Found (error "GHC.Prim ModLocation") mod)
268         else 
269
270   let
271      dflags = hsc_dflags hsc_env
272      tag = buildTag dflags
273
274            -- hi-suffix for packages depends on the build tag.
275      package_hisuf | null tag  = "hi"
276                    | otherwise = tag ++ "_hi"
277      hi_exts =
278         [ (package_hisuf, mkHiOnlyModLocation dflags package_hisuf) ]
279
280      source_exts = 
281        [ ("hs",   mkHiOnlyModLocation dflags package_hisuf)
282        , ("lhs",  mkHiOnlyModLocation dflags package_hisuf)
283        ]
284
285      -- mkdependHS needs to look for source files in packages too, so
286      -- that we can make dependencies between package before they have
287      -- been built.
288      exts 
289       | MkDepend <- ghcMode dflags = hi_exts ++ source_exts
290       | otherwise                  = hi_exts
291       -- we never look for a .hi-boot file in an external package;
292       -- .hi-boot files only make sense for the home package.
293   in
294   searchPathExts (importDirs pkg_conf) mod exts
295
296 -- -----------------------------------------------------------------------------
297 -- General path searching
298
299 searchPathExts
300   :: [FilePath]         -- paths to search
301   -> Module             -- module name
302   -> [ (
303         FileExt,                                -- suffix
304         FilePath -> BaseName -> IO ModLocation  -- action
305        )
306      ] 
307   -> IO FindResult
308
309 searchPathExts paths mod exts 
310    = do result <- search to_search
311 {-
312         hPutStrLn stderr (showSDoc $
313                 vcat [text "Search" <+> ppr mod <+> sep (map (text. fst) exts)
314                     , nest 2 (vcat (map text paths))
315                     , case result of
316                         Succeeded (loc, p) -> text "Found" <+> ppr loc
317                         Failed fs          -> text "not found"])
318 -}      
319         return result
320
321   where
322     basename = dots_to_slashes (moduleNameString (moduleName mod))
323
324     to_search :: [(FilePath, IO ModLocation)]
325     to_search = [ (file, fn path basename)
326                 | path <- paths, 
327                   (ext,fn) <- exts,
328                   let base | path == "." = basename
329                            | otherwise   = path `joinFileName` basename
330                       file = base `joinFileExt` ext
331                 ]
332
333     search [] = return (NotFound (map fst to_search) (Just (modulePackageId mod)))
334     search ((file, mk_result) : rest) = do
335       b <- doesFileExist file
336       if b 
337         then do { loc <- mk_result; return (Found loc mod) }
338         else search rest
339
340 mkHomeModLocationSearched :: DynFlags -> ModuleName -> FileExt
341                           -> FilePath -> BaseName -> IO ModLocation
342 mkHomeModLocationSearched dflags mod suff path basename = do
343    mkHomeModLocation2 dflags mod (path `joinFileName` basename) suff
344
345 -- -----------------------------------------------------------------------------
346 -- Constructing a home module location
347
348 -- This is where we construct the ModLocation for a module in the home
349 -- package, for which we have a source file.  It is called from three
350 -- places:
351 --
352 --  (a) Here in the finder, when we are searching for a module to import,
353 --      using the search path (-i option).
354 --
355 --  (b) The compilation manager, when constructing the ModLocation for
356 --      a "root" module (a source file named explicitly on the command line
357 --      or in a :load command in GHCi).
358 --
359 --  (c) The driver in one-shot mode, when we need to construct a
360 --      ModLocation for a source file named on the command-line.
361 --
362 -- Parameters are:
363 --
364 -- mod
365 --      The name of the module
366 --
367 -- path
368 --      (a): The search path component where the source file was found.
369 --      (b) and (c): "."
370 --
371 -- src_basename
372 --      (a): dots_to_slashes (moduleNameUserString mod)
373 --      (b) and (c): The filename of the source file, minus its extension
374 --
375 -- ext
376 --      The filename extension of the source file (usually "hs" or "lhs").
377
378 mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO ModLocation
379 mkHomeModLocation dflags mod src_filename = do
380    let (basename,extension) = splitFilename src_filename
381    mkHomeModLocation2 dflags mod basename extension
382
383 mkHomeModLocation2 :: DynFlags
384                    -> ModuleName
385                    -> FilePath  -- Of source module, without suffix
386                    -> String    -- Suffix
387                    -> IO ModLocation
388 mkHomeModLocation2 dflags mod src_basename ext = do
389    let mod_basename = dots_to_slashes (moduleNameString mod)
390
391    obj_fn  <- mkObjPath  dflags src_basename mod_basename
392    hi_fn   <- mkHiPath   dflags src_basename mod_basename
393
394    return (ModLocation{ ml_hs_file   = Just (src_basename `joinFileExt` ext),
395                         ml_hi_file   = hi_fn,
396                         ml_obj_file  = obj_fn })
397
398 mkHiOnlyModLocation :: DynFlags -> Suffix -> FilePath -> String
399                     -> IO ModLocation
400 mkHiOnlyModLocation dflags hisuf path basename
401  = do let full_basename = path `joinFileName` basename
402       obj_fn  <- mkObjPath  dflags full_basename basename
403       return ModLocation{    ml_hs_file   = Nothing,
404                              ml_hi_file   = full_basename  `joinFileExt` hisuf,
405                                 -- Remove the .hi-boot suffix from
406                                 -- hi_file, if it had one.  We always
407                                 -- want the name of the real .hi file
408                                 -- in the ml_hi_file field.
409                              ml_obj_file  = obj_fn
410                   }
411
412 -- | Constructs the filename of a .o file for a given source file.
413 -- Does /not/ check whether the .o file exists
414 mkObjPath
415   :: DynFlags
416   -> FilePath           -- the filename of the source file, minus the extension
417   -> String             -- the module name with dots replaced by slashes
418   -> IO FilePath
419 mkObjPath dflags basename mod_basename
420   = do  let
421                 odir = objectDir dflags
422                 osuf = objectSuf dflags
423         
424                 obj_basename | Just dir <- odir = dir `joinFileName` mod_basename
425                              | otherwise        = basename
426
427         return (obj_basename `joinFileExt` osuf)
428
429 -- | Constructs the filename of a .hi file for a given source file.
430 -- Does /not/ check whether the .hi file exists
431 mkHiPath
432   :: DynFlags
433   -> FilePath           -- the filename of the source file, minus the extension
434   -> String             -- the module name with dots replaced by slashes
435   -> IO FilePath
436 mkHiPath dflags basename mod_basename
437   = do  let
438                 hidir = hiDir dflags
439                 hisuf = hiSuf dflags
440
441                 hi_basename | Just dir <- hidir = dir `joinFileName` mod_basename
442                             | otherwise         = basename
443
444         return (hi_basename `joinFileExt` hisuf)
445
446
447 -- -----------------------------------------------------------------------------
448 -- Filenames of the stub files
449
450 -- We don't have to store these in ModLocations, because they can be derived
451 -- from other available information, and they're only rarely needed.
452
453 mkStubPaths
454   :: DynFlags
455   -> ModuleName
456   -> ModLocation
457   -> (FilePath,FilePath)
458
459 mkStubPaths dflags mod location
460   = let
461                 stubdir = stubDir dflags
462
463                 mod_basename = dots_to_slashes (moduleNameString mod)
464                 src_basename = basenameOf (expectJust "mkStubPaths" 
465                                                 (ml_hs_file location))
466
467                 stub_basename0
468                         | Just dir <- stubdir = dir `joinFileName` mod_basename
469                         | otherwise           = src_basename
470
471                 stub_basename = stub_basename0 ++ "_stub"
472      in
473         (stub_basename `joinFileExt` "c",
474          stub_basename `joinFileExt` "h")
475         -- the _stub.o filename is derived from the ml_obj_file.
476
477 -- -----------------------------------------------------------------------------
478 -- findLinkable isn't related to the other stuff in here, 
479 -- but there's no other obvious place for it
480
481 findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable)
482 findObjectLinkableMaybe mod locn
483    = do let obj_fn = ml_obj_file locn
484         maybe_obj_time <- modificationTimeIfExists obj_fn
485         case maybe_obj_time of
486           Nothing -> return Nothing
487           Just obj_time -> liftM Just (findObjectLinkable mod obj_fn obj_time)
488
489 -- Make an object linkable when we know the object file exists, and we know
490 -- its modification time.
491 findObjectLinkable :: Module -> FilePath -> ClockTime -> IO Linkable
492 findObjectLinkable mod obj_fn obj_time = do
493   let stub_fn = case splitFilename3 obj_fn of
494                         (dir, base, ext) -> dir ++ "/" ++ base ++ "_stub.o"
495   stub_exist <- doesFileExist stub_fn
496   if stub_exist
497         then return (LM obj_time mod [DotO obj_fn, DotO stub_fn])
498         else return (LM obj_time mod [DotO obj_fn])
499
500 -- -----------------------------------------------------------------------------
501 -- Utils
502
503 dots_to_slashes = map (\c -> if c == '.' then '/' else c)
504
505
506 -- -----------------------------------------------------------------------------
507 -- Error messages
508
509 cannotFindModule :: DynFlags -> ModuleName -> FindResult -> SDoc
510 cannotFindModule = cantFindErr SLIT("Could not find module")
511
512 cannotFindInterface  :: DynFlags -> ModuleName -> FindResult -> SDoc
513 cannotFindInterface = cantFindErr SLIT("Failed to load interface for")
514
515 cantFindErr cannot_find dflags mod_name (FoundMultiple pkgs)
516   = hang (ptext cannot_find <+> quotes (ppr mod_name) <> colon) 2 (
517        sep [ptext SLIT("it was found in multiple packages:"),
518                 hsep (map (text.packageIdString) pkgs)]
519     )
520 cantFindErr cannot_find dflags mod_name find_result
521   = hang (ptext cannot_find <+> quotes (ppr mod_name) <> colon)
522        2 more_info
523   where
524     more_info
525       = case find_result of
526             PackageHidden pkg 
527                 -> ptext SLIT("it is a member of package") <+> ppr pkg <> comma
528                    <+> ptext SLIT("which is hidden")
529
530             ModuleHidden pkg
531                 -> ptext SLIT("it is hidden") <+> parens (ptext SLIT("in package")
532                    <+> ppr pkg)
533
534             NoPackage pkg
535                 -> ptext SLIT("no package matching") <+> ppr pkg <+>
536                    ptext SLIT("was found")
537
538             NotFound files mb_pkg
539                 | null files
540                 -> ptext SLIT("it is not a module in the current program, or in any known package.")
541                 | Just pkg <- mb_pkg, pkg /= thisPackage dflags, build_tag /= ""
542                 -> let 
543                      build = if build_tag == "p" then "profiling" 
544                                                  else "\"" ++ build_tag ++ "\""
545                    in
546                    ptext SLIT("Perhaps you haven't installed the ") <> text build <>
547                    ptext SLIT(" libraries for package ") <> ppr pkg <> char '?' $$
548                    not_found files
549
550                 | otherwise
551                 -> not_found files
552
553             NotFoundInPackage pkg
554                 -> ptext SLIT("it is not in package") <+> ppr pkg
555
556             _ -> panic "cantFindErr"
557
558     build_tag = buildTag dflags
559
560     not_found files
561         | verbosity dflags < 3
562         = ptext SLIT("Use -v to see a list of the files searched for.")
563         | otherwise 
564         = hang (ptext SLIT("locations searched:")) 2 (vcat (map text files))
565 \end{code}