diff --git a/app/Markdown.hs b/app/Markdown.hs index 049ed8a..2a4a6ec 100644 --- a/app/Markdown.hs +++ b/app/Markdown.hs @@ -7,16 +7,22 @@ module Markdown where import Control.Applicative (many, optional, some, (<|>)) import Control.Monad (guard, void) +import Control.Monad.Trans.Class (lift) import Data.Char (isAlpha) import Data.Text (Text) import qualified Data.Text as T import Data.Void (Void) 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 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 = anySingle @@ -78,10 +84,11 @@ blankLine = do headingBlock :: Parser Element headingBlock = do hashes <- some (char '#') "Heading Hashes" + log_ "heading" let level = length hashes guard (level <= 6) "Higher than level 6" 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 -- Fenced Code Block diff --git a/app/Utilities.hs b/app/Utilities.hs index 4d0704a..14382be 100644 --- a/app/Utilities.hs +++ b/app/Utilities.hs @@ -2,6 +2,7 @@ module Utilities where import Config import Control.Monad (filterM) +import Control.Monad.IO.Class (liftIO) import Data.List (find) import Data.Text (Text) import qualified Data.Text as T @@ -15,7 +16,7 @@ import Development.Shake.FilePath ((<.>), ()) import qualified Development.Shake.FilePath as FP import HTML import Markdown -import Text.Megaparsec (parse) +import Text.Megaparsec (errorBundlePretty, runParserT) import Types indexHtmlOutputPath :: FilePath -> FilePath @@ -37,9 +38,10 @@ indexHtmlMarkdownSourcePath = markdownToHtml :: (FromJSON a) => FilePath -> Action (a, Text) markdownToHtml filePath = do 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) - Left e -> error $ show e + Left e -> error $ errorBundlePretty e let metadata = case decodeEither' $ encodeUtf8 metadataText of Right m -> m @@ -52,10 +54,10 @@ now = Shake.liftIO $ fmap (T.pack . iso8601Show) getCurrentTime markdownToPost :: FilePath -> Action Post markdownToPost path = do content <- Shake.readFile' path - -- TODO: error handling - let postData = case parse Markdown.metadata path content of + parse <- liftIO $ runParserT Markdown.metadata path content + let postData = case parse of Right p -> p - Left e -> error $ show e + Left e -> error $ errorBundlePretty e let post = case decodeEither' $ encodeUtf8 postData of Right p -> p Left e -> error $ show e diff --git a/psb.cabal b/psb.cabal index 6e44d5c..16fe9d9 100644 --- a/psb.cabal +++ b/psb.cabal @@ -35,7 +35,7 @@ executable psb -- Other library packages from which modules are imported. -- 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 -- Directories containing source files.