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 (
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
......
......@@ -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
......
......@@ -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)
......
......@@ -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 ()
......
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 (
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
......
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
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
......
......@@ -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
......
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