Support ?style=plain on haddocks

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

View File

@ -50,6 +50,11 @@ 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
mstyle <- lookupGetParam "style"
case mstyle of
Just "plain" -> respondSource "text/html; charset=utf-8"
$ responseBody res .| mapC (Chunk . toBuilder)
_ -> do
doc <- responseBody res doc <- responseBody res
$$ eventConduit $$ eventConduit
=$ concatMapC addExtra =$ concatMapC addExtra