X-Git-Url: https://ruin.nu/git/?a=blobdiff_plain;f=Wiki.hs;h=5e75da1958e2c494a7ac6e643c939e4c28c4f366;hb=HEAD;hp=94f4a5f433000c2a86cbd8eb19cc7ca1f8dffb8d;hpb=625a2981711271d1f5841c55978d69881d6054da;p=yawbih.git diff --git a/Wiki.hs b/Wiki.hs index 94f4a5f..5e75da1 100644 --- a/Wiki.hs +++ b/Wiki.hs @@ -6,7 +6,8 @@ module Wiki ( ,FontOp (Bold, Emph, Mono, Underline, Strike) ,Document ,wikiParser - ,htmlOutput + ,toHtml + ,toLatex ) where @@ -49,8 +50,13 @@ type Document = [Markup] wikiParser :: Parser Document wikiParser = many1 pMain +firstInLineChars = "#*=" + pPara :: Parser Markup -pPara = count 2 pEol >> return (Paragraph) +pPara = do + count 2 pEol + notFollowedBy $ oneOf firstInLineChars + return (Paragraph) pLink :: Parser Markup pLink = do @@ -67,16 +73,21 @@ pList enum = do pListItem :: Bool -> Parser [Markup] pListItem enum = do - many1 pEol + pEol char $ listToken enum - many pOneLine + many (pOneLine <|> try (pOneEol)) + +pOneEol = do + c <- pEol + notFollowedBy (oneOf $ firstInLineChars++"\r\n") + return c listToken True = '#' listToken False = '*' pHeading :: Parser Markup pHeading = do - many1 pEol + pEol level <- many1 $ char '=' s <- pStopAt level return (Heading (length level) s) @@ -242,21 +253,44 @@ toHtml [] = [] toHtml ((Paragraph):xs) = "

\n"++toHtml xs toHtml ((Text s):xs) = s++toHtml xs toHtml ((Link l d):xs) = ""++toHtml xs -toHtml ((Font o d):xs) = "<"++fontOp o++">"++toHtml d++""++toHtml xs +toHtml ((Font o d):xs) = "<"++htmlFontOp o++">"++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) = "

"++toHtml s++"
"++toHtml xs -toHtml ((List o l):xs) = "<"++listType o++">\n"++(unlines $ map (\s -> "
  • "++toHtml s++"
  • \n") l) ++ ""++toHtml xs - -listType True = "ol" -listType False = "ul" - -fontOp Bold = "b" -fontOp Emph = "em" -fontOp Mono = "tt" -fontOp Underline = "u" -fontOp Strike = "strike" - -htmlOutput s = case parse wikiParser "" s of - Right n -> putStr (toHtml n) +toHtml ((List o l):xs) = "<"++htmlListType o++">\n"++(unlines $ map (\s -> "
  • "++toHtml s++"
  • \n") l) ++ ""++toHtml xs + +htmlFontOp Bold = "b" +htmlFontOp Emph = "em" +htmlFontOp Mono = "tt" +htmlFontOp Underline = "u" +htmlFontOp Strike = "strike" + +htmlListType True = "ol" +htmlListType False = "ul" + +toLatex :: [Markup] -> String +toLatex [] = [] +toLatex ((Paragraph):xs) = "\n\n"++toLatex xs +toLatex ((Text s):xs) = s++toLatex xs +toLatex ((Link l d):xs) = "{\\em "++d++"}"++toLatex xs +toLatex ((Font o d):xs) = "{\\"++latexFontOp o++" "++toLatex d++"}"++toHtml xs +toLatex ((Heading n d):xs) = "\n\\"++(unwords $ take (n-1) $ repeat "sub")++"section{"++toLatex d++"}"++"\n\n"++toLatex xs +toLatex ((Url l):xs) = "{\\bf "++l++"}"++toLatex xs +toLatex ((Pre s):xs) = "
    "++toLatex s++"
    "++toLatex xs +toLatex ((List o l):xs) = "\n\\begin{"++latexListType o++"}\n"++(unlines $ map (\s -> "\\item "++toLatex s++"\n") l) ++ "\\end{"++latexListType o++"}"++toLatex xs + +latexFontOp Bold = "bf" +latexFontOp Emph = "em" +latexFontOp Mono = "tt" +latexFontOp Underline = "u" +latexFontOp Strike = "strike" + +latexListType True = "enumeration" +latexListType False = "itemize" + +output s f = case parse wikiParser "" s of + Right n -> putStr (f n) Left e -> print e + +htmlOutput s = output s toHtml +latexOutput s = output s toLatex