diff --git a/app/HTML.hs b/app/HTML.hs
index e8e7df6..c760678 100644
--- a/app/HTML.hs
+++ b/app/HTML.hs
@@ -15,14 +15,14 @@ compileToHTML (Doc elements) = T.concat $ map elementToHTML elements
elementToHTML :: Element -> T.Text
elementToHTML (Heading (H {level, text})) = T.concat ["
"]
+elementToHTML (Code (C {language = m_language, code})) = T.concat ["", code, ""]
where
language = fromMaybe "" m_language
elementToHTML (BlockQuote (Q elems)) = T.concat ["", serializeInlineToHTML elems, "
"]
elementToHTML (List (L {list_type = Ordered, items})) = T.concat ["", generateLiElems items, "
"]
elementToHTML (List (L {list_type = Unordered, items})) = T.concat ["
", generateLiElems items, "
"]
-elementToHTML (HTML (HTMLTag {tagName, attributes, html_content})) = T.concat ["<", tagName, T.concat $ map (\(name, value) -> T.concat [name, "=", "\"", fromMaybe "" value, "\""]) attributes, ">", html_content, "", tagName, ">"]
-elementToHTML (Paragraph (P snippets)) = serializeInlineToHTML snippets
+elementToHTML (HTML (HTMLTag {html_content})) = html_content
+elementToHTML (Paragraph (P snippets)) = T.concat ["", serializeInlineToHTML snippets, "
"]
elementToHTML HorizontalRule = "
"
generateLiElems :: [ListItem] -> T.Text
@@ -34,11 +34,16 @@ generateLiElems (LI {content, children} : remainder) =
-- if they aren't this is fucked
serializeInlineToHTML content,
T.concat $ map (elementToHTML . List) children,
- ""
+ "",
+ generateLiElems remainder
]
serializeInlineToHTML :: [InlineText] -> T.Text
serializeInlineToHTML [] = ""
-serializeInlineToHTML (Text t : rem) = t <> serializeInlineToHTML rem
-serializeInlineToHTML (Bold elems : rem) = T.concat ["", serializeInlineToHTML elems, "", serializeInlineToHTML rem]
-serializeInlineToHTML (Italic elems : rem) = T.concat ["", serializeInlineToHTML elems, "", serializeInlineToHTML rem]
+serializeInlineToHTML (Text t : remaining) = 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 (HTMLInline {inline_html_content} : remaining) = inline_html_content <> serializeInlineToHTML remaining
diff --git a/app/IR.hs b/app/IR.hs
index b4363a5..1348db8 100644
--- a/app/IR.hs
+++ b/app/IR.hs
@@ -41,9 +41,7 @@ data List = L
data HTML
= HTMLTag
- { tagName :: Text,
- attributes :: [(Text, Maybe Text)],
- html_content :: Text
+ { html_content :: Text
}
newtype Paragraph = P [InlineText]
@@ -63,10 +61,7 @@ data InlineText
url :: Text,
title :: Maybe Text
}
- | HTMLInline
- { inlineTagName :: Text,
- inlineAttributes :: [(Text, Maybe Text)]
- }
+ | HTMLInline {inline_html_content :: Text}
-- for processing math
-- https://hackage.haskell.org/package/typst-0.6.1/docs/Typst-Parse.html#v:parseTypst
diff --git a/app/Markdown.hs b/app/Markdown.hs
index ee33936..392bd1a 100644
--- a/app/Markdown.hs
+++ b/app/Markdown.hs
@@ -174,37 +174,13 @@ orderedListItem = do
-- HTML Block
htmlBlock :: Parser Element
-htmlBlock = char '<' *> choice [try htmlCommentBlock, try htmlDeclarationBlock, htmlTagBlock]
-
-htmlCommentBlock :: Parser Element
-htmlCommentBlock = do
- string "!--"
- content <- manyTill anyChar (try $ string "-->")
- lineEnding
- pure $ HTML $ HTMLTag "!--" [] (T.pack content)
-
-htmlDeclarationBlock :: Parser Element
-htmlDeclarationBlock = do
- char '!'
- decl <- some (satisfy isAlpha)
- rest <- many (noneOf ">\n\r")
- char '>'
- lineEnding
- pure $ HTML $ HTMLTag (T.pack $ "!" ++ decl) [] (T.pack rest)
-
-htmlTagBlock :: Parser Element
-htmlTagBlock = do
- name <- Markdown.tagName
- attrs <- many (try $ wsParser >> attribute)
- optional wsParser
- selfClose <- option False (char '/' >> pure True)
- char '>'
- content <-
- if selfClose
- then pure ""
- else manyTill anyChar (try $ string "" >> string name >> char '>')
- when (not selfClose) lineEnding
- pure $ HTML $ HTMLTag (T.pack name) attrs (T.pack content)
+htmlBlock = do
+ start <- getPosition
+ char '<'
+ -- Capture the entire HTML block as raw text
+ rest <- manyTill anyChar (try $ char '>' >> lineEnding)
+ let content = '<' : rest
+ return $ HTML $ HTMLTag (T.pack content)
tagName :: Parser String
tagName = do
@@ -353,10 +329,10 @@ image :: Parser InlineText
image = do
char '!'
char '['
- alt <- some (notFollowedBy (char ']') >> inlineElementNoBracket)
+ alt <- T.pack <$> many (noneOf "]\n\r")
char ']'
(url, title) <- linkDestination
- pure $ Image alt url title
+ return $ Image {altText = alt, url = url, title = title}
-- Link
link :: Parser InlineText
@@ -407,13 +383,9 @@ titleParser =
-- HTML Inline
htmlInline :: Parser InlineText
htmlInline = do
- char '<'
- name <- Markdown.tagName
- attrs <- many (try $ wsParser >> attribute)
- optional wsParser
- _ <- option False (char '/' >> pure True)
- char '>'
- pure $ HTMLInline (T.pack name) attrs
+ start <- char '<'
+ content <- manyTill anyChar (try $ char '>')
+ return $ HTMLInline (T.pack (start : content ++ ">"))
-- Escaped Character
escapedChar :: Parser InlineText
diff --git a/app/Utilities.hs b/app/Utilities.hs
index 40785c0..d29e06d 100644
--- a/app/Utilities.hs
+++ b/app/Utilities.hs
@@ -41,10 +41,12 @@ indexHtmlMarkdownSourcePath =
markdownToHtml :: (FromJSON a) => FilePath -> Action (a, Text)
markdownToHtml filePath = do
content <- Shake.readFile' filePath
+ -- TODO: error handling
let Right (metadataText, document) = parse (liftA2 (,) Markdown.metadata Markdown.document) filePath content
let Right metadata = decodeEither' $ encodeUtf8 metadataText
pure (metadata, compileToHTML document)
+markdownToHtml_ :: (FromJSON a) => FilePath -> Action (a, Text)
markdownToHtml_ filePath = do
content <- Shake.readFile' filePath
Shake.quietly . Shake.traced "Markdown to HTML" $ do
@@ -89,6 +91,14 @@ now = Shake.liftIO $ fmap (T.pack . iso8601Show) getCurrentTime
markdownToPost :: FilePath -> Action Post
markdownToPost path = do
+ content <- Shake.readFile' path
+ -- TODO: error handling
+ let Right postData = parse Markdown.metadata path content
+ let Right post = decodeEither' $ encodeUtf8 postData
+ pure post
+
+markdownToPost_ :: FilePath -> Action Post
+markdownToPost_ path = do
content <- Shake.readFile' path
(Pandoc meta _) <-
Shake.liftIO . runPandoc . Pandoc.readMarkdown readerOptions . T.pack $ content