Flushing a WAI response

flush.hs

{-# LANGUAGE OverloadedStrings #-}
import Network.Wai
import Network.Wai.Handler.Warp
import Network.HTTP.Types
import Data.Conduit
import Control.Monad.IO.Class
import Control.Concurrent
import Blaze.ByteString.Builder.Char.Utf8 (fromString)
import Data.Time
import Network.Wai.Middleware.Gzip

main :: IO ()
main = run 3000 $ gzip def app

app :: Application
app _ =
    return $ ResponseSource status200 [("Content-Type", "text/plain")] src
  where
    src = sourceState False pull
    pull False = do
        liftIO $ threadDelay 1000000
        now <- liftIO getCurrentTime
        return (True, Open $ Chunk $ fromString $ show now ++ "\n\n")
    pull True = return (False, Open Flush)