-- | 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