Commit 49e3cdae authored by Simon Marlow's avatar Simon Marlow
Browse files

Refactorings only

Here are a batch of refactorings to clean up parsing and parts of the
simple build system.  This patch originated in a patch sent to
cabal-devel@haskell.org with an intial implementation of
configurations.  Since then we decided to go a different route with
configurations, so I have separated the refactoring from the
configurations patch.

At this point, 2 tests fail for me, but I get the same 2 failures
without this patch.
parent a73d4db2
......@@ -69,7 +69,7 @@ import HUnit (Test)
data CompilerFlavor
= GHC | NHC | Hugs | HBC | Helium | JHC | OtherCompiler String
deriving (Show, Read, Eq)
deriving (Show, Read, Eq, Ord)
data Compiler = Compiler {compilerFlavor:: CompilerFlavor,
compilerVersion :: Version,
......
......@@ -55,7 +55,7 @@ module Distribution.InstalledPackageInfo (
) where
import Distribution.ParseUtils (
StanzaField(..), singleStanza, ParseResult(..), LineNo,
FieldDescr(..), readFields, ParseResult(..), LineNo,
simpleField, listField, parseLicenseQ,
parseFilePathQ, parseTokenQ, parseModuleNameQ, parsePackageNameQ,
showFilePath, showToken, parseReadS, parseOptVersion, parseQuoted,
......@@ -149,16 +149,16 @@ noVersion = Version{ versionBranch=[], versionTags=[] }
parseInstalledPackageInfo :: String -> ParseResult InstalledPackageInfo
parseInstalledPackageInfo inp = do
stLines <- singleStanza inp
stLines <- readFields inp
-- not interested in stanzas, so just allow blank lines in
-- the package info.
foldM (parseBasicStanza all_fields) emptyInstalledPackageInfo stLines
parseBasicStanza :: [StanzaField a]
parseBasicStanza :: [FieldDescr a]
-> a
-> (LineNo, String, String)
-> ParseResult a
parseBasicStanza ((StanzaField name _ set):fields) pkg (lineNo, f, val)
parseBasicStanza ((FieldDescr name _ set):fields) pkg (lineNo, f, val)
| name == f = set lineNo val pkg
| otherwise = parseBasicStanza fields pkg (lineNo, f, val)
parseBasicStanza [] pkg (_, _, _) = return pkg
......@@ -170,14 +170,14 @@ showInstalledPackageInfo :: InstalledPackageInfo -> String
showInstalledPackageInfo pkg = render (ppFields all_fields)
where
ppFields [] = empty
ppFields ((StanzaField name get' _):flds) =
ppFields ((FieldDescr name get' _):flds) =
pprField name (get' pkg) $$ ppFields flds
showInstalledPackageInfoField
:: String
-> Maybe (InstalledPackageInfo -> String)
showInstalledPackageInfoField field
= case [ (f,get') | (StanzaField f get' _) <- all_fields, f == field ] of
= case [ (f,get') | (FieldDescr f get' _) <- all_fields, f == field ] of
[] -> Nothing
((f,get'):_) -> Just (render . pprField f . get')
......@@ -187,11 +187,11 @@ pprField name field = text name <> colon <+> field
-- -----------------------------------------------------------------------------
-- Description of the fields, for parsing/printing
all_fields :: [StanzaField InstalledPackageInfo]
all_fields = basicStanzaFields ++ installedStanzaFields
all_fields :: [FieldDescr InstalledPackageInfo]
all_fields = basicFieldDescrs ++ installedFieldDescrs
basicStanzaFields :: [StanzaField InstalledPackageInfo]
basicStanzaFields =
basicFieldDescrs :: [FieldDescr InstalledPackageInfo]
basicFieldDescrs =
[ simpleField "name"
text parsePackageNameQ
(pkgName . package) (\name pkg -> pkg{package=(package pkg){pkgName=name}})
......@@ -227,8 +227,8 @@ basicStanzaFields =
author (\val pkg -> pkg{author=val})
]
installedStanzaFields :: [StanzaField InstalledPackageInfo]
installedStanzaFields = [
installedFieldDescrs :: [FieldDescr InstalledPackageInfo]
installedFieldDescrs = [
simpleField "exposed"
(text.show) parseReadS
exposed (\val pkg -> pkg{exposed=val})
......
This diff is collapsed.
......@@ -44,29 +44,32 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
-- #hide
module Distribution.ParseUtils (
LineNo, PError(..), PWarning,
locatedErrorMsg, showError, syntaxError, warning,
LineNo, PError(..), PWarning, locatedErrorMsg, syntaxError, warning,
runP, ParseResult(..),
StanzaField(..), splitStanzas, Stanza, singleStanza,
Field,
FieldDescr(..), readFields,
parseFilePathQ, parseTokenQ,
parseModuleNameQ, parseDependency, parseOptVersion,
parsePackageNameQ, parseVersionRangeQ,
parseTestedWithQ, parseLicenseQ, parseExtensionQ, parseCommaList, parseOptCommaList,
parseTestedWithQ, parseLicenseQ, parseExtensionQ,
parseSepList, parseCommaList, parseOptCommaList,
showFilePath, showToken, showTestedWith, showDependency, showFreeText,
simpleField, listField, commaListField, optsField,
field, simpleField, listField, commaListField, optsField, liftField,
parseReadS, parseReadSQ, parseQuoted,
) where
import Text.PrettyPrint.HughesPJ
import Distribution.Compiler (CompilerFlavor)
import Distribution.License
import Distribution.Version
import Distribution.Package ( parsePackageName )
import Distribution.Compat.ReadP as ReadP hiding (get)
import Distribution.Compat.FilePath (platformPath)
import Language.Haskell.Extension (Extension)
import Text.PrettyPrint.HughesPJ
import Control.Monad (liftM)
import Data.Char
import Language.Haskell.Extension (Extension)
import Data.Maybe ( fromMaybe)
-- -----------------------------------------------------------------------------
......@@ -91,23 +94,16 @@ instance Monad ParseResult where
fail s = ParseFailed (FromString s Nothing)
runP :: LineNo -> String -> ReadP a a -> String -> ParseResult a
runP lineNo field p s =
runP lineNo fieldname p s =
case [ x | (x,"") <- results ] of
[a] -> ParseOk [] a
[] -> case [ x | (x,ys) <- results, all isSpace ys ] of
[a] -> ParseOk [] a
[] -> ParseFailed (NoParse field lineNo)
_ -> ParseFailed (AmbigousParse field lineNo)
_ -> ParseFailed (AmbigousParse field lineNo)
[] -> ParseFailed (NoParse fieldname lineNo)
_ -> ParseFailed (AmbigousParse fieldname lineNo)
_ -> ParseFailed (AmbigousParse fieldname lineNo)
where results = readP_to_S p s
-- TODO: deprecated
showError :: PError -> String
showError e =
case locatedErrorMsg e of
(Just n, s) -> "Line "++show n++": " ++ s
(Nothing, s) -> s
locatedErrorMsg :: PError -> (Maybe LineNo, String)
locatedErrorMsg (AmbigousParse f n) = (Just n, "Ambigous parse in field '"++f++"'")
locatedErrorMsg (NoParse f n) = (Just n, "Parse of field '"++f++"' failed: ")
......@@ -119,70 +115,61 @@ syntaxError n s = ParseFailed $ FromString s (Just n)
warning :: String -> ParseResult ()
warning s = ParseOk [s] ()
data StanzaField a
= StanzaField
data FieldDescr a
= FieldDescr
{ fieldName :: String
, fieldGet :: a -> Doc
, fieldSet :: LineNo -> String -> a -> ParseResult a
}
simpleField :: String -> (a -> Doc) -> (ReadP a a) -> (b -> a) -> (a -> b -> b) -> StanzaField b
simpleField name showF readF get set = StanzaField name
(\st -> showF (get st))
(\lineNo val st -> do
x <- runP lineNo name readF val
return (set x st))
commaListField :: String -> (a -> Doc) -> (ReadP [a] a) -> (b -> [a]) -> ([a] -> b -> b) -> StanzaField b
commaListField name showF readF get set = StanzaField name
(\st -> fsep (punctuate comma (map showF (get st))))
(\lineNo val st -> do
xs <- runP lineNo name (parseCommaList readF) val
return (set xs st))
listField :: String -> (a -> Doc) -> (ReadP [a] a) -> (b -> [a]) -> ([a] -> b -> b) -> StanzaField b
listField name showF readF get set = StanzaField name
(\st -> fsep (map showF (get st)))
(\lineNo val st -> do
xs <- runP lineNo name (parseOptCommaList readF) val
return (set xs st))
optsField :: String -> CompilerFlavor -> (b -> [(CompilerFlavor,[String])]) -> ([(CompilerFlavor,[String])] -> b -> b) -> StanzaField b
optsField name flavor get set = StanzaField name
(\st -> case lookup flavor (get st) of
Just args -> hsep (map text args)
Nothing -> empty)
(\_ val st ->
let
old_val = get st
old_args = case lookup flavor old_val of
Just args -> args
Nothing -> []
val' = filter (\(f,_) -> f/=flavor) old_val
in return (set ((flavor,words val++old_args) : val') st))
type Stanza = [(LineNo,String,String)]
-- |Split a string into blank line-separated stanzas of
-- "Field: value" groups
splitStanzas :: String -> ParseResult [Stanza]
splitStanzas = mapM mkStanza . map merge . groupStanzas . filter validLine . zip [1..] . map trimTrailingSpaces . lines
where validLine (_,s) = case dropWhile isSpace s of
'-':'-':_ -> False -- Comment
_ -> True
groupStanzas :: [(Int,String)] -> [[(Int,String)]]
groupStanzas [] = []
groupStanzas xs = let (ys,zs) = break (null . snd) xs
in ys : groupStanzas (dropWhile (null . snd) zs)
field :: String -> (a -> Doc) -> (ReadP a a) -> FieldDescr a
field name showF readF =
FieldDescr name showF (\lineNo val _st -> runP lineNo name readF val)
liftField :: (b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField get set (FieldDescr name showF parseF)
= FieldDescr name (\b -> showF (get b))
(\lineNo str b -> do
a <- parseF lineNo str (get b)
return (set a b))
simpleField :: String -> (a -> Doc) -> (ReadP a a)
-> (b -> a) -> (a -> b -> b) -> FieldDescr b
simpleField name showF readF get set
= liftField get set $ field name showF readF
commaListField :: String -> (a -> Doc) -> (ReadP [a] a)
-> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
commaListField name showF readF get set =
liftField get set $
field name (fsep . punctuate comma . map showF) (parseCommaList readF)
listField :: String -> (a -> Doc) -> (ReadP [a] a)
-> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
listField name showF readF get set =
liftField get set $
field name (fsep . map showF) (parseOptCommaList readF)
optsField :: String -> CompilerFlavor -> (b -> [(CompilerFlavor,[String])]) -> ([(CompilerFlavor,[String])] -> b -> b) -> FieldDescr b
optsField name flavor get set =
liftField (fromMaybe [] . lookup flavor . get)
(\opts b -> set (update flavor opts (get b)) b) $
field name (hsep . map text)
(sepBy parseTokenQ' (munch1 isSpace))
where
update f opts [] = [(f,opts)]
update f opts ((f',opts'):rest)
| f == f' = (f, opts ++ opts') : rest
| otherwise = (f',opts') : update f opts rest
trimTrailingSpaces :: String -> String
trimTrailingSpaces = reverse . dropWhile isSpace . reverse
-- |Split a file into "Field: value" groups, but blank lines have no
-- significance, unlike 'splitStanzas'. A field value may span over blank
-- lines.
singleStanza :: String -> ParseResult Stanza
singleStanza = mkStanza . merge . filter validLine . zip [1..] . map trimTrailingSpaces . lines
type Field = (LineNo,String,String)
-- |Split a file into "Field: value" groups
readFields :: String -> ParseResult [Field]
readFields = mkStanza . merge . filter validLine . zip [1..] . map trimTrailingSpaces . lines
where validLine (_,s) = case dropWhile isSpace s of
'-':'-':_ -> False -- Comment
[] -> False -- blank line
......@@ -196,29 +183,19 @@ merge ((n,x):(_,c:s):ys)
merge ((n,x):ys) = (n,x) : merge ys
merge [] = []
mkStanza :: [(Int,String)] -> ParseResult Stanza
mkStanza :: [(Int,String)] -> ParseResult [Field]
mkStanza [] = return []
mkStanza ((n,'#':xs):ys) | not (isSpace (head xs)) = do
ss <- mkStanza ys
return ((n, '#':dir, dropWhile isSpace val) : ss)
where (dir,val) = break isSpace xs
mkStanza ((n,xs):ys) =
case break (==':') xs of
(fld', ':':val) -> do
let fld'' = map toLower fld'
fld <- case () of
_ | fld'' == "hs-source-dir"
-> do warning "The field \"hs-source-dir\" is deprecated, please use hs-source-dirs."
return "hs-source-dirs"
| fld'' == "other-files"
-> do warning "The field \"other-files\" is deprecated, please use extra-source-files."
return "extra-source-files"
| otherwise -> return fld''
(fld0, ':':val) -> do
let fld = map toLower fld0
ss <- mkStanza ys
checkDuplField fld ss
return ((n, fld, dropWhile isSpace val):ss)
(_, _) -> syntaxError n "Invalid syntax (no colon after field name)"
where
checkDuplField _ [] = return ()
checkDuplField fld ((n',fld',_):xs')
| fld' == fld = syntaxError (max n n') $ "The field "++fld++" was already defined on line " ++ show (min n n')
| otherwise = checkDuplField fld xs'
-- |parse a module name
parseModuleNameQ :: ReadP r String
......@@ -278,15 +255,22 @@ parseReadSQ = parseQuoted parseReadS <++ parseReadS
parseTokenQ :: ReadP r String
parseTokenQ = parseReadS <++ munch1 (\x -> not (isSpace x) && x /= ',')
parseTokenQ' :: ReadP r String
parseTokenQ' = parseReadS <++ munch1 (\x -> not (isSpace x))
parseSepList :: ReadP r b
-> ReadP r a -- ^The parser for the stuff between commas
-> ReadP r [a]
parseSepList sepr p = sepBy p separator
where separator = skipSpaces >> sepr >> skipSpaces
parseCommaList :: ReadP r a -- ^The parser for the stuff between commas
-> ReadP r [a]
parseCommaList p = sepBy p separator
where separator = skipSpaces >> ReadP.char ',' >> skipSpaces
parseCommaList = parseSepList (ReadP.char ',')
parseOptCommaList :: ReadP r a -- ^The parser for the stuff between commas
-> ReadP r [a]
parseOptCommaList p = sepBy p separator
where separator = skipSpaces >> optional (ReadP.char ',') >> skipSpaces
-> ReadP r [a]
parseOptCommaList = parseSepList (optional (ReadP.char ','))
parseQuoted :: ReadP r a -> ReadP r a
parseQuoted p = between (ReadP.char '"') (ReadP.char '"') p
......
......@@ -34,6 +34,7 @@ module Distribution.Program(
, programOptsField
, defaultProgramConfiguration
, updateProgram
, maybeUpdateProgram
, userSpecifyPath
, userSpecifyArgs
, lookupProgram
......@@ -241,8 +242,8 @@ userSpecifyPath :: String -- ^Program name
-> ProgramConfiguration
userSpecifyPath name path conf'@(ProgramConfiguration conf)
= case Map.lookup name conf of
Just p -> updateProgram (Just p{programLocation=UserSpecified path}) conf'
Nothing -> updateProgram (Just $ Program name name [] (UserSpecified path))
Just p -> updateProgram p{programLocation=UserSpecified path} conf'
Nothing -> updateProgram (Program name name [] (UserSpecified path))
conf'
-- |User-specify the arguments for this program. Basically override
......@@ -254,15 +255,17 @@ userSpecifyArgs :: String -- ^Program name
-> ProgramConfiguration
userSpecifyArgs name args conf'@(ProgramConfiguration conf)
= case Map.lookup name conf of
Just p -> updateProgram (Just p{programArgs=(words args)}) conf'
Nothing -> updateProgram (Just $ Program name name (words args) EmptyLocation) conf'
Just p -> updateProgram p{programArgs=(words args)} conf'
Nothing -> updateProgram (Program name name (words args) EmptyLocation) conf'
-- |Update this program's entry in the configuration. No changes if
-- you pass in Nothing.
updateProgram :: Maybe Program -> ProgramConfiguration -> ProgramConfiguration
updateProgram (Just p@Program{programName=n}) (ProgramConfiguration conf)
updateProgram :: Program -> ProgramConfiguration -> ProgramConfiguration
updateProgram p@Program{programName=n} (ProgramConfiguration conf)
= ProgramConfiguration $ Map.insert n p conf
updateProgram Nothing conf = conf
maybeUpdateProgram :: Maybe Program -> ProgramConfiguration -> ProgramConfiguration
maybeUpdateProgram m c = maybe c (\p -> updateProgram p c) m
-- |Runs the given program.
rawSystemProgram :: Int -- ^Verbosity
......
......@@ -415,7 +415,7 @@ parseGlobalArgs :: ProgramConfiguration -> [String] -> IO (Action,[String])
parseGlobalArgs progConf args =
case getOpt' RequireOrder globalOptions args of
(flags, _, _, []) | hasHelpFlag flags -> do
(printGlobalHelp progConf)
printGlobalHelp progConf
exitWith ExitSuccess
(_, cname:cargs, extra_args, []) -> do
case lookupCommand cname (commandList progConf) of
......
......@@ -87,12 +87,12 @@ import Distribution.Simple.Register ( register, unregister,
import Distribution.Simple.Configure(getPersistBuildConfig, maybeGetPersistBuildConfig,
configure, writePersistBuildConfig, localBuildInfoFile)
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))
import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..), distPref,
srcPref, haddockPref )
import Distribution.Simple.Install(install)
import Distribution.Simple.Utils (die, currentDir, rawSystemVerbose,
defaultPackageDesc, defaultHookedPackageDesc,
moduleToFilePath, findFile,
distPref, srcPref, haddockPref)
moduleToFilePath, findFile, warn)
#if mingw32_HOST_OS || mingw32_TARGET_OS
import Distribution.Simple.Utils (rawSystemPath)
......@@ -107,6 +107,8 @@ import Distribution.License
import Control.Monad(when, unless)
import Data.List ( intersperse, unionBy )
import System.IO.Error (try)
import System.IO ( hPutStrLn, stderr )
import System.Environment ( getProgName )
import Distribution.GetOpt
import Distribution.Compat.Directory(createDirectoryIfMissing,removeDirectoryRecursive, copyFile)
......@@ -146,7 +148,7 @@ data UserHooks = UserHooks
-- |Hook to run before build command. Second arg indicates verbosity level.
preBuild :: Args -> BuildFlags -> IO HookedBuildInfo,
-- |Over-ride this hook to get different behavior during build.
-- |Over-ride this hook to gbet different behavior during build.
buildHook :: PackageDescription -> LocalBuildInfo -> Maybe UserHooks -> BuildFlags -> IO (),
-- |Hook to run after build command. Second arg indicates verbosity level.
postBuild :: Args -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ExitCode,
......@@ -211,57 +213,68 @@ data UserHooks = UserHooks
}
-- |A simple implementation of @main@ for a Cabal setup script.
-- | A simple implementation of @main@ for a Cabal setup script.
-- It reads the package description file using IO, and performs the
-- action specified on the command line.
defaultMain :: IO ()
defaultMain = getArgs >>= defaultMainArgs
defaultMain = defaultMain__ Nothing Nothing Nothing
-- | A version of 'defaultMain' that is passed the command line
-- arguments, rather than getting them from the environment.
defaultMainArgs :: [String] -> IO ()
defaultMainArgs args = do
let hooks = theRealDefaultUserHooks
get_pkg_descr verbosity
= defaultPackageDesc verbosity >>= readPackageDescription verbosity
(action, args') <- parseGlobalArgs (allPrograms hooks) args
defaultMainWorker get_pkg_descr action args' hooks
return ()
defaultMainArgs args = defaultMain__ (Just args) Nothing Nothing
-- | A customizable version of 'defaultMain'.
defaultMainWithHooks :: UserHooks -> IO ()
defaultMainWithHooks hooks = getArgs >>= defaultMainWithHooksArgs hooks
defaultMainWithHooks hooks = defaultMain__ Nothing (Just hooks) Nothing
-- | A customizable version of 'defaultMain' that also takes the command
-- line arguments.
defaultMainWithHooksArgs :: UserHooks -> [String] -> IO ()
defaultMainWithHooksArgs hooks args
= do args <- getArgs
(action, args') <- parseGlobalArgs (allPrograms hooks) args
let get_pkg_descr verbosity = do
maybeDesc <- readDesc hooks
maybe (defaultPackageDesc verbosity >>=
readPackageDescription verbosity)
return
maybeDesc
defaultMainWorker get_pkg_descr action args' hooks
return ()
-- |Like 'defaultMain', but accepts the package description as input
= defaultMain__ (Just args) (Just hooks) Nothing
-- | Like 'defaultMain', but accepts the package description as input
-- rather than using IO to read it.
defaultMainNoRead :: PackageDescription -> IO ()
defaultMainNoRead pkg_descr
= do args <- getArgs
let hooks = theRealDefaultUserHooks
(action, args') <- parseGlobalArgs (allPrograms hooks) args
defaultMainWorker (\_ -> return pkg_descr) action args' hooks
return ()
-- |Combine the programs in the given hooks with the programs built
defaultMainNoRead pkg_descr = defaultMain__ Nothing Nothing (Just pkg_descr)
defaultMain__ :: Maybe [String]
-> Maybe UserHooks
-> Maybe PackageDescription
-> IO ()
defaultMain__ margs mhooks mdescr = do
args <- maybe getArgs return margs
let hooks = maybe simpleUserHooks id mhooks
let prog_conf = allPrograms hooks
(action, args') <- parseGlobalArgs prog_conf args
let get_pkg_descr verbosity =
case mdescr of
Just pkg_descr -> return pkg_descr
Nothing ->
case mhooks of
Nothing -> defaultPkgDescr
Just h -> do
maybeDesc <- readDesc h
case maybeDesc of
Nothing -> defaultPkgDescr
Just p -> return p
where
defaultPkgDescr = do
pkg_descr_file <- defaultPackageDesc verbosity
readPackageDescription verbosity pkg_descr_file
defaultMainWorker get_pkg_descr action args' hooks prog_conf
return ()
-- | Combine the programs in the given hooks with the programs built
-- into cabal.
allPrograms :: UserHooks
-> ProgramConfiguration -- combine defaults w/ user programs
allPrograms hooks = foldl (\pConf p -> updateProgram (Just p) pConf)
defaultProgramConfiguration
(hookedPrograms hooks)
allPrograms h = foldl (flip updateProgram)
defaultProgramConfiguration
(hookedPrograms h)
-- |Combine the preprocessors in the given hooks with the
-- | Combine the preprocessors in the given hooks with the
-- preprocessors built into cabal.
allSuffixHandlers :: Maybe UserHooks
-> [PPSuffixHandler]
......@@ -273,135 +286,107 @@ allSuffixHandlers hooks
overridesPP :: [PPSuffixHandler] -> [PPSuffixHandler] -> [PPSuffixHandler]
overridesPP = unionBy (\x y -> fst x == fst y)
-- |Helper function for /defaultMain/ and /defaultMainNoRead/
-- | Helper function for /defaultMain/
defaultMainWorker :: (Int -> IO PackageDescription)
-> Action
-> [String] -- ^args1
-> [String]
-> UserHooks
-> ProgramConfiguration
-> IO ExitCode
defaultMainWorker get_pkg_descr action args hooks
defaultMainWorker get_pkg_descr action all_args hooks prog_conf
= do case action of
ConfigCmd flags -> do
(flags', optFns, args') <-
parseConfigureArgs (allPrograms hooks) flags args [buildDirOpt]
pkg_descr <- hookOrInArgs preConf args' flags' configVerbose
(flags', optFns, args) <-
parseConfigureArgs prog_conf flags all_args [buildDirOpt]
pbi <- preConf hooks args flags'
pkg_descr0 <- get_pkg_descr (configVerbose flags')
let pkg_descr = updatePackageDescription pbi pkg_descr0
(warns, ers) <- sanityCheckPackage pkg_descr
errorOut (configVerbose flags') warns ers
let c = confHook hooks
localbuildinfo <- c pkg_descr flags'
writePersistBuildConfig (foldr id localbuildinfo optFns)
postHook postConf args' flags' pkg_descr localbuildinfo
BuildCmd -> do
(flags, _, args') <- parseBuildArgs args []
pkg_descr <- hookOrInArgs preBuild args' flags buildVerbose
localbuildinfo <- getPersistBuildConfig
cmdHook buildHook pkg_descr localbuildinfo flags
postHook postBuild args' flags pkg_descr localbuildinfo
HaddockCmd -> do
(flags, _, args') <- parseHaddockArgs emptyHaddockFlags args []
pkg_descr <- hookOrInArgs preHaddock args' flags haddockVerbose
localbuildinfo <- getPersistBuildConfig
cmdHook haddockHook pkg_descr localbuildinfo flags
postHook postHaddock args' flags pkg_descr localbuildinfo
localbuildinfo <- confHook hooks pkg_descr flags'
writePersistBuildConfig (foldr id localbuildinfo optFns)
postConf hooks args flags' pkg_descr localbuildinfo
BuildCmd ->
command parseBuildArgs buildVerbose
preBuild buildHook postBuild
getPersistBuildConfig
HaddockCmd ->
command (parseHaddockArgs emptyHaddockFlags) haddockVerbose
preHaddock haddockHook postHaddock
getPersistBuildConfig
ProgramaticaCmd -> do
(flags, _, args') <- parseProgramaticaArgs args []
pkg_descr <- hookOrInArgs prePFE args' flags pfeVerbose
localbuildinfo <- getPersistBuildConfig
cmdHook pfeHook pkg_descr localbuildinfo flags
postHook postPFE args' flags pkg_descr localbuildinfo
command parseProgramaticaArgs pfeVerbose
prePFE pfeHook postPFE
getPersistBuildConfig
CleanCmd -> do
(flags,_, args') <- parseCleanArgs emptyCleanFlags args []