{-|
Module      : System.CPU
Description : Haskell Library for Checking CPU Information
Copyright   : Travis Whitaker 2016
License     : MIT
Maintainer  : pi.boy.travis@gmail.com
Stability   : Provisional
Portability : Linux >=2.6

This module provides information about the processors available on a system.
Modern hardware provides not only multiple physical processors and physical
cores, but logical cores which may not have dedicated execution resources.
Intel's Hyper-Threading is an example of such a technology, capable of providing
two logical cores for every physical core present on a supported physical
processor.

These additional logical cores increase the performance of some, but not all
workloads. Indeed, some parallel workloads may suffer a performance decrease if
all logical cores presented by the operating system do not have dedicated
physical resources. This is because technologies providing supernumerary logical
cores typically work by scheduling multiple threads in a shared pool of
execution resources, e.g. ALUs and FPUs. If threads sharing a pool of execution
resources are doing the same sort of work there will be scheduling contention
for a single type of execution resource on the physical core.

It is common for threaded Haskell programs to be run with @+RTS -N@, causing the
RTS to simply multiplex Haskell threads or sparks over the number of logical
cores available. However, if each logical core does not have dedicated physical
resources and the thread/spark workloads are similar, then this might be slower
than multiplexing over fewer cores.

This package allows a program to use information about the physical and logical
features of the available processors as a heuristic for selecting the number of
worker OS threads to use (e.g. via 'setNumCapabilities'). Some workloads may
benefit from, for example, using half the number of logical cores available if
there are in fact two logical cores for each physical core. This is typically
true of numerical workloads, but as always benchmarking should be employed to
evaluate the impact of different heuristics.

In its current state this module can only collect information from Linux systems
with a kernel from the 2.6 branch or later by reading @\/proc\/cpuinfo@. If this
module is unable to provide information on your system please file a bug
including your @\/proc\/cpuinfo@. Help providing Windows support would be
greatly appreciated!
-}

