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 StringBuffer ( StringBuffer, hGetStringBuffer )
19 import SrcLoc ( Located(..), mkSrcLoc, unLoc )
20 import FastString ( mkFastString )
21 import CmdLineOpts ( DynFlags )
25 import Bag ( unitBag )
27 import EXCEPTION ( throwDyn )
31 -- getImportsFromFile is careful to close the file afterwards, otherwise
32 -- we can end up with a large number of open handles before the garbage
33 -- collector gets around to closing them.
34 getImportsFromFile :: DynFlags -> FilePath -> IO ([Module], [Module], Module)
35 getImportsFromFile dflags filename = do
36 buf <- hGetStringBuffer filename
37 getImports dflags buf filename
39 getImports :: DynFlags -> StringBuffer -> FilePath -> IO ([Module], [Module], Module)
40 getImports dflags buf filename = do
41 let loc = mkSrcLoc (mkFastString filename) 1 0
42 case unP parseHeader (mkPState buf loc dflags) of
43 PFailed span err -> parseError span err
46 L _ (HsModule mod _ imps _ _) ->
48 mod_name | Just (L _ m) <- mod = m
49 | otherwise = mkModule "Main"
50 (src_idecls, ord_idecls) = partition isSourceIdecl (map unLoc imps)
51 source_imps = map getImpMod src_idecls
52 ordinary_imps = map getImpMod ord_idecls
54 return (source_imps, ordinary_imps, mod_name)
56 parseError span err = throwDyn (ProgramError err_doc)
57 where err_doc = render (pprBagOfErrors (unitBag (mkPlainErrMsg span err)))
59 isSourceIdecl (ImportDecl _ s _ _ _) = s
61 getImpMod (ImportDecl (L _ mod) _ _ _ _) = mod