From 07218a32a6e639fff8b96c12dd33cc1974869f4e Mon Sep 17 00:00:00 2001
From: Pagwin <pgp2024@pagwin.xyz>
Date: Fri, 9 May 2025 20:08:34 -0400
Subject: [PATCH] restructuring handling of markdown

---
 app/Markdown.hs        | 46 +++++++-----------------------------------
 app/Markdown/Data.hs   | 30 +++++++++++++++++++++++++++
 app/Markdown/Parser.hs | 44 ++++++++++++++++++++++++++++++++++++++++
 psb.cabal              |  2 +-
 4 files changed, 82 insertions(+), 40 deletions(-)
 create mode 100644 app/Markdown/Data.hs
 create mode 100644 app/Markdown/Parser.hs

diff --git a/app/Markdown.hs b/app/Markdown.hs
index c0ca295..4d198f7 100644
--- a/app/Markdown.hs
+++ b/app/Markdown.hs
@@ -1,41 +1,9 @@
-{-# LANGUAGE FlexibleContexts #-}
+module Markdown
+  ( module Markdown.Parser,
+    module Markdown.Data,
+  )
+where
 
-module Markdown where
+import Markdown.Data
+import Markdown.Parser
 
-import Data.Functor (void)
-import Data.Text (Text, pack)
-import Text.Parsec
-
--- https://spec.commonmark.org/0.31.2/
--- https://hackage.haskell.org/package/parsec
-
-linebreak ::
-  (Monad m, Stream s m Char) =>
-  ParsecT s u m ()
--- 2 newlines due to mark
-linebreak = void (newline *> newline)
-
-emptyParse ::
-  (Monad m, Stream s m Char) =>
-  ParsecT s u m String
-emptyParse = "" <$ notFollowedBy anyChar
-
-line ::
-  (Monad m, Stream s m Char) =>
-  ParsecT s u m Text
-line = fmap pack $ many $ notFollowedBy linebreak *> anyChar
-
-lines ::
-  (Monad m, Stream s m Char) =>
-  ParsecT s u m [Text]
-lines = line `sepBy` linebreak
-
-heading ::
-  (Monad m, Stream s m Char) =>
-  ParsecT s u m (Int, Text)
-heading = do
-  level <- fmap length $ many1 $ char '#'
-  text <- line
-  pure (level, text)
-
--- TODO: blockquote, single backticks, triple backticks, links, arb HTML
diff --git a/app/Markdown/Data.hs b/app/Markdown/Data.hs
new file mode 100644
index 0000000..91168dd
--- /dev/null
+++ b/app/Markdown/Data.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE RankNTypes, FlexibleContexts #-}
+
+module Markdown.Data
+  ( MarkDownElement,
+    MListItem,
+    Parser,
+  )
+where
+
+import Data.Text
+import Text.Parsec
+
+--  modified version of https://github.com/tusharad/markdown-parser
+data MarkDownElement
+  = MHeading Int MarkDownElement
+  | MParagraph MarkDownElement
+  | MBold MarkDownElement
+  | MItalic MarkDownElement
+  | MBoldItalic MarkDownElement
+  | MLink MarkDownElement Text
+  | MLine [MarkDownElement]
+  | MUnorderedList [MListItem]
+  | MOrderedList [MListItem]
+  | Only Text -- Bottom of all types
+  deriving (Eq, Show)
+
+data MListItem = MListItem MarkDownElement [MarkDownElement]
+  deriving (Eq, Show)
+
+type Parser v = forall s u m. (Monad m, Stream s m Char) => ParsecT s u m v
diff --git a/app/Markdown/Parser.hs b/app/Markdown/Parser.hs
new file mode 100644
index 0000000..552075e
--- /dev/null
+++ b/app/Markdown/Parser.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module Markdown.Parser
+  ( Markdown.Parser.lines,
+  )
+where
+
+import Data.Functor (void)
+import Data.Text (Text, pack)
+import Text.Parsec
+
+-- https://spec.commonmark.org/0.31.2/
+-- https://hackage.haskell.org/package/parsec
+
+linebreak ::
+  (Monad m, Stream s m Char) =>
+  ParsecT s u m ()
+-- 2 newlines due to mark
+linebreak = void (newline *> newline)
+
+emptyParse ::
+  (Monad m, Stream s m Char) =>
+  ParsecT s u m String
+emptyParse = "" <$ notFollowedBy anyChar
+
+line ::
+  (Monad m, Stream s m Char) =>
+  ParsecT s u m Text
+line = fmap pack $ many $ notFollowedBy linebreak *> anyChar
+
+lines ::
+  (Monad m, Stream s m Char) =>
+  ParsecT s u m [Text]
+lines = line `sepBy` linebreak
+
+heading ::
+  (Monad m, Stream s m Char) =>
+  ParsecT s u m (Int, Text)
+heading = do
+  level <- fmap length $ many1 $ char '#'
+  text <- line
+  pure (level, text)
+
+-- TODO: blockquote, single backticks, triple backticks, links, arb HTML
diff --git a/psb.cabal b/psb.cabal
index 0f9ef17..e78733d 100644
--- a/psb.cabal
+++ b/psb.cabal
@@ -29,7 +29,7 @@ executable psb
     -- .hs or .lhs file containing the Main module.
     main-is:          Main.hs
 
-    other-modules: Config Utilities Templates Types IR Markdown Restruct
+    other-modules: Config Utilities Templates Types IR Markdown Markdown.Data Markdown.Parser Restruct
 
     default-extensions: ApplicativeDo DataKinds NamedFieldPuns DerivingVia LambdaCase TypeApplications DeriveGeneric