Distribution/System.hs

    {-# 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,

      -- * Classification
      ClassificationStrictness (..),
      classifyOS,
      classifyArch,
      ) where

    import Prelude ()
    import Distribution.Compat.Prelude

    import qualified System.Info (os, arch)

    import Distribution.Text
    import qualified Distribution.Compat.ReadP as Parse

    import qualified Text.PrettyPrint as Disp

    -- | 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
    -- ------------------------------------------------------------

    -- | These are the known OS names: Linux, Windows, OSX
    --  ,FreeBSD, OpenBSD, NetBSD, DragonFly
    --  ,Solaris, AIX, HPUX, IRIX
    --  ,HaLVM ,Hurd ,IOS, Android,Ghcjs
    --
    -- The following aliases can also be used:,
    --    * Windows aliases: mingw32, win32, cygwin32
    --    * OSX alias: darwin
    --    * Hurd alias: gnu
    --    * FreeBSD alias: kfreebsdgnu
    --    * Solaris alias: solaris2
    --
    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
    -- ------------------------------------------------------------

    -- | These are the known Arches: I386, X86_64, PPC, PPC64, Sparc
    -- ,Arm, Mips, SH, IA64, S39, Alpha, Hppa, Rs6000, M68k, Vax
    -- and JavaScript.
    --
    -- The following aliases can also be used:
    --    * PPC alias: powerpc
    --    * PPC64 alias : powerpc64
    --    * Sparc aliases: sparc64, sun4
    --    * Mips aliases: mipsel, mipseb
    --    * Arm aliases: armeb, armel
    --
    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 (:) firstChar rest
      where firstChar = Parse.satisfy isAlpha
            rest = Parse.munch (\c -> isAlphaNum c || c == '_' || c == '-')

    dashlessIdent :: Parse.ReadP r String
    dashlessIdent = liftM2 (:) firstChar rest
      where firstChar = Parse.satisfy isAlpha
            rest = Parse.munch (\c -> isAlphaNum c || c == '_')

    lowercase :: String -> String
    lowercase = map toLower

    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 -- Skip vendor
              _ <- Parse.char '-'
              os <- fmap (classifyOS Permissive) ident -- OS may have hyphens, like
                                                   -- 'nto-qnx'
              return $ Platform arch os