fucking hell inline html is a bitch
This commit is contained in:
parent
f5eb2e7657
commit
57126ef6be
2 changed files with 20 additions and 5 deletions
|
|
@ -4,6 +4,7 @@
|
|||
|
||||
module Markdown (markdownParser) where
|
||||
|
||||
import Data.Functor
|
||||
import Data.Text
|
||||
import IR
|
||||
import Text.Parsec
|
||||
|
|
@ -60,12 +61,25 @@ escapedChar = char '\\' *> fmap Escaped visibleChar
|
|||
|
||||
htmlInline :: Parser InlineText
|
||||
htmlInline = do
|
||||
_ <- char '<'
|
||||
char '<'
|
||||
tagName <- name
|
||||
remaining <- htmlInlineRemainder
|
||||
pure $ HTMLIn $ pack $ '<' : remaining
|
||||
whiteSpace
|
||||
char '>'
|
||||
let remainingTagText = foldl' (\ongoing current -> ongoing ++ ' ' : current) "" remaining
|
||||
|
||||
pure $ HTMLIn $ pack $ '<' : name ++ remaining
|
||||
where
|
||||
htmlInlineRemainder = tagName *> attrList
|
||||
tagName = many $ choice [alphaNum, char '-', char ':']
|
||||
htmlInlineRemainder = many $ whiteSpace *> attribute
|
||||
name = many $ choice [alphaNum, char '-', char ':']
|
||||
attribute = do
|
||||
attrName <- name
|
||||
char '='
|
||||
attrValue <- value
|
||||
pure attrName ++ '=' :
|
||||
|
||||
whiteSpace :: Parser Text
|
||||
whiteSpace = pack <$> many space
|
||||
|
||||
visibleChar :: Parser Char
|
||||
-- technically more strict but I'm just going to hope I never have to deal with that
|
||||
|
|
|
|||
|
|
@ -126,7 +126,8 @@ entity-name = 1*( ALPHA / DIGIT )
|
|||
; HTML attributes and tag content
|
||||
tag-name = ALPHA *( ALPHA / DIGIT / "-" / ":" )
|
||||
attribute = attribute-name [ "=" attribute-value ]
|
||||
attribute-name = ( ALPHA / "_" / ":" ) *( ALPHA / DIGIT / "-" / "_" / ":" / "." )
|
||||
attribute-name = ALPHA *( ALPHA / DIGIT / "-" / ":" )
|
||||
|
||||
attribute-value = DQUOTE attribute-value-dquote DQUOTE /
|
||||
"'" attribute-value-squote "'" /
|
||||
attribute-value-unquoted
|
||||
|
|
|
|||
Loading…
Reference in a new issue