Experimental streaming pretty style

Handler/Haddock.hs

@@ -6,7 +6,7 @@ module Handler.Haddock
 import Import
 import Stackage.Database
 import Text.HTML.DOM (eventConduit)
-import Text.XML (fromEvents)
+import Text.XML.Stream.Render
 import Data.XML.Types (Event (..), Content (..))
 
 makeURL :: SnapName -> [Text] -> Text
@@ -50,19 +50,23 @@ getHaddockR slug rest
                 addExtra t = [t]
             req <- parseRequest $ unpack $ makeURL slug rest
             (_, res) <- acquireResponse req >>= allocateAcquire
-            -- mstyle <- lookupGetParam "style"
+            mstyle' <- lookupGetParam "style"
             -- TODO: Uncomment line above. Restyling is really slow right now, still need to debug it.
-            let mstyle = Just ("plain" :: Text)
+            let mstyle =
+                  case mstyle' of
+                    Just "pretty" -> Nothing
+                    _ -> Just ("plain" :: Text)
             case mstyle of
               Just "plain" -> respondSource "text/html; charset=utf-8"
                             $ responseBody res .| mapC (Chunk . toBuilder)
-              _ -> do
+              _ -> respondSource "text/html; charset=utf-8"
-                doc <- responseBody res
+                     $ responseBody res
-                    $$ eventConduit
+                    .| eventConduit
-                    =$ concatMapC addExtra
+                    .| concatMapC addExtra
-                    =$ mapC (Nothing, )
+                    .| renderBuilder def
-                    =$ fromEvents
+                         { rsXMLDeclaration = False
-                sendResponse $ toHtml doc
+                         }
+                    .| mapC Chunk
   | otherwise = redirect $ makeURL slug rest
 
 redirectWithVersion