IPPrint 0.3 now provides pshow
[darcs-mirror-latutman.git] / haskell / MyHAppS.hs
1 {-# OPTIONS -fcontext-stack=30 -fglasgow-exts -fth -fallow-undecidable-instances #-}
2 module MyHAppS (
3         plainEdit
4         ) where
5
6 import HAppS.Data
7 import HAppS.Server
8 import HAppS.State
9 import HAppS.State.Transaction
10 import HAppS.Server.SimpleHTTP
11
12 import IPPrint
13
14 $( deriveAll [''Ord,''Eq,''Read,''Show,''Default] 
15    [d|
16      newtype FormData = FormData String 
17  |] )
18
19 plainEdit :: (  UpdateEvent ue (),
20                 Read a, Show a,
21                 QueryEvent qe a) => qe -> (a -> ue) -> [ServerPart]
22
23 plainEdit getter setter = [
24         method GET $ query getter >>= ok . toDataForm "." "POST" . pshow,
25         withData $ \(FormData fdat) -> [ method POST $ update (setter (read fdat)) >> redirect "." ]
26         ]
27
28
29 -- Just a copy from HAppS/Data/Pairs.hs, with textfield instead of input
30 toDataForm action method fdat
31  = [ Elem "form" (
32                 Attr "xmlns" "http://www.w3.org/1999/xhtml" :
33                 Attr "action" action :
34                 Attr "method" method :
35                 Elem "div" [
36                          Attr "class" "formEl"
37                         ,Elem "textarea" [
38                                 Attr "name" "formData"
39                                 ,Attr "cols" "120"
40                                 ,Attr "rows" "20"
41                                 ,CData fdat
42                                 ]]:
43                 Elem "input" [Attr "type" "submit"] :
44                 [])]
45
46