{-# LANGUAGE DeriveAnyClass
           , DeriveDataTypeable
           , DeriveGeneric
           , OverloadedStrings
           #-}

module System.CPU (
    CPU(..)
    -- * Retrieving CPU Information
  , getCPUs
  , tryGetCPUs
    -- * Physical Features
  , physicalProcessors
  , physicalCores
  , logicalCores
  , hyperthreadingFactor
  , hyperthreadingInUse
  ) where

import Control.Applicative

import Control.Arrow

import Control.DeepSeq

import qualified Data.Attoparsec.ByteString.Char8 as A

import qualified Data.ByteString       as B
import qualified Data.ByteString.Char8 as BC

import Data.Data

import Data.Foldable

import Data.List

import Data.Maybe

import Data.Word

import GHC.Generics

-- | Representation of a logical processor and its features.
data CPU = CPU {
    -- | Logical Processor Index
    CPU -> Word32
processorID     :: !Word32
    -- | CPU Vendor
  , CPU -> Maybe ByteString
vendor          :: !(Maybe B.ByteString)
    -- | CPU Model Number
  , CPU -> Maybe Word32
model           :: !(Maybe Word32)
    -- | CPU Model Name
  , CPU -> Maybe ByteString
modelName       :: !(Maybe B.ByteString)
    -- | CPU Model Revision
  , CPU -> Maybe Word32
revision        :: !(Maybe Word32)
    -- | CPU Microcode Revision
  , CPU -> Maybe Word32
microcode       :: !(Maybe Word32)
    -- | Processor Frequency
  , CPU -> Double
freq            :: !Double
    -- | CPU Cache Size. (TODO figure out how to get the cache topology)
  , CPU -> Maybe Word32
cache           :: !(Maybe Word32)
    -- | Physical Processor Index
  , CPU -> Word32
physicalID      :: !Word32
    -- | Number of Physical Cores on this Physical Processor.
  , CPU -> Word32
siblings        :: !Word32
    -- | Physical Core Index
  , CPU -> Word32
coreID          :: !Word32
    -- | CPU APIC Index
  , CPU -> Maybe Word32
apicID          :: !(Maybe Word32)
    -- | Whether or not the Physical Core provides a floating point unit.
  , CPU -> Maybe Bool
fpu             :: !(Maybe Bool)
    -- | Whether or not the Physical Core provides a floating point exception
    --   unit.
  , CPU -> Maybe Bool
fpuExcept       :: !(Maybe Bool)
    -- | Vendor-specific CPU flags.
  , CPU -> Maybe [ByteString]
flags           :: !(Maybe [B.ByteString])
    -- | MIPS approximation computed by the Linux kernel on boot.
  , CPU -> Double
bogoMIPS        :: !Double
    -- | Cache line size in bytes.
  , CPU -> Maybe Word32
cacheAlignment  :: !(Maybe Word32)
    -- | Physical address width.
  , CPU -> Maybe Word32
physicalAddress :: !(Maybe Word32)
    -- | Virtual address width.
  , CPU -> Maybe Word32
virtualAddress  :: !(Maybe Word32)
  } deriving ( CPU -> CPU -> Bool
(CPU -> CPU -> Bool) -> (CPU -> CPU -> Bool) -> Eq CPU
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CPU -> CPU -> Bool
$c/= :: CPU -> CPU -> Bool
== :: CPU -> CPU -> Bool
$c== :: CPU -> CPU -> Bool
Eq
             , Eq CPU
Eq CPU
-> (CPU -> CPU -> Ordering)
-> (CPU -> CPU -> Bool)
-> (CPU -> CPU -> Bool)
-> (CPU -> CPU -> Bool)
-> (CPU -> CPU -> Bool)
-> (CPU -> CPU -> CPU)
-> (CPU -> CPU -> CPU)
-> Ord CPU
CPU -> CPU -> Bool
CPU -> CPU -> Ordering
CPU -> CPU -> CPU
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CPU -> CPU -> CPU
$cmin :: CPU -> CPU -> CPU
max :: CPU -> CPU -> CPU
$cmax :: CPU -> CPU -> CPU
>= :: CPU -> CPU -> Bool
$c>= :: CPU -> CPU -> Bool
> :: CPU -> CPU -> Bool
$c> :: CPU -> CPU -> Bool
<= :: CPU -> CPU -> Bool
$c<= :: CPU -> CPU -> Bool
< :: CPU -> CPU -> Bool
$c< :: CPU -> CPU -> Bool
compare :: CPU -> CPU -> Ordering
$ccompare :: CPU -> CPU -> Ordering
$cp1Ord :: Eq CPU
Ord
             , ReadPrec [CPU]
ReadPrec CPU
Int -> ReadS CPU
ReadS [CPU]
(Int -> ReadS CPU)
-> ReadS [CPU] -> ReadPrec CPU -> ReadPrec [CPU] -> Read CPU
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CPU]
$creadListPrec :: ReadPrec [CPU]
readPrec :: ReadPrec CPU
$creadPrec :: ReadPrec CPU
readList :: ReadS [CPU]
$creadList :: ReadS [CPU]
readsPrec :: Int -> ReadS CPU
$creadsPrec :: Int -> ReadS CPU
Read
             , Int -> CPU -> ShowS
[CPU] -> ShowS
CPU -> String
(Int -> CPU -> ShowS)
-> (CPU -> String) -> ([CPU] -> ShowS) -> Show CPU
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CPU] -> ShowS
$cshowList :: [CPU] -> ShowS
show :: CPU -> String
$cshow :: CPU -> String
showsPrec :: Int -> CPU -> ShowS
$cshowsPrec :: Int -> CPU -> ShowS
Show
             , Typeable CPU
