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:
parent
f7a6482447
commit
e6048e34d1
52
.claude/agents/haskell-refactoring-expert.md
Normal file
52
.claude/agents/haskell-refactoring-expert.md
Normal file
@ -0,0 +1,52 @@
|
|||||||
|
---
|
||||||
|
name: haskell-refactoring-expert
|
||||||
|
description: Use this agent when you need to refactor Haskell code to improve clarity, resolve package dependencies, enhance naming conventions, optimize library usage (especially Text vs String vs ByteString), create cleaner abstractions without over-engineering, and organize code into appropriate module structure by splitting large files when beneficial. Examples: <example>Context: User has written some Haskell code that mixes String and Text types inconsistently. user: 'I just wrote this function that processes file paths but I'm mixing String and Text types. Can you help clean this up?' assistant: 'I'll use the haskell-refactoring-expert agent to analyze your code and provide refactoring suggestions for consistent type usage.' <commentary>The user needs help with type consistency in Haskell, which is exactly what the haskell-refactoring-expert specializes in.</commentary></example> <example>Context: User has a Haskell module with unclear function names and tangled dependencies. user: 'This module has grown organically and now the dependencies are a mess and the function names don't clearly express their intent.' assistant: 'Let me use the haskell-refactoring-expert agent to analyze your module structure and suggest improvements for naming and dependency organization.' <commentary>This is a perfect case for the refactoring expert to address naming and dependency issues.</commentary></example>
|
||||||
|
tools: Task, Bash, Glob, Grep, LS, ExitPlanMode, Read, Edit, MultiEdit, Write, NotebookRead, NotebookEdit, WebFetch, TodoWrite, WebSearch, mcp__sequential-thinking__sequentialthinking
|
||||||
|
color: cyan
|
||||||
|
---
|
||||||
|
|
||||||
|
You are an expert Haskell developer with impeccable taste in refactoring and a deep understanding of idiomatic Haskell code. Your expertise lies in transforming messy, unclear, or inefficient Haskell code into clean, well-structured, and maintainable solutions.
|
||||||
|
|
||||||
|
Your core responsibilities:
|
||||||
|
|
||||||
|
**Dependency Management**: Analyze and resolve package dependency issues by identifying redundant imports, suggesting more appropriate libraries, and organizing module dependencies for clarity and minimal coupling.
|
||||||
|
|
||||||
|
**Module Organization**: Analyze file size and functional responsibilities to determine when to split large files into separate modules. Create appropriate module hierarchies following Haskell conventions (ProjectName.ModuleName). Keep Main.hs focused on CLI and orchestration only.
|
||||||
|
|
||||||
|
**File Splitting Criteria**:
|
||||||
|
- Split files exceeding 150-200 lines into logical modules
|
||||||
|
- Create separate modules when there are 3+ distinct responsibilities
|
||||||
|
- Extract common patterns: Types, Utils, Parser, Renderer modules
|
||||||
|
- Always update cabal file's other-modules section for new modules
|
||||||
|
|
||||||
|
**Modularity**: Analyze responsibilities of data structures and functions that operate on them. Separate functions that have different responsibilities into separate modules.
|
||||||
|
|
||||||
|
**Patterns**: Refactor towards modular patterns that represent current good practice in Haskell.
|
||||||
|
|
||||||
|
**Type System Optimization**: Make precise decisions about when to use String, Text, ByteString, or other data types based on performance characteristics and API requirements. Always justify your type choices with clear reasoning.
|
||||||
|
|
||||||
|
**Naming Excellence**: Transform unclear variable, function, and module names into self-documenting identifiers that clearly express intent and domain concepts. Follow Haskell naming conventions while prioritizing clarity.
|
||||||
|
|
||||||
|
**Clean Abstractions**: Create appropriate abstractions that eliminate code duplication and improve maintainability without falling into over-engineering traps. Know when to abstract and when to keep things simple.
|
||||||
|
|
||||||
|
**Library Usage Mastery**: Recommend the most appropriate libraries and functions for specific tasks, considering factors like performance, maintainability, and ecosystem maturity.
|
||||||
|
|
||||||
|
Your refactoring approach:
|
||||||
|
1. **Analyze First**: Examine the existing code structure, dependencies, and patterns before suggesting changes
|
||||||
|
2. **Assess Structure**: Evaluate if large files (>150 lines) should be split into logical modules
|
||||||
|
3. **Prioritize Impact**: Focus on changes that provide the most significant improvement in clarity and maintainability
|
||||||
|
4. **Create When Beneficial**: Don't hesitate to create new modules/files when it improves organization
|
||||||
|
5. **Preserve Semantics**: Ensure all refactoring maintains the original behavior unless explicitly asked to change functionality
|
||||||
|
6. **Explain Rationale**: Always explain why specific refactoring choices improve the code
|
||||||
|
7. **Consider Context**: Take into account the broader codebase context and project requirements when making suggestions
|
||||||
|
|
||||||
|
When reviewing code:
|
||||||
|
- Assess if file size and responsibilities warrant splitting into modules
|
||||||
|
- Identify inconsistent type usage (especially String/Text/ByteString mixing)
|
||||||
|
- Spot opportunities for better naming that expresses domain concepts
|
||||||
|
- Detect unnecessary dependencies or missing beneficial ones
|
||||||
|
- Recognize patterns that could benefit from cleaner abstractions
|
||||||
|
- Flag over-engineered solutions that could be simplified
|
||||||
|
- Check if module structure follows Haskell conventions and project needs
|
||||||
|
|
||||||
|
Always provide concrete, actionable refactoring suggestions with clear before/after examples. Your goal is to elevate Haskell code to its most elegant and maintainable form while respecting the principle that perfect is the enemy of good.
|
193
app/Main.hs
193
app/Main.hs
@ -4,12 +4,9 @@
|
|||||||
module Main (main) where
|
module Main (main) where
|
||||||
|
|
||||||
import Text.Pandoc
|
import Text.Pandoc
|
||||||
import Text.Pandoc.Class (runIOorExplode)
|
|
||||||
import Text.Pandoc.PDF (makePDF)
|
import Text.Pandoc.PDF (makePDF)
|
||||||
import Text.Pandoc.Walk (walkM)
|
|
||||||
import Text.Pandoc.Extensions (getDefaultExtensions)
|
|
||||||
import System.Environment (getArgs)
|
import System.Environment (getArgs)
|
||||||
import System.FilePath (replaceExtension, takeDirectory, takeFileName, takeExtension, (</>))
|
import System.FilePath (replaceExtension, takeDirectory, takeFileName, (</>))
|
||||||
import System.Process (callProcess)
|
import System.Process (callProcess)
|
||||||
import System.Directory (removeFile)
|
import System.Directory (removeFile)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
@ -30,63 +27,106 @@ data DocsterError
|
|||||||
|
|
||||||
instance Exception 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
|
-- | Type-safe wrappers for better domain modeling
|
||||||
newtype SourceDir = SourceDir FilePath deriving (Show, Eq)
|
newtype SourceDir = SourceDir FilePath deriving (Show, Eq)
|
||||||
newtype OutputPath = OutputPath FilePath deriving (Show, Eq)
|
newtype OutputPath = OutputPath FilePath deriving (Show, Eq)
|
||||||
newtype DiagramId = DiagramId Text deriving (Show, Eq)
|
newtype DiagramId = DiagramId Text deriving (Show, Eq)
|
||||||
|
|
||||||
-- | Constants for the application
|
-- | Configuration for diagram generation
|
||||||
mermaidCommand :: String
|
data DiagramConfig = DiagramConfig
|
||||||
|
{ dcSourceDir :: SourceDir
|
||||||
|
, dcOutputFormat :: OutputFormat
|
||||||
|
} deriving (Show)
|
||||||
|
|
||||||
|
-- | Constants for the application (using Text for consistency)
|
||||||
|
mermaidCommand :: Text
|
||||||
mermaidCommand = "mmdc"
|
mermaidCommand = "mmdc"
|
||||||
|
|
||||||
diagramPrefix :: String
|
diagramPrefix :: Text
|
||||||
diagramPrefix = "diagram-"
|
diagramPrefix = "diagram-"
|
||||||
|
|
||||||
successEmoji :: String
|
successEmoji :: Text
|
||||||
successEmoji = "✅"
|
successEmoji = "✅"
|
||||||
|
|
||||||
-- | Generate a diagram ID from content hash or explicit ID
|
-- | Generate a diagram ID from content hash or explicit ID
|
||||||
generateDiagramId :: Text -> Text -> DiagramId
|
generateDiagramId :: Text -> Text -> DiagramId
|
||||||
generateDiagramId explicitId contents
|
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
|
| otherwise = DiagramId explicitId
|
||||||
|
|
||||||
-- | Transform Mermaid code blocks into image embeds with resource cleanup
|
-- | Transform Mermaid code blocks into image embeds with resource cleanup
|
||||||
processMermaidBlock :: SourceDir -> OutputPath -> Block -> IO Block
|
processMermaidBlock :: DiagramConfig -> Block -> IO (Either DocsterError Block)
|
||||||
processMermaidBlock (SourceDir sourceDir) (OutputPath outputPath) (CodeBlock (id', classes, _) contents)
|
processMermaidBlock config (CodeBlock (id', classes, _) contents)
|
||||||
| "mermaid" `elem` classes = do
|
| "mermaid" `elem` classes = do
|
||||||
let DiagramId diagId = generateDiagramId id' contents
|
let diagId = generateDiagramId id' contents
|
||||||
diagIdStr = T.unpack diagId
|
result <- renderMermaidDiagram config diagId contents
|
||||||
mmdFile = sourceDir </> diagIdStr <> ".mmd"
|
case result of
|
||||||
-- Use SVG for HTML (scalable), high-res PNG for PDF (text compatibility)
|
Left err -> return $ Left err
|
||||||
(outputFile, imagePath) = if isHTMLOutput outputPath
|
Right imagePath -> return $ Right $ createImageBlock imagePath
|
||||||
then let svgFile = sourceDir </> diagIdStr <> ".svg"
|
processMermaidBlock _ block = return $ Right block
|
||||||
in (svgFile, takeFileName svgFile)
|
|
||||||
else let pngFile = sourceDir </> diagIdStr <> ".png"
|
|
||||||
in (pngFile, pngFile)
|
|
||||||
|
|
||||||
-- Use bracket to ensure cleanup of temporary mermaid file
|
-- | Generate file paths for diagram based on format
|
||||||
bracket
|
generateDiagramPaths :: DiagramConfig -> DiagramId -> (FilePath, Text)
|
||||||
(TIO.writeFile mmdFile contents >> return mmdFile)
|
generateDiagramPaths (DiagramConfig (SourceDir sourceDir) format) (DiagramId diagId) =
|
||||||
(\file -> removeFile file `catch` \(_ :: SomeException) -> return ())
|
let diagIdStr = T.unpack diagId
|
||||||
(\_ -> do
|
in case format of
|
||||||
-- Generate with appropriate format and quality for output type
|
HTML -> let svgFile = sourceDir </> diagIdStr <> ".svg"
|
||||||
if isHTMLOutput outputPath
|
in (svgFile, T.pack $ takeFileName svgFile)
|
||||||
then void $ callProcess mermaidCommand ["-i", mmdFile, "-o", outputFile]
|
PDF -> let pngFile = sourceDir </> diagIdStr <> ".png"
|
||||||
else void $ callProcess mermaidCommand ["-i", mmdFile, "-o", outputFile, "--scale", "3"]
|
in (pngFile, T.pack pngFile)
|
||||||
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
|
-- | Render Mermaid diagram to appropriate format
|
||||||
isHTMLOutput :: FilePath -> Bool
|
renderMermaidDiagram :: DiagramConfig -> DiagramId -> Text -> IO (Either DocsterError Text)
|
||||||
isHTMLOutput path = takeExtension path == ".html"
|
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
|
-- | Call mermaid process with appropriate arguments
|
||||||
transformDocument :: SourceDir -> OutputPath -> Pandoc -> IO Pandoc
|
callMermaidProcess :: OutputFormat -> FilePath -> FilePath -> IO (Either DocsterError ())
|
||||||
transformDocument sourceDir outputPath = walkM (processMermaidBlock sourceDir outputPath)
|
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
|
-- | LaTeX template with comprehensive package support
|
||||||
latexTemplate :: Text -> Text
|
latexTemplate :: Text -> Text
|
||||||
@ -175,24 +215,32 @@ compileToPDF path = do
|
|||||||
|
|
||||||
-- | Safe PDF compilation with proper error handling
|
-- | Safe PDF compilation with proper error handling
|
||||||
compileToPDFSafe :: SourceDir -> OutputPath -> OutputPath -> IO (Either DocsterError ())
|
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
|
content <- TIO.readFile inputPath
|
||||||
let readerOptions = def { readerExtensions = getDefaultExtensions "markdown" }
|
let readerOptions = def { readerExtensions = getDefaultExtensions "markdown" }
|
||||||
|
config = DiagramConfig sourceDir PDF
|
||||||
|
|
||||||
pandoc <- runIOorExplode $ readMarkdown readerOptions content
|
pandocResult <- runIO $ readMarkdown readerOptions content
|
||||||
transformed <- transformDocument sourceDir outputPath pandoc
|
case pandocResult of
|
||||||
|
Left err -> return $ Left $ FileError $ "Failed to parse markdown: " <> T.pack (show err)
|
||||||
-- Generate LaTeX with proper template
|
Right pandoc -> do
|
||||||
latexOutput <- runIOorExplode $ writeLaTeX def transformed
|
transformResult <- transformDocument config pandoc
|
||||||
let completeLatex = latexTemplate latexOutput
|
case transformResult of
|
||||||
|
Left err -> return $ Left err
|
||||||
result <- runIOorExplode $ makePDF "xelatex" [] (\_ _ -> return completeLatex) def transformed
|
Right transformed -> do
|
||||||
case result of
|
latexResult <- runIO $ writeLaTeX def transformed
|
||||||
Left err -> return $ Left $ PDFGenerationError $ T.pack $ show err
|
case latexResult of
|
||||||
Right bs -> do
|
Left err -> return $ Left $ PDFGenerationError $ "LaTeX generation failed: " <> T.pack (show err)
|
||||||
BL.writeFile outputPathStr bs
|
Right latexOutput -> do
|
||||||
putStrLn $ successEmoji <> " PDF written to " <> outputPathStr
|
let completeLatex = latexTemplate latexOutput
|
||||||
return $ Right ()
|
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
|
-- | Compile markdown to HTML
|
||||||
compileToHTML :: FilePath -> IO ()
|
compileToHTML :: FilePath -> IO ()
|
||||||
@ -207,22 +255,31 @@ compileToHTML path = do
|
|||||||
|
|
||||||
-- | Safe HTML compilation with proper error handling
|
-- | Safe HTML compilation with proper error handling
|
||||||
compileToHTMLSafe :: SourceDir -> OutputPath -> OutputPath -> IO (Either DocsterError ())
|
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
|
content <- TIO.readFile inputPath
|
||||||
let readerOptions = def { readerExtensions = getDefaultExtensions "markdown" }
|
let readerOptions = def { readerExtensions = getDefaultExtensions "markdown" }
|
||||||
|
config = DiagramConfig sourceDir HTML
|
||||||
|
|
||||||
pandoc <- runIOorExplode $ readMarkdown readerOptions content
|
pandocResult <- runIO $ readMarkdown readerOptions content
|
||||||
transformed <- transformDocument sourceDir outputPath pandoc
|
case pandocResult of
|
||||||
|
Left err -> return $ Left $ FileError $ "Failed to parse markdown: " <> T.pack (show err)
|
||||||
html <- runIOorExplode $ writeHtml5String def transformed
|
Right pandoc -> do
|
||||||
TIO.writeFile outputPathStr html
|
transformResult <- transformDocument config pandoc
|
||||||
putStrLn $ successEmoji <> " HTML written to " <> outputPathStr
|
case transformResult of
|
||||||
|
Left err -> return $ Left err
|
||||||
-- Open the generated HTML file in browser
|
Right transformed -> do
|
||||||
putStrLn $ "🌐 Opening " <> outputPathStr <> " in browser for error checking..."
|
htmlResult <- runIO $ writeHtml5String def transformed
|
||||||
void $ callProcess "open" [outputPathStr]
|
case htmlResult of
|
||||||
|
Left err -> return $ Left $ FileError $ "HTML generation failed: " <> T.pack (show err)
|
||||||
return $ Right ()
|
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 entry point
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
|
Loading…
x
Reference in New Issue
Block a user