<commit_before>--
-- Haddock - A Haskell Documentation Tool
--
-- (c) <NAME> 2003
-- 
-- Ported to use the GHC API by <NAME> during "Summer of Code" 2006
--


module Main (main) where


import Haddock.Backends.Html
import Haddock.Backends.Hoogle
import Haddock.Interface
import Haddock.Types
import Haddock.Version
import Haddock.InterfaceFile
import Haddock.Exception
import Haddock.Options
import Haddock.GHC
import Haddock.Utils
import Paths_haddock

import Control.Monad
#if __GLASGOW_HASKELL__ >= 609
import Control.OldException
import qualified Control.Exception as NewException
#else
import Control.Exception
#endif
import Data.Dynamic
import Data.Maybe
import Data.IORef
import qualified Data.Map as Map
import Data.Version
import System.IO
import System.Exit
import System.Environment
import System.FilePath
#ifdef IN_GHC_TREE
import Foreign
import Foreign.C
import Data.Int
#endif

import GHC
#ifdef GHC_PATHS
import GHC.Paths
#endif
import DynFlags
import Bag
import ErrUtils
#if __GLASGOW_HASKELL__ >= 609
import Panic (handleGhcException)
import Util
#else
import Util hiding (handle)
#endif


--------------------------------------------------------------------------------
-- Exception handling
--------------------------------------------------------------------------------


handleTopExceptions = 
  handleNormalExceptions . handleHaddockExceptions . handleGhcExceptions


handleNormalExceptions inner =
  handle (\exception -> do
    hFlush stdout    
    case exception of
      AsyncException StackOverflow -> do
        putStrLn "stack overflow: use -g +RTS -K<size> to increase it"
        exitFailure
      ExitException code -> exitWith code
      _other -> do
        putStrLn ("haddock: internal Haddock or GHC error: " ++ show exception)
        exitFailure
  ) inner


handleHaddockExceptions inner = 
#if __GLASGOW_HASKELL__ >= 609
  NewException.catches inner [NewException.Handler handler]
#else
  handleDyn handler inner
#endif
  where
    handler (e::HaddockException) = do
      putStrLn $ "haddock: " ++ (show e)
      exitFailure


handleGhcExceptions inner = 
  -- compilation errors: messages with locations attached
