[project @ 2000-10-06 13:07:32 by sewardj]
[ghc-hetmet.git] / 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}