ghc/compiler/ghci/CmFind.lhs

   1 %
   2 % (c) The University of Glasgow, 2000
   3 %
   4 \section[CmFind]{Module finder for GHCI}
   5
   6 \begin{code}
   7 module CmFind ( Finder, newFinder )
   8 where
   9
  10 #include "HsVersions.h"
  11
  12 import IO               ( hPutStr, stderr )
  13 import List             ( maximumBy )
  14 import Maybe            ( catMaybes )
  15 import Time             ( ClockTime )
  16 import Directory        ( doesFileExist, getModificationTime )
  17 import Outputable
  18
  19 import Module           ( Module, ModuleName, ModuleKind(..), PackageName,
  20                           mkModule, moduleNameUserString )
  21 import CmStaticInfo     ( Package(..), PackageConfigInfo(..) )
  22 \end{code}
  23
  24 \begin{code}
  25 type Finder = ModuleName -> IO (Maybe Module)
  26
  27 mkFinder :: [(ModuleName,PackageName,FilePath)] -> [FilePath] -> Finder
  28 mkFinder pkg_ifaces home_dirs modnm
  29    = do found <- mkFinderX pkg_ifaces home_dirs modnm
  30         --putStrLn ("FINDER: request  = " ++ modnm ++ "\n" ++
  31         --          "FINDER: response = " ++ showSDoc (ppr found))
  32         return found
  33
  34
  35 mkFinderX :: [(ModuleName,PackageName,FilePath)] -> [FilePath] -> Finder
  36 mkFinderX pkg_ifaces home_dirs modnm
  37    -- If the module exists both as package and home, emit a warning
  38    -- and (arbitrarily) choose the user's one.
  39    = do home_maybe_found <- mapM (homeModuleExists modnm) home_dirs
  40                          :: IO [Maybe (Module, ClockTime)]
  41         case (in_package, catMaybes home_maybe_found) of
  42            ([], [])
  43               -> return Nothing
  44            ([], locs_n_times@(_:_))
  45               -> return (Just (homeMod locs_n_times))
  46            ((pkgname,path):_, [])
  47               -> return (Just (mkModule modnm (InPackage pkgname)))
  48            (packages, locs_n_times)
  49               -> do hPutStr stderr ( "GHCI: warning: module `"
  50                                      ++ moduleNameUserString modnm
  51                                      ++ "' appears as both a home and package module\n")
  52                     return (Just (homeMod locs_n_times))
  53      where
  54         in_package
  55            = [(pkgname,path) | (modname,pkgname,path) <- pkg_ifaces,
  56                                modname == modnm]
  57         homeMod :: [(Module, ClockTime)] -> Module
  58         homeMod locs_n_times
  59            = fst (maximumBy (\lt1 lt2 -> if snd lt1 > snd lt2 then lt1 else lt2)
  60                             locs_n_times)
  61
  62
  63 -- See if a .hs or (.hi, .o) pair exist on the given path,
  64 -- and return a Module for whichever is younger
  65 homeModuleExists :: ModuleName -> FilePath -> IO (Maybe (Module, ClockTime))
  66 homeModuleExists modname path
  67    = do m_ths <- maybeTime nm_hs
  68         m_thi <- maybeTime nm_hi
  69         m_to  <- maybeTime nm_o
  70         return (
  71            case (m_ths, m_thi, m_to) of
  72               (Just ths, Just thi, Just to)
  73                  |  thi >= ths && to >= ths -> object thi to
  74                  |  otherwise               -> source ths
  75               (Just ths, _, _)              -> source ths
  76               (Nothing, Just thi, Just to)  -> object thi to
  77               (Nothing, _, _)               -> Nothing
  78            )
  79      where
  80         object thi to = Just (mkModule modname (ObjectCode nm_o nm_hi),
  81                               max thi to)
  82         source ths    = Just (mkModule modname (SourceOnly nm_hs),
  83                               ths)
  84         nm = path ++ "/" ++ moduleNameUserString modname
  85         nm_hs = nm ++ ".hs"
  86         nm_hi = nm ++ ".hi"
  87         nm_o  = nm ++ ".o"
  88
  89         maybeTime :: String -> IO (Maybe ClockTime)
  90         maybeTime f
  91            = do -- putStrLn ("maybeTime: " ++ f)
  92                 exists <- doesFileExist f
  93                 if not exists
  94                  then do -- putStrLn " ... no"
  95                          return Nothing
  96                  else do tm <- getModificationTime f
  97                          -- putStrLn (" ... " ++ show tm)
  98                          return (Just tm)
  99
 100
 101
 102 newFinder :: FilePath{-temp debugging hack-}
 103           -> PackageConfigInfo -> IO Finder
 104 newFinder path pci
 105    = return (mkFinder (pci_modtable pci) [path])
 106
 107 \end{code}