{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Devel ( devel , DevelOpts(..) , defaultDevelOpts ) where import qualified Distribution.Compiler as D import qualified Distribution.ModuleName as D import qualified Distribution.PackageDescription as D import qualified Distribution.PackageDescription.Parse as D import qualified Distribution.Simple.Configure as D import qualified Distribution.Simple.Program as D import qualified Distribution.Simple.Utils as D import qualified Distribution.Verbosity as D import Control.Applicative ((<$>), (<*>)) import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar, tryPutMVar) import qualified Control.Exception as Ex import Control.Monad (forever, unless, void, when) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.State (evalStateT, get) import qualified Data.IORef as I import Data.Char (isNumber, isUpper) import qualified Data.List as L import qualified Data.Map as Map import Data.Maybe (fromMaybe) import qualified Data.Set as Set import System.Directory import System.Environment (getEnvironment) import System.Exit (ExitCode (..), exitFailure, exitSuccess) import System.FilePath (dropExtension, splitDirectories, takeExtension, (>)) import System.FSNotify import System.IO (Handle) import System.IO.Error (isDoesNotExistError) import System.Posix.Types (EpochTime) import System.PosixCompat.Files (getFileStatus, modificationTime) import System.Process (ProcessHandle, createProcess, env, getProcessExitCode, proc, readProcess, system, terminateProcess) import System.Timeout (timeout) import Build (getDeps, isNewerThan, recompDeps) import GhcBuild (buildPackage, getBuildFlags, getPackageArgs) import qualified Config as GHC import Data.Conduit.Network (HostPreference (HostIPv4), bindPort) import Network (withSocketsDo) import Network.HTTP.Conduit (def, newManager) import Network.HTTP.ReverseProxy (ProxyDest (ProxyDest), waiProxyToSettings, wpsTimeout, wpsOnExc) #if MIN_VERSION_http_reverse_proxy(0, 2, 0) import qualified Network.HTTP.ReverseProxy as ReverseProxy #endif import Network.HTTP.Types (status200) import Network.Socket (sClose) import Network.Wai (responseLBS) import Network.Wai.Handler.Warp (run) import SrcLoc (Located) lockFile :: DevelOpts -> FilePath lockFile _opts = "yesod-devel/devel-terminate" writeLock :: DevelOpts -> IO () writeLock opts = do createDirectoryIfMissing True "yesod-devel" writeFile (lockFile opts) "" createDirectoryIfMissing True "dist" -- for compatibility with old devel.hs writeFile "dist/devel-terminate" "" removeLock :: DevelOpts -> IO () removeLock opts = do removeFileIfExists (lockFile opts) removeFileIfExists "dist/devel-terminate" -- for compatibility with old devel.hs data DevelOpts = DevelOpts { isCabalDev :: Bool , forceCabal :: Bool , verbose :: Bool , eventTimeout :: Int -- negative value for no timeout , successHook :: Maybe String , failHook :: Maybe String , buildDir :: Maybe String , develPort :: Int , proxyTimeout :: Int } deriving (Show, Eq) getBuildDir :: DevelOpts -> String getBuildDir opts = fromMaybe "dist" (buildDir opts) defaultDevelOpts :: DevelOpts defaultDevelOpts = DevelOpts False False False (-1) Nothing Nothing Nothing 3000 10 cabalProgram :: DevelOpts -> FilePath cabalProgram opts | isCabalDev opts = "cabal-dev" | otherwise = "cabal" -- | Run a reverse proxy from port 3000 to 3001. If there is no response on -- 3001, give an appropriate message to the user. reverseProxy :: DevelOpts -> I.IORef Int -> IO () reverseProxy opts iappPort = do manager <- newManager def let loop = forever $ do run (develPort opts) $ waiProxyToSettings (const $ do appPort <- liftIO $ I.readIORef iappPort return $ #if MIN_VERSION_http_reverse_proxy(0, 2, 0) ReverseProxy.WPRProxyDest #else Right #endif $ ProxyDest "127.0.0.1" appPort) def { wpsOnExc = onExc , wpsTimeout = if proxyTimeout opts == 0 then Nothing else Just (1000000 * proxyTimeout opts) } manager putStrLn "Reverse proxy stopped, but it shouldn't" threadDelay 1000000 putStrLn "Restarting reverse proxy" loop `Ex.onException` exitFailure where onExc _ _ = return $ responseLBS status200 [ ("content-type", "text/html") , ("Refresh", "1") ] "