Refactor Compiler.hs with higher-order functions to eliminate duplication

- Extract PDF and HTML compilation differences using strategy pattern
- Implement CompilationStrategy record with format-specific operations
- Create higher-order compileWithStrategy function for common pipeline
- Eliminate ~40 lines of duplicated code between PDF/HTML compilation
- Add LambdaCase extension for cleaner monadic error handling
- Maintain same external API while improving internal architecture
- Enable easy addition of new output formats through new strategies

🤖 Generated with [Claude Code](https://claude.ai/code)

Co-Authored-By: Claude <noreply@anthropic.com>
This commit is contained in:
Willem van den Ende 2025-07-29 23:12:13 +02:00
parent 1c8cfdb075
commit 303f347243

View File

@ -1,4 +1,5 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
-- | Document compilation functionality for PDF and HTML output
module Docster.Compiler
@ -25,81 +26,124 @@ import Control.Monad (void)
successEmoji :: Text
successEmoji = ""
-- | Compile markdown to PDF using XeLaTeX
compileToPDF :: FilePath -> IO ()
compileToPDF path = do
let sourceDir = SourceDir $ takeDirectory path
outputPath = OutputPath $ replaceExtension path "pdf"
-- | Strategy pattern: Record of format-specific operations
data CompilationStrategy = CompilationStrategy
{ -- | Format for diagram configuration
csOutputFormat :: OutputFormat
-- | Pandoc writer function
, csWriter :: WriterOptions -> Pandoc -> PandocIO Text
-- | Post-processing function for the generated content
, csProcessOutput :: Text -> String -> IO (Either DocsterError ())
-- | Success message formatter
, csSuccessMessage :: String -> Text
}
result <- compileToPDFSafe sourceDir (OutputPath path) outputPath
case result of
Left err -> throwIO err
Right _ -> return ()
-- | PDF compilation strategy
pdfStrategy :: CompilationStrategy
pdfStrategy = CompilationStrategy
{ csOutputFormat = PDF
, csWriter = writeLaTeX
, csProcessOutput = processPDFOutput
, csSuccessMessage = \path -> successEmoji <> " PDF written to " <> T.pack path
}
-- | Safe PDF compilation with comprehensive error handling
compileToPDFSafe :: SourceDir -> OutputPath -> OutputPath -> IO (Either DocsterError ())
compileToPDFSafe sourceDir (OutputPath inputPath) (OutputPath outputPathStr) = do
content <- TIO.readFile inputPath
let readerOptions = def { readerExtensions = getDefaultExtensions "markdown" }
config = DiagramConfig sourceDir PDF
-- | HTML compilation strategy
htmlStrategy :: CompilationStrategy
htmlStrategy = CompilationStrategy
{ csOutputFormat = HTML
, csWriter = writeHtml5String
, csProcessOutput = processHTMLOutput
, csSuccessMessage = \path -> successEmoji <> " HTML written to " <> T.pack path
}
pandocResult <- runIO $ readMarkdown readerOptions content
case pandocResult of
Left err -> return $ Left $ FileError $ "Failed to parse markdown: " <> T.pack (show err)
Right pandoc -> do
transformResult <- transformDocument config pandoc
case transformResult of
Left err -> return $ Left err
Right transformed -> do
latexResult <- runIO $ writeLaTeX def transformed
case latexResult of
Left err -> return $ Left $ PDFGenerationError $ "LaTeX generation failed: " <> T.pack (show err)
Right latexOutput -> do
-- | Process PDF output: LaTeX template application and PDF generation
processPDFOutput :: Text -> String -> IO (Either DocsterError ())
processPDFOutput latexOutput outputPath = do
let completeLatex = latexTemplate latexOutput
pdfResult <- runIO $ makePDF "xelatex" [] (\_ _ -> return completeLatex) def transformed
-- We need a Pandoc document for makePDF, but it's not used in the template function
-- Create a minimal document for the API
let dummyDoc = Pandoc nullMeta []
pdfResult <- runIO $ makePDF "xelatex" [] (\_ _ -> return completeLatex) def dummyDoc
case pdfResult of
Left err -> return $ Left $ PDFGenerationError $ T.pack $ show err
Right (Left err) -> return $ Left $ PDFGenerationError $ T.pack $ show err
Right (Right bs) -> do
BL.writeFile outputPathStr bs
putStrLn $ T.unpack $ successEmoji <> " PDF written to " <> T.pack outputPathStr
BL.writeFile outputPath bs
return $ Right ()
-- | Process HTML output: file writing and browser opening
processHTMLOutput :: Text -> String -> IO (Either DocsterError ())
processHTMLOutput html outputPath = do
TIO.writeFile outputPath html
-- Open the generated HTML file in browser for verification
putStrLn $ "🌐 Opening " <> outputPath <> " in browser for error checking..."
void $ callProcess "open" [outputPath]
return $ Right ()
-- | Higher-order compilation function that takes a strategy and executes the pipeline
compileWithStrategy :: CompilationStrategy -> SourceDir -> OutputPath -> OutputPath -> IO (Either DocsterError ())
compileWithStrategy strategy sourceDir (OutputPath inputPath) (OutputPath outputPath) = do
-- Step 1: Read and parse markdown
content <- TIO.readFile inputPath
let readerOptions = def { readerExtensions = getDefaultExtensions "markdown" }
config = DiagramConfig sourceDir (csOutputFormat strategy)
parseResult <- parseMarkdown readerOptions content
case parseResult of
Left err -> return $ Left err
Right pandoc ->
-- Step 2: Transform document (process Mermaid diagrams)
transformDocument config pandoc >>= \case
Left err -> return $ Left err
Right transformed ->
-- Step 3: Generate output using format-specific writer
generateOutput strategy transformed >>= \case
Left err -> return $ Left err
Right output -> do
-- Step 4: Process output and write to file
processResult <- csProcessOutput strategy output outputPath
case processResult of
Left err -> return $ Left err
Right _ -> do
-- Step 5: Print success message
putStrLn $ T.unpack $ csSuccessMessage strategy outputPath
return $ Right ()
-- | Parse markdown with error handling
parseMarkdown :: ReaderOptions -> Text -> IO (Either DocsterError Pandoc)
parseMarkdown readerOptions content = do
pandocResult <- runIO $ readMarkdown readerOptions content
return $ case pandocResult of
Left err -> Left $ FileError $ "Failed to parse markdown: " <> T.pack (show err)
Right pandoc -> Right pandoc
-- | Generate output using the strategy's writer with error handling
generateOutput :: CompilationStrategy -> Pandoc -> IO (Either DocsterError Text)
generateOutput strategy transformed = do
result <- runIO $ csWriter strategy def transformed
return $ case result of
Left err -> Left $ case csOutputFormat strategy of
PDF -> PDFGenerationError $ "LaTeX generation failed: " <> T.pack (show err)
HTML -> FileError $ "HTML generation failed: " <> T.pack (show err)
Right output -> Right output
-- | Compile markdown to PDF using XeLaTeX
compileToPDF :: FilePath -> IO ()
compileToPDF = compileWithFormat pdfStrategy "pdf"
-- | Compile markdown to HTML
compileToHTML :: FilePath -> IO ()
compileToHTML path = do
let sourceDir = SourceDir $ takeDirectory path
outputPath = OutputPath $ replaceExtension path "html"
compileToHTML = compileWithFormat htmlStrategy "html"
result <- compileToHTMLSafe sourceDir (OutputPath path) outputPath
-- | Higher-order function to compile with any format strategy
compileWithFormat :: CompilationStrategy -> String -> FilePath -> IO ()
compileWithFormat strategy extension path = do
let sourceDir = SourceDir $ takeDirectory path
outputPath = OutputPath $ replaceExtension path extension
result <- compileWithStrategy strategy sourceDir (OutputPath path) outputPath
case result of
Left err -> throwIO err
Right _ -> return ()
-- | Safe HTML compilation with comprehensive error handling
compileToHTMLSafe :: SourceDir -> OutputPath -> OutputPath -> IO (Either DocsterError ())
compileToHTMLSafe sourceDir (OutputPath inputPath) (OutputPath outputPathStr) = do
content <- TIO.readFile inputPath
let readerOptions = def { readerExtensions = getDefaultExtensions "markdown" }
config = DiagramConfig sourceDir HTML
pandocResult <- runIO $ readMarkdown readerOptions content
case pandocResult of
Left err -> return $ Left $ FileError $ "Failed to parse markdown: " <> T.pack (show err)
Right pandoc -> do
transformResult <- transformDocument config pandoc
case transformResult of
Left err -> return $ Left err
Right transformed -> do
htmlResult <- runIO $ writeHtml5String def transformed
case htmlResult of
Left err -> return $ Left $ FileError $ "HTML generation failed: " <> T.pack (show err)
Right html -> do
TIO.writeFile outputPathStr html
putStrLn $ T.unpack $ successEmoji <> " HTML written to " <> T.pack outputPathStr
-- Open the generated HTML file in browser for verification
putStrLn $ "🌐 Opening " <> outputPathStr <> " in browser for error checking..."
void $ callProcess "open" [outputPathStr]
return $ Right ()