Merge pull request #1346 from alx741/email

Allow for a  custom Email login widget

yesod-auth/ChangeLog.md

@@ -3,6 +3,7 @@
 * Add Show instance for user credentials `Creds`
 * Export pid type for identifying plugin
 * Fix warnings
+* Allow for a custom Email Login DOM with `emailLoginHandler`
 
 ## 1.4.16
 

yesod-auth/Yesod/Auth/Email.hs

@@ -106,6 +106,7 @@ module Yesod.Auth.Email
     , loginLinkKey
     , setLoginLinkKey
      -- * Default handlers
+    , defaultEmailLoginHandler
     , defaultRegisterHandler
     , defaultForgotPasswordHandler
     , defaultSetPasswordHandler
@@ -290,6 +291,17 @@ class ( YesodAuth site
     normalizeEmailAddress :: site -> Text -> Text
     normalizeEmailAddress _ = TS.toLower
 
+    -- | Handler called to render the login page.
+    -- The default works fine, but you may want to override it in
+    -- order to have a different DOM.
+    --
+    -- Default: 'defaultEmailLoginHandler'.
+    --
+    -- @since 1.4.17
+    emailLoginHandler :: (Route Auth -> Route site) -> WidgetT site IO ()
+    emailLoginHandler = defaultEmailLoginHandler
+
+
     -- | Handler called to render the registration page.  The
     -- default works fine, but you may want to override it in
     -- order to have a different DOM.
@@ -346,8 +358,11 @@ authEmail =
 getRegisterR :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) Html
 getRegisterR = registerHandler
 
-emailLoginHandler :: YesodAuthEmail master => (Route Auth -> Route master) -> WidgetT master IO ()
+-- | Default implementation of 'emailLoginHandler'.
-emailLoginHandler toParent = do
+--
+-- @since 1.4.17
+defaultEmailLoginHandler :: YesodAuthEmail master => (Route Auth -> Route master) -> WidgetT master IO ()
+defaultEmailLoginHandler toParent = do
         (widget, enctype) <- liftWidgetT $ generateFormPost loginForm
 
         [whamlet|
@@ -402,6 +417,7 @@ emailLoginHandler toParent = do
         langs <- languages
         master <- getYesod
         return $ renderAuthMessage master langs msg
+
 -- | Default implementation of 'registerHandler'.
 --
 -- @since 1.2.6
@@ -518,7 +534,7 @@ defaultForgotPasswordHandler = do
   where
     forgotPasswordForm extra = do
         (emailRes, emailView) <- mreq emailField emailSettings Nothing
-    
+
         let forgotPasswordRes = ForgotPasswordForm <$> emailRes
         let widget = do
             [whamlet|