hlint applied

This commit is contained in:
Michael Snoyman 2010-01-27 09:40:39 +02:00
parent 097561b7aa
commit d1618eb3d0
7 changed files with 17 additions and 18 deletions

View File

@ -109,7 +109,7 @@ instance ConvertSuccess [(TS.Text, TS.Text)] HtmlObject where
convertSuccess = omTO convertSuccess = omTO
showAttribs :: [(String, String)] -> String -> String showAttribs :: [(String, String)] -> String -> String
showAttribs pairs rest = foldr ($) rest $ map helper pairs where showAttribs pairs rest = foldr (($) . helper) rest pairs where
helper :: (String, String) -> String -> String helper :: (String, String) -> String -> String
helper (k, v) rest' = helper (k, v) rest' =
' ' : encodeHtml k ' ' : encodeHtml k
@ -122,18 +122,17 @@ htmlToText :: Bool -- ^ True to close empty tags like XML, False like HTML
htmlToText _ (Html t) = (:) t htmlToText _ (Html t) = (:) t
htmlToText _ (Text t) = (:) $ encodeHtml t htmlToText _ (Text t) = (:) $ encodeHtml t
htmlToText xml (Tag n as content) = \rest -> htmlToText xml (Tag n as content) = \rest ->
(cs $ '<' : n) cs ('<' : n)
: (cs $ showAttribs as ">") : cs (showAttribs as ">")
: (htmlToText xml content : htmlToText xml content
$ (cs $ '<' : '/' : n) ( cs ('<' : '/' : n)
: cs ">" : cs ">"
: rest) : rest)
htmlToText xml (EmptyTag n as) = \rest -> htmlToText xml (EmptyTag n as) = \rest ->
(cs $ '<' : n ) cs ('<' : n )
: (cs $ showAttribs as (if xml then "/>" else ">")) : cs (showAttribs as (if xml then "/>" else ">"))
: rest : rest
htmlToText xml (HtmlList l) = \rest -> htmlToText xml (HtmlList l) = flip (foldr ($)) (map (htmlToText xml) l)
foldr ($) rest $ map (htmlToText xml) l
newtype HtmlFragment = HtmlFragment { unHtmlFragment :: Text } newtype HtmlFragment = HtmlFragment { unHtmlFragment :: Text }
instance ConvertSuccess Html HtmlFragment where instance ConvertSuccess Html HtmlFragment where
@ -173,7 +172,7 @@ instance ConvertSuccess HtmlObject Html where
convertSuccess (Scalar h) = h convertSuccess (Scalar h) = h
convertSuccess (Sequence hs) = Tag "ul" [] $ HtmlList $ map addLi hs convertSuccess (Sequence hs) = Tag "ul" [] $ HtmlList $ map addLi hs
where where
addLi h = Tag "li" [] $ cs h addLi = Tag "li" [] . cs
convertSuccess (Mapping pairs) = convertSuccess (Mapping pairs) =
Tag "dl" [] $ HtmlList $ concatMap addDtDd pairs where Tag "dl" [] $ HtmlList $ concatMap addDtDd pairs where
addDtDd (k, v) = addDtDd (k, v) =

View File

@ -30,7 +30,7 @@ denied = permissionDenied
needsIdent :: Handler Errors (Html, HtmlObject) needsIdent :: Handler Errors (Html, HtmlObject)
needsIdent = do needsIdent = do
i <- authIdentifier i <- authIdentifier
return $ (cs "", cs i) return (cs "", cs i)
hasArgs :: Handler Errors (Html, HtmlObject) hasArgs :: Handler Errors (Html, HtmlObject)
hasArgs = do hasArgs = do

View File

@ -128,7 +128,7 @@ runHandler handler eh rr y cts = do
safeEh :: ErrorResponse -> Handler yesod ChooseRep safeEh :: ErrorResponse -> Handler yesod ChooseRep
safeEh er = do safeEh er = do
liftIO $ hPutStrLn stderr $ "Error handler errored out: " ++ show er liftIO $ hPutStrLn stderr $ "Error handler errored out: " ++ show er
return $ chooseRep $ return $ chooseRep
( Tag "title" [] $ cs "Internal Server Error" ( Tag "title" [] $ cs "Internal Server Error"
, toHtmlObject "Internal server error" , toHtmlObject "Internal server error"
) )

View File

@ -51,7 +51,7 @@ serveStatic _ _ _ = notFound
getStatic :: FileLookup -> [String] -> Handler y [(ContentType, Content)] getStatic :: FileLookup -> [String] -> Handler y [(ContentType, Content)]
getStatic fl fp' = do getStatic fl fp' = do
when (any isUnsafe fp') $ notFound when (any isUnsafe fp') notFound
let fp = intercalate "/" fp' let fp = intercalate "/" fp'
content <- liftIO $ fl fp content <- liftIO $ fl fp
case content of case content of

View File

@ -47,7 +47,7 @@ import Data.Typeable
import Control.Exception (Exception) import Control.Exception (Exception)
import Data.Attempt -- for failure stuff import Data.Attempt -- for failure stuff
import Data.Object.Text import Data.Object.Text
import Control.Monad ((<=<), unless) import Control.Monad ((<=<), unless, zipWithM)
import Data.Object.Yaml import Data.Object.Yaml
import Yesod.Handler import Yesod.Handler
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
@ -152,7 +152,7 @@ doPatternPiecesMatch rp r
let Slurp slurpKey = last rp let Slurp slurpKey = last rp
return $ (slurpKey, SlurpParam r2) : smap return $ (slurpKey, SlurpParam r2) : smap
| length rp /= length r = failure NoMatch | length rp /= length r = failure NoMatch
| otherwise = concat `fmap` sequence (zipWith doesPatternPieceMatch rp r) | otherwise = concat `fmap` zipWithM doesPatternPieceMatch rp r
data NoMatch = NoMatch data NoMatch = NoMatch
doesPatternPieceMatch :: MonadFailure NoMatch m doesPatternPieceMatch :: MonadFailure NoMatch m

View File

@ -55,5 +55,5 @@ tempToContent :: Template
tempToContent t ho f = ioTextToContent $ fmap render $ f ho t tempToContent t ho f = ioTextToContent $ fmap render $ f ho t
ioTextToContent :: IO Text -> Content ioTextToContent :: IO Text -> Content
ioTextToContent iotext = Content $ \f a -> iotext >>= \t -> ioTextToContent iotext =
foldM f a $ toChunks $ cs t Content $ \f a -> iotext >>= foldM f a . toChunks . cs

View File

@ -110,7 +110,7 @@ toHackApp a = do
$ jsonp $ jsonp
$ methodOverride $ methodOverride
$ clientsession encryptedCookies key mins $ clientsession encryptedCookies key mins
$ app' app'
toHackApp' :: Yesod y => y -> Hack.Env -> IO Hack.Response toHackApp' :: Yesod y => y -> Hack.Env -> IO Hack.Response
toHackApp' y env = do toHackApp' y env = do