-- | Gathering information about the build environment.
module BuildBox.Command.Environment
	( -- * Build Environment
	  Environment(..)
	, getEnvironmentWith
	
	  -- * Build platform
	, Platform(..)
	, getHostPlatform
	, getHostName
	, getHostArch
	, getHostProcessor
	, getHostOS
	, getHostRelease
	
	  -- * Software versions
	, getVersionGHC
	, getVersionGCC)
where
import BuildBox.Build
import BuildBox.Command.System
import BuildBox.Command.File
import BuildBox.Pretty


-- Environment ------------------------------------------------------------------------------------
-- | The environment consists of the `Platform`, and some tool versions.
data Environment 
	= Environment
	{ environmentPlatform	:: Platform
	, environmentVersions	:: [(String, String)] }
	deriving (Show, Read)


instance Pretty Environment where
 ppr env
	= hang (ppr "Environment") 2 $ vcat
	[ ppr 	$ environmentPlatform env
	, hang (ppr "Versions") 2 
		$ vcat 
		$ map (\(name, ver) -> ppr name <+> ppr ver) 
		$ environmentVersions env ]



-- | Get the current environment, including versions of these tools.
getEnvironmentWith 
	:: [(String, Build String)]	-- ^ List of tool names and commands to get their versions.
	-> Build Environment
	
getEnvironmentWith nameGets 
 = do	platform	<- getHostPlatform

	versions	<- mapM (\(name, get) -> do
					ver	<- get
					return	(name, ver))
			$  nameGets
			
	return	$ Environment
		{ environmentPlatform	= platform 
		, environmentVersions	= versions }
	


-- Platform ---------------------------------------------------------------------------------------
-- | Generic information about the platform we're running on.
data Platform
	= Platform
	{ platformHostName 	:: String
	, platformHostArch	:: String
	, platformHostProcessor	:: String
	, platformHostOS	:: String
	, platformHostRelease	:: String }
	deriving (Show, Read)
	
	
instance Pretty Platform where
 ppr plat
	= hang (ppr "Platform") 2 $ vcat
	[ ppr "host:      " <> (ppr $ platformHostName plat)
	, ppr "arch:      " <> (ppr $ platformHostArch plat)
	, ppr "processor: " <> (ppr $ platformHostProcessor plat)
	, ppr "system:    " <> (ppr $ platformHostOS plat) <+> (ppr $ platformHostRelease plat) ]


-- | Get information about the host platform.
getHostPlatform :: Build Platform
getHostPlatform 
 = do	name		<- getHostName
	arch		<- getHostArch
	processor	<- getHostProcessor
	os		<- getHostOS
	release		<- getHostRelease
	
	return	$ Platform
		{ platformHostName	= name
		, platformHostArch	= arch
		, platformHostProcessor	= processor
		, platformHostOS	= os
		, platformHostRelease	= release }
		

-- Platform Tests ---------------------------------------------------------------------------------
-- | Get the name of this host, using @uname@.
getHostName :: Build String
getHostName
 = do	check $ HasExecutable "uname"
	name   <- sesystemq "uname -n"
	return	$ init name


-- | Get the host architecture, using @uname@.
getHostArch :: Build String
getHostArch
 = do	check $ HasExecutable "arch"
	name   <- sesystemq "arch"
	return	$ init name


-- | Get the host processor name, using @uname@.
getHostProcessor :: Build String
getHostProcessor
 = do	check $ HasExecutable "uname"
	name   <- sesystemq "uname -p"
	return	$ init name


-- | Get the host operating system, using @uname@.
getHostOS :: Build String
getHostOS
 = do	check $ HasExecutable "uname"
	name   <- sesystemq "uname -s"
	return	$ init name


-- | Get the host operating system release, using @uname@.
getHostRelease :: Build String
getHostRelease
 = do	check $ HasExecutable "uname"
	str    <- sesystemq "uname -r"
	return	$ init str


-- Software version tests -------------------------------------------------------------------------
-- | Get the version of this GHC, or throw an error if it can't be found.
getVersionGHC :: FilePath -> Build String
getVersionGHC path
 = do	check $ HasExecutable path
	str	<- sesystemq $ path ++ " --version"
	return	$ init str
	
-- | Get the version of this GCC, or throw an error if it can't be found. 
getVersionGCC :: FilePath -> Build String
getVersionGCC path
 = do	check $ HasExecutable path
 	str	<- sesystemq $ path ++ " --version"
	return	$ head $ lines str