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

[Mark Wright]

Hi,

I try to bump warp to 0.8.0 in the gentoo haskell overlay, which
requires wai 0.4.0, this breaks hoogle.  This is my incomplete
and failed attempt to bump wai to 0.4.0 in hoogle:

--- 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-20 23:55:34.234388414 +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

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.

Thanks, Mark

PS: I have built all of yesod 0.8.0 for gentoo, but we would need to somehow fix hoogle
in order for me to apply these changes to the gentoo haskell overlay.