#if __GLASGOW_HASKELL__ >= 609
  handleErrMsg (\e -> do
#else
 handleDyn (\e -> do
#endif
    putStrLn "haddock: Compilation error(s):"
    printBagOfErrors defaultDynFlags (unitBag e)
    exitFailure
  ) $

  -- error messages propagated as exceptions
#if __GLASGOW_HASKELL__ >= 609
  handleGhcException (\e -> do
#else
  handleDyn (\e -> do
#endif
    hFlush stdout
    case e of
      PhaseFailed _ code -> exitWith code
      Interrupted -> exitFailure
      _ -> do 
        print (e :: GhcException)
        exitFailure
  ) inner


-------------------------------------------------------------------------------
-- Top level
-------------------------------------------------------------------------------


main :: IO ()
main = handleTopExceptions $ do

  -- parse command-line flags and handle some of them initially
  args <- getArgs
  (flags, fileArgs) <- parseHaddockOpts args
  handleEasyFlags flags fileArgs

  let renderStep packages interfaces = do 
        updateHTMLXRefs packages
        let ifaceFiles = map fst packages
            installedIfaces = concatMap ifInstalledIfaces ifaceFiles
        render flags interfaces installedIfaces

  if not (null fileArgs)
    then do

      let libDir
            | Just dir <- getGhcLibDir flags = dir
            | otherwise =
#ifdef IN_GHC_TREE
                error "No GhcLibDir found"
#else
                libdir -- from GHC.Paths
#endif

      -- initialize GHC
      (session, dynflags) <- startGhc libDir (ghcFlags flags)

      -- get packages supplied with --read-interface
      packages <- readInterfaceFiles (Just session) (ifacePairs flags)<commit_msg>Fix installed haddock on Windows<commit_after>--
-- Haddock - A Haskell Documentation Tool
--
-- (c) <NAME> 2003
-- 
-- Ported to use the GHC API by <NAME> during "Summer of Code" 2006
--


module Main (main) where


import Haddock.Backends.Html
import Haddock.Backends.Hoogle
import Haddock.Interface
import Haddock.Types
import Haddock.Version
import Haddock.InterfaceFile
import Haddock.Exception
import Haddock.Options
import Haddock.GHC
import Haddock.Utils
import Paths_haddock

import Control.Monad
#if __GLASGOW_HASKELL__ >= 609
import Control.OldException
import qualified Control.Exception as NewException
#else
import Control.Exception
#endif
import Data.Dynamic
import Data.Maybe
import Data.IORef
import qualified Data.Map as Map
import Data.Version
import System.IO
import System.Exit
import System.Environment
import System.FilePath
#ifdef IN_GHC_TREE
import Foreign
import Foreign.C
import Data.Int
#endif

import GHC
#ifdef GHC_PATHS
import GHC.Paths
#endif
import DynFlags
import Bag
import ErrUtils
#if __GLASGOW_HASKELL__ >= 609
import Panic (handleGhcException)
import Util
#else
import Util hiding (handle)
#endif


--------------------------------------------------------------------------------
-- Exception handling
--------------------------------------------------------------------------------


handleTopExceptions = 
  handleNormalExceptions . handleHaddockExceptions . handleGhcExceptions


handleNormalExceptions inner =
  handle (\exception -> do
    hFlush stdout    
    case exception of
      AsyncException StackOverflow -> do
        putStrLn "stack overflow: use -g +RTS -K<size> to increase it"
        exitFailure
      ExitException code -> exitWith code
      _other -> do
        putStrLn ("haddock: internal Haddock or GHC error: " ++ show exception)
        exitFailure
  ) inner


handleHaddockExceptions inner = 
#if __GLASGOW_HASKELL__ >= 609
  NewException.catches inner [NewException.Handler handler]
#else
  handleDyn handler inner
#endif
  where
    handler (e::HaddockException) = do
      putStrLn $ "haddock: " ++ (show e)
      exitFailure


handleGhcExceptions inner = 
  -- compilation errors: messages with locations attached
#if __GLASGOW_HASKELL__ >= 609
  handleErrMsg (\e -> do
#else
 handleDyn (\e -> do
#endif
    putStrLn "haddock: Compilation error(s):"
    printBagOfErrors defaultDynFlags (unitBag e)
    exitFailure
  ) $

  -- error messages propagated as exceptions
#if __GLASGOW_HASKELL__ >= 609
  handleGhcException (\e -> do
#else
  handleDyn (\e -> do
#endif
    hFlush stdout
    case e of
      PhaseFailed _ code -> exitWith code
      Interrupted -> exitFailure
      _ -> do 
        print (e :: GhcException)
        exitFailure
  ) inner


-------------------------------------------------------------------------------
-- Top level
-------------------------------------------------------------------------------


main :: IO ()
main = handleTopExceptions $ do

  -- parse command-line flags and handle some of them initially
  args <- getArgs
  (flags, fileArgs) <- parseHaddockOpts args
  handleEasyFlags flags fileArgs

  let renderStep packages interfaces = do 
        updateHTMLXRefs packages
        let ifaceFiles = map fst packages
            installedIfaces = concatMap ifInstalledIfaces ifaceFiles
        render flags interfaces installedIfaces

  if not (null fileArgs)
    then do

      libDir <- case getGhcLibDir flags of
                Just dir -> return dir
                Nothing ->
#ifdef IN_GHC_TREE
                    do m <- getExecDir
                       case m of
                           Nothing -> error "No GhcLibDir found"
                           Just d -> return (d </> "..")
#else
                    return libdir -- from GHC.Paths
#endif

      -- initialize GHC
      (session, dynflags) <- startGhc libDir (ghcFlags flags)

      -- get packages supplied with --read-interface
      packages <- readInterfaceFiles (Just session) (ifacePairs flags)
{'fraction_non_alphanumeric': 0.14567233384853168, 'fraction_numerical': 0.00592478104070067, 'mean_word_length': 2.207352333746386, 'pattern_counts': {'":': 0, '<': 21, '<?xml version=': 0, '>': 46, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2425049', 'n_tokens_mistral': 2232, 'n_tokens_neox': 2112, 'n_words': 699}