[web-devel] happstack code reloading

Jeremy Shaw jeremy at n-heptane.com
Mon Mar 19 20:46:36 CET 2012


Hello.

The example code you provided seems to work fine for me under GHC 7.4.1.
(Though I did have to patch plugins to get it to build  -- I am working on
getting that fixed upstream).

So, I do not yet have enough information to say why it is not working for
you..

My Handler module looks like this:

module Handler where

import Happstack.Server

user :: ServerPart Response
user = ok $ toResponse "user"

book :: ServerPart Response
book = ok $ toResponse "book"

And if I update "user" to "user!" I see the change with out having to
restart the server.

- jeremy

On Sat, Mar 17, 2012 at 9:12 PM, Asafe Ribeiro <asafe.hai.kai at gmail.com>wrote:

> Hi,
>
> Since one extra parameters was added to the plugin lambda my hmt code
> does no update when I refresh the page. As my code is in hierarchical
> modules , I tried the hack of changing System.Plugin.Make.build but to
> no sucess. Maybe am I missing something?
>
> {-# LANGUAGE CPP, TemplateHaskell,NoOverloadedStrings #-}
>
> module Main where
>
> import Control.Monad(msum)
> import Happstack.Server
> import Control.Monad.IO.Class(liftIO)
> import qualified Page as P
> import qualified Handler as H
>
> #define DESENVOLVIMENTO
>
> --plugins
> #ifdef DESENVOLVIMENTO
> import Happstack.Server.Plugins.Dynamic
> #else
> import Happstack.Server.Plugins.Static
> #endif
>
> main = do
>       dev <- initPlugins
>       simpleHTTP nullConf $ do decodeBody (defaultBodyPolicy "/tmp/"
> 106496 106496 106496)
>                                msum [
>                                          $(withServerPart 'H.user)
> dev devHandler ,
>                                          dir "book" $
> $(withServerPart 'H.book) dev devHandler
>                                          }
>     where devHandler = (\ _ handler -> handler)
>
> _______________________________________________
> web-devel mailing list
> web-devel at haskell.org
> http://www.haskell.org/mailman/listinfo/web-devel
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/web-devel/attachments/20120319/56561ae6/attachment.htm>


More information about the web-devel mailing list