Compare commits
17
Commits
fe3e599909
..
main
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
54c7502f0f | ||
|
|
eb374d20f5 | ||
|
|
57f4f9f165 | ||
|
|
f016950ac7 | ||
|
|
f4dab3e354 | ||
|
|
6b49db5801 | ||
|
|
b0457388dc | ||
|
|
8abe1d1bc2 | ||
|
|
9dd9313829 | ||
|
|
fa850d5017 | ||
|
|
dda2fc15b2 | ||
|
|
705d53b958 | ||
|
|
3398dd2bae | ||
|
|
1a44dc8753 | ||
|
|
7de2bc811a | ||
|
|
7d2b407908 | ||
|
|
4ae2321cfd |
+12
@@ -1,6 +1,8 @@
|
||||
dist-newstyle
|
||||
dist-newstyle
|
||||
/.stack-work/
|
||||
/.stack-root/
|
||||
/.cabal-config/
|
||||
*.mmd
|
||||
*.png
|
||||
*.svg
|
||||
@@ -8,3 +10,13 @@ dist-newstyle
|
||||
*.pdf
|
||||
/svg-inkscape/
|
||||
dist-newstyle
|
||||
output/
|
||||
*.log
|
||||
cabal.project
|
||||
lts-24-34.yaml
|
||||
stack-setup-2.yaml
|
||||
analytics-charts.md
|
||||
architecture-deep-dive.md
|
||||
devcontainer.org
|
||||
.devcontainer/
|
||||
root.json
|
||||
|
||||
@@ -10,31 +10,36 @@ Docster is a Haskell CLI tool that converts Markdown files with embedded Mermaid
|
||||
|
||||
### Build
|
||||
```bash
|
||||
cabal build
|
||||
stack build
|
||||
```
|
||||
|
||||
### Run
|
||||
```bash
|
||||
# Convert to PDF
|
||||
cabal run docster -- -pdf path/to/file.md
|
||||
stack exec docster -- -pdf path/to/file.md
|
||||
|
||||
# Convert to HTML
|
||||
cabal run docster -- -html path/to/file.md
|
||||
stack exec docster -- -html path/to/file.md
|
||||
```
|
||||
|
||||
### Test
|
||||
```bash
|
||||
stack test
|
||||
```
|
||||
|
||||
### Test a single file
|
||||
```bash
|
||||
cabal run docster -- -pdf mermaid-to-svg/sample.md
|
||||
stack exec docster -- -pdf mermaid-to-svg/sample.md
|
||||
```
|
||||
|
||||
### Clean build artifacts
|
||||
```bash
|
||||
cabal clean
|
||||
stack clean
|
||||
```
|
||||
|
||||
### Interactive development
|
||||
```bash
|
||||
cabal repl
|
||||
stack repl
|
||||
```
|
||||
|
||||
## Architecture
|
||||
@@ -57,17 +62,11 @@ The tool uses Pandoc's AST transformation capabilities to:
|
||||
## Dependencies
|
||||
|
||||
External requirements:
|
||||
- GHC 9.12.2 and Cabal 3.16 (install via ghcup)
|
||||
- Pandoc library
|
||||
- Stack (install via ghcup) — manages GHC 9.10.3 automatically via lts-24.34
|
||||
- Pandoc library (Haskell dependency, pulled by Stack)
|
||||
- TeX Live (for PDF generation via XeLaTeX)
|
||||
- Mermaid CLI (`npm install -g @mermaid-js/mermaid-cli`)
|
||||
|
||||
To install GHC and Cabal:
|
||||
```bash
|
||||
source ~/.ghcup/env && ghcup install ghc 9.12.2
|
||||
source ~/.ghcup/env && ghcup install cabal 3.16.0.0
|
||||
source ~/.ghcup/env && ghcup set ghc 9.12.2
|
||||
```
|
||||
- pkg-config, libgmp-dev, libffi-dev, zlib1g-dev (see `install-deps.sh`)
|
||||
|
||||
## Common Issues
|
||||
|
||||
|
||||
@@ -6,32 +6,77 @@ A self-contained CLI tool that converts Markdown with Mermaid diagrams into PDF
|
||||
|
||||
docster -pdf path/to/file.md
|
||||
docster -html path/to/file.md
|
||||
docster -docx path/to/file.md
|
||||
|
||||
Mermaid code blocks (```mermaid) will be rendered to SVG and embedded.
|
||||
Mermaid code blocks (```mermaid) will be rendered to SVG (HTML) or PNG (PDF/DOCX) and embedded.
|
||||
|
||||
## Installation
|
||||
|
||||
### Build and install to PATH
|
||||
### Prerequisites
|
||||
|
||||
cabal install --installdir=$HOME/.local/bin
|
||||
Install the required system dependencies (Ubuntu/Debian):
|
||||
|
||||
Make sure `~/.local/bin` is in your PATH. Add to your shell config if needed:
|
||||
```bash
|
||||
./install-deps.sh
|
||||
```
|
||||
|
||||
export PATH="$HOME/.local/bin:$PATH"
|
||||
This installs build-essential, libgmp-dev, libffi-dev, zlib1g-dev, pkg-config, and TeX Live packages for PDF generation.
|
||||
|
||||
## Requirements
|
||||
### Install Haskell toolchain
|
||||
|
||||
- GHC + Cabal (via ghcup)
|
||||
- Pandoc
|
||||
- TeX Live (for PDF)
|
||||
- Mermaid CLI (`npm install -g @mermaid-js/mermaid-cli`)
|
||||
Install ghcup (Haskell toolchain installer):
|
||||
|
||||
### specific versions
|
||||
```bash
|
||||
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh
|
||||
source ~/.ghcup/env
|
||||
```
|
||||
|
||||
source ~/.ghcup/env && ghcup install ghc 9.12.2
|
||||
source ~/.ghcup/env && ghcup install cabal 3.16.0.0
|
||||
source ~/.ghcup/env && ghcup install hls 2.11.0.0
|
||||
#### Option A: Build with Stack (recommended)
|
||||
|
||||
Stack manages its own GHC installation automatically.
|
||||
|
||||
```bash
|
||||
ghcup install stack
|
||||
stack build
|
||||
stack install
|
||||
```
|
||||
|
||||
This uses the resolver defined in `stack.yaml` (currently lts-24.34 / GHC 9.10.3).
|
||||
|
||||
#### Option B: Build with Cabal
|
||||
|
||||
```bash
|
||||
ghcup install ghc 9.10.3
|
||||
ghcup install cabal 3.16.0.0
|
||||
ghcup set ghc 9.10.3
|
||||
ghcup set cabal 3.16.0.0
|
||||
cabal install --installdir=$HOME/.local/bin
|
||||
```
|
||||
|
||||
### Install Mermaid CLI
|
||||
|
||||
```bash
|
||||
npm install -g @mermaid-js/mermaid-cli
|
||||
```
|
||||
|
||||
### PATH setup
|
||||
|
||||
Make sure the install location is in your PATH. Add to your shell config if needed:
|
||||
|
||||
```bash
|
||||
# For Stack
|
||||
export PATH="$HOME/.local/bin:$PATH"
|
||||
|
||||
# For Cabal
|
||||
export PATH="$HOME/.local/bin:$PATH"
|
||||
```
|
||||
|
||||
## Development
|
||||
|
||||
```bash
|
||||
stack build # compile
|
||||
stack test # run tests
|
||||
stack repl # interactive REPL
|
||||
```
|
||||
|
||||
See [agents.md](agents.md) for information about the Claude Code agents used for Haskell refactoring in this project.
|
||||
|
||||
@@ -1,115 +1,48 @@
|
||||
# Claude Code Agents
|
||||
# Docster — Project Guide
|
||||
|
||||
This project uses specialized Claude Code agents for different types of Haskell refactoring. Each agent has focused expertise to provide targeted improvements.
|
||||
Docster is a Haskell CLI tool: Markdown + embedded Mermaid diagrams → PDF, HTML, or DOCX.
|
||||
|
||||
## Available Agents
|
||||
## Quick Commands
|
||||
|
||||
### haskell-refactoring-expert
|
||||
**Purpose**: Basic code quality and structural improvements
|
||||
|
||||
**Expertise**:
|
||||
- Type consistency (String vs Text vs ByteString)
|
||||
- Module organization and file splitting (>150 lines)
|
||||
- Naming conventions and clarity
|
||||
- Dependency management
|
||||
- Basic code structure improvements
|
||||
|
||||
**When to use**:
|
||||
- Inconsistent type usage across the codebase
|
||||
- Large files that need module organization
|
||||
- Poor naming or unclear function responsibilities
|
||||
- Mixed concerns in single modules
|
||||
|
||||
**Example**: Converting a 300-line Main.hs into proper module hierarchy
|
||||
|
||||
### haskell-higher-order
|
||||
**Purpose**: Advanced functional programming patterns and architectural refactoring
|
||||
|
||||
**Expertise**:
|
||||
- Monad transformer patterns (ExceptT, ReaderT, StateT)
|
||||
- Pipeline composition with monadic operators
|
||||
- Higher-order abstractions and strategy patterns
|
||||
- Effect management and pure/IO separation
|
||||
- Functional design patterns
|
||||
|
||||
**When to use**:
|
||||
- Nested case statements handling Either values in IO
|
||||
- Duplicated functions that differ only in specific steps
|
||||
- Manual threading of configuration or state
|
||||
- Imperative-style code that could be more functional
|
||||
- Complex error handling that needs cleanup
|
||||
|
||||
**Example**: Converting nested Either/IO handling to ExceptT pipelines
|
||||
|
||||
## Agent Boundaries and Trade-offs
|
||||
|
||||
### Complementary Design
|
||||
These agents are designed to work **sequentially**:
|
||||
1. **First pass**: `haskell-refactoring-expert` for structural cleanup
|
||||
2. **Second pass**: `haskell-higher-order` for functional patterns
|
||||
|
||||
### Why Separate Agents?
|
||||
|
||||
**Benefits**:
|
||||
- **Focused expertise**: Each agent has deep knowledge in its domain
|
||||
- **Clear boundaries**: Easy to know which agent to use
|
||||
- **Manageable complexity**: Avoids instruction bloat in single agent
|
||||
- **Progressive enhancement**: Apply increasingly sophisticated refactoring
|
||||
- **Composability**: Can run both agents or just one as needed
|
||||
|
||||
**Trade-offs**:
|
||||
- **Coordination overhead**: Need to run multiple agents
|
||||
- **Context switching**: Each agent analyzes code independently
|
||||
- **Potential overlap**: Some patterns might fit both agents
|
||||
|
||||
### Decision Framework
|
||||
|
||||
**Use haskell-refactoring-expert when you have**:
|
||||
- ❌ Mixed String/Text types
|
||||
- ❌ Large monolithic files (>150 lines)
|
||||
- ❌ Unclear naming or responsibilities
|
||||
- ❌ Basic structural issues
|
||||
|
||||
**Use haskell-higher-order when you have**:
|
||||
- ❌ Nested error handling (Either in IO)
|
||||
- ❌ Duplicated function structures
|
||||
- ❌ Manual state/config threading
|
||||
- ❌ Imperative-style patterns
|
||||
|
||||
**Use both agents when**:
|
||||
- ❌ You want comprehensive refactoring
|
||||
- ❌ Code has both structural and architectural issues
|
||||
- ❌ You're doing major codebase improvements
|
||||
|
||||
## Usage Patterns
|
||||
|
||||
### Sequential Refactoring
|
||||
```bash
|
||||
# Run basic refactoring first
|
||||
/agent haskell-refactoring-expert "Please refactor the Main.hs file"
|
||||
|
||||
# Then apply advanced patterns
|
||||
/agent haskell-higher-order "Please improve the error handling patterns"
|
||||
stack build # build
|
||||
stack test # run tests
|
||||
stack exec docster -- -pdf file.md # convert to PDF
|
||||
stack exec docster -- -html file.md # convert to HTML
|
||||
stack exec docster -- -docx file.md # convert to DOCX
|
||||
stack exec docster -- -pdf sample.md # test with a single file
|
||||
stack clean # clean build artifacts
|
||||
```
|
||||
|
||||
### Targeted Improvements
|
||||
```bash
|
||||
# Just structural cleanup
|
||||
/agent haskell-refactoring-expert "Split this large module"
|
||||
## Structure
|
||||
|
||||
# Just functional patterns
|
||||
/agent haskell-higher-order "Convert these nested cases to monadic style"
|
||||
```
|
||||
docster.cabal # package definition
|
||||
stack.yaml # GHC 9.12.2, lts-24.34
|
||||
app/Main.hs # everything — entry point + all logic (~70 lines)
|
||||
test/ # HSpec tests (TransformSpec.hs)
|
||||
```
|
||||
|
||||
## Evolution Strategy
|
||||
## How It Works
|
||||
|
||||
These agents can evolve independently:
|
||||
- **haskell-refactoring-expert**: Add more structural patterns, linting rules
|
||||
- **haskell-higher-order**: Add more advanced patterns (free monads, effect systems)
|
||||
1. Parse Markdown via Pandoc AST
|
||||
2. Walk the AST, find Mermaid code blocks
|
||||
3. Run `mmdc` (mermaid-cli) to render each block → SVG (for HTML) or high-res PNG (for PDF)
|
||||
4. Replace code blocks with image references in the AST
|
||||
5. Compile final output via Pandoc (LaTeX/XeLaTeX for PDF, native for HTML/DOCX)
|
||||
|
||||
New specialized agents could be added:
|
||||
- **haskell-performance**: Optimization-focused refactoring
|
||||
- **haskell-testing**: Test-driven refactoring and property-based testing
|
||||
- **haskell-domain**: Domain modeling and type design
|
||||
Key functions in `Main.hs`:
|
||||
- `transformDoc` — AST walker
|
||||
- `processMermaidBlock` — calls `mmdc`, returns image reference
|
||||
- `compileToPDF` / `compileToHTML` / `compileToDOCX` — final Pandoc compilation
|
||||
|
||||
The key is maintaining clear boundaries and complementary functionality.
|
||||
## Dependencies
|
||||
|
||||
**System**: TeX Live (for PDF), `npm install -g @mermaid-js/mermaid-cli`
|
||||
**Haskell**: Pandoc library, Stack manages GHC automatically
|
||||
|
||||
## Common Gotchas
|
||||
|
||||
- **Text vs String**: Codebase mixes `Data.Text` and `String`. Use `T.pack`/`T.unpack` for conversions.
|
||||
- **PDF needs LaTeX**: BasicTeX/TinyTeX + `tlmgr` for missing packages.
|
||||
- **mmdc in PATH**: `mermaid-cli` must be globally installed and on PATH.
|
||||
|
||||
+3
-2
@@ -4,7 +4,7 @@
|
||||
module Main (main) where
|
||||
|
||||
import Docster.Types (DocsterError(..))
|
||||
import Docster.Compiler (compileToPDF, compileToHTML)
|
||||
import Docster.Compiler (compileToPDF, compileToHTML, compileToDOCX)
|
||||
import System.Environment (getArgs)
|
||||
import Control.Exception (throwIO)
|
||||
|
||||
@@ -12,7 +12,8 @@ import Control.Exception (throwIO)
|
||||
parseArgs :: [String] -> Either DocsterError (IO ())
|
||||
parseArgs ["-pdf", path] = Right (compileToPDF path)
|
||||
parseArgs ["-html", path] = Right (compileToHTML path)
|
||||
parseArgs _ = Left $ InvalidUsage "Usage: docster -pdf|-html <file.md>"
|
||||
parseArgs ["-docx", path] = Right (compileToDOCX path)
|
||||
parseArgs _ = Left $ InvalidUsage "Usage: docster -pdf|-html|-docx <file.md>"
|
||||
|
||||
-- | Main entry point - parse arguments and execute appropriate action
|
||||
main :: IO ()
|
||||
|
||||
+27
-6
@@ -1,9 +1,9 @@
|
||||
cabal-version: 3.0
|
||||
name: docster
|
||||
version: 0.1.0.0
|
||||
synopsis: A self-contained CLI tool that converts Markdown with Mermaid diagrams to PDF/HTML
|
||||
description: Docster converts Markdown documents containing Mermaid diagrams into PDF or HTML files
|
||||
using Pandoc and Mermaid CLI. It automatically renders Mermaid code blocks to SVG
|
||||
synopsis: A self-contained CLI tool that converts Markdown with Mermaid diagrams to PDF, HTML, or DOCX
|
||||
description: Docster converts Markdown documents containing Mermaid diagrams into PDF, HTML, or DOCX files
|
||||
using Pandoc and Mermaid CLI. It automatically renders Mermaid code blocks to SVG (HTML) or PNG (PDF/DOCX)
|
||||
and embeds them in the output.
|
||||
homepage: https://github.com/yourusername/docster
|
||||
license: BSD-3-Clause
|
||||
@@ -34,13 +34,14 @@ library
|
||||
Docster.Compiler
|
||||
hs-source-dirs: src
|
||||
build-depends:
|
||||
base >=4.21 && <5,
|
||||
base >=4.18 && <5,
|
||||
text >=2.0 && <2.2,
|
||||
filepath >=1.4 && <1.6,
|
||||
directory >=1.3 && <1.4,
|
||||
process >=1.6 && <1.7,
|
||||
hashable >=1.4 && <1.6,
|
||||
pandoc >=3.0 && <3.2,
|
||||
containers >=0.6 && <0.8,
|
||||
pandoc >=3.0 && <3.8,
|
||||
pandoc-types >=1.23 && <1.25,
|
||||
bytestring >=0.11 && <0.13,
|
||||
temporary >=1.3 && <1.4,
|
||||
@@ -52,10 +53,30 @@ executable docster
|
||||
main-is: Main.hs
|
||||
hs-source-dirs: app
|
||||
build-depends:
|
||||
base >=4.21 && <5,
|
||||
base >=4.18 && <5,
|
||||
text >=2.0 && <2.2,
|
||||
docster
|
||||
default-language: Haskell2010
|
||||
ghc-options: -threaded
|
||||
-rtsopts
|
||||
-with-rtsopts=-N
|
||||
|
||||
test-suite docster-test
|
||||
import: warnings
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Spec.hs
|
||||
hs-source-dirs: test
|
||||
other-modules: Docster.TransformSpec
|
||||
build-depends:
|
||||
base >=4.18 && <5,
|
||||
text >=2.0 && <2.2,
|
||||
filepath >=1.4 && <1.6,
|
||||
containers >=0.6 && <0.8,
|
||||
hspec >=2.10 && <2.12,
|
||||
pandoc-types >=1.23 && <1.25,
|
||||
docster
|
||||
default-language: Haskell2010
|
||||
ghc-options: -threaded
|
||||
-rtsopts
|
||||
-with-rtsopts=-N
|
||||
build-tool-depends: hspec-discover:hspec-discover
|
||||
|
||||
@@ -0,0 +1,2 @@
|
||||
sudo apt update
|
||||
sudo apt install -y build-essential pkg-config libgmp-dev libffi-dev zlib1g-dev texlive-latex-base texlive-fonts-recommended texlive-latex-extra texlive-xetex
|
||||
@@ -0,0 +1,2 @@
|
||||
cabal install --installdir=$HOME/.local/bin --overwrite-policy=always
|
||||
|
||||
+176
-64
@@ -1,21 +1,27 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
-- | Document compilation functionality for PDF and HTML output
|
||||
-- | Document compilation functionality for PDF, HTML, and DOCX output
|
||||
module Docster.Compiler
|
||||
( -- * Compilation Functions
|
||||
compileToPDF
|
||||
, compileToHTML
|
||||
, compileToDOCX
|
||||
) where
|
||||
|
||||
import Docster.Types
|
||||
( DocsterError(..), OutputFormat(..), SourceDir(..), OutputDir(..), OutputPath(..)
|
||||
, DiagramConfig(..), computeOutputDir, ensureOutputDir
|
||||
)
|
||||
import Text.Pandoc.Writers ()
|
||||
import qualified Data.ByteString.Lazy as BSL
|
||||
import Docster.Transform (transformDocument)
|
||||
import Docster.LaTeX (latexTemplate)
|
||||
import Text.Pandoc
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as TIO
|
||||
import System.FilePath (takeDirectory, replaceExtension, (</>))
|
||||
import System.FilePath (takeDirectory, takeBaseName, replaceExtension, (</>), (<.>))
|
||||
import System.Process (callProcess, readProcessWithExitCode)
|
||||
import System.IO.Temp (withSystemTempDirectory)
|
||||
import System.Directory (copyFile, doesFileExist)
|
||||
@@ -26,6 +32,8 @@ import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
|
||||
import Control.Monad.Trans.Reader (ReaderT, runReaderT, asks)
|
||||
import Control.Monad.Trans.Class (lift)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Data.Maybe (mapMaybe)
|
||||
import Data.Char (ord)
|
||||
|
||||
-- | Success indicator for user feedback
|
||||
successEmoji :: Text
|
||||
@@ -34,9 +42,9 @@ successEmoji = "✅"
|
||||
-- | Compilation context for pipeline operations
|
||||
data CompilationContext = CompilationContext
|
||||
{ ccStrategy :: CompilationStrategy
|
||||
, ccSourceDir :: SourceDir
|
||||
, ccInputPath :: FilePath
|
||||
, ccOutputPath :: FilePath
|
||||
, ccDocName :: Text
|
||||
, ccReaderOptions :: ReaderOptions
|
||||
, ccConfig :: DiagramConfig
|
||||
}
|
||||
@@ -48,10 +56,10 @@ type CompilationM = ReaderT CompilationContext (ExceptT DocsterError IO)
|
||||
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 :: String -> Text -> IO (Either DocsterError ())
|
||||
-- | Pandoc writer: writes output directly to the given file path
|
||||
, csWriter :: WriterOptions -> Pandoc -> FilePath -> IO (Either DocsterError ())
|
||||
-- | Post-processing after write (PDF→xelatex, HTML→open browser, DOCX→noop)
|
||||
, csPostProcess :: String -> IO (Either DocsterError ())
|
||||
-- | Success message formatter
|
||||
, csSuccessMessage :: String -> Text
|
||||
}
|
||||
@@ -60,8 +68,14 @@ data CompilationStrategy = CompilationStrategy
|
||||
pdfStrategy :: CompilationStrategy
|
||||
pdfStrategy = CompilationStrategy
|
||||
{ csOutputFormat = PDF
|
||||
, csWriter = writeLaTeX
|
||||
, csProcessOutput = processPDFOutput
|
||||
, csWriter = \opts doc path -> do
|
||||
result <- runIO (writeLaTeX opts doc)
|
||||
case result of
|
||||
Left err -> return $ Left $ FileError $ "LaTeX write failed: " <> T.pack (show err)
|
||||
Right latex -> do
|
||||
TIO.writeFile path (latexTemplate latex)
|
||||
return $ Right ()
|
||||
, csPostProcess = processPDFOutput
|
||||
, csSuccessMessage = \path -> successEmoji <> " PDF written to " <> T.pack path
|
||||
}
|
||||
|
||||
@@ -69,15 +83,99 @@ pdfStrategy = CompilationStrategy
|
||||
htmlStrategy :: CompilationStrategy
|
||||
htmlStrategy = CompilationStrategy
|
||||
{ csOutputFormat = HTML
|
||||
, csWriter = writeHtml5String
|
||||
, csProcessOutput = processHTMLOutput
|
||||
, csWriter = \opts doc path -> do
|
||||
result <- runIO (writeHtml5String opts doc)
|
||||
case result of
|
||||
Left err -> return $ Left $ FileError $ "HTML write failed: " <> T.pack (show err)
|
||||
Right html -> do
|
||||
TIO.writeFile path html
|
||||
return $ Right ()
|
||||
, csPostProcess = processHTMLOutput
|
||||
, csSuccessMessage = \path -> successEmoji <> " HTML written to " <> T.pack path
|
||||
}
|
||||
|
||||
-- | Process PDF output: LaTeX template application and direct XeLaTeX compilation
|
||||
processPDFOutput :: String -> Text -> IO (Either DocsterError ())
|
||||
processPDFOutput outputPath latexOutput = do
|
||||
let completeLatex = latexTemplate latexOutput
|
||||
-- | DOCX compilation strategy (Pandoc writes file directly)
|
||||
docxStrategy :: CompilationStrategy
|
||||
docxStrategy = CompilationStrategy
|
||||
{ csOutputFormat = DOCX
|
||||
, csWriter = \opts doc path -> do
|
||||
result <- runIO (writeDocx opts doc)
|
||||
case result of
|
||||
Left err -> return $ Left $ FileError $ "DOCX generation failed: " <> T.pack (show err)
|
||||
Right docxBS -> do
|
||||
BSL.writeFile path docxBS
|
||||
return $ Right ()
|
||||
, csPostProcess = \_ -> return $ Right () -- no post-processing needed
|
||||
, csSuccessMessage = \path -> successEmoji <> " DOCX written to " <> T.pack path
|
||||
}
|
||||
|
||||
-- | Parse LaTeX log content to extract meaningful error messages
|
||||
parseLatexErrors :: Text -> Text
|
||||
parseLatexErrors logContent =
|
||||
let logLines = T.lines logContent
|
||||
missingChars = extractMissingChars logLines
|
||||
overfullBoxes = extractOverfullBoxes logLines
|
||||
undefinedCommands = extractUndefinedCommands logLines
|
||||
fatalErrors = extractFatalErrors logLines
|
||||
|
||||
errorCount = length missingChars + length overfullBoxes + length undefinedCommands + length fatalErrors
|
||||
|
||||
summary = if errorCount == 0
|
||||
then "Unknown LaTeX error occurred."
|
||||
else T.unlines $ filter (not . T.null) [
|
||||
if not (null fatalErrors) then "Fatal errors:\n" <> T.unlines (map (" • " <>) fatalErrors) else "",
|
||||
if not (null undefinedCommands) then "Undefined commands:\n" <> T.unlines (map (" • " <>) undefinedCommands) else "",
|
||||
if not (null missingChars) then "Missing Unicode characters:\n" <> T.unlines (map (" • " <>) missingChars) else "",
|
||||
if not (null overfullBoxes) then T.pack (show (length overfullBoxes)) <> " overfull boxes (layout warnings)" else ""
|
||||
]
|
||||
in summary
|
||||
|
||||
-- | Extract missing character warnings from LaTeX log
|
||||
extractMissingChars :: [Text] -> [Text]
|
||||
extractMissingChars = mapMaybe extractChar
|
||||
where
|
||||
extractChar line
|
||||
| "Missing character:" `T.isInfixOf` line =
|
||||
case T.splitOn "(U+" line of
|
||||
[_, rest] -> case T.splitOn ")" rest of
|
||||
(unicode:_) -> Just $ "U+" <> unicode <> " " <> extractCharContext line
|
||||
_ -> Nothing
|
||||
_ -> Nothing
|
||||
| otherwise = Nothing
|
||||
|
||||
extractCharContext line =
|
||||
case T.splitOn " in font " line of
|
||||
[_, rest] -> "in " <> T.takeWhile (/= ':') rest
|
||||
_ -> ""
|
||||
|
||||
-- | Extract overfull box warnings
|
||||
extractOverfullBoxes :: [Text] -> [Text]
|
||||
extractOverfullBoxes = mapMaybe extractBox
|
||||
where
|
||||
extractBox line
|
||||
| "Overfull \\hbox" `T.isInfixOf` line = Just $ T.takeWhile (/= '\n') line
|
||||
| otherwise = Nothing
|
||||
|
||||
-- | Extract undefined command errors
|
||||
extractUndefinedCommands :: [Text] -> [Text]
|
||||
extractUndefinedCommands = mapMaybe extractUndef
|
||||
where
|
||||
extractUndef line
|
||||
| "Undefined control sequence" `T.isInfixOf` line = Just line
|
||||
| otherwise = Nothing
|
||||
|
||||
-- | Extract fatal LaTeX errors
|
||||
extractFatalErrors :: [Text] -> [Text]
|
||||
extractFatalErrors = mapMaybe extractFatal
|
||||
where
|
||||
extractFatal line
|
||||
| "! " `T.isPrefixOf` line && not ("Missing character:" `T.isInfixOf` line) = Just $ T.drop 2 line
|
||||
| otherwise = Nothing
|
||||
|
||||
-- | Process PDF output: direct XeLaTeX compilation (LaTeX already written by csWriter)
|
||||
processPDFOutput :: String -> IO (Either DocsterError ())
|
||||
processPDFOutput outputPath = do
|
||||
let logOutputPath = replaceExtension outputPath "log"
|
||||
|
||||
-- Use temporary directory for LaTeX compilation
|
||||
withSystemTempDirectory "docster-latex" $ \tempDir -> do
|
||||
@@ -85,9 +183,6 @@ processPDFOutput outputPath latexOutput = do
|
||||
pdfFile = tempDir </> "document.pdf"
|
||||
logFile = tempDir </> "document.log"
|
||||
|
||||
-- Write LaTeX content to temporary file
|
||||
TIO.writeFile texFile completeLatex
|
||||
|
||||
-- Run XeLaTeX compilation
|
||||
(exitCode, _stdout, stderr) <- readProcessWithExitCode "xelatex"
|
||||
[ "-output-directory=" <> tempDir
|
||||
@@ -95,6 +190,13 @@ processPDFOutput outputPath latexOutput = do
|
||||
, texFile
|
||||
] ""
|
||||
|
||||
-- Always copy log file to output location for debugging
|
||||
logExists <- doesFileExist logFile
|
||||
logContent <- if logExists
|
||||
then TIO.readFile logFile
|
||||
else return (T.pack stderr)
|
||||
TIO.writeFile logOutputPath logContent
|
||||
|
||||
case exitCode of
|
||||
ExitSuccess -> do
|
||||
-- Check if PDF was actually generated
|
||||
@@ -105,28 +207,20 @@ processPDFOutput outputPath latexOutput = do
|
||||
copyFile pdfFile outputPath
|
||||
return $ Right ()
|
||||
else do
|
||||
-- PDF generation failed, read log for details
|
||||
logExists <- doesFileExist logFile
|
||||
logContent <- if logExists
|
||||
then TIO.readFile logFile
|
||||
else return "No log file generated"
|
||||
return $ Left $ PDFGenerationError $
|
||||
"PDF file not generated. LaTeX log:\n" <> logContent
|
||||
"PDF file not generated despite successful exit code.\n" <>
|
||||
"Full LaTeX log written to: " <> T.pack logOutputPath
|
||||
ExitFailure code -> do
|
||||
-- LaTeX compilation failed, read log for details
|
||||
logExists <- doesFileExist logFile
|
||||
logContent <- if logExists
|
||||
then TIO.readFile logFile
|
||||
else return (T.pack stderr)
|
||||
-- LaTeX compilation failed - parse log for meaningful errors
|
||||
let errorSummary = parseLatexErrors logContent
|
||||
return $ Left $ PDFGenerationError $
|
||||
"XeLaTeX compilation failed (exit code " <> T.pack (show code) <> "):\n" <>
|
||||
T.pack stderr <> "\n\nLaTeX log:\n" <> logContent
|
||||
|
||||
-- | Process HTML output: file writing and browser opening
|
||||
processHTMLOutput :: String -> Text -> IO (Either DocsterError ())
|
||||
processHTMLOutput outputPath html = do
|
||||
TIO.writeFile outputPath html
|
||||
"❌ LaTeX compilation failed (exit code " <> T.pack (show code) <> "):\n" <>
|
||||
errorSummary <> "\n\n" <>
|
||||
"Full LaTeX log written to: " <> T.pack logOutputPath
|
||||
|
||||
-- | Process HTML output: open browser (HTML already written by csWriter)
|
||||
processHTMLOutput :: String -> IO (Either DocsterError ())
|
||||
processHTMLOutput outputPath = do
|
||||
-- Open the generated HTML file in browser for verification
|
||||
putStrLn $ "🌐 Opening " <> outputPath <> " in browser for error checking..."
|
||||
void $ callProcess "open" [outputPath]
|
||||
@@ -141,11 +235,30 @@ liftEitherM action = do
|
||||
Left err -> lift $ throwE err
|
||||
Right value -> return value
|
||||
|
||||
-- | Strip ANSI escape sequences (CSI codes like color/style) from text.
|
||||
-- These appear in copy-pasted terminal output and break LaTeX compilation.
|
||||
stripAnsiCodes :: Text -> Text
|
||||
stripAnsiCodes input = case T.break (== '\x1b') input of
|
||||
(before, rest)
|
||||
| T.null rest -> before
|
||||
| otherwise -> before <> stripAnsiCodes (skipEscape (T.tail rest))
|
||||
where
|
||||
-- Skip an ESC sequence: ESC [ <params> <final byte>
|
||||
skipEscape t
|
||||
| T.null t = t
|
||||
| T.head t == '[' = skipCSIParams (T.tail t)
|
||||
| otherwise = T.tail t -- non-CSI escape: skip one char after ESC
|
||||
-- Skip CSI parameter/intermediate bytes until final byte (0x40-0x7E)
|
||||
skipCSIParams t
|
||||
| T.null t = t
|
||||
| let c = ord (T.head t), c >= 0x40 && c <= 0x7E = T.tail t -- final byte, consume it
|
||||
| otherwise = skipCSIParams (T.tail t)
|
||||
|
||||
-- | Pipeline step: Read content from input file
|
||||
readContent :: CompilationM Text
|
||||
readContent = do
|
||||
inputPath <- asks ccInputPath
|
||||
liftIO $ TIO.readFile inputPath
|
||||
liftIO $ stripAnsiCodes <$> TIO.readFile inputPath
|
||||
|
||||
-- | Pipeline step: Parse markdown content into Pandoc AST
|
||||
parseDocument :: Text -> CompilationM Pandoc
|
||||
@@ -157,20 +270,16 @@ parseDocument content = do
|
||||
transformDocumentM :: Pandoc -> CompilationM Pandoc
|
||||
transformDocumentM pandoc = do
|
||||
config <- asks ccConfig
|
||||
liftEitherM $ transformDocument config pandoc
|
||||
docName <- asks ccDocName
|
||||
liftEitherM $ transformDocument config docName pandoc
|
||||
|
||||
-- | Pipeline step: Generate output using format-specific writer
|
||||
generateOutputM :: Pandoc -> CompilationM Text
|
||||
generateOutputM pandoc = do
|
||||
strategy <- asks ccStrategy
|
||||
liftEitherM $ generateOutput strategy pandoc
|
||||
|
||||
-- | Pipeline step: Process output and write to file
|
||||
processOutput :: Text -> CompilationM ()
|
||||
processOutput output = do
|
||||
-- | Pipeline step: Write output and post-process (format-specific)
|
||||
writeAndProcessOutput :: Pandoc -> CompilationM ()
|
||||
writeAndProcessOutput pandoc = do
|
||||
strategy <- asks ccStrategy
|
||||
outputPath <- asks ccOutputPath
|
||||
liftEitherM $ csProcessOutput strategy outputPath output
|
||||
liftEitherM $ csWriter strategy def pandoc outputPath
|
||||
liftEitherM $ (csPostProcess strategy) outputPath
|
||||
|
||||
-- | Pipeline step: Print success message
|
||||
printSuccess :: CompilationM ()
|
||||
@@ -180,12 +289,12 @@ printSuccess = do
|
||||
liftIO $ putStrLn $ T.unpack $ csSuccessMessage strategy outputPath
|
||||
|
||||
-- | 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
|
||||
compileWithStrategy :: CompilationStrategy -> SourceDir -> OutputDir -> Text -> OutputPath -> OutputPath -> IO (Either DocsterError ())
|
||||
compileWithStrategy strategy sourceDir outputDir docName (OutputPath inputPath) (OutputPath outputPath) = do
|
||||
let readerOptions = def { readerExtensions = getDefaultExtensions "markdown" }
|
||||
config = DiagramConfig sourceDir (csOutputFormat strategy)
|
||||
context = CompilationContext strategy sourceDir inputPath outputPath readerOptions config
|
||||
pipeline = readContent >>= parseDocument >>= transformDocumentM >>= generateOutputM >>= processOutput >> printSuccess
|
||||
config = DiagramConfig sourceDir outputDir (csOutputFormat strategy)
|
||||
context = CompilationContext strategy inputPath outputPath docName readerOptions config
|
||||
pipeline = readContent >>= parseDocument >>= transformDocumentM >>= writeAndProcessOutput >> printSuccess
|
||||
|
||||
runExceptT $ runReaderT pipeline context
|
||||
|
||||
@@ -197,15 +306,7 @@ parseMarkdown readerOptions content = do
|
||||
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 ()
|
||||
@@ -215,13 +316,24 @@ compileToPDF = compileWithFormat pdfStrategy "pdf"
|
||||
compileToHTML :: FilePath -> IO ()
|
||||
compileToHTML = compileWithFormat htmlStrategy "html"
|
||||
|
||||
-- | Compile markdown to DOCX
|
||||
compileToDOCX :: FilePath -> IO ()
|
||||
compileToDOCX = compileWithFormat docxStrategy "docx"
|
||||
|
||||
-- | 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
|
||||
outputDir = computeOutputDir path
|
||||
OutputDir outDirPath = outputDir
|
||||
baseName = takeBaseName path
|
||||
docName = T.pack baseName
|
||||
outputPath = OutputPath $ outDirPath </> baseName <.> extension
|
||||
|
||||
result <- compileWithStrategy strategy sourceDir (OutputPath path) outputPath
|
||||
-- Ensure output directory exists before compilation
|
||||
ensureOutputDir outputDir
|
||||
|
||||
result <- compileWithStrategy strategy sourceDir outputDir docName (OutputPath path) outputPath
|
||||
case result of
|
||||
Left err -> throwIO err
|
||||
Right _ -> return ()
|
||||
|
||||
+45
-6
@@ -9,33 +9,72 @@ module Docster.LaTeX
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
|
||||
-- | LaTeX template with comprehensive package support for PDF generation
|
||||
-- | LaTeX template with modern corporate styling for PDF generation
|
||||
latexTemplate :: Text -> Text
|
||||
latexTemplate bodyContent = T.unlines
|
||||
[ "\\documentclass{article}"
|
||||
, "\\usepackage[utf8]{inputenc}"
|
||||
-- Packages
|
||||
, "\\usepackage{fontspec}"
|
||||
, "\\usepackage{graphicx}"
|
||||
, "\\usepackage{adjustbox}"
|
||||
, "\\usepackage{geometry}"
|
||||
, "\\geometry{margin=1in}"
|
||||
, "\\usepackage{hyperref}"
|
||||
, "\\usepackage{longtable}"
|
||||
, "\\usepackage{booktabs}"
|
||||
, "\\usepackage{array}"
|
||||
, "\\usepackage{calc}"
|
||||
, "\\usepackage{enumitem}"
|
||||
, "\\usepackage{amsmath}"
|
||||
, "\\usepackage{amssymb}"
|
||||
, "\\usepackage{fancyvrb}"
|
||||
, "\\usepackage{color}"
|
||||
, "\\usepackage[dvipsnames,svgnames,x11names]{xcolor}"
|
||||
, "\\usepackage{titlesec}"
|
||||
, "\\usepackage{fancyhdr}"
|
||||
, "\\usepackage{framed}"
|
||||
-- Typography: Helvetica Neue + Menlo, sans-serif default
|
||||
, "\\setmainfont{Helvetica Neue}"
|
||||
, "\\setsansfont{Helvetica Neue}"
|
||||
, "\\setmonofont{Menlo}[Scale=0.85]"
|
||||
, "\\renewcommand{\\familydefault}{\\sfdefault}"
|
||||
-- Layout: wider margins, block paragraphs
|
||||
, "\\geometry{left=0.9in,right=0.9in,top=1in,bottom=1in}"
|
||||
, "\\setlength{\\parindent}{0pt}"
|
||||
, "\\setlength{\\parskip}{0.5em}"
|
||||
-- Color scheme
|
||||
, "\\definecolor{accent}{HTML}{1A365D}"
|
||||
, "\\definecolor{codebg}{HTML}{F5F5F5}"
|
||||
-- Hyperlinks: accent-colored, no boxes
|
||||
, "\\usepackage[colorlinks=true,linkcolor=accent,urlcolor=accent,citecolor=accent]{hyperref}"
|
||||
-- Heading styles
|
||||
, "\\titleformat{\\section}{\\Large\\bfseries\\color{accent}}{\\thesection}{1em}{}[\\vspace{2pt}\\titlerule]"
|
||||
, "\\titleformat{\\subsection}{\\large\\bfseries\\color{accent}}{\\thesubsection}{1em}{}"
|
||||
, "\\titleformat{\\subsubsection}{\\normalsize\\bfseries\\color{accent}}{\\thesubsubsection}{1em}{}"
|
||||
, "\\titlespacing*{\\section}{0pt}{1.5em}{0.8em}"
|
||||
, "\\titlespacing*{\\subsection}{0pt}{1.2em}{0.5em}"
|
||||
, "\\titlespacing*{\\subsubsection}{0pt}{1em}{0.4em}"
|
||||
-- Page header/footer: minimal centered page number
|
||||
, "\\pagestyle{fancy}"
|
||||
, "\\fancyhf{}"
|
||||
, "\\renewcommand{\\headrulewidth}{0pt}"
|
||||
, "\\fancyfoot[C]{\\small\\thepage}"
|
||||
-- Code blocks: light gray background
|
||||
, "\\DefineVerbatimEnvironment{Highlighting}{Verbatim}{commandchars=\\\\\\{\\}}"
|
||||
, "\\newenvironment{Shaded}{}{}"
|
||||
, "\\newenvironment{Shaded}{\\begin{snugshade}}{\\end{snugshade}}"
|
||||
, "\\definecolor{shadecolor}{HTML}{F5F5F5}"
|
||||
, syntaxHighlightingCommands
|
||||
-- Pandoc helpers
|
||||
, "\\providecommand{\\tightlist}{%"
|
||||
, " \\setlength{\\itemsep}{0pt}\\setlength{\\parskip}{0pt}}"
|
||||
, "\\newcommand{\\real}[1]{#1}"
|
||||
, "% Unicode symbol substitutions"
|
||||
, "\\providecommand{\\checkmark}{\\ensuremath{\\checkmark}}"
|
||||
, "\\providecommand{\\times}{\\ensuremath{\\times}}"
|
||||
, "% 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}"
|
||||
, "\\providecommand{\\pandocbounded}[1]{#1}"
|
||||
, "\\begin{document}"
|
||||
, bodyContent
|
||||
, "\\end{document}"
|
||||
|
||||
+30
-10
@@ -7,17 +7,20 @@ module Docster.Mermaid
|
||||
processMermaidBlock
|
||||
, renderMermaidDiagram
|
||||
, generateDiagramId
|
||||
, createImageBlock
|
||||
) where
|
||||
|
||||
import Docster.Types
|
||||
import Docster.Types (DiagramConfig(..), DiagramId(..), OutputDir(..), OutputFormat(..), DocsterError(..))
|
||||
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.Directory (removeFile, getTemporaryDirectory)
|
||||
import System.Process (callProcess)
|
||||
import System.IO (hClose)
|
||||
import System.IO.Temp (openTempFile)
|
||||
import Control.Exception (bracket, catch, SomeException)
|
||||
|
||||
-- | Application constants
|
||||
@@ -49,9 +52,9 @@ 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
|
||||
renderMermaidDiagram config@(DiagramConfig _ (OutputDir outDir) format) diagId contents = do
|
||||
let diagIdStr = T.unpack $ (\(DiagramId d) -> d) diagId
|
||||
mmdFile = sourceDir </> diagIdStr <> ".mmd"
|
||||
mmdFile = outDir </> diagIdStr <> ".mmd"
|
||||
(outputFile, imagePath) = generateDiagramPaths config diagId
|
||||
|
||||
-- Use bracket to ensure cleanup of temporary mermaid file
|
||||
@@ -69,24 +72,41 @@ renderMermaidDiagram config@(DiagramConfig (SourceDir sourceDir) format) diagId
|
||||
|
||||
-- | Generate file paths for diagram based on format
|
||||
generateDiagramPaths :: DiagramConfig -> DiagramId -> (FilePath, Text)
|
||||
generateDiagramPaths (DiagramConfig (SourceDir sourceDir) format) (DiagramId diagId) =
|
||||
generateDiagramPaths (DiagramConfig _ (OutputDir outDir) format) (DiagramId diagId) =
|
||||
let diagIdStr = T.unpack diagId
|
||||
in case format of
|
||||
HTML -> let svgFile = sourceDir </> diagIdStr <> ".svg"
|
||||
HTML -> let svgFile = outDir </> diagIdStr <> ".svg"
|
||||
in (svgFile, T.pack $ takeFileName svgFile)
|
||||
PDF -> let pngFile = sourceDir </> diagIdStr <> ".png"
|
||||
PDF -> let pngFile = outDir </> diagIdStr <> ".png"
|
||||
in (pngFile, T.pack pngFile)
|
||||
DOCX -> let pngFile = outDir </> diagIdStr <> ".png"
|
||||
in (pngFile, T.pack pngFile)
|
||||
|
||||
-- | Puppeteer configuration content for disabling sandbox
|
||||
puppeteerConfigContent :: Text
|
||||
puppeteerConfigContent = "{\n \"args\": [\"--no-sandbox\", \"--disable-setuid-sandbox\"]\n}"
|
||||
|
||||
-- | Call mermaid CLI process with appropriate arguments
|
||||
callMermaidProcess :: OutputFormat -> FilePath -> FilePath -> IO (Either DocsterError ())
|
||||
callMermaidProcess format mmdFile outputFile = do
|
||||
let args = case format of
|
||||
let baseArgs = case format of
|
||||
HTML -> ["-i", mmdFile, "-o", outputFile]
|
||||
PDF -> ["-i", mmdFile, "-o", outputFile, "--scale", "3"]
|
||||
DOCX -> ["-i", mmdFile, "-o", outputFile]
|
||||
|
||||
result <- catch
|
||||
-- Create temporary puppeteer config file
|
||||
result <- bracket
|
||||
(do tempDir <- getTemporaryDirectory
|
||||
(configPath, configHandle) <- openTempFile tempDir "puppeteer-config.json"
|
||||
hClose configHandle
|
||||
TIO.writeFile configPath puppeteerConfigContent
|
||||
return configPath)
|
||||
(\configPath -> removeFile configPath `catch` \(_ :: SomeException) -> return ())
|
||||
(\configPath -> do
|
||||
let args = baseArgs ++ ["--puppeteerConfigFile", configPath]
|
||||
catch
|
||||
(callProcess (T.unpack mermaidCommand) args >> return (Right ()))
|
||||
(\(e :: SomeException) -> return $ Left $ ProcessError $ "Mermaid process failed: " <> T.pack (show e))
|
||||
(\(e :: SomeException) -> return $ Left $ ProcessError $ "Mermaid process failed: " <> T.pack (show e)))
|
||||
return result
|
||||
|
||||
-- | Create Pandoc image block from image path
|
||||
|
||||
+87
-11
@@ -4,20 +4,96 @@
|
||||
module Docster.Transform
|
||||
( -- * Document Transformation
|
||||
transformDocument
|
||||
-- * Utilities (exported for testing)
|
||||
, inlinesToText
|
||||
) where
|
||||
|
||||
import Docster.Types
|
||||
import Docster.Mermaid (processMermaidBlock)
|
||||
import Text.Pandoc.Definition (Pandoc(..), Block)
|
||||
( DocsterError(..), OutputFormat(..), DiagramConfig(..), DiagramId(..)
|
||||
, TraversalState(..), initialTraversalState, normalizeHeading
|
||||
)
|
||||
import Docster.Mermaid (renderMermaidDiagram, createImageBlock)
|
||||
import Text.Pandoc.Definition (Pandoc(..), Block(..), Inline(..))
|
||||
import Text.Pandoc.Walk (walk)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Control.Monad.Trans.State.Strict (StateT, runStateT, get, modify)
|
||||
import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
|
||||
import Control.Monad.Trans.Class (lift)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
|
||||
-- | Walk the Pandoc AST and process blocks with error handling
|
||||
transformDocument :: DiagramConfig -> Pandoc -> IO (Either DocsterError Pandoc)
|
||||
transformDocument config doc = walkMEither (processMermaidBlock config) doc
|
||||
-- | Monad stack for stateful block transformation with error handling
|
||||
type TransformM = StateT TraversalState (ExceptT DocsterError IO)
|
||||
|
||||
-- | 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
|
||||
-- | Walk the Pandoc AST and process blocks with heading tracking
|
||||
transformDocument :: DiagramConfig -> Text -> Pandoc -> IO (Either DocsterError Pandoc)
|
||||
transformDocument config docName (Pandoc meta blocks) = do
|
||||
let initialState = initialTraversalState docName
|
||||
result <- runExceptT $ runStateT (mapM (processBlockStateful config) blocks) initialState
|
||||
case result of
|
||||
Left err -> return $ Left err
|
||||
Right newBlocks -> return $ Right $ Pandoc meta newBlocks
|
||||
Right (newBlocks, _finalState) ->
|
||||
case dcOutputFormat config of
|
||||
PDF -> return $ Right $ substituteUnicodeSymbols (Pandoc meta newBlocks)
|
||||
HTML -> return $ Right $ Pandoc meta newBlocks
|
||||
DOCX -> return $ Right $ Pandoc meta newBlocks
|
||||
|
||||
-- | Process a single block with heading tracking state
|
||||
processBlockStateful :: DiagramConfig -> Block -> TransformM Block
|
||||
processBlockStateful config block = case block of
|
||||
-- Update current heading on any heading level
|
||||
Header _ _ inlines -> do
|
||||
let headingText = normalizeHeading $ inlinesToText inlines
|
||||
modify $ \s -> s { tsCurrentHeading = Just headingText }
|
||||
return block
|
||||
|
||||
-- Process mermaid blocks with heading context
|
||||
CodeBlock (_, classes, _) contents
|
||||
| "mermaid" `elem` classes -> do
|
||||
state <- get
|
||||
let baseName = fromMaybe (tsDocumentName state) (tsCurrentHeading state)
|
||||
counter = Map.findWithDefault 0 baseName (tsHeadingCounters state)
|
||||
diagName = if counter == 0
|
||||
then baseName
|
||||
else baseName <> "_" <> T.pack (show counter)
|
||||
-- Increment counter for this heading
|
||||
modify $ \s -> s { tsHeadingCounters = Map.insertWith (+) baseName 1 (tsHeadingCounters s) }
|
||||
-- Render diagram with semantic name
|
||||
let diagId = DiagramId diagName
|
||||
result <- liftIO $ renderMermaidDiagram config diagId contents
|
||||
case result of
|
||||
Left err -> lift $ throwE err
|
||||
Right imagePath -> return $ createImageBlock imagePath
|
||||
|
||||
-- Pass through all other blocks unchanged
|
||||
_ -> return block
|
||||
|
||||
-- | Extract text content from inline elements
|
||||
inlinesToText :: [Inline] -> Text
|
||||
inlinesToText = T.concat . map inlineToText
|
||||
where
|
||||
inlineToText :: Inline -> Text
|
||||
inlineToText (Str t) = t
|
||||
inlineToText Space = " "
|
||||
inlineToText SoftBreak = " "
|
||||
inlineToText (Code _ t) = t
|
||||
inlineToText (Emph inlines) = inlinesToText inlines
|
||||
inlineToText (Strong inlines) = inlinesToText inlines
|
||||
inlineToText (Strikeout inlines) = inlinesToText inlines
|
||||
inlineToText (Quoted _ inlines) = inlinesToText inlines
|
||||
inlineToText (Link _ inlines _) = inlinesToText inlines
|
||||
inlineToText _ = ""
|
||||
|
||||
-- | Substitute Unicode symbols with LaTeX equivalents for PDF output
|
||||
substituteUnicodeSymbols :: Pandoc -> Pandoc
|
||||
substituteUnicodeSymbols = walk substituteInline
|
||||
where
|
||||
substituteInline :: Inline -> Inline
|
||||
substituteInline (Str text) = Str (substituteSymbols text)
|
||||
substituteInline other = other
|
||||
|
||||
substituteSymbols :: T.Text -> T.Text
|
||||
substituteSymbols = T.replace "✅" "\\checkmark"
|
||||
. T.replace "❌" "\\times"
|
||||
|
||||
Binary file not shown.
+59
-1
@@ -10,13 +10,29 @@ module Docster.Types
|
||||
|
||||
-- * Domain Types
|
||||
, SourceDir(..)
|
||||
, OutputDir(..)
|
||||
, OutputPath(..)
|
||||
, DiagramId(..)
|
||||
, DiagramConfig(..)
|
||||
|
||||
-- * Traversal State
|
||||
, TraversalState(..)
|
||||
, initialTraversalState
|
||||
, normalizeHeading
|
||||
|
||||
-- * Path Utilities
|
||||
, computeOutputDir
|
||||
, ensureOutputDir
|
||||
) where
|
||||
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Char (isAlphaNum, isSpace)
|
||||
import Data.Map.Strict (Map)
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Control.Exception (Exception)
|
||||
import System.FilePath (takeDirectory, takeBaseName, (</>))
|
||||
import System.Directory (createDirectoryIfMissing)
|
||||
|
||||
-- | Custom error types for comprehensive error handling
|
||||
data DocsterError
|
||||
@@ -29,13 +45,17 @@ data DocsterError
|
||||
instance Exception DocsterError
|
||||
|
||||
-- | Output format for document generation
|
||||
data OutputFormat = PDF | HTML
|
||||
data OutputFormat = PDF | HTML | DOCX
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- | Type-safe wrapper for source directory paths
|
||||
newtype SourceDir = SourceDir FilePath
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- | Type-safe wrapper for output directory paths
|
||||
newtype OutputDir = OutputDir FilePath
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- | Type-safe wrapper for output file paths
|
||||
newtype OutputPath = OutputPath FilePath
|
||||
deriving (Show, Eq)
|
||||
@@ -47,5 +67,43 @@ newtype DiagramId = DiagramId Text
|
||||
-- | Configuration for diagram generation
|
||||
data DiagramConfig = DiagramConfig
|
||||
{ dcSourceDir :: SourceDir
|
||||
, dcOutputDir :: OutputDir
|
||||
, dcOutputFormat :: OutputFormat
|
||||
} deriving (Show)
|
||||
|
||||
-- | Compute output directory from input file path
|
||||
-- "docs/readme.md" -> "docs/output/readme"
|
||||
computeOutputDir :: FilePath -> OutputDir
|
||||
computeOutputDir inputPath =
|
||||
let dir = takeDirectory inputPath
|
||||
baseName = takeBaseName inputPath
|
||||
in OutputDir $ if null dir || dir == "."
|
||||
then "output" </> baseName
|
||||
else dir </> "output" </> baseName
|
||||
|
||||
-- | Ensure output directory exists
|
||||
ensureOutputDir :: OutputDir -> IO ()
|
||||
ensureOutputDir (OutputDir dir) = createDirectoryIfMissing True dir
|
||||
|
||||
-- | State for heading-aware diagram naming during AST traversal
|
||||
data TraversalState = TraversalState
|
||||
{ tsCurrentHeading :: Maybe Text -- ^ Current heading text (normalized)
|
||||
, tsHeadingCounters :: Map Text Int -- ^ Counter for diagrams per heading
|
||||
, tsDocumentName :: Text -- ^ Fallback name when no heading
|
||||
} deriving (Show, Eq)
|
||||
|
||||
-- | Create initial traversal state with document name as fallback
|
||||
initialTraversalState :: Text -> TraversalState
|
||||
initialTraversalState docName = TraversalState
|
||||
{ tsCurrentHeading = Nothing
|
||||
, tsHeadingCounters = Map.empty
|
||||
, tsDocumentName = docName
|
||||
}
|
||||
|
||||
-- | Normalize heading text for use as a filename
|
||||
-- "File Flow Diagram!" -> "file_flow_diagram"
|
||||
normalizeHeading :: Text -> Text
|
||||
normalizeHeading = T.intercalate "_"
|
||||
. T.words
|
||||
. T.filter (\c -> isAlphaNum c || isSpace c)
|
||||
. T.toLower
|
||||
+1
-1
@@ -1,4 +1,4 @@
|
||||
resolver: lts-22.39 # GHC 9.12.2 compatible
|
||||
resolver: lts-24.34 # GHC 9.10.3
|
||||
|
||||
packages:
|
||||
- .
|
||||
|
||||
+4
-4
@@ -6,7 +6,7 @@
|
||||
packages: []
|
||||
snapshots:
|
||||
- completed:
|
||||
sha256: 6c5aeace2ca5ecde793a9e0acfaa730ec8f384aa2f6183a2a252f5f9ec55d623
|
||||
size: 720039
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/39.yaml
|
||||
original: lts-22.39
|
||||
sha256: 45b164eaf5c16bd220d2c5d7ab9a66ca0cfbcde7753703a5cb3549172adde813
|
||||
size: 728959
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/24/34.yaml
|
||||
original: lts-24.34
|
||||
|
||||
@@ -0,0 +1,101 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Docster.TransformSpec (spec) where
|
||||
|
||||
import Test.Hspec
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Text()
|
||||
import qualified Data.Text as T
|
||||
import Text.Pandoc.Definition (Inline(..))
|
||||
|
||||
import Docster.Types
|
||||
( OutputDir(..)
|
||||
, TraversalState(..)
|
||||
, computeOutputDir
|
||||
, normalizeHeading
|
||||
, initialTraversalState
|
||||
)
|
||||
import Docster.Transform (inlinesToText)
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "normalizeHeading" $ do
|
||||
it "lowercases and replaces spaces with underscores" $
|
||||
normalizeHeading "File Flow" `shouldBe` "file_flow"
|
||||
|
||||
it "strips non-alphanumeric characters" $
|
||||
normalizeHeading "API (v2.0)!" `shouldBe` "api_v20"
|
||||
|
||||
it "handles multiple spaces" $
|
||||
normalizeHeading "Hello World" `shouldBe` "hello_world"
|
||||
|
||||
it "handles unicode letters" $
|
||||
normalizeHeading "Diagrama de Flujo" `shouldBe` "diagrama_de_flujo"
|
||||
|
||||
it "handles empty string" $
|
||||
normalizeHeading "" `shouldBe` ""
|
||||
|
||||
it "handles heading with only symbols" $
|
||||
normalizeHeading "!@#$%^" `shouldBe` ""
|
||||
|
||||
describe "computeOutputDir" $ do
|
||||
it "creates output subdir from input path" $
|
||||
computeOutputDir "docs/readme.md" `shouldBe` OutputDir "docs/output/readme"
|
||||
|
||||
it "handles nested paths" $
|
||||
computeOutputDir "a/b/c/file.md" `shouldBe` OutputDir "a/b/c/output/file"
|
||||
|
||||
it "handles current directory (no path)" $
|
||||
computeOutputDir "readme.md" `shouldBe` OutputDir "output/readme"
|
||||
|
||||
it "handles dot prefix path" $
|
||||
computeOutputDir "./readme.md" `shouldBe` OutputDir "output/readme"
|
||||
|
||||
describe "initialTraversalState" $ do
|
||||
it "starts with no current heading" $
|
||||
tsCurrentHeading (initialTraversalState "doc") `shouldBe` Nothing
|
||||
|
||||
it "starts with empty counters" $
|
||||
tsHeadingCounters (initialTraversalState "doc") `shouldBe` Map.empty
|
||||
|
||||
it "stores document name" $
|
||||
tsDocumentName (initialTraversalState "myfile") `shouldBe` "myfile"
|
||||
|
||||
describe "diagram naming logic" $ do
|
||||
it "first diagram under heading has no suffix" $
|
||||
let baseName = "file_flow"
|
||||
counter = Map.findWithDefault (0 :: Int) baseName Map.empty
|
||||
diagName = if counter == 0 then baseName else baseName <> "_" <> T.pack (show counter)
|
||||
in diagName `shouldBe` "file_flow"
|
||||
|
||||
it "second diagram gets _1 suffix" $
|
||||
let baseName = "file_flow"
|
||||
counters = Map.singleton "file_flow" (1 :: Int)
|
||||
counter = Map.findWithDefault (0 :: Int) baseName counters
|
||||
diagName = if counter == 0 then baseName else baseName <> "_" <> T.pack (show counter)
|
||||
in diagName `shouldBe` "file_flow_1"
|
||||
|
||||
it "third diagram gets _2 suffix" $
|
||||
let baseName = "file_flow"
|
||||
counters = Map.singleton "file_flow" (2 :: Int)
|
||||
counter = Map.findWithDefault (0 :: Int) baseName counters
|
||||
diagName = if counter == 0 then baseName else baseName <> "_" <> T.pack (show counter)
|
||||
in diagName `shouldBe` "file_flow_2"
|
||||
|
||||
it "uses document name when no heading" $
|
||||
let state = initialTraversalState "readme"
|
||||
baseName = maybe (tsDocumentName state) id (tsCurrentHeading state)
|
||||
in baseName `shouldBe` "readme"
|
||||
|
||||
describe "inlinesToText" $ do
|
||||
it "extracts text from Str inline" $
|
||||
inlinesToText [Str "hello"] `shouldBe` "hello"
|
||||
|
||||
it "handles Space" $
|
||||
inlinesToText [Str "hello", Space, Str "world"] `shouldBe` "hello world"
|
||||
|
||||
it "handles nested emphasis" $
|
||||
inlinesToText [Emph [Str "important"]] `shouldBe` "important"
|
||||
|
||||
it "handles Code inline" $
|
||||
inlinesToText [Code ("", [], []) "code"] `shouldBe` "code"
|
||||
@@ -0,0 +1 @@
|
||||
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
|
||||
Reference in New Issue
Block a user