module Main (main) where

import System.Process
import System.Exit
import Control.Concurrent
import System.Environment
import System.FilePath
import System.IO
import Control.Monad
import Paths_roguestar_gl

main :: IO ()
main = 
    do (should_echo_protocol,args) <- 
           do args <- getArgs
	      return ("--echo-protocol" `elem` args,
		      filter (/= "--echo-protocol") $ args)
       n <- getNumberOfCPUCores
       bin_dir <- getBinDir
       let n_rts_string = if n == 1 then [] else ["-N" ++ show n]
       let gl_args = ["+RTS", "-G4"] ++ n_rts_string ++ ["-RTS"] ++ args
       let engine_args = ["+RTS"] ++ n_rts_string ++ ["-RTS"] ++ ["version","over","begin"]
       (e_in,e_out,e_err,roguestar_engine) <- runInteractiveProcess (bin_dir `combine` "roguestar-engine") engine_args Nothing Nothing
       (gl_in,gl_out,gl_err,roguestar_gl) <- runInteractiveProcess (bin_dir `combine` "roguestar-gl") gl_args Nothing Nothing
       forkIO $ pump e_out  $ [("",gl_in)] ++ (if should_echo_protocol then [("engine >>> gl *** ",stdout)] else [])
       forkIO $ pump gl_out $ [("",e_in)] ++ (if should_echo_protocol then [("gl <<< engine *** ",stdout)] else [])
       forkIO $ pump e_err  $ [("roguestar-engine *** ",stderr)]
       forkIO $ pump gl_err $ [("roguestar-gl     *** ",stderr)]
       forkIO $
           do roguestar_engine_exit <- waitForProcess roguestar_engine
              case roguestar_engine_exit of
                  ExitFailure x -> putStrLn $ "roguestar-engine terminated unexpectedly (" ++ show x ++  ")"
                  _ -> return ()
	      return ()
       roguestar_gl_exit <- waitForProcess roguestar_gl
       case roguestar_gl_exit of
           ExitFailure x -> putStrLn $ "roguestar-gl terminated unexpectedly (" ++ show x ++ ")"
           _ -> return ()       

pump :: Handle -> [(String,Handle)] -> IO ()
pump from tos =
    do mapM_ (flip hSetBuffering NoBuffering . snd) tos
       hSetBuffering from NoBuffering
       forever $
           do l <- hGetLine from
	      flip mapM_ tos $ \(name,to) -> 
	          do hPutStrLn to $ name ++ l
	             hFlush to

getNumberOfCPUCores :: IO Int
getNumberOfCPUCores =
    do m_nop <- readNumberOfProcessors
       m_cpuinfo <- scanCPUInfo
       case (m_nop,m_cpuinfo) of
           (Just n,_) -> do hPutStrLn stderr $ "roguestar: " ++ show n ++ 
	                        " CPU core(s) based on windows environment variable NUMBER_OF_PROCESSORS. "
			    return n
           (_,Just n) -> do hPutStrLn stderr $ "roguestar: " ++ show n ++ " CPU core(s) based on /proc/cpuinfo. " 
	                    return n
	   _ ->          do hPutStrLn stderr "roguestar: couldn't find number of CPU cores, assuming 1 core"
	                    return 1

readNumberOfProcessors :: IO (Maybe Int)
readNumberOfProcessors = flip catch (const $ return Nothing) $ liftM Just $
    do n <- getEnv "NUMBER_OF_PROCESSORS"
       return $! read n

scanCPUInfo :: IO (Maybe Int)
scanCPUInfo = catch (liftM (Just . length . filter isProcessorLine . map words . lines) $ readFile "/proc/cpuinfo")
                    (const $ return Nothing)
    where isProcessorLine ["processor",":",_] = True
          isProcessorLine _ = False