Merge branch 'beta'

Conflicts:
	yesod-core/yesod-core.cabal
	yesod-json/yesod-json.cabal
	yesod-test/Yesod/Test.hs
	yesod-test/test/main.hs
	yesod-test/yesod-test.cabal

yesod-auth/Yesod/Auth.hs

@@ -149,7 +149,10 @@ setCreds doRedirects creds = do
         Nothing ->
           when doRedirects $ do
             case authRoute y of
-              Nothing -> do rh <- defaultLayout $ toWidget [shamlet| <h1>Invalid login |]
+              Nothing -> do rh <- defaultLayout $ toWidget [shamlet|
+$newline never
+<h1>Invalid login
+|]
                             sendResponse rh
               Just ar -> do setMessageI Msg.InvalidLogin
                             redirect ar
@@ -168,6 +171,7 @@ getCheckR = do
   where
     html' creds =
         [shamlet|
+$newline never
 <h1>Authentication Status
 $maybe _ <- creds
     <p>Logged in.

yesod-auth/Yesod/Auth/BrowserId.hs

@@ -62,6 +62,7 @@ helper maudience = AuthPlugin
     , apLogin = \toMaster -> do
         addScriptRemote browserIdJs
         toWidget [hamlet|
+$newline never
 <p>
     <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">

yesod-auth/Yesod/Auth/Dummy.hs

@@ -24,6 +24,7 @@ authDummy =
     url = PluginR "dummy" []
     login authToMaster =
         toWidget [hamlet|
+$newline never
 <form method="post" action="@{authToMaster url}">
     Your new identifier is: #
     <input type="text" name="ident">

yesod-auth/Yesod/Auth/Email.hs

@@ -79,6 +79,7 @@ authEmail :: YesodAuthEmail m => AuthPlugin m
 authEmail =
     AuthPlugin "email" dispatch $ \tm ->
         [whamlet|
+$newline never
 <form method="post" action="@{tm loginR}">
     <table>
         <tr>
@@ -112,6 +113,7 @@ getRegisterR = do
     defaultLayout $ do
         setTitleI Msg.RegisterLong
         [whamlet|
+$newline never
 <p>_{Msg.EnterEmail}
 <form method="post" action="@{toMaster registerR}">
     <label for="email">_{Msg.Email}
@@ -141,7 +143,10 @@ postRegisterR = do
     sendVerifyEmail email verKey verUrl
     defaultLayout $ do
         setTitleI Msg.ConfirmationEmailSentTitle
-        [whamlet| <p>_{Msg.ConfirmationEmailSent email} |]
+        [whamlet|
+$newline never
+<p>_{Msg.ConfirmationEmailSent email}
+|]
 
 getVerifyR :: YesodAuthEmail m
            => AuthEmailId m -> Text -> GHandler Auth m RepHtml
@@ -161,7 +166,10 @@ getVerifyR lid key = do
         _ -> return ()
     defaultLayout $ do
         setTitleI Msg.InvalidKey
-        [whamlet| <p>_{Msg.InvalidKey} |]
+        [whamlet|
+$newline never
+<p>_{Msg.InvalidKey}
+|]
 
 postLoginR :: YesodAuthEmail master => GHandler Auth master ()
 postLoginR = do
@@ -200,6 +208,7 @@ getPasswordR = do
     defaultLayout $ do
         setTitleI Msg.SetPassTitle
         [whamlet|
+$newline never
 <h3>_{Msg.SetPass}
 <form method="post" action="@{toMaster setpassR}">
     <table>

yesod-auth/Yesod/Auth/GoogleEmail.hs

@@ -46,7 +46,10 @@ authGoogleEmail =
   where
     complete = PluginR pid ["complete"]
     login tm =
-        [whamlet|<a href=@{tm forwardUrl}>_{Msg.LoginGoogle}|]
+        [whamlet|
+$newline never
+<a href=@{tm forwardUrl}>_{Msg.LoginGoogle}
+|]
     dispatch "GET" ["forward"] = do
         render <- getUrlRender
         toMaster <- getRouteToMaster

yesod-auth/Yesod/Auth/HashDB.hs

@@ -76,7 +76,7 @@ import Yesod.Handler
 import Yesod.Form
 import Yesod.Auth
 import Yesod.Widget (toWidget)
-import Text.Hamlet (hamlet, shamlet)
+import Text.Hamlet (hamlet)
 
 import Control.Applicative         ((<$>), (<*>))
 import Control.Monad               (replicateM,liftM)
@@ -176,7 +176,7 @@ postLoginR uniq = do
                  (validateUser <$> (uniq =<< mu) <*> mp)
     if isValid 
        then setCreds True $ Creds "hashdb" (fromMaybe "" mu) []
-       else do setMessage [shamlet| Invalid username/password |]
+       else do setMessage "Invalid username/password"
                toMaster <- getRouteToMaster
                redirect $ toMaster LoginR
 
@@ -207,7 +207,7 @@ getAuthIdHashDB authR uniq creds = do
                 -- user exists
                 Just (Entity uid _) -> return $ Just uid
                 Nothing       -> do
-                    setMessage [shamlet| User not found |]
+                    setMessage "User not found"
                     redirect $ authR LoginR
 
 -- | Prompt for username and password, validate that against a database
@@ -221,6 +221,7 @@ authHashDB :: ( YesodAuth m, YesodPersist m
               , PersistUnique b (GHandler Auth m))
            => (Text -> Maybe (Unique user b)) -> AuthPlugin m
 authHashDB uniq = AuthPlugin "hashdb" dispatch $ \tm -> toWidget [hamlet|
+$newline never
     <div id="header">
         <h1>Login
 

yesod-auth/Yesod/Auth/OpenId.hs

@@ -3,10 +3,11 @@
 {-# LANGUAGE CPP #-}
 module Yesod.Auth.OpenId
     ( authOpenId
-    , authOpenIdExtended
     , forwardUrl
     , claimedKey
+    , opLocalKey
     , credsIdentClaimed
+    , IdentifierType (..)
     ) where
 
 import Yesod.Auth
@@ -30,11 +31,13 @@ import Data.Maybe (fromMaybe)
 forwardUrl :: AuthRoute
 forwardUrl = PluginR "openid" ["forward"]
 
-authOpenId :: YesodAuth m => AuthPlugin m
+data IdentifierType = Claimed | OPLocal
-authOpenId = authOpenIdExtended []
 
-authOpenIdExtended :: YesodAuth m => [(Text, Text)] -> AuthPlugin m
+authOpenId :: YesodAuth m
-authOpenIdExtended extensionFields =
+           => IdentifierType
+           -> [(Text, Text)] -- ^ extension fields
+           -> AuthPlugin m
+authOpenId idType extensionFields =
     AuthPlugin "openid" dispatch login
   where
     complete = PluginR "openid" ["complete"]
@@ -46,6 +49,7 @@ authOpenIdExtended extensionFields =
     padding-left: 18px;
 |]
         [whamlet|
+$newline never
 <form method="get" action="@{tm forwardUrl}">
     <input type="hidden" name="openid_identifier" value="https://www.google.com/accounts/o8/id">
     <button .openid-google>_{Msg.LoginGoogle}
@@ -78,15 +82,15 @@ authOpenIdExtended extensionFields =
     dispatch "GET" ["complete", ""] = dispatch "GET" ["complete"] -- compatibility issues
     dispatch "GET" ["complete"] = do
         rr <- getRequest
-        completeHelper $ reqGetParams rr
+        completeHelper idType $ reqGetParams rr
     dispatch "POST" ["complete", ""] = dispatch "POST" ["complete"] -- compatibility issues
     dispatch "POST" ["complete"] = do
         (posts, _) <- runRequestBody
-        completeHelper posts
+        completeHelper idType posts
     dispatch _ _ = notFound
 
-completeHelper :: YesodAuth m => [(Text, Text)] -> GHandler Auth m ()
+completeHelper :: YesodAuth m => IdentifierType -> [(Text, Text)] -> GHandler Auth m ()
-completeHelper gets' = do
+completeHelper idType gets' = do
         master <- getYesod
         eres <- lift $ try $ OpenId.authenticateClaimed gets' (authHttpManager master)
         toMaster <- getRouteToMaster
@@ -98,8 +102,14 @@ completeHelper gets' = do
                         case OpenId.oirClaimed oir of
                             Nothing -> id
                             Just (OpenId.Identifier i') -> ((claimedKey, i'):)
-                    gets'' = claimed $ filter (\(k, _) -> not $ "__" `isPrefixOf` k) gets'
+                    oplocal =
-                    i = OpenId.identifier $ OpenId.oirOpLocal oir
+                        case OpenId.oirOpLocal oir of
+                            OpenId.Identifier i' -> ((opLocalKey, i'):)
+                    gets'' = oplocal $ claimed $ filter (\(k, _) -> not $ "__" `isPrefixOf` k) gets'
+                    i = OpenId.identifier $
+                            case idType of
+                                OPLocal -> OpenId.oirOpLocal oir
+                                Claimed -> fromMaybe (OpenId.oirOpLocal oir) $ OpenId.oirClaimed oir
                 setCreds True $ Creds "openid" i gets''
         either onFailure onSuccess eres
 
@@ -117,6 +127,9 @@ completeHelper gets' = do
 claimedKey :: Text
 claimedKey = "__CLAIMED"
 
+opLocalKey :: Text
+opLocalKey = "__OPLOCAL"
+
 -- | A helper function which will get the claimed identifier, if available, falling back to the OP local identifier.
 --
 -- See 'claimedKey'.

yesod-auth/Yesod/Auth/Rpxnow.hs

@@ -25,6 +25,7 @@ authRpxnow app apiKey =
     login tm = do
         let url = {- FIXME urlEncode $ -} tm $ PluginR "rpxnow" []
         toWidget [hamlet|
+$newline never
 <iframe src="http://#{app}.rpxnow.com/openid/embed?token_url=@{url}" scrolling="no" frameBorder="no" allowtransparency="true" style="width:400px;height:240px">
 |]
     dispatch _ [] = do

yesod-auth/yesod-auth.cabal

@@ -1,5 +1,5 @@
 name:            yesod-auth
-version:         1.0.2.1
+version:         1.1.0
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman, Patrick Brisbin
@@ -12,44 +12,34 @@ build-type:      Simple
 homepage:        http://www.yesodweb.com/
 description:     Authentication for Yesod.
 
-flag blaze_html_0_5
-    description: use blaze-html 0.5 and blaze-markup 0.5
-    default: True
-
 library
     build-depends:   base                    >= 4         && < 5
-                   , authenticate            >= 1.2.1     && < 1.3
+                   , authenticate            >= 1.3       && < 1.4
                    , bytestring              >= 0.9.1.4
-                   , yesod-core              >= 1.0       && < 1.1
+                   , yesod-core              >= 1.1       && < 1.2
-                   , wai                     >= 1.2       && < 1.3
+                   , wai                     >= 1.3       && < 1.4
                    , template-haskell
                    , pureMD5                 >= 2.0       && < 2.2
                    , random                  >= 1.0.0.2  && < 1.1
                    , text                    >= 0.7       && < 0.12
                    , mime-mail               >= 0.3       && < 0.5
-                   , yesod-persistent        >= 1.0       && < 1.1
+                   , yesod-persistent        >= 1.1       && < 1.2
-                   , hamlet                  >= 1.0       && < 1.1
+                   , hamlet                  >= 1.1       && < 1.2
                    , shakespeare-css         >= 1.0       && < 1.1
-                   , yesod-json              >= 1.0       && < 1.1
+                   , yesod-json              >= 1.1       && < 1.2
                    , containers
                    , unordered-containers
-                   , yesod-form              >= 1.0       && < 1.1
+                   , yesod-form              >= 1.1       && < 1.2
                    , transformers            >= 0.2.2     && < 0.4
-                   , persistent              >= 0.9       && < 0.10
+                   , persistent              >= 1.0       && < 1.1
-                   , persistent-template     >= 0.9       && < 0.10
+                   , persistent-template     >= 1.0       && < 1.1
                    , SHA                     >= 1.4.1.3   && < 1.6
-                   , http-conduit            >= 1.4.1.1   && < 1.5
+                   , http-conduit            >= 1.5       && < 1.6
                    , aeson                   >= 0.5
                    , pwstore-fast            >= 2.2       && < 3
                    , lifted-base             >= 0.1       && < 0.2
-
+                   , blaze-html              >= 0.5       && < 0.6
-    if flag(blaze_html_0_5)
+                   , blaze-markup            >= 0.5.1     && < 0.6
-        build-depends:
-                     blaze-html               >= 0.5     && < 0.6
-                   , blaze-markup             >= 0.5.1   && < 0.6
-    else
-        build-depends:
-                     blaze-html               >= 0.4     && < 0.5
 
     exposed-modules: Yesod.Auth
                      Yesod.Auth.BrowserId

yesod-core/Yesod/Content.hs

@@ -60,11 +60,7 @@ import Blaze.ByteString.Builder (Builder, fromByteString, fromLazyByteString)
 import Data.Monoid (mempty)
 
 import Text.Hamlet (Html)
-#if MIN_VERSION_blaze_html(0, 5, 0)
 import Text.Blaze.Html.Renderer.Utf8 (renderHtmlBuilder)
-#else
-import Text.Blaze.Renderer.Utf8 (renderHtmlBuilder)
-#endif
 import Data.String (IsString (fromString))
 import Network.Wai (FilePart)
 import Data.Conduit (Source, ResourceT, Flush)

yesod-core/Yesod/Core.hs

@@ -10,6 +10,7 @@ module Yesod.Core
     , breadcrumbs
       -- * Types
     , Approot (..)
+    , FileUpload (..)
       -- * Utitlities
     , maybeAuthorized
     , widgetToPageContent
@@ -20,8 +21,6 @@ module Yesod.Core
     , unauthorizedI
       -- * Logging
     , LogLevel (..)
-    , formatLogMessage
-    , fileLocationToString
     , logDebug
     , logInfo
     , logWarn
@@ -59,38 +58,7 @@ import Yesod.Request
 import Yesod.Widget
 import Yesod.Message
 
-import Language.Haskell.TH.Syntax
+import Control.Monad.Logger
-import qualified Language.Haskell.TH.Syntax as TH
-import Data.Text (Text)
-
-logTH :: LogLevel -> Q Exp
-logTH level =
-    [|messageLoggerHandler $(qLocation >>= liftLoc) $(TH.lift level)|]
-  where
-    liftLoc :: Loc -> Q Exp
-    liftLoc (Loc a b c d e) = [|Loc $(TH.lift a) $(TH.lift b) $(TH.lift c) $(TH.lift d) $(TH.lift e)|]
-
--- | Generates a function that takes a 'Text' and logs a 'LevelDebug' message. Usage:
---
--- > $(logDebug) "This is a debug log message"
-logDebug :: Q Exp
-logDebug = logTH LevelDebug
-
--- | See 'logDebug'
-logInfo :: Q Exp
-logInfo = logTH LevelInfo
--- | See 'logDebug'
-logWarn :: Q Exp
-logWarn = logTH LevelWarn
--- | See 'logDebug'
-logError :: Q Exp
-logError = logTH LevelError
-
--- | Generates a function that takes a 'Text' and logs a 'LevelOther' message. Usage:
---
--- > $(logOther "My new level") "This is a log message"
-logOther :: Text -> Q Exp
-logOther = logTH . LevelOther
 
 -- | Return an 'Unauthorized' value, with the given i18n message.
 unauthorizedI :: RenderMessage master msg => msg -> GHandler sub master AuthResult

yesod-core/Yesod/Dispatch.hs

@@ -28,7 +28,7 @@ module Yesod.Dispatch
     , WaiSubsite (..)
     ) where
 
-import Data.Functor   ((<$>))
+import Control.Applicative ((<$>), (<*>))
 import Prelude hiding (exp)
 import Yesod.Internal.Core
 import Yesod.Handler hiding (lift)
@@ -53,6 +53,7 @@ import Network.HTTP.Types (status301)
 import Yesod.Routes.TH
 import Yesod.Content (chooseRep)
 import Yesod.Routes.Parse
+import System.Log.FastLogger (Logger)
 
 type Texts = [Text]
 
@@ -60,7 +61,7 @@ type Texts = [Text]
 -- is used for creating sites, /not/ subsites. See 'mkYesodSub' for the latter.
 -- Use 'parseRoutes' to create the 'Resource's.
 mkYesod :: String -- ^ name of the argument datatype
-        -> [Resource String]
+        -> [ResourceTree String]
         -> Q [Dec]
 mkYesod name = fmap (uncurry (++)) . mkYesodGeneral name [] [] False
 
@@ -71,7 +72,7 @@ mkYesod name = fmap (uncurry (++)) . mkYesodGeneral name [] [] False
 -- be embedded in other sites.
 mkYesodSub :: String -- ^ name of the argument datatype
            -> Cxt
-           -> [Resource String]
+           -> [ResourceTree String]
            -> Q [Dec]
 mkYesodSub name clazzes =
     fmap (uncurry (++)) . mkYesodGeneral name' rest clazzes True
@@ -82,28 +83,28 @@ mkYesodSub name clazzes =
 -- your handlers elsewhere. For example, this is the only way to break up a
 -- monolithic file into smaller parts. Use this function, paired with
 -- 'mkYesodDispatch', to do just that.
-mkYesodData :: String -> [Resource String] -> Q [Dec]
+mkYesodData :: String -> [ResourceTree String] -> Q [Dec]
 mkYesodData name res = mkYesodDataGeneral name [] False res
 
-mkYesodSubData :: String -> Cxt -> [Resource String] -> Q [Dec]
+mkYesodSubData :: String -> Cxt -> [ResourceTree String] -> Q [Dec]
 mkYesodSubData name clazzes res = mkYesodDataGeneral name clazzes True res
 
-mkYesodDataGeneral :: String -> Cxt -> Bool -> [Resource String] -> Q [Dec]
+mkYesodDataGeneral :: String -> Cxt -> Bool -> [ResourceTree String] -> Q [Dec]
 mkYesodDataGeneral name clazzes isSub res = do
     let (name':rest) = words name
     (x, _) <- mkYesodGeneral name' rest clazzes isSub res
     let rname = mkName $ "resources" ++ name
     eres <- lift res
-    let y = [ SigD rname $ ListT `AppT` (ConT ''Resource `AppT` ConT ''String)
+    let y = [ SigD rname $ ListT `AppT` (ConT ''ResourceTree `AppT` ConT ''String)
             , FunD rname [Clause [] (NormalB eres) []]
             ]
     return $ x ++ y
 
 -- | See 'mkYesodData'.
-mkYesodDispatch :: String -> [Resource String] -> Q [Dec]
+mkYesodDispatch :: String -> [ResourceTree String] -> Q [Dec]
 mkYesodDispatch name = fmap snd . mkYesodGeneral name [] [] False
 
-mkYesodSubDispatch :: String -> Cxt -> [Resource String] -> Q [Dec]
+mkYesodSubDispatch :: String -> Cxt -> [ResourceTree String] -> Q [Dec]
 mkYesodSubDispatch name clazzes = fmap snd . mkYesodGeneral name' rest clazzes True 
   where (name':rest) = words name
 
@@ -111,7 +112,7 @@ mkYesodGeneral :: String -- ^ foundation type
                -> [String]
                -> Cxt -- ^ classes
                -> Bool -- ^ is subsite?
-               -> [Resource String]
+               -> [ResourceTree String]
                -> Q ([Dec], [Dec])
 mkYesodGeneral name args clazzes isSub resS = do
     let args' = map mkName args
@@ -119,7 +120,13 @@ mkYesodGeneral name args clazzes isSub resS = do
     let res = map (fmap parseType) resS
     renderRouteDec <- mkRenderRouteInstance arg res
 
-    disp <- mkDispatchClause [|yesodRunner|] [|yesodDispatch|] [|fmap chooseRep|] res
+    let logger = mkName "logger"
+    Clause pat body decs <- mkDispatchClause
+        [|yesodRunner $(return $ VarE logger)|]
+        [|yesodDispatch $(return $ VarE logger)|]
+        [|fmap chooseRep|]
+        res
+    let disp = Clause (VarP logger : pat) body decs
     let master = mkName "master"
     let ctx = if isSub
                 then ClassP (mkName "Yesod") [VarT master] : clazzes
@@ -130,7 +137,7 @@ mkYesodGeneral name args clazzes isSub resS = do
     let yesodDispatch' =
             InstanceD ctx ytyp [FunD (mkName "yesodDispatch") [disp]]
 
-    return (renderRouteDec : masterTypSyns, [yesodDispatch'])
+    return (renderRouteDec ++ masterTypSyns, [yesodDispatch'])
   where
     name' = mkName name
     masterTypSyns
@@ -160,23 +167,24 @@ toWaiApp y = gzip (gzipSettings y) . autohead <$> toWaiAppPlain y
 toWaiAppPlain :: ( Yesod master
                  , YesodDispatch master master
                  ) => master -> IO W.Application
-toWaiAppPlain a = toWaiApp' a <$> makeSessionBackend a
+toWaiAppPlain a = toWaiApp' a <$> getLogger a <*> makeSessionBackend a
 
 
 toWaiApp' :: ( Yesod master
              , YesodDispatch master master
              )
           => master
+          -> Logger
           -> Maybe (SessionBackend master)
           -> W.Application
-toWaiApp' y sb env =
+toWaiApp' y logger sb env =
     case cleanPath y $ W.pathInfo env of
         Left pieces -> sendRedirect y pieces env
         Right pieces ->
-            yesodDispatch y y id app404 handler405 method pieces sb env
+            yesodDispatch logger y y id app404 handler405 method pieces sb env
   where
-    app404 = yesodRunner notFound y y Nothing id
+    app404 = yesodRunner logger notFound y y Nothing id
-    handler405 route = yesodRunner badMethod y y (Just route) id
+    handler405 route = yesodRunner logger badMethod y y (Just route) id
     method = decodeUtf8With lenientDecode $ W.requestMethod env
 
 sendRedirect :: Yesod master => master -> [Text] -> W.Application
@@ -202,4 +210,4 @@ instance RenderRoute WaiSubsite where
     renderRoute (WaiSubsiteRoute ps qs) = (ps, qs)
 
 instance YesodDispatch WaiSubsite master where
-    yesodDispatch _master (WaiSubsite app) _tomaster _404 _405 _method _pieces _session = app
+    yesodDispatch _logger _master (WaiSubsite app) _tomaster _404 _405 _method _pieces _session = app

yesod-core/Yesod/Handler.hs

@@ -138,11 +138,7 @@ import qualified Network.Wai as W
 import qualified Network.HTTP.Types as H
 
 import Text.Hamlet
-#if MIN_VERSION_blaze_html(0, 5, 0)
 import qualified Text.Blaze.Html.Renderer.Text as RenderText
-#else
-import qualified Text.Blaze.Renderer.Text as RenderText
-#endif
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8, decodeUtf8With)
 import Data.Text.Encoding.Error (lenientDecode)
@@ -159,18 +155,18 @@ import Control.Arrow ((***))
 import qualified Network.Wai.Parse as NWP
 import Data.Monoid (mappend, mempty, Endo (..))
 import qualified Data.ByteString.Char8 as S8
+import Data.ByteString (ByteString)
 import Data.CaseInsensitive (CI)
 import qualified Data.CaseInsensitive as CI
 import Blaze.ByteString.Builder (toByteString)
 import Data.Text (Text)
 import Yesod.Message (RenderMessage (..))
 
-#if MIN_VERSION_blaze_html(0, 5, 0)
 import Text.Blaze.Html (toHtml, preEscapedToMarkup)
 #define preEscapedText preEscapedToMarkup
-#else
+
-import Text.Blaze (toHtml, preEscapedText)
+import System.Log.FastLogger
-#endif
+import Control.Monad.Logger
 
 import qualified Yesod.Internal.Cache as Cache
 import Yesod.Internal.Cache (mkCacheKey, CacheKey)
@@ -181,6 +177,9 @@ import Control.Monad.Trans.Control
 import Control.Monad.Trans.Resource
 import Control.Monad.Base
 import Yesod.Routes.Class
+import Data.Word (Word64)
+import Data.Conduit (Sink)
+import Language.Haskell.TH.Syntax (Loc)
 
 class YesodSubRoute s y where
     fromSubRoute :: s -> y -> Route s -> Route y
@@ -193,6 +192,8 @@ data HandlerData sub master = HandlerData
     , handlerRender   :: Route master -> [(Text, Text)] -> Text
     , handlerToMaster :: Route sub -> Route master
     , handlerState    :: I.IORef GHState
+    , handlerUpload   :: Word64 -> FileUpload
+    , handlerLog      :: Loc -> LogLevel -> LogStr -> IO ()
     }
 
 handlerSubData :: (Route sub -> Route master)
@@ -322,22 +323,36 @@ hcError = liftIO . throwIO . HCError
 
 runRequestBody :: GHandler s m RequestBodyContents
 runRequestBody = do
+    hd <- ask
+    let getUpload = handlerUpload hd
+        len = reqBodySize $ handlerRequest hd
+        upload = getUpload len
     x <- get
     case ghsRBC x of
         Just rbc -> return rbc
         Nothing -> do
             rr <- waiRequest
-            rbc <- lift $ rbHelper rr
+            rbc <- lift $ rbHelper upload rr
             put x { ghsRBC = Just rbc }
             return rbc
 
-rbHelper :: W.Request -> ResourceT IO RequestBodyContents
+rbHelper :: FileUpload -> W.Request -> ResourceT IO RequestBodyContents
-rbHelper req =
+rbHelper upload =
-    (map fix1 *** map fix2) <$> (NWP.parseRequestBody NWP.lbsBackEnd req)
+    case upload of
+        FileUploadMemory s -> rbHelper' s mkFileInfoLBS
+        FileUploadDisk s -> rbHelper' s mkFileInfoFile
+        FileUploadSource s -> rbHelper' s mkFileInfoSource
+
+rbHelper' :: Sink S8.ByteString (ResourceT IO) x
+          -> (Text -> Text -> x -> FileInfo)
+          -> W.Request
+          -> ResourceT IO ([(Text, Text)], [(Text, FileInfo)])
+rbHelper' sink mkFI req =
+    (map fix1 *** map fix2) <$> (NWP.parseRequestBody sink req)
   where
     fix1 = go *** go
     fix2 (x, NWP.FileInfo a b c) =
-        (go x, FileInfo (go a) (go b) c)
+        (go x, mkFI (go a) (go b) c)
     go = decodeUtf8With lenientDecode
 
 -- | Get the sub application argument.
@@ -378,8 +393,10 @@ runHandler :: HasReps c
            -> (Route sub -> Route master)
            -> master
            -> sub
+           -> (Word64 -> FileUpload)
+           -> (Loc -> LogLevel -> LogStr -> IO ())
            -> YesodApp
-runHandler handler mrender sroute tomr master sub =
+runHandler handler mrender sroute tomr master sub upload log' =
   YesodApp $ \eh rr cts initSession -> do
     let toErrorHandler e =
             case fromException e of
@@ -400,6 +417,8 @@ runHandler handler mrender sroute tomr master sub =
             , handlerRender = mrender
             , handlerToMaster = tomr
             , handlerState = istate
+            , handlerUpload = upload
+            , handlerLog = log'
             }
     contents' <- catch (fmap Right $ unGHandler handler hd)
         (\e -> return $ Left $ maybe (HCError $ toErrorHandler e) id
@@ -772,6 +791,8 @@ getSession = liftM ghsSession get
 handlerToYAR :: (HasReps a, HasReps b)
              => master -- ^ master site foundation
              -> sub    -- ^ sub site foundation
+             -> (Word64 -> FileUpload)
+             -> (Loc -> LogLevel -> LogStr -> IO ())
              -> (Route sub -> Route master)
              -> (Route master -> [(Text, Text)] -> Text) -- route renderer
              -> (ErrorResponse -> GHandler sub master a)
@@ -780,15 +801,15 @@ handlerToYAR :: (HasReps a, HasReps b)
              -> SessionMap
              -> GHandler sub master b
              -> ResourceT IO YesodAppResult
-handlerToYAR y s toMasterRoute render errorHandler rr murl sessionMap h =
+handlerToYAR y s upload log' toMasterRoute render errorHandler rr murl sessionMap h =
     unYesodApp ya eh' rr types sessionMap
   where
-    ya = runHandler h render murl toMasterRoute y s
+    ya = runHandler h render murl toMasterRoute y s upload log'
-    eh' er = runHandler (errorHandler' er) render murl toMasterRoute y s
+    eh' er = runHandler (errorHandler' er) render murl toMasterRoute y s upload log'
     types = httpAccept $ reqWaiRequest rr
     errorHandler' = localNoCurrent . errorHandler
 
-yarToResponse :: YesodAppResult -> [(CI H.Ascii, H.Ascii)] -> W.Response
+yarToResponse :: YesodAppResult -> [(CI ByteString, ByteString)] -> W.Response
 yarToResponse (YARWai a) _ = a
 yarToResponse (YARPlain s hs _ c _) extraHeaders =
     case c of
@@ -810,7 +831,7 @@ httpAccept = parseHttpAccept
 
 -- | Convert Header to a key/value pair.
 headerToPair :: Header
-             -> (CI H.Ascii, H.Ascii)
+             -> (CI ByteString, ByteString)
 headerToPair (AddCookie sc) =
     ("Set-Cookie", toByteString $ renderSetCookie $ sc)
 headerToPair (DeleteCookie key path) =
@@ -842,6 +863,7 @@ redirectToPost :: RedirectUrl master url => url -> GHandler sub master a
 redirectToPost url = do
     urlText <- toTextUrl url
     hamletToRepHtml [hamlet|
+$newline never
 $doctype 5
 
 <html>
@@ -936,3 +958,8 @@ instance MonadResource (GHandler sub master) where
     register = lift . register
     release = lift . release
     resourceMask = lift . resourceMask
+
+instance MonadLogger (GHandler sub master) where
+    monadLoggerLog a b c = do
+        hd <- ask
+        liftIO $ handlerLog hd a b (toLogStr c)

yesod-core/Yesod/Internal.hs

@@ -27,7 +27,8 @@ module Yesod.Internal
     , tokenKey
     ) where
 
-import Text.Hamlet (HtmlUrl, hamlet, Html)
+import Text.Hamlet (HtmlUrl, Html)
+import Text.Blaze.Html (toHtml)
 import Text.Julius (JavascriptUrl)
 import Data.Monoid (Monoid (..), Last)
 import Data.List (nub)
@@ -41,8 +42,8 @@ import qualified Network.HTTP.Types as H
 import Data.String (IsString)
 import qualified Data.Map as Map
 import Data.Text.Lazy.Builder (Builder)
-import Network.HTTP.Types (Ascii)
 import Web.Cookie (SetCookie (..))
+import Data.ByteString (ByteString)
 
 -- | Responses to indicate some form of an error occurred. These are different
 -- from 'SpecialResponse' in that they allow for custom error pages.
@@ -59,8 +60,8 @@ instance Exception ErrorResponse
 -- | Headers to be added to a 'Result'.
 data Header =
     AddCookie SetCookie
-    | DeleteCookie Ascii Ascii
+    | DeleteCookie ByteString ByteString
-    | Header Ascii Ascii
+    | Header ByteString ByteString
     deriving (Eq, Show)
 
 langKey :: IsString a => a
@@ -69,10 +70,8 @@ langKey = "_LANG"
 data Location url = Local url | Remote Text
     deriving (Show, Eq)
 locationToHtmlUrl :: Location url -> HtmlUrl url
-locationToHtmlUrl (Local url) = [hamlet|\@{url}
+locationToHtmlUrl (Local url) render = toHtml $ render url []
-|]
+locationToHtmlUrl (Remote s) _ = toHtml s
-locationToHtmlUrl (Remote s) = [hamlet|\#{s}
-|]
 
 newtype UniqueList x = UniqueList ([x] -> [x])
 instance Monoid (UniqueList x) where
@@ -100,13 +99,14 @@ tokenKey = "_TOKEN"
 type CssBuilderUrl a = (a -> [(Text, Text)] -> Text) -> Builder
 
 data GWData a = GWData
-    !(Body a)
+    { gwdBody :: !(Body a)
-    !(Last Title)
+    , gwdTitle :: !(Last Title)
-    !(UniqueList (Script a))
+    , gwdScripts :: !(UniqueList (Script a))
-    !(UniqueList (Stylesheet a))
+    , gwdStylesheets :: !(UniqueList (Stylesheet a))
-    !(Map.Map (Maybe Text) (CssBuilderUrl a)) -- media type
+    , gwdCss :: !(Map.Map (Maybe Text) (CssBuilderUrl a)) -- media type
-    !(Maybe (JavascriptUrl a))
+    , gwdJavascript :: !(Maybe (JavascriptUrl a))
-    !(Head a)
+    , gwdHead :: !(Head a)
+    }
 instance Monoid (GWData a) where
     mempty = GWData mempty mempty mempty mempty mempty mempty mempty
     mappend (GWData a1 a2 a3 a4 a5 a6 a7)

yesod-core/Yesod/Internal/Core.hs

@@ -20,11 +20,6 @@ module Yesod.Internal.Core
     , defaultErrorHandler
       -- * Data types
     , AuthResult (..)
-      -- * Logging
-    , LogLevel (..)
-    , formatLogMessage
-    , fileLocationToString
-    , messageLoggerHandler
       -- * Sessions
     , SessionBackend (..)
     , defaultClientSessionBackend
@@ -40,6 +35,7 @@ module Yesod.Internal.Core
     , yesodRender
     , resolveApproot
     , Approot (..)
+    , FileUpload (..)
     ) where
 
 import Yesod.Content
@@ -47,6 +43,7 @@ import Yesod.Handler hiding (lift, getExpires)
 
 import Yesod.Routes.Class
 
+import Data.Word (Word64)
 import Control.Arrow ((***))
 import Control.Monad (forM)
 import Yesod.Widget
@@ -80,26 +77,19 @@ import Blaze.ByteString.Builder.Char.Utf8 (fromText)
 import Data.List (foldl')
 import qualified Network.HTTP.Types as H
 import Web.Cookie (SetCookie (..))
-import qualified Data.Text.Lazy as TL
+import Language.Haskell.TH.Syntax (Loc (..))
-import qualified Data.Text.Lazy.IO
-import qualified Data.Text.Lazy.Builder as TB
-import Language.Haskell.TH.Syntax (Loc (..), Lift (..))
-#if MIN_VERSION_blaze_html(0, 5, 0)
 import Text.Blaze (preEscapedToMarkup)
-#else
-import Text.Blaze (preEscapedLazyText)
-#endif
 import Data.Aeson (Value (Array, String))
 import Data.Aeson.Encode (encode)
 import qualified Data.Vector as Vector
 import Network.Wai.Middleware.Gzip (GzipSettings, def)
+import Network.Wai.Parse (tempFileSink, lbsSink)
 import qualified Paths_yesod_core
 import Data.Version (showVersion)
-
+import System.Log.FastLogger (Logger, mkLogger, loggerDate, LogStr (..), loggerPutStr)
-#if MIN_VERSION_blaze_html(0, 5, 0)
+import Control.Monad.Logger (LogLevel (LevelInfo, LevelOther))
-preEscapedLazyText :: TL.Text -> Html
+import System.Log.FastLogger.Date (ZonedDate)
-preEscapedLazyText = preEscapedToMarkup
+import System.IO (stdout)
-#endif
 
 yesodVersion :: String
 yesodVersion = showVersion Paths_yesod_core.version
@@ -109,7 +99,8 @@ yesodVersion = showVersion Paths_yesod_core.version
 class YesodDispatch sub master where
     yesodDispatch
         :: Yesod master
-        => master
+        => Logger
+        -> master
         -> sub
         -> (Route sub -> Route master)
         -> (Maybe (SessionBackend master) -> W.Application) -- ^ 404 handler
@@ -120,7 +111,8 @@ class YesodDispatch sub master where
         -> W.Application
 
     yesodRunner :: Yesod master
-                => GHandler sub master ChooseRep
+                => Logger
+                -> GHandler sub master ChooseRep
                 -> master
                 -> sub
                 -> Maybe (Route sub)
@@ -170,6 +162,7 @@ class RenderRoute a => Yesod a where
         p <- widgetToPageContent w
         mmsg <- getMessage
         hamletToRepHtml [hamlet|
+$newline never
 $doctype 5
 
 <html>
@@ -290,21 +283,28 @@ $doctype 5
     cookieDomain _ = Nothing
 
     -- | Maximum allowed length of the request body, in bytes.
-    maximumContentLength :: a -> Maybe (Route a) -> Int
+    --
+    -- Default: 2 megabytes.
+    maximumContentLength :: a -> Maybe (Route a) -> Word64
     maximumContentLength _ _ = 2 * 1024 * 1024 -- 2 megabytes
 
-    -- | Send a message to the log. By default, prints to stdout.
+    -- | Returns a @Logger@ to use for log messages.
+    --
+    -- Default: Sends to stdout and automatically flushes on each write.
+    getLogger :: a -> IO Logger
+    getLogger _ = mkLogger True stdout
+
+    -- | Send a message to the @Logger@ provided by @getLogger@.
     messageLogger :: a
+                  -> Logger
                   -> Loc -- ^ position in source code
                   -> LogLevel
-                  -> Text -- ^ message
+                  -> LogStr -- ^ message
                   -> IO ()
-    messageLogger a loc level msg =
+    messageLogger a logger loc level msg =
         if level < logLevel a
             then return ()
-            else
+            else formatLogMessage (loggerDate logger) loc level msg >>= loggerPutStr logger
-                formatLogMessage loc level msg >>=
-                Data.Text.Lazy.IO.putStrLn
 
     -- | The logging level in place for this application. Any messages below
     -- this level will simply be ignored.
@@ -332,38 +332,37 @@ $doctype 5
         key <- CS.getKey CS.defaultKeyFile
         return $ Just $ clientSessionBackend key 120
 
+    -- | How to store uploaded files.
+    --
+    -- Default: Whe nthe request body is greater than 50kb, store in a temp
+    -- file. Otherwise, store in memory.
+    fileUpload :: a
+               -> Word64 -- ^ request body size
+               -> FileUpload
+    fileUpload _ size
+        | size > 50000 = FileUploadDisk tempFileSink
+        | otherwise = FileUploadMemory lbsSink
 
-messageLoggerHandler :: Yesod m
+formatLogMessage :: IO ZonedDate
-                     => Loc -> LogLevel -> Text -> GHandler s m ()
+                 -> Loc
-messageLoggerHandler loc level msg = do
-    y <- getYesod
-    liftIO $ messageLogger y loc level msg
-
-data LogLevel = LevelDebug | LevelInfo | LevelWarn | LevelError | LevelOther Text
-    deriving (Eq, Show, Read, Ord)
-
-instance Lift LogLevel where
-    lift LevelDebug = [|LevelDebug|]
-    lift LevelInfo = [|LevelInfo|]
-    lift LevelWarn = [|LevelWarn|]
-    lift LevelError = [|LevelError|]
-    lift (LevelOther x) = [|LevelOther $ T.pack $(lift $ T.unpack x)|]
-
-formatLogMessage :: Loc
                  -> LogLevel
-                 -> Text -- ^ message
+                 -> LogStr -- ^ message
-                 -> IO TL.Text
+                 -> IO [LogStr]
-formatLogMessage loc level msg = do
+formatLogMessage getdate loc level msg = do
-    now <- getCurrentTime
+    now <- getdate
-    return $ TB.toLazyText $
+    return
-        TB.fromText (T.pack $ show now)
+        [ LB now
-        `mappend` TB.fromText " ["
+        , LB " ["
-        `mappend` TB.fromText (T.pack $ drop 5 $ show level)
+        , LS $
-        `mappend` TB.fromText "] "
+            case level of
-        `mappend` TB.fromText msg
+                LevelOther t -> T.unpack t
-        `mappend` TB.fromText " @("
+                _ -> drop 5 $ show level
-        `mappend` TB.fromText (T.pack $ fileLocationToString loc)
+        , LB "] "
-        `mappend` TB.fromText ") "
+        , msg
+        , LB " @("
+        , LS $ fileLocationToString loc
+        , LB ")\n"
+        ]
 
 -- taken from file-location package
 -- turn the TH Loc loaction information into a human readable string
@@ -376,31 +375,26 @@ fileLocationToString loc = (loc_package loc) ++ ':' : (loc_module loc) ++
     char = show . snd . loc_start
 
 defaultYesodRunner :: Yesod master
-                   => GHandler sub master ChooseRep
+                   => Logger
+                   -> GHandler sub master ChooseRep
                    -> master
                    -> sub
                    -> Maybe (Route sub)
                    -> (Route sub -> Route master)
                    -> Maybe (SessionBackend master)
                    -> W.Application
-defaultYesodRunner _ master _ murl toMaster _ req
+defaultYesodRunner logger handler master sub murl toMasterRoute msb req
-    | maximumContentLength master (fmap toMaster murl) < len =
+  | maximumContentLength master (fmap toMasterRoute murl) < len =
         return $ W.responseLBS
             (H.Status 413 "Too Large")
             [("Content-Type", "text/plain")]
             "Request body too large to be processed."
-  where
+  | otherwise = do
-    len = fromMaybe 0 $ lookup "content-length" (W.requestHeaders req) >>= readMay
-    readMay s =
-        case reads $ S8.unpack s of
-            [] -> Nothing
-            (x, _):_ -> Just x
-defaultYesodRunner handler master sub murl toMasterRoute msb req = do
     now <- liftIO getCurrentTime
     let dontSaveSession _ _ = return []
     (session, saveSession) <- liftIO $
         maybe (return ([], dontSaveSession)) (\sb -> sbLoadSession sb master req now) msb
-    rr <- liftIO $ parseWaiRequest req session (isJust msb)
+    rr <- liftIO $ parseWaiRequest req session (isJust msb) len
     let h = {-# SCC "h" #-} do
           case murl of
             Nothing -> handler
@@ -420,7 +414,8 @@ defaultYesodRunner handler master sub murl toMasterRoute msb req = do
                 handler
     let sessionMap = Map.fromList . filter ((/=) tokenKey . fst) $ session
     let ra = resolveApproot master req
-    yar <- handlerToYAR master sub toMasterRoute
+    let log' = messageLogger master logger
+    yar <- handlerToYAR master sub (fileUpload master) log' toMasterRoute
         (yesodRender master ra) errorHandler rr murl sessionMap h
     extraHeaders <- case yar of
         (YARPlain _ _ ct _ newSess) -> do
@@ -432,6 +427,12 @@ defaultYesodRunner handler master sub murl toMasterRoute msb req = do
             return $ ("Content-Type", ct) : map headerToPair sessionHeaders
         _ -> return []
     return $ yarToResponse yar extraHeaders
+  where
+    len = fromMaybe 0 $ lookup "content-length" (W.requestHeaders req) >>= readMay
+    readMay s =
+        case reads $ S8.unpack s of
+            [] -> Nothing
+            (x, _):_ -> Just x
 
 data AuthResult = Authorized | AuthenticationRequired | Unauthorized Text
     deriving (Eq, Show, Read)
@@ -478,18 +479,21 @@ defaultErrorHandler NotFound = do
     let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r
     applyLayout' "Not Found"
         [hamlet|
+$newline never
 <h1>Not Found
 <p>#{path'}
 |]
 defaultErrorHandler (PermissionDenied msg) =
     applyLayout' "Permission Denied"
         [hamlet|
+$newline never
 <h1>Permission denied
 <p>#{msg}
 |]
 defaultErrorHandler (InvalidArgs ia) =
     applyLayout' "Invalid Arguments"
         [hamlet|
+$newline never
 <h1>Invalid Arguments
 <ul>
     $forall msg <- ia
@@ -498,12 +502,14 @@ defaultErrorHandler (InvalidArgs ia) =
 defaultErrorHandler (InternalError e) =
     applyLayout' "Internal Server Error"
         [hamlet|
+$newline never
 <h1>Internal Server Error
 <p>#{e}
 |]
 defaultErrorHandler (BadMethod m) =
     applyLayout' "Bad Method"
         [hamlet|
+$newline never
 <h1>Method Not Supported
 <p>Method "#{S8.unpack m}" not supported
 |]
@@ -521,7 +527,7 @@ maybeAuthorized r isWrite = do
     return $ if x == Authorized then Just r else Nothing
 
 jsToHtml :: Javascript -> Html
-jsToHtml (Javascript b) = preEscapedLazyText $ toLazyText b
+jsToHtml (Javascript b) = preEscapedToMarkup $ toLazyText b
 
 jelper :: JavascriptUrl url -> HtmlUrl url
 jelper = fmap jsToHtml
@@ -549,7 +555,7 @@ widgetToPageContent w = do
            $ encodeUtf8 rendered
         return (mmedia,
             case x of
-                Nothing -> Left $ preEscapedLazyText rendered
+                Nothing -> Left $ preEscapedToMarkup rendered
                 Just y -> Right $ either id (uncurry render) y)
     jsLoc <-
         case jscript of
@@ -563,6 +569,7 @@ widgetToPageContent w = do
     -- 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
         regularScriptLoad = [hamlet|
+$newline never
 $forall s <- scripts
     ^{mkScriptTag s}
 $maybe j <- jscript
@@ -573,6 +580,7 @@ $maybe j <- jscript
 |]
 
         headAll = [hamlet|
+$newline never
 \^{head'}
 $forall s <- stylesheets
     ^{mkLinkTag s}
@@ -595,6 +603,7 @@ $case jsLoader master
       ^{regularScriptLoad}
 |]
     let bodyScript = [hamlet|
+$newline never
 ^{body}
 ^{regularScriptLoad}
 |]
@@ -641,6 +650,7 @@ jsonArray = unsafeLazyByteString . encode . Array . Vector.fromList . map String
 loadJsYepnope :: Yesod master => Either Text (Route master) -> [Text] -> Maybe (HtmlUrl (Route master)) -> (HtmlUrl (Route master))
 loadJsYepnope eyn scripts mcomplete =
   [hamlet|
+$newline never
     $maybe yn <- left eyn
         <script src=#{yn}>
     $maybe yn <- right eyn

yesod-core/Yesod/Internal/Request.hs

@@ -4,7 +4,15 @@ module Yesod.Internal.Request
     ( parseWaiRequest
     , Request (..)
     , RequestBodyContents
-    , FileInfo (..)
+    , FileInfo
+    , fileName
+    , fileContentType
+    , fileSource
+    , fileMove
+    , mkFileInfoLBS
+    , mkFileInfoFile
+    , mkFileInfoSource
+    , FileUpload (..)
     -- The below are exported for testing.
     , randomString
     , parseWaiRequest'
@@ -28,6 +36,10 @@ import qualified Data.Set as Set
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8With)
 import Data.Text.Encoding.Error (lenientDecode)
+import Data.Conduit
+import Data.Conduit.List (sourceList)
+import Data.Conduit.Binary (sourceFile, sinkFile)
+import Data.Word (Word64)
 
 -- | The parsed request information.
 data Request = Request
@@ -38,23 +50,27 @@ data Request = Request
     , reqLangs :: [Text]
       -- | A random, session-specific token used to prevent CSRF attacks.
     , reqToken :: Maybe Text
+      -- | Size of the request body.
+    , reqBodySize :: Word64
     }
 
 parseWaiRequest :: W.Request
                 -> [(Text, ByteString)] -- ^ session
                 -> Bool
+                -> Word64
                 -> IO Request
-parseWaiRequest env session' useToken =
+parseWaiRequest env session' useToken bodySize =
-    parseWaiRequest' env session' useToken <$> newStdGen
+    parseWaiRequest' env session' useToken bodySize <$> newStdGen
 
 parseWaiRequest' :: RandomGen g
                  => W.Request
                  -> [(Text, ByteString)] -- ^ session
                  -> Bool
+                 -> Word64
                  -> g
                  -> Request
-parseWaiRequest' env session' useToken gen = 
+parseWaiRequest' env session' useToken bodySize gen =
-    Request gets'' cookies' env langs'' token
+    Request gets'' cookies' env langs'' token bodySize
   where
     gets' = queryToQueryText $ W.queryString env
     gets'' = map (second $ fromMaybe "") gets'
@@ -116,6 +132,19 @@ type RequestBodyContents =
 data FileInfo = FileInfo
     { fileName :: Text
     , fileContentType :: Text
-    , fileContent :: L.ByteString
+    , fileSource :: Source (ResourceT IO) ByteString
+    , fileMove :: FilePath -> IO ()
     }
-    deriving (Eq, Show)
+
+mkFileInfoLBS :: Text -> Text -> L.ByteString -> FileInfo
+mkFileInfoLBS name ct lbs = FileInfo name ct (sourceList $ L.toChunks lbs) (\fp -> L.writeFile fp lbs)
+
+mkFileInfoFile :: Text -> Text -> FilePath -> FileInfo
+mkFileInfoFile name ct fp = FileInfo name ct (sourceFile fp) (\dst -> runResourceT $ sourceFile fp $$ sinkFile dst)
+
+mkFileInfoSource :: Text -> Text -> Source (ResourceT IO) ByteString -> FileInfo
+mkFileInfoSource name ct src = FileInfo name ct src (\dst -> runResourceT $ src $$ sinkFile dst)
+
+data FileUpload = FileUploadMemory (Sink ByteString (ResourceT IO) L.ByteString)
+                | FileUploadDisk (Sink ByteString (ResourceT IO) FilePath)
+                | FileUploadSource (Sink ByteString (ResourceT IO) (Source (ResourceT IO) ByteString))

yesod-core/Yesod/Logger.hs

@@ -1,138 +0,0 @@
-{-# LANGUAGE BangPatterns #-}
-module Yesod.Logger
-    ( Logger
-    , handle
-    , developmentLogger, productionLogger
-    , defaultDevelopmentLogger, defaultProductionLogger
-    , toProduction
-    , flushLogger
-    , logText
-    , logLazyText
-    , logString
-    , logBS
-    , logMsg
-    , formatLogText
-    , timed
-    -- * Deprecated
-    , makeLoggerWithHandle
-    , makeDefaultLogger
-    ) where
-
-import System.IO (Handle, stdout, hFlush)
-import Data.ByteString (ByteString)
-import Data.ByteString.Char8 (pack)
-import Data.ByteString.Lazy (toChunks)
-import qualified Data.Text.Lazy as TL
-import Data.Text (Text)
-import Data.Text.Encoding (encodeUtf8)
-import qualified Data.Text.Lazy.Encoding as TLE
-import System.Log.FastLogger
-import Network.Wai.Logger.Date (DateRef, dateInit, getDate)
-
--- for timed logging
-import Data.Time (getCurrentTime, diffUTCTime)
-import Control.Monad.IO.Class (MonadIO, liftIO)
-import Text.Printf (printf)
-import Data.Text (unpack)
-
--- for formatter
-import Language.Haskell.TH.Syntax (Loc)
-import Yesod.Core (LogLevel, fileLocationToString)
-
-data Logger = Logger {
-    loggerLogFun   :: [LogStr] -> IO ()
-  , loggerHandle   :: Handle
-  , loggerDateRef  :: DateRef
-  }
-
-handle :: Logger -> Handle
-handle = loggerHandle
-
-flushLogger :: Logger -> IO ()
-flushLogger = hFlush . loggerHandle
-
-makeDefaultLogger :: IO Logger
-makeDefaultLogger = defaultDevelopmentLogger
-{-# DEPRECATED makeDefaultLogger "Use defaultProductionLogger or defaultDevelopmentLogger instead" #-}
-
-makeLoggerWithHandle, developmentLogger, productionLogger :: Handle -> IO Logger
-makeLoggerWithHandle = productionLogger
-{-# DEPRECATED makeLoggerWithHandle "Use productionLogger or developmentLogger instead" #-}
-
--- | uses stdout handle
-defaultProductionLogger, defaultDevelopmentLogger :: IO Logger
-defaultProductionLogger = productionLogger stdout
-defaultDevelopmentLogger = developmentLogger stdout
-
-
-productionLogger h = mkLogger h (handleToLogFun h)
--- | a development logger gets automatically flushed
-developmentLogger h = mkLogger h (\bs -> (handleToLogFun h) bs >> hFlush h)
-
-mkLogger :: Handle -> ([LogStr] -> IO ()) -> IO Logger
-mkLogger h logFun = do
-    initHandle h
-    dateInit >>= return . Logger logFun h
-
--- convert (a development) logger to production settings
-toProduction :: Logger -> Logger
-toProduction (Logger _ h d) = Logger (handleToLogFun h) h d
-
-handleToLogFun :: Handle -> ([LogStr] -> IO ())
-handleToLogFun = hPutLogStr
-
-logMsg :: Logger -> [LogStr] -> IO ()
-logMsg = hPutLogStr . handle
-
-logLazyText :: Logger -> TL.Text -> IO ()
-logLazyText logger msg = loggerLogFun logger $
-  map LB (toChunks $ TLE.encodeUtf8 msg) ++ [newLine]
-
-logText :: Logger -> Text -> IO ()
-logText logger = logBS logger . encodeUtf8
-
-logBS :: Logger -> ByteString -> IO ()
-logBS logger msg = loggerLogFun logger $ [LB msg, newLine]
-
-logString :: Logger -> String -> IO ()
-logString logger msg = loggerLogFun logger $ [LS msg, newLine]
-
-formatLogText :: Logger -> Loc -> LogLevel -> Text -> IO [LogStr]
-formatLogText logger loc level msg = formatLogMsg logger loc level (toLB msg)
-
-toLB :: Text -> LogStr
-toLB = LB . encodeUtf8
-
-formatLogMsg :: Logger -> Loc -> LogLevel -> LogStr -> IO [LogStr]
-formatLogMsg logger loc level msg = do
-    date <- liftIO $ getDate $ loggerDateRef logger
-    return
-        [ LB date
-        , LB $ pack" ["
-        , LS (drop 5 $ show level)
-        , LB $ pack "] "
-        , msg
-        , LB $ pack " @("
-        , LS (fileLocationToString loc)
-        , LB $ pack ") "
-        ]
-
-newLine :: LogStr
-newLine = LB $ pack "\n"
-
--- | Execute a monadic action and log the duration
---
-timed :: MonadIO m
-      => Logger  -- ^ Logger
-      -> Text  -- ^ Message
-      -> m a     -- ^ Action
-      -> m a     -- ^ Timed and logged action
-timed logger msg action = do
-    start <- liftIO getCurrentTime
-    !result <- action
-    stop <- liftIO getCurrentTime
-    let diff = fromEnum $ diffUTCTime stop start
-        ms = diff `div` 10 ^ (9 :: Int)
-        formatted = printf "  [%4dms] %s" ms (unpack msg)
-    liftIO $ logString logger formatted
-    return result

yesod-core/Yesod/Request.hs

@@ -16,7 +16,11 @@ module Yesod.Request
       -- * Request datatype
       RequestBodyContents
     , Request (..)
-    , FileInfo (..)
+    , FileInfo
+    , fileName
+    , fileContentType
+    , fileSource
+    , fileMove
       -- * Convenience functions
     , languages
       -- * Lookup parameters

yesod-core/Yesod/Widget.hs

@@ -53,6 +53,7 @@ module Yesod.Widget
     , addScriptEither
       -- * Internal
     , unGWidget
+    , whamletFileWithSettings
     ) where
 
 import Data.Monoid
@@ -80,20 +81,16 @@ import Control.Monad.Trans.Control (MonadBaseControl (..))
 import Control.Exception (throwIO)
 import qualified Text.Hamlet as NP
 import Data.Text.Lazy.Builder (fromLazyText)
-#if MIN_VERSION_blaze_html(0, 5, 0)
 import Text.Blaze.Html (toHtml, preEscapedToMarkup)
 import qualified Data.Text.Lazy as TL
-#else
-import Text.Blaze (toHtml, preEscapedLazyText)
-#endif
 import Control.Monad.Base (MonadBase (liftBase))
 import Control.Arrow (first)
 import Control.Monad.Trans.Resource
 
-#if MIN_VERSION_blaze_html(0, 5, 0)
+import Control.Monad.Logger
+
 preEscapedLazyText :: TL.Text -> Html
 preEscapedLazyText = preEscapedToMarkup
-#endif
 
 -- | A generic widget, allowing specification of both the subsite and master
 -- site datatypes. While this is simply a @WriterT@, we define a newtype for
@@ -272,6 +269,9 @@ whamlet = NP.hamletWithSettings rules NP.defaultHamletSettings
 whamletFile :: FilePath -> Q Exp
 whamletFile = NP.hamletFileWithSettings rules NP.defaultHamletSettings
 
+whamletFileWithSettings :: NP.HamletSettings -> FilePath -> Q Exp
+whamletFileWithSettings = NP.hamletFileWithSettings rules
+
 rules :: Q NP.HamletRules
 rules = do
     ah <- [|toWidget|]
@@ -344,3 +344,6 @@ instance MonadResource (GWidget sub master) where
     register = lift . register
     release = lift . release
     resourceMask = lift . resourceMask
+
+instance MonadLogger (GWidget sub master) where
+    monadLoggerLog a b = lift . monadLoggerLog a b

yesod-core/helloworld.hs

@@ -5,7 +5,7 @@
 import Yesod.Core
 import Control.Monad.IO.Class (liftIO)
 import Network.Wai.Handler.Warp (run)
-import Data.Text (unpack)
+import Data.Text (unpack, pack)
 import Text.Julius (julius)
 
 data Subsite = Subsite String
@@ -22,13 +22,13 @@ getSubRootR = do
     Subsite s <- getYesodSub
     tm <- getRouteToMaster
     render <- getUrlRender
-    $(logDebug) "I'm in SubRootR"
+    $logDebug "I'm in SubRootR"
     return $ RepPlain $ toContent $ "Hello Sub World: " ++ s ++ ". " ++ unpack (render (tm SubRootR))
 
 handleSubMultiR :: Yesod m => Strings -> GHandler Subsite m RepPlain
 handleSubMultiR x = do
     Subsite y <- getYesodSub
-    $(logInfo) "In SubMultiR"
+    $logInfo "In SubMultiR"
     return . RepPlain . toContent . show $ (x, y)
 
 data HelloWorld = HelloWorld { getSubsite :: String -> Subsite }
@@ -38,7 +38,7 @@ mkYesod "HelloWorld" [parseRoutes|
 |]
 instance Yesod HelloWorld where
     addStaticContent a b c = do
-        liftIO $ print (a, b, c)
+        $logInfo $ pack $ show (a, b, c)
         return Nothing
 
 getRootR = do

yesod-core/test/YesodCoreTest/CleanPath.hs

@@ -26,7 +26,7 @@ instance RenderRoute Subsite where
     renderRoute (SubsiteRoute x) = (x, [])
 
 instance YesodDispatch Subsite master where
-    yesodDispatch _ _ _ _ _ _ pieces _ _ = return $ responseLBS
+    yesodDispatch _ _ _ _ _ _ _ pieces _ _ = return $ responseLBS
         status200
         [ ("Content-Type", "SUBSITE")
         ] $ L8.pack $ show pieces

yesod-core/test/YesodCoreTest/ErrorHandling.hs

@@ -24,7 +24,9 @@ mkYesod "App" [parseRoutes|
 instance Yesod App
 
 getHomeR :: Handler RepHtml
-getHomeR = defaultLayout $ toWidget [hamlet|
+getHomeR = do
+    $logDebug "Testing logging"
+    defaultLayout $ toWidget [hamlet|
 $doctype 5
 
 <html>
@@ -49,7 +51,7 @@ postFirstThingR = do
 
 postAfterRunRequestBodyR = do
    x <- runRequestBody
-   _ <- error $ show x
+   _ <- error $ show $ fst x
    getHomeR
 
 errorHandlingTest :: Spec

yesod-core/test/YesodCoreTest/InternalRequest.hs

@@ -40,19 +40,19 @@ tokenSpecs = describe "Yesod.Internal.Request.parseWaiRequest (reqToken)"
 
 noDisabledToken :: Bool
 noDisabledToken = reqToken r == Nothing where
-  r = parseWaiRequest' defaultRequest [] False g
+  r = parseWaiRequest' defaultRequest [] False 0 g
 
 ignoreDisabledToken :: Bool
 ignoreDisabledToken = reqToken r == Nothing where
-  r = parseWaiRequest' defaultRequest [("_TOKEN", "old")] False g
+  r = parseWaiRequest' defaultRequest [("_TOKEN", "old")] False 0 g
 
 useOldToken :: Bool
 useOldToken = reqToken r == Just "old" where
-  r = parseWaiRequest' defaultRequest [("_TOKEN", "old")] True g
+  r = parseWaiRequest' defaultRequest [("_TOKEN", "old")] True 0 g
 
 generateToken :: Bool
 generateToken = reqToken r /= Nothing where
-  r = parseWaiRequest' defaultRequest [("_TOKEN", "old")] True g
+  r = parseWaiRequest' defaultRequest [("_TOKEN", "old")] True 0 g
 
 
 langSpecs :: Spec
@@ -67,21 +67,21 @@ langSpecs = describe "Yesod.Internal.Request.parseWaiRequest (reqLangs)"
 respectAcceptLangs :: Bool
 respectAcceptLangs = reqLangs r == ["en-US", "es", "en"] where
   r = parseWaiRequest' defaultRequest
-        { requestHeaders = [("Accept-Language", "en-US, es")] } [] False g
+        { requestHeaders = [("Accept-Language", "en-US, es")] } [] False 0 g
 
 respectSessionLang :: Bool
 respectSessionLang = reqLangs r == ["en"] where
-  r = parseWaiRequest' defaultRequest [("_LANG", "en")] False g
+  r = parseWaiRequest' defaultRequest [("_LANG", "en")] False 0 g
 
 respectCookieLang :: Bool
 respectCookieLang = reqLangs r == ["en"] where
   r = parseWaiRequest' defaultRequest
         { requestHeaders = [("Cookie", "_LANG=en")]
-        } [] False g
+        } [] False 0 g
 
 respectQueryLang :: Bool
 respectQueryLang = reqLangs r == ["en-US", "en"] where
-  r = parseWaiRequest' defaultRequest { queryString = [("_LANG", Just "en-US")] } [] False g
+  r = parseWaiRequest' defaultRequest { queryString = [("_LANG", Just "en-US")] } [] False 0 g
 
 prioritizeLangs :: Bool
 prioritizeLangs = reqLangs r == ["en-QUERY", "en-COOKIE", "en-SESSION", "en", "es"] where
@@ -90,7 +90,7 @@ prioritizeLangs = reqLangs r == ["en-QUERY", "en-COOKIE", "en-SESSION", "en", "e
                            , ("Cookie", "_LANG=en-COOKIE")
                            ]
         , queryString = [("_LANG", Just "en-QUERY")]
-        } [("_LANG", "en-SESSION")] False g
+        } [("_LANG", "en-SESSION")] False 0 g
 
 
 internalRequestTest :: Spec

yesod-core/test/YesodCoreTest/Links.hs

@@ -31,4 +31,4 @@ runner f = toWaiApp Y >>= runSession f
 case_linkToHome :: IO ()
 case_linkToHome = runner $ do
     res <- request defaultRequest
-    assertBody "<!DOCTYPE html>\n<html><head><title></title></head><body><a href=\"/\"></a></body></html>" res
+    assertBody "<!DOCTYPE html>\n<html><head><title></title></head><body><a href=\"/\"></a>\n</body></html>" res

yesod-core/test/YesodCoreTest/Widget.hs

@@ -56,12 +56,13 @@ getTowidgetR = defaultLayout $ do
     toWidget [lucius|foo{bar:baz}|]
     toWidgetHead [lucius|foo{bar:baz}|]
 
-    toWidget [hamlet|<foo>|] :: Widget
+    toWidget [hamlet|<foo>|]
     toWidgetHead [hamlet|<foo>|]
     toWidgetBody [hamlet|<foo>|]
 
 getWhamletR :: Handler RepHtml
 getWhamletR = defaultLayout [whamlet|
+$newline never
 <h1>Test
 <h2>@{WhamletR}
 <h3>_{Goodbye}
@@ -69,10 +70,14 @@ getWhamletR = defaultLayout [whamlet|
 ^{embed}
 |]
   where
-    embed = [whamlet|<h4>Embed|]
+    embed = [whamlet|
+$newline never
+<h4>Embed
+|]
 
 getAutoR :: Handler RepHtml
 getAutoR = defaultLayout [whamlet|
+$newline never
 ^{someHtml}
 |]
   where

yesod-core/yesod-core.cabal

@@ -1,5 +1,5 @@
 name:            yesod-core
-version:         1.0.1.3
+version:         1.1.0
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -40,10 +40,6 @@ flag test
   description: Build the executable to run unit tests
   default: False
 
-flag blaze_html_0_5
-    description: use blaze-html 0.5 and blaze-markup 0.5
-    default: True
-
 library
     -- Work around a bug in cabal. Without this, wai-test doesn't get built and
     -- we have a missing dependency during --enable-tests builds.
@@ -52,21 +48,21 @@ library
 
     build-depends:   base                  >= 4.3      && < 5
                    , time                  >= 1.1.4
-                   , yesod-routes          >= 1.0      && < 1.1
+                   , yesod-routes          >= 1.1      && < 1.2
-                   , wai                   >= 1.2      && < 1.3
+                   , wai                   >= 1.3      && < 1.4
-                   , wai-extra             >= 1.2      && < 1.3
+                   , wai-extra             >= 1.3      && < 1.4
                    , bytestring            >= 0.9.1.4
                    , text                  >= 0.7      && < 0.12
                    , template-haskell
                    , path-pieces           >= 0.1      && < 0.2
-                   , hamlet                >= 1.0      && < 1.1
+                   , hamlet                >= 1.1      && < 1.2
                    , shakespeare           >= 1.0      && < 1.1
                    , shakespeare-js        >= 1.0      && < 1.1
                    , shakespeare-css       >= 1.0      && < 1.1
                    , shakespeare-i18n      >= 1.0      && < 1.1
                    , blaze-builder         >= 0.2.1.4  && < 0.4
                    , transformers          >= 0.2.2    && < 0.4
-                   , clientsession         >= 0.7.3.1  && < 0.8
+                   , clientsession         >= 0.8      && < 0.9
                    , random                >= 1.0.0.2  && < 1.1
                    , cereal                >= 0.3      && < 0.4
                    , old-locale            >= 1.0.0.2  && < 1.1
@@ -75,31 +71,24 @@ library
                    , monad-control         >= 0.3      && < 0.4
                    , transformers-base     >= 0.4
                    , cookie                >= 0.4      && < 0.5
-                   , http-types            >= 0.6.5    && < 0.7
+                   , http-types            >= 0.7      && < 0.8
                    , case-insensitive      >= 0.2
                    , parsec                >= 2        && < 3.2
                    , directory             >= 1        && < 1.2
                    , vector                >= 0.9      && < 0.10
                    , aeson                 >= 0.5
-                   , fast-logger           >= 0.0.2
+                   , fast-logger           >= 0.2      && < 0.3
-                   , wai-logger            >= 0.0.1
+                   , monad-logger          >= 0.2      && < 0.3
-                   , conduit               >= 0.4      && < 0.5
+                   , conduit               >= 0.5      && < 0.6
                    , resourcet             >= 0.3      && < 0.4
                    , lifted-base           >= 0.1      && < 0.2
-
+                   , blaze-html            >= 0.5      && < 0.6
-    if flag(blaze_html_0_5)
+                   , blaze-markup          >= 0.5.1    && < 0.6
-        build-depends:
-                     blaze-html               >= 0.5     && < 0.6
-                   , blaze-markup             >= 0.5.1   && < 0.6
-    else
-        build-depends:
-                     blaze-html               >= 0.4     && < 0.5
 
     exposed-modules: Yesod.Content
                      Yesod.Core
                      Yesod.Dispatch
                      Yesod.Handler
-                     Yesod.Logger
                      Yesod.Request
                      Yesod.Widget
                      Yesod.Message

yesod-default/Yesod/Default/Main.hs

@@ -7,7 +7,6 @@ module Yesod.Default.Main
     ) where
 
 import Yesod.Default.Config
-import Yesod.Logger (Logger, defaultDevelopmentLogger, logString)
 import Network.Wai (Application)
 import Network.Wai.Handler.Warp
     (runSettings, defaultSettings, settingsPort, settingsHost)
@@ -33,12 +32,11 @@ import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
 --
 defaultMain :: (Show env, Read env)
             => IO (AppConfig env extra)
-            -> (AppConfig env extra -> Logger -> IO Application)
+            -> (AppConfig env extra -> IO Application)
             -> IO ()
 defaultMain load getApp = do
     config <- load
-    logger <- defaultDevelopmentLogger
+    app <- getApp config
-    app <- getApp config logger
     print $ appHost config
     runSettings defaultSettings
         { settingsPort = appPort config
@@ -80,12 +78,11 @@ defaultRunner f app = do
 defaultDevelApp
     :: (Show env, Read env)
     => IO (AppConfig env extra) -- ^ A means to load your development @'AppConfig'@
-    -> (AppConfig env extra -> Logger -> IO Application) -- ^ Get your @Application@
+    -> (AppConfig env extra -> IO Application) -- ^ Get your @Application@
     -> IO (Int, Application)
 defaultDevelApp load getApp = do
     conf   <- load
-    logger <- defaultDevelopmentLogger
     let p = appPort conf
-    logString logger $ "Devel application launched: http://localhost:" ++ show p
+    putStrLn $ "Devel application launched: http://localhost:" ++ show p
-    app <- getApp conf logger
+    app <- getApp conf
     return (p, app)

yesod-default/Yesod/Default/Util.hs

@@ -7,7 +7,11 @@ module Yesod.Default.Util
     , globFile
     , widgetFileNoReload
     , widgetFileReload
-    , widgetFileJsCss
+    , TemplateLanguage (..)
+    , defaultTemplateLanguages
+    , WidgetFileSettings
+    , wfsLanguages
+    , wfsHamletSettings
     ) where
 
 import Control.Monad.IO.Class (liftIO)
@@ -20,7 +24,9 @@ import Language.Haskell.TH.Syntax
 import Text.Lucius (luciusFile, luciusFileReload)
 import Text.Julius (juliusFile, juliusFileReload)
 import Text.Cassius (cassiusFile, cassiusFileReload)
+import Text.Hamlet (HamletSettings, defaultHamletSettings)
 import Data.Maybe (catMaybes)
+import Data.Default (Default (def))
 
 -- | An implementation of 'addStaticContent' which stores the contents in an
 -- external file. Files are created in the given static folder with names based
@@ -57,34 +63,40 @@ addStaticContentExternal minify hash staticDir toRoute ext' _ content = do
 globFile :: String -> String -> FilePath
 globFile kind x = "templates/" ++ x ++ "." ++ kind
 
-widgetFileNoReload :: FilePath -> Q Exp
+data TemplateLanguage = TemplateLanguage
-widgetFileNoReload x = combine "widgetFileNoReload" x
+    { tlRequiresToWidget :: Bool
-    [ whenExists x False "hamlet"  whamletFile
+    , tlExtension :: String
-    , whenExists x True  "cassius" cassiusFile
+    , tlNoReload :: FilePath -> Q Exp
-    , whenExists x True  "julius"  juliusFile
+    , tlReload :: FilePath -> Q Exp
-    , whenExists x True  "lucius"  luciusFile
+    }
-    ]
 
-widgetFileReload :: FilePath -> Q Exp
+defaultTemplateLanguages :: HamletSettings -> [TemplateLanguage]
-widgetFileReload x = combine "widgetFileReload" x
+defaultTemplateLanguages hset =
-    [ whenExists x False "hamlet"  whamletFile
+    [ TemplateLanguage False "hamlet"  whamletFile' whamletFile'
-    , whenExists x True  "cassius" cassiusFileReload
+    , TemplateLanguage True  "cassius" cassiusFile  cassiusFileReload
-    , whenExists x True  "julius"  juliusFileReload
+    , TemplateLanguage True  "julius"  juliusFile   juliusFileReload
-    , whenExists x True  "lucius"  luciusFileReload
+    , TemplateLanguage True  "lucius"  luciusFile   luciusFileReload
     ]
+  where
+    whamletFile' = whamletFileWithSettings hset
 
-widgetFileJsCss :: (String, FilePath -> Q Exp) -- ^ JavaScript file extenstion and loading function. example: ("julius", juliusFileReload)
+data WidgetFileSettings = WidgetFileSettings
-                -> (String, FilePath -> Q Exp) -- ^ Css file extenstion and loading function. example: ("cassius", cassiusFileReload)
+    { wfsLanguages :: HamletSettings -> [TemplateLanguage]
-                -> FilePath -> Q Exp
+    , wfsHamletSettings :: HamletSettings
-widgetFileJsCss (jsExt, jsLoad) (csExt, csLoad) x = combine "widgetFileJsCss" x
+    }
-    [ whenExists x False "hamlet"  whamletFile
-    , whenExists x True  csExt csLoad
-    , whenExists x True  jsExt jsLoad
-    ]
 
-combine :: String -> String -> [Q (Maybe Exp)] -> Q Exp
+instance Default WidgetFileSettings where
-combine func file qmexps = do
+    def = WidgetFileSettings defaultTemplateLanguages defaultHamletSettings
-    mexps <- sequence qmexps
+
+widgetFileNoReload :: WidgetFileSettings -> FilePath -> Q Exp
+widgetFileNoReload wfs x = combine "widgetFileNoReload" x False $ wfsLanguages wfs $ wfsHamletSettings wfs
+
+widgetFileReload :: WidgetFileSettings -> FilePath -> Q Exp
+widgetFileReload wfs x = combine "widgetFileReload" x True $ wfsLanguages wfs $ wfsHamletSettings wfs
+
+combine :: String -> String -> Bool -> [TemplateLanguage] -> Q Exp
+combine func file isReload tls = do
+    mexps <- qmexps
     case catMaybes mexps of
         [] -> error $ concat
             [ "Called "
@@ -94,6 +106,12 @@ combine func file qmexps = do
             , ", but no template were found."
             ]
         exps -> return $ DoE $ map NoBindS exps
+  where
+    qmexps :: Q [Maybe Exp]
+    qmexps = mapM go tls
+
+    go :: TemplateLanguage -> Q (Maybe Exp)
+    go tl = whenExists file (tlRequiresToWidget tl) (tlExtension tl) ((if isReload then tlReload else tlNoReload) tl)
 
 whenExists :: String
            -> Bool -- ^ requires toWidget wrap

yesod-default/yesod-default.cabal

@@ -1,5 +1,5 @@
 name:            yesod-default
-version:         1.0.1.1
+version:         1.1.0
 license:         MIT
 license-file:    LICENSE
 author:          Patrick Brisbin
@@ -18,10 +18,10 @@ library
         cpp-options: -DWINDOWS
 
     build-depends:   base                  >= 4       && < 5
-                   , yesod-core            >= 1.0     && < 1.1
+                   , yesod-core            >= 1.1     && < 1.2
-                   , warp                  >= 1.2     && < 1.3
+                   , warp                  >= 1.3     && < 1.4
-                   , wai                   >= 1.2     && < 1.3
+                   , wai                   >= 1.3     && < 1.4
-                   , wai-extra             >= 1.2     && < 1.3
+                   , wai-extra             >= 1.3     && < 1.4
                    , bytestring            >= 0.9.1.4
                    , transformers          >= 0.2.2   && < 0.4
                    , text                  >= 0.9
@@ -29,9 +29,11 @@ library
                    , shakespeare-css       >= 1.0     && < 1.1
                    , shakespeare-js        >= 1.0     && < 1.1
                    , template-haskell
-                   , yaml                  >= 0.7     && < 0.8
+                   , yaml                  >= 0.8     && < 0.9
-                   , network-conduit       >= 0.4     && < 0.5
+                   , network-conduit       >= 0.5     && < 0.6
                    , unordered-containers
+                   , hamlet                >= 1.1     && < 1.2
+                   , data-default
 
     if !os(windows)
          build-depends: unix

yesod-form/Yesod/Form/Fields.hs

@@ -111,6 +111,7 @@ intField = Field
             _ -> Left $ MsgInvalidInteger s
 
     , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
+$newline never
 <input id="#{theId}" name="#{name}" *{attrs} type="number" :isReq:required="" value="#{showVal val}">
 |]
     }
@@ -126,6 +127,7 @@ doubleField = Field
             _ -> Left $ MsgInvalidNumber s
 
     , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
+$newline never
 <input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required="" value="#{showVal val}">
 |]
     }
@@ -135,6 +137,7 @@ dayField :: RenderMessage master FormMessage => Field sub master Day
 dayField = Field
     { fieldParse = blank $ parseDate . unpack
     , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
+$newline never
 <input id="#{theId}" name="#{name}" *{attrs} type="date" :isReq:required="" value="#{showVal val}">
 |]
     }
@@ -144,6 +147,7 @@ timeField :: RenderMessage master FormMessage => Field sub master TimeOfDay
 timeField = Field
     { fieldParse = blank $ parseTime . unpack
     , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
+$newline never
 <input id="#{theId}" name="#{name}" *{attrs} :isReq:required="" value="#{showVal val}">
 |]
     }
@@ -158,6 +162,7 @@ htmlField :: RenderMessage master FormMessage => Field sub master Html
 htmlField = Field
     { fieldParse = blank $ Right . preEscapedText . sanitizeBalance
     , fieldView = \theId name attrs val _isReq -> toWidget [hamlet|
+$newline never
 $# FIXME: There was a class="html" attribute, for what purpose?
 <textarea id="#{theId}" name="#{name}" *{attrs}>#{showVal val}
 |]
@@ -186,6 +191,7 @@ textareaField :: RenderMessage master FormMessage => Field sub master Textarea
 textareaField = Field
     { fieldParse =  blank $ Right . Textarea
     , fieldView = \theId name attrs val _isReq -> toWidget [hamlet|
+$newline never
 <textarea id="#{theId}" name="#{name}" *{attrs}>#{either id unTextarea val}
 |]
     }
@@ -195,6 +201,7 @@ hiddenField :: (PathPiece p, RenderMessage master FormMessage)
 hiddenField = Field
     { fieldParse = blank $ maybe (Left MsgValueRequired) Right . fromPathPiece
     , fieldView = \theId name attrs val _isReq -> toWidget [hamlet|
+$newline never
 <input type="hidden" id="#{theId}" name="#{name}" *{attrs} value="#{either id toPathPiece val}">
 |]
     }
@@ -204,6 +211,7 @@ textField = Field
     { fieldParse = blank $ Right
     , fieldView = \theId name attrs val isReq ->
         [whamlet|
+$newline never
 <input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required value="#{either id id val}">
 |]
     }
@@ -212,6 +220,7 @@ passwordField :: RenderMessage master FormMessage => Field sub master Text
 passwordField = Field
     { fieldParse = blank $ Right
     , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
+$newline never
 <input id="#{theId}" name="#{name}" *{attrs} type="password" :isReq:required="" value="#{either id id val}">
 |]
     }
@@ -261,6 +270,7 @@ emailField = Field
                 then Right s
                 else Left $ MsgInvalidEmail s
     , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
+$newline never
 <input id="#{theId}" name="#{name}" *{attrs} type="email" :isReq:required="" value="#{either id id val}">
 |]
     }
@@ -271,11 +281,15 @@ searchField autoFocus = Field
     { fieldParse = blank Right
     , fieldView = \theId name attrs val isReq -> do
         [whamlet|\
+$newline never
 <input id="#{theId}" name="#{name}" *{attrs} type="search" :isReq:required="" :autoFocus:autofocus="" value="#{either id id val}">
 |]
         when autoFocus $ do
           -- we want this javascript to be placed immediately after the field
-          [whamlet|<script>if (!('autofocus' in document.createElement('input'))) {document.getElementById('#{theId}').focus();}|]
+          [whamlet|
+$newline never
+<script>if (!('autofocus' in document.createElement('input'))) {document.getElementById('#{theId}').focus();}
+|]
           toWidget [cassius|
             #{theId}
               -webkit-appearance: textfield
@@ -290,6 +304,7 @@ urlField = Field
             Just _ -> Right s
     , fieldView = \theId name attrs val isReq ->
         [whamlet|
+$newline never
 <input ##{theId} name=#{name} *{attrs} type=url :isReq:required value=#{either id id val}>
 |]
     }
@@ -299,9 +314,18 @@ selectFieldList = selectField . optionsPairs
 
 selectField :: (Eq a, RenderMessage master FormMessage) => GHandler sub master (OptionList a) -> Field sub master a
 selectField = selectFieldHelper
-    (\theId name inside -> [whamlet|<select ##{theId} name=#{name}>^{inside}|]) -- outside
+    (\theId name inside -> [whamlet|
-    (\_theId _name isSel -> [whamlet|<option value=none :isSel:selected>_{MsgSelectNone}|]) -- onOpt
+$newline never
-    (\_theId _name attrs value isSel text -> [whamlet|<option value=#{value} :isSel:selected *{attrs}>#{text}|]) -- inside
+<select ##{theId} name=#{name}>^{inside}
+|]) -- outside
+    (\_theId _name isSel -> [whamlet|
+$newline never
+<option value=none :isSel:selected>_{MsgSelectNone}
+|]) -- onOpt
+    (\_theId _name attrs value isSel text -> [whamlet|
+$newline never
+<option value=#{value} :isSel:selected *{attrs}>#{text}
+|]) -- inside
 
 multiSelectFieldList :: (Eq a, RenderMessage master FormMessage, RenderMessage master msg) => [(msg, a)] -> Field sub master [a]
 multiSelectFieldList = multiSelectField . optionsPairs
@@ -323,6 +347,7 @@ multiSelectField ioptlist =
         opts <- fmap olOptions $ lift ioptlist
         let selOpts = map (id &&& (optselected val)) opts
         [whamlet|
+$newline never
             <select ##{theId} name=#{name} :isReq:required multiple *{attrs}>
                 $forall (opt, optsel) <- selOpts
                     <option value=#{optionExternalValue opt} :optsel:selected>#{optionDisplay opt}
@@ -336,13 +361,18 @@ radioFieldList = radioField . optionsPairs
 
 radioField :: (Eq a, RenderMessage master FormMessage) => GHandler sub master (OptionList a) -> Field sub master a
 radioField = selectFieldHelper
-    (\theId _name inside -> [whamlet|<div ##{theId}>^{inside}|])
+    (\theId _name inside -> [whamlet|
+$newline never
+<div ##{theId}>^{inside}
+|])
     (\theId name isSel -> [whamlet|
+$newline never
 <div>
     <input id=#{theId}-none type=radio name=#{name} value=none :isSel:checked>
     <label for=#{theId}-none>_{MsgSelectNone}
 |])
     (\theId name attrs value isSel text -> [whamlet|
+$newline never
 <div>
     <input id=#{theId}-#{value} type=radio name=#{name} value=#{value} :isSel:checked *{attrs}>
     <label for=#{theId}-#{value}>#{text}
@@ -352,6 +382,7 @@ boolField :: RenderMessage master FormMessage => Field sub master Bool
 boolField = Field
       { fieldParse = return . boolParser
       , fieldView = \theId name attrs val isReq -> [whamlet|
+$newline never
   $if not isReq
       <input id=#{theId}-none *{attrs} type=radio name=#{name} value=none checked>
       <label for=#{theId}-none>_{MsgSelectNone}
@@ -386,6 +417,7 @@ checkBoxField :: RenderMessage m FormMessage => Field s m Bool
 checkBoxField = Field
     { fieldParse = return . checkBoxParser
     , fieldView  = \theId name attrs val _ -> [whamlet|
+$newline never
 <input id=#{theId} *{attrs} type=checkbox name=#{name} value=yes :showVal id val:checked>
 |]
     }
@@ -501,6 +533,7 @@ fileAFormReq fs = AForm $ \(master, langs) menvs ints -> do
             , fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs
             , fvId = id'
             , fvInput = [whamlet|
+$newline never
 <input type=file name=#{name} ##{id'} *{fsAttrs fs}>
 |]
             , fvErrors = errs
@@ -529,6 +562,7 @@ fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do
             , fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs
             , fvId = id'
             , fvInput = [whamlet|
+$newline never
 <input type=file name=#{name} ##{id'} *{fsAttrs fs}>
 |]
             , fvErrors = errs

yesod-form/Yesod/Form/Functions.hs

@@ -55,14 +55,13 @@ import Text.Blaze (Html, toHtml)
 import Yesod.Handler (GHandler, getRequest, runRequestBody, newIdent, getYesod)
 import Yesod.Core (RenderMessage, SomeMessage (..))
 import Yesod.Widget (GWidget, whamlet)
-import Yesod.Request (reqToken, reqWaiRequest, reqGetParams, languages, FileInfo (..))
+import Yesod.Request (reqToken, reqWaiRequest, reqGetParams, languages)
 import Network.Wai (requestMethod)
 import Text.Hamlet (shamlet)
 import Data.Monoid (mempty)
 import Data.Maybe (listToMaybe, fromMaybe)
 import Yesod.Message (RenderMessage (..))
 import qualified Data.Map as Map
-import qualified Data.ByteString.Lazy as L
 import Control.Applicative ((<$>))
 import Control.Arrow (first)
 
@@ -188,7 +187,10 @@ postHelper form env = do
     let token =
             case reqToken req of
                 Nothing -> mempty
-                Just n -> [shamlet|<input type=hidden name=#{tokenKey} value=#{n}>|]
+                Just n -> [shamlet|
+$newline never
+<input type=hidden name=#{tokenKey} value=#{n}>
+|]
     m <- getYesod
     langs <- languages
     ((res, xml), enctype) <- runFormGeneric (form token) m langs env
@@ -218,9 +220,7 @@ postEnv = do
         else do
             (p, f) <- runRequestBody
             let p' = Map.unionsWith (++) $ map (\(x, y) -> Map.singleton x [y]) p
-            return $ Just (p', Map.fromList $ filter (notEmpty . snd) f)
+            return $ Just (p', Map.fromList f)
-  where
-    notEmpty = not . L.null . fileContent
 
 runFormPostNoToken :: (Html -> MForm sub master (FormResult a, xml)) -> GHandler sub master ((FormResult a, xml), Enctype)
 runFormPostNoToken form = do
@@ -246,7 +246,10 @@ getKey = "_hasdata"
 
 getHelper :: (Html -> MForm sub master a) -> Maybe (Env, FileEnv) -> GHandler sub master (a, Enctype)
 getHelper form env = do
-    let fragment = [shamlet|<input type=hidden name=#{getKey}>|]
+    let fragment = [shamlet|
+$newline never
+<input type=hidden name=#{getKey}>
+|]
     langs <- languages
     m <- getYesod
     runFormGeneric (form fragment) m langs env
@@ -262,6 +265,7 @@ renderTable aform fragment = do
     let views = views' []
     -- FIXME non-valid HTML
     let widget = [whamlet|
+$newline never
 \#{fragment}
 $forall view <- views
     <tr :fvRequired view:.required :not $ fvRequired view:.optional>
@@ -286,6 +290,7 @@ renderDivsMaybeLabels withLabels aform fragment = do
     (res, views') <- aFormToForm aform
     let views = views' []
     let widget = [whamlet|
+$newline never
 \#{fragment}
 $forall view <- views
     <div :fvRequired view:.required :not $ fvRequired view:.optional>
@@ -321,6 +326,7 @@ renderBootstrap aform fragment = do
         has (Just _) = True
         has Nothing  = False
     let widget = [whamlet|
+$newline never
 \#{fragment}
 $forall view <- views
     <div .control-group .clearfix :fvRequired view:.required :not $ fvRequired view:.optional :has $ fvErrors view:.error>
@@ -347,13 +353,21 @@ checkM :: RenderMessage master msg
        => (a -> GHandler sub master (Either msg a))
        -> Field sub master a
        -> Field sub master a
-checkM f field = field
+checkM f = checkM' f id
+
+checkM' :: RenderMessage master msg
+        => (a -> GHandler sub master (Either msg b))
+        -> (b -> a)
+        -> Field sub master a
+        -> Field sub master b
+checkM' f inv field = field
     { fieldParse = \ts -> do
         e1 <- fieldParse field ts
         case e1 of
             Left msg -> return $ Left msg
             Right Nothing -> return $ Right Nothing
             Right (Just a) -> fmap (either (Left . SomeMessage) (Right . Just)) $ f a
+    , fieldView = \i n a eres req -> fieldView field i n a (fmap inv eres) req
     }
 
 -- | Allows you to overwrite the error message on parse error.

yesod-form/Yesod/Form/Jquery.hs

@@ -70,6 +70,7 @@ jqueryDayField jds = Field
               . unpack
     , fieldView = \theId name attrs val isReq -> do
         toWidget [shamlet|
+$newline never
 <input id="#{theId}" name="#{name}" *{attrs} type="date" :isReq:required="" value="#{showVal val}">
 |]
         addScript' urlJqueryJs
@@ -109,6 +110,7 @@ jqueryAutocompleteField src = Field
     { fieldParse = blank $ Right
     , fieldView = \theId name attrs val isReq -> do
         toWidget [shamlet|
+$newline never
 <input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required="" value="#{either id id val}" .autocomplete>
 |]
         addScript' urlJqueryJs

yesod-form/Yesod/Form/MassInput.hs

@@ -80,6 +80,7 @@ inputList label fixXml single mdef = formToAForm $ do
         , fvTooltip = Nothing
         , fvId = theId
         , fvInput = [whamlet|
+$newline never
 ^{fixXml views}
 <p>
     $forall xml <- xmls
@@ -100,7 +101,10 @@ withDelete af = do
     deleteName <- newFormIdent
     (menv, _, _) <- ask
     res <- case menv >>= Map.lookup deleteName . fst of
-        Just ("yes":_) -> return $ Left [whamlet|<input type=hidden name=#{deleteName} value=yes>|]
+        Just ("yes":_) -> return $ Left [whamlet|
+$newline never
+<input type=hidden name=#{deleteName} value=yes>
+|]
         _ -> do
             (_, xml2) <- aFormToForm $ areq boolField FieldSettings
                 { fsLabel = SomeMessage MsgDelete
@@ -127,6 +131,7 @@ massDivs, massTable
          :: [[FieldView sub master]]
          -> GWidget sub master ()
 massDivs viewss = [whamlet|
+$newline never
 $forall views <- viewss
     <fieldset>
         $forall view <- views
@@ -140,6 +145,7 @@ $forall views <- viewss
 |]
 
 massTable viewss = [whamlet|
+$newline never
 $forall views <- viewss
     <fieldset>
         <table>

yesod-form/Yesod/Form/Nic.hs

@@ -38,6 +38,7 @@ nicHtmlField = Field
     { fieldParse = return . Right . fmap (preEscapedText . sanitizeBalance) . listToMaybe
     , fieldView = \theId name attrs val _isReq -> do
         toWidget [shamlet|
+$newline never
     <textarea id="#{theId}" *{attrs} name="#{name}" .html>#{showVal val}
 |]
         addScript' urlNicEdit

yesod-form/yesod-form.cabal

@@ -1,5 +1,5 @@
 name:            yesod-form
-version:         1.0.0.4
+version:         1.1.0
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -12,19 +12,15 @@ build-type:      Simple
 homepage:        http://www.yesodweb.com/
 description:     Form handling support for Yesod Web Framework
 
-flag blaze_html_0_5
-    description: use blaze-html 0.5 and blaze-markup 0.5
-    default: True
-
 library
     build-depends:   base                  >= 4        && < 5
-                   , yesod-core            >= 1.0      && < 1.1
+                   , yesod-core            >= 1.1      && < 1.2
-                   , yesod-persistent      >= 1.0      && < 1.1
+                   , yesod-persistent      >= 1.1      && < 1.2
                    , time                  >= 1.1.4
-                   , hamlet                >= 1.0      && < 1.1
+                   , hamlet                >= 1.1      && < 1.2
                    , shakespeare-css       >= 1.0      && < 1.1
                    , shakespeare-js        >= 1.0      && < 1.1
-                   , persistent            >= 0.9      && < 0.10
+                   , persistent            >= 1.0      && < 1.1
                    , template-haskell
                    , transformers          >= 0.2.2    && < 0.4
                    , data-default
@@ -34,16 +30,10 @@ library
                    , email-validate        >= 0.2.6    && < 0.3
                    , bytestring            >= 0.9.1.4
                    , text                  >= 0.9      && < 1.0
-                   , wai                   >= 1.2      && < 1.3
+                   , wai                   >= 1.3      && < 1.4
                    , containers            >= 0.2
-
+                   , blaze-html            >= 0.5      && < 0.6
-    if flag(blaze_html_0_5)
+                   , blaze-markup          >= 0.5.1    && < 0.6
-        build-depends:
-                     blaze-html               >= 0.5     && < 0.6
-                   , blaze-markup             >= 0.5.1   && < 0.6
-    else
-        build-depends:
-                     blaze-html               >= 0.4     && < 0.5
 
     exposed-modules: Yesod.Form
                      Yesod.Form.Class

yesod-json/yesod-json.cabal

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

yesod-newsfeed/Yesod/AtomFeed.hs

@@ -31,11 +31,8 @@ import qualified Data.ByteString.Char8 as S8
 import Data.Text (Text)
 import Data.Text.Lazy (toStrict)
 import Text.XML
-#if MIN_VERSION_blaze_html(0, 5, 0)
 import Text.Blaze.Html.Renderer.Text (renderHtml)
-#else
+import qualified Data.Map as Map
-import Text.Blaze.Renderer.Text (renderHtml)
-#endif
 
 newtype RepAtom = RepAtom Content
 instance HasReps RepAtom where
@@ -55,21 +52,22 @@ template Feed {..} render =
     addNS' n = n
     namespace = "http://www.w3.org/2005/Atom"
 
-    root = Element "feed" [] $ map NodeElement
+    root = Element "feed" Map.empty $ map NodeElement
-        $ Element "title" [] [NodeContent feedTitle]
+        $ Element "title" Map.empty [NodeContent feedTitle]
-        : Element "link" [("rel", "self"), ("href", render feedLinkSelf)] []
+        : Element "link" (Map.fromList [("rel", "self"), ("href", render feedLinkSelf)]) []
-        : Element "link" [("href", render feedLinkHome)] []
+        : Element "link" (Map.singleton "href" $ render feedLinkHome) []
-        : Element "updated" [] [NodeContent $ formatW3 feedUpdated]
+        : Element "updated" Map.empty [NodeContent $ formatW3 feedUpdated]
-        : Element "id" [] [NodeContent $ render feedLinkHome]
+        : Element "id" Map.empty [NodeContent $ render feedLinkHome]
+        : Element "author" Map.empty [NodeContent feedAuthor]
         : map (flip entryTemplate render) feedEntries
 
 entryTemplate :: FeedEntry url -> (url -> Text) -> Element
-entryTemplate FeedEntry {..} render = Element "entry" [] $ map NodeElement
+entryTemplate FeedEntry {..} render = Element "entry" Map.empty $ map NodeElement
-    [ Element "id" [] [NodeContent $ render feedEntryLink]
+    [ Element "id" Map.empty [NodeContent $ render feedEntryLink]
-    , Element "link" [("href", render feedEntryLink)] []
+    , Element "link" (Map.singleton "href" $ render feedEntryLink) []
-    , Element "updated" [] [NodeContent $ formatW3 feedEntryUpdated]
+    , Element "updated" Map.empty [NodeContent $ formatW3 feedEntryUpdated]
-    , Element "title" [] [NodeContent feedEntryTitle]
+    , Element "title" Map.empty [NodeContent feedEntryTitle]
-    , Element "content" [("type", "html")] [NodeContent $ toStrict $ renderHtml feedEntryContent]
+    , Element "content" (Map.singleton "type" "html") [NodeContent $ toStrict $ renderHtml feedEntryContent]
     ]
 
 -- | Generates a link tag in the head of a widget.
@@ -77,5 +75,6 @@ atomLink :: Route m
          -> Text -- ^ title
          -> GWidget s m ()
 atomLink r title = toWidgetHead [hamlet|
+$newline never
 <link href=@{r} type=#{S8.unpack typeAtom} rel="alternate" title=#{title}>
 |]

yesod-newsfeed/Yesod/FeedTypes.hs

@@ -12,6 +12,7 @@ data Feed url = Feed
     { feedTitle       :: Text
     , feedLinkSelf    :: url
     , feedLinkHome    :: url
+    , feedAuthor      :: Text
 
 
     -- | note: currently only used for Rss

yesod-newsfeed/Yesod/RssFeed.hs

@@ -27,11 +27,8 @@ import qualified Data.ByteString.Char8 as S8
 import Data.Text (Text, pack)
 import Data.Text.Lazy (toStrict)
 import Text.XML
-#if MIN_VERSION_blaze_html(0, 5, 0)
 import Text.Blaze.Html.Renderer.Text (renderHtml)
-#else
+import qualified Data.Map as Map
-import Text.Blaze.Renderer.Text (renderHtml)
-#endif
 
 newtype RepRss = RepRss Content
 instance HasReps RepRss where
@@ -47,26 +44,26 @@ template :: Feed url -> (url -> Text) -> Document
 template Feed {..} render =
     Document (Prologue [] Nothing []) root []
   where
-    root = Element "rss" [("version", "2.0")] $ return $ NodeElement $ Element "channel" [] $ map NodeElement
+    root = Element "rss" (Map.singleton "version" "2.0") $ return $ NodeElement $ Element "channel" Map.empty $ map NodeElement
-        $ Element "{http://www.w3.org/2005/Atom}link"
+        $ Element "{http://www.w3.org/2005/Atom}link" (Map.fromList
             [ ("href", render feedLinkSelf)
             , ("rel", "self")
             , ("type", pack $ S8.unpack typeRss)
-            ] []
+            ]) []
-        : Element "title" [] [NodeContent feedTitle]
+        : Element "title" Map.empty [NodeContent feedTitle]
-        : Element "link" [] [NodeContent $ render feedLinkHome]
+        : Element "link" Map.empty [NodeContent $ render feedLinkHome]
-        : Element "description" [] [NodeContent $ toStrict $ renderHtml feedDescription]
+        : Element "description" Map.empty [NodeContent $ toStrict $ renderHtml feedDescription]
-        : Element "lastBuildDate" [] [NodeContent $ formatRFC822 feedUpdated]
+        : Element "lastBuildDate" Map.empty [NodeContent $ formatRFC822 feedUpdated]
-        : Element "language" [] [NodeContent feedLanguage]
+        : Element "language" Map.empty [NodeContent feedLanguage]
         : map (flip entryTemplate render) feedEntries
 
 entryTemplate :: FeedEntry url -> (url -> Text) -> Element
-entryTemplate FeedEntry {..} render = Element "item" [] $ map NodeElement
+entryTemplate FeedEntry {..} render = Element "item" Map.empty $ map NodeElement
-    [ Element "title" [] [NodeContent feedEntryTitle]
+    [ Element "title" Map.empty [NodeContent feedEntryTitle]
-    , Element "link" [] [NodeContent $ render feedEntryLink]
+    , Element "link" Map.empty [NodeContent $ render feedEntryLink]
-    , Element "guid" [] [NodeContent $ render feedEntryLink]
+    , Element "guid" Map.empty [NodeContent $ render feedEntryLink]
-    , Element "pubDate" [] [NodeContent $ formatRFC822 feedEntryUpdated]
+    , Element "pubDate" Map.empty [NodeContent $ formatRFC822 feedEntryUpdated]
-    , Element "description" [] [NodeContent $ toStrict $ renderHtml feedEntryContent]
+    , Element "description" Map.empty [NodeContent $ toStrict $ renderHtml feedEntryContent]
     ]
 
 -- | Generates a link tag in the head of a widget.
@@ -74,5 +71,6 @@ rssLink :: Route m
         -> Text -- ^ title
         -> GWidget s m ()
 rssLink r title = toWidgetHead [hamlet|
+$newline never
     <link href=@{r} type=#{S8.unpack typeRss} rel="alternate" title=#{title}>
     |]

yesod-newsfeed/yesod-newsfeed.cabal

@@ -1,5 +1,5 @@
 name:            yesod-newsfeed
-version:         1.0.0.2
+version:         1.1.0
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman, Patrick Brisbin
@@ -12,26 +12,17 @@ build-type:      Simple
 homepage:        http://www.yesodweb.com/
 description:     Helper functions and data types for producing News feeds.
 
-flag blaze_html_0_5
-    description: use blaze-html 0.5 and blaze-markup 0.5
-    default: True
-
 library
     build-depends:   base                 >= 4        && < 5
-                   , yesod-core           >= 1.0      && < 1.1
+                   , yesod-core           >= 1.1      && < 1.2
                    , time                 >= 1.1.4
-                   , hamlet               >= 1.0      && < 1.1
+                   , hamlet               >= 1.1      && < 1.2
                    , bytestring           >= 0.9.1.4
                    , text                 >= 0.9      && < 0.12
-                   , xml-conduit          >= 0.7      && < 0.8
+                   , xml-conduit          >= 1.0      && < 1.1
-
+                   , blaze-html           >= 0.5      && < 0.6
-    if flag(blaze_html_0_5)
+                   , blaze-markup         >= 0.5.1    && < 0.6
-        build-depends:
+                   , containers
-                     blaze-html               >= 0.5     && < 0.6
-                   , blaze-markup             >= 0.5.1   && < 0.6
-    else
-        build-depends:
-                     blaze-html               >= 0.4     && < 0.5
 
     exposed-modules: Yesod.AtomFeed
                    , Yesod.RssFeed

yesod-persistent/yesod-persistent.cabal

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

yesod-routes/Yesod/Routes/Overlap.hs

@@ -2,27 +2,41 @@
 module Yesod.Routes.Overlap
     ( findOverlaps
     , findOverlapNames
+    , Overlap (..)
     ) where
 
 import Yesod.Routes.TH.Types
-import Control.Arrow ((***))
+import Data.List (intercalate)
-import Data.Maybe (mapMaybe)
 
-findOverlaps :: [Resource t] -> [(Resource t, Resource t)]
+data Overlap t = Overlap
-findOverlaps [] = []
+    { overlapParents :: [String] -> [String] -- ^ parent resource trees
-findOverlaps (x:xs) = mapMaybe (findOverlap x) xs ++ findOverlaps xs
+    , overlap1 :: ResourceTree t
+    , overlap2 :: ResourceTree t
+    }
 
-findOverlap :: Resource t -> Resource t -> Maybe (Resource t, Resource t)
+findOverlaps :: ([String] -> [String]) -> [ResourceTree t] -> [Overlap t]
-findOverlap x y
+findOverlaps _ [] = []
-    | overlaps (resourcePieces x) (resourcePieces y) (hasSuffix x) (hasSuffix y) = Just (x, y)
+findOverlaps front (x:xs) = concatMap (findOverlap front x) xs ++ findOverlaps front xs
-    | otherwise = Nothing
 
-hasSuffix :: Resource t -> Bool
+findOverlap :: ([String] -> [String]) -> ResourceTree t -> ResourceTree t -> [Overlap t]
-hasSuffix r =
+findOverlap front x y =
+    here rest
+  where
+    here
+        | overlaps (resourceTreePieces x) (resourceTreePieces y) (hasSuffix x) (hasSuffix y) = (Overlap front x y:)
+        | otherwise = id
+    rest =
+        case x of
+            ResourceParent name _ children -> findOverlaps (front . (name:)) children
+            ResourceLeaf{} -> []
+
+hasSuffix :: ResourceTree t -> Bool
+hasSuffix (ResourceLeaf r) =
     case resourceDispatch r of
         Subsite{} -> True
         Methods Just{} _ -> True
         Methods Nothing _ -> False
+hasSuffix ResourceParent{} = True
 
 overlaps :: [(CheckOverlap, Piece t)] -> [(CheckOverlap, Piece t)] -> Bool -> Bool -> Bool
 
@@ -50,9 +64,14 @@ piecesOverlap :: Piece t -> Piece t -> Bool
 piecesOverlap (Static x) (Static y) = x == y
 piecesOverlap _ _ = True
 
-findOverlapNames :: [Resource t] -> [(String, String)]
+findOverlapNames :: [ResourceTree t] -> [(String, String)]
-findOverlapNames = map (resourceName *** resourceName) . findOverlaps
+findOverlapNames =
-
+    map go . findOverlaps id
+  where
+    go (Overlap front x y) =
+        (go' $ resourceTreeName x, go' $ resourceTreeName y)
+      where
+        go' = intercalate "/" . front . return
 {-
 -- n^2, should be a way to speed it up
 findOverlaps :: [Resource a] -> [[Resource a]]

yesod-routes/Yesod/Routes/Parse.hs

@@ -10,7 +10,6 @@ module Yesod.Routes.Parse
     ) where
 
 import Language.Haskell.TH.Syntax
-import Data.Maybe
 import Data.Char (isUpper)
 import Language.Haskell.TH.Quote
 import qualified System.IO as SIO
@@ -55,18 +54,29 @@ parseRoutesNoCheck = QuasiQuoter
 -- | Convert a multi-line string to a set of resources. See documentation for
 -- the format of this string. This is a partial function which calls 'error' on
 -- invalid input.
-resourcesFromString :: String -> [Resource String]
+resourcesFromString :: String -> [ResourceTree String]
 resourcesFromString =
-    mapMaybe go . lines
+    fst . parse 0 . lines
   where
-    go s =
+    parse _ [] = ([], [])
-        case takeWhile (/= "--") $ words s of
+    parse indent (thisLine:otherLines)
-            (pattern:constr:rest) ->
+        | length spaces < indent = ([], thisLine : otherLines)
-                let (pieces, mmulti) = piecesFromString $ drop1Slash pattern
+        | otherwise = (this others, remainder)
-                    disp = dispatchFromString rest mmulti
+      where
-                 in Just $ Resource constr pieces disp
+        spaces = takeWhile (== ' ') thisLine
-            [] -> Nothing
+        (others, remainder) = parse indent otherLines'
-            _ -> error $ "Invalid resource line: " ++ s
+        (this, otherLines') =
+            case takeWhile (/= "--") $ words thisLine of
+                [pattern, constr] | last constr == ':' ->
+                    let (children, otherLines'') = parse (length spaces + 1) otherLines
+                        (pieces, Nothing) = piecesFromString $ drop1Slash pattern
+                     in ((ResourceParent (init constr) pieces children :), otherLines'')
+                (pattern:constr:rest) ->
+                    let (pieces, mmulti) = piecesFromString $ drop1Slash pattern
+                        disp = dispatchFromString rest mmulti
+                     in ((ResourceLeaf (Resource constr pieces disp):), otherLines)
+                [] -> (id, otherLines)
+                _ -> error $ "Invalid resource line: " ++ thisLine
 
 dispatchFromString :: [String] -> Maybe String -> Dispatch String
 dispatchFromString rest mmulti

yesod-routes/Yesod/Routes/TH/Dispatch.hs

@@ -17,6 +17,16 @@ import Web.PathPieces (PathPiece (..), PathMultiPiece (..))
 import Control.Applicative ((<$>))
 import Data.List (foldl')
 
+data FlatResource a = FlatResource [(String, [(CheckOverlap, Piece a)])] String [(CheckOverlap, Piece a)] (Dispatch a)
+
+flatten :: [ResourceTree a] -> [FlatResource a]
+flatten =
+    concatMap (go id)
+  where
+    go front (ResourceLeaf (Resource a b c)) = [FlatResource (front []) a b c]
+    go front (ResourceParent name pieces children) =
+        concatMap (go (front . ((name, pieces):))) children
+
 -- |
 --
 -- This function will generate a single clause that will address all
@@ -83,9 +93,9 @@ import Data.List (foldl')
 mkDispatchClause :: Q Exp -- ^ runHandler function
                  -> Q Exp -- ^ dispatcher function
                  -> Q Exp -- ^ fixHandler function
-                 -> [Resource a]
+                 -> [ResourceTree a]
                  -> Q Clause
-mkDispatchClause runHandler dispatcher fixHandler ress = do
+mkDispatchClause runHandler dispatcher fixHandler ress' = do
     -- Allocate the names to be used. Start off with the names passed to the
     -- function itself (with a 0 suffix).
     --
@@ -130,22 +140,25 @@ mkDispatchClause runHandler dispatcher fixHandler ress = do
             Nothing -> $(return $ VarE app4040)
           |]
     return $ Clause pats (NormalB u) $ dispatchFun : methodMaps
+  where
+    ress = flatten ress'
 
 -- | Determine the name of the method map for a given resource name.
 methodMapName :: String -> Name
 methodMapName s = mkName $ "methods" ++ s
 
 buildMethodMap :: Q Exp -- ^ fixHandler
-               -> Resource a
+               -> FlatResource a
                -> Q (Maybe Dec)
-buildMethodMap _ (Resource _ _ (Methods _ [])) = return Nothing -- single handle function
+buildMethodMap _ (FlatResource _ _ _ (Methods _ [])) = return Nothing -- single handle function
-buildMethodMap fixHandler (Resource name pieces (Methods mmulti methods)) = do
+buildMethodMap fixHandler (FlatResource parents name pieces' (Methods mmulti methods)) = do
     fromList <- [|Map.fromList|]
     methods' <- mapM go methods
     let exp = fromList `AppE` ListE methods'
     let fun = FunD (methodMapName name) [Clause [] (NormalB exp) []]
     return $ Just fun
   where
+    pieces = concat $ map snd parents ++ [pieces']
     go method = do
         fh <- fixHandler
         let func = VarE $ mkName $ map toLower method ++ name
@@ -156,28 +169,31 @@ buildMethodMap fixHandler (Resource name pieces (Methods mmulti methods)) = do
         xs <- replicateM argCount $ newName "arg"
         let rhs = LamE (map VarP xs) $ fh `AppE` (foldl' AppE func $ map VarE xs)
         return $ TupE [pack' `AppE` LitE (StringL method), rhs]
-buildMethodMap _ (Resource _ _ Subsite{}) = return Nothing
+buildMethodMap _ (FlatResource _ _ _ Subsite{}) = return Nothing
 
 -- | Build a single 'D.Route' expression.
-buildRoute :: Q Exp -> Q Exp -> Q Exp -> Resource a -> Q Exp
+buildRoute :: Q Exp -> Q Exp -> Q Exp -> FlatResource a -> Q Exp
-buildRoute runHandler dispatcher fixHandler (Resource name resPieces resDisp) = do
+buildRoute runHandler dispatcher fixHandler (FlatResource parents name resPieces resDisp) = do
     -- First two arguments to D.Route
-    routePieces <- ListE <$> mapM (convertPiece . snd) resPieces
+    routePieces <- ListE <$> mapM (convertPiece . snd) allPieces
     isMulti <-
         case resDisp of
             Methods Nothing _ -> [|False|]
             _ -> [|True|]
 
-    [|D.Route $(return routePieces) $(return isMulti) $(routeArg3 runHandler dispatcher fixHandler name (map snd resPieces) resDisp)|]
+    [|D.Route $(return routePieces) $(return isMulti) $(routeArg3 runHandler dispatcher fixHandler parents name (map snd allPieces) resDisp)|]
+  where
+    allPieces = concat $ map snd parents ++ [resPieces]
 
 routeArg3 :: Q Exp -- ^ runHandler
           -> Q Exp -- ^ dispatcher
           -> Q Exp -- ^ fixHandler
+          -> [(String, [(CheckOverlap, Piece a)])]
           -> String -- ^ name of resource
           -> [Piece a]
           -> Dispatch a
           -> Q Exp
-routeArg3 runHandler dispatcher fixHandler name resPieces resDisp = do
+routeArg3 runHandler dispatcher fixHandler parents name resPieces resDisp = do
     pieces <- newName "pieces"
 
     -- Allocate input piece variables (xs) and variables that have been
@@ -216,7 +232,7 @@ routeArg3 runHandler dispatcher fixHandler name resPieces resDisp = do
             _ -> return ([], [])
 
     -- The final expression that actually uses the values we've computed
-    caller <- buildCaller runHandler dispatcher fixHandler xrest name resDisp $ map snd ys ++ yrest'
+    caller <- buildCaller runHandler dispatcher fixHandler xrest parents name resDisp $ map snd ys ++ yrest'
 
     -- Put together all the statements
     just <- [|Just|]
@@ -239,11 +255,12 @@ buildCaller :: Q Exp -- ^ runHandler
             -> Q Exp -- ^ dispatcher
             -> Q Exp -- ^ fixHandler
             -> Name -- ^ xrest
+            -> [(String, [(CheckOverlap, Piece a)])]
             -> String -- ^ name of resource
             -> Dispatch a
             -> [Name] -- ^ ys
             -> Q Exp
-buildCaller runHandler dispatcher fixHandler xrest name resDisp ys = do
+buildCaller runHandler dispatcher fixHandler xrest parents name resDisp ys = do
     master <- newName "master"
     sub <- newName "sub"
     toMaster <- newName "toMaster"
@@ -254,7 +271,7 @@ buildCaller runHandler dispatcher fixHandler xrest name resDisp ys = do
     let pat = map VarP [master, sub, toMaster, app404, handler405, method]
 
     -- Create the route
-    let route = foldl' (\a b -> a `AppE` VarE b) (ConE $ mkName name) ys
+    let route = routeFromDynamics parents name ys
 
     exp <-
         case resDisp of
@@ -309,3 +326,16 @@ buildCaller runHandler dispatcher fixHandler xrest name resDisp ys = do
 convertPiece :: Piece a -> Q Exp
 convertPiece (Static s) = [|D.Static (pack $(lift s))|]
 convertPiece (Dynamic _) = [|D.Dynamic|]
+
+routeFromDynamics :: [(String, [(CheckOverlap, Piece a)])] -- ^ parents
+                  -> String -- ^ constructor name
+                  -> [Name]
+                  -> Exp
+routeFromDynamics [] name ys = foldl' (\a b -> a `AppE` VarE b) (ConE $ mkName name) ys
+routeFromDynamics ((parent, pieces):rest) name ys =
+    foldl' (\a b -> a `AppE` b) (ConE $ mkName parent) here
+  where
+    (here', ys') = splitAt (length $ filter (isDynamic . snd) pieces) ys
+    isDynamic Dynamic{} = True
+    isDynamic _ = False
+    here = map VarE here' ++ [routeFromDynamics rest name ys']

yesod-routes/Yesod/Routes/TH/RenderRoute.hs

@@ -14,17 +14,19 @@ import Control.Monad (replicateM)
 import Data.Text (pack)
 import Web.PathPieces (PathPiece (..), PathMultiPiece (..))
 import Yesod.Routes.Class
+import Data.Monoid (mconcat)
 
 -- | Generate the constructors of a route data type.
-mkRouteCons :: [Resource Type] -> [Con]
+mkRouteCons :: [ResourceTree Type] -> ([Con], [Dec])
 mkRouteCons =
-    map mkRouteCon
+    mconcat . map mkRouteCon
   where
-    mkRouteCon res =
+    mkRouteCon (ResourceLeaf res) =
-        NormalC (mkName $ resourceName res)
+        ([con], [])
+      where
+        con = NormalC (mkName $ resourceName res)
             $ map (\x -> (NotStrict, x))
             $ concat [singles, multi, sub]
-      where
         singles = concatMap (toSingle . snd) $ resourcePieces res
         toSingle Static{} = []
         toSingle (Dynamic typ) = [typ]
@@ -35,16 +37,53 @@ mkRouteCons =
             case resourceDispatch res of
                 Subsite { subsiteType = typ } -> [ConT ''Route `AppT` typ]
                 _ -> []
+    mkRouteCon (ResourceParent name pieces children) =
+        ([con], dec : decs)
+      where
+        (cons, decs) = mkRouteCons children
+        con = NormalC (mkName name)
+            $ map (\x -> (NotStrict, x))
+            $ concat [singles, [ConT $ mkName name]]
+        dec = DataD [] (mkName name) [] cons [''Show, ''Read, ''Eq]
+
+        singles = concatMap (toSingle . snd) pieces
+        toSingle Static{} = []
+        toSingle (Dynamic typ) = [typ]
 
 -- | Clauses for the 'renderRoute' method.
-mkRenderRouteClauses :: [Resource Type] -> Q [Clause]
+mkRenderRouteClauses :: [ResourceTree Type] -> Q [Clause]
 mkRenderRouteClauses =
     mapM go
   where
     isDynamic Dynamic{} = True
     isDynamic _ = False
 
-    go res = do
+    go (ResourceParent name pieces children) = do
+        let cnt = length $ filter (isDynamic . snd) pieces
+        dyns <- replicateM cnt $ newName "dyn"
+        child <- newName "child"
+        let pat = ConP (mkName name) $ map VarP $ dyns ++ [child]
+
+        pack' <- [|pack|]
+        tsp <- [|toPathPiece|]
+        let piecesSingle = mkPieces (AppE pack' . LitE . StringL) tsp (map snd pieces) dyns
+
+        childRender <- newName "childRender"
+        let rr = VarE childRender
+        childClauses <- mkRenderRouteClauses children
+
+        a <- newName "a"
+        b <- newName "b"
+
+        colon <- [|(:)|]
+        let cons y ys = InfixE (Just y) colon (Just ys)
+        let pieces' = foldr cons (VarE a) piecesSingle
+
+        let body = LamE [TupP [VarP a, VarP b]] (TupE [pieces', VarE b]) `AppE` (rr `AppE` VarE child)
+
+        return $ Clause [pat] (NormalB body) [FunD childRender childClauses]
+
+    go (ResourceLeaf res) = do
         let cnt = length (filter (isDynamic . snd) $ resourcePieces res) + maybe 0 (const 1) (resourceMulti res)
         dyns <- replicateM cnt $ newName "dyn"
         sub <-
@@ -93,18 +132,19 @@ mkRenderRouteClauses =
 -- This includes both the 'Route' associated type and the
 -- 'renderRoute' method.  This function uses both 'mkRouteCons' and
 -- 'mkRenderRouteClasses'.
-mkRenderRouteInstance :: Type -> [Resource Type] -> Q Dec
+mkRenderRouteInstance :: Type -> [ResourceTree Type] -> Q [Dec]
 mkRenderRouteInstance = mkRenderRouteInstance' []
 
 -- | A more general version of 'mkRenderRouteInstance' which takes an
 -- additional context.
 
-mkRenderRouteInstance' :: Cxt -> Type -> [Resource Type] -> Q Dec
+mkRenderRouteInstance' :: Cxt -> Type -> [ResourceTree Type] -> Q [Dec]
 mkRenderRouteInstance' cxt typ ress = do
     cls <- mkRenderRouteClauses ress
+    let (cons, decs) = mkRouteCons ress
     return $ InstanceD cxt (ConT ''RenderRoute `AppT` typ)
-        [ DataInstD [] ''Route [typ] (mkRouteCons ress) clazzes
+        [ DataInstD [] ''Route [typ] cons clazzes
         , FunD (mkName "renderRoute") cls
-        ]
+        ] : decs
   where
     clazzes = [''Show, ''Eq, ''Read]

yesod-routes/Yesod/Routes/TH/Types.hs

@@ -2,16 +2,37 @@
 module Yesod.Routes.TH.Types
     ( -- * Data types
       Resource (..)
+    , ResourceTree (..)
     , Piece (..)
     , Dispatch (..)
     , CheckOverlap
       -- ** Helper functions
     , resourceMulti
+    , resourceTreePieces
+    , resourceTreeName
     ) where
 
 import Language.Haskell.TH.Syntax
 import Control.Arrow (second)
 
+data ResourceTree typ = ResourceLeaf (Resource typ) | ResourceParent String [(CheckOverlap, Piece typ)] [ResourceTree typ]
+
+resourceTreePieces :: ResourceTree typ -> [(CheckOverlap, Piece typ)]
+resourceTreePieces (ResourceLeaf r) = resourcePieces r
+resourceTreePieces (ResourceParent _ x _) = x
+
+resourceTreeName :: ResourceTree typ -> String
+resourceTreeName (ResourceLeaf r) = resourceName r
+resourceTreeName (ResourceParent x _ _) = x
+
+instance Functor ResourceTree where
+    fmap f (ResourceLeaf r) = ResourceLeaf (fmap f r)
+    fmap f (ResourceParent a b c) = ResourceParent a (map (second $ fmap f) b) $ map (fmap f) c
+
+instance Lift t => Lift (ResourceTree t) where
+    lift (ResourceLeaf r) = [|ResourceLeaf $(lift r)|]
+    lift (ResourceParent a b c) = [|ResourceParent $(lift a) $(lift b) $(lift c)|]
+
 data Resource typ = Resource
     { resourceName :: String
     , resourcePieces :: [(CheckOverlap, Piece typ)]

yesod-routes/test/Hierarchy.hs

@@ -0,0 +1,103 @@
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Hierarchy
+    ( hierarchy
+    , Dispatcher (..)
+    , RunHandler (..)
+    , Handler
+    , App
+    , toText
+    ) where
+
+import Test.Hspec.Monadic
+import Test.Hspec.HUnit ()
+import Test.HUnit
+import Yesod.Routes.Parse
+import Yesod.Routes.TH
+import Yesod.Routes.Class
+import Language.Haskell.TH.Syntax
+import qualified Yesod.Routes.Class as YRC
+import Data.Text (Text, pack, append)
+
+class ToText a where
+    toText :: a -> Text
+
+instance ToText Text where toText = id
+instance ToText String where toText = pack
+
+type Handler sub master = Text
+type App sub master = (Text, Maybe (YRC.Route master))
+
+class Dispatcher sub master where
+    dispatcher
+        :: master
+        -> sub
+        -> (YRC.Route sub -> YRC.Route master)
+        -> App sub master -- ^ 404 page
+        -> (YRC.Route sub -> App sub master) -- ^ 405 page
+        -> Text -- ^ method
+        -> [Text]
+        -> App sub master
+
+class RunHandler sub master where
+    runHandler
+        :: Handler sub master
+        -> master
+        -> sub
+        -> Maybe (YRC.Route sub)
+        -> (YRC.Route sub -> YRC.Route master)
+        -> App sub master
+
+data Hierarchy = Hierarchy
+
+do
+    let resources = [parseRoutes|
+/ HomeR GET
+/admin/#Int AdminR:
+    / AdminRootR GET
+    /login LoginR GET POST
+    /table/#Text TableR GET
+|]
+    rrinst <- mkRenderRouteInstance (ConT ''Hierarchy) $ map (fmap parseType) resources
+    dispatch <- mkDispatchClause [|runHandler|] [|dispatcher|] [|toText|] resources
+    return
+        $ InstanceD
+            []
+            (ConT ''Dispatcher
+                `AppT` ConT ''Hierarchy
+                `AppT` ConT ''Hierarchy)
+            [FunD (mkName "dispatcher") [dispatch]]
+        : rrinst
+
+getHomeR :: Handler sub master
+getHomeR = "home"
+
+getAdminRootR :: Int -> Handler sub master
+getAdminRootR i = pack $ "admin root: " ++ show i
+
+getLoginR :: Int -> Handler sub master
+getLoginR i = pack $ "login: " ++ show i
+
+postLoginR :: Int -> Handler sub master
+postLoginR i = pack $ "post login: " ++ show i
+
+getTableR :: Int -> Text -> Handler sub master
+getTableR _ t = append "TableR " t
+
+instance RunHandler Hierarchy master where
+    runHandler h _ _ subRoute toMaster = (h, fmap toMaster subRoute)
+
+hierarchy :: Specs
+hierarchy = describe "hierarchy" $ do
+    it "renders root correctly" $
+        renderRoute (AdminR 5 AdminRootR) @?= (["admin", "5"], [])
+    it "renders table correctly" $
+        renderRoute (AdminR 6 $ TableR "foo") @?= (["admin", "6", "table", "foo"], [])
+    let disp m ps = dispatcher Hierarchy Hierarchy id (pack "404", Nothing) (\route -> (pack "405", Just route)) (pack m) (map pack ps)
+    it "dispatches root correctly" $ disp "GET" ["admin", "7"] @?= ("admin root: 7", Just $ AdminR 7 AdminRootR)
+    it "dispatches table correctly" $ disp "GET" ["admin", "8", "table", "bar"] @?= ("TableR bar", Just $ AdminR 8 $ TableR "bar")

yesod-routes/test/main.hs

@@ -20,12 +20,7 @@ import Yesod.Routes.Parse (parseRoutesNoCheck)
 import Yesod.Routes.Overlap (findOverlapNames)
 import Yesod.Routes.TH hiding (Dispatch)
 import Language.Haskell.TH.Syntax
-
+import Hierarchy
-class ToText a where
-    toText :: a -> Text
-
-instance ToText Text where toText = id
-instance ToText String where toText = pack
 
 result :: ([Text] -> Maybe Int) -> Dispatch Int
 result f ts = f ts
@@ -101,32 +96,9 @@ instance RenderRoute MySubParam where
 getMySubParam :: MyApp -> Int -> MySubParam
 getMySubParam _ = MySubParam
 
-type Handler sub master = Text
-type App sub master = (Text, Maybe (YRC.Route master))
-
-class Dispatcher sub master where
-    dispatcher
-        :: master
-        -> sub
-        -> (YRC.Route sub -> YRC.Route master)
-        -> App sub master -- ^ 404 page
-        -> (YRC.Route sub -> App sub master) -- ^ 405 page
-        -> Text -- ^ method
-        -> [Text]
-        -> App sub master
-
-class RunHandler sub master where
-    runHandler
-        :: Handler sub master
-        -> master
-        -> sub
-        -> Maybe (YRC.Route sub)
-        -> (YRC.Route sub -> YRC.Route master)
-        -> App sub master
-
 do
     texts <- [t|[Text]|]
-    let ress =
+    let ress = map ResourceLeaf
             [ Resource "RootR" [] $ Methods Nothing ["GET"]
             , Resource "BlogPostR" (addCheck [Static "blog", Dynamic $ ConT ''Text]) $ Methods Nothing ["GET", "POST"]
             , Resource "WikiR" (addCheck [Static "wiki"]) $ Methods (Just texts) []
@@ -137,14 +109,13 @@ do
     rrinst <- mkRenderRouteInstance (ConT ''MyApp) ress
     dispatch <- mkDispatchClause [|runHandler|] [|dispatcher|] [|toText|] ress
     return
-        [ rrinst
+        $ InstanceD
-        , InstanceD
             []
             (ConT ''Dispatcher
                 `AppT` ConT ''MyApp
                 `AppT` ConT ''MyApp)
             [FunD (mkName "dispatcher") [dispatch]]
-        ]
+        : rrinst
 
 instance RunHandler MyApp master where
     runHandler h _ _ subRoute toMaster = (h, fmap toMaster subRoute)
@@ -328,6 +299,7 @@ main = hspecX $ do
 /bar/baz Foo3
 |]
             findOverlapNames routes @?= []
+    hierarchy
 
 getRootR :: Text
 getRootR = pack "this is the root"

yesod-routes/yesod-routes.cabal

@@ -1,5 +1,5 @@
 name:            yesod-routes
-version:         1.0.1.2
+version:         1.1.0
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -36,12 +36,13 @@ test-suite runtests
     type: exitcode-stdio-1.0
     main-is: main.hs
     hs-source-dirs: test
+    other-modules: Hierarchy
 
     build-depends: base                      >= 4.3      && < 5
                  , yesod-routes
                  , text                      >= 0.5      && < 0.12
                  , HUnit                     >= 1.2      && < 1.3
-                 , hspec                     >= 0.6      && < 1.2
+                 , hspec                     >= 1.2      && < 1.3
                  , containers
                  , template-haskell
                  , path-pieces

yesod-sitemap/Yesod/Sitemap.hs

@@ -30,6 +30,7 @@ import Data.Time (UTCTime)
 import Data.Monoid (mappend)
 import Text.XML
 import Data.Text (Text, pack)
+import qualified Data.Map as Map
 
 data SitemapChangeFreq = Always
                        | Hourly
@@ -66,13 +67,13 @@ template urls render =
     addNS' n = n
     namespace = "http://www.sitemaps.org/schemas/sitemap/0.9"
 
-    root = Element "urlset" [] $ map go urls
+    root = Element "urlset" Map.empty $ map go urls
 
-    go SitemapUrl {..} = NodeElement $ Element "url" [] $ map NodeElement
+    go SitemapUrl {..} = NodeElement $ Element "url" Map.empty $ map NodeElement
-        [ Element "loc" [] [NodeContent $ render sitemapLoc]
+        [ Element "loc" Map.empty [NodeContent $ render sitemapLoc]
-        , Element "lastmod" [] [NodeContent $ formatW3 sitemapLastMod]
+        , Element "lastmod" Map.empty [NodeContent $ formatW3 sitemapLastMod]
-        , Element "changefreq" [] [NodeContent $ showFreq sitemapChangeFreq]
+        , Element "changefreq" Map.empty [NodeContent $ showFreq sitemapChangeFreq]
-        , Element "priority" [] [NodeContent $ pack $ show sitemapPriority]
+        , Element "priority" Map.empty [NodeContent $ pack $ show sitemapPriority]
         ]
 
 sitemap :: [SitemapUrl (Route master)] -> GHandler sub master RepXml

yesod-sitemap/yesod-sitemap.cabal

@@ -1,5 +1,5 @@
 name:            yesod-sitemap
-version:         1.0.0.1
+version:         1.1.0
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -14,10 +14,11 @@ description:     Generate XML sitemaps.
 
 library
     build-depends:   base                      >= 4        && < 5
-                   , yesod-core                >= 1.0      && < 1.1
+                   , yesod-core                >= 1.1      && < 1.2
                    , time                      >= 1.1.4
-                   , xml-conduit               >= 0.7      && < 0.8
+                   , xml-conduit               >= 1.0      && < 1.1
                    , text
+                   , containers
     exposed-modules: Yesod.Sitemap
     ghc-options:     -Wall
 

yesod-static/Yesod/Static.hs

@@ -78,19 +78,15 @@ import System.Posix.Types (EpochTime)
 import Data.Conduit (($$))
 import Data.Conduit.List (sourceList)
 import Data.Functor.Identity (runIdentity)
+import qualified Filesystem.Path.CurrentOS as F
 
 import Network.Wai.Application.Static
     ( StaticSettings (..)
-    , defaultWebAppSettings
     , staticApp
-    , embeddedLookup
-    , toEmbedded
-    , toFilePath
-    , fromFilePath
-    , FilePath
-    , ETagLookup
     , webAppSettingsWithLookup
+    , embeddedSettings
     )
+import WaiAppStatic.Storage.Filesystem (ETagLookup)
 
 -- | Type used for the subsite with static contents.
 newtype Static = Static StaticSettings
@@ -106,7 +102,7 @@ type StaticRoute = Route Static
 static :: Prelude.FilePath -> IO Static
 static dir = do
     hashLookup <- cachedETagLookup dir
-    return $ Static $ webAppSettingsWithLookup (toFilePath dir) hashLookup
+    return $ Static $ webAppSettingsWithLookup (F.decodeString dir) hashLookup
 
 -- | Same as 'static', but does not assumes that the files do not
 -- change and checks their modification time whenever a request
@@ -114,7 +110,7 @@ static dir = do
 staticDevel :: Prelude.FilePath -> IO Static
 staticDevel dir = do
     hashLookup <- cachedETagLookupDevel dir
-    return $ Static $ webAppSettingsWithLookup (toFilePath dir) hashLookup
+    return $ Static $ webAppSettingsWithLookup (F.decodeString dir) hashLookup
 
 -- | Produce a 'Static' based on embedding all of the static
 -- files' contents in the executable at compile time.
@@ -126,10 +122,7 @@ staticDevel dir = do
 -- You can easily change @addStaticContent@ to @\_ _ _ -> return Nothing@ as a workaround.
 -- This will cause yesod to embed those assets into the generated HTML file itself.  
 embed :: Prelude.FilePath -> Q Exp
-embed fp =
+embed fp = [|Static (embeddedSettings $(embedDir fp))|]
-    [|Static (defaultWebAppSettings
-        { ssFolder = embeddedLookup (toEmbedded $(embedDir fp))
-        })|]
 
 instance RenderRoute Static where
     -- | A route on the static subsite (see also 'staticFiles').
@@ -152,10 +145,10 @@ instance RenderRoute Static where
 
 instance Yesod master => YesodDispatch Static master where
     -- Need to append trailing slash to make relative links work
-    yesodDispatch _ _ _ _ _ _ [] _ req =
+    yesodDispatch _ _ _ _ _ _ _ [] _ req =
         return $ responseLBS status301 [("Location", rawPathInfo req `S.append` "/")] ""
 
-    yesodDispatch _ (Static set) _ _ _ _ textPieces  _ req =
+    yesodDispatch _ _ (Static set) _ _ _ _ textPieces  _ req =
         staticApp set req { pathInfo = textPieces }
 
 notHidden :: Prelude.FilePath -> Bool
@@ -233,18 +226,18 @@ publicFiles :: Prelude.FilePath -> Q [Dec]
 publicFiles dir = mkStaticFiles' dir "StaticRoute" False
 
 
-mkHashMap :: Prelude.FilePath -> IO (M.Map FilePath S8.ByteString)
+mkHashMap :: Prelude.FilePath -> IO (M.Map F.FilePath S8.ByteString)
 mkHashMap dir = do
     fs <- getFileListPieces dir
     hashAlist fs >>= return . M.fromList
   where
-    hashAlist :: [[String]] -> IO [(FilePath, S8.ByteString)]
+    hashAlist :: [[String]] -> IO [(F.FilePath, S8.ByteString)]
     hashAlist fs = mapM hashPair fs
       where
-        hashPair :: [String] -> IO (FilePath, S8.ByteString)
+        hashPair :: [String] -> IO (F.FilePath, S8.ByteString)
         hashPair pieces = do let file = pathFromRawPieces dir pieces
                              h <- base64md5File file
-                             return (toFilePath file, S8.pack h)
+                             return (F.decodeString file, S8.pack h)
 
 pathFromRawPieces :: Prelude.FilePath -> [String] -> Prelude.FilePath
 pathFromRawPieces =
@@ -255,12 +248,12 @@ pathFromRawPieces =
 cachedETagLookupDevel :: Prelude.FilePath -> IO ETagLookup
 cachedETagLookupDevel dir = do
     etags <- mkHashMap dir
-    mtimeVar <- newIORef (M.empty :: M.Map FilePath EpochTime)
+    mtimeVar <- newIORef (M.empty :: M.Map F.FilePath EpochTime)
     return $ \f ->
       case M.lookup f etags of
         Nothing -> return Nothing
         Just checksum -> do
-          fs <- getFileStatus $ fromFilePath f
+          fs <- getFileStatus $ F.encodeString f
           let newt = modificationTime fs
           mtimes <- readIORef mtimeVar
           oldt <- case M.lookup f mtimes of

yesod-static/yesod-static.cabal

@@ -1,5 +1,5 @@
 name:            yesod-static
-version:         1.0.0.3
+version:         1.1.0
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -19,22 +19,23 @@ library
     build-depends:   base                  >= 4        && < 5
                    , containers            >= 0.2
                    , old-time              >= 1.0
-                   , yesod-core            >= 1.0      && < 1.1
+                   , yesod-core            >= 1.1      && < 1.2
                    , base64-bytestring     >= 0.1.0.1  && < 0.2
                    , cereal                >= 0.3      && < 0.4
                    , bytestring            >= 0.9.1.4
                    , template-haskell
                    , directory             >= 1.0      && < 1.2
                    , transformers          >= 0.2.2    && < 0.4
-                   , wai-app-static        >= 1.2      && < 1.3
+                   , wai-app-static        >= 1.3      && < 1.4
-                   , wai                   >= 1.2      && < 1.3
+                   , wai                   >= 1.3      && < 1.4
                    , text                  >= 0.9      && < 1.0
                    , file-embed            >= 0.0.4.1  && < 0.5
-                   , http-types            >= 0.6.5    && < 0.7
+                   , http-types            >= 0.7      && < 0.8
                    , unix-compat           >= 0.2
-                   , conduit               >= 0.4      && < 0.5
+                   , conduit               >= 0.5      && < 0.6
-                   , crypto-conduit        >= 0.3      && < 0.4
+                   , crypto-conduit        >= 0.4      && < 0.5
                    , cryptohash            >= 0.6.1
+                   , system-filepath       >= 0.4.6    && < 0.5
     exposed-modules: Yesod.Static
     ghc-options:     -Wall
 
@@ -60,11 +61,12 @@ test-suite tests
                    , wai
                    , text                  >= 0.9      && < 1.0
                    , file-embed            >= 0.0.4.1  && < 0.5
-                   , http-types            >= 0.6.5    && < 0.7
+                   , http-types
                    , unix-compat           >= 0.2
                    , conduit
                    , crypto-conduit
                    , cryptohash            >= 0.6.1
+                   , system-filepath
 
     ghc-options:     -Wall
 

yesod-test/Yesod/Test.hs

@@ -69,6 +69,7 @@ import qualified Test.Hspec.Runner as Runner
 import qualified Data.List as DL
 import qualified Data.Maybe as DY
 import qualified Data.ByteString.Char8 as BS8
+import Data.ByteString (ByteString)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
 import qualified Data.ByteString.Lazy.Char8 as BSL8
@@ -77,7 +78,6 @@ import qualified Test.Hspec.HUnit ()
 import qualified Network.HTTP.Types as H
 import qualified Network.Socket.Internal as Sock
 import Data.CaseInsensitive (CI)
-import Text.XML.HXT.Core hiding (app, err)
 import Network.Wai
 import Network.Wai.Test hiding (assertHeader, assertNoHeader)
 import qualified Control.Monad.Trans.State as ST
@@ -88,6 +88,8 @@ import Database.Persist.GenericSql
 import Data.Monoid (mappend)
 import qualified Data.Text.Lazy as TL
 import Data.Text.Lazy.Encoding (encodeUtf8, decodeUtf8)
+import Text.XML.Cursor hiding (element)
+import qualified Text.HTML.DOM as HD
 
 -- | The state used in 'describe' to build a list of specs
 data SpecsData = SpecsData Application ConnectionPool [Core.Spec]
@@ -105,8 +107,8 @@ data RequestBuilderData = RequestBuilderData [RequestPart] (Maybe SResponse)
 
 -- | Request parts let us discern regular key/values from files sent in the request.
 data RequestPart
-  = ReqPlainPart String String
+  = ReqPlainPart T.Text T.Text
-  | ReqFilePart String FilePath BSL8.ByteString String
+  | ReqFilePart T.Text FilePath BSL8.ByteString T.Text
 
 -- | The RequestBuilder state monad constructs an url encoded string of arguments
 -- to send with your requests. Some of the functions that run on it use the current
@@ -123,7 +125,7 @@ instance HoldsResponse OneSpecData where
 instance HoldsResponse RequestBuilderData where
   readResponse (RequestBuilderData _ x) = x
   
-type CookieValue = H.Ascii
+type CookieValue = ByteString
 
 -- | Runs your test suite, using you wai 'Application' and 'ConnectionPool' for performing 
 -- the database queries in your tests.
@@ -136,12 +138,7 @@ type CookieValue = H.Ascii
 runTests :: Application -> ConnectionPool -> Specs -> IO ()
 runTests app connection specsDef = do
   (SpecsData _ _ specs) <- ST.execStateT specsDef (SpecsData app connection [])
-#if MIN_VERSION_hspec(1,2,0)
+  Runner.hspec specs
-  Runner.hspec
-#else
-  Runner.hspecX
-#endif
-    specs
 
 -- | Start describing a Tests suite keeping cookies and a reference to the tested 'Application'
 -- and 'ConnectionPool'
@@ -168,14 +165,14 @@ withResponse f = maybe err f =<< fmap readResponse ST.get
 
 -- | Use HXT to parse a value from an html tag.
 -- Check for usage examples in this module's source.
-parseHTML :: Html -> LA XmlTree a -> [a]
+parseHTML :: Html -> (Cursor -> [a]) -> [a]
-parseHTML html p = runLA (hread >>> p ) (TL.unpack $ decodeUtf8 html)
+parseHTML html p = p $ fromDocument $ HD.parseLBS html
 
 -- | Query the last response using css selectors, returns a list of matched fragments
 htmlQuery :: HoldsResponse a => Query -> ST.StateT a IO [Html]
 htmlQuery query = withResponse $ \ res ->
   case findBySelector (simpleBody res) query of
-    Left err -> failure $ T.unpack query ++ " did not parse: " ++ (show err)
+    Left err -> failure $ query <> " did not parse: " <> T.pack (show err)
     Right matches -> return $ map (encodeUtf8 . TL.pack) matches
 
 -- | Asserts that the two given values are equal.
@@ -194,7 +191,7 @@ statusIs number = withResponse $ \ SResponse { simpleStatus = s } ->
 assertHeader :: HoldsResponse a => CI BS8.ByteString -> BS8.ByteString -> ST.StateT a IO ()
 assertHeader header value = withResponse $ \ SResponse { simpleHeaders = h } ->
   case lookup header h of
-    Nothing -> failure $ concat
+    Nothing -> failure $ T.pack $ concat
         [ "Expected header "
         , show header
         , " to be "
@@ -215,7 +212,7 @@ assertNoHeader :: HoldsResponse a => CI BS8.ByteString -> ST.StateT a IO ()
 assertNoHeader header = withResponse $ \ SResponse { simpleHeaders = h } ->
   case lookup header h of
     Nothing -> return ()
-    Just s  -> failure $ concat
+    Just s  -> failure $ T.pack $ concat
         [ "Unexpected header "
         , show header
         , " containing "
@@ -245,7 +242,7 @@ htmlAllContain :: HoldsResponse a => Query -> String -> ST.StateT a IO ()
 htmlAllContain query search = do
   matches <- htmlQuery query
   case matches of
-    [] -> failure $ "Nothing matched css query: "++T.unpack query
+    [] -> failure $ "Nothing matched css query: " <> query
     _ -> liftIO $ HUnit.assertBool ("Not all "++T.unpack query++" contain "++search) $
           DL.all (DL.isInfixOf search) (map (TL.unpack . decodeUtf8) matches)
 
@@ -269,7 +266,7 @@ printMatches query = do
   liftIO $ hPutStrLn stderr $ show matches
 
 -- | Add a parameter with the given name and value.
-byName :: String -> String -> RequestBuilder ()
+byName :: T.Text -> T.Text -> RequestBuilder ()
 byName name value = do
   RequestBuilderData parts r <- ST.get
   ST.put $ RequestBuilderData ((ReqPlainPart name value):parts) r
@@ -277,50 +274,67 @@ byName name value = do
 -- | Add a file to be posted with the current request
 --
 -- Adding a file will automatically change your request content-type to be multipart/form-data
-fileByName :: String -> FilePath -> String -> RequestBuilder ()
+fileByName :: T.Text -> FilePath -> T.Text -> RequestBuilder ()
 fileByName name path mimetype = do
   RequestBuilderData parts r <- ST.get
   contents <- liftIO $ BSL8.readFile path
   ST.put $ RequestBuilderData ((ReqFilePart name path contents mimetype):parts) r
 
 -- This looks up the name of a field based on the contents of the label pointing to it.
-nameFromLabel :: String -> RequestBuilder String
+nameFromLabel :: T.Text -> RequestBuilder T.Text
 nameFromLabel label = withResponse $ \ res -> do
   let
     body = simpleBody res
     escaped = escapeHtmlEntities label
-    mfor = parseHTML body $ deep $ hasName "label"
+    mfor = parseHTML body $ \c -> c
-        >>> filterA (xshow this >>> mkText >>> hasText (DL.isInfixOf escaped))
+                $// attributeIs "name" "label"
-        >>> getAttrValue "for"
+                >=> contentContains escaped
+                >=> attribute "for"
+
+    contentContains x c
+        | x `T.isInfixOf` T.concat (c $// content) = [c]
+        | otherwise = []
 
   case mfor of
     for:[] -> do
-      let mname = parseHTML body $ deep $ hasAttrValue "id" (==for) >>> getAttrValue "name"
+      let mname = parseHTML body $ \c -> c
+                    $// attributeIs "id" for
+                    >=> attribute "name"
       case mname of
-        "":_ -> failure $ "Label "++label++" resolved to id "++for++" which was not found. "
+        "":_ -> failure $ T.concat
+            [ "Label "
+            , label
+            , " resolved to id "
+            , for
+            , " which was not found. "
+            ]
         name:_ -> return name
-        _ -> failure $ "More than one input with id " ++ for
+        _ -> failure $ "More than one input with id " <> for
-    [] -> failure $ "No label contained: "++label
+    [] -> failure $ "No label contained: " <> label
-    _ -> failure $ "More than one label contained "++label
+    _ -> failure $ "More than one label contained " <> label
+
+(<>) :: T.Text -> T.Text -> T.Text
+(<>) = T.append
 
 -- | Escape HTML entities in a string, so you can write the text you want in
 -- label lookups without worrying about the fact that yesod escapes some characters.
-escapeHtmlEntities :: String -> String 
+escapeHtmlEntities :: T.Text -> T.Text
-escapeHtmlEntities "" = ""
+escapeHtmlEntities =
-escapeHtmlEntities (c:cs) = case c of
+    T.concatMap go
-  '<'  -> '&' : 'l' : 't' : ';'             : escapeHtmlEntities cs
+  where
-  '>'  -> '&' : 'g' : 't' : ';'             : escapeHtmlEntities cs
+    go '<' = "&lt;"
-  '&'  -> '&' : 'a' : 'm' : 'p' : ';'       : escapeHtmlEntities cs
+    go '>' = "&gt;"
-  '"'  -> '&' : 'q' : 'u' : 'o' : 't' : ';' : escapeHtmlEntities cs
+    go '&' = "&amp;"
-  '\'' -> '&' : '#' : '3' : '9' : ';'       : escapeHtmlEntities cs
+    go '"' = "&quot;"
-  x    -> x                                 : escapeHtmlEntities cs
+    go '\'' = "&#39;"
+    go x = T.singleton x
 
-byLabel :: String -> String -> RequestBuilder ()
+byLabel :: T.Text -> T.Text -> RequestBuilder ()
 byLabel label value = do
   name <- nameFromLabel label
   byName name value
 
-fileByLabel :: String -> FilePath -> String -> RequestBuilder ()
+fileByLabel :: T.Text -> FilePath -> T.Text -> RequestBuilder ()
 fileByLabel label path mime = do
   name <- nameFromLabel label
   fileByName name path mime
@@ -332,7 +346,7 @@ addNonce_ scope = do
   matches <- htmlQuery $ scope `mappend` "input[name=_token][type=hidden][value]"
   case matches of
     [] -> failure $ "No nonce found in the current page"
-    element:[] -> byName "_token" $ head $ parseHTML element $ getAttrValue "value"
+    element:[] -> byName "_token" $ head $ parseHTML element $ attribute "value"
     _ -> failure $ "More than one nonce found in the page"
 
 -- | For responses that display a single form, just lookup the only nonce available.
@@ -384,22 +398,22 @@ doRequest method url paramsBuild = do
     BS8.concat $ separator : [BS8.concat [multipartPart p, separator] | p <- parts]
   multipartPart (ReqPlainPart k v) = BS8.concat
     [ "Content-Disposition: form-data; "
-    , "name=\"", (BS8.pack k), "\"\r\n\r\n"
+    , "name=\"", TE.encodeUtf8 k, "\"\r\n\r\n"
-    , (BS8.pack v), "\r\n"]
+    , TE.encodeUtf8 v, "\r\n"]
   multipartPart (ReqFilePart k v bytes mime) = BS8.concat
     [ "Content-Disposition: form-data; "
-    , "name=\"", BS8.pack k, "\"; "
+    , "name=\"", TE.encodeUtf8 k, "\"; "
     , "filename=\"", BS8.pack v, "\"\r\n"
-    , "Content-Type: ", BS8.pack mime, "\r\n\r\n"
+    , "Content-Type: ", TE.encodeUtf8 mime, "\r\n\r\n"
     , BS8.concat $ BSL8.toChunks bytes, "\r\n"]
 
   -- For building the regular non-multipart requests
   makeSinglepart cookie parts = SRequest (mkRequest 
     [("Cookie",cookie), ("Content-Type", "application/x-www-form-urlencoded")]) $
-    BSL8.pack $ DL.concat $ DL.intersperse "&" $ map singlepartPart parts
+    BSL8.fromChunks $ return $ TE.encodeUtf8 $ T.intercalate "&" $ map singlepartPart parts
 
   singlepartPart (ReqFilePart _ _ _ _) = ""
-  singlepartPart (ReqPlainPart k v) = concat [k,"=",v]
+  singlepartPart (ReqPlainPart k v) = T.concat [k,"=",v]
 
   -- General request making 
   mkRequest headers = defaultRequest
@@ -418,5 +432,5 @@ runDB query = do
   liftIO $ runSqlPool query pool
 
 -- Yes, just a shortcut
-failure :: (MonadIO a) => String -> a b
+failure :: (MonadIO a) => T.Text -> a b
-failure reason = (liftIO $ HUnit.assertFailure reason) >> error ""
+failure reason = (liftIO $ HUnit.assertFailure $ T.unpack reason) >> error ""

yesod-test/Yesod/Test/HtmlParse.hs

@@ -1,14 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
--- | Parse an HTML document into xml-conduit's Document.
---
--- Assumes UTF-8 encoding.
-module Yesod.Test.HtmlParse
-    ( parseHtml
-    ) where
-
-import qualified Data.ByteString.Lazy as L
-import Text.XML (Document)
-import qualified Text.HTML.DOM as HD
-
-parseHtml :: L.ByteString -> Either String Document
-parseHtml = Right . HD.parseLBS

yesod-test/Yesod/Test/TransversingCSS.hs

@@ -41,11 +41,11 @@ where
 
 import Yesod.Test.CssQuery
 import qualified Data.Text as T
-import Yesod.Test.HtmlParse (parseHtml)
 import Control.Applicative ((<$>), (<*>))
 import Text.XML
 import Text.XML.Cursor
 import qualified Data.ByteString.Lazy as L
+import qualified Text.HTML.DOM as HD
 #if MIN_VERSION_blaze_html(0, 5, 0)
 import Text.Blaze.Html (toHtml)
 import Text.Blaze.Html.Renderer.String (renderHtml)
@@ -53,7 +53,6 @@ import Text.Blaze.Html.Renderer.String (renderHtml)
 import Text.Blaze (toHtml)
 import Text.Blaze.Renderer.String (renderHtml)
 #endif
-import Text.XML.Xml2Html ()
 
 type Query = T.Text
 type Html = L.ByteString
@@ -65,7 +64,7 @@ type Html = L.ByteString
 -- * Right: List of matching Html fragments.
 findBySelector :: Html -> Query -> Either String [String]
 findBySelector html query = (\x -> map (renderHtml . toHtml . node) . runQuery x)
-    <$> (fromDocument <$> parseHtml html)
+    <$> (Right $ fromDocument $ HD.parseLBS html)
     <*> parseQuery query
 
 -- Run a compiled query on Html, returning a list of matching Html fragments.

yesod-test/test/main.hs

@@ -6,23 +6,18 @@ import Test.Hspec.HUnit ()
 
 import Yesod.Test.CssQuery
 import Yesod.Test.TransversingCSS
-import Yesod.Test.HtmlParse
 import Text.XML
 
 import Data.ByteString.Lazy.Char8 ()
+import qualified Data.Map as Map
+import qualified Text.HTML.DOM as HD
 
 parseQuery_ = either error id . parseQuery
 findBySelector_ x = either error id . findBySelector x
-parseHtml_ = either error id . parseHtml
+parseHtml_ = HD.parseLBS
 
 main :: IO ()
-main =
+main = hspec $ do
-#if MIN_VERSION_hspec(1,2,0)
-  hspec
-#else
-  hspecX
-#endif
-   $ do
     describe "CSS selector parsing" $ do
         it "elements" $ parseQuery_ "strong" @?= [[DeepChildren [ByTagName "strong"]]]
         it "child elements" $ parseQuery_ "strong > i" @?= [[DeepChildren [ByTagName "strong"], DirectChildren [ByTagName "i"]]]
@@ -40,13 +35,13 @@ main =
         it "XHTML" $
             let html = "<html><head><title>foo</title></head><body><p>Hello World</p></body></html>"
                 doc = Document (Prologue [] Nothing []) root []
-                root = Element "html" []
+                root = Element "html" Map.empty
-                    [ NodeElement $ Element "head" []
+                    [ NodeElement $ Element "head" Map.empty
-                        [ NodeElement $ Element "title" []
+                        [ NodeElement $ Element "title" Map.empty
                             [NodeContent "foo"]
                         ]
-                    , NodeElement $ Element "body" []
+                    , NodeElement $ Element "body" Map.empty
-                        [ NodeElement $ Element "p" []
+                        [ NodeElement $ Element "p" Map.empty
                             [NodeContent "Hello World"]
                         ]
                     ]
@@ -54,14 +49,14 @@ main =
         it "HTML" $
             let html = "<html><head><title>foo</title></head><body><br><p>Hello World</p></body></html>"
                 doc = Document (Prologue [] Nothing []) root []
-                root = Element "html" []
+                root = Element "html" Map.empty
-                    [ NodeElement $ Element "head" []
+                    [ NodeElement $ Element "head" Map.empty
-                        [ NodeElement $ Element "title" []
+                        [ NodeElement $ Element "title" Map.empty
                             [NodeContent "foo"]
                         ]
-                    , NodeElement $ Element "body" []
+                    , NodeElement $ Element "body" Map.empty
-                        [ NodeElement $ Element "br" [] []
+                        [ NodeElement $ Element "br" Map.empty []
-                        , NodeElement $ Element "p" []
+                        , NodeElement $ Element "p" Map.empty
                             [NodeContent "Hello World"]
                         ]
                     ]

yesod-test/yesod-test.cabal

@@ -1,5 +1,5 @@
 name:               yesod-test
-version:            0.2.1
+version:            0.3.0
 license:            MIT
 license-file:       LICENSE
 author:             Nubis <nubis@woobiz.com.ar>
@@ -13,44 +13,30 @@ homepage:           http://www.yesodweb.com
 description:        Behaviour Oriented integration Testing for Yesod Applications 
 extra-source-files: README.md, LICENSE, test/main.hs
 
-flag blaze_html_0_5
-    description: use blaze-html 0.5 and blaze-markup 0.5
-    default: True
-
-
 library
     build-depends:   base                      >= 4.3      && < 5
-                   , hxt                       >= 9.1.6
                    , attoparsec                >= 0.10     && < 0.11
-                   , persistent                >= 0.9      && < 0.10
+                   , persistent                >= 1.0      && < 1.1
                    , transformers              >= 0.2.2    && < 0.4
-                   , wai                       >= 1.2      && < 1.3
+                   , wai                       >= 1.3      && < 1.4
-                   , wai-test                  >= 1.2      && < 1.3
+                   , wai-test                  >= 1.3      && < 1.4
                    , network                   >= 2.2      && < 2.4
-                   , http-types                >= 0.6      && < 0.7
+                   , http-types                >= 0.7      && < 0.8
                    , HUnit                     >= 1.2      && < 1.3
-                   , hspec                     >= 1.1      && < 1.3
+                   , hspec                     >= 1.2      && < 1.3
                    , bytestring                >= 0.9
                    , case-insensitive          >= 0.2
                    , text
-                   , xml-conduit               >= 0.7      && < 0.8
+                   , xml-conduit               >= 1.0      && < 1.1
                    , xml-types                 >= 0.3      && < 0.4
                    , containers
-                   , xml2html                  >= 0.1.2.3  && < 0.2
+                   , html-conduit              >= 0.1      && < 0.2
-                   , html-conduit              >= 0.0.1    && < 0.1
+                   , blaze-html                >= 0.5      && < 0.6
-
+                   , blaze-markup              >= 0.5.1    && < 0.6
-    if flag(blaze_html_0_5)
-        build-depends:
-                     blaze-html               >= 0.5     && < 0.6
-                   , blaze-markup             >= 0.5.1   && < 0.6
-    else
-        build-depends:
-                     blaze-html               >= 0.4     && < 0.5
 
     exposed-modules: Yesod.Test
                      Yesod.Test.CssQuery
                      Yesod.Test.TransversingCSS
-                     Yesod.Test.HtmlParse
     ghc-options:  -Wall
 
 test-suite test
@@ -63,6 +49,8 @@ test-suite test
                           , HUnit
                           , xml-conduit
                           , bytestring
+                          , containers
+                          , html-conduit
 
 source-repository head
   type: git

yesod/AddHandler.hs

@@ -0,0 +1,113 @@
+module AddHandler (addHandler) where
+
+import Prelude hiding (readFile)
+import System.IO (hFlush, stdout)
+import Data.Char (isLower, toLower, isSpace)
+import Data.List (isPrefixOf, isSuffixOf)
+import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
+import System.Directory (getDirectoryContents)
+
+-- strict readFile
+readFile :: FilePath -> IO String
+readFile = fmap T.unpack . TIO.readFile
+
+addHandler :: IO ()
+addHandler = do
+    allFiles <- getDirectoryContents "."
+    cabal <-
+        case filter (".cabal" `isSuffixOf`) allFiles of
+            [x] -> return x
+            [] -> error "No cabal file found"
+            _ -> error "Too many cabal files found"
+
+    putStr "Name of route (without trailing R): "
+    hFlush stdout
+    name <- getLine
+    case name of
+        [] -> error "Please provide a name"
+        c:_
+            | isLower c -> error "Name must start with an upper case letter"
+            | otherwise -> return ()
+    putStr "Enter route pattern: "
+    hFlush stdout
+    pattern <- getLine
+    putStr "Enter space-separated list of methods: "
+    hFlush stdout
+    methods <- getLine
+
+    let modify fp f = readFile fp >>= writeFile fp . f
+
+    modify "Application.hs" $ fixApp name
+    modify cabal $ fixCabal name
+    modify "config/routes" $ fixRoutes name pattern methods
+    writeFile ("Handler/" ++ name ++ ".hs") $ mkHandler name pattern methods
+
+fixApp :: String -> String -> String
+fixApp name =
+    unlines . reverse . go . reverse . lines
+  where
+    l = "import Handler." ++ name
+
+    go [] = [l]
+    go (x:xs)
+        | "import Handler." `isPrefixOf` x = l : x : xs
+        | otherwise = x : go xs
+
+fixCabal :: String -> String -> String
+fixCabal name =
+    unlines . reverse . go . reverse . lines
+  where
+    l = "import Handler." ++ name
+
+    go [] = [l]
+    go (x:xs)
+        | "Handler." `isPrefixOf` x' = (spaces ++ "Handler." ++ name) : x : xs
+        | otherwise = x : go xs
+      where
+        (spaces, x') = span isSpace x
+
+fixRoutes :: String -> String -> String -> String -> String
+fixRoutes name pattern methods =
+    (++ l)
+  where
+    l = concat
+        [ pattern
+        , " "
+        , name
+        , "R "
+        , methods
+        , "\n"
+        ]
+
+mkHandler :: String -> String -> String -> String
+mkHandler name pattern methods = unlines
+    $ ("module Handler." ++ name ++ " where")
+    : ""
+    : "import Import"
+    : concatMap go (words methods)
+  where
+    go method =
+        [ ""
+        , concat $ func : " :: " : map toArrow types ++ ["Handler RepHtml"]
+        , concat
+            [ func
+            , " = error \"Not yet implemented: "
+            , func
+            , "\""
+            ]
+        ]
+      where
+        func = concat [map toLower method, name, "R"]
+
+    types = getTypes pattern
+
+    toArrow t = concat [t, " -> "]
+
+    getTypes "" = []
+    getTypes ('/':rest) = getTypes rest
+    getTypes ('#':rest) =
+        typ : getTypes rest'
+      where
+        (typ, rest') = break (== '/') rest
+    getTypes rest = getTypes $ dropWhile (/= '/') rest

yesod/Scaffolding/Scaffolder.hs

@@ -143,6 +143,7 @@ scaffold = do
       Mysql      -> writeFile' ("config/" ++ backendLower ++ ".yml") $(codegen "config/mysql.yml")
 
     writeFile' "config/settings.yml" $(codegen "config/settings.yml")
+    writeFile' "config/keter.yaml" $(codegen "config/keter.yaml")
     writeFile' "main.hs" $(codegen "main.hs")
     writeFile' "devel.hs" $(codegen "devel.hs")
     writeFile' (project ++ ".cabal") $(codegen "project.cabal")

yesod/Yesod.hs

@@ -45,15 +45,13 @@ import Text.Julius
 import Yesod.Form
 import Yesod.Json
 import Yesod.Persist
-import Network.HTTP.Types (status200)
 import Control.Monad.IO.Class (liftIO, MonadIO(..))
 import Control.Monad.Trans.Control (MonadBaseControl)
 
 import Network.Wai
-import Network.Wai.Logger
+import Network.Wai.Middleware.RequestLogger (logStdout)
 import Network.Wai.Handler.Warp (run)
-import System.IO (stderr, stdout, hFlush, hPutStrLn)
+import System.IO (stderr, hPutStrLn)
-import System.Log.FastLogger
 #if MIN_VERSION_blaze_html(0, 5, 0)
 import Text.Blaze.Html (toHtml)
 #else
@@ -80,23 +78,7 @@ warpDebug :: (Yesod a, YesodDispatch a a) => Int -> a -> IO ()
 warpDebug port app = do
   hPutStrLn stderr $ "Application launched, listening on port " ++ show port
   waiApp <- toWaiApp app
-  dateRef <- dateInit
+  run port $ logStdout waiApp
-  run port $ (logStdout dateRef) waiApp
-
-logStdout :: DateRef -> Middleware
-logStdout dateRef waiApp =
-  \req -> do
-    logRequest dateRef req
-    waiApp req
-
-logRequest  :: Control.Monad.IO.Class.MonadIO m =>
-               DateRef -> Network.Wai.Request -> m ()
-logRequest dateRef req = do
-  date <- liftIO $ getDate dateRef
-  let status = status200
-      len = 4
-  liftIO $ hPutLogStr stdout $ apacheFormat FromSocket date req status (Just len)
-  liftIO $ hFlush stdout
 
 -- | Run a development server, where your code changes are automatically
 -- reloaded.

yesod/main.hs

@@ -11,6 +11,7 @@ import Control.Monad (unless)
 import Build (touch)
 #endif
 import Devel (devel)
+import AddHandler (addHandler)
 
 windowsWarning :: String
 #ifdef WINDOWS
@@ -46,6 +47,7 @@ main = do
             rawSystem' cmd ["test"]
         ["version"] -> putStrLn $ "yesod-core version:" ++ yesodVersion
         "configure":rest -> rawSystem cmd ("configure":rest) >>= exitWith
+        ["add-handler"] -> addHandler
         _ -> do
             putStrLn "Usage: yesod <command>"
             putStrLn "Available commands:"
@@ -59,6 +61,7 @@ main = do
             putStrLn "                    use --dev devel to build with cabal-dev"
             putStrLn "    test         Build and run the integration tests"
             putStrLn "                    use --dev devel to build with cabal-dev"
+            putStrLn "    add-handler  Add a new handler and module to your project"
             putStrLn "    version      Print the version of Yesod"
 
 -- | Like @rawSystem@, but exits if it receives a non-success result.

yesod/scaffold/Application.hs.cg

@@ -11,8 +11,7 @@ import Yesod.Auth
 import Yesod.Default.Config
 import Yesod.Default.Main
 import Yesod.Default.Handlers
-import Yesod.Logger (Logger, logBS, toProduction)
+import Network.Wai.Middleware.RequestLogger (logStdout, logStdoutDev)
-import Network.Wai.Middleware.RequestLogger (logCallback, logCallbackDev)
 import qualified Database.Persist.Store~importMigration~
 import Network.HTTP.Conduit (newManager, def)
 
@@ -29,25 +28,24 @@ mkYesodDispatch "~sitearg~" resources~sitearg~
 -- performs initialization and creates a WAI application. This is also the
 -- place to put your migrate statements to have automatic database
 -- migrations handled by Yesod.
-makeApplication :: AppConfig DefaultEnv Extra -> Logger -> IO Application
+makeApplication :: AppConfig DefaultEnv Extra -> IO Application
-makeApplication conf logger = do
+makeApplication conf = do
-    foundation <- makeFoundation conf setLogger
+    foundation <- makeFoundation conf
     app <- toWaiAppPlain foundation
     return $ logWare app
   where
-    setLogger = if development then logger else toProduction logger
+    logWare   = if development then logStdoutDev
-    logWare   = if development then logCallbackDev (logBS setLogger)
+                               else logStdout
-                               else logCallback    (logBS setLogger)
 
-makeFoundation :: AppConfig DefaultEnv Extra -> Logger -> IO ~sitearg~
+makeFoundation :: AppConfig DefaultEnv Extra -> IO ~sitearg~
-makeFoundation conf setLogger = do
+makeFoundation conf = do
     manager <- newManager def
     s <- staticSite
     dbconf <- withYamlEnvironment "config/~dbConfigFile~.yml" (appEnv conf)
               Database.Persist.Store.loadConfig >>=
               Database.Persist.Store.applyEnv
     p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig)~runMigration~
-    return $ ~sitearg~ conf setLogger s p manager dbconf
+    return $ ~sitearg~ conf s p manager dbconf
 
 -- for yesod devel
 getApplicationDev :: IO (Int, Application)

yesod/scaffold/Foundation.hs.cg

@@ -20,7 +20,6 @@ import Yesod.Auth.BrowserId
 import Yesod.Auth.GoogleEmail
 import Yesod.Default.Config
 import Yesod.Default.Util (addStaticContentExternal)
-import Yesod.Logger (Logger, logMsg, formatLogText)
 import Network.HTTP.Conduit (Manager)
 import qualified Settings
 import qualified Database.Persist.Store
@@ -38,7 +37,6 @@ import Text.Hamlet (hamletFile)
 -- access to the data present here.
 data ~sitearg~ = ~sitearg~
     { settings :: AppConfig DefaultEnv Extra
-    , getLogger :: Logger
     , getStatic :: Static -- ^ Settings for static file serving.
     , connPool :: Database.Persist.Store.PersistConfigPool Settings.PersistConfig -- ^ Database connection pool.
     , httpManager :: Manager
@@ -107,9 +105,6 @@ instance Yesod ~sitearg~ where
     -- The page to be redirected to when authentication is required.
     authRoute _ = Just $ AuthR LoginR
 
-    messageLogger y loc level msg =
-      formatLogText (getLogger y) loc level msg >>= logMsg (getLogger y)
-
     -- This function creates static content files in the static folder
     -- and names them based on a hash of their content. This allows
     -- expiration dates to be set far in the future without worry of

yesod/scaffold/Settings.hs.cg

@@ -17,11 +17,13 @@ import Text.Shakespeare.Text (st)
 import Language.Haskell.TH.Syntax
 import Database.Persist.~importPersist~ (~configPersist~)
 import Yesod.Default.Config
-import qualified Yesod.Default.Util
+import Yesod.Default.Util
 import Data.Text (Text)
 import Data.Yaml
 import Control.Applicative
 import Settings.Development
+import Data.Default (def)
+import Text.Hamlet
 
 -- | Which Persistent backend this site is using.
 type PersistConfig = ~configPersist~
@@ -49,13 +51,22 @@ staticDir = "static"
 staticRoot :: AppConfig DefaultEnv x -> Text
 staticRoot conf = [st|#{appRoot conf}/static|]
 
+-- | Settings for 'widgetFile', such as which template languages to support and
+-- default Hamlet settings.
+widgetFileSettings :: WidgetFileSettings
+widgetFileSettings = def
+    { wfsHamletSettings = defaultHamletSettings
+        { hamletNewlines = AlwaysNewlines
+        }
+    }
 
 -- The rest of this file contains settings which rarely need changing by a
 -- user.
 
 widgetFile :: String -> Q Exp
-widgetFile = if development then Yesod.Default.Util.widgetFileReload
+widgetFile = (if development then widgetFileReload
-                            else Yesod.Default.Util.widgetFileNoReload
+                             else widgetFileNoReload)
+              widgetFileSettings
 
 data Extra = Extra
     { extraCopyright :: Text

yesod/scaffold/config/keter.yaml.cg

@@ -0,0 +1,4 @@
+exec: ../dist/build/~project~/~project~
+args:
+    - production
+host: ~project~.yesodweb.com

yesod/scaffold/project.cabal.cg

@@ -50,31 +50,32 @@ library
                 NoMonomorphismRestriction
 
     build-depends: base                          >= 4          && < 5
-                 , yesod-platform                >= 1.0        && < 1.1
+                 -- , yesod-platform                >= 1.1        && < 1.2
-                 , yesod                         >= 1.0        && < 1.1
+                 , yesod                         >= 1.1        && < 1.2
-                 , yesod-core                    >= 1.0        && < 1.1
+                 , yesod-core                    >= 1.1        && < 1.2
-                 , yesod-auth                    >= 1.0        && < 1.1
+                 , yesod-auth                    >= 1.1        && < 1.2
-                 , yesod-static                  >= 1.0        && < 1.1
+                 , yesod-static                  >= 1.1        && < 1.2
-                 , yesod-default                 >= 1.0        && < 1.1
+                 , yesod-default                 >= 1.1        && < 1.2
-                 , yesod-form                    >= 1.0        && < 1.1
+                 , yesod-form                    >= 1.1        && < 1.2
-                 , yesod-test                    >= 0.2        && < 0.3
+                 , yesod-test                    >= 0.3        && < 0.4
-                 , clientsession                 >= 0.7.3      && < 0.8
+                 , clientsession                 >= 0.8        && < 0.9
                  , bytestring                    >= 0.9        && < 0.10
                  , text                          >= 0.11       && < 0.12
-                 , persistent                    >= 0.9        && < 0.10
+                 , persistent                    >= 1.0        && < 1.1
-                 , persistent-~backendLower~     >= 0.9        && < 0.10
+                 , persistent-~backendLower~     >= 1.0        && < 1.1
                  , template-haskell
-                 , hamlet                        >= 1.0        && < 1.1
+                 , hamlet                        >= 1.1        && < 1.2
                  , shakespeare-css               >= 1.0        && < 1.1
                  , shakespeare-js                >= 1.0        && < 1.1
                  , shakespeare-text              >= 1.0        && < 1.1
                  , hjsmin                        >= 0.1        && < 0.2
                  , monad-control                 >= 0.3        && < 0.4
-                 , wai-extra                     >= 1.2        && < 1.3
+                 , wai-extra                     >= 1.3        && < 1.4
-                 , yaml                          >= 0.7        && < 0.8
+                 , yaml                          >= 0.8        && < 0.9
-                 , http-conduit                  >= 1.4        && < 1.5
+                 , http-conduit                  >= 1.5        && < 1.6
                  , directory                     >= 1.1        && < 1.2
-                 , warp                          >= 1.2        && < 1.3
+                 , warp                          >= 1.3        && < 1.4
+                 , data-default
 
 executable         ~project~
     if flag(library-only)
@@ -93,17 +94,6 @@ test-suite test
     main-is:           main.hs
     hs-source-dirs:    tests
     ghc-options:       -Wall
-    extensions:        TemplateHaskell
-                       QuasiQuotes
-                       OverloadedStrings
-                       NoImplicitPrelude
-                       CPP
-                       OverloadedStrings
-                       MultiParamTypeClasses
-                       TypeFamilies
-                       GADTs
-                       GeneralizedNewtypeDeriving
-                       FlexibleContexts
 
     build-depends: base
                  , ~project~

yesod/scaffold/templates/default-layout-wrapper.hamlet.cg

@@ -1,3 +1,4 @@
+$newline never
 \<!doctype html>
 \<!--[if lt IE 7]> <html class="no-js ie6 oldie" lang="en"> <![endif]-->
 \<!--[if IE 7]>    <html class="no-js ie7 oldie" lang="en"> <![endif]-->

yesod/scaffold/tests/HomeTest.hs.cg

@@ -1,8 +1,8 @@
+{-# LANGUAGE OverloadedStrings #-}
 module HomeTest
     ( homeSpecs
     ) where
 
-import Import
 import Yesod.Test
 
 homeSpecs :: Specs

yesod/scaffold/tests/main.hs.cg

@@ -13,7 +13,7 @@ import Application (makeFoundation)
 
 import HomeTest
 
-main :: IO a
+main :: IO ()
 main = do
     conf <- loadConfig $ (configSettings Testing) { csParseExtra = parseExtra }
     logger <- defaultDevelopmentLogger

yesod/yesod.cabal

@@ -1,5 +1,5 @@
 name:            yesod
-version:         1.0.1.6
+version:         1.1.0
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -51,6 +51,7 @@ extra-source-files:
   scaffold/templates/boilerplate-wrapper.hamlet.cg
   scaffold/templates/homepage.lucius.cg
   scaffold/messages/en.msg.cg
+  scaffold/config/keter.yaml.cg
   scaffold/config/models.cg
   scaffold/config/mysql.yml.cg
   scaffold/config/sqlite.yml.cg
@@ -62,34 +63,23 @@ extra-source-files:
   scaffold/config/mongoDB.yml.cg
   scaffold/devel.hs.cg
 
-flag blaze_html_0_5
-    description: use blaze-html 0.5 and blaze-markup 0.5
-    default: True
-
 library
     build-depends:   base                      >= 4.3      && < 5
-                   , yesod-core                >= 1.0      && < 1.1
+                   , yesod-core                >= 1.1      && < 1.2
-                   , yesod-auth                >= 1.0      && < 1.1
+                   , yesod-auth                >= 1.1      && < 1.2
-                   , yesod-json                >= 1.0      && < 1.1
+                   , yesod-json                >= 1.1      && < 1.2
-                   , yesod-persistent          >= 1.0      && < 1.1
+                   , yesod-persistent          >= 1.1      && < 1.2
-                   , yesod-form                >= 1.0      && < 1.1
+                   , yesod-form                >= 1.1      && < 1.2
                    , monad-control             >= 0.3      && < 0.4
                    , transformers              >= 0.2.2    && < 0.4
-                   , wai                       >= 1.2      && < 1.3
+                   , wai                       >= 1.3      && < 1.4
-                   , wai-extra                 >= 1.2      && < 1.3
+                   , wai-extra                 >= 1.3      && < 1.4
-                   , wai-logger                >= 0.1.2
+                   , hamlet                    >= 1.1      && < 1.2
-                   , hamlet                    >= 1.0      && < 1.1
                    , shakespeare-js            >= 1.0      && < 1.1
                    , shakespeare-css           >= 1.0      && < 1.1
-                   , warp                      >= 1.2      && < 1.3
+                   , warp                      >= 1.3      && < 1.4
-
+                   , blaze-html                >= 0.5      && < 0.6
-    if flag(blaze_html_0_5)
+                   , blaze-markup              >= 0.5.1    && < 0.6
-        build-depends:
-                     blaze-html               >= 0.5     && < 0.6
-                   , blaze-markup             >= 0.5.1   && < 0.6
-    else
-        build-depends:
-                     blaze-html               >= 0.4     && < 0.5
 
     exposed-modules: Yesod
     ghc-options:     -Wall
@@ -109,10 +99,9 @@ executable             yesod
                      , unix-compat        >= 0.2          && < 0.4
                      , containers         >= 0.2
                      , attoparsec         >= 0.10
-                     , http-types         >= 0.6.1        && < 0.7
+                     , http-types         >= 0.7          && < 0.8
                      , blaze-builder      >= 0.2.1.4      && < 0.4
                      , filepath           >= 1.1
-                     , fast-logger        >= 0.0.2        && < 0.1
                      , process
     ghc-options:       -Wall -threaded
     main-is:           main.hs
@@ -120,6 +109,7 @@ executable             yesod
                        Scaffolding.Scaffolder
                        Devel
                        Build
+                       AddHandler
 
 source-repository head
   type:     git