This commit is contained in:
Michael Snoyman 2010-05-12 17:56:06 +03:00
parent a847b5c02d
commit 6e639e9333
4 changed files with 12 additions and 15 deletions

View File

@ -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

View File

@ -2,7 +2,6 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Yesod.Hamlet
( -- * Hamlet library

View File

@ -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

View File

@ -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)