X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FWiki%2FParser.hs;h=912237c7eda8db5b2f7de3ca79e7ad5d257be6fd;hb=522dde5470584bb3f82cb0b4179233724d2408d0;hp=6c5d20722c89f8243b8accc45fe193d771b33f8b;hpb=4e8a07033b0b0ea0961bffb3bab0b6fc9c21afba;p=Rakka.git diff --git a/Rakka/Wiki/Parser.hs b/Rakka/Wiki/Parser.hs index 6c5d207..912237c 100644 --- a/Rakka/Wiki/Parser.hs +++ b/Rakka/Wiki/Parser.hs @@ -5,9 +5,9 @@ module Rakka.Wiki.Parser where import Data.Maybe -import Network.URI +import Network.URI hiding (fragment) import Rakka.Wiki -import Text.ParserCombinators.Parsec +import Text.ParserCombinators.Parsec hiding (label) type CommandTypeOf = String -> Maybe CommandType @@ -34,7 +34,7 @@ blockElement cmdTypeOf , horizontalLine , listElement cmdTypeOf , definitionList cmdTypeOf - , pdata + , verbatim , leadingSpaced cmdTypeOf , paragraph cmdTypeOf , blockCmd cmdTypeOf @@ -73,16 +73,15 @@ horizontalLine = try ( do count 4 (char '-') listElement :: CommandTypeOf -> Parser BlockElement -listElement cmdTypeOf = listElement' [] >>= return . List +listElement cmdTypeOf = listElement' [] where - listElement' :: [Char] -> Parser ListElement + listElement' :: [Char] -> Parser BlockElement listElement' stack = do t <- oneOf "*#" ws xs <- items (stack ++ [t]) - return (ListElement (toType t) xs) + return (List (toType t) xs) - -- ListItem の終了條件は、 items :: [Char] -> Parser [ListItem] items stack = do xs <- many1 $ inlineElement cmdTypeOf nested <- option Nothing @@ -91,7 +90,7 @@ listElement cmdTypeOf = listElement' [] >>= return . List string stack listElement' stack >>= return . Just rest <- items stack - return $ (map Right xs ++ map Left (catMaybes [nested])) : rest + return $ (map Inline xs ++ map Block (catMaybes [nested])) : rest <|> (try $ do skipMany comment newline @@ -105,6 +104,7 @@ listElement cmdTypeOf = listElement' [] >>= return . List toType :: Char -> ListType toType '*' = Bullet toType '#' = Numbered + toType _ = undefined definitionList :: CommandTypeOf -> Parser BlockElement @@ -150,19 +150,19 @@ definitionList cmdTypeOf = many1 definition >>= return . DefinitionList "description of term" -pdata :: Parser BlockElement -pdata = do try (string "> string "]]>") - return [] - <|> - do x <- anyChar - xs <- pdata' - return (x:xs) + verbatim' :: Parser String + verbatim' = do try (many (oneOf " \t\n") >> string "]>") + return [] + <|> + do x <- anyChar + xs <- verbatim' + return (x:xs) leadingSpaced :: CommandTypeOf -> Parser BlockElement @@ -187,10 +187,6 @@ leadingSpaced cmdTypeOf = (char ' ' >> leadingSpaced' >>= return . Preformatted) return [] -blockCommand :: Parser BlockElement -blockCommand = pzero -- not implemented - - paragraph :: CommandTypeOf -> Parser BlockElement paragraph cmdTypeOf = paragraph' >>= return . Paragraph where @@ -271,35 +267,35 @@ blockCmd cmdTypeOf undefinedCmdErr :: String -> BlockElement undefinedCmdErr name = Div [("class", "error")] - [ Paragraph [Text ("The command `" ++ name ++ "' is not defined. " ++ - "Ensure that you haven't mistyped and the module " ++ - "providing the command is actually loaded.") - ] + [ Block (Paragraph [Text ("The command `" ++ name ++ "' is not defined. " ++ + "Make sure you haven't mistyped.") + ]) ] inlineElement :: CommandTypeOf -> Parser InlineElement inlineElement cmdTypeOf = try $ do skipMany comment - foldr (<|>) pzero [ cdata + foldr (<|>) pzero [ nowiki , apostrophes cmdTypeOf , text + , objLink , pageLink , extLink , inlineCmd cmdTypeOf ] -cdata :: Parser InlineElement -cdata = try (string "> cdata' >>= return . Text +nowiki :: Parser InlineElement +nowiki = try (string "> nowiki' >>= return . Text where - cdata' :: Parser String - cdata' = do try (string "]]>") - return [] - <|> - do x <- anyChar - xs <- cdata' - return (x:xs) + nowiki' :: Parser String + nowiki' = do try (string "]>") + return [] + <|> + do x <- anyChar + xs <- nowiki' + return (x:xs) text :: Parser InlineElement @@ -345,13 +341,24 @@ apostrophes cmdTypeOf = foldr (<|>) pzero (map try [apos1, apos2, apos3, apos4, apos n = count n (char '\'') >> notFollowedBy (char '\'') +objLink :: Parser InlineElement +objLink = do try (string "[[[") + page <- many1 (noneOf "|]") + label <- option Nothing + (char '|' >> many1 (satisfy (/= ']')) >>= return . Just) + string "]]]" + return $ ObjectLink page label + + "object link" + + pageLink :: Parser InlineElement pageLink = do try (string "[[") page <- option Nothing (many1 (noneOf "#|]") >>= return . Just) fragment <- option Nothing (char '#' >> many1 (noneOf "|]") >>= return . Just) - text <- option Nothing + label <- option Nothing (char '|' >> many1 (satisfy (/= ']')) >>= return . Just) case (page, fragment) of @@ -359,7 +366,7 @@ pageLink = do try (string "[[") (_, _) -> return () string "]]" - return $ PageLink page fragment text + return $ PageLink page fragment label "page link" @@ -368,11 +375,11 @@ extLink :: Parser InlineElement extLink = do char '[' uriStr <- many1 (noneOf " \t]") skipMany (oneOf " \t") - text <- option Nothing - (many1 (noneOf "]") >>= return . Just) + label <- option Nothing + (many1 (noneOf "]") >>= return . Just) case parseURI uriStr of - Just uri -> char ']' >> return (ExternalLink uri text) + Just uri -> char ']' >> return (ExternalLink uri label) Nothing -> pzero "absolute URI" "external link"