Merge remote-tracking branch 'origin/master' into yesod1.2

Conflicts:
	yesod-core/yesod-core.cabal
	yesod-json/yesod-json.cabal
This commit is contained in:
Michael Snoyman 2013-03-10 05:10:13 +02:00
commit eda98f96db
29 changed files with 6423 additions and 315 deletions

View File

@ -37,7 +37,7 @@ Isolating an entire project with a virtual machine is also a great idea, you jus
cabal-dev creates a sandboxed environment for an individual cabal package. cabal-dev creates a sandboxed environment for an individual cabal package.
Instead of using the `cabal` command, use the `cabal-dev` command which will use the sandbox. Instead of using the `cabal` command, use the `cabal-dev` command which will use the sandbox.
Use `yesod-devel --dev` when developing your application. Use `yesod devel --dev` when developing your application.

View File

@ -1,5 +1,5 @@
name: yesod-auth-oauth name: yesod-auth-oauth
version: 1.1.0.1 version: 1.1.0.2
license: BSD3 license: BSD3
license-file: LICENSE license-file: LICENSE
author: Hiromi Ishii author: Hiromi Ishii
@ -21,7 +21,7 @@ library
else else
build-depends: base >= 4 && < 4.3 build-depends: base >= 4 && < 4.3
build-depends: authenticate-oauth >= 1.4 && < 1.5 build-depends: authenticate-oauth >= 1.4 && < 1.5
, bytestring >= 0.9.1.4 && < 0.10 , bytestring >= 0.9.1.4
, yesod-core >= 1.1 && < 1.2 , yesod-core >= 1.1 && < 1.2
, yesod-auth >= 1.1 && < 1.2 , yesod-auth >= 1.1 && < 1.2
, text >= 0.7 && < 0.12 , text >= 0.7 && < 0.12

View File

@ -1,5 +1,6 @@
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Yesod.Auth.BrowserId module Yesod.Auth.BrowserId
( authBrowserId ( authBrowserId
, authBrowserIdAudience , authBrowserIdAudience
@ -19,6 +20,8 @@ import Control.Exception (throwIO)
import Text.Julius (julius, rawJS) import Text.Julius (julius, rawJS)
import Data.Aeson (toJSON) import Data.Aeson (toJSON)
import Network.URI (uriPath, parseURI) import Network.URI (uriPath, parseURI)
import Data.FileEmbed (embedFile)
import Data.ByteString (ByteString)
pid :: Text pid :: Text
pid = "browserid" pid = "browserid"
@ -62,6 +65,10 @@ helper maudience = AuthPlugin
, credsIdent = email , credsIdent = email
, credsExtra = [] , credsExtra = []
} }
("GET", ["static", "sign-in.png"]) -> sendResponse
( "image/png" :: ByteString
, toContent $(embedFile "persona_sign_in_blue.png")
)
(_, []) -> badMethod (_, []) -> badMethod
_ -> notFound _ -> notFound
, apLogin = \toMaster -> do , apLogin = \toMaster -> do
@ -76,10 +83,11 @@ helper maudience = AuthPlugin
$newline never $newline never
<p> <p>
<a href="javascript:#{onclick}()"> <a href="javascript:#{onclick}()">
<img src="https://browserid.org/i/sign_in_green.png"> <img src=@{toMaster loginIcon}>
|] |]
} }
where where
loginIcon = PluginR pid ["static", "sign-in.png"]
stripScheme t = fromMaybe t $ T.stripPrefix "//" $ snd $ T.breakOn "//" t stripScheme t = fromMaybe t $ T.stripPrefix "//" $ snd $ T.breakOn "//" t
-- | Generates a function to handle on-click events, and returns that function -- | Generates a function to handle on-click events, and returns that function

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.6 KiB

View File

@ -1,5 +1,5 @@
name: yesod-auth name: yesod-auth
version: 1.1.4.1 version: 1.1.5.3
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman, Patrick Brisbin author: Michael Snoyman, Patrick Brisbin
@ -11,37 +11,39 @@ cabal-version: >= 1.6.0
build-type: Simple build-type: Simple
homepage: http://www.yesodweb.com/ homepage: http://www.yesodweb.com/
description: Authentication for Yesod. description: Authentication for Yesod.
extra-source-files: persona_sign_in_blue.png
library library
build-depends: base >= 4 && < 5 build-depends: base >= 4 && < 5
, authenticate >= 1.3 && < 1.4 , authenticate >= 1.3
, bytestring >= 0.9.1.4 , bytestring >= 0.9.1.4
, yesod-core >= 1.1 && < 1.2 , yesod-core >= 1.1 && < 1.2
, wai >= 1.3 && < 1.4 , wai >= 1.3
, template-haskell , template-haskell
, pureMD5 >= 2.0 && < 2.2 , pureMD5 >= 2.0
, random >= 1.0.0.2 && < 1.1 , random >= 1.0.0.2
, text >= 0.7 && < 0.12 , text >= 0.7
, mime-mail >= 0.3 && < 0.5 , mime-mail >= 0.3
, yesod-persistent >= 1.1 && < 1.2 , yesod-persistent >= 1.1
, hamlet >= 1.1 && < 1.2 , hamlet >= 1.1 && < 1.2
, shakespeare-css >= 1.0 && < 1.1 , shakespeare-css >= 1.0 && < 1.1
, shakespeare-js >= 1.0.2 && < 1.2 , shakespeare-js >= 1.0.2 && < 1.2
, containers , containers
, unordered-containers , unordered-containers
, yesod-form >= 1.1 && < 1.3 , yesod-form >= 1.1 && < 1.3
, transformers >= 0.2.2 && < 0.4 , transformers >= 0.2.2
, persistent >= 1.0 && < 1.2 , persistent >= 1.0 && < 1.2
, persistent-template >= 1.0 && < 1.2 , persistent-template >= 1.0 && < 1.2
, SHA >= 1.4.1.3 && < 1.7 , SHA >= 1.4.1.3
, http-conduit >= 1.5 && < 1.9 , http-conduit >= 1.5
, aeson >= 0.5 , aeson >= 0.5
, pwstore-fast >= 2.2 && < 3 , pwstore-fast >= 2.2
, lifted-base >= 0.1 , lifted-base >= 0.1
, blaze-html >= 0.5 && < 0.6 , blaze-html >= 0.5
, blaze-markup >= 0.5.1 && < 0.6 , blaze-markup >= 0.5.1
, network , network
, http-types , http-types
, file-embed
exposed-modules: Yesod.Auth exposed-modules: Yesod.Auth
Yesod.Auth.BrowserId Yesod.Auth.BrowserId

View File

@ -1056,10 +1056,16 @@ instance MonadResource (GHandler sub master) where
#endif #endif
instance MonadLogger (GHandler sub master) where instance MonadLogger (GHandler sub master) where
#if MIN_VERSION_monad_logger(0, 3, 0)
monadLoggerLog a b c d = do
hd <- ask
liftIO $ handlerLog hd a b c (toLogStr d)
#else
monadLoggerLog a c d = monadLoggerLogSource a "" c d monadLoggerLog a c d = monadLoggerLogSource a "" c d
monadLoggerLogSource a b c d = do monadLoggerLogSource a b c d = do
hd <- ask hd <- ask
liftIO $ handlerLog hd a b c (toLogStr d) liftIO $ handlerLog hd a b c (toLogStr d)
#endif
instance Exception e => Failure e (GHandler sub master) where instance Exception e => Failure e (GHandler sub master) where
failure = liftIO . throwIO failure = liftIO . throwIO

View File

@ -909,6 +909,9 @@ runFakeHandler fakeSessionMap logger master handler = liftIO $ do
, W.queryString = [] , W.queryString = []
, W.requestBody = mempty , W.requestBody = mempty
, W.vault = mempty , W.vault = mempty
#if MIN_VERSION_wai(1, 4, 0)
, W.requestBodyLength = W.KnownLength 0
#endif
} }
fakeRequest = fakeRequest =
Request Request

View File

@ -313,5 +313,9 @@ instance MonadResource (GWidget sub master) where
#endif #endif
instance MonadLogger (GWidget sub master) where instance MonadLogger (GWidget sub master) where
#if MIN_VERSION_monad_logger(0, 3, 0)
monadLoggerLog a b c = lift . monadLoggerLog a b c
#else
monadLoggerLog a b = lift . monadLoggerLog a b monadLoggerLog a b = lift . monadLoggerLog a b
monadLoggerLogSource a b c = lift . monadLoggerLogSource a b c monadLoggerLogSource a b c = lift . monadLoggerLogSource a b c
#endif

View File

@ -1,5 +1,5 @@
name: yesod-core name: yesod-core
version: 1.1.8 version: 1.1.8.2
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>
@ -50,7 +50,7 @@ library
build-depends: base >= 4.3 && < 5 build-depends: base >= 4.3 && < 5
, time >= 1.1.4 , time >= 1.1.4
, yesod-routes >= 1.1 && < 1.2 , yesod-routes >= 1.1 && < 1.2
, wai >= 1.3 && < 1.4 , wai >= 1.3 && < 1.5
, wai-extra >= 1.3 && < 1.4 , wai-extra >= 1.3 && < 1.4
, bytestring >= 0.9.1.4 , bytestring >= 0.9.1.4
, text >= 0.7 && < 0.12 , text >= 0.7 && < 0.12
@ -79,13 +79,13 @@ library
, vector >= 0.9 && < 0.11 , vector >= 0.9 && < 0.11
, aeson >= 0.5 , aeson >= 0.5
, fast-logger >= 0.2 , fast-logger >= 0.2
, monad-logger >= 0.2.1 && < 0.3 , monad-logger >= 0.2.1 && < 0.4
, conduit >= 0.5 && < 0.6 , conduit >= 0.5
, resourcet >= 0.3 && < 0.5 , resourcet >= 0.3 && < 0.5
, lifted-base >= 0.1 , lifted-base >= 0.1
, blaze-html >= 0.5 && < 0.6
, blaze-markup >= 0.5.1 && < 0.6
, attoparsec-conduit , attoparsec-conduit
, blaze-html >= 0.5
, blaze-markup >= 0.5.1
exposed-modules: Yesod.Content exposed-modules: Yesod.Content
Yesod.Core Yesod.Core

View File