DataType
Constr
Typeable CPU
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> CPU -> c CPU)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CPU)
-> (CPU -> Constr)
-> (CPU -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CPU))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CPU))
-> ((forall b. Data b => b -> b) -> CPU -> CPU)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CPU -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CPU -> r)
-> (forall u. (forall d. Data d => d -> u) -> CPU -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> CPU -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CPU -> m CPU)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CPU -> m CPU)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CPU -> m CPU)
-> Data CPU
CPU -> DataType
CPU -> Constr
(forall b. Data b => b -> b) -> CPU -> CPU
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CPU -> c CPU
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CPU
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CPU -> u
forall u. (forall d. Data d => d -> u) -> CPU -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CPU -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CPU -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CPU -> m CPU
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CPU -> m CPU
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CPU
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CPU -> c CPU
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CPU)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CPU)
$cCPU :: Constr
$tCPU :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> CPU -> m CPU
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CPU -> m CPU
gmapMp :: (forall d. Data d => d -> m d) -> CPU -> m CPU
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CPU -> m CPU
gmapM :: (forall d. Data d => d -> m d) -> CPU -> m CPU
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CPU -> m CPU
gmapQi :: Int -> (forall d. Data d => d -> u) -> CPU -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CPU -> u
gmapQ :: (forall d. Data d => d -> u) -> CPU -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CPU -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CPU -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CPU -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CPU -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CPU -> r
gmapT :: (forall b. Data b => b -> b) -> CPU -> CPU
$cgmapT :: (forall b. Data b => b -> b) -> CPU -> CPU
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CPU)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CPU)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CPU)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CPU)
dataTypeOf :: CPU -> DataType
$cdataTypeOf :: CPU -> DataType
toConstr :: CPU -> Constr
$ctoConstr :: CPU -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CPU
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CPU
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CPU -> c CPU
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CPU -> c CPU
$cp1Data :: Typeable CPU
Data
             , Typeable
             , (forall x. CPU -> Rep CPU x)
-> (forall x. Rep CPU x -> CPU) -> Generic CPU
forall x. Rep CPU x -> CPU
forall x. CPU -> Rep CPU x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CPU x -> CPU
$cfrom :: forall x. CPU -> Rep CPU x
Generic
             , CPU -> ()
(CPU -> ()) -> NFData CPU
forall a. (a -> ()) -> NFData a
rnf :: CPU -> ()
$crnf :: CPU -> ()
NFData
             )

parsePair :: B.ByteString -> A.Parser a -> A.Parser a
parsePair :: ByteString -> Parser a -> Parser a
parsePair ByteString
k Parser a
vp = ByteString -> Parser ByteString
A.string ByteString
k
              Parser ByteString -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ()
A.skipSpace
              Parser ByteString ()
-> Parser ByteString Char -> Parser ByteString Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString Char
A.char Char
':'
              Parser ByteString Char
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ()
A.skipSpace
              Parser ByteString () -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
vp

parseProcessor :: A.Parser Word32
parseProcessor :: Parser Word32
parseProcessor = ByteString -> Parser Word32 -> Parser Word32
forall a. ByteString -> Parser a -> Parser a
parsePair ByteString
"processor" Parser Word32
forall a. Integral a => Parser a
A.decimal

parseVendor :: A.Parser B.ByteString
parseVendor :: Parser ByteString
parseVendor = ByteString -> Parser ByteString -> Parser ByteString
forall a. ByteString -> Parser a -> Parser a
parsePair ByteString
"vendor_id" Parser ByteString
A.takeByteString

parseModel :: A.Parser Word32
parseModel :: Parser Word32
parseModel = ByteString -> Parser Word32 -> Parser Word32
forall a. ByteString -> Parser a -> Parser a
parsePair ByteString
"model" Parser Word32
forall a. Integral a => Parser a
A.decimal

parseModelName :: A.Parser B.ByteString
parseModelName :: Parser ByteString
parseModelName = ByteString -> Parser ByteString -> Parser ByteString
forall a. ByteString -> Parser a -> Parser a
parsePair ByteString
"model name" Parser ByteString
A.takeByteString

