-----------------------------------------------------------------------------
-- |
-- 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 \"ming32\"). 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,
  ) where

import qualified System.Info (os, arch)
import qualified Data.Char as Char (toLower, isAlphaNum)

import Distribution.Text (Text(..), display)
import qualified Distribution.Compat.ReadP as Parse
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        -- teir 1 desktop OSs
        | FreeBSD | OpenBSD | NetBSD   -- other free unix OSs
        | Solaris | AIX | HPUX | IRIX  -- ageing Unix OSs
        | HaLVM                        -- bare metal / VMs / hypervisors
        | OtherOS String
  deriving (D:Eq :: (a -> a -> Bool) -> (a -> a -> Bool) -> T:Eq aEq, D:Ord ::
  Eq a =>
  (a -> a -> Ordering)
  -> (a -> a -> Bool)
  -> (a -> a -> Bool)
  -> (a -> a -> Bool)
  -> (a -> a -> Bool)
  -> (a -> a -> a)
  -> (a -> a -> a)
  -> T:Ord aOrd, D:Show ::
  (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> T:Show aShow, D:Read ::
  (Int -> ReadS a)
  -> ReadS [a]
  -> ReadPrec a
  -> ReadPrec [a]
  -> T:Read aRead)

--TODO: decide how to handle Android and iOS.
-- They are like Linux and OSX but with some differences.
-- Should they be separate from linux/osx, or a subtype?
-- e.g. should we have os(linux) && os(android) true simultaneously?

knownOSs :: [OS]
knownOSs = [Linux :: OSLinux, Windows :: OSWindows, OSX :: OSOSX
           ,FreeBSD :: OSFreeBSD, OpenBSD :: OSOpenBSD, NetBSD :: OSNetBSD
           ,Solaris :: OSSolaris, AIX :: OSAIX, HPUX :: OSHPUX, IRIX :: OSIRIX
           ,HaLVM :: OSHaLVM]

osAliases :: ClassificationStrictness -> OS -> [String]
osAliases Permissive Windows = ["mingw32", "cygwin32"]
osAliases Compat     Windows = ["mingw32", "win32"]
osAliases _          OSX     = ["darwin"]
osAliases Permissive FreeBSD = ["kfreebsdgnu"]
osAliases Permissive Solaris = ["solaris2"]
osAliases _          _       = [] :: [a][]

instance D:Text :: (a -> Doc) -> (forall r. ReadP r a) -> T:Text aText OS where
  disp (OtherOS name) = text :: String -> DocDisp.text name :: Stringname
  disp other          = text :: String -> DocDisp.text (lowercase :: String -> Stringlowercase (show :: Show a => a -> Stringshow other :: OSother))

  parse = fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap (classifyOS :: ClassificationStrictness -> String -> OSclassifyOS Compat :: ClassificationStrictnessCompat) ident :: ReadP r Stringident

classifyOS :: ClassificationStrictness -> String -> OS
classifyOS strictness s =
  case lookup :: Eq a => a -> [(a, b)] -> Maybe blookup (lowercase :: String -> Stringlowercase s :: Strings) osMap :: [(String, OS)]osMap of
    Just os -> os :: OSos
    Nothing -> OtherOS :: String -> OSOtherOS s :: Strings
  where
    osMap = [ (name :: Stringname, os :: OSos)
            | os <- knownOSs :: [OS]knownOSs
            , name <- display :: Text a => a -> Stringdisplay os :: OSos (:) :: a -> [a] -> [a]: osAliases :: ClassificationStrictness -> OS -> [String]osAliases strictness :: ClassificationStrictnessstrictness os :: OSos ]

buildOS :: OS
buildOS = classifyOS :: ClassificationStrictness -> String -> OSclassifyOS Permissive :: ClassificationStrictnessPermissive os :: StringSystem.Info.os

-- ------------------------------------------------------------
-- * Machine Architecture
-- ------------------------------------------------------------

data Arch = I386  | X86_64 | PPC | PPC64 | Sparc
          | Arm   | Mips   | SH
          | IA64  | S390
          | Alpha | Hppa   | Rs6000
          | M68k  | Vax
          | OtherArch String
  deriving (D:Eq :: (a -> a -> Bool) -> (a -> a -> Bool) -> T:Eq aEq, D:Ord ::
  Eq a =>
  (a -> a -> Ordering)
  -> (a -> a -> Bool)
  -> (a -> a -> Bool)
  -> (a -> a -> Bool)
  -> (a -> a -> Bool)
  -> (a -> a -> a)
  -> (a -> a -> a)
  -> T:Ord aOrd, D:Show ::
  (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> T:Show aShow, D:Read ::
  (Int -> ReadS a)
  -> ReadS [a]
  -> ReadPrec a
  -> ReadPrec [a]
  -> T:Read aRead)

knownArches :: [Arch]
knownArches = [I386 :: ArchI386, X86_64 :: ArchX86_64, PPC :: ArchPPC, PPC64 :: ArchPPC64, Sparc :: ArchSparc
              ,Arm :: ArchArm, Mips :: ArchMips, SH :: ArchSH
              ,IA64 :: ArchIA64, S390 :: ArchS390
              ,Alpha :: ArchAlpha, Hppa :: ArchHppa, Rs6000 :: ArchRs6000
              ,M68k :: ArchM68k, Vax :: ArchVax]

archAliases :: ClassificationStrictness -> Arch -> [String]
archAliases Strict _     = [] :: [a][]
archAliases Compat _     = [] :: [a][]
archAliases _      PPC   = ["powerpc"]
archAliases _      PPC64 = ["powerpc64"]
archAliases _      Sparc = ["sparc64", "sun4"]
archAliases _      Mips  = ["mipsel", "mipseb"]
archAliases _      Arm   = ["armeb", "armel"]
archAliases _      _     = [] :: [a][]

instance D:Text :: (a -> Doc) -> (forall r. ReadP r a) -> T:Text aText Arch where
  disp (OtherArch name) = text :: String -> DocDisp.text name :: Stringname
  disp other            = text :: String -> DocDisp.text (lowercase :: String -> Stringlowercase (show :: Show a => a -> Stringshow other :: OSother))

  parse = fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap (classifyArch :: ClassificationStrictness -> String -> ArchclassifyArch Strict :: ClassificationStrictnessStrict) ident :: ReadP r Stringident

classifyArch :: ClassificationStrictness -> String -> Arch
classifyArch strictness s =
  case lookup :: Eq a => a -> [(a, b)] -> Maybe blookup (lowercase :: String -> Stringlowercase s :: Strings) archMap :: [(String, Arch)]archMap of
    Just arch -> arch :: Archarch
    Nothing   -> OtherArch :: String -> ArchOtherArch s :: Strings
  where
    archMap = [ (name :: Stringname, arch :: Archarch)
              | arch <- knownArches :: [Arch]knownArches
              , name <- display :: Text a => a -> Stringdisplay arch :: Archarch (:) :: a -> [a] -> [a]: archAliases :: ClassificationStrictness -> Arch -> [String]archAliases strictness :: ClassificationStrictnessstrictness arch :: Archarch ]

buildArch :: Arch
buildArch = classifyArch :: ClassificationStrictness -> String -> ArchclassifyArch Permissive :: ClassificationStrictnessPermissive arch :: StringSystem.Info.arch

-- ------------------------------------------------------------
-- * Platform
-- ------------------------------------------------------------

data Platform = Platform Arch OS
  deriving (D:Eq :: (a -> a -> Bool) -> (a -> a -> Bool) -> T:Eq aEq, D:Ord ::
  Eq a =>
  (a -> a -> Ordering)
  -> (a -> a -> Bool)
  -> (a -> a -> Bool)
  -> (a -> a -> Bool)
  -> (a -> a -> Bool)
  -> (a -> a -> a)
  -> (a -> a -> a)
  -> T:Ord aOrd, D:Show ::
  (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> T:Show aShow, D:Read ::
  (Int -> ReadS a)
  -> ReadS [a]
  -> ReadPrec a
  -> ReadPrec [a]
  -> T:Read aRead)

instance D:Text :: (a -> Doc) -> (forall r. ReadP r a) -> T:Text aText Platform where
  disp (Platform arch os) = disp :: Text a => a -> Docdisp arch :: Archarch (<>) :: Doc -> Doc -> Doc<> char :: Char -> DocDisp.char '-' (<>) :: Doc -> Doc -> Doc<> disp :: Text a => a -> Docdisp os :: OSos
  parse = do
    arch <- parse :: Text a => forall r. ReadP r aparse
    _ <- char :: Char -> ReadP r CharParse.char '-'
    os   <- parse :: Text a => forall r. ReadP r aparse
    return :: Monad m => forall a. a -> m areturn (Platform :: Arch -> OS -> PlatformPlatform arch :: Archarch os :: OSos)

buildPlatform :: Platform
buildPlatform = Platform :: Arch -> OS -> PlatformPlatform buildArch :: ArchbuildArch buildOS :: OSbuildOS

-- Utils:

ident :: Parse.ReadP r String
ident = munch1 :: (Char -> Bool) -> ReadP r StringParse.munch1 (\c -> isAlphaNum :: Char -> BoolChar.isAlphaNum c :: Charc (||) :: Bool -> Bool -> Bool|| c :: Charc (==) :: Eq a => a -> a -> Bool== '_' (||) :: Bool -> Bool -> Bool|| c :: Charc (==) :: Eq a => a -> a -> Bool== '-')
  --TODO: probably should disallow starting with a number

lowercase :: String -> String
lowercase = map :: (a -> b) -> [a] -> [b]map toLower :: Char -> CharChar.toLower