9 files changed, 66 insertions, 20 deletions
diff --git a/hadrian/src/Oracles/Flavour.hs b/hadrian/src/Oracles/Flavour.hs
new file mode 100644
index 0000000000..88e9c89757
--- /dev/null
+++ b/hadrian/src/Oracles/Flavour.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Oracles.Flavour
+  ( oracles
+  , askDynGhcPrograms
+  , askGhcProfiled
+  ) where
+
+import Base
+import Flavour
+import Settings (flavour)
+
+newtype DynGhcPrograms =
+  DynGhcPrograms () deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
+type instance RuleResult DynGhcPrograms = Bool
+
+newtype GhcProfiled =
+  GhcProfiled () deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
+type instance RuleResult GhcProfiled = Bool
+
+oracles :: Rules ()
+oracles = do
+  void $ addOracle $ \(DynGhcPrograms _) -> dynamicGhcPrograms =<< flavour
+  void $ addOracle $ \(GhcProfiled _) -> ghcProfiled <$> flavour
+
+askDynGhcPrograms :: Action Bool
+askDynGhcPrograms = askOracle $ DynGhcPrograms ()
+
+askGhcProfiled :: Action Bool
+askGhcProfiled = askOracle $ GhcProfiled ()
diff --git a/hadrian/src/Oracles/TestSettings.hs b/hadrian/src/Oracles/TestSettings.hs
index 9d93e10cf4..ba89e00beb 100644
--- a/hadrian/src/Oracles/TestSettings.hs
+++ b/hadrian/src/Oracles/TestSettings.hs
@@ -10,8 +10,8 @@ module Oracles.TestSettings
 import Base
 import Hadrian.Oracles.TextFile
 import Oracles.Setting (topDirectory, setting, Setting(..))
-import Settings (programContext)
 import Packages
+import Settings.Program (programContext)
 
 testConfigFile :: Action FilePath
 testConfigFile = buildRoot <&> (-/- "test/ghcconfig")
diff --git a/hadrian/src/Rules.hs b/hadrian/src/Rules.hs
index 5b2682390a..e72623d4ce 100644
--- a/hadrian/src/Rules.hs
+++ b/hadrian/src/Rules.hs
@@ -8,6 +8,7 @@ import qualified Hadrian.Oracles.Path
 import qualified Hadrian.Oracles.TextFile
 
 import Expression
+import qualified Oracles.Flavour
 import qualified Oracles.ModuleFiles
 import Packages
 import qualified Rules.BinaryDist
@@ -24,10 +25,10 @@ import qualified Rules.Register
 import qualified Rules.Rts
 import qualified Rules.SimpleTargets
 import Settings
+import Settings.Program (programContext)
 import Target
 import UserSettings
 
-
 -- | @tool-args@ is used by tooling in order to get the arguments necessary
 -- to set up a GHC API session which can compile modules from GHC. When
 -- run, the target prints out the arguments that would be passed to @ghc@
@@ -176,4 +177,5 @@ oracleRules = do
     Hadrian.Oracles.DirectoryContents.directoryContentsOracle
     Hadrian.Oracles.Path.pathOracle
     Hadrian.Oracles.TextFile.textFileOracle
+    Oracles.Flavour.oracles
     Oracles.ModuleFiles.moduleFilesOracle
diff --git a/hadrian/src/Rules/BinaryDist.hs b/hadrian/src/Rules/BinaryDist.hs
index 11301a0372..fb7fa47c84 100644
--- a/hadrian/src/Rules/BinaryDist.hs
+++ b/hadrian/src/Rules/BinaryDist.hs
@@ -7,6 +7,7 @@ import Expression
 import Oracles.Setting
 import Packages
 import Settings
+import Settings.Program (programContext)
 import Target
 import Utilities
 
diff --git a/hadrian/src/Rules/Program.hs b/hadrian/src/Rules/Program.hs
index b5dde25624..6273f3da4d 100644
--- a/hadrian/src/Rules/Program.hs
+++ b/hadrian/src/Rules/Program.hs
@@ -12,6 +12,7 @@ import Oracles.Setting (topDirectory)
 import Packages
 import Settings
 import Settings.Default
+import Settings.Program (programContext)
 import Target
 import Utilities
 import Rules.Library
diff --git a/hadrian/src/Rules/Test.hs b/hadrian/src/Rules/Test.hs
index 5dea40a48b..84374ff492 100644
--- a/hadrian/src/Rules/Test.hs
+++ b/hadrian/src/Rules/Test.hs
@@ -12,6 +12,7 @@ import Packages
 import Settings
 import Settings.Default
 import Settings.Builders.RunTest
+import Settings.Program (programContext)
 import Target
 import Utilities
 
diff --git a/hadrian/src/Settings.hs b/hadrian/src/Settings.hs
index 0548bccfae..ba0cff770a 100755
--- a/hadrian/src/Settings.hs
+++ b/hadrian/src/Settings.hs
@@ -1,8 +1,7 @@
 module Settings (
     getArgs, getLibraryWays, getRtsWays, flavour, knownPackages,
     findPackageByName, unsafeFindPackageByName, unsafeFindPackageByPath,
-    isLibrary, stagePackages, programContext, getIntegerPackage,
-    completeSetting
+    isLibrary, stagePackages, getIntegerPackage, completeSetting
     ) where
 
 import CommandLine
@@ -68,22 +67,6 @@ flavour = do
 getIntegerPackage :: Expr Package
 getIntegerPackage = expr (integerLibrary =<< flavour)
 
--- TODO: there is duplication and inconsistency between this and
--- Rules.Program.getProgramContexts. There should only be one way to get a
--- context / contexts for a given stage and package.
-programContext :: Stage -> Package -> Action Context
-programContext stage pkg = do
-    profiled <- ghcProfiled <$> flavour
-    dynGhcProgs <- dynamicGhcPrograms =<< flavour
-    return $ Context stage pkg (wayFor profiled dynGhcProgs)
-
-    where wayFor prof dyn
-            | prof && dyn                          =
-                error "programContext: profiling+dynamic not supported"
-            | pkg == ghc && prof && stage > Stage0 = profiling
-            | dyn && stage > Stage0                = dynamic
-            | otherwise                            = vanilla
-
 -- TODO: switch to Set Package as the order of packages should not matter?
 -- Otherwise we have to keep remembering to sort packages from time to time.
 knownPackages :: [Package]
diff --git a/hadrian/src/Settings/Builders/Make.hs b/hadrian/src/Settings/Builders/Make.hs
index 56bb8e35fb..431c2cb22e 100644
--- a/hadrian/src/Settings/Builders/Make.hs
+++ b/hadrian/src/Settings/Builders/Make.hs
@@ -4,6 +4,7 @@ import Oracles.Setting
 import Packages
 import Rules.Gmp
 import Settings.Builders.Common
+import Settings.Program (programContext)
 import CommandLine
 
 makeBuilderArgs :: Args
diff --git a/hadrian/src/Settings/Program.hs b/hadrian/src/Settings/Program.hs
new file mode 100644
index 0000000000..d98b1a9327
--- /dev/null
+++ b/hadrian/src/Settings/Program.hs
@@ -0,0 +1,24 @@
+module Settings.Program
+  ( programContext
+  ) where
+
+import Base
+import Context
+import Oracles.Flavour
+import Packages
+
+-- TODO: there is duplication and inconsistency between this and
+-- Rules.Program.getProgramContexts. There should only be one way to
+-- get a context/contexts for a given stage and package.
+programContext :: Stage -> Package -> Action Context
+programContext stage pkg = do
+    profiled <- askGhcProfiled
+    dynGhcProgs <- askDynGhcPrograms --dynamicGhcPrograms =<< flavour
+    return $ Context stage pkg (wayFor profiled dynGhcProgs)
+
+    where wayFor prof dyn
+            | prof && dyn                          =
+                error "programContext: profiling+dynamic not supported"
+            | pkg == ghc && prof && stage > Stage0 = profiling
+            | dyn && stage > Stage0                = dynamic
+            | otherwise                            = vanilla