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 ["", serializeInlineToHTML text, ""] -- -elementToHTML (Code (C {language = m_language, code})) = 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, ""] -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