parseRevision :: A.Parser Word32
parseRevision :: Parser Word32
parseRevision = ByteString -> Parser Word32 -> Parser Word32
forall a. ByteString -> Parser a -> Parser a
parsePair ByteString
"stepping" Parser Word32
forall a. Integral a => Parser a
A.decimal

parseMicrocode :: A.Parser Word32
parseMicrocode :: Parser Word32
parseMicrocode = ByteString -> Parser Word32 -> Parser Word32
forall a. ByteString -> Parser a -> Parser a
parsePair ByteString
"microcode" (ByteString -> Parser ByteString
A.string ByteString
"0x" Parser ByteString -> Parser Word32 -> Parser Word32
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Word32
forall a. (Integral a, Bits a) => Parser a
A.hexadecimal)

parseFreq :: A.Parser Double
parseFreq :: Parser Double
parseFreq = ByteString -> Parser Double -> Parser Double
forall a. ByteString -> Parser a -> Parser a
parsePair ByteString
"cpu MHz" Parser Double
A.double

parseCache :: A.Parser Word32
parseCache :: Parser Word32
parseCache = ByteString -> Parser Word32 -> Parser Word32
forall a. ByteString -> Parser a -> Parser a
parsePair ByteString
"cache size"
                       (Parser Word32
forall a. Integral a => Parser a
A.decimal Parser Word32 -> Parser ByteString -> Parser Word32
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser ByteString ()
A.skipSpace Parser ByteString () -> Parser ByteString -> Parser ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ByteString -> Parser ByteString
A.string ByteString
"KB"))

parsePhysicalID :: A.Parser Word32
parsePhysicalID :: Parser Word32
parsePhysicalID = ByteString -> Parser Word32 -> Parser Word32
forall a. ByteString -> Parser a -> Parser a
parsePair ByteString
"physical id" Parser Word32
forall a. Integral a => Parser a
A.decimal

parseSiblings :: A.Parser Word32
parseSiblings :: Parser Word32
parseSiblings = ByteString -> Parser Word32 -> Parser Word32
forall a. ByteString -> Parser a -> Parser a
parsePair ByteString
"siblings" Parser Word32
forall a. Integral a => Parser a
A.decimal

parseCoreID :: A.Parser Word32
parseCoreID :: Parser Word32
parseCoreID = ByteString -> Parser Word32 -> Parser Word32
forall a. ByteString -> Parser a -> Parser a
parsePair ByteString
"core id" Parser Word32
forall a. Integral a => Parser a
A.decimal

parseApicID :: A.Parser Word32
parseApicID :: Parser Word32
parseApicID = ByteString -> Parser Word32 -> Parser Word32
forall a. ByteString -> Parser a -> Parser a
parsePair ByteString
"apicid" Parser Word32
forall a. Integral a => Parser a
A.decimal

parseFpu :: A.Parser Bool
parseFpu :: Parser Bool
parseFpu = ByteString -> Parser Bool -> Parser Bool
forall a. ByteString -> Parser a -> Parser a
parsePair ByteString
"fpu" Parser Bool
parseBool

parseFpuExcept :: A.Parser Bool
parseFpuExcept :: Parser Bool
parseFpuExcept = ByteString -> Parser Bool -> Parser Bool
forall a. ByteString -> Parser a -> Parser a
parsePair ByteString
"fpu_exception" Parser Bool
parseBool

parseFlags :: A.Parser [B.ByteString]
parseFlags :: Parser [ByteString]
parseFlags = ByteString -> Parser [ByteString] -> Parser [ByteString]
forall a. ByteString -> Parser a -> Parser a
parsePair ByteString
"flags" Parser [ByteString]
parseWords

parseBogoMIPS :: A.Parser Double
parseBogoMIPS :: Parser Double
parseBogoMIPS = ByteString -> Parser Double -> Parser Double
forall a. ByteString -> Parser a -> Parser a
parsePair ByteString
"bogomips" Parser Double
A.double

