Merge pull request #969 from urbanslug/master

Updated yesod-bin/Devel.hs
This commit is contained in:
Michael Snoyman 2015-04-16 10:08:23 +03:00
commit 3fd99e77e7

View File

@ -84,23 +84,24 @@ import Network.Wai.Handler.WarpTLS (runTLS, tlsSettingsMemor
import SrcLoc (Located) import SrcLoc (Located)
import Data.FileEmbed (embedFile) import Data.FileEmbed (embedFile)
lockFile :: DevelOpts -> FilePath lockFile :: FilePath
lockFile _opts = "yesod-devel/devel-terminate" lockFile = "yesod-devel/devel-terminate"
writeLock :: DevelOpts -> IO () writeLock :: DevelOpts -> IO ()
writeLock opts = do writeLock opts = do
createDirectoryIfMissing True "yesod-devel" createDirectoryIfMissing True "yesod-devel"
writeFile (lockFile opts) "" writeFile lockFile ""
createDirectoryIfMissing True "dist" -- for compatibility with old devel.hs createDirectoryIfMissing True "dist" -- for compatibility with old devel.hs
writeFile "dist/devel-terminate" "" writeFile "dist/devel-terminate" ""
removeLock :: DevelOpts -> IO () removeLock :: DevelOpts -> IO ()
removeLock opts = do removeLock opts = do
removeFileIfExists (lockFile opts) removeFileIfExists lockFile
removeFileIfExists "dist/devel-terminate" -- for compatibility with old devel.hs removeFileIfExists "dist/devel-terminate" -- for compatibility with old devel.hs
data DevelTermOpt = TerminateOnEnter | TerminateOnlyInterrupt data DevelTermOpt = TerminateOnEnter | TerminateOnlyInterrupt
deriving (Show, Eq) deriving (Show, Eq)
data DevelOpts = DevelOpts data DevelOpts = DevelOpts
{ isCabalDev :: Bool { isCabalDev :: Bool
, forceCabal :: Bool , forceCabal :: Bool
@ -136,8 +137,9 @@ defaultDevelOpts = DevelOpts
} }
cabalProgram :: DevelOpts -> FilePath cabalProgram :: DevelOpts -> FilePath
cabalProgram opts | isCabalDev opts = "cabal-dev" cabalProgram opts
| otherwise = "cabal" | isCabalDev opts = "cabal-dev"
| otherwise = "cabal"
-- | Run a reverse proxy from port 3000 to 3001. If there is no response on -- | Run a reverse proxy from port 3000 to 3001. If there is no response on
-- 3001, give an appropriate message to the user. -- 3001, give an appropriate message to the user.
@ -207,7 +209,8 @@ checkPort p = do
return True return True
getPort :: DevelOpts -> Int -> IO Int getPort :: DevelOpts -> Int -> IO Int
getPort opts _ | not (useReverseProxy opts) = return $ develPort opts getPort opts _
| not (useReverseProxy opts) = return $ develPort opts
getPort _ p0 = getPort _ p0 =
loop p0 loop p0
where where
@ -504,7 +507,11 @@ lookupLdAr = do
lookupLdAr' :: IO (Maybe (FilePath, FilePath)) lookupLdAr' :: IO (Maybe (FilePath, FilePath))
lookupLdAr' = do lookupLdAr' = do
#if MIN_VERSION_Cabal(1,22,0)
(_, _, pgmc) <- D.configCompilerEx (Just D.GHC) Nothing Nothing D.defaultProgramConfiguration D.silent
#else
(_, pgmc) <- D.configCompiler (Just D.GHC) Nothing Nothing D.defaultProgramConfiguration D.silent (_, pgmc) <- D.configCompiler (Just D.GHC) Nothing Nothing D.defaultProgramConfiguration D.silent
#endif
pgmc' <- D.configureAllKnownPrograms D.silent pgmc pgmc' <- D.configureAllKnownPrograms D.silent pgmc
return $ (,) <$> look D.ldProgram pgmc' <*> look D.arProgram pgmc' return $ (,) <$> look D.ldProgram pgmc' <*> look D.arProgram pgmc'
where where