Merge branch 'master' into yesod-1.4

yesod-auth/Yesod/Auth/GoogleEmail2.hs

@@ -156,7 +156,7 @@ authGoogleEmail clientID clientSecret =
         manager <- liftM authHttpManager $ lift getYesod
         res <- http req manager
         value <- responseBody res $$+- sinkParser json'
-        Tokens accessToken _idToken tokenType <-
+        Tokens accessToken tokenType <-
             case parseEither parseJSON value of
                 Left e -> error e
                 Right t -> return t
@@ -184,11 +184,10 @@ authGoogleEmail clientID clientSecret =
 
     dispatch _ _ = notFound
 
-data Tokens = Tokens Text Text Text
+data Tokens = Tokens Text Text
 instance FromJSON Tokens where
     parseJSON = withObject "Tokens" $ \o -> Tokens
         <$> o .: "access_token"
-        <*> o .: "id_token"
         <*> o .: "token_type"
 
 data Person = Person [Email]

yesod-auth/browserid.hs

@@ -26,7 +26,7 @@ mkYesod "BID" [parseRoutes|
 getRootR :: Handler ()
 getRootR = redirect $ AuthR LoginR
 
-getAfterLoginR :: Handler RepHtml
+getAfterLoginR :: Handler Html
 getAfterLoginR = do
     mauth <- maybeAuthId
     defaultLayout $ toWidget [hamlet|
@@ -41,13 +41,14 @@ instance YesodAuth BID where
     loginDest _ = AfterLoginR
     logoutDest _ = AuthR LoginR
     getAuthId = return . Just . credsIdent
-    authPlugins _ = [authBrowserId]
+    authPlugins _ = [authBrowserId def]
     authHttpManager = httpManager
+    maybeAuthId = lookupSession credsKey
 
 instance RenderMessage BID FormMessage where
     renderMessage _ _ = defaultFormMessage
 
 main :: IO ()
 main = do
-    m <- newManager def
+    m <- newManager conduitManagerSettings
     toWaiApp (BID m) >>= run 3000 . logStdoutDev

yesod-auth/yesod-auth.cabal

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

yesod-bin/hsfiles/mongo.hsfiles

@@ -188,7 +188,7 @@ instance Yesod App where
                 , css_bootstrap_css
                 ])
             $(widgetFile "default-layout")
-        giveUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
+        withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
 
     -- This is done to provide an optimization for serving static files from
     -- a separate domain. Please see the staticRoot setting in Settings.hs
@@ -230,7 +230,7 @@ instance Yesod App where
 
 -- How to run database actions.
 instance YesodPersist App where
-    type YesodPersistBackend App = Action
+    type YesodPersistBackend App = MongoContext
     runDB = defaultRunDB persistConfig connPool
 
 instance YesodAuth App where
@@ -359,9 +359,7 @@ import Prelude
 -- You can find more information on persistent and how to declare entities
 -- at:
 -- http://www.yesodweb.com/book/persistent/
-let mongoSettings = (mkPersistSettings (ConT ''MongoBackend))
+let mongoSettings = (mkPersistSettings (ConT ''MongoContext))
-                        { mpsGeneric = False
-                        }
  in share [mkPersist mongoSettings]
     $(persistFileWith upperCaseSettings "config/models")
 
@@ -411,15 +409,15 @@ library
 
     build-depends: base                          >= 4          && < 5
                  , yesod                         >= 1.2.5      && < 1.3
-                 , yesod-core                    >= 1.2.12     && < 1.3
+                 , yesod-core                    >= 1.2.20     && < 1.3
                  , yesod-auth                    >= 1.3        && < 1.4
                  , yesod-static                  >= 1.2        && < 1.3
                  , yesod-form                    >= 1.3        && < 1.4
                  , bytestring                    >= 0.9        && < 0.11
                  , text                          >= 0.11       && < 2.0
