ghc/compiler/ghci/CmFind.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1993-2000
   3 %
   4 \section[CmFind]{Module finder for GHCI}
   5
   6 \begin{code}
   7 module CmFind ( Path, ModName, PkgName,
   8                 ModLocation(..), ml_modname, isPackageLoc,
   9                 Finder, newFinder )
  10 where
  11
  12 #include "HsVersions.h"
  13
  14 import IO               ( hPutStr, stderr )
  15 import List             ( maximumBy )
  16 import Maybe            ( catMaybes )
  17 import Char             ( isUpper )
  18 import List             ( nub )
  19 import Time             ( ClockTime )
  20 import Directory        ( doesFileExist, getModificationTime,
  21                           getDirectoryContents)
  22
  23 import Module           ( Module )
  24 import CmStaticInfo     ( PCI, Package(..) )
  25 \end{code}
  26
  27 \begin{code}
  28 type Path    = String
  29 type ModName = String
  30 type PkgName = String
  31
  32 data ModLocation
  33    = SourceOnly ModName Path        -- .hs
  34    | ObjectCode ModName Path Path   -- .o, .hi
  35    | InPackage  ModName PkgName
  36    | NotFound
  37      deriving Show
  38
  39 type Finder = ModName -> IO ModLocation
  40
  41 ml_modname (SourceOnly nm _)   = nm
  42 ml_modname (ObjectCode nm _ _) = nm
  43 ml_modname (InPackage  nm _)   = nm
  44
  45 isPackageLoc (InPackage _ _) = True
  46 isPackageLoc _               = False
  47
  48 mkFinder :: [(ModName,PkgName,Path)] -> [Path] -> Finder
  49 mkFinder pkg_ifaces home_dirs modnm
  50    = do found <- mkFinderX pkg_ifaces home_dirs modnm
  51         putStrLn ("FINDER: request  = " ++ modnm ++ "\n" ++
  52                   "FINDER: response = " ++ show found)
  53         return found
  54
  55
  56 mkFinderX :: [(ModName,PkgName,Path)] -> [Path] -> Finder
  57 mkFinderX pkg_ifaces home_dirs modnm
  58    -- If the module exists both as package and home, emit a warning
  59    -- and (arbitrarily) choose the user's one.
  60    = do home_maybe_found <- mapM (homeModuleExists modnm) home_dirs
  61                          :: IO [Maybe (ModLocation, ClockTime)]
  62         case (in_package, catMaybes home_maybe_found) of
  63            ([], [])
  64               -> return NotFound
  65            ([], locs_n_times@(_:_))
  66               -> return (homeMod locs_n_times)
  67            ((pkgname,path):_, [])
  68               -> return (InPackage modnm pkgname)
  69            (packages, locs_n_times)
  70               -> do hPutStr stderr ( "GHCI: warning: module `" ++ modnm ++
  71                                      "' appears as both a home and package module\n")
  72                     return (homeMod locs_n_times)
  73      where
  74         in_package
  75            = [(pkgname,path) | (modname,pkgname,path) <- pkg_ifaces,
  76                                modname == modnm]
  77         homeMod :: [(ModLocation, ClockTime)] -> ModLocation
  78         homeMod locs_n_times
  79            = fst (maximumBy (\lt1 lt2 -> if snd lt1 > snd lt2 then lt1 else lt2)
  80                             locs_n_times)
  81
  82
  83 -- See if a .hs or (.hi, .o) pair exist on the given path,
  84 -- and return a ModLocation for whichever is younger
  85 homeModuleExists :: ModName -> Path -> IO (Maybe (ModLocation, ClockTime))
  86 homeModuleExists modname path
  87    = do m_ths <- maybeTime nm_hs
  88         m_thi <- maybeTime nm_hi
  89         m_to  <- maybeTime nm_o
  90         return (
  91            case (m_ths, m_thi, m_to) of
  92               (Just ths, Just thi, Just to)
  93                  |  thi >= ths && to >= ths -> object thi to
  94                  |  otherwise               -> source ths
  95               (Just ths, _, _)              -> source ths
  96               (Nothing, Just thi, Just to)  -> object thi to
  97               (Nothing, _, _)               -> Nothing
  98            )
  99      where
 100         object thi to = Just (ObjectCode modname nm_o nm_hi, max thi to)
 101         source ths    = Just (SourceOnly modname nm_hs, ths)
 102         nm = path ++ "/" ++ modname
 103         nm_hs = nm ++ ".hs"
 104         nm_hi = nm ++ ".hi"
 105         nm_o  = nm ++ ".o"
 106
 107         maybeTime :: String -> IO (Maybe ClockTime)
 108         maybeTime f
 109            = do -- putStrLn ("maybeTime: " ++ f)
 110                 exists <- doesFileExist f
 111                 if not exists
 112                  then do -- putStrLn " ... no"
 113                          return Nothing
 114                  else do tm <- getModificationTime f
 115                          -- putStrLn (" ... " ++ show tm)
 116                          return (Just tm)
 117
 118
 119
 120 newFinder :: PCI -> IO Finder
 121 newFinder pci
 122    -- PCI is a list of packages and their names
 123    = do
 124         -- the list of directories where package interfaces are
 125         let p_i_dirs :: [(PkgName,Path)]
 126             p_i_dirs = concatMap nm_and_paths pci
 127
 128         -- interface names in each directory
 129         ifacess <- mapM ifaces_in_dir p_i_dirs
 130         let ifaces :: [(ModName,PkgName,Path)]
 131             ifaces = concat ifacess
 132
 133         -- ToDo: allow a range of home package directories
 134         return (mkFinder ifaces ["."])
 135      where
 136         nm_and_paths :: Package -> [(PkgName,Path)]
 137         nm_and_paths package
 138            = [(name package, path) | path <- nub (import_dirs package)]
 139
 140         ifaces_in_dir :: (PkgName,Path) -> IO [(ModName,PkgName,Path)]
 141         ifaces_in_dir (pkgname,path)
 142            = getDirectoryContents path >>= \ entries ->
 143              return [(zap_hi if_nm, pkgname, path)
 144                     | if_nm <- entries, looks_like_iface_name if_nm]
 145         looks_like_iface_name e
 146            = not (null e) && isUpper (head e)
 147                           && take 3 (reverse e) == "ih."
 148         zap_hi
 149            = reverse . drop 3 . reverse
 150
 151 \end{code}