more robust link parsing

diff --git a/Main.hs b/Main.hs
index 324241616b6b4c462ceceddd58b41fb525af98e1..b1b4f5736db06aa1a13c2935873ccda28360d129 100644 (file)
--- a/Main.hs
+++ b/Main.hs
@@ -118,11 +118,17 @@ ex ((Bold d):xs) = do
 ex ((Emph d):xs) = do
        em (ex d)
        ex xs
+ex ((Underline d):xs) = do
+       u (ex d)
+       ex xs
+ex ((Strike d):xs) = do
+       strike (ex d)
+       ex xs
 ex ((Heading n d):xs) = do
        heading n $ ex d
        ex xs
 ex ((Url l):xs) = do
-       hlink (URL {unURL = ("wiki?"++l)}) (text l)
+       hlink (URL {unURL = (l)}) (text l)
        ex xs
 
 heading 1 = h1
@@ -133,17 +139,19 @@ heading 5 = h5
 heading 6 = h6
 
 ex2 [] = []
-ex2 ((Paragraph):xs) = "<p>"++ex2 xs
+ex2 ((Paragraph):xs) = "<p>\n"++ex2 xs
 ex2 ((Text s):xs) = s++ex2 xs
 ex2 ((Link l d):xs) = "<link: "++l++" desc: "++d++">"++ex2 xs
 ex2 ((Bold d):xs) = "<b>"++ex2 d++"</b>"++ex2 xs
 ex2 ((Emph d):xs) = "<em>"++ex2 d++"</em>"++ex2 xs
-ex2 ((Heading n d):xs) = "<h"++show n++">"++ex2 d++"</h"++show n++">"++ex2 xs
+ex2 ((Underline d):xs) = "<u>"++ex2 d++"</u>"++ex2 xs
+ex2 ((Strike d):xs) = "<strike>"++ex2 d++"</strike>"++ex2 xs
+ex2 ((Heading n d):xs) = "\n<h"++show n++">"++ex2 d++"</h"++show n++">\n"++ex2 xs
 ex2 ((Url l):xs) = "<link: "++l++">"++ex2 xs
 
 
 test s = case parse wikiParser "" s of
                                        Right n -> do 
-                                               print (ex2 n)
+                                               putStr (ex2 n)
                                        Left e -> do
                                                print e

diff --git a/Wiki.hs b/Wiki.hs
index 59e592938df2e7fbb25634bb30b65dd357f05735..83827cc1a6e6fbb9e04059f91350b99a0ae824cd 100644 (file)
--- a/Wiki.hs
+++ b/Wiki.hs
@@ -2,7 +2,7 @@ module Wiki (
        Backend (getCurrent,getList,get,setCurrent,update)
        ,PGB
        ,createPGB
-       ,Markup (Text, Paragraph, Link, Bold, Emph, Heading, Url)
+       ,Markup (Text, Paragraph, Link, Bold, Emph, Heading, Url, Underline, Strike)
        ,Document
        ,wikiParser
 
@@ -35,6 +35,8 @@ data Markup = Text String
        | Emph [Markup]
        | Heading Int [Markup]
        | Url String
+       | Underline [Markup]
+       | Strike [Markup]
 
 type Document = [Markup]
 
@@ -58,19 +60,22 @@ pEol = char '\n' <|> do
        char '\r'
        char '\n'
 
-pLinkLong = do
-       string "[["
-       l <- many1 $ noneOf ['|']
-       char '|'
-       d <- many1 $ noneOf "]" 
-       string "]]"
-       return (Link l d)
+pLinkParser = do try (string "]]" >> return ([],[])) 
+       <|> try (do
+               string " | "
+               d <- pString "]]"
+               return ([],d))
+       <|> (do
+               c <- anyChar
+               (l,d) <- pLinkParser
+               return (c:l,d))
 
 pLink = do
        string "[["
-       l <- many1 $ noneOf "]"
-       string "]]"
-       return (Link l l)
+       (l,d) <- pLinkParser
+       case d of
+               [] -> return (Link l l)
+               _ -> return (Link l d)
 
 pBold = do
        string "**"
@@ -82,12 +87,28 @@ pEmph = do
        s <- pStringParser "//"
        return (Emph s)
 
+pUnderline = do
+       string "__"
+       s <- pStringParser "__"
+       return (Underline s)
+
+pStrike = do
+       string "--"
+       s <- pStringParser "--"
+       return (Strike s)
+
 pStringParser xs = do 
        try (string xs >> return []) <|> (do
                s <- pMain 
                ss <- pStringParser xs
                return (s:ss))
 
+pString xs = do
+       try (string xs >> return []) <|> (do
+       s <- anyChar
+       ss <- pString xs
+       return (s:ss))
+       
 pHeading = do
        many1 pEol
        level <- many1 $ char '='
@@ -106,7 +127,8 @@ pMain = try (pHeading)
        <|> pSpace 
        <|> try(pBold) 
        <|> try(pEmph) 
-       <|> try (pLinkLong)
+       <|> try(pUnderline) 
+       <|> try(pStrike) 
        <|> try (pLink)
        <|> try (pURL)
        <|> pOtherChar
@@ -139,7 +161,9 @@ instance Backend PGB where
 
        getList (PGB db) key = do
                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
+               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