After many days reading the source,
I'm still trying to grok HAppS.
Meanwhile, here is a patch that adds
examples to HAppS/Examples/HTTP1.hs for combining state and io, based on
your advice.
see especiallly the handler stateioH
accepts an arbitrary state action, arbitrary io action, and a function
for combining the two.
Thomas.
New patches:
[add examples showing state and io
thomas.hartman@db.com**20070906215844]
{
hunk ./src/HAppS/Examples/HTTP1.hs
7
+import System.Directory
hunk ./src/HAppS/Examples/HTTP1.hs
68
+
+
,h ["showbashrc"] GET $ ioshowH readbashrc
+
,h ["showhttp1"] GET $ ioshowH readhttp1
+
+
,h ["incrementstate"] GET $ stateH $ incnshow
+
,h ["decrementstate"] GET $ stateH $ decnshow
+
,h ["viewstate"] GET $ stateH view
+
+
,h ["showbashrc_and_inc"] GET $ stateioH incnshow readbashrc
append_state
+
,h ["showbashrc_and_dec"] GET $ stateioH decnshow readbashrc
append_state
+
,h ["showbashrc_and_view"] GET $ stateioH decnshow readbashrc
append_state
+
hunk ./src/HAppS/Examples/HTTP1.hs
82
+append_state s io = io ++ "<BR>State:
" ++ s
+
+incnshow = modify (+1) >> get
>>=^ show
+decnshow = modify (\x -> x-1) >>
get >>=^ show
+view = get >>=^ show
+
+
+readbashrc = do
+ home <- getHomeDirectory
+ readfileSafe $ home ++ "/.bashrc"
+
+readhttp1 = readfileSafe "./HTTP1.hs"
+
+readfileSafe file = catch
+
( readFile file >>=^ format_html )
+
( \e -> return ( show e ) )
+
+stateioH stateaction ioaction combinestio
= \() () -> do
+ stateresult <- stateaction
+ respond $ do
+ ioresult <-
ioaction
+ showresult (combinestio
stateresult ioresult)
+
+
+stateH stateaction = ok $ \() () ->
stateaction >>= respond
+
+ioshowH :: (Monad m, Show a) =>
IO a -> () -> () -> m (Either Request (IO Result))
+ioshowH ioaction = \() () -> respond
$ do
+ ioresult <- ioaction
+ showresult ioresult
+
+showresult showable = sresult 200
(show showable)
+
+
hunk ./src/HAppS/Examples/HTTP1.hs
151
+
+format_html xs = concat $ map newlinetobr
xs
+ where newlinetobr '\n'
= "<br>"
+ newlinetobr
x = [x]
+
+f >>=^ g = f >>= return
. g
}
Martin Lütke <prionic@gmx.de> Sent by: haskell-cafe-bounces@haskell.org
09/01/2007 07:04 PM
To
haskell-cafe@haskell.org
cc
Subject
[Haskell-cafe] Re: wanted: HAppS example
combining state and io
Thomas Hartman <thomas.hartman <at> db.com>
writes:
>
>
> In the latest happs (darcs pulled, updated
> head is 0.9.1 iirc), I am experimenting with the example file in
src/HAppS/Examples/HTTP1.hs.
> I would like to combine state with io.
> Eventually io will mean stuff like reading from a database, but for
now
> I'm just reading a file.
> The example file HTTP1.hs has an example
> that demonstrates state with macid.
> I added an example that allows you to
> execute arbitrary io.
> I tried, but was unable to, add a handler
> that combines state and io.
>
> , h ["iohandler"] GET $
ioReadFileHandler
>
> , h ["statehandler"] GET $ stateHandler
>
> --, h ["ioandstatehandler"] GET $ ioAndStateHandler
> .....
> -- displays contents of HAPPS.hs in
> current directory
> ioReadFileHandler = iohandler $ readFile
> "./HAppS.hs"
> -- displays incremented state counter
> stateHandler = ok $ \() () ->
>
> modify (+(1::Int)) >> get
>>=
> respond . show
> -- should combine effect of iohandler
> with statehandler
> -- specifically, should display contents
> of HAppS.hs, and under that an incremented state handler
> -- is this possible
> ioAndStateHandler = undefined undefined
> Is mixing state and io possible with
> HAppS? If so, an example showing how to do it would be extremely helpful.
> best, thomas.
> ---This e-mail may contain confidential and/or privileged information.
If you
are not the intended recipient (or have received this e-mail in error)
please
notify the sender immediately and destroy this e-mail. Any unauthorized
copying,
disclosure or distribution of the material in this e-mail is strictly forbidden.
>
> Attachment (https1-whatsnew): application/octet-stream, 1933 bytes
> Attachment (HTTP1.hs): application/octet-stream, 4794 bytes
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe <at> haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
I had no trouble getting this handler to work:
h ["iohandler"] GET $ \() () -> do
modify (+1)
x <- get
respond $ do
cnts <- readFile
"./sometext.txt"
sresult 200 (cnts
++ show x)
I believe the trick is that you cant mix io INTO the HAppS ServerPart monad.
But from the ServerPart monad you can RETURN an io action.
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
---
This e-mail may contain confidential and/or privileged information. If you are not the intended recipient (or have received this e-mail in error) please notify the sender immediately and destroy this e-mail. Any unauthorized copying, disclosure or distribution of the material in this e-mail is strictly forbidden.