-                 , persistent                    >= 1.3        && < 1.4
+                 , persistent                    >= 2.0        && < 2.1
-                 , persistent-mongoDB            >= 1.3        && < 1.5
+                 , persistent-mongoDB            >= 2.0        && < 2.1
-                 , persistent-template           >= 1.3        && < 1.4
+                 , persistent-template           >= 2.0        && < 2.1
                  , template-haskell
                  , shakespeare                   >= 2.0        && < 2.1
                  , hjsmin                        >= 0.1        && < 0.2

yesod-bin/hsfiles/mysql.hsfiles

@@ -130,7 +130,7 @@ import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager))
 import qualified Settings
 import Settings.Development (development)
 import qualified Database.Persist
-import Database.Persist.Sql (SqlPersistT)
+import Database.Persist.Sql (SqlBackend)
 import Settings.StaticFiles
 import Settings (widgetFile, Extra (..))
 import Model
@@ -195,7 +195,7 @@ instance Yesod App where
                 , css_bootstrap_css
                 ])
             $(widgetFile "default-layout")
-        giveUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
+        withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
 
     -- This is done to provide an optimization for serving static files from
     -- a separate domain. Please see the staticRoot setting in Settings.hs
@@ -237,7 +237,7 @@ instance Yesod App where
 
 -- How to run database actions.
 instance YesodPersist App where
-    type YesodPersistBackend App = SqlPersistT
+    type YesodPersistBackend App = SqlBackend
     runDB = defaultRunDB persistConfig connPool
 instance YesodPersistRunner App where
     getDBRunner = defaultGetDBRunner connPool
@@ -366,7 +366,7 @@ import Prelude
 -- You can find more information on persistent and how to declare entities
 -- at:
 -- http://www.yesodweb.com/book/persistent/
-share [mkPersist sqlOnlySettings, mkMigrate "migrateAll"]
+share [mkPersist sqlSettings, mkMigrate "migrateAll"]
     $(persistFileWith lowerCaseSettings "config/models")
 
 {-# START_FILE PROJECTNAME.cabal #-}
@@ -415,15 +415,15 @@ library
 
     build-depends: base                          >= 4          && < 5
                  , yesod                         >= 1.2.5      && < 1.3
-                 , yesod-core                    >= 1.2.12     && < 1.3
+                 , yesod-core                    >= 1.2.20     && < 1.3
                  , yesod-auth                    >= 1.3        && < 1.4
                  , yesod-static                  >= 1.2        && < 1.3
                  , yesod-form                    >= 1.3        && < 1.4
                  , bytestring                    >= 0.9        && < 0.11
                  , text                          >= 0.11       && < 2.0
-                 , persistent                    >= 1.3        && < 1.4
+                 , persistent                    >= 2.0        && < 2.1
-                 , persistent-mysql              >= 1.3        && < 1.4
+                 , persistent-mysql              >= 2.0        && < 2.1
-                 , persistent-template           >= 1.3        && < 1.4
+                 , persistent-template           >= 2.0        && < 2.1
                  , template-haskell
                  , shakespeare                   >= 2.0        && < 2.1
                  , hjsmin                        >= 0.1        && < 0.2

yesod-bin/hsfiles/postgres-fay.hsfiles

@@ -133,7 +133,7 @@ import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager))
 import qualified Settings
 import Settings.Development (development)
 import qualified Database.Persist
-import Database.Persist.Sql (SqlPersistT)
+import Database.Persist.Sql (SqlBackend)
 import Settings.StaticFiles
 import Settings (widgetFile, Extra (..))
 import Model
@@ -199,7 +199,7 @@ instance Yesod App where
                 , css_bootstrap_css
                 ])
             $(widgetFile "default-layout")
-        giveUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
+        withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
 
     -- This is done to provide an optimization for serving static files from
     -- a separate domain. Please see the staticRoot setting in Settings.hs
