Rewrite yesod devel based on Stack #1304
Please see ChangeLog for explanation.
This commit is contained in:
Michael Snoyman
parent
54cc4205d8
commit
83d3a12a23
@ -26,3 +26,5 @@ extra-deps:
|
|||||||
|
|
||||||
- conduit-extra-1.1.14
|
- conduit-extra-1.1.14
|
||||||
- streaming-commons-0.1.16
|
- streaming-commons-0.1.16
|
||||||
|
- typed-process-0.1.0.0
|
||||||
|
- say-0.1.0.0
|
||||||
|
|||||||
@ -1,3 +1,21 @@
|
|||||||
|
## 1.5.0
|
||||||
|
|
||||||
|
Rewrite of `yesod devel` to take advantage of Stack for a simpler codebase.
|
||||||
|
|
||||||
|
Advantages:
|
||||||
|
|
||||||
|
* Does not link against the ghc library, so can be used with multiple
|
||||||
|
GHC versions
|
||||||
|
* Leverages Stack's ability to check for dependent files, which is
|
||||||
|
more robust than what yesod devel was doing previously
|
||||||
|
* Seems to involve less rebuilding of the library on initial run
|
||||||
|
|
||||||
|
Disadvantages:
|
||||||
|
|
||||||
|
* Lost some functionality (e.g., failure hooks, controlling the exit
|
||||||
|
command)
|
||||||
|
* Newer codebase, quite likely has bugs that need to be ironed out.
|
||||||
|
|
||||||
## 1.4.18.7
|
## 1.4.18.7
|
||||||
|
|
||||||
* Actually release the changes for #1284
|
* Actually release the changes for #1284
|
||||||
|
|||||||
@ -1,163 +1,124 @@
|
|||||||
{-# LANGUAGE CPP #-}
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
|
||||||
module Devel
|
module Devel
|
||||||
( devel
|
( devel
|
||||||
|
, develSignal
|
||||||
, DevelOpts(..)
|
, DevelOpts(..)
|
||||||
, DevelTermOpt(..)
|
|
||||||
, defaultDevelOpts
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Distribution.Compiler as D
|
import Control.Applicative ((<|>))
|
||||||
import qualified Distribution.ModuleName as D
|
import Control.Concurrent (threadDelay)
|
||||||
|
import Control.Concurrent.Async (race_)
|
||||||
|
import Control.Concurrent.MVar (newEmptyMVar, putMVar,
|
||||||
|
takeMVar)
|
||||||
|
import Control.Concurrent.STM
|
||||||
|
import qualified Control.Exception.Safe as Ex
|
||||||
|
import Control.Monad (forever, unless, void,
|
||||||
|
when)
|
||||||
|
import qualified Data.ByteString.Lazy as LB
|
||||||
|
import Data.Default.Class (def)
|
||||||
|
import Data.FileEmbed (embedFile)
|
||||||
|
import qualified Data.Map as Map
|
||||||
|
import Data.Streaming.Network (bindPortTCP,
|
||||||
|
bindRandomPortTCP)
|
||||||
|
import Data.Time (getCurrentTime)
|
||||||
|
import qualified Distribution.Package as D
|
||||||
import qualified Distribution.PackageDescription as D
|
import qualified Distribution.PackageDescription as D
|
||||||
import qualified Distribution.PackageDescription.Parse 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.Simple.Utils as D
|
||||||
import qualified Distribution.Verbosity as D
|
import qualified Distribution.Verbosity as D
|
||||||
|
import Network.HTTP.Client (newManager)
|
||||||
import Control.Applicative ((<$>), (<*>))
|
import Network.HTTP.Client (managerSetProxy,
|
||||||
import Control.Concurrent (forkIO, threadDelay)
|
noProxy)
|
||||||
import Control.Concurrent.MVar (MVar, newEmptyMVar,
|
import Network.HTTP.Client.TLS (tlsManagerSettings)
|
||||||
takeMVar, tryPutMVar)
|
|
||||||
import Control.Concurrent.Async (race_)
|
|
||||||
import qualified Control.Exception as Ex
|
|
||||||
import Control.Monad (forever, unless, void,
|
|
||||||
when, forM)
|
|
||||||
import Control.Monad.IO.Class (liftIO)
|
|
||||||
import Control.Monad.Trans.State (evalStateT, get)
|
|
||||||
import qualified Data.IORef as I
|
|
||||||
|
|
||||||
import qualified Data.ByteString.Lazy as LB
|
|
||||||
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.Streaming.Network (bindPortTCP)
|
|
||||||
import Network (withSocketsDo)
|
|
||||||
import Network.HTTP.Conduit (conduitManagerSettings, newManager)
|
|
||||||
import Data.Default.Class (def)
|
|
||||||
#if MIN_VERSION_http_client(0,4,7)
|
|
||||||
import Network.HTTP.Client (managerSetProxy, noProxy)
|
|
||||||
#endif
|
|
||||||
import Network.HTTP.ReverseProxy (ProxyDest (ProxyDest),
|
import Network.HTTP.ReverseProxy (ProxyDest (ProxyDest),
|
||||||
waiProxyToSettings, wpsTimeout, wpsOnExc)
|
waiProxyToSettings,
|
||||||
|
wpsOnExc, wpsTimeout)
|
||||||
import qualified Network.HTTP.ReverseProxy as ReverseProxy
|
import qualified Network.HTTP.ReverseProxy as ReverseProxy
|
||||||
import Network.HTTP.Types (status200, status503)
|
import Network.HTTP.Types (status200, status503)
|
||||||
import Network.Socket (sClose)
|
import qualified Network.Socket
|
||||||
import Network.Wai (responseLBS, requestHeaders,
|
import Network.Wai (requestHeaderHost,
|
||||||
requestHeaderHost)
|
requestHeaders,
|
||||||
|
responseLBS)
|
||||||
|
import Network.Wai.Handler.Warp (defaultSettings, run,
|
||||||
|
setPort)
|
||||||
|
import Network.Wai.Handler.WarpTLS (runTLS,
|
||||||
|
tlsSettingsMemory)
|
||||||
import Network.Wai.Parse (parseHttpAccept)
|
import Network.Wai.Parse (parseHttpAccept)
|
||||||
import Network.Wai.Handler.Warp (run, defaultSettings, setPort)
|
import Say
|
||||||
import Network.Wai.Handler.WarpTLS (runTLS, tlsSettingsMemory)
|
import System.Directory
|
||||||
import SrcLoc (Located)
|
import System.Environment (getEnvironment,
|
||||||
import Data.FileEmbed (embedFile)
|
getExecutablePath)
|
||||||
|
import System.FilePath (takeDirectory,
|
||||||
|
takeFileName, (</>))
|
||||||
|
import System.FSNotify
|
||||||
|
import System.IO.Error (isDoesNotExistError)
|
||||||
|
import System.Process.Typed
|
||||||
|
|
||||||
lockFile :: FilePath
|
-- We have two special files:
|
||||||
lockFile = "yesod-devel/devel-terminate"
|
--
|
||||||
|
-- * The terminate file tells the child process to die simply by being
|
||||||
|
-- present. Ideally we'd handle this via killing the process
|
||||||
|
-- directly, but that's historically never worked reliably.
|
||||||
|
--
|
||||||
|
-- * The signal file, which tells us that "stack build" has succeeded
|
||||||
|
-- yet again.
|
||||||
|
data SpecialFile = TermFile | SignalFile
|
||||||
|
|
||||||
writeLock :: DevelOpts -> IO ()
|
specialFilePath :: SpecialFile -> FilePath
|
||||||
writeLock _opts = do
|
|
||||||
createDirectoryIfMissing True "yesod-devel"
|
|
||||||
writeFile lockFile ""
|
|
||||||
createDirectoryIfMissing True "dist" -- for compatibility with old devel.hs
|
|
||||||
writeFile "dist/devel-terminate" ""
|
|
||||||
|
|
||||||
removeLock :: DevelOpts -> IO ()
|
-- used by scaffolded app, cannot change
|
||||||
removeLock _opts = do
|
specialFilePath TermFile = "yesod-devel/devel-terminate"
|
||||||
removeFileIfExists lockFile
|
|
||||||
removeFileIfExists "dist/devel-terminate" -- for compatibility with old devel.hs
|
|
||||||
|
|
||||||
data DevelTermOpt = TerminateOnEnter | TerminateOnlyInterrupt
|
-- only used internally, can change
|
||||||
deriving (Show, Eq)
|
specialFilePath SignalFile = "yesod-devel/rebuild"
|
||||||
|
|
||||||
|
-- | Write a special file
|
||||||
|
writeSpecialFile :: SpecialFile -> IO ()
|
||||||
|
writeSpecialFile sp = do
|
||||||
|
let fp = specialFilePath sp
|
||||||
|
createDirectoryIfMissing True $ takeDirectory fp
|
||||||
|
now <- getCurrentTime
|
||||||
|
writeFile fp $ show now
|
||||||
|
|
||||||
|
-- | Remove a special file
|
||||||
|
removeSpecialFile :: SpecialFile -> IO ()
|
||||||
|
removeSpecialFile sp = removeFile (specialFilePath sp) `Ex.catch` \e ->
|
||||||
|
if isDoesNotExistError e
|
||||||
|
then return ()
|
||||||
|
else Ex.throwIO e
|
||||||
|
|
||||||
|
-- | Get an absolute path to the special file
|
||||||
|
canonicalizeSpecialFile :: SpecialFile -> IO FilePath
|
||||||
|
canonicalizeSpecialFile sp = do
|
||||||
|
let fp = specialFilePath sp
|
||||||
|
dir = takeDirectory fp
|
||||||
|
file = takeFileName fp
|
||||||
|
createDirectoryIfMissing True dir
|
||||||
|
dir' <- canonicalizePath dir
|
||||||
|
return $ dir' </> file
|
||||||
|
|
||||||
|
-- | Used as a callback from "stack build --exec" to write the signal file
|
||||||
|
develSignal :: IO ()
|
||||||
|
develSignal = writeSpecialFile SignalFile
|
||||||
|
|
||||||
|
-- | Options to be provided on the command line
|
||||||
data DevelOpts = DevelOpts
|
data DevelOpts = DevelOpts
|
||||||
{ isCabalDev :: Bool
|
{ verbose :: Bool
|
||||||
, forceCabal :: Bool
|
, successHook :: Maybe String
|
||||||
, verbose :: Bool
|
, develPort :: Int
|
||||||
, eventTimeout :: Int -- negative value for no timeout
|
, develTlsPort :: Int
|
||||||
, successHook :: Maybe String
|
, proxyTimeout :: Int
|
||||||
, failHook :: Maybe String
|
|
||||||
, buildDir :: Maybe String
|
|
||||||
, develPort :: Int
|
|
||||||
, develTlsPort :: Int
|
|
||||||
, proxyTimeout :: Int
|
|
||||||
, useReverseProxy :: Bool
|
, useReverseProxy :: Bool
|
||||||
, terminateWith :: DevelTermOpt
|
|
||||||
|
|
||||||
-- Support for GHC_PACKAGE_PATH wrapping
|
|
||||||
, develConfigOpts :: [String]
|
|
||||||
, develEnv :: Maybe [(String, String)]
|
|
||||||
} deriving (Show, Eq)
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
getBuildDir :: DevelOpts -> String
|
-- | Run a reverse proxy from the develPort and develTlsPort ports to
|
||||||
getBuildDir opts = fromMaybe "dist" (buildDir opts)
|
-- the app running in appPortVar. If there is no response on the
|
||||||
|
-- application port, give an appropriate message to the user.
|
||||||
defaultDevelOpts :: DevelOpts
|
reverseProxy :: DevelOpts -> TVar Int -> IO ()
|
||||||
defaultDevelOpts = DevelOpts
|
reverseProxy opts appPortVar = do
|
||||||
{ isCabalDev = False
|
manager <- newManager $ managerSetProxy noProxy tlsManagerSettings
|
||||||
, forceCabal = False
|
let refreshHtml = LB.fromChunks [$(embedFile "refreshing.html")]
|
||||||
, verbose = False
|
|
||||||
, eventTimeout = -1
|
|
||||||
, successHook = Nothing
|
|
||||||
, failHook = Nothing
|
|
||||||
, buildDir = Nothing
|
|
||||||
, develPort = 3000
|
|
||||||
, develTlsPort = 3443
|
|
||||||
, proxyTimeout = 10
|
|
||||||
, useReverseProxy = True
|
|
||||||
, terminateWith = TerminateOnEnter
|
|
||||||
, develConfigOpts = []
|
|
||||||
, develEnv = Nothing
|
|
||||||
}
|
|
||||||
|
|
||||||
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
|
|
||||||
#if MIN_VERSION_http_client(0,4,7)
|
|
||||||
manager <- newManager $ managerSetProxy noProxy conduitManagerSettings
|
|
||||||
#else
|
|
||||||
manager <- newManager conduitManagerSettings
|
|
||||||
#endif
|
|
||||||
let refreshHtml = LB.fromChunks $ return $(embedFile "refreshing.html")
|
|
||||||
let onExc _ req
|
let onExc _ req
|
||||||
| maybe False (("application/json" `elem`) . parseHttpAccept)
|
| maybe False (("application/json" `elem`) . parseHttpAccept)
|
||||||
(lookup "accept" $ requestHeaders req) =
|
(lookup "accept" $ requestHeaders req) =
|
||||||
@ -173,7 +134,7 @@ reverseProxy opts iappPort = do
|
|||||||
|
|
||||||
let proxyApp = waiProxyToSettings
|
let proxyApp = waiProxyToSettings
|
||||||
(const $ do
|
(const $ do
|
||||||
appPort <- liftIO $ I.readIORef iappPort
|
appPort <- atomically $ readTVar appPortVar
|
||||||
return $
|
return $
|
||||||
ReverseProxy.WPRProxyDest
|
ReverseProxy.WPRProxyDest
|
||||||
$ ProxyDest "127.0.0.1" appPort)
|
$ ProxyDest "127.0.0.1" appPort)
|
||||||
@ -209,361 +170,226 @@ reverseProxy opts iappPort = do
|
|||||||
app req' send
|
app req' send
|
||||||
httpProxy = run (develPort opts) proxyApp
|
httpProxy = run (develPort opts) proxyApp
|
||||||
httpsProxy = runProxyTls (develTlsPort opts) proxyApp
|
httpsProxy = runProxyTls (develTlsPort opts) proxyApp
|
||||||
putStrLn "Application can be accessed at:\n"
|
say "Application can be accessed at:\n"
|
||||||
putStrLn $ "http://localhost:" ++ show (develPort opts)
|
sayString $ "http://localhost:" ++ show (develPort opts)
|
||||||
putStrLn $ "https://localhost:" ++ show (develTlsPort opts)
|
sayString $ "https://localhost:" ++ show (develTlsPort opts)
|
||||||
putStrLn $ "If you wish to test https capabilities, you should set the following variable:"
|
say $ "If you wish to test https capabilities, you should set the following variable:"
|
||||||
putStrLn $ " export APPROOT=https://localhost:" ++ show (develTlsPort opts)
|
sayString $ " export APPROOT=https://localhost:" ++ show (develTlsPort opts)
|
||||||
putStrLn ""
|
say ""
|
||||||
loop (race_ httpProxy httpsProxy) `Ex.catch` \e -> do
|
race_ httpProxy httpsProxy
|
||||||
print (e :: Ex.SomeException)
|
|
||||||
_ <- exitFailure
|
|
||||||
Ex.throwIO e -- heh, just for good measure
|
|
||||||
where
|
|
||||||
loop proxies = forever $ do
|
|
||||||
void proxies
|
|
||||||
putStrLn $ "Reverse proxy stopped, but it shouldn't"
|
|
||||||
threadDelay 1000000
|
|
||||||
putStrLn $ "Restarting reverse proxies"
|
|
||||||
|
|
||||||
|
-- | Check if the given port is available.
|
||||||
checkPort :: Int -> IO Bool
|
checkPort :: Int -> IO Bool
|
||||||
checkPort p = do
|
checkPort p = do
|
||||||
es <- Ex.try $ bindPortTCP p "*4"
|
es <- Ex.tryIO $ bindPortTCP p "*4"
|
||||||
case es of
|
case es of
|
||||||
Left (_ :: Ex.IOException) -> return False
|
Left _ -> return False
|
||||||
Right s -> do
|
Right s -> do
|
||||||
sClose s
|
Network.Socket.close s
|
||||||
return True
|
return True
|
||||||
|
|
||||||
getPort :: DevelOpts -> Int -> IO Int
|
-- | Get a random, unused port.
|
||||||
getPort opts _
|
getNewPort :: DevelOpts -> IO Int
|
||||||
| not (useReverseProxy opts) = return $ develPort opts
|
getNewPort opts = do
|
||||||
getPort _ p0 =
|
(port, socket) <- bindRandomPortTCP "*"
|
||||||
loop p0
|
when (verbose opts) $ sayString $ "Got new port: " ++ show port
|
||||||
where
|
Network.Socket.close socket
|
||||||
loop p = do
|
return port
|
||||||
avail <- checkPort p
|
|
||||||
if avail then return p else loop (succ p)
|
|
||||||
|
|
||||||
|
-- | Utility function
|
||||||
unlessM :: Monad m => m Bool -> m () -> m ()
|
unlessM :: Monad m => m Bool -> m () -> m ()
|
||||||
unlessM c a = c >>= \res -> unless res a
|
unlessM c a = c >>= \res -> unless res a
|
||||||
|
|
||||||
devel :: DevelOpts -> [String] -> IO ()
|
-- | Find the file containing the devel code to be run.
|
||||||
devel opts passThroughArgs = withSocketsDo $ withManager $ \manager -> do
|
|
||||||
unlessM (checkPort $ develPort opts) $ error "devel port unavailable"
|
|
||||||
iappPort <- getPort opts 17834 >>= I.newIORef
|
|
||||||
when (useReverseProxy opts) $ void $ forkIO $ reverseProxy opts iappPort
|
|
||||||
develHsPath <- checkDevelFile
|
|
||||||
writeLock opts
|
|
||||||
|
|
||||||
let (terminator, after) = case terminateWith opts of
|
|
||||||
TerminateOnEnter ->
|
|
||||||
("Type 'quit'", blockQuit)
|
|
||||||
TerminateOnlyInterrupt -> -- run for one year
|
|
||||||
("Interrupt", threadDelay $ 1000 * 1000 * 60 * 60 * 24 * 365)
|
|
||||||
|
|
||||||
blockQuit = do
|
|
||||||
s <- getLine
|
|
||||||
if s == "quit"
|
|
||||||
then return ()
|
|
||||||
else do
|
|
||||||
putStrLn "Type 'quit' to quit"
|
|
||||||
blockQuit
|
|
||||||
|
|
||||||
|
|
||||||
putStrLn $ "Yesod devel server. " ++ terminator ++ " to quit"
|
|
||||||
void $ forkIO $ do
|
|
||||||
filesModified <- newEmptyMVar
|
|
||||||
void $ forkIO $
|
|
||||||
void $ watchTree manager "." (const True) (\_ -> void (tryPutMVar filesModified ()))
|
|
||||||
evalStateT (mainOuterLoop develHsPath iappPort filesModified) Map.empty
|
|
||||||
after
|
|
||||||
writeLock opts
|
|
||||||
exitSuccess
|
|
||||||
where
|
|
||||||
bd = getBuildDir opts
|
|
||||||
|
|
||||||
-- outer loop re-reads the cabal file
|
|
||||||
mainOuterLoop develHsPath iappPort filesModified = do
|
|
||||||
ghcVer <- liftIO ghcVersion
|
|
||||||
#if MIN_VERSION_Cabal(1,20,0)
|
|
||||||
cabal <- liftIO $ D.tryFindPackageDesc "."
|
|
||||||
#else
|
|
||||||
cabal <- liftIO $ D.findPackageDesc "."
|
|
||||||
#endif
|
|
||||||
gpd <- liftIO $ D.readPackageDescription D.normal cabal
|
|
||||||
ldar <- liftIO lookupLdAr
|
|
||||||
(hsSourceDirs, _) <- liftIO $ checkCabalFile gpd
|
|
||||||
liftIO $ removeFileIfExists (bd </> "setup-config")
|
|
||||||
c <- liftIO $ configure opts passThroughArgs
|
|
||||||
if c then do
|
|
||||||
-- these files contain the wrong data after the configure step,
|
|
||||||
-- remove them to force a cabal build first
|
|
||||||
liftIO $ mapM_ removeFileIfExists [ "yesod-devel/ghcargs.txt"
|
|
||||||
, "yesod-devel/arargs.txt"
|
|
||||||
, "yesod-devel/ldargs.txt"
|
|
||||||
]
|
|
||||||
rebuild <- liftIO $ mkRebuild ghcVer cabal opts ldar
|
|
||||||
mainInnerLoop develHsPath iappPort hsSourceDirs filesModified cabal rebuild
|
|
||||||
else do
|
|
||||||
liftIO (threadDelay 5000000)
|
|
||||||
mainOuterLoop develHsPath iappPort filesModified
|
|
||||||
|
|
||||||
-- inner loop rebuilds after files change
|
|
||||||
mainInnerLoop develHsPath iappPort hsSourceDirs filesModified cabal rebuild = go
|
|
||||||
where
|
|
||||||
go = do
|
|
||||||
_ <- recompDeps hsSourceDirs
|
|
||||||
list <- liftIO $ getFileList hsSourceDirs [cabal]
|
|
||||||
success <- liftIO rebuild
|
|
||||||
pkgArgs <- liftIO (ghcPackageArgs opts)
|
|
||||||
let devArgs = pkgArgs ++ [develHsPath]
|
|
||||||
let loop list0 = do
|
|
||||||
(haskellFileChanged, list1) <- liftIO $
|
|
||||||
watchForChanges filesModified hsSourceDirs [cabal] list0 (eventTimeout opts)
|
|
||||||
anyTouched <- recompDeps hsSourceDirs
|
|
||||||
unless (anyTouched || haskellFileChanged) $ loop list1
|
|
||||||
if not success
|
|
||||||
then liftIO $ do
|
|
||||||
putStrLn "\x1b[1;31mBuild failure, pausing...\x1b[0m"
|
|
||||||
runBuildHook $ failHook opts
|
|
||||||
else do
|
|
||||||
liftIO $ runBuildHook $ successHook opts
|
|
||||||
liftIO $ removeLock opts
|
|
||||||
liftIO $ putStrLn
|
|
||||||
$ if verbose opts then "Starting development server: runghc " ++ L.unwords devArgs
|
|
||||||
else "Starting development server..."
|
|
||||||
env0 <- liftIO getEnvironment
|
|
||||||
|
|
||||||
-- get a new port for the new process to listen on
|
|
||||||
appPort <- liftIO $ I.readIORef iappPort >>= getPort opts . (+ 1)
|
|
||||||
liftIO $ I.writeIORef iappPort appPort
|
|
||||||
|
|
||||||
(_,_,_,ph) <- liftIO $ createProcess (proc "runghc" devArgs)
|
|
||||||
{ env = Just $ Map.toList
|
|
||||||
$ Map.insert "PORT" (show appPort)
|
|
||||||
$ Map.insert "DISPLAY_PORT" (show $ develPort opts)
|
|
||||||
$ Map.fromList env0
|
|
||||||
}
|
|
||||||
derefMap <- get
|
|
||||||
watchTid <- liftIO . forkIO . try_ $ flip evalStateT derefMap $ do
|
|
||||||
loop list
|
|
||||||
liftIO $ do
|
|
||||||
putStrLn "Stopping development server..."
|
|
||||||
writeLock opts
|
|
||||||
threadDelay 1000000
|
|
||||||
putStrLn "Terminating development server..."
|
|
||||||
terminateProcess ph
|
|
||||||
ec <- liftIO $ waitForProcess' ph
|
|
||||||
liftIO $ putStrLn $ "Exit code: " ++ show ec
|
|
||||||
liftIO $ Ex.throwTo watchTid (userError "process finished")
|
|
||||||
loop list
|
|
||||||
n <- liftIO $ cabal `isNewerThan` (bd </> "setup-config")
|
|
||||||
if n then mainOuterLoop develHsPath iappPort filesModified else go
|
|
||||||
|
|
||||||
runBuildHook :: Maybe String -> IO ()
|
|
||||||
runBuildHook (Just s) = do
|
|
||||||
ret <- system s
|
|
||||||
case ret of
|
|
||||||
ExitFailure _ -> putStrLn ("Error executing hook: " ++ s)
|
|
||||||
_ -> return ()
|
|
||||||
runBuildHook Nothing = return ()
|
|
||||||
|
|
||||||
{-
|
|
||||||
run `cabal configure' with our wrappers
|
|
||||||
-}
|
|
||||||
configure :: DevelOpts -> [String] -> IO Bool
|
|
||||||
configure opts extraArgs =
|
|
||||||
checkExit =<< createProcess (proc (cabalProgram opts) $
|
|
||||||
[ "configure"
|
|
||||||
, "-flibrary-only"
|
|
||||||
, "--disable-tests"
|
|
||||||
, "--disable-benchmarks"
|
|
||||||
, "-fdevel"
|
|
||||||
, "--disable-library-profiling"
|
|
||||||
, "--with-ld=yesod-ld-wrapper"
|
|
||||||
, "--with-ghc=yesod-ghc-wrapper"
|
|
||||||
, "--with-ar=yesod-ar-wrapper"
|
|
||||||
, "--with-hc-pkg=ghc-pkg"
|
|
||||||
] ++ develConfigOpts opts ++ extraArgs
|
|
||||||
) { env = develEnv opts }
|
|
||||||
|
|
||||||
removeFileIfExists :: FilePath -> IO ()
|
|
||||||
removeFileIfExists file = removeFile file `Ex.catch` handler
|
|
||||||
where
|
|
||||||
handler :: IOError -> IO ()
|
|
||||||
handler e | isDoesNotExistError e = return ()
|
|
||||||
| otherwise = Ex.throw e
|
|
||||||
|
|
||||||
mkRebuild :: String -> FilePath -> DevelOpts -> (FilePath, FilePath) -> IO (IO Bool)
|
|
||||||
mkRebuild ghcVer cabalFile opts (ldPath, arPath)
|
|
||||||
| GHC.cProjectVersion /= ghcVer =
|
|
||||||
failWith "Yesod has been compiled with a different GHC version, please reinstall yesod-bin"
|
|
||||||
| forceCabal opts = return (rebuildCabal opts)
|
|
||||||
| otherwise =
|
|
||||||
return $ do
|
|
||||||
ns <- mapM (cabalFile `isNewerThan`)
|
|
||||||
[ "yesod-devel/ghcargs.txt", "yesod-devel/arargs.txt", "yesod-devel/ldargs.txt" ]
|
|
||||||
if or ns
|
|
||||||
then rebuildCabal opts
|
|
||||||
else do
|
|
||||||
bf <- getBuildFlags
|
|
||||||
rebuildGhc bf ldPath arPath
|
|
||||||
|
|
||||||
|
|
||||||
rebuildGhc :: [Located String] -> FilePath -> FilePath -> IO Bool
|
|
||||||
rebuildGhc bf ld ar = do
|
|
||||||
putStrLn "Rebuilding application... (using GHC API)"
|
|
||||||
buildPackage bf ld ar
|
|
||||||
|
|
||||||
rebuildCabal :: DevelOpts -> IO Bool
|
|
||||||
rebuildCabal opts = do
|
|
||||||
putStrLn $ "Rebuilding application... (using " ++ cabalProgram opts ++ ")"
|
|
||||||
checkExit =<< createProcess (proc (cabalProgram opts) args)
|
|
||||||
{ env = develEnv opts
|
|
||||||
}
|
|
||||||
where
|
|
||||||
args | verbose opts = [ "build" ]
|
|
||||||
| otherwise = [ "build", "-v0" ]
|
|
||||||
|
|
||||||
try_ :: forall a. IO a -> IO ()
|
|
||||||
try_ x = void (Ex.try x :: IO (Either Ex.SomeException a))
|
|
||||||
|
|
||||||
type FileList = Map.Map FilePath EpochTime
|
|
||||||
|
|
||||||
getFileList :: [FilePath] -> [FilePath] -> IO FileList
|
|
||||||
getFileList hsSourceDirs extraFiles = do
|
|
||||||
(files, deps) <- getDeps hsSourceDirs
|
|
||||||
let files' = extraFiles ++ files ++ map fst (Map.toList deps)
|
|
||||||
fmap Map.fromList $ forM files' $ \f -> do
|
|
||||||
efs <- Ex.try $ getFileStatus f
|
|
||||||
return $ case efs of
|
|
||||||
Left (_ :: Ex.SomeException) -> (f, 0)
|
|
||||||
Right fs -> (f, modificationTime fs)
|
|
||||||
|
|
||||||
-- | Returns @True@ if a .hs file changed.
|
|
||||||
watchForChanges :: MVar () -> [FilePath] -> [FilePath] -> FileList -> Int -> IO (Bool, FileList)
|
|
||||||
watchForChanges filesModified hsSourceDirs extraFiles list t = do
|
|
||||||
newList <- getFileList hsSourceDirs extraFiles
|
|
||||||
if list /= newList
|
|
||||||
then do
|
|
||||||
let haskellFileChanged = not $ Map.null $ Map.filterWithKey isHaskell $
|
|
||||||
Map.differenceWith compareTimes newList list `Map.union`
|
|
||||||
Map.differenceWith compareTimes list newList
|
|
||||||
return (haskellFileChanged, newList)
|
|
||||||
else timeout (1000000*t) (takeMVar filesModified) >>
|
|
||||||
watchForChanges filesModified hsSourceDirs extraFiles list t
|
|
||||||
where
|
|
||||||
compareTimes x y
|
|
||||||
| x == y = Nothing
|
|
||||||
| otherwise = Just x
|
|
||||||
|
|
||||||
isHaskell filename _ = takeExtension filename `elem` [".hs", ".lhs", ".hsc", ".cabal"]
|
|
||||||
|
|
||||||
checkDevelFile :: IO FilePath
|
checkDevelFile :: IO FilePath
|
||||||
checkDevelFile =
|
checkDevelFile =
|
||||||
loop paths
|
loop paths
|
||||||
where
|
where
|
||||||
paths = ["app/devel.hs", "devel.hs", "src/devel.hs"]
|
paths = ["app/devel.hs", "devel.hs", "src/devel.hs"]
|
||||||
|
|
||||||
loop [] = failWith $ "file devel.hs not found, checked: " ++ show paths
|
loop [] = error $ "file devel.hs not found, checked: " ++ show paths
|
||||||
loop (x:xs) = do
|
loop (x:xs) = do
|
||||||
e <- doesFileExist x
|
e <- doesFileExist x
|
||||||
if e
|
if e
|
||||||
then return x
|
then return x
|
||||||
else loop xs
|
else loop xs
|
||||||
|
|
||||||
checkCabalFile :: D.GenericPackageDescription -> IO ([FilePath], D.Library)
|
-- | This is the main entry point. Run the devel server.
|
||||||
checkCabalFile gpd = case D.condLibrary gpd of
|
devel :: DevelOpts -- ^ command line options
|
||||||
Nothing -> failWith "incorrect cabal file, no library"
|
-> [String] -- ^ extra options to pass to Stack
|
||||||
Just ct ->
|
-> IO ()
|
||||||
case lookupDevelLib gpd ct of
|
devel opts passThroughArgs = do
|
||||||
Nothing ->
|
-- Check that the listening ports are available
|
||||||
failWith "no development flag found in your configuration file. Expected a 'library-only' flag or the older 'devel' flag"
|
unlessM (checkPort $ develPort opts) $ error "devel port unavailable"
|
||||||
Just dLib -> do
|
unlessM (checkPort $ develTlsPort opts) $ error "devel TLS port unavailable"
|
||||||
let hsSourceDirs = D.hsSourceDirs . D.libBuildInfo $ dLib
|
|
||||||
fl <- getFileList hsSourceDirs []
|
|
||||||
let unlisted = checkFileList fl dLib
|
|
||||||
unless (null unlisted) $ do
|
|
||||||
putStrLn "WARNING: the following source files are not listed in exposed-modules or other-modules:"
|
|
||||||
mapM_ putStrLn unlisted
|
|
||||||
when ("Application" `notElem` (map (last . D.components) $ D.exposedModules dLib)) $
|
|
||||||
putStrLn "WARNING: no exposed module Application"
|
|
||||||
return (hsSourceDirs, dLib)
|
|
||||||
|
|
||||||
failWith :: String -> IO a
|
-- Friendly message to the user
|
||||||
failWith msg = do
|
say "Yesod devel server. Enter 'quit' or hit Ctrl-C to quit."
|
||||||
putStrLn $ "ERROR: " ++ msg
|
|
||||||
exitFailure
|
|
||||||
|
|
||||||
checkFileList :: FileList -> D.Library -> [FilePath]
|
-- Find out the name of our package, needed for the upcoming Stack
|
||||||
checkFileList fl lib = filter (not . isSetup) . filter isUnlisted . filter isSrcFile $ sourceFiles
|
-- commands
|
||||||
|
cabal <- D.tryFindPackageDesc "."
|
||||||
|
gpd <- D.readPackageDescription D.normal cabal
|
||||||
|
let pd = D.packageDescription gpd
|
||||||
|
D.PackageIdentifier (D.PackageName packageName) _version = D.package pd
|
||||||
|
|
||||||
|
-- Create a baton to indicate we're watching for file changes. We
|
||||||
|
-- need to ensure that we install the file watcher before we start
|
||||||
|
-- the Stack build loop.
|
||||||
|
watchingBaton <- newEmptyMVar
|
||||||
|
|
||||||
|
-- Which file contains the code to run
|
||||||
|
develHsPath <- checkDevelFile
|
||||||
|
|
||||||
|
-- The port that we're currently listening on, and that the
|
||||||
|
-- reverse proxy should point to
|
||||||
|
appPortVar <- newTVarIO (-1)
|
||||||
|
|
||||||
|
-- If we're actually using reverse proxying, spawn off a reverse
|
||||||
|
-- proxy thread
|
||||||
|
let withRevProxy =
|
||||||
|
if useReverseProxy opts
|
||||||
|
then race_ (reverseProxy opts appPortVar)
|
||||||
|
else id
|
||||||
|
|
||||||
|
-- Run the following concurrently. If any of them exit, take the
|
||||||
|
-- whole thing down.
|
||||||
|
withRevProxy $ race_
|
||||||
|
-- Wait until we're watching for file changes, then start the
|
||||||
|
-- build loop
|
||||||
|
(takeMVar watchingBaton >> runStackBuild packageName)
|
||||||
|
|
||||||
|
-- Run the app itself, restarting when a build succeeds
|
||||||
|
(runApp appPortVar watchingBaton develHsPath)
|
||||||
where
|
where
|
||||||
al = allModules lib
|
-- say, but only when verbose is on
|
||||||
-- a file is only a possible 'module file' if all path pieces start with a capital letter
|
sayV = when (verbose opts) . sayString
|
||||||
sourceFiles = filter isSrcFile . map fst . Map.toList $ fl
|
|
||||||
isSrcFile file = let dirs = filter (/=".") $ splitDirectories file
|
|
||||||
in all (isUpper . head) dirs && (takeExtension file `elem` [".hs", ".lhs"])
|
|
||||||
isUnlisted file = not (toModuleName file `Set.member` al)
|
|
||||||
toModuleName = L.intercalate "." . filter (/=".") . splitDirectories . dropExtension
|
|
||||||
|
|
||||||
isSetup "Setup.hs" = True
|
-- Leverage "stack build --file-watch" to do the build
|
||||||
isSetup "./Setup.hs" = True
|
runStackBuild packageName = do
|
||||||
isSetup "Setup.lhs" = True
|
-- We call into this app for the devel-signal command
|
||||||
isSetup "./Setup.lhs" = True
|
myPath <- getExecutablePath
|
||||||
isSetup _ = False
|
runProcess_ $
|
||||||
|
setDelegateCtlc True $
|
||||||
|
proc "stack" $
|
||||||
|
[ "build"
|
||||||
|
, "--fast"
|
||||||
|
, "--file-watch"
|
||||||
|
|
||||||
allModules :: D.Library -> Set.Set String
|
-- Turn on various flags, and indicate the specific
|
||||||
allModules lib = Set.fromList $ map toString $ D.exposedModules lib ++ (D.otherModules . D.libBuildInfo) lib
|
-- component we want
|
||||||
where
|
, "--flag", packageName ++ ":dev"
|
||||||
toString = L.intercalate "." . D.components
|
, "--flag", packageName ++ ":library-only"
|
||||||
|
, packageName ++ ":lib"
|
||||||
|
|
||||||
ghcVersion :: IO String
|
-- signal the watcher that a build has succeeded
|
||||||
ghcVersion = fmap getNumber $ readProcess "runghc" ["--numeric-version", "0"] []
|
, "--exec", myPath ++ " devel-signal"
|
||||||
where
|
] ++
|
||||||
getNumber = filter (\x -> isNumber x || x == '.')
|
-- Add the success hook
|
||||||
|
(case successHook opts of
|
||||||
|
Nothing -> []
|
||||||
|
Just h -> ["--exec", h]) ++
|
||||||
|
|
||||||
ghcPackageArgs :: DevelOpts -> IO [String]
|
-- Any extra args passed on the command line
|
||||||
ghcPackageArgs opts = getBuildFlags >>= getPackageArgs (buildDir opts)
|
passThroughArgs
|
||||||
|
|
||||||
lookupDevelLib :: D.GenericPackageDescription -> D.CondTree D.ConfVar c a -> Maybe a
|
-- Each time the library builds successfully, run the application
|
||||||
lookupDevelLib gpd ct | found = Just (D.condTreeData ct)
|
runApp appPortVar watchingBaton develHsPath = do
|
||||||
| otherwise = Nothing
|
-- Get the absolute path of the signal file, needed for the
|
||||||
where
|
-- file watching
|
||||||
flags = map (unFlagName . D.flagName) $ D.genPackageFlags gpd
|
develSignalFile' <- canonicalizeSpecialFile SignalFile
|
||||||
unFlagName (D.FlagName x) = x
|
|
||||||
found = any (`elem` ["library-only", "devel"]) flags
|
|
||||||
|
|
||||||
-- location of `ld' and `ar' programs
|
-- Enable file watching
|
||||||
lookupLdAr :: IO (FilePath, FilePath)
|
withManager $ \manager -> do
|
||||||
lookupLdAr = do
|
-- Variable indicating that the signal file has been
|
||||||
mla <- lookupLdAr'
|
-- changed. We reset it each time we handle the signal.
|
||||||
case mla of
|
changedVar <- newTVarIO False
|
||||||
Nothing -> failWith "Cannot determine location of `ar' or `ld' program"
|
|
||||||
Just la -> return la
|
|
||||||
|
|
||||||
lookupLdAr' :: IO (Maybe (FilePath, FilePath))
|
-- Start watching the signal file, and set changedVar to
|
||||||
lookupLdAr' = do
|
-- True each time it's changed.
|
||||||
#if MIN_VERSION_Cabal(1,18,0)
|
void $ watchDir manager
|
||||||
(_, _, pgmc) <- D.configCompilerEx (Just D.GHC) Nothing Nothing D.defaultProgramConfiguration D.silent
|
(takeDirectory develSignalFile')
|
||||||
#else
|
(\e -> eventPath e == develSignalFile')
|
||||||
(_, pgmc) <- D.configCompiler (Just D.GHC) Nothing Nothing D.defaultProgramConfiguration D.silent
|
(const $ atomically $ writeTVar changedVar True)
|
||||||
#endif
|
|
||||||
pgmc' <- D.configureAllKnownPrograms D.silent pgmc
|
|
||||||
return $ (,) <$> look D.ldProgram pgmc' <*> look D.arProgram pgmc'
|
|
||||||
where
|
|
||||||
look pgm pdb = fmap D.programPath (D.lookupProgram pgm pdb)
|
|
||||||
|
|
||||||
-- | nonblocking version of @waitForProcess@
|
-- Alright, watching is set up, let the build thread know
|
||||||
waitForProcess' :: ProcessHandle -> IO ExitCode
|
-- it can get started.
|
||||||
waitForProcess' pid = go
|
putMVar watchingBaton ()
|
||||||
where
|
|
||||||
go = do
|
|
||||||
mec <- getProcessExitCode pid
|
|
||||||
case mec of
|
|
||||||
Just ec -> return ec
|
|
||||||
Nothing -> threadDelay 100000 >> go
|
|
||||||
|
|
||||||
-- | wait for process started by @createProcess@, return True for ExitSuccess
|
-- Wait for the first change, indicating that the library
|
||||||
checkExit :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO Bool
|
-- has been built
|
||||||
checkExit (_,_,_,h) = (==ExitSuccess) <$> waitForProcess' h
|
atomically $ do
|
||||||
|
changed <- readTVar changedVar
|
||||||
|
check changed
|
||||||
|
writeTVar changedVar False
|
||||||
|
|
||||||
|
sayV "First successful build complete, running app"
|
||||||
|
|
||||||
|
-- We're going to set the PORT and DISPLAY_PORT variables
|
||||||
|
-- for the child below
|
||||||
|
env <- fmap Map.fromList getEnvironment
|
||||||
|
|
||||||
|
-- Keep looping forever, print any synchronous exceptions,
|
||||||
|
-- and eventually die from an async exception from one of
|
||||||
|
-- the other threads (via race_ above).
|
||||||
|
forever $ Ex.handleAny (\e -> sayErrString $ "Exception in runApp: " ++ show e) $ do
|
||||||
|
-- Get the port the child should listen on, and tell
|
||||||
|
-- the reverse proxy about it
|
||||||
|
newPort <-
|
||||||
|
if useReverseProxy opts
|
||||||
|
then getNewPort opts
|
||||||
|
-- no reverse proxy, so use the develPort directly
|
||||||
|
else return (develPort opts)
|
||||||
|
atomically $ writeTVar appPortVar newPort
|
||||||
|
|
||||||
|
-- Modified environment
|
||||||
|
let env' = Map.toList
|
||||||
|
$ Map.insert "PORT" (show newPort)
|
||||||
|
$ Map.insert "DISPLAY_PORT" (show $ develPort opts)
|
||||||
|
env
|
||||||
|
|
||||||
|
-- Remove the terminate file so we don't immediately exit
|
||||||
|
removeSpecialFile TermFile
|
||||||
|
|
||||||
|
-- Launch the main function in the Main module defined
|
||||||
|
-- in the file develHsPath. We use ghc instead of
|
||||||
|
-- runghc to avoid the extra (confusing) resident
|
||||||
|
-- runghc process. Starting with GHC 8.0.2, that will
|
||||||
|
-- not be necessary.
|
||||||
|
let procDef = setEnv env' $ proc "stack"
|
||||||
|
[ "ghc"
|
||||||
|
, "--"
|
||||||
|
, develHsPath
|
||||||
|
, "-e"
|
||||||
|
, "Main.main"
|
||||||
|
]
|
||||||
|
|
||||||
|
-- Start running the child process with GHC
|
||||||
|
withProcess procDef $ \p -> do
|
||||||
|
-- Wait for either the process to exit, or for a new build to come through
|
||||||
|
eres <- atomically (fmap Left (waitExitCodeSTM p) <|> fmap Right
|
||||||
|
(do changed <- readTVar changedVar
|
||||||
|
check changed
|
||||||
|
writeTVar changedVar False))
|
||||||
|
-- on an async exception, make sure the child dies
|
||||||
|
`Ex.onException` writeSpecialFile TermFile
|
||||||
|
case eres of
|
||||||
|
-- Child exited, which indicates some
|
||||||
|
-- error. Let the user know, sleep for a bit
|
||||||
|
-- to avoid busy-looping, and then we'll try
|
||||||
|
-- again.
|
||||||
|
Left ec -> do
|
||||||
|
sayErrString $ "Unexpected: child process exited with " ++ show ec
|
||||||
|
threadDelay 1000000
|
||||||
|
sayErrString "Trying again"
|
||||||
|
-- New build succeeded
|
||||||
|
Right () -> do
|
||||||
|
-- Kill the child process, both with the
|
||||||
|
-- TermFile, and by signaling the process
|
||||||
|
-- directly.
|
||||||
|
writeSpecialFile TermFile
|
||||||
|
stopProcess p
|
||||||
|
|
||||||
|
-- Wait until the child properly exits, then we'll try again
|
||||||
|
ec <- waitExitCode p
|
||||||
|
sayV $ "Expected: child process exited with " ++ show ec
|
||||||
|
|||||||
@ -1,547 +0,0 @@
|
|||||||
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
|
|
||||||
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
|
|
||||||
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
|
|
||||||
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
|
|
||||||
{-
|
|
||||||
There is a lot of code copied from GHC here, and some conditional
|
|
||||||
compilation. Instead of fixing all warnings and making it much more
|
|
||||||
difficult to compare the code to the original, just ignore unused
|
|
||||||
binds and imports.
|
|
||||||
-}
|
|
||||||
{-# LANGUAGE CPP #-}
|
|
||||||
{-# LANGUAGE PatternGuards #-}
|
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
|
||||||
|
|
||||||
{-
|
|
||||||
build package with the GHC API
|
|
||||||
-}
|
|
||||||
|
|
||||||
module GhcBuild (getBuildFlags, buildPackage, getPackageArgs) where
|
|
||||||
|
|
||||||
import qualified Control.Exception as Ex
|
|
||||||
import Control.Monad (when)
|
|
||||||
import Data.IORef
|
|
||||||
import System.Process (rawSystem)
|
|
||||||
import System.Environment (getEnvironment)
|
|
||||||
|
|
||||||
import CmdLineParser
|
|
||||||
import Data.Char (toLower)
|
|
||||||
import Data.List (isPrefixOf, isSuffixOf, partition)
|
|
||||||
import Data.Maybe (fromMaybe)
|
|
||||||
import DriverPhases (Phase (..), anyHsc, isHaskellSrcFilename,
|
|
||||||
isSourceFilename, startPhase)
|
|
||||||
import DriverPipeline (compileFile, link, linkBinary, oneShot)
|
|
||||||
import DynFlags (DynFlags, compilerInfo)
|
|
||||||
import qualified DynFlags
|
|
||||||
import qualified DynFlags as DF
|
|
||||||
import qualified GHC
|
|
||||||
import GHC.Paths (libdir)
|
|
||||||
import HscTypes (HscEnv (..), emptyHomePackageTable)
|
|
||||||
import qualified Module
|
|
||||||
import MonadUtils (liftIO)
|
|
||||||
import Panic (throwGhcException, panic)
|
|
||||||
import SrcLoc (Located, mkGeneralLocated)
|
|
||||||
import qualified StaticFlags
|
|
||||||
#if __GLASGOW_HASKELL__ >= 707
|
|
||||||
import DynFlags (ldInputs)
|
|
||||||
#else
|
|
||||||
import StaticFlags (v_Ld_inputs)
|
|
||||||
#endif
|
|
||||||
import System.FilePath (normalise, (</>))
|
|
||||||
import Util (consIORef, looksLikeModuleName)
|
|
||||||
|
|
||||||
{-
|
|
||||||
This contains a huge hack:
|
|
||||||
GHC only accepts setting static flags once per process, however it has no way to
|
|
||||||
get the remaining options from the command line, without setting the static flags.
|
|
||||||
This code overwrites the IORef to disable the check. This will likely cause
|
|
||||||
problems if the flags are modified, but fortunately that's relatively uncommon.
|
|
||||||
-}
|
|
||||||
getBuildFlags :: IO [Located String]
|
|
||||||
getBuildFlags = do
|
|
||||||
argv0 <- fmap read $ readFile "yesod-devel/ghcargs.txt" -- generated by yesod-ghc-wrapper
|
|
||||||
argv0' <- prependHsenvArgv argv0
|
|
||||||
let (minusB_args, argv1) = partition ("-B" `isPrefixOf`) argv0'
|
|
||||||
mbMinusB | null minusB_args = Nothing
|
|
||||||
| otherwise = Just (drop 2 (last minusB_args))
|
|
||||||
let argv1' = map (mkGeneralLocated "on the commandline") argv1
|
|
||||||
writeIORef StaticFlags.v_opt_C_ready False -- the huge hack
|
|
||||||
(argv2, staticFlagWarnings) <- GHC.parseStaticFlags argv1'
|
|
||||||
return argv2
|
|
||||||
|
|
||||||
prependHsenvArgv :: [String] -> IO [String]
|
|
||||||
prependHsenvArgv argv = do
|
|
||||||
env <- getEnvironment
|
|
||||||
return $ case (lookup "HSENV" env) of
|
|
||||||
Nothing -> argv
|
|
||||||
_ -> hsenvArgv ++ argv
|
|
||||||
where hsenvArgv = words $ fromMaybe "" (lookup "PACKAGE_DB_FOR_GHC" env)
|
|
||||||
|
|
||||||
-- construct a command line for loading the right packages
|
|
||||||
getPackageArgs :: Maybe String -> [Located String] -> IO [String]
|
|
||||||
getPackageArgs buildDir argv2 = do
|
|
||||||
(mode, argv3, modeFlagWarnings) <- parseModeFlags argv2
|
|
||||||
GHC.runGhc (Just libdir) $ do
|
|
||||||
dflags0 <- GHC.getSessionDynFlags
|
|
||||||
(dflags1, _, _) <- GHC.parseDynamicFlags dflags0 argv3
|
|
||||||
let pkgFlags = map convertPkgFlag (GHC.packageFlags dflags1)
|
|
||||||
ignorePkgFlags =
|
|
||||||
#if __GLASGOW_HASKELL__ >= 800
|
|
||||||
map convertIgnorePkgFlag (GHC.ignorePackageFlags dflags1)
|
|
||||||
#else
|
|
||||||
[]
|
|
||||||
#endif
|
|
||||||
trustPkgFlags =
|
|
||||||
#if __GLASGOW_HASKELL__ >= 800
|
|
||||||
map convertTrustPkgFlag (GHC.trustFlags dflags1)
|
|
||||||
#else
|
|
||||||
[]
|
|
||||||
#endif
|
|
||||||
hideAll | gopt DF.Opt_HideAllPackages dflags1 = [ "-hide-all-packages"]
|
|
||||||
| otherwise = []
|
|
||||||
ownPkg = packageString (DF.thisPackage dflags1)
|
|
||||||
return (reverse (extra dflags1) ++ hideAll ++ trustPkgFlags ++ ignorePkgFlags ++ pkgFlags ++ ownPkg)
|
|
||||||
where
|
|
||||||
#if __GLASGOW_HASKELL__ >= 800
|
|
||||||
convertIgnorePkgFlag (DF.IgnorePackage p) = "-ignore-package" ++ p
|
|
||||||
convertTrustPkgFlag (DF.TrustPackage p) = "-trust" ++ p
|
|
||||||
convertTrustPkgFlag (DF.DistrustPackage p) = "-distrust" ++ p
|
|
||||||
#else
|
|
||||||
convertPkgFlag (DF.IgnorePackage p) = "-ignore-package" ++ p
|
|
||||||
convertPkgFlag (DF.TrustPackage p) = "-trust" ++ p
|
|
||||||
convertPkgFlag (DF.DistrustPackage p) = "-distrust" ++ p
|
|
||||||
#endif
|
|
||||||
#if __GLASGOW_HASKELL__ >= 800
|
|
||||||
convertPkgFlag (DF.ExposePackage _ (DF.PackageArg p) _) = "-package" ++ p
|
|
||||||
convertPkgFlag (DF.ExposePackage _ (DF.UnitIdArg p) _) = "-package-id" ++ p
|
|
||||||
#elif __GLASGOW_HASKELL__ == 710
|
|
||||||
convertPkgFlag (DF.ExposePackage (DF.PackageArg p) _) = "-package" ++ p
|
|
||||||
convertPkgFlag (DF.ExposePackage (DF.PackageIdArg p) _) = "-package-id" ++ p
|
|
||||||
convertPkgFlag (DF.ExposePackage (DF.PackageKeyArg p) _) = "-package-key" ++ p
|
|
||||||
#else
|
|
||||||
convertPkgFlag (DF.ExposePackage p) = "-package" ++ p
|
|
||||||
convertPkgFlag (DF.ExposePackageId p) = "-package-id" ++ p
|
|
||||||
#endif
|
|
||||||
convertPkgFlag (DF.HidePackage p) = "-hide-package" ++ p
|
|
||||||
#if __GLASGOW_HASKELL__ >= 800
|
|
||||||
-- See: https://github.com/yesodweb/yesod/issues/1284
|
|
||||||
packageString _flags = []
|
|
||||||
--packageString flags = "-package-id" ++ Module.unitIdString flags
|
|
||||||
#elif __GLASGOW_HASKELL__ == 710
|
|
||||||
packageString flags = ["-package-key" ++ Module.packageKeyString flags]
|
|
||||||
#else
|
|
||||||
packageString flags = ["-package-id" ++ Module.packageIdString flags ++ "-inplace"]
|
|
||||||
#endif
|
|
||||||
#if __GLASGOW_HASKELL__ >= 705
|
|
||||||
extra df = inplaceConf ++ extra'
|
|
||||||
where
|
|
||||||
extra' = concatMap convertExtra (extraConfs df)
|
|
||||||
-- old cabal-install sometimes misses the .inplace db, fix it here
|
|
||||||
inplaceConf
|
|
||||||
| any (".inplace" `isSuffixOf`) extra' = []
|
|
||||||
| otherwise = ["-package-db" ++ fromMaybe "dist" buildDir
|
|
||||||
++ "/package.conf.inplace"]
|
|
||||||
extraConfs df = GHC.extraPkgConfs df []
|
|
||||||
convertExtra DF.GlobalPkgConf = [ ]
|
|
||||||
convertExtra DF.UserPkgConf = [ ]
|
|
||||||
convertExtra (DF.PkgConfFile file) = [ "-package-db" ++ file ]
|
|
||||||
#else
|
|
||||||
extra df = inplaceConf ++ extra'
|
|
||||||
where
|
|
||||||
extra' = map ("-package-conf"++) (GHC.extraPkgConfs df)
|
|
||||||
-- old cabal-install sometimes misses the .inplace db, fix it here
|
|
||||||
inplaceConf
|
|
||||||
| any (".inplace" `isSuffixOf`) extra' = []
|
|
||||||
| otherwise = ["-package-conf" ++ fromMaybe "dist" buildDir
|
|
||||||
++ "/package.conf.inplace"]
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#if __GLASGOW_HASKELL__ >= 707
|
|
||||||
gopt = DF.gopt
|
|
||||||
#else
|
|
||||||
gopt = DF.dopt
|
|
||||||
#endif
|
|
||||||
|
|
||||||
|
|
||||||
buildPackage :: [Located String] -> FilePath -> FilePath -> IO Bool
|
|
||||||
buildPackage a ld ar = buildPackage' a ld ar `Ex.catch` \e -> do
|
|
||||||
putStrLn ("exception building package: " ++ show (e :: Ex.SomeException))
|
|
||||||
return False
|
|
||||||
|
|
||||||
buildPackage' :: [Located String] -> FilePath -> FilePath -> IO Bool
|
|
||||||
buildPackage' argv2 ld ar = do
|
|
||||||
(mode, argv3, modeFlagWarnings) <- parseModeFlags argv2
|
|
||||||
GHC.runGhc (Just libdir) $ do
|
|
||||||
dflags0 <- GHC.getSessionDynFlags
|
|
||||||
(dflags1, _, _) <- GHC.parseDynamicFlags dflags0 argv3
|
|
||||||
let dflags2 = dflags1 { GHC.ghcMode = GHC.CompManager
|
|
||||||
, GHC.hscTarget = GHC.hscTarget dflags1
|
|
||||||
, GHC.ghcLink = GHC.LinkBinary
|
|
||||||
, GHC.verbosity = 1
|
|
||||||
}
|
|
||||||
(dflags3, fileish_args, _) <- GHC.parseDynamicFlags dflags2 argv3
|
|
||||||
GHC.setSessionDynFlags dflags3
|
|
||||||
let normal_fileish_paths = map (normalise . GHC.unLoc) fileish_args
|
|
||||||
(srcs, objs) = partition_args normal_fileish_paths [] []
|
|
||||||
(hs_srcs, non_hs_srcs) = partition haskellish srcs
|
|
||||||
haskellish (f,Nothing) =
|
|
||||||
looksLikeModuleName f || isHaskellSrcFilename f || '.' `notElem` f
|
|
||||||
haskellish (_,Just phase) =
|
|
||||||
#if MIN_VERSION_ghc(8,0,0)
|
|
||||||
phase `notElem` [As True, As False, Cc, Cobjc, Cobjcxx, CmmCpp, Cmm, StopLn]
|
|
||||||
#elif MIN_VERSION_ghc(7,8,3)
|
|
||||||
phase `notElem` [As True, As False, Cc, Cobjc, Cobjcpp, CmmCpp, Cmm, StopLn]
|
|
||||||
#elif MIN_VERSION_ghc(7,4,0)
|
|
||||||
phase `notElem` [As, Cc, Cobjc, Cobjcpp, CmmCpp, Cmm, StopLn]
|
|
||||||
#else
|
|
||||||
phase `notElem` [As, Cc, CmmCpp, Cmm, StopLn]
|
|
||||||
#endif
|
|
||||||
hsc_env <- GHC.getSession
|
|
||||||
-- if (null hs_srcs)
|
|
||||||
-- then liftIO (oneShot hsc_env StopLn srcs)
|
|
||||||
-- else do
|
|
||||||
#if MIN_VERSION_ghc(7,2,0)
|
|
||||||
o_files <- mapM (\x -> liftIO $ compileFile hsc_env StopLn x)
|
|
||||||
#else
|
|
||||||
o_files <- mapM (\x -> compileFile hsc_env StopLn x)
|
|
||||||
#endif
|
|
||||||
non_hs_srcs
|
|
||||||
#if __GLASGOW_HASKELL__ >= 707
|
|
||||||
let dflags4 = dflags3
|
|
||||||
{ ldInputs = map (DF.FileOption "") (reverse o_files)
|
|
||||||
++ ldInputs dflags3
|
|
||||||
}
|
|
||||||
GHC.setSessionDynFlags dflags4
|
|
||||||
#else
|
|
||||||
liftIO $ mapM_ (consIORef v_Ld_inputs) (reverse o_files)
|
|
||||||
#endif
|
|
||||||
targets <- mapM (uncurry GHC.guessTarget) hs_srcs
|
|
||||||
GHC.setTargets targets
|
|
||||||
ok_flag <- GHC.load GHC.LoadAllTargets
|
|
||||||
if GHC.failed ok_flag
|
|
||||||
then return False
|
|
||||||
else liftIO (linkPkg ld ar) >> return True
|
|
||||||
|
|
||||||
linkPkg :: FilePath -> FilePath -> IO ()
|
|
||||||
linkPkg ld ar = do
|
|
||||||
arargs <- fmap read $ readFile "yesod-devel/arargs.txt"
|
|
||||||
rawSystem ar arargs
|
|
||||||
ldargs <- fmap read $ readFile "yesod-devel/ldargs.txt"
|
|
||||||
rawSystem ld ldargs
|
|
||||||
return ()
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------------------
|
|
||||||
-- stuff below copied from ghc main.hs
|
|
||||||
--------------------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
partition_args :: [String] -> [(String, Maybe Phase)] -> [String]
|
|
||||||
-> ([(String, Maybe Phase)], [String])
|
|
||||||
partition_args [] srcs objs = (reverse srcs, reverse objs)
|
|
||||||
partition_args ("-x":suff:args) srcs objs
|
|
||||||
| "none" <- suff = partition_args args srcs objs
|
|
||||||
| StopLn <- phase = partition_args args srcs (slurp ++ objs)
|
|
||||||
| otherwise = partition_args rest (these_srcs ++ srcs) objs
|
|
||||||
where phase = startPhase suff
|
|
||||||
(slurp,rest) = break (== "-x") args
|
|
||||||
these_srcs = zip slurp (repeat (Just phase))
|
|
||||||
partition_args (arg:args) srcs objs
|
|
||||||
| looks_like_an_input arg = partition_args args ((arg,Nothing):srcs) objs
|
|
||||||
| otherwise = partition_args args srcs (arg:objs)
|
|
||||||
|
|
||||||
{-
|
|
||||||
We split out the object files (.o, .dll) and add them
|
|
||||||
to v_Ld_inputs for use by the linker.
|
|
||||||
|
|
||||||
The following things should be considered compilation manager inputs:
|
|
||||||
|
|
||||||
- haskell source files (strings ending in .hs, .lhs or other
|
|
||||||
haskellish extension),
|
|
||||||
|
|
||||||
- module names (not forgetting hierarchical module names),
|
|
||||||
|
|
||||||
- and finally we consider everything not containing a '.' to be
|
|
||||||
a comp manager input, as shorthand for a .hs or .lhs filename.
|
|
||||||
|
|
||||||
Everything else is considered to be a linker object, and passed
|
|
||||||
straight through to the linker.
|
|
||||||
-}
|
|
||||||
looks_like_an_input :: String -> Bool
|
|
||||||
looks_like_an_input m = isSourceFilename m
|
|
||||||
|| looksLikeModuleName m
|
|
||||||
|| '.' `notElem` m
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- Parsing the mode flag
|
|
||||||
|
|
||||||
parseModeFlags :: [Located String]
|
|
||||||
-> IO (Mode,
|
|
||||||
[Located String],
|
|
||||||
[Located String])
|
|
||||||
parseModeFlags args = do
|
|
||||||
let ((leftover, errs1, warns), (mModeFlag, errs2, flags')) =
|
|
||||||
runCmdLine (processArgs mode_flags args)
|
|
||||||
(Nothing, [], [])
|
|
||||||
mode = case mModeFlag of
|
|
||||||
Nothing -> doMakeMode
|
|
||||||
Just (m, _) -> m
|
|
||||||
errs = errs1 ++ map (mkGeneralLocated "on the commandline") errs2
|
|
||||||
#if __GLASGOW_HASKELL__ >= 710
|
|
||||||
errorsToGhcException' = errorsToGhcException . map (\(GHC.L _ e) -> ("on the commandline", e))
|
|
||||||
#else
|
|
||||||
errorsToGhcException' = errorsToGhcException
|
|
||||||
#endif
|
|
||||||
|
|
||||||
when (not (null errs)) $ throwGhcException $ errorsToGhcException' errs
|
|
||||||
return (mode, flags' ++ leftover, warns)
|
|
||||||
|
|
||||||
type ModeM = CmdLineP (Maybe (Mode, String), [String], [Located String])
|
|
||||||
-- mode flags sometimes give rise to new DynFlags (eg. -C, see below)
|
|
||||||
-- so we collect the new ones and return them.
|
|
||||||
|
|
||||||
mode_flags :: [Flag ModeM]
|
|
||||||
mode_flags =
|
|
||||||
[ ------- help / version ----------------------------------------------
|
|
||||||
mkFlag "?" (PassFlag (setMode showGhcUsageMode))
|
|
||||||
, mkFlag "-help" (PassFlag (setMode showGhcUsageMode))
|
|
||||||
, mkFlag "V" (PassFlag (setMode showVersionMode))
|
|
||||||
, mkFlag "-version" (PassFlag (setMode showVersionMode))
|
|
||||||
, mkFlag "-numeric-version" (PassFlag (setMode showNumVersionMode))
|
|
||||||
, mkFlag "-info" (PassFlag (setMode showInfoMode))
|
|
||||||
, mkFlag "-supported-languages" (PassFlag (setMode showSupportedExtensionsMode))
|
|
||||||
, mkFlag "-supported-extensions" (PassFlag (setMode showSupportedExtensionsMode))
|
|
||||||
] ++
|
|
||||||
[ mkFlag k' (PassFlag (setMode (printSetting k)))
|
|
||||||
| k <- ["Project version",
|
|
||||||
"Booter version",
|
|
||||||
"Stage",
|
|
||||||
"Build platform",
|
|
||||||
"Host platform",
|
|
||||||
"Target platform",
|
|
||||||
"Have interpreter",
|
|
||||||
"Object splitting supported",
|
|
||||||
"Have native code generator",
|
|
||||||
"Support SMP",
|
|
||||||
"Unregisterised",
|
|
||||||
"Tables next to code",
|
|
||||||
"RTS ways",
|
|
||||||
"Leading underscore",
|
|
||||||
"Debug on",
|
|
||||||
"LibDir",
|
|
||||||
"Global Package DB",
|
|
||||||
"C compiler flags",
|
|
||||||
"Gcc Linker flags",
|
|
||||||
"Ld Linker flags"],
|
|
||||||
let k' = "-print-" ++ map (replaceSpace . toLower) k
|
|
||||||
replaceSpace ' ' = '-'
|
|
||||||
replaceSpace c = c
|
|
||||||
] ++
|
|
||||||
------- interfaces ----------------------------------------------------
|
|
||||||
[ mkFlag "-show-iface" (HasArg (\f -> setMode (showInterfaceMode f)
|
|
||||||
"--show-iface"))
|
|
||||||
|
|
||||||
------- primary modes ------------------------------------------------
|
|
||||||
, mkFlag "c" (PassFlag (\f -> do setMode (stopBeforeMode StopLn) f
|
|
||||||
addFlag "-no-link" f))
|
|
||||||
, mkFlag "M" (PassFlag (setMode doMkDependHSMode))
|
|
||||||
, mkFlag "E" (PassFlag (setMode (stopBeforeMode anyHsc)))
|
|
||||||
, mkFlag "C" (PassFlag (\f -> do setMode (stopBeforeMode HCc) f
|
|
||||||
addFlag "-fvia-C" f))
|
|
||||||
#if MIN_VERSION_ghc(7,8,3)
|
|
||||||
, mkFlag "S" (PassFlag (setMode (stopBeforeMode (As True))))
|
|
||||||
#else
|
|
||||||
, mkFlag "S" (PassFlag (setMode (stopBeforeMode As)))
|
|
||||||
#endif
|
|
||||||
, mkFlag "-make" (PassFlag (setMode doMakeMode))
|
|
||||||
, mkFlag "-interactive" (PassFlag (setMode doInteractiveMode))
|
|
||||||
, mkFlag "-abi-hash" (PassFlag (setMode doAbiHashMode))
|
|
||||||
, mkFlag "e" (SepArg (\s -> setMode (doEvalMode s) "-e"))
|
|
||||||
]
|
|
||||||
#if MIN_VERSION_ghc(7,10,1)
|
|
||||||
where mkFlag fName fOptKind = Flag fName fOptKind AllModes
|
|
||||||
#else
|
|
||||||
where mkFlag fName fOptKind = Flag fName fOptKind
|
|
||||||
#endif
|
|
||||||
|
|
||||||
setMode :: Mode -> String -> EwM ModeM ()
|
|
||||||
setMode newMode newFlag = liftEwM $ do
|
|
||||||
(mModeFlag, errs, flags') <- getCmdLineState
|
|
||||||
let (modeFlag', errs') =
|
|
||||||
case mModeFlag of
|
|
||||||
Nothing -> ((newMode, newFlag), errs)
|
|
||||||
Just (oldMode, oldFlag) ->
|
|
||||||
case (oldMode, newMode) of
|
|
||||||
-- -c/--make are allowed together, and mean --make -no-link
|
|
||||||
_ | isStopLnMode oldMode && isDoMakeMode newMode
|
|
||||||
|| isStopLnMode newMode && isDoMakeMode oldMode ->
|
|
||||||
((doMakeMode, "--make"), [])
|
|
||||||
|
|
||||||
-- If we have both --help and --interactive then we
|
|
||||||
-- want showGhciUsage
|
|
||||||
_ | isShowGhcUsageMode oldMode &&
|
|
||||||
isDoInteractiveMode newMode ->
|
|
||||||
((showGhciUsageMode, oldFlag), [])
|
|
||||||
| isShowGhcUsageMode newMode &&
|
|
||||||
isDoInteractiveMode oldMode ->
|
|
||||||
((showGhciUsageMode, newFlag), [])
|
|
||||||
-- Otherwise, --help/--version/--numeric-version always win
|
|
||||||
| isDominantFlag oldMode -> ((oldMode, oldFlag), [])
|
|
||||||
| isDominantFlag newMode -> ((newMode, newFlag), [])
|
|
||||||
-- We need to accumulate eval flags like "-e foo -e bar"
|
|
||||||
(Right (Right (DoEval esOld)),
|
|
||||||
Right (Right (DoEval [eNew]))) ->
|
|
||||||
((Right (Right (DoEval (eNew : esOld))), oldFlag),
|
|
||||||
errs)
|
|
||||||
-- Saying e.g. --interactive --interactive is OK
|
|
||||||
_ | oldFlag == newFlag -> ((oldMode, oldFlag), errs)
|
|
||||||
-- Otherwise, complain
|
|
||||||
_ -> let err = flagMismatchErr oldFlag newFlag
|
|
||||||
in ((oldMode, oldFlag), err : errs)
|
|
||||||
putCmdLineState (Just modeFlag', errs', flags')
|
|
||||||
where isDominantFlag f = isShowGhcUsageMode f ||
|
|
||||||
isShowGhciUsageMode f ||
|
|
||||||
isShowVersionMode f ||
|
|
||||||
isShowNumVersionMode f
|
|
||||||
|
|
||||||
flagMismatchErr :: String -> String -> String
|
|
||||||
flagMismatchErr oldFlag newFlag
|
|
||||||
= "cannot use `" ++ oldFlag ++ "' with `" ++ newFlag ++ "'"
|
|
||||||
|
|
||||||
addFlag :: String -> String -> EwM ModeM ()
|
|
||||||
addFlag s flag = liftEwM $ do
|
|
||||||
(m, e, flags') <- getCmdLineState
|
|
||||||
putCmdLineState (m, e, mkGeneralLocated loc s : flags')
|
|
||||||
where loc = "addFlag by " ++ flag ++ " on the commandline"
|
|
||||||
|
|
||||||
type Mode = Either PreStartupMode PostStartupMode
|
|
||||||
type PostStartupMode = Either PreLoadMode PostLoadMode
|
|
||||||
|
|
||||||
data PreStartupMode
|
|
||||||
= ShowVersion -- ghc -V/--version
|
|
||||||
| ShowNumVersion -- ghc --numeric-version
|
|
||||||
| ShowSupportedExtensions -- ghc --supported-extensions
|
|
||||||
| Print String -- ghc --print-foo
|
|
||||||
|
|
||||||
showVersionMode, showNumVersionMode, showSupportedExtensionsMode :: Mode
|
|
||||||
showVersionMode = mkPreStartupMode ShowVersion
|
|
||||||
showNumVersionMode = mkPreStartupMode ShowNumVersion
|
|
||||||
showSupportedExtensionsMode = mkPreStartupMode ShowSupportedExtensions
|
|
||||||
|
|
||||||
mkPreStartupMode :: PreStartupMode -> Mode
|
|
||||||
mkPreStartupMode = Left
|
|
||||||
|
|
||||||
isShowVersionMode :: Mode -> Bool
|
|
||||||
isShowVersionMode (Left ShowVersion) = True
|
|
||||||
isShowVersionMode _ = False
|
|
||||||
|
|
||||||
isShowNumVersionMode :: Mode -> Bool
|
|
||||||
isShowNumVersionMode (Left ShowNumVersion) = True
|
|
||||||
isShowNumVersionMode _ = False
|
|
||||||
|
|
||||||
data PreLoadMode
|
|
||||||
= ShowGhcUsage -- ghc -?
|
|
||||||
| ShowGhciUsage -- ghci -?
|
|
||||||
| ShowInfo -- ghc --info
|
|
||||||
| PrintWithDynFlags (DynFlags -> String) -- ghc --print-foo
|
|
||||||
|
|
||||||
showGhcUsageMode, showGhciUsageMode, showInfoMode :: Mode
|
|
||||||
showGhcUsageMode = mkPreLoadMode ShowGhcUsage
|
|
||||||
showGhciUsageMode = mkPreLoadMode ShowGhciUsage
|
|
||||||
showInfoMode = mkPreLoadMode ShowInfo
|
|
||||||
|
|
||||||
printSetting :: String -> Mode
|
|
||||||
printSetting k = mkPreLoadMode (PrintWithDynFlags f)
|
|
||||||
where f dflags = fromMaybe (panic ("Setting not found: " ++ show k))
|
|
||||||
#if MIN_VERSION_ghc(7,2,0)
|
|
||||||
$ lookup k (compilerInfo dflags)
|
|
||||||
#else
|
|
||||||
$ fmap convertPrintable (lookup k compilerInfo)
|
|
||||||
where
|
|
||||||
convertPrintable (DynFlags.String s) = s
|
|
||||||
convertPrintable (DynFlags.FromDynFlags f) = f dflags
|
|
||||||
#endif
|
|
||||||
|
|
||||||
mkPreLoadMode :: PreLoadMode -> Mode
|
|
||||||
mkPreLoadMode = Right . Left
|
|
||||||
|
|
||||||
isShowGhcUsageMode :: Mode -> Bool
|
|
||||||
isShowGhcUsageMode (Right (Left ShowGhcUsage)) = True
|
|
||||||
isShowGhcUsageMode _ = False
|
|
||||||
|
|
||||||
isShowGhciUsageMode :: Mode -> Bool
|
|
||||||
isShowGhciUsageMode (Right (Left ShowGhciUsage)) = True
|
|
||||||
isShowGhciUsageMode _ = False
|
|
||||||
|
|
||||||
data PostLoadMode
|
|
||||||
= ShowInterface FilePath -- ghc --show-iface
|
|
||||||
| DoMkDependHS -- ghc -M
|
|
||||||
| StopBefore Phase -- ghc -E | -C | -S
|
|
||||||
-- StopBefore StopLn is the default
|
|
||||||
| DoMake -- ghc --make
|
|
||||||
| DoInteractive -- ghc --interactive
|
|
||||||
| DoEval [String] -- ghc -e foo -e bar => DoEval ["bar", "foo"]
|
|
||||||
| DoAbiHash -- ghc --abi-hash
|
|
||||||
|
|
||||||
doMkDependHSMode, doMakeMode, doInteractiveMode, doAbiHashMode :: Mode
|
|
||||||
doMkDependHSMode = mkPostLoadMode DoMkDependHS
|
|
||||||
doMakeMode = mkPostLoadMode DoMake
|
|
||||||
doInteractiveMode = mkPostLoadMode DoInteractive
|
|
||||||
doAbiHashMode = mkPostLoadMode DoAbiHash
|
|
||||||
|
|
||||||
|
|
||||||
showInterfaceMode :: FilePath -> Mode
|
|
||||||
showInterfaceMode fp = mkPostLoadMode (ShowInterface fp)
|
|
||||||
|
|
||||||
stopBeforeMode :: Phase -> Mode
|
|
||||||
stopBeforeMode phase = mkPostLoadMode (StopBefore phase)
|
|
||||||
|
|
||||||
doEvalMode :: String -> Mode
|
|
||||||
doEvalMode str = mkPostLoadMode (DoEval [str])
|
|
||||||
|
|
||||||
mkPostLoadMode :: PostLoadMode -> Mode
|
|
||||||
mkPostLoadMode = Right . Right
|
|
||||||
|
|
||||||
isDoInteractiveMode :: Mode -> Bool
|
|
||||||
isDoInteractiveMode (Right (Right DoInteractive)) = True
|
|
||||||
isDoInteractiveMode _ = False
|
|
||||||
|
|
||||||
isStopLnMode :: Mode -> Bool
|
|
||||||
isStopLnMode (Right (Right (StopBefore StopLn))) = True
|
|
||||||
isStopLnMode _ = False
|
|
||||||
|
|
||||||
isDoMakeMode :: Mode -> Bool
|
|
||||||
isDoMakeMode (Right (Right DoMake)) = True
|
|
||||||
isDoMakeMode _ = False
|
|
||||||
|
|
||||||
#ifdef GHCI
|
|
||||||
isInteractiveMode :: PostLoadMode -> Bool
|
|
||||||
isInteractiveMode DoInteractive = True
|
|
||||||
isInteractiveMode _ = False
|
|
||||||
#endif
|
|
||||||
|
|
||||||
-- isInterpretiveMode: byte-code compiler involved
|
|
||||||
isInterpretiveMode :: PostLoadMode -> Bool
|
|
||||||
isInterpretiveMode DoInteractive = True
|
|
||||||
isInterpretiveMode (DoEval _) = True
|
|
||||||
isInterpretiveMode _ = False
|
|
||||||
|
|
||||||
needsInputsMode :: PostLoadMode -> Bool
|
|
||||||
needsInputsMode DoMkDependHS = True
|
|
||||||
needsInputsMode (StopBefore _) = True
|
|
||||||
needsInputsMode DoMake = True
|
|
||||||
needsInputsMode _ = False
|
|
||||||
|
|
||||||
-- True if we are going to attempt to link in this mode.
|
|
||||||
-- (we might not actually link, depending on the GhcLink flag)
|
|
||||||
isLinkMode :: PostLoadMode -> Bool
|
|
||||||
isLinkMode (StopBefore StopLn) = True
|
|
||||||
isLinkMode DoMake = True
|
|
||||||
isLinkMode DoInteractive = True
|
|
||||||
isLinkMode (DoEval _) = True
|
|
||||||
isLinkMode _ = False
|
|
||||||
|
|
||||||
isCompManagerMode :: PostLoadMode -> Bool
|
|
||||||
isCompManagerMode DoMake = True
|
|
||||||
isCompManagerMode DoInteractive = True
|
|
||||||
isCompManagerMode (DoEval _) = True
|
|
||||||
isCompManagerMode _ = False
|
|
||||||
@ -1,65 +0,0 @@
|
|||||||
{-
|
|
||||||
wrapper executable that captures arguments to ghc, ar or ld
|
|
||||||
-}
|
|
||||||
|
|
||||||
{-# LANGUAGE CPP #-}
|
|
||||||
module Main where
|
|
||||||
|
|
||||||
import Control.Monad (when)
|
|
||||||
import Data.Maybe (fromMaybe)
|
|
||||||
|
|
||||||
import Distribution.Compiler (CompilerFlavor (..))
|
|
||||||
import qualified Distribution.Simple.Configure as D
|
|
||||||
import Distribution.Simple.Program (arProgram,
|
|
||||||
defaultProgramConfiguration,
|
|
||||||
ghcProgram, ldProgram,
|
|
||||||
programPath)
|
|
||||||
import Distribution.Simple.Program.Db (configureAllKnownPrograms,
|
|
||||||
lookupProgram)
|
|
||||||
import Distribution.Simple.Program.Types (Program (..))
|
|
||||||
import Distribution.Verbosity (silent)
|
|
||||||
|
|
||||||
import System.Directory (doesDirectoryExist)
|
|
||||||
import System.Environment (getArgs)
|
|
||||||
import System.Exit (ExitCode (..), exitWith)
|
|
||||||
import System.IO (hPutStrLn, stderr)
|
|
||||||
import System.Process (rawSystem, readProcess)
|
|
||||||
|
|
||||||
|
|
||||||
#ifdef LDCMD
|
|
||||||
cmd :: Program
|
|
||||||
cmd = ldProgram
|
|
||||||
outFile = "yesod-devel/ldargs.txt"
|
|
||||||
#else
|
|
||||||
#ifdef ARCMD
|
|
||||||
cmd :: Program
|
|
||||||
cmd = arProgram
|
|
||||||
outFile ="yesod-devel/arargs.txt"
|
|
||||||
#else
|
|
||||||
cmd :: Program
|
|
||||||
cmd = ghcProgram
|
|
||||||
outFile = "yesod-devel/ghcargs.txt"
|
|
||||||
#endif
|
|
||||||
#endif
|
|
||||||
|
|
||||||
runProgram :: Program -> [String] -> IO ExitCode
|
|
||||||
runProgram pgm args = do
|
|
||||||
#if MIN_VERSION_Cabal(1,18,0)
|
|
||||||
(_, comp, pgmc) <- D.configCompilerEx (Just GHC) Nothing Nothing defaultProgramConfiguration silent
|
|
||||||
#else
|
|
||||||
(comp, pgmc) <- D.configCompiler (Just GHC) Nothing Nothing defaultProgramConfiguration silent
|
|
||||||
#endif
|
|
||||||
pgmc' <- configureAllKnownPrograms silent pgmc
|
|
||||||
case lookupProgram pgm pgmc' of
|
|
||||||
Nothing -> do
|
|
||||||
hPutStrLn stderr ("cannot find program '" ++ programName pgm ++ "'")
|
|
||||||
return (ExitFailure 1)
|
|
||||||
Just p -> rawSystem (programPath p) args
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = do
|
|
||||||
args <- getArgs
|
|
||||||
e <- doesDirectoryExist "yesod-devel"
|
|
||||||
when e $ writeFile outFile (show args ++ "\n")
|
|
||||||
ex <- runProgram cmd args
|
|
||||||
exitWith ex
|
|
||||||
@ -1,5 +1,6 @@
|
|||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
|
module Main (main) where
|
||||||
|
|
||||||
import Control.Monad (unless)
|
import Control.Monad (unless)
|
||||||
import Data.Monoid
|
import Data.Monoid
|
||||||
@ -7,11 +8,10 @@ import Data.Version (showVersion)
|
|||||||
import Options.Applicative
|
import Options.Applicative
|
||||||
import System.Environment (getEnvironment)
|
import System.Environment (getEnvironment)
|
||||||
import System.Exit (ExitCode (ExitSuccess), exitWith, exitFailure)
|
import System.Exit (ExitCode (ExitSuccess), exitWith, exitFailure)
|
||||||
import System.FilePath (splitSearchPath)
|
|
||||||
import System.Process (rawSystem)
|
import System.Process (rawSystem)
|
||||||
|
|
||||||
import AddHandler (addHandler)
|
import AddHandler (addHandler)
|
||||||
import Devel (DevelOpts (..), devel, DevelTermOpt(..))
|
import Devel (DevelOpts (..), devel, develSignal)
|
||||||
import Keter (keter)
|
import Keter (keter)
|
||||||
import Options (injectDefaults)
|
import Options (injectDefaults)
|
||||||
import qualified Paths_yesod_bin
|
import qualified Paths_yesod_bin
|
||||||
@ -48,19 +48,14 @@ data Command = Init [String]
|
|||||||
| Configure
|
| Configure
|
||||||
| Build { buildExtraArgs :: [String] }
|
| Build { buildExtraArgs :: [String] }
|
||||||
| Touch
|
| Touch
|
||||||
| Devel { _develDisableApi :: Bool
|
| Devel { develSuccessHook :: Maybe String
|
||||||
, _develSuccessHook :: Maybe String
|
|
||||||
, _develFailHook :: Maybe String
|
|
||||||
, _develRescan :: Int
|
|
||||||
, _develBuildDir :: Maybe String
|
|
||||||
, develIgnore :: [String]
|
|
||||||
, develExtraArgs :: [String]
|
, develExtraArgs :: [String]
|
||||||
, _develPort :: Int
|
, develPort :: Int
|
||||||
, _develTlsPort :: Int
|
, develTlsPort :: Int
|
||||||
, _proxyTimeout :: Int
|
, proxyTimeout :: Int
|
||||||
, _noReverseProxy :: Bool
|
, noReverseProxy :: Bool
|
||||||
, _interruptOnly :: Bool
|
|
||||||
}
|
}
|
||||||
|
| DevelSignal
|
||||||
| Test
|
| Test
|
||||||
| AddHandler
|
| AddHandler
|
||||||
{ addHandlerRoute :: Maybe String
|
{ addHandlerRoute :: Maybe String
|
||||||
@ -89,11 +84,6 @@ main = do
|
|||||||
d@Devel{} -> d { develExtraArgs = args }
|
d@Devel{} -> d { develExtraArgs = args }
|
||||||
c -> c
|
c -> c
|
||||||
})
|
})
|
||||||
, ("yesod.devel.ignore" , \o args -> o { optCommand =
|
|
||||||
case optCommand o of
|
|
||||||
d@Devel{} -> d { develIgnore = args }
|
|
||||||
c -> c
|
|
||||||
})
|
|
||||||
, ("yesod.build.extracabalarg" , \o args -> o { optCommand =
|
, ("yesod.build.extracabalarg" , \o args -> o { optCommand =
|
||||||
case optCommand o of
|
case optCommand o of
|
||||||
b@Build{} -> b { buildExtraArgs = args }
|
b@Build{} -> b { buildExtraArgs = args }
|
||||||
@ -111,25 +101,15 @@ main = do
|
|||||||
Version -> putStrLn ("yesod-bin version: " ++ showVersion Paths_yesod_bin.version)
|
Version -> putStrLn ("yesod-bin version: " ++ showVersion Paths_yesod_bin.version)
|
||||||
AddHandler{..} -> addHandler addHandlerRoute addHandlerPattern addHandlerMethods
|
AddHandler{..} -> addHandler addHandlerRoute addHandlerPattern addHandlerMethods
|
||||||
Test -> cabalTest cabal
|
Test -> cabalTest cabal
|
||||||
Devel{..} ->do
|
Devel{..} -> devel DevelOpts
|
||||||
(configOpts, menv) <- handleGhcPackagePath
|
{ verbose = optVerbose o
|
||||||
let develOpts = DevelOpts
|
, successHook = develSuccessHook
|
||||||
{ isCabalDev = optCabalPgm o == CabalDev
|
, develPort = develPort
|
||||||
, forceCabal = _develDisableApi
|
, develTlsPort = develTlsPort
|
||||||
, verbose = optVerbose o
|
, proxyTimeout = proxyTimeout
|
||||||
, eventTimeout = _develRescan
|
, useReverseProxy = not noReverseProxy
|
||||||
, successHook = _develSuccessHook
|
} develExtraArgs
|
||||||
, failHook = _develFailHook
|
DevelSignal -> develSignal
|
||||||
, buildDir = _develBuildDir
|
|
||||||
, develPort = _develPort
|
|
||||||
, develTlsPort = _develTlsPort
|
|
||||||
, proxyTimeout = _proxyTimeout
|
|
||||||
, useReverseProxy = not _noReverseProxy
|
|
||||||
, terminateWith = if _interruptOnly then TerminateOnlyInterrupt else TerminateOnEnter
|
|
||||||
, develConfigOpts = configOpts
|
|
||||||
, develEnv = menv
|
|
||||||
}
|
|
||||||
devel develOpts develExtraArgs
|
|
||||||
where
|
where
|
||||||
cabalTest cabal = do
|
cabalTest cabal = do
|
||||||
env <- getEnvironment
|
env <- getEnvironment
|
||||||
@ -154,19 +134,6 @@ main = do
|
|||||||
]
|
]
|
||||||
exitFailure
|
exitFailure
|
||||||
|
|
||||||
|
|
||||||
handleGhcPackagePath :: IO ([String], Maybe [(String, String)])
|
|
||||||
handleGhcPackagePath = do
|
|
||||||
env <- getEnvironment
|
|
||||||
case lookup "GHC_PACKAGE_PATH" env of
|
|
||||||
Nothing -> return ([], Nothing)
|
|
||||||
Just gpp -> do
|
|
||||||
let opts = "--package-db=clear"
|
|
||||||
: "--package-db=global"
|
|
||||||
: map ("--package-db=" ++)
|
|
||||||
(drop 1 $ reverse $ splitSearchPath gpp)
|
|
||||||
return (opts, Just $ filter (\(x, _) -> x /= "GHC_PACKAGE_PATH") env)
|
|
||||||
|
|
||||||
optParser' :: ParserInfo Options
|
optParser' :: ParserInfo Options
|
||||||
optParser' = info (helper <*> optParser) ( fullDesc <> header "Yesod Web Framework command line utility" )
|
optParser' = info (helper <*> optParser) ( fullDesc <> header "Yesod Web Framework command line utility" )
|
||||||
|
|
||||||
@ -186,6 +153,8 @@ optParser = Options
|
|||||||
(progDesc $ "Touch any files with altered TH dependencies but do not build" ++ windowsWarning))
|
(progDesc $ "Touch any files with altered TH dependencies but do not build" ++ windowsWarning))
|
||||||
<> command "devel" (info (helper <*> develOptions)
|
<> command "devel" (info (helper <*> develOptions)
|
||||||
(progDesc "Run project with the devel server"))
|
(progDesc "Run project with the devel server"))
|
||||||
|
<> command "devel-signal" (info (helper <*> pure DevelSignal)
|
||||||
|
(progDesc "Used internally by the devel command"))
|
||||||
<> command "test" (info (pure Test)
|
<> command "test" (info (pure Test)
|
||||||
(progDesc "Build and run the integration tests"))
|
(progDesc "Build and run the integration tests"))
|
||||||
<> command "add-handler" (info (helper <*> addHandlerOptions)
|
<> command "add-handler" (info (helper <*> addHandlerOptions)
|
||||||
@ -208,25 +177,9 @@ keterOptions = Keter
|
|||||||
where
|
where
|
||||||
optStrToList m = option (words <$> str) $ value [] <> m
|
optStrToList m = option (words <$> str) $ value [] <> m
|
||||||
|
|
||||||
defaultRescan :: Int
|
|
||||||
defaultRescan = 10
|
|
||||||
|
|
||||||
develOptions :: Parser Command
|
develOptions :: Parser Command
|
||||||
develOptions = Devel <$> switch ( long "disable-api" <> short 'd'
|
develOptions = Devel <$> optStr ( long "success-hook" <> short 's' <> metavar "COMMAND"
|
||||||
<> help "Disable fast GHC API rebuilding")
|
|
||||||
<*> optStr ( long "success-hook" <> short 's' <> metavar "COMMAND"
|
|
||||||
<> help "Run COMMAND after rebuild succeeds")
|
<> help "Run COMMAND after rebuild succeeds")
|
||||||
<*> optStr ( long "failure-hook" <> short 'f' <> metavar "COMMAND"
|
|
||||||
<> help "Run COMMAND when rebuild fails")
|
|
||||||
<*> option auto ( long "event-timeout" <> short 't' <> value defaultRescan <> metavar "N"
|
|
||||||
<> help ("Force rescan of files every N seconds (default "
|
|
||||||
++ show defaultRescan
|
|
||||||
++ ", use -1 to rely on FSNotify alone)") )
|
|
||||||
<*> optStr ( long "builddir" <> short 'b'
|
|
||||||
<> help "Set custom cabal build directory, default `dist'")
|
|
||||||
<*> many ( strOption ( long "ignore" <> short 'i' <> metavar "DIR"
|
|
||||||
<> help "ignore file changes in DIR" )
|
|
||||||
)
|
|
||||||
<*> extraCabalArgs
|
<*> extraCabalArgs
|
||||||
<*> option auto ( long "port" <> short 'p' <> value 3000 <> metavar "N"
|
<*> option auto ( long "port" <> short 'p' <> value 3000 <> metavar "N"
|
||||||
<> help "Devel server listening port" )
|
<> help "Devel server listening port" )
|
||||||
@ -236,8 +189,6 @@ develOptions = Devel <$> switch ( long "disable-api" <> short 'd'
|
|||||||
<> help "Devel server timeout before returning 'not ready' message (in seconds, 0 for none)" )
|
<> help "Devel server timeout before returning 'not ready' message (in seconds, 0 for none)" )
|
||||||
<*> switch ( long "disable-reverse-proxy" <> short 'n'
|
<*> switch ( long "disable-reverse-proxy" <> short 'n'
|
||||||
<> help "Disable reverse proxy" )
|
<> help "Disable reverse proxy" )
|
||||||
<*> switch ( long "interrupt-only" <> short 'c'
|
|
||||||
<> help "Disable exiting when enter is pressed")
|
|
||||||
|
|
||||||
extraCabalArgs :: Parser [String]
|
extraCabalArgs :: Parser [String]
|
||||||
extraCabalArgs = many (strOption ( long "extra-cabal-arg" <> short 'e' <> metavar "ARG"
|
extraCabalArgs = many (strOption ( long "extra-cabal-arg" <> short 'e' <> metavar "ARG"
|
||||||
|
|||||||
@ -1,5 +1,5 @@
|
|||||||
name: yesod-bin
|
name: yesod-bin
|
||||||
version: 1.4.18.7
|
version: 1.5.0
|
||||||
license: MIT
|
license: MIT
|
||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
author: Michael Snoyman <michael@snoyman.com>
|
author: Michael Snoyman <michael@snoyman.com>
|
||||||
@ -17,26 +17,6 @@ extra-source-files:
|
|||||||
ChangeLog.md
|
ChangeLog.md
|
||||||
*.pem
|
*.pem
|
||||||
|
|
||||||
executable yesod-ghc-wrapper
|
|
||||||
main-is: ghcwrapper.hs
|
|
||||||
build-depends:
|
|
||||||
base >= 4 && < 5
|
|
||||||
, Cabal
|
|
||||||
|
|
||||||
executable yesod-ld-wrapper
|
|
||||||
main-is: ghcwrapper.hs
|
|
||||||
cpp-options: -DLDCMD
|
|
||||||
build-depends:
|
|
||||||
base >= 4 && < 5
|
|
||||||
, Cabal
|
|
||||||
|
|
||||||
executable yesod-ar-wrapper
|
|
||||||
main-is: ghcwrapper.hs
|
|
||||||
cpp-options: -DARCMD
|
|
||||||
build-depends:
|
|
||||||
base >= 4 && < 5
|
|
||||||
, Cabal
|
|
||||||
|
|
||||||
executable yesod
|
executable yesod
|
||||||
if os(windows)
|
if os(windows)
|
||||||
cpp-options: -DWINDOWS
|
cpp-options: -DWINDOWS
|
||||||
@ -44,8 +24,6 @@ executable yesod
|
|||||||
ld-options: -Wl,-zwxneeded
|
ld-options: -Wl,-zwxneeded
|
||||||
|
|
||||||
build-depends: base >= 4.3 && < 5
|
build-depends: base >= 4.3 && < 5
|
||||||
, ghc >= 7.0.3
|
|
||||||
, ghc-paths >= 0.1
|
|
||||||
, parsec >= 2.1 && < 4
|
, parsec >= 2.1 && < 4
|
||||||
, text >= 0.11
|
, text >= 0.11
|
||||||
, shakespeare >= 2.0
|
, shakespeare >= 2.0
|
||||||
@ -53,7 +31,7 @@ executable yesod
|
|||||||
, time >= 1.1.4
|
, time >= 1.1.4
|
||||||
, template-haskell
|
, template-haskell
|
||||||
, directory >= 1.2.1
|
, directory >= 1.2.1
|
||||||
, Cabal
|
, Cabal >= 1.20
|
||||||
, unix-compat >= 0.2 && < 0.5
|
, unix-compat >= 0.2 && < 0.5
|
||||||
, containers >= 0.2
|
, containers >= 0.2
|
||||||
, attoparsec >= 0.10
|
, attoparsec >= 0.10
|
||||||
@ -75,10 +53,13 @@ executable yesod
|
|||||||
, base64-bytestring
|
, base64-bytestring
|
||||||
, lifted-base
|
, lifted-base
|
||||||
, http-reverse-proxy >= 0.4
|
, http-reverse-proxy >= 0.4
|
||||||
, network
|
, network >= 2.5
|
||||||
, http-conduit >= 2.1.4
|
, http-client-tls
|
||||||
, http-client
|
, http-client >= 0.4.7
|
||||||
, project-template >= 0.1.1
|
, project-template >= 0.1.1
|
||||||
|
, safe-exceptions
|
||||||
|
, say
|
||||||
|
, stm
|
||||||
, transformers
|
, transformers
|
||||||
, transformers-compat
|
, transformers-compat
|
||||||
, warp >= 1.3.7.5
|
, warp >= 1.3.7.5
|
||||||
@ -89,12 +70,12 @@ executable yesod
|
|||||||
, warp-tls >= 3.0.1
|
, warp-tls >= 3.0.1
|
||||||
, async
|
, async
|
||||||
, deepseq
|
, deepseq
|
||||||
|
, typed-process
|
||||||
|
|
||||||
ghc-options: -Wall -threaded -rtsopts
|
ghc-options: -Wall -threaded -rtsopts
|
||||||
main-is: main.hs
|
main-is: main.hs
|
||||||
other-modules: Devel
|
other-modules: Devel
|
||||||
Build
|
Build
|
||||||
GhcBuild
|
|
||||||
Keter
|
Keter
|
||||||
AddHandler
|
AddHandler
|
||||||
Paths_yesod_bin
|
Paths_yesod_bin
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user