X-Git-Url: https://ruin.nu/git/?a=blobdiff_plain;f=Main.hs;h=2457b058632e32edc520c090bf631d33f86b5063;hb=b9ff8d1cc183f8f07056efb4680b8b56556d4246;hp=ea9316b3f68dedc03091d24ce365ea1766cc0fc9;hpb=cfd9357931f136f52df2becd0af605111e102234;p=yawbih.git diff --git a/Main.hs b/Main.hs index ea9316b..2457b05 100644 --- a/Main.hs +++ b/Main.hs @@ -15,7 +15,7 @@ testDB = createPGB "wave" "wiki" "wiki" "12wiki34db" main = do db <- testDB - runWithHook [] (\(key:act) -> showPage db key) $ showPage db "MainPage" + runWithHook [] (\(key:act) -> showPage db (filter (/= '\\') key)) $ showPage db "MainPage" ps a = standardQuery "Hello" a @@ -52,7 +52,7 @@ showPage db key = do Nothing -> text "No text added for this keyword" Just (full, date) -> do parseText full - p $ text $ "Last edited: "++date + p $ tt $ text $ "Last edited: "++date footer db key parseText full = case parse wikiParser "" full of @@ -65,7 +65,7 @@ parseText full = case parse wikiParser "" full of footer db key = do hr empty table $ tr $ do - td $ submitLink0 (editPage db key) (text "Edit this page") + td $ submitLink0 (editPage db key) (text "Edit this keyword") td $ submitLink0 (listRevs db key) (text "List old versions") td $ text "Keyword: " td $ activate (showPage db) textInputField empty @@ -91,8 +91,16 @@ showRev db key id = do case s of Nothing -> text "No such revision" Just s -> parseText s + p empty + submitLink0 (changeCurrent db key id) (text "Set this version as the current one") footer db key - +changeCurrent db key id = do + b <- io $ setCurrent db key id + if b then showPage db key + else standardQuery key $ do + text "Could not set this revision as the current active one." + p empty + linkKey db key ex [] = return () ex ((Paragraph):xs) = do @@ -104,11 +112,19 @@ ex ((Text s):xs) = do ex ((Link l d):xs) = do hlink (URL {unURL = ("wiki?"++l)}) (text d) ex xs +ex ((Bold d):xs) = do + b (ex d) + ex xs +ex ((Emph d):xs) = do + em (ex d) + ex xs ex2 [] = [] ex2 ((Paragraph):xs) = "

"++ex2 xs ex2 ((Text s):xs) = s++ex2 xs ex2 ((Link l d):xs) = ""++ex2 xs +ex2 ((Bold d):xs) = ""++ex2 d++""++ex2 xs +ex2 ((Emph d):xs) = ""++ex2 d++""++ex2 xs test s = case parse wikiParser "" s of