@@ -250,7 +250,7 @@ instance YesodFay App where
 
 -- How to run database actions.
 instance YesodPersist App where
-    type YesodPersistBackend App = SqlPersistT
+    type YesodPersistBackend App = SqlBackend
     runDB = defaultRunDB persistConfig connPool
 instance YesodPersistRunner App where
     getDBRunner = defaultGetDBRunner connPool
@@ -398,7 +398,7 @@ import Prelude
 -- You can find more information on persistent and how to declare entities
 -- at:
 -- http://www.yesodweb.com/book/persistent/
-share [mkPersist sqlOnlySettings, mkMigrate "migrateAll"]
+share [mkPersist sqlSettings, mkMigrate "migrateAll"]
     $(persistFileWith lowerCaseSettings "config/models")
 
 {-# START_FILE PROJECTNAME.cabal #-}
@@ -451,7 +451,7 @@ library
 
     build-depends: base                          >= 4          && < 5
                  , yesod                         >= 1.2.5      && < 1.3
-                 , yesod-core                    >= 1.2.12     && < 1.3
+                 , yesod-core                    >= 1.2.20     && < 1.3
                  , yesod-auth                    >= 1.3        && < 1.4
                  , yesod-static                  >= 1.2        && < 1.3
                  , yesod-form                    >= 1.3        && < 1.4
@@ -459,9 +459,9 @@ library
                  , fay                           >= 0.16
                  , bytestring                    >= 0.9        && < 0.11
                  , text                          >= 0.11       && < 2.0
-                 , persistent                    >= 1.3        && < 1.4
+                 , persistent                    >= 2.0        && < 2.1
-                 , persistent-postgresql         >= 1.3        && < 1.4
+                 , persistent-postgresql         >= 2.0        && < 2.1
-                 , persistent-template           >= 1.3        && < 1.4
+                 , persistent-template           >= 2.0        && < 2.1
                  , template-haskell
                  , shakespeare                   >= 2.0        && < 2.1
                  , monad-control                 >= 0.3        && < 0.4

yesod-bin/hsfiles/postgres.hsfiles

@@ -130,7 +130,7 @@ import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager))
 import qualified Settings
 import Settings.Development (development)
 import qualified Database.Persist
-import Database.Persist.Sql (SqlPersistT)
+import Database.Persist.Sql (SqlBackend)
 import Settings.StaticFiles
 import Settings (widgetFile, Extra (..))
 import Model
@@ -195,7 +195,7 @@ instance Yesod App where
                 , css_bootstrap_css
                 ])
             $(widgetFile "default-layout")
-        giveUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
+        withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
 
     -- This is done to provide an optimization for serving static files from
     -- a separate domain. Please see the staticRoot setting in Settings.hs
@@ -237,7 +237,7 @@ instance Yesod App where
 
 -- How to run database actions.
 instance YesodPersist App where
-    type YesodPersistBackend App = SqlPersistT
+    type YesodPersistBackend App = SqlBackend
     runDB = defaultRunDB persistConfig connPool
 instance YesodPersistRunner App where
     getDBRunner = defaultGetDBRunner connPool
@@ -366,7 +366,7 @@ import Prelude
 -- You can find more information on persistent and how to declare entities
 -- at:
 -- http://www.yesodweb.com/book/persistent/
