- list <- selectReturnTuples db $ "SELECT id, timestamp, author, comment from fulltexts where keyword = '"++key++"'"
- return $ map (\[id,date,author,comment] -> (id,date,author,comment)) list
-
- get (PGB db) key id = return ""
-
- setCurrent (PGB db) key id = return ()
-
- addNew (PGB db) key text = return ""
-
+ list <- selectReturnTuples db $ "SELECT id, timestamp, author, comment from fulltexts WHERE keyword = "++tov key
+ case list of
+ [[]] -> return []
+ _ -> return $ map (\[id,date,author,comment] -> (id,date,author,comment)) list
+
+ get (PGB db) key id = do
+ list <- selectReturnTuples db $ "SELECT fulltext from fulltexts WHERE id = "++tov id
+ case list of
+ [s]:_ -> return (Just s)
+ _ -> return Nothing
+
+ setCurrent (PGB db) key id = do
+ full <- selectReturnTuples db $ "SELECT keyword FROM fulltexts WHERE keyword="++tov key++" AND id='"++id++"'"
+ cur <- selectReturnTuples db $ "SELECT keyword FROM curtexts WHERE keyword="++tov key
+ case full of
+ [[]] -> do
+ return False
+ _ -> do
+ rows <- case cur of
+ [[]] -> do
+ execute db $ "INSERT INTO current (keyword, id) VALUES ("++tov key++","++tov id++")"
+ _ -> do
+ execute db $ "UPDATE current SET id = "++tov id++" WHERE keyword = "++tov key
+ if rows == 1 then return True
+ else return False
+
+ update (PGB db) key text author comment = do
+ rows <- execute db $ "INSERT INTO fulltexts (keyword,fulltext, author, comment) VALUES ("++tov key++","++tov text++","++tov author++","++tov comment++")"
+ if rows == 0 then return ""
+ else do
+ [[id]] <- selectReturnTuples db $ "SELECT currval('fulltexts_id_seq')"
+ setCurrent (PGB db) key id
+ return id
+
+ listKeys (PGB db) = do
+ list <- selectReturnTuples db $ "SELECT keyword FROM fulltexts GROUP BY keyword ORDER BY lower(keyword)"
+ case list of
+ [[]] -> return []
+ _ -> mapM (\[key] -> return key) list
+
+
+
+tov :: String -> String
+tov s = '\'':escapeQuery s++"'"
+
+toHtml :: [Markup] -> String
+toHtml [] = []
+toHtml ((Paragraph):xs) = "<p>\n"++toHtml xs
+toHtml ((Text s):xs) = s++toHtml xs
+toHtml ((Link l d):xs) = "<link: "++l++" desc: "++d++">"++toHtml xs
+toHtml ((Bold d):xs) = "<b>"++toHtml d++"</b>"++toHtml xs
+toHtml ((Emph d):xs) = "<em>"++toHtml d++"</em>"++toHtml xs
+toHtml ((Underline d):xs) = "<u>"++toHtml d++"</u>"++toHtml xs
+toHtml ((Strike d):xs) = "<strike>"++toHtml d++"</strike>"++toHtml xs
+toHtml ((Heading n d):xs) = "\n<h"++show n++">"++toHtml d++"</h"++show n++">\n"++toHtml xs
+toHtml ((Url l):xs) = "<link: "++l++">"++toHtml xs
+toHtml ((Pre s):xs) = "<pre>"++s++"</pre>"++toHtml xs
+
+
+htmlOutput s = case parse wikiParser "" s of
+ Right n -> do
+ putStr (toHtml n)
+ Left e -> do
+ print e