From e657726555e1e7a494c5a759547b1d102d54c236 Mon Sep 17 00:00:00 2001
From: panne <unknown>
Date: Wed, 27 Aug 2003 07:50:03 +0000
Subject: [haddock @ 2003-08-27 07:50:02 by panne] * Made -D a short option for
 --dump-interface. * Made -m a short option for --ms-help. * Made -n a short
 option for --no-implicit-prelude. * Made -c a short option for --css. *
 Removed DocBook options from executable (they didn't do anything),   but mark
 them as reserved in the docs. Note that the short option   for DocBook output
 is now -S (from SGML) instead of -d. The latter   is now a short option for
 --debug. * The order of the Options in the documentation now matches the
 order   printed by Haddock itself.

Note: Although changing the names of options is often a bad idea, I'd
really like to make the options for the programs in fptools more
consistent and compatible to the ones used in common GNU programs.
---
 src/HaddockUtil.hs | 15 ++++++++++++---
 1 file changed, 12 insertions(+), 3 deletions(-)

(limited to 'src/HaddockUtil.hs')

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 _ [] = []
-- 
cgit v1.2.3