aboutsummaryrefslogtreecommitdiff
path: root/src/HaddockUtil.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/HaddockUtil.hs')
-rw-r--r--src/HaddockUtil.hs15
1 files changed, 12 insertions, 3 deletions
diff --git a/src/HaddockUtil.hs b/src/HaddockUtil.hs
index 9804fb6e..20d86b79 100644
--- a/src/HaddockUtil.hs
+++ b/src/HaddockUtil.hs
@@ -18,7 +18,7 @@ module HaddockUtil (
moduleHtmlFile,
-- * Miscellaneous utilities
- die, dieMsg, mapSnd, mapMaybeM,
+ getProgramName, bye, die, dieMsg, mapSnd, mapMaybeM,
-- * HTML cross reference mapping
html_xrefs_ref, html_xrefs,
@@ -26,7 +26,7 @@ module HaddockUtil (
import HsSyn
-import List ( intersect )
+import List ( intersect, isSuffixOf )
import Maybe
import IO ( hPutStr, stderr )
import System
@@ -261,11 +261,20 @@ moduleHtmlFile dir mod0 = dir ++ pathSeparator : mod0 ++ ".html"
-----------------------------------------------------------------------------
-- misc.
+getProgramName :: IO String
+getProgramName = liftM (`withoutSuffix` ".bin") getProgName
+ where str `withoutSuffix` suff
+ | suff `isSuffixOf` str = take (length str - length suff) str
+ | otherwise = str
+
+bye :: String -> IO a
+bye s = putStr s >> exitWith ExitSuccess
+
die :: String -> IO a
die s = hPutStr stderr s >> exitWith (ExitFailure 1)
dieMsg :: String -> IO a
-dieMsg s = getProgName >>= \prog -> die (prog ++ ": " ++ s)
+dieMsg s = getProgramName >>= \prog -> die (prog ++ ": " ++ s)
mapSnd :: (b -> c) -> [(a,b)] -> [(a,c)]
mapSnd _ [] = []