-share [mkPersist sqlOnlySettings, mkMigrate "migrateAll"]
+share [mkPersist sqlSettings, mkMigrate "migrateAll"]
     $(persistFileWith lowerCaseSettings "config/models")
 
 {-# START_FILE PROJECTNAME.cabal #-}
@@ -415,15 +415,15 @@ library
 
     build-depends: base                          >= 4          && < 5
                  , yesod                         >= 1.2.5      && < 1.3
-                 , yesod-core                    >= 1.2.12     && < 1.3
+                 , yesod-core                    >= 1.2.20     && < 1.3
                  , yesod-auth                    >= 1.3        && < 1.4
                  , yesod-static                  >= 1.2        && < 1.3
                  , yesod-form                    >= 1.3        && < 1.4
                  , bytestring                    >= 0.9        && < 0.11
                  , text                          >= 0.11       && < 2.0
-                 , persistent                    >= 1.3        && < 1.4
+                 , persistent                    >= 2.0        && < 2.1
-                 , persistent-postgresql         >= 1.3        && < 1.4
+                 , persistent-postgresql         >= 2.0        && < 2.1
-                 , persistent-template           >= 1.3        && < 1.4
+                 , persistent-template           >= 2.0        && < 2.1
                  , template-haskell
                  , shakespeare                   >= 2.0        && < 2.1
                  , hjsmin                        >= 0.1        && < 0.2

yesod-bin/hsfiles/simple.hsfiles

@@ -174,7 +174,7 @@ instance Yesod App where
                 , css_bootstrap_css
                 ])
             $(widgetFile "default-layout")
-        giveUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
+        withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
 
     -- This is done to provide an optimization for serving static files from
     -- a separate domain. Please see the staticRoot setting in Settings.hs
@@ -342,7 +342,7 @@ library
 
     build-depends: base                          >= 4          && < 5
                  , yesod                         >= 1.2.5      && < 1.3
-                 , yesod-core                    >= 1.2.12     && < 1.3
+                 , yesod-core                    >= 1.2.20     && < 1.3
                  , yesod-auth                    >= 1.3        && < 1.4
                  , yesod-static                  >= 1.2        && < 1.3
                  , yesod-form                    >= 1.3        && < 1.4

yesod-bin/hsfiles/sqlite.hsfiles

@@ -130,7 +130,7 @@ import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager))
 import qualified Settings
 import Settings.Development (development)
 import qualified Database.Persist
-import Database.Persist.Sql (SqlPersistT)
+import Database.Persist.Sql (SqlBackend)
 import Settings.StaticFiles
 import Settings (widgetFile, Extra (..))
 import Model
@@ -195,7 +195,7 @@ instance Yesod App where
                 , css_bootstrap_css
                 ])
             $(widgetFile "default-layout")
-        giveUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
+        withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
 
     -- This is done to provide an optimization for serving static files from
     -- a separate domain. Please see the staticRoot setting in Settings.hs
@@ -237,7 +237,7 @@ instance Yesod App where
 
 -- How to run database actions.
 instance YesodPersist App where
-    type YesodPersistBackend App = SqlPersistT
+    type YesodPersistBackend App = SqlBackend
     runDB = defaultRunDB persistConfig connPool
 instance YesodPersistRunner App where
     getDBRunner = defaultGetDBRunner connPool
@@ -366,7 +366,7 @@ import Prelude
 -- You can find more information on persistent and how to declare entities
 -- at:
 -- http://www.yesodweb.com/book/persistent/
-share [mkPersist sqlOnlySettings, mkMigrate "migrateAll"]
+share [mkPersist sqlSettings, mkMigrate "migrateAll"]
     $(persistFileWith lowerCaseSettings "config/models")
 
 {-# START_FILE PROJECTNAME.cabal #-}
@@ -415,15 +415,15 @@ library
 
     build-depends: base                          >= 4          && < 5
                  , yesod                         >= 1.2.5      && < 1.3
-                 , yesod-core                    >= 1.2.12     && < 1.3
+                 , yesod-core                    >= 1.2.20     && < 1.3
                  , yesod-auth                    >= 1.3        && < 1.4
                  , yesod-static                  >= 1.2        && < 1.3
                  , yesod-form                    >= 1.3        && < 1.4
                  , bytestring                    >= 0.9        && < 0.11
                  , text                          >= 0.11       && < 2.0
-                 , persistent                    >= 1.3        && < 1.4
+                 , persistent                    >= 2.0        && < 2.1
-                 , persistent-sqlite             >= 1.3        && < 1.4
+                 , persistent-sqlite             >= 2.0        && < 2.1
-                 , persistent-template           >= 1.3        && < 1.4
+                 , persistent-template           >= 2.0        && < 2.1
                  , template-haskell
                  , shakespeare                   >= 2.0        && < 2.1
                  , hjsmin                        >= 0.1        && < 0.2

yesod-bin/yesod-bin.cabal

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

yesod-form/Yesod/Form/Functions.hs

@@ -45,6 +45,7 @@ module Yesod.Form.Functions
     , fieldSettingsLabel
     , parseHelper
     , parseHelperGen
+    , convertField
     ) where
 
 import Yesod.Form.Types
