Commit 178de1dc authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Make an Arch enum like we have for OS and use it

We get more robust parsing and comparisons of arch names this way
and it'll allows us to detect and warn about unknown arches.
parent 23e64722
......@@ -85,7 +85,7 @@ import Distribution.Version (Version(Version), VersionRange(AnyVersion))
import Distribution.License (License(AllRightsReserved))
import Distribution.Version (Dependency, showVersionRange)
import Distribution.Compiler (CompilerFlavor)
import Distribution.System (OS, showOS)
import Distribution.System (OS, showOS, Arch, showArch)
import Distribution.Simple.Utils (currentDir)
import Language.Haskell.Extension (Extension)
......@@ -455,14 +455,14 @@ data ConfFlag = ConfFlag String
-- | A @ConfVar@ represents the variable type used.
data ConfVar = OS OS
| Arch String
| Arch Arch
| Flag ConfFlag
| Impl String VersionRange
deriving Eq
instance Show ConfVar where
show (OS os) = "os(" ++ showOS os ++ ")"
show (Arch n) = "arch(" ++ n ++ ")"
show (Arch arch) = "arch(" ++ showArch arch ++ ")"
show (Flag (ConfFlag f)) = "flag(" ++ f ++ ")"
show (Impl c v) = "impl(" ++ c ++ " " ++ showVersionRange v ++ ")"
......
......@@ -63,7 +63,7 @@ import Distribution.Version
( Version(..), Dependency(..), VersionRange(..)
, withinRange, parseVersionRange )
import Distribution.System
( OS, readOS )
( OS, readOS, Arch, readArch )
import Distribution.Simple.Utils (currentDir, lowercase)
import Distribution.Compat.ReadP as ReadP hiding ( char )
......@@ -117,13 +117,13 @@ simplifyCondition cond i = fv . walk $ cond
-- | Simplify a configuration condition using the os and arch names. Returns
-- the names of all the flags occurring in the condition.
simplifyWithSysParams :: OS -> String -> (String, Version) -> Condition ConfVar
simplifyWithSysParams :: OS -> Arch -> (String, Version) -> Condition ConfVar
-> (Condition ConfFlag, [String])
simplifyWithSysParams os arch (impl, implVer) cond = (cond', flags)
where
(cond', fvs) = simplifyCondition cond interp
interp (OS os') = Right $ os' == os
interp (Arch name) = Right $ lowercase name == lowercase arch
interp (Arch arch') = Right $ arch' == arch
interp (Impl i vr) = Right $ lowercase impl == lowercase i
&& implVer `withinRange` vr
interp (Flag f) = Left f
......@@ -157,7 +157,7 @@ parseCondition = condOr
inparens = between (ReadP.char '(' >> sp) (sp >> ReadP.char ')' >> sp)
notCond = ReadP.char '!' >> sp >> cond >>= return . CNot
osCond = string "os" >> sp >> inparens osIdent >>= return . Var . OS . readOS
archCond = string "arch" >> sp >> inparens archIdent >>= return . Var . Arch
archCond = string "arch" >> sp >> inparens archIdent >>= return . Var . Arch . readArch
flagCond = string "flag" >> sp >> inparens flagIdent >>= return . Var . Flag . ConfFlag
implCond = string "impl" >> sp >> inparens implIdent >>= return . Var
ident = munch1 isIdentChar >>= return . map toLower
......@@ -230,7 +230,7 @@ resolveWithFlags :: Monoid a =>
[(String,[Bool])]
-- ^ Domain for each flag name, will be tested in order.
-> OS -- ^ OS as returned by Distribution.System.buildOS
-> String -- ^ arch name, as returned by System.Info.arch
-> Arch -- ^ Arch as returned by Distribution.System.buildArch
-> (String, Version) -- ^ Compiler name + version
-> [CondTree ConfVar [d] a]
-> ([d] -> DepTestRslt [d]) -- ^ Dependency test function.
......@@ -345,7 +345,7 @@ finalizePackageDescription
-> Maybe (PackageIndex pkg) -- ^ Available dependencies. Pass 'Nothing' if
-- this is unknown.
-> OS -- ^ OS-name
-> String -- ^ Arch-name
-> Arch -- ^ Arch-name
-> (String, Version) -- ^ Compiler + Version
-> GenericPackageDescription
-> Either [Dependency]
......
......@@ -100,7 +100,7 @@ import Distribution.Simple.Utils
import Distribution.Simple.Register
( removeInstalledConfig )
import Distribution.System
( os, OS(..), Windows(..) )
( os, OS(..), Windows(..), buildArch )
import Distribution.Version
( Version(..), Dependency(..), VersionRange(..), showVersion, readVersion
, showVersionRange, orLaterVersion, withinRange )
......@@ -129,7 +129,7 @@ import System.Exit
import System.FilePath
( (</>) )
import qualified System.Info
( arch, compilerName, compilerVersion )
( compilerName, compilerVersion )
import System.IO
( hPutStrLn, stderr )
import Text.PrettyPrint.HughesPJ
......@@ -294,7 +294,7 @@ configure (pkg_descr0, pbi) cfg
(configConfigurationsFlags cfg)
maybePackageIndex
Distribution.System.os
System.Info.arch
Distribution.System.buildArch
(map toLower (show flavor),version)
ppd
of Right r -> return r
......
......@@ -5,9 +5,15 @@ module Distribution.System (
showOS,
readOS,
os,
-- * Machine Architecture
Arch(..),
showArch,
readArch,
buildArch,
) where
import qualified System.Info (os)
import qualified System.Info (os, arch)
import qualified Data.Char as Char (toLower)
-- ------------------------------------------------------------
......@@ -17,7 +23,7 @@ import qualified Data.Char as Char (toLower)
data OS = Linux | Windows Windows | OSX
| FreeBSD | OpenBSD | NetBSD
| Solaris | AIX | HPUX | IRIX
| Other String
| OtherOS String
deriving (Eq, Ord, Show, Read)
--TODO: eliminate Windows data type
......@@ -37,20 +43,66 @@ osAliases Solaris = ["solaris2"]
osAliases _ = []
showOS :: OS -> String
showOS (Other name) = lowercase name
showOS other = lowercase (show other)
showOS (OtherOS name) = name
showOS other = lowercase (show other)
readOS :: String -> OS
readOS s = case lookup (lowercase s)
[ (name, os')
| os' <- knownOSs
, name <- showOS os' : osAliases os' ] of
Just os' -> os'
Nothing -> Other s
readOS s =
case lookup (lowercase s) osMap of
Just os' -> os'
Nothing -> OtherOS (lowercase s)
where
osMap = [ (name, os')
| os' <- knownOSs
, name <- showOS os' : osAliases os' ]
--TODO: rename to buildOS and rename os' above to just os
os :: OS
os = readOS System.Info.os
-- ------------------------------------------------------------
-- * Machine Architecture
-- ------------------------------------------------------------
data Arch = I386 | X86_64 | PPC | PPC64 | Sparc
| Arm | Mips | SH
| IA64 | S390
| Alpha | Hppa | Rs6000
| M68k | Vax
| OtherArch String
deriving (Eq, Ord, Show, Read)
knownArches :: [Arch]
knownArches = [I386, X86_64, PPC, PPC64, Sparc
,Arm, Mips, SH
,IA64, S390
,Alpha, Hppa, Rs6000
,M68k, Vax]
archAliases :: Arch -> [String]
archAliases PPC = ["powerpc"]
archAliases PPC64 = ["powerpc64"]
archAliases Sparc = ["sparc64"]
archAliases Mips = ["mipsel", "mipseb"]
archAliases Arm = ["armeb", "armel"]
archAliases _ = []
showArch :: Arch -> String
showArch (OtherArch name) = name
showArch other = lowercase (show other)
readArch :: String -> Arch
readArch s =
case lookup (lowercase s) archMap of
Just arch -> arch
Nothing -> OtherArch (lowercase s)
where
archMap = [ (name, arch)
| arch <- knownArches
, name <- showArch arch : archAliases arch ]
buildArch :: Arch
buildArch = readArch System.Info.arch
lowercase :: String -> String
lowercase = map Char.toLower
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