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

Merge branch 'master' into yesod-1.4

Browse Source 
Conflicts:
	yesod-form/Yesod/Form/Functions.hs
This commit is contained in:
Michael Snoyman 2014-08-25 20:20:16 +03:00
commit c66ef04f17
29 changed files with 375 additions and 223 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
yesod-auth/Yesod/Auth/BrowserId.hs
View File

@ -9,6 +9,7 @@ module Yesod.Auth.BrowserId
, BrowserIdSettings , BrowserIdSettings
, bisAudience , bisAudience
, bisLazyLoad , bisLazyLoad
, forwardUrl
) where ) where
import Yesod.Auth import Yesod.Auth
@ -28,8 +29,11 @@ import Data.Default
pid :: Text pid :: Text
pid = "browserid" pid = "browserid"
complete :: Route Auth forwardUrl :: AuthRoute
complete = PluginR pid [] forwardUrl = PluginR pid []
complete :: AuthRoute
complete = forwardUrl
-- | A settings type for various configuration options relevant to BrowserID. -- | A settings type for various configuration options relevant to BrowserID.
-- --

13
yesod-auth/Yesod/Auth/GoogleEmail2.hs
View File

@ -30,15 +30,20 @@ import Blaze.ByteString.Builder (fromByteString, toByteString)
import Control.Applicative ((<$>), (<*>)) import Control.Applicative ((<$>), (<*>))
import Control.Arrow (second) import Control.Arrow (second)
import Control.Monad (liftM, unless) import Control.Monad (liftM, unless)
import qualified Data.Aeson as A
import qualified Data.Aeson.Encode as A
import Data.Aeson.Parser (json') import Data.Aeson.Parser (json')
import Data.Aeson.Types (FromJSON (parseJSON), parseEither, import Data.Aeson.Types (FromJSON (parseJSON), parseEither,
withObject) withObject)
import Data.Conduit (($$+-)) import Data.Conduit (($$+-))
import Data.Conduit.Attoparsec (sinkParser) import Data.Conduit.Attoparsec (sinkParser)
import qualified Data.HashMap.Strict as M
import Data.Monoid (mappend) import Data.Monoid (mappend)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TL
import Network.HTTP.Client (parseUrl, requestHeaders, import Network.HTTP.Client (parseUrl, requestHeaders,
responseBody, urlEncodedBody) responseBody, urlEncodedBody)
import Network.HTTP.Conduit (http) import Network.HTTP.Conduit (http)
@ -175,7 +180,7 @@ authGoogleEmail clientID clientSecret =
[e] -> return e [e] -> return e
[] -> error "No account email" [] -> error "No account email"
x -> error $ "Too many account emails: " ++ show x x -> error $ "Too many account emails: " ++ show x
lift $ setCredsRedirect $ Creds pid email [] lift $ setCredsRedirect $ Creds pid email $ allPersonInfo value2
dispatch _ _ = notFound dispatch _ _ = notFound
@ -200,3 +205,9 @@ instance FromJSON Email where
parseJSON = withObject "Email" $ \o -> Email parseJSON = withObject "Email" $ \o -> Email
<$> o .: "value" <$> o .: "value"
<*> o .: "type" <*> o .: "type"
allPersonInfo :: A.Value -> [(Text, Text)]
allPersonInfo (A.Object o) = map enc $ M.toList o
where enc (key, A.String s) = (key, s)
enc (key, v) = (key, TL.toStrict $ TL.toLazyText $ A.encodeToTextBuilder v)
allPersonInfo _ = []

61
yesod-auth/Yesod/Auth/Message.hs
View File

@ -15,6 +15,7 @@ module Yesod.Auth.Message
, chineseMessage , chineseMessage
, spanishMessage , spanishMessage
, czechMessage , czechMessage
, russianMessage
) where ) where
import Data.Monoid (mappend) import Data.Monoid (mappend)
@ -396,15 +397,15 @@ japaneseMessage NowLoggedIn = "ログインしました"
japaneseMessage LoginTitle = "ログイン" japaneseMessage LoginTitle = "ログイン"
japaneseMessage PleaseProvideUsername = "ユーザ名を入力してください" japaneseMessage PleaseProvideUsername = "ユーザ名を入力してください"
japaneseMessage PleaseProvidePassword = "パスワードを入力してください" japaneseMessage PleaseProvidePassword = "パスワードを入力してください"
japaneseMessage NoIdentifierProvided = "No email/username provided" japaneseMessage NoIdentifierProvided = "メールアドレス/ユーザ名が入力されていません"
japaneseMessage InvalidEmailAddress = "Invalid email address provided" japaneseMessage InvalidEmailAddress = "メールアドレスが無効です"
japaneseMessage PasswordResetTitle = "Password Reset" japaneseMessage PasswordResetTitle = "パスワードの再設定"
japaneseMessage ProvideIdentifier = "Email or Username" japaneseMessage ProvideIdentifier = "メールアドレスまたはユーザ名"
japaneseMessage SendPasswordResetEmail = "Send password reset email" japaneseMessage SendPasswordResetEmail = "パスワード再設定用メールの送信"
japaneseMessage PasswordResetPrompt = "Enter your e-mail address or username below, and a password reset e-mail will be sent to you." japaneseMessage PasswordResetPrompt = "以下にメールアドレスまたはユーザ名を入力してください。パスワードを再設定するためのメールが送信されます。"
japaneseMessage InvalidUsernamePass = "Invalid username/password combination" japaneseMessage InvalidUsernamePass = "ユーザ名とパスワードの組み合わせが間違っています"
japaneseMessage (IdentifierNotFound ident) = japaneseMessage (IdentifierNotFound ident) =
"「" `mappend` ident `mappend` "」は正しくないログインので、または未入力の項目があります。" ident `mappend` "は登録されていません"
finnishMessage :: AuthMessage -> Text finnishMessage :: AuthMessage -> Text
finnishMessage NoOpenID = "OpenID-tunnistetta ei löydy" finnishMessage NoOpenID = "OpenID-tunnistetta ei löydy"
@ -533,3 +534,47 @@ czechMessage PasswordResetPrompt = "Zadejte svou e-mailovou adresu nebo uživate
czechMessage InvalidUsernamePass = "Neplatná kombinace uživatelského jména a hesla" czechMessage InvalidUsernamePass = "Neplatná kombinace uživatelského jména a hesla"
-- TODO -- TODO
czechMessage i@(IdentifierNotFound _) = englishMessage i czechMessage i@(IdentifierNotFound _) = englishMessage i
-- Так как e-mail – это фактическое сокращение словосочетания electronic mail,
-- для русского перевода так же использовано сокращение: эл.почта
russianMessage :: AuthMessage -> Text
russianMessage NoOpenID = "Идентификатор OpenID не найден"
russianMessage LoginOpenID = "Вход с помощью OpenID"
russianMessage LoginGoogle = "Вход с помощью Google"
russianMessage LoginYahoo = "Вход с помощью Yahoo"
russianMessage Email = "Эл.почта"
russianMessage Password = "Пароль"
russianMessage Register = "Регистрация"
russianMessage RegisterLong = "Создать учётную запись"
russianMessage EnterEmail = "Введите свой адрес эл.почты ниже, вам будет отправлено письмо для подтверждения."
russianMessage ConfirmationEmailSentTitle = "Письмо для подтверждения отправлено"
russianMessage (ConfirmationEmailSent email) =
"Письмо для подтверждения было отправлено на адрес " `mappend`
email `mappend`
"."
russianMessage AddressVerified = "Адрес подтверждён. Пожалуйста, установите новый пароль."
russianMessage InvalidKeyTitle = "Неверный ключ подтверждения"
russianMessage InvalidKey = "Извините, но ключ подтверждения оказался недействительным."
russianMessage InvalidEmailPass = "Неверное сочетание эл.почты и пароля"
russianMessage BadSetPass = "Чтобы изменить пароль, необходимо выполнить вход"
russianMessage SetPassTitle = "Установить пароль"
russianMessage SetPass = "Установить новый пароль"
russianMessage NewPass = "Новый пароль"
russianMessage ConfirmPass = "Подтверждение"
russianMessage PassMismatch = "Пароли не совпадают, повторите снова"
russianMessage PassUpdated = "Пароль обновлён"
russianMessage Facebook = "Вход с помощью Facebook"
russianMessage LoginViaEmail = "Вход по адресу эл.почты"
russianMessage InvalidLogin = "Неверный логин"
russianMessage NowLoggedIn = "Вход выполнен"
russianMessage LoginTitle = "Вход"
russianMessage PleaseProvideUsername = "Пожалуйста, введите ваше имя пользователя"
russianMessage PleaseProvidePassword = "Пожалуйста, введите ваш пароль"
russianMessage NoIdentifierProvided = "Не указан адрес эл.почты/имя пользователя"
russianMessage InvalidEmailAddress = "Указан неверный адрес эл.почты"
russianMessage PasswordResetTitle = "Сброс пароля"
russianMessage ProvideIdentifier = "Имя пользователя или эл.почта"
russianMessage SendPasswordResetEmail = "Отправить письмо для сброса пароля"
russianMessage PasswordResetPrompt = "Введите адрес эл.почты или ваше имя пользователя ниже, вам будет отправлено письмо для сброса пароля."
russianMessage InvalidUsernamePass = "Неверное сочетание имени пользователя и пароля"
russianMessage (IdentifierNotFound ident) = "Логин не найден: " `mappend` ident

14
yesod-auth/yesod-auth.cabal
View File

