Resurrection from slight bitrot.

[Rakka.git] / Rakka / Wiki / Parser.hs

diff --git a/Rakka/Wiki/Parser.hs b/Rakka/Wiki/Parser.hs
index 19170b1fb1a941a9709968d24b2ae007c7563d37..1744570b1bd5a27d805523ff9252cdc8eaece0fc 100644 (file)
--- 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 "<!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
@@ -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[") >> 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)