X-Git-Url: https://ruin.nu/git/%3CTMPL_VAR%20NAME=PAGE%3E?a=blobdiff_plain;f=Main.hs;h=2fdbbd559f99c7f082766cae3b026e4852bc2701;hb=refs%2Fheads%2Fmaster;hp=2457b058632e32edc520c090bf631d33f86b5063;hpb=b9ff8d1cc183f8f07056efb4680b8b56556d4246;p=yawbih.git diff --git a/Main.hs b/Main.hs index 2457b05..2fdbbd5 100644 --- a/Main.hs +++ b/Main.hs @@ -6,18 +6,17 @@ import CGIOutput import CGITypes import System import Wiki +import Backend +import Control.Monad import Text.ParserCombinators.Parsec -testDB = createPGB "wave" "wiki" "wiki" "12wiki34db" - ---main = start [] cgi +--backend = createPGB "hostname" "database" "user" "password" +--If you want to implement this function here, then remove the import of Backend main = do - db <- testDB - runWithHook [] (\(key:act) -> showPage db (filter (/= '\\') key)) $ showPage db "MainPage" - -ps a = standardQuery "Hello" a + db <- backend + runWithHook [] (\(key:act) -> showPage db (filter (/= '\\') key)) $ showPage db "itproj3" editPage db key = do s <- io $ getCurrent db key @@ -25,17 +24,14 @@ editPage db key = do Nothing -> return "" Just (x,_) -> return x standardQuery key $ do - t <- p $ makeTextarea s' (attr_SS "rows" "10" ## attr_SS "cols" "75" ## attr_SS "colspan" "2") + t <- p $ makeTextarea s' (attr_SS "rows" "25" ## attr_SS "cols" "120" ## attr_SS "colspan" "2") p empty text "Author: " a <- textInputField (fieldSIZE 20) p empty text "Comment: " c <- textInputField (fieldSIZE 20) - --p $ submit (F2 t a) testing (attr "value" "Send") p $ defaultSubmit (F3 t a c) (savePage db key) (attr "value" "Send") - --submit0 (sp db key []) (attr "value" "Send1") - savePage db key (F3 t a c) = do io $ update db key fulltext author comment @@ -55,27 +51,63 @@ showPage db key = do p $ tt $ text $ "Last edited: "++date footer db key +showLatex 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 + parseLatex full + p $ tt $ text $ "Last edited: "++date + footer db key + parseText full = case parse wikiParser "" full of - Right n -> ex n + Right n -> toWash n Left e -> do text "PARSE ERROR: " text (show e) p $ text full +parseLatex full = case parse wikiParser "" full of + Right n -> pre $ text $ toLatex n + Left e -> do + text "PARSE ERROR: " + text (show e) + footer db key = do hr empty - table $ tr $ do - td $ submitLink0 (editPage db key) (text "Edit this keyword") - td $ submitLink0 (listRevs db key) (text "List old versions") + table $ do + tr $ do td $ text "Keyword: " - td $ activate (showPage db) textInputField empty + searchKey <- td $ textInputField empty + td $ defaultSubmit (F1 searchKey) (\(F1 sk) -> showPage db (value sk)) (attr "value" "Go") + tr $ do + td $ submitLink0 (showPage db "itproj3") (text "Back to main page") + when (e key) $ td $ submitLink0 (editPage db key) (text "Edit this keyword") + when (e key) $ td $ submitLink0 (listRevs db key) (text "List old versions") + when (e key) $ td $ submitLink0 (showLatex db key) (text "Output latex") + td $ submitLink0 (listKeywords db) (text "List all keywords") + --td $ activate (showPage db) textInputField empty + +e "" = False +e _ = True 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 + standardQuery key $ do + table $ do + tr $ mapM (\header -> th (text header)) + ["Id", "Date", "Author", "Comment"] + mapM (revRow db key) list + footer db key + +listKeywords db = do + list <- io $ listKeys db + standardQuery "List of keywords" $ do + table (do + tr $ th (text "Keyword") + mapM (\key -> tr $ td $ linkKey db key) list) + footer db "" linkKey db key = submitLink0 (showPage db key) (text key) @@ -102,33 +134,47 @@ changeCurrent db key id = do p empty linkKey db key -ex [] = return () -ex ((Paragraph):xs) = do +toWash [] = return () +toWash ((Paragraph):xs) = do p empty - ex xs -ex ((Text s):xs) = do + toWash xs +toWash ((Text s):xs) = do text s - ex xs -ex ((Link l d):xs) = do + toWash xs +toWash ((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) = "