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