diff --git a/README.md b/README.md index 9d4ae62..78645d9 100644 --- a/README.md +++ b/README.md @@ -12,7 +12,7 @@ A [Markdown](https://www.markdownguide.org/) parser for idris2 - [ ] Blockquote - [ ] Unordered List - [ ] Ordered List -- [ ] Horizontal Rule +- [x] Horizontal Rule - [ ] Image ## Extended Syntax diff --git a/src/Language/Markdown/Data.idr b/src/Language/Markdown/Data.idr index 952bbc7..dd066d7 100644 --- a/src/Language/Markdown/Data.idr +++ b/src/Language/Markdown/Data.idr @@ -6,7 +6,7 @@ import Data.List -- 行内元素 public export -data Inline = MBold String | MBare String | MCode String | MItalic String +data Inline = MBold String | MBare String | MCode String | MItalic String public export Show Inline where @@ -25,17 +25,21 @@ Eq Inline where -- 块级元素 public export -data Block = MLine (List Inline) | MHeading Int (List Inline) +data Block = MLine (List Inline) | MHeading Int (List Inline) | MHorizontal | MSpaceLine public export Show Block where show (MLine s) = "MLine(" ++ show s ++ ")" show (MHeading n s) = "MHeading " ++ show n ++ " (" ++ show s ++ ")" + show MHorizontal = "MHorizontal" + show MSpaceLine = "MSpaceLine" export Eq Block where (MLine x) == (MLine y) = x == y (MHeading s x) == (MHeading t y) = s == t && x == y + MHorizontal == MHorizontal = True + MSpaceLine == MSpaceLine = True _ == _ = False public export diff --git a/src/Language/Markdown/Lexer.idr b/src/Language/Markdown/Lexer.idr index d4acd1e..f977533 100644 --- a/src/Language/Markdown/Lexer.idr +++ b/src/Language/Markdown/Lexer.idr @@ -50,11 +50,12 @@ markdownTokenMap : TokenMap MarkdownToken markdownTokenMap = toTokenMap [ (multNewLine, MKBreak), (spaceLineBreak, MKBreak), - -- (code, MKCode), + (newline, MKSoftBreak), (is ' ', MKSpace), (is '#', MKNumberSign), (is '*', MKAsterisk), (is '_', MKUnderline), + (is '-', MKDash), (is '`', MKBackQuote), (any, MKText) ] diff --git a/src/Language/Markdown/Parser.idr b/src/Language/Markdown/Parser.idr index e40c092..fb99066 100644 --- a/src/Language/Markdown/Parser.idr +++ b/src/Language/Markdown/Parser.idr @@ -3,6 +3,8 @@ module Language.Markdown.Parser import Language.Markdown.Data import Text.Parser import Data.List +import Data.Nat + import public Language.Markdown.Tokens @@ -26,22 +28,38 @@ mergeBare : List Inline -> List Inline mergeBare = foldr consBare [] private -isT : Token MarkdownTokenKind -> Bool -isT (Tok MKAsterisk _) = True -isT _ = True +softbreak : Grammar state MarkdownToken True String +softbreak = do + match MKSoftBreak + pure " " + +-- 水平线 +private +horizontal : Grammar state MarkdownToken (isSucc (min (atLeast 3)) || Delay True) Block +horizontal = do + _ <- many $ match MKSpace + _ <- count (atLeast 3) $ match MKDash + _ <- many $ match MKSpace + maybeNewline <|> match MKSoftBreak + pure $ MHorizontal + +spaceLine : Grammar state MarkdownToken True Block +spaceLine = do + _ <- some $ match MKBreak + pure $ MSpaceLine mutual private document : Grammar state MarkdownToken True Markdown document = do - vals <- some (heading <|> line) + vals <- some (heading <|> horizontal <|> line <|> spaceLine) pure $ MDoc $ forget vals textNumberSign : Grammar state MarkdownToken True Inline textNumberSign = pure $ MBare !(match MKNumberSign) textSpace : Grammar state MarkdownToken True Inline - textSpace = pure $ MBare !(match MKSpace) + textSpace = pure $ MBare !(match MKSpace <|> softbreak) private heading : Grammar state MarkdownToken True Block @@ -112,7 +130,7 @@ mutual pure $ MBare "**" bare : Grammar state MarkdownToken True Inline - bare = do vals <- some $ (match MKText <|> match MKSpace) + bare = do vals <- some $ (match MKText <|> match MKSpace <|> match MKDash) pure $ MBare $ concat1 vals export diff --git a/src/Language/Markdown/Tokens.idr b/src/Language/Markdown/Tokens.idr index 435ed7a..bb55932 100644 --- a/src/Language/Markdown/Tokens.idr +++ b/src/Language/Markdown/Tokens.idr @@ -10,10 +10,10 @@ data MarkdownTokenKind | MKText | MKSpace | MKBreak + | MKSoftBreak | MKBackQuote | MKUnderline - | MKCode - | MKItalic + | MKDash public export Eq MarkdownTokenKind where @@ -22,10 +22,10 @@ Eq MarkdownTokenKind where (==) MKText MKText = True (==) MKSpace MKSpace = True (==) MKBreak MKBreak = True + (==) MKSoftBreak MKSoftBreak = True (==) MKBackQuote MKBackQuote = True (==) MKUnderline MKUnderline = True - (==) MKCode MKCode = True - (==) MKItalic MKItalic = True + (==) MKDash MKDash = True (==) _ _ = False public export @@ -35,16 +35,15 @@ Show MarkdownTokenKind where show MKText = "MKText" show MKSpace = "MKSpace" show MKBreak = "MKBreak" + show MKSoftBreak = "MKSoftBreak" show MKBackQuote = "MKBackQuote" show MKUnderline = "MKUnderline" - show MKCode = "MKCode" - show MKItalic = "MKCode" + show MKDash = "MKDash" public export TokenKind MarkdownTokenKind where TokType MKText = String - TokType MKCode = String - TokType MKItalic = String + TokType MKDash = String TokType MKSpace = String TokType MKAsterisk = String TokType MKBackQuote = String @@ -55,10 +54,10 @@ TokenKind MarkdownTokenKind where tokValue MKNumberSign _ = "#" tokValue MKAsterisk _ = "*" tokValue MKText s = s - tokValue MKCode s = strSubstr 1 ((strLength s) - 2) s - tokValue MKItalic s = strSubstr 1 ((strLength s) - 2) s + tokValue MKDash _ = "-" tokValue MKSpace _ = " " tokValue MKBreak _ = () + tokValue MKSoftBreak _ = () tokValue MKBackQuote _ = "`" tokValue MKUnderline _ = "_" diff --git a/test/src/Test/Parser.idr b/test/src/Test/Parser.idr index 55f00b1..ca17465 100644 --- a/test/src/Test/Parser.idr +++ b/test/src/Test/Parser.idr @@ -67,9 +67,23 @@ testItalic = [ , test "测试标题中斜体" $ assertBlocks "## 我是*斜体*" [MHeading 2 [MBare "我是", MItalic "斜体"]] ] +-- 测试行内代码 +private +testHor : List Test +testHor = [ + test "测试水平线" $ assertBlocks "---" [MHorizontal] + , test "测试水平线加空格" $ assertBlocks "--- " [MHorizontal] + , test "测试水平线加后空行" $ assertBlocks "---\n" [MHorizontal] + , test "测试水平线加前软换行" $ assertBlocks "\n---" [MLine [MBare " ---"]] + , test "测试水平线加前硬换行" $ assertBlocks "\n\n---" [MSpaceLine, MHorizontal] + , test "测试水平线加前空格" $ assertBlocks " ---" [MHorizontal] + , test "测试水平线多加-" $ assertBlocks "------- " [MHorizontal] + , test "测试水平线加后字符" $ assertBlocks "---abcd" [MLine [MBare "---abcd"]] +] + export testParser : List Test -testParser = testHeading ++ testBold ++ testCode ++ testItalic +testParser = testHeading ++ testBold ++ testCode ++ testItalic ++ testHor private