[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