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:
parent
1c8cfdb075
commit
303f347243
@ -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"
|
||||
|
||||
result <- compileToPDFSafe sourceDir (OutputPath path) outputPath
|
||||
case result of
|
||||
Left err -> throwIO err
|
||||
Right _ -> return ()
|
||||
-- | 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
|
||||
}
|
||||
|
||||
-- | Safe PDF compilation with comprehensive error handling
|
||||
compileToPDFSafe :: SourceDir -> OutputPath -> OutputPath -> IO (Either DocsterError ())
|
||||
compileToPDFSafe sourceDir (OutputPath inputPath) (OutputPath outputPathStr) = do
|
||||
-- | PDF compilation strategy
|
||||
pdfStrategy :: CompilationStrategy
|
||||
pdfStrategy = CompilationStrategy
|
||||
{ csOutputFormat = PDF
|
||||
, csWriter = writeLaTeX
|
||||
, csProcessOutput = processPDFOutput
|
||||
, csSuccessMessage = \path -> successEmoji <> " PDF written to " <> T.pack path
|
||||
}
|
||||
|
||||
-- | HTML compilation strategy
|
||||
htmlStrategy :: CompilationStrategy
|
||||
htmlStrategy = CompilationStrategy
|
||||
{ csOutputFormat = HTML
|
||||
, csWriter = writeHtml5String
|
||||
, csProcessOutput = processHTMLOutput
|
||||
, csSuccessMessage = \path -> successEmoji <> " HTML written to " <> T.pack path
|
||||
}
|
||||
|
||||
-- | Process PDF output: LaTeX template application and PDF generation
|
||||
processPDFOutput :: Text -> String -> IO (Either DocsterError ())
|
||||
processPDFOutput latexOutput outputPath = do
|
||||
let completeLatex = latexTemplate latexOutput
|
||||
-- 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 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 PDF
|
||||
config = DiagramConfig sourceDir (csOutputFormat strategy)
|
||||
|
||||
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
|
||||
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 -> do
|
||||
latexResult <- runIO $ writeLaTeX def transformed
|
||||
case latexResult of
|
||||
Left err -> return $ Left $ PDFGenerationError $ "LaTeX generation failed: " <> T.pack (show err)
|
||||
Right latexOutput -> do
|
||||
let completeLatex = latexTemplate latexOutput
|
||||
pdfResult <- runIO $ makePDF "xelatex" [] (\_ _ -> return completeLatex) def transformed
|
||||
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
|
||||
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
|
||||
compileToHTML = compileWithFormat htmlStrategy "html"
|
||||
|
||||
-- | 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 "html"
|
||||
outputPath = OutputPath $ replaceExtension path extension
|
||||
|
||||
result <- compileToHTMLSafe sourceDir (OutputPath path) outputPath
|
||||
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 ()
|
||||
Right _ -> return ()
|
||||
Loading…
x
Reference in New Issue
Block a user