Merge remote-tracking branch 'origin/master' into yesod-1.4

Conflicts:
	yesod-routes/Yesod/Routes/Parse.hs
	yesod-routes/test/Hierarchy.hs
	yesod-routes/yesod-routes.cabal

yesod-auth-oauth/Yesod/Auth/OAuth.hs

@@ -43,6 +43,7 @@ authOAuth oauth mkCreds = AuthPlugin name dispatch login
     url = PluginR name []
     lookupTokenSecret = bsToText . fromMaybe "" . lookup "oauth_token_secret" . unCredential
     oauthSessionName = "__oauth_token_secret"
+
     dispatch "GET" ["forward"] = do
         render <- lift getUrlRender
         tm <- getRouteToParent
@@ -72,8 +73,9 @@ authOAuth oauth mkCreds = AuthPlugin name dispatch login
       master <- getYesod
       accTok <- getAccessToken oauth reqTok (authHttpManager master)
       creds  <- liftIO $ mkCreds accTok
-      setCreds True creds
+      setCredsRedirect creds
     dispatch _ _ = notFound
+
     login tm = do
         render <- getUrlRender
         let oaUrl = render $ tm $ oauthUrl name

yesod-auth-oauth/yesod-auth-oauth.cabal

@@ -1,5 +1,5 @@
 name:            yesod-auth-oauth
-version:         1.2.0
+version:         1.3.0
 license:         BSD3
 license-file:    LICENSE
 author:          Hiromi Ishii
@@ -20,13 +20,13 @@ library
         cpp-options:     -DGHC7
     else
         build-depends:   base                >= 4         && < 4.3
-    build-depends:   authenticate-oauth      >= 1.4       && < 1.5
+    build-depends:   authenticate-oauth      >= 1.5       && < 1.6
                    , bytestring              >= 0.9.1.4
                    , yesod-core              >= 1.2       && < 1.3
-                   , yesod-auth              >= 1.2       && < 1.3
+                   , yesod-auth              >= 1.3       && < 1.4
-                   , text                    >= 0.7       && < 1.1
+                   , text                    >= 0.7
                    , yesod-form              >= 1.3       && < 1.4
-                   , transformers            >= 0.2.2     && < 0.4
+                   , transformers            >= 0.2.2     && < 0.5
                    , lifted-base             >= 0.2       && < 0.3
     exposed-modules: Yesod.Auth.OAuth
     ghc-options:     -Wall

yesod-auth/Yesod/Auth.hs

@@ -57,7 +57,6 @@ import Data.Monoid (Endo)
 import Network.HTTP.Conduit (Manager)
 
 import qualified Network.Wai as W
-import Text.Hamlet (shamlet)
 
 import Yesod.Core
 import Yesod.Persist
@@ -483,7 +482,7 @@ type AuthEntity master = KeyEntity (AuthId master)
 -- authenticated.
 --
 -- Since 1.1.0
-requireAuthId :: YesodAuthPersist master => HandlerT master IO (AuthId master)
+requireAuthId :: YesodAuth master => HandlerT master IO (AuthId master)
 requireAuthId = maybeAuthId >>= maybe redirectLogin return
 
 -- | Similar to 'maybeAuth', but redirects to a login page if user is not

yesod-auth/Yesod/Auth/GoogleEmail2.hs

@@ -53,9 +53,10 @@ import qualified Yesod.Auth.Message       as Msg
 import           Yesod.Core               (HandlerSite, MonadHandler,
                                            getRouteToParent, getUrlRender,
                                            getYesod, invalidArgs, lift,
-                                           liftBase, lookupGetParam,
+                                           lookupGetParam,
                                            lookupSession, notFound, redirect,
-                                           setSession, whamlet, (.:))
+                                           setSession, whamlet, (.:),
+                                           TypedContent, HandlerT, liftIO)
 
 pid :: Text
 pid = "googleemail2"
@@ -75,7 +76,7 @@ getCreateCsrfToken = do
     case mtoken of
         Just token -> return token
         Nothing -> do
-            stdgen <- liftBase newStdGen
+            stdgen <- liftIO newStdGen
             let token = T.pack $ fst $ randomString 10 stdgen
             setSession csrfKey token
             return token