parseCacheAlignment :: A.Parser Word32
parseCacheAlignment :: Parser Word32
parseCacheAlignment = ByteString -> Parser Word32 -> Parser Word32
forall a. ByteString -> Parser a -> Parser a
parsePair ByteString
"cache_alignment" Parser Word32
forall a. Integral a => Parser a
A.decimal

parseAddresses :: A.Parser (Word32, Word32)
parseAddresses :: Parser (Word32, Word32)
parseAddresses = ByteString -> Parser (Word32, Word32) -> Parser (Word32, Word32)
forall a. ByteString -> Parser a -> Parser a
parsePair ByteString
"address sizes"
                           ((,) (Word32 -> Word32 -> (Word32, Word32))
-> Parser Word32 -> Parser ByteString (Word32 -> (Word32, Word32))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word32
parsePhysicalAddress
                                Parser ByteString (Word32 -> (Word32, Word32))
-> Parser Word32 -> Parser (Word32, Word32)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word32
parseVirtualAddress)

parsePhysicalAddress :: A.Parser Word32
parsePhysicalAddress :: Parser Word32
parsePhysicalAddress = Parser Word32
forall a. Integral a => Parser a
A.decimal Parser Word32 -> Parser ByteString -> Parser Word32
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ByteString -> Parser ByteString
A.string ByteString
" bits physical, "

parseVirtualAddress :: A.Parser Word32
parseVirtualAddress :: Parser Word32
parseVirtualAddress = Parser Word32
forall a. Integral a => Parser a
A.decimal Parser Word32 -> Parser ByteString -> Parser Word32
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ByteString -> Parser ByteString
A.string ByteString
" bits virtual"

parseBool :: A.Parser Bool
parseBool :: Parser Bool
parseBool = (ByteString -> Parser ByteString
A.string ByteString
"yes" Parser ByteString -> Parser Bool -> Parser Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
        Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> Parser ByteString
A.string ByteString
"no" Parser ByteString -> Parser Bool -> Parser Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)

parseWords :: A.Parser [B.ByteString]
parseWords :: Parser [ByteString]
parseWords = Parser ByteString -> Parser ByteString Char -> Parser [ByteString]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
A.sepBy ((Char -> Bool) -> Parser ByteString
A.takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ')) (Char -> Parser ByteString Char
A.char Char
' ')

parseMaybe :: A.Parser a -> B.ByteString -> Maybe a
parseMaybe :: Parser a -> ByteString -> Maybe a
parseMaybe = (Either String a -> Maybe a
forall a a. Either a a -> Maybe a
check (Either String a -> Maybe a)
-> (ByteString -> Either String a) -> ByteString -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((ByteString -> Either String a) -> ByteString -> Maybe a)
-> (Parser a -> ByteString -> Either String a)
-> Parser a
-> ByteString
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> ByteString -> Either String a
forall a. Parser a -> ByteString -> Either String a
A.parseOnly
    where check :: Either a a -> Maybe a
check (Left a
_)  = Maybe a
forall a. Maybe a
Nothing
          check (Right a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x

keepTrying :: [B.ByteString] -> A.Parser a -> Maybe a
keepTrying :: [ByteString] -> Parser a -> Maybe a
keepTrying [ByteString]
bs Parser a
p = [Maybe a] -> Maybe a
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ((ByteString -> Maybe a) -> [ByteString] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
map (Parser a -> ByteString -> Maybe a
forall a. Parser a -> ByteString -> Maybe a
parseMaybe Parser a
p) [ByteString]
bs)

splitCPULines :: B.ByteString -> [[B.ByteString]]
splitCPULines :: ByteString -> [[ByteString]]
splitCPULines = [ByteString] -> [[ByteString]]
forall a. (Eq a, IsString a) => [a] -> [[a]]
splitCPUs ([ByteString] -> [[ByteString]])
-> (ByteString -> [ByteString]) -> ByteString -> [[ByteString]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BC.lines
    where splitCPUs :: [a] -> [[a]]
splitCPUs [] = []
          splitCPUs [a]
ls = let ([a]
cs, [a]
lss) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"") [a]
ls
                         in [a]
cs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: case [a]
lss of []      -> []
                                             (a
_:[a]
ls') -> [a] -> [[a]]
splitCPUs [a]
ls'

tryCPU :: [B.ByteString] -> Maybe CPU
tryCPU :: [ByteString] -> Maybe CPU
tryCPU [ByteString]
bs = do
    Word32
proc     <- [ByteString] -> Parser Word32 -> Maybe Word32
forall a. [ByteString] -> Parser a -> Maybe a
keepTrying [ByteString]
bs Parser Word32
parseProcessor
    Maybe ByteString
vend     <- Maybe ByteString -> Maybe (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ByteString] -> Parser ByteString -> Maybe ByteString
forall a. [ByteString] -> Parser a -> Maybe a
keepTrying [ByteString]
bs Parser ByteString
parseVendor)
    Maybe Word32
modl     <- Maybe Word32 -> Maybe (Maybe Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ByteString] -> Parser Word32 -> Maybe Word32
forall a. [ByteString] -> Parser a -> Maybe a
keepTrying [ByteString]
bs Parser Word32
parseModel)
    Maybe ByteString
modn     <- Maybe ByteString -> Maybe (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ByteString] -> Parser ByteString -> Maybe ByteString
forall a. [ByteString] -> Parser a -> Maybe a
keepTrying [ByteString]
bs Parser ByteString
parseModelName)
    Maybe Word32
