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