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, noSrcSpan )
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
36 -> IO ([Located Module], [Located Module], Located Module)
37 getImportsFromFile dflags filename = do
38 buf <- hGetStringBuffer filename
39 getImports dflags buf filename
41 getImports :: DynFlags -> StringBuffer -> FilePath
42 -> IO ([Located Module], [Located Module], Located Module)
43 getImports dflags buf filename = do
44 let loc = mkSrcLoc (mkFastString filename) 1 0
45 case unP parseHeader (mkPState buf loc dflags) of
46 PFailed span err -> parseError span err
49 L _ (HsModule mod _ imps _ _) ->
51 mod_name | Just located_mod <- mod = located_mod
52 | otherwise = L noSrcSpan (mkModule "Main")
53 (src_idecls, ord_idecls) = partition isSourceIdecl (map unLoc imps)
54 source_imps = map getImpMod src_idecls
55 ordinary_imps = filter ((/= gHC_PRIM) . unLoc)
56 (map getImpMod ord_idecls)
57 -- GHC.Prim doesn't exist physically, so don't go looking for it.
59 return (source_imps, ordinary_imps, mod_name)
61 parseError span err = throwDyn $ mkPlainErrMsg span err
63 isSourceIdecl (ImportDecl _ s _ _ _) = s
65 getImpMod (ImportDecl located_mod _ _ _ _) = located_mod