yesod devel: hide "Loading package" messages
This commit is contained in:
parent
c3f58479f9
commit
c00aa5971b
@ -27,7 +27,8 @@ import System.FilePath (splitDirectories, dropExtension, takeExtension
|
|||||||
import System.Posix.Types (EpochTime)
|
import System.Posix.Types (EpochTime)
|
||||||
import System.PosixCompat.Files (modificationTime, getFileStatus)
|
import System.PosixCompat.Files (modificationTime, getFileStatus)
|
||||||
import System.Process (createProcess, proc, terminateProcess, readProcess,
|
import System.Process (createProcess, proc, terminateProcess, readProcess,
|
||||||
waitForProcess, rawSystem)
|
waitForProcess, rawSystem, runInteractiveProcess)
|
||||||
|
import System.IO (hClose, hIsEOF, hGetLine)
|
||||||
|
|
||||||
import Build (recompDeps, getDeps)
|
import Build (recompDeps, getDeps)
|
||||||
|
|
||||||
@ -78,7 +79,7 @@ devel isCabalDev passThroughArgs = do
|
|||||||
mainLoop :: [FilePath] -> IO ()
|
mainLoop :: [FilePath] -> IO ()
|
||||||
mainLoop hsSourceDirs = do
|
mainLoop hsSourceDirs = do
|
||||||
ghcVer <- ghcVersion
|
ghcVer <- ghcVersion
|
||||||
when isCabalDev (rawSystem cmd ["build"] >> return ()) -- cabal-dev fails with strange errors sometimes if we cabal-dev buildinfo before cabal-dev build
|
when isCabalDev (rawSystemFilter cmd ["build"] >> return ()) -- cabal-dev fails with strange errors sometimes if we cabal-dev buildinfo before cabal-dev build
|
||||||
pkgArgs <- ghcPackageArgs isCabalDev ghcVer
|
pkgArgs <- ghcPackageArgs isCabalDev ghcVer
|
||||||
let devArgs = pkgArgs ++ ["devel.hs"] ++ passThroughArgs
|
let devArgs = pkgArgs ++ ["devel.hs"] ++ passThroughArgs
|
||||||
forever $ do
|
forever $ do
|
||||||
@ -87,7 +88,7 @@ devel isCabalDev passThroughArgs = do
|
|||||||
recompDeps hsSourceDirs
|
recompDeps hsSourceDirs
|
||||||
|
|
||||||
list <- getFileList hsSourceDirs
|
list <- getFileList hsSourceDirs
|
||||||
exit <- rawSystem cmd ["build"]
|
exit <- rawSystemFilter cmd ["build"]
|
||||||
|
|
||||||
case exit of
|
case exit of
|
||||||
ExitFailure _ -> putStrLn "Build failure, pausing..."
|
ExitFailure _ -> putStrLn "Build failure, pausing..."
|
||||||
@ -204,6 +205,19 @@ lookupDevelLib ct | found = Just (D.condTreeData ct)
|
|||||||
isDevelLib (D.Var (D.Flag (D.FlagName f)), _, _) = f `elem` ["library-only", "devel"]
|
isDevelLib (D.Var (D.Flag (D.FlagName f)), _, _) = f `elem` ["library-only", "devel"]
|
||||||
isDevelLib _ = False
|
isDevelLib _ = False
|
||||||
|
|
||||||
|
-- | Acts like @rawSystem@, but filters out lines from the output that we're not interested in seeing.
|
||||||
|
rawSystemFilter :: String -> [String] -> IO ExitCode
|
||||||
|
rawSystemFilter command args = do
|
||||||
|
(inh, outh, errh, ph) <- runInteractiveProcess command args Nothing Nothing
|
||||||
|
hClose inh
|
||||||
|
hClose errh
|
||||||
|
let go = do
|
||||||
|
isEof <- hIsEOF outh
|
||||||
|
if isEof
|
||||||
|
then hClose outh
|
||||||
|
else do
|
||||||
|
line <- hGetLine outh
|
||||||
|
unless ("Loading package " `L.isPrefixOf` line) $ putStrLn line
|
||||||
|
go
|
||||||
|
forkIO go
|
||||||
|
waitForProcess ph
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user