rev      <- Maybe Word32 -> Maybe (Maybe Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ByteString] -> Parser Word32 -> Maybe Word32
forall a. [ByteString] -> Parser a -> Maybe a
keepTrying [ByteString]
bs Parser Word32
parseRevision)
    Maybe Word32
mcode    <- Maybe Word32 -> Maybe (Maybe Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ByteString] -> Parser Word32 -> Maybe Word32
forall a. [ByteString] -> Parser a -> Maybe a
keepTrying [ByteString]
bs Parser Word32
parseMicrocode)
    Double
frq      <- [ByteString] -> Parser Double -> Maybe Double
forall a. [ByteString] -> Parser a -> Maybe a
keepTrying [ByteString]
bs Parser Double
parseFreq
    Maybe Word32
cch      <- Maybe Word32 -> Maybe (Maybe Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ByteString] -> Parser Word32 -> Maybe Word32
forall a. [ByteString] -> Parser a -> Maybe a
keepTrying [ByteString]
bs Parser Word32
parseCache)
    Word32
pid      <- [ByteString] -> Parser Word32 -> Maybe Word32
forall a. [ByteString] -> Parser a -> Maybe a
keepTrying [ByteString]
bs Parser Word32
parsePhysicalID
    Word32
sib      <- [ByteString] -> Parser Word32 -> Maybe Word32
forall a. [ByteString] -> Parser a -> Maybe a
keepTrying [ByteString]
bs Parser Word32
parseSiblings
    Word32
cid      <- [ByteString] -> Parser Word32 -> Maybe Word32
forall a. [ByteString] -> Parser a -> Maybe a
keepTrying [ByteString]
bs Parser Word32
parseCoreID
    Maybe Word32
aid      <- Maybe Word32 -> Maybe (Maybe Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ByteString] -> Parser Word32 -> Maybe Word32
forall a. [ByteString] -> Parser a -> Maybe a
keepTrying [ByteString]
bs Parser Word32
parseApicID)
    Maybe Bool
flpu     <- Maybe Bool -> Maybe (Maybe Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ByteString] -> Parser Bool -> Maybe Bool
forall a. [ByteString] -> Parser a -> Maybe a
keepTrying [ByteString]
bs Parser Bool
parseFpu)
    Maybe Bool
flpex    <- Maybe Bool -> Maybe (Maybe Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ByteString] -> Parser Bool -> Maybe Bool
forall a. [ByteString] -> Parser a -> Maybe a
keepTrying [ByteString]
bs Parser Bool
parseFpuExcept)
    Maybe [ByteString]