@ -1,5 +1,5 @@
name: yesod-auth name: yesod-auth
version: 1.3.1.1 version: 1.3.4.2
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman, Patrick Brisbin author: Michael Snoyman, Patrick Brisbin
@ -20,6 +20,10 @@ description:
* <https://github.com/ollieh/yesod-auth-bcrypt/>: An alternative to the HashDB module. * <https://github.com/ollieh/yesod-auth-bcrypt/>: An alternative to the HashDB module.
extra-source-files: persona_sign_in_blue.png extra-source-files: persona_sign_in_blue.png
flag network-uri
description: Get Network.URI from the network-uri package
default: True
library library
build-depends: base >= 4 && < 5 build-depends: base >= 4 && < 5
, authenticate >= 1.3 , authenticate >= 1.3
@ -44,11 +48,10 @@ library
, persistent >= 1.2 && < 2.1 , persistent >= 1.2 && < 2.1
, persistent-template >= 1.2 && < 2.1 , persistent-template >= 1.2 && < 2.1
, http-conduit >= 1.5 , http-conduit >= 1.5
, aeson >= 0.5 , aeson >= 0.7
, lifted-base >= 0.1 , lifted-base >= 0.1
, blaze-html >= 0.5 , blaze-html >= 0.5
, blaze-markup >= 0.5.1 , blaze-markup >= 0.5.1
, network
, http-types , http-types
, file-embed , file-embed
, email-validate >= 1.0 , email-validate >= 1.0
@ -65,6 +68,11 @@ library
, conduit-extra , conduit-extra
, attoparsec-conduit , attoparsec-conduit
if flag(network-uri)
build-depends: network-uri >= 2.6
else
build-depends: network < 2.6
exposed-modules: Yesod.Auth exposed-modules: Yesod.Auth
Yesod.Auth.BrowserId Yesod.Auth.BrowserId
Yesod.Auth.Dummy Yesod.Auth.Dummy

35
yesod-bin/AddHandler.hs
View File

@ -6,7 +6,8 @@ import Data.Char (isLower, toLower, isSpace)
import Data.List (isPrefixOf, isSuffixOf) import Data.List (isPrefixOf, isSuffixOf)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as TIO import qualified Data.Text.IO as TIO
import System.Directory (getDirectoryContents) import System.Directory (getDirectoryContents, doesFileExist)
import Control.Monad (when)
-- strict readFile -- strict readFile
readFile :: FilePath -> IO String readFile :: FilePath -> IO String
@ -21,14 +22,28 @@ addHandler = do
[] -> error "No cabal file found" [] -> error "No cabal file found"
_ -> error "Too many cabal files found" _ -> error "Too many cabal files found"
putStr "Name of route (without trailing R): " let routeInput = do
hFlush stdout putStr "Name of route (without trailing R): "
name <- getLine hFlush stdout
case name of name <- getLine
[] -> error "Please provide a name" case name of
c:_ [] -> error "No name entered. Quitting ..."
| isLower c -> error "Name must start with an upper case letter" c:_
| otherwise -> return () | isLower c -> do
putStrLn "Name must start with an upper case letter"
routeInput
| otherwise -> do
-- Check that the handler file doesn't already exist
let handlerFile = concat ["Handler/", name, ".hs"]
exists <- doesFileExist handlerFile
if exists
then do
putStrLn $ "File already exists: " ++ show handlerFile
putStrLn "Try another name or leave blank to exit"
routeInput
else return (name, handlerFile)
(name, handlerFile) <- routeInput
putStr "Enter route pattern (ex: /entry/#EntryId): " putStr "Enter route pattern (ex: /entry/#EntryId): "
hFlush stdout hFlush stdout
pattern <- getLine pattern <- getLine
@ -41,7 +56,7 @@ addHandler = do
modify "Application.hs" $ fixApp name modify "Application.hs" $ fixApp name
modify cabal $ fixCabal name modify cabal $ fixCabal name
modify "config/routes" $ fixRoutes name pattern methods modify "config/routes" $ fixRoutes name pattern methods
writeFile ("Handler/" ++ name ++ ".hs") $ mkHandler name pattern methods writeFile handlerFile $ mkHandler name pattern methods
fixApp :: String -> String -> String fixApp :: String -> String -> String
fixApp name = fixApp name =

12
yesod-bin/Build.hs
View File

@ -33,7 +33,8 @@ import qualified Data.Set as Set
import qualified System.Posix.Types import qualified System.Posix.Types
import System.Directory import System.Directory
import System.FilePath (takeExtension, replaceExtension, (</>), takeDirectory) import System.FilePath (takeExtension, replaceExtension, (</>), takeDirectory,
splitPath, joinPath)
import System.PosixCompat.Files (getFileStatus, setFileTimes, import System.PosixCompat.Files (getFileStatus, setFileTimes,
accessTime, modificationTime) accessTime, modificationTime)
@ -112,7 +113,7 @@ removeHi :: FilePath -> FilePath -> IO ()
removeHi _ hs = mapM_ removeFile' hiFiles removeHi _ hs = mapM_ removeFile' hiFiles
where where
removeFile' file = try' (removeFile file) >> return () removeFile' file = try' (removeFile file) >> return ()
hiFiles = map (\e -> "dist/build" </> replaceExtension hs e) hiFiles = map (\e -> "dist/build" </> removeSrc (replaceExtension hs e))
["hi", "p_hi"] ["hi", "p_hi"]
-- | change file mtime of .hs file to that of the dependency -- | change file mtime of .hs file to that of the dependency
@ -124,7 +125,12 @@ updateFileTime x hs = do
return () return ()
hiFile :: FilePath -> FilePath hiFile :: FilePath -> FilePath
hiFile hs = "dist/build" </> replaceExtension hs "hi" hiFile hs = "dist/build" </> removeSrc (replaceExtension hs "hi")
removeSrc :: FilePath -> FilePath
removeSrc f = case splitPath f of
("src/" : xs) -> joinPath xs
_ -> f
try' :: IO x -> IO (Either SomeException x) try' :: IO x -> IO (Either SomeException x)
try' = try try' = try

2
yesod-bin/Devel.hs
View File

@ -416,7 +416,7 @@ checkCabalFile gpd = case D.condLibrary gpd of
unless (null unlisted) $ do unless (null unlisted) $ do
putStrLn "WARNING: the following source files are not listed in exposed-modules or other-modules:" putStrLn "WARNING: the following source files are not listed in exposed-modules or other-modules:"
mapM_ putStrLn unlisted mapM_ putStrLn unlisted
when (D.fromString "Application" `notElem` D.exposedModules dLib) $ when ("Application" `notElem` (map (last . D.components) $ D.exposedModules dLib)) $
putStrLn "WARNING: no exposed module Application" putStrLn "WARNING: no exposed module Application"
return (hsSourceDirs, dLib) return (hsSourceDirs, dLib)

15
yesod-bin/Keter.hs
View File

@ -27,16 +27,17 @@ keter :: String -- ^ cabal command
-> Bool -- ^ no build? -> Bool -- ^ no build?
-> IO () -> IO ()
keter cabal noBuild = do keter cabal noBuild = do
mvalue <- decodeFile "config/keter.yaml" ketercfg <- keterConfig
mvalue <- decodeFile ketercfg
value <- value <-
case mvalue of case mvalue of
Nothing -> error "No config/keter.yaml found" Nothing -> error "No config/keter.yaml found"
Just (Object value) -> Just (Object value) ->
case Map.lookup "host" value of case Map.lookup "host" value of
Just (String s) | "<<" `T.isPrefixOf` s -> Just (String s) | "<<" `T.isPrefixOf` s ->
error "Please set your hostname in config/keter.yaml" error $ "Please set your hostname in " ++ ketercfg
_ -> return value _ -> return value
Just _ -> error "config/keter.yaml is not an object" Just _ -> error $ ketercfg ++ " is not an object"
files <- getDirectoryContents "." files <- getDirectoryContents "."
project <- project <-
@ -48,7 +49,7 @@ keter cabal noBuild = do
exec <- exec <-
case Map.lookup "exec" value of case Map.lookup "exec" value of
Just (String s) -> return $ F.collapse $ "config" F.</> F.fromText s Just (String s) -> return $ F.collapse $ "config" F.</> F.fromText s
_ -> error "exec not found in config/keter.yaml" _ -> error $ "exec not found in " ++ ketercfg
unless noBuild $ do unless noBuild $ do
run cabal ["clean"] run cabal ["clean"]
@ -67,6 +68,12 @@ keter cabal noBuild = do
Just i -> run "scp" ["-P" ++ show (i :: Int), fp, T.unpack s] Just i -> run "scp" ["-P" ++ show (i :: Int), fp, T.unpack s]
Nothing -> run "scp" [fp, T.unpack s] Nothing -> run "scp" [fp, T.unpack s]
_ -> return () _ -> return ()
where
-- Test for alternative config file extension (yaml or yml).
keterConfig = do
let yml = "config/keter.yml"
ymlExists <- doesFileExist yml
return $ if ymlExists then yml else "config/keter.yaml"
try' :: IO a -> IO (Either SomeException a) try' :: IO a -> IO (Either SomeException a)
try' = try try' = try

37
yesod-bin/hsfiles/mongo.hsfiles
View File

