From b930a78f6669d6a72deba182af52dcc0dc573af2 Mon Sep 17 00:00:00 2001
From: Pagwin <pgp2024@pagwin.xyz>
Date: Sun, 16 Nov 2025 14:51:19 -0500
Subject: [PATCH] made logging in parsing more generic

---
 app/Main.hs      |  2 +-
 app/Markdown.hs  | 13 +++++++------
 app/Utilities.hs |  6 +++---
 psb.cabal        |  6 +++---
 4 files changed, 14 insertions(+), 13 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index e2c7b63..2ab6d81 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -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" $
diff --git a/app/Markdown.hs b/app/Markdown.hs
index 5445f40..4e4a320 100644
--- a/app/Markdown.hs
+++ b/app/Markdown.hs
@@ -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' = ' '
diff --git a/app/Utilities.hs b/app/Utilities.hs
index 14382be..2483850 100644
--- a/app/Utilities.hs
+++ b/app/Utilities.hs
@@ -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
diff --git a/psb.cabal b/psb.cabal
index 16fe9d9..aa287d2 100644
--- a/psb.cabal
+++ b/psb.cabal
@@ -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.