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

[Michael Snoyman]

Hi Mark,

Glad it worked, and thanks for getting Yesod bumped.

Michael

On Thu, Apr 21, 2011 at 7:43 PM, Mark Wright
<markwright at internode.on.net> wrote:
>> > ... 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
>