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