Refactor Haskell code with enhanced type safety and error handling
- Add OutputFormat ADT for explicit format handling vs file extension checking - Replace crash-prone runIOorExplode with proper Either error handling - Extract processMermaidBlock into focused functions for better maintainability - Convert String constants to Text for type consistency - Add DiagramConfig type for better configuration management - Enhance haskell-refactoring-expert agent to handle module organization 🤖 Generated with [Claude Code](https://claude.ai/code) Co-Authored-By: Claude <noreply@anthropic.com>
This commit is contained in:
Claude
+125
-68
@@ -4,12 +4,9 @@
|
||||
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.FilePath (replaceExtension, takeDirectory, takeFileName, (</>))
|
||||
import System.Process (callProcess)
|
||||
import System.Directory (removeFile)
|
||||
import Data.Text (Text)
|
||||
@@ -30,63 +27,106 @@ data DocsterError
|
||||
|
||||
instance Exception DocsterError
|
||||
|
||||
-- | Output format for explicit handling instead of file extension checking
|
||||
data OutputFormat = PDF | HTML deriving (Show, Eq)
|
||||
|
||||
-- | 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
|
||||
-- | Configuration for diagram generation
|
||||
data DiagramConfig = DiagramConfig
|
||||
{ dcSourceDir :: SourceDir
|
||||
, dcOutputFormat :: OutputFormat
|
||||
} deriving (Show)
|
||||
|
||||
-- | Constants for the application (using Text for consistency)
|
||||
mermaidCommand :: Text
|
||||
mermaidCommand = "mmdc"
|
||||
|
||||
diagramPrefix :: String
|
||||
diagramPrefix :: Text
|
||||
diagramPrefix = "diagram-"
|
||||
|
||||
successEmoji :: String
|
||||
successEmoji :: Text
|
||||
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))))
|
||||
| T.null explicitId = DiagramId $ diagramPrefix <> T.take 6 (T.pack . 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)
|
||||
processMermaidBlock :: DiagramConfig -> Block -> IO (Either DocsterError Block)
|
||||
processMermaidBlock config (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)
|
||||
let diagId = generateDiagramId id' contents
|
||||
result <- renderMermaidDiagram config diagId contents
|
||||
case result of
|
||||
Left err -> return $ Left err
|
||||
Right imagePath -> return $ Right $ createImageBlock imagePath
|
||||
processMermaidBlock _ block = return $ Right block
|
||||
|
||||
-- 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
|
||||
-- | Generate file paths for diagram based on format
|
||||
generateDiagramPaths :: DiagramConfig -> DiagramId -> (FilePath, Text)
|
||||
generateDiagramPaths (DiagramConfig (SourceDir sourceDir) format) (DiagramId diagId) =
|
||||
let diagIdStr = T.unpack diagId
|
||||
in case format of
|
||||
HTML -> let svgFile = sourceDir </> diagIdStr <> ".svg"
|
||||
in (svgFile, T.pack $ takeFileName svgFile)
|
||||
PDF -> let pngFile = sourceDir </> diagIdStr <> ".png"
|
||||
in (pngFile, T.pack pngFile)
|
||||
|
||||
-- | Check if output is HTML format based on file extension
|
||||
isHTMLOutput :: FilePath -> Bool
|
||||
isHTMLOutput path = takeExtension path == ".html"
|
||||
-- | Render Mermaid diagram to appropriate format
|
||||
renderMermaidDiagram :: DiagramConfig -> DiagramId -> Text -> IO (Either DocsterError Text)
|
||||
renderMermaidDiagram config@(DiagramConfig (SourceDir sourceDir) format) diagId contents = do
|
||||
let diagIdStr = T.unpack $ (\(DiagramId d) -> d) diagId
|
||||
mmdFile = sourceDir </> diagIdStr <> ".mmd"
|
||||
(outputFile, imagePath) = generateDiagramPaths config diagId
|
||||
|
||||
-- Use bracket to ensure cleanup of temporary mermaid file
|
||||
result <- bracket
|
||||
(TIO.writeFile mmdFile contents >> return mmdFile)
|
||||
(\file -> removeFile file `catch` \(_ :: SomeException) -> return ())
|
||||
(\_ -> do
|
||||
processResult <- callMermaidProcess format mmdFile outputFile
|
||||
case processResult of
|
||||
Left err -> return $ Left err
|
||||
Right _ -> do
|
||||
putStrLn $ T.unpack $ successEmoji <> " Generated " <> T.pack outputFile
|
||||
return $ Right imagePath)
|
||||
return result
|
||||
|
||||
-- | Walk the Pandoc AST and process blocks using walkM
|
||||
transformDocument :: SourceDir -> OutputPath -> Pandoc -> IO Pandoc
|
||||
transformDocument sourceDir outputPath = walkM (processMermaidBlock sourceDir outputPath)
|
||||
-- | Call mermaid process with appropriate arguments
|
||||
callMermaidProcess :: OutputFormat -> FilePath -> FilePath -> IO (Either DocsterError ())
|
||||
callMermaidProcess format mmdFile outputFile = do
|
||||
let args = case format of
|
||||
HTML -> ["-i", mmdFile, "-o", outputFile]
|
||||
PDF -> ["-i", mmdFile, "-o", outputFile, "--scale", "3"]
|
||||
|
||||
result <- catch
|
||||
(callProcess (T.unpack mermaidCommand) args >> return (Right ()))
|
||||
(\(e :: SomeException) -> return $ Left $ ProcessError $ "Mermaid process failed: " <> T.pack (show e))
|
||||
return result
|
||||
|
||||
-- | Create Pandoc image block
|
||||
createImageBlock :: Text -> Block
|
||||
createImageBlock imagePath = Para [Image nullAttr [] (imagePath, "Mermaid diagram")]
|
||||
|
||||
-- | Walk the Pandoc AST and process blocks using walkM with proper error handling
|
||||
transformDocument :: DiagramConfig -> Pandoc -> IO (Either DocsterError Pandoc)
|
||||
transformDocument config doc = do
|
||||
result <- walkMEither (processMermaidBlock config) doc
|
||||
return result
|
||||
|
||||
-- | Walk with error handling - transforms Either into IO Either
|
||||
walkMEither :: Monad m => (Block -> m (Either e Block)) -> Pandoc -> m (Either e Pandoc)
|
||||
walkMEither f (Pandoc meta blocks) = do
|
||||
results <- mapM f blocks
|
||||
case sequence results of
|
||||
Left err -> return $ Left err
|
||||
Right newBlocks -> return $ Right $ Pandoc meta newBlocks
|
||||
|
||||
-- | LaTeX template with comprehensive package support
|
||||
latexTemplate :: Text -> Text
|
||||
@@ -175,24 +215,32 @@ compileToPDF path = do
|
||||
|
||||
-- | Safe PDF compilation with proper error handling
|
||||
compileToPDFSafe :: SourceDir -> OutputPath -> OutputPath -> IO (Either DocsterError ())
|
||||
compileToPDFSafe sourceDir (OutputPath inputPath) outputPath@(OutputPath outputPathStr) = do
|
||||
compileToPDFSafe sourceDir (OutputPath inputPath) (OutputPath outputPathStr) = do
|
||||
content <- TIO.readFile inputPath
|
||||
let readerOptions = def { readerExtensions = getDefaultExtensions "markdown" }
|
||||
config = DiagramConfig sourceDir PDF
|
||||
|
||||
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 ()
|
||||
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
|
||||
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
|
||||
return $ Right ()
|
||||
|
||||
-- | Compile markdown to HTML
|
||||
compileToHTML :: FilePath -> IO ()
|
||||
@@ -207,22 +255,31 @@ compileToHTML path = do
|
||||
|
||||
-- | Safe HTML compilation with proper error handling
|
||||
compileToHTMLSafe :: SourceDir -> OutputPath -> OutputPath -> IO (Either DocsterError ())
|
||||
compileToHTMLSafe sourceDir (OutputPath inputPath) outputPath@(OutputPath outputPathStr) = do
|
||||
compileToHTMLSafe sourceDir (OutputPath inputPath) (OutputPath outputPathStr) = do
|
||||
content <- TIO.readFile inputPath
|
||||
let readerOptions = def { readerExtensions = getDefaultExtensions "markdown" }
|
||||
config = DiagramConfig sourceDir HTML
|
||||
|
||||
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 ()
|
||||
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
|
||||
putStrLn $ "🌐 Opening " <> outputPathStr <> " in browser for error checking..."
|
||||
void $ callProcess "open" [outputPathStr]
|
||||
|
||||
return $ Right ()
|
||||
|
||||
-- | Main entry point
|
||||
main :: IO ()
|
||||
|
||||
Reference in New Issue
Block a user