{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module      : Test.Hspec.BenchGolden.Arch
-- Description : Architecture detection for machine-specific golden files
-- Copyright   : (c) 2026
-- License     : MIT
-- Maintainer  : your.email@example.com
--
-- This module provides functions for detecting the current machine's
-- architecture, which is used to create architecture-specific golden files.
--
-- The architecture identifier includes:
--
-- * CPU architecture (x86_64, aarch64, etc.)
-- * Operating system (darwin, linux, windows)
-- * CPU model when available (Apple M1, Intel Core i7, etc.)

module Test.Hspec.BenchGolden.Arch
  ( -- * Architecture Detection
    detectArchitecture
  , getArchId

    -- * Environment Overrides
  , getArchFromEnv

    -- * Utilities
  , sanitizeForFilename
  ) where

import Control.Exception (catch, SomeException)
import Data.Char (isAlphaNum)
import Data.Text (Text)
import qualified Data.Text as T
import System.Environment (lookupEnv)
import System.Info (arch, os)
import System.Process (readProcess)

import Test.Hspec.BenchGolden.Types (ArchConfig(..))

-- | Detect the current machine's architecture.
--
-- This function queries the system for CPU architecture, OS, and CPU model.
-- The resulting 'ArchConfig' can be used to generate architecture-specific
-- golden file paths.
--
-- The architecture can be overridden by setting the @GOLDS_GYM_ARCH@
-- environment variable.
detectArchitecture :: IO ArchConfig
detectArchitecture :: IO ArchConfig
detectArchitecture = do
  Maybe Text
envArch <- IO (Maybe Text)
getArchFromEnv
  case Maybe Text
envArch of
    Just Text
customArch -> ArchConfig -> IO ArchConfig
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ArchConfig -> IO ArchConfig) -> ArchConfig -> IO ArchConfig
forall a b. (a -> b) -> a -> b
$ ArchConfig
      { archId :: Text
archId    = Text
customArch
      , archOS :: Text
archOS    = String -> Text
T.pack String
os
      , archCPU :: Text
archCPU   = String -> Text
T.pack String
arch
      , archModel :: Maybe Text
archModel = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
customArch
      }
    Maybe Text
Nothing -> do
      Maybe Text
model <- IO (Maybe Text)
getCPUModel
      let archConfig :: ArchConfig
archConfig = ArchConfig
            { archId :: Text
archId    = Text -> Text -> Maybe Text -> Text
buildArchId (String -> Text
T.pack String
arch) (String -> Text
T.pack String
os) Maybe Text
model
            , archOS :: Text
archOS    = String -> Text
T.pack String
os
            , archCPU :: Text
archCPU   = String -> Text
T.pack String
arch
            , archModel :: Maybe Text
archModel = Maybe Text
model
            }
      ArchConfig -> IO ArchConfig
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ArchConfig
archConfig

-- | Build an architecture identifier from components.
buildArchId :: Text -> Text -> Maybe Text -> Text
buildArchId :: Text -> Text -> Maybe Text -> Text
buildArchId Text
cpu Text
osName Maybe Text
maybeModel =
  let base :: Text
base = Text
cpu Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
osName
  in case Maybe Text
maybeModel of
       Maybe Text
Nothing    -> Text
base
       Just Text
model -> Text
base Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
sanitizeForFilename Text
model

-- | Get the architecture identifier string.
--
-- This is a convenience function that returns just the ID string
-- suitable for use in file paths.
getArchId :: IO Text
getArchId :: IO Text
getArchId = ArchConfig -> Text
archId (ArchConfig -> Text) -> IO ArchConfig -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ArchConfig
detectArchitecture

-- | Check for architecture override from environment.
--
-- Users can set @GOLDS_GYM_ARCH@ to force a specific architecture
-- identifier, useful for CI environments with consistent hardware.
getArchFromEnv :: IO (Maybe Text)
getArchFromEnv :: IO (Maybe Text)
getArchFromEnv = (String -> Text) -> Maybe String -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (Maybe String -> Maybe Text)
-> IO (Maybe String) -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"GOLDS_GYM_ARCH"

-- | Get the CPU model name.
--
-- This is platform-specific:
--
-- * macOS: Uses @sysctl -n machdep.cpu.brand_string@
-- * Linux: Parses @\/proc\/cpuinfo@
-- * Windows: Uses @wmic cpu get name@
-- * Other: Returns 'Nothing'
getCPUModel :: IO (Maybe Text)
getCPUModel :: IO (Maybe Text)
getCPUModel = do
#if defined(darwin_HOST_OS)
  getDarwinCPUModel
#elif defined(linux_HOST_OS)
  IO (Maybe Text)
getLinuxCPUModel
#elif defined(mingw32_HOST_OS)
  getWindowsCPUModel
#else
  return Nothing
#endif

#if defined(darwin_HOST_OS)
-- | Get CPU model on macOS using sysctl.
getDarwinCPUModel :: IO (Maybe Text)
getDarwinCPUModel = do
  result <- safeReadProcess "sysctl" ["-n", "machdep.cpu.brand_string"] ""
  case result of
    Nothing -> do
      -- Apple Silicon doesn't have brand_string, try chip info
      chipResult <- safeReadProcess "sysctl" ["-n", "machdep.cpu.brand"] ""
      case chipResult of
        Nothing -> do
          -- Last resort: check if it's Apple Silicon
          armResult <- safeReadProcess "uname" ["-m"] ""
          case armResult of
            Just m | "arm" `T.isInfixOf` T.toLower m -> return $ Just "Apple_Silicon"
            _ -> return Nothing
        Just chip -> return $ Just $ cleanCPUName chip
    Just name -> return $ Just $ cleanCPUName name
#endif

#if defined(linux_HOST_OS)
-- | Get CPU model on Linux by parsing /proc/cpuinfo.
getLinuxCPUModel :: IO (Maybe Text)
getLinuxCPUModel :: IO (Maybe Text)
getLinuxCPUModel = do
  Maybe Text
result <- String -> [String] -> String -> IO (Maybe Text)
safeReadProcess String
"grep" [String
"-m1", String
"model name", String
"/proc/cpuinfo"] String
""
  case Maybe Text
result of
    Maybe Text
Nothing -> Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
    Just Text
line ->
      let parts :: [Text]
parts = HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
":" Text
line
      in case [Text]
parts of
           [Text
_, Text
name] -> Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
cleanCPUName Text
name
           [Text]
_         -> Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
#endif

#if defined(mingw32_HOST_OS)
-- | Get CPU model on Windows using WMIC.
getWindowsCPUModel :: IO (Maybe Text)
getWindowsCPUModel = do
  result <- safeReadProcess "wmic" ["cpu", "get", "name"] ""
  case result of
    Nothing -> return Nothing
    Just output ->
      let ls = filter (not . T.null) $ T.lines output
      in case drop 1 ls of  -- Skip header line
           (name:_) -> return $ Just $ cleanCPUName name
           _        -> return Nothing
#endif

-- | Safely run a process, returning Nothing on failure.
safeReadProcess :: FilePath -> [String] -> String -> IO (Maybe Text)
safeReadProcess :: String -> [String] -> String -> IO (Maybe Text)
safeReadProcess String
cmd [String]
args String
input =
  (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (String -> Text) -> String -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Maybe Text) -> IO String -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> String -> IO String
readProcess String
cmd [String]
args String
input)
    IO (Maybe Text)
-> (SomeException -> IO (Maybe Text)) -> IO (Maybe Text)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(SomeException
_ :: SomeException) -> Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing)

-- | Clean up a CPU name for use as an identifier.
cleanCPUName :: Text -> Text
cleanCPUName :: Text -> Text
cleanCPUName = Text -> Text
T.strip (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unwords ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words

-- | Sanitize a string for use in filenames.
--
-- Replaces spaces with underscores and removes problematic characters.
sanitizeForFilename :: Text -> Text
sanitizeForFilename :: Text -> Text
sanitizeForFilename = (Char -> Char) -> Text -> Text
T.map Char -> Char
sanitizeChar
  where
    sanitizeChar :: Char -> Char
sanitizeChar Char
c
      | Char -> Bool
isAlphaNum Char
c = Char
c
      | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'     = Char
c
      | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'     = Char
c
      | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '     = Char
'_'
      | Bool
otherwise    = Char
'_'