Commit 0530e0df authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Refactor command line arguments and flavours

* Get rid of unsafePerformIO using shakeExtra
* Move diagnostic info utilities to the library

See #347
parent db56cf4e
...@@ -20,7 +20,7 @@ executable hadrian ...@@ -20,7 +20,7 @@ executable hadrian
, src , src
other-modules: Base other-modules: Base
, Builder , Builder
, CmdLineFlag , CommandLine
, Context , Context
, Environment , Environment
, Expression , Expression
......
module CmdLineFlag ( module CommandLine (
putCmdLineFlags, cmdFlags, cmdBuildHaddock, cmdFlavour, cmdIntegerSimple, optDescrs, cmdLineArgsMap, cmdBuildHaddock, cmdFlavour, cmdIntegerSimple,
cmdProgressColour, cmdProgressInfo, ProgressInfo (..), cmdSkipConfigure, cmdProgressColour, cmdProgressInfo, cmdSkipConfigure, cmdSplitObjects
cmdSplitObjects
) where ) where
import Data.IORef import Data.Dynamic
import Data.Either
import qualified Data.HashMap.Strict as Map
import Data.List.Extra import Data.List.Extra
import Development.Shake hiding (Normal)
import Hadrian.Utilities import Hadrian.Utilities
import System.Console.GetOpt import System.Console.GetOpt
import System.IO.Unsafe import System.Environment
-- | 'CmdLineFlag.Untracked' is a collection of flags that can be passed via the -- | All arguments that can be passed to Hadrian via the command line.
-- command line. These flags are not tracked, that is they do not force any data CommandLineArgs = CommandLineArgs
-- build rules to be rurun.
data Untracked = Untracked
{ buildHaddock :: Bool { buildHaddock :: Bool
, flavour :: Maybe String , flavour :: Maybe String
, integerSimple :: Bool , integerSimple :: Bool
...@@ -23,11 +23,9 @@ data Untracked = Untracked ...@@ -23,11 +23,9 @@ data Untracked = Untracked
, splitObjects :: Bool } , splitObjects :: Bool }
deriving (Eq, Show) deriving (Eq, Show)
data ProgressInfo = None | Brief | Normal | Unicorn deriving (Eq, Show) -- | Default values for 'CommandLineArgs'.
defaultCommandLineArgs :: CommandLineArgs
-- | Default values for 'CmdLineFlag.Untracked'. defaultCommandLineArgs = CommandLineArgs
defaultUntracked :: Untracked
defaultUntracked = Untracked
{ buildHaddock = False { buildHaddock = False
, flavour = Nothing , flavour = Nothing
, integerSimple = False , integerSimple = False
...@@ -36,16 +34,16 @@ defaultUntracked = Untracked ...@@ -36,16 +34,16 @@ defaultUntracked = Untracked
, skipConfigure = False , skipConfigure = False
, splitObjects = False } , splitObjects = False }
readBuildHaddock :: Either String (Untracked -> Untracked) readBuildHaddock :: Either String (CommandLineArgs -> CommandLineArgs)
readBuildHaddock = Right $ \flags -> flags { buildHaddock = True } readBuildHaddock = Right $ \flags -> flags { buildHaddock = True }
readFlavour :: Maybe String -> Either String (Untracked -> Untracked) readFlavour :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
readFlavour ms = Right $ \flags -> flags { flavour = lower <$> ms } readFlavour ms = Right $ \flags -> flags { flavour = lower <$> ms }
readIntegerSimple :: Either String (Untracked -> Untracked) readIntegerSimple :: Either String (CommandLineArgs -> CommandLineArgs)
readIntegerSimple = Right $ \flags -> flags { integerSimple = True } readIntegerSimple = Right $ \flags -> flags { integerSimple = True }
readProgressColour :: Maybe String -> Either String (Untracked -> Untracked) readProgressColour :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
readProgressColour ms = readProgressColour ms =
maybe (Left "Cannot parse progress-colour") (Right . set) (go =<< lower <$> ms) maybe (Left "Cannot parse progress-colour") (Right . set) (go =<< lower <$> ms)
where where
...@@ -54,10 +52,10 @@ readProgressColour ms = ...@@ -54,10 +52,10 @@ readProgressColour ms =
go "auto" = Just Auto go "auto" = Just Auto
go "always" = Just Always go "always" = Just Always
go _ = Nothing go _ = Nothing
set :: UseColour -> Untracked -> Untracked set :: UseColour -> CommandLineArgs -> CommandLineArgs
set flag flags = flags { progressColour = flag } set flag flags = flags { progressColour = flag }
readProgressInfo :: Maybe String -> Either String (Untracked -> Untracked) readProgressInfo :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
readProgressInfo ms = readProgressInfo ms =
maybe (Left "Cannot parse progress-info") (Right . set) (go =<< lower <$> ms) maybe (Left "Cannot parse progress-info") (Right . set) (go =<< lower <$> ms)
where where
...@@ -67,17 +65,18 @@ readProgressInfo ms = ...@@ -67,17 +65,18 @@ readProgressInfo ms =
go "normal" = Just Normal go "normal" = Just Normal
go "unicorn" = Just Unicorn go "unicorn" = Just Unicorn
go _ = Nothing go _ = Nothing
set :: ProgressInfo -> Untracked -> Untracked set :: ProgressInfo -> CommandLineArgs -> CommandLineArgs
set flag flags = flags { progressInfo = flag } set flag flags = flags { progressInfo = flag }
readSkipConfigure :: Either String (Untracked -> Untracked) readSkipConfigure :: Either String (CommandLineArgs -> CommandLineArgs)
readSkipConfigure = Right $ \flags -> flags { skipConfigure = True } readSkipConfigure = Right $ \flags -> flags { skipConfigure = True }
readSplitObjects :: Either String (Untracked -> Untracked) readSplitObjects :: Either String (CommandLineArgs -> CommandLineArgs)
readSplitObjects = Right $ \flags -> flags { splitObjects = True } readSplitObjects = Right $ \flags -> flags { splitObjects = True }
cmdFlags :: [OptDescr (Either String (Untracked -> Untracked))] -- | Standard 'OptDescr' descriptions of Hadrian's command line arguments.
cmdFlags = optDescrs :: [OptDescr (Either String (CommandLineArgs -> CommandLineArgs))]
optDescrs =
[ Option [] ["flavour"] (OptArg readFlavour "FLAVOUR") [ Option [] ["flavour"] (OptArg readFlavour "FLAVOUR")
"Build flavour (Default, Devel1, Devel2, Perf, Prof, Quick or Quickest)." "Build flavour (Default, Devel1, Devel2, Perf, Prof, Quick or Quickest)."
, Option [] ["haddock"] (NoArg readBuildHaddock) , Option [] ["haddock"] (NoArg readBuildHaddock)
...@@ -93,36 +92,37 @@ cmdFlags = ...@@ -93,36 +92,37 @@ cmdFlags =
, Option [] ["split-objects"] (NoArg readSplitObjects) , Option [] ["split-objects"] (NoArg readSplitObjects)
"Generate split objects (requires a full clean rebuild)." ] "Generate split objects (requires a full clean rebuild)." ]
-- TODO: Avoid unsafePerformIO by using shakeExtra. -- | A type-indexed map containing Hadrian command line arguments to be passed
{-# NOINLINE cmdLineFlags #-} -- to Shake via 'shakeExtra'.
cmdLineFlags :: IORef Untracked cmdLineArgsMap :: IO (Map.HashMap TypeRep Dynamic)
cmdLineFlags = unsafePerformIO $ newIORef defaultUntracked cmdLineArgsMap = do
(opts, _, _) <- getOpt Permute optDescrs <$> getArgs
let args = foldl (flip id) defaultCommandLineArgs (rights opts)
return $ insertExtra (progressColour args) -- Accessed by Hadrian.Utilities
$ insertExtra (progressInfo args) -- Accessed by Hadrian.Utilities
$ insertExtra args Map.empty
putCmdLineFlags :: [Untracked -> Untracked] -> IO () cmdLineArgs :: Action CommandLineArgs
putCmdLineFlags flags = modifyIORef cmdLineFlags (\f -> foldl (flip id) f flags) cmdLineArgs = userSetting defaultCommandLineArgs
-- TODO: Avoid unsafePerformIO by using shakeExtra. cmdBuildHaddock :: Action Bool
{-# NOINLINE getCmdLineFlags #-} cmdBuildHaddock = buildHaddock <$> cmdLineArgs
getCmdLineFlags :: Untracked
getCmdLineFlags = unsafePerformIO $ readIORef cmdLineFlags
cmdBuildHaddock :: Bool cmdFlavour :: Action (Maybe String)
cmdBuildHaddock = buildHaddock getCmdLineFlags cmdFlavour = flavour <$> cmdLineArgs
cmdFlavour :: Maybe String cmdIntegerSimple :: Action Bool
cmdFlavour = flavour getCmdLineFlags cmdIntegerSimple = integerSimple <$> cmdLineArgs
cmdIntegerSimple :: Bool cmdProgressColour :: Action UseColour
cmdIntegerSimple = integerSimple getCmdLineFlags cmdProgressColour = progressColour <$> cmdLineArgs
cmdProgressColour :: UseColour cmdProgressInfo :: Action ProgressInfo
cmdProgressColour = progressColour getCmdLineFlags cmdProgressInfo = progressInfo <$> cmdLineArgs
cmdProgressInfo :: ProgressInfo cmdSkipConfigure :: Action Bool
cmdProgressInfo = progressInfo getCmdLineFlags cmdSkipConfigure = skipConfigure <$> cmdLineArgs
cmdSplitObjects :: Bool cmdSplitObjects :: Action Bool
cmdSplitObjects = splitObjects getCmdLineFlags cmdSplitObjects = splitObjects <$> cmdLineArgs
cmdSkipConfigure :: Bool
cmdSkipConfigure = skipConfigure getCmdLineFlags
...@@ -9,15 +9,15 @@ import Expression ...@@ -9,15 +9,15 @@ import Expression
-- * @Predicate@: a flag whose value can depend on the build environment and -- * @Predicate@: a flag whose value can depend on the build environment and
-- on the current build target. -- on the current build target.
data Flavour = Flavour data Flavour = Flavour
{ name :: String -- ^ Flavour name, to set from command line. { name :: String -- ^ Flavour name, to set from command line.
, args :: Args -- ^ Use these command line arguments. , args :: Args -- ^ Use these command line arguments.
, packages :: Packages -- ^ Build these packages. , packages :: Packages -- ^ Build these packages.
, integerLibrary :: Package -- ^ Either 'integerGmp' or 'integerSimple'. , integerLibrary :: Action Package -- ^ Either 'integerGmp' or 'integerSimple'.
, libraryWays :: Ways -- ^ Build libraries these ways. , libraryWays :: Ways -- ^ Build libraries these ways.
, rtsWays :: Ways -- ^ Build RTS these ways. , rtsWays :: Ways -- ^ Build RTS these ways.
, splitObjects :: Predicate -- ^ Build split objects. , splitObjects :: Predicate -- ^ Build split objects.
, buildHaddock :: Predicate -- ^ Build Haddock and documentation. , buildHaddock :: Predicate -- ^ Build Haddock and documentation.
, dynamicGhcPrograms :: Bool -- ^ Build dynamic GHC programs. , dynamicGhcPrograms :: Bool -- ^ Build dynamic GHC programs.
, ghciWithDebugger :: Bool -- ^ Enable GHCi debugger. , ghciWithDebugger :: Bool -- ^ Enable GHCi debugger.
, ghcProfiled :: Bool -- ^ Build profiled GHC. , ghcProfiled :: Bool -- ^ Build profiled GHC.
, ghcDebugged :: Bool } -- ^ Build GHC with debug information. , ghcDebugged :: Bool } -- ^ Build GHC with debug information.
module Hadrian.Utilities ( module Hadrian.Utilities (
-- * List manipulation -- * List manipulation
fromSingleton, replaceEq, minusOrd, intersectOrd, lookupAll, fromSingleton, replaceEq, minusOrd, intersectOrd, lookupAll,
...@@ -9,19 +8,30 @@ module Hadrian.Utilities ( ...@@ -9,19 +8,30 @@ module Hadrian.Utilities (
-- * FilePath manipulation -- * FilePath manipulation
unifyPath, (-/-), matchVersionedFilePath, unifyPath, (-/-), matchVersionedFilePath,
-- * Miscellaneous -- * Accessing Shake's type-indexed map
UseColour (..), putColoured insertExtra, userSetting,
-- * Diagnostic info
UseColour (..), putColoured, BuildProgressColour (..), putBuild,
SuccessColour (..), putSuccess, ProgressInfo (..),
putProgressInfo, renderAction, renderProgram, renderLibrary, renderBox,
renderUnicorn
) where ) where
import Control.Monad import Control.Monad
import Data.Char import Data.Char
import Data.Dynamic
import Data.HashMap.Strict (HashMap)
import Data.List.Extra import Data.List.Extra
import Development.Shake import Data.Maybe
import Development.Shake hiding (Normal)
import Development.Shake.FilePath import Development.Shake.FilePath
import System.Console.ANSI import System.Console.ANSI
import System.Info.Extra import System.Info.Extra
import System.IO import System.IO
import qualified Data.HashMap.Strict as Map
-- | Extract a value from a singleton list, or terminate with an error message -- | Extract a value from a singleton list, or terminate with an error message
-- if the list does not contain exactly one value. -- if the list does not contain exactly one value.
fromSingleton :: String -> [a] -> a fromSingleton :: String -> [a] -> a
...@@ -109,11 +119,24 @@ matchVersionedFilePath prefix suffix filePath = ...@@ -109,11 +119,24 @@ matchVersionedFilePath prefix suffix filePath =
Nothing -> False Nothing -> False
Just version -> all (\c -> isDigit c || c == '-' || c == '.') version Just version -> all (\c -> isDigit c || c == '-' || c == '.') version
data UseColour = Never | Auto | Always deriving (Eq, Show) -- | Insert a value into Shake's type-indexed map.
insertExtra :: Typeable a => a -> HashMap TypeRep Dynamic -> HashMap TypeRep Dynamic
insertExtra value = Map.insert (typeOf value) (toDyn value)
-- | Lookup a user setting in Shake's type-indexed map 'shakeExtra'. If the
-- setting is not found, return the provided default value instead.
userSetting :: Typeable a => a -> Action a
userSetting defaultValue = do
extra <- shakeExtra <$> getShakeOptions
let maybeValue = fromDynamic =<< Map.lookup (typeOf defaultValue) extra
return $ fromMaybe defaultValue maybeValue
data UseColour = Never | Auto | Always deriving (Eq, Show, Typeable)
-- | A more colourful version of Shake's 'putNormal'. -- | A more colourful version of Shake's 'putNormal'.
putColoured :: UseColour -> ColorIntensity -> Color -> String -> Action () putColoured :: ColorIntensity -> Color -> String -> Action ()
putColoured useColour intensity colour msg = do putColoured intensity colour msg = do
useColour <- userSetting Never
supported <- liftIO $ hSupportsANSI stdout supported <- liftIO $ hSupportsANSI stdout
let c Never = False let c Never = False
c Auto = supported || isWindows -- Colours do work on Windows c Auto = supported || isWindows -- Colours do work on Windows
...@@ -121,3 +144,126 @@ putColoured useColour intensity colour msg = do ...@@ -121,3 +144,126 @@ putColoured useColour intensity colour msg = do
when (c useColour) . liftIO $ setSGR [SetColor Foreground intensity colour] when (c useColour) . liftIO $ setSGR [SetColor Foreground intensity colour]
putNormal msg putNormal msg
when (c useColour) . liftIO $ setSGR [] >> hFlush stdout when (c useColour) . liftIO $ setSGR [] >> hFlush stdout
newtype BuildProgressColour = BuildProgressColour (ColorIntensity, Color)
deriving Typeable
-- | Default 'BuildProgressColour'.
magenta :: BuildProgressColour
magenta = BuildProgressColour (Dull, Magenta)
-- | Print a build progress message (e.g. executing a build command).
putBuild :: String -> Action ()
putBuild msg = do
BuildProgressColour (intensity, colour) <- userSetting magenta
putColoured intensity colour msg
newtype SuccessColour = SuccessColour (ColorIntensity, Color)
deriving Typeable
-- | Default 'SuccessColour'.
green :: SuccessColour
green = SuccessColour (Dull, Green)
-- | Print a success message (e.g. a package is built successfully).
putSuccess :: String -> Action ()
putSuccess msg = do
SuccessColour (intensity, colour) <- userSetting green
putColoured intensity colour msg
data ProgressInfo = None | Brief | Normal | Unicorn deriving (Eq, Show, Typeable)
-- | Version of 'putBuild' controlled by @--progress-info@ command line flag.
putProgressInfo :: String -> Action ()
putProgressInfo msg = do
progressInfo <- userSetting None
when (progressInfo /= None) $ putBuild msg
-- | Render an action.
renderAction :: String -> FilePath -> FilePath -> Action String
renderAction what input output = do
progressInfo <- userSetting Normal
return $ case progressInfo of
None -> ""
Brief -> "| " ++ what ++ ": " ++ i ++ " => " ++ o
Normal -> renderBox [ what, " input: " ++ i, " => output: " ++ o ]
Unicorn -> renderUnicorn [ what, " input: " ++ i, " => output: " ++ o ]
where
i = unifyPath input
o = unifyPath output
-- | Render the successful build of a program.
renderProgram :: String -> String -> String -> String
renderProgram name bin synopsis = renderBox [ "Successfully built program " ++ name
, "Executable: " ++ bin
, "Program synopsis: " ++ synopsis ++ "."]
-- | Render the successful build of a library.
renderLibrary :: String -> String -> String -> String
renderLibrary name lib synopsis = renderBox [ "Successfully built library " ++ name
, "Library: " ++ lib
, "Library synopsis: " ++ synopsis ++ "."]
-- | Render the given set of lines in an ASCII box. The minimum width and
-- whether to use Unicode symbols are hardcoded in the function's body.
--
-- >>> renderBox (words "lorem ipsum")
-- /----------\
-- | lorem |
-- | ipsum |
-- \----------/
renderBox :: [String] -> String
renderBox ls = tail $ concatMap ('\n' :) (boxTop : map renderLine ls ++ [boxBot])
where
-- Minimum total width of the box in characters
minimumBoxWidth = 32
-- TODO: Make this setting configurable? Setting to True by default seems
-- to work poorly with many fonts.
useUnicode = False
-- Characters to draw the box
(dash, pipe, topLeft, topRight, botLeft, botRight, padding)
| useUnicode = ('─', '│', '╭', '╮', '╰', '╯', ' ')
| otherwise = ('-', '|', '/', '\\', '\\', '/', ' ')
-- Box width, taking minimum desired length and content into account.
-- The -4 is for the beginning and end pipe/padding symbols, as
-- in "| xxx |".
boxContentWidth = (minimumBoxWidth - 4) `max` maxContentLength
where
maxContentLength = maximum (map length ls)
renderLine l = concat
[ [pipe, padding]
, padToLengthWith boxContentWidth padding l
, [padding, pipe] ]
where
padToLengthWith n filler x = x ++ replicate (n - length x) filler
(boxTop, boxBot) = ( topLeft : dashes ++ [topRight]
, botLeft : dashes ++ [botRight] )
where
-- +1 for each non-dash (= corner) char
dashes = replicate (boxContentWidth + 2) dash
-- | Render the given set of lines next to our favorite unicorn Robert.
renderUnicorn :: [String] -> String
renderUnicorn ls =
unlines $ take (max (length ponyLines) (length boxLines)) $
zipWith (++) (ponyLines ++ repeat ponyPadding) (boxLines ++ repeat "")
where
ponyLines :: [String]
ponyLines = [ " ,;,,;'"
, " ,;;'( Robert the spitting unicorn"
, " __ ,;;' ' \\ wants you to know"
, " /' '\\'~~'~' \\ /'\\.) that a task "
, " ,;( ) / |. / just finished! "
, " ,;' \\ /-.,,( ) \\ "
, " ^ ) / ) / )| Almost there! "
, " || || \\) "
, " (_\\ (_\\ " ]
ponyPadding :: String
ponyPadding = " "
boxLines :: [String]
boxLines = ["", "", ""] ++ (lines . renderBox $ ls)
module Main (main) where module Main (main) where
import Development.Shake import Development.Shake
import Hadrian.Utilities
import qualified CmdLineFlag import qualified CommandLine
import qualified Environment import qualified Environment
import qualified Rules import qualified Rules
import qualified Rules.Clean import qualified Rules.Clean
...@@ -11,28 +12,37 @@ import qualified Rules.SourceDist ...@@ -11,28 +12,37 @@ import qualified Rules.SourceDist
import qualified Rules.Selftest import qualified Rules.Selftest
import qualified Rules.Test import qualified Rules.Test
import qualified Settings.Path import qualified Settings.Path
import qualified UserSettings
main :: IO () main :: IO ()
main = shakeArgsWith options CmdLineFlag.cmdFlags $ \cmdLineFlags targets -> do main = do
CmdLineFlag.putCmdLineFlags cmdLineFlags -- Provide access to command line arguments and some user settings through
Environment.setupEnvironment -- Shake's type-indexed map 'shakeExtra'.
return . Just $ if null targets argsMap <- CommandLine.cmdLineArgsMap
then rules let extra = insertExtra UserSettings.buildProgressColour
else want targets >> withoutActions rules $ insertExtra UserSettings.successColour argsMap
where
rules :: Rules () options :: ShakeOptions
rules = do options = shakeOptions
Rules.buildRules { shakeChange = ChangeModtimeAndDigest
Rules.Clean.cleanRules , shakeFiles = Settings.Path.shakeFilesPath
Rules.Install.installRules , shakeProgress = progressSimple
Rules.oracleRules , shakeTimings = True
Rules.Selftest.selftestRules , shakeExtra = extra }
Rules.SourceDist.sourceDistRules
Rules.Test.testRules rules :: Rules ()
Rules.topLevelTargets rules = do
options :: ShakeOptions Rules.buildRules
options = shakeOptions Rules.Clean.cleanRules
{ shakeChange = ChangeModtimeAndDigest Rules.Install.installRules
, shakeFiles = Settings.Path.shakeFilesPath Rules.oracleRules
, shakeProgress = progressSimple Rules.Selftest.selftestRules
, shakeTimings = True } Rules.SourceDist.sourceDistRules
Rules.Test.testRules
Rules.topLevelTargets
shakeArgsWith options CommandLine.optDescrs $ \_ targets -> do
Environment.setupEnvironment
return . Just $ if null targets
then rules
else want targets >> withoutActions rules
...@@ -57,13 +57,13 @@ packageTargets stage pkg = do ...@@ -57,13 +57,13 @@ packageTargets stage pkg = do
then do -- Collect all targets of a library package. then do -- Collect all targets of a library package.
ways <- interpretInContext context getLibraryWays ways <- interpretInContext context getLibraryWays
libs <- mapM (pkgLibraryFile . Context stage pkg) ways libs <- mapM (pkgLibraryFile . Context stage pkg) ways
docs <- interpretInContext context $ buildHaddock flavour docs <- interpretInContext context =<< buildHaddock <$> flavour
more <- libraryTargets context more <- libraryTargets context
return $ [ pkgSetupConfigFile context | nonCabalContext context ] return $ [ pkgSetupConfigFile context | nonCabalContext context ]
++ [ pkgHaddockFile context | docs && stage == Stage1 ] ++ [ pkgHaddockFile context | docs && stage == Stage1 ]
++ libs ++ more ++ libs ++ more
else -- The only target of a program package is the executable. else -- The only target of a program package is the executable.
maybeToList <$> programPath (programContext stage pkg) fmap maybeToList . programPath =<< programContext stage pkg
packageRules :: Rules () packageRules :: Rules ()
packageRules = do packageRules = do
...@@ -77,24 +77,21 @@ packageRules = do ...@@ -77,24 +77,21 @@ packageRules = do
let contexts = liftM3 Context allStages knownPackages allWays let contexts = liftM3 Context allStages knownPackages allWays
vanillaContexts = liftM2 vanillaContext allStages knownPackages vanillaContexts = liftM2 vanillaContext allStages knownPackages
programContexts = liftM2 programContext allStages knownPackages
forM_ contexts $ mconcat forM_ contexts $ mconcat
[ Rules.Compile.compilePackage readPackageDb [ Rules.Compile.compilePackage readPackageDb
, Rules.Library.buildPackageLibrary ] , Rules.Library.buildPackageLibrary ]
let dynamicContexts = liftM3 Context [Stage1 ..] knownPackages [dynamic] let dynamicContexts = liftM3 Context [Stage1 ..] knownPackages [dynamic]
forM_ dynamicContexts Rules.Library.buildDynamicLib forM_ dynamicContexts Rules.Library.buildDynamicLib
forM_ programContexts $ Rules.Program.buildProgram readPackageDb
forM_ vanillaContexts $ mconcat forM_ vanillaContexts $ mconcat
[ Rules.Data.buildPackageData [ Rules.Data.buildPackageData
, Rules.Dependencies.buildPackageDependencies readPackageDb , Rules.Dependencies.buildPackageDependencies readPackageDb
, Rules.Documentation.buildPackageDocumentation , Rules.Documentation.buildPackageDocumentation
, Rules.Library.buildPackageGhciLibrary , Rules.Library.buildPackageGhciLibrary
, Rules.Generate.generatePackageCode , Rules.Generate.generatePackageCode
, Rules.Program.buildProgram readPackageDb
, Rules.Register.registerPackage writePackageDb ] , Rules.Register.registerPackage writePackageDb ]
buildRules :: Rules ()