X-Git-Url: https://ruin.nu/git/?p=yawbih.git;a=blobdiff_plain;f=Main.hs;h=2fdbbd559f99c7f082766cae3b026e4852bc2701;hp=2aa225ead5154a711fbbc957f3036ad552c0abda;hb=refs%2Fheads%2Fmaster;hpb=fd788a2053b4f32bd80d002329d64272af23759d diff --git a/Main.hs b/Main.hs index 2aa225e..2fdbbd5 100644 --- a/Main.hs +++ b/Main.hs @@ -6,21 +6,16 @@ import CGIOutput import CGITypes import System import Wiki +import Backend import Control.Monad import Text.ParserCombinators.Parsec -testDB = createPGB "localhost" "wiki" "wiki" "12wiki34db" - -test key = do - db <- testDB - s <- getCurrent db key - print s - ---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 + db <- backend runWithHook [] (\(key:act) -> showPage db (filter (/= '\\') key)) $ showPage db "itproj3" editPage db key = do @@ -56,6 +51,16 @@ 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 -> toWash n Left e -> do @@ -63,15 +68,26 @@ parseText full = case parse wikiParser "" full of 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 + table $ do + tr $ do + td $ text "Keyword: " + 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 $ text "Keyword: " - td $ activate (showPage db) textInputField empty + --td $ activate (showPage db) textInputField empty e "" = False e _ = True @@ -128,20 +144,8 @@ toWash ((Text s):xs) = do toWash ((Link l d):xs) = do hlink (URL {unURL = ("wiki?"++l)}) (text d) toWash xs -toWash ((Bold d):xs) = do - b (toWash d) - toWash xs -toWash ((Emph d):xs) = do - em (toWash d) - toWash xs -toWash ((Mono d):xs) = do - tt (toWash d) - toWash xs -toWash ((Underline d):xs) = do - u (toWash d) - toWash xs -toWash ((Strike d):xs) = do - strike (toWash d) +toWash ((Font o d):xs) = do + fontOp o (toWash d) toWash xs toWash ((Heading n d):xs) = do heading n $ toWash d @@ -162,6 +166,12 @@ listType False = ul stripMailto ('m':'a':'i':'l':'t':'o':':':xs) = xs stripMailto xs = xs +fontOp Bold = b +fontOp Emph = em +fontOp Mono = tt +fontOp Underline = u +fontOp Strike = strike + heading 1 = h1 heading 2 = h2 heading 3 = h3