Fix warnings, improve documentation

2 files changed, 58 insertions, 27 deletions

diff --git a/src/Hadrian/Expression.hs b/src/Hadrian/Expression.hs
index 6649565a62..53c86de68b 100644
--- a/src/Hadrian/Expression.hs
+++ b/src/Hadrian/Expression.hs
@@ -19,7 +19,6 @@ module Hadrian.Expression (
 import Control.Monad.Extra
 import Control.Monad.Trans
 import Control.Monad.Trans.Reader
-import Data.Semigroup (Semigroup, (<>))
 import Development.Shake
 import Development.Shake.Classes
 
@@ -71,7 +70,7 @@ class ToPredicate p c b where
 infixr 3 ?
 
 -- | Apply a predicate to an expression.
-(?) :: (Monoid a, Semigroup a, ToPredicate p c b) => p -> Expr c b a -> Expr c b a
+(?) :: (Monoid a, ToPredicate p c b) => p -> Expr c b a -> Expr c b a
 p ? e = do
     bool <- toPredicate p
     if bool then e else mempty
diff --git a/src/Oracles/Setting.hs b/src/Oracles/Setting.hs
index 333b16714c..1cdcddf186 100644
--- a/src/Oracles/Setting.hs
+++ b/src/Oracles/Setting.hs
@@ -11,14 +11,16 @@ import Hadrian.Oracles.TextFile
 import Hadrian.Oracles.Path
 
 import Base
-import Way.Type
 
--- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions).
--- | Each 'Setting' comes from @system.config@ file, e.g. 'target-os = mingw32'.
--- @setting TargetOs@ looks up the config file and returns "mingw32".
--- 'SettingList' is used for multiple string values separated by spaces, such
--- as @gmp-include-dirs = a b@.
--- @settingList GmpIncludeDirs@ therefore returns a list of strings ["a", "b"].
+-- | Each 'Setting' comes from the file @hadrian/cfg/system.config@, generated
+-- by the @configure@ script from the input file @hadrian/cfg/system.config.in@.
+-- For example, the line
+--
+-- > target-os = mingw32
+--
+-- sets the value of the setting 'TargetOs'. The action 'setting' 'TargetOs'
+-- looks up the value of the setting and returns the string @"mingw32"@,
+-- tracking the result in the Shake database.
 data Setting = BuildArch
              | BuildOs
              | BuildPlatform
@@ -57,13 +59,24 @@ data Setting = BuildArch
              | TargetPlatformFull
              | TargetVendor
 
+-- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions).
+-- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@,
+-- generated by the @configure@ script from the input file
+-- @hadrian/cfg/system.config.in@. For example, the line
+--
+-- > hs-cpp-args = -E -undef -traditional
+--
+-- sets the value of 'HsCppArgs'. The action 'settingList' 'HsCppArgs' looks up
+-- the value of the setting and returns the list of strings
+-- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database.
 data SettingList = ConfCcArgs Stage
                  | ConfCppArgs Stage
                  | ConfGccLinkerArgs Stage
                  | ConfLdLinkerArgs Stage
                  | HsCppArgs
 
--- | Maps 'Setting's to names in @cfg/system.config.in@.
+-- | Look up the value of a 'Setting' in @cfg/system.config@, tracking the
+-- result.
 setting :: Setting -> Action String
 setting key = lookupValueOrError configFile $ case key of
     BuildArch          -> "build-arch"
@@ -104,6 +117,8 @@ setting key = lookupValueOrError configFile $ case key of
     TargetPlatformFull -> "target-platform-full"
     TargetVendor       -> "target-vendor"
 
+-- | Look up the value of a 'SettingList' in @cfg/system.config@, tracking the
+-- result.
 settingList :: SettingList -> Action [String]
 settingList key = fmap words $ lookupValueOrError configFile $ case key of
     ConfCcArgs        stage -> "conf-cc-args-"         ++ stageString stage
@@ -112,38 +127,50 @@ settingList key = fmap words $ lookupValueOrError configFile $ case key of
     ConfLdLinkerArgs  stage -> "conf-ld-linker-args-"  ++ stageString stage
     HsCppArgs               -> "hs-cpp-args"
 
--- | Get a configuration setting.
+-- | An expression that looks up the value of a 'Setting' in @cfg/system.config@,
+-- tracking the result.
 getSetting :: Setting -> Expr c b String
 getSetting = expr . setting
 
--- | Get a list of configuration settings.
+-- | An expression that looks up the value of a 'SettingList' in
+-- @cfg/system.config@, tracking the result.
 getSettingList :: SettingList -> Args c b
 getSettingList = expr . settingList
 
+-- | Check whether the value of a 'Setting' matches one of the given strings.
 matchSetting :: Setting -> [String] -> Action Bool
 matchSetting key values = (`elem` values) <$> setting key
 
