1-- |
2-- Module      : Foundation.System.Info
3-- License     : BSD-style
4-- Maintainer  : foundation
5-- Stability   : experimental
6-- Portability : portable
7--
8
9{-# LANGUAGE CPP #-}
10
11module Foundation.System.Info
12    (
13      -- * Operation System info
14      OS(..)
15    , os
16      -- * CPU info
17    , Arch(..)
18    , arch
19    , cpus
20    , Endianness(..)
21    , endianness
22      -- * Compiler info
23    , compilerName
24    , System.Info.compilerVersion
25    , Data.Version.Version(..)
26    ) where
27
28import qualified System.Info
29import qualified Data.Version
30import           Data.Data
31import qualified GHC.Conc
32import           Basement.Compat.Base
33import           Basement.Endianness (Endianness(..), endianness)
34import           Foundation.String
35
36data OS
37    = Windows
38    | OSX
39    | Linux
40    | Android
41    | BSD
42  deriving (Show, Eq, Ord, Enum, Bounded, Data, Typeable)
43
44-- | get the operating system on which the program is running.
45--
46-- Either return the known `OS` or a strict `String` of the OS name.
47--
48-- This function uses the `base`'s `System.Info.os` function.
49--
50os :: Either [Char] OS
51os = case System.Info.os of
52    "darwin"  -> Right OSX
53    "mingw32" -> Right Windows
54    "linux"   -> Right Linux
55    "linux-android" -> Right Android
56    "openbsd" -> Right BSD
57    "netbsd"  -> Right BSD
58    "freebsd" -> Right BSD
59    str       -> Left str
60
61-- | Enumeration of the known GHC supported architecture.
62--
63data Arch
64    = I386
65    | X86_64
66    | PowerPC
67    | PowerPC64
68    | Sparc
69    | Sparc64
70    | ARM
71    | ARM64
72  deriving (Show, Eq, Ord, Enum, Bounded, Data, Typeable)
73
74-- | get the machine architecture on which the program is running
75--
76-- Either return the known architecture or a Strict `String` of the
77-- architecture name.
78--
79-- This function uses the `base`'s `System.Info.arch` function.
80--
81arch :: Either [Char] Arch
82arch = case System.Info.arch of
83    "i386"          -> Right I386
84    "x86_64"        -> Right X86_64
85    "powerpc"       -> Right PowerPC
86    "powerpc64"     -> Right PowerPC64
87    "powerpc64le"   -> Right PowerPC64
88    "sparc"         -> Right Sparc
89    "sparc64"       -> Right Sparc64
90    "arm"           -> Right ARM
91    "aarch64"       -> Right ARM64
92    str             -> Left str
93
94-- | get the compiler name
95--
96-- get the compilerName from base package but convert
97-- it into a strict String
98compilerName :: String
99compilerName = fromList System.Info.compilerName
100
101-- | returns the number of CPUs the machine has
102cpus :: IO Int
103cpus = GHC.Conc.getNumProcessors
104