Willem van den Ende
f7a6482447
Replace manual size constraints with LaTeX's built-in image scaling mechanism. - Remove artificial width/height constraints that caused diagram truncation - Add adjustbox package and auto-scaling macros to LaTeX template - Images now scale intelligently: natural size if they fit, auto-scaled if oversized - Maintains aspect ratio and prevents page rotation issues 🤖 Generated with [Claude Code](https://claude.ai/code) Co-Authored-By: Claude <noreply@anthropic.com>
233 lines
10 KiB
Haskell
233 lines
10 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
|
|
module Main (main) where
|
|
|
|
import Text.Pandoc
|
|
import Text.Pandoc.Class (runIOorExplode)
|
|
import Text.Pandoc.PDF (makePDF)
|
|
import Text.Pandoc.Walk (walkM)
|
|
import Text.Pandoc.Extensions (getDefaultExtensions)
|
|
import System.Environment (getArgs)
|
|
import System.FilePath (replaceExtension, takeDirectory, takeFileName, takeExtension, (</>))
|
|
import System.Process (callProcess)
|
|
import System.Directory (removeFile)
|
|
import Data.Text (Text)
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.IO as TIO
|
|
import Data.Hashable (hash)
|
|
import Control.Monad (void)
|
|
import Control.Exception (Exception, throwIO, bracket, catch, SomeException)
|
|
import qualified Data.ByteString.Lazy as BL
|
|
|
|
-- | Custom error types for better error handling
|
|
data DocsterError
|
|
= InvalidUsage Text
|
|
| FileError Text
|
|
| PDFGenerationError Text
|
|
| ProcessError Text
|
|
deriving (Show)
|
|
|
|
instance Exception DocsterError
|
|
|
|
-- | Type-safe wrappers for better domain modeling
|
|
newtype SourceDir = SourceDir FilePath deriving (Show, Eq)
|
|
newtype OutputPath = OutputPath FilePath deriving (Show, Eq)
|
|
newtype DiagramId = DiagramId Text deriving (Show, Eq)
|
|
|
|
-- | Constants for the application
|
|
mermaidCommand :: String
|
|
mermaidCommand = "mmdc"
|
|
|
|
diagramPrefix :: String
|
|
diagramPrefix = "diagram-"
|
|
|
|
successEmoji :: String
|
|
successEmoji = "✅"
|
|
|
|
-- | Generate a diagram ID from content hash or explicit ID
|
|
generateDiagramId :: Text -> Text -> DiagramId
|
|
generateDiagramId explicitId contents
|
|
| T.null explicitId = DiagramId $ T.pack $ diagramPrefix <> take 6 (show (abs (hash (T.unpack contents))))
|
|
| otherwise = DiagramId explicitId
|
|
|
|
-- | Transform Mermaid code blocks into image embeds with resource cleanup
|
|
processMermaidBlock :: SourceDir -> OutputPath -> Block -> IO Block
|
|
processMermaidBlock (SourceDir sourceDir) (OutputPath outputPath) (CodeBlock (id', classes, _) contents)
|
|
| "mermaid" `elem` classes = do
|
|
let DiagramId diagId = generateDiagramId id' contents
|
|
diagIdStr = T.unpack diagId
|
|
mmdFile = sourceDir </> diagIdStr <> ".mmd"
|
|
-- Use SVG for HTML (scalable), high-res PNG for PDF (text compatibility)
|
|
(outputFile, imagePath) = if isHTMLOutput outputPath
|
|
then let svgFile = sourceDir </> diagIdStr <> ".svg"
|
|
in (svgFile, takeFileName svgFile)
|
|
else let pngFile = sourceDir </> diagIdStr <> ".png"
|
|
in (pngFile, pngFile)
|
|
|
|
-- Use bracket to ensure cleanup of temporary mermaid file
|
|
bracket
|
|
(TIO.writeFile mmdFile contents >> return mmdFile)
|
|
(\file -> removeFile file `catch` \(_ :: SomeException) -> return ())
|
|
(\_ -> do
|
|
-- Generate with appropriate format and quality for output type
|
|
if isHTMLOutput outputPath
|
|
then void $ callProcess mermaidCommand ["-i", mmdFile, "-o", outputFile]
|
|
else void $ callProcess mermaidCommand ["-i", mmdFile, "-o", outputFile, "--scale", "3"]
|
|
putStrLn $ successEmoji <> " Generated " <> outputFile
|
|
-- Let images scale naturally - LaTeX will handle oversized images with adjustbox
|
|
let imageAttrs = nullAttr -- Constrain size and maintain aspect ratio for PDF
|
|
return $ Para [Image imageAttrs [] (T.pack imagePath, "Mermaid diagram")])
|
|
processMermaidBlock _ _ block = return block
|
|
|
|
-- | Check if output is HTML format based on file extension
|
|
isHTMLOutput :: FilePath -> Bool
|
|
isHTMLOutput path = takeExtension path == ".html"
|
|
|
|
-- | Walk the Pandoc AST and process blocks using walkM
|
|
transformDocument :: SourceDir -> OutputPath -> Pandoc -> IO Pandoc
|
|
transformDocument sourceDir outputPath = walkM (processMermaidBlock sourceDir outputPath)
|
|
|
|
-- | LaTeX template with comprehensive package support
|
|
latexTemplate :: Text -> Text
|
|
latexTemplate bodyContent = T.unlines
|
|
[ "\\documentclass{article}"
|
|
, "\\usepackage[utf8]{inputenc}"
|
|
, "\\usepackage{fontspec}"
|
|
, "\\usepackage{graphicx}"
|
|
, "\\usepackage{adjustbox}"
|
|
, "\\usepackage{geometry}"
|
|
, "\\geometry{margin=1in}"
|
|
, "\\usepackage{hyperref}"
|
|
, "\\usepackage{enumitem}"
|
|
, "\\usepackage{amsmath}"
|
|
, "\\usepackage{amssymb}"
|
|
, "\\usepackage{fancyvrb}"
|
|
, "\\usepackage{color}"
|
|
, "\\DefineVerbatimEnvironment{Highlighting}{Verbatim}{commandchars=\\\\\\{\\}}"
|
|
, "\\newenvironment{Shaded}{}{}"
|
|
, syntaxHighlightingCommands
|
|
, "\\providecommand{\\tightlist}{%"
|
|
, " \\setlength{\\itemsep}{0pt}\\setlength{\\parskip}{0pt}}"
|
|
, "% Auto-scale oversized images to fit page"
|
|
, "\\makeatletter"
|
|
, "\\def\\maxwidth{\\ifdim\\Gin@nat@width>\\linewidth\\linewidth\\else\\Gin@nat@width\\fi}"
|
|
, "\\def\\maxheight{\\ifdim\\Gin@nat@height>\\textheight\\textheight\\else\\Gin@nat@height\\fi}"
|
|
, "\\makeatother"
|
|
, "\\setkeys{Gin}{width=\\maxwidth,height=\\maxheight,keepaspectratio}"
|
|
, "\\begin{document}"
|
|
, bodyContent
|
|
, "\\end{document}"
|
|
]
|
|
|
|
-- | Syntax highlighting commands for LaTeX
|
|
syntaxHighlightingCommands :: Text
|
|
syntaxHighlightingCommands = T.unlines
|
|
[ "\\newcommand{\\AlertTok}[1]{\\textcolor[rgb]{1.00,0.00,0.00}{\\textbf{#1}}}"
|
|
, "\\newcommand{\\AnnotationTok}[1]{\\textcolor[rgb]{0.38,0.63,0.69}{\\textbf{\\textit{#1}}}}"
|
|
, "\\newcommand{\\AttributeTok}[1]{\\textcolor[rgb]{0.49,0.56,0.16}{#1}}"
|
|
, "\\newcommand{\\BaseNTok}[1]{\\textcolor[rgb]{0.25,0.63,0.44}{#1}}"
|
|
, "\\newcommand{\\BuiltInTok}[1]{#1}"
|
|
, "\\newcommand{\\CharTok}[1]{\\textcolor[rgb]{0.25,0.44,0.63}{#1}}"
|
|
, "\\newcommand{\\CommentTok}[1]{\\textcolor[rgb]{0.38,0.63,0.69}{\\textit{#1}}}"
|
|
, "\\newcommand{\\CommentVarTok}[1]{\\textcolor[rgb]{0.38,0.63,0.69}{\\textbf{\\textit{#1}}}}"
|
|
, "\\newcommand{\\ConstantTok}[1]{\\textcolor[rgb]{0.53,0.00,0.00}{#1}}"
|
|
, "\\newcommand{\\ControlFlowTok}[1]{\\textcolor[rgb]{0.00,0.44,0.13}{\\textbf{#1}}}"
|
|
, "\\newcommand{\\DataTypeTok}[1]{\\textcolor[rgb]{0.56,0.13,0.00}{#1}}"
|
|
, "\\newcommand{\\DecValTok}[1]{\\textcolor[rgb]{0.25,0.63,0.44}{#1}}"
|
|
, "\\newcommand{\\DocumentationTok}[1]{\\textcolor[rgb]{0.73,0.13,0.13}{\\textit{#1}}}"
|
|
, "\\newcommand{\\ErrorTok}[1]{\\textcolor[rgb]{1.00,0.00,0.00}{\\textbf{#1}}}"
|
|
, "\\newcommand{\\ExtensionTok}[1]{#1}"
|
|
, "\\newcommand{\\FloatTok}[1]{\\textcolor[rgb]{0.25,0.63,0.44}{#1}}"
|
|
, "\\newcommand{\\FunctionTok}[1]{\\textcolor[rgb]{0.02,0.16,0.49}{#1}}"
|
|
, "\\newcommand{\\ImportTok}[1]{#1}"
|
|
, "\\newcommand{\\InformationTok}[1]{\\textcolor[rgb]{0.38,0.63,0.69}{\\textbf{\\textit{#1}}}}"
|
|
, "\\newcommand{\\KeywordTok}[1]{\\textcolor[rgb]{0.00,0.44,0.13}{\\textbf{#1}}}"
|
|
, "\\newcommand{\\NormalTok}[1]{#1}"
|
|
, "\\newcommand{\\OperatorTok}[1]{\\textcolor[rgb]{0.40,0.40,0.40}{#1}}"
|
|
, "\\newcommand{\\OtherTok}[1]{\\textcolor[rgb]{0.00,0.44,0.13}{#1}}"
|
|
, "\\newcommand{\\PreprocessorTok}[1]{\\textcolor[rgb]{0.74,0.48,0.00}{#1}}"
|
|
, "\\newcommand{\\RegionMarkerTok}[1]{#1}"
|
|
, "\\newcommand{\\SpecialCharTok}[1]{\\textcolor[rgb]{0.25,0.44,0.63}{#1}}"
|
|
, "\\newcommand{\\SpecialStringTok}[1]{\\textcolor[rgb]{0.73,0.40,0.53}{#1}}"
|
|
, "\\newcommand{\\StringTok}[1]{\\textcolor[rgb]{0.25,0.44,0.63}{#1}}"
|
|
, "\\newcommand{\\VariableTok}[1]{\\textcolor[rgb]{0.10,0.09,0.49}{#1}}"
|
|
, "\\newcommand{\\VerbatimStringTok}[1]{\\textcolor[rgb]{0.25,0.44,0.63}{#1}}"
|
|
, "\\newcommand{\\WarningTok}[1]{\\textcolor[rgb]{0.38,0.63,0.69}{\\textbf{\\textit{#1}}}}"
|
|
]
|
|
|
|
-- | Parse command line arguments
|
|
parseArgs :: [String] -> Either DocsterError (IO ())
|
|
parseArgs ["-pdf", path] = Right (compileToPDF path)
|
|
parseArgs ["-html", path] = Right (compileToHTML path)
|
|
parseArgs _ = Left $ InvalidUsage "Usage: docster -pdf|-html <file.md>"
|
|
|
|
-- | Compile markdown to PDF using XeLaTeX
|
|
compileToPDF :: FilePath -> IO ()
|
|
compileToPDF path = do
|
|
let sourceDir = SourceDir $ takeDirectory path
|
|
outputPath = OutputPath $ replaceExtension path "pdf"
|
|
|
|
result <- compileToPDFSafe sourceDir (OutputPath path) outputPath
|
|
case result of
|
|
Left err -> throwIO err
|
|
Right _ -> return ()
|
|
|
|
-- | Safe PDF compilation with proper error handling
|
|
compileToPDFSafe :: SourceDir -> OutputPath -> OutputPath -> IO (Either DocsterError ())
|
|
compileToPDFSafe sourceDir (OutputPath inputPath) outputPath@(OutputPath outputPathStr) = do
|
|
content <- TIO.readFile inputPath
|
|
let readerOptions = def { readerExtensions = getDefaultExtensions "markdown" }
|
|
|
|
pandoc <- runIOorExplode $ readMarkdown readerOptions content
|
|
transformed <- transformDocument sourceDir outputPath pandoc
|
|
|
|
-- Generate LaTeX with proper template
|
|
latexOutput <- runIOorExplode $ writeLaTeX def transformed
|
|
let completeLatex = latexTemplate latexOutput
|
|
|
|
result <- runIOorExplode $ makePDF "xelatex" [] (\_ _ -> return completeLatex) def transformed
|
|
case result of
|
|
Left err -> return $ Left $ PDFGenerationError $ T.pack $ show err
|
|
Right bs -> do
|
|
BL.writeFile outputPathStr bs
|
|
putStrLn $ successEmoji <> " PDF written to " <> outputPathStr
|
|
return $ Right ()
|
|
|
|
-- | Compile markdown to HTML
|
|
compileToHTML :: FilePath -> IO ()
|
|
compileToHTML path = do
|
|
let sourceDir = SourceDir $ takeDirectory path
|
|
outputPath = OutputPath $ replaceExtension path "html"
|
|
|
|
result <- compileToHTMLSafe sourceDir (OutputPath path) outputPath
|
|
case result of
|
|
Left err -> throwIO err
|
|
Right _ -> return ()
|
|
|
|
-- | Safe HTML compilation with proper error handling
|
|
compileToHTMLSafe :: SourceDir -> OutputPath -> OutputPath -> IO (Either DocsterError ())
|
|
compileToHTMLSafe sourceDir (OutputPath inputPath) outputPath@(OutputPath outputPathStr) = do
|
|
content <- TIO.readFile inputPath
|
|
let readerOptions = def { readerExtensions = getDefaultExtensions "markdown" }
|
|
|
|
pandoc <- runIOorExplode $ readMarkdown readerOptions content
|
|
transformed <- transformDocument sourceDir outputPath pandoc
|
|
|
|
html <- runIOorExplode $ writeHtml5String def transformed
|
|
TIO.writeFile outputPathStr html
|
|
putStrLn $ successEmoji <> " HTML written to " <> outputPathStr
|
|
|
|
-- Open the generated HTML file in browser
|
|
putStrLn $ "🌐 Opening " <> outputPathStr <> " in browser for error checking..."
|
|
void $ callProcess "open" [outputPathStr]
|
|
|
|
return $ Right ()
|
|
|
|
-- | Main entry point
|
|
main :: IO ()
|
|
main = do
|
|
args <- getArgs
|
|
case parseArgs args of
|
|
Left err -> throwIO err
|
|
Right action -> action |