@@ -526,3 +527,29 @@ parseHelperGen :: (Monad m, RenderMessage site msg)
 parseHelperGen _ [] _ = return $ Right Nothing
 parseHelperGen _ ("":_) _ = return $ Right Nothing
 parseHelperGen f (x:_) _ = return $ either (Left . SomeMessage) (Right . Just) $ f x
+
+-- | Since a 'Field' cannot be a 'Functor', it is not obvious how to "reuse" a Field
+-- on a @newtype@ or otherwise equivalent type. This function allows you to convert
+-- a @Field m a@ to a @Field m b@ assuming you provide a bidireccional
+-- convertion among the two, through the first two functions.
+--
+-- A simple example:
+--
+-- > import Data.Monoid
+-- > sumField :: (Functor m, Monad m, RenderMessage (HandlerSite m) FormMessage) => Field m (Sum Int)
+-- > sumField = convertField Sum getSum intField
+--
+-- Another example, not using a newtype, but instead creating a Lazy Text field:
+--
+-- > import qualified Data.Text.Lazy as TL
+-- > TextField :: (Functor m, Monad m, RenderMessage (HandlerSite m) FormMessage) => Field m TL.Text
+-- > lazyTextField = convertField TL.fromStrict TL.toStrict textField
+--
+-- Since 1.3.16
+convertField :: (Functor m)
+             => (a -> b) -> (b -> a)
+             -> Field m a -> Field m b
+convertField to from (Field fParse fView fEnctype) = let
+  fParse' ts = fmap (fmap (fmap to)) . fParse ts
+  fView' ti tn at ei = fView ti tn at (fmap from ei)
+  in Field fParse' fView' fEnctype

yesod-form/yesod-form.cabal

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

yesod-test/Yesod/Test/CssQuery.hs

@@ -9,7 +9,10 @@ module Yesod.Test.CssQuery
 import Prelude hiding (takeWhile)
 import Data.Text (Text)
 import Data.Attoparsec.Text
-import Control.Applicative (many, (<|>), optional)
+import Control.Applicative
+import Data.Char
+
+import qualified Data.Text as T
 
 data SelectorGroup
   = DirectChildren [Selector]
@@ -27,6 +30,13 @@ data Selector
   | ByAttrEnds Text Text
   deriving (Show, Eq)
 
+
+-- The official syntax specification for CSS2 can be found here:
+--      http://www.w3.org/TR/CSS2/syndata.html
+-- but that spec is tricky to fully support. Instead we do the minimal and we
+-- can extend it as needed.
+
+
 -- | Parses a query into an intermediate format which is easy to feed to HXT
 --
 -- * The top-level lists represent the top level comma separated queries.
@@ -41,66 +51,54 @@ parseQuery = parseOnly cssQuery
 
 -- Below this line is the Parsec parser for css queries.
 cssQuery :: Parser [[SelectorGroup]]
-cssQuery = sepBy rules (char ',' >> (optional (char ' ')))
+cssQuery = sepBy rules (char ',' >> optional (char ' '))
 
 rules :: Parser [SelectorGroup]
 rules = many $ directChildren <|> deepChildren
 
 directChildren :: Parser SelectorGroup