+-- | Check whether the target platform setting matches one of the given strings.
 anyTargetPlatform :: [String] -> Action Bool
 anyTargetPlatform = matchSetting TargetPlatformFull
 
+-- | Check whether the target OS setting matches one of the given strings.
 anyTargetOs :: [String] -> Action Bool
 anyTargetOs = matchSetting TargetOs
 
+-- | Check whether the target architecture setting matches one of the given
+-- strings.
 anyTargetArch :: [String] -> Action Bool
 anyTargetArch = matchSetting TargetArch
 
+-- | Check whether the host OS setting matches one of the given strings.
 anyHostOs :: [String] -> Action Bool
 anyHostOs = matchSetting HostOs
 
+-- | Check whether the host OS setting is set to @"ios"@.
 iosHost :: Action Bool
 iosHost = anyHostOs ["ios"]
 
+-- | Check whether the host OS setting is set to @"darwin"@.
 osxHost :: Action Bool
 osxHost = anyHostOs ["darwin"]
 
+-- | Check whether the host OS setting is set to @"mingw32"@ or @"cygwin32"@.
 windowsHost :: Action Bool
 windowsHost = anyHostOs ["mingw32", "cygwin32"]
 
+-- | Check whether the target supports GHCi.
 ghcWithInterpreter :: Action Bool
 ghcWithInterpreter = do
     goodOs <- anyTargetOs [ "mingw32", "cygwin32", "linux", "solaris2"
@@ -153,14 +180,17 @@ ghcWithInterpreter = do
                               , "sparc64", "arm" ]
     return $ goodOs && goodArch
 
+-- | Check whether the target architecture supports placing info tables next to
+-- code. See: https://ghc.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/HeapObjects#TABLES_NEXT_TO_CODE.
 ghcEnableTablesNextToCode :: Action Bool
 ghcEnableTablesNextToCode = notM $ anyTargetArch ["ia64", "powerpc64", "powerpc64le"]
 
+-- | Check to use @libffi@ for adjustors.
 useLibFFIForAdjustors :: Action Bool
 useLibFFIForAdjustors = notM $ anyTargetArch ["i386", "x86_64"]
 
 -- | Canonicalised GHC version number, used for integer version comparisons. We
--- expand GhcMinorVersion to two digits by adding a leading zero if necessary.
+-- expand 'GhcMinorVersion' to two digits by adding a leading zero if necessary.
 ghcCanonVersion :: Action String
 ghcCanonVersion = do
     ghcMajorVersion <- setting GhcMajorVersion
@@ -172,18 +202,20 @@ ghcCanonVersion = do
 topDirectory :: Action FilePath
 topDirectory = fixAbsolutePathOnWindows =<< setting GhcSourcePath
 
--- TODO: find out why we need version number in the dynamic suffix
--- The current theory: dynamic libraries are eventually placed in a single
--- giant directory in the load path of the dynamic linker, and hence we must
--- distinguish different versions of GHC. In contrast static libraries live
--- in their own per-package directory and hence do not need a unique filename.
--- We also need to respect the system's dynamic extension, e.g. .dll or .so.
+-- | The file suffix used for libraries of a given build 'Way'. For example,
+-- @_p.a@ corresponds to a static profiled library, and @-ghc7.11.20141222.so@
+-- is a dynamic vanilly library. Why do we need GHC version number in the
+-- dynamic suffix? Here is a possible reason: dynamic libraries are placed in a
+-- single giant directory in the load path of the dynamic linker, and hence we
+-- must distinguish different versions of GHC. In contrast, static libraries
+-- live in their own per-package directory and hence do not need a unique
+-- filename. We also need to respect the system's dynamic extension, e.g. @.dll@
+-- or @.so@.
 libsuf :: Way -> Action String
-libsuf way =
-  if not (wayUnit Dynamic way)
-  then return $ waySuffix way ++ ".a" -- e.g., _p.a
-  else do
-    extension <- setting DynamicExtension  -- e.g., .dll or .so
-    version   <- setting ProjectVersion    -- e.g., 7.11.20141222
-    let suffix = waySuffix $ removeWayUnit Dynamic way
-    return $ "-ghc" ++ version ++ suffix ++ extension
+libsuf way
+    | not (wayUnit Dynamic way) = return (waySuffix way ++ ".a") -- e.g., _p.a
+    | otherwise = do
+        extension <- setting DynamicExtension -- e.g., .dll or .so
+        version   <- setting ProjectVersion   -- e.g., 7.11.20141222
+        let suffix = waySuffix (removeWayUnit Dynamic way)
+        return ("-ghc" ++ version ++ suffix ++ extension)