[web-devel] happstack + hamlet

[Jeremy Shaw]

Hello,

As an experiment I modified the hamlet  demo to use happstack. Was  
pretty trivial. I just added,

-- happstack changes

main :: IO ()
main = simpleHTTP nullConf $ liftIO $ hamletToResponse renderUrls $  
template person

hamletToResponse :: (Monad m) => (url -> String) -> Hamlet url m () ->  
m Response
hamletToResponse showFn hamlet =
     do msg <- hamletToText showFn hamlet
        return $ toResponse_ (B.pack "text/html; charset=UTF-8")  
(T.encodeUtf8 msg)

toResponse_ :: B.ByteString -> L.ByteString -> Response
toResponse_ contentType message =
     let res = Response 200 M.empty nullRsFlags message Nothing
     in setHeaderBS (B.pack "Content-Type") contentType res

The toResponse_ function really belongs in happstack anyway. I am  
going to add that right now.

Normally we would add a ToMessage instance, so you could do:

simpleHTTP nullConf $ template person

But that won't work for two reasons:

  1. we would need a way to pass in the (url -> String) function
  2. the toResponse type signature does not allow for the monadic  
requirements of hamletToText

But that is really just an issue with ToMessage class (and why I don't  
really like that type class much).

I would like to make hamletToResponse (or something similar) available  
to happstack users. I think I probably need to make a new package,  
happstack-hamlet, to stick it in. I wonder if there is anything else  
useful that could go in there. I could add some additional instances,  
such as:

mapHamlet :: forall a b url m n. (Monad m) => (m a -> m b) -> Hamlet  
url m a -> Hamlet url m b
mapHamlet f m =
     Hamlet $ \showFn seed iteratee -> f' (runHamlet m showFn seed  
iteratee)
         where
           f' :: m (Either seed (a, seed)) -> m (Either seed (b, seed))
           f' m =
               do e <- m
                  case e of
                    (Left s) -> return (Left s)
                    (Right (a, seed)) ->
                        do b <- f (return a)
                           return (Right (b, seed))

instance (ServerMonad m) => ServerMonad (Hamlet url m) where
     askRq   = liftHamlet askRq
     localRq f = mapHamlet (localRq f)

instance (FilterMonad r m) => FilterMonad r (Hamlet url m) where
     setFilter     = liftHamlet . setFilter
     composeFilter = liftHamlet . composeFilter
     getFilter     = mapHamlet getFilter

instance (WebMonad a m) => WebMonad a (Hamlet url m) where
     finishWith = liftHamlet . finishWith

So that you could use some of the functionality of the ServerMonad,  
etc, in your Hamlet templates. But I am not clear how that would be  
useful yet.

- jeremy

Anyway, the full code is attached.

-------------- next part --------------
A non-text attachment was scrubbed...
Name: hamlet-happs.hs
Type: application/octet-stream
Size: 2309 bytes
Desc: not available
Url : http://www.haskell.org/pipermail/web-devel/attachments/20100420/e4b25bf0/hamlet-happs.obj