@ -45,8 +45,7 @@ import Network.Wai.Middleware.RequestLogger
import qualified Network.Wai.Middleware.RequestLogger as RequestLogger import qualified Network.Wai.Middleware.RequestLogger as RequestLogger
import qualified Database.Persist import qualified Database.Persist
import Network.HTTP.Client.Conduit (newManager) import Network.HTTP.Client.Conduit (newManager)
import Control.Concurrent (forkIO, threadDelay) import System.Log.FastLogger (newStdoutLoggerSet, defaultBufSize)
import System.Log.FastLogger (newStdoutLoggerSet, defaultBufSize, flushLogStr)
import Network.Wai.Logger (clockDateCacher) import Network.Wai.Logger (clockDateCacher)
import Data.Default (def) import Data.Default (def)
import Yesod.Core.Types (loggerSet, Logger (Logger)) import Yesod.Core.Types (loggerSet, Logger (Logger))
@ -94,18 +93,7 @@ makeFoundation conf = do
p <- Database.Persist.createPoolConfig (dbconf :: Settings.PersistConf) p <- Database.Persist.createPoolConfig (dbconf :: Settings.PersistConf)
loggerSet' <- newStdoutLoggerSet defaultBufSize loggerSet' <- newStdoutLoggerSet defaultBufSize
(getter, updater) <- clockDateCacher (getter, _) <- clockDateCacher
-- If the Yesod logger (as opposed to the request logger middleware) is
-- used less than once a second on average, you may prefer to omit this
-- thread and use "(updater >> getter)" in place of "getter" below. That
-- would update the cache every time it is used, instead of every second.
let updateLoop = do
threadDelay 1000000
updater
flushLogStr loggerSet'
updateLoop
_ <- forkIO updateLoop
let logger = Yesod.Core.Types.Logger loggerSet' getter let logger = Yesod.Core.Types.Logger loggerSet' getter
foundation = App conf s p manager dbconf logger foundation = App conf s p manager dbconf logger
@ -430,7 +418,7 @@ library
, bytestring >= 0.9 && < 0.11 , bytestring >= 0.9 && < 0.11
, text >= 0.11 && < 2.0 , text >= 0.11 && < 2.0
, persistent >= 1.3 && < 1.4 , persistent >= 1.3 && < 1.4
, persistent-mongoDB >= 1.3 && < 1.4 , persistent-mongoDB >= 1.3 && < 1.5
, persistent-template >= 1.3 && < 1.4 , persistent-template >= 1.3 && < 1.4
, template-haskell , template-haskell
, shakespeare >= 2.0 && < 2.1 , shakespeare >= 2.0 && < 2.1
@ -442,11 +430,11 @@ library
, directory >= 1.1 && < 1.3 , directory >= 1.1 && < 1.3
, warp >= 3.0 && < 3.1 , warp >= 3.0 && < 3.1
, data-default , data-default
, aeson >= 0.6 && < 0.8 , aeson >= 0.6 && < 0.9
, conduit >= 1.0 && < 2.0 , conduit >= 1.0 && < 2.0
, monad-logger >= 0.3 && < 0.4 , monad-logger >= 0.3 && < 0.4
, fast-logger >= 2.1.4 && < 2.2 , fast-logger >= 2.2 && < 2.3
, wai-logger >= 2.1 && < 2.2 , wai-logger >= 2.2 && < 2.3
executable PROJECTNAME executable PROJECTNAME
if flag(library-only) if flag(library-only)
@ -458,7 +446,7 @@ executable PROJECTNAME
, PROJECTNAME , PROJECTNAME
, yesod , yesod
ghc-options: -threaded -O2 ghc-options: -threaded -O2 -rtsopts -with-rtsopts=-N
test-suite test test-suite test
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
@ -714,7 +702,7 @@ AAAAAAAAAAAA////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA== AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==
{-# START_FILE config/keter.yaml #-} {-# START_FILE config/keter.yml #-}
exec: ../dist/build/PROJECTNAME/PROJECTNAME exec: ../dist/build/PROJECTNAME/PROJECTNAME
args: args:
- production - production
@ -890,6 +878,7 @@ Production:
web: ./dist/build/PROJECTNAME/PROJECTNAME production -p $PORT web: ./dist/build/PROJECTNAME/PROJECTNAME production -p $PORT
{-# START_FILE devel.hs #-} {-# START_FILE devel.hs #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE PackageImports #-} {-# LANGUAGE PackageImports #-}
import "PROJECTNAME" Application (getApplicationDev) import "PROJECTNAME" Application (getApplicationDev)
import Network.Wai.Handler.Warp import Network.Wai.Handler.Warp
@ -899,8 +888,16 @@ import System.Directory (doesFileExist, removeFile)
import System.Exit (exitSuccess) import System.Exit (exitSuccess)
import Control.Concurrent (threadDelay) import Control.Concurrent (threadDelay)
#ifndef mingw32_HOST_OS
import System.Posix.Signals (installHandler, sigINT, Handler(Catch))
#endif
main :: IO () main :: IO ()
main = do main = do
#ifndef mingw32_HOST_OS
_ <- installHandler sigINT (Catch $ return ()) Nothing
#endif
putStrLn "Starting devel application" putStrLn "Starting devel application"
(port, app) <- getApplicationDev (port, app) <- getApplicationDev
forkIO $ runSettings (setPort port defaultSettings) app forkIO $ runSettings (setPort port defaultSettings) app

35
yesod-bin/hsfiles/mysql.hsfiles
View File

@ -47,8 +47,7 @@ import qualified Database.Persist
import Database.Persist.Sql (runMigration) import Database.Persist.Sql (runMigration)
import Network.HTTP.Client.Conduit (newManager) import Network.HTTP.Client.Conduit (newManager)
import Control.Monad.Logger (runLoggingT) import Control.Monad.Logger (runLoggingT)
import Control.Concurrent (forkIO, threadDelay) import System.Log.FastLogger (newStdoutLoggerSet, defaultBufSize)
import System.Log.FastLogger (newStdoutLoggerSet, defaultBufSize, flushLogStr)
import Network.Wai.Logger (clockDateCacher) import Network.Wai.Logger (clockDateCacher)
import Data.Default (def) import Data.Default (def)
import Yesod.Core.Types (loggerSet, Logger (Logger)) import Yesod.Core.Types (loggerSet, Logger (Logger))
@ -96,18 +95,7 @@ makeFoundation conf = do
p <- Database.Persist.createPoolConfig (dbconf :: Settings.PersistConf) p <- Database.Persist.createPoolConfig (dbconf :: Settings.PersistConf)
loggerSet' <- newStdoutLoggerSet defaultBufSize loggerSet' <- newStdoutLoggerSet defaultBufSize
(getter, updater) <- clockDateCacher (getter, _) <- clockDateCacher
-- If the Yesod logger (as opposed to the request logger middleware) is
-- used less than once a second on average, you may prefer to omit this
-- thread and use "(updater >> getter)" in place of "getter" below. That
-- would update the cache every time it is used, instead of every second.
let updateLoop = do
threadDelay 1000000
updater
flushLogStr loggerSet'
updateLoop
_ <- forkIO updateLoop
let logger = Yesod.Core.Types.Logger loggerSet' getter let logger = Yesod.Core.Types.Logger loggerSet' getter
foundation = App conf s p manager dbconf logger foundation = App conf s p manager dbconf logger
@ -446,11 +434,11 @@ library
, directory >= 1.1 && < 1.3 , directory >= 1.1 && < 1.3
, warp >= 3.0 && < 3.1 , warp >= 3.0 && < 3.1
, data-default , data-default
, aeson >= 0.6 && < 0.8 , aeson >= 0.6 && < 0.9
, conduit >= 1.0 && < 2.0 , conduit >= 1.0 && < 2.0
, monad-logger >= 0.3 && < 0.4 , monad-logger >= 0.3 && < 0.4
, fast-logger >= 2.1.4 && < 2.2 , fast-logger >= 2.2 && < 2.3
, wai-logger >= 2.1 && < 2.2 , wai-logger >= 2.2 && < 2.3
executable PROJECTNAME executable PROJECTNAME
if flag(library-only) if flag(library-only)
@ -462,7 +450,7 @@ executable PROJECTNAME
, PROJECTNAME , PROJECTNAME
, yesod , yesod
ghc-options: -threaded -O2 ghc-options: -threaded -O2 -rtsopts -with-rtsopts=-N
test-suite test test-suite test
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
@ -718,7 +706,7 @@ AAAAAAAAAAAA////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA== AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==
{-# START_FILE config/keter.yaml #-} {-# START_FILE config/keter.yml #-}
exec: ../dist/build/PROJECTNAME/PROJECTNAME exec: ../dist/build/PROJECTNAME/PROJECTNAME
args: args:
- production - production
@ -920,6 +908,7 @@ Production:
web: ./dist/build/PROJECTNAME/PROJECTNAME production -p $PORT web: ./dist/build/PROJECTNAME/PROJECTNAME production -p $PORT
{-# START_FILE devel.hs #-} {-# START_FILE devel.hs #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE PackageImports #-} {-# LANGUAGE PackageImports #-}
import "PROJECTNAME" Application (getApplicationDev) import "PROJECTNAME" Application (getApplicationDev)
import Network.Wai.Handler.Warp import Network.Wai.Handler.Warp
@ -929,8 +918,16 @@ import System.Directory (doesFileExist, removeFile)
import System.Exit (exitSuccess) import System.Exit (exitSuccess)
import Control.Concurrent (threadDelay) import Control.Concurrent (threadDelay)
#ifndef mingw32_HOST_OS
import System.Posix.Signals (installHandler, sigINT, Handler(Catch))
#endif
main :: IO () main :: IO ()
main = do main = do
#ifndef mingw32_HOST_OS
_ <- installHandler sigINT (Catch $ return ()) Nothing
#endif
putStrLn "Starting devel application" putStrLn "Starting devel application"
(port, app) <- getApplicationDev (port, app) <- getApplicationDev
forkIO $ runSettings (setPort port defaultSettings) app forkIO $ runSettings (setPort port defaultSettings) app

35
yesod-bin/hsfiles/postgres-fay.hsfiles
View File

@ -49,8 +49,7 @@ import Database.Persist.Sql (runMigration)
import Network.HTTP.Client.Conduit (newManager) import Network.HTTP.Client.Conduit (newManager)
import Yesod.Fay (getFaySite) import Yesod.Fay (getFaySite)
import Control.Monad.Logger (runLoggingT) import Control.Monad.Logger (runLoggingT)
import Control.Concurrent (forkIO, threadDelay) import System.Log.FastLogger (newStdoutLoggerSet, defaultBufSize)
import System.Log.FastLogger (newStdoutLoggerSet, defaultBufSize, flushLogStr)
import Network.Wai.Logger (clockDateCacher) import Network.Wai.Logger (clockDateCacher)
import Data.Default (def) import Data.Default (def)
import Yesod.Core.Types (loggerSet, Logger (Logger)) import Yesod.Core.Types (loggerSet, Logger (Logger))
@ -99,18 +98,7 @@ makeFoundation conf = do
p <- Database.Persist.createPoolConfig (dbconf :: Settings.PersistConf) p <- Database.Persist.createPoolConfig (dbconf :: Settings.PersistConf)
loggerSet' <- newStdoutLoggerSet defaultBufSize loggerSet' <- newStdoutLoggerSet defaultBufSize
(getter, updater) <- clockDateCacher (getter, _) <- clockDateCacher
-- If the Yesod logger (as opposed to the request logger middleware) is
-- used less than once a second on average, you may prefer to omit this
-- thread and use "(updater >> getter)" in place of "getter" below. That
-- would update the cache every time it is used, instead of every second.
let updateLoop = do
threadDelay 1000000
updater
flushLogStr loggerSet'
updateLoop
_ <- forkIO updateLoop
let logger = Yesod.Core.Types.Logger loggerSet' getter let logger = Yesod.Core.Types.Logger loggerSet' getter
foundation = App conf s p manager dbconf onCommand logger foundation = App conf s p manager dbconf onCommand logger
@ -483,11 +471,11 @@ library
, directory >= 1.1 && < 1.3 , directory >= 1.1 && < 1.3
, warp >= 3.0 && < 3.1 , warp >= 3.0 && < 3.1
, data-default , data-default
, aeson >= 0.6 && < 0.8 , aeson >= 0.6 && < 0.9
, conduit >= 1.0 && < 2.0 , conduit >= 1.0 && < 2.0
, monad-logger >= 0.3 && < 0.4 , monad-logger >= 0.3 && < 0.4
, fast-logger >= 2.1.4 && < 2.2 , fast-logger >= 2.2 && < 2.3
, wai-logger >= 2.1 && < 2.2 , wai-logger >= 2.2 && < 2.3
executable PROJECTNAME executable PROJECTNAME
if flag(library-only) if flag(library-only)
@ -499,7 +487,7 @@ executable PROJECTNAME
, PROJECTNAME , PROJECTNAME
, yesod , yesod
ghc-options: -threaded -O2 ghc-options: -threaded -O2 -rtsopts -with-rtsopts=-N
test-suite test test-suite test
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
@ -767,7 +755,7 @@ AAAAAAAAAAAA////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA== AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==
{-# START_FILE config/keter.yaml #-} {-# START_FILE config/keter.yml #-}
exec: ../dist/build/PROJECTNAME/PROJECTNAME exec: ../dist/build/PROJECTNAME/PROJECTNAME
args: args:
- production - production
@ -944,6 +932,7 @@ Production:
web: ./dist/build/PROJECTNAME/PROJECTNAME production -p $PORT web: ./dist/build/PROJECTNAME/PROJECTNAME production -p $PORT
{-# START_FILE devel.hs #-} {-# START_FILE devel.hs #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE PackageImports #-} {-# LANGUAGE PackageImports #-}
import "PROJECTNAME" Application (getApplicationDev) import "PROJECTNAME" Application (getApplicationDev)
import Network.Wai.Handler.Warp import Network.Wai.Handler.Warp
@ -953,8 +942,16 @@ import System.Directory (doesFileExist, removeFile)
import System.Exit (exitSuccess) import System.Exit (exitSuccess)
import Control.Concurrent (threadDelay) import Control.Concurrent (threadDelay)
#ifndef mingw32_HOST_OS
import System.Posix.Signals (installHandler, sigINT, Handler(Catch))
#endif
main :: IO () main :: IO ()
main = do main = do
#ifndef mingw32_HOST_OS
_ <- installHandler sigINT (Catch $ return ()) Nothing
#endif
putStrLn "Starting devel application" putStrLn "Starting devel application"
(port, app) <- getApplicationDev (port, app) <- getApplicationDev
forkIO $ runSettings (setPort port defaultSettings) app forkIO $ runSettings (setPort port defaultSettings) app

35
yesod-bin/hsfiles/postgres.hsfiles
View File

@ -47,8 +47,7 @@ import qualified Database.Persist
import Database.Persist.Sql (runMigration) import Database.Persist.Sql (runMigration)
import Network.HTTP.Client.Conduit (newManager) import Network.HTTP.Client.Conduit (newManager)
import Control.Monad.Logger (runLoggingT) import Control.Monad.Logger (runLoggingT)
import Control.Concurrent (forkIO, threadDelay) import System.Log.FastLogger (newStdoutLoggerSet, defaultBufSize)
import System.Log.FastLogger (newStdoutLoggerSet, defaultBufSize, flushLogStr)
import Network.Wai.Logger (clockDateCacher) import Network.Wai.Logger (clockDateCacher)
import Data.Default (def) import Data.Default (def)
import Yesod.Core.Types (loggerSet, Logger (Logger)) import Yesod.Core.Types (loggerSet, Logger (Logger))
@ -96,18 +95,7 @@ makeFoundation conf = do
p <- Database.Persist.createPoolConfig (dbconf :: Settings.PersistConf) p <- Database.Persist.createPoolConfig (dbconf :: Settings.PersistConf)
loggerSet' <- newStdoutLoggerSet defaultBufSize loggerSet' <- newStdoutLoggerSet defaultBufSize
(getter, updater) <- clockDateCacher (getter, _) <- clockDateCacher
-- If the Yesod logger (as opposed to the request logger middleware) is
-- used less than once a second on average, you may prefer to omit this
-- thread and use "(updater >> getter)" in place of "getter" below. That
-- would update the cache every time it is used, instead of every second.
let updateLoop = do
threadDelay 1000000
updater
flushLogStr loggerSet'
updateLoop
_ <- forkIO updateLoop
let logger = Yesod.Core.Types.Logger loggerSet' getter let logger = Yesod.Core.Types.Logger loggerSet' getter
foundation = App conf s p manager dbconf logger foundation = App conf s p manager dbconf logger
@ -446,11 +434,11 @@ library
, directory >= 1.1 && < 1.3 , directory >= 1.1 && < 1.3
, warp >= 3.0 && < 3.1 , warp >= 3.0 && < 3.1
, data-default , data-default
, aeson >= 0.6 && < 0.8 , aeson >= 0.6 && < 0.9
, conduit >= 1.0 && < 2.0 , conduit >= 1.0 && < 2.0
, monad-logger >= 0.3 && < 0.4 , monad-logger >= 0.3 && < 0.4
, fast-logger >= 2.1.4 && < 2.2 , fast-logger >= 2.2 && < 2.3
, wai-logger >= 2.1 && < 2.2 , wai-logger >= 2.2 && < 2.3
executable PROJECTNAME executable PROJECTNAME
if flag(library-only) if flag(library-only)
@ -462,7 +450,7 @@ executable PROJECTNAME
, PROJECTNAME , PROJECTNAME
, yesod , yesod
ghc-options: -threaded -O2 ghc-options: -threaded -O2 -rtsopts -with-rtsopts=-N
test-suite test test-suite test
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
@ -718,7 +706,7 @@ AAAAAAAAAAAA////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA== AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==
{-# START_FILE config/keter.yaml #-} {-# START_FILE config/keter.yml #-}
exec: ../dist/build/PROJECTNAME/PROJECTNAME exec: ../dist/build/PROJECTNAME/PROJECTNAME
args: args:
- production - production
@ -894,6 +882,7 @@ Production:
web: ./dist/build/PROJECTNAME/PROJECTNAME production -p $PORT web: ./dist/build/PROJECTNAME/PROJECTNAME production -p $PORT
{-# START_FILE devel.hs #-} {-# START_FILE devel.hs #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE PackageImports #-} {-# LANGUAGE PackageImports #-}
import "PROJECTNAME" Application (getApplicationDev) import "PROJECTNAME" Application (getApplicationDev)
import Network.Wai.Handler.Warp import Network.Wai.Handler.Warp
@ -903,8 +892,16 @@ import System.Directory (doesFileExist, removeFile)
import System.Exit (exitSuccess) import System.Exit (exitSuccess)
import Control.Concurrent (threadDelay) import Control.Concurrent (threadDelay)
#ifndef mingw32_HOST_OS
import System.Posix.Signals (installHandler, sigINT, Handler(Catch))
#endif
main :: IO () main :: IO ()
main = do main = do
#ifndef mingw32_HOST_OS
_ <- installHandler sigINT (Catch $ return ()) Nothing
#endif
putStrLn "Starting devel application" putStrLn "Starting devel application"
(port, app) <- getApplicationDev (port, app) <- getApplicationDev
forkIO $ runSettings (setPort port defaultSettings) app forkIO $ runSettings (setPort port defaultSettings) app

38
yesod-bin/hsfiles/simple.hsfiles
View File

@ -42,8 +42,7 @@ import Network.Wai.Middleware.RequestLogger
) )
import qualified Network.Wai.Middleware.RequestLogger as RequestLogger import qualified Network.Wai.Middleware.RequestLogger as RequestLogger
import Network.HTTP.Client.Conduit (newManager) import Network.HTTP.Client.Conduit (newManager)
import Control.Concurrent (forkIO, threadDelay) import System.Log.FastLogger (newStdoutLoggerSet, defaultBufSize)
import System.Log.FastLogger (newStdoutLoggerSet, defaultBufSize, flushLogStr)
import Network.Wai.Logger (clockDateCacher) import Network.Wai.Logger (clockDateCacher)
import Data.Default (def) import Data.Default (def)
import Yesod.Core.Types (loggerSet, Logger (Logger)) import Yesod.Core.Types (loggerSet, Logger (Logger))
@ -87,18 +86,7 @@ makeFoundation conf = do
s <- staticSite s <- staticSite
loggerSet' <- newStdoutLoggerSet defaultBufSize loggerSet' <- newStdoutLoggerSet defaultBufSize
(getter, updater) <- clockDateCacher (getter, _) <- clockDateCacher
-- If the Yesod logger (as opposed to the request logger middleware) is
-- used less than once a second on average, you may prefer to omit this
-- thread and use "(updater >> getter)" in place of "getter" below. That
-- would update the cache every time it is used, instead of every second.
let updateLoop = do
threadDelay 1000000
updater
flushLogStr loggerSet'
updateLoop
_ <- forkIO updateLoop
let logger = Yesod.Core.Types.Logger loggerSet' getter let logger = Yesod.Core.Types.Logger loggerSet' getter
foundation = App conf s manager logger foundation = App conf s manager logger
@ -120,8 +108,6 @@ module Foundation where
import Prelude import Prelude
import Yesod import Yesod
import Yesod.Static import Yesod.Static
import Yesod.Auth
import Yesod.Auth.BrowserId
import Yesod.Default.Config import Yesod.Default.Config
import Yesod.Default.Util (addStaticContentExternal) import Yesod.Default.Util (addStaticContentExternal)
import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager)) import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager))
@ -197,7 +183,6 @@ instance Yesod App where
urlRenderOverride _ _ = Nothing urlRenderOverride _ _ = Nothing
-- Routes not requiring authenitcation. -- Routes not requiring authenitcation.
isAuthorized (AuthR _) _ = return Authorized
isAuthorized FaviconR _ = return Authorized isAuthorized FaviconR _ = return Authorized
isAuthorized RobotsR _ = return Authorized isAuthorized RobotsR _ = return Authorized
-- Default to Authorized for now. -- Default to Authorized for now.
@ -373,11 +358,11 @@ library
, directory >= 1.1 && < 1.3 , directory >= 1.1 && < 1.3
, warp >= 3.0 && < 3.1 , warp >= 3.0 && < 3.1
, data-default , data-default
, aeson >= 0.6 && < 0.8 , aeson >= 0.6 && < 0.9
, conduit >= 1.0 && < 2.0 , conduit >= 1.0 && < 2.0
, monad-logger >= 0.3 && < 0.4 , monad-logger >= 0.3 && < 0.4
, fast-logger >= 2.1.4 && < 2.2 , fast-logger >= 2.2 && < 2.3
, wai-logger >= 2.1 && < 2.2 , wai-logger >= 2.2 && < 2.3
executable PROJECTNAME executable PROJECTNAME
if flag(library-only) if flag(library-only)
@ -389,7 +374,7 @@ executable PROJECTNAME
, PROJECTNAME , PROJECTNAME
, yesod , yesod
ghc-options: -threaded -O2 ghc-options: -threaded -O2 -rtsopts -with-rtsopts=-N
test-suite test test-suite test
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
@ -636,7 +621,7 @@ AAAAAAAAAAAA////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA== AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==
{-# START_FILE config/keter.yaml #-} {-# START_FILE config/keter.yml #-}
exec: ../dist/build/PROJECTNAME/PROJECTNAME exec: ../dist/build/PROJECTNAME/PROJECTNAME
args: args:
- production - production
@ -771,6 +756,7 @@ Production:
web: ./dist/build/PROJECTNAME/PROJECTNAME production -p $PORT web: ./dist/build/PROJECTNAME/PROJECTNAME production -p $PORT
{-# START_FILE devel.hs #-} {-# START_FILE devel.hs #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE PackageImports #-} {-# LANGUAGE PackageImports #-}
import "PROJECTNAME" Application (getApplicationDev) import "PROJECTNAME" Application (getApplicationDev)
import Network.Wai.Handler.Warp import Network.Wai.Handler.Warp
@ -780,8 +766,16 @@ import System.Directory (doesFileExist, removeFile)
import System.Exit (exitSuccess) import System.Exit (exitSuccess)
import Control.Concurrent (threadDelay) import Control.Concurrent (threadDelay)
#ifndef mingw32_HOST_OS
import System.Posix.Signals (installHandler, sigINT, Handler(Catch))
#endif
main :: IO () main :: IO ()
main = do main = do
#ifndef mingw32_HOST_OS
_ <- installHandler sigINT (Catch $ return ()) Nothing
#endif
putStrLn "Starting devel application" putStrLn "Starting devel application"
(port, app) <- getApplicationDev (port, app) <- getApplicationDev
forkIO $ runSettings (setPort port defaultSettings) app forkIO $ runSettings (setPort port defaultSettings) app

35
yesod-bin/hsfiles/sqlite.hsfiles
View File

@ -47,8 +47,7 @@ import qualified Database.Persist
import Database.Persist.Sql (runMigration) import Database.Persist.Sql (runMigration)
import Network.HTTP.Client.Conduit (newManager) import Network.HTTP.Client.Conduit (newManager)
import Control.Monad.Logger (runLoggingT) import Control.Monad.Logger (runLoggingT)
import Control.Concurrent (forkIO, threadDelay) import System.Log.FastLogger (newStdoutLoggerSet, defaultBufSize)
import System.Log.FastLogger (newStdoutLoggerSet, defaultBufSize, flushLogStr)
import Network.Wai.Logger (clockDateCacher) import Network.Wai.Logger (clockDateCacher)
import Data.Default (def) import Data.Default (def)
import Yesod.Core.Types (loggerSet, Logger (Logger)) import Yesod.Core.Types (loggerSet, Logger (Logger))
@ -96,18 +95,7 @@ makeFoundation conf = do
p <- Database.Persist.createPoolConfig (dbconf :: Settings.PersistConf) p <- Database.Persist.createPoolConfig (dbconf :: Settings.PersistConf)
loggerSet' <- newStdoutLoggerSet defaultBufSize loggerSet' <- newStdoutLoggerSet defaultBufSize
(getter, updater) <- clockDateCacher (getter, _) <- clockDateCacher
-- If the Yesod logger (as opposed to the request logger middleware) is
-- used less than once a second on average, you may prefer to omit this
-- thread and use "(updater >> getter)" in place of "getter" below. That
-- would update the cache every time it is used, instead of every second.
let updateLoop = do
threadDelay 1000000
updater
flushLogStr loggerSet'
updateLoop
_ <- forkIO updateLoop
let logger = Yesod.Core.Types.Logger loggerSet' getter let logger = Yesod.Core.Types.Logger loggerSet' getter
foundation = App conf s p manager dbconf logger foundation = App conf s p manager dbconf logger
@ -446,11 +434,11 @@ library
, directory >= 1.1 && < 1.3 , directory >= 1.1 && < 1.3
, warp >= 3.0 && < 3.1 , warp >= 3.0 && < 3.1
, data-default , data-default
, aeson >= 0.6 && < 0.8 , aeson >= 0.6 && < 0.9
, conduit >= 1.0 && < 2.0 , conduit >= 1.0 && < 2.0
, monad-logger >= 0.3 && < 0.4 , monad-logger >= 0.3 && < 0.4
, fast-logger >= 2.1.4 && < 2.2 , fast-logger >= 2.2 && < 2.3
, wai-logger >= 2.1 && < 2.2 , wai-logger >= 2.2 && < 2.3
executable PROJECTNAME executable PROJECTNAME
if flag(library-only) if flag(library-only)
@ -462,7 +450,7 @@ executable PROJECTNAME
, PROJECTNAME , PROJECTNAME
, yesod , yesod
ghc-options: -threaded -O2 ghc-options: -threaded -O2 -rtsopts -with-rtsopts=-N
test-suite test test-suite test
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
@ -718,7 +706,7 @@ AAAAAAAAAAAA////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA== AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==
{-# START_FILE config/keter.yaml #-} {-# START_FILE config/keter.yml #-}
exec: ../dist/build/PROJECTNAME/PROJECTNAME exec: ../dist/build/PROJECTNAME/PROJECTNAME
args: args:
- production - production
@ -890,6 +878,7 @@ Production:
web: ./dist/build/PROJECTNAME/PROJECTNAME production -p $PORT web: ./dist/build/PROJECTNAME/PROJECTNAME production -p $PORT
{-# START_FILE devel.hs #-} {-# START_FILE devel.hs #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE PackageImports #-} {-# LANGUAGE PackageImports #-}
import "PROJECTNAME" Application (getApplicationDev) import "PROJECTNAME" Application (getApplicationDev)
import Network.Wai.Handler.Warp import Network.Wai.Handler.Warp
@ -899,8 +888,16 @@ import System.Directory (doesFileExist, removeFile)
import System.Exit (exitSuccess) import System.Exit (exitSuccess)
import Control.Concurrent (threadDelay) import Control.Concurrent (threadDelay)
#ifndef mingw32_HOST_OS
import System.Posix.Signals (installHandler, sigINT, Handler(Catch))
#endif
main :: IO () main :: IO ()
main = do main = do
#ifndef mingw32_HOST_OS
_ <- installHandler sigINT (Catch $ return ()) Nothing
#endif
putStrLn "Starting devel application" putStrLn "Starting devel application"
(port, app) <- getApplicationDev (port, app) <- getApplicationDev
forkIO $ runSettings (setPort port defaultSettings) app forkIO $ runSettings (setPort port defaultSettings) app

9
yesod-bin/main.hs
View File

@ -152,6 +152,9 @@ optParser = Options
keterOptions :: Parser Command keterOptions :: Parser Command
keterOptions = Keter <$> switch ( long "nobuild" <> short 'n' <> help "Skip rebuilding" ) keterOptions = Keter <$> switch ( long "nobuild" <> short 'n' <> help "Skip rebuilding" )
defaultRescan :: Int
defaultRescan = 10
develOptions :: Parser Command develOptions :: Parser Command
develOptions = Devel <$> switch ( long "disable-api" <> short 'd' develOptions = Devel <$> switch ( long "disable-api" <> short 'd'
<> help "Disable fast GHC API rebuilding") <> help "Disable fast GHC API rebuilding")
@ -159,8 +162,10 @@ develOptions = Devel <$> switch ( long "disable-api" <> short 'd'
<> help "Run COMMAND after rebuild succeeds") <> help "Run COMMAND after rebuild succeeds")
<*> optStr ( long "failure-hook" <> short 'f' <> metavar "COMMAND" <*> optStr ( long "failure-hook" <> short 'f' <> metavar "COMMAND"
<> help "Run COMMAND when rebuild fails") <> help "Run COMMAND when rebuild fails")
<*> option ( long "event-timeout" <> short 't' <> value 1 <> metavar "N" <*> option ( long "event-timeout" <> short 't' <> value defaultRescan <> metavar "N"
<> help "Force rescan of files every N seconds" ) <> help ("Force rescan of files every N seconds (default "
++ show defaultRescan
++ ", use -1 to rely on FSNotify alone)") )
<*> optStr ( long "builddir" <> short 'b' <*> optStr ( long "builddir" <> short 'b'
<> help "Set custom cabal build directory, default `dist'") <> help "Set custom cabal build directory, default `dist'")
<*> many ( strOption ( long "ignore" <> short 'i' <> metavar "DIR" <*> many ( strOption ( long "ignore" <> short 'i' <> metavar "DIR"

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

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

10
yesod-core/Yesod/Core/Types.hs
View File

@ -68,6 +68,9 @@ import Yesod.Routes.Class (RenderRoute (..), ParseRout
import Control.Monad.Reader (MonadReader (..)) import Control.Monad.Reader (MonadReader (..))
import Prelude hiding (catch) import Prelude hiding (catch)
import Control.DeepSeq (NFData (rnf)) import Control.DeepSeq (NFData (rnf))
#if MIN_VERSION_conduit(1, 1, 0)
import Data.Conduit.Lazy (MonadActive, monadActive)
#endif
-- Sessions -- Sessions
type SessionMap = Map Text ByteString type SessionMap = Map Text ByteString
@ -458,6 +461,13 @@ instance MonadIO m => MonadLogger (WidgetT site m) where
monadLoggerLog a b c d = WidgetT $ \hd -> monadLoggerLog a b c d = WidgetT $ \hd ->
liftIO $ fmap (, mempty) $ rheLog (handlerEnv hd) a b c (toLogStr d) liftIO $ fmap (, mempty) $ rheLog (handlerEnv hd) a b c (toLogStr d)
#if MIN_VERSION_conduit(1, 1, 0)
instance MonadActive m => MonadActive (WidgetT site m) where
monadActive = lift monadActive
instance MonadActive m => MonadActive (HandlerT site m) where
monadActive = lift monadActive
#endif
instance MonadTrans (HandlerT site) where instance MonadTrans (HandlerT site) where
lift = HandlerT . const lift = HandlerT . const

2
yesod-core/test/YesodCoreTest/InternalRequest.hs
View File

@ -16,7 +16,7 @@ import System.IO.Unsafe (unsafePerformIO)
randomStringSpecs :: Spec randomStringSpecs :: Spec
randomStringSpecs = describe "Yesod.Internal.Request.randomString" $ do randomStringSpecs = describe "Yesod.Internal.Request.randomString" $ do
it "looks reasonably random" looksRandom --it "looks reasonably random" looksRandom
it "does not repeat itself" $ noRepeat 10 100 it "does not repeat itself" $ noRepeat 10 100
-- NOTE: this testcase may break on other systems/architectures if -- NOTE: this testcase may break on other systems/architectures if

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

@ -1,5 +1,5 @@
name: yesod-core name: yesod-core
version: 1.2.17 version: 1.2.19.1
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>

6
yesod-form/Yesod/Form/Functions.hs
View File

@ -430,6 +430,8 @@ renderBootstrap = renderBootstrap2
-- > ^{formWidget} -- > ^{formWidget}
-- > <div .form-actions> -- > <div .form-actions>
-- > <input .btn .primary type=submit value=_{MsgSubmit}> -- > <input .btn .primary type=submit value=_{MsgSubmit}>
--
-- Since 1.3.14
renderBootstrap2 :: Monad m => FormRender m a renderBootstrap2 :: Monad m => FormRender m a
renderBootstrap2 aform fragment = do renderBootstrap2 aform fragment = do
(res, views') <- aFormToForm aform (res, views') <- aFormToForm aform
@ -450,6 +452,10 @@ renderBootstrap2 aform fragment = do
<span .help-block>#{err} <span .help-block>#{err}
|] |]
return (res, widget) return (res, widget)
-- | Deprecated synonym for 'renderBootstrap2'.
renderBootstrap :: Monad m => FormRender m a
renderBootstrap = renderBootstrap2
{-# DEPRECATED renderBootstrap "Please use the Yesod.Form.Bootstrap3 module." #-} {-# DEPRECATED renderBootstrap "Please use the Yesod.Form.Bootstrap3 module." #-}
check :: (Monad m, RenderMessage (HandlerSite m) msg) check :: (Monad m, RenderMessage (HandlerSite m) msg)

26
yesod-form/Yesod/Form/I18n/Russian.hs Normal file
View File

@ -0,0 +1,26 @@
{-# LANGUAGE OverloadedStrings #-}
module Yesod.Form.I18n.Russian where
import Yesod.Form.Types (FormMessage (..))
import Data.Monoid (mappend)
import Data.Text (Text)
russianFormMessage :: FormMessage -> Text
russianFormMessage (MsgInvalidInteger t) = "Неверно записано целое число: " `mappend` t
russianFormMessage (MsgInvalidNumber t) = "Неверный формат числа: " `mappend` t
russianFormMessage (MsgInvalidEntry t) = "Неверный выбор: " `mappend` t
russianFormMessage MsgInvalidTimeFormat = "Неверно указано время, используйте формат ЧЧ:ММ[:СС]"
russianFormMessage MsgInvalidDay = "Неверно указана дата, используйте формат ГГГГ-ММ-ДД"
russianFormMessage (MsgInvalidUrl t) = "Неверно указан URL адрес: " `mappend` t
russianFormMessage (MsgInvalidEmail t) = "Неверно указана электронная почта: " `mappend` t
russianFormMessage (MsgInvalidHour t) = "Неверно указан час: " `mappend` t
russianFormMessage (MsgInvalidMinute t) = "Неверно указаны минуты: " `mappend` t
russianFormMessage (MsgInvalidSecond t) = "Неверны указаны секунды: " `mappend` t
russianFormMessage MsgCsrfWarning = "Для защиты от межсайтовой подделки запросов (CSRF), пожалуйста, подтвердите отправку данных формы."
russianFormMessage MsgValueRequired = "Обязательно к заполнению"
russianFormMessage (MsgInputNotFound t) = "Поле не найдено: " `mappend` t
russianFormMessage MsgSelectNone = "<Не выбрано>"
russianFormMessage (MsgInvalidBool t) = "Неверное логическое значение: " `mappend` t
russianFormMessage MsgBoolYes = "Да"
russianFormMessage MsgBoolNo = "Нет"
russianFormMessage MsgDelete = "Удалить?"

11
yesod-form/Yesod/Form/Jquery.hs
View File

@ -7,6 +7,7 @@ module Yesod.Form.Jquery
( YesodJquery (..) ( YesodJquery (..)
, jqueryDayField , jqueryDayField
, jqueryAutocompleteField , jqueryAutocompleteField
, jqueryAutocompleteField'
, googleHostedJqueryUiCss , googleHostedJqueryUiCss
, JqueryDaySettings (..) , JqueryDaySettings (..)
, Default (..) , Default (..)
@ -98,7 +99,13 @@ $(function(){
jqueryAutocompleteField :: (RenderMessage site FormMessage, YesodJquery site) jqueryAutocompleteField :: (RenderMessage site FormMessage, YesodJquery site)
=> Route site -> Field (HandlerT site IO) Text => Route site -> Field (HandlerT site IO) Text
jqueryAutocompleteField src = Field jqueryAutocompleteField = jqueryAutocompleteField' 2
jqueryAutocompleteField' :: (RenderMessage site FormMessage, YesodJquery site)
=> Int -- ^ autocomplete minimum length
-> Route site
-> Field (HandlerT site IO) Text
jqueryAutocompleteField' minLen src = Field
{ fieldParse = parseHelper $ Right { fieldParse = parseHelper $ Right
, fieldView = \theId name attrs val isReq -> do , fieldView = \theId name attrs val isReq -> do
toWidget [shamlet| toWidget [shamlet|
@ -109,7 +116,7 @@ $newline never
addScript' urlJqueryUiJs addScript' urlJqueryUiJs
addStylesheet' urlJqueryUiCss addStylesheet' urlJqueryUiCss
toWidget [julius| toWidget [julius|
$(function(){$("##{rawJS theId}").autocomplete({source:"@{src}",minLength:2})}); $(function(){$("##{rawJS theId}").autocomplete({source:"@{src}",minLength:#{toJSON minLen}})});
|] |]
, fieldEnctype = UrlEncoded , fieldEnctype = UrlEncoded
} }

4
yesod-form/Yesod/Form/Nic.hs
View File

@ -26,10 +26,10 @@ class Yesod a => YesodNic a where
nicHtmlField :: YesodNic site => Field (HandlerT site IO) Html nicHtmlField :: YesodNic site => Field (HandlerT site IO) Html
nicHtmlField = Field nicHtmlField = Field
{ fieldParse = \e _ -> return . Right . fmap (preEscapedToMarkup . sanitizeBalance) . listToMaybe $ e { fieldParse = \e _ -> return . Right . fmap (preEscapedToMarkup . sanitizeBalance) . listToMaybe $ e
, fieldView = \theId name attrs val _isReq -> do , fieldView = \theId name attrs val isReq -> do
toWidget [shamlet| toWidget [shamlet|
$newline never $newline never
<textarea id="#{theId}" *{attrs} name="#{name}" .html>#{showVal val} <textarea id="#{theId}" *{attrs} name="#{name}" :isReq:required .html>#{showVal val}
|] |]
addScript' urlNicEdit addScript' urlNicEdit
master <- getYesod master <- getYesod

13
yesod-form/yesod-form.cabal
View File

@ -1,5 +1,5 @@
name: yesod-form name: yesod-form
version: 1.3.11 version: 1.3.15.2
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>
@ -12,6 +12,10 @@ build-type: Simple
homepage: http://www.yesodweb.com/ homepage: http://www.yesodweb.com/
description: Form handling support for Yesod Web Framework description: Form handling support for Yesod Web Framework
flag network-uri
description: Get Network.URI from the network-uri package
default: True
library library
build-depends: base >= 4 && < 5 build-depends: base >= 4 && < 5
, yesod-core >= 1.2 && < 1.3 , yesod-core >= 1.2 && < 1.3
@ -27,7 +31,6 @@ library
, data-default , data-default
, xss-sanitize >= 0.3.0.1 , xss-sanitize >= 0.3.0.1
, blaze-builder >= 0.2.1.4 , blaze-builder >= 0.2.1.4
, network >= 2.2
, email-validate >= 1.0 , email-validate >= 1.0
, bytestring >= 0.9.1.4 , bytestring >= 0.9.1.4
, text >= 0.9 , text >= 0.9
@ -40,6 +43,11 @@ library
, aeson , aeson
, resourcet , resourcet
if flag(network-uri)
build-depends: network-uri >= 2.6
else
build-depends: network < 2.6
exposed-modules: Yesod.Form exposed-modules: Yesod.Form
Yesod.Form.Types Yesod.Form.Types
Yesod.Form.Functions Yesod.Form.Functions
@ -57,6 +65,7 @@ library
Yesod.Form.I18n.Norwegian Yesod.Form.I18n.Norwegian
Yesod.Form.I18n.Japanese Yesod.Form.I18n.Japanese
Yesod.Form.I18n.Czech Yesod.Form.I18n.Czech
Yesod.Form.I18n.Russian
-- FIXME Yesod.Helpers.Crud -- FIXME Yesod.Helpers.Crud
ghc-options: -Wall ghc-options: -Wall

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

@ -1,5 +1,5 @@
name: yesod-newsfeed name: yesod-newsfeed
version: 1.2.0.2 version: 1.2.1
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman, Patrick Brisbin author: Michael Snoyman, Patrick Brisbin

2
yesod-platform/to-cabal.hs
View File

@ -3,7 +3,7 @@ import Control.Applicative ((<$>))
main = do main = do
pkgs <- map (intercalate " == ") pkgs <- map (intercalate " == ")
. filter (\xs -> not $ any (`isPrefixOf` xs) $ map return ["parsec", "text", "transformers", "mtl", "HUnit", "QuickCheck", "binary", "zlib", "stm", "regex-compat", "hashable", "vault", "integer-gmp"]) . filter (\xs -> not $ any (`isPrefixOf` xs) $ map return ["parsec", "text", "transformers", "mtl", "HUnit", "QuickCheck", "binary", "zlib", "stm", "regex-compat", "hashable", "vault", "integer-gmp", "unordered-containers", "async", "aeson", "attoparsec", "scientific", "case-insensitive", "vector", "primitive", "unix-compat", "transformers-compat"])
. map words . map words
. filter (not . null) . filter (not . null)
. lines . lines

103
yesod-platform/yesod-platform.cabal
View File

@ -1,5 +1,5 @@
name: yesod-platform name: yesod-platform
version: 1.2.12.2 version: 1.2.13.2
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>
@ -14,17 +14,15 @@ homepage: http://www.yesodweb.com/
library library
build-depends: base >= 4 && < 5 build-depends: base >= 4 && < 5
, SHA == 1.6.4 , SHA == 1.6.4.1
, aeson == 0.7.0.6
, ansi-terminal == 0.6.1.1 , ansi-terminal == 0.6.1.1
, ansi-wl-pprint == 0.6.7.1 , ansi-wl-pprint == 0.6.7.1
, asn1-encoding == 0.8.1.3 , asn1-encoding == 0.8.1.3
, asn1-parse == 0.8.1 , asn1-parse == 0.8.1
, asn1-types == 0.2.3 , asn1-types == 0.2.3
, async == 2.0.1.5
, attoparsec == 0.12.0.0
, attoparsec-conduit == 1.1.0 , attoparsec-conduit == 1.1.0
, authenticate == 1.3.2.8 , authenticate == 1.3.2.10
, auto-update == 0.1.0.0
, base16-bytestring == 0.1.1.6 , base16-bytestring == 0.1.1.6
, base64-bytestring == 1.0.0.1 , base64-bytestring == 1.0.0.1
, blaze-builder == 0.3.3.2 , blaze-builder == 0.3.3.2
@ -33,16 +31,15 @@ library
, blaze-markup == 0.6.1.0 , blaze-markup == 0.6.1.0
, byteable == 0.1.1 , byteable == 0.1.1
, byteorder == 1.0.4 , byteorder == 1.0.4
, case-insensitive == 1.2.0.0
, cereal == 0.4.0.1 , cereal == 0.4.0.1
, cipher-aes == 0.2.7 , cipher-aes == 0.2.8
, cipher-des == 0.0.6 , cipher-des == 0.0.6
, cipher-rc4 == 0.1.4 , cipher-rc4 == 0.1.4
, clientsession == 0.9.0.3 , clientsession == 0.9.0.3
, conduit == 1.1.6 , conduit == 1.1.7
, conduit-extra == 1.1.0.4 , conduit-extra == 1.1.3
, connection == 0.2.1 , connection == 0.2.3
, cookie == 0.4.1.1 , cookie == 0.4.1.2
, cprng-aes == 0.5.2 , cprng-aes == 0.5.2
, crypto-api == 0.13 , crypto-api == 0.13
, crypto-cipher-types == 0.0.9 , crypto-cipher-types == 0.0.9
@ -50,7 +47,7 @@ library
, crypto-pubkey == 0.2.4 , crypto-pubkey == 0.2.4
, crypto-pubkey-types == 0.4.2.2 , crypto-pubkey-types == 0.4.2.2
, crypto-random == 0.0.7 , crypto-random == 0.0.7
, cryptohash == 0.11.5 , cryptohash == 0.11.6
, cryptohash-conduit == 0.1.1 , cryptohash-conduit == 0.1.1
, css-text == 0.1.2.1 , css-text == 0.1.2.1
, data-default == 0.5.3 , data-default == 0.5.3
@ -59,61 +56,59 @@ library
, data-default-instances-containers == 0.0.1 , data-default-instances-containers == 0.0.1
, data-default-instances-dlist == 0.0.1 , data-default-instances-dlist == 0.0.1
, data-default-instances-old-locale == 0.0.1 , data-default-instances-old-locale == 0.0.1
, dlist == 0.7.0.1 , dlist == 0.7.1
, email-validate == 2.0.1 , email-validate == 2.0.1
, entropy == 0.3.2 , entropy == 0.3.2
, esqueleto == 1.4.1.2 , esqueleto == 1.4.4
, exceptions == 0.6.1 , exceptions == 0.6.1
, fast-logger == 2.1.5 , fast-logger == 2.2.0
, file-embed == 0.0.7 , file-embed == 0.0.7
, hamlet == 1.2.0 , hamlet == 1.2.0
, hjsmin == 0.1.4.6 , hjsmin == 0.1.4.7
, hspec == 1.9.5 , hspec == 1.11.0
, hspec-expectations == 0.5.0.1 , hspec-expectations == 0.6.0.1
, html-conduit == 1.1.0.5 , html-conduit == 1.1.0.5
, http-client == 0.3.3 , http-client == 0.3.7.1
, http-client-tls == 0.2.1.1 , http-client-tls == 0.2.2
, http-conduit == 2.1.2 , http-conduit == 2.1.4
, http-date == 0.0.4 , http-date == 0.0.4
, http-reverse-proxy == 0.3.1.8 , http-reverse-proxy == 0.4.0.1
, http-types == 0.8.5 , http-types == 0.8.5
, language-javascript == 0.5.13 , language-javascript == 0.5.13
, lifted-base == 0.2.2.2 , lifted-base == 0.2.3.0
, mime-mail == 0.4.5.2 , mime-mail == 0.4.5.2
, mime-types == 0.1.0.4 , mime-types == 0.1.0.4
, mmorph == 1.0.3 , mmorph == 1.0.3
, monad-control == 0.3.3.0 , monad-control == 0.3.3.0
, monad-logger == 0.3.6.1 , monad-logger == 0.3.7.1
, monad-loops == 0.4.2 , monad-loops == 0.4.2.1
, nats == 0.2 , nats == 0.2
, network-conduit == 1.1.0 , network-conduit == 1.1.0
, optparse-applicative == 0.8.1 , optparse-applicative == 0.9.1.1
, path-pieces == 0.1.3.1 , path-pieces == 0.1.4
, pem == 0.2.2 , pem == 0.2.2
, persistent == 1.3.1.1 , persistent == 1.3.3
, persistent-template == 1.3.1.4 , persistent-template == 1.3.2.2
, primitive == 0.5.3.0
, publicsuffixlist == 0.1 , publicsuffixlist == 0.1
, pwstore-fast == 2.4.1 , pwstore-fast == 2.4.1
, quickcheck-io == 0.1.1 , quickcheck-io == 0.1.1
, resource-pool == 0.2.3.0 , resource-pool == 0.2.3.0
, resourcet == 1.1.2.2 , resourcet == 1.1.2.3
, safe == 0.3.4 , safe == 0.3.7
, scientific == 0.3.2.1
, securemem == 0.1.3 , securemem == 0.1.3
, semigroups == 0.15 , semigroups == 0.15.2
, setenv == 0.1.1.1 , setenv == 0.1.1.1
, shakespeare == 2.0.0.3 , shakespeare == 2.0.1.1
, shakespeare-css == 1.1.0 , shakespeare-css == 1.1.0
, shakespeare-i18n == 1.1.0 , shakespeare-i18n == 1.1.0
, shakespeare-js == 1.3.0 , shakespeare-js == 1.3.0
, shakespeare-text == 1.1.0 , shakespeare-text == 1.1.0
, silently == 1.2.4.1 , silently == 1.2.4.1
, simple-sendfile == 0.2.14 , simple-sendfile == 0.2.15
, skein == 1.0.9 , skein == 1.0.9
, socks == 0.5.4 , socks == 0.5.4
, stm-chans == 3.0.0.2 , stm-chans == 3.0.0.2
, streaming-commons == 0.1.3 , streaming-commons == 0.1.4.1
, stringsearch == 0.3.6.5 , stringsearch == 0.3.6.5
, system-fileio == 0.3.14 , system-fileio == 0.3.14
, system-filepath == 0.4.12 , system-filepath == 0.4.12
@ -123,37 +118,33 @@ library
, tf-random == 0.5 , tf-random == 0.5
, tls == 1.2.8 , tls == 1.2.8
, transformers-base == 0.4.2 , transformers-base == 0.4.2
-- , transformers-compat == 0.3.3.4
, unix-compat == 0.4.1.1
, unordered-containers == 0.2.4.0
, utf8-string == 0.3.8 , utf8-string == 0.3.8
, vector == 0.10.11.0
, void == 0.6.1 , void == 0.6.1
, wai == 3.0.0 , wai == 3.0.1.1
, wai-app-static == 3.0.0 , wai-app-static == 3.0.0
, wai-extra == 3.0.0 , wai-extra == 3.0.1.2
, wai-logger == 2.1.1 , wai-logger == 2.2.0
, wai-test == 3.0.0 , wai-test == 3.0.0
, warp == 3.0.0.2 , warp == 3.0.0.5
, warp-tls == 3.0.0 , warp-tls == 3.0.0
, word8 == 0.0.4 , word8 == 0.1.1
, x509 == 1.4.11 , x509 == 1.4.11
, x509-store == 1.4.4 , x509-store == 1.4.4
, x509-system == 1.4.5 , x509-system == 1.4.5
, x509-validation == 1.5.0 , x509-validation == 1.5.0
, xml-conduit == 1.2.0.2 , xml-conduit == 1.2.1
, xml-types == 0.3.4 , xml-types == 0.3.4
, xss-sanitize == 0.3.5.2 , xss-sanitize == 0.3.5.3
, yaml == 0.8.8.3 , yaml == 0.8.8.4
, yesod == 1.2.6 , yesod == 1.2.6.1
, yesod-auth == 1.3.1 , yesod-auth == 1.3.4.1
, yesod-auth-hashdb == 1.3.0.1 , yesod-auth-hashdb == 1.3.0.1
, yesod-core == 1.2.16 , yesod-core == 1.2.19
, yesod-form == 1.3.10 , yesod-form == 1.3.15.1
, yesod-persistent == 1.2.3 , yesod-persistent == 1.2.3
, yesod-routes == 1.2.0.6 , yesod-routes == 1.2.0.7
, yesod-static == 1.2.4 , yesod-static == 1.2.4
, yesod-test == 1.2.3 , yesod-test == 1.2.3.2
exposed-modules: Yesod.Platform exposed-modules: Yesod.Platform

27
yesod-test/Yesod/Test.hs
View File

@ -28,7 +28,9 @@ module Yesod.Test
yesodSpec yesodSpec
, YesodSpec , YesodSpec
, yesodSpecWithSiteGenerator , yesodSpecWithSiteGenerator
, yesodSpecApp
, YesodExample , YesodExample
, YesodExampleData(..)
, YesodSpecTree (..) , YesodSpecTree (..)
, ydescribe , ydescribe
, yit , yit
@ -125,7 +127,7 @@ import Data.Time.Clock (getCurrentTime)
-- | The state used in a single test case defined using 'yit' -- | The state used in a single test case defined using 'yit'
-- --
-- Since 1.2.0 -- Since 1.2.4
data YesodExampleData site = YesodExampleData data YesodExampleData site = YesodExampleData
{ yedApp :: !Application { yedApp :: !Application
, yedSite :: !site , yedSite :: !site
@ -187,7 +189,7 @@ data RequestPart
-- | The RequestBuilder state monad constructs an url encoded string of arguments -- | The RequestBuilder state monad constructs an url encoded string of arguments
-- to send with your requests. Some of the functions that run on it use the current -- to send with your requests. Some of the functions that run on it use the current
-- response to analize the forms that the server is expecting to receive. -- response to analyze the forms that the server is expecting to receive.
type RequestBuilder site = ST.StateT (RequestBuilderData site) IO type RequestBuilder site = ST.StateT (RequestBuilderData site) IO
-- | Start describing a Tests suite keeping cookies and a reference to the tested 'Application' -- | Start describing a Tests suite keeping cookies and a reference to the tested 'Application'
@ -234,6 +236,27 @@ yesodSpecWithSiteGenerator getSiteAction yspecs =
, yedResponse = Nothing , yedResponse = Nothing
} }
-- | Same as yesodSpec, but instead of taking a site it
-- takes an action which produces the 'Application' for each test.
-- This lets you use your middleware from makeApplication
yesodSpecApp :: YesodDispatch site
=> site
-> IO Application
-> YesodSpec site
-> Hspec.Spec
yesodSpecApp site getApp yspecs =
Core.fromSpecList $ map unYesod $ execWriter yspecs
where
unYesod (YesodSpecGroup x y) = Core.SpecGroup x $ map unYesod y
unYesod (YesodSpecItem x y) = Core.it x $ do
app <- getApp
ST.evalStateT y YesodExampleData
{ yedApp = app
, yedSite = site
, yedCookies = M.empty
, yedResponse = Nothing
}
-- | Describe a single test that keeps cookies, and a reference to the last response. -- | Describe a single test that keeps cookies, and a reference to the last response.
yit :: String -> YesodExample site () -> YesodSpec site yit :: String -> YesodExample site () -> YesodSpec site
yit label example = tell [YesodSpecItem label example] yit label example = tell [YesodSpecItem label example]

4
yesod-test/yesod-test.cabal
View File

@ -1,9 +1,9 @@
name: yesod-test name: yesod-test
version: 1.2.3.1 version: 1.2.5
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Nubis <nubis@woobiz.com.ar> author: Nubis <nubis@woobiz.com.ar>
maintainer: Nubis <nubis@woobiz.com.ar>, Michael Snoyman maintainer: Michael Snoyman, Greg Weber, Nubis <nubis@woobiz.com.ar>
synopsis: integration testing for WAI/Yesod Applications synopsis: integration testing for WAI/Yesod Applications
category: Web, Yesod, Testing category: Web, Yesod, Testing
stability: Experimental stability: Experimental