<commit_before>-----------------------------------------------------------------------------
--
-- Parsing the top of a Haskell source file to get its module name,
-- imports and options.
--
-- (c) <NAME> 2005
-- (c) Lemmih 2006
--
-----------------------------------------------------------------------------

module HeaderInfo ( getImportsFromFile, getImports
                  , getOptionsFromFile, getOptions
                  , optionsErrorMsgs ) where

#include "HsVersions.h"

import Parser		( parseHeader )
import Lexer		( P(..), ParseResult(..), mkPState, pragState
                        , lexer, Token(..), PState(..) )
import FastString
import HsSyn		( ImportDecl(..), HsModule(..) )
import Module		( ModuleName, moduleName )
import PrelNames        ( gHC_PRIM, mAIN_NAME )
import StringBuffer	( StringBuffer(..), hGetStringBuffer, hGetStringBufferBlock
                        , appendStringBuffers )
import SrcLoc		( Located(..), mkSrcLoc, unLoc, noSrcSpan )
import FastString	( mkFastString )
import DynFlags	( DynFlags )
import ErrUtils
import Util
import Outputable
import Pretty           ()
import Panic
import Bag		( emptyBag, listToBag )

import Distribution.Compiler

import Control.Exception
import System.IO
import Data.List

#if __GLASGOW_HASKELL__ >= 601
import System.IO		( openBinaryFile )
#else
import IOExts                   ( openFileEx, IOModeEx(..) )
#endif

#if __GLASGOW_HASKELL__ < 601
openBinaryFile fp mode = openFileEx fp (BinaryMode mode)
#endif

-- getImportsFromFile is careful to close the file afterwards, otherwise
-- we can end up with a large number of open handles before the garbage
-- collector gets around to closing them.
getImportsFromFile :: DynFlags -> FilePath
   -> IO ([Located ModuleName], [Located ModuleName], Located ModuleName)
getImportsFromFile dflags filename = do
  buf <- hGetStringBuffer filename
  getImports dflags buf filename

getImports :: DynFlags -> StringBuffer -> FilePath
    -> IO ([Located ModuleName], [Located ModuleName], Located ModuleName)
getImports dflags buf filename = do
  let loc  = mkSrcLoc (mkFastString filename) 1 0
  case unP parseHeader (mkPState buf loc dflags) of
	PFailed span err -> parseError span err
	POk _ rdr_module -> 
	  case rdr_module of
	    L _ (HsModule mod _ imps _ _ _ _ _) ->
	      let
		mod_name | Just located_mod <- mod = located_mod
			 | otherwise               = L noSrcSpan mAIN_NAME
	        (src_idecls, ord_idecls) = partition isSourceIdecl (map unLoc imps)
		source_imps   = map getImpMod src_idecls	
		ordinary_imps = filter ((/= moduleName gHC_PRIM) . unLoc) 
					(map getImpMod ord_idecls)
		     -- GHC.Prim doesn't exist physically, so don't go looking for it.
	      in
	      return (source_imps, ordinary_imps, mod_name)
  
parseError span err = throwDyn $ mkPlainErrMsg span err

isSourceIdecl (ImportDecl _ s _ _ _) = s

getImpMod (ImportDecl located_mod _ _ _ _) = located_mod

--------------------------------------------------------------
-- Get options
--------------------------------------------------------------


getOptionsFromFile :: FilePath            -- input file
                   -> IO [Located String] -- options, if any
