Possible to list and get old revisions

[yawbih.git] / Main.hs

diff --git a/Main.hs b/Main.hs
index b261901b66d582807a39efe272dd658d9d40b4e2..ea9316b3f68dedc03091d24ce365ea1766cc0fc9 100644 (file)
--- a/Main.hs
+++ b/Main.hs
@@ -15,7 +15,7 @@ testDB = createPGB "wave" "wiki" "wiki" "12wiki34db"
 
 main = do 
        db <- testDB
-       runWithHook [] (\(key:act) -> sp db key) $ sp db "MainPage"
+       runWithHook [] (\(key:act) -> showPage db key) $ showPage db "MainPage"
 
 ps a = standardQuery "Hello" a
 
@@ -36,39 +36,64 @@ editPage db key = do
                p $ defaultSubmit (F3 t a c) (savePage db key) (attr "value" "Send")
                --submit0 (sp db key []) (attr "value" "Send1")
 
-sp db key = do
-       s <- io $ getCurrent db key 
-       standardQuery key $ showPage db key s
 
 savePage db key (F3 t a c) = do
        io $ update db key fulltext author comment
-       s <- io $ getCurrent db key 
-       standardQuery key $ do
-               showPage db key s
+       showPage db key 
   where
        fulltext = value t
        author = value a
        comment = value c 
 
-showPage db key s = do
+showPage db key = do
+       s <- io $ getCurrent db key 
+       standardQuery key $ do
                case s of
                        Nothing -> text "No text added for this keyword"
                        Just (full, date) -> do
-                               case parse wikiParser "" full of
-                                       Right n -> ex n 
-                                       Left e -> do
-                                               text "PARSE ERROR: "
-                                               text (show e)
-                                               p $ text full
+                               parseText full  
                                p $ text $ "Last edited: "++date
                footer db key
 
+parseText full = case parse wikiParser "" full of
+       Right n -> ex n 
+       Left e -> do
+               text "PARSE ERROR: "
+               text (show e)
+               p $ text full
+
 footer db key = do
        hr empty
        table $ tr $ do
                td $ submitLink0 (editPage db key) (text "Edit this page")
-               td $ text "Keyword: " >> activate (sp db) textInputField empty
+               td $ submitLink0 (listRevs db key) (text "List old versions")
+               td $ text "Keyword: " 
+               td $ activate (showPage db) textInputField empty
+
+listRevs db key = do 
+       list <- io $ getList db key 
+       standardQuery key $ table $ do
+               tr $ mapM (\header -> th (text header))
+                       ["Id", "Date", "Author", "Comment"]
+               mapM (revRow db key) list
+
+linkKey db key = submitLink0 (showPage db key) (text key)
+
+revRow db key (id, date, author, comment) = tr $ do
+       td $ submitLink0 (showRev db key id) (text id) 
+       td $ text date
+       td $ linkKey db author
+       td $ text comment
+
+showRev db key id = do
+       s <- io $ get db key id
+       standardQuery key $ do
+               case s of 
+                       Nothing -> text "No such revision"
+                       Just s -> parseText s
+               footer db key
 
+       
 ex [] = return ()
 ex ((Paragraph):xs) = do
        p empty