Main.hs

   1 module Main where
   2
   3 import CGI hiding (div, head, map, span, Text)
   4 import RawCGIInternal
   5 import CGIOutput
   6 import CGITypes
   7 import System
   8 import Wiki
   9
  10 import Text.ParserCombinators.Parsec
  11
  12 testDB = createPGB "wave" "wiki" "wiki" "12wiki34db"
  13
  14 --main = start [] cgi
  15
  16 main = do
  17         db <- testDB
  18         runWithHook [] (\(key:act) -> sp db key act ) $ sp db "MainPage" []
  19
  20 ps a = standardQuery "Hello" a
  21
  22 editPage db key = do
  23         s <- io $ getCurrent db key
  24         s' <- case s of
  25                 Nothing -> return ""
  26                 Just (x,_) -> return x
  27         standardQuery key $ do
  28                 t <- p $ makeTextarea s' (attr_SS "rows" "10" ## attr_SS "cols" "75" ## attr_SS "colspan" "2")
  29                 p (text "Author: ")
  30                 a <- textInputField (fieldSIZE 20)
  31                 p (text "Comment: ")
  32                 c <- textInputField (fieldSIZE 20)
  33                 --p $ submit (F2 t a) testing (attr "value" "Send")
  34                 p $ defaultSubmit (F3 t a c) (savePage db key) (attr "value" "Send")
  35                 --submit0 (sp db key []) (attr "value" "Send1")
  36
  37 sp db key _ = do
  38         s <- io $ getCurrent db key
  39         standardQuery key $ showPage db key s
  40
  41 savePage db key (F3 t a c) = do
  42         s <- io $ update db key fulltext author comment
  43         standardQuery key $ do
  44         text "Updated with revision: "
  45         text s
  46         address (hlink (URL {unURL = ("wiki?"++key)}) (text "Back to keyword") )
  47   where
  48         fulltext = value t
  49         author = value a
  50         comment = value c
  51
  52 showPage db key s = do
  53                 case s of
  54                         Nothing -> text "No text added for this keyword"
  55                         Just (full, date) -> do
  56                                 case parse wikiParser "" full of
  57                                         Right n -> ex n
  58                                         Left e -> do
  59                                                 text "PARSE ERROR: "
  60                                                 text (show e)
  61                                                 p $ text full
  62                                 p $ text $ "Last edited: "++date
  63                 footer db key
  64
  65 footer db key = do
  66         hr empty
  67         submit0 (editPage db key) (attr "value" "Edit")
  68         --address (hlink (URL {unURL = ("wiki?"++key++"+edit")}) (text "Edit this page")
  69
  70 ex [] = return ()
  71 ex ((Paragraph):xs) = do
  72         p empty
  73         ex xs
  74 ex ((Text s):xs) = do
  75         text s
  76         ex xs
  77 ex ((Link l d):xs) = do
  78         hlink (URL {unURL = ("wiki?"++l)}) (text d)
  79         ex xs
  80
  81 ex2 [] = []
  82 ex2 ((Paragraph):xs) = "<p>"++ex2 xs
  83 ex2 ((Text s):xs) = s++ex2 xs
  84 ex2 ((Link l d):xs) = "<link: "++l++" desc: "++d++">"++ex2 xs
  85
  86
  87 test s = case parse wikiParser "" s of
  88                                         Right n -> do
  89                                                 print (ex2 n)
  90                                         Left e -> do
  91                                                 print e