X-Git-Url: https://ruin.nu/git/?p=yawbih.git;a=blobdiff_plain;f=Wiki.hs;fp=Wiki.hs;h=231dda46217123dc1cee063d5dbc150a1c8f4f1f;hp=9db2541a9dcff880b840770e91d9db40a5b2a020;hb=464842463236cab162bb4cffa8bebe8b42f3b3eb;hpb=1f195ec53bd48d4471e92d60f1e83808679a79ce diff --git a/Wiki.hs b/Wiki.hs index 9db2541..231dda4 100644 --- a/Wiki.hs +++ b/Wiki.hs @@ -1,10 +1,11 @@ module Wiki ( - Backend (getCurrent,getList,get,setCurrent,update) + Backend (getCurrent,getList,get,setCurrent,update,listKeys) ,PGB ,createPGB ,Markup (Text, Paragraph, Link, Bold, Emph, Heading, Url, Underline, Strike, Pre) ,Document ,wikiParser + ,htmlOutput ) where @@ -28,6 +29,9 @@ class Backend a where --Keyword -> Full text -> id update :: a -> String -> String -> String -> String -> IO String + --[Keyword] + listKeys :: a -> IO [String] + data Markup = Text String | Paragraph | Link String String @@ -190,9 +194,34 @@ instance Backend PGB where [[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 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) = "

\n"++toHtml xs +toHtml ((Text s):xs) = s++toHtml xs +toHtml ((Link l d):xs) = ""++toHtml xs +toHtml ((Bold d):xs) = ""++toHtml d++""++toHtml xs +toHtml ((Emph d):xs) = ""++toHtml d++""++toHtml xs +toHtml ((Underline d):xs) = ""++toHtml d++""++toHtml xs +toHtml ((Strike d):xs) = ""++toHtml d++""++toHtml xs +toHtml ((Heading n d):xs) = "\n"++toHtml d++"\n"++toHtml xs +toHtml ((Url l):xs) = ""++toHtml xs +toHtml ((Pre s):xs) = "

"++s++"
"++toHtml xs + + +htmlOutput s = case parse wikiParser "" s of + Right n -> do + putStr (toHtml n) + Left e -> do + print e