
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)

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
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@haskell.org http://www.haskell.org/mailman/listinfo/web-devel
participants (2)
-
Asafe Ribeiro
-
Jeremy Shaw