haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Allow devel.hs in subdirs

Browse Source
This commit is contained in:
Michael Snoyman 2014-11-19 21:11:49 +02:00
parent d7bf7a1215
commit fb42a6d4bb
3 changed files with 23 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
yesod-bin/ChangeLog.md
View File

@ -1,3 +1,5 @@
__1.4.0.9__ Allow devel.hs to be located in app/ or src/ subdirectories.
__1.4.0.8__ Updated postgres-fay scaffolding for yesod-fay 0.7.0 __1.4.0.8__ Updated postgres-fay scaffolding for yesod-fay 0.7.0
__1.4.0.7__ Fix a bug in `yesod devel` when cabal config has `tests: True` #864 __1.4.0.7__ Fix a bug in `yesod devel` when cabal config has `tests: True` #864

32
yesod-bin/Devel.hs
View File

@ -188,7 +188,7 @@ devel opts passThroughArgs = withSocketsDo $ withManager $ \manager -> do
unlessM (checkPort $ develPort opts) $ error "devel port unavailable" unlessM (checkPort $ develPort opts) $ error "devel port unavailable"
iappPort <- getPort opts 17834 >>= I.newIORef iappPort <- getPort opts 17834 >>= I.newIORef
when (useReverseProxy opts) $ void $ forkIO $ reverseProxy opts iappPort when (useReverseProxy opts) $ void $ forkIO $ reverseProxy opts iappPort
checkDevelFile develHsPath <- checkDevelFile
writeLock opts writeLock opts
let (terminator, after) = case terminateWith opts of let (terminator, after) = case terminateWith opts of
@ -203,7 +203,7 @@ devel opts passThroughArgs = withSocketsDo $ withManager $ \manager -> do
filesModified <- newEmptyMVar filesModified <- newEmptyMVar
void $ forkIO $ void $ forkIO $
void $ watchTree manager "." (const True) (\_ -> void (tryPutMVar filesModified ())) void $ watchTree manager "." (const True) (\_ -> void (tryPutMVar filesModified ()))
evalStateT (mainOuterLoop iappPort filesModified) Map.empty evalStateT (mainOuterLoop develHsPath iappPort filesModified) Map.empty
after after
writeLock opts writeLock opts
exitSuccess exitSuccess
@ -211,7 +211,7 @@ devel opts passThroughArgs = withSocketsDo $ withManager $ \manager -> do
bd = getBuildDir opts bd = getBuildDir opts
-- outer loop re-reads the cabal file -- outer loop re-reads the cabal file
mainOuterLoop iappPort filesModified = do mainOuterLoop develHsPath iappPort filesModified = do
ghcVer <- liftIO ghcVersion ghcVer <- liftIO ghcVersion
cabal <- liftIO $ D.findPackageDesc "." cabal <- liftIO $ D.findPackageDesc "."
gpd <- liftIO $ D.readPackageDescription D.normal cabal gpd <- liftIO $ D.readPackageDescription D.normal cabal
@ -227,20 +227,20 @@ devel opts passThroughArgs = withSocketsDo $ withManager $ \manager -> do
, "yesod-devel/ldargs.txt" , "yesod-devel/ldargs.txt"
] ]
rebuild <- liftIO $ mkRebuild ghcVer cabal opts ldar rebuild <- liftIO $ mkRebuild ghcVer cabal opts ldar
mainInnerLoop iappPort hsSourceDirs filesModified cabal rebuild mainInnerLoop develHsPath iappPort hsSourceDirs filesModified cabal rebuild
else do else do
liftIO (threadDelay 5000000) liftIO (threadDelay 5000000)
mainOuterLoop iappPort filesModified mainOuterLoop develHsPath iappPort filesModified
-- inner loop rebuilds after files change -- inner loop rebuilds after files change
mainInnerLoop iappPort hsSourceDirs filesModified cabal rebuild = go mainInnerLoop develHsPath iappPort hsSourceDirs filesModified cabal rebuild = go
where where
go = do go = do
_ <- recompDeps hsSourceDirs _ <- recompDeps hsSourceDirs
list <- liftIO $ getFileList hsSourceDirs [cabal] list <- liftIO $ getFileList hsSourceDirs [cabal]
success <- liftIO rebuild success <- liftIO rebuild
pkgArgs <- liftIO (ghcPackageArgs opts) pkgArgs <- liftIO (ghcPackageArgs opts)
let devArgs = pkgArgs ++ ["devel.hs"] let devArgs = pkgArgs ++ [develHsPath]
let loop list0 = do let loop list0 = do
(haskellFileChanged, list1) <- liftIO $ (haskellFileChanged, list1) <- liftIO $
watchForChanges filesModified hsSourceDirs [cabal] list0 (eventTimeout opts) watchForChanges filesModified hsSourceDirs [cabal] list0 (eventTimeout opts)
@ -282,7 +282,7 @@ devel opts passThroughArgs = withSocketsDo $ withManager $ \manager -> do
liftIO $ Ex.throwTo watchTid (userError "process finished") liftIO $ Ex.throwTo watchTid (userError "process finished")
loop list loop list
n <- liftIO $ cabal `isNewerThan` (bd </> "setup-config") n <- liftIO $ cabal `isNewerThan` (bd </> "setup-config")
if n then mainOuterLoop iappPort filesModified else go if n then mainOuterLoop develHsPath iappPort filesModified else go
runBuildHook :: Maybe String -> IO () runBuildHook :: Maybe String -> IO ()
runBuildHook (Just s) = do runBuildHook (Just s) = do
@ -381,10 +381,18 @@ watchForChanges filesModified hsSourceDirs extraFiles list t = do
isHaskell filename _ = takeExtension filename `elem` [".hs", ".lhs", ".hsc", ".cabal"] isHaskell filename _ = takeExtension filename `elem` [".hs", ".lhs", ".hsc", ".cabal"]
checkDevelFile :: IO () checkDevelFile :: IO FilePath
checkDevelFile = do checkDevelFile =
e <- doesFileExist "devel.hs" loop paths
unless e $ failWith "file devel.hs not found" where
paths = ["app/devel.hs", "devel.hs", "src/devel.hs"]
loop [] = failWith $ "file devel.hs not found, checked: " ++ show paths
loop (x:xs) = do
e <- doesFileExist x
if e
then return x
else loop xs
checkCabalFile :: D.GenericPackageDescription -> IO ([FilePath], D.Library) checkCabalFile :: D.GenericPackageDescription -> IO ([FilePath], D.Library)
checkCabalFile gpd = case D.condLibrary gpd of checkCabalFile gpd = case D.condLibrary gpd of

2
yesod-bin/yesod-bin.cabal
View File

@ -1,5 +1,5 @@
name: yesod-bin name: yesod-bin
version: 1.4.0.8 version: 1.4.0.9
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>