flg      <- Maybe [ByteString] -> Maybe (Maybe [ByteString])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ByteString] -> Parser [ByteString] -> Maybe [ByteString]
forall a. [ByteString] -> Parser a -> Maybe a
keepTrying [ByteString]
bs Parser [ByteString]
parseFlags)
    Double
bgm      <- [ByteString] -> Parser Double -> Maybe Double
forall a. [ByteString] -> Parser a -> Maybe a
keepTrying [ByteString]
bs Parser Double
parseBogoMIPS
    Maybe Word32
ca       <- Maybe Word32 -> Maybe (Maybe Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ByteString] -> Parser Word32 -> Maybe Word32
forall a. [ByteString] -> Parser a -> Maybe a
keepTrying [ByteString]
bs Parser Word32
parseCacheAlignment)
    (Maybe Word32
pa, Maybe Word32
va) <- (Maybe Word32, Maybe Word32) -> Maybe (Maybe Word32, Maybe Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Maybe Word32, Maybe Word32)
 -> Maybe (Maybe Word32, Maybe Word32))
-> (Maybe Word32, Maybe Word32)
-> Maybe (Maybe Word32, Maybe Word32)
forall a b. (a -> b) -> a -> b
$ case [ByteString] -> Parser (Word32, Word32) -> Maybe (Word32, Word32)
forall a. [ByteString] -> Parser a -> Maybe a
keepTrying [ByteString]
bs Parser (Word32, Word32)
parseAddresses
                of Maybe (Word32, Word32)
Nothing     -> (Maybe Word32
forall a. Maybe a
Nothing, Maybe Word32
forall a. Maybe a
Nothing)
                   Just (Word32
p, Word32
v) -> (Word32 -> Maybe Word32
forall a. a -> Maybe a
Just Word32
p, Word32 -> Maybe Word32
forall a. a -> Maybe a
Just Word32
v)
    CPU -> Maybe CPU
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CPU -> Maybe CPU) -> CPU -> Maybe CPU
forall a b. (a -> b) -> a -> b
$ Word32
-> Maybe ByteString
-> Maybe Word32
-> Maybe ByteString
-> Maybe Word32
-> Maybe Word32
-> Double
-> Maybe Word32
-> Word32
-> Word32
-> Word32
-> Maybe Word32
-> Maybe Bool
-> Maybe Bool
-> Maybe [ByteString]
-> Double
-> Maybe Word32
-> Maybe Word32
-> Maybe Word32
-> CPU
CPU Word32
proc
               Maybe ByteString
vend
               Maybe Word32
modl
               Maybe ByteString
modn
               Maybe Word32
rev
               Maybe Word32
mcode
               Double
frq
               Maybe Word32
cch
               Word32
pid
               Word32
sib
               Word32
cid
               Maybe Word32
aid
               Maybe Bool
flpu
               Maybe Bool
flpex
               Maybe [ByteString]
flg
               Double
bgm
               Maybe Word32
ca
               Maybe Word32
pa
               Maybe Word32
va

-- | Read @\/proc\/cpuinfo@ and try to parse the output. If this function
--   returns 'Nothing' on your system, please file a bug report with your
--   @\/proc\/cpuinfo@ contents and CPU specifications.
tryGetCPUs :: IO (Maybe [CPU])
tryGetCPUs :: IO (Maybe [CPU])
tryGetCPUs = (([ByteString] -> Maybe CPU) -> [[ByteString]] -> Maybe [CPU]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [ByteString] -> Maybe CPU
tryCPU ([[ByteString]] -> Maybe [CPU])
-> (ByteString -> [[ByteString]]) -> ByteString -> Maybe [CPU]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [[ByteString]]
splitCPULines)
          (ByteString -> Maybe [CPU]) -> IO ByteString -> IO (Maybe [CPU])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
