Split Main.hs into logical modules for better maintainability

- Extract types into Docster.Types module (50 lines)
- Move Mermaid processing to Docster.Mermaid module (93 lines)
- Create Docster.Transform for document walking (21 lines)
- Isolate LaTeX templates in Docster.LaTeX module (65 lines)
- Extract compilation logic to Docster.Compiler module (90 lines)
- Reduce Main.hs to minimal CLI entry point (23 lines from 233)
- Add library stanza to cabal file with proper module organization
- Follow Haskell conventions with Docster.ModuleName hierarchy

🤖 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 22:31:55 +02:00
parent e6048e34d1
commit 1c8cfdb075
7 changed files with 374 additions and 276 deletions

View File

@ -1,287 +1,20 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | Docster CLI - Convert Markdown with Mermaid diagrams to PDF/HTML
module Main (main) where module Main (main) where
import Text.Pandoc import Docster.Types (DocsterError(..))
import Text.Pandoc.PDF (makePDF) import Docster.Compiler (compileToPDF, compileToHTML)
import System.Environment (getArgs) import System.Environment (getArgs)
import System.FilePath (replaceExtension, takeDirectory, takeFileName, (</>)) import Control.Exception (throwIO)
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 -- | Parse command line arguments and return appropriate action
data DocsterError
= InvalidUsage Text
| FileError Text
| PDFGenerationError Text
| ProcessError Text
deriving (Show)
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)
-- | 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 :: Text
diagramPrefix = "diagram-"
successEmoji :: Text
successEmoji = ""
-- | Generate a diagram ID from content hash or explicit ID
generateDiagramId :: Text -> Text -> DiagramId
generateDiagramId explicitId 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 :: DiagramConfig -> Block -> IO (Either DocsterError Block)
processMermaidBlock config (CodeBlock (id', classes, _) contents)
| "mermaid" `elem` classes = do
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
-- | 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)
-- | 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
-- | 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
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 :: [String] -> Either DocsterError (IO ())
parseArgs ["-pdf", path] = Right (compileToPDF path) parseArgs ["-pdf", path] = Right (compileToPDF path)
parseArgs ["-html", path] = Right (compileToHTML path) parseArgs ["-html", path] = Right (compileToHTML path)
parseArgs _ = Left $ InvalidUsage "Usage: docster -pdf|-html <file.md>" parseArgs _ = Left $ InvalidUsage "Usage: docster -pdf|-html <file.md>"
-- | Compile markdown to PDF using XeLaTeX -- | Main entry point - parse arguments and execute appropriate action
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 outputPathStr) = do
content <- TIO.readFile inputPath
let readerOptions = def { readerExtensions = getDefaultExtensions "markdown" }
config = DiagramConfig sourceDir PDF
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 ()
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 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
putStrLn $ "🌐 Opening " <> outputPathStr <> " in browser for error checking..."
void $ callProcess "open" [outputPathStr]
return $ Right ()
-- | Main entry point
main :: IO () main :: IO ()
main = do main = do
args <- getArgs args <- getArgs

View File

@ -25,10 +25,14 @@ common warnings
-Wpartial-fields -Wpartial-fields
-Wredundant-constraints -Wredundant-constraints
executable docster library
import: warnings import: warnings
main-is: Main.hs exposed-modules: Docster.Types
hs-source-dirs: app Docster.Mermaid
Docster.Transform
Docster.LaTeX
Docster.Compiler
hs-source-dirs: src
build-depends: build-depends:
base >=4.21 && <5, base >=4.21 && <5,
text >=2.0 && <2.2, text >=2.0 && <2.2,
@ -40,6 +44,16 @@ executable docster
pandoc-types >=1.23 && <1.25, pandoc-types >=1.23 && <1.25,
bytestring >=0.11 && <0.13 bytestring >=0.11 && <0.13
default-language: Haskell2010 default-language: Haskell2010
executable docster
import: warnings
main-is: Main.hs
hs-source-dirs: app
build-depends:
base >=4.21 && <5,
text >=2.0 && <2.2,
docster
default-language: Haskell2010
ghc-options: -threaded ghc-options: -threaded
-rtsopts -rtsopts
-with-rtsopts=-N -with-rtsopts=-N

105
src/Docster/Compiler.hs Normal file
View File

