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