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

Add nice refreshing page.

Browse Source
This commit is contained in:
Chris Done 2013-07-16 07:00:07 +02:00
parent 444ee7aadb
commit 39b031f35e
3 changed files with 80 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
yesod-bin/Devel.hs
View File

@ -7,6 +7,7 @@ module Devel
, defaultDevelOpts , defaultDevelOpts
) where ) where
import Paths_yesod_bin
import qualified Distribution.Compiler as D import qualified Distribution.Compiler as D
import qualified Distribution.ModuleName as D import qualified Distribution.ModuleName as D
@ -28,6 +29,7 @@ import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.State (evalStateT, get) import Control.Monad.Trans.State (evalStateT, get)
import qualified Data.IORef as I import qualified Data.IORef as I
import qualified Data.ByteString.Lazy as LB
import Data.Char (isNumber, isUpper) import Data.Char (isNumber, isUpper)
import qualified Data.List as L import qualified Data.List as L
import qualified Data.Map as Map import qualified Data.Map as Map
@ -144,12 +146,15 @@ reverseProxy opts iappPort = do
putStrLn "Restarting reverse proxy" putStrLn "Restarting reverse proxy"
loop `Ex.onException` exitFailure loop `Ex.onException` exitFailure
where where
onExc _ _ = return $ responseLBS onExc _ _ = do
refreshing <- liftIO $ getDataFileName "refreshing.html"
html <- liftIO $ LB.readFile refreshing
return $ responseLBS
status200 status200
[ ("content-type", "text/html") [ ("content-type", "text/html")
, ("Refresh", "1") , ("Refresh", "1")
] ]
"<h1>App not ready, please refresh</h1>" html
checkPort :: Int -> IO Bool checkPort :: Int -> IO Bool
checkPort p = do checkPort p = do
@ -444,4 +449,3 @@ waitForProcess' pid = go
-- | wait for process started by @createProcess@, return True for ExitSuccess -- | wait for process started by @createProcess@, return True for ExitSuccess
checkExit :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO Bool checkExit :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO Bool
checkExit (_,_,_,h) = (==ExitSuccess) <$> waitForProcess' h checkExit (_,_,_,h) = (==ExitSuccess) <$> waitForProcess' h

72
yesod-bin/refreshing.html Normal file
View File

@ -0,0 +1,72 @@
<!doctype html>
<html>
<head>
<meta charset='utf-8'>
<title>Refreshing - Yesod devel</title>
<style>
body {
background: #e6e6e6;
color: #444;
text-shadow: 1px 1px 1px #ffffff;
font-size: 30px;
font-family: georgia, serif;
}
.wrap {
margin: auto;
width: 25em;
}
h1 {
margin-bottom: 0;
}
h2 {
margin-top: 0;
font-size: 1em;
font-style: italic;
color: #546369;
}
header {
margin-top: 1em;
padding-bottom: 0.25em;
border-bottom: 1px solid #ccc;
color: #1a6e8e;
}
footer {
margin-top: 3em;
padding-top: 0.25em;
border-top: 1px solid #ccc;
color: #666;
font-size: 0.8em;
}
.msgs {
font-size: 0.9em;
}
.msgs p {
margin-bottom: 0.5em;
}
.msgs ul {
margin-top: 0;
line-height: 1.7em;
}
.msgs li {
padding-left: 0.5em;
}
</style>
</head>
<body>
<div class="wrap">
<header><small>Yesod Devel</small></header>
<h1>The application isn’t built</h1>
<h2>We’ll keep trying to refresh every second</h2>
<div class="msgs">
<p>Meanwhile, here are some motivational messages:</p>
<ul>
<li>You are a beautiful person making a beautiful web site.</li>
<li>Keep going, you’ve nearly fixed the bug!</li>
<li>Check your posture, don’t lean over too much.</li>
<li>Get a glass of water, keep hydrated.</li>
</ul>
</div>
<footer><small><script>document.write(new Date())</script></small></footer>
</div>
</body>
</html>

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

@ -11,6 +11,7 @@ stability: Stable
cabal-version: >= 1.6 cabal-version: >= 1.6
build-type: Simple build-type: Simple
homepage: http://www.yesodweb.com/ homepage: http://www.yesodweb.com/
data-files: refreshing.html
extra-source-files: extra-source-files:
input/*.cg input/*.cg