@ -1,5 +1,5 @@
name: yesod-default name: yesod-default
version: 1.1.3 version: 1.1.3.2
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Patrick Brisbin author: Patrick Brisbin
@ -20,7 +20,7 @@ library
build-depends: base >= 4 && < 5 build-depends: base >= 4 && < 5
, yesod-core >= 1.1 && < 1.2 , yesod-core >= 1.1 && < 1.2
, warp >= 1.3 && < 1.4 , warp >= 1.3 && < 1.4
, wai >= 1.3 && < 1.4 , wai >= 1.3 && < 1.5
, wai-extra >= 1.3 && < 1.4 , wai-extra >= 1.3 && < 1.4
, bytestring >= 0.9.1.4 , bytestring >= 0.9.1.4
, transformers >= 0.2.2 && < 0.4 , transformers >= 0.2.2 && < 0.4
@ -30,7 +30,7 @@ library
, shakespeare-js >= 1.0 && < 1.2 , shakespeare-js >= 1.0 && < 1.2
, template-haskell , template-haskell
, yaml >= 0.8 && < 0.9 , yaml >= 0.8 && < 0.9
, network-conduit >= 0.5 && < 0.7 , network-conduit >= 0.5
, unordered-containers , unordered-containers
, hamlet >= 1.1 && < 1.2 , hamlet >= 1.1 && < 1.2
, data-default , data-default

View File

@ -328,7 +328,7 @@ $newline never
<script>if (!('autofocus' in document.createElement('input'))) {document.getElementById('#{theId}').focus();} <script>if (!('autofocus' in document.createElement('input'))) {document.getElementById('#{theId}').focus();}
|] |]
toWidget [cassius| toWidget [cassius|
#{theId} ##{theId}
-webkit-appearance: textfield -webkit-appearance: textfield
|] |]
, fieldEnctype = UrlEncoded , fieldEnctype = UrlEncoded

View File

@ -1,5 +1,5 @@
name: yesod-form name: yesod-form
version: 1.2.1.1 version: 1.2.1.3
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>
@ -22,20 +22,20 @@ library
, shakespeare-js >= 1.0.2 && < 1.2 , shakespeare-js >= 1.0.2 && < 1.2
, persistent >= 1.0 && < 1.2 , persistent >= 1.0 && < 1.2
, template-haskell , template-haskell
, transformers >= 0.2.2 && < 0.4 , transformers >= 0.2.2
, data-default , data-default
, xss-sanitize >= 0.3.0.1 && < 0.4 , xss-sanitize >= 0.3.0.1
, blaze-builder >= 0.2.1.4 && < 0.4 , blaze-builder >= 0.2.1.4
, network >= 2.2 , network >= 2.2
, email-validate >= 0.2.6 , email-validate >= 0.2.6
, bytestring >= 0.9.1.4 , bytestring >= 0.9.1.4
, text >= 0.9 && < 1.0 , text >= 0.9
, wai >= 1.3 && < 1.4 , wai >= 1.3
, containers >= 0.2 , containers >= 0.2
, blaze-html >= 0.5 && < 0.6 , blaze-html >= 0.5
, blaze-markup >= 0.5.1 && < 0.6 , blaze-markup >= 0.5.1
, attoparsec >= 0.10 && < 0.11 , attoparsec >= 0.10
, crypto-api >= 0.8 && < 0.11 , crypto-api >= 0.8
, aeson , aeson
exposed-modules: Yesod.Form exposed-modules: Yesod.Form

View File

@ -1,5 +1,5 @@
name: yesod-newsfeed name: yesod-newsfeed
version: 1.1.0 version: 1.1.0.1
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman, Patrick Brisbin author: Michael Snoyman, Patrick Brisbin
@ -18,10 +18,10 @@ library
, time >= 1.1.4 , time >= 1.1.4
, hamlet >= 1.1 && < 1.2 , hamlet >= 1.1 && < 1.2
, bytestring >= 0.9.1.4 , bytestring >= 0.9.1.4
, text >= 0.9 && < 0.12 , text >= 0.9
, xml-conduit >= 1.0 && < 1.1 , xml-conduit >= 1.0
, blaze-html >= 0.5 && < 0.6 , blaze-html >= 0.5
, blaze-markup >= 0.5.1 && < 0.6 , blaze-markup >= 0.5.1
, containers , containers
exposed-modules: Yesod.AtomFeed exposed-modules: Yesod.AtomFeed

View File

@ -1,5 +1,5 @@
name: yesod-platform name: yesod-platform
version: 1.1.7.2 version: 1.1.8
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>
@ -17,33 +17,32 @@ library
, ReadArgs == 1.2.1 , ReadArgs == 1.2.1
, SHA == 1.6.1 , SHA == 1.6.1
, aeson == 0.6.1.0 , aeson == 0.6.1.0
, ansi-terminal == 0.5.5.1 , ansi-terminal == 0.6
, asn1-data == 0.7.1 , asn1-data == 0.7.1
, attoparsec == 0.10.3.0 , attoparsec == 0.10.4.0
, attoparsec-conduit == 0.5.0.3 , attoparsec-conduit == 1.0.0
, authenticate == 1.3.2 , authenticate == 1.3.2.6
, base-unicode-symbols == 0.2.2.4 , base-unicode-symbols == 0.2.2.4
, base64-bytestring == 1.0.0.0 , base64-bytestring == 1.0.0.1
, base64-conduit == 0.5.1 , base64-conduit == 1.0.0
, basic-prelude == 0.3.2.0 , basic-prelude == 0.3.4.0
, blaze-builder == 0.3.1.0 , blaze-builder == 0.3.1.0
, blaze-builder-conduit == 0.5.0.3 , blaze-builder-conduit == 1.0.0
, blaze-html == 0.5.1.3 , blaze-html == 0.6.0.0
, blaze-markup == 0.5.1.4 , blaze-markup == 0.5.1.4
, byteorder == 1.0.3 , byteorder == 1.0.3
, case-insensitive == 0.4.0.4 , case-insensitive == 1.0
, cereal == 0.3.5.2 , cereal == 0.3.5.2
, certificate == 1.3.5 , certificate == 1.3.5
, cipher-aes == 0.1.7 , cipher-aes == 0.1.7
, cipher-rc4 == 0.1.2 , cipher-rc4 == 0.1.2
, classy-prelude == 0.4.3 , classy-prelude == 0.5.3
, classy-prelude-conduit == 0.4.3
, clientsession == 0.8.1 , clientsession == 0.8.1
, conduit == 0.5.6 , conduit == 1.0.2
, cookie == 0.4.0.1 , cookie == 0.4.0.1
, cprng-aes == 0.3.4 , cprng-aes == 0.3.4
, crypto-api == 0.10.2 , crypto-api == 0.11
, crypto-conduit == 0.4.3 , crypto-conduit == 0.5.0
, crypto-numbers == 0.1.3 , crypto-numbers == 0.1.3
, crypto-pubkey == 0.1.2 , crypto-pubkey == 0.1.2
, crypto-pubkey-types == 0.2.0 , crypto-pubkey-types == 0.2.0
@ -53,66 +52,65 @@ library
, data-default == 0.5.0 , data-default == 0.5.0
, date-cache == 0.3.0 , date-cache == 0.3.0
, dlist == 0.5 , dlist == 0.5
, email-validate == 0.3.2 , email-validate == 1.0.0
, entropy == 0.2.1 , entropy == 0.2.1
, failure == 0.2.0.1 , failure == 0.2.0.1
, fast-logger == 0.3.1 , fast-logger == 0.3.1
, file-embed == 0.0.4.7 , file-embed == 0.0.4.7
, filesystem-conduit == 0.5.0.2 , filesystem-conduit == 1.0.0
, fsnotify == 0.0.6 , fsnotify == 0.0.6
, ghc-paths == 0.1.0.9 , ghc-paths == 0.1.0.9
, hamlet == 1.1.3.1 , hamlet == 1.1.6.3
, hashable == 1.2.0.5 , hashable == 1.2.0.5
, hjsmin == 0.1.4 , hjsmin == 0.1.4.1
, hspec == 1.4.3 , hspec == 1.4.4
, hspec-expectations == 0.3.0.3 , hspec-expectations == 0.3.0.3
, html-conduit == 0.1.0.4 , html-conduit == 1.1.0
, http-conduit == 1.8.7 , http-conduit == 1.9.0
, http-date == 0.0.4 , http-date == 0.0.4
, http-reverse-proxy == 0.1.1.1 , http-reverse-proxy == 0.1.1.3
, http-types == 0.7.3.0.1 , http-types == 0.8.0
, language-javascript == 0.5.7 , language-javascript == 0.5.7
, largeword == 1.0.4
, lifted-base == 0.2.0.2 , lifted-base == 0.2.0.2
, mime-mail == 0.4.1.2 , mime-mail == 0.4.1.2
, mime-types == 0.1.0.2 , mime-types == 0.1.0.3
, monad-control == 0.3.1.4 , monad-control == 0.3.1.4
, monad-logger == 0.2.3.2 , monad-logger == 0.3.0.1
, network-conduit == 0.6.2.2 , network-conduit == 1.0.0
, optparse-applicative == 0.5.2.1 , optparse-applicative == 0.5.2.1
, path-pieces == 0.1.2 , path-pieces == 0.1.2
, pem == 0.1.2 , pem == 0.1.2
, persistent == 1.1.4 , persistent == 1.1.5.1
, persistent-template == 1.1.2.1 , persistent-template == 1.1.2.4
, pool-conduit == 0.1.1 , pool-conduit == 0.1.1
, primitive == 0.5.0.1 , primitive == 0.5.0.1
, project-template == 0.1.1 , project-template == 0.1.3
, publicsuffixlist == 0.0.3
, pureMD5 == 2.1.2.1 , pureMD5 == 2.1.2.1
, pwstore-fast == 2.3 , pwstore-fast == 2.3
, ranges == 0.2.4
, resource-pool == 0.2.1.1 , resource-pool == 0.2.1.1
, resourcet == 0.4.4 , resourcet == 0.4.5
, safe == 0.3.3 , safe == 0.3.3
, semigroups == 0.9 , semigroups == 0.9
, setenv == 0.1.0 , setenv == 0.1.0
, shakespeare == 1.0.2 , shakespeare == 1.0.3.1
, shakespeare-css == 1.0.2 , shakespeare-css == 1.0.3
, shakespeare-i18n == 1.0.0.2 , shakespeare-i18n == 1.0.0.2
, shakespeare-js == 1.1.1 , shakespeare-js == 1.1.2.1
, shakespeare-text == 1.0.0.5 , shakespeare-text == 1.0.0.5
, silently == 1.2.4.1 , silently == 1.2.4.1
, simple-sendfile == 0.2.10 , simple-sendfile == 0.2.11
, skein == 0.1.0.11 , skein == 0.1.0.12
, socks == 0.4.2 , socks == 0.5.0
, split == 0.2.1.1 , split == 0.2.1.2
, stringsearch == 0.3.6.4 , stringsearch == 0.3.6.4
, system-fileio == 0.3.11 , system-fileio == 0.3.11
, system-filepath == 0.4.7 , system-filepath == 0.4.7
, tagged == 0.4.4 , tagged == 0.4.4
, tagsoup == 0.12.8 , tagsoup == 0.12.8
, tagstream-conduit == 0.5.3 , tagstream-conduit == 0.5.4
, tar == 0.4.0.1 , tar == 0.4.0.1
, tls == 1.1.1 , tls == 1.1.2
, tls-extra == 0.6.1 , tls-extra == 0.6.1
, transformers-base == 0.4.1 , transformers-base == 0.4.1
, unix-compat == 0.4.1.0 , unix-compat == 0.4.1.0
@ -122,29 +120,29 @@ library
, vault == 0.2.0.4 , vault == 0.2.0.4
, vector == 0.10.0.1 , vector == 0.10.0.1
, void == 0.5.11 , void == 0.5.11
, wai == 1.3.0.1 , wai == 1.4.0
, wai-app-static == 1.3.1 , wai-app-static == 1.3.1.2
, wai-extra == 1.3.2 , wai-extra == 1.3.2.4
, wai-logger == 0.3.0 , wai-logger == 0.3.0
, wai-test == 1.3.0 , wai-test == 1.3.0.4
, warp == 1.3.7.1 , warp == 1.3.7.4
, word8 == 0.0.3 , word8 == 0.0.3
, xml-conduit == 1.0.3.3 , xml-conduit == 1.1.0.3
, xml-types == 0.3.3 , xml-types == 0.3.3
, xss-sanitize == 0.3.3 , xss-sanitize == 0.3.3
, yaml == 0.8.2 , yaml == 0.8.2.3
, yesod == 1.1.7.2 , yesod == 1.1.9.2
, yesod-auth == 1.1.3 , yesod-auth == 1.1.5.3
, yesod-core == 1.1.7.1 , yesod-core == 1.1.8.2
, yesod-default == 1.1.3 , yesod-default == 1.1.3.2
, yesod-form == 1.2.0.2 , yesod-form == 1.2.1.3
, yesod-json == 1.1.2 , yesod-json == 1.1.2.1
, yesod-persistent == 1.1.0.1 , yesod-persistent == 1.1.0.1
, yesod-routes == 1.1.1.1 , yesod-routes == 1.1.2
, yesod-static == 1.1.1.2 , yesod-static == 1.1.2.2
, yesod-test == 0.3.3 , yesod-test == 0.3.5
, zlib-bindings == 0.1.1.3 , zlib-bindings == 0.1.1.3
, zlib-conduit == 0.5.0.3 , zlib-conduit == 1.0.0
exposed-modules: Yesod.Platform exposed-modules: Yesod.Platform

