Merge remote-tracking branch 'origin/master'

Conflicts:
	yesod-default/yesod-default.cabal
This commit is contained in:
Michael Snoyman 2011-09-23 08:40:37 +03:00
commit c9bb4fe622
10 changed files with 78 additions and 149 deletions

@ -1 +1 @@
Subproject commit e791ced0395245e30d37b5098a27bba5e818ecb7
Subproject commit 2fc59a850bdc49e01f7a5e062b813df321ce5c78

View File

@ -30,16 +30,16 @@ g = undefined
nonceSpecs :: [Spec]
nonceSpecs = describe "Yesod.Internal.Request.parseWaiRequest (reqNonce)"
[ it "is Nothing for unsecure sessions" noUnsecureNonce
, it "ignores pre-existing nonce for unsecure sessions" ignoreUnsecureNonce
, it "uses preexisting nonce for secure sessions" useOldNonce
, it "generates a new nonce for secure sessions without nonce" generateNonce
[ it "is Nothing if sessions are disabled" noDisabledNonce
, it "ignores pre-existing nonce if sessions are disabled" ignoreDisabledNonce
, it "uses preexisting nonce in session" useOldNonce
, it "generates a new nonce for sessions without nonce" generateNonce
]
noUnsecureNonce = reqNonce r == Nothing where
noDisabledNonce = reqNonce r == Nothing where
r = parseWaiRequest' defaultRequest [] Nothing g
ignoreUnsecureNonce = reqNonce r == Nothing where
ignoreDisabledNonce = reqNonce r == Nothing where
r = parseWaiRequest' defaultRequest [("_NONCE", "old")] Nothing g
useOldNonce = reqNonce r == Just "old" where

View File

@ -1,16 +1,25 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Yesod.Default.Main
( defaultMain
, defaultRunner
, defaultDevelApp
, defaultDevelAppWith
) where
import Yesod.Core
import Yesod.Default.Config
import Yesod.Logger (Logger, makeLogger, logString, logLazyText, flushLogger)
import Network.Wai (Application)
import Network.Wai.Handler.Warp (run)
import Network.Wai.Middleware.Debug (debugHandle)
#ifndef WINDOWS
import qualified System.Posix.Signals as Signal
import Control.Concurrent (forkIO, killThread)
import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
#endif
-- | Run your app, taking environment and port settings from the
-- commandline.
--
@ -31,6 +40,35 @@ defaultMain load withSite = do
logger <- makeLogger
withSite config logger $ run (appPort config)
-- | Run your application continously, listening for SIGINT and exiting
-- when recieved
--
-- > withYourSite :: AppConfig DefaultEnv -> Logger -> (Application -> IO a) -> IO ()
-- > withYourSite conf logger f = do
-- > Settings.withConnectionPool conf $ \p -> do
-- > runConnectionPool (runMigration yourMigration) p
-- > defaultRunner f $ YourSite conf logger p
--
-- TODO: ifdef WINDOWS
--
defaultRunner :: (YesodDispatch y y, Yesod y)
=> (Application -> IO a)
-> y -- ^ your foundation type
-> IO ()
defaultRunner f h =
#ifdef WINDOWS
toWaiApp h >>= f >> return ()
#else
do
tid <- forkIO $ toWaiApp h >>= f >> return ()
flag <- newEmptyMVar
_ <- Signal.installHandler Signal.sigINT (Signal.CatchOnce $ do
putStrLn "Caught an interrupt"
killThread tid
putMVar flag ()) Nothing
takeMVar flag
#endif
-- | Run your development app using the provided @'DefaultEnv'@ type
--
-- > withDevelAppPort :: Dynamic

View File

@ -7,7 +7,6 @@ module Yesod.Default.Util
, globFile
, widgetFileProduction
, widgetFileDebug
, runWaiApp
) where
import Control.Monad.IO.Class (liftIO)
@ -21,13 +20,6 @@ import Text.Lucius (luciusFile, luciusFileDebug)
import Text.Julius (juliusFile, juliusFileDebug)
import Text.Cassius (cassiusFile, cassiusFileDebug)
import Data.Monoid (mempty)
import Network.Wai (Application)
#ifndef WINDOWS
import qualified System.Posix.Signals as Signal
import Control.Concurrent (forkIO, killThread)
import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
#endif
-- | An implementation of 'addStaticContent' which stores the contents in an
-- external file. Files are created in the given static folder with names based
@ -85,21 +77,3 @@ whenExists x glob f = do
let fn = globFile glob x
e <- qRunIO $ doesFileExist fn
if e then f fn else [|mempty|]
-- | A signal-aware runner for WAI applications. On Windows, this doesn't do
-- anything special. On POSIX systems, this installs a signal handler for INT
-- and automatically kills the application when the signal is received. This
-- allows you to add cleanup code (like log flushing) after an application
-- exits.
runWaiApp :: (Application -> IO ()) -> Application -> IO ()
#ifdef WINDOWS
runWaiApp f app = f app
#else
runWaiApp f app = do
tid <- forkIO $ f app >> return ()
flag <- newEmptyMVar
_ <- Signal.installHandler Signal.sigINT (Signal.CatchOnce $ do
killThread tid
putMVar flag ()) Nothing
takeMVar flag
#endif

View File

