Commit 3a2dd4de authored by Mikhail Glushenkov's avatar Mikhail Glushenkov
Browse files

Add a 'haddock' section to '~/.cabal/config'.

Fixes #931, #1585.

The new config file section looks like this by default:

    haddock
      -- keep-temp-files: False
      -- hoogle: False
      -- html: False
      -- html-location:
      -- executables: False
      -- tests: False
      -- benchmarks: False
      -- all:
      -- internal: False
      -- css:
      -- hyperlink-source: False
      -- hscolour-css:
      -- contents-location:
parent ac7a5bfa
......@@ -35,7 +35,6 @@ module Distribution.Client.Config (
withProgramOptionsFields
) where
import Distribution.Client.Types
( RemoteRepo(..), Username(..), Password(..) )
import Distribution.Client.BuildReports.Types
......@@ -52,6 +51,7 @@ import Distribution.Simple.Compiler
( OptimisationLevel(..) )
import Distribution.Simple.Setup
( ConfigFlags(..), configureOptions, defaultConfigFlags
, HaddockFlags(..), haddockOptions, defaultHaddockFlags
, installDirsOptions
, programConfigurationPaths', programConfigurationOptions
, Flag(..), toFlag, flagToMaybe, fromFlagOrDefault )
......@@ -121,7 +121,8 @@ data SavedConfig = SavedConfig {
savedUserInstallDirs :: InstallDirs (Flag PathTemplate),
savedGlobalInstallDirs :: InstallDirs (Flag PathTemplate),
savedUploadFlags :: UploadFlags,
savedReportFlags :: ReportFlags
savedReportFlags :: ReportFlags,
savedHaddockFlags :: HaddockFlags
}
instance Monoid SavedConfig where
......@@ -133,7 +134,8 @@ instance Monoid SavedConfig where
savedUserInstallDirs = mempty,
savedGlobalInstallDirs = mempty,
savedUploadFlags = mempty,
savedReportFlags = mempty
savedReportFlags = mempty,
savedHaddockFlags = mempty
}
mappend a b = SavedConfig {
savedGlobalFlags = combine savedGlobalFlags,
......@@ -143,7 +145,8 @@ instance Monoid SavedConfig where
savedUserInstallDirs = combine savedUserInstallDirs,
savedGlobalInstallDirs = combine savedGlobalInstallDirs,
savedUploadFlags = combine savedUploadFlags,
savedReportFlags = combine savedReportFlags
savedReportFlags = combine savedReportFlags,
savedHaddockFlags = combine savedHaddockFlags
}
where combine field = field a `mappend` field b
......@@ -359,7 +362,8 @@ commentSavedConfig = do
savedUserInstallDirs = fmap toFlag userInstallDirs,
savedGlobalInstallDirs = fmap toFlag globalInstallDirs,
savedUploadFlags = commandDefaultFlags uploadCommand,
savedReportFlags = commandDefaultFlags reportCommand
savedReportFlags = commandDefaultFlags reportCommand,
savedHaddockFlags = defaultHaddockFlags
}
-- | All config file fields.
......@@ -510,18 +514,25 @@ parseConfig initial = \str -> do
config <- parse others
let user0 = savedUserInstallDirs config
global0 = savedGlobalInstallDirs config
(user, global, paths, args) <-
foldM parseSections (user0, global0, [], []) knownSections
(haddockFlags, user, global, paths, args) <-
foldM parseSections
(savedHaddockFlags config, user0, global0, [], [])
knownSections
return config {
savedConfigureFlags = (savedConfigureFlags config) {
configProgramPaths = paths,
configProgramArgs = args
},
savedHaddockFlags = haddockFlags {
haddockProgramPaths = paths,
haddockProgramArgs = args
},
savedUserInstallDirs = user,
savedGlobalInstallDirs = global
}
where
isKnownSection (ParseUtils.Section _ "haddock" _ _) = True
isKnownSection (ParseUtils.Section _ "install-dirs" _ _) = True
isKnownSection (ParseUtils.Section _ "program-locations" _ _) = True
isKnownSection (ParseUtils.Section _ "program-default-options" _ _) = True
......@@ -530,26 +541,34 @@ parseConfig initial = \str -> do
parse = parseFields (configFieldDescriptions
++ deprecatedFieldDescriptions) initial
parseSections accum@(u,g,p,a) (ParseUtils.Section _ "install-dirs" name fs)
parseSections accum@(h,u,g,p,a)
(ParseUtils.Section _ "haddock" name fs)
| name == "" = do h' <- parseFields haddockFlagsFields h fs
return (h', u, g, p, a)
| otherwise = do
warning "The 'haddock' section should be unnamed"
return accum
parseSections accum@(h,u,g,p,a)
(ParseUtils.Section _ "install-dirs" name fs)
| name' == "user" = do u' <- parseFields installDirsFields u fs
return (u', g, p, a)
return (h, u', g, p, a)
| name' == "global" = do g' <- parseFields installDirsFields g fs
return (u, g', p, a)
return (h, u, g', p, a)
| otherwise = do
warning "The 'install-paths' section should be for 'user' or 'global'"
return accum
where name' = lowercase name
parseSections accum@(u,g,p,a)
parseSections accum@(h,u,g,p,a)
(ParseUtils.Section _ "program-locations" name fs)
| name == "" = do p' <- parseFields withProgramsFields p fs
return (u, g, p', a)
return (h, u, g, p', a)
| otherwise = do
warning "The 'program-locations' section should be unnamed"
return accum
parseSections accum@(u, g, p, a)
parseSections accum@(h, u, g, p, a)
(ParseUtils.Section _ "program-default-options" name fs)
| name == "" = do a' <- parseFields withProgramOptionsFields a fs
return (u, g, p, a')
return (h, u, g, p, a')
| otherwise = do
warning "The 'program-default-options' section should be unnamed"
return accum
......@@ -564,6 +583,9 @@ showConfigWithComments :: SavedConfig -> SavedConfig -> String
showConfigWithComments comment vals = Disp.render $
ppFields configFieldDescriptions mcomment vals
$+$ Disp.text ""
$+$ ppSection "haddock" "" haddockFlagsFields
(fmap savedHaddockFlags mcomment) (savedHaddockFlags vals)
$+$ Disp.text ""
$+$ installDirsSection "user" savedUserInstallDirs
$+$ Disp.text ""
$+$ installDirsSection "global" savedGlobalInstallDirs
......@@ -583,10 +605,20 @@ showConfigWithComments comment vals = Disp.render $
(fmap (field . savedConfigureFlags) mcomment)
((field . savedConfigureFlags) vals)
-- | Fields for the 'install-dirs' sections.
installDirsFields :: [FieldDescr (InstallDirs (Flag PathTemplate))]
installDirsFields = map viewAsFieldDescr installDirsOptions
-- | Fields for the 'haddock' section.
haddockFlagsFields :: [FieldDescr HaddockFlags]
haddockFlagsFields = [ field
| opt <- haddockOptions ParseArgs
, let field = viewAsFieldDescr opt
name = fieldName field
, name `notElem` exclusions ]
where
exclusions = ["verbose", "builddir"]
-- | Fields for the 'program-locations' section.
withProgramsFields :: [FieldDescr [(String, FilePath)]]
withProgramsFields =
......
......@@ -39,7 +39,7 @@ import Distribution.Client.Setup
, reportCommand
)
import Distribution.Simple.Setup
( HaddockFlags(..), haddockCommand
( HaddockFlags(..), haddockCommand, defaultHaddockFlags
, HscolourFlags(..), hscolourCommand
, ReplFlags(..), replCommand
, CopyFlags(..), copyCommand
......@@ -214,10 +214,9 @@ mainWorker args = topHandler $
,replCommand defaultProgramConfiguration
`commandAddAction` replAction
,sandboxCommand `commandAddAction` sandboxAction
,haddockCommand `commandAddAction` haddockAction
,wrapperAction copyCommand
copyVerbosity copyDistPref
,wrapperAction haddockCommand
haddockVerbosity haddockDistPref
,wrapperAction cleanCommand
cleanVerbosity cleanDistPref
,wrapperAction hscolourCommand
......@@ -636,6 +635,8 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags)
savedConfigureExFlags config `mappend` configExFlags
installFlags' = defaultInstallFlags `mappend`
savedInstallFlags config `mappend` installFlags
haddockFlags' = defaultHaddockFlags `mappend`
savedHaddockFlags config `mappend` haddockFlags
globalFlags' = savedGlobalFlags config `mappend` globalFlags
(comp, platform, conf) <- configCompilerAux' configFlags'
......@@ -670,7 +671,7 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags)
comp platform conf
useSandbox mSandboxPkgInfo
globalFlags' configFlags'' configExFlags'
installFlags' haddockFlags
installFlags' haddockFlags'
targets
testAction :: (TestFlags, BuildFlags, BuildExFlags) -> [String] -> GlobalFlags
......@@ -735,6 +736,20 @@ benchmarkAction (benchmarkFlags, buildFlags, buildExFlags)
setupWrapper verbosity setupOptions Nothing
Cabal.benchmarkCommand (const benchmarkFlags) extraArgs
haddockAction :: HaddockFlags -> [String] -> GlobalFlags -> IO ()
haddockAction haddockFlags extraArgs globalFlags = do
let verbosity = fromFlag (haddockVerbosity haddockFlags)
(_useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags mempty
let haddockFlags' = defaultHaddockFlags `mappend`
savedHaddockFlags config `mappend` haddockFlags
setupScriptOptions = defaultSetupScriptOptions {
useDistPref = fromFlagOrDefault
(useDistPref defaultSetupScriptOptions)
(haddockDistPref haddockFlags')
}
setupWrapper verbosity setupScriptOptions Nothing
haddockCommand (const haddockFlags') extraArgs
listAction :: ListFlags -> [String] -> GlobalFlags -> IO ()
listAction listFlags extraArgs globalFlags = do
let verbosity = fromFlag (listVerbosity listFlags)
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment