{-# LANGUAGE TemplateHaskell #-}

module Hledger.Flow.Internals where

import GHC.Conc (getNumCapabilities, getNumProcessors)
import Development.GitRev
import Data.Version (Version, showVersion)
import Paths_hledger_flow (version)

import qualified Data.Text as T
import qualified System.Info as Sys

data SystemInfo = SystemInfo { SystemInfo -> String
os :: String
                             , SystemInfo -> String
arch :: String
                             , SystemInfo -> String
compilerName :: String
                             , SystemInfo -> Version
compilerVersion :: Version
                             , SystemInfo -> Int
cores :: Int
                             , SystemInfo -> Int
availableCores :: Int
                             }
                deriving (Int -> SystemInfo -> ShowS
[SystemInfo] -> ShowS
SystemInfo -> String
(Int -> SystemInfo -> ShowS)
-> (SystemInfo -> String)
-> ([SystemInfo] -> ShowS)
-> Show SystemInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SystemInfo] -> ShowS
$cshowList :: [SystemInfo] -> ShowS
show :: SystemInfo -> String
$cshow :: SystemInfo -> String
showsPrec :: Int -> SystemInfo -> ShowS
$cshowsPrec :: Int -> SystemInfo -> ShowS
Show)

versionInfo :: SystemInfo -> T.Text
versionInfo :: SystemInfo -> Text
versionInfo SystemInfo
sysInfo = String -> Text
T.pack (String
"hledger-flow " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
version String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                       SystemInfo -> String
os SystemInfo
sysInfo String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SystemInfo -> String
arch SystemInfo
sysInfo String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                       SystemInfo -> String
compilerName SystemInfo
sysInfo String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                       Version -> String
showVersion (SystemInfo -> Version
compilerVersion SystemInfo
sysInfo) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                       String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ $(String
gitHash))

systemInfo :: IO SystemInfo
systemInfo :: IO SystemInfo
systemInfo = do
    Int
processors <- IO Int
getNumProcessors
    Int
available <- IO Int
getNumCapabilities
    SystemInfo -> IO SystemInfo
forall (m :: * -> *) a. Monad m => a -> m a
return SystemInfo :: String -> String -> String -> Version -> Int -> Int -> SystemInfo
SystemInfo {
        os :: String
os = String
Sys.os,
        arch :: String
arch = String
Sys.arch,
        compilerName :: String
compilerName = String
Sys.compilerName,
        compilerVersion :: Version
compilerVersion = Version
Sys.compilerVersion,
        cores :: Int
cores = Int
processors,
        availableCores :: Int
availableCores = Int
available
        }