diff options
Diffstat (limited to 'src/Main.hs')
-rw-r--r-- | src/Main.hs | 27 |
1 files changed, 13 insertions, 14 deletions
diff --git a/src/Main.hs b/src/Main.hs index deb699f7..b49fc6e4 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -57,7 +57,7 @@ import Paths_haddock import GHC hiding (flags, verbosity) import Config import DynFlags hiding (flags, verbosity) -import Panic (handleGhcException) +import Panic (panic, handleGhcException) import Module @@ -393,7 +393,7 @@ getPrologue flags = [] -> return Nothing [filename] -> do str <- readFile filename - case parseParas (tokenise defaultDynFlags str + case parseParas (tokenise (defaultDynFlags (panic "No settings")) str (1,0) {- TODO: real position -}) of Nothing -> throwE $ "failed to parse haddock prologue from file: " ++ filename Just doc -> return (Just doc) @@ -416,18 +416,17 @@ getInTreeLibDir = do getExecDir :: IO (Maybe String) #if defined(mingw32_HOST_OS) -getExecDir = allocaArray len $ \buf -> do - ret <- getModuleFileName nullPtr buf len - if ret == 0 then - return Nothing - else do - s <- peekCString buf - return (Just (dropFileName s)) - where len = 2048 -- Plenty, PATH_MAX is 512 under Win32. - - -foreign import stdcall unsafe "GetModuleFileNameA" - getModuleFileName :: Ptr () -> CString -> Int -> IO Int32 +getExecDir = try_size 2048 -- plenty, PATH_MAX is 512 under Win32. + where + try_size size = allocaArray (fromIntegral size) $ \buf -> do + ret <- c_GetModuleFileName nullPtr buf size + case ret of + 0 -> return Nothing + _ | ret < size -> fmap (Just . dropFileName) $ peekCWString buf + | otherwise -> try_size (size * 2) + +foreign import stdcall unsafe "windows.h GetModuleFileNameW" + c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32 #else getExecDir = return Nothing #endif |