@@ -111,6 +112,11 @@ authGoogleEmail clientID clientSecret =
     login tm = do
         url <- getDest tm
         [whamlet|<a href=#{url}>_{Msg.LoginGoogle}|]
+
+    dispatch :: YesodAuth site
+             => Text
+             -> [Text]
+             -> HandlerT Auth (HandlerT site IO) TypedContent
     dispatch "GET" ["forward"] = do
         tm <- getRouteToParent
         lift (getDest tm) >>= redirect
@@ -130,7 +136,7 @@ authGoogleEmail clientID clientSecret =
 
         render <- getUrlRender
 
-        req' <- parseUrl "https://accounts.google.com/o/oauth2/token" -- FIXME don't hardcode, use: https://accounts.google.com/.well-known/openid-configuration
+        req' <- liftIO $ parseUrl "https://accounts.google.com/o/oauth2/token" -- FIXME don't hardcode, use: https://accounts.google.com/.well-known/openid-configuration
         let req =
                 urlEncodedBody
                     [ ("code", encodeUtf8 code)
@@ -152,7 +158,7 @@ authGoogleEmail clientID clientSecret =
 
         unless (tokenType == "Bearer") $ error $ "Unknown token type: " ++ show tokenType
 
-        req2' <- parseUrl "https://www.googleapis.com/plus/v1/people/me"
+        req2' <- liftIO $ parseUrl "https://www.googleapis.com/plus/v1/people/me"
         let req2 = req2'
                 { requestHeaders =
                     [ ("Authorization", encodeUtf8 $ "Bearer " `mappend` accessToken)

yesod-auth/yesod-auth.cabal

@@ -1,5 +1,5 @@
 name:            yesod-auth
-version:         1.3.1
+version:         1.3.1.1
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman, Patrick Brisbin

yesod-bin/Devel.hs

@@ -266,7 +266,7 @@ devel opts passThroughArgs = withSocketsDo $ withManager $ \manager -> do
                    unless (anyTouched || haskellFileChanged) $ loop list1
            if not success
              then liftIO $ do
-                   putStrLn "Build failure, pausing..."
+                   putStrLn "\x1b[1;31mBuild failure, pausing...\x1b[0m"
                    runBuildHook $ failHook opts
              else do
                    liftIO $ runBuildHook $ successHook opts

yesod-bin/Keter.hs

@@ -7,7 +7,7 @@ import Data.Yaml
 import qualified Data.HashMap.Strict as Map
 import qualified Data.Text as T
 import System.Exit
-import System.Cmd
+import System.Process
 import Control.Monad
 import System.Directory
 import Data.Maybe (mapMaybe)

yesod-bin/Scaffolding/Scaffolder.hs

@@ -73,7 +73,6 @@ scaffold isBare = do
         if validPackageName s && s /= "test"
             then Just s
             else Nothing
-    let dir = project
 
     puts $ renderTextUrl undefined $(textFile "input/database.cg")
 

yesod-bin/hsfiles/mongo.hsfiles

@@ -1,5 +1,12 @@
+{-# START_FILE .dir-locals.el #-}
+((haskell-mode . ((haskell-indent-spaces . 4)
+                  (haskell-process-use-ghci . t)))
+ (hamlet-mode . ((hamlet/basic-offset . 4)
+                 (haskell-process-use-ghci . t))))
+
 {-# START_FILE .ghci #-}
 :set -i.:config:dist/build/autogen
+:set -DDEVELOPMENT
 :set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable
 
 {-# START_FILE .gitignore #-}
@@ -204,6 +211,13 @@ instance Yesod App where
     -- The page to be redirected to when authentication is required.
     authRoute _ = Just $ AuthR LoginR
 
+    -- Routes not requiring authenitcation.
+    isAuthorized (AuthR _) _ = return Authorized
+    isAuthorized FaviconR _ = return Authorized
+    isAuthorized RobotsR _ = return Authorized
+    -- Default to Authorized for now.
+    isAuthorized _ _ = return Authorized
+
     -- 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
@@ -351,6 +365,7 @@ import Database.Persist.Quasi
 import Database.Persist.MongoDB hiding (master)
 import Language.Haskell.TH.Syntax
 import Data.Typeable (Typeable)
+import Prelude
 
 -- You can define all of your database entities in the entities file.
 -- You can find more information on persistent and how to declare entities
@@ -594,6 +609,75 @@ combineStylesheets = combineStylesheets' development combineSettings
 combineScripts :: Name -> [Route Static] -> Q Exp
 combineScripts = combineScripts' development combineSettings
 
+{-# START_FILE app/DevelMain.hs #-}
+-- | Development version to be run inside GHCi.
+--
+-- start this up with:
+--
+-- cabal repl --ghc-options="-O0 -fobject-code"
+--
+-- run with:
+--
+-- :l DevelMain
+-- DevelMain.update
+--
+-- You will need to add these packages to your .cabal file
+-- * foreign-store >= 0.1 (very light-weight)
+-- * warp (you already depend on this, it just isn't in your .cabal file)
+--
+-- If you don't use cabal repl, you will need
+-- to add settings to your .ghci file.
+--
+-- :set -DDEVELOPMENT
+--
+-- There is more information about using ghci
+-- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci
+
+module DevelMain where
+
+import Application (getApplicationDev)
+
+import Control.Exception (finally)
+import Control.Concurrent
+import Data.IORef
+import Foreign.Store
+import Network.Wai.Handler.Warp
+
+-- | Start or restart the server.
+-- A Store holds onto some data across ghci reloads
+update :: IO ()
+update = do
+    mtidStore <- lookupStore tidStoreNum
+    case mtidStore of
+      -- no server running
+      Nothing -> do
+          done <- storeAction doneStore newEmptyMVar
+          tid <- start done
+          _ <- storeAction (Store tidStoreNum) (newIORef tid)
+          return ()
+      -- server is already running
+      Just tidStore ->
+          -- shut the server down with killThread and wait for the done signal
+          modifyStoredIORef tidStore $ \tid -> do
+              killThread tid
+              withStore doneStore takeMVar >> readStore doneStore >>= start
+  where
+    doneStore = Store 0
+    tidStoreNum = 1
+
+    modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO ()
+    modifyStoredIORef store f = withStore store $ \ref -> do
+        v <- readIORef ref
+        f v >>= writeIORef ref
+
+-- | Start the server in a separate thread.
+start :: MVar () -- ^ Written to when the thread is killed.
+      -> IO ThreadId
+start done = do
+    (port,app) <- getApplicationDev
+    forkIO (finally (runSettings (setPort port defaultSettings) app)
+                    (putMVar done ()))
+
 {-# START_FILE app/main.hs #-}
 import Prelude              (IO)
 import Yesod.Default.Config (fromArgs)

yesod-bin/hsfiles/mysql.hsfiles

@@ -1,5 +1,12 @@
+{-# START_FILE .dir-locals.el #-}
+((haskell-mode . ((haskell-indent-spaces . 4)
+                  (haskell-process-use-ghci . t)))
+ (hamlet-mode . ((hamlet/basic-offset . 4)
+                 (haskell-process-use-ghci . t))))
+
 {-# START_FILE .ghci #-}
 :set -i.:config:dist/build/autogen
+:set -DDEVELOPMENT
 :set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable
 
 {-# START_FILE .gitignore #-}
@@ -211,6 +218,13 @@ instance Yesod App where
     -- The page to be redirected to when authentication is required.
     authRoute _ = Just $ AuthR LoginR
 
+    -- Routes not requiring authenitcation.
+    isAuthorized (AuthR _) _ = return Authorized
+    isAuthorized FaviconR _ = return Authorized
+    isAuthorized RobotsR _ = return Authorized
+    -- Default to Authorized for now.
+    isAuthorized _ _ = return Authorized
+
     -- 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
@@ -358,6 +372,7 @@ import Yesod
 import Data.Text (Text)
 import Database.Persist.Quasi
 import Data.Typeable (Typeable)
+import Prelude
 
 -- You can define all of your database entities in the entities file.
 -- You can find more information on persistent and how to declare entities
@@ -598,6 +613,75 @@ combineStylesheets = combineStylesheets' development combineSettings
 combineScripts :: Name -> [Route Static] -> Q Exp
 combineScripts = combineScripts' development combineSettings
 
+{-# START_FILE app/DevelMain.hs #-}
+-- | Development version to be run inside GHCi.
+--
+-- start this up with:
+--
+-- cabal repl --ghc-options="-O0 -fobject-code"
+--
+-- run with:
+--
+-- :l DevelMain
+-- DevelMain.update
+--
+-- You will need to add these packages to your .cabal file
+-- * foreign-store >= 0.1 (very light-weight)
+-- * warp (you already depend on this, it just isn't in your .cabal file)
+--
+-- If you don't use cabal repl, you will need
+-- to add settings to your .ghci file.
+--
+-- :set -DDEVELOPMENT
+--
+-- There is more information about using ghci
+-- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci
+
+module DevelMain where
+
+import Application (getApplicationDev)
+
+import Control.Exception (finally)
+import Control.Concurrent
+import Data.IORef
+import Foreign.Store
+import Network.Wai.Handler.Warp
+
+-- | Start or restart the server.
+-- A Store holds onto some data across ghci reloads
+update :: IO ()
+update = do
+    mtidStore <- lookupStore tidStoreNum
+    case mtidStore of
+      -- no server running
+      Nothing -> do
+          done <- storeAction doneStore newEmptyMVar
+          tid <- start done
+          _ <- storeAction (Store tidStoreNum) (newIORef tid)
+          return ()
+      -- server is already running
+      Just tidStore ->
+          -- shut the server down with killThread and wait for the done signal
+          modifyStoredIORef tidStore $ \tid -> do
+              killThread tid
+              withStore doneStore takeMVar >> readStore doneStore >>= start
+  where
+    doneStore = Store 0
+    tidStoreNum = 1
+
+    modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO ()
+    modifyStoredIORef store f = withStore store $ \ref -> do
+        v <- readIORef ref
+        f v >>= writeIORef ref
+
+-- | Start the server in a separate thread.
+start :: MVar () -- ^ Written to when the thread is killed.
+      -> IO ThreadId
+start done = do
+    (port,app) <- getApplicationDev
+    forkIO (finally (runSettings (setPort port defaultSettings) app)
+                    (putMVar done ()))
+
 {-# START_FILE app/main.hs #-}
 import Prelude              (IO)
 import Yesod.Default.Config (fromArgs)

yesod-bin/hsfiles/postgres-fay.hsfiles

@@ -1,5 +1,12 @@
+{-# START_FILE .dir-locals.el #-}
+((haskell-mode . ((haskell-indent-spaces . 4)
+                  (haskell-process-use-ghci . t)))
+ (hamlet-mode . ((hamlet/basic-offset . 4)
+                 (haskell-process-use-ghci . t))))
+
 {-# START_FILE .ghci #-}
 :set -i.:config:dist/build/autogen
+:set -DDEVELOPMENT
 :set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable
 
 {-# START_FILE .gitignore #-}
@@ -215,6 +222,13 @@ instance Yesod App where
     -- The page to be redirected to when authentication is required.
     authRoute _ = Just $ AuthR LoginR
 
+    -- Routes not requiring authenitcation.
+    isAuthorized (AuthR _) _ = return Authorized
+    isAuthorized FaviconR _ = return Authorized
+    isAuthorized RobotsR _ = return Authorized
+    -- Default to Authorized for now.
+    isAuthorized _ _ = return Authorized
+
     -- 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
@@ -390,6 +404,7 @@ import Yesod
 import Data.Text (Text)
 import Database.Persist.Quasi
 import Data.Typeable (Typeable)
+import Prelude
 
 -- You can define all of your database entities in the entities file.
 -- You can find more information on persistent and how to declare entities
@@ -647,6 +662,75 @@ combineStylesheets = combineStylesheets' development combineSettings
 combineScripts :: Name -> [Route Static] -> Q Exp
 combineScripts = combineScripts' development combineSettings
 
+{-# START_FILE app/DevelMain.hs #-}
+-- | Development version to be run inside GHCi.
+--
+-- start this up with:
+--
+-- cabal repl --ghc-options="-O0 -fobject-code"
+--
+-- run with:
+--
+-- :l DevelMain
+-- DevelMain.update
+--
+-- You will need to add these packages to your .cabal file
+-- * foreign-store >= 0.1 (very light-weight)
+-- * warp (you already depend on this, it just isn't in your .cabal file)
+--
+-- If you don't use cabal repl, you will need
+-- to add settings to your .ghci file.
+--
+-- :set -DDEVELOPMENT
+--
+-- There is more information about using ghci
+-- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci
+
+module DevelMain where
+
+import Application (getApplicationDev)
+
+import Control.Exception (finally)
+import Control.Concurrent
+import Data.IORef
+import Foreign.Store
+import Network.Wai.Handler.Warp
+
+-- | Start or restart the server.
+-- A Store holds onto some data across ghci reloads
+update :: IO ()
+update = do
+    mtidStore <- lookupStore tidStoreNum
+    case mtidStore of
+      -- no server running
+      Nothing -> do
+          done <- storeAction doneStore newEmptyMVar
+          tid <- start done
+          _ <- storeAction (Store tidStoreNum) (newIORef tid)
+          return ()
+      -- server is already running
+      Just tidStore ->
+          -- shut the server down with killThread and wait for the done signal
+          modifyStoredIORef tidStore $ \tid -> do
+              killThread tid
+              withStore doneStore takeMVar >> readStore doneStore >>= start
+  where
+    doneStore = Store 0
+    tidStoreNum = 1
+
+    modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO ()
+    modifyStoredIORef store f = withStore store $ \ref -> do
+        v <- readIORef ref
+        f v >>= writeIORef ref
+
+-- | Start the server in a separate thread.
+start :: MVar () -- ^ Written to when the thread is killed.
+      -> IO ThreadId
+start done = do
+    (port,app) <- getApplicationDev
+    forkIO (finally (runSettings (setPort port defaultSettings) app)
+                    (putMVar done ()))
+
 {-# START_FILE app/main.hs #-}
 import Prelude              (IO)
 import Yesod.Default.Config (fromArgs)

yesod-bin/hsfiles/postgres.hsfiles

@@ -1,5 +1,12 @@
+{-# START_FILE .dir-locals.el #-}
+((haskell-mode . ((haskell-indent-spaces . 4)
+                  (haskell-process-use-ghci . t)))
+ (hamlet-mode . ((hamlet/basic-offset . 4)
+                 (haskell-process-use-ghci . t))))
+
 {-# START_FILE .ghci #-}
 :set -i.:config:dist/build/autogen
+:set -DDEVELOPMENT
 :set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable
 
 {-# START_FILE .gitignore #-}
@@ -211,6 +218,13 @@ instance Yesod App where
     -- The page to be redirected to when authentication is required.
     authRoute _ = Just $ AuthR LoginR
 
+    -- Routes not requiring authenitcation.
+    isAuthorized (AuthR _) _ = return Authorized
+    isAuthorized FaviconR _ = return Authorized
+    isAuthorized RobotsR _ = return Authorized
+    -- Default to Authorized for now.
+    isAuthorized _ _ = return Authorized
+
     -- 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
@@ -358,6 +372,7 @@ import Yesod
 import Data.Text (Text)
 import Database.Persist.Quasi
 import Data.Typeable (Typeable)
+import Prelude
 
 -- You can define all of your database entities in the entities file.
 -- You can find more information on persistent and how to declare entities
@@ -598,6 +613,75 @@ combineStylesheets = combineStylesheets' development combineSettings
 combineScripts :: Name -> [Route Static] -> Q Exp
 combineScripts = combineScripts' development combineSettings
 
+{-# START_FILE app/DevelMain.hs #-}
+-- | Development version to be run inside GHCi.
+--
+-- start this up with:
+--
+-- cabal repl --ghc-options="-O0 -fobject-code"
+--
+-- run with:
+--
+-- :l DevelMain
+-- DevelMain.update
+--
+-- You will need to add these packages to your .cabal file
+-- * foreign-store >= 0.1 (very light-weight)
+-- * warp (you already depend on this, it just isn't in your .cabal file)
+--
+-- If you don't use cabal repl, you will need
+-- to add settings to your .ghci file.
+--
+-- :set -DDEVELOPMENT
+--
+-- There is more information about using ghci
+-- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci
+
+module DevelMain where
+
+import Application (getApplicationDev)
+
+import Control.Exception (finally)
+import Control.Concurrent
+import Data.IORef
+import Foreign.Store
+import Network.Wai.Handler.Warp
+
+-- | Start or restart the server.
+-- A Store holds onto some data across ghci reloads
+update :: IO ()
+update = do
+    mtidStore <- lookupStore tidStoreNum
+    case mtidStore of
+      -- no server running
+      Nothing -> do
+          done <- storeAction doneStore newEmptyMVar
+          tid <- start done
+          _ <- storeAction (Store tidStoreNum) (newIORef tid)
+          return ()
+      -- server is already running
+      Just tidStore ->
+          -- shut the server down with killThread and wait for the done signal
+          modifyStoredIORef tidStore $ \tid -> do
+              killThread tid
+              withStore doneStore takeMVar >> readStore doneStore >>= start
+  where
+    doneStore = Store 0
+    tidStoreNum = 1
+
+    modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO ()
+    modifyStoredIORef store f = withStore store $ \ref -> do
+        v <- readIORef ref
+        f v >>= writeIORef ref
+
+-- | Start the server in a separate thread.
+start :: MVar () -- ^ Written to when the thread is killed.
+      -> IO ThreadId
+start done = do
+    (port,app) <- getApplicationDev
+    forkIO (finally (runSettings (setPort port defaultSettings) app)
+                    (putMVar done ()))
+
 {-# START_FILE app/main.hs #-}
 import Prelude              (IO)
 import Yesod.Default.Config (fromArgs)

yesod-bin/hsfiles/simple.hsfiles

@@ -1,5 +1,12 @@
+{-# START_FILE .dir-locals.el #-}
+((haskell-mode . ((haskell-indent-spaces . 4)
+                  (haskell-process-use-ghci . t)))
+ (hamlet-mode . ((hamlet/basic-offset . 4)
+                 (haskell-process-use-ghci . t))))
+
 {-# START_FILE .ghci #-}
 :set -i.:config:dist/build/autogen
+:set -DDEVELOPMENT
 :set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable
 
 {-# START_FILE .gitignore #-}
@@ -189,6 +196,13 @@ instance Yesod App where
         Just $ uncurry (joinPath y (Settings.staticRoot $ settings y)) $ renderRoute s
     urlRenderOverride _ _ = Nothing
 
+    -- Routes not requiring authenitcation.
+    isAuthorized (AuthR _) _ = return Authorized
+    isAuthorized FaviconR _ = return Authorized
+    isAuthorized RobotsR _ = return Authorized
+    -- Default to Authorized for now.
+    isAuthorized _ _ = return Authorized
+
     -- 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
@@ -517,6 +531,75 @@ combineStylesheets = combineStylesheets' development combineSettings
 combineScripts :: Name -> [Route Static] -> Q Exp
 combineScripts = combineScripts' development combineSettings
 
+{-# START_FILE app/DevelMain.hs #-}
+-- | Development version to be run inside GHCi.
+--
+-- start this up with:
+--
+-- cabal repl --ghc-options="-O0 -fobject-code"
+--
+-- run with:
+--
+-- :l DevelMain
+-- DevelMain.update
+--
+-- You will need to add these packages to your .cabal file
+-- * foreign-store >= 0.1 (very light-weight)
+-- * warp (you already depend on this, it just isn't in your .cabal file)
+--
+-- If you don't use cabal repl, you will need
+-- to add settings to your .ghci file.
+--
+-- :set -DDEVELOPMENT
+--
+-- There is more information about using ghci
+-- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci
+
+module DevelMain where
+
+import Application (getApplicationDev)
+
+import Control.Exception (finally)
+import Control.Concurrent
+import Data.IORef
+import Foreign.Store
+import Network.Wai.Handler.Warp
+
+-- | Start or restart the server.
+-- A Store holds onto some data across ghci reloads
+update :: IO ()
+update = do
+    mtidStore <- lookupStore tidStoreNum
+    case mtidStore of
+      -- no server running
+      Nothing -> do
+          done <- storeAction doneStore newEmptyMVar
+          tid <- start done
+          _ <- storeAction (Store tidStoreNum) (newIORef tid)
+          return ()
+      -- server is already running
+      Just tidStore ->
+          -- shut the server down with killThread and wait for the done signal
+          modifyStoredIORef tidStore $ \tid -> do
+              killThread tid
+              withStore doneStore takeMVar >> readStore doneStore >>= start
+  where
+    doneStore = Store 0
+    tidStoreNum = 1
+
+    modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO ()
+    modifyStoredIORef store f = withStore store $ \ref -> do
+        v <- readIORef ref
+        f v >>= writeIORef ref
+
+-- | Start the server in a separate thread.
+start :: MVar () -- ^ Written to when the thread is killed.
+      -> IO ThreadId
+start done = do
+    (port,app) <- getApplicationDev
+    forkIO (finally (runSettings (setPort port defaultSettings) app)
+                    (putMVar done ()))
+
 {-# START_FILE app/main.hs #-}
 import Prelude              (IO)
 import Yesod.Default.Config (fromArgs)

yesod-bin/hsfiles/sqlite.hsfiles

@@ -1,5 +1,12 @@
+{-# START_FILE .dir-locals.el #-}
+((haskell-mode . ((haskell-indent-spaces . 4)
+                  (haskell-process-use-ghci . t)))
+ (hamlet-mode . ((hamlet/basic-offset . 4)
+                 (haskell-process-use-ghci . t))))
+
 {-# START_FILE .ghci #-}
 :set -i.:config:dist/build/autogen
+:set -DDEVELOPMENT
 :set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls -XDeriveDataTypeable
 
 {-# START_FILE .gitignore #-}
@@ -211,6 +218,13 @@ instance Yesod App where
     -- The page to be redirected to when authentication is required.
     authRoute _ = Just $ AuthR LoginR
 
+    -- Routes not requiring authenitcation.
+    isAuthorized (AuthR _) _ = return Authorized
+    isAuthorized FaviconR _ = return Authorized
+    isAuthorized RobotsR _ = return Authorized
+    -- Default to Authorized for now.
+    isAuthorized _ _ = return Authorized
+
     -- 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
@@ -358,6 +372,7 @@ import Yesod
 import Data.Text (Text)
 import Database.Persist.Quasi
 import Data.Typeable (Typeable)
+import Prelude
 
 -- You can define all of your database entities in the entities file.
 -- You can find more information on persistent and how to declare entities
@@ -598,6 +613,75 @@ combineStylesheets = combineStylesheets' development combineSettings
 combineScripts :: Name -> [Route Static] -> Q Exp
 combineScripts = combineScripts' development combineSettings
 
+{-# START_FILE app/DevelMain.hs #-}
+-- | Development version to be run inside GHCi.
+--
+-- start this up with:
+--
+-- cabal repl --ghc-options="-O0 -fobject-code"
+--
+-- run with:
+--
+-- :l DevelMain
+-- DevelMain.update
+--
+-- You will need to add these packages to your .cabal file
+-- * foreign-store >= 0.1 (very light-weight)
+-- * warp (you already depend on this, it just isn't in your .cabal file)
+--
+-- If you don't use cabal repl, you will need
+-- to add settings to your .ghci file.
+--
+-- :set -DDEVELOPMENT
+--
+-- There is more information about using ghci
+-- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci
+
+module DevelMain where
+
+import Application (getApplicationDev)
+
+import Control.Exception (finally)
+import Control.Concurrent
+import Data.IORef
+import Foreign.Store
+import Network.Wai.Handler.Warp
+
+-- | Start or restart the server.
+-- A Store holds onto some data across ghci reloads
+update :: IO ()
+update = do
+    mtidStore <- lookupStore tidStoreNum
+    case mtidStore of
+      -- no server running
+      Nothing -> do
+          done <- storeAction doneStore newEmptyMVar
+          tid <- start done
+          _ <- storeAction (Store tidStoreNum) (newIORef tid)
+          return ()
+      -- server is already running
+      Just tidStore ->
+          -- shut the server down with killThread and wait for the done signal
+          modifyStoredIORef tidStore $ \tid -> do
+              killThread tid
+              withStore doneStore takeMVar >> readStore doneStore >>= start
+  where
+    doneStore = Store 0
+    tidStoreNum = 1
+
+    modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO ()
+    modifyStoredIORef store f = withStore store $ \ref -> do
+        v <- readIORef ref
+        f v >>= writeIORef ref
+
+-- | Start the server in a separate thread.
+start :: MVar () -- ^ Written to when the thread is killed.
+      -> IO ThreadId
+start done = do
+    (port,app) <- getApplicationDev
+    forkIO (finally (runSettings (setPort port defaultSettings) app)
+                    (putMVar done ()))
+
 {-# START_FILE app/main.hs #-}
 import Prelude              (IO)
 import Yesod.Default.Config (fromArgs)

yesod-bin/yesod-bin.cabal

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

yesod-core/README

@@ -1 +1 @@
-Learn more at http://docs.yesodweb.com/
+Learn more at http://www.yesodweb.com/

yesod-core/Yesod/Core/Handler.hs

@@ -1018,8 +1018,8 @@ lookupCookies pn = do
 -- representations, e.g.:
 --
 -- > selectRep $ do
--- >   provideRep typeHtml $ produceHtmlOutput
+-- >   provideRep produceHtmlOutput
--- >   provideRep typeJson $ produceJsonOutput
+-- >   provideRep produceJsonOutput
 --
 -- The first provided representation will be used if no matches are found.
 

yesod-form/Yesod/Form/Fields.hs

@@ -237,7 +237,7 @@ $newline never
     }
 
 readMay :: Read a => String -> Maybe a
-readMay s = case reads s of
+readMay s = case filter (Prelude.null . snd) $ reads s of
                 (x, _):_ -> Just x
                 [] -> Nothing
 

yesod-form/Yesod/Form/Functions.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -23,6 +24,7 @@ module Yesod.Form.Functions
     , runFormGet
       -- * Generate a blank form
     , generateFormPost
+    , generateFormGet'
     , generateFormGet
       -- * More than one form on a handler
     , identifyForm
@@ -270,6 +272,17 @@ runFormGet form = do
                 Just _ -> Just (Map.unionsWith (++) $ map (\(x, y) -> Map.singleton x [y]) gets, Map.empty)
     getHelper form env
 
+{- FIXME: generateFormGet' "Will be renamed to generateFormGet in next verison of Yesod" -}
+-- |
+--
+-- Since 1.3.11
+generateFormGet'
+    :: (RenderMessage (HandlerSite m) FormMessage, MonadHandler m)
+    => (Html -> MForm m (FormResult a, xml))
+    -> m (xml, Enctype)
+generateFormGet' form = first snd `liftM` getHelper form Nothing
+
+{-# DEPRECATED generateFormGet "Will require RenderMessage in next verison of Yesod" #-}
 generateFormGet :: MonadHandler m
                 => (Html -> MForm m a)
                 -> m (a, Enctype)
@@ -345,15 +358,21 @@ type FormRender m a =
     -> MForm m (FormResult a, WidgetT (HandlerSite m) IO ())
 
 renderTable, renderDivs, renderDivsNoLabels :: Monad m => FormRender m a
+-- | Render a form into a series of tr tags. Note that, in order to allow
+-- you to add extra rows to the table, this function does /not/ wrap up
+-- the resulting HTML in a table tag; you must do that yourself.
 renderTable aform fragment = do
     (res, views') <- aFormToForm aform
     let views = views' []
     let widget = [whamlet|
 $newline never
-\#{fragment}
+$if null views
-$forall view <- views
+    \#{fragment}
+$forall (isFirst, view) <- addIsFirst views
     <tr :fvRequired view:.required :not $ fvRequired view:.optional>
         <td>
+            $if isFirst
+                \#{fragment}
             <label for=#{fvId view}>#{fvLabel view}
             $maybe tt <- fvTooltip view
                 <div .tooltip>#{tt}
@@ -362,6 +381,9 @@ $forall view <- views
             <td .errors>#{err}
 |]
     return (res, widget)
+  where
+    addIsFirst [] = []
+    addIsFirst (x:y) = (True, x) : map (False, ) y
 
 -- | render a field inside a div
 renderDivs = renderDivsMaybeLabels True

yesod-form/yesod-form.cabal

@@ -1,5 +1,5 @@
 name:            yesod-form
-version:         1.3.10
+version:         1.3.11
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>

yesod-newsfeed/Yesod/AtomFeed.hs

@@ -20,6 +20,7 @@
 -- | Generation of Atom newsfeeds.
 module Yesod.AtomFeed
     ( atomFeed
+    , atomFeedText
     , atomLink
     , RepAtom (..)
     , module Yesod.FeedTypes
@@ -47,6 +48,11 @@ atomFeed feed = do
     render <- getUrlRender
     return $ RepAtom $ toContent $ renderLBS def $ template feed render
 
+-- | Same as @'atomFeed'@ but for @'Feed Text'@. Useful for cases where you are
+--   generating a feed of external links.
+atomFeedText :: MonadHandler m => Feed Text -> m RepAtom
+atomFeedText feed = return $ RepAtom $ toContent $ renderLBS def $ template feed id
+
 template :: Feed url -> (url -> Text) -> Document
 template Feed {..} render =
     Document (Prologue [] Nothing []) (addNS root) []

yesod-newsfeed/Yesod/Feed.hs

@@ -17,6 +17,7 @@
 -------------------------------------------------------------------------------
 module Yesod.Feed
     ( newsFeed
+    , newsFeedText
     , module Yesod.FeedTypes
     ) where
 
@@ -25,7 +26,16 @@ import Yesod.AtomFeed
 import Yesod.RssFeed
 import Yesod.Core
 
+import Data.Text
+
 newsFeed :: MonadHandler m => Feed (Route (HandlerSite m)) -> m TypedContent
 newsFeed f = selectRep $ do
     provideRep $ atomFeed f
     provideRep $ rssFeed f
+
+-- | Same as @'newsFeed'@ but for @'Feed Text'@. Useful for cases where you are
+--   generating a feed of external links.
+newsFeedText :: MonadHandler m => Feed Text -> m TypedContent
+newsFeedText f = selectRep $ do
+    provideRep $ atomFeedText f
+    provideRep $ rssFeedText f

yesod-newsfeed/Yesod/RssFeed.hs

@@ -16,6 +16,7 @@
 -------------------------------------------------------------------------------
 module Yesod.RssFeed
     ( rssFeed
+    , rssFeedText
     , rssLink
     , RepRss (..)
     , module Yesod.FeedTypes
@@ -44,6 +45,11 @@ rssFeed feed = do
     render <- getUrlRender
     return $ RepRss $ toContent $ renderLBS def $ template feed render
 
+-- | Same as @'rssFeed'@ but for @'Feed Text'@. Useful for cases where you are
+--   generating a feed of external links.
+rssFeedText :: MonadHandler m => Feed Text -> m RepRss
+rssFeedText feed = return $ RepRss $ toContent $ renderLBS def $ template feed id
+
 template :: Feed url -> (url -> Text) -> Document
 template Feed {..} render =
     Document (Prologue [] Nothing []) root []

yesod-routes/Yesod/Routes/Parse.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE PatternGuards #-}
 {-# OPTIONS_GHC -fno-warn-missing-fields #-} -- QuasiQuoter
 module Yesod.Routes.Parse
     ( parseRoutes
@@ -18,6 +19,8 @@ import qualified System.IO as SIO
 import Yesod.Routes.TH
 import Yesod.Routes.Overlap (findOverlapNames)
 import Data.List (foldl')
+import Data.Maybe (mapMaybe)
+import qualified Data.Set as Set
 
 -- | A quasi-quoter to parse a string into a list of 'Resource's. Checks for
 -- overlapping routes, failing if present; use 'parseRoutesNoCheck' to skip the
@@ -67,14 +70,30 @@ resourcesFromString =
         | length spaces < indent = ([], thisLine : otherLines)
         | otherwise = (this others, remainder)
       where
+        parseAttr ('!':x) = Just x
+        parseAttr _ = Nothing
+
+        stripColonLast =
+            go id
+          where
+            go _ [] = Nothing
+            go front [x]
+                | null x = Nothing
+                | last x == ':' = Just $ front [init x]
+                | otherwise = Nothing
+            go front (x:xs) = go (front . (x:)) xs
+
         spaces = takeWhile (== ' ') thisLine
         (others, remainder) = parse indent otherLines'
         (this, otherLines') =
             case takeWhile (/= "--") $ words thisLine of
-                [pattern, constr] | last constr == ':' ->
+                (pattern:rest0)
+                    | Just (constr:rest) <- stripColonLast rest0
+                    , Just attrs <- mapM parseAttr rest ->
                     let (children, otherLines'') = parse (length spaces + 1) otherLines
+                        children' = addAttrs attrs children
                         (pieces, Nothing, check) = piecesFromStringCheck pattern
-                     in ((ResourceParent (init constr) check pieces children :), otherLines'')
+                     in ((ResourceParent constr check pieces children' :), otherLines'')
                 (pattern:constr:rest) ->
                     let (pieces, mmulti, check) = piecesFromStringCheck pattern
                         (attrs, rest') = takeAttrs rest
@@ -96,6 +115,28 @@ piecesFromStringCheck s0 =
     stripBang ('!':rest) = (rest, False)
     stripBang x = (x, True)
 
+addAttrs :: [String] -> [ResourceTree String] -> [ResourceTree String]
+addAttrs attrs =
+    map goTree
+  where
+    goTree (ResourceLeaf res) = ResourceLeaf (goRes res)
+    goTree (ResourceParent w x y z) = ResourceParent w x y (map goTree z)
+
+    goRes res =
+        res { resourceAttrs = noDupes ++ resourceAttrs res }
+      where
+        usedKeys = Set.fromList $ map fst $ mapMaybe toPair $ resourceAttrs res
+        used attr =
+            case toPair attr of
+                Nothing -> False
+                Just (key, _) -> key `Set.member` usedKeys
+        noDupes = filter (not . used) attrs
+
+    toPair s =
+        case break (== '=') s of
+            (x, '=':y) -> Just (x, y)
+            _ -> Nothing
+
 -- | Take attributes out of the list and put them in the first slot in the
 -- result tuple.
 takeAttrs :: [String] -> ([String], [String])

yesod-routes/test/Hierarchy.hs

@@ -32,6 +32,7 @@ import qualified Data.ByteString.Char8 as S8
 #if SIMPLE_DISPATCH
 import Yesod.Routes.TH.Simple
 #endif
+import qualified Data.Set as Set
 
 class ToText a where
     toText :: a -> Text
@@ -89,9 +90,9 @@ do
     /login       LoginR     GET POST
     /table/#Text TableR     GET
 
-/nest/ NestR:
+/nest/ NestR !NestingAttr:
 
-  /spaces      SpacedR   GET
+  /spaces      SpacedR   GET !NonNested
 
   /nest2 Nest2:
     /           GetPostR  GET POST
@@ -103,8 +104,8 @@ do
     /post       Post3         POST
 --    /#Int       Delete3            DELETE
 
-/afterwards AfterR:
+/afterwards AfterR !parent !key=value1:
-  /             After     GET
+  /             After     GET !child !key=value2
 
 -- /trailing-nest TrailingNestR:
 --  /foo TrailingFooR GET
@@ -112,6 +113,7 @@ do
 |]
 
     rrinst <- mkRenderRouteInstance (ConT ''Hierarchy) $ map (fmap parseType) resources
+    rainst <- mkRouteAttrsInstance (ConT ''Hierarchy) $ map (fmap parseType) resources
     prinst <- mkParseRouteInstance (ConT ''Hierarchy) $ map (fmap parseType) resources
 #if SIMPLE_DISPATCH
     dispatch <- mkSimpleDispatchClause MkDispatchSettings
@@ -135,6 +137,7 @@ do
                 `AppT` ConT ''Hierarchy)
             [FunD (mkName "dispatcher") [dispatch]]
         : prinst
+        : rainst
         : rrinst
 
 getSpacedR :: Handler site String
@@ -208,3 +211,7 @@ hierarchy = describe "hierarchy" $ do
         parseRoute ([], [("foo", "bar")]) @?= Just HomeR
         parseRoute (["admin", "5"], []) @?= Just (AdminR 5 AdminRootR)
         parseRoute (["admin!", "5"], []) @?= (Nothing :: Maybe (Route Hierarchy))
+    it "inherited attributes" $ do
+        routeAttrs (NestR SpacedR) @?= Set.fromList ["NestingAttr", "NonNested"]
+    it "pair attributes" $
+        routeAttrs (AfterR After) @?= Set.fromList ["parent", "child", "key=value2"]

yesod-test/Yesod/Test.hs

@@ -421,10 +421,10 @@ nameFromLabel label = do
       Just res -> return res
   let
     body = simpleBody res
-    mfor = parseHTML body
+    mlabel = parseHTML body
                 $// C.element "label"
                 >=> contentContains label
-                >=> attribute "for"
+    mfor = mlabel >>= attribute "for"
 
     contentContains x c
         | x `T.isInfixOf` T.concat (c $// content) = [c]
@@ -444,8 +444,11 @@ nameFromLabel label = do
             , " which was not found. "
             ]
         name:_ -> return name
-        _ -> failure $ "More than one input with id " <> for
+        [] -> failure $ "No input with id " <> for
-    [] -> failure $ "No label contained: " <> label
+    [] ->
+      case filter (/= "") $ mlabel >>= (child >=> C.element "input" >=> attribute "name") of
+        [] -> failure $ "No label contained: " <> label
+        name:_ -> return name
     _ -> failure $ "More than one label contained " <> label
 
 (<>) :: T.Text -> T.Text -> T.Text

yesod-test/test/main.hs

@@ -132,6 +132,14 @@ main = hspec $ do
                 get ("/dynamic2/שלום" :: Text)
                 statusIs 200
                 bodyEquals "שלום"
+
+        ydescribe "labels" $ do
+            yit "can click checkbox" $ do
+                get ("/labels" :: Text)
+                request $ do
+                    setMethod "POST"
+                    setUrl ("/labels" :: Text)
+                    byLabel "Foo Bar" "yes"
     describe "cookies" $ yesodSpec cookieApp $ do
         yit "should send the cookie #730" $ do
             get ("/" :: Text)
@@ -174,6 +182,9 @@ app = liteApp $ do
     onStatic "html" $ dispatchTo $
         return ("<html><head><title>Hello</title></head><body><p>Hello World</p><p>Hello Moon</p></body></html>" :: Text)
 
+    onStatic "labels" $ dispatchTo $
+        return ("<html><label><input type='checkbox' name='fooname' id='foobar'>Foo Bar</label></html>" :: Text)
+
 
 cookieApp :: LiteApp
 cookieApp = liteApp $ do

yesod-test/yesod-test.cabal

@@ -1,5 +1,5 @@
 name:               yesod-test
-version:            1.2.3
+version:            1.2.3.1
 license:            MIT
 license-file:       LICENSE
 author:             Nubis <nubis@woobiz.com.ar>

yesod-websockets/Yesod/WebSockets.hs

@@ -67,13 +67,13 @@ webSockets inner = do
 receiveData :: (MonadIO m, WS.WebSocketsData a) => WebSocketsT m a
 receiveData = ReaderT $ liftIO . WS.receiveData
 
--- | Send a textual messsage to the client.
+-- | Send a textual message to the client.
 --
 -- Since 0.1.0
 sendTextData :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m ()
 sendTextData x = ReaderT $ liftIO . flip WS.sendTextData x
 
--- | Send a binary messsage to the client.
+-- | Send a binary message to the client.
 --
 -- Since 0.1.0
 sendBinaryData :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m ()

yesod-websockets/yesod-websockets.cabal

@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                yesod-websockets
-version:             0.1.1.1
+version:             0.1.1.2
 synopsis:            WebSockets support for Yesod
 description:         WebSockets support for Yesod
 homepage:            https://github.com/yesodweb/yesod

yesod/Yesod/Default/Config.hs

@@ -23,7 +23,7 @@ import Data.Maybe (fromMaybe)
 import qualified Data.HashMap.Strict as M
 import System.Environment (getArgs, getProgName, getEnvironment)
 import System.Exit (exitFailure)
-import Data.Conduit.Network (HostPreference)
+import Data.Streaming.Network (HostPreference)
 import Data.String (fromString)
 
 -- | A yesod-provided @'AppEnv'@, allows for Development, Testing, and

yesod/yesod.cabal

@@ -1,5 +1,5 @@
 name:            yesod
-version:         1.2.6
+version:         1.2.6.1
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -50,6 +50,7 @@ library
                    , fast-logger
                    , conduit-extra
                    , shakespeare
+                   , streaming-commons
 
     exposed-modules: Yesod
                    , Yesod.Default.Config