okay errors are abound with the new setup slowly working through them though

This commit is contained in:
Pagwin 2025-11-04 23:22:30 -05:00
parent b1f9a8d2f9
commit b956f906ec
No known key found for this signature in database
GPG key ID: 81137023740CA260
3 changed files with 33 additions and 19 deletions

View file

@ -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

View file

@ -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

View file

@ -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