View File

@ -1,5 +1,5 @@
name: yesod-sitemap name: yesod-sitemap
version: 1.1.0 version: 1.1.0.1
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>
@ -16,7 +16,7 @@ library
build-depends: base >= 4 && < 5 build-depends: base >= 4 && < 5
, yesod-core >= 1.1 && < 1.2 , yesod-core >= 1.1 && < 1.2
, time >= 1.1.4 , time >= 1.1.4
, xml-conduit >= 1.0 && < 1.1 , xml-conduit >= 1.0
, text , text
, containers , containers
exposed-modules: Yesod.Sitemap exposed-modules: Yesod.Sitemap

View File

@ -1,5 +1,5 @@
name: yesod-static name: yesod-static
version: 1.1.2 version: 1.1.2.2
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>
@ -31,13 +31,13 @@ library
, directory >= 1.0 , directory >= 1.0
, transformers >= 0.2.2 , transformers >= 0.2.2
, wai-app-static >= 1.3 && < 1.4 , wai-app-static >= 1.3 && < 1.4
, wai >= 1.3 && < 1.4 , wai >= 1.3 && < 1.5
, text >= 0.9 , text >= 0.9
, file-embed >= 0.0.4.1 && < 0.5 , file-embed >= 0.0.4.1 && < 0.5
, http-types >= 0.7 , http-types >= 0.7
, unix-compat >= 0.2 , unix-compat >= 0.2
, conduit >= 0.5 && < 0.6 , conduit >= 0.5
, crypto-conduit >= 0.4 && < 0.5 , crypto-conduit >= 0.4
, cryptohash >= 0.6.1 , cryptohash >= 0.6.1
, system-filepath >= 0.4.6 && < 0.5 , system-filepath >= 0.4.6 && < 0.5
exposed-modules: Yesod.Static exposed-modules: Yesod.Static

View File

@ -52,7 +52,7 @@ module Yesod.Test (
-- * Assertions -- * Assertions
assertEqual, assertHeader, assertNoHeader, statusIs, bodyEquals, bodyContains, assertEqual, assertHeader, assertNoHeader, statusIs, bodyEquals, bodyContains,
htmlAllContain, htmlCount, htmlAllContain, htmlAnyContain, htmlCount,
-- * Utils for debugging tests -- * Utils for debugging tests
printBody, printMatches, printBody, printMatches,
@ -253,6 +253,18 @@ htmlAllContain query search = do
_ -> liftIO $ HUnit.assertBool ("Not all "++T.unpack query++" contain "++search) $ _ -> liftIO $ HUnit.assertBool ("Not all "++T.unpack query++" contain "++search) $
DL.all (DL.isInfixOf search) (map (TL.unpack . decodeUtf8) matches) DL.all (DL.isInfixOf search) (map (TL.unpack . decodeUtf8) matches)
-- | Queries the html using a css selector, and passes if any matched
-- element contains the given string.
--
-- Since 0.3.5
htmlAnyContain :: HoldsResponse a => Query -> String -> ST.StateT a IO ()
htmlAnyContain query search = do
matches <- htmlQuery query
case matches of
[] -> failure $ "Nothing matched css query: " <> query
_ -> liftIO $ HUnit.assertBool ("None of "++T.unpack query++" contain "++search) $
DL.any (DL.isInfixOf search) (map (TL.unpack . decodeUtf8) matches)
-- | Performs a css query on the last response and asserts the matched elements -- | Performs a css query on the last response and asserts the matched elements
-- are as many as expected. -- are as many as expected.
htmlCount :: HoldsResponse a => Query -> Int -> ST.StateT a IO () htmlCount :: HoldsResponse a => Query -> Int -> ST.StateT a IO ()
@ -437,9 +449,13 @@ doRequestHeaders method url extrahead paramsBuild = do
{ requestMethod = method { requestMethod = method
, remoteHost = Sock.SockAddrInet 1 2 , remoteHost = Sock.SockAddrInet 1 2
, requestHeaders = headers , requestHeaders = headers
, rawPathInfo = url , rawPathInfo = urlPath
, pathInfo = DL.filter (/="") $ T.split (== '/') $ TE.decodeUtf8 url , pathInfo = DL.filter (/="") $ T.split (== '/') $ TE.decodeUtf8 urlPath
, rawQueryString = urlQuery
, queryString = H.parseQuery urlQuery
} }
(urlPath, urlQuery) = BS8.break (== '?') url
-- | Run a persistent db query. For asserting on the results of performed actions -- | Run a persistent db query. For asserting on the results of performed actions
-- or setting up pre-conditions. At the moment this part is still very raw. -- or setting up pre-conditions. At the moment this part is still very raw.

View File

@ -1,5 +1,5 @@
name: yesod-test name: yesod-test
version: 0.3.3.1 version: 0.3.5
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Nubis <nubis@woobiz.com.ar> author: Nubis <nubis@woobiz.com.ar>
@ -15,24 +15,24 @@ extra-source-files: README.md, LICENSE, test/main.hs
library library
build-depends: base >= 4.3 && < 5 build-depends: base >= 4.3 && < 5
, attoparsec >= 0.10 && < 0.11 , attoparsec >= 0.10
, persistent >= 1.0 && < 1.2 , persistent >= 1.0
, transformers >= 0.2.2 && < 0.4 , transformers >= 0.2.2
, wai >= 1.3 && < 1.4 , wai >= 1.3
, wai-test >= 1.3 && < 1.4 , wai-test >= 1.3
, network >= 2.2 , network >= 2.2
, http-types >= 0.7 , http-types >= 0.7
, HUnit >= 1.2 && < 1.3 , HUnit >= 1.2
, hspec >= 1.4 , hspec >= 1.4
, bytestring >= 0.9 , bytestring >= 0.9
, case-insensitive >= 0.2 , case-insensitive >= 0.2
, text , text
, xml-conduit >= 1.0 && < 1.1 , xml-conduit >= 1.0
, xml-types >= 0.3 && < 0.4 , xml-types >= 0.3
, containers , containers
, html-conduit >= 0.1 && < 0.2 , html-conduit >= 0.1
, blaze-html >= 0.5 && < 0.6 , blaze-html >= 0.5
, blaze-markup >= 0.5.1 && < 0.6 , blaze-markup >= 0.5.1
, pool-conduit , pool-conduit
, monad-control , monad-control
, time , time

View File

@ -9,18 +9,11 @@ module Devel
import qualified Distribution.Compiler as D import qualified Distribution.Compiler as D
import qualified Distribution.InstalledPackageInfo as IPI
import qualified Distribution.ModuleName as D import qualified Distribution.ModuleName as D
import qualified Distribution.Package as D
import qualified Distribution.PackageDescription as D import qualified Distribution.PackageDescription as D
import qualified Distribution.PackageDescription.Parse as D import qualified Distribution.PackageDescription.Parse as D
import qualified Distribution.Simple.Build as D
import qualified Distribution.Simple.Compiler as D
import qualified Distribution.Simple.Configure as D import qualified Distribution.Simple.Configure as D
import qualified Distribution.Simple.LocalBuildInfo as D
import qualified Distribution.Simple.Program as D import qualified Distribution.Simple.Program as D
import qualified Distribution.Simple.Register as D
import qualified Distribution.Simple.Setup as DSS
import qualified Distribution.Simple.Utils as D import qualified Distribution.Simple.Utils as D
import qualified Distribution.Verbosity as D import qualified Distribution.Verbosity as D
@ -40,9 +33,6 @@ import qualified Data.List as L
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import qualified Data.Set as Set import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import System.Directory import System.Directory
import System.Environment (getEnvironment) import System.Environment (getEnvironment)
@ -53,6 +43,7 @@ import System.FilePath (dropExtension,
splitDirectories, splitDirectories,
takeExtension, (</>)) takeExtension, (</>))
import System.FSNotify import System.FSNotify
import System.IO (Handle)
import System.IO.Error (isDoesNotExistError) import System.IO.Error (isDoesNotExistError)
import System.Posix.Types (EpochTime) import System.Posix.Types (EpochTime)
import System.PosixCompat.Files (getFileStatus, import System.PosixCompat.Files (getFileStatus,
@ -66,9 +57,9 @@ import System.Process (ProcessHandle,
import System.Timeout (timeout) import System.Timeout (timeout)
import Build (getDeps, isNewerThan, import Build (getDeps, isNewerThan,
recompDeps, safeReadFile) recompDeps)
import GhcBuild (buildPackage, import GhcBuild (buildPackage,
getBuildFlags) getBuildFlags, getPackageArgs)
import qualified Config as GHC import qualified Config as GHC
import Data.Conduit.Network (HostPreference (HostIPv4), import Data.Conduit.Network (HostPreference (HostIPv4),
@ -116,6 +107,10 @@ getBuildDir opts = fromMaybe "dist" (buildDir opts)
defaultDevelOpts :: DevelOpts defaultDevelOpts :: DevelOpts
defaultDevelOpts = DevelOpts False False False (-1) Nothing Nothing Nothing 3000 10 defaultDevelOpts = DevelOpts False False False (-1) Nothing Nothing Nothing 3000 10
cabalProgram :: DevelOpts -> FilePath
cabalProgram opts | isCabalDev opts = "cabal-dev"
| otherwise = "cabal"
-- | Run a reverse proxy from port 3000 to 3001. If there is no response on -- | Run a reverse proxy from port 3000 to 3001. If there is no response on
-- 3001, give an appropriate message to the user. -- 3001, give an appropriate message to the user.
reverseProxy :: DevelOpts -> I.IORef Int -> IO () reverseProxy :: DevelOpts -> I.IORef Int -> IO ()
@ -183,26 +178,34 @@ devel opts passThroughArgs = withSocketsDo $ withManager $ \manager -> do
cabal <- liftIO $ D.findPackageDesc "." cabal <- liftIO $ D.findPackageDesc "."
gpd <- liftIO $ D.readPackageDescription D.normal cabal gpd <- liftIO $ D.readPackageDescription D.normal cabal
ldar <- liftIO lookupLdAr ldar <- liftIO lookupLdAr
(hsSourceDirs, lib) <- liftIO $ checkCabalFile gpd (hsSourceDirs, _) <- liftIO $ checkCabalFile gpd
liftIO $ removeFileIfExists (bd </> "setup-config") liftIO $ removeFileIfExists (bd </> "setup-config")
liftIO $ configure cabal ghcVer gpd opts c <- liftIO $ configure opts passThroughArgs
liftIO $ removeFileIfExists "yesod-devel/ghcargs.txt" -- these files contain the wrong data after if c then do
liftIO $ removeFileIfExists "yesod-devel/arargs.txt" -- the configure step, remove them to force -- these files contain the wrong data after the configure step,
liftIO $ removeFileIfExists "yesod-devel/ldargs.txt" -- a cabal build first -- remove them to force a cabal build first
rebuild <- liftIO $ mkRebuild gpd ghcVer cabal opts ldar liftIO $ mapM_ removeFileIfExists [ "yesod-devel/ghcargs.txt"
mainInnerLoop iappPort hsSourceDirs filesModified cabal gpd lib ghcVer rebuild , "yesod-devel/arargs.txt"
, "yesod-devel/ldargs.txt"
]
rebuild <- liftIO $ mkRebuild ghcVer cabal opts ldar
mainInnerLoop iappPort hsSourceDirs filesModified cabal rebuild
else do
liftIO (threadDelay 5000000)
mainOuterLoop iappPort filesModified
-- inner loop rebuilds after files change -- inner loop rebuilds after files change
mainInnerLoop iappPort hsSourceDirs filesModified cabal gpd lib ghcVer rebuild = go mainInnerLoop 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 ghcVer (D.packageDescription gpd) lib pkgArgs <- liftIO (ghcPackageArgs opts)
let devArgs = pkgArgs ++ ["devel.hs"] ++ passThroughArgs let devArgs = pkgArgs ++ ["devel.hs"]
let loop list0 = do let loop list0 = do
(haskellFileChanged, list1) <- liftIO $ watchForChanges filesModified hsSourceDirs [cabal] list0 (eventTimeout opts) (haskellFileChanged, list1) <- liftIO $
watchForChanges filesModified hsSourceDirs [cabal] list0 (eventTimeout opts)
anyTouched <- recompDeps hsSourceDirs anyTouched <- recompDeps hsSourceDirs
unless (anyTouched || haskellFileChanged) $ loop list1 unless (anyTouched || haskellFileChanged) $ loop list1
if not success if not success
@ -249,53 +252,21 @@ runBuildHook (Just s) = do
runBuildHook Nothing = return () runBuildHook Nothing = return ()
{- {-
configure with the built-in Cabal lib for non-cabal-dev, since run `cabal configure' with our wrappers
otherwise we cannot read the configuration later
cabal-dev uses the command-line tool, we can fall back to
cabal-dev buildopts if required
-} -}
configure :: FilePath -> String -> D.GenericPackageDescription -> DevelOpts -> IO () configure :: DevelOpts -> [String] -> IO Bool
configure _cabalFile ghcVer gpd opts = do configure opts extraArgs =
lbi <- D.configure (gpd, hookedBuildInfo) configFlags checkExit =<< (createProcess $ proc (cabalProgram opts)
D.writePersistBuildConfig (getBuildDir opts) lbi -- fixme we could keep this in memory instead of file ([ "configure"
where , "-flibrary-only"
hookedBuildInfo = (Nothing, []) , "-fdevel"
configFlags0 | forceCabal opts = config , "--disable-library-profiling"
| otherwise = config , "--with-ld=yesod-ld-wrapper"
{ DSS.configProgramPaths = , "--with-ghc=yesod-ghc-wrapper"
[ ("ar", "yesod-ar-wrapper") , "--with-ar=yesod-ar-wrapper"
, ("ld", "yesod-ld-wrapper") , "--with-hc-pkg=ghc-pkg"
, ("ghc", "yesod-ghc-wrapper") ] ++ extraArgs)
] )
, DSS.configHcPkg = DSS.Flag "ghc-pkg"
}
#if MIN_VERSION_Cabal(1,16,0)
configFlags | isCabalDev opts = configFlags0
{ DSS.configPackageDBs =
[ Nothing
, Just D.GlobalPackageDB
, Just cabalDevPackageDb
]
}
#else
configFlags | isCabalDev opts = configFlags0
{ DSS.configPackageDB = DSS.Flag cabalDevPackageDb
}
#endif
| otherwise = configFlags0
cabalDevPackageDb = D.SpecificPackageDB ("cabal-dev/packages-" ++ ghcVer ++ ".conf")
config = (DSS.defaultConfigFlags D.defaultProgramConfiguration)
{ DSS.configConfigurationsFlags =
[ (D.FlagName "devel", True) -- legacy
, (D.FlagName "library-only", True)
]
, DSS.configProfLib = DSS.Flag False
, DSS.configUserInstall = DSS.Flag True
}
removeFileIfExists :: FilePath -> IO () removeFileIfExists :: FilePath -> IO ()
removeFileIfExists file = removeFile file `Ex.catch` handler removeFileIfExists file = removeFile file `Ex.catch` handler
@ -304,17 +275,17 @@ removeFileIfExists file = removeFile file `Ex.catch` handler
handler e | isDoesNotExistError e = return () handler e | isDoesNotExistError e = return ()
| otherwise = Ex.throw e | otherwise = Ex.throw e
mkRebuild :: D.GenericPackageDescription -> String -> FilePath -> DevelOpts -> (FilePath, FilePath) -> IO (IO Bool) mkRebuild :: String -> FilePath -> DevelOpts -> (FilePath, FilePath) -> IO (IO Bool)
mkRebuild gpd ghcVer cabalFile opts (ldPath, arPath) mkRebuild ghcVer cabalFile opts (ldPath, arPath)
| GHC.cProjectVersion /= ghcVer = failWith "Yesod has been compiled with a different GHC version, please reinstall" | GHC.cProjectVersion /= ghcVer =
| forceCabal opts = return (rebuildCabal gpd opts) failWith "Yesod has been compiled with a different GHC version, please reinstall"
| forceCabal opts = return (rebuildCabal opts)
| otherwise = do | otherwise = do
return $ do return $ do
n1 <- cabalFile `isNewerThan` "yesod-devel/ghcargs.txt" ns <- mapM (cabalFile `isNewerThan`)
n2 <- cabalFile `isNewerThan` "yesod-devel/arargs.txt" [ "yesod-devel/ghcargs.txt", "yesod-devel/arargs.txt", "yesod-devel/ldargs.txt" ]
n3 <- cabalFile `isNewerThan` "yesod-devel/ldargs.txt" if or ns
if n1 || n2 || n3 then rebuildCabal opts
then rebuildCabal gpd opts
else do else do
bf <- getBuildFlags bf <- getBuildFlags
rebuildGhc bf ldPath arPath rebuildGhc bf ldPath arPath
@ -325,18 +296,13 @@ rebuildGhc bf ld ar = do
putStrLn "Rebuilding application... (using GHC API)" putStrLn "Rebuilding application... (using GHC API)"
buildPackage bf ld ar buildPackage bf ld ar
rebuildCabal :: D.GenericPackageDescription -> DevelOpts -> IO Bool rebuildCabal :: DevelOpts -> IO Bool
rebuildCabal _gpd opts = do rebuildCabal opts = do
putStrLn $ "Rebuilding application... (using Cabal library)" putStrLn $ "Rebuilding application... (using " ++ cabalProgram opts ++ ")"
lbi <- getPersistBuildConfig opts -- fixme we could cache this from the configure step checkExit =<< createProcess (proc (cabalProgram opts) args)
let buildFlags | verbose opts = DSS.defaultBuildFlags where
| otherwise = DSS.defaultBuildFlags { DSS.buildVerbosity = DSS.Flag D.silent } args | verbose opts = [ "build" ]
tryBool $ D.build (D.localPkgDescr lbi) lbi buildFlags [] | otherwise = [ "build", "-v0" ]
tryBool :: IO a -> IO Bool
tryBool a = (a >> return True) `Ex.catch` \(e::Ex.SomeException) -> do
putStrLn $ "Exception: " ++ show e
return False
try_ :: forall a. IO a -> IO () try_ :: forall a. IO a -> IO ()
try_ x = (Ex.try x :: IO (Either Ex.SomeException a)) >> return () try_ x = (Ex.try x :: IO (Either Ex.SomeException a)) >> return ()
@ -421,57 +387,8 @@ ghcVersion = fmap getNumber $ readProcess "runghc" ["--numeric-version", "0"] []
where where
getNumber = filter (\x -> isNumber x || x == '.') getNumber = filter (\x -> isNumber x || x == '.')
ghcPackageArgs :: DevelOpts -> String -> D.PackageDescription -> D.Library -> IO [String] ghcPackageArgs :: DevelOpts -> IO [String]
ghcPackageArgs opts ghcVer cabal lib = do ghcPackageArgs opts = getBuildFlags >>= getPackageArgs (buildDir opts)
lbi <- getPersistBuildConfig opts
cbi <- fromMaybeErr errCbi (D.libraryConfig lbi)
if isCabalDev opts
then return ("-hide-all-packages" : "-no-user-package-conf" : inplaceConf
: selfPkgArg lbi : cabalDevConf : depArgs lbi cbi)
else return ("-hide-all-packages" : inplaceConf : selfPkgArg lbi : depArgs lbi cbi)
where
selfPkgArg lbi = pkgArg . D.inplacePackageId . D.package . D.localPkgDescr $ lbi
pkgArg (D.InstalledPackageId pkgId) = "-package-id" ++ pkgId
depArgs lbi cbi = map pkgArg (deps lbi cbi)
deps lbi cbi = let pkgInfo = D.inplaceInstalledPackageInfo "." (getBuildDir opts) cabal lib lbi cbi
in IPI.depends $ pkgInfo
errCbi = "No library ComponentBuildInfo"
cabalDevConf = "-package-confcabal-dev/packages-" ++ ghcVer ++ ".conf"
inplaceConf = "-package-conf" ++ (getBuildDir opts</>"package.conf.inplace")
getPersistBuildConfig :: DevelOpts -> IO D.LocalBuildInfo
getPersistBuildConfig opts = fromRightErr errLbi =<< getPersistConfigLenient opts -- D.maybeGetPersistBuildConfig path
where
errLbi = "Could not read BuildInfo file: " ++ D.localBuildInfoFile (getBuildDir opts) ++
"\nMake sure that cabal-install has been compiled with the same GHC version as yesod." ++
"\nand that the Cabal library used by GHC is the same version"
-- there can be slight differences in the cabal version, ignore those when loading the file as long as we can parse it
getPersistConfigLenient :: DevelOpts -> IO (Either String D.LocalBuildInfo)
getPersistConfigLenient opts = do
let file = D.localBuildInfoFile (getBuildDir opts)
exists <- doesFileExist file
if not exists
then return (Left $ "file does not exist: " ++ file)
else do
xs <- safeReadFile file
case xs of
Left e -> return $ Left $ show e
Right bs ->
return $ case lines $ T.unpack $ decodeUtf8With lenientDecode bs of
[_,l2] -> -- two lines, header and serialized rest
case reads l2 of
[(bi,_)] -> Right bi
_ -> (Left "cannot parse contents")
_ -> (Left "not a valid header/content file")
fromMaybeErr :: String -> Maybe b -> IO b
fromMaybeErr err Nothing = failWith err
fromMaybeErr _ (Just x) = return x
fromRightErr :: String -> Either String b -> IO b
fromRightErr str (Left err) = failWith (str ++ "\n" ++ err)
fromRightErr _ (Right b) = return b
lookupDevelLib :: D.GenericPackageDescription -> D.CondTree D.ConfVar c a -> Maybe a lookupDevelLib :: D.GenericPackageDescription -> D.CondTree D.ConfVar c a -> Maybe a
lookupDevelLib gpd ct | found = Just (D.condTreeData ct) lookupDevelLib gpd ct | found = Just (D.condTreeData ct)
@ -507,3 +424,7 @@ waitForProcess' pid = go
Just ec -> return ec Just ec -> return ec
Nothing -> threadDelay 100000 >> go Nothing -> threadDelay 100000 >> go
-- | wait for process started by @createProcess@, return True for ExitSuccess
checkExit :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO Bool
checkExit (_,_,_,h) = (==ExitSuccess) <$> waitForProcess' h

View File

@ -16,7 +16,7 @@
build package with the GHC API build package with the GHC API
-} -}
module GhcBuild (getBuildFlags, buildPackage) where module GhcBuild (getBuildFlags, buildPackage, getPackageArgs) where
import qualified Control.Exception as Ex import qualified Control.Exception as Ex
import Control.Monad (when) import Control.Monad (when)
@ -26,21 +26,23 @@ import System.Environment (getEnvironment)
import CmdLineParser import CmdLineParser
import Data.Char (toLower) import Data.Char (toLower)
import Data.List (isPrefixOf, partition) import Data.List (isPrefixOf, isSuffixOf, partition)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import DriverPhases (Phase (..), anyHsc, isHaskellSrcFilename, import DriverPhases (Phase (..), anyHsc, isHaskellSrcFilename,
isSourceFilename, startPhase) isSourceFilename, startPhase)
import DriverPipeline (compileFile, link, linkBinary, oneShot) import DriverPipeline (compileFile, link, linkBinary, oneShot)
import DynFlags (DynFlags, compilerInfo) import DynFlags (DynFlags, compilerInfo)
import qualified DynFlags import qualified DynFlags
import qualified DynFlags as DF
import qualified GHC import qualified GHC
import GHC.Paths (libdir) import GHC.Paths (libdir)
import HscTypes (HscEnv (..), emptyHomePackageTable) import HscTypes (HscEnv (..), emptyHomePackageTable)
import qualified Module
import MonadUtils (liftIO) import MonadUtils (liftIO)
import Panic (ghcError, panic) import Panic (ghcError, panic)
import SrcLoc (Located, mkGeneralLocated) import SrcLoc (Located, mkGeneralLocated)
import StaticFlags (v_Ld_inputs)
import qualified StaticFlags import qualified StaticFlags
import StaticFlags (v_Ld_inputs)
import System.FilePath (normalise, (</>)) import System.FilePath (normalise, (</>))
import Util (consIORef, looksLikeModuleName) import Util (consIORef, looksLikeModuleName)
@ -71,6 +73,56 @@ prependHsenvArgv argv = do
_ -> hsenvArgv ++ argv _ -> hsenvArgv ++ argv
where hsenvArgv = words $ fromMaybe "" (lookup "PACKAGE_DB_FOR_GHC" env) where hsenvArgv = words $ fromMaybe "" (lookup "PACKAGE_DB_FOR_GHC" env)
-- construct a command line for loading the right packages
getPackageArgs :: Maybe String -> [Located String] -> IO [String]
getPackageArgs buildDir argv2 = do
(mode, argv3, modeFlagWarnings) <- parseModeFlags argv2
GHC.runGhc (Just libdir) $ do
dflags0 <- GHC.getSessionDynFlags
(dflags1, _, _) <- GHC.parseDynamicFlags dflags0 argv3
let pkgFlags = map convertPkgFlag (GHC.packageFlags dflags1)
hideAll | gopt DF.Opt_HideAllPackages dflags1 = [ "-hide-all-packages"]
| otherwise = []
ownPkg = "-package-id" ++ Module.packageIdString (DF.thisPackage dflags1) ++ "-inplace"
return (extra dflags1 ++ hideAll ++ pkgFlags ++ [ownPkg])
where
convertPkgFlag (DF.ExposePackage p) = "-package" ++ p
convertPkgFlag (DF.ExposePackageId p) = "-package-id" ++ p
convertPkgFlag (DF.HidePackage p) = "-hide-package" ++ p
convertPkgFlag (DF.IgnorePackage p) = "-ignore-package" ++ p
convertPkgFlag (DF.TrustPackage p) = "-trust" ++ p
convertPkgFlag (DF.DistrustPackage p) ="-distrust" ++ p
#if __GLASGOW_HASKELL__ >= 705
extra df = inplaceConf ++ extra'
where
extra' = concatMap convertExtra (extraConfs df)
-- old cabal-install sometimes misses the .inplace db, fix it here
inplaceConf
| any (".inplace" `isSuffixOf`) extra' = []
| otherwise = ["-package-db" ++ fromMaybe "dist" buildDir
++ "/package.conf.inplace"]
extraConfs df = GHC.extraPkgConfs df []
convertExtra DF.GlobalPkgConf = [ ]
convertExtra DF.UserPkgConf = [ ]
convertExtra (DF.PkgConfFile file) = [ "-package-db" ++ file ]
#else
extra df = inplaceConf ++ extra'
where
extra' = map ("-package-conf"++) (GHC.extraPkgConfs df)
-- old cabal-install sometimes misses the .inplace db, fix it here
inplaceConf
| any (".inplace" `isSuffixOf`) extra' = []
| otherwise = ["-package-conf" ++ fromMaybe "dist" buildDir
++ "/package.conf.inplace"]
#endif
#if __GLASGOW_HASKELL__ >= 707
gopt = DF.gopt
#else
gopt = DF.dopt
#endif
buildPackage :: [Located String] -> FilePath -> FilePath -> IO Bool buildPackage :: [Located String] -> FilePath -> FilePath -> IO Bool
buildPackage a ld ar = buildPackage' a ld ar `Ex.catch` \e -> do buildPackage a ld ar = buildPackage' a ld ar `Ex.catch` \e -> do
putStrLn ("exception building package: " ++ show (e :: Ex.SomeException)) putStrLn ("exception building package: " ++ show (e :: Ex.SomeException))

View File

@ -25,7 +25,12 @@ prompt f = do
hFlush stdout hFlush stdout
prompt f prompt f
data Backend = Sqlite | Postgresql | Mysql | MongoDB | Simple data Backend = Sqlite
| Postgresql
| PostgresqlFay
| Mysql
| MongoDB
| Simple
deriving (Eq, Read, Show, Enum, Bounded) deriving (Eq, Read, Show, Enum, Bounded)
puts :: LT.Text -> IO () puts :: LT.Text -> IO ()
@ -37,6 +42,7 @@ backends = [minBound .. maxBound]
showBackend :: Backend -> String showBackend :: Backend -> String
showBackend Sqlite = "s" showBackend Sqlite = "s"
showBackend Postgresql = "p" showBackend Postgresql = "p"
showBackend PostgresqlFay = "pf"
showBackend Mysql = "mysql" showBackend Mysql = "mysql"
showBackend MongoDB = "mongo" showBackend MongoDB = "mongo"
showBackend Simple = "simple" showBackend Simple = "simple"
@ -47,6 +53,7 @@ readBackend s = lookup s $ map (showBackend &&& id) backends
backendBS :: Backend -> S.ByteString backendBS :: Backend -> S.ByteString
backendBS Sqlite = $(embedFile "hsfiles/sqlite.hsfiles") backendBS Sqlite = $(embedFile "hsfiles/sqlite.hsfiles")
backendBS Postgresql = $(embedFile "hsfiles/postgres.hsfiles") backendBS Postgresql = $(embedFile "hsfiles/postgres.hsfiles")
backendBS PostgresqlFay = $(embedFile "hsfiles/postgres-fay.hsfiles")
backendBS Mysql = $(embedFile "hsfiles/mysql.hsfiles") backendBS Mysql = $(embedFile "hsfiles/mysql.hsfiles")
backendBS MongoDB = $(embedFile "hsfiles/mongo.hsfiles") backendBS MongoDB = $(embedFile "hsfiles/mongo.hsfiles")
backendBS Simple = $(embedFile "hsfiles/simple.hsfiles") backendBS Simple = $(embedFile "hsfiles/simple.hsfiles")

View File

@ -26,9 +26,11 @@ import Yesod.Auth
import Yesod.Default.Config import Yesod.Default.Config
import Yesod.Default.Main import Yesod.Default.Main
import Yesod.Default.Handlers import Yesod.Default.Handlers
import Network.Wai.Middleware.RequestLogger (logStdout, logStdoutDev) import Network.Wai.Middleware.RequestLogger
import qualified Database.Persist.Store import qualified Database.Persist.Store
import Network.HTTP.Conduit (newManager, def) import Network.HTTP.Conduit (newManager, def)
import System.IO (stdout)
import System.Log.FastLogger (mkLogger)
-- Import all relevant handler modules here. -- Import all relevant handler modules here.
-- Don't forget to add new modules to your cabal file! -- Don't forget to add new modules to your cabal file!
@ -46,12 +48,22 @@ mkYesodDispatch "App" resourcesApp
makeApplication :: AppConfig DefaultEnv Extra -> IO Application makeApplication :: AppConfig DefaultEnv Extra -> IO Application
makeApplication conf = do makeApplication conf = do
foundation <- makeFoundation conf foundation <- makeFoundation conf
-- Initialize the logging middleware
logWare <- mkRequestLogger def
{ outputFormat =
if development
then Detailed True
else Apache FromSocket
, destination = Logger $ appLogger foundation
}
-- Create the WAI application and apply middlewares
app <- toWaiAppPlain foundation app <- toWaiAppPlain foundation
return $ logWare app return $ logWare app
where
logWare = if development then logStdoutDev
else logStdout
-- | Loads up any necessary settings, creates your foundation datatype, and
-- performs some initialization.
makeFoundation :: AppConfig DefaultEnv Extra -> IO App makeFoundation :: AppConfig DefaultEnv Extra -> IO App
makeFoundation conf = do makeFoundation conf = do
manager <- newManager def manager <- newManager def
@ -60,7 +72,10 @@ makeFoundation conf = do
Database.Persist.Store.loadConfig >>= Database.Persist.Store.loadConfig >>=
Database.Persist.Store.applyEnv Database.Persist.Store.applyEnv
p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig) p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig)
return $ App conf s p manager dbconf logger <- mkLogger True stdout
let foundation = App conf s p manager dbconf logger
return foundation
-- for yesod devel -- for yesod devel
getApplicationDev :: IO (Int, Application) getApplicationDev :: IO (Int, Application)
@ -93,6 +108,7 @@ import Model
import Text.Jasmine (minifym) import Text.Jasmine (minifym)
import Web.ClientSession (getKey) import Web.ClientSession (getKey)
import Text.Hamlet (hamletFile) import Text.Hamlet (hamletFile)
import System.Log.FastLogger (Logger)
-- | The site argument for your application. This can be a good place to -- | The site argument for your application. This can be a good place to
-- keep settings and values requiring initialization before your application -- keep settings and values requiring initialization before your application
@ -104,6 +120,7 @@ data App = App
, connPool :: Database.Persist.Store.PersistConfigPool Settings.PersistConfig -- ^ Database connection pool. , connPool :: Database.Persist.Store.PersistConfigPool Settings.PersistConfig -- ^ Database connection pool.
, httpManager :: Manager , httpManager :: Manager
, persistConfig :: Settings.PersistConfig , persistConfig :: Settings.PersistConfig
, appLogger :: Logger
} }
-- Set up i18n messages. See the message folder. -- Set up i18n messages. See the message folder.
@ -190,6 +207,8 @@ instance Yesod App where
shouldLog _ _source level = shouldLog _ _source level =
development || level == LevelWarn || level == LevelError development || level == LevelWarn || level == LevelError
getLogger = return . appLogger
-- How to run database actions. -- How to run database actions.
instance YesodPersist App where instance YesodPersist App where
type YesodPersistBackend App = Action type YesodPersistBackend App = Action
@ -394,11 +413,14 @@ library
, monad-control >= 0.3 && < 0.4 , monad-control >= 0.3 && < 0.4
, wai-extra >= 1.3 && < 1.4 , wai-extra >= 1.3 && < 1.4
, yaml >= 0.8 && < 0.9 , yaml >= 0.8 && < 0.9
, http-conduit >= 1.8 && < 1.9 , http-conduit >= 1.8 && < 1.10
, directory >= 1.1 && < 1.3 , directory >= 1.1 && < 1.3
, warp >= 1.3 && < 1.4 , warp >= 1.3 && < 1.4
, data-default , data-default
, aeson , aeson
, conduit >= 1.0
, monad-logger >= 0.3
, fast-logger >= 0.3
executable PROJECTNAME executable PROJECTNAME
if flag(library-only) if flag(library-only)
@ -426,6 +448,7 @@ test-suite test
, persistent , persistent
, persistent-mongoDB , persistent-mongoDB
, resourcet , resourcet
, monad-logger
{-# START_FILE Settings.hs #-} {-# START_FILE Settings.hs #-}
-- | Settings are centralized, as much as possible, into this file. This -- | Settings are centralized, as much as possible, into this file. This
@ -5773,15 +5796,18 @@ import Yesod.Test
import Database.Persist hiding (get) import Database.Persist hiding (get)
import Database.Persist.MongoDB hiding (master) import Database.Persist.MongoDB hiding (master)
import Control.Monad.Trans.Resource (ResourceT, runResourceT) import Control.Monad.Trans.Resource (ResourceT, runResourceT)
import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
import Model import Model
type Specs = SpecsConn Connection type Specs = SpecsConn Connection
runDB :: Action (ResourceT IO) a -> OneSpec Connection a runDB :: Action (NoLoggingT (ResourceT IO)) a -> OneSpec Connection a
runDB = runDBRunner poolRunner runDB = runDBRunner poolRunner
where where
poolRunner query pool = runResourceT $ runMongoDBPoolDef query pool poolRunner query pool = runResourceT
$ runNoLoggingT
$ runMongoDBPoolDef query pool
{-# START_FILE tests/main.hs #-} {-# START_FILE tests/main.hs #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}

View File

@ -26,10 +26,13 @@ import Yesod.Auth
import Yesod.Default.Config import Yesod.Default.Config
import Yesod.Default.Main import Yesod.Default.Main
import Yesod.Default.Handlers import Yesod.Default.Handlers
import Network.Wai.Middleware.RequestLogger (logStdout, logStdoutDev) import Network.Wai.Middleware.RequestLogger
import qualified Database.Persist.Store import qualified Database.Persist.Store
import Database.Persist.GenericSql (runMigration) import Database.Persist.GenericSql (runMigration)
import Network.HTTP.Conduit (newManager, def) import Network.HTTP.Conduit (newManager, def)
import Control.Monad.Logger (runLoggingT)
import System.IO (stdout)
import System.Log.FastLogger (mkLogger)
-- Import all relevant handler modules here. -- Import all relevant handler modules here.
-- Don't forget to add new modules to your cabal file! -- Don't forget to add new modules to your cabal file!
@ -47,12 +50,22 @@ mkYesodDispatch "App" resourcesApp
makeApplication :: AppConfig DefaultEnv Extra -> IO Application makeApplication :: AppConfig DefaultEnv Extra -> IO Application
makeApplication conf = do makeApplication conf = do
foundation <- makeFoundation conf foundation <- makeFoundation conf
-- Initialize the logging middleware
logWare <- mkRequestLogger def
{ outputFormat =
if development
then Detailed True
else Apache FromSocket
, destination = Logger $ appLogger foundation
}
-- Create the WAI application and apply middlewares
app <- toWaiAppPlain foundation app <- toWaiAppPlain foundation
return $ logWare app return $ logWare app
where
logWare = if development then logStdoutDev
else logStdout
-- | Loads up any necessary settings, creates your foundation datatype, and
-- performs some initialization.
makeFoundation :: AppConfig DefaultEnv Extra -> IO App makeFoundation :: AppConfig DefaultEnv Extra -> IO App
makeFoundation conf = do makeFoundation conf = do
manager <- newManager def manager <- newManager def
@ -61,8 +74,15 @@ makeFoundation conf = do
Database.Persist.Store.loadConfig >>= Database.Persist.Store.loadConfig >>=
Database.Persist.Store.applyEnv Database.Persist.Store.applyEnv
p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig) p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig)
Database.Persist.Store.runPool dbconf (runMigration migrateAll) p logger <- mkLogger True stdout
return $ App conf s p manager dbconf let foundation = App conf s p manager dbconf logger
-- Perform database migration using our application's logging settings.
runLoggingT
(Database.Persist.Store.runPool dbconf (runMigration migrateAll) p)
(messageLoggerSource foundation logger)
return foundation
-- for yesod devel -- for yesod devel
getApplicationDev :: IO (Int, Application) getApplicationDev :: IO (Int, Application)
@ -95,6 +115,7 @@ import Model
import Text.Jasmine (minifym) import Text.Jasmine (minifym)
import Web.ClientSession (getKey) import Web.ClientSession (getKey)
import Text.Hamlet (hamletFile) import Text.Hamlet (hamletFile)
import System.Log.FastLogger (Logger)
-- | The site argument for your application. This can be a good place to -- | The site argument for your application. This can be a good place to
-- keep settings and values requiring initialization before your application -- keep settings and values requiring initialization before your application
@ -106,6 +127,7 @@ data App = App
, connPool :: Database.Persist.Store.PersistConfigPool Settings.PersistConfig -- ^ Database connection pool. , connPool :: Database.Persist.Store.PersistConfigPool Settings.PersistConfig -- ^ Database connection pool.
, httpManager :: Manager , httpManager :: Manager
, persistConfig :: Settings.PersistConfig , persistConfig :: Settings.PersistConfig
, appLogger :: Logger
} }
-- Set up i18n messages. See the message folder. -- Set up i18n messages. See the message folder.
@ -192,6 +214,8 @@ instance Yesod App where
shouldLog _ _source level = shouldLog _ _source level =
development || level == LevelWarn || level == LevelError development || level == LevelWarn || level == LevelError
getLogger = return . appLogger
-- How to run database actions. -- How to run database actions.
instance YesodPersist App where instance YesodPersist App where
type YesodPersistBackend App = SqlPersist type YesodPersistBackend App = SqlPersist
@ -392,11 +416,14 @@ library
, monad-control >= 0.3 && < 0.4 , monad-control >= 0.3 && < 0.4
, wai-extra >= 1.3 && < 1.4 , wai-extra >= 1.3 && < 1.4
, yaml >= 0.8 && < 0.9 , yaml >= 0.8 && < 0.9
, http-conduit >= 1.8 && < 1.9 , http-conduit >= 1.8 && < 1.10
, directory >= 1.1 && < 1.3 , directory >= 1.1 && < 1.3
, warp >= 1.3 && < 1.4 , warp >= 1.3 && < 1.4
, data-default , data-default
, aeson , aeson
, conduit >= 1.0
, monad-logger >= 0.3
, fast-logger >= 0.3
executable PROJECTNAME executable PROJECTNAME
if flag(library-only) if flag(library-only)
@ -424,6 +451,7 @@ test-suite test
, persistent , persistent
, persistent-mysql , persistent-mysql
, resourcet , resourcet
, monad-logger
{-# START_FILE Settings.hs #-} {-# START_FILE Settings.hs #-}
-- | Settings are centralized, as much as possible, into this file. This -- | Settings are centralized, as much as possible, into this file. This
@ -5797,15 +5825,18 @@ import Yesod.Test
import Database.Persist hiding (get) import Database.Persist hiding (get)
import Database.Persist.GenericSql (runSqlPool, SqlPersist, Connection) import Database.Persist.GenericSql (runSqlPool, SqlPersist, Connection)
import Control.Monad.Trans.Resource (ResourceT, runResourceT) import Control.Monad.Trans.Resource (ResourceT, runResourceT)
import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
import Model import Model
type Specs = SpecsConn Connection type Specs = SpecsConn Connection
runDB :: SqlPersist (ResourceT IO) a -> OneSpec Connection a runDB :: SqlPersist (NoLoggingT (ResourceT IO)) a -> OneSpec Connection a
runDB = runDBRunner poolRunner runDB = runDBRunner poolRunner
where where
poolRunner query pool = runResourceT $ runSqlPool query pool poolRunner query pool = runResourceT
$ runNoLoggingT
$ runSqlPool query pool
{-# START_FILE tests/main.hs #-} {-# START_FILE tests/main.hs #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}

File diff suppressed because it is too large Load Diff

View File

@ -26,10 +26,13 @@ import Yesod.Auth
import Yesod.Default.Config import Yesod.Default.Config
import Yesod.Default.Main import Yesod.Default.Main
import Yesod.Default.Handlers import Yesod.Default.Handlers
import Network.Wai.Middleware.RequestLogger (logStdout, logStdoutDev) import Network.Wai.Middleware.RequestLogger
import qualified Database.Persist.Store import qualified Database.Persist.Store
import Database.Persist.GenericSql (runMigration) import Database.Persist.GenericSql (runMigration)
import Network.HTTP.Conduit (newManager, def) import Network.HTTP.Conduit (newManager, def)
import Control.Monad.Logger (runLoggingT)
import System.IO (stdout)
import System.Log.FastLogger (mkLogger)
-- Import all relevant handler modules here. -- Import all relevant handler modules here.
-- Don't forget to add new modules to your cabal file! -- Don't forget to add new modules to your cabal file!
@ -47,12 +50,22 @@ mkYesodDispatch "App" resourcesApp
makeApplication :: AppConfig DefaultEnv Extra -> IO Application makeApplication :: AppConfig DefaultEnv Extra -> IO Application
makeApplication conf = do makeApplication conf = do
foundation <- makeFoundation conf foundation <- makeFoundation conf
-- Initialize the logging middleware
logWare <- mkRequestLogger def
{ outputFormat =
if development
then Detailed True
else Apache FromSocket
, destination = Logger $ appLogger foundation
}
-- Create the WAI application and apply middlewares
app <- toWaiAppPlain foundation app <- toWaiAppPlain foundation
return $ logWare app return $ logWare app
where
logWare = if development then logStdoutDev
else logStdout
-- | Loads up any necessary settings, creates your foundation datatype, and
-- performs some initialization.
makeFoundation :: AppConfig DefaultEnv Extra -> IO App makeFoundation :: AppConfig DefaultEnv Extra -> IO App
makeFoundation conf = do makeFoundation conf = do
manager <- newManager def manager <- newManager def
@ -61,8 +74,15 @@ makeFoundation conf = do
Database.Persist.Store.loadConfig >>= Database.Persist.Store.loadConfig >>=
Database.Persist.Store.applyEnv Database.Persist.Store.applyEnv
p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig) p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig)
Database.Persist.Store.runPool dbconf (runMigration migrateAll) p logger <- mkLogger True stdout
return $ App conf s p manager dbconf let foundation = App conf s p manager dbconf logger
-- Perform database migration using our application's logging settings.
runLoggingT
(Database.Persist.Store.runPool dbconf (runMigration migrateAll) p)
(messageLoggerSource foundation logger)
return foundation
-- for yesod devel -- for yesod devel
getApplicationDev :: IO (Int, Application) getApplicationDev :: IO (Int, Application)
@ -95,6 +115,7 @@ import Model
import Text.Jasmine (minifym) import Text.Jasmine (minifym)
import Web.ClientSession (getKey) import Web.ClientSession (getKey)
import Text.Hamlet (hamletFile) import Text.Hamlet (hamletFile)
import System.Log.FastLogger (Logger)
-- | The site argument for your application. This can be a good place to -- | The site argument for your application. This can be a good place to
-- keep settings and values requiring initialization before your application -- keep settings and values requiring initialization before your application
@ -106,6 +127,7 @@ data App = App
, connPool :: Database.Persist.Store.PersistConfigPool Settings.PersistConfig -- ^ Database connection pool. , connPool :: Database.Persist.Store.PersistConfigPool Settings.PersistConfig -- ^ Database connection pool.
, httpManager :: Manager , httpManager :: Manager
, persistConfig :: Settings.PersistConfig , persistConfig :: Settings.PersistConfig
, appLogger :: Logger
} }
-- Set up i18n messages. See the message folder. -- Set up i18n messages. See the message folder.
@ -192,6 +214,8 @@ instance Yesod App where
shouldLog _ _source level = shouldLog _ _source level =
development || level == LevelWarn || level == LevelError development || level == LevelWarn || level == LevelError
getLogger = return . appLogger
-- How to run database actions. -- How to run database actions.
instance YesodPersist App where instance YesodPersist App where
type YesodPersistBackend App = SqlPersist type YesodPersistBackend App = SqlPersist
@ -392,11 +416,14 @@ library
, monad-control >= 0.3 && < 0.4 , monad-control >= 0.3 && < 0.4
, wai-extra >= 1.3 && < 1.4 , wai-extra >= 1.3 && < 1.4
, yaml >= 0.8 && < 0.9 , yaml >= 0.8 && < 0.9
, http-conduit >= 1.8 && < 1.9 , http-conduit >= 1.8 && < 1.10
, directory >= 1.1 && < 1.3 , directory >= 1.1 && < 1.3
, warp >= 1.3 && < 1.4 , warp >= 1.3 && < 1.4
, data-default , data-default
, aeson , aeson
, conduit >= 1.0
, monad-logger >= 0.3
, fast-logger >= 0.3
executable PROJECTNAME executable PROJECTNAME
if flag(library-only) if flag(library-only)
@ -424,6 +451,7 @@ test-suite test
, persistent , persistent
, persistent-postgresql , persistent-postgresql
, resourcet , resourcet
, monad-logger
{-# START_FILE Settings.hs #-} {-# START_FILE Settings.hs #-}
-- | Settings are centralized, as much as possible, into this file. This -- | Settings are centralized, as much as possible, into this file. This
@ -5771,15 +5799,18 @@ import Yesod.Test
import Database.Persist hiding (get) import Database.Persist hiding (get)
import Database.Persist.GenericSql (runSqlPool, SqlPersist, Connection) import Database.Persist.GenericSql (runSqlPool, SqlPersist, Connection)
import Control.Monad.Trans.Resource (ResourceT, runResourceT) import Control.Monad.Trans.Resource (ResourceT, runResourceT)
import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
import Model import Model
type Specs = SpecsConn Connection type Specs = SpecsConn Connection
runDB :: SqlPersist (ResourceT IO) a -> OneSpec Connection a runDB :: SqlPersist (NoLoggingT (ResourceT IO)) a -> OneSpec Connection a
runDB = runDBRunner poolRunner runDB = runDBRunner poolRunner
where where
poolRunner query pool = runResourceT $ runSqlPool query pool poolRunner query pool = runResourceT
$ runNoLoggingT
$ runSqlPool query pool
{-# START_FILE tests/main.hs #-} {-# START_FILE tests/main.hs #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}

View File

@ -24,8 +24,11 @@ import Import
import Yesod.Default.Config import Yesod.Default.Config
import Yesod.Default.Main import Yesod.Default.Main
import Yesod.Default.Handlers import Yesod.Default.Handlers
import Network.Wai.Middleware.RequestLogger (logStdout, logStdoutDev) import Network.Wai.Middleware.RequestLogger
import Network.HTTP.Conduit (newManager, def) import Network.HTTP.Conduit (newManager, def)
import Control.Monad.Logger (runLoggingT)
import System.IO (stdout)
import System.Log.FastLogger (mkLogger)
-- Import all relevant handler modules here. -- Import all relevant handler modules here.
-- Don't forget to add new modules to your cabal file! -- Don't forget to add new modules to your cabal file!
@ -43,17 +46,30 @@ mkYesodDispatch "App" resourcesApp
makeApplication :: AppConfig DefaultEnv Extra -> IO Application makeApplication :: AppConfig DefaultEnv Extra -> IO Application
makeApplication conf = do makeApplication conf = do
foundation <- makeFoundation conf foundation <- makeFoundation conf
-- Initialize the logging middleware
logWare <- mkRequestLogger def
{ outputFormat =
if development
then Detailed True
else Apache FromSocket
, destination = Logger $ appLogger foundation
}
-- Create the WAI application and apply middlewares
app <- toWaiAppPlain foundation app <- toWaiAppPlain foundation
return $ logWare app return $ logWare app
where
logWare = if development then logStdoutDev
else logStdout
-- | Loads up any necessary settings, creates your foundation datatype, and
-- performs some initialization.
makeFoundation :: AppConfig DefaultEnv Extra -> IO App makeFoundation :: AppConfig DefaultEnv Extra -> IO App
makeFoundation conf = do makeFoundation conf = do
manager <- newManager def manager <- newManager def
s <- staticSite s <- staticSite
return $ App conf s manager logger <- mkLogger True stdout
let foundation = App conf s manager logger
return foundation
-- for yesod devel -- for yesod devel
getApplicationDev :: IO (Int, Application) getApplicationDev :: IO (Int, Application)
@ -80,6 +96,7 @@ import Settings (widgetFile, Extra (..))
import Text.Jasmine (minifym) import Text.Jasmine (minifym)
import Web.ClientSession (getKey) import Web.ClientSession (getKey)
import Text.Hamlet (hamletFile) import Text.Hamlet (hamletFile)
import System.Log.FastLogger (Logger)
-- | The site argument for your application. This can be a good place to -- | The site argument for your application. This can be a good place to
-- keep settings and values requiring initialization before your application -- keep settings and values requiring initialization before your application
@ -89,6 +106,7 @@ data App = App
{ settings :: AppConfig DefaultEnv Extra { settings :: AppConfig DefaultEnv Extra
, getStatic :: Static -- ^ Settings for static file serving. , getStatic :: Static -- ^ Settings for static file serving.
, httpManager :: Manager , httpManager :: Manager
, appLogger :: Logger
} }
-- Set up i18n messages. See the message folder. -- Set up i18n messages. See the message folder.
@ -172,6 +190,8 @@ instance Yesod App where
shouldLog _ _source level = shouldLog _ _source level =
development || level == LevelWarn || level == LevelError development || level == LevelWarn || level == LevelError
getLogger = return . appLogger
-- This instance is required to use forms. You can modify renderMessage to -- This instance is required to use forms. You can modify renderMessage to
-- achieve customized and internationalized form validation messages. -- achieve customized and internationalized form validation messages.
instance RenderMessage App FormMessage where instance RenderMessage App FormMessage where
@ -320,11 +340,14 @@ library
, monad-control >= 0.3 && < 0.4 , monad-control >= 0.3 && < 0.4
, wai-extra >= 1.3 && < 1.4 , wai-extra >= 1.3 && < 1.4
, yaml >= 0.8 && < 0.9 , yaml >= 0.8 && < 0.9
, http-conduit >= 1.8 && < 1.9 , http-conduit >= 1.8 && < 1.10
, directory >= 1.1 && < 1.3 , directory >= 1.1 && < 1.3
, warp >= 1.3 && < 1.4 , warp >= 1.3 && < 1.4
, data-default , data-default
, aeson , aeson
, conduit >= 1.0
, monad-logger >= 0.3
, fast-logger >= 0.3
executable PROJECTNAME executable PROJECTNAME
if flag(library-only) if flag(library-only)

View File

@ -26,10 +26,13 @@ import Yesod.Auth
import Yesod.Default.Config import Yesod.Default.Config
import Yesod.Default.Main import Yesod.Default.Main
import Yesod.Default.Handlers import Yesod.Default.Handlers
import Network.Wai.Middleware.RequestLogger (logStdout, logStdoutDev) import Network.Wai.Middleware.RequestLogger
import qualified Database.Persist.Store import qualified Database.Persist.Store
import Database.Persist.GenericSql (runMigration) import Database.Persist.GenericSql (runMigration)
import Network.HTTP.Conduit (newManager, def) import Network.HTTP.Conduit (newManager, def)
import Control.Monad.Logger (runLoggingT)
import System.IO (stdout)
import System.Log.FastLogger (mkLogger)
-- Import all relevant handler modules here. -- Import all relevant handler modules here.
-- Don't forget to add new modules to your cabal file! -- Don't forget to add new modules to your cabal file!
@ -47,12 +50,22 @@ mkYesodDispatch "App" resourcesApp
makeApplication :: AppConfig DefaultEnv Extra -> IO Application makeApplication :: AppConfig DefaultEnv Extra -> IO Application
makeApplication conf = do makeApplication conf = do
foundation <- makeFoundation conf foundation <- makeFoundation conf
-- Initialize the logging middleware
logWare <- mkRequestLogger def
{ outputFormat =
if development
then Detailed True
else Apache FromSocket
, destination = Logger $ appLogger foundation
}
-- Create the WAI application and apply middlewares
app <- toWaiAppPlain foundation app <- toWaiAppPlain foundation
return $ logWare app return $ logWare app
where
logWare = if development then logStdoutDev
else logStdout
-- | Loads up any necessary settings, creates your foundation datatype, and
-- performs some initialization.
makeFoundation :: AppConfig DefaultEnv Extra -> IO App makeFoundation :: AppConfig DefaultEnv Extra -> IO App
makeFoundation conf = do makeFoundation conf = do
manager <- newManager def manager <- newManager def
@ -61,8 +74,15 @@ makeFoundation conf = do
Database.Persist.Store.loadConfig >>= Database.Persist.Store.loadConfig >>=
Database.Persist.Store.applyEnv Database.Persist.Store.applyEnv
p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig) p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig)
Database.Persist.Store.runPool dbconf (runMigration migrateAll) p logger <- mkLogger True stdout
return $ App conf s p manager dbconf let foundation = App conf s p manager dbconf logger
-- Perform database migration using our application's logging settings.
runLoggingT
(Database.Persist.Store.runPool dbconf (runMigration migrateAll) p)
(messageLoggerSource foundation logger)
return foundation
-- for yesod devel -- for yesod devel
getApplicationDev :: IO (Int, Application) getApplicationDev :: IO (Int, Application)
@ -95,6 +115,7 @@ import Model
import Text.Jasmine (minifym) import Text.Jasmine (minifym)
import Web.ClientSession (getKey) import Web.ClientSession (getKey)
import Text.Hamlet (hamletFile) import Text.Hamlet (hamletFile)
import System.Log.FastLogger (Logger)
-- | The site argument for your application. This can be a good place to -- | The site argument for your application. This can be a good place to
-- keep settings and values requiring initialization before your application -- keep settings and values requiring initialization before your application
@ -106,6 +127,7 @@ data App = App
, connPool :: Database.Persist.Store.PersistConfigPool Settings.PersistConfig -- ^ Database connection pool. , connPool :: Database.Persist.Store.PersistConfigPool Settings.PersistConfig -- ^ Database connection pool.
, httpManager :: Manager , httpManager :: Manager
, persistConfig :: Settings.PersistConfig , persistConfig :: Settings.PersistConfig
, appLogger :: Logger
} }
-- Set up i18n messages. See the message folder. -- Set up i18n messages. See the message folder.
@ -192,6 +214,8 @@ instance Yesod App where
shouldLog _ _source level = shouldLog _ _source level =
development || level == LevelWarn || level == LevelError development || level == LevelWarn || level == LevelError
getLogger = return . appLogger
-- How to run database actions. -- How to run database actions.
instance YesodPersist App where instance YesodPersist App where
type YesodPersistBackend App = SqlPersist type YesodPersistBackend App = SqlPersist
@ -392,11 +416,14 @@ library
, monad-control >= 0.3 && < 0.4 , monad-control >= 0.3 && < 0.4
, wai-extra >= 1.3 && < 1.4 , wai-extra >= 1.3 && < 1.4
, yaml >= 0.8 && < 0.9 , yaml >= 0.8 && < 0.9
, http-conduit >= 1.8 && < 1.9 , http-conduit >= 1.8 && < 1.10
, directory >= 1.1 && < 1.3 , directory >= 1.1 && < 1.3
, warp >= 1.3 && < 1.4 , warp >= 1.3 && < 1.4
, data-default , data-default
, aeson , aeson
, conduit >= 1.0
, monad-logger >= 0.3
, fast-logger >= 0.3
executable PROJECTNAME executable PROJECTNAME
if flag(library-only) if flag(library-only)
@ -424,6 +451,7 @@ test-suite test
, persistent , persistent
, persistent-sqlite , persistent-sqlite
, resourcet , resourcet
, monad-logger
{-# START_FILE Settings.hs #-} {-# START_FILE Settings.hs #-}
-- | Settings are centralized, as much as possible, into this file. This -- | Settings are centralized, as much as possible, into this file. This
@ -5767,15 +5795,18 @@ import Yesod.Test
import Database.Persist hiding (get) import Database.Persist hiding (get)
import Database.Persist.GenericSql (runSqlPool, SqlPersist, Connection) import Database.Persist.GenericSql (runSqlPool, SqlPersist, Connection)
import Control.Monad.Trans.Resource (ResourceT, runResourceT) import Control.Monad.Trans.Resource (ResourceT, runResourceT)
import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
import Model import Model
type Specs = SpecsConn Connection type Specs = SpecsConn Connection
runDB :: SqlPersist (ResourceT IO) a -> OneSpec Connection a runDB :: SqlPersist (NoLoggingT (ResourceT IO)) a -> OneSpec Connection a
runDB = runDBRunner poolRunner runDB = runDBRunner poolRunner
where where
poolRunner query pool = runResourceT $ runSqlPool query pool poolRunner query pool = runResourceT
$ runNoLoggingT
$ runSqlPool query pool
{-# START_FILE tests/main.hs #-} {-# START_FILE tests/main.hs #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}

View File

@ -4,6 +4,7 @@ We recommend starting with SQLite: it has no dependencies.
s = sqlite s = sqlite
p = postgresql p = postgresql
pf = postgresql + Fay (experimental)
mongo = mongodb mongo = mongodb
mysql = MySQL mysql = MySQL
simple = no database, no auth simple = no database, no auth

View File

@ -1,5 +1,5 @@
name: yesod name: yesod
version: 1.1.8 version: 1.1.9.2
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>
@ -22,6 +22,7 @@ extra-source-files:
hsfiles/mongo.hsfiles hsfiles/mongo.hsfiles
hsfiles/mysql.hsfiles hsfiles/mysql.hsfiles
hsfiles/postgres.hsfiles hsfiles/postgres.hsfiles
hsfiles/postgres-fay.hsfiles
hsfiles/simple.hsfiles hsfiles/simple.hsfiles
hsfiles/sqlite.hsfiles hsfiles/sqlite.hsfiles
@ -34,14 +35,14 @@ library
, yesod-default >= 1.1.3 && < 1.2 , yesod-default >= 1.1.3 && < 1.2
, monad-control >= 0.3 && < 0.4 , monad-control >= 0.3 && < 0.4
, transformers >= 0.2.2 && < 0.4 , transformers >= 0.2.2 && < 0.4
, wai >= 1.3 && < 1.4 , wai >= 1.3 && < 1.5
, wai-extra >= 1.3 && < 1.4 , wai-extra >= 1.3 && < 1.4
, hamlet >= 1.1 && < 1.2 , hamlet >= 1.1 && < 1.2
, shakespeare-js >= 1.0.2 && < 1.2 , shakespeare-js >= 1.0.2 && < 1.2
, shakespeare-css >= 1.0 && < 1.1 , shakespeare-css >= 1.0 && < 1.1
, warp >= 1.3 && < 1.4 , warp >= 1.3 && < 1.4
, blaze-html >= 0.5 && < 0.6 , blaze-html >= 0.5
, blaze-markup >= 0.5.1 && < 0.6 , blaze-markup >= 0.5.1
, aeson , aeson
exposed-modules: Yesod exposed-modules: Yesod
@ -100,7 +101,7 @@ executable yesod
, fsnotify >= 0.0 && < 0.1 , fsnotify >= 0.0 && < 0.1
, split >= 0.2 && < 0.3 , split >= 0.2 && < 0.3
, file-embed , file-embed
, conduit >= 0.5 && < 0.6 , conduit >= 0.5 && < 1.1
, resourcet >= 0.3 && < 0.5 , resourcet >= 0.3 && < 0.5
, base64-bytestring , base64-bytestring
, lifted-base , lifted-base