diff --git a/app/IR.hs b/app/IR.hs index 1348db8..0e41902 100644 --- a/app/IR.hs +++ b/app/IR.hs @@ -3,6 +3,7 @@ module IR where import Data.Text newtype Document = Doc [Element] + deriving (Show) data Element = Heading Heading @@ -12,6 +13,7 @@ data Element | HTML HTML | Paragraph Paragraph | HorizontalRule + deriving (Show) -- Removed: BlankLine @@ -19,32 +21,37 @@ data Heading = H { level :: Int, text :: [InlineText] } + deriving (Show) data Code = C { language :: Maybe Text, code :: Text } + deriving (Show) -data BlockQuote = Q [InlineText] +data BlockQuote = Q [InlineText] deriving (Show) data ListItem = LI { content :: [InlineText], -- Flatten continuations into here children :: [List] } + deriving (Show) -data ListType = Ordered | Unordered +data ListType = Ordered | Unordered deriving (Show) data List = L { list_type :: ListType, items :: [ListItem] } + deriving (Show) data HTML = HTMLTag { html_content :: Text } + deriving (Show) -newtype Paragraph = P [InlineText] +newtype Paragraph = P [InlineText] deriving (Show) data InlineText = Text Text -- Combined Normal and Escaped @@ -62,6 +69,7 @@ data InlineText title :: Maybe Text } | HTMLInline {inline_html_content :: Text} + deriving (Show) -- 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 392bd1a..5ffcf7c 100644 --- a/app/Markdown.hs +++ b/app/Markdown.hs @@ -2,10 +2,11 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} -module Markdown (document, metadata) where +-- (document, metadata) +module Markdown where import Control.Applicative (many, optional, some, (<|>)) -import Control.Monad (guard, void, when) +import Control.Monad (guard, void) import Data.Char (isAlpha) import Data.Text (Text) import qualified Data.Text as T @@ -175,7 +176,6 @@ orderedListItem = do -- HTML Block htmlBlock :: Parser Element htmlBlock = do - start <- getPosition char '<' -- Capture the entire HTML block as raw text rest <- manyTill anyChar (try $ char '>' >> lineEnding) @@ -219,10 +219,10 @@ paragraphBlock = do notFollowedBy (string "```" <|> string "~~~") notFollowedBy (count 4 (char ' ' <|> char '\t')) notFollowedBy (count 3 (char '*') <|> count 3 (char '-') <|> count 3 (char '_')) - notFollowedBy (char '<') + -- notFollowedBy (char '<') content <- some inlineElement - lineEnding + lineEnding <|> eof pure $ Paragraph $ P content -- Inline Elements @@ -400,14 +400,14 @@ plainText = Text . T.pack <$> some plainTextChar plainTextChar :: Parser Char plainTextChar = satisfy $ \c -> - (c `notElem` ("*_`[!<\\\n\r" :: String)) && c >= ' ' + (c `notElem` ("*_`[<\\\n\r" :: String)) && c >= ' ' plainTextNoAsterisk :: Parser InlineText plainTextNoAsterisk = Text . T.pack <$> some ( satisfy $ \c -> - (c `notElem` ("*_`[!<\\\n\r" :: String)) && c >= ' ' + (c `notElem` ("*_`[<\\\n\r" :: String)) && c >= ' ' ) plainTextNoUnderscore :: Parser InlineText @@ -415,7 +415,7 @@ plainTextNoUnderscore = Text . T.pack <$> some ( satisfy $ \c -> - not (c `elem` ("_*`[!<\\\n\r" :: String)) && c >= ' ' + not (c `elem` ("_*`[<\\\n\r" :: String)) && c >= ' ' ) plainTextNoBracket :: Parser InlineText @@ -423,7 +423,7 @@ plainTextNoBracket = Text . T.pack <$> some ( satisfy $ \c -> - not (c `elem` ("]_*`[!<\\\n\r" :: String)) && c >= ' ' + not (c `elem` ("]_*`[<\\\n\r" :: String)) && c >= ' ' ) -- Helper Parsers diff --git a/app/Utilities.hs b/app/Utilities.hs index b084ae7..c071f6e 100644 --- a/app/Utilities.hs +++ b/app/Utilities.hs @@ -2,8 +2,6 @@ module Utilities where import Config import Control.Monad (filterM) -import Data.Aeson (Result (Error, Success)) -import qualified Data.Aeson as A import Data.List (find) import Data.Text (Text) import qualified Data.Text as T @@ -39,9 +37,13 @@ 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 + let (metadataText, document) = case parse (liftA2 (,) Markdown.metadata Markdown.document) filePath content of + Right (a, b) -> (a, b) + Left e -> error $ show e + + let metadata = case decodeEither' $ encodeUtf8 metadataText of + Right m -> m + Left e -> error $ show e pure (metadata, compileToHTML document) now :: Action T.Text @@ -51,8 +53,12 @@ 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 + let postData = case parse Markdown.metadata path content of + Right p -> p + Left e -> error $ show e + let post = case decodeEither' $ encodeUtf8 postData of + Right p -> p + Left e -> error $ show e pure post yamlToPost :: FilePath -> Action Post