AC-BuildPlatform-1.1.0: Configure/Detect.hs

module Configure.Detect (detect) where

import Prelude hiding (catch)
import Control.Exception (catch, IOException)
import System.IO
import System.Process
import System.Exit (ExitCode (..))

detect :: IO (Maybe String, Maybe String, Maybe String)
detect = do
  putStrLn "-| Attempting to detect platform data..."
  m_txt <- gather
  case m_txt of
    Nothing  -> return (Nothing, Nothing, Nothing)
    Just txt -> parse txt

gather :: IO (Maybe String)
gather = do
  putStrLn "---| Attempting to invoke Setup.hs compiled program..."
  let cmd0 = proc "./dist/setup/setup" ["+RTS", "--info"]
  let cmd1 = cmd0 {std_out = CreatePipe}

  catch
    (do
      (Nothing, Just hout, Nothing, pid) <- createProcess cmd1
      txt  <- hGetContents hout
      exit <- waitForProcess pid

      case exit of
        ExitFailure n -> do
          putStrLn $ "---| Compiled Setup.hs program failed with return code " ++ show n
          return Nothing
        ExitSuccess   -> return (Just txt)
    )
    (\ e -> do
      let f = e `asTypeOf` (undefined :: IOException)
      putStrLn "---| Could not run compiled Setup.hs program."
      return Nothing
    )

parse :: String -> IO (Maybe String, Maybe String, Maybe String)
parse txt = do
  putStrLn "---| OK. Parsing program result..."
  case txt of
    "" -> do
      putStrLn "---| Empty result."
      return (Nothing, Nothing, Nothing)
    _  ->
      case readsPrec 0 txt of
        [] -> do
          putStrLn "---| Parser error."
          return (Nothing, Nothing, Nothing)
        (info, _):_ ->
          let
            os   =
              case lookup "Target OS" info of
                Nothing        -> Nothing
                Just "mingw32" -> Just "MS_Windows"
                Just _         -> Just "Unix"
            (name, ver) =
              case lookup "GHC version" info of
                Nothing -> (Nothing   , Nothing)
                Just v  -> (Just "GHC", Just v )
          in return (os, name, ver)