Commit 3108588e authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Extend and use the OS data type in the package description

Rather than just using a string. This makes comparing OSs easier since
we can normalise them once when we parse rather than every time we compare.
Also makes it easy to discover when a package mentions an unknown OS since
it's marked as Other "whatever".
parent 4bdbdfab
......@@ -85,6 +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.Simple.Utils (currentDir)
import Language.Haskell.Extension (Extension)
......@@ -453,14 +454,14 @@ data ConfFlag = ConfFlag String
deriving Eq
-- | A @ConfVar@ represents the variable type used.
data ConfVar = OS String
data ConfVar = OS OS
| Arch String
| Flag ConfFlag
| Impl String VersionRange
deriving Eq
instance Show ConfVar where
show (OS n) = "os(" ++ n ++ ")"
show (OS os) = "os(" ++ showOS os ++ ")"
show (Arch n) = "arch(" ++ n ++ ")"
show (Flag (ConfFlag f)) = "flag(" ++ f ++ ")"
show (Impl c v) = "impl(" ++ c ++ " " ++ showVersionRange v ++ ")"
......
......@@ -62,7 +62,9 @@ import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Version
( Version(..), Dependency(..), VersionRange(..)
, withinRange, parseVersionRange )
import Distribution.Simple.Utils (currentDir)
import Distribution.System
( OS, readOS )
import Distribution.Simple.Utils (currentDir, lowercase)
import Distribution.Compat.ReadP as ReadP hiding ( char )
import qualified Distribution.Compat.ReadP as ReadP ( char )
......@@ -115,25 +117,18 @@ 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 :: String -> String -> (String, Version) -> Condition ConfVar ->
(Condition ConfFlag, [String])
simplifyWithSysParams :: OS -> String -> (String, Version) -> Condition ConfVar
-> (Condition ConfFlag, [String])
simplifyWithSysParams os arch (impl, implVer) cond = (cond', flags)
where
(cond', fvs) = simplifyCondition cond interp
interp (OS name) = Right $ lcase name == lcase os
|| lcase name `elem` osAliases (lcase os)
interp (Arch name) = Right $ lcase name == lcase arch
interp (Impl i vr) = Right $ lcase impl == lcase i
interp (OS os') = Right $ os' == os
interp (Arch name) = Right $ lowercase name == lowercase arch
interp (Impl i vr) = Right $ lowercase impl == lowercase i
&& implVer `withinRange` vr
interp (Flag f) = Left f
flags = [ fname | ConfFlag fname <- fvs ]
--FIXME: use Distribution.System.OS type and alias list:
osAliases "mingw32" = ["windows"]
osAliases "solaris2" = ["solaris"]
osAliases _ = []
lcase = map toLower
-- XXX: Add instances and check
--
-- prop_sC_idempotent cond a o = cond' == cond''
......@@ -161,7 +156,7 @@ parseCondition = condOr
+++ archCond +++ flagCond +++ implCond )
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
osCond = string "os" >> sp >> inparens osIdent >>= return . Var . OS . readOS
archCond = string "arch" >> sp >> inparens archIdent >>= return . Var . Arch
flagCond = string "flag" >> sp >> inparens flagIdent >>= return . Var . Flag . ConfFlag
implCond = string "impl" >> sp >> inparens implIdent >>= return . Var
......@@ -234,7 +229,7 @@ data BT a = BTN a | BTB (BT a) (BT a) -- very simple binary tree
resolveWithFlags :: Monoid a =>
[(String,[Bool])]
-- ^ Domain for each flag name, will be tested in order.
-> String -- ^ OS name, as returned by System.Info.os
-> OS -- ^ OS as returned by Distribution.System.buildOS
-> String -- ^ arch name, as returned by System.Info.arch
-> (String, Version) -- ^ Compiler name + version
-> [CondTree ConfVar [d] a]
......@@ -349,7 +344,7 @@ finalizePackageDescription
=> [(String,Bool)] -- ^ Explicitly specified flag assignments
-> Maybe (PackageIndex pkg) -- ^ Available dependencies. Pass 'Nothing' if
-- this is unknown.
-> String -- ^ OS-name
-> OS -- ^ OS-name
-> String -- ^ Arch-name
-> (String, Version) -- ^ Compiler + Version
-> GenericPackageDescription
......
......@@ -129,7 +129,7 @@ import System.Exit
import System.FilePath
( (</>) )
import qualified System.Info
( os, arch )
( arch )
import System.IO
( hPutStrLn, stderr )
import Text.PrettyPrint.HughesPJ
......@@ -231,7 +231,7 @@ configure (pkg_descr0, pbi) cfg
case finalizePackageDescription
(configConfigurationsFlags cfg)
maybePackageIndex
System.Info.os
Distribution.System.os
System.Info.arch
(map toLower (show flavor),version)
ppd
......
module Distribution.System where
module Distribution.System (
-- * Operating System
OS(..),
Windows(..),
showOS,
readOS,
os,
) where
import qualified System.Info
import qualified System.Info (os)
import qualified Data.Char as Char (toLower)
data OS = Linux | Windows Windows | OSX | Solaris | Other String
-- ------------------------------------------------------------
-- * Operating System
-- ------------------------------------------------------------
data OS = Linux | Windows Windows | OSX
| FreeBSD | OpenBSD | NetBSD
| Solaris | AIX | HPUX | IRIX
| Other String
deriving (Eq, Ord, Show, Read)
--TODO: eliminate Windows data type
data Windows = MingW
deriving (Eq, Ord, Show, Read)
knownOSs :: [OS]
knownOSs = [Linux, Windows MingW, OSX
,FreeBSD, OpenBSD, NetBSD
,Solaris, AIX, HPUX, IRIX]
osAliases :: OS -> [String]
osAliases (Windows _) = ["mingw32", "cygwin32"]
osAliases OSX = ["darwin"]
osAliases FreeBSD = ["kfreebsdgnu"]
osAliases Solaris = ["solaris2"]
osAliases _ = []
showOS :: OS -> String
showOS (Other name) = lowercase 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
--TODO: rename to buildOS and rename os' above to just os
os :: OS
os = case System.Info.os of
"linux" -> Linux
"mingw32" -> Windows MingW
"darwin" -> OSX
"solaris2" -> Solaris
other -> Other other
os = readOS System.Info.os
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