@ -0,0 +1,105 @@
{-# LANGUAGE OverloadedStrings #-}
-- | Document compilation functionality for PDF and HTML output
module Docster.Compiler
( -- * Compilation Functions
compileToPDF
, compileToHTML
) where
import Docster.Types
import Docster.Transform (transformDocument)
import Docster.LaTeX (latexTemplate)
import Text.Pandoc
import Text.Pandoc.PDF (makePDF)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import qualified Data.ByteString.Lazy as BL
import System.FilePath (takeDirectory, replaceExtension)
import System.Process (callProcess)
import Control.Exception (throwIO)
import Control.Monad (void)
-- | Success indicator for user feedback
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 ()
-- | 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
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 ()
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 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 ()

78
src/Docster/LaTeX.hs Normal file
View File

@ -0,0 +1,78 @@
{-# LANGUAGE OverloadedStrings #-}
-- | LaTeX template and syntax highlighting definitions
module Docster.LaTeX
( -- * LaTeX Generation
latexTemplate
) where
import Data.Text (Text)
import qualified Data.Text as T
-- | LaTeX template with comprehensive package support for PDF generation
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 code blocks
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}}}}"
]

94
src/Docster/Mermaid.hs Normal file
View File

@ -0,0 +1,94 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | Mermaid diagram processing functionality
module Docster.Mermaid
( -- * Diagram Processing
processMermaidBlock
, renderMermaidDiagram
, generateDiagramId
) where
import Docster.Types
import Text.Pandoc.Definition (Block(..), Inline(..), nullAttr)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Data.Hashable (hash)
import System.FilePath (takeFileName, (</>))
import System.Directory (removeFile)
import System.Process (callProcess)
import Control.Exception (bracket, catch, SomeException)
-- | Application constants
mermaidCommand :: Text
mermaidCommand = "mmdc"
diagramPrefix :: Text
diagramPrefix = "diagram-"
successEmoji :: Text
successEmoji = ""
-- | Generate a diagram ID from content hash or explicit ID
generateDiagramId :: Text -> Text -> DiagramId
generateDiagramId explicitId 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
processMermaidBlock :: DiagramConfig -> Block -> IO (Either DocsterError Block)
processMermaidBlock config (CodeBlock (id', classes, _) contents)
| "mermaid" `elem` classes = do
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
-- | Render Mermaid diagram to appropriate format with resource cleanup
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
-- | 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)
-- | Call mermaid CLI 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 from image path
createImageBlock :: Text -> Block
createImageBlock imagePath = Para [Image nullAttr [] (imagePath, "Mermaid diagram")]

23
src/Docster/Transform.hs Normal file
View File

@ -0,0 +1,23 @@
{-# LANGUAGE OverloadedStrings #-}
-- | Document transformation functionality for processing Pandoc AST
module Docster.Transform
( -- * Document Transformation
transformDocument
) where
import Docster.Types
import Docster.Mermaid (processMermaidBlock)
import Text.Pandoc.Definition (Pandoc(..), Block)
-- | Walk the Pandoc AST and process blocks with error handling
transformDocument :: DiagramConfig -> Pandoc -> IO (Either DocsterError Pandoc)
transformDocument config doc = walkMEither (processMermaidBlock config) doc
-- | 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

51
src/Docster/Types.hs Normal file
View File

@ -0,0 +1,51 @@
{-# LANGUAGE OverloadedStrings #-}
-- | Core types and error definitions for Docster
module Docster.Types
( -- * Error Types
DocsterError(..)
-- * Output Format
, OutputFormat(..)
-- * Domain Types
, SourceDir(..)
, OutputPath(..)
, DiagramId(..)
, DiagramConfig(..)
) where
import Data.Text (Text)
import Control.Exception (Exception)
-- | Custom error types for comprehensive error handling
data DocsterError
= InvalidUsage Text
| FileError Text
| PDFGenerationError Text
| ProcessError Text
deriving (Show)
instance Exception DocsterError
-- | Output format for document generation
data OutputFormat = PDF | HTML
deriving (Show, Eq)
-- | Type-safe wrapper for source directory paths
newtype SourceDir = SourceDir FilePath
deriving (Show, Eq)
-- | Type-safe wrapper for output file paths
newtype OutputPath = OutputPath FilePath
deriving (Show, Eq)
-- | Type-safe wrapper for diagram identifiers
newtype DiagramId = DiagramId Text
deriving (Show, Eq)
-- | Configuration for diagram generation
data DiagramConfig = DiagramConfig
{ dcSourceDir :: SourceDir
, dcOutputFormat :: OutputFormat
} deriving (Show)