-directChildren = do
+directChildren = string "> " >> DirectChildren <$> parseSelectors
-  _ <- char '>'
-  _ <- char ' '
-  sels <- selectors
-  _ <- optional $ char ' '
-  return $ DirectChildren sels
 
 deepChildren :: Parser SelectorGroup
-deepChildren = do 
+deepChildren = DeepChildren <$> parseSelectors
-  sels <- selectors
-  _ <- optional $ char ' '
-  return $ DeepChildren sels
 
-selectors :: Parser [Selector]
+parseSelectors :: Parser [Selector]
-selectors = many1 $ parseId
+parseSelectors = pOptionalTrailingSpace . many1 $
-  <|> parseClass
+    parseId <|> parseClass <|> parseTag <|> parseAttr
-  <|> parseTag
-  <|> parseAttr
 
 parseId :: Parser Selector
-parseId = do
+parseId = char '#' >> ById <$> pIdent
-  _ <- char '#'
-  x <- takeWhile $ flip notElem ",#.[ >"
-  return $ ById x
 
 parseClass :: Parser Selector
-parseClass = do
+parseClass = char '.' >> ByClass <$> pIdent
-  _ <- char '.'
-  x <- takeWhile $ flip notElem ",#.[ >"
-  return $ ByClass x
 
 parseTag :: Parser Selector
-parseTag = do
+parseTag = ByTagName <$> pIdent
-  x <- takeWhile1 $ flip notElem ",#.[ >"
-  return $ ByTagName x
 
 parseAttr :: Parser Selector
-parseAttr = do
+parseAttr = pSquare $ choice
-  _ <- char '['
+    [ ByAttrEquals <$> pIdent <*> (string "=" *> pAttrValue)
-  name <- takeWhile $ flip notElem ",#.=$^*]"
+    , ByAttrContains <$> pIdent <*> (string "*=" *> pAttrValue)
-  (parseAttrExists name)
+    , ByAttrStarts <$> pIdent <*> (string "^=" *> pAttrValue)
-    <|> (parseAttrWith "=" ByAttrEquals name)
+    , ByAttrEnds <$> pIdent <*> (string "$=" *> pAttrValue)
-    <|> (parseAttrWith "*=" ByAttrContains name)
+    , ByAttrExists <$> pIdent
-    <|> (parseAttrWith "^=" ByAttrStarts name)
+    ]
-    <|> (parseAttrWith "$=" ByAttrEnds name)
 
-parseAttrExists :: Text -> Parser Selector
+-- | pIdent : Parse an identifier (not yet supporting escapes and unicode as
-parseAttrExists attrname = do
+-- part of the identifier). Basically the regex: [-]?[_a-zA-Z][_a-zA-Z0-9]*
-  _ <- char ']'
+pIdent :: Parser Text
-  return $ ByAttrExists attrname
+pIdent = pOptionalTrailingSpace $ do
+    leadingMinus <- string "-" <|> pure ""
+    nmstart <- T.singleton <$> satisfy (\c -> isAlpha c || c == '_')
+    nmchar <- takeWhile (\c -> isAlphaNum c || c == '_')
+    return $ T.concat [ leadingMinus, nmstart, nmchar ]
 
-parseAttrWith :: Text -> (Text -> Text -> Selector) -> Text -> Parser Selector
+
-parseAttrWith sign constructor name = do
+pAttrValue :: Parser Text
-  _ <- string sign
+pAttrValue = takeWhile (/= ']')
-  value <- takeWhile $ flip notElem ",#.]"
+
-  _ <- char ']'
+pSquare :: Parser a -> Parser a
-  return $ constructor name value
+pSquare p = char '[' *> p <* char ']'
+
+pOptionalTrailingSpace :: Parser a -> Parser a
+pOptionalTrailingSpace p = p <* optional (char ' ')

yesod-test/yesod-test.cabal

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