Workaround for #176

This commit is contained in:
Michael Snoyman 2016-05-17 19:28:26 +03:00
parent c5f16f2faa
commit 413aa50450

View File

@ -14,8 +14,12 @@ makeURL slug rest = concat
: toPathPiece slug
: map (cons '/') rest
shouldRedirect :: Bool
shouldRedirect = True
getHaddockR :: SnapName -> [Text] -> Handler TypedContent
getHaddockR slug rest
| shouldRedirect = redirect $ makeURL slug rest
| final:_ <- reverse rest, ".html" `isSuffixOf` final = do
render <- getUrlRender
@ -44,6 +48,7 @@ getHaddockR slug rest
$ responseBody res
$= tokenStream
$= concatMapC addExtra
-- FIXME showToken does not encode HTML entities
$= mapC (Chunk . showToken id)
| otherwise = redirect $ makeURL slug rest