From 59b188d7089a639f72b35c6d522b7cb4e9809545 Mon Sep 17 00:00:00 2001
From: David Waern <david.waern@gmail.com>
Date: Fri, 14 May 2010 19:01:52 +0000
Subject: Move flag evaluation code from Main to Haddock.Options Determining
 the value of "singular" flags (by e.g. taking the last occurrence of the
 flag) and other flag evaluation should done in Haddock.Options which is the
 module that is supposed to define the command line interface. This makes Main
 a bit easier on the eyes as well.

---
 src/Haddock/Options.hs | 60 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 60 insertions(+)

(limited to 'src/Haddock/Options.hs')

diff --git a/src/Haddock/Options.hs b/src/Haddock/Options.hs
index 89a79a41..1c194166 100644
--- a/src/Haddock/Options.hs
+++ b/src/Haddock/Options.hs
@@ -15,11 +15,20 @@ module Haddock.Options (
   parseHaddockOpts,
   Flag(..),
   getUsage,
+  optTitle,
+  outputDir,
+  optContentsUrl,
+  optIndexUrl,
+  optHtmlHelpFormat,
+  optCssFile,
+  optSourceUrls,
+  optWikiUrls,
   ghcFlags,
   ifacePairs
 ) where
 
 
+import Data.Maybe
 import Haddock.Utils
 import Haddock.Types
 import System.Console.GetOpt 
@@ -43,6 +52,50 @@ parseHaddockOpts params =
       throwE (concat errors ++ usage)
 
 
+optTitle :: [Flag] -> Maybe String  
+optTitle flags =
+  case [str | Flag_Heading str <- flags] of
+    [] -> Nothing
+    (t:_) -> Just t
+
+
+outputDir :: [Flag] -> FilePath
+outputDir flags = 
+  case [ path | Flag_OutputDir path <- flags ] of
+    []    -> "."
+    paths -> last paths
+
+
+optContentsUrl :: [Flag] -> Maybe String
+optContentsUrl flags = optLast [ url | Flag_UseContents url <- flags ]
+
+
+optIndexUrl :: [Flag] -> Maybe String
+optIndexUrl flags = optLast [ url | Flag_UseIndex url <- flags ]
+
+
+optHtmlHelpFormat :: [Flag] -> Maybe String
+optHtmlHelpFormat flags = optLast [ hhformat | Flag_HtmlHelp hhformat <- flags ]
+
+
+optCssFile :: [Flag] -> Maybe FilePath
+optCssFile flags = optLast [ str | Flag_CSS str <- flags ]
+
+
+optSourceUrls :: [Flag] -> (Maybe String, Maybe String, Maybe String)
+optSourceUrls flags =
+  (listToMaybe [str | Flag_SourceBaseURL   str <- flags]
+  ,listToMaybe [str | Flag_SourceModuleURL str <- flags]
+  ,listToMaybe [str | Flag_SourceEntityURL str <- flags])
+
+
+optWikiUrls :: [Flag] -> (Maybe String, Maybe String, Maybe String)
+optWikiUrls flags =
+  (listToMaybe [str | Flag_WikiBaseURL   str <- flags]
+  ,listToMaybe [str | Flag_WikiModuleURL str <- flags]
+  ,listToMaybe [str | Flag_WikiEntityURL str <- flags])
+
+
 ghcFlags :: [Flag] -> [String]
 ghcFlags flags = [ option | Flag_OptGhc option <- flags ]
 
@@ -169,3 +222,10 @@ options backwardsCompat =
     Option [] ["no-tmp-comp-dir"] (NoArg Flag_NoTmpCompDir)
         "don't re-direct compilation output to a temporary directory"
    ]
+
+
+-- | Like 'listToMaybe' but returns the last element instead of the first.
+optLast :: [a] -> Maybe a
+optLast [] = Nothing
+optLast xs = Just (last xs)
+
-- 
cgit v1.2.3