module Houseman where
import Control.Concurrent
import Control.Monad
import Control.Monad.Cont
import Data.Function
import Data.List
import System.Directory
import System.Environment
import System.Exit
import System.Posix.Signals
import System.Process
import qualified Configuration.Dotenv as Dotenv
import Data.Streaming.Process (StreamingProcessHandle)
import Houseman.Internal (terminateAndWaitForProcess,
withAllExit, withAnyExit, withProcess)
import Houseman.Logger (installLogger, newLogger, runLogger,
stopLogger)
import Houseman.Types
import Procfile.Types
run :: String -> Procfile -> IO ExitCode
run cmd' apps = case find (\App{cmd} -> cmd == cmd') apps of
Just app -> Houseman.start [app]
Nothing -> die ("Command '" ++ cmd' ++ "' not found in Procfile")
start :: Procfile -> IO ExitCode
start apps = do
print apps
logger <- newLogger
(`runContT` return) $ do
phs <- mapM (ContT . withApp logger) apps
liftIO $ do
readyToTerminate <- newEmptyMVar
runLogger logger
[sigINT, sigTERM, keyboardSignal] `forM_` \signal ->
installHandler signal (Catch (putMVar readyToTerminate ())) Nothing
_ <- forkIO $ withAnyExit (/= ExitSuccess) phs (putMVar readyToTerminate ())
_ <- forkIO $ withAllExit (== ExitSuccess) phs (putMVar readyToTerminate ())
takeMVar readyToTerminate
mapM_ terminateAndWaitForProcess phs
stopLogger logger
putStrLn "bye"
return ExitSuccess
withApp :: Logger -> App -> (StreamingProcessHandle -> IO a) -> IO a
withApp logger App {name,cmd} action = do
envs <- nubBy ((==) `on` fst) . mconcat <$> sequence [getEnvsInDotEnvFile, getEnvironment]
withProcess (shell cmd) { env = Just envs } $ \(out,err,ph) -> do
_ <- forkIO $ forM_ [out,err] (installLogger name logger)
action ph
where
getEnvsInDotEnvFile :: IO [Env]
getEnvsInDotEnvFile = do
d <- doesFileExist ".env"
if d then Dotenv.parseFile ".env" else return []