intermediate markdown wrapping

bore.cabal

@@ -5,7 +5,7 @@ cabal-version: 2.2
 -- see: https://github.com/sol/hpack
 
 name:           bore
-version:        0.23.0.0
+version:        0.24.0.0
 synopsis:       Build gopherholes.
 description:    Static site builder, but for gopherholes. Manage phlogs with tags, use the Markdown renderer and Mustache templating system.
 category:       Network
@@ -87,8 +87,6 @@ library
     , neat-interpolation
     , network-uri
     , optparse-applicative
-    , pandoc
-    , pandoc-types
     , parsec
     , prettyprinter
     , raw-strings-qq
@@ -152,8 +150,6 @@ executable bore
     , neat-interpolation
     , network-uri
     , optparse-applicative
-    , pandoc
-    , pandoc-types
     , parsec
     , prettyprinter
     , raw-strings-qq
@@ -215,8 +211,6 @@ test-suite bore-test
     , neat-interpolation
     , network-uri
     , optparse-applicative
-    , pandoc
-    , pandoc-types
     , parsec
     , prettyprinter
     , raw-strings-qq

package.yaml

@@ -71,8 +71,6 @@ dependencies:
   - spacecookie
   - edit-distance
   - safe
-  - pandoc
-  - pandoc-types
 
 library:
   source-dirs: src

src/Bore/Text/Wrap.hs

@@ -1,49 +1,78 @@
-{- | Wrap text in Markdown format without converting tabs to spaces.
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
-This module has two problems because of the hacky solution:
-
-1. Gopher links have the potential of being wrapped in the middle of the link, which would
-   break the link.
-2. The tab character is preserved by using a placeholder, which is not ideal.
-
--}
-module Bore.Text.Wrap (wrapMarkdown) where
+module Bore.Text.Wrap where
 
+import Commonmark
 import Data.Text (Text)
 import qualified Data.Text as T
-import Text.Pandoc
+import Text.Wrap (wrapText, defaultWrapSettings)
+import Control.Monad.Reader (Reader, asks, runReader)
+
+-- Configuration for the renderer
+data WrapConfig = WrapConfig
+  { lineWidth :: Int  -- Configurable line width
+  }
+
+-- Custom Renderer for Wrapping Text
+newtype WrapRenderer = WrapRenderer { getWrappedText :: Reader WrapConfig Text }
+
+instance Show WrapRenderer where
+  show (WrapRenderer t) = show (runReader t (WrapConfig 80))
+instance Rangeable WrapRenderer where
+  ranged _ (WrapRenderer t) = WrapRenderer t
+instance HasAttributes WrapRenderer where
+  addAttributes _ (WrapRenderer t) = WrapRenderer t
+
+instance Semigroup WrapRenderer where
+  WrapRenderer a <> WrapRenderer b = WrapRenderer $ (<>) <$> a <*> b
+
+instance Monoid WrapRenderer where
+  mempty = WrapRenderer $ pure ""
 
--- Define the placeholder
-tabPlaceholder :: Text
-tabPlaceholder = "\FFFF"
+-- Handle Paragraphs
+instance IsBlock WrapRenderer WrapRenderer where
+  paragraph (WrapRenderer content) = WrapRenderer $ do
+    width <- asks lineWidth
+    wrapped <- content
+    if '\t' `T.elem` wrapped
+      then return $ wrapped <> "\n\n"
+      else return $ wrapText defaultWrapSettings width wrapped <> "\n\n"
+  plain = id
+  thematicBreak = WrapRenderer $ return "------------------------------\n"
+  blockQuote = id  -- need to wrap this too
+  heading _ = id
+  codeBlock _ t = WrapRenderer $ return $ "```\n" <> t <> "\n```\n\n"
+  rawBlock _ t = WrapRenderer $ return t
+  list _ _ items = mconcat items  -- wrap this too
+  referenceLinkDefinition _ _ = mempty
 
--- Preprocess: Replace tabs with placeholder
-preprocess :: Text -> Text
-preprocess = T.replace "\t" tabPlaceholder
+-- Handle Inline Elements
+instance IsInline WrapRenderer where
+  str t = WrapRenderer $ return t
+  softBreak = WrapRenderer $ return " "
+  lineBreak = WrapRenderer $ return "\n"
+  emph (WrapRenderer t) = WrapRenderer $ fmap ("*" <>) (fmap (<> "*") t)
+  strong (WrapRenderer t) = WrapRenderer $ fmap ("**" <>) (fmap (<> "**") t)
+  code t = WrapRenderer $ return $ "`" <> t <> "`"
+  link _ _ (WrapRenderer t) = WrapRenderer t
+  image _ _ (WrapRenderer t) = WrapRenderer t
+  escapedChar c = WrapRenderer $ return $ T.singleton c
+  entity t = WrapRenderer $ return t
+  rawInline _ rawContent = WrapRenderer $ return rawContent
 
--- Postprocess: Replace placeholder back to tabs
-postprocess :: Text -> Text
-postprocess = T.replace tabPlaceholder "\t"
+-- Parse and Render Markdown
+wrapMarkdownParagraphs :: Int -> Text -> Either String Text
+wrapMarkdownParagraphs width input =
+  case commonmark "source" input of
+    Left err -> Left $ show err
+    Right (WrapRenderer result) ->
+      Right $ runReader result (WrapConfig width)
 
--- | Word wrap a Markdown document without converting tabs to spaces
 wrapMarkdown :: Int -> Text -> Text
 wrapMarkdown width input =
-  let
-    preprocessedInput = preprocess input
-
-    result = runPure $ do
-      -- Parse the preprocessed Markdown input into Pandoc AST
-      pandoc <- readMarkdown def { readerExtensions = pandocExtensions } preprocessedInput
-
-      -- Render the Pandoc AST back to Markdown with wrapping settings
-      writeMarkdown def
-          { writerWrapText = WrapAuto
-          , writerColumns = width
-          }
-          pandoc
-
-    wrappedOutput = case result of
-      Left err -> error $ show err
-      Right output -> postprocess output
-  in
-    wrappedOutput
+  case wrapMarkdownParagraphs width input of
+    Left err -> "Error: " <> T.pack err
+    Right output -> output