@ -14,24 +14,25 @@ description: Convenient wrappers for your the configuration and
execution of your yesod application
library
build-depends: base >= 4 && < 5
, yesod-core >= 0.9 && < 0.10
, cmdargs >= 0.8 && < 0.9
, warp >= 0.4 && < 0.5
, wai >= 0.4 && < 0.5
, wai-extra >= 0.4 && < 0.5
, bytestring >= 0.9 && < 0.10
, transformers >= 0.2 && < 0.3
, text >= 0.9 && < 1.0
, directory >= 1.0 && < 1.2
if os(windows)
cpp-options: -DWINDOWS
build-depends: base >= 4 && < 5
, yesod-core >= 0.9 && < 0.10
, cmdargs >= 0.8 && < 0.9
, warp >= 0.4 && < 0.5
, wai >= 0.4 && < 0.5
, wai-extra >= 0.4 && < 0.5
, bytestring >= 0.9 && < 0.10
, transformers >= 0.2 && < 0.3
, text >= 0.9 && < 1.0
, directory >= 1.0 && < 1.2
, shakespeare-css >= 0.10 && < 0.11
, shakespeare-js >= 0.10 && < 0.11
, template-haskell
if os(windows)
cpp-options: -DWINDOWS
else
build-depends: unix
if !os(windows)
build-depends: unix
exposed-modules: Yesod.Default.Config
, Yesod.Default.Main

View File

@ -14,7 +14,6 @@ import Yesod.Static
import Yesod.Auth
import Yesod.Default.Config
import Yesod.Default.Main
import Yesod.Default.Util (runWaiApp)
import Yesod.Logger (Logger)
import Database.Persist.~importGenericDB~
import Data.ByteString (ByteString)
@ -49,8 +48,7 @@ with~sitearg~ conf logger f = do
#endif
Settings.withConnectionPool conf $ \p -> do~runMigration~
let h = ~sitearg~ conf logger s p
app <- toWaiApp h
runWaiApp f app
defaultRunner f h
-- for yesod devel
withDevelAppPort :: Dynamic

View File

@ -12,8 +12,7 @@ import Foundation
import Settings
import Yesod.Static
import Yesod.Default.Config
import Yesod.Default.Main (defaultDevelApp)
import Yesod.Default.Util (runWaiApp)
import Yesod.Default.Main (defaultDevelApp, defaultRunner)
import Yesod.Logger (Logger)
import Data.ByteString (ByteString)
import Network.Wai (Application)
@ -47,8 +46,7 @@ with~sitearg~ conf logger f = do
s <- staticDevel Settings.staticDir
#endif
let h = ~sitearg~ conf logger s
app <- toWaiApp h
runWaiApp f app
defaultRunner f h
-- for yesod devel
withDevelAppPort :: Dynamic

View File

@ -1,97 +1,12 @@
#!/bin/bash -e
#
# Runs test/scaffold.sh with a variety of inputs. Hides all output
# besides failure details.
#
###
#!/bin/bash
[[ "$1" =~ -v|--verbose ]] && stdout=/dev/stdout || stdout=/dev/null
cat << EOF
tmp='/tmp'
pwd="$PWD"
You're using the deprecated ./test/run.sh. This file will be removed
soon in favor of ../scripts/runtests.
pkg=
dir=
Running ../scripts/runtests...
failures=()
n_tested=0
n_failed=0
EOF
# runs the function named by $1, silencing stdout and redirecting stderr
# to /tmp/function.errors. failures are tracked to be reported on during
# cleanup
run_test() { # {{{
local test_function="$*"
n_tested=$((n_tested+1))
if $test_function >"$stdout" 2>"$tmp/$test_function.errors"; then
echo -n '.'
[[ -f "$tmp/$test_function.errors" ]] && rm "$tmp/$test_function.errors"
else
echo -n 'F'
failures+=( "$test_function" )
n_failed=$((n_failed+1))
fi
}
# }}}
# changes back to the original directory, removes the dist file and
# outputs a report of tests and failures
cleanup() { # {{{
cd "$pwd"
[[ -d "$dir" ]] && rm -r "$dir"
echo
echo
echo "Tests: $n_tested, Failures: $n_failed."
echo
[[ $n_failed -eq 0 ]] && return 0
for test in ${failures[@]}; do
echo "Failure: $test"
echo 'details:'
echo
if [[ -f "$tmp/$test.errors" ]]; then
cat "$tmp/$test.errors"
rm "$tmp/$test.errors"
else
echo '<no stderr captured>'
fi
echo
done
return $n_failed
}
# }}}
# compilation is test #1, sets global variable dir. other tests are run
# from within this directory and it is removed as part of cleanup
test_compile() {
cabal clean
cabal install
cabal sdist
read -r pkg < <(find dist/ -type f -name '*.tar.gz' | sort -rV)
dir="$(basename "$pkg" .tar.gz)"
tar -xzf "$pkg" && cd "$dir"
}
test_sqlite() { ../test/scaffold.sh < ../test/sqlite-input.txt ; }
test_postgresql() { ../test/scaffold.sh < ../test/postgresql-input.txt; }
test_mongodb() { ../test/scaffold.sh < ../test/mongodb-input.txt ; }
test_tiny() { ../test/scaffold.sh < ../test/tiny-input.txt ; }
echo 'Started'
run_test 'test_compile'
run_test 'test_sqlite'
run_test 'test_postgresql'
run_test 'test_mongodb'
run_test 'test_tiny'
cleanup
exit $?
../scripts/runtests "$@"

View File

@ -1,12 +1,10 @@
#!/bin/bash -ex
rm -rf foobar
runghc main.hs init
(
cd foobar
cabal install
cabal install -fdevel
cabal install -fproduction
)
ghc-pkg unregister foobar

View File

@ -0,0 +1,7 @@
setup() { rm -rf foobar; }
teardown() { rm -rf foobar; ghc-pkg unregister foobar &>/dev/null; }
test_sqlite() { ../test/scaffold.sh < ../test/sqlite-input.txt ; }
test_postgresql() { ../test/scaffold.sh < ../test/postgresql-input.txt; }
test_mongodb() { ../test/scaffold.sh < ../test/mongodb-input.txt ; }
test_tiny() { ../test/scaffold.sh < ../test/tiny-input.txt ; }