Repository : ssh://darcs.haskell.org//srv/darcs/haddock

On branch  : ghc-7.4

http://hackage.haskell.org/trac/ghc/changeset/29861370dd56f59557c3bcecd53fba0f88a89792

>---------------------------------------------------------------

commit 29861370dd56f59557c3bcecd53fba0f88a89792
Author: Henning Thielemann <[email protected]>
Date:   Sun Apr 1 16:25:02 2012 +0200

    emit an error message when the --qual option is used incorrectly

>---------------------------------------------------------------

 src/Haddock/Options.hs |   13 ++++++++-----
 src/Main.hs            |    6 +++++-
 2 files changed, 13 insertions(+), 6 deletions(-)

diff --git a/src/Haddock/Options.hs b/src/Haddock/Options.hs
index 3292ba1..537bffa 100644
--- a/src/Haddock/Options.hs
+++ b/src/Haddock/Options.hs
@@ -229,13 +229,16 @@ optLaTeXStyle :: [Flag] -> Maybe String
 optLaTeXStyle flags = optLast [ str | Flag_LaTeXStyle str <- flags ]
 
 
-qualification :: [Flag] -> QualOption
+qualification :: [Flag] -> Either String QualOption
 qualification flags =
   case map (map Char.toLower) [ str | Flag_Qualification str <- flags ] of
-      "full":_     -> OptFullQual
-      "local":_    -> OptLocalQual
-      "relative":_ -> OptRelativeQual
-      _            -> OptNoQual
+      []           -> Right OptNoQual
+      ["none"]     -> Right OptNoQual
+      ["full"]     -> Right OptFullQual
+      ["local"]    -> Right OptLocalQual
+      ["relative"] -> Right OptRelativeQual
+      [arg]        -> Left $ "unknown qualification type " ++ show arg
+      _:_          -> Left "qualification option given multiple times"
 
 
 verbosity :: [Flag] -> Verbosity
diff --git a/src/Main.hs b/src/Main.hs
index e423cf0..7d83866 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -189,6 +189,11 @@ renderStep flags pkgs interfaces = do
 render :: [Flag] -> [Interface] -> [InstalledInterface] -> SrcMap -> IO ()
 render flags ifaces installedIfaces srcMap = do
 
+  opt_qualification <-
+    case qualification flags of
+      Left msg -> throwE msg
+      Right q -> return q
+
   let
     title                = fromMaybe "" (optTitle flags)
     unicode              = Flag_UseUnicode `elem` flags
@@ -198,7 +203,6 @@ render flags ifaces installedIfaces srcMap = do
     opt_index_url        = optIndexUrl       flags
     odir                 = outputDir         flags
     opt_latex_style      = optLaTeXStyle     flags
-    opt_qualification    = qualification     flags
 
     visibleIfaces    = [ i | i <- ifaces, OptHide `notElem` ifaceOptions i ]
 



_______________________________________________
Cvs-ghc mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/cvs-ghc

Reply via email to