2 % (c) The University of Glasgow, 2000
4 \section[CmFind]{Module finder for GHCI}
7 module CmFind ( Finder, newFinder )
10 #include "HsVersions.h"
12 import IO ( hPutStr, stderr )
13 import List ( maximumBy )
14 import Maybe ( catMaybes )
15 import Time ( ClockTime )
16 import Directory ( doesFileExist, getModificationTime )
19 import Module ( Module, ModuleName, ModuleKind(..), PackageName,
20 mkModule, moduleNameUserString )
21 import CmStaticInfo ( Package(..), PackageConfigInfo(..) )
25 type Finder = ModuleName -> IO (Maybe Module)
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))
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
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))
55 = [(pkgname,path) | (modname,pkgname,path) <- pkg_ifaces,
57 homeMod :: [(Module, ClockTime)] -> Module
59 = fst (maximumBy (\lt1 lt2 -> if snd lt1 > snd lt2 then lt1 else lt2)
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
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
80 object thi to = Just (mkModule modname (ObjectCode nm_o nm_hi),
82 source ths = Just (mkModule modname (SourceOnly nm_hs),
84 nm = path ++ "/" ++ moduleNameUserString modname
89 maybeTime :: String -> IO (Maybe ClockTime)
91 = do -- putStrLn ("maybeTime: " ++ f)
92 exists <- doesFileExist f
94 then do -- putStrLn " ... no"
96 else do tm <- getModificationTime f
97 -- putStrLn (" ... " ++ show tm)
102 newFinder :: FilePath{-temp debugging hack-}
103 -> PackageConfigInfo -> IO Finder
105 = return (mkFinder (pci_modtable pci) [path])