1 -----------------------------------------------------------------------------
3 -- Parsing the top of a Haskell source file to get its module name
6 -- (c) Simon Marlow 2005
8 -----------------------------------------------------------------------------
10 module GetImports ( getImportsFromFile, getImports ) where
12 #include "HsVersions.h"
14 import Parser ( parseHeader )
15 import Lexer ( P(..), ParseResult(..), mkPState )
16 import HsSyn ( ImportDecl(..), HsModule(..) )
17 import Module ( Module, mkModule )
18 import PrelNames ( gHC_PRIM )
19 import StringBuffer ( StringBuffer, hGetStringBuffer )
20 import SrcLoc ( Located(..), mkSrcLoc, unLoc )
21 import FastString ( mkFastString )
22 import DynFlags ( DynFlags )
26 import Bag ( unitBag )
28 import EXCEPTION ( throwDyn )
32 -- getImportsFromFile is careful to close the file afterwards, otherwise
33 -- we can end up with a large number of open handles before the garbage
34 -- collector gets around to closing them.
35 getImportsFromFile :: DynFlags -> FilePath -> IO ([Module], [Module], Module)
36 getImportsFromFile dflags filename = do
37 buf <- hGetStringBuffer filename
38 getImports dflags buf filename
40 getImports :: DynFlags -> StringBuffer -> FilePath -> IO ([Module], [Module], Module)
41 getImports dflags buf filename = do
42 let loc = mkSrcLoc (mkFastString filename) 1 0
43 case unP parseHeader (mkPState buf loc dflags) of
44 PFailed span err -> parseError span err
47 L _ (HsModule mod _ imps _ _) ->
49 mod_name | Just (L _ m) <- mod = m
50 | otherwise = mkModule "Main"
51 (src_idecls, ord_idecls) = partition isSourceIdecl (map unLoc imps)
52 source_imps = map getImpMod src_idecls
53 ordinary_imps = filter (/= gHC_PRIM) (map getImpMod ord_idecls)
54 -- GHC.Prim doesn't exist physically, so don't go looking for it.
56 return (source_imps, ordinary_imps, mod_name)
58 parseError span err = throwDyn (ProgramError err_doc)
59 where err_doc = render (pprBagOfErrors (unitBag (mkPlainErrMsg span err)))
61 isSourceIdecl (ImportDecl _ s _ _ _) = s
63 getImpMod (ImportDecl (L _ mod) _ _ _ _) = mod