X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Rakka.git;a=blobdiff_plain;f=Rakka%2FWiki%2FParser.hs;h=1744570b1bd5a27d805523ff9252cdc8eaece0fc;hp=19170b1fb1a941a9709968d24b2ae007c7563d37;hb=fcddebcc3cc02ae8d1904b9338334d538019e74a;hpb=01a4a132192ed8b65c8aa7b86cb0e9bc08b725ff diff --git a/Rakka/Wiki/Parser.hs b/Rakka/Wiki/Parser.hs index 19170b1..1744570 100644 --- a/Rakka/Wiki/Parser.hs +++ b/Rakka/Wiki/Parser.hs @@ -48,7 +48,7 @@ heading = foldr (<|>) pzero (map heading' [1..5]) "heading" where heading' :: Int -> Parser BlockElement - heading' n = do try $ do count n (char '=') + heading' n = do try $ do _ <- count n (char '=') notFollowedBy (char '=') ws x <- notFollowedBy (char '=') >> anyChar @@ -63,8 +63,8 @@ heading = foldr (<|>) pzero (map heading' [1..5]) horizontalLine :: Parser BlockElement -horizontalLine = try ( do count 4 (char '-') - many (char '-') +horizontalLine = try ( do _ <- count 4 (char '-') + _ <- many (char '-') ws eol return HorizontalLine @@ -87,15 +87,15 @@ listElement cmdTypeOf = listElement' [] items stack = do xs <- many1 $ inlineElement cmdTypeOf nested <- option Nothing $ try $ do skipMany comment - newline - string stack + _ <- newline + _ <- string stack liftM Just (listElement' stack) rest <- items stack return $ (map Inline xs ++ map Block (catMaybes [nested])) : rest <|> (try $ do skipMany comment - newline - string stack + _ <- newline + _ <- string stack ws items stack ) @@ -112,8 +112,8 @@ definitionList :: CommandTypeOf -> Parser BlockElement definitionList cmdTypeOf = liftM DefinitionList (many1 definition) where definition :: Parser Definition - definition = do char ';' - ws + definition = do _ <- char ';' + _ <- ws tHead <- inlineElement cmdTypeOf tRest <- term d <- description @@ -137,9 +137,9 @@ definitionList cmdTypeOf = liftM DefinitionList (many1 definition) xs <- description return (x:xs) <|> - try ( do newline - char ':' - ws + try ( do _ <- newline + _ <- char ':' + _ <- ws xs <- description return (Text "\n" : xs) ) @@ -152,13 +152,13 @@ definitionList cmdTypeOf = liftM DefinitionList (many1 definition) verbatim :: Parser BlockElement -verbatim = do try (string "> string "]>") + verbatim' = do _ <- try (many (oneOf " \t\n") >> string "]>") return [] <|> do x <- anyChar @@ -192,21 +192,27 @@ paragraph cmdTypeOf = liftM Paragraph paragraph' where paragraph' :: Parser [InlineElement] paragraph' = do x <- inlineElement cmdTypeOf - xs <- try ( do newline - eof + xs <- try ( do _ <- newline + _ <- eof return [] -- \n で文字列が終はってゐたら、ここ -- で終了。 ) <|> - try ( do newline - ((oneOf ('\n':blockSymbols) >> pzero) <|> return ()) + try ( do _ <- newline + _ <- ((oneOf ('\n':blockSymbols) >> pzero) <|> return ()) ys <- (paragraph' <|> return []) return (Text "\n" : ys) -- \n があり、その次に \n または -- blockSymbols があれば、fail して -- 最初の newline を讀んだ所まで卷き -- 戻す。 + + -- FIXME: 本當にそのやうな動作になつ + -- てゐるか？偶然動いてゐるだけではな + -- いか？確かにこの實裝でユニットテス + -- トは通るのだが、私の理解を越えてし + -- まったやうだ。 ) <|> paragraph' @@ -290,7 +296,7 @@ nowiki :: Parser InlineElement nowiki = liftM Text (try (string "> nowiki') where nowiki' :: Parser String - nowiki' = do try (string "]>") + nowiki' = do _ <- try (string "]>") return [] <|> do x <- anyChar @@ -337,18 +343,18 @@ apostrophes cmdTypeOf = foldr (<|>) pzero (map try [apos1, apos2, apos3, apos4, objLink :: Parser InlineElement -objLink = do try (string "[[[") +objLink = do _ <- try (string "[[[") page <- many1 (noneOf "|]") label <- option Nothing (liftM Just (char '|' >> many1 (satisfy (/= ']')))) - string "]]]" + _ <- string "]]]" return $ ObjectLink page label "object link" pageLink :: Parser InlineElement -pageLink = do try (string "[[") +pageLink = do _ <- try (string "[[") page <- option Nothing (liftM Just (many1 (noneOf "#|]"))) fragment <- option Nothing @@ -360,16 +366,16 @@ pageLink = do try (string "[[") (Nothing, Nothing) -> pzero (_, _) -> return () - string "]]" + _ <- string "]]" return $ PageLink page fragment label "page link" extLink :: Parser InlineElement -extLink = do char '[' +extLink = do _ <- char '[' uriStr <- many1 (noneOf " \t]") - skipMany (oneOf " \t") + _ <- skipMany (oneOf " \t") label <- option Nothing (liftM Just (many1 (noneOf "]"))) @@ -421,48 +427,48 @@ inlineCmd cmdTypeOf openTag :: Parser (String, [Attribute]) -openTag = try $ do char '<' - many space +openTag = try $ do _ <- char '<' + _ <- many space name <- many1 letter - many space + _ <- many space attrs <- many $ do attr <- tagAttr - many space + _ <- many space return attr - char '>' + _ <- char '>' return (name, attrs) emptyTag :: Parser (String, [Attribute]) -emptyTag = try $ do char '<' - many space +emptyTag = try $ do _ <- char '<' + _ <- many space name <- many1 letter - many space + _ <- many space attrs <- many $ do attr <- tagAttr - many space + _ <- many space return attr - char '/' - many space - char '>' + _ <- char '/' + _ <- many space + _ <- char '>' return (name, attrs) closeTag :: String -> Parser () -closeTag name = try $ do char '<' - many space - char '/' - many space - string name - many space - char '>' +closeTag name = try $ do _ <- char '<' + _ <- many space + _ <- char '/' + _ <- many space + _ <- string name + _ <- many space + _ <- char '>' return () tagAttr :: Parser (String, String) tagAttr = do name <- many1 letter - char '=' - char '"' + _ <- char '=' + _ <- char '"' value <- many (satisfy (/= '"')) - char '"' + _ <- char '"' return (name, value)