{-# LINE 1 "src/System/LibCPUID/CPUID.hsc" #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  System.LibCPUID.CPUID
-- Copyright   :  (c) Daniel Taskoff, 2020
-- License     :  MIT
--
-- Maintainer  :  daniel.taskoff@gmail.com
-- Stability   :  experimental
--
-- A wrapper around __cpu_id_t__ from https://github.com/anrieff/libcpuid.
-----------------------------------------------------------------------------

module System.LibCPUID.CPUID
  (
  -- * 'CPUID'
    CPUID(..)
  ) where

import Foreign.C.String (peekCString)
import Foreign.C.Types (CInt(..), CUChar(..))
import Foreign.Marshal (advancePtr)
import Foreign.Ptr (castPtr, plusPtr)
import Foreign.Storable (Storable(..))


-- | CPU information and features.
data CPUID = CPUID
  { vendorString :: String
    -- ^ CPU vendor string, e.g. \"GenuineIntel\".
  , brandString :: String
    -- ^ CPU brand string, e.g. \"Intel(R) Core(TM) i5-7500 CPU @ 3.40GHz\".
  , hasTSC :: Bool
    -- ^ Is a time-stamp counter available.
  , physicalCores :: Int
    -- ^ Number of physical cores per processor.
  , logicalCores :: Int
    -- ^ Number of logical cores per processor.
  , totalLogicalCores :: Int
    -- ^ Total number of logical cores, which is 'logicalCores' multiplied by the number of processors.
  }



instance Storable CPUID where
  alignment _ = 8
{-# LINE 46 "src/System/LibCPUID/CPUID.hsc" #-}
  sizeOf _ = (432)
{-# LINE 47 "src/System/LibCPUID/CPUID.hsc" #-}
  peek ptr = do
    vendorString <- peekCString $ plusPtr ptr (0)
{-# LINE 49 "src/System/LibCPUID/CPUID.hsc" #-}
    brandString <- peekCString $ plusPtr ptr (16)
{-# LINE 50 "src/System/LibCPUID/CPUID.hsc" #-}
    hasTSC <-
      let ptr' = advancePtr (castPtr @CPUID @CUChar ptr) 4
{-# LINE 52 "src/System/LibCPUID/CPUID.hsc" #-}
       in (/= 0) <$> peekElemOff ptr' (84)
{-# LINE 53 "src/System/LibCPUID/CPUID.hsc" #-}
    physicalCores <- fromIntegral @CInt <$> (\hsc_ptr -> peekByteOff hsc_ptr 232) ptr
{-# LINE 54 "src/System/LibCPUID/CPUID.hsc" #-}
    logicalCores <- fromIntegral @CInt <$> (\hsc_ptr -> peekByteOff hsc_ptr 236) ptr
{-# LINE 55 "src/System/LibCPUID/CPUID.hsc" #-}
    totalLogicalCores <- fromIntegral @CInt <$> (\hsc_ptr -> peekByteOff hsc_ptr 240) ptr
{-# LINE 56 "src/System/LibCPUID/CPUID.hsc" #-}

    pure CPUID {..}
  poke _ _ = error "CPUID is read-only"