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 ( ModLocation(..), ml_modname, isPackageLoc,
   8                 Finder, newFinder )
   9 where
  10
  11 #include "HsVersions.h"
  12
  13 import IO               ( hPutStr, stderr )
  14 import List             ( maximumBy )
  15 import Maybe            ( catMaybes )
  16 import Time             ( ClockTime )
  17 import Directory        ( doesFileExist, getModificationTime )
  18 import Outputable
  19
  20 import Module           ( Module, ModuleName, PackageName )
  21 import CmStaticInfo     ( PCI(..), Package(..) )
  22 \end{code}
  23
  24 \begin{code}
  25 -- make a product type, with Maybe return --> Module,lhs
  26 data ModLocation
  27    = SourceOnly ModuleName Path        -- .hs
  28    | ObjectCode ModuleName Path Path   -- .o, .hi
  29    | InPackage  ModuleName PackageName
  30    | NotFound
  31
  32 instance Outputable ModLocation where
  33    ppr (SourceOnly nm path_hs)
  34       = hsep [text "SourceOnly", text (show nm), text (show path_hs)]
  35    ppr (ObjectCode nm path_o path_hi)
  36       = hsep [text "ObjectCode", text (show nm),
  37                                  text (show path_o), text (show path_hi)]
  38    ppr (InPackage nm pkgname)
  39       = hsep [text "InPackage", text (show nm), text (show pkgname)]
  40
  41
  42
  43 type Finder = ModuleName -> IO ModLocation
  44
  45 ml_modname (SourceOnly nm _)   = nm
  46 ml_modname (ObjectCode nm _ _) = nm
  47 ml_modname (InPackage  nm _)   = nm
  48
  49 isPackageLoc (InPackage _ _) = True
  50 isPackageLoc _               = False
  51
  52 mkFinder :: [(ModuleName,PackageName,FilePath)] -> [FilePath] -> Finder
  53 mkFinder pkg_ifaces home_dirs modnm
  54    = do found <- mkFinderX pkg_ifaces home_dirs modnm
  55         putStrLn ("FINDER: request  = " ++ modnm ++ "\n" ++
  56                   "FINDER: response = " ++ showSDoc (ppr found))
  57         return found
  58
  59
  60 mkFinderX :: [(ModuleName,PackageName,FilePath)] -> [FilePath] -> Finder
  61 mkFinderX pkg_ifaces home_dirs modnm
  62    -- If the module exists both as package and home, emit a warning
  63    -- and (arbitrarily) choose the user's one.
  64    = do home_maybe_found <- mapM (homeModuleExists modnm) home_dirs
  65                          :: IO [Maybe (ModLocation, ClockTime)]
  66         case (in_package, catMaybes home_maybe_found) of
  67            ([], [])
  68               -> return NotFound
  69            ([], locs_n_times@(_:_))
  70               -> return (homeMod locs_n_times)
  71            ((pkgname,path):_, [])
  72               -> return (InPackage modnm pkgname)
  73            (packages, locs_n_times)
  74               -> do hPutStr stderr ( "GHCI: warning: module `" ++ modnm ++
  75                                      "' appears as both a home and package module\n")
  76                     return (homeMod locs_n_times)
  77      where
  78         in_package
  79            = [(pkgname,path) | (modname,pkgname,path) <- pkg_ifaces,
  80                                modname == modnm]
  81         homeMod :: [(ModLocation, ClockTime)] -> ModLocation
  82         homeMod locs_n_times
  83            = fst (maximumBy (\lt1 lt2 -> if snd lt1 > snd lt2 then lt1 else lt2)
  84                             locs_n_times)
  85
  86
  87 -- See if a .hs or (.hi, .o) pair exist on the given path,
  88 -- and return a ModLocation for whichever is younger
  89 homeModuleExists :: ModuleName -> FilePath -> IO (Maybe (ModLocation, ClockTime))
  90 homeModuleExists modname path
  91    = do m_ths <- maybeTime nm_hs
  92         m_thi <- maybeTime nm_hi
  93         m_to  <- maybeTime nm_o
  94         return (
  95            case (m_ths, m_thi, m_to) of
  96               (Just ths, Just thi, Just to)
  97                  |  thi >= ths && to >= ths -> object thi to
  98                  |  otherwise               -> source ths
  99               (Just ths, _, _)              -> source ths
 100               (Nothing, Just thi, Just to)  -> object thi to
 101               (Nothing, _, _)               -> Nothing
 102            )
 103      where
 104         object thi to = Just (ObjectCode modname nm_o nm_hi, max thi to)
 105         source ths    = Just (SourceOnly modname nm_hs, ths)
 106         nm = path ++ "/" ++ modname
 107         nm_hs = nm ++ ".hs"
 108         nm_hi = nm ++ ".hi"
 109         nm_o  = nm ++ ".o"
 110
 111         maybeTime :: String -> IO (Maybe ClockTime)
 112         maybeTime f
 113            = do -- putStrLn ("maybeTime: " ++ f)
 114                 exists <- doesFileExist f
 115                 if not exists
 116                  then do -- putStrLn " ... no"
 117                          return Nothing
 118                  else do tm <- getModificationTime f
 119                          -- putStrLn (" ... " ++ show tm)
 120                          return (Just tm)
 121
 122
 123
 124 newFinder :: FilePath{-temp debugging hack-}
 125           -> PCI -> IO Finder
 126 newFinder path pci
 127    = return (mkFinder (module_table pci) [path])
 128
 129 \end{code}