diff --git a/app/HTML.hs b/app/HTML.hs index d59c614..c324fa7 100644 --- a/app/HTML.hs +++ b/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 ["", serializeInlineToHTML header.text, ""] -- -elementToHTML (Code code_block) = T.concat ["
", code_block.code, "", "
"] +elementToHTML (Code code_block) = T.concat ["
", escapeText code_block.code, "", "
"] where language = fromMaybe "" code_block.language elementToHTML (BlockQuote (Q elems)) = T.concat ["
", serializeInlineToHTML elems, "
"] @@ -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 ["", serializeInlineToHTML elems, "", serializeInlineToHTML remaining] serializeInlineToHTML (Italic elems : remaining) = T.concat ["", serializeInlineToHTML elems, "", serializeInlineToHTML remaining] -serializeInlineToHTML (InlineCode code : remaining) = T.concat ["", code, "", serializeInlineToHTML remaining] -serializeInlineToHTML (Link {linkText, url, title} : remaining) = T.concat [" T.concat ["title=\"", t, "\""]) title, "\">", serializeInlineToHTML linkText, "", serializeInlineToHTML remaining] -serializeInlineToHTML (Image {altText, url, title} : remaining) = T.concat ["", url, "\" alt=\"", altText, "\"", maybe "" (\t -> T.concat ["title=\"", t, "\""]) title, ">", serializeInlineToHTML remaining] +serializeInlineToHTML (Crossed elems : remaining) = T.concat ["", serializeInlineToHTML elems, "", serializeInlineToHTML remaining] +serializeInlineToHTML (InlineCode code : remaining) = T.concat ["", escapeText code, "", serializeInlineToHTML remaining] +serializeInlineToHTML (Link {linkText, url, title} : remaining) = T.concat [" T.concat ["title=\"", escapeText t, "\""]) title, "\">", serializeInlineToHTML linkText, "", serializeInlineToHTML remaining] +serializeInlineToHTML (Image {altText, url, title} : remaining) = T.concat ["", 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 diff --git a/app/IR.hs b/app/IR.hs index 0e41902..29f3cd7 100644 --- a/app/IR.hs +++ b/app/IR.hs @@ -57,6 +57,7 @@ data InlineText = Text Text -- Combined Normal and Escaped | Bold [InlineText] | Italic [InlineText] + | Crossed [InlineText] | InlineCode Text | Link { linkText :: [InlineText], diff --git a/app/Markdown.hs b/app/Markdown.hs index 7f72a92..40ed572 100644 --- a/app/Markdown.hs +++ b/app/Markdown.hs @@ -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"