module System.Information
(
OS, os
, CPUName, CPUNames, cpuNames
, numLogicalCores, LogicalCores(unLogicalCores), CPU, CPUs
, cpus, showCPUs
) where
import Control.Applicative
import Control.Exception (try, SomeException)
import Data.Attoparsec.Text (parse, maybeResult, anyChar, endOfLine, manyTill, space, string)
import Data.List (group, sort)
import Data.Maybe (fromJust)
import Data.Text (Text, pack)
import Foreign.C.String (CWString, peekCWString)
import Foreign.Marshal.Alloc (free)
import Foreign.Ptr (Ptr)
import Foreign.Storable (peek)
import System.IO.Unsafe (unsafePerformIO)
import System.Process (readProcess)
#ifdef darwin_HOST_OS
import Data.List (isPrefixOf)
import Text.Read (readMaybe)
#elif linux_HOST_OS
import Data.List (isPrefixOf)
#elif mingw32_HOST_OS
import Control.Monad (forM)
import System.Win32.Registry
( hKEY_LOCAL_MACHINE
, regOpenKey, regCloseKey, regQueryInfoKey, regQueryValue
, subkeys
)
#endif
newtype OS = OS String
instance Show OS where
show (OS os) = os
os :: String
os = unsafePerformIO $ do
let os' = c_getOS
res <- peekCWString os'
free os'
pure res
foreign import ccall safe "getOS"
c_getOS :: CWString
parseLineAfter :: String -> String -> Maybe String
parseLineAfter separator = maybeResult .
parse (manyTill anyChar (string (pack separator)) *> many space *> manyTill anyChar endOfLine) . pack
newtype CPUName = CPUName String
deriving (Eq, Ord)
instance Show CPUName where
show (CPUName name) = name
type CPUNames = [CPUName]
newtype LogicalCores = LogicalCores { unLogicalCores :: Word }
deriving (Show)
type CPU = (CPUName, LogicalCores)
type CPUs = [CPU]
cpuNames :: IO CPUNames
cpuNames =
#ifdef darwin_HOST_OS
macOSCPUNames
#elif linux_HOST_OS
linuxCPUNames
#elif mingw32_HOST_OS
windowsCPUNames
#endif
#ifdef darwin_HOST_OS
macOSCPUNames :: IO CPUNames
macOSCPUNames = do
eCPU <- try $ readProcess "sysctl" ["machdep.cpu.brand_string", "machdep.cpu.thread_count"] ""
case eCPU of
Left (_ :: SomeException) -> pure []
Right cpus -> do
let cpuString = "machdep.cpu.brand_string:"
nString = "machdep.cpu.thread_count:"
let mCPU = CPUName <$> parseLineAfter cpuString cpus
mN = readMaybe =<< parseLineAfter nString cpus
case (mCPU, mN) of
(Just cpu, Just n) -> pure $ replicate n cpu
_ -> pure []
#elif linux_HOST_OS
linuxCPUNames :: IO CPUNames
linuxCPUNames = do
lines' <- lines <$> readFile "/proc/cpuinfo"
pure . map (CPUName . unwords . drop 3 . words) $
filter ("model name" `isPrefixOf`) lines'
#elif mingw32_HOST_OS
windowsCPUNames :: IO CPUNames
windowsCPUNames = do
cpus <- regOpenKey hKEY_LOCAL_MACHINE "Hardware\\Description\\System\\CentralProcessor"
n <- subkeys <$> regQueryInfoKey cpus
res <- forM [0..n1] $ \i -> do
cpu <- regOpenKey cpus $ show i
cpuName <- regQueryValue cpu $ Just "ProcessorNameString"
regCloseKey cpu
pure cpuName
regCloseKey cpus
pure $ map (CPUName . unwords . words) res
#endif
numLogicalCores :: IO LogicalCores
numLogicalCores = LogicalCores . fromIntegral . length <$> cpuNames
cpus :: IO CPUs
cpus = map (liftA2 (,) head (LogicalCores . fromIntegral . length)) . group . sort <$> cpuNames
showCPUs :: CPUs -> String
showCPUs = unlines . map (\(CPUName c, n) -> concat
[c, ", # of logical cores: ", show $ unLogicalCores n])