getOptionsFromFile filename
    = bracket (openBinaryFile filename ReadMode)
              (hClose)
              (\handle ->
                   do buf <- hGetStringBufferBlock handle blockSize
                      loop handle buf)
    where blockSize = 1024
          loop handle buf
              | len buf == 0 = return []
              | otherwise
              = case getOptions' buf filename of
                  (Nothing, opts) -> return opts
                  (Just buf', opts) -> do nextBlock <- hGetStringBufferBlock handle blockSize
                                          newBuf <- appendStringBuffers buf' nextBlock
                                          if len newBuf == len buf
                                             then return opts
                                             else do opts' <- loop handle newBuf
                                                     return (opts++opts')

getOptions :: StringBuffer -> FilePath -> [Located String]
getOptions buf filename
    = case getOptions' buf filename of
        (_,opts) -> opts
<commit_msg>fix 5.04 compile<commit_after>-----------------------------------------------------------------------------
--
-- Parsing the top of a Haskell source file to get its module name,
-- imports and options.
--
-- (c) <NAME> 2005
-- (c) Lemmih 2006
--
-----------------------------------------------------------------------------

module HeaderInfo ( getImportsFromFile, getImports
                  , getOptionsFromFile, getOptions
                  , optionsErrorMsgs ) where

#include "HsVersions.h"

import Parser		( parseHeader )
import Lexer		( P(..), ParseResult(..), mkPState, pragState
                        , lexer, Token(..), PState(..) )
import FastString
import HsSyn		( ImportDecl(..), HsModule(..) )
import Module		( ModuleName, moduleName )
import PrelNames        ( gHC_PRIM, mAIN_NAME )
import StringBuffer	( StringBuffer(..), hGetStringBuffer, hGetStringBufferBlock
                        , appendStringBuffers )
import SrcLoc		( Located(..), mkSrcLoc, unLoc, noSrcSpan )
import FastString	( mkFastString )
import DynFlags	( DynFlags )
import ErrUtils
import Util
import Outputable
import Pretty           ()
import Panic
import Bag		( emptyBag, listToBag )

import Distribution.Compiler

import Control.Exception
import System.IO
import Data.List

#if __GLASGOW_HASKELL__ >= 601
import System.IO		( openBinaryFile )
#else
import IOExts                   ( openFileEx, IOModeEx(..) )
#endif

#if __GLASGOW_HASKELL__ < 601
openBinaryFile fp mode = openFileEx fp (BinaryMode mode)
#endif

-- getImportsFromFile is careful to close the file afterwards, otherwise
-- we can end up with a large number of open handles before the garbage
-- collector gets around to closing them.
getImportsFromFile :: DynFlags -> FilePath
   -> IO ([Located ModuleName], [Located ModuleName], Located ModuleName)
getImportsFromFile dflags filename = do
  buf <- hGetStringBuffer filename
  getImports dflags buf filename

getImports :: DynFlags -> StringBuffer -> FilePath
    -> IO ([Located ModuleName], [Located ModuleName], Located ModuleName)
getImports dflags buf filename = do
  let loc  = mkSrcLoc (mkFastString filename) 1 0
  case unP parseHeader (mkPState buf loc dflags) of
	PFailed span err -> parseError span err
	POk _ rdr_module -> 
	  case rdr_module of
	    L _ (HsModule mod _ imps _ _ _ _ _) ->
	      let
		mod_name | Just located_mod <- mod = located_mod
			 | otherwise               = L noSrcSpan mAIN_NAME
	        (src_idecls, ord_idecls) = partition isSourceIdecl (map unLoc imps)
		source_imps   = map getImpMod src_idecls	
		ordinary_imps = filter ((/= moduleName gHC_PRIM) . unLoc) 
					(map getImpMod ord_idecls)
		     -- GHC.Prim doesn't exist physically, so don't go looking for it.
	      in
	      return (source_imps, ordinary_imps, mod_name)
  
parseError span err = throwDyn $ mkPlainErrMsg span err

isSourceIdecl (ImportDecl _ s _ _ _) = s

getImpMod (ImportDecl located_mod _ _ _ _) = located_mod

--------------------------------------------------------------
-- Get options
--------------------------------------------------------------


getOptionsFromFile :: FilePath            -- input file
                   -> IO [Located String] -- options, if any
getOptionsFromFile filename
    = System.IO.bracket
	      (openBinaryFile filename ReadMode)
              (hClose)
              (\handle ->
                   do buf <- hGetStringBufferBlock handle blockSize
                      loop handle buf)
    where blockSize = 1024
          loop handle buf
              | len buf == 0 = return []
              | otherwise
              = case getOptions' buf filename of
                  (Nothing, opts) -> return opts
                  (Just buf', opts) -> do nextBlock <- hGetStringBufferBlock handle blockSize
                                          newBuf <- appendStringBuffers buf' nextBlock
                                          if len newBuf == len buf
                                             then return opts
                                             else do opts' <- loop handle newBuf
                                                     return (opts++opts')

getOptions :: StringBuffer -> FilePath -> [Located String]
getOptions buf filename
    = case getOptions' buf filename of
        (_,opts) -> opts

{'fraction_non_alphanumeric': 0.13651277243965315, 'fraction_numerical': 0.005273025544879306, 'mean_word_length': 1.7974434611602754, 'pattern_counts': {'":': 0, '<': 19, '<?xml version=': 0, '>': 37, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 20, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5079920', 'n_tokens_mistral': 2334, 'n_tokens_neox': 2184, 'n_words': 738}