hlint applied
This commit is contained in:
parent
097561b7aa
commit
d1618eb3d0
@ -109,7 +109,7 @@ instance ConvertSuccess [(TS.Text, TS.Text)] HtmlObject where
|
||||
convertSuccess = omTO
|
||||
|
||||
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 (k, v) rest' =
|
||||
' ' : encodeHtml k
|
||||
@ -122,18 +122,17 @@ htmlToText :: Bool -- ^ True to close empty tags like XML, False like HTML
|
||||
htmlToText _ (Html t) = (:) t
|
||||
htmlToText _ (Text t) = (:) $ encodeHtml t
|
||||
htmlToText xml (Tag n as content) = \rest ->
|
||||
(cs $ '<' : n)
|
||||
: (cs $ showAttribs as ">")
|
||||
: (htmlToText xml content
|
||||
$ (cs $ '<' : '/' : n)
|
||||
cs ('<' : n)
|
||||
: cs (showAttribs as ">")
|
||||
: htmlToText xml content
|
||||
( cs ('<' : '/' : n)
|
||||
: cs ">"
|
||||
: rest)
|
||||
htmlToText xml (EmptyTag n as) = \rest ->
|
||||
(cs $ '<' : n )
|
||||
: (cs $ showAttribs as (if xml then "/>" else ">"))
|
||||
cs ('<' : n )
|
||||
: cs (showAttribs as (if xml then "/>" else ">"))
|
||||
: rest
|
||||
htmlToText xml (HtmlList l) = \rest ->
|
||||
foldr ($) rest $ map (htmlToText xml) l
|
||||
htmlToText xml (HtmlList l) = flip (foldr ($)) (map (htmlToText xml) l)
|
||||
|
||||
newtype HtmlFragment = HtmlFragment { unHtmlFragment :: Text }
|
||||
instance ConvertSuccess Html HtmlFragment where
|
||||
@ -173,7 +172,7 @@ instance ConvertSuccess HtmlObject Html where
|
||||
convertSuccess (Scalar h) = h
|
||||
convertSuccess (Sequence hs) = Tag "ul" [] $ HtmlList $ map addLi hs
|
||||
where
|
||||
addLi h = Tag "li" [] $ cs h
|
||||
addLi = Tag "li" [] . cs
|
||||
convertSuccess (Mapping pairs) =
|
||||
Tag "dl" [] $ HtmlList $ concatMap addDtDd pairs where
|
||||
addDtDd (k, v) =
|
||||
|
||||
@ -30,7 +30,7 @@ denied = permissionDenied
|
||||
needsIdent :: Handler Errors (Html, HtmlObject)
|
||||
needsIdent = do
|
||||
i <- authIdentifier
|
||||
return $ (cs "", cs i)
|
||||
return (cs "", cs i)
|
||||
|
||||
hasArgs :: Handler Errors (Html, HtmlObject)
|
||||
hasArgs = do
|
||||
|
||||
@ -128,7 +128,7 @@ runHandler handler eh rr y cts = do
|
||||
safeEh :: ErrorResponse -> Handler yesod ChooseRep
|
||||
safeEh er = do
|
||||
liftIO $ hPutStrLn stderr $ "Error handler errored out: " ++ show er
|
||||
return $ chooseRep $
|
||||
return $ chooseRep
|
||||
( Tag "title" [] $ cs "Internal Server Error"
|
||||
, toHtmlObject "Internal server error"
|
||||
)
|
||||
|
||||
@ -51,7 +51,7 @@ serveStatic _ _ _ = notFound
|
||||
|
||||
getStatic :: FileLookup -> [String] -> Handler y [(ContentType, Content)]
|
||||
getStatic fl fp' = do
|
||||
when (any isUnsafe fp') $ notFound
|
||||
when (any isUnsafe fp') notFound
|
||||
let fp = intercalate "/" fp'
|
||||
content <- liftIO $ fl fp
|
||||
case content of
|
||||
|
||||
@ -47,7 +47,7 @@ import Data.Typeable
|
||||
import Control.Exception (Exception)
|
||||
import Data.Attempt -- for failure stuff
|
||||
import Data.Object.Text
|
||||
import Control.Monad ((<=<), unless)
|
||||
import Control.Monad ((<=<), unless, zipWithM)
|
||||
import Data.Object.Yaml
|
||||
import Yesod.Handler
|
||||
import Data.Maybe (fromJust)
|
||||
@ -152,7 +152,7 @@ doPatternPiecesMatch rp r
|
||||
let Slurp slurpKey = last rp
|
||||
return $ (slurpKey, SlurpParam r2) : smap
|
||||
| length rp /= length r = failure NoMatch
|
||||
| otherwise = concat `fmap` sequence (zipWith doesPatternPieceMatch rp r)
|
||||
| otherwise = concat `fmap` zipWithM doesPatternPieceMatch rp r
|
||||
|
||||
data NoMatch = NoMatch
|
||||
doesPatternPieceMatch :: MonadFailure NoMatch m
|
||||
|
||||
@ -55,5 +55,5 @@ tempToContent :: Template
|
||||
tempToContent t ho f = ioTextToContent $ fmap render $ f ho t
|
||||
|
||||
ioTextToContent :: IO Text -> Content
|
||||
ioTextToContent iotext = Content $ \f a -> iotext >>= \t ->
|
||||
foldM f a $ toChunks $ cs t
|
||||
ioTextToContent iotext =
|
||||
Content $ \f a -> iotext >>= foldM f a . toChunks . cs
|
||||
|
||||
@ -110,7 +110,7 @@ toHackApp a = do
|
||||
$ jsonp
|
||||
$ methodOverride
|
||||
$ clientsession encryptedCookies key mins
|
||||
$ app'
|
||||
app'
|
||||
|
||||
toHackApp' :: Yesod y => y -> Hack.Env -> IO Hack.Response
|
||||
toHackApp' y env = do
|
||||
|
||||
Loading…
Reference in New Issue
Block a user