haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-01-20 16:01:55 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Workaround for #176

Browse Source
This commit is contained in:
Michael Snoyman 2016-05-17 19:28:26 +03:00
parent c5f16f2faa
commit 413aa50450
1 changed files with 5 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
Handler/Haddock.hs
View File

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