"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
horizontalLine :: Parser BlockElement
-horizontalLine = try ( do count 4 (char '-')
- many (char '-')
+horizontalLine = try ( do _ <- count 4 (char '-')
+ _ <- many (char '-')
ws
eol
return HorizontalLine
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
)
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
xs <- description
return (x:xs)
<|>
- try ( do newline
- char ':'
- ws
+ try ( do _ <- newline
+ _ <- char ':'
+ _ <- ws
xs <- description
return (Text "\n" : xs)
)
verbatim :: Parser BlockElement
-verbatim = do try (string "<!verbatim[")
- many (oneOf " \t\n")
+verbatim = do _ <- try (string "<!verbatim[")
+ _ <- many (oneOf " \t\n")
x <- verbatim'
return (Preformatted [Text x])
where
verbatim' :: Parser String
- verbatim' = do try (many (oneOf " \t\n") >> string "]>")
+ verbatim' = do _ <- try (many (oneOf " \t\n") >> string "]>")
return []
<|>
do x <- anyChar
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'
nowiki = liftM Text (try (string "<!nowiki[") >> nowiki')
where
nowiki' :: Parser String
- nowiki' = do try (string "]>")
+ nowiki' = do _ <- try (string "]>")
return []
<|>
do x <- anyChar
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
(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 "]")))
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)