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

Support ?style=plain on haddocks

Browse Source
This commit is contained in:
Michael Snoyman 2017-12-08 10:17:19 +02:00
parent 950cb7ef6d
commit eac18f4b1b
No known key found for this signature in database
GPG Key ID: A048E8C057E86876
1 changed files with 11 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
Handler/Haddock.hs
View File

@ -50,12 +50,17 @@ getHaddockR slug rest
addExtra t = [t] addExtra t = [t]
req <- parseRequest $ unpack $ makeURL slug rest req <- parseRequest $ unpack $ makeURL slug rest
(_, res) <- acquireResponse req >>= allocateAcquire (_, res) <- acquireResponse req >>= allocateAcquire
doc <- responseBody res mstyle <- lookupGetParam "style"
$$ eventConduit case mstyle of
=$ concatMapC addExtra Just "plain" -> respondSource "text/html; charset=utf-8"
=$ mapC (Nothing, ) $ responseBody res .| mapC (Chunk . toBuilder)
=$ fromEvents _ -> do
sendResponse $ toHtml doc doc <- responseBody res
$$ eventConduit
=$ concatMapC addExtra
=$ mapC (Nothing, )
=$ fromEvents
sendResponse $ toHtml doc
| otherwise = redirect $ makeURL slug rest | otherwise = redirect $ makeURL slug rest
redirectWithVersion redirectWithVersion