escaped html stuff that needs escaping, added crossing out text and fixed how plain text consumed everything alongside setup for some future refactoring of parsing
This commit is contained in:
parent
24606b1e83
commit
b834cd6dbb
3 changed files with 48 additions and 9 deletions
24
app/HTML.hs
24
app/HTML.hs
|
|
@ -6,6 +6,19 @@ import Data.Maybe (fromMaybe)
|
|||
import qualified Data.Text as T
|
||||
import IR
|
||||
|
||||
escapeChar :: Char -> T.Text
|
||||
escapeChar '<' = "<"
|
||||
escapeChar '>' = ">"
|
||||
escapeChar '"' = """
|
||||
escapeChar '\'' = "'"
|
||||
escapeChar '&' = "&"
|
||||
escapeChar c = T.singleton c
|
||||
|
||||
-- not effiecient, main optimization would be to have unpack go to
|
||||
-- some haskell vector or array impl rather than the list impl
|
||||
escapeText :: T.Text -> T.Text
|
||||
escapeText = T.concat . map escapeChar . T.unpack
|
||||
|
||||
tshow :: (Show s) => s -> T.Text
|
||||
tshow = T.pack . show
|
||||
|
||||
|
|
@ -15,7 +28,7 @@ compileToHTML (Doc elements) = T.concat $ map elementToHTML elements
|
|||
elementToHTML :: Element -> T.Text
|
||||
elementToHTML (Heading header) = T.concat ["<h", tshow header.level, ">", serializeInlineToHTML header.text, "</h", tshow header.level, ">"]
|
||||
--
|
||||
elementToHTML (Code code_block) = T.concat ["<pre class=\"sourceCode ", language, "\"><code class=\"sourceCode ", language, "\">", code_block.code, "</code>", "</pre>"]
|
||||
elementToHTML (Code code_block) = T.concat ["<pre class=\"sourceCode ", language, "\"><code class=\"sourceCode ", language, "\">", escapeText code_block.code, "</code>", "</pre>"]
|
||||
where
|
||||
language = fromMaybe "" code_block.language
|
||||
elementToHTML (BlockQuote (Q elems)) = T.concat ["<blockquote>", serializeInlineToHTML elems, "</blockquote>"]
|
||||
|
|
@ -40,10 +53,11 @@ generateLiElems (element : remainder) =
|
|||
|
||||
serializeInlineToHTML :: [InlineText] -> T.Text
|
||||
serializeInlineToHTML [] = ""
|
||||
serializeInlineToHTML (Text t : remaining) = t <> serializeInlineToHTML remaining
|
||||
serializeInlineToHTML (Text t : remaining) = escapeText t <> serializeInlineToHTML remaining
|
||||
serializeInlineToHTML (Bold elems : remaining) = T.concat ["<b>", serializeInlineToHTML elems, "</b>", serializeInlineToHTML remaining]
|
||||
serializeInlineToHTML (Italic elems : remaining) = T.concat ["<i>", serializeInlineToHTML elems, "</i>", serializeInlineToHTML remaining]
|
||||
serializeInlineToHTML (InlineCode code : remaining) = T.concat ["<code>", code, "</code>", serializeInlineToHTML remaining]
|
||||
serializeInlineToHTML (Link {linkText, url, title} : remaining) = T.concat ["<a href=\"", url, "\" ", maybe "" (\t -> T.concat ["title=\"", t, "\""]) title, "\">", serializeInlineToHTML linkText, "</a>", serializeInlineToHTML remaining]
|
||||
serializeInlineToHTML (Image {altText, url, title} : remaining) = T.concat ["<img src=\">", url, "\" alt=\"", altText, "\"", maybe "" (\t -> T.concat ["title=\"", t, "\""]) title, ">", serializeInlineToHTML remaining]
|
||||
serializeInlineToHTML (Crossed elems : remaining) = T.concat ["<s>", serializeInlineToHTML elems, "</s>", serializeInlineToHTML remaining]
|
||||
serializeInlineToHTML (InlineCode code : remaining) = T.concat ["<code>", escapeText code, "</code>", serializeInlineToHTML remaining]
|
||||
serializeInlineToHTML (Link {linkText, url, title} : remaining) = T.concat ["<a href=\"", url, "\" ", maybe "" (\t -> T.concat ["title=\"", escapeText t, "\""]) title, "\">", serializeInlineToHTML linkText, "</a>", serializeInlineToHTML remaining]
|
||||
serializeInlineToHTML (Image {altText, url, title} : remaining) = T.concat ["<img src=\">", url, "\" alt=\"", escapeText altText, "\"", maybe "" (\t -> T.concat ["title=\"", escapeText t, "\""]) title, ">", serializeInlineToHTML remaining]
|
||||
serializeInlineToHTML (HTMLInline {inline_html_content} : remaining) = inline_html_content <> serializeInlineToHTML remaining
|
||||
|
|
|
|||
|
|
@ -57,6 +57,7 @@ data InlineText
|
|||
= Text Text -- Combined Normal and Escaped
|
||||
| Bold [InlineText]
|
||||
| Italic [InlineText]
|
||||
| Crossed [InlineText]
|
||||
| InlineCode Text
|
||||
| Link
|
||||
{ linkText :: [InlineText],
|
||||
|
|
|
|||
|
|
@ -223,6 +223,7 @@ inlineElement =
|
|||
choice
|
||||
[ try strong,
|
||||
try emphasis,
|
||||
try crossedText,
|
||||
try codeSpan,
|
||||
try image,
|
||||
try link,
|
||||
|
|
@ -249,6 +250,13 @@ strongUnderscore = do
|
|||
string "__"
|
||||
pure $ Bold content
|
||||
|
||||
crossedText :: Parser InlineText
|
||||
crossedText = do
|
||||
string "~~"
|
||||
content <- some (notFollowedBy (string "~~") >> inlineElementNo '~')
|
||||
string "~~"
|
||||
pure $ Crossed content
|
||||
|
||||
-- Emphasis (Italic)
|
||||
emphasis :: Parser InlineText
|
||||
emphasis = emphasisAsterisk <|> emphasisUnderscore
|
||||
|
|
@ -267,6 +275,21 @@ emphasisUnderscore = do
|
|||
char '_'
|
||||
pure $ Italic content
|
||||
|
||||
inlineElementNo :: Char -> Parser InlineText
|
||||
inlineElementNo c =
|
||||
choice
|
||||
[ try strong,
|
||||
try codeSpan,
|
||||
try image,
|
||||
try link,
|
||||
try htmlInline,
|
||||
try escapedChar,
|
||||
plainTextNo c
|
||||
]
|
||||
|
||||
plainTextNo :: Char -> Parser InlineText
|
||||
plainTextNo c = fmap (Text . T.pack) $ some $ noneOf [c, '\n']
|
||||
|
||||
inlineElementNoAsterisk :: Parser InlineText
|
||||
inlineElementNoAsterisk =
|
||||
choice
|
||||
|
|
@ -276,7 +299,7 @@ inlineElementNoAsterisk =
|
|||
try link,
|
||||
try htmlInline,
|
||||
try escapedChar,
|
||||
plainTextNoAsterisk
|
||||
plainTextNo '*'
|
||||
]
|
||||
|
||||
inlineElementNoUnderscore :: Parser InlineText
|
||||
|
|
@ -288,7 +311,7 @@ inlineElementNoUnderscore =
|
|||
try link,
|
||||
try htmlInline,
|
||||
try escapedChar,
|
||||
plainTextNoUnderscore
|
||||
plainTextNo '_'
|
||||
]
|
||||
|
||||
-- Code Span
|
||||
|
|
@ -385,11 +408,12 @@ escapedChar = do
|
|||
pure $ Text (T.singleton c)
|
||||
|
||||
-- Plain Text
|
||||
-- TODO: this eats stuff it shouldn't, inefficient solution is to try other inline elements and exit if they succeed
|
||||
plainText :: Parser InlineText
|
||||
plainText = Text . T.pack <$> some plainTextChar
|
||||
plainText = fmap (Text . T.pack) (liftA2 (:) (noneOf "\n") $ many plainTextChar)
|
||||
|
||||
plainTextChar :: Parser Char
|
||||
plainTextChar = noneOf "\n"
|
||||
plainTextChar = noneOf "\n[~`_*"
|
||||
|
||||
plainTextNoAsterisk :: Parser InlineText
|
||||
plainTextNoAsterisk = fmap (Text . T.pack) $ some $ noneOf "*\n"
|
||||
|
|
|
|||
Loading…
Reference in a new issue