diff --git a/Yesod/Dispatch.hs b/Yesod/Dispatch.hs index 2d24502c..1f6c6efa 100644 --- a/Yesod/Dispatch.hs +++ b/Yesod/Dispatch.hs @@ -104,7 +104,7 @@ sessionName = "_SESSION" -- | Convert the given argument into a WAI application, executable with any WAI -- handler. You can use 'basicHandler' if you wish. toWaiApp :: Yesod y => y -> IO W.Application -toWaiApp a = do +toWaiApp a = return $ gzip $ jsonp $ methodOverride @@ -138,10 +138,9 @@ toWaiApp' y resource env = do types = httpAccept env pathSegments = filter (not . null) $ cleanupSegments resource eurl = quasiParse site pathSegments - render u = - case urlRenderOverride y u of - Nothing -> fullRender (approot y) site u - Just s -> s + render u = fromMaybe + (fullRender (approot y) site u) + (urlRenderOverride y u) rr <- parseWaiRequest env session' onRequest y rr let ya = case eurl of diff --git a/Yesod/Hamlet.hs b/Yesod/Hamlet.hs index 0f8adfbe..e5f28bf4 100644 --- a/Yesod/Hamlet.hs +++ b/Yesod/Hamlet.hs @@ -2,7 +2,6 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE QuasiQuotes #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Yesod.Hamlet ( -- * Hamlet library diff --git a/Yesod/Handler.hs b/Yesod/Handler.hs index 58a00038..85485d88 100644 --- a/Yesod/Handler.hs +++ b/Yesod/Handler.hs @@ -70,7 +70,7 @@ import Yesod.Content import Yesod.Internal import Web.Routes.Quasi (Routes) import Data.List (foldl') -import Web.Encodings (encodeUrlPairs) +import Web.Encodings (encodeUrlPairs, encodeHtml) import Control.Exception hiding (Handler, catch) import qualified Control.Exception as E @@ -93,7 +93,6 @@ import qualified Network.Wai as W import Data.Convertible.Text (cs) import Text.Hamlet import Data.Text (Text) -import Web.Encodings (encodeHtml) data HandlerData sub master = HandlerData { handlerRequest :: Request @@ -157,9 +156,9 @@ instance C.MonadCatchIO (GHandler sub master) where catch (Handler m) f = Handler $ \d -> E.catch (m d) (\e -> unHandler (f e) d) block (Handler m) = - Handler $ \d -> E.block (m d) + Handler $ E.block . m unblock (Handler m) = - Handler $ \d -> E.unblock (m d) + Handler $ E.unblock . m instance Failure ErrorResponse (GHandler sub master) where failure e = Handler $ \_ -> return ([], [], HCError e) instance RequestReader (GHandler sub master) where @@ -320,7 +319,7 @@ setMessage = setSession msgKey . cs . htmlContentToText getMessage :: GHandler sub master (Maybe HtmlContent) getMessage = do clearSession msgKey - (fmap $ fmap $ Encoded . cs) $ lookupSession msgKey + fmap (fmap $ Encoded . cs) $ lookupSession msgKey -- | FIXME move this definition into hamlet htmlContentToText :: HtmlContent -> Text diff --git a/Yesod/Helpers/Auth.hs b/Yesod/Helpers/Auth.hs index 1f8a4271..ef11a6ba 100644 --- a/Yesod/Helpers/Auth.hs +++ b/Yesod/Helpers/Auth.hs @@ -238,10 +238,10 @@ handleRpxnowR = do -- | Get some form of a display name. getDisplayName :: [(String, String)] -> Maybe String -getDisplayName extra = helper choices where +getDisplayName extra = + foldr (\x -> mplus (lookup x extra)) Nothing choices + where choices = ["verifiedEmail", "email", "displayName", "preferredUsername"] - helper [] = Nothing - helper (x:xs) = maybe (helper xs) Just $ lookup x extra getCheck :: Yesod master => GHandler Auth master RepHtmlJson getCheck = do @@ -457,7 +457,7 @@ saltPass' salt pass = salt ++ show (md5 $ cs $ salt ++ pass) inMemoryEmailSettings :: IO AuthEmailSettings inMemoryEmailSettings = do mm <- newMVar [] - return $ AuthEmailSettings + return AuthEmailSettings { addUnverified = \email verkey -> modifyMVar mm $ \m -> do let helper (_, EmailCreds x _ _ _) = x let newId = 1 + maximum (0 : map helper m)