Compare commits
29
Commits
7f1f1aeeb0
...
main
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
54c7502f0f | ||
|
|
eb374d20f5 | ||
|
|
57f4f9f165 | ||
|
|
f016950ac7 | ||
|
|
f4dab3e354 | ||
|
|
6b49db5801 | ||
|
|
b0457388dc | ||
|
|
8abe1d1bc2 | ||
|
|
9dd9313829 | ||
|
|
fa850d5017 | ||
|
|
dda2fc15b2 | ||
|
|
705d53b958 | ||
|
|
3398dd2bae | ||
|
|
1a44dc8753 | ||
|
|
7de2bc811a | ||
|
|
7d2b407908 | ||
|
|
4ae2321cfd | ||
|
|
fe3e599909 | ||
|
|
7b3e46d1ec | ||
|
|
8a25a9e365 | ||
|
|
dbefe27f9f | ||
|
|
a7db2a53df | ||
|
|
a4011e73e4 | ||
|
|
907fcb3884 | ||
|
|
bf6f82abe5 | ||
|
|
303f347243 | ||
|
|
1c8cfdb075 | ||
|
|
e6048e34d1 | ||
|
|
f7a6482447 |
@@ -0,0 +1,66 @@
|
|||||||
|
---
|
||||||
|
name: haskell-higher-order
|
||||||
|
description: Use this agent when you need to refactor Haskell code to use advanced functional patterns, including monad transformers (ExceptT, ReaderT), pipeline composition, higher-order abstractions, and functional design patterns. This agent focuses on architectural improvements rather than basic code cleanup. Examples: <example>Context: User has nested case statements handling Either values in IO functions. user: 'I have these deeply nested case statements handling errors in my IO functions. It's getting hard to follow the logic.' assistant: 'I'll use the haskell-higher-order agent to refactor this into a cleaner monadic pipeline using ExceptT.' <commentary>The user needs help with monad transformer patterns to simplify error handling in IO.</commentary></example> <example>Context: User has similar functions that differ only in output format handling. user: 'These PDF and HTML compilation functions are nearly identical except for the final formatting step.' assistant: 'Let me use the haskell-higher-order agent to extract the common pipeline and create a strategy pattern for format-specific operations.' <commentary>Perfect case for higher-order abstraction and the strategy pattern.</commentary></example>
|
||||||
|
tools: Task, Bash, Glob, Grep, LS, ExitPlanMode, Read, Edit, MultiEdit, Write, NotebookRead, NotebookEdit, WebFetch, TodoWrite, WebSearch, mcp__sequential-thinking__sequentialthinking
|
||||||
|
color: purple
|
||||||
|
---
|
||||||
|
|
||||||
|
You are an expert Haskell developer specializing in advanced functional programming patterns and architectural refactoring. Your expertise lies in transforming imperative-style Haskell code into elegant functional solutions using higher-order abstractions, monad transformers, and functional design patterns.
|
||||||
|
|
||||||
|
Your core responsibilities:
|
||||||
|
|
||||||
|
**Monad Transformer Expertise**: Transform nested Either/IO handling into clean monadic pipelines using ExceptT, ReaderT, StateT, and other transformers. Know when each transformer adds value and when it's overkill.
|
||||||
|
|
||||||
|
**Pipeline Composition**: Convert sequential operations with manual error threading into composed pipelines using operators like >>=, >=>>, and <$>. Create custom operators when they improve readability.
|
||||||
|
|
||||||
|
**Higher-Order Abstractions**: Identify repeated patterns and extract them into parameterized functions. Use function parameters, records of functions, or type classes to capture varying behavior.
|
||||||
|
|
||||||
|
**Functional Design Patterns**: Apply patterns like:
|
||||||
|
- Strategy pattern using records of functions
|
||||||
|
- Interpreter pattern with free monads (when appropriate)
|
||||||
|
- Builder pattern using function composition
|
||||||
|
- Dependency injection via ReaderT or implicit parameters
|
||||||
|
|
||||||
|
**Effect Management**: Separate pure computations from effects:
|
||||||
|
- Extract pure cores from effectful shells
|
||||||
|
- Use mtl-style constraints for flexible effects
|
||||||
|
- Consider tagless final when beneficial
|
||||||
|
- Know when to use IO vs more restricted effect types
|
||||||
|
|
||||||
|
**Type-Level Programming**: When beneficial, use:
|
||||||
|
- Type families for better APIs
|
||||||
|
- GADTs for enhanced type safety
|
||||||
|
- Phantom types for compile-time guarantees
|
||||||
|
- But avoid over-engineering
|
||||||
|
|
||||||
|
Your refactoring approach:
|
||||||
|
1. **Identify Patterns**: Look for repeated structures, nested error handling, and mixed concerns
|
||||||
|
2. **Design Abstractions**: Create appropriate higher-order functions or type classes
|
||||||
|
3. **Preserve Behavior**: Ensure refactoring maintains semantics unless explicitly changing them
|
||||||
|
4. **Incremental Steps**: Show progression from current code to final solution
|
||||||
|
5. **Explain Trade-offs**: Discuss when advanced patterns are worth their complexity
|
||||||
|
6. **Avoid Over-Engineering**: Know when simple code is better than clever code
|
||||||
|
|
||||||
|
When reviewing code, look for:
|
||||||
|
- Nested case expressions on Either/Maybe in IO
|
||||||
|
- Functions with similar structure but different details
|
||||||
|
- Manual threading of configuration or state
|
||||||
|
- Imperative-style loops that could be folds/traversals
|
||||||
|
- Mixed pure and effectful code
|
||||||
|
- Opportunities for lawful abstractions (Functor, Applicative, Monad)
|
||||||
|
|
||||||
|
Common transformations you perform:
|
||||||
|
- `IO (Either e a)` → `ExceptT e IO a`
|
||||||
|
- Nested cases → monadic composition with >>=
|
||||||
|
- Similar functions → higher-order function with strategy parameter
|
||||||
|
- Global config passing → ReaderT environment
|
||||||
|
- Accumulating state → StateT or WriterT
|
||||||
|
- Multiple effects → monad transformer stack or mtl-style
|
||||||
|
|
||||||
|
Always consider:
|
||||||
|
- Is the abstraction worth the complexity?
|
||||||
|
- Will other developers understand this code?
|
||||||
|
- Does this make the code more or less maintainable?
|
||||||
|
- Are we solving real problems or just showing off?
|
||||||
|
|
||||||
|
Provide concrete before/after examples showing the progression from current code to improved functional style. Focus on practical improvements that enhance maintainability and expressiveness without sacrificing clarity.
|
||||||
@@ -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.
|
||||||
+22
@@ -0,0 +1,22 @@
|
|||||||
|
dist-newstyle
|
||||||
|
dist-newstyle
|
||||||
|
/.stack-work/
|
||||||
|
/.stack-root/
|
||||||
|
/.cabal-config/
|
||||||
|
*.mmd
|
||||||
|
*.png
|
||||||
|
*.svg
|
||||||
|
*.html
|
||||||
|
*.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
|
||||||
@@ -0,0 +1,12 @@
|
|||||||
|
{
|
||||||
|
"mcpServers": {
|
||||||
|
"playwright": {
|
||||||
|
"type": "stdio",
|
||||||
|
"command": "npx",
|
||||||
|
"args": [
|
||||||
|
"@playwright/mcp"
|
||||||
|
],
|
||||||
|
"env": {}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
@@ -10,31 +10,36 @@ Docster is a Haskell CLI tool that converts Markdown files with embedded Mermaid
|
|||||||
|
|
||||||
### Build
|
### Build
|
||||||
```bash
|
```bash
|
||||||
cabal build
|
stack build
|
||||||
```
|
```
|
||||||
|
|
||||||
### Run
|
### Run
|
||||||
```bash
|
```bash
|
||||||
# Convert to PDF
|
# Convert to PDF
|
||||||
cabal run docster -- -pdf path/to/file.md
|
stack exec docster -- -pdf path/to/file.md
|
||||||
|
|
||||||
# Convert to HTML
|
# 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
|
### Test a single file
|
||||||
```bash
|
```bash
|
||||||
cabal run docster -- -pdf mermaid-to-svg/sample.md
|
stack exec docster -- -pdf mermaid-to-svg/sample.md
|
||||||
```
|
```
|
||||||
|
|
||||||
### Clean build artifacts
|
### Clean build artifacts
|
||||||
```bash
|
```bash
|
||||||
cabal clean
|
stack clean
|
||||||
```
|
```
|
||||||
|
|
||||||
### Interactive development
|
### Interactive development
|
||||||
```bash
|
```bash
|
||||||
cabal repl
|
stack repl
|
||||||
```
|
```
|
||||||
|
|
||||||
## Architecture
|
## Architecture
|
||||||
@@ -57,17 +62,11 @@ The tool uses Pandoc's AST transformation capabilities to:
|
|||||||
## Dependencies
|
## Dependencies
|
||||||
|
|
||||||
External requirements:
|
External requirements:
|
||||||
- GHC 9.12.2 and Cabal 3.16 (install via ghcup)
|
- Stack (install via ghcup) — manages GHC 9.10.3 automatically via lts-24.34
|
||||||
- Pandoc library
|
- Pandoc library (Haskell dependency, pulled by Stack)
|
||||||
- TeX Live (for PDF generation via XeLaTeX)
|
- TeX Live (for PDF generation via XeLaTeX)
|
||||||
- Mermaid CLI (`npm install -g @mermaid-js/mermaid-cli`)
|
- Mermaid CLI (`npm install -g @mermaid-js/mermaid-cli`)
|
||||||
|
- pkg-config, libgmp-dev, libffi-dev, zlib1g-dev (see `install-deps.sh`)
|
||||||
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
|
|
||||||
```
|
|
||||||
|
|
||||||
## Common Issues
|
## Common Issues
|
||||||
|
|
||||||
|
|||||||
@@ -6,18 +6,77 @@ A self-contained CLI tool that converts Markdown with Mermaid diagrams into PDF
|
|||||||
|
|
||||||
docster -pdf path/to/file.md
|
docster -pdf path/to/file.md
|
||||||
docster -html 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.
|
||||||
|
|
||||||
## Requirements
|
## Installation
|
||||||
|
|
||||||
- GHC + Cabal (via ghcup)
|
### Prerequisites
|
||||||
- Pandoc
|
|
||||||
- TeX Live (for PDF)
|
|
||||||
- Mermaid CLI (`npm install -g @mermaid-js/mermaid-cli`)
|
|
||||||
|
|
||||||
### specific versions
|
Install the required system dependencies (Ubuntu/Debian):
|
||||||
|
|
||||||
source ~/.ghcup/env && ghcup install ghc 9.12.2
|
```bash
|
||||||
source ~/.ghcup/env && ghcup install cabal 3.16.0.0
|
./install-deps.sh
|
||||||
source ~/.ghcup/env && ghcup install hls 2.11.0.0
|
```
|
||||||
|
|
||||||
|
This installs build-essential, libgmp-dev, libffi-dev, zlib1g-dev, pkg-config, and TeX Live packages for PDF generation.
|
||||||
|
|
||||||
|
### Install Haskell toolchain
|
||||||
|
|
||||||
|
Install ghcup (Haskell toolchain installer):
|
||||||
|
|
||||||
|
```bash
|
||||||
|
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh
|
||||||
|
source ~/.ghcup/env
|
||||||
|
```
|
||||||
|
|
||||||
|
#### 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.
|
||||||
|
|||||||
@@ -0,0 +1,48 @@
|
|||||||
|
# Docster — Project Guide
|
||||||
|
|
||||||
|
Docster is a Haskell CLI tool: Markdown + embedded Mermaid diagrams → PDF, HTML, or DOCX.
|
||||||
|
|
||||||
|
## Quick Commands
|
||||||
|
|
||||||
|
```bash
|
||||||
|
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
|
||||||
|
```
|
||||||
|
|
||||||
|
## Structure
|
||||||
|
|
||||||
|
```
|
||||||
|
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)
|
||||||
|
```
|
||||||
|
|
||||||
|
## How It Works
|
||||||
|
|
||||||
|
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)
|
||||||
|
|
||||||
|
Key functions in `Main.hs`:
|
||||||
|
- `transformDoc` — AST walker
|
||||||
|
- `processMermaidBlock` — calls `mmdc`, returns image reference
|
||||||
|
- `compileToPDF` / `compileToHTML` / `compileToDOCX` — final Pandoc compilation
|
||||||
|
|
||||||
|
## 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.
|
||||||
+8
-208
@@ -1,221 +1,21 @@
|
|||||||
{-# 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.Class (runIOorExplode)
|
import Docster.Compiler (compileToPDF, compileToHTML, compileToDOCX)
|
||||||
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 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
|
|
||||||
|
|
||||||
-- | Type-safe wrappers for better domain modeling
|
|
||||||
newtype SourceDir = SourceDir FilePath deriving (Show, Eq)
|
|
||||||
newtype OutputPath = OutputPath FilePath deriving (Show, Eq)
|
|
||||||
newtype DiagramId = DiagramId Text deriving (Show, Eq)
|
|
||||||
|
|
||||||
-- | Constants for the application
|
|
||||||
mermaidCommand :: String
|
|
||||||
mermaidCommand = "mmdc"
|
|
||||||
|
|
||||||
diagramPrefix :: String
|
|
||||||
diagramPrefix = "diagram-"
|
|
||||||
|
|
||||||
successEmoji :: String
|
|
||||||
successEmoji = "✅"
|
|
||||||
|
|
||||||
-- | Generate a diagram ID from content hash or explicit ID
|
|
||||||
generateDiagramId :: Text -> Text -> DiagramId
|
|
||||||
generateDiagramId explicitId contents
|
|
||||||
| T.null explicitId = DiagramId $ T.pack $ diagramPrefix <> take 6 (show (abs (hash (T.unpack contents))))
|
|
||||||
| otherwise = DiagramId explicitId
|
|
||||||
|
|
||||||
-- | Transform Mermaid code blocks into image embeds with resource cleanup
|
|
||||||
processMermaidBlock :: SourceDir -> OutputPath -> Block -> IO Block
|
|
||||||
processMermaidBlock (SourceDir sourceDir) (OutputPath outputPath) (CodeBlock (id', classes, _) contents)
|
|
||||||
| "mermaid" `elem` classes = do
|
|
||||||
let DiagramId diagId = generateDiagramId id' contents
|
|
||||||
diagIdStr = T.unpack diagId
|
|
||||||
mmdFile = sourceDir </> diagIdStr <> ".mmd"
|
|
||||||
-- Use SVG for HTML (scalable), high-res PNG for PDF (text compatibility)
|
|
||||||
(outputFile, imagePath) = if isHTMLOutput outputPath
|
|
||||||
then let svgFile = sourceDir </> diagIdStr <> ".svg"
|
|
||||||
in (svgFile, takeFileName svgFile)
|
|
||||||
else let pngFile = sourceDir </> diagIdStr <> ".png"
|
|
||||||
in (pngFile, pngFile)
|
|
||||||
|
|
||||||
-- Use bracket to ensure cleanup of temporary mermaid file
|
|
||||||
bracket
|
|
||||||
(TIO.writeFile mmdFile contents >> return mmdFile)
|
|
||||||
(\file -> removeFile file `catch` \(_ :: SomeException) -> return ())
|
|
||||||
(\_ -> do
|
|
||||||
-- Generate with appropriate format and quality for output type
|
|
||||||
if isHTMLOutput outputPath
|
|
||||||
then void $ callProcess mermaidCommand ["-i", mmdFile, "-o", outputFile]
|
|
||||||
else void $ callProcess mermaidCommand ["-i", mmdFile, "-o", outputFile, "--scale", "3"]
|
|
||||||
putStrLn $ successEmoji <> " Generated " <> outputFile
|
|
||||||
return $ Para [Image nullAttr [] (T.pack imagePath, "Mermaid diagram")])
|
|
||||||
processMermaidBlock _ _ block = return block
|
|
||||||
|
|
||||||
-- | Check if output is HTML format based on file extension
|
|
||||||
isHTMLOutput :: FilePath -> Bool
|
|
||||||
isHTMLOutput path = takeExtension path == ".html"
|
|
||||||
|
|
||||||
-- | Walk the Pandoc AST and process blocks using walkM
|
|
||||||
transformDocument :: SourceDir -> OutputPath -> Pandoc -> IO Pandoc
|
|
||||||
transformDocument sourceDir outputPath = walkM (processMermaidBlock sourceDir outputPath)
|
|
||||||
|
|
||||||
-- | LaTeX template with comprehensive package support
|
|
||||||
latexTemplate :: Text -> Text
|
|
||||||
latexTemplate bodyContent = T.unlines
|
|
||||||
[ "\\documentclass{article}"
|
|
||||||
, "\\usepackage[utf8]{inputenc}"
|
|
||||||
, "\\usepackage{fontspec}"
|
|
||||||
, "\\usepackage{graphicx}"
|
|
||||||
, "\\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}}"
|
|
||||||
, "\\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 ["-docx", path] = Right (compileToDOCX path)
|
||||||
|
parseArgs _ = Left $ InvalidUsage "Usage: docster -pdf|-html|-docx <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@(OutputPath outputPathStr) = do
|
|
||||||
content <- TIO.readFile inputPath
|
|
||||||
let readerOptions = def { readerExtensions = getDefaultExtensions "markdown" }
|
|
||||||
|
|
||||||
pandoc <- runIOorExplode $ readMarkdown readerOptions content
|
|
||||||
transformed <- transformDocument sourceDir outputPath pandoc
|
|
||||||
|
|
||||||
-- Generate LaTeX with proper template
|
|
||||||
latexOutput <- runIOorExplode $ writeLaTeX def transformed
|
|
||||||
let completeLatex = latexTemplate latexOutput
|
|
||||||
|
|
||||||
result <- runIOorExplode $ makePDF "xelatex" [] (\_ _ -> return completeLatex) def transformed
|
|
||||||
case result of
|
|
||||||
Left err -> return $ Left $ PDFGenerationError $ T.pack $ show err
|
|
||||||
Right bs -> do
|
|
||||||
BL.writeFile outputPathStr bs
|
|
||||||
putStrLn $ successEmoji <> " PDF written to " <> outputPathStr
|
|
||||||
return $ Right ()
|
|
||||||
|
|
||||||
-- | 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@(OutputPath outputPathStr) = do
|
|
||||||
content <- TIO.readFile inputPath
|
|
||||||
let readerOptions = def { readerExtensions = getDefaultExtensions "markdown" }
|
|
||||||
|
|
||||||
pandoc <- runIOorExplode $ readMarkdown readerOptions content
|
|
||||||
transformed <- transformDocument sourceDir outputPath pandoc
|
|
||||||
|
|
||||||
html <- runIOorExplode $ writeHtml5String def transformed
|
|
||||||
TIO.writeFile outputPathStr html
|
|
||||||
putStrLn $ successEmoji <> " HTML written to " <> outputPathStr
|
|
||||||
|
|
||||||
-- Open the generated HTML file in browser
|
|
||||||
putStrLn $ "🌐 Opening " <> outputPathStr <> " in browser for error checking..."
|
|
||||||
void $ callProcess "open" [outputPathStr]
|
|
||||||
|
|
||||||
return $ Right ()
|
|
||||||
|
|
||||||
-- | Main entry point
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
args <- getArgs
|
args <- getArgs
|
||||||
|
|||||||
Vendored
BIN
Binary file not shown.
+46
-9
@@ -1,9 +1,9 @@
|
|||||||
cabal-version: 3.0
|
cabal-version: 3.0
|
||||||
name: docster
|
name: docster
|
||||||
version: 0.1.0.0
|
version: 0.1.0.0
|
||||||
synopsis: A self-contained CLI tool that converts Markdown with Mermaid diagrams to PDF/HTML
|
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 or HTML files
|
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
|
using Pandoc and Mermaid CLI. It automatically renders Mermaid code blocks to SVG (HTML) or PNG (PDF/DOCX)
|
||||||
and embeds them in the output.
|
and embeds them in the output.
|
||||||
homepage: https://github.com/yourusername/docster
|
homepage: https://github.com/yourusername/docster
|
||||||
license: BSD-3-Clause
|
license: BSD-3-Clause
|
||||||
@@ -25,21 +25,58 @@ 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.18 && <5,
|
||||||
text >=2.0 && <2.2,
|
text >=2.0 && <2.2,
|
||||||
filepath >=1.4 && <1.6,
|
filepath >=1.4 && <1.6,
|
||||||
directory >=1.3 && <1.4,
|
directory >=1.3 && <1.4,
|
||||||
process >=1.6 && <1.7,
|
process >=1.6 && <1.7,
|
||||||
hashable >=1.4 && <1.6,
|
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,
|
pandoc-types >=1.23 && <1.25,
|
||||||
bytestring >=0.11 && <0.13
|
bytestring >=0.11 && <0.13,
|
||||||
|
temporary >=1.3 && <1.4,
|
||||||
|
transformers >=0.5 && <0.7
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
executable docster
|
||||||
|
import: warnings
|
||||||
|
main-is: Main.hs
|
||||||
|
hs-source-dirs: app
|
||||||
|
build-depends:
|
||||||
|
base >=4.18 && <5,
|
||||||
|
text >=2.0 && <2.2,
|
||||||
|
docster
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
ghc-options: -threaded
|
ghc-options: -threaded
|
||||||
-rtsopts
|
-rtsopts
|
||||||
-with-rtsopts=-N
|
-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
|
||||||
|
|
||||||
@@ -0,0 +1,339 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
|
||||||
|
-- | 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, takeBaseName, replaceExtension, (</>), (<.>))
|
||||||
|
import System.Process (callProcess, readProcessWithExitCode)
|
||||||
|
import System.IO.Temp (withSystemTempDirectory)
|
||||||
|
import System.Directory (copyFile, doesFileExist)
|
||||||
|
import System.Exit (ExitCode(..))
|
||||||
|
import Control.Exception (throwIO)
|
||||||
|
import Control.Monad (void)
|
||||||
|
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
|
||||||
|
successEmoji = "✅"
|
||||||
|
|
||||||
|
-- | Compilation context for pipeline operations
|
||||||
|
data CompilationContext = CompilationContext
|
||||||
|
{ ccStrategy :: CompilationStrategy
|
||||||
|
, ccInputPath :: FilePath
|
||||||
|
, ccOutputPath :: FilePath
|
||||||
|
, ccDocName :: Text
|
||||||
|
, ccReaderOptions :: ReaderOptions
|
||||||
|
, ccConfig :: DiagramConfig
|
||||||
|
}
|
||||||
|
|
||||||
|
-- | Monad stack for compilation pipeline
|
||||||
|
type CompilationM = ReaderT CompilationContext (ExceptT DocsterError IO)
|
||||||
|
|
||||||
|
-- | Strategy pattern: Record of format-specific operations
|
||||||
|
data CompilationStrategy = CompilationStrategy
|
||||||
|
{ -- | Format for diagram configuration
|
||||||
|
csOutputFormat :: OutputFormat
|
||||||
|
-- | 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
|
||||||
|
}
|
||||||
|
|
||||||
|
-- | PDF compilation strategy
|
||||||
|
pdfStrategy :: CompilationStrategy
|
||||||
|
pdfStrategy = CompilationStrategy
|
||||||
|
{ csOutputFormat = PDF
|
||||||
|
, 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
|
||||||
|
}
|
||||||
|
|
||||||
|
-- | HTML compilation strategy
|
||||||
|
htmlStrategy :: CompilationStrategy
|
||||||
|
htmlStrategy = CompilationStrategy
|
||||||
|
{ csOutputFormat = HTML
|
||||||
|
, 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
|
||||||
|
}
|
||||||
|
|
||||||
|
-- | 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
|
||||||
|
let texFile = tempDir </> "document.tex"
|
||||||
|
pdfFile = tempDir </> "document.pdf"
|
||||||
|
logFile = tempDir </> "document.log"
|
||||||
|
|
||||||
|
-- Run XeLaTeX compilation
|
||||||
|
(exitCode, _stdout, stderr) <- readProcessWithExitCode "xelatex"
|
||||||
|
[ "-output-directory=" <> tempDir
|
||||||
|
, "-interaction=nonstopmode" -- Don't stop on errors
|
||||||
|
, 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
|
||||||
|
pdfExists <- doesFileExist pdfFile
|
||||||
|
if pdfExists
|
||||||
|
then do
|
||||||
|
-- Copy the generated PDF to the final location
|
||||||
|
copyFile pdfFile outputPath
|
||||||
|
return $ Right ()
|
||||||
|
else do
|
||||||
|
return $ Left $ PDFGenerationError $
|
||||||
|
"PDF file not generated despite successful exit code.\n" <>
|
||||||
|
"Full LaTeX log written to: " <> T.pack logOutputPath
|
||||||
|
ExitFailure code -> do
|
||||||
|
-- LaTeX compilation failed - parse log for meaningful errors
|
||||||
|
let errorSummary = parseLatexErrors logContent
|
||||||
|
return $ Left $ PDFGenerationError $
|
||||||
|
"❌ 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]
|
||||||
|
|
||||||
|
return $ Right ()
|
||||||
|
|
||||||
|
-- | Helper function to lift IO (Either DocsterError a) into CompilationM
|
||||||
|
liftEitherM :: IO (Either DocsterError a) -> CompilationM a
|
||||||
|
liftEitherM action = do
|
||||||
|
result <- liftIO action
|
||||||
|
case result of
|
||||||
|
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 $ stripAnsiCodes <$> TIO.readFile inputPath
|
||||||
|
|
||||||
|
-- | Pipeline step: Parse markdown content into Pandoc AST
|
||||||
|
parseDocument :: Text -> CompilationM Pandoc
|
||||||
|
parseDocument content = do
|
||||||
|
readerOptions <- asks ccReaderOptions
|
||||||
|
liftEitherM $ parseMarkdown readerOptions content
|
||||||
|
|
||||||
|
-- | Pipeline step: Transform document (process Mermaid diagrams)
|
||||||
|
transformDocumentM :: Pandoc -> CompilationM Pandoc
|
||||||
|
transformDocumentM pandoc = do
|
||||||
|
config <- asks ccConfig
|
||||||
|
docName <- asks ccDocName
|
||||||
|
liftEitherM $ transformDocument config docName pandoc
|
||||||
|
|
||||||
|
-- | Pipeline step: Write output and post-process (format-specific)
|
||||||
|
writeAndProcessOutput :: Pandoc -> CompilationM ()
|
||||||
|
writeAndProcessOutput pandoc = do
|
||||||
|
strategy <- asks ccStrategy
|
||||||
|
outputPath <- asks ccOutputPath
|
||||||
|
liftEitherM $ csWriter strategy def pandoc outputPath
|
||||||
|
liftEitherM $ (csPostProcess strategy) outputPath
|
||||||
|
|
||||||
|
-- | Pipeline step: Print success message
|
||||||
|
printSuccess :: CompilationM ()
|
||||||
|
printSuccess = do
|
||||||
|
strategy <- asks ccStrategy
|
||||||
|
outputPath <- asks ccOutputPath
|
||||||
|
liftIO $ putStrLn $ T.unpack $ csSuccessMessage strategy outputPath
|
||||||
|
|
||||||
|
-- | Higher-order compilation function that takes a strategy and executes the pipeline
|
||||||
|
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 outputDir (csOutputFormat strategy)
|
||||||
|
context = CompilationContext strategy inputPath outputPath docName readerOptions config
|
||||||
|
pipeline = readContent >>= parseDocument >>= transformDocumentM >>= writeAndProcessOutput >> printSuccess
|
||||||
|
|
||||||
|
runExceptT $ runReaderT pipeline context
|
||||||
|
|
||||||
|
-- | Parse markdown with error handling
|
||||||
|
parseMarkdown :: ReaderOptions -> Text -> IO (Either DocsterError Pandoc)
|
||||||
|
parseMarkdown readerOptions content = do
|
||||||
|
pandocResult <- runIO $ readMarkdown readerOptions content
|
||||||
|
return $ case pandocResult of
|
||||||
|
Left err -> Left $ FileError $ "Failed to parse markdown: " <> T.pack (show err)
|
||||||
|
Right pandoc -> Right pandoc
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- | Compile markdown to PDF using XeLaTeX
|
||||||
|
compileToPDF :: FilePath -> IO ()
|
||||||
|
compileToPDF = compileWithFormat pdfStrategy "pdf"
|
||||||
|
|
||||||
|
-- | Compile markdown to HTML
|
||||||
|
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
|
||||||
|
outputDir = computeOutputDir path
|
||||||
|
OutputDir outDirPath = outputDir
|
||||||
|
baseName = takeBaseName path
|
||||||
|
docName = T.pack baseName
|
||||||
|
outputPath = OutputPath $ outDirPath </> baseName <.> extension
|
||||||
|
|
||||||
|
-- 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 ()
|
||||||
@@ -0,0 +1,117 @@
|
|||||||
|
{-# 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 modern corporate styling for PDF generation
|
||||||
|
latexTemplate :: Text -> Text
|
||||||
|
latexTemplate bodyContent = T.unlines
|
||||||
|
[ "\\documentclass{article}"
|
||||||
|
-- Packages
|
||||||
|
, "\\usepackage{fontspec}"
|
||||||
|
, "\\usepackage{graphicx}"
|
||||||
|
, "\\usepackage{adjustbox}"
|
||||||
|
, "\\usepackage{geometry}"
|
||||||
|
, "\\usepackage{longtable}"
|
||||||
|
, "\\usepackage{booktabs}"
|
||||||
|
, "\\usepackage{array}"
|
||||||
|
, "\\usepackage{calc}"
|
||||||
|
, "\\usepackage{enumitem}"
|
||||||
|
, "\\usepackage{amsmath}"
|
||||||
|
, "\\usepackage{amssymb}"
|
||||||
|
, "\\usepackage{fancyvrb}"
|
||||||
|
, "\\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}{\\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}"
|
||||||
|
]
|
||||||
|
|
||||||
|
-- | 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}}}}"
|
||||||
|
]
|
||||||
@@ -0,0 +1,114 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
|
||||||
|
-- | Mermaid diagram processing functionality
|
||||||
|
module Docster.Mermaid
|
||||||
|
( -- * Diagram Processing
|
||||||
|
processMermaidBlock
|
||||||
|
, renderMermaidDiagram
|
||||||
|
, generateDiagramId
|
||||||
|
, createImageBlock
|
||||||
|
) where
|
||||||
|
|
||||||
|
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, getTemporaryDirectory)
|
||||||
|
import System.Process (callProcess)
|
||||||
|
import System.IO (hClose)
|
||||||
|
import System.IO.Temp (openTempFile)
|
||||||
|
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 _ (OutputDir outDir) format) diagId contents = do
|
||||||
|
let diagIdStr = T.unpack $ (\(DiagramId d) -> d) diagId
|
||||||
|
mmdFile = outDir </> 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 _ (OutputDir outDir) format) (DiagramId diagId) =
|
||||||
|
let diagIdStr = T.unpack diagId
|
||||||
|
in case format of
|
||||||
|
HTML -> let svgFile = outDir </> diagIdStr <> ".svg"
|
||||||
|
in (svgFile, T.pack $ takeFileName svgFile)
|
||||||
|
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 baseArgs = case format of
|
||||||
|
HTML -> ["-i", mmdFile, "-o", outputFile]
|
||||||
|
PDF -> ["-i", mmdFile, "-o", outputFile, "--scale", "3"]
|
||||||
|
DOCX -> ["-i", mmdFile, "-o", outputFile]
|
||||||
|
|
||||||
|
-- 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)))
|
||||||
|
return result
|
||||||
|
|
||||||
|
-- | Create Pandoc image block from image path
|
||||||
|
createImageBlock :: Text -> Block
|
||||||
|
createImageBlock imagePath = Para [Image nullAttr [] (imagePath, "Mermaid diagram")]
|
||||||
@@ -0,0 +1,99 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
-- | Document transformation functionality for processing Pandoc AST
|
||||||
|
module Docster.Transform
|
||||||
|
( -- * Document Transformation
|
||||||
|
transformDocument
|
||||||
|
-- * Utilities (exported for testing)
|
||||||
|
, inlinesToText
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Docster.Types
|
||||||
|
( 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)
|
||||||
|
|
||||||
|
-- | Monad stack for stateful block transformation with error handling
|
||||||
|
type TransformM = StateT TraversalState (ExceptT DocsterError IO)
|
||||||
|
|
||||||
|
-- | 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, _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.
@@ -0,0 +1,109 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
-- | Core types and error definitions for Docster
|
||||||
|
module Docster.Types
|
||||||
|
( -- * Error Types
|
||||||
|
DocsterError(..)
|
||||||
|
|
||||||
|
-- * Output Format
|
||||||
|
, OutputFormat(..)
|
||||||
|
|
||||||
|
-- * 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
|
||||||
|
= InvalidUsage Text
|
||||||
|
| FileError Text
|
||||||
|
| PDFGenerationError Text
|
||||||
|
| ProcessError Text
|
||||||
|
deriving (Show)
|
||||||
|
|
||||||
|
instance Exception DocsterError
|
||||||
|
|
||||||
|
-- | Output format for document generation
|
||||||
|
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)
|
||||||
|
|
||||||
|
-- | Type-safe wrapper for diagram identifiers
|
||||||
|
newtype DiagramId = DiagramId Text
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
-- | 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
|
||||||
@@ -0,0 +1,8 @@
|
|||||||
|
resolver: lts-24.34 # GHC 9.10.3
|
||||||
|
|
||||||
|
packages:
|
||||||
|
- .
|
||||||
|
|
||||||
|
extra-deps: []
|
||||||
|
|
||||||
|
allow-newer: true
|
||||||
@@ -0,0 +1,12 @@
|
|||||||
|
# This file was autogenerated by Stack.
|
||||||
|
# You should not edit this file by hand.
|
||||||
|
# For more information, please see the documentation at:
|
||||||
|
# https://docs.haskellstack.org/en/stable/topics/lock_files
|
||||||
|
|
||||||
|
packages: []
|
||||||
|
snapshots:
|
||||||
|
- completed:
|
||||||
|
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