Main.hs

   1 module Main where
   2
   3 import CGI hiding (div, head, map, span)
   4 import RawCGIInternal
   5 import CGIOutput
   6 import CGITypes
   7 import System
   8 import Wiki
   9
  10 testDB = createPGB "wave" "wiki" "wiki" "12wiki34db"
  11
  12 --main = start [] cgi
  13
  14 main = do
  15         db <- testDB
  16         runWithHook [] (\(key:act) -> sp db key act ) $ sp db "MainPage" []
  17
  18 ps a = standardQuery "Hello" a
  19
  20 editPage db key = do
  21         s <- io $ getCurrent db key
  22         s' <- case s of
  23                 Nothing -> return ""
  24                 Just (x,_) -> return x
  25         standardQuery key $ do
  26                 t <- p $ makeTextarea s' (attr_SS "rows" "10" ## attr_SS "cols" "75" ## attr_SS "colspan" "2")
  27                 p (text "Author: ")
  28                 a <- textInputField (fieldSIZE 20)
  29                 p (text "Comment: ")
  30                 c <- textInputField (fieldSIZE 20)
  31                 --p $ submit (F2 t a) testing (attr "value" "Send")
  32                 p $ defaultSubmit (F3 t a c) (savePage db key) (attr "value" "Send")
  33                 --submit0 (sp db key []) (attr "value" "Send1")
  34
  35 sp db key _ = do
  36         s <- io $ getCurrent db key
  37         standardQuery key $ showPage db key s
  38
  39 savePage db key (F3 t a c) = do
  40         s <- io $ update db key fulltext author comment
  41         standardQuery key $ do
  42         text "Updated with revision: "
  43         text s
  44         address (hlink (URL {unURL = ("wiki?"++key)}) (text "Back to keyword") )
  45   where
  46         fulltext = value t
  47         author = value a
  48         comment = value c
  49
  50 showPage db key s = do
  51                 case s of
  52                         Nothing -> text "No text added for this keyword"
  53                         Just (full, date) -> do
  54                                 text full
  55                                 p $ text $ "Last edited: "++date
  56                 footer db key
  57
  58 footer db key = do
  59         hr empty
  60         submit0 (editPage db key) (attr "value" "Edit")
  61         --address (hlink (URL {unURL = ("wiki?"++key++"+edit")}) (text "Edit this page") )