/
System.hs
235 lines (199 loc) · 7.72 KB
/
System.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.System
-- Copyright : Duncan Coutts 2007-2008
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
--
-- Cabal often needs to do slightly different things on specific platforms. You
-- probably know about the 'System.Info.os' however using that is very
-- inconvenient because it is a string and different Haskell implementations
-- do not agree on using the same strings for the same platforms! (In
-- particular see the controversy over \"windows\" vs \"mingw32\"). So to make it
-- more consistent and easy to use we have an 'OS' enumeration.
--
module Distribution.System (
-- * Operating System
OS(..),
buildOS,
-- * Machine Architecture
Arch(..),
buildArch,
-- * Platform is a pair of arch and OS
Platform(..),
buildPlatform,
platformFromTriple,
-- * Internal
knownOSs,
knownArches
) where
import qualified System.Info (os, arch)
import qualified Data.Char as Char (toLower, isAlphaNum, isAlpha)
import Distribution.Compat.Binary
import Distribution.Text
import qualified Distribution.Compat.ReadP as Parse
import Control.Monad (liftM2)
import Data.Data (Data)
import Data.Typeable (Typeable)
import Data.Maybe (fromMaybe, listToMaybe)
import GHC.Generics (Generic)
import qualified Text.PrettyPrint as Disp
import Text.PrettyPrint ((<>))
-- | How strict to be when classifying strings into the 'OS' and 'Arch' enums.
--
-- The reason we have multiple ways to do the classification is because there
-- are two situations where we need to do it.
--
-- For parsing OS and arch names in .cabal files we really want everyone to be
-- referring to the same or or arch by the same name. Variety is not a virtue
-- in this case. We don't mind about case though.
--
-- For the System.Info.os\/arch different Haskell implementations use different
-- names for the same or\/arch. Also they tend to distinguish versions of an
-- OS\/arch which we just don't care about.
--
-- The 'Compat' classification allows us to recognise aliases that are already
-- in common use but it allows us to distinguish them from the canonical name
-- which enables us to warn about such deprecated aliases.
--
data ClassificationStrictness = Permissive | Compat | Strict
-- ------------------------------------------------------------
-- * Operating System
-- ------------------------------------------------------------
data OS = Linux | Windows | OSX -- tier 1 desktop OSs
| FreeBSD | OpenBSD | NetBSD -- other free Unix OSs
| DragonFly
| Solaris | AIX | HPUX | IRIX -- ageing Unix OSs
| HaLVM -- bare metal / VMs / hypervisors
| Hurd -- GNU's microkernel
| IOS | Android -- mobile OSs
| Ghcjs
| OtherOS String
deriving (Eq, Generic, Ord, Show, Read, Typeable, Data)
instance Binary OS
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 _ _ = []
instance Text OS where
disp (OtherOS name) = Disp.text name
disp other = Disp.text (lowercase (show other))
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
-- ------------------------------------------------------------
-- * Machine Architecture
-- ------------------------------------------------------------
data Arch = I386 | X86_64 | PPC | PPC64 | Sparc
| Arm | Mips | SH
| IA64 | S390
| Alpha | Hppa | Rs6000
| M68k | Vax
| JavaScript
| OtherArch String
deriving (Eq, Generic, Ord, Show, Read, Typeable, Data)
instance Binary Arch
knownArches :: [Arch]
knownArches = [I386, X86_64, PPC, PPC64, Sparc
,Arm, Mips, SH
,IA64, S390
,Alpha, Hppa, Rs6000
,M68k, Vax
,JavaScript]
archAliases :: ClassificationStrictness -> Arch -> [String]
archAliases Strict _ = []
archAliases Compat _ = []
archAliases _ PPC = ["powerpc"]
archAliases _ PPC64 = ["powerpc64"]
archAliases _ Sparc = ["sparc64", "sun4"]
archAliases _ Mips = ["mipsel", "mipseb"]
archAliases _ Arm = ["armeb", "armel"]
archAliases _ _ = []
instance Text Arch where
disp (OtherArch name) = Disp.text name
disp other = Disp.text (lowercase (show other))
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
-- ------------------------------------------------------------
-- * Platform
-- ------------------------------------------------------------
data Platform = Platform Arch OS
deriving (Eq, Generic, Ord, Show, Read, Typeable, Data)
instance Binary Platform
instance Text Platform where
disp (Platform arch os) = disp arch <> Disp.char '-' <> disp os
-- TODO: there are ambigious platforms like: `arch-word-os`
-- which could be parsed as
-- * Platform "arch-word" "os"
-- * Platform "arch" "word-os"
-- We could support that preferring variants 'OtherOS' or 'OtherArch'
--
-- For now we split into arch and os parts on the first dash.
parse = do
arch <- parseDashlessArch
_ <- Parse.char '-'
os <- parse
return (Platform arch os)
where
parseDashlessArch :: Parse.ReadP r Arch
parseDashlessArch = fmap (classifyArch Strict) dashlessIdent
-- | The platform Cabal was compiled on. In most cases,
-- @LocalBuildInfo.hostPlatform@ should be used instead (the platform we're
-- targeting).
buildPlatform :: Platform
buildPlatform = Platform buildArch buildOS
-- Utils:
ident :: Parse.ReadP r String
ident = liftM2 (:) first rest
where first = Parse.satisfy Char.isAlpha
rest = Parse.munch (\c -> Char.isAlphaNum c || c == '_' || c == '-')
dashlessIdent :: Parse.ReadP r String
dashlessIdent = liftM2 (:) first rest
where first = Parse.satisfy Char.isAlpha
rest = Parse.munch (\c -> Char.isAlphaNum c || c == '_')
lowercase :: String -> String
lowercase = map Char.toLower
platformFromTriple :: String -> Maybe Platform
platformFromTriple triple =
fmap fst (listToMaybe $ Parse.readP_to_S parseTriple triple)
where parseWord = Parse.munch1 (\c -> Char.isAlphaNum c || c == '_')
parseTriple = do
arch <- fmap (classifyArch Permissive) parseWord
_ <- Parse.char '-'
_ <- parseWord -- Skip vendor
_ <- Parse.char '-'
os <- fmap (classifyOS Permissive) ident -- OS may have hyphens, like
-- 'nto-qnx'
return $ Platform arch os