3 import CGI hiding (div, head, map, span, Text)
10 import Text.ParserCombinators.Parsec
12 testDB = createPGB "wave" "wiki" "wiki" "12wiki34db"
18 runWithHook [] (\(key:act) -> showPage db (filter (/= '\\') key)) $ showPage db "MainPage"
20 ps a = standardQuery "Hello" a
23 s <- io $ getCurrent db key
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")
31 a <- textInputField (fieldSIZE 20)
34 c <- textInputField (fieldSIZE 20)
35 --p $ submit (F2 t a) testing (attr "value" "Send")
36 p $ defaultSubmit (F3 t a c) (savePage db key) (attr "value" "Send")
37 --submit0 (sp db key []) (attr "value" "Send1")
40 savePage db key (F3 t a c) = do
41 io $ update db key fulltext author comment
49 s <- io $ getCurrent db key
50 standardQuery key $ do
52 Nothing -> text "No text added for this keyword"
53 Just (full, date) -> do
55 p $ tt $ text $ "Last edited: "++date
58 parseText full = case parse wikiParser "" full of
68 td $ submitLink0 (editPage db key) (text "Edit this keyword")
69 td $ submitLink0 (listRevs db key) (text "List old versions")
71 td $ activate (showPage db) textInputField empty
74 list <- io $ getList db key
75 standardQuery key $ table $ do
76 tr $ mapM (\header -> th (text header))
77 ["Id", "Date", "Author", "Comment"]
78 mapM (revRow db key) list
80 linkKey db key = submitLink0 (showPage db key) (text key)
82 revRow db key (id, date, author, comment) = tr $ do
83 td $ submitLink0 (showRev db key id) (text id)
85 td $ linkKey db author
88 showRev db key id = do
89 s <- io $ get db key id
90 standardQuery key $ do
92 Nothing -> text "No such revision"
95 submitLink0 (changeCurrent db key id) (text "Set this version as the current one")
97 changeCurrent db key id = do
98 b <- io $ setCurrent db key id
99 if b then showPage db key
100 else standardQuery key $ do
101 text "Could not set this revision as the current active one."
106 ex ((Paragraph):xs) = do
109 ex ((Text s):xs) = do
112 ex ((Link l d):xs) = do
113 hlink (URL {unURL = ("wiki?"++l)}) (text d)
115 ex ((Bold d):xs) = do
118 ex ((Emph d):xs) = do
121 ex ((Underline d):xs) = do
124 ex ((Strike d):xs) = do
127 ex ((Heading n d):xs) = do
131 hlink (URL {unURL = (l)}) (text l)
142 ex2 ((Paragraph):xs) = "<p>\n"++ex2 xs
143 ex2 ((Text s):xs) = s++ex2 xs
144 ex2 ((Link l d):xs) = "<link: "++l++" desc: "++d++">"++ex2 xs
145 ex2 ((Bold d):xs) = "<b>"++ex2 d++"</b>"++ex2 xs
146 ex2 ((Emph d):xs) = "<em>"++ex2 d++"</em>"++ex2 xs
147 ex2 ((Underline d):xs) = "<u>"++ex2 d++"</u>"++ex2 xs
148 ex2 ((Strike d):xs) = "<strike>"++ex2 d++"</strike>"++ex2 xs
149 ex2 ((Heading n d):xs) = "\n<h"++show n++">"++ex2 d++"</h"++show n++">\n"++ex2 xs
150 ex2 ((Url l):xs) = "<link: "++l++">"++ex2 xs
153 test s = case parse wikiParser "" s of