Commit 272f1005 authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Refactor and rename Oracles/Option.hs.

parent a8cfbde5
...@@ -6,7 +6,7 @@ module Base ( ...@@ -6,7 +6,7 @@ module Base (
module Control.Applicative, module Control.Applicative,
module Data.Function, module Data.Function,
module Data.Monoid, module Data.Monoid,
module Data.List, --module Data.List,
Stage (..), Stage (..),
Arg, ArgList, Arg, ArgList,
ShowArg (..), ShowArgs (..), ShowArg (..), ShowArgs (..),
...@@ -18,7 +18,6 @@ import Development.Shake.FilePath ...@@ -18,7 +18,6 @@ import Development.Shake.FilePath
import Control.Applicative import Control.Applicative
import Data.Function import Data.Function
import Data.Monoid import Data.Monoid
import Data.List
import GHC.Generics import GHC.Generics
import Development.Shake.Classes import Development.Shake.Classes
......
...@@ -6,9 +6,10 @@ module Builder ( ...@@ -6,9 +6,10 @@ module Builder (
import Base import Base
import Util import Util
import Data.List
import Oracles.Base import Oracles.Base
import Oracles.Flag import Oracles.Flag
import Oracles.Option import Oracles.Setting
import GHC.Generics import GHC.Generics
import Development.Shake.Classes import Development.Shake.Classes
......
...@@ -16,6 +16,7 @@ import Base ...@@ -16,6 +16,7 @@ import Base
import Builder import Builder
import Package import Package
import Target import Target
import Data.List
import Oracles.Base import Oracles.Base
import Data.Monoid import Data.Monoid
import Control.Monad.Reader hiding (liftIO) import Control.Monad.Reader hiding (liftIO)
......
...@@ -13,6 +13,7 @@ import Control.Monad.Extra ...@@ -13,6 +13,7 @@ import Control.Monad.Extra
import Oracles.Base import Oracles.Base
import Oracles.PackageData import Oracles.PackageData
import Oracles.DependencyList import Oracles.DependencyList
import Data.List
-- Oracle for configuration files -- Oracle for configuration files
configOracle :: Rules () configOracle :: Rules ()
......
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"]
...@@ -8,6 +8,7 @@ module Oracles.PackageData ( ...@@ -8,6 +8,7 @@ module Oracles.PackageData (
import Development.Shake.Classes import Development.Shake.Classes
import Base import Base
import Util import Util
import Data.List
import Data.Maybe import Data.Maybe
-- For each (PackageData path) the file 'path/package-data.mk' contains -- For each (PackageData path) the file 'path/package-data.mk' contains
......
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"]
...@@ -7,14 +7,15 @@ import Base ...@@ -7,14 +7,15 @@ import Base
import Builder import Builder
import Package import Package
import Util import Util
import Oracles.Base
import Switches
import Expression import Expression
import Switches
import Oracles.Base
import Settings.User import Settings.User
import Settings.Ways import Settings.Ways
import Settings.Util import Settings.Util
import Settings.Packages import Settings.Packages
import Settings.TargetDirectory import Settings.TargetDirectory
import Data.List
cabalArgs :: Args cabalArgs :: Args
cabalArgs = builder GhcCabal ? do cabalArgs = builder GhcCabal ? do
......
...@@ -15,10 +15,10 @@ module Way ( -- TODO: rename to "Way"? ...@@ -15,10 +15,10 @@ module Way ( -- TODO: rename to "Way"?
import Base import Base
import Util import Util
import Data.IntSet (IntSet) import Oracles.Setting
import qualified Data.IntSet as IntSet
import Oracles.Option
import Development.Shake.Classes import Development.Shake.Classes
import Data.List hiding (delete)
import Data.IntSet (IntSet, elems, member, delete, fromList)
data WayUnit = Threaded data WayUnit = Threaded
| Debug | Debug
...@@ -45,13 +45,13 @@ instance Read WayUnit where ...@@ -45,13 +45,13 @@ instance Read WayUnit where
newtype Way = Way IntSet newtype Way = Way IntSet
wayFromUnits :: [WayUnit] -> Way wayFromUnits :: [WayUnit] -> Way
wayFromUnits = Way . IntSet.fromList . map fromEnum wayFromUnits = Way . fromList . map fromEnum
wayToUnits :: Way -> [WayUnit] wayToUnits :: Way -> [WayUnit]
wayToUnits (Way set) = map toEnum . IntSet.elems $ set wayToUnits (Way set) = map toEnum . elems $ set
wayUnit :: WayUnit -> Way -> Bool 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 instance Show Way where
show way = if null tag then "v" else tag show way = if null tag then "v" else tag
...@@ -117,9 +117,9 @@ libsuf way @ (Way set) = ...@@ -117,9 +117,9 @@ libsuf way @ (Way set) =
if (not . wayUnit Dynamic $ way) if (not . wayUnit Dynamic $ way)
then return $ wayPrefix way ++ "a" -- e.g., p_a then return $ wayPrefix way ++ "a" -- e.g., p_a
else do else do
extension <- showArg DynamicExtension -- e.g., .dll or .so extension <- setting DynamicExtension -- e.g., .dll or .so
version <- showArg ProjectVersion -- e.g., 7.11.20141222 version <- setting ProjectVersion -- e.g., 7.11.20141222
let prefix = wayPrefix . Way . IntSet.delete (fromEnum Dynamic) $ set let prefix = wayPrefix . Way . delete (fromEnum Dynamic) $ set
-- e.g., p_ghc7.11.20141222.dll (the result) -- e.g., p_ghc7.11.20141222.dll (the result)
return $ prefix ++ "ghc" ++ version ++ extension return $ prefix ++ "ghc" ++ version ++ extension
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment