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

conduit 0.3

Browse Source
This commit is contained in:
Michael Snoyman 2012-03-12 13:40:04 +02:00
parent b5f2e4863d
commit cbd0719f37
32 changed files with 129 additions and 178 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitmodules vendored
View File

@ -12,7 +12,7 @@
url = https://github.com/snoyberg/xml url = https://github.com/snoyberg/xml
[submodule "crypto-conduit"] [submodule "crypto-conduit"]
path = crypto-conduit path = crypto-conduit
url = https://github.com/snoyberg/crypto-conduit url = https://github.com/snoyberg/crypto-conduit.git
[submodule "yaml"] [submodule "yaml"]
path = yaml path = yaml
url = https://github.com/snoyberg/yaml url = https://github.com/snoyberg/yaml

1
authenticate Submodule

@ -0,0 +1 @@
Subproject commit c61c883be061b86d38b87f4da302a76074c21956

1
crypto-conduit Submodule

@ -0,0 +1 @@
Subproject commit 26697093384afe848b834270c58229dac822f70d

2
package-list.sh
View File

@ -3,6 +3,8 @@
pkgs=( ./yesod-routes pkgs=( ./yesod-routes
./yesod-core ./yesod-core
./yesod-json ./yesod-json
./crypto-conduit
./authenticate/authenticate
./yesod-static ./yesod-static
./yesod-persistent ./yesod-persistent
./yesod-newsfeed ./yesod-newsfeed

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

@ -27,8 +27,6 @@ module Yesod.Auth
, AuthException (..) , AuthException (..)
) where ) where
#include "qq.h"
import Control.Monad (when) import Control.Monad (when)
import Control.Monad.Trans.Maybe import Control.Monad.Trans.Maybe
@ -132,7 +130,7 @@ mkYesodSub "Auth"
[ ClassP ''YesodAuth [VarT $ mkName "master"] [ ClassP ''YesodAuth [VarT $ mkName "master"]
] ]
#define STRINGS *Texts #define STRINGS *Texts
[QQ(parseRoutes)| [parseRoutes|
/check CheckR GET /check CheckR GET
/login LoginR GET /login LoginR GET
/logout LogoutR GET POST /logout LogoutR GET POST
@ -151,7 +149,7 @@ setCreds doRedirects creds = do
Nothing -> Nothing ->
when doRedirects $ do when doRedirects $ do
case authRoute y of case authRoute y of
Nothing -> do rh <- defaultLayout $ addHtml [QQ(shamlet)| <h1>Invalid login |] Nothing -> do rh <- defaultLayout $ addHtml [shamlet| <h1>Invalid login |]
sendResponse rh sendResponse rh
Just ar -> do setMessageI Msg.InvalidLogin Just ar -> do setMessageI Msg.InvalidLogin
redirect ar redirect ar
@ -169,7 +167,7 @@ getCheckR = do
addHtml $ html' creds) (jsonCreds creds) addHtml $ html' creds) (jsonCreds creds)
where where
html' creds = html' creds =
[QQ(shamlet)| [shamlet|
<h1>Authentication Status <h1>Authentication Status
$maybe _ <- creds $maybe _ <- creds
<p>Logged in. <p>Logged in.

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

@ -16,8 +16,6 @@ import Data.Maybe (fromMaybe)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Exception (throwIO) import Control.Exception (throwIO)
#include "qq.h"
pid :: Text pid :: Text
pid = "browserid" pid = "browserid"
@ -64,7 +62,7 @@ helper maudience = AuthPlugin
_ -> notFound _ -> notFound
, apLogin = \toMaster -> do , apLogin = \toMaster -> do
addScriptRemote browserIdJs addScriptRemote browserIdJs
addHamlet [QQ(hamlet)| addHamlet [hamlet|
<p> <p>
<a href="javascript:navigator.id.getVerifiedEmail(function(a){if(a)document.location='@{toMaster complete}/'+a});"> <a href="javascript:navigator.id.getVerifiedEmail(function(a){if(a)document.location='@{toMaster complete}/'+a});">
<img src="https://browserid.org/i/sign_in_green.png"> <img src="https://browserid.org/i/sign_in_green.png">

6
yesod-auth/Yesod/Auth/Dummy.hs
View File

@ -8,8 +8,6 @@ module Yesod.Auth.Dummy
( authDummy ( authDummy
) where ) where
#include "qq.h"
import Yesod.Auth import Yesod.Auth
import Yesod.Form (runInputPost, textField, ireq) import Yesod.Form (runInputPost, textField, ireq)
import Yesod.Handler (notFound) import Yesod.Handler (notFound)
@ -26,9 +24,9 @@ authDummy =
dispatch _ _ = notFound dispatch _ _ = notFound
url = PluginR "dummy" [] url = PluginR "dummy" []
login authToMaster = login authToMaster =
addHamlet [QQ(hamlet)| addHamlet [hamlet|
<form method="post" action="@{authToMaster url}"> <form method="post" action="@{authToMaster url}">
\Your new identifier is: Your new identifier is: #
<input type="text" name="ident"> <input type="text" name="ident">
<input type="submit" value="Dummy Login"> <input type="submit" value="Dummy Login">
|] |]

12
yesod-auth/Yesod/Auth/Email.hs
View File

@ -15,8 +15,6 @@ module Yesod.Auth.Email
, isValidPass , isValidPass
) where ) where
#include "qq.h"
import Network.Mail.Mime (randomString) import Network.Mail.Mime (randomString)
import Yesod.Auth import Yesod.Auth
import System.Random import System.Random
@ -82,7 +80,7 @@ class (YesodAuth m, PathPiece (AuthEmailId m)) => YesodAuthEmail m where
authEmail :: YesodAuthEmail m => AuthPlugin m authEmail :: YesodAuthEmail m => AuthPlugin m
authEmail = authEmail =
AuthPlugin "email" dispatch $ \tm -> AuthPlugin "email" dispatch $ \tm ->
[QQ(whamlet)| [whamlet|
<form method="post" action="@{tm loginR}"> <form method="post" action="@{tm loginR}">
<table> <table>
<tr> <tr>
@ -116,7 +114,7 @@ getRegisterR = do
defaultLayout $ do defaultLayout $ do
setTitleI Msg.RegisterLong setTitleI Msg.RegisterLong
addWidget addWidget
[QQ(whamlet)| [whamlet|
<p>_{Msg.EnterEmail} <p>_{Msg.EnterEmail}
<form method="post" action="@{toMaster registerR}"> <form method="post" action="@{toMaster registerR}">
<label for="email">_{Msg.Email} <label for="email">_{Msg.Email}
@ -147,7 +145,7 @@ postRegisterR = do
defaultLayout $ do defaultLayout $ do
setTitleI Msg.ConfirmationEmailSentTitle setTitleI Msg.ConfirmationEmailSentTitle
addWidget addWidget
[QQ(whamlet)| <p>_{Msg.ConfirmationEmailSent email} |] [whamlet| <p>_{Msg.ConfirmationEmailSent email} |]
getVerifyR :: YesodAuthEmail m getVerifyR :: YesodAuthEmail m
=> AuthEmailId m -> Text -> GHandler Auth m RepHtml => AuthEmailId m -> Text -> GHandler Auth m RepHtml
@ -168,7 +166,7 @@ getVerifyR lid key = do
defaultLayout $ do defaultLayout $ do
setTitleI Msg.InvalidKey setTitleI Msg.InvalidKey
addWidget addWidget
[QQ(whamlet)| <p>_{Msg.InvalidKey} |] [whamlet| <p>_{Msg.InvalidKey} |]
postLoginR :: YesodAuthEmail master => GHandler Auth master () postLoginR :: YesodAuthEmail master => GHandler Auth master ()
postLoginR = do postLoginR = do
@ -207,7 +205,7 @@ getPasswordR = do
defaultLayout $ do defaultLayout $ do
setTitleI Msg.SetPassTitle setTitleI Msg.SetPassTitle
addWidget addWidget
[QQ(whamlet)| [whamlet|
<h3>_{Msg.SetPass} <h3>_{Msg.SetPass}
<form method="post" action="@{toMaster setpassR}"> <form method="post" action="@{toMaster setpassR}">
<table> <table>

10
yesod-auth/Yesod/Auth/HashDB.hs
View File

@ -72,8 +72,6 @@ module Yesod.Auth.HashDB
, migrateUsers , migrateUsers
) where ) where
#include "qq.h"
import Yesod.Persist import Yesod.Persist
import Yesod.Handler import Yesod.Handler
import Yesod.Form import Yesod.Form
@ -179,7 +177,7 @@ postLoginR uniq = do
(validateUser <$> (uniq =<< mu) <*> mp) (validateUser <$> (uniq =<< mu) <*> mp)
if isValid if isValid
then setCreds True $ Creds "hashdb" (fromMaybe "" mu) [] then setCreds True $ Creds "hashdb" (fromMaybe "" mu) []
else do setMessage [QQ(shamlet)| Invalid username/password |] else do setMessage [shamlet| Invalid username/password |]
toMaster <- getRouteToMaster toMaster <- getRouteToMaster
redirect $ toMaster LoginR redirect $ toMaster LoginR
@ -210,7 +208,7 @@ getAuthIdHashDB authR uniq creds = do
-- user exists -- user exists
Just (Entity uid _) -> return $ Just uid Just (Entity uid _) -> return $ Just uid
Nothing -> do Nothing -> do
setMessage [QQ(shamlet)| User not found |] setMessage [shamlet| User not found |]
redirect $ authR LoginR redirect $ authR LoginR
-- | Prompt for username and password, validate that against a database -- | Prompt for username and password, validate that against a database
@ -224,7 +222,7 @@ authHashDB :: ( YesodAuth m, YesodPersist m
, PersistUnique b (GHandler Auth m)) , PersistUnique b (GHandler Auth m))
=> (Text -> Maybe (Unique user b)) -> AuthPlugin m => (Text -> Maybe (Unique user b)) -> AuthPlugin m
authHashDB uniq = AuthPlugin "hashdb" dispatch $ \tm -> addHamlet authHashDB uniq = AuthPlugin "hashdb" dispatch $ \tm -> addHamlet
[QQ(hamlet)| [hamlet|
<div id="header"> <div id="header">
<h1>Login <h1>Login
@ -261,7 +259,7 @@ authHashDB uniq = AuthPlugin "hashdb" dispatch $ \tm -> addHamlet
-- | Generate data base instances for a valid user -- | Generate data base instances for a valid user
share [mkPersist sqlSettings, mkMigrate "migrateUsers"] share [mkPersist sqlSettings, mkMigrate "migrateUsers"]
[QQ(persistUpperCase)| [persistUpperCase|
User User
username Text Eq username Text Eq
password Text password Text

6
yesod-auth/Yesod/Auth/OpenId.hs
View File

@ -7,8 +7,6 @@ module Yesod.Auth.OpenId
, forwardUrl , forwardUrl
) where ) where
#include "qq.h"
import Yesod.Auth import Yesod.Auth
import qualified Web.Authenticate.OpenId as OpenId import qualified Web.Authenticate.OpenId as OpenId
@ -37,11 +35,11 @@ authOpenIdExtended extensionFields =
login tm = do login tm = do
ident <- lift newIdent ident <- lift newIdent
addCassius addCassius
[QQ(cassius)|##{ident} [cassius|##{ident}
background: #fff url(http://www.myopenid.com/static/openid-icon-small.gif) no-repeat scroll 0pt 50%; background: #fff url(http://www.myopenid.com/static/openid-icon-small.gif) no-repeat scroll 0pt 50%;
padding-left: 18px; padding-left: 18px;
|] |]
[QQ(whamlet)| [whamlet|
<form method="get" action="@{tm forwardUrl}"> <form method="get" action="@{tm forwardUrl}">
<input type="hidden" name="openid_identifier" value="https://www.google.com/accounts/o8/id"> <input type="hidden" name="openid_identifier" value="https://www.google.com/accounts/o8/id">
<button .openid-google>_{Msg.LoginGoogle} <button .openid-google>_{Msg.LoginGoogle}

4
yesod-auth/Yesod/Auth/Rpxnow.hs
View File

@ -5,8 +5,6 @@ module Yesod.Auth.Rpxnow
( authRpxnow ( authRpxnow
) where ) where
#include "qq.h"
import Yesod.Auth import Yesod.Auth
import qualified Web.Authenticate.Rpxnow as Rpxnow import qualified Web.Authenticate.Rpxnow as Rpxnow
import Control.Monad (mplus) import Control.Monad (mplus)
@ -28,7 +26,7 @@ authRpxnow app apiKey =
login tm = do login tm = do
let url = {- FIXME urlEncode $ -} tm $ PluginR "rpxnow" [] let url = {- FIXME urlEncode $ -} tm $ PluginR "rpxnow" []
addHamlet addHamlet
[QQ(hamlet)| [hamlet|
<iframe src="http://#{app}.rpxnow.com/openid/embed?token_url=@{url}" scrolling="no" frameBorder="no" allowtransparency="true" style="width:400px;height:240px"> <iframe src="http://#{app}.rpxnow.com/openid/embed?token_url=@{url}" scrolling="no" frameBorder="no" allowtransparency="true" style="width:400px;height:240px">
|] |]
dispatch _ [] = do dispatch _ [] = do

10
yesod-auth/include/qq.h
View File

@ -1,10 +0,0 @@
-- CPP macro which choses which quasyquotes syntax to use depending
-- on GHC version.
--
-- QQ stands for quasyquote.
#if GHC7
# define QQ(x) x
#else
# define QQ(x) $x
#endif

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

@ -1,5 +1,5 @@
name: yesod-auth name: yesod-auth
version: 0.8.1.1 version: 1.0.0
license: BSD3 license: BSD3
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman, Patrick Brisbin author: Michael Snoyman, Patrick Brisbin
@ -10,39 +10,34 @@ stability: Stable
cabal-version: >= 1.6.0 cabal-version: >= 1.6.0
build-type: Simple build-type: Simple
homepage: http://www.yesodweb.com/ homepage: http://www.yesodweb.com/
extra-source-files: include/qq.h
description: Authentication for Yesod. description: Authentication for Yesod.
flag ghc7 flag ghc7
library library
if flag(ghc7) build-depends: base >= 4 && < 5
build-depends: base >= 4.3 && < 5 , authenticate >= 1.1 && < 1.2
cpp-options: -DGHC7
else
build-depends: base >= 4 && < 4.3
build-depends: authenticate >= 1.0 && < 1.1
, bytestring >= 0.9.1.4 && < 0.10 , bytestring >= 0.9.1.4 && < 0.10
, yesod-core >= 0.10.1 && < 0.11 , yesod-core >= 1.0 && < 1.1
, wai >= 1.1 && < 1.2 , wai >= 1.2 && < 1.3
, template-haskell , template-haskell
, pureMD5 >= 2.0 && < 2.2 , pureMD5 >= 2.0 && < 2.2
, random >= 1.0.0.2 && < 1.1 , random >= 1.0.0.2 && < 1.1
, text >= 0.7 && < 0.12 , text >= 0.7 && < 0.12
, mime-mail >= 0.3 && < 0.5 , mime-mail >= 0.3 && < 0.5
, blaze-html >= 0.4.1.3 && < 0.5 , blaze-html >= 0.4.1.3 && < 0.5
, yesod-persistent >= 0.3.1 && < 0.4 , yesod-persistent >= 1.0 && < 1.1
, hamlet >= 0.10 && < 0.11 , hamlet >= 0.10 && < 0.11
, shakespeare-css >= 0.10 && < 0.11 , shakespeare-css >= 0.10 && < 0.11
, yesod-json >= 0.3.1 && < 0.4 , yesod-json >= 1.0 && < 1.1
, containers , containers
, unordered-containers , unordered-containers
, yesod-form >= 0.4.1 && < 0.5 , yesod-form >= 1.0 && < 1.1
, transformers >= 0.2.2 && < 0.3 , transformers >= 0.2.2 && < 0.3
, persistent >= 0.8 && < 0.9 , persistent >= 0.9 && < 0.10
, persistent-template >= 0.8 && < 0.9 , persistent-template >= 0.9 && < 0.10
, SHA >= 1.4.1.3 && < 1.6 , SHA >= 1.4.1.3 && < 1.6
, http-conduit >= 1.2.5 && < 1.3 , http-conduit >= 1.3 && < 1.4
, aeson >= 0.5 , aeson >= 0.5
, pwstore-fast >= 2.2 && < 3 , pwstore-fast >= 2.2 && < 3
, lifted-base >= 0.1 && < 0.2 , lifted-base >= 0.1 && < 0.2
@ -57,7 +52,6 @@ library
Yesod.Auth.Message Yesod.Auth.Message
Yesod.Auth.GoogleEmail Yesod.Auth.GoogleEmail
ghc-options: -Wall ghc-options: -Wall
include-dirs: include
source-repository head source-repository head
type: git type: git

4
yesod-core/Yesod/Content.hs
View File

@ -62,10 +62,10 @@ import Text.Hamlet (Html)
import Text.Blaze.Renderer.Utf8 (renderHtmlBuilder) import Text.Blaze.Renderer.Utf8 (renderHtmlBuilder)
import Data.String (IsString (fromString)) import Data.String (IsString (fromString))
import Network.Wai (FilePart) import Network.Wai (FilePart)
import Data.Conduit (Source, Flush) import Data.Conduit (Source, ResourceT, Flush)
data Content = ContentBuilder Builder (Maybe Int) -- ^ The content and optional content length. data Content = ContentBuilder Builder (Maybe Int) -- ^ The content and optional content length.
| ContentSource (Source IO (Flush Builder)) | ContentSource (Source (ResourceT IO) (Flush Builder))
| ContentFile FilePath (Maybe FilePart) | ContentFile FilePath (Maybe FilePart)
-- | Zero-length enumerator. -- | Zero-length enumerator.

29
yesod-core/Yesod/Handler.hs
View File

@ -166,9 +166,9 @@ import qualified Yesod.Internal.Cache as Cache
import Yesod.Internal.Cache (mkCacheKey, CacheKey) import Yesod.Internal.Cache (mkCacheKey, CacheKey)
import Data.Typeable (Typeable) import Data.Typeable (Typeable)
import qualified Data.IORef as I import qualified Data.IORef as I
import Control.Monad.Trans.Resource
import Control.Exception.Lifted (catch) import Control.Exception.Lifted (catch)
import Control.Monad.Trans.Control import Control.Monad.Trans.Control
import Control.Monad.Trans.Resource
import Control.Monad.Base import Control.Monad.Base
import Yesod.Routes.Class import Yesod.Routes.Class
@ -831,13 +831,8 @@ newIdent = do
redirectToPost :: RedirectUrl master url => url -> GHandler sub master a redirectToPost :: RedirectUrl master url => url -> GHandler sub master a
redirectToPost url = do redirectToPost url = do
urlText <- toTextUrl url urlText <- toTextUrl url
hamletToRepHtml hamletToRepHtml [hamlet|
#if GHC7 $doctype 5
[hamlet|
#else
[$hamlet|
#endif
\<!DOCTYPE html>
<html> <html>
<head> <head>
@ -922,12 +917,12 @@ instance MonadBaseControl IO (GHandler sub master) where
f $ liftM StH . runInBase . (\(GHandler r) -> r reader) f $ liftM StH . runInBase . (\(GHandler r) -> r reader)
restoreM (StH base) = GHandler $ const $ restoreM base restoreM (StH base) = GHandler $ const $ restoreM base
instance Resource (GHandler sub master) where instance MonadUnsafeIO (GHandler sub master) where
type Base (GHandler sub master) = IO unsafeLiftIO = liftIO
resourceLiftBase = liftIO instance MonadThrow (GHandler sub master) where
resourceBracket_ a b c = control $ \run -> resourceBracket_ a b (run c) monadThrow = liftIO . throwIO
instance ResourceUnsafeIO (GHandler sub master) where instance MonadResource (GHandler sub master) where
unsafeFromIO = liftIO allocate a = lift . allocate a
instance ResourceThrow (GHandler sub master) where register = lift . register
resourceThrow = liftIO . throwIO release = lift . release
instance ResourceIO (GHandler sub master) resourceMask = lift . resourceMask

10
yesod-core/Yesod/Internal.hs
View File

@ -45,12 +45,6 @@ import Data.Text.Lazy.Builder (Builder)
import Network.HTTP.Types (Ascii) import Network.HTTP.Types (Ascii)
import Web.Cookie (SetCookie (..)) import Web.Cookie (SetCookie (..))
#if GHC7
#define HAMLET hamlet
#else
#define HAMLET $hamlet
#endif
-- | Responses to indicate some form of an error occurred. These are different -- | Responses to indicate some form of an error occurred. These are different
-- from 'SpecialResponse' in that they allow for custom error pages. -- from 'SpecialResponse' in that they allow for custom error pages.
data ErrorResponse = data ErrorResponse =
@ -76,9 +70,9 @@ langKey = "_LANG"
data Location url = Local url | Remote Text data Location url = Local url | Remote Text
deriving (Show, Eq) deriving (Show, Eq)
locationToHtmlUrl :: Location url -> HtmlUrl url locationToHtmlUrl :: Location url -> HtmlUrl url
locationToHtmlUrl (Local url) = [HAMLET|\@{url} locationToHtmlUrl (Local url) = [hamlet|\@{url}
|] |]
locationToHtmlUrl (Remote s) = [HAMLET|\#{s} locationToHtmlUrl (Remote s) = [hamlet|\#{s}
|] |]
newtype UniqueList x = UniqueList ([x] -> [x]) newtype UniqueList x = UniqueList ([x] -> [x])

34
yesod-core/Yesod/Internal/Core.hs
View File

@ -84,23 +84,11 @@ import Data.Aeson (Value (Array, String))
import Data.Aeson.Encode (encode) import Data.Aeson.Encode (encode)
import qualified Data.Vector as Vector import qualified Data.Vector as Vector
import Network.Wai.Middleware.Gzip (GzipSettings, def) import Network.Wai.Middleware.Gzip (GzipSettings, def)
-- mega repo can't access this
#ifndef MEGA
import qualified Paths_yesod_core import qualified Paths_yesod_core
import Data.Version (showVersion) import Data.Version (showVersion)
yesodVersion :: String yesodVersion :: String
yesodVersion = showVersion Paths_yesod_core.version yesodVersion = showVersion Paths_yesod_core.version
#else
yesodVersion :: String
yesodVersion = "0.9.4"
#endif
#if GHC7
#define HAMLET hamlet
#else
#define HAMLET $hamlet
#endif
-- | This class is automatically instantiated when you use the template haskell -- | This class is automatically instantiated when you use the template haskell
-- mkYesod function. You should never need to deal with it directly. -- mkYesod function. You should never need to deal with it directly.
@ -177,7 +165,7 @@ class RenderRoute a => Yesod a where
defaultLayout w = do defaultLayout w = do
p <- widgetToPageContent w p <- widgetToPageContent w
mmsg <- getMessage mmsg <- getMessage
hamletToRepHtml [HAMLET| hamletToRepHtml [hamlet|
!!! !!!
<html> <html>
@ -505,19 +493,19 @@ defaultErrorHandler NotFound = do
r <- waiRequest r <- waiRequest
let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r
applyLayout' "Not Found" applyLayout' "Not Found"
[HAMLET| [hamlet|
<h1>Not Found <h1>Not Found
<p>#{path'} <p>#{path'}
|] |]
defaultErrorHandler (PermissionDenied msg) = defaultErrorHandler (PermissionDenied msg) =
applyLayout' "Permission Denied" applyLayout' "Permission Denied"
[HAMLET| [hamlet|
<h1>Permission denied <h1>Permission denied
<p>#{msg} <p>#{msg}
|] |]
defaultErrorHandler (InvalidArgs ia) = defaultErrorHandler (InvalidArgs ia) =
applyLayout' "Invalid Arguments" applyLayout' "Invalid Arguments"
[HAMLET| [hamlet|
<h1>Invalid Arguments <h1>Invalid Arguments
<ul> <ul>
$forall msg <- ia $forall msg <- ia
@ -525,13 +513,13 @@ defaultErrorHandler (InvalidArgs ia) =
|] |]
defaultErrorHandler (InternalError e) = defaultErrorHandler (InternalError e) =
applyLayout' "Internal Server Error" applyLayout' "Internal Server Error"
[HAMLET| [hamlet|
<h1>Internal Server Error <h1>Internal Server Error
<p>#{e} <p>#{e}
|] |]
defaultErrorHandler (BadMethod m) = defaultErrorHandler (BadMethod m) =
applyLayout' "Bad Method" applyLayout' "Bad Method"
[HAMLET| [hamlet|
<h1>Method Not Supported <h1>Method Not Supported
<p>Method "#{S8.unpack m}" not supported <p>Method "#{S8.unpack m}" not supported
|] |]
@ -590,7 +578,7 @@ widgetToPageContent w = do
-- modernizr should be at the end of the <head> http://www.modernizr.com/docs/#installing -- modernizr should be at the end of the <head> http://www.modernizr.com/docs/#installing
-- the asynchronous loader means your page doesn't have to wait for all the js to load -- the asynchronous loader means your page doesn't have to wait for all the js to load
let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc
regularScriptLoad = [HAMLET| regularScriptLoad = [hamlet|
$forall s <- scripts $forall s <- scripts
^{mkScriptTag s} ^{mkScriptTag s}
$maybe j <- jscript $maybe j <- jscript
@ -600,7 +588,7 @@ $maybe j <- jscript
<script>^{jelper j} <script>^{jelper j}
|] |]
headAll = [HAMLET| headAll = [hamlet|
\^{head'} \^{head'}
$forall s <- stylesheets $forall s <- stylesheets
^{mkLinkTag s} ^{mkLinkTag s}
@ -622,7 +610,7 @@ $case jsLoader master
$of BottomOfHeadBlocking $of BottomOfHeadBlocking
^{regularScriptLoad} ^{regularScriptLoad}
|] |]
let bodyScript = [HAMLET| let bodyScript = [hamlet|
^{body} ^{body}
^{regularScriptLoad} ^{regularScriptLoad}
|] |]
@ -668,7 +656,7 @@ jsonArray = unsafeLazyByteString . encode . Array . Vector.fromList . map String
-- | For use with setting 'jsLoader' to 'BottomOfHeadAsync' -- | For use with setting 'jsLoader' to 'BottomOfHeadAsync'
loadJsYepnope :: Yesod master => Either Text (Route master) -> [Text] -> Maybe (HtmlUrl (Route master)) -> (HtmlUrl (Route master)) loadJsYepnope :: Yesod master => Either Text (Route master) -> [Text] -> Maybe (HtmlUrl (Route master)) -> (HtmlUrl (Route master))
loadJsYepnope eyn scripts mcomplete = loadJsYepnope eyn scripts mcomplete =
[HAMLET| [hamlet|
$maybe yn <- left eyn $maybe yn <- left eyn
<script src=#{yn}> <script src=#{yn}>
$maybe yn <- right eyn $maybe yn <- right eyn

22
yesod-core/Yesod/Widget.hs
View File

@ -76,14 +76,14 @@ import qualified Data.Map as Map
import Language.Haskell.TH.Quote (QuasiQuoter) import Language.Haskell.TH.Quote (QuasiQuoter)
import Language.Haskell.TH.Syntax (Q, Exp (InfixE, VarE, LamE), Pat (VarP), newName) import Language.Haskell.TH.Syntax (Q, Exp (InfixE, VarE, LamE), Pat (VarP), newName)
import Control.Monad.Trans.Control (MonadBaseControl (..), control) import Control.Monad.Trans.Control (MonadBaseControl (..))
import Control.Monad.Trans.Resource
import Control.Exception (throwIO) import Control.Exception (throwIO)
import qualified Text.Hamlet as NP import qualified Text.Hamlet as NP
import Data.Text.Lazy.Builder (fromLazyText) import Data.Text.Lazy.Builder (fromLazyText)
import Text.Blaze (toHtml, preEscapedLazyText) import Text.Blaze (toHtml, preEscapedLazyText)
import Control.Monad.Base (MonadBase (liftBase)) import Control.Monad.Base (MonadBase (liftBase))
import Control.Arrow (first) import Control.Arrow (first)
import Control.Monad.Trans.Resource
-- | A generic widget, allowing specification of both the subsite and master -- | A generic widget, allowing specification of both the subsite and master
-- site datatypes. While this is simply a @WriterT@, we define a newtype for -- site datatypes. While this is simply a @WriterT@, we define a newtype for
@ -321,12 +321,12 @@ instance MonadBaseControl IO (GWidget sub master) where
(f $ liftM StW . runInBase . unGWidget) (f $ liftM StW . runInBase . unGWidget)
restoreM (StW base) = GWidget $ restoreM base restoreM (StW base) = GWidget $ restoreM base
instance Resource (GWidget sub master) where instance MonadUnsafeIO (GWidget sub master) where
type Base (GWidget sub master) = IO unsafeLiftIO = liftIO
resourceLiftBase = liftIO instance MonadThrow (GWidget sub master) where
resourceBracket_ a b c = control $ \run -> resourceBracket_ a b (run c) monadThrow = liftIO . throwIO
instance ResourceUnsafeIO (GWidget sub master) where instance MonadResource (GWidget sub master) where
unsafeFromIO = liftIO allocate a = lift . allocate a
instance ResourceThrow (GWidget sub master) where register = lift . register
resourceThrow = liftIO . throwIO release = lift . release
instance ResourceIO (GWidget sub master) resourceMask = lift . resourceMask

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

@ -1,5 +1,5 @@
name: yesod-core name: yesod-core
version: 0.10.2.2 version: 1.0.0
license: BSD3 license: BSD3
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>
@ -47,9 +47,9 @@ library
build-depends: wai-test build-depends: wai-test
build-depends: time >= 1.1.4 build-depends: time >= 1.1.4
, yesod-routes >= 0.0.1 && < 0.1 , yesod-routes >= 1.0 && < 1.1
, wai >= 1.1 && < 1.2 , wai >= 1.2 && < 1.3
, wai-extra >= 1.1 && < 1.3 , wai-extra >= 1.2 && < 1.3
, bytestring >= 0.9.1.4 && < 0.10 , bytestring >= 0.9.1.4 && < 0.10
, text >= 0.7 && < 0.12 , text >= 0.7 && < 0.12
, template-haskell , template-haskell
@ -79,7 +79,8 @@ library
, aeson >= 0.5 , aeson >= 0.5
, fast-logger >= 0.0.2 , fast-logger >= 0.0.2
, wai-logger >= 0.0.1 , wai-logger >= 0.0.1
, conduit >= 0.2 && < 0.3 , conduit >= 0.3 && < 0.4
, resourcet >= 0.3 && < 0.4
, lifted-base >= 0.1 && < 0.2 , lifted-base >= 0.1 && < 0.2
exposed-modules: Yesod.Content exposed-modules: Yesod.Content

12
yesod-default/yesod-default.cabal
View File

@ -1,5 +1,5 @@
name: yesod-default name: yesod-default
version: 0.6.1 version: 1.0.0
license: BSD3 license: BSD3
license-file: LICENSE license-file: LICENSE
author: Patrick Brisbin author: Patrick Brisbin
@ -18,10 +18,10 @@ library
cpp-options: -DWINDOWS cpp-options: -DWINDOWS
build-depends: base >= 4 && < 5 build-depends: base >= 4 && < 5
, yesod-core >= 0.10.1&& < 0.11 , yesod-core >= 1.0 && < 1.1
, warp >= 1.1 && < 1.2 , warp >= 1.2 && < 1.3
, wai >= 1.1 && < 1.2 , wai >= 1.2 && < 1.3
, wai-extra >= 1.1 && < 1.3 , wai-extra >= 1.2 && < 1.3
, bytestring >= 0.9.1.4 , bytestring >= 0.9.1.4
, transformers >= 0.2.2 && < 0.3 , transformers >= 0.2.2 && < 0.3
, text >= 0.9 , text >= 0.9
@ -29,7 +29,7 @@ library
, shakespeare-css >= 0.10.5 && < 0.11 , shakespeare-css >= 0.10.5 && < 0.11
, shakespeare-js >= 0.11 && < 0.12 , shakespeare-js >= 0.11 && < 0.12
, template-haskell , template-haskell
, yaml >= 0.5.1.2 && < 0.6 , yaml >= 0.6 && < 0.7
, unordered-containers , unordered-containers
if !os(windows) if !os(windows)

5
yesod-form/Yesod/Form/Fields.hs
View File

@ -273,9 +273,8 @@ searchField autoFocus = Field
|] |]
when autoFocus $ do when autoFocus $ do
-- we want this javascript to be placed immediately after the field -- we want this javascript to be placed immediately after the field
[whamlet|\<script>if (!('autofocus' in document.createElement('input'))) {document.getElementById('#{theId}').focus();}</script> [whamlet|<script>if (!('autofocus' in document.createElement('input'))) {document.getElementById('#{theId}').focus();}|]
|] addCassius [cassius|
addCassius [CASSIUS|
#{theId} #{theId}
-webkit-appearance: textfield -webkit-appearance: textfield
|] |]

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

@ -1,5 +1,5 @@
name: yesod-form name: yesod-form
version: 0.4.2.1 version: 1.0.0
license: BSD3 license: BSD3
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>
@ -14,13 +14,13 @@ description: Form handling support for Yesod Web Framework
library library
build-depends: base >= 4 && < 5 build-depends: base >= 4 && < 5
, yesod-core >= 0.10.2 && < 0.11 , yesod-core >= 1.0 && < 1.1
, yesod-persistent >= 0.3.1 && < 0.4 , yesod-persistent >= 1.0 && < 1.1
, time >= 1.1.4 , time >= 1.1.4
, hamlet >= 0.10 && < 0.11 , hamlet >= 0.10 && < 0.11
, shakespeare-css >= 0.10 && < 0.11 , shakespeare-css >= 0.10 && < 0.11
, shakespeare-js >= 0.11 && < 0.12 , shakespeare-js >= 0.11 && < 0.12
, persistent >= 0.8 && < 0.9 , persistent >= 0.9 && < 0.10
, template-haskell , template-haskell
, transformers >= 0.2.2 && < 0.3 , transformers >= 0.2.2 && < 0.3
, data-default >= 0.3 && < 0.4 , data-default >= 0.3 && < 0.4
@ -31,7 +31,7 @@ library
, blaze-html >= 0.4.1.3 && < 0.5 , blaze-html >= 0.4.1.3 && < 0.5
, bytestring >= 0.9.1.4 && < 0.10 , bytestring >= 0.9.1.4 && < 0.10
, text >= 0.9 && < 1.0 , text >= 0.9 && < 1.0
, wai >= 1.1 && < 1.2 , wai >= 1.2 && < 1.3
, containers >= 0.2 && < 0.5 , containers >= 0.2 && < 0.5
exposed-modules: Yesod.Form exposed-modules: Yesod.Form
Yesod.Form.Class Yesod.Form.Class

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

@ -1,5 +1,5 @@
name: yesod-json name: yesod-json
version: 0.3.1 version: 1.0.0
license: BSD3 license: BSD3
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>
@ -14,19 +14,19 @@ description: Generate content for Yesod using the aeson package.
library library
build-depends: base >= 4 && < 5 build-depends: base >= 4 && < 5
, yesod-core >= 0.10.1 && < 0.11 , yesod-core >= 1.0 && < 1.1
, yesod-routes < 0.1 , yesod-routes >= 1.0 && < 1.1
, aeson >= 0.5 , aeson >= 0.5
, text >= 0.8 && < 1.0 , text >= 0.8 && < 1.0
, shakespeare-js >= 0.11 && < 0.12 , shakespeare-js >= 0.11 && < 0.12
, vector >= 0.9 , vector >= 0.9
, containers >= 0.2 , containers >= 0.2
, blaze-builder , blaze-builder
, attoparsec-conduit >= 0.2 && < 0.3 , attoparsec-conduit >= 0.3 && < 0.4
, conduit >= 0.2 && < 0.3 , conduit >= 0.3 && < 0.4
, transformers >= 0.2.2 && < 0.3 , transformers >= 0.2.2 && < 0.3
, wai >= 1.1 && < 1.2 , wai >= 1.2 && < 1.3
, wai-extra >= 1.1 && < 1.3 , wai-extra >= 1.2 && < 1.3
, bytestring >= 0.9 && < 0.10 , bytestring >= 0.9 && < 0.10
, safe >= 0.2 && < 0.4 , safe >= 0.2 && < 0.4
exposed-modules: Yesod.Json exposed-modules: Yesod.Json

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

@ -14,7 +14,7 @@ description: Helper functions and data types for producing News feeds.
library library
build-depends: base >= 4 && < 5 build-depends: base >= 4 && < 5
, yesod-core >= 0.10.1 && < 0.11 , yesod-core >= 1.0 && < 1.1
, time >= 1.1.4 , time >= 1.1.4
, hamlet >= 0.10 && < 0.11 , hamlet >= 0.10 && < 0.11
, bytestring >= 0.9.1.4 && < 0.10 , bytestring >= 0.9.1.4 && < 0.10

8
yesod-persistent/yesod-persistent.cabal
View File

@ -1,5 +1,5 @@
name: yesod-persistent name: yesod-persistent
version: 0.3.1 version: 1.0.0
license: BSD3 license: BSD3
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>
@ -14,9 +14,9 @@ description: Some helpers for using Persistent from Yesod.
library library
build-depends: base >= 4 && < 5 build-depends: base >= 4 && < 5
, yesod-core >= 0.10.1 && < 0.11 , yesod-core >= 1.0 && < 1.1
, persistent >= 0.8 && < 0.9 , persistent >= 0.9 && < 0.10
, persistent-template >= 0.8 && < 0.9 , persistent-template >= 0.9 && < 0.10
, transformers >= 0.2.2 && < 0.3 , transformers >= 0.2.2 && < 0.3
exposed-modules: Yesod.Persist exposed-modules: Yesod.Persist
ghc-options: -Wall ghc-options: -Wall

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

@ -1,5 +1,5 @@
name: yesod-routes name: yesod-routes
version: 0.0.1 version: 1.0.0
license: BSD3 license: BSD3
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>

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

@ -1,5 +1,5 @@
name: yesod-sitemap name: yesod-sitemap
version: 0.3.0 version: 1.0.0
license: BSD3 license: BSD3
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>
@ -14,7 +14,7 @@ description: Generate XML sitemaps.
library library
build-depends: base >= 4 && < 5 build-depends: base >= 4 && < 5
, yesod-core >= 0.10 && < 0.11 , yesod-core >= 1.0 && < 1.1
, time >= 1.1.4 , time >= 1.1.4
, hamlet >= 0.10 && < 0.11 , hamlet >= 0.10 && < 0.11
exposed-modules: Yesod.Sitemap exposed-modules: Yesod.Sitemap

6
yesod-static/Yesod/Static.hs
View File

@ -76,9 +76,9 @@ import qualified Data.ByteString as S
import Network.HTTP.Types (status301) import Network.HTTP.Types (status301)
import System.PosixCompat.Files (getFileStatus, modificationTime) import System.PosixCompat.Files (getFileStatus, modificationTime)
import System.Posix.Types (EpochTime) import System.Posix.Types (EpochTime)
import Data.Conduit (($$), runResourceT) import Data.Conduit (($$))
import Data.Conduit.List (sourceList) import Data.Conduit.List (sourceList)
import Control.Monad.ST (runST) import Data.Functor.Identity (runIdentity)
import Network.Wai.Application.Static import Network.Wai.Application.Static
( StaticSettings (..) ( StaticSettings (..)
@ -323,7 +323,7 @@ base64md5File = fmap (base64 . encode) . hashFile
base64md5 :: L.ByteString -> String base64md5 :: L.ByteString -> String
base64md5 lbs = base64md5 lbs =
base64 $ encode base64 $ encode
$ runST $ runResourceT $ runIdentity
$ sourceList (L.toChunks lbs) $$ sinkHash $ sourceList (L.toChunks lbs) $$ sinkHash
where where
encode d = Data.Serialize.encode (d :: MD5) encode d = Data.Serialize.encode (d :: MD5)

18
yesod-static/yesod-static.cabal
View File

@ -1,5 +1,5 @@
name: yesod-static name: yesod-static
version: 0.10.1 version: 1.0.0
license: BSD3 license: BSD3
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>
@ -19,21 +19,21 @@ library
build-depends: base >= 4 && < 5 build-depends: base >= 4 && < 5
, containers >= 0.2 && < 0.5 , containers >= 0.2 && < 0.5
, old-time >= 1.0 , old-time >= 1.0
, yesod-core >= 0.10.1 && < 0.11 , yesod-core >= 1.0 && < 1.1
, base64-bytestring >= 0.1.0.1 && < 0.2 , base64-bytestring >= 0.1.0.1 && < 0.2
, cereal >= 0.3 && < 0.4 , cereal >= 0.3 && < 0.4
, bytestring >= 0.9.1.4 && < 0.10 , bytestring >= 0.9.1.4 && < 0.10
, template-haskell , template-haskell
, directory >= 1.0 && < 1.2 , directory >= 1.0 && < 1.2
, transformers >= 0.2.2 && < 0.3 , transformers >= 0.2.2 && < 0.3
, wai-app-static >= 1.1 && < 1.2 , wai-app-static >= 1.2 && < 1.3
, wai >= 1.1 && < 1.2 , wai >= 1.2 && < 1.3
, text >= 0.9 && < 1.0 , text >= 0.9 && < 1.0
, file-embed >= 0.0.4.1 && < 0.5 , file-embed >= 0.0.4.1 && < 0.5
, http-types >= 0.6.5 && < 0.7 , http-types >= 0.6.5 && < 0.7
, unix-compat >= 0.2 , unix-compat >= 0.2
, conduit >= 0.2 , conduit >= 0.2
, crypto-conduit >= 0.1.1.2 && < 0.2 , crypto-conduit >= 0.2 && < 0.3
, cryptohash >= 0.6.1 , cryptohash >= 0.6.1
exposed-modules: Yesod.Static exposed-modules: Yesod.Static
ghc-options: -Wall ghc-options: -Wall
@ -49,21 +49,21 @@ test-suite tests
-- copy from above -- copy from above
, containers >= 0.2 && < 0.5 , containers >= 0.2 && < 0.5
, old-time >= 1.0 , old-time >= 1.0
, yesod-core >= 0.10 && < 0.11 , yesod-core
, base64-bytestring >= 0.1.0.1 && < 0.2 , base64-bytestring >= 0.1.0.1 && < 0.2
, cereal >= 0.3 && < 0.4 , cereal >= 0.3 && < 0.4
, bytestring >= 0.9.1.4 && < 0.10 , bytestring >= 0.9.1.4 && < 0.10
, template-haskell , template-haskell
, directory >= 1.0 && < 1.2 , directory >= 1.0 && < 1.2
, transformers >= 0.2.2 && < 0.3 , transformers >= 0.2.2 && < 0.3
, wai-app-static >= 1.1 && < 1.2 , wai-app-static
, wai >= 1.1 && < 1.2 , wai
, text >= 0.9 && < 1.0 , text >= 0.9 && < 1.0
, file-embed >= 0.0.4.1 && < 0.5 , file-embed >= 0.0.4.1 && < 0.5
, http-types >= 0.6.5 && < 0.7 , http-types >= 0.6.5 && < 0.7
, unix-compat >= 0.2 , unix-compat >= 0.2
, conduit >= 0.2 , conduit >= 0.2
, crypto-conduit >= 0.1.1.2 && < 0.2 , crypto-conduit >= 0.2 && < 0.3
, cryptohash >= 0.6.1 , cryptohash >= 0.6.1
ghc-options: -Wall ghc-options: -Wall

2
yesod/scaffold/Settings.hs.cg
View File

@ -46,7 +46,7 @@ staticDir = "static"
-- --
-- To see how this value is used, see urlRenderOverride in Foundation.hs -- To see how this value is used, see urlRenderOverride in Foundation.hs
staticRoot :: AppConfig DefaultEnv x -> Text staticRoot :: AppConfig DefaultEnv x -> Text
staticRoot conf = [~qq~st|#{appRoot conf}/static|] staticRoot conf = [st|#{appRoot conf}/static|]
-- The rest of this file contains settings which rarely need changing by a -- The rest of this file contains settings which rarely need changing by a

2
yesod/scaffold/tiny/Settings.hs.cg
View File

@ -39,7 +39,7 @@ staticDir = "static"
-- --
-- To see how this value is used, see urlRenderOverride in ~project~.hs -- To see how this value is used, see urlRenderOverride in ~project~.hs
staticRoot :: AppConfig DefaultEnv a -> Text staticRoot :: AppConfig DefaultEnv a -> Text
staticRoot conf = [~qq~st|#{appRoot conf}/static|] staticRoot conf = [st|#{appRoot conf}/static|]
widgetFile :: String -> Q Exp widgetFile :: String -> Q Exp
#if DEVELOPMENT #if DEVELOPMENT

18
yesod/yesod.cabal
View File

@ -1,5 +1,5 @@
name: yesod name: yesod
version: 0.10.1.4 version: 1.0.0
license: BSD3 license: BSD3
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>
@ -73,20 +73,20 @@ library
cpp-options: -DGHC7 cpp-options: -DGHC7
else else
build-depends: base >= 4 && < 4.3 build-depends: base >= 4 && < 4.3
build-depends: yesod-core >= 0.10.1 && < 0.11 build-depends: yesod-core >= 1.0 && < 1.1
, yesod-auth >= 0.8.1 && < 0.9 , yesod-auth >= 1.0 && < 1.1
, yesod-json >= 0.3.1 && < 0.4 , yesod-json >= 1.0 && < 1.1
, yesod-persistent >= 0.3.1 && < 0.4 , yesod-persistent >= 1.0 && < 1.1
, yesod-form >= 0.4.1 && < 0.5 , yesod-form >= 1.0 && < 1.1
, monad-control >= 0.3 && < 0.4 , monad-control >= 0.3 && < 0.4
, transformers >= 0.2.2 && < 0.3 , transformers >= 0.2.2 && < 0.3
, wai >= 1.1 && < 1.2 , wai >= 1.2 && < 1.3
, wai-extra >= 1.1 && < 1.3 , wai-extra >= 1.2 && < 1.3
, wai-logger >= 0.1.2 , wai-logger >= 0.1.2
, hamlet >= 0.10 && < 0.11 , hamlet >= 0.10 && < 0.11
, shakespeare-js >= 0.11 && < 0.12 , shakespeare-js >= 0.11 && < 0.12
, shakespeare-css >= 0.10 && < 0.11 , shakespeare-css >= 0.10 && < 0.11
, warp >= 1.1 && < 1.2 , warp >= 1.2 && < 1.3
, blaze-html >= 0.4.1.3 && < 0.5 , blaze-html >= 0.4.1.3 && < 0.5
exposed-modules: Yesod exposed-modules: Yesod
ghc-options: -Wall ghc-options: -Wall