pretty errors and swapped to ParsecT to do debugging stuff

This commit is contained in:
Pagwin 2025-11-14 00:37:14 -05:00
parent bc0475fde4
commit ebcb13929a
No known key found for this signature in database
GPG key ID: 81137023740CA260
3 changed files with 19 additions and 10 deletions

View file

@ -7,16 +7,22 @@ module Markdown where
import Control.Applicative (many, optional, some, (<|>)) import Control.Applicative (many, optional, some, (<|>))
import Control.Monad (guard, void) import Control.Monad (guard, void)
import Control.Monad.Trans.Class (lift)
import Data.Char (isAlpha) import Data.Char (isAlpha)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Void (Void) import Data.Void (Void)
import IR import IR
import Text.Megaparsec (Parsec, anySingle, anySingleBut, between, choice, count, eof, manyTill, notFollowedBy, satisfy, skipSome, try, (<?>)) import Text.Megaparsec (ParsecT, anySingle, anySingleBut, between, choice, count, eof, manyTill, notFollowedBy, satisfy, skipSome, try, (<?>))
import qualified Text.Megaparsec as MP import qualified Text.Megaparsec as MP
import Text.Megaparsec.Char (alphaNumChar, char, digitChar, string) import Text.Megaparsec.Char (alphaNumChar, char, digitChar, string)
type Parser = Parsec Void String type ParserT m = ParsecT Void String m
type Parser = ParserT IO
log_ :: String -> Parser ()
log_ = lift . putStrLn
anyChar :: Parser Char anyChar :: Parser Char
anyChar = anySingle anyChar = anySingle
@ -78,10 +84,11 @@ blankLine = do
headingBlock :: Parser Element headingBlock :: Parser Element
headingBlock = do headingBlock = do
hashes <- some (char '#') <?> "Heading Hashes" hashes <- some (char '#') <?> "Heading Hashes"
log_ "heading"
let level = length hashes let level = length hashes
guard (level <= 6) <?> "Higher than level 6" guard (level <= 6) <?> "Higher than level 6"
many (char ' ' <|> char '\t') <?> "Pre-Text Whitespace" many (char ' ' <|> char '\t') <?> "Pre-Text Whitespace"
content <- manyTill (inlineElement <?> "Header Text") (try lineEnding <?> "Header Ending") content <- manyTill ((inlineElement <* log_ "element") <?> "Header Text") (try lineEnding <?> "Header Ending")
pure $ Heading $ H level content pure $ Heading $ H level content
-- Fenced Code Block -- Fenced Code Block

View file

@ -2,6 +2,7 @@ module Utilities where
import Config import Config
import Control.Monad (filterM) import Control.Monad (filterM)
import Control.Monad.IO.Class (liftIO)
import Data.List (find) import Data.List (find)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
@ -15,7 +16,7 @@ import Development.Shake.FilePath ((<.>), (</>))
import qualified Development.Shake.FilePath as FP import qualified Development.Shake.FilePath as FP
import HTML import HTML
import Markdown import Markdown
import Text.Megaparsec (parse) import Text.Megaparsec (errorBundlePretty, runParserT)
import Types import Types
indexHtmlOutputPath :: FilePath -> FilePath indexHtmlOutputPath :: FilePath -> FilePath
@ -37,9 +38,10 @@ indexHtmlMarkdownSourcePath =
markdownToHtml :: (FromJSON a) => FilePath -> Action (a, Text) markdownToHtml :: (FromJSON a) => FilePath -> Action (a, Text)
markdownToHtml filePath = do markdownToHtml filePath = do
content <- Shake.readFile' filePath content <- Shake.readFile' filePath
let (metadataText, document) = case parse (liftA2 (,) Markdown.metadata Markdown.document) filePath content of parse <- liftIO $ runParserT (liftA2 (,) Markdown.metadata Markdown.document) filePath content
let (metadataText, document) = case parse of
Right (a, b) -> (a, b) Right (a, b) -> (a, b)
Left e -> error $ show e Left e -> error $ errorBundlePretty e
let metadata = case decodeEither' $ encodeUtf8 metadataText of let metadata = case decodeEither' $ encodeUtf8 metadataText of
Right m -> m Right m -> m
@ -52,10 +54,10 @@ now = Shake.liftIO $ fmap (T.pack . iso8601Show) getCurrentTime
markdownToPost :: FilePath -> Action Post markdownToPost :: FilePath -> Action Post
markdownToPost path = do markdownToPost path = do
content <- Shake.readFile' path content <- Shake.readFile' path
-- TODO: error handling parse <- liftIO $ runParserT Markdown.metadata path content
let postData = case parse Markdown.metadata path content of let postData = case parse of
Right p -> p Right p -> p
Left e -> error $ show e Left e -> error $ errorBundlePretty e
let post = case decodeEither' $ encodeUtf8 postData of let post = case decodeEither' $ encodeUtf8 postData of
Right p -> p Right p -> p
Left e -> error $ show e Left e -> error $ show e

View file

@ -35,7 +35,7 @@ executable psb
-- Other library packages from which modules are imported. -- Other library packages from which modules are imported.
-- https://hackage.haskell.org/package/texmath -- https://hackage.haskell.org/package/texmath
build-depends: base >=4.17.2.1, mustache >=2.4.2, shake >= 0.19.8, deriving-aeson >= 0.2.9, aeson, text, time, unordered-containers, yaml, megaparsec >= 9.7.0 build-depends: base >=4.17.2.1, mustache >=2.4.2, shake >= 0.19.8, deriving-aeson >= 0.2.9, aeson, text, time, unordered-containers, yaml, megaparsec >= 9.7.0, transformers >= 0.6.2
--parsec >= 3.1.18.0 --parsec >= 3.1.18.0
-- Directories containing source files. -- Directories containing source files.