module Distribution.System (
OS(..),
buildOS,
Arch(..),
buildArch,
Platform(..),
buildPlatform,
platformFromTriple,
knownOSs,
knownArches,
ClassificationStrictness (..),
classifyOS,
classifyArch,
) where
import Prelude ()
import Distribution.Compat.Prelude
import Control.Applicative (liftA2)
import qualified System.Info (os, arch)
import Distribution.Utils.Generic (lowercase)
import Distribution.Parsec.Class
import Distribution.Pretty
import Distribution.Text
import qualified Distribution.Compat.ReadP as Parse
import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint as Disp
data ClassificationStrictness = Permissive | Compat | Strict
data OS = Linux | Windows | OSX
| FreeBSD | OpenBSD | NetBSD
| DragonFly
| Solaris | AIX | HPUX | IRIX
| HaLVM
| Hurd
| IOS | Android
| Ghcjs
| OtherOS String
deriving (Eq, Generic, Ord, Show, Read, Typeable, Data)
instance Binary OS
instance NFData OS where rnf = genericRnf
knownOSs :: [OS]
knownOSs = [Linux, Windows, OSX
,FreeBSD, OpenBSD, NetBSD, DragonFly
,Solaris, AIX, HPUX, IRIX
,HaLVM
,Hurd
,IOS, Android
,Ghcjs]
osAliases :: ClassificationStrictness -> OS -> [String]
osAliases Permissive Windows = ["mingw32", "win32", "cygwin32"]
osAliases Compat Windows = ["mingw32", "win32"]
osAliases _ OSX = ["darwin"]
osAliases _ Hurd = ["gnu"]
osAliases Permissive FreeBSD = ["kfreebsdgnu"]
osAliases Compat FreeBSD = ["kfreebsdgnu"]
osAliases Permissive Solaris = ["solaris2"]
osAliases Compat Solaris = ["solaris2"]
osAliases _ Android = ["linux-android"]
osAliases _ _ = []
instance Pretty OS where
pretty (OtherOS name) = Disp.text name
pretty other = Disp.text (lowercase (show other))
instance Parsec OS where
parsec = classifyOS Compat <$> parsecIdent
instance Text OS where
parse = fmap (classifyOS Compat) ident
classifyOS :: ClassificationStrictness -> String -> OS
classifyOS strictness s =
fromMaybe (OtherOS s) $ lookup (lowercase s) osMap
where
osMap = [ (name, os)
| os <- knownOSs
, name <- display os : osAliases strictness os ]
buildOS :: OS
buildOS = classifyOS Permissive System.Info.os
data Arch = I386 | X86_64 | PPC | PPC64 | Sparc
| Arm | AArch64 | Mips | SH
| IA64 | S390
| Alpha | Hppa | Rs6000
| M68k | Vax
| JavaScript
| OtherArch String
deriving (Eq, Generic, Ord, Show, Read, Typeable, Data)
instance Binary Arch
instance NFData Arch where rnf = genericRnf
knownArches :: [Arch]
knownArches = [I386, X86_64, PPC, PPC64, Sparc
,Arm, AArch64, Mips, SH
,IA64, S390
,Alpha, Hppa, Rs6000
,M68k, Vax
,JavaScript]
archAliases :: ClassificationStrictness -> Arch -> [String]
archAliases Strict _ = []
archAliases Compat _ = []
archAliases _ PPC = ["powerpc"]
archAliases _ PPC64 = ["powerpc64", "powerpc64le"]
archAliases _ Sparc = ["sparc64", "sun4"]
archAliases _ Mips = ["mipsel", "mipseb"]
archAliases _ Arm = ["armeb", "armel"]
archAliases _ AArch64 = ["arm64"]
archAliases _ _ = []
instance Pretty Arch where
pretty (OtherArch name) = Disp.text name
pretty other = Disp.text (lowercase (show other))
instance Parsec Arch where
parsec = classifyArch Strict <$> parsecIdent
instance Text Arch where
parse = fmap (classifyArch Strict) ident
classifyArch :: ClassificationStrictness -> String -> Arch
classifyArch strictness s =
fromMaybe (OtherArch s) $ lookup (lowercase s) archMap
where
archMap = [ (name, arch)
| arch <- knownArches
, name <- display arch : archAliases strictness arch ]
buildArch :: Arch
buildArch = classifyArch Permissive System.Info.arch
data Platform = Platform Arch OS
deriving (Eq, Generic, Ord, Show, Read, Typeable, Data)
instance Binary Platform
instance NFData Platform where rnf = genericRnf
instance Pretty Platform where
pretty (Platform arch os) = pretty arch <<>> Disp.char '-' <<>> pretty os
instance Parsec Platform where
parsec = do
arch <- parsecDashlessArch
_ <- P.char '-'
os <- parsec
return (Platform arch os)
where
parsecDashlessArch = classifyArch Strict <$> dashlessIdent
dashlessIdent = liftA2 (:) firstChar rest
where
firstChar = P.satisfy isAlpha
rest = P.munch (\c -> isAlphaNum c || c == '_')
instance Text Platform where
parse = do
arch <- parseDashlessArch
_ <- Parse.char '-'
os <- parse
return (Platform arch os)
where
parseDashlessArch :: Parse.ReadP r Arch
parseDashlessArch = fmap (classifyArch Strict) dashlessIdent
dashlessIdent :: Parse.ReadP r String
dashlessIdent = liftM2 (:) firstChar rest
where firstChar = Parse.satisfy isAlpha
rest = Parse.munch (\c -> isAlphaNum c || c == '_')
buildPlatform :: Platform
buildPlatform = Platform buildArch buildOS
ident :: Parse.ReadP r String
ident = liftM2 (:) firstChar rest
where firstChar = Parse.satisfy isAlpha
rest = Parse.munch (\c -> isAlphaNum c || c == '_' || c == '-')
parsecIdent :: CabalParsing m => m String
parsecIdent = (:) <$> firstChar <*> rest
where
firstChar = P.satisfy isAlpha
rest = P.munch (\c -> isAlphaNum c || c == '_' || c == '-')
platformFromTriple :: String -> Maybe Platform
platformFromTriple triple =
fmap fst (listToMaybe $ Parse.readP_to_S parseTriple triple)
where parseWord = Parse.munch1 (\c -> isAlphaNum c || c == '_')
parseTriple = do
arch <- fmap (classifyArch Permissive) parseWord
_ <- Parse.char '-'
_ <- parseWord
_ <- Parse.char '-'
os <- fmap (classifyOS Permissive) ident
return $ Platform arch os