Refactor and rename Oracles/Option.hs.

src/Base.hs

@@ -6,7 +6,7 @@ module Base (
     module Control.Applicative,
     module Data.Function,
     module Data.Monoid,
-    module Data.List,
+    --module Data.List,
     Stage (..),
     Arg, ArgList,
     ShowArg (..), ShowArgs (..),
@@ -18,7 +18,6 @@ import Development.Shake.FilePath
 import Control.Applicative
 import Data.Function
 import Data.Monoid
-import Data.List
 import GHC.Generics
 import Development.Shake.Classes
 

src/Builder.hs

@@ -6,9 +6,10 @@ module Builder (
 
 import Base
 import Util
+import Data.List
 import Oracles.Base
 import Oracles.Flag
-import Oracles.Option
+import Oracles.Setting
 import GHC.Generics
 import Development.Shake.Classes
 

src/Expression.hs

@@ -16,6 +16,7 @@ import Base
 import Builder
 import Package
 import Target
+import Data.List
 import Oracles.Base
 import Data.Monoid
 import Control.Monad.Reader hiding (liftIO)

src/Oracles.hs

@@ -13,6 +13,7 @@ import Control.Monad.Extra
 import Oracles.Base
 import Oracles.PackageData
 import Oracles.DependencyList
+import Data.List
 
 -- Oracle for configuration files
 configOracle :: Rules ()

src/Oracles/Option.hs

-module Oracles.Option (
-    Option (..), MultiOption (..), windowsHost
-    ) where
-
-import Base
-import Oracles.Base
-
--- For each Option the file default.config contains a line of the
--- form 'target-os = mingw32'.
--- (showArg TargetOs) is an action that consults the config files
--- and returns "mingw32".
---
--- MultiOption is used for multiple string options separated by spaces,
--- such as 'src-hc-args = -H32m -O'.
--- (showArgs SrcHcArgs) therefore returns a list of strings ["-H32", "-O"].
-data Option = TargetOs
-            | TargetArch
-            | TargetPlatformFull
-            | HostOsCpp
-            | DynamicExtension
-            | ProjectVersion
-            | GhcSourcePath
-
-data MultiOption = SrcHcArgs
-                 | ConfCcArgs Stage
-                 | ConfGccLinkerArgs Stage
-                 | ConfLdLinkerArgs Stage
-                 | ConfCppArgs Stage
-                 | IconvIncludeDirs
-                 | IconvLibDirs
-                 | GmpIncludeDirs
-                 | GmpLibDirs
-
-instance ShowArg Option where
-    showArg opt = askConfig $ case opt of
-        TargetOs                -> "target-os"
-        TargetArch              -> "target-arch"
-        TargetPlatformFull      -> "target-platform-full"
-        HostOsCpp               -> "host-os-cpp"
-        DynamicExtension        -> "dynamic-extension"
-        ProjectVersion          -> "project-version"
-        GhcSourcePath           -> "ghc-source-path"
-
-instance ShowArgs MultiOption where
-    showArgs opt = showArgs $ fmap words $ askConfig $ case opt of
-        SrcHcArgs               -> "src-hc-args"
-        ConfCcArgs        stage -> "conf-cc-args"         ++ showStage stage
-        ConfCppArgs       stage -> "conf-cpp-args"        ++ showStage stage
-        ConfGccLinkerArgs stage -> "conf-gcc-linker-args" ++ showStage stage
-        ConfLdLinkerArgs  stage -> "conf-ld-linker-args"  ++ showStage stage
-        IconvIncludeDirs        -> "iconv-include-dirs"
-        IconvLibDirs            -> "iconv-lib-dirs"
-        GmpIncludeDirs          -> "gmp-include-dirs"
-        GmpLibDirs              -> "gmp-lib-dirs"
-      where
-        showStage = ("-stage" ++) . show
-
-windowsHost :: Action Bool
-windowsHost = do
-    hostOsCpp <- showArg HostOsCpp
-    return $ hostOsCpp `elem` ["mingw32", "cygwin32"]

src/Oracles/PackageData.hs

@@ -8,6 +8,7 @@ module Oracles.PackageData (
 import Development.Shake.Classes
 import Base
 import Util
+import Data.List
 import Data.Maybe
 
 -- For each (PackageData path) the file 'path/package-data.mk' contains

src/Oracles/Setting.hs

+module Oracles.Setting (
+    Setting (..), MultiSetting (..),
+    setting, multiSetting,
+    windowsHost
+    ) where
+
+import Base
+import Oracles.Base
+
+-- Each Setting comes from the system.config file, e.g. 'target-os = mingw32'.
+-- setting TargetOs looks up the config file and returns "mingw32".
+--
+-- MultiSetting is used for multiple string values separated by spaces, such
+-- as 'src-hc-args = -H32m -O'.
+-- multiSetting SrcHcArgs therefore returns a list of strings ["-H32", "-O"].
+data Setting = TargetOs
+             | TargetArch
+             | TargetPlatformFull
+             | HostOsCpp
+             | DynamicExtension
+             | ProjectVersion
+             | GhcSourcePath
+
+data MultiSetting = SrcHcArgs
+                  | ConfCcArgs Stage
+                  | ConfGccLinkerArgs Stage
+                  | ConfLdLinkerArgs Stage
+                  | ConfCppArgs Stage
+                  | IconvIncludeDirs
+                  | IconvLibDirs
+                  | GmpIncludeDirs
+                  | GmpLibDirs
+
+setting :: Setting -> Action String
+setting s = askConfig $ case s of
+    TargetOs           -> "target-os"
+    TargetArch         -> "target-arch"
+    TargetPlatformFull -> "target-platform-full"
+    HostOsCpp          -> "host-os-cpp"
+    DynamicExtension   -> "dynamic-extension"
+    ProjectVersion     -> "project-version"
+    GhcSourcePath      -> "ghc-source-path"
+
+multiSetting :: MultiSetting -> Action [String]
+multiSetting s = fmap words $ askConfig $ case s of
+    SrcHcArgs               -> "src-hc-args"
+    ConfCcArgs        stage -> "conf-cc-args"         ++ showStage stage
+    ConfCppArgs       stage -> "conf-cpp-args"        ++ showStage stage
+    ConfGccLinkerArgs stage -> "conf-gcc-linker-args" ++ showStage stage
+    ConfLdLinkerArgs  stage -> "conf-ld-linker-args"  ++ showStage stage
+    IconvIncludeDirs        -> "iconv-include-dirs"
+    IconvLibDirs            -> "iconv-lib-dirs"
+    GmpIncludeDirs          -> "gmp-include-dirs"
+    GmpLibDirs              -> "gmp-lib-dirs"
+  where
+    showStage = ("-stage" ++) . show
+
+windowsHost :: Action Bool
+windowsHost = do
+    hostOsCpp <- setting HostOsCpp
+    return $ hostOsCpp `elem` ["mingw32", "cygwin32"]

src/Settings/GhcCabal.hs

@@ -7,14 +7,15 @@ import Base
 import Builder
 import Package
 import Util
-import Oracles.Base
-import Switches
 import Expression
+import Switches
+import Oracles.Base
 import Settings.User
 import Settings.Ways
 import Settings.Util
 import Settings.Packages
 import Settings.TargetDirectory
+import Data.List
 
 cabalArgs :: Args
 cabalArgs = builder GhcCabal ? do

src/Way.hs

@@ -15,10 +15,10 @@ module Way ( -- TODO: rename to "Way"?
 
 import Base
 import Util
-import Data.IntSet (IntSet)
-import qualified Data.IntSet as IntSet
-import Oracles.Option
+import Oracles.Setting
 import Development.Shake.Classes
+import Data.List hiding (delete)
+import Data.IntSet (IntSet, elems, member, delete, fromList)
 
 data WayUnit = Threaded
              | Debug
@@ -45,13 +45,13 @@ instance Read WayUnit where
 newtype Way = Way IntSet
 
 wayFromUnits :: [WayUnit] -> Way
-wayFromUnits = Way . IntSet.fromList . map fromEnum
+wayFromUnits = Way . fromList . map fromEnum
 
 wayToUnits :: Way -> [WayUnit]
-wayToUnits (Way set) = map toEnum . IntSet.elems $ set
+wayToUnits (Way set) = map toEnum . elems $ set
 
 wayUnit :: WayUnit -> Way -> Bool
-wayUnit unit (Way set) = fromEnum unit `IntSet.member` set
+wayUnit unit (Way set) = fromEnum unit `member` set
 
 instance Show Way where
     show way = if null tag then "v" else tag
@@ -117,9 +117,9 @@ libsuf way @ (Way set) =
     if (not . wayUnit Dynamic $ way)
     then return $ wayPrefix way ++ "a" -- e.g., p_a
     else do
-        extension <- showArg DynamicExtension  -- e.g., .dll or .so
-        version   <- showArg ProjectVersion    -- e.g., 7.11.20141222
-        let prefix = wayPrefix . Way . IntSet.delete (fromEnum Dynamic) $ set
+        extension <- setting DynamicExtension  -- e.g., .dll or .so
+        version   <- setting ProjectVersion    -- e.g., 7.11.20141222
+        let prefix = wayPrefix . Way . delete (fromEnum Dynamic) $ set
         -- e.g., p_ghc7.11.20141222.dll (the result)
         return $ prefix ++ "ghc" ++ version ++ extension