made logging in parsing more generic

This commit is contained in:
Pagwin 2025-11-16 14:51:19 -05:00
parent 53290132e7
commit b930a78f66
No known key found for this signature in database
GPG key ID: 81137023740CA260
4 changed files with 14 additions and 13 deletions

View file

@ -29,7 +29,7 @@ import Utilities
main :: IO ()
main = do
Shake.shakeArgs Shake.shakeOptions $ do
Shake.shakeArgs Shake.shakeOptions {Shake.shakeProgress = Shake.progressSimple} $ do
Shake.withTargetDocs "Build the site" $
"build" ~> buildSite
Shake.withTargetDocs "Clean the built site" $

View file

@ -7,27 +7,28 @@ 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.Functor.Identity (Identity)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Void (Void)
import IR
import Logger (Logger (logDebug))
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 ParserT m = ParsecT Void String m
type Parser = ParserT IO
type Parser = ParserT Identity
log_ :: String -> Parser ()
log_ = lift . putStrLn
log_ :: T.Text -> Parser ()
log_ = logDebug
logP :: (Show s) => Parser s -> Parser s
logP v = do
underlying <- v
log_ $ show underlying
logDebug $ T.show underlying
v
anyChar :: Parser Char
@ -331,7 +332,7 @@ plainTextNo disallow = do
log_ "a"
firstChar <- noneOf disallow <?> "Plain Text Initial Disallow"
log_ "b"
remChars <- manyTill (plainTextCharNo disallow) lineEnding <?> "Remaining Characters"
remChars <- many $ notFollowedBy lineEnding *> plainTextCharNo disallow
pure $ Text $ T.map wspHandler $ T.pack $ firstChar : remChars
where
wspHandler '\n' = ' '

View file

@ -2,7 +2,7 @@ module Utilities where
import Config
import Control.Monad (filterM)
import Control.Monad.IO.Class (liftIO)
import Data.Functor.Identity (Identity (runIdentity))
import Data.List (find)
import Data.Text (Text)
import qualified Data.Text as T
@ -38,7 +38,7 @@ indexHtmlMarkdownSourcePath =
markdownToHtml :: (FromJSON a) => FilePath -> Action (a, Text)
markdownToHtml filePath = do
content <- Shake.readFile' filePath
parse <- liftIO $ runParserT (liftA2 (,) Markdown.metadata Markdown.document) filePath content
let parse = runIdentity $ runParserT (liftA2 (,) Markdown.metadata Markdown.document) filePath content
let (metadataText, document) = case parse of
Right (a, b) -> (a, b)
Left e -> error $ errorBundlePretty e
@ -54,7 +54,7 @@ now = Shake.liftIO $ fmap (T.pack . iso8601Show) getCurrentTime
markdownToPost :: FilePath -> Action Post
markdownToPost path = do
content <- Shake.readFile' path
parse <- liftIO $ runParserT Markdown.metadata path content
let parse = runIdentity $ runParserT Markdown.metadata path content
let postData = case parse of
Right p -> p
Left e -> error $ errorBundlePretty e

View file

@ -29,13 +29,13 @@ executable psb
-- .hs or .lhs file containing the Main module.
main-is: Main.hs
other-modules: Config Utilities Templates Types IR Markdown Restruct HTML
other-modules: Config Utilities Templates Types IR Markdown Restruct HTML Logger
default-extensions: ApplicativeDo DataKinds NamedFieldPuns DerivingVia LambdaCase TypeApplications DeriveGeneric OverloadedRecordDot NamedFieldPuns DuplicateRecordFields DisambiguateRecordFields
default-extensions: ApplicativeDo DataKinds NamedFieldPuns DerivingVia LambdaCase TypeApplications DeriveGeneric OverloadedRecordDot NamedFieldPuns DuplicateRecordFields DisambiguateRecordFields FlexibleInstances
-- 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, transformers >= 0.6.2
build-depends: base >=4.17.2.1, mustache >=2.4.2, shake >= 0.19.8, deriving-aeson >= 0.2.9, aeson, text >= 2.1.2, time, unordered-containers, yaml, megaparsec >= 9.7.0, transformers >= 0.6.2
--parsec >= 3.1.18.0
-- Directories containing source files.