[web-devel] wai 0.4.0 uprade for warp 0.8.0 breaks hoogle

[Mark Wright]

> > ... incomplete patch deleted ...
> > The compiler error is:
> >
> > [61 of 72] Compiling Web.Server       ( src/Web/Server.hs,
> > dist/build/hoogle/hoogle-tmp/Web/Server.o )
> >
> > src/Web/Server.hs:46:14:
> >    Couldn't match expected type `Response'
> >                with actual type `Maybe FilePart -> Response'
> >    In the return type of a call of `ResponseFile'
> >    In the expression: ResponseFile statusOK hdr file
> >    In the second argument of `($)', namely
> >      `if not b then
> >           responseNotFound file
> >       else
> >           ResponseFile statusOK hdr file'
> >
> > I was wondering how to convert from Maybe FilePart to Response,
> > this looks tricky.
> >
On Wed, 20 Apr 2011 18:39:15 +0300, Michael Snoyman <michael at snoyman.com> wrote:
> It looks to me like you're actually trying to convert a "Maybe FilePart ->
> Response" to a "Response". In WAI 0.4, we added an extra field to the
> ResponseFile constructor to allow for partial file responses. To get the
> previous behavior (send the whole thing), just provide a "Nothing" value for
> the "Maybe FilePart".

Hi Michael,

Great, thanks, I patched hoogle to implement this change, hoogle
compiles fine.  My untested hoogle patch is included below.
I've sent a pull request to bump yesod to 0.8.0 in the gentoo overlay.

Thanks, Mark

the hoogle patch, which is also available here:
https://github.com/markwright/gentoo-haskell/blob/master/dev-haskell/hoogle/files/hoogle-4.2.1-warp.patch

Non-text part: text/html

--- hoogle-4.2.1-orig/hoogle.cabal	2011-01-26 22:16:52.000000000 +1100
+++ hoogle-4.2.1/hoogle.cabal	2011-04-20 23:59:18.021501043 +1000
@@ -35,7 +35,7 @@
         array, bytestring, containers, directory, filepath, process, random,
         safe,
         binary,
-        parsec == 2.1.*,
+        parsec >= 2.1,
         transformers == 0.2.*,
         uniplate == 1.6.*,
         haskell-src-exts >= 1.9 && < 1.11
@@ -107,9 +107,11 @@
         cmdargs == 0.6.*,
         tagsoup >= 0.11 && < 0.13,
         enumerator == 0.4.*,
-        blaze-builder == 0.2.*,
-        wai == 0.3.0,
-        warp == 0.3.0,
+        blaze-builder >= 0.2 && < 0.4,
+        http-types >= 0.6 && < 0.7,
+        case-insensitive >= 0.2 && < 0.3,
+        wai >= 0.4.0 && < 0.5.0,
+        warp >= 0.4.0 && < 0.5.0,
         Cabal >= 1.8 && < 1.11
 
     other-modules:
--- hoogle-4.2.1-orig/src/General/Web.hs	2011-01-26 22:16:52.000000000 +1100
+++ hoogle-4.2.1/src/General/Web.hs	2011-04-21 00:03:49.840705869 +1000
@@ -16,6 +16,8 @@
 import General.System
 import General.Base
 import Network.Wai
+import Network.HTTP.Types
+import Data.CaseInsensitive(original)
 import Blaze.ByteString.Builder(toLazyByteString)
 import Data.Enumerator.List(consume)
 import qualified Data.ByteString.Lazy.Char8 as LBS
@@ -23,13 +25,15 @@
 
 type Args = [(String, String)]
 
+type ResponseHeader = Header
 
 ---------------------------------------------------------------------
 -- WAI STUFF
 
-statusOK = status200
-hdrContentType = fromString "Content-Type" :: ResponseHeader
-hdrCacheControl = fromString "Cache-Control" :: ResponseHeader
+hdrContentType :: Ascii -> Header
+hdrContentType = headerContentType
+hdrCacheControl :: Ascii -> Header
+hdrCacheControl = headerCacheControl
 
 responseOK = responseLBS statusOK
 responseBadRequest x = responseLBS status400 [] $ fromString $ "Bad request: " ++ x
@@ -125,7 +129,7 @@
 cgiResponse r = do
     (status,headers,body) <- responseFlatten r
     LBS.putStr $ LBS.unlines $
-        [LBS.fromChunks [ciOriginal a, fromString ": ", b] | (a,b) <- headers] ++
+        [LBS.fromChunks [original a, fromString ": ", b] | (a,b) <- headers] ++
         [fromString "",body]
 
 
--- hoogle-4.2.1-orig/src/Web/Response.hs	2011-01-26 22:16:52.000000000 +1100
+++ hoogle-4.2.1/src/Web/Response.hs	2011-04-20 23:06:21.128254027 +1000
@@ -15,6 +15,7 @@
 import Data.Time.Format
 import System.Locale
 import Network.Wai
+import Network.HTTP.Types(headerContentType)
 import System.IO.Unsafe(unsafeInterleaveIO)
 
 
@@ -24,7 +25,7 @@
 response :: FilePath -> CmdLine -> IO Response
 response resources q = do
     logMessage q
-    let response x ys z = responseOK ((hdrContentType,fromString x) : ys) (fromString z)
+    let response x ys z = responseOK ((headerContentType $ fromString x) : ys) (fromString z)
 
     dbs <- unsafeInterleaveIO $ case queryParsed q of
         Left _ -> return mempty
--- hoogle-4.2.1-orig/src/Web/Server.hs	2011-01-26 22:16:52.000000000 +1100
+++ hoogle-4.2.1/src/Web/Server.hs	2011-04-21 10:15:48.919257875 +1000
@@ -15,19 +15,18 @@
 import qualified Data.ByteString.Lazy.Char8 as LBS
 import qualified Data.ByteString.Char8 as BS
 
-
 server :: CmdLine -> IO ()
 server q at Server{..} = do
     v <- newMVar ()
     putStrLn $ "Starting Hoogle Server on port " ++ show port
     run port $ \r -> liftIO $ do
-        withMVar v $ const $ putStrLn $ bsUnpack (pathInfo r) ++ bsUnpack (queryString r)
+        withMVar v $ const $ putStrLn $ bsUnpack (rawPathInfo r) ++ bsUnpack (rawQueryString r)
         talk q r
 
 
 -- FIXME: Avoid all the conversions to/from LBS
 talk :: CmdLine -> Request -> IO Response
-talk Server{..} Request{pathInfo=path_, queryString=query_}
+talk Server{..} Request{rawPathInfo=path_, rawQueryString=query_}
     | path `elem` ["/","/hoogle"] = do
         let args = parseHttpQueryArgs $ drop 1 query
         cmd <- cmdLineWeb args
@@ -44,9 +43,9 @@
     b <- doesFileExist file
     return $ if not b
         then responseNotFound file
-        else ResponseFile statusOK hdr file
-    where hdr = [(hdrContentType, fromString $ contentExt $ takeExtension file)] ++
-                [(hdrCacheControl, fromString "max-age=604800" {- 1 week -}) | cache]
+        else ResponseFile statusOK hdr file Nothing
+    where hdr = [(hdrContentType $ fromString $ contentExt $ takeExtension file)] ++
+                [(hdrCacheControl $ fromString "max-age=604800" {- 1 week -}) | cache]
 
 
 rewriteFileLinks :: Response -> IO Response