X-Git-Url: https://ruin.nu/git/?a=blobdiff_plain;f=Wiki.hs;h=7d337c9f679b3b14ce01e1bf6716864a3390fb6d;hb=cfd9357931f136f52df2becd0af605111e102234;hp=d6ece0dc5f4d94829dd09bfd86f657be3927f781;hpb=a3c05f5d3f4be5f28a3eae7739f138a07fa263ad;p=yawbih.git diff --git a/Wiki.hs b/Wiki.hs index d6ece0d..7d337c9 100644 --- a/Wiki.hs +++ b/Wiki.hs @@ -2,11 +2,15 @@ module Wiki ( Backend (getCurrent,getList,get,setCurrent,update) ,PGB ,createPGB + ,Markup (Text, Paragraph, Link) + ,Document + ,wikiParser ) where import Dbconnect import Data.Char +import Text.ParserCombinators.Parsec class Backend a where --Keyword -> (Full text,date) @@ -16,7 +20,7 @@ class Backend a where getList :: a -> String -> IO [(String, String, String, String)] --Keyword -> id -> Full text - get :: a -> String -> String -> IO String + get :: a -> String -> String -> IO (Maybe String) --Keyword -> id -> () setCurrent :: a -> String -> String -> IO Bool @@ -25,11 +29,57 @@ class Backend a where update :: a -> String -> String -> String -> String -> IO String data Markup = Text String - | Bold String - | Paragraph [Markup] + | Paragraph + | Link String String type Document = [Markup] +wikiParser :: GenParser Char st Document +wikiParser = do + s <- (try (pPara) + <|> pSpace + <|> try (pLinkLong) + <|> try (pLink) + <|> pOtherChar + <|> pText) + ss <- (wikiParser <|> return []) + return (s:ss) + +pPara = do + pEol + pEol + return (Paragraph) + + +pSpace = do + space + return (Text " ") + +pEol = char '\n' <|> do + char '\r' + char '\n' + +pLinkLong = do + string "[[" + l <- many1 $ noneOf ['|'] + char '|' + d <- many1 $ noneOf "]" + string "]]" + return (Link l d) +pLink = do + string "[[" + l <- many1 $ noneOf "]" + string "]]" + return (Link l l) +pOtherChar = do + c <- oneOf ",;.:!?[]()\'\"=-%$£<>/\\|" + return (Text (c:[])) + +pText = do + t <- many1 alphaNum--(noneOf ['\n','\r','[',']']) + return (Text t) + + newtype PGB = PGB DBService createPGB :: String -> String -> String -> String -> IO PGB @@ -50,7 +100,11 @@ instance Backend PGB where list <- selectReturnTuples db $ "SELECT id, timestamp, author, comment from fulltexts WHERE keyword = "++tov key return $ map (\[id,date,author,comment] -> (id,date,author,comment)) list - get (PGB db) key id = return "" + 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++"'"