diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,65 @@ +# Changelog + +All notable changes to this project are documented in this file. This project follows the Haskell Package Versioning Policy. + +## [Unreleased] + +## [0.3.0.2] - 2026-10-23 + +### Changed + +- Adopted Fourmolu formatting with a pinned configuration. +- Added Fourmolu and Gitleaks checks to CI and pinned GitHub Actions by commit SHA. +- Added a dedicated release guide and made binary publication an explicit manual step. +- Added the HLint configuration and documented SSH tag signing, checksum basenames, and environment secret handling. +- Declared every compiler exercised by CI in `tested-with`. + +### Fixed + +- Removed partial `Text.head` calls from thematic break detection. + +## [0.3.0.1] - 2026-10-21 + +### Fixed + +- Removed leading Zim metadata headers such as `Content-Type`, `Wiki-Format`, `Creation-Date`, and `Modification-Date`. +- Normalized per-page heading levels into consecutive Markdown levels capped at `###`. +- Translated namespace colons in internal links, so `[[Sistema:cron]]` resolves to `Sistema/cron.md`. +- Rendered `user@host` pseudo-links as plain text instead of page links. +- Corrected the reported application version to `0.3.0.1`. + +### Changed + +- Added Hackage and GitHub package metadata, a changelog, and source repository information. +- Added prebuilt Linux, macOS, and Windows binaries to GitHub releases. + +## [0.3.0.0] - 2026-10-20 + +### Added + +- Pipe table conversion in both directions. +- Horizontal rules, blockquotes, setext headings, anchors, HTML inline tags, autolinks, image alt text, and additional task states. +- Recursive formatting inside link labels. +- Support for passing `notebook.zim` as an alternative notebook root. + +### Changed + +- Reflowed the README and documentation to avoid hard wrapped lines. +- Documented the supported conversion rules and known limitations. + +## [0.2.0.0] - 2026-10-20 + +### Added + +- Conversion of whole notebooks, preserving the folder structure. +- Asset copying and internal link resolution across notebooks. +- Markdown to Zim conversion. +- Initial formatting rules for headings, emphasis, lists, tasks, links, images, and code blocks. +- A dependency free test suite. + +## [0.1.0.0] - 2026-10-20 + +### Added + +- Initial Cabal project scaffold with a pure library and a thin executable. +- Command line parsing, domain types, versioning, and documentation. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,28 @@ +BSD 3-Clause License + +Copyright (c) 2026, Tunai Raiol + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +3. Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,134 @@ +# zim-to-markdown + +Command line converter between Zim wiki pages and Markdown. It handles single pages and whole notebooks in both directions. + +## Stack + +Haskell with Cabal. Stack is not used. + +## Versioning + +PVP, single-sourced from the `zim-to-markdown.cabal` file. + +- Patch: fixes and minor refinements. +- Minor: new user-facing features or screens. +- Major 2: data model breaking changes. +- Major 1: major release milestones. + +## Features + +- Converts a single page to standard output or to a file. +- Converts a whole notebook recursively, reconstructing its folder structure. +- Accepts the notebook directory or its `notebook.zim` configuration file as input. +- Strips the leading Zim metadata header and normalizes heading levels to `#`, `##`, and `###`. +- Copies notebook assets so images and attachments keep working. +- Resolves internal Zim links across the notebook. +- Converts Markdown back to Zim, including notebook structure. +- Supports headings, emphasis, lists, task lists, links, images, anchors, tables, blockquotes, horizontal rules, and code blocks. +- Keeps conversion pure and reports failures as data. + +## Links + +- Hackage: (available after the first publication) +- GitHub: + +## Documentation + +- [Architecture](docs/architecture.md) +- [Domain model](docs/domain.md) +- [Command line interface](docs/cli.md) +- [Conversion rules](docs/conversion.md) +- [Release guide](docs/releasing.md) +- [Versioning](docs/versioning.md) +- [Changelog](CHANGELOG.md) + +## Installation + +After the first Hackage publication, install with: + +```sh +cabal install zim-to-markdown +``` + +## Prebuilt binaries + +Prebuilt Linux, macOS, and Windows binaries are attached to [GitHub releases](https://github.com/Tralen/zim-to-markdown/releases/latest). The release workflow builds Linux x86_64 on Ubuntu 22.04 (glibc 2.35 or newer), macOS ARM64, and Windows x86_64 archives. Build from source for other Linux distributions. + +## Requirements + +- GHC 9.14.1 +- cabal-install 3.18.1.0 + +## Build and test + +```sh +cabal build +cabal test +``` + +## Development + +Run the formatter and linter with: + +```sh +fourmolu --mode check src app test +hlint src app test +``` + +Install the pre-commit hook to scan staged changes for secrets: + +```sh +pre-commit install +``` + +The hook requires `gitleaks` to be installed. The equivalent manual command is: + +```sh +gitleaks git --staged --redact +``` + +## Usage + +Convert a single Zim page to standard output: + +```sh +cabal run zim-to-markdown -- page.txt +``` + +Convert a single page to a Markdown file: + +```sh +cabal run zim-to-markdown -- page.txt --output page.md +``` + +Convert a whole Zim notebook, preserving its folders: + +```sh +cabal run zim-to-markdown -- my-notebook --output my-notebook-markdown +``` + +The notebook directory or its `notebook.zim` file can be used as input: + +```sh +cabal run zim-to-markdown -- my-notebook/notebook.zim --output my-notebook-markdown +``` + +Convert Markdown back to Zim: + +```sh +cabal run zim-to-markdown -- --direction markdown-to-zim notes --output notes-zim +``` + +Run `cabal run zim-to-markdown -- --help` for the complete option list. + +## Releasing + +Follow the [release guide](docs/releasing.md). + +## Status + +The converter covers headings, emphasis, lists, task lists, links, images, anchors, tables, blockquotes, horizontal rules, and code blocks. Reference links, footnotes, nested links, raw HTML blocks, and Markdown indented code blocks are not converted yet. See [conversion rules](docs/conversion.md) for details and known limitations. + +## License + +BSD-3-Clause. See [LICENSE](LICENSE). diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,323 @@ +module Main ( + main, +) where + +import Control.Exception (Exception, IOException, displayException, try) +import Data.ByteString qualified as ByteString +import Data.List (sort) +import Data.Set qualified as Set +import Data.Text (Text) +import Data.Text qualified as Text +import Data.Text.Encoding qualified as TextEncoding +import Data.Text.IO qualified as TextIO +import System.Directory ( + copyFile, + createDirectoryIfMissing, + doesDirectoryExist, + doesFileExist, + listDirectory, + makeAbsolute, + pathIsSymbolicLink, + ) +import System.Environment (getArgs) +import System.Exit (exitFailure) +import System.FilePath ( + normalise, + splitDirectories, + takeDirectory, + takeFileName, + (), + ) +import System.IO (stderr) + +import ZimToMarkdown.Converter (convertMarkdownDocument, convertZimPage) +import ZimToMarkdown.Domain ( + ConversionDirection (..), + MarkdownDocument (..), + RelativePath (..), + ZimPage (..), + ) +import ZimToMarkdown.Links (LinkContext (..)) +import ZimToMarkdown.Notebook ( + NotebookItem (..), + classifyNotebookItems, + outputRelativePath, + pageRelativePaths, + ) +import ZimToMarkdown.Options ( + ConversionRequest (..), + InputPath (..), + Options (..), + OutputPath (..), + helpText, + parseOptions, + renderOptionsError, + ) +import ZimToMarkdown.Paths (relativePathFrom) +import ZimToMarkdown.Version (versionText) + +main :: IO () +main = do + arguments <- getArgs + case parseOptions arguments of + Left optionsError -> failWith (renderOptionsError optionsError) + Right ShowHelp -> TextIO.putStr helpText + Right ShowVersion -> TextIO.putStrLn versionText + Right (Convert request) -> runConversion request + +runConversion :: ConversionRequest -> IO () +runConversion request = do + let inputPath = unInputPath (conversionInput request) + inputIsDirectory <- doesDirectoryExist inputPath + inputIsFile <- doesFileExist inputPath + if inputIsDirectory + then runNotebookRoot request inputPath + else + if inputIsFile + then + if isNotebookDefinition inputPath + then runNotebookRoot request (takeDirectory inputPath) + else runSingleFile request inputPath + else + failWith + ("Input path does not exist: " <> Text.pack inputPath) + +isNotebookDefinition :: FilePath -> Bool +isNotebookDefinition path = takeFileName path == "notebook.zim" + +runSingleFile :: ConversionRequest -> FilePath -> IO () +runSingleFile request inputPath = do + readResult <- readUtf8File inputPath + case readResult of + Left message -> failWith message + Right content -> do + let sourcePath = RelativePath (takeFileName inputPath) + context = LinkContext sourcePath (Set.singleton sourcePath) + rendered = + convertContent + (conversionDirection request) + context + content + case conversionOutput request of + Nothing -> TextIO.putStr rendered + Just outputPath -> do + outputIsDirectory <- + doesDirectoryExist (unOutputPath outputPath) + if outputIsDirectory + then + failWith + "For a single page, --output must be a file path." + else + writeUtf8File (unOutputPath outputPath) rendered + >>= either failWith pure + +runNotebookRoot :: ConversionRequest -> FilePath -> IO () +runNotebookRoot request inputRoot = + case conversionOutput request of + Nothing -> + failWith + "An output directory is required when converting a notebook." + Just outputPath -> do + let outputRoot = unOutputPath outputPath + inputAbsolute <- makeAbsolute inputRoot + outputAbsolute <- makeAbsolute outputRoot + if isStrictlyInside inputAbsolute outputAbsolute + then + failWith + "The output directory must not be inside the input directory." + else do + discovered <- discoverFiles inputRoot + case discovered of + Left message -> failWith message + Right relativePaths -> do + let items = + classifyNotebookItems + (conversionDirection request) + relativePaths + knownPages = pageRelativePaths items + convertNotebookItems + request + inputRoot + outputRoot + knownPages + items + >>= either failWith pure + +convertNotebookItems :: + ConversionRequest -> + FilePath -> + FilePath -> + Set.Set RelativePath -> + [NotebookItem] -> + IO (Either Text ()) +convertNotebookItems request inputRoot outputRoot knownPages = go + where + go [] = pure (Right ()) + go (item : rest) = do + result <- processItem item + case result of + Right () -> go rest + Left message -> pure (Left message) + + processItem (PageItem sourceRelative) = + convertPageItem sourceRelative + processItem (AssetItem relative) = + copyAssetItem relative + + convertPageItem sourceRelative = do + let sourcePath = inputRoot unRelativePath sourceRelative + destinationRelative = + outputRelativePath + (conversionDirection request) + sourceRelative + destinationPath = + outputRoot unRelativePath destinationRelative + context = LinkContext sourceRelative knownPages + readResult <- readUtf8File sourcePath + case readResult of + Left message -> pure (Left message) + Right content -> do + let rendered = + convertContent + (conversionDirection request) + context + content + writeUtf8File destinationPath rendered + + copyAssetItem relative = do + let sourcePath = inputRoot unRelativePath relative + destinationPath = outputRoot unRelativePath relative + copyAsset sourcePath destinationPath + +convertContent :: ConversionDirection -> LinkContext -> Text -> Text +convertContent direction context content = + case direction of + ZimToMarkdown -> + unMarkdownDocument + (convertZimPage context (ZimPage content)) + MarkdownToZim -> + unZimPage + (convertMarkdownDocument (MarkdownDocument content)) + +discoverFiles :: FilePath -> IO (Either Text [RelativePath]) +discoverFiles root = go "" + where + go relativeDirectory = do + let directory = + if null relativeDirectory + then root + else root relativeDirectory + listed <- + try (listDirectory directory) :: + IO (Either IOException [FilePath]) + case listed of + Left exception -> + pure (Left (renderFileError directory exception)) + Right names -> do + results <- mapM (visit relativeDirectory) (sort names) + pure (fmap concat (sequence results)) + + visit relativeDirectory name + | isHidden name = pure (Right []) + | otherwise = do + let relativePath = + normalise + ( if null relativeDirectory + then name + else relativeDirectory name + ) + fullPath = root relativePath + if relativePath == "notebook.zim" + then pure (Right []) + else do + symbolicResult <- + try (pathIsSymbolicLink fullPath) :: + IO (Either IOException Bool) + case symbolicResult of + Left exception -> + pure (Left (renderFileError fullPath exception)) + Right True -> pure (Right []) + Right False -> do + isDirectory <- doesDirectoryExist fullPath + isFile <- doesFileExist fullPath + if isDirectory + then go relativePath + else + if isFile + then + pure + ( Right + [RelativePath relativePath] + ) + else pure (Right []) + + isHidden ('.' : _) = True + isHidden _ = False + +isStrictlyInside :: FilePath -> FilePath -> Bool +isStrictlyInside parent child = + let relative = + normalise + (relativePathFrom (normalise parent) (normalise child)) + in relative /= "." + && relative /= "" + && case splitDirectories relative of + (".." : _) -> False + _ -> True + +readUtf8File :: FilePath -> IO (Either Text Text) +readUtf8File path = do + readResult <- + try (ByteString.readFile path) :: + IO (Either IOException ByteString.ByteString) + pure $ + case readResult of + Left exception -> Left (renderFileError path exception) + Right bytes -> + case TextEncoding.decodeUtf8' bytes of + Left exception -> + Left (renderFileError path exception) + Right content -> Right content + +writeUtf8File :: FilePath -> Text -> IO (Either Text ()) +writeUtf8File path content = do + let directory = takeDirectory path + created <- + try (createDirectoryIfMissing True directory) :: + IO (Either IOException ()) + case created of + Left exception -> + pure (Left (renderFileError directory exception)) + Right () -> do + written <- + try + ( ByteString.writeFile + path + (TextEncoding.encodeUtf8 content) + ) :: + IO (Either IOException ()) + pure (either (Left . renderFileError path) Right written) + +copyAsset :: FilePath -> FilePath -> IO (Either Text ()) +copyAsset source destination = do + let directory = takeDirectory destination + created <- + try (createDirectoryIfMissing True directory) :: + IO (Either IOException ()) + case created of + Left exception -> + pure (Left (renderFileError directory exception)) + Right () -> do + copied <- + try (copyFile source destination) :: + IO (Either IOException ()) + pure (either (Left . renderFileError destination) Right copied) + +renderFileError :: (Exception exception) => FilePath -> exception -> Text +renderFileError path exception = + Text.pack path <> ": " <> Text.pack (displayException exception) + +failWith :: Text -> IO value +failWith message = do + TextIO.hPutStrLn stderr message + exitFailure diff --git a/docs/architecture.md b/docs/architecture.md new file mode 100644 --- /dev/null +++ b/docs/architecture.md @@ -0,0 +1,50 @@ +# Architecture + +The project is split into a pure library and a thin executable. All effects live in `app/Main.hs`; the library only transforms immutable values. + +## Modules + +| Module | Responsibility | +| --- | --- | +| `ZimToMarkdown.Domain` | Core types: directions, documents, and relative paths. | +| `ZimToMarkdown.Zim` | Pure Zim to Markdown block and inline conversion. | +| `ZimToMarkdown.Markdown` | Pure Markdown to Zim block and inline conversion. | +| `ZimToMarkdown.Converter` | Direction specific entry points used by the executable. | +| `ZimToMarkdown.Links` | Pure resolution of internal Zim links using notebook context. | +| `ZimToMarkdown.Inline` | Shared inline scanning helpers. | +| `ZimToMarkdown.Table` | Shared pipe table detection and normalization. | +| `ZimToMarkdown.Notebook` | Pure classification of notebook files and destination paths. | +| `ZimToMarkdown.Paths` | Pure relative path calculation. | +| `ZimToMarkdown.Options` | Pure command line parsing and user facing messages. | +| `ZimToMarkdown.Version` | Application version sourced from the Cabal package metadata. | +| `Main` | Effect boundary: filesystem discovery, reading, writing, and exit codes. | + +## Data flow + +```text +argv -> parseOptions -> ConversionRequest + | + v +discoverFiles -> classifyNotebookItems -> pages and assets + | + v +file bytes -> decodeUtf8' -> ZimPage or MarkdownDocument + | + v +convertZimPage or convertMarkdownDocument + | + v +encodeUtf8 -> stdout or output file +``` + +## Purity boundary + +Parsing, conversion, link resolution, path calculation, table normalization, and notebook classification are pure functions. Reading, writing, directory discovery, asset copying, and exiting are confined to `Main`, which turns failures into `Text` messages and a non-zero exit code instead of throwing exceptions. + +## Notebook behavior + +For a notebook, the executable discovers every file and classifies it as a page or an asset. The input can be the notebook directory or its `notebook.zim` file; the definition file itself is never copied. Pages are converted to the target extension and assets are copied unchanged. Internal links are resolved against the set of discovered pages, so links keep pointing to the converted pages. Hidden files, symbolic links, and empty directories are skipped. + +## Evolution + +New markup rules belong in `ZimToMarkdown.Zim` or `ZimToMarkdown.Markdown`. Shared syntax helpers belong in `ZimToMarkdown.Inline` and `ZimToMarkdown.Table`. Path and link behavior must remain pure and free of filesystem access. diff --git a/docs/cli.md b/docs/cli.md new file mode 100644 --- /dev/null +++ b/docs/cli.md @@ -0,0 +1,50 @@ +# Command line interface + +## Usage + +```text +zim-to-markdown [--direction DIRECTION] [--output PATH] INPUT +zim-to-markdown --help +zim-to-markdown --version +``` + +## Options + +| Option | Meaning | +| --- | --- | +| `-d DIRECTION`, `--direction DIRECTION` | `zim-to-markdown` (default) or `markdown-to-zim`. | +| `-o PATH`, `--output PATH` | Output file for a single page; output directory for a notebook. | +| `-h`, `--help` | Show usage information. | +| `-V`, `--version` | Show the application version. | + +## Single pages + +When `INPUT` is a file, the result goes to standard output unless `--output` is given. In that case `PATH` must be a file path. + +```sh +cabal run zim-to-markdown -- page.txt +cabal run zim-to-markdown -- page.txt --output page.md +cabal run zim-to-markdown -- --direction markdown-to-zim page.md --output page.txt +``` + +## Notebooks + +When `INPUT` is a directory, it is treated as a notebook. A file named `notebook.zim` is also accepted; its parent directory becomes the notebook root. In both cases `--output` is required and the whole tree is converted recursively: + +- Page files are converted to the target extension (`.txt` to `.md`, or `.md` and `.markdown` to `.txt`). +- Other files are copied unchanged, preserving their relative paths. +- The root `notebook.zim` file is treated as metadata and is not copied. +- Internal links are resolved using every page found in the notebook. +- Hidden files and symbolic links are skipped. +- Empty directories are not recreated. +- The output directory must not be inside the input directory. + +```sh +cabal run zim-to-markdown -- my-notebook --output my-notebook-markdown +cabal run zim-to-markdown -- my-notebook/notebook.zim --output my-notebook-markdown +cabal run zim-to-markdown -- --direction markdown-to-zim notes --output notes-zim +``` + +## Exit status + +The process exits with `0` on success and with a non-zero status when the arguments are invalid or when an input or output operation fails. diff --git a/docs/conversion.md b/docs/conversion.md new file mode 100644 --- /dev/null +++ b/docs/conversion.md @@ -0,0 +1,85 @@ +# Conversion rules + +The conversion is line based for blocks and scanner based for inline markup. Rules that are not recognized are preserved as plain text. + +## Zim to Markdown + +| Zim | Markdown | +| --- | --- | +| `=` heading syntax, levels 1 to 5 | Normalized Markdown heading, from `#` to `###` | +| `**bold**` | `**bold**` | +| `//italic//` | `*italic*` | +| `__underline__` | `underline` | +| `''verbatim''` | `` `verbatim` `` | +| `~~strike~~` | `~~strike~~` | +| `_{subscript}` | `subscript` | +| `^{superscript}` | `superscript` | +| `bold` or `bold` | `**bold**` | +| `italic` or `italic` | `*italic*` | +| `{{id: name}}` | `` | +| `* item` | `* item` | +| `1. item` or `a. item` | `1. item` | +| `[ ] task` | `- [ ] task` | +| `[*] task`, `[x] task`, `[>] task`, or `[<] task` | `- [x] task` | +| `[[page]]` | `[page](page.md)` | +| `[[page\|label]]` | `[label](page.md)` | +| `[[Sistema:cron]]` | `[Sistema:cron](Sistema/cron.md)` | +| `[[user@host.example\|user@host]]` | plain text | +| `[[:page]]` | link to the notebook root | +| `[[+page]]` | link to a child of the current page | +| `[[https://example.com\|label]]` | `[label](https://example.com)` | +| `{{image.png}}` | `![image](image.png)` | +| `{{image.png\|alt text}}` | `![alt text](image.png)` | +| `'''` block delimiters | fenced code block | +| `-----` on its own line | `---` | +| Tab-indented block | `> blockquote` | +| `\| cell \| cell \|` pipe table | pipe table with an alignment row | + +Leading Zim metadata header lines (`Content-Type`, `Wiki-Format`, `Creation-Date`, `Modification-Date`) are removed. Heading levels are normalized per page: distinct Zim levels are compressed into consecutive Markdown levels starting at `#` and capped at `###`. A pipe table without an alignment row receives a default alignment row. + +Colons in internal link targets are translated to path separators, so `[[Sistema:cron]]` points to `Sistema/cron.md`. Targets that look like `user@host` are rendered as plain text instead of page links. + +## Markdown to Zim + +| Markdown | Zim | +| --- | --- | +| `# Heading` through `##### Heading` | six through two `=` characters | +| `###### Heading` | clamped to Zim heading level five (two `=` characters) | +| Setext heading with `=` | Zim heading level one | +| Setext heading with `-` | Zim heading level two | +| `**bold**` or `__bold__` | `**bold**` | +| `*italic*` or `_italic_` | `//italic//` | +| `~~strike~~` | `~~strike~~` | +| `` `code` `` | `''code''` | +| `underline` or `marked` | `__underlined__` | +| `subscript` | `_{subscript}` | +| `superscript` | `^{superscript}` | +| `bold` or `bold` | `**bold**` | +| `italic` or `italic` | `//italic//` | +| `` | `{{id: name}}` | +| `` | `[[https://example.com]]` | +| `- item`, `* item`, or `+ item` | `* item` | +| `1. item` or `1) item` | `1. item` | +| `- [ ] task` | `[ ] task` | +| `- [x] task` | `[*] task` | +| `[label](page.md)` | `[[page\|label]]` | +| `[page](page.md)` | `[[page]]` | +| `![alt](image.png)` | `{{image.png\|alt}}` | +| fenced code block | `'''` block delimiters | +| `---`, `***`, or `___` on its own line | `-----` | +| `> quote` | tab-indented block | +| Pipe table with an alignment row | pipe table | + +Internal Markdown link targets lose their page extension. Leading `./` and `../` segments are removed so Zim can resolve the link with its own upward search. Absolute Markdown links become root links such as `[[:page]]`. Inline markup inside link labels is converted recursively. + +## Known limitations + +- Reference links, footnotes, nested links, raw HTML blocks, and Markdown indented code blocks are not converted. +- Tables nested inside blockquotes or list items are not detected, and a Markdown table without body rows may not be recognized by Zim. +- Zim table objects stored in `{{{table: ...}}}` blocks are not read. +- Multiline list items are not joined. +- Code fence language hints are discarded. +- Markdown indentation is converted assuming two spaces per list level. +- A single page has no notebook index, so internal links can only resolve to a same-level target. +- Notebook metadata files and hidden files are not copied, and reverse conversion does not create a `notebook.zim` file. +- Existing destination files are overwritten without an additional prompt. diff --git a/docs/domain.md b/docs/domain.md new file mode 100644 --- /dev/null +++ b/docs/domain.md @@ -0,0 +1,35 @@ +# Domain model + +## Directions + +A `ConversionDirection` is either `ZimToMarkdown` or `MarkdownToZim`. The constructor determines which parser reads the input and which extension is used for output pages. + +## Documents + +A `ZimPage` is the immutable text of one page read from a Zim wiki notebook. It still contains Zim markup and has not been interpreted. A `MarkdownDocument` is the immutable text produced by a successful conversion to Markdown. + +## Notebook paths + +A `RelativePath` is a path relative to the root of a notebook. It identifies a page or asset independently of the notebook location on disk. `RelativePath` derives `Ord` so it can be stored in a `Set` for link resolution. + +## Notebook definitions + +The notebook root is the directory that contains `notebook.zim`. When that file is passed as input, `Main` uses its parent directory as the root. The definition file is metadata and is neither converted nor copied. + +## Link context + +`LinkContext` records the current page and every known page in the notebook. It allows the converter to resolve Zim link semantics: + +- `[[page]]` searches the current namespace and then its parents. +- `[[:page]]` targets the notebook root. +- `[[+page]]` targets a child of the current page. + +The resolved target is rendered relative to the current page and with the output extension, so the generated Markdown links remain valid. The label renderer passed to `renderZimLink` makes inline markup inside link labels recursive. + +## Notebook items + +A discovered file is classified as either a `PageItem` or an `AssetItem`. Pages are converted. Assets are copied verbatim to preserve images and attachments referenced by the pages. + +## Requests and errors + +A `ConversionRequest` records the input path, the optional output path, and the direction. Command line failures are modeled by `OptionsError`. Input and output failures are reported by `Main` as `Text` messages because they describe effects at the boundary. diff --git a/docs/releasing.md b/docs/releasing.md new file mode 100644 --- /dev/null +++ b/docs/releasing.md @@ -0,0 +1,119 @@ +# Releasing + +This guide follows the global release skill. It covers Hackage publication and the GitHub release with prebuilt binaries. + +## Version source + +The version is defined only in the `version:` field of `zim-to-markdown.cabal`. Cabal generates `Paths_zim_to_markdown`, and `ZimToMarkdown.Version` exposes it to the executable and tests. Update `CHANGELOG.md` before releasing. + +The tag convention in use is an annotated tag named `v`, for example `v0.3.0.1`. + +## Pre-flight checks + +Work from a clean tree and make sure local commits are pushed before tagging. Run: + +```sh +cabal check +cabal build all +cabal test all +cabal haddock --haddock-for-hackage +cabal sdist +fourmolu --mode check src app test +hlint src app test +gitleaks git --redact --log-opts="--all" +``` + +Check that `dist-newstyle/sdist/` and `dist-newstyle/` contain the expected source and documentation tarballs. + +## Candidate + +Upload a candidate and inspect it before publishing: + +```sh +cabal upload dist-newstyle/sdist/zim-to-markdown-*.tar.gz +``` + +Wait for explicit authorization before publishing. The candidate URL is printed by Cabal. + +## Checksums + +Generate and verify checksums for the exact candidate artifacts. Use a staging directory so the `SHA256SUMS` file contains asset basenames, not repository paths: + +```sh +mkdir -p dist-newstyle/checksums +cp dist-newstyle/sdist/zim-to-markdown-*.tar.gz dist-newstyle/zim-to-markdown-*-docs.tar.gz dist-newstyle/checksums/ +cd dist-newstyle/checksums +sha256sum * > SHA256SUMS +sha256sum -c SHA256SUMS +``` + +The source tarball hash must match the registry tarball and any attached source archive. + +## Publish on Hackage + +After the candidate is approved: + +```sh +cabal upload --publish dist-newstyle/sdist/zim-to-markdown-*.tar.gz +cabal upload --publish --documentation dist-newstyle/zim-to-markdown-*-docs.tar.gz +``` + +## Tag and GitHub release + +Create, verify, and push the signed tag, then create the GitHub release: + +```sh +git tag -s v -m "zim-to-markdown " +git tag -v v +git push origin main +git push origin v +gh release create v --verify-tag --generate-notes +``` + +Do not rewrite or force-push an existing release tag. The existing `v0.3.0.1` tag predates the signing configuration and remains unsigned; sign the next tag. + +### Tag signing + +The repository uses SSH signing in the current setup. Configure it with: + +```sh +git config gpg.format ssh +git config user.signingkey +git config gpg.ssh.allowedSignersFile +git config tag.gpgSign true +``` + +Add the same public key to GitHub as a signing key and add the signer e-mail to the allowed signers file. For OpenPGP, use the long key ID as `user.signingkey` instead. + +## Verification + +Install the published package in a clean environment and run the main command: + +```sh +cabal install zim-to-markdown +zim-to-markdown --version +``` + +For the library, build a temporary consumer project pinned to the published version. + +## Prebuilt binaries + +Run the `Release binaries` workflow manually with the release tag and `publish` enabled: + +```sh +gh workflow run release-binaries.yml -f release_tag=v -f publish=true +``` + +The workflow builds Linux x86_64, macOS ARM64, and Windows x86_64 archives, attaches them to the release, adds provenance attestations, and publishes a `SHA256SUMS` file. A run with `publish=false` only builds and tests the artifacts. + +## CI + +Push `main` before tagging so the CI matrix runs on Linux, macOS, and Windows, including GHC 9.6.7, GHC 9.14.1, HLint, Fourmolu, and Gitleaks. + +## Environment and secrets + +The `release` environment exists and is used by the `Release binaries` workflow. If a registry upload is added to a workflow, store its token as an environment secret and map it to the environment variable read by the upload command. Do not use Actions variables for tokens. Hackage publication is currently performed locally with `HACKAGE_TOKEN` in the environment. + +## Rules + +Never publish, rewrite history, force-push, or create a repository without explicit authorization. If a check is blocked, stop and report the exact action needed. diff --git a/docs/versioning.md b/docs/versioning.md new file mode 100644 --- /dev/null +++ b/docs/versioning.md @@ -0,0 +1,18 @@ +# Versioning + +The project follows the Package Version Policy with four components: `major.minor.patch.revision`. The current version is `0.3.0.2`. + +## Source of truth + +The version is defined only in the `version:` field of `zim-to-markdown.cabal`. Cabal generates `Paths_zim_to_markdown`, and `ZimToMarkdown.Version` exposes that value to the executable and the test suite. There is no separate version constant to keep in sync. + +## Bump rules + +| Change | Bump | +| --- | --- | +| Fixes and minor refinements | Patch | +| New user facing features or screens | Minor | +| Data model breaking changes | Major component 2 | +| Major release milestones | Major component 1 | + +Every commit message starts with the application version and mentions the version bump in its summary. diff --git a/src/ZimToMarkdown/Converter.hs b/src/ZimToMarkdown/Converter.hs new file mode 100644 --- /dev/null +++ b/src/ZimToMarkdown/Converter.hs @@ -0,0 +1,18 @@ +-- | Direction-specific conversion entry points. +module ZimToMarkdown.Converter ( + convertMarkdownDocument, + convertZimPage, +) where + +import ZimToMarkdown.Domain (MarkdownDocument, ZimPage) +import ZimToMarkdown.Links (LinkContext) +import ZimToMarkdown.Markdown (convertMarkdownToZim) +import ZimToMarkdown.Zim (convertZimToMarkdown) + +-- | Converts a Zim page into a Markdown document. +convertZimPage :: LinkContext -> ZimPage -> MarkdownDocument +convertZimPage = convertZimToMarkdown + +-- | Converts a Markdown document into a Zim page. +convertMarkdownDocument :: MarkdownDocument -> ZimPage +convertMarkdownDocument = convertMarkdownToZim diff --git a/src/ZimToMarkdown/Domain.hs b/src/ZimToMarkdown/Domain.hs new file mode 100644 --- /dev/null +++ b/src/ZimToMarkdown/Domain.hs @@ -0,0 +1,34 @@ +-- | Core immutable types used by the converter. +module ZimToMarkdown.Domain ( + ConversionDirection (..), + MarkdownDocument (..), + RelativePath (..), + ZimPage (..), +) where + +import Data.Text (Text) +import System.FilePath (FilePath) + +-- | The direction in which a document is converted. +data ConversionDirection + = ZimToMarkdown + | MarkdownToZim + deriving (Eq, Show) + +-- | A page read from a Zim wiki notebook, still containing Zim markup. +newtype ZimPage = ZimPage + { unZimPage :: Text + } + deriving (Eq, Show) + +-- | A document rendered as Markdown. +newtype MarkdownDocument = MarkdownDocument + { unMarkdownDocument :: Text + } + deriving (Eq, Show) + +-- | A path relative to the root of a notebook. +newtype RelativePath = RelativePath + { unRelativePath :: FilePath + } + deriving (Eq, Ord, Show) diff --git a/src/ZimToMarkdown/Inline.hs b/src/ZimToMarkdown/Inline.hs new file mode 100644 --- /dev/null +++ b/src/ZimToMarkdown/Inline.hs @@ -0,0 +1,85 @@ +-- | Shared scanning helpers for inline markup. +module ZimToMarkdown.Inline ( + breakOnFirstMarker, + enclosed, + italicBoundary, + renderInlineCode, + renderMarkdownPath, +) where + +import Data.Char (isSpace) +import Data.List (minimumBy) +import Data.Ord (comparing) +import Data.Text (Text) +import Data.Text qualified as Text + +{- | Finds the earliest occurrence of any marker and returns the text before it +together with the remaining text, which starts with the marker. +-} +breakOnFirstMarker :: [Text] -> Text -> (Text, Maybe Text) +breakOnFirstMarker markers text = + case [ (Text.length prefix, suffix) + | marker <- markers + , let (prefix, suffix) = Text.breakOn marker text + , not (Text.null suffix) + ] of + [] -> (text, Nothing) + matches -> + let (index, suffix) = minimumBy (comparing fst) matches + in (Text.take index text, Just suffix) + +{- | Splits text that starts with an opening delimiter and contains a closing +delimiter, returning the rendered content and the remaining text. +-} +enclosed :: Text -> Text -> (Text -> Text) -> Text -> Maybe (Text, Text) +enclosed opener closer render text = do + rest <- Text.stripPrefix opener text + let (inner, closing) = Text.breakOn closer rest + if Text.null inner || Text.null closing + then Nothing + else + Just + ( render inner + , Text.drop (Text.length closer) closing + ) + +{- | Tests whether an opening delimiter can start inline emphasis. This keeps +constructs such as URLs and identifiers with underscores intact. +-} +italicBoundary :: Text -> Bool +italicBoundary preceding = + case Text.unsnoc preceding of + Nothing -> True + Just (_, character) -> + isSpace character || character `elem` ("([{<'\"-" :: String) + +-- | Renders inline code with a backtick fence long enough to hold its content. +renderInlineCode :: Text -> Text +renderInlineCode content = + let fence = Text.replicate (longestBacktickRun content + 1) "`" + padded + | Text.isPrefixOf "`" content || Text.isSuffixOf "`" content = + " " <> content <> " " + | otherwise = content + in fence <> padded <> fence + +{- | Renders a link target, wrapping it in angle brackets when it contains +characters that would break a Markdown destination. +-} +renderMarkdownPath :: Text -> Text +renderMarkdownPath path + | Text.null path = path + | Text.any needsBrackets path = "<" <> path <> ">" + | otherwise = path + where + needsBrackets character = + character == ' ' || character == '(' || character == ')' + +longestBacktickRun :: Text -> Int +longestBacktickRun = snd . Text.foldl' step (0, 0) + where + step (current, longest) character + | character == '`' = + let next = current + 1 + in (next, max longest next) + | otherwise = (0, longest) diff --git a/src/ZimToMarkdown/Links.hs b/src/ZimToMarkdown/Links.hs new file mode 100644 --- /dev/null +++ b/src/ZimToMarkdown/Links.hs @@ -0,0 +1,202 @@ +-- | Resolution of Zim links against notebook context. +module ZimToMarkdown.Links ( + LinkContext (..), + isExternalTarget, + renderZimLink, +) where + +import Data.Char (toLower) +import Data.List (find) +import Data.Maybe (fromMaybe) +import Data.Set qualified as Set +import Data.Text (Text) +import Data.Text qualified as Text +import System.FilePath ( + addExtension, + dropExtension, + normalise, + takeDirectory, + takeExtension, + (), + ) + +import ZimToMarkdown.Domain (RelativePath (..)) +import ZimToMarkdown.Inline (renderMarkdownPath) +import ZimToMarkdown.Paths (relativePathFrom, toPosixPath) + +-- | The notebook context needed to resolve internal Zim links. +data LinkContext = LinkContext + { linkCurrentPage :: RelativePath + , linkKnownPages :: Set.Set RelativePath + } + deriving (Eq, Show) + +{- | Converts the inner text of a Zim link into a Markdown link. The label +renderer converts inline markup inside an explicit link label. +-} +renderZimLink :: LinkContext -> (Text -> Text) -> Text -> Text +renderZimLink context renderLabel rawInner = + let inner = Text.strip rawInner + in if Text.null inner + then "" + else + let (target, label) = splitLink inner + in if Text.null target + then escapeLabel (maybe "" renderLabel label) + else + if isExternalTarget target + then renderExternal renderLabel target label + else + if isPseudoLink target + then renderPlain target label + else renderInternal context renderLabel target label + +-- | Tests whether a link target points outside the notebook. +isExternalTarget :: Text -> Bool +isExternalTarget target = + any + (`Text.isPrefixOf` target) + ["http://", "https://", "ftp://", "ftps://", "mailto:", "file:"] + || "://" `Text.isInfixOf` target + +{- | Tests whether a target looks like a user or host identifier rather than +a notebook page, such as an SSH destination. +-} +isPseudoLink :: Text -> Bool +isPseudoLink target = + "@" `Text.isInfixOf` target + && not ("/" `Text.isInfixOf` target) + && not ("\\" `Text.isInfixOf` target) + && not (" " `Text.isInfixOf` target) + +renderPlain :: Text -> Maybe Text -> Text +renderPlain target = maybe target stripInlineVerbatim + +stripInlineVerbatim :: Text -> Text +stripInlineVerbatim text = + let trimmed = Text.strip text + in fromMaybe + trimmed + ( Text.stripPrefix "''" trimmed + >>= Text.stripSuffix "''" + ) + +splitLink :: Text -> (Text, Maybe Text) +splitLink inner = + let (target, labelWithPipe) = Text.breakOn "|" inner + in ( Text.strip target + , if Text.null labelWithPipe + then Nothing + else Just (Text.strip (Text.drop 1 labelWithPipe)) + ) + +renderExternal :: (Text -> Text) -> Text -> Maybe Text -> Text +renderExternal renderLabel target label = + "[" + <> escapeLabel (maybe target renderLabel label) + <> "](" + <> renderMarkdownPath target + <> ")" + +renderInternal :: LinkContext -> (Text -> Text) -> Text -> Maybe Text -> Text +renderInternal context renderLabel target label = + let (pathPart, anchor) = Text.breakOn "#" target + cleanTarget = Text.strip pathPart + display = + case label of + Just value -> renderLabel value + Nothing -> stripLinkPrefix target + in if Text.null cleanTarget + then escapeLabel display + else + let resolved = resolveTarget context (Text.unpack cleanTarget) + withAnchor = resolved <> Text.unpack anchor + in "[" + <> escapeLabel display + <> "](" + <> renderMarkdownPath (Text.pack withAnchor) + <> ")" + +stripLinkPrefix :: Text -> Text +stripLinkPrefix text = + let cleaned = + Text.dropWhile + (\character -> character == ':' || character == '+') + (Text.strip text) + in if Text.null cleaned then Text.strip text else cleaned + +escapeLabel :: Text -> Text +escapeLabel = Text.replace "]" "\\]" + +resolveTarget :: LinkContext -> FilePath -> FilePath +resolveTarget context rawTarget = + let currentPage = unRelativePath (linkCurrentPage context) + currentDirectory = takeDirectory currentPage + target = stripSourceExtension (normalise rawTarget) + (candidates, fallback) = + targetCandidates currentPage currentDirectory target + chosen = + fromMaybe + fallback + (find (isKnownPage context) candidates) + markdownPath = addExtension chosen "md" + relativePath = + normalise + (relativePathFrom currentDirectory markdownPath) + in toPosixPath relativePath + +targetCandidates :: FilePath -> FilePath -> FilePath -> ([FilePath], FilePath) +targetCandidates currentPage currentDirectory target = + case target of + ':' : rest -> + let rooted = + normalise + (dropLeadingSeparators (namespacePath rest)) + in ([rooted], rooted) + '+' : rest -> + let child = + normalise + (dropExtension currentPage namespacePath rest) + in ([child], child) + _ -> + let normalizedTarget = namespacePath target + parents = parentDirectories currentDirectory + candidates = + [ normalise (directory normalizedTarget) + | directory <- parents + ] + <> [normalise normalizedTarget] + fallback = + if currentDirectory == "." + then normalise normalizedTarget + else + normalise + (currentDirectory normalizedTarget) + in (candidates, fallback) + +namespacePath :: FilePath -> FilePath +namespacePath = + map (\character -> if character == ':' then '/' else character) + +parentDirectories :: FilePath -> [FilePath] +parentDirectories directory + | directory == "." + || directory == "/" + || null directory = + [] + | otherwise = directory : parentDirectories (takeDirectory directory) + +dropLeadingSeparators :: FilePath -> FilePath +dropLeadingSeparators = dropWhile (== '/') + +stripSourceExtension :: FilePath -> FilePath +stripSourceExtension path = + if map toLower (takeExtension path) == ".txt" + then dropExtension path + else path + +isKnownPage :: LinkContext -> FilePath -> Bool +isKnownPage context candidate = + Set.member + (RelativePath (normalise (addExtension candidate "txt"))) + (linkKnownPages context) diff --git a/src/ZimToMarkdown/Markdown.hs b/src/ZimToMarkdown/Markdown.hs new file mode 100644 --- /dev/null +++ b/src/ZimToMarkdown/Markdown.hs @@ -0,0 +1,473 @@ +-- | Conversion from Markdown to Zim wiki markup. +module ZimToMarkdown.Markdown ( + convertMarkdownToZim, +) where + +import Control.Applicative ((<|>)) +import Data.Char (isDigit) +import Data.Maybe (isNothing) +import Data.Text (Text) +import Data.Text qualified as Text +import System.FilePath ( + dropExtension, + isAbsolute, + joinPath, + normalise, + splitDirectories, + takeExtension, + ) + +import ZimToMarkdown.Domain (MarkdownDocument (..), ZimPage (..)) +import ZimToMarkdown.Inline ( + breakOnFirstMarker, + enclosed, + italicBoundary, + ) +import ZimToMarkdown.Links (isExternalTarget) +import ZimToMarkdown.Table ( + isTableStart, + normalizeTable, + takeTableBlock, + ) + +-- | Converts a Markdown document into a Zim page. +convertMarkdownToZim :: MarkdownDocument -> ZimPage +convertMarkdownToZim (MarkdownDocument content) = + ZimPage + ( Text.intercalate + "\n" + (renderBlocks (Text.splitOn "\n" (normalizeNewlines content))) + ) + +normalizeNewlines :: Text -> Text +normalizeNewlines = + Text.replace "\r" "\n" . Text.replace "\r\n" "\n" + +data Fence = Fence + { fenceCharacter :: Char + , fenceLength :: Int + } + +renderBlocks :: [Text] -> [Text] +renderBlocks = go Nothing + where + go _ [] = [] + go (Just fence) (line : rest) + | isClosingFence fence line = + "'''" : go Nothing rest + | otherwise = + line : go (Just fence) rest + go Nothing (line : underline : rest) + | Just level <- setextLevel underline + , isParagraphLine line = + let zimLevel = min level 5 + marker = Text.replicate (7 - zimLevel) "=" + in ( marker + <> " " + <> convertInline (Text.strip line) + <> " " + <> marker + ) + : go Nothing rest + go Nothing (line : rest) + | Just fence <- openingFence line = + "'''" : go (Just fence) rest + | isTableStart line = + let (block, remaining) = takeTableBlock (line : rest) + in normalizeTable block <> go Nothing remaining + | otherwise = + renderLine line : go Nothing rest + +setextLevel :: Text -> Maybe Int +setextLevel line = + let trimmed = Text.strip line + in if not (Text.null trimmed) && Text.all (== '=') trimmed + then Just 1 + else + if not (Text.null trimmed) && Text.all (== '-') trimmed + then Just 2 + else Nothing + +isParagraphLine :: Text -> Bool +isParagraphLine line = + not (Text.null (Text.strip line)) + && isNothing (parseHeading line) + && isNothing (parseListLine line) + && isNothing (parseBlockquote line) + && isNothing (openingFence line) + && not (isTableStart line) + && not (isThematicBreak line) + +openingFence :: Text -> Maybe Fence +openingFence line = + let stripped = Text.stripStart line + in case Text.uncons stripped of + Just (character, rest) + | character == '`' || character == '~' -> + let count = + 1 + Text.length (Text.takeWhile (== character) rest) + in if count >= 3 + then Just (Fence character count) + else Nothing + _ -> Nothing + +isClosingFence :: Fence -> Text -> Bool +isClosingFence fence line = + let trimmed = Text.strip line + run = + Text.length + (Text.takeWhile (== fenceCharacter fence) trimmed) + in run >= fenceLength fence + && Text.length trimmed == run + +renderLine :: Text -> Text +renderLine line + | isThematicBreak line = "-----" + | Just (depth, content) <- parseBlockquote line = + Text.replicate depth "\t" <> renderLine content + | Just (level, content) <- parseHeading line = + let zimLevel = min level 5 + marker = Text.replicate (7 - zimLevel) "=" + in marker <> " " <> convertInline content <> " " <> marker + | Just listLine <- parseListLine line = + renderListLine listLine + | otherwise = convertInline line + +isThematicBreak :: Text -> Bool +isThematicBreak line = + case Text.uncons stripped of + Nothing -> False + Just (marker, rest) -> + Text.length stripped >= 3 + && Text.all (== marker) rest + && marker `elem` ['-', '*', '_'] + where + stripped = Text.filter (/= ' ') (Text.strip line) + +parseBlockquote :: Text -> Maybe (Int, Text) +parseBlockquote line = + let (depth, content) = countQuotes 0 (Text.stripStart line) + in if depth == 0 + then Nothing + else Just (depth, content) + where + countQuotes depth text = + case Text.stripPrefix ">" text of + Nothing -> (depth, text) + Just after -> + let rest = Text.dropWhile (== ' ') after + in countQuotes (depth + 1) rest + +parseHeading :: Text -> Maybe (Int, Text) +parseHeading line = + let stripped = Text.stripStart line + hashes = Text.takeWhile (== '#') stripped + level = Text.length hashes + after = Text.drop level stripped + in if level >= 1 + && level <= 6 + && (Text.null after || Text.isPrefixOf " " after) + then + let content = stripClosingHashes (Text.strip after) + in if Text.null content + then Nothing + else Just (level, content) + else Nothing + +stripClosingHashes :: Text -> Text +stripClosingHashes text = + let trimmed = Text.stripEnd text + hashes = Text.takeWhileEnd (== '#') trimmed + body = Text.dropEnd (Text.length hashes) trimmed + in if Text.null hashes || Text.null (Text.stripEnd body) + then trimmed + else Text.stripEnd body + +data MarkdownListMarker + = Bullet + | Task Bool + | Numbered + deriving (Eq) + +data MarkdownListLine = MarkdownListLine + { markdownListIndent :: Text + , markdownListMarker :: MarkdownListMarker + , markdownListContent :: Text + } + +parseListLine :: Text -> Maybe MarkdownListLine +parseListLine line = + let (indent, rest) = Text.span isIndent line + in case parseMarker rest of + Nothing -> Nothing + Just (marker, content) -> + Just + MarkdownListLine + { markdownListIndent = indent + , markdownListMarker = marker + , markdownListContent = content + } + where + isIndent character = character == ' ' || character == '\t' + +parseMarker :: Text -> Maybe (MarkdownListMarker, Text) +parseMarker text + | Just rest <- Text.stripPrefix "- [ ] " text = Just (Task False, rest) + | Just rest <- Text.stripPrefix "* [ ] " text = Just (Task False, rest) + | Just rest <- Text.stripPrefix "+ [ ] " text = Just (Task False, rest) + | Just rest <- taskChecked "-" text = Just (Task True, rest) + | Just rest <- taskChecked "*" text = Just (Task True, rest) + | Just rest <- taskChecked "+" text = Just (Task True, rest) + | Just rest <- Text.stripPrefix "- " text = Just (Bullet, rest) + | Just rest <- Text.stripPrefix "* " text = Just (Bullet, rest) + | Just rest <- Text.stripPrefix "+ " text = Just (Bullet, rest) + | otherwise = parseNumbered text + +taskChecked :: Text -> Text -> Maybe Text +taskChecked bullet text = + let afterBullet = Text.stripPrefix bullet text + in case afterBullet of + Just rest -> + Text.stripPrefix " [x] " rest <|> Text.stripPrefix " [X] " rest + Nothing -> Nothing + +parseNumbered :: Text -> Maybe (MarkdownListMarker, Text) +parseNumbered text = + let (digits, afterDigits) = Text.span isDigit text + in if Text.null digits + then Nothing + else case Text.stripPrefix ". " afterDigits + <|> Text.stripPrefix ") " afterDigits of + Just rest -> Just (Numbered, rest) + Nothing -> Nothing + +renderListLine :: MarkdownListLine -> Text +renderListLine listLine = + indentToTabs (markdownListIndent listLine) + <> prefix + <> convertInline (markdownListContent listLine) + where + prefix = + case markdownListMarker listLine of + Bullet -> "* " + Task False -> "[ ] " + Task True -> "[*] " + Numbered -> "1. " + +indentToTabs :: Text -> Text +indentToTabs indent = + let (spaces, rest) = Text.span (== ' ') indent + tabs = Text.replicate (Text.length spaces `div` 2) "\t" + leftover = Text.replicate (Text.length spaces `mod` 2) " " + in tabs <> leftover <> rest + +inlineMarkers :: [Text] +inlineMarkers = + [ "![" + , "[" + , "" + , "" + , "" + , "" + , "" + , "" + , "" + , "" + , "<" + , "**" + , "__" + , "~~" + , "`" + , "*" + , "_" + ] + +convertInline :: Text -> Text +convertInline = go + where + go text = + let (plain, marker) = breakOnFirstMarker inlineMarkers text + in plain + <> case marker of + Nothing -> "" + Just suffix -> convertMarker plain suffix + + convertMarker preceding text + | Just result <- convertImage text = keep result + | Just result <- convertLink text = keep result + | Just result <- convertAnchor text = keep result + | Just result <- + enclosed "" "" (\inner -> "**" <> go inner <> "**") text = + keep result + | Just result <- + enclosed "" "" (\inner -> "**" <> go inner <> "**") text = + keep result + | Just result <- + enclosed "" "" (\inner -> "//" <> go inner <> "//") text = + keep result + | Just result <- + enclosed "" "" (\inner -> "//" <> go inner <> "//") text = + keep result + | Just result <- + enclosed "" "" (\inner -> "__" <> go inner <> "__") text = + keep result + | Just result <- + enclosed "" "" (\inner -> "__" <> go inner <> "__") text = + keep result + | Just result <- + enclosed "" "" (\inner -> "_{" <> go inner <> "}") text = + keep result + | Just result <- + enclosed "" "" (\inner -> "^{" <> go inner <> "}") text = + keep result + | Just result <- convertAutolink text = keep result + | Just result <- + enclosed "**" "**" (\inner -> "**" <> go inner <> "**") text = + keep result + | Just result <- + enclosed "__" "__" (\inner -> "**" <> go inner <> "**") text = + keep result + | Just result <- + enclosed "~~" "~~" (\inner -> "~~" <> go inner <> "~~") text = + keep result + | Just result <- convertCode text = keep result + | italicBoundary preceding + , Just result <- + enclosed "*" "*" (\inner -> "//" <> go inner <> "//") text = + keep result + | italicBoundary preceding + , Just result <- + enclosed "_" "_" (\inner -> "//" <> go inner <> "//") text = + keep result + | otherwise = Text.take 1 text <> go (Text.drop 1 text) + + keep (rendered, after) = rendered <> go after + +convertImage :: Text -> Maybe (Text, Text) +convertImage text = do + rest <- Text.stripPrefix "![" text + let (alt, afterAlt) = Text.breakOn "](" rest + afterOpen <- Text.stripPrefix "](" afterAlt + let (target, afterTarget) = Text.breakOn ")" afterOpen + if Text.null afterTarget + then Nothing + else + let path = Text.strip target + display = Text.strip alt + in if Text.null path + then Nothing + else + let rendered = + "{{" + <> path + <> ( if Text.null display + then "" + else "|" <> display + ) + <> "}}" + in Just (rendered, Text.drop 1 afterTarget) + +convertAnchor :: Text -> Maybe (Text, Text) +convertAnchor text = do + rest <- Text.stripPrefix "" afterName + if Text.null name + then Nothing + else Just ("{{id: " <> name <> "}}", afterClose) + +convertAutolink :: Text -> Maybe (Text, Text) +convertAutolink text = do + rest <- Text.stripPrefix "<" text + let (inner, after) = Text.breakOn ">" rest + if Text.null after + then Nothing + else + let target = Text.strip inner + in if isExternalTarget target + then Just ("[[" <> target <> "]]", Text.drop 1 after) + else Nothing + +convertLink :: Text -> Maybe (Text, Text) +convertLink text = do + rest <- Text.stripPrefix "[" text + let (label, afterLabel) = Text.breakOn "](" rest + afterOpen <- Text.stripPrefix "](" afterLabel + let (target, afterTarget) = Text.breakOn ")" afterOpen + if Text.null afterTarget + then Nothing + else + let display = convertInline (Text.strip label) + zimTarget = markdownTarget (Text.strip target) + in if Text.null zimTarget + then Nothing + else + let rendered = + if Text.null display || display == zimTarget + then "[[" <> zimTarget <> "]]" + else + "[[" + <> zimTarget + <> "|" + <> display + <> "]]" + in Just (rendered, Text.drop 1 afterTarget) + +markdownTarget :: Text -> Text +markdownTarget rawTarget = + let target = stripAngleBrackets rawTarget + (pathPart, anchor) = Text.breakOn "#" target + in convertPath (Text.strip pathPart) <> anchor + +stripAngleBrackets :: Text -> Text +stripAngleBrackets target + | Text.isPrefixOf "<" target && Text.isSuffixOf ">" target = + Text.dropEnd 1 (Text.drop 1 target) + | otherwise = target + +convertPath :: Text -> Text +convertPath path + | Text.null path = path + | isExternalTarget path = path + | extension `elem` [".md", ".markdown", ".txt"] = + Text.pack (zimPath (dropExtension (Text.unpack path))) + | otherwise = path + where + extension = + Text.toLower (Text.pack (takeExtension (Text.unpack path))) + +zimPath :: FilePath -> FilePath +zimPath path = + let parts = splitDirectories (normalise path) + cleaned = + if isAbsolute path + then dropWhile (== "/") parts + else dropWhile (\part -> part == "." || part == "..") parts + joined = joinPath cleaned + in if isAbsolute path then ':' : joined else joined + +convertCode :: Text -> Maybe (Text, Text) +convertCode text = + let (ticks, rest) = Text.span (== '`') text + count = Text.length ticks + in if count == 0 + then Nothing + else + let (inner, closing) = Text.breakOn ticks rest + in if Text.null inner || Text.null closing + then Nothing + else + Just + ( "''" <> normalizeCodeContent inner <> "''" + , Text.drop count closing + ) + +normalizeCodeContent :: Text -> Text +normalizeCodeContent content + | Text.length content >= 2 + , Text.isPrefixOf " " content + , Text.isSuffixOf " " content + , not (Text.all (== ' ') content) = + Text.dropEnd 1 (Text.drop 1 content) + | otherwise = content diff --git a/src/ZimToMarkdown/Notebook.hs b/src/ZimToMarkdown/Notebook.hs new file mode 100644 --- /dev/null +++ b/src/ZimToMarkdown/Notebook.hs @@ -0,0 +1,53 @@ +-- | Classification and destination paths for notebook files. +module ZimToMarkdown.Notebook ( + NotebookItem (..), + classifyNotebookItems, + outputRelativePath, + pageRelativePaths, + sourcePageExtensions, +) where + +import Data.Char (toLower) +import Data.Set qualified as Set +import System.FilePath (replaceExtension, takeExtension) + +import ZimToMarkdown.Domain (ConversionDirection (..), RelativePath (..)) + +-- | A file discovered inside a notebook. +data NotebookItem + = PageItem RelativePath + | AssetItem RelativePath + deriving (Eq, Show) + +-- | Splits discovered notebook files into pages and assets. +classifyNotebookItems :: ConversionDirection -> [RelativePath] -> [NotebookItem] +classifyNotebookItems direction = + map + ( \path -> + if isPagePath direction path + then PageItem path + else AssetItem path + ) + +-- | Lists the source extensions that represent pages in a direction. +sourcePageExtensions :: ConversionDirection -> [String] +sourcePageExtensions ZimToMarkdown = [".txt"] +sourcePageExtensions MarkdownToZim = [".md", ".markdown"] + +-- | Computes the destination path of a page while preserving its namespace. +outputRelativePath :: ConversionDirection -> RelativePath -> RelativePath +outputRelativePath direction (RelativePath path) = + RelativePath (replaceExtension path (outputExtension direction)) + +-- | Collects every page path so links can be resolved across the notebook. +pageRelativePaths :: [NotebookItem] -> Set.Set RelativePath +pageRelativePaths items = + Set.fromList [path | PageItem path <- items] + +isPagePath :: ConversionDirection -> RelativePath -> Bool +isPagePath direction (RelativePath path) = + map toLower (takeExtension path) `elem` sourcePageExtensions direction + +outputExtension :: ConversionDirection -> String +outputExtension ZimToMarkdown = ".md" +outputExtension MarkdownToZim = ".txt" diff --git a/src/ZimToMarkdown/Options.hs b/src/ZimToMarkdown/Options.hs new file mode 100644 --- /dev/null +++ b/src/ZimToMarkdown/Options.hs @@ -0,0 +1,158 @@ +-- | Command line parsing and usage messages. +module ZimToMarkdown.Options ( + ConversionRequest (..), + InputPath (..), + Options (..), + OptionsError (..), + OutputPath (..), + helpText, + parseOptions, + renderOptionsError, +) where + +import Data.Text (Text) +import Data.Text qualified as Text +import System.FilePath (FilePath) + +import ZimToMarkdown.Domain (ConversionDirection (..)) + +-- | Path of the Zim page or notebook to read. +newtype InputPath = InputPath + { unInputPath :: FilePath + } + deriving (Eq, Show) + +-- | Path where the Markdown document or notebook is written. +newtype OutputPath = OutputPath + { unOutputPath :: FilePath + } + deriving (Eq, Show) + +-- | A conversion requested from the command line. +data ConversionRequest = ConversionRequest + { conversionInput :: InputPath + , conversionOutput :: Maybe OutputPath + , conversionDirection :: ConversionDirection + } + deriving (Eq, Show) + +-- | A command line action. +data Options + = ShowHelp + | ShowVersion + | Convert ConversionRequest + deriving (Eq, Show) + +-- | A failure produced while interpreting the command line. +data OptionsError + = MissingInput + | UnknownOption Text + | MissingOptionValue Text + | UnexpectedArgument Text + | InvalidDirection Text + deriving (Eq, Show) + +-- | Parses command line arguments without performing any input or output. +parseOptions :: [String] -> Either OptionsError Options +parseOptions arguments + | any (`elem` ["-h", "--help"]) arguments = Right ShowHelp + | any (`elem` ["-V", "--version"]) arguments = Right ShowVersion + | otherwise = Convert <$> parseConversion arguments + +data PartialOptions = PartialOptions + { partialInput :: Maybe FilePath + , partialOutput :: Maybe FilePath + , partialDirection :: ConversionDirection + } + +emptyOptions :: PartialOptions +emptyOptions = + PartialOptions + { partialInput = Nothing + , partialOutput = Nothing + , partialDirection = ZimToMarkdown + } + +parseConversion :: [String] -> Either OptionsError ConversionRequest +parseConversion = go emptyOptions + where + go options [] = + case partialInput options of + Nothing -> Left MissingInput + Just path -> + Right + ConversionRequest + { conversionInput = InputPath path + , conversionOutput = OutputPath <$> partialOutput options + , conversionDirection = partialDirection options + } + go _ ["--output"] = Left (MissingOptionValue "--output") + go _ ["-o"] = Left (MissingOptionValue "-o") + go _ ["--direction"] = Left (MissingOptionValue "--direction") + go _ ["-d"] = Left (MissingOptionValue "-d") + go options ("--output" : value : rest) = + go options{partialOutput = Just value} rest + go options ("-o" : value : rest) = + go options{partialOutput = Just value} rest + go options ("--direction" : value : rest) = + setDirection options value rest + go options ("-d" : value : rest) = + setDirection options value rest + go options (argument : rest) + | isOption argument = Left (UnknownOption (Text.pack argument)) + | otherwise = + case partialInput options of + Nothing -> + go options{partialInput = Just argument} rest + Just _ -> Left (UnexpectedArgument (Text.pack argument)) + + setDirection options value rest = + case parseDirection value of + Nothing -> Left (InvalidDirection (Text.pack value)) + Just direction -> + go options{partialDirection = direction} rest + + isOption ('-' : _) = True + isOption _ = False + +parseDirection :: String -> Maybe ConversionDirection +parseDirection value = + case value of + "zim-to-markdown" -> Just ZimToMarkdown + "markdown-to-zim" -> Just MarkdownToZim + _ -> Nothing + +-- | Renders an option parsing failure as a user facing message. +renderOptionsError :: OptionsError -> Text +renderOptionsError optionsError = + case optionsError of + MissingInput -> "Missing input file or directory." + UnknownOption option -> "Unknown option: " <> option + MissingOptionValue option -> "Missing value for option: " <> option + UnexpectedArgument argument -> "Unexpected argument: " <> argument + InvalidDirection direction -> + "Invalid direction: " + <> direction + <> ". Use zim-to-markdown or markdown-to-zim." + +-- | Command line usage description. +helpText :: Text +helpText = + Text.unlines + [ "zim-to-markdown - converts between Zim wiki and Markdown." + , "" + , "Usage:" + , " zim-to-markdown [--direction DIRECTION] [--output PATH] INPUT" + , " zim-to-markdown --help" + , " zim-to-markdown --version" + , "" + , "Options:" + , " -d, --direction DIRECTION zim-to-markdown (default) or markdown-to-zim." + , " -o, --output PATH Output file for a page; output directory for a notebook." + , " -h, --help Show this help." + , " -V, --version Show the application version." + , "" + , "A notebook is a directory, or a path to its notebook.zim file. Its" + , "page files are converted and its other files are copied, preserving" + , "the folder structure. Hidden files and symbolic links are skipped." + ] diff --git a/src/ZimToMarkdown/Paths.hs b/src/ZimToMarkdown/Paths.hs new file mode 100644 --- /dev/null +++ b/src/ZimToMarkdown/Paths.hs @@ -0,0 +1,32 @@ +-- | Relative path calculations shared by link resolution and the executable. +module ZimToMarkdown.Paths ( + relativePathFrom, + toPosixPath, +) where + +import System.FilePath (joinPath, normalise, splitDirectories) + +{- | Computes the path of a target relative to a base directory, including +@..@ segments when the paths diverge. +-} +relativePathFrom :: FilePath -> FilePath -> FilePath +relativePathFrom from target = + let (fromRest, targetRest) = + dropCommon (pathParts from) (pathParts target) + upwards = replicate (length fromRest) ".." + in joinPath (upwards <> targetRest) + +pathParts :: FilePath -> [FilePath] +pathParts path + | path == "." || null path = [] + | otherwise = splitDirectories (normalise path) + +dropCommon :: [FilePath] -> [FilePath] -> ([FilePath], [FilePath]) +dropCommon (fromPart : fromRest) (targetPart : targetRest) + | fromPart == targetPart = dropCommon fromRest targetRest +dropCommon fromRest targetRest = (fromRest, targetRest) + +-- | Replaces Windows separators with the separators used in Markdown links. +toPosixPath :: FilePath -> FilePath +toPosixPath = + map (\character -> if character == '\\' then '/' else character) diff --git a/src/ZimToMarkdown/Table.hs b/src/ZimToMarkdown/Table.hs new file mode 100644 --- /dev/null +++ b/src/ZimToMarkdown/Table.hs @@ -0,0 +1,118 @@ +-- | Pipe table detection and normalization for both conversion directions. +module ZimToMarkdown.Table ( + isTableStart, + normalizeTable, + takeTableBlock, +) where + +import Data.Text (Text) +import Data.Text qualified as Text + +-- | Tests whether a line can start a pipe table. +isTableStart :: Text -> Bool +isTableStart = isTableRow + +-- | Splits a table into its header, optional alignment line, and body rows. +takeTableBlock :: [Text] -> ([Text], [Text]) +takeTableBlock [] = ([], []) +takeTableBlock (header : rest) + | not (isTableRow header) = ([], header : rest) + | otherwise = + let (alignment, afterAlignment) = + case rest of + (candidate : more) + | isAlignmentLine candidate -> + ([candidate], more) + _ -> ([], rest) + (body, remaining) = span isTableRow afterAlignment + in (header : alignment <> body, remaining) + +-- | Normalizes a Zim or Markdown table into a portable pipe table. +normalizeTable :: [Text] -> [Text] +normalizeTable [] = [] +normalizeTable (headerLine : rest) = + let headerCells = map stripHeaderWrap (parseTableCells headerLine) + (alignmentCells, bodyLines) = + case rest of + (candidate : more) + | isAlignmentLine candidate -> + (parseTableCells candidate, more) + _ -> ([], rest) + bodyCells = map parseTableCells bodyLines + width = + maximum + (length headerCells : map length bodyCells) + paddedHeader = padTo width headerCells + paddedAlignment = + take + width + (map normalizeAlignmentCell alignmentCells <> repeat "---") + paddedBody = map (padTo width) bodyCells + in renderTableRow paddedHeader + : renderTableRow paddedAlignment + : map renderTableRow paddedBody + +isTableRow :: Text -> Bool +isTableRow line = + let trimmed = Text.strip line + in Text.length trimmed >= 2 + && Text.isPrefixOf "|" trimmed + && Text.isSuffixOf "|" trimmed + +isAlignmentLine :: Text -> Bool +isAlignmentLine line = + isTableRow line + && all isAlignmentCell (parseTableCells line) + +isAlignmentCell :: Text -> Bool +isAlignmentCell cell = + let trimmed = Text.strip cell + in not (Text.null trimmed) + && Text.all (\character -> character == '-' || character == ':' || character == ' ') trimmed + && Text.any (== '-') trimmed + +parseTableCells :: Text -> [Text] +parseTableCells line = + let trimmed = Text.strip line + inner = Text.dropEnd 1 (Text.drop 1 trimmed) + in splitUnescaped '|' inner + +splitUnescaped :: Char -> Text -> [Text] +splitUnescaped delimiter = go [] [] + where + go current acc text = + case Text.uncons text of + Nothing -> + reverse (Text.pack (reverse current) : acc) + Just ('\\', rest) -> + case Text.uncons rest of + Just (character, more) -> + go (character : '\\' : current) acc more + Nothing -> + reverse + (Text.pack (reverse ('\\' : current)) : acc) + Just (character, rest) + | character == delimiter -> + go [] (Text.pack (reverse current) : acc) rest + | otherwise -> + go (character : current) acc rest + +normalizeAlignmentCell :: Text -> Text +normalizeAlignmentCell cell = + let trimmed = Text.strip cell + alignedLeft = Text.isPrefixOf ":" trimmed + alignedRight = Text.isSuffixOf ":" trimmed + in (if alignedLeft then ":" else "") + <> "---" + <> (if alignedRight then ":" else "") + +stripHeaderWrap :: Text -> Text +stripHeaderWrap cell = + Text.stripEnd (Text.dropWhileEnd (== '<') (Text.strip cell)) + +padTo :: Int -> [Text] -> [Text] +padTo width cells = take width (map Text.strip cells <> repeat "") + +renderTableRow :: [Text] -> Text +renderTableRow cells = + "| " <> Text.intercalate " | " cells <> " |" diff --git a/src/ZimToMarkdown/Version.hs b/src/ZimToMarkdown/Version.hs new file mode 100644 --- /dev/null +++ b/src/ZimToMarkdown/Version.hs @@ -0,0 +1,18 @@ +-- | Application version sourced from the Cabal package metadata. +module ZimToMarkdown.Version ( + appVersion, + versionText, +) where + +import Data.Text (Text) +import Data.Text qualified as Text +import Data.Version (Version, showVersion) +import Paths_zim_to_markdown (version) + +-- | The package version generated by Cabal from the @.cabal@ file. +appVersion :: Version +appVersion = version + +-- | The package version rendered for command line output. +versionText :: Text +versionText = Text.pack (showVersion appVersion) diff --git a/src/ZimToMarkdown/Zim.hs b/src/ZimToMarkdown/Zim.hs new file mode 100644 --- /dev/null +++ b/src/ZimToMarkdown/Zim.hs @@ -0,0 +1,346 @@ +-- | Conversion from Zim wiki markup to Markdown. +module ZimToMarkdown.Zim ( + convertZimToMarkdown, +) where + +import Data.Char (isAlpha, isDigit) +import Data.List (nub, sort) +import Data.Map.Strict qualified as Map +import Data.Text (Text) +import Data.Text qualified as Text +import System.FilePath (takeBaseName) + +import ZimToMarkdown.Domain (MarkdownDocument (..), ZimPage (..)) +import ZimToMarkdown.Inline ( + breakOnFirstMarker, + enclosed, + italicBoundary, + renderInlineCode, + renderMarkdownPath, + ) +import ZimToMarkdown.Links (LinkContext, renderZimLink) +import ZimToMarkdown.Table ( + isTableStart, + normalizeTable, + takeTableBlock, + ) + +-- | Converts a Zim page into Markdown. +convertZimToMarkdown :: LinkContext -> ZimPage -> MarkdownDocument +convertZimToMarkdown context (ZimPage content) = + let lines = + Text.splitOn + "\n" + (stripZimHeader (normalizeNewlines content)) + headingMap = buildHeadingMap lines + in MarkdownDocument + ( Text.intercalate + "\n" + (renderBlocks context headingMap lines) + ) + +stripZimHeader :: Text -> Text +stripZimHeader content = + let lines = Text.splitOn "\n" content + remaining = dropWhile isMetadataLine lines + in if length remaining == length lines + then content + else Text.intercalate "\n" (dropWhile isBlank remaining) + +isMetadataLine :: Text -> Bool +isMetadataLine line = + let key = Text.toLower (Text.strip (fst (Text.breakOn ":" line))) + in key `elem` metadataKeys + +metadataKeys :: [Text] +metadataKeys = + [ "content-type" + , "wiki-format" + , "creation-date" + , "modification-date" + ] + +isBlank :: Text -> Bool +isBlank = Text.null . Text.strip + +{- | Compresses the heading levels present in a page into consecutive +Markdown levels starting at one. +-} +buildHeadingMap :: [Text] -> Map.Map Int Int +buildHeadingMap lines = + Map.fromList + (zip (sort (nub (collectHeadingLevels lines))) [1 ..]) + +collectHeadingLevels :: [Text] -> [Int] +collectHeadingLevels = go OutsideVerbatim + where + go _ [] = [] + go state (line : rest) + | isVerbatimDelimiter line = go (toggleState state) rest + | state == InsideVerbatim = go InsideVerbatim rest + | Just (level, _) <- parseHeading line = + level : go OutsideVerbatim rest + | otherwise = go OutsideVerbatim rest + +normalizeNewlines :: Text -> Text +normalizeNewlines = + Text.replace "\r" "\n" . Text.replace "\r\n" "\n" + +data BlockState + = OutsideVerbatim + | InsideVerbatim + deriving (Eq) + +renderBlocks :: LinkContext -> Map.Map Int Int -> [Text] -> [Text] +renderBlocks context headingMap = go OutsideVerbatim + where + go _ [] = [] + go state (line : rest) + | isVerbatimDelimiter line = + "```" : go (toggleState state) rest + | state == InsideVerbatim = + line : go InsideVerbatim rest + | isTableStart line = + let (block, remaining) = takeTableBlock (line : rest) + in normalizeTable block <> go OutsideVerbatim remaining + | otherwise = + renderLine context headingMap line : go OutsideVerbatim rest + +toggleState :: BlockState -> BlockState +toggleState OutsideVerbatim = InsideVerbatim +toggleState InsideVerbatim = OutsideVerbatim + +isVerbatimDelimiter :: Text -> Bool +isVerbatimDelimiter line = Text.strip line == "'''" + +renderLine :: LinkContext -> Map.Map Int Int -> Text -> Text +renderLine context headingMap line + | Text.null (Text.strip line) = line + | Just (level, content) <- parseHeading line = + let markdownLevel = + min 3 (Map.findWithDefault level level headingMap) + in Text.replicate markdownLevel "#" + <> " " + <> convertInline context content + | isHorizontalRule line = "---" + | Just listLine <- parseListLine line = + renderListLine context listLine + | Just (depth, content) <- parseIndentedBlock line = + Text.replicate depth "> " + <> renderLine context headingMap content + | otherwise = convertInline context line + +isHorizontalRule :: Text -> Bool +isHorizontalRule line = + let trimmed = Text.strip line + in Text.length trimmed >= 5 && Text.all (== '-') trimmed + +parseIndentedBlock :: Text -> Maybe (Int, Text) +parseIndentedBlock line = + let (tabs, afterTabs) = Text.span (== '\t') line + (spaces, rest) = Text.span (== ' ') afterTabs + depth = Text.length tabs + Text.length spaces `div` 4 + in if depth == 0 + then Nothing + else Just (depth, rest) + +parseHeading :: Text -> Maybe (Int, Text) +parseHeading line = + let opening = Text.takeWhile (== '=') line + count = Text.length opening + in if count >= 2 && count <= 6 + then + let afterOpening = Text.drop count line + closing = Text.takeWhileEnd (== '=') afterOpening + content = + Text.strip + (Text.dropEnd (Text.length closing) afterOpening) + in if Text.length closing == count && not (Text.null content) + then Just (7 - count, content) + else Nothing + else Nothing + +data ListMarker + = Bullet + | Numbered + | Alphabetic + | Task Bool + deriving (Eq) + +data ListLine = ListLine + { listIndent :: Text + , listMarker :: ListMarker + , listContent :: Text + } + +parseListLine :: Text -> Maybe ListLine +parseListLine line = + let (indent, rest) = Text.span isIndent line + in case parseMarker rest of + Nothing -> Nothing + Just (marker, content) -> + Just + ListLine + { listIndent = indent + , listMarker = marker + , listContent = content + } + where + isIndent character = character == ' ' || character == '\t' + +parseMarker :: Text -> Maybe (ListMarker, Text) +parseMarker text + | Just rest <- Text.stripPrefix "[ ] " text = Just (Task False, rest) + | Just rest <- Text.stripPrefix "[*] " text = Just (Task True, rest) + | Just rest <- Text.stripPrefix "[x] " text = Just (Task True, rest) + | Just rest <- Text.stripPrefix "[X] " text = Just (Task True, rest) + | Just rest <- Text.stripPrefix "[>] " text = Just (Task True, rest) + | Just rest <- Text.stripPrefix "[<] " text = Just (Task True, rest) + | Just rest <- Text.stripPrefix "* " text = Just (Bullet, rest) + | Just rest <- Text.stripPrefix "- " text = Just (Bullet, rest) + | otherwise = parseOrdered text + +parseOrdered :: Text -> Maybe (ListMarker, Text) +parseOrdered text = + let (digits, afterDigits) = Text.span isDigit text + in if Text.null digits + then parseAlphabetic text + else case Text.stripPrefix ". " afterDigits of + Just rest -> Just (Numbered, rest) + Nothing -> parseAlphabetic text + +parseAlphabetic :: Text -> Maybe (ListMarker, Text) +parseAlphabetic text = + case Text.uncons text of + Just (letter, afterLetter) + | isAlpha letter + , Just rest <- Text.stripPrefix ". " afterLetter -> + Just (Alphabetic, rest) + _ -> Nothing + +renderListLine :: LinkContext -> ListLine -> Text +renderListLine context listLine = + indentToSpaces (listIndent listLine) + <> prefix + <> convertInline context (listContent listLine) + where + prefix = + case listMarker listLine of + Bullet -> "* " + Numbered -> "1. " + Alphabetic -> "1. " + Task False -> "- [ ] " + Task True -> "- [x] " + +indentToSpaces :: Text -> Text +indentToSpaces = + Text.concatMap + ( \character -> + if character == '\t' + then " " + else Text.singleton character + ) + +inlineMarkers :: [Text] +inlineMarkers = + [ "" + , "" + , "" + , "" + , "{{id:" + , "**" + , "//" + , "__" + , "''" + , "~~" + , "[[" + , "{{" + , "_{" + , "^{" + ] + +convertInline :: LinkContext -> Text -> Text +convertInline context = go + where + go text = + let (plain, marker) = breakOnFirstMarker inlineMarkers text + in plain + <> case marker of + Nothing -> "" + Just suffix -> convertMarker plain suffix + + convertMarker preceding text + | Just result <- + enclosed "" "" (\inner -> "**" <> go inner <> "**") text = + keep result + | Just result <- + enclosed "" "" (\inner -> "**" <> go inner <> "**") text = + keep result + | Just result <- + enclosed "" "" (\inner -> "*" <> go inner <> "*") text = + keep result + | Just result <- + enclosed "" "" (\inner -> "*" <> go inner <> "*") text = + keep result + | Just result <- enclosed "{{id:" "}}" renderAnchor text = + keep result + | Just result <- + enclosed "**" "**" (\inner -> "**" <> go inner <> "**") text = + keep result + | italicBoundary preceding + , Just result <- + enclosed "//" "//" (\inner -> "*" <> go inner <> "*") text = + keep result + | Just result <- + enclosed "__" "__" (\inner -> "" <> go inner <> "") text = + keep result + | Just result <- enclosed "''" "''" renderInlineCode text = + keep result + | Just result <- + enclosed "~~" "~~" (\inner -> "~~" <> go inner <> "~~") text = + keep result + | Just result <- + enclosed + "[[" + "]]" + (renderZimLink context (convertInline context)) + text = + keep result + | Just result <- enclosed "{{" "}}" renderImage text = + keep result + | Just result <- + enclosed "_{" "}" (\inner -> "" <> go inner <> "") text = + keep result + | Just result <- + enclosed "^{" "}" (\inner -> "" <> go inner <> "") text = + keep result + | otherwise = Text.take 1 text <> go (Text.drop 1 text) + + keep (rendered, after) = rendered <> go after + +renderAnchor :: Text -> Text +renderAnchor inner = + let name = Text.strip inner + in if Text.null name + then "{{id:}}" + else + " Text.replace "\"" """ name + <> "\">" + +renderImage :: Text -> Text +renderImage inner = + let (pathPart, altPart) = Text.breakOn "|" inner + path = Text.strip pathPart + altText = + if Text.null altPart + then Text.pack (takeBaseName (Text.unpack path)) + else Text.strip (Text.drop 1 altPart) + in if Text.null path + then "{{" <> inner <> "}}" + else + "![" + <> Text.replace "]" "\\]" altText + <> "](" + <> renderMarkdownPath path + <> ")" diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,401 @@ +module Main ( + main, +) where + +import Data.Set qualified as Set +import Data.Text (Text) +import Data.Text qualified as Text +import Data.Version (showVersion) +import Paths_zim_to_markdown (version) +import System.Exit (exitFailure) +import System.FilePath (()) + +import ZimToMarkdown.Converter (convertMarkdownDocument, convertZimPage) +import ZimToMarkdown.Domain ( + ConversionDirection (..), + MarkdownDocument (..), + RelativePath (..), + ZimPage (..), + ) +import ZimToMarkdown.Links (LinkContext (..)) +import ZimToMarkdown.Notebook (outputRelativePath) +import ZimToMarkdown.Version (versionText) + +data TestCase = TestCase + { testName :: String + , testActual :: Text + , testExpected :: Text + } + +main :: IO () +main = do + let failures = + [ test + | test <- tests + , testExpected test /= testActual test + ] + if null failures + then + putStrLn + ("All " <> show (length tests) <> " tests passed.") + else do + mapM_ printFailure failures + exitFailure + +printFailure :: TestCase -> IO () +printFailure test = do + putStrLn ("FAIL: " <> testName test) + putStrLn (" expected: " <> show (testExpected test)) + putStrLn (" actual: " <> show (testActual test)) + +tests :: [TestCase] +tests = + [ TestCase + "version text matches the Cabal package version" + versionText + (Text.pack (showVersion version)) + , TestCase + "zim heading level 1" + (zimToMarkdown "====== Title ======") + "# Title" + , TestCase + "zim heading level 2" + (zimToMarkdown "===== Second =====") + "# Second" + , TestCase + "zim heading level 5" + (zimToMarkdown "== Fifth ==") + "# Fifth" + , TestCase + "zim heading hierarchy" + (zimToMarkdown (Text.unlines ["====== Title ======", "", "=== Section ===", "", "== Subsection =="])) + (Text.unlines ["# Title", "", "## Section", "", "### Subsection"]) + , TestCase + "zim deep heading hierarchy" + (zimToMarkdown (Text.unlines ["=== Section ===", "", "== Subsection =="])) + (Text.unlines ["# Section", "", "## Subsection"]) + , TestCase + "zim headings are capped at three levels" + (zimToMarkdown (Text.unlines ["====== Title ======", "===== Two =====", "==== Three ====", "=== Four ===", "== Five =="])) + (Text.unlines ["# Title", "## Two", "### Three", "### Four", "### Five"]) + , TestCase + "zim metadata header removed" + ( zimToMarkdown + ( Text.unlines + [ "Content-Type: text/x-zim-wiki" + , "Wiki-Format: zim 0.6" + , "Creation-Date: 2016-04-15T16:02:48-03:00" + , "" + , "====== Backup ======" + ] + ) + ) + (Text.unlines ["# Backup"]) + , TestCase + "zim bold" + (zimToMarkdown "**bold**") + "**bold**" + , TestCase + "zim italic" + (zimToMarkdown "//italic//") + "*italic*" + , TestCase + "zim underline" + (zimToMarkdown "__under__") + "under" + , TestCase + "zim inline verbatim" + (zimToMarkdown "''code''") + "`code`" + , TestCase + "zim strikethrough" + (zimToMarkdown "~~gone~~") + "~~gone~~" + , TestCase + "zim subscript" + (zimToMarkdown "H_{2}O") + "H2O" + , TestCase + "zim superscript" + (zimToMarkdown "x^{2}") + "x2" + , TestCase + "zim bullet list" + (zimToMarkdown "* item") + "* item" + , TestCase + "zim nested bullet list" + (zimToMarkdown "\t* sub item") + " * sub item" + , TestCase + "zim numbered list" + (zimToMarkdown "1. item") + "1. item" + , TestCase + "zim unchecked task" + (zimToMarkdown "[ ] todo") + "- [ ] todo" + , TestCase + "zim checked task" + (zimToMarkdown "[*] done") + "- [x] done" + , TestCase + "zim internal link" + (zimToMarkdown "[[sibling]]") + "[sibling](sibling.md)" + , TestCase + "zim link label markup" + (zimToMarkdown "[[sibling|**bold**]]") + "[**bold**](sibling.md)" + , TestCase + "zim root link" + (zimToMarkdown "[[:root]]") + "[root](../root.md)" + , TestCase + "zim namespace link" + (zimToMarkdownWithContext rootLinkContext "[[Sistema:cron|página]]") + "[página](Sistema/cron.md)" + , TestCase + "zim pseudo link" + (zimToMarkdown "[[user@host.example]]") + "user@host.example" + , TestCase + "zim pseudo link with label" + (zimToMarkdown "[[user@host.example|''user@host.example'']]") + "user@host.example" + , TestCase + "zim child link" + (zimToMarkdown "[[+child]]") + "[child](page/child.md)" + , TestCase + "zim external link" + (zimToMarkdown "[[https://example.com|Example]]") + "[Example](https://example.com)" + , TestCase + "zim image" + (zimToMarkdown "{{./pic.png}}") + "![pic](./pic.png)" + , TestCase + "zim image with alt text" + (zimToMarkdown "{{./pic.png|A picture}}") + "![A picture](./pic.png)" + , TestCase + "zim anchor" + (zimToMarkdown "{{id: intro}}") + "" + , TestCase + "zim html bold" + (zimToMarkdown "bold") + "**bold**" + , TestCase + "zim html italic" + (zimToMarkdown "italic") + "*italic*" + , TestCase + "zim migrated task" + (zimToMarkdown "[>] done") + "- [x] done" + , TestCase + "zim horizontal rule" + (zimToMarkdown "-----") + "---" + , TestCase + "zim indented block" + (zimToMarkdown "\tquoted") + "> quoted" + , TestCase + "zim nested indented block" + (zimToMarkdown "\t\tdeep") + "> > deep" + , TestCase + "zim table with alignment" + (zimToMarkdown (Text.unlines ["| Name | Age |", "|:-----|----:|", "| Ana | 30 |"])) + (Text.unlines ["| Name | Age |", "| :--- | ---: |", "| Ana | 30 |"]) + , TestCase + "zim table without alignment" + (zimToMarkdown (Text.unlines ["| A | B |", "| 1 | 2 |"])) + (Text.unlines ["| A | B |", "| --- | --- |", "| 1 | 2 |"]) + , TestCase + "zim verbatim block" + (zimToMarkdown (Text.unlines ["'''", "x = 1", "'''"])) + (Text.unlines ["```", "x = 1", "```"]) + , TestCase + "markdown heading level 1" + (markdownToZim "# Title") + "====== Title ======" + , TestCase + "markdown heading level 5" + (markdownToZim "##### Fifth") + "== Fifth ==" + , TestCase + "markdown heading level 6 is clamped" + (markdownToZim "###### Sixth") + "== Sixth ==" + , TestCase + "markdown bold" + (markdownToZim "**bold**") + "**bold**" + , TestCase + "markdown italic" + (markdownToZim "*italic*") + "//italic//" + , TestCase + "markdown underscore italic" + (markdownToZim "_italic_") + "//italic//" + , TestCase + "markdown inline code" + (markdownToZim "`code`") + "''code''" + , TestCase + "markdown underline html" + (markdownToZim "under") + "__under__" + , TestCase + "markdown internal link" + (markdownToZim "[label](page.md)") + "[[page|label]]" + , TestCase + "markdown link label markup" + (markdownToZim "[**bold**](page.md)") + "[[page|**bold**]]" + , TestCase + "markdown self labelled link" + (markdownToZim "[page](page.md)") + "[[page]]" + , TestCase + "markdown parent link" + (markdownToZim "[Home](../Home.md)") + "[[Home]]" + , TestCase + "markdown image" + (markdownToZim "![alt](pic.png)") + "{{pic.png|alt}}" + , TestCase + "markdown image with alt text" + (markdownToZim "![A picture](pic.png)") + "{{pic.png|A picture}}" + , TestCase + "markdown anchor" + (markdownToZim "") + "{{id: intro}}" + , TestCase + "markdown html strong" + (markdownToZim "bold") + "**bold**" + , TestCase + "markdown html emphasis" + (markdownToZim "italic") + "//italic//" + , TestCase + "markdown html mark" + (markdownToZim "marked") + "__marked__" + , TestCase + "markdown autolink" + (markdownToZim "") + "[[https://example.com]]" + , TestCase + "markdown thematic break" + (markdownToZim "---") + "-----" + , TestCase + "markdown blank line is not a thematic break" + (markdownToZim "") + "" + , TestCase + "markdown short marker run is not a thematic break" + (markdownToZim "--") + "--" + , TestCase + "markdown blockquote" + (markdownToZim "> quoted") + "\tquoted" + , TestCase + "markdown nested blockquote" + (markdownToZim "> > deep") + "\t\tdeep" + , TestCase + "markdown list in blockquote" + (markdownToZim "> - item") + "\t* item" + , TestCase + "markdown setext heading level 1" + (markdownToZim "Title\n=====") + "====== Title ======" + , TestCase + "markdown setext heading level 2" + (markdownToZim "Title\n-----") + "===== Title =====" + , TestCase + "markdown table" + (markdownToZim (Text.unlines ["| Name | Age |", "|:-----|----:|", "| Ana | 30 |"])) + (Text.unlines ["| Name | Age |", "| :--- | ---: |", "| Ana | 30 |"]) + , TestCase + "markdown bullet list" + (markdownToZim "- item") + "* item" + , TestCase + "markdown nested bullet list" + (markdownToZim " * nested") + "\t* nested" + , TestCase + "markdown numbered list" + (markdownToZim "1. item") + "1. item" + , TestCase + "markdown unchecked task" + (markdownToZim "- [ ] todo") + "[ ] todo" + , TestCase + "markdown checked task" + (markdownToZim "- [x] done") + "[*] done" + , TestCase + "markdown fenced code" + (markdownToZim (Text.unlines ["```", "x = 1", "```"])) + (Text.unlines ["'''", "x = 1", "'''"]) + , TestCase + "notebook zim output path" + (Text.pack (unRelativePath (outputRelativePath ZimToMarkdown (RelativePath ("notes" "page.txt"))))) + (Text.pack ("notes" "page.md")) + , TestCase + "notebook markdown output path" + (Text.pack (unRelativePath (outputRelativePath MarkdownToZim (RelativePath ("notes" "page.md"))))) + (Text.pack ("notes" "page.txt")) + ] + +zimToMarkdown :: Text -> Text +zimToMarkdown = zimToMarkdownWithContext linkContext + +zimToMarkdownWithContext :: LinkContext -> Text -> Text +zimToMarkdownWithContext context input = + unMarkdownDocument (convertZimPage context (ZimPage input)) + +markdownToZim :: Text -> Text +markdownToZim input = + unZimPage (convertMarkdownDocument (MarkdownDocument input)) + +linkContext :: LinkContext +linkContext = + LinkContext + { linkCurrentPage = RelativePath ("notes" "page.txt") + , linkKnownPages = + Set.fromList + [ RelativePath ("notes" "page.txt") + , RelativePath ("notes" "sibling.txt") + , RelativePath "root.txt" + , RelativePath ("notes" "page" "child.txt") + ] + } + +rootLinkContext :: LinkContext +rootLinkContext = + LinkContext + { linkCurrentPage = RelativePath "Backup.txt" + , linkKnownPages = + Set.fromList + [ RelativePath "Backup.txt" + , RelativePath ("Sistema" "cron.txt") + ] + } diff --git a/zim-to-markdown.cabal b/zim-to-markdown.cabal new file mode 100644 --- /dev/null +++ b/zim-to-markdown.cabal @@ -0,0 +1,101 @@ +cabal-version: 3.0 +name: zim-to-markdown +version: 0.3.0.2 +synopsis: Converts Zim wiki pages to Markdown and back. +description: + A command line converter between Zim wiki markup and Markdown. + + It converts single pages and whole notebooks in both directions, + copies notebook assets, preserves the folder structure, and resolves + internal links. + + Zim metadata headers are removed and heading levels are normalized + for Markdown output. +homepage: https://github.com/Tralen/zim-to-markdown +bug-reports: https://github.com/Tralen/zim-to-markdown/issues +license: BSD-3-Clause +license-file: LICENSE +author: Tunai Raiol +maintainer: Tralen +copyright: 2026 Tunai Raiol +category: Text +build-type: Simple +tested-with: GHC ==9.6.7 || ==9.14.1 +extra-doc-files: CHANGELOG.md + README.md + docs/architecture.md + docs/cli.md + docs/conversion.md + docs/domain.md + docs/releasing.md + docs/versioning.md + +source-repository head + type: git + location: https://github.com/Tralen/zim-to-markdown.git + +common warnings + ghc-options: + -Wall + -Wcompat + -Widentities + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wmissing-export-lists + -Wmissing-home-modules + -Wpartial-fields + -Wredundant-constraints + +library + exposed-modules: + ZimToMarkdown.Converter + ZimToMarkdown.Domain + ZimToMarkdown.Inline + ZimToMarkdown.Links + ZimToMarkdown.Markdown + ZimToMarkdown.Notebook + ZimToMarkdown.Options + ZimToMarkdown.Paths + ZimToMarkdown.Table + ZimToMarkdown.Version + ZimToMarkdown.Zim + hs-source-dirs: src + other-modules: Paths_zim_to_markdown + autogen-modules: Paths_zim_to_markdown + build-depends: + base >=4.18 && <5, + containers >=0.6 && <0.9, + filepath >=1.4 && <1.6, + text >=2.0 && <2.2 + default-language: GHC2021 + default-extensions: OverloadedStrings + +executable zim-to-markdown + main-is: Main.hs + hs-source-dirs: app + build-depends: + base >=4.18 && <5, + bytestring >=0.11 && <0.13, + containers >=0.6 && <0.9, + directory >=1.3 && <1.4, + filepath >=1.4 && <1.6, + text >=2.0 && <2.2, + zim-to-markdown + default-language: GHC2021 + default-extensions: OverloadedStrings + ghc-options: -threaded -rtsopts -with-rtsopts=-N + +test-suite zim-to-markdown-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: test + other-modules: Paths_zim_to_markdown + autogen-modules: Paths_zim_to_markdown + build-depends: + base >=4.18 && <5, + containers >=0.6 && <0.9, + filepath >=1.4 && <1.6, + text >=2.0 && <2.2, + zim-to-markdown + default-language: GHC2021 + default-extensions: OverloadedStrings