B.readFile String
"/proc/cpuinfo"

-- | Read @\/proc\/cpuinfo@ and try to parse the output. If this function throws
--   an error on your system, please file a bug report with your
--   @\/proc\/cpuinfo@ contents and CPU specifications.
getCPUs :: IO [CPU]
getCPUs :: IO [CPU]
getCPUs = [CPU] -> Maybe [CPU] -> [CPU]
forall a. a -> Maybe a -> a
fromMaybe (String -> [CPU]
forall a. HasCallStack => String -> a
error String
e) (Maybe [CPU] -> [CPU]) -> IO (Maybe [CPU]) -> IO [CPU]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe [CPU])
tryGetCPUs
    where e :: String
e = [String] -> String
unlines [ String
"Couldn't parse your /proc/cpuinfo contents."
                      , String
"Please file a bug including your /proc/cpuinfo here:"
                      , String
"https://github.com/traviswhitaker/cpuinfo/issues"
                      ]

-- | Counts the number of physical processors in the system. A physical
--   processor corresponds to a single CPU unit in a single socket, i.e. unless
--   you have a multi-socket motherboard, this number will be one.
physicalProcessors :: [CPU] -> Int
physicalProcessors :: [CPU] -> Int
physicalProcessors = [Word32] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Word32] -> Int) -> ([CPU] -> [Word32]) -> [CPU] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word32] -> [Word32]
forall a. Eq a => [a] -> [a]
nub ([Word32] -> [Word32]) -> ([CPU] -> [Word32]) -> [CPU] -> [Word32]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CPU -> Word32) -> [CPU] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map CPU -> Word32
physicalID

-- | Counts the number of physical cores in the system. A physical core is an
--   independent processing unit that reads and executes instructions on its
--   own, but potentially shares its die (and other resources) with other cores.
physicalCores :: [CPU] -> Int
physicalCores :: [CPU] -> Int
physicalCores = [(Word32, Word32)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(Word32, Word32)] -> Int)
-> ([CPU] -> [(Word32, Word32)]) -> [CPU] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Word32, Word32)] -> [(Word32, Word32)]
forall a. Eq a => [a] -> [a]
nub ([(Word32, Word32)] -> [(Word32, Word32)])
-> ([CPU] -> [(Word32, Word32)]) -> [CPU] -> [(Word32, Word32)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CPU -> (Word32, Word32)) -> [CPU] -> [(Word32, Word32)]
forall a b. (a -> b) -> [a] -> [b]
map (CPU -> Word32
physicalID (CPU -> Word32) -> (CPU -> Word32) -> CPU -> (Word32, Word32)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& CPU -> Word32
coreID)

-- | Counts the number of logical cores in the system. A logical core is a
--   virtual processing unit exposed to the operating system, that may or may
--   not directly correspond with an independent physical processing unit, e.g.
--   a hyperthread appears as an independent processing unit to the operating
--   system, but has no physically dedicated execution resources.
logicalCores :: [CPU] -> Int
logicalCores :: [CPU] -> Int
logicalCores = [CPU] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length

-- | The hyperthreading factor is the number of logical cores divided by the
--   number of physical cores. This quantity indicates the degree to which
--   physical execution resources are shared among logical processors, and may
--   be used to tune parallel applications.
hyperthreadingFactor :: [CPU] -> Rational
hyperthreadingFactor :: [CPU] -> Rational
hyperthreadingFactor [CPU]
cpus = Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([CPU] -> Int
logicalCores [CPU]
cpus)
                          Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([CPU] -> Int
physicalCores [CPU]
cpus)

-- | If hyperthreading is in use, the 'hyperthreadingFactor' will be greater
--   than 1.
hyperthreadingInUse :: [CPU] -> Bool
hyperthreadingInUse :: [CPU] -> Bool
hyperthreadingInUse = (Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
/= Rational
1) (Rational -> Bool) -> ([CPU] -> Rational) -> [CPU] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CPU] -> Rational
hyperthreadingFactor