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

Neil Mitchell ndmitchell at gmail.com
Mon Apr 25 20:22:12 CEST 2011


Hi Mark,

Thanks for the patch, I've applied it and released Hoogle 4.2.2, which
works with the latest WAI/Warp.

Thanks for all your help with the upgrade,

Neil

On Mon, Apr 25, 2011 at 3:13 PM, Mark Wright
<markwright at internode.on.net> wrote:
> On Fri, 22 Apr 2011 14:33:47 +0100, Neil Mitchell <ndmitchell at gmail.com> wrote:
>> Hi Mark,
>>
>> I'm the author of Hoogle. Thanks for your diff, I've applied it to the
>> development version and will be making a new release of Hoogle in the
>> next few days - I was just about to start upgrading WAI/Warp when I
>> came across your message - so great timing! In future, you're welcome
>> to always cc me on emails about Hoogle. Also, if you ever want to make
>> similarly sized changes to Hoogle, you may want to make them on the
>> darcs head version of Hoogle, and mail me a patch. I always leave the
>> repo in a releasable state, so if you mail a patch I can incorporate
>> it and release a new version immediately.
>
> Hi Neil,
>
> Thanks very much for applying the diff.  I mailed you a trivial
> patch, with that the darcs build of hoogle installs, hoogle data
> and hoogle queries work on gentoo.
>
>> Do let me know if there's anything else I can do to help make it
>> easier to package Hoogle. I've now applied variants of everything in
>> your patch file, so hopefully the next point release will require no
>> patches. I'm aiming for a new release within a week (but could push
>> this forward if it was of benefit to you).
>>
>> Thanks, Neil
>
> Its no hurry thanks, as I can apply patches in the ebuild while
> waiting for the next release.
>
> Hoogle is awesome, thanks very much for writing it.
>
> Thanks, Mark
>
>> On Thu, Apr 21, 2011 at 5: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
>> >
>> > _______________________________________________
>> > web-devel mailing list
>> > web-devel at haskell.org
>> > http://www.haskell.org/mailman/listinfo/web-devel
>> >
>



More information about the web-devel mailing list