mdoc 0.1.1.4 → 0.2.0.0
raw patch · 105 files changed
+2961/−2779 lines, 105 filesdep +stachedep ~autodocodecdep ~prettyprinter
Dependencies added: stache
Dependency ranges changed: autodocodec, prettyprinter
Files
- README.lhs +20/−8
- README.md +20/−8
- data/man1.template +0/−15
- data/man5.template +0/−11
- examples/crontab.5 +22/−0
- examples/example.1 +35/−0
- examples/examplerc.5 +18/−0
- examples/grep.1 +154/−0
- examples/mdoc-dump.1 +43/−0
- examples/mdoc-dump.1.html +87/−0
- examples/person.5 +30/−0
- examples/style.css +394/−0
- mdoc.cabal +40/−46
- src/Autodocodec/Schema/Mdoc.hs +19/−92
- src/Env/Mdoc.hs +16/−55
- src/Mdoc.hs +36/−18
- src/Mdoc/Data/Argument.hs +74/−0
- src/Mdoc/Data/Config.hs +45/−0
- src/Mdoc/Data/Described.hs +90/−0
- src/Mdoc/Data/EnvVar.hs +37/−0
- src/Mdoc/Data/Flag.hs +67/−0
- src/Mdoc/Data/List.hs +84/−0
- src/Mdoc/Data/Named.hs +47/−0
- src/Mdoc/Data/Option.hs +50/−0
- src/Mdoc/Data/Optionality.hs +19/−0
- src/Mdoc/Data/Page.hs +83/−0
- src/Mdoc/Data/Positional.hs +65/−0
- src/Mdoc/Data/Synopsis.hs +95/−0
- src/Mdoc/Dump/Diff.hs +1/−1
- src/Mdoc/Dump/Env.hs +2/−1
- src/Mdoc/Dump/Main.hs +1/−1
- src/Mdoc/Dump/Options.hs +2/−1
- src/Mdoc/Examples/Grep.hs +88/−0
- src/Mdoc/Examples/OptEnvConf.hs +74/−0
- src/Mdoc/Examples/Person.hs +64/−0
- src/Mdoc/Gen.hs +0/−76
- src/Mdoc/Gen/Argument.hs +0/−58
- src/Mdoc/Gen/Config.hs +0/−58
- src/Mdoc/Gen/CrossRef.hs +0/−44
- src/Mdoc/Gen/Described.hs +0/−85
- src/Mdoc/Gen/Description.hs +0/−99
- src/Mdoc/Gen/EnvVar.hs +0/−36
- src/Mdoc/Gen/Environment.hs +0/−38
- src/Mdoc/Gen/ExitStatus.hs +0/−38
- src/Mdoc/Gen/File.hs +0/−63
- src/Mdoc/Gen/Flag.hs +0/−58
- src/Mdoc/Gen/Man1.hs +0/−69
- src/Mdoc/Gen/Man5.hs +0/−42
- src/Mdoc/Gen/Name.hs +0/−49
- src/Mdoc/Gen/Option.hs +0/−22
- src/Mdoc/Gen/Optionality.hs +0/−38
- src/Mdoc/Gen/Synopsis.hs +0/−77
- src/Mdoc/Gen/Template.hs +0/−80
- src/Mdoc/Input.hs +2/−1
- src/Mdoc/Interpolated.hs +0/−66
- src/Mdoc/Interpolation.hs +0/−38
- src/Mdoc/MacroArg.hs +0/−38
- src/Mdoc/MacroName.hs +0/−149
- src/Mdoc/MdocLine.hs +0/−37
- src/Mdoc/Optics.hs +16/−1
- src/Mdoc/Parse/Interpolation.hs +0/−41
- src/Mdoc/Parse/MacroArg.hs +1/−6
- src/Mdoc/Parse/MacroName.hs +1/−1
- src/Mdoc/Parse/Mdoc.hs +20/−0
- src/Mdoc/Parse/MdocLine.hs +1/−3
- src/Mdoc/Parse/TableLine.hs +1/−1
- src/Mdoc/Parse/TroffMacro.hs +1/−1
- src/Mdoc/Prelude.hs +23/−8
- src/Mdoc/Pretty.hs +29/−6
- src/Mdoc/Pretty/Interpolation.hs +0/−22
- src/Mdoc/Pretty/MacroArg.hs +0/−53
- src/Mdoc/Pretty/MacroName.hs +0/−19
- src/Mdoc/Pretty/MdocLine.hs +0/−34
- src/Mdoc/Pretty/TableLine.hs +0/−19
- src/Mdoc/Pretty/TroffMacro.hs +0/−31
- src/Mdoc/Syntax.hs +19/−0
- src/Mdoc/Syntax/MacroArg.hs +77/−0
- src/Mdoc/Syntax/MacroName.hs +159/−0
- src/Mdoc/Syntax/Mdoc.hs +32/−0
- src/Mdoc/Syntax/MdocLine.hs +54/−0
- src/Mdoc/Syntax/TableLine.hs +26/−0
- src/Mdoc/Syntax/TroffMacro.hs +43/−0
- src/Mdoc/TableLine.hs +0/−18
- src/Mdoc/Template.hs +87/−0
- src/Mdoc/TroffMacro.hs +0/−20
- src/Mdoc/UpdateMdocdate.hs +3/−3
- src/OptEnvConf/Mdoc.hs +51/−119
- src/Options/Applicative/Mdoc.hs +41/−118
- test/Autodocodec/Schema/MdocSpec.hs +110/−121
- test/Mdoc/Data/ConfigSpec.hs +40/−0
- test/Mdoc/Data/PositionalSpec.hs +87/−0
- test/Mdoc/Data/SynopsisSpec.hs +28/−0
- test/Mdoc/ExamplesSpec.hs +68/−0
- test/Mdoc/Gen/DescriptionSpec.hs +0/−48
- test/Mdoc/Gen/ExitStatusSpec.hs +0/−51
- test/Mdoc/Gen/FlagSpec.hs +0/−95
- test/Mdoc/GenSpec.hs +0/−89
- test/Mdoc/Parse/MacroArgSpec.hs +1/−6
- test/Mdoc/Parse/MdocLineSpec.hs +1/−23
- test/Mdoc/Parse/TableLineSpec.hs +1/−1
- test/Mdoc/Parse/TroffMacroSpec.hs +1/−1
- test/Mdoc/Test/Fixtures.hs +0/−173
- test/Mdoc/Test/Render.hs +13/−24
- test/Mdoc/UpdateMdocdateSpec.hs +1/−4
- test/MdocSpec.hs +1/−3
README.lhs view
@@ -35,25 +35,37 @@ [mdoc-dump.1]: ./examples/mdoc-dump.1 ```haskell+module Main+ ( main+ ) where+ import Prelude import Data.Function ((&)) import Env.Mdoc qualified as Env-import Mdoc.Gen-import Mdoc.Gen.Man1+import Mdoc+import Mdoc.Data.Page (setEpilogue) import Mdoc.Dump.Env (envParser) import Mdoc.Dump.Options (optionsInfo, optionsParser) import Options.Applicative.Mdoc qualified as Opt -mdocDump1 :: Man1+mdocDump1 :: Named mdocDump1 =- baseMan1 "mdoc-dump" optionsInfo- & Opt.addToMan1 optionsParser- & Env.addToMan1 envParser- & addCrossRef "mdoc" 7+ mempty+ & (<> Opt.getPage optionsParser)+ & (<> Env.getPage envParser)+ & setEpilogue+ ( Mdoc+ [ MacroLine Sh ["SEE ALSO"]+ , MacroLine Xr ["mdoc", "7"]+ ]+ )+ & name "mdoc-dump" optionsInfo main :: IO ()-main = putMdoc =<< genMan1 mdocDump1+main = do+ mdoc <- renderTemplateThrow man1 mdocDump1+ putMdoc =<< updateMdocdate mdoc ``` <details>
README.md view
@@ -35,25 +35,37 @@ [mdoc-dump.1]: ./examples/mdoc-dump.1 ```haskell+module Main+ ( main+ ) where+ import Prelude import Data.Function ((&)) import Env.Mdoc qualified as Env-import Mdoc.Gen-import Mdoc.Gen.Man1+import Mdoc+import Mdoc.Data.Page (setEpilogue) import Mdoc.Dump.Env (envParser) import Mdoc.Dump.Options (optionsInfo, optionsParser) import Options.Applicative.Mdoc qualified as Opt -mdocDump1 :: Man1+mdocDump1 :: Named mdocDump1 =- baseMan1 "mdoc-dump" optionsInfo- & Opt.addToMan1 optionsParser- & Env.addToMan1 envParser- & addCrossRef "mdoc" 7+ mempty+ & (<> Opt.getPage optionsParser)+ & (<> Env.getPage envParser)+ & setEpilogue+ ( Mdoc+ [ MacroLine Sh ["SEE ALSO"]+ , MacroLine Xr ["mdoc", "7"]+ ]+ )+ & name "mdoc-dump" optionsInfo main :: IO ()-main = putMdoc =<< genMan1 mdocDump1+main = do+ mdoc <- renderTemplateThrow man1 mdocDump1+ putMdoc =<< updateMdocdate mdoc ``` <details>
− data/man1.template
@@ -1,15 +0,0 @@-.\" vim: ft=nroff-.Dd $Mdocdate$-.Dt {{docTitle}} {{docSection}}-.Os-.Sh NAME-{{name}}-.Sh SYNOPSIS-{{synopsis}}-.Sh DESCRIPTION-{{description}}-{{environment}}-{{files}}-.Sh EXIT STATUS-{{exitStatus}}-{{seeAlso}}
− data/man5.template
@@ -1,11 +0,0 @@-.\" vim: ft=nroff-.Dd $Mdocdate$-.Dt {{docTitle}} {{docSection}}-.Os-.Sh NAME-{{name}}-.Sh SYNOPSIS-{{synopsis}}-.Sh DESCRIPTION-{{description}}-{{seeAlso}}
+ examples/crontab.5 view
@@ -0,0 +1,22 @@+.\" vim: ft=nroff.mustache+.Dd $Mdocdate: September 20 2026 $+.Dt CRONTAB 5+.Os+.Sh NAME+.Nm crontab+.Nd tables for driving cron+.Sh SYNOPSIS+.Bl -tag -width indent -compact+.It Pa /etc/cron.daily ,+.It Pa /etc/cron.hourly ,+.It Pa /etc/cron.weekly+.El+.Sh DESCRIPTION+.Bl -tag -width indent+.It Cm bar.bat : Ar number Ns []+Bar's bat is better than that+.It Cm bar.baz : Ar boolean+Bar's baz of bazzle+.It Cm foo : Ar string+Foo's the fooing of fooers+.El
+ examples/example.1 view
@@ -0,0 +1,35 @@+.\" vim: ft=nroff.mustache+.Dd $Mdocdate: September 20 2026 $+.Dt EXAMPLE 1+.Os+.Sh NAME+.Nm example+.Nd opt\-env\-conf example+.Sh SYNOPSIS+.Nm+.Bk -words+.Op Fl v+.Fl i Ar INPUT+.Op Fl Fl debug+.Ar FILE+.Op Ar FILE ...+.Ek+.Sh DESCRIPTION+The options are as follows:+.Bl -tag -width indent+.It Fl i Ar INPUT+.It Fl v , Fl Fl verbose+.It Fl Fl debug+Enable debug+.It Ar FILE+.El+.Sh ENVIRONMENT+The following environment variables affect the execution of+.Nm :+.Bl -tag -width "INPUT=INPUT"+.It Ev DEBUG+Enable debug+.It Ev INPUT= Ns Ar INPUT+.El+.Sh EXIT STATUS+.Ex -std
+ examples/examplerc.5 view
@@ -0,0 +1,18 @@+.\" vim: ft=nroff.mustache+.Dd $Mdocdate: September 20 2026 $+.Dt EXAMPLERC 5+.Os+.Sh NAME+.Nm examplerc+.Nd opt\-env\-conf example config+.Sh SYNOPSIS+.Bl -tag -width indent -compact+.It Pa .examplerc.yaml+.El+.Sh DESCRIPTION+.Bl -tag -width indent+.It Cm debug : Ar boolean+Enable debug+.It Cm file : Ar string+.It Cm verbose : Ar boolean+.El
+ examples/grep.1 view
@@ -0,0 +1,154 @@+.\" vim: ft=nroff.mustache+.Dd $Mdocdate: September 20 2026 $+.Dt GREP 1+.Os+.Sh NAME+.Nm grep ,+.Nm egrep ,+.Nm fgrep ,+.Nm rgrep+.Nd file pattern searcher+.Sh SYNOPSIS+.Nm+.Bk -words+.Op Fl abcEFGHhIiLlnoqRsUVvwxZ+.Op Fl A Ar num+.Op Fl B Ar num+.Op Fl C Ar num+.Op Fl e Ar pattern+.Op Fl f Ar file+.Op Fl m Ar num+.Op Fl Fl binary\-files= Ns Ar value+.Op Fl Fl label= Ns Ar name+.Op Fl Fl line\-buffered+.Op Fl Fl null+.Op Ar pattern+.Op Ar file ...+.Ek+.Sh DESCRIPTION+The options are as follows:+.Bl -tag -width indent+.It Fl A Ar num+Print num lines of trailing context after each match. See also the \-B and \-C+options.+.It Fl a+Treat all files as ASCII text. Normally grep will simply print “Binary file ...+matches” if files contain binary characters. Use of this option forces grep to+output lines matching the specified pattern.+.It Fl B Ar num+Print num lines of leading context before each match. See also the \-A and \-C+options.+.It Fl b+Each output line is preceded by its position (in bytes) in the file. If option+\-o is also specified, the position of the matched pattern is displayed.+.It Fl C Ar num , Fl Fl context= Ns Ar num+Print num lines of leading and trailing context surrounding each match. The+default is 2 and is equivalent to \-A 2 \-B 2. Note: no whitespace may be given+between the option and its argument.+.It Fl c+Only a count of selected lines is written to standard output.+.It Fl E+Interpret pattern as an extended regular expression (i.e. force grep to behave+as egrep).+.It Fl e Ar pattern+Specify a pattern used during the search of the input: an input line is selected+if it matches any of the specified patterns. This option is most useful when+multiple \-e options are used to specify multiple patterns, or when a pattern+begins with a dash (‘\-’).+.It Fl F+Interpret pattern as a set of fixed strings (i.e. force grep to behave as+fgrep).+.It Fl f Ar file+Read one or more newline separated patterns from file. Empty pattern lines match+every input line. Newlines are not considered part of a pattern. If file is+empty, nothing is matched.+.It Fl G+Interpret pattern as a basic regular expression (i.e. force grep to behave as+traditional grep).+.It Fl H+Always print filename headers (i.e. filenames) with output lines.+.It Fl h+Never print filename headers (i.e. filenames) with output lines.+.It Fl I+Ignore binary files.+.It Fl i+Perform case insensitive matching. By default, grep is case sensitive.+.It Fl L+Only the names of files not containing selected lines are written to standard+output. Pathnames are listed once per file searched. If the standard input is+searched, the string “(standard input)” is written.+.It Fl l+Only the names of files containing selected lines are written to standard+output. grep will only search a file until a match has been found, making+searches potentially less expensive. Pathnames are listed once per file+searched. If the standard input is searched, the string “(standard input)” is+written.+.It Fl m Ar num+Stop after finding at least one match on num different lines.+.It Fl n+Each output line is preceded by its relative line number in the file, starting+at line 1. The line number counter is reset for each file processed. This option+is ignored if \-c, \-L, \-l, or \-q is specified.+.It Fl o+Print each match, but only the match, not the entire line.+.It Fl q+Quiet mode: suppress normal output. grep will only search a file until a match+has been found, making searches potentially less expensive.+.It Fl R+Recursively search subdirectories listed. If no file is given, grep searches the+current working directory.+.It Fl s+Silent mode. Nonexistent and unreadable files are ignored (i.e. their error+messages are suppressed).+.It Fl U+Search binary files, but do not attempt to print them.+.It Fl V+Display version information. All other options are ignored.+.It Fl v+Selected lines are those not matching any of the specified patterns.+.It Fl w+The expression is searched for as a word (as if surrounded by ‘[[:<:]]’ and+‘[[:>:]]’; see re_format(7)).+.It Fl x+Only input lines selected against an entire fixed string or regular expression+are considered to be matching lines.+.It Fl Z+Force grep to behave as zgrep.+.It Fl Fl binary\-files= Ns Ar value+Controls searching and printing of binary files. Options are binary, the+default: search binary files but do not print them; without\-match: do not+search binary files; and text: treat all files as text.+.It Fl Fl label= Ns Ar name+Print name instead of the filename before lines.+.It Fl Fl line\-buffered+Force output to be line buffered. By default, output is line buffered when+standard output is a terminal and block buffered otherwise.+.It Fl Fl null+Output a zero byte instead of the character that normally follows a file name.+This option makes the output unambiguous, even in the presence of file names+containing unusual characters like newlines. This is similar to the \-print0+primary in find(1).+.It Ar pattern+.It Ar file+.El+.Sh ENVIRONMENT+The following environment variables affect the execution of+.Nm :+.Bl -tag -width "GREP_OPTIONS"+.It Ev GREP_COLOR+This variable specifies the color used to highlight matched (non\-empty) text.+.It Ev GREP_OPTIONS+This variable specifies default options to be placed in front of any explicit+options. It may cause problems with portable scripts.+.It Ev TERM+This variable specifies the type name of the terminal, console or+display\-device type to be used. See term(7).+.El+.Sh EXIT STATUS+.Ex -std+.Sh SEE ALSO+.Xr ed 1 ,+.Xr ex 1 ,+.Xr sed 1 ,+.Xr zgrep 1 ,+.Xr re_format 7
+ examples/mdoc-dump.1 view
@@ -0,0 +1,43 @@+.\" vim: ft=nroff.mustache+.Dd $Mdocdate: September 29 2026 $+.Dt MDOC\-DUMP 1+.Os+.Sh NAME+.Nm mdoc\-dump+.Nd parse and dump an mdoc file+.Sh SYNOPSIS+.Nm+.Bk -words+.Op Fl cv+.Op Fl Fl color= Ns Ar auto|always|never+.Op Fl Fl update\-mdocdate+.Op Ar FILE ...+.Ek+.Sh DESCRIPTION+The options are as follows:+.Bl -tag -width indent+.It Fl c , Fl Fl check+Check that re\-rendering parsed as mdoc matches input+.It Fl v , Fl Fl debug+Log more verbosely+.It Fl Fl color= Ns Ar auto|always|never+When to colorize the output+.It Fl Fl update\-mdocdate+Update any $Mdocdate$ macros in the output+.It Ar FILE+Read from the given file (if specified multiple times, output is concatenated;+if none are specified, stdin is read)+.El+.Sh ENVIRONMENT+The following environment variables affect the execution of+.Nm :+.Bl -tag -width "MDOC_DUMP_DEBUG"+.It Ev MDOC_DUMP_COLOR+When to colorize the output+.It Ev MDOC_DUMP_DEBUG+Log more verbosely+.El+.Sh EXIT STATUS+.Ex -std+.Sh SEE ALSO+.Xr mdoc 7
+ examples/mdoc-dump.1.html view
@@ -0,0 +1,87 @@+<!DOCTYPE html>+<html>+<!-- This is an automatically generated file. Do not edit.+ vim: ft=nroff.mustache+ -->+<head>+ <meta charset="utf-8"/>+ <meta name="viewport" content="width=device-width, initial-scale=1.0"/>+ <link rel="stylesheet" href="./style.css" type="text/css" media="all"/>+ <title>MDOC-DUMP(1)</title>+</head>+<body>+<table class="head">+ <tr>+ <td class="head-ltitle">MDOC-DUMP(1)</td>+ <td class="head-vol">General Commands Manual</td>+ <td class="head-rtitle">MDOC-DUMP(1)</td>+ </tr>+</table>+<div class="manual-text">+<section class="Sh">+<h1 class="Sh" id="NAME"><a class="permalink" href="#NAME">NAME</a></h1>+<p class="Pp"><code class="Nm">mdoc-dump</code> — <span class="Nd">parse+ and dump an mdoc file</span></p>+</section>+<section class="Sh">+<h1 class="Sh" id="SYNOPSIS"><a class="permalink" href="#SYNOPSIS">SYNOPSIS</a></h1>+<table class="Nm">+ <tr>+ <td><code class="Nm">mdoc-dump</code></td>+ <td>[<code class="Fl">-cv</code>]+ [<code class="Fl">--color=</code><var class="Ar">auto|always|never</var>]+ [<code class="Fl">--update-mdocdate</code>]+ [<var class="Ar">FILE ...</var>]</td>+ </tr>+</table>+</section>+<section class="Sh">+<h1 class="Sh" id="DESCRIPTION"><a class="permalink" href="#DESCRIPTION">DESCRIPTION</a></h1>+<p class="Pp">The options are as follows:</p>+<dl class="Bl-tag">+ <dt id="c"><a class="permalink" href="#c"><code class="Fl">-c</code></a>,+ <code class="Fl">--check</code></dt>+ <dd>Check that re-rendering parsed as mdoc matches input</dd>+ <dt id="v"><a class="permalink" href="#v"><code class="Fl">-v</code></a>,+ <code class="Fl">--debug</code></dt>+ <dd>Log more verbosely</dd>+ <dt id="color="><a class="permalink" href="#color="><code class="Fl">--color=</code></a><var class="Ar">auto|always|never</var></dt>+ <dd>When to colorize the output</dd>+ <dt id="update"><a class="permalink" href="#update"><code class="Fl">--update-mdocdate</code></a></dt>+ <dd>Update any $Mdocdate$ macros in the output</dd>+ <dt><var class="Ar">FILE</var></dt>+ <dd>Read from the given file (if specified multiple times, output is+ concatenated; if none are specified, stdin is read)</dd>+</dl>+</section>+<section class="Sh">+<h1 class="Sh" id="ENVIRONMENT"><a class="permalink" href="#ENVIRONMENT">ENVIRONMENT</a></h1>+<p class="Pp">The following environment variables affect the execution of+ <code class="Nm">mdoc-dump</code>:</p>+<dl class="Bl-tag">+ <dt id="MDOC_DUMP_COLOR"><a class="permalink" href="#MDOC_DUMP_COLOR"><code class="Ev">MDOC_DUMP_COLOR</code></a></dt>+ <dd>When to colorize the output</dd>+ <dt id="MDOC_DUMP_DEBUG"><a class="permalink" href="#MDOC_DUMP_DEBUG"><code class="Ev">MDOC_DUMP_DEBUG</code></a></dt>+ <dd>Log more verbosely</dd>+</dl>+</section>+<section class="Sh">+<h1 class="Sh" id="EXIT_STATUS"><a class="permalink" href="#EXIT_STATUS">EXIT+ STATUS</a></h1>+<p class="Pp">The <code class="Nm">mdoc-dump</code> utility exits 0 on+ success, and >0 if an error occurs.</p>+</section>+<section class="Sh">+<h1 class="Sh" id="SEE_ALSO"><a class="permalink" href="#SEE_ALSO">SEE+ ALSO</a></h1>+<p class="Pp"><a class="Xr" href="https://man.openbsd.org/mdoc.7">mdoc(7)</a></p>+</section>+</div>+<table class="foot">+ <tr>+ <td class="foot-date">September 22, 2026</td>+ <td class="foot-os">Linux 6.19.11-arch1-1</td>+ </tr>+</table>+</body>+</html>
+ examples/person.5 view
@@ -0,0 +1,30 @@+.\" vim: ft=nroff.mustache+.Dd $Mdocdate: September 20 2026 $+.Dt PERSON 5+.Os+.Sh NAME+.Nm person+.Nd person example via Codec+.Sh SYNOPSIS+.Bl -tag -width indent -compact+.It Pa person.schema.json+.El+.Sh DESCRIPTION+.Bl -tag -width indent+.It Cm address : Ar object+Their address+.It Cm address.city : Ar string+The city+.It Cm address.postalCode : Ar string+The postal code+.It Cm address.state : Ar string+The state+.It Cm address.street : Ar string+The street+.It Cm age : Ar number+Their age+.It Cm hobbies : Ar string Ns []+Their hobbies+.It Cm name : Ar string+Their name+.El
+ examples/style.css view
@@ -0,0 +1,394 @@+/* https://mandoc.bsd.lv/mandoc.css */+/* $Id: mandoc.css,v 1.48 2021/03/30 19:26:20 schwarze Exp $ */+/*+ * Standard style sheet for mandoc(1) -Thtml and man.cgi(8).+ *+ * Written by Ingo Schwarze <schwarze@openbsd.org>.+ * I place this file into the public domain.+ * Permission to use, copy, modify, and distribute it for any purpose+ * with or without fee is hereby granted, without any conditions.+ */++/* Global defaults. */++html { max-width: 65em;+ --bg: #FFFFFF;+ --fg: #000000; }+body { background: var(--bg);+ color: var(--fg);+ font-family: Helvetica,Arial,sans-serif; }+h1 { font-size: 110%; }+table { margin-top: 0em;+ margin-bottom: 0em;+ border-collapse: collapse; }+/* Some browsers set border-color in a browser style for tbody,+ * but not for table, resulting in inconsistent border styling. */+tbody { border-color: inherit; }+tr { border-color: inherit; }+td { vertical-align: top;+ padding-left: 0.2em;+ padding-right: 0.2em;+ border-color: inherit; }+ul, ol, dl { margin-top: 0em;+ margin-bottom: 0em; }+li, dt { margin-top: 1em; }+pre { font-family: inherit; }++.permalink { border-bottom: thin dotted;+ color: inherit;+ font: inherit;+ text-decoration: inherit; }+* { clear: both }++/* Search form and search results. */++fieldset { border: thin solid silver;+ border-radius: 1em;+ text-align: center; }+input[name=expr] {+ width: 25%; }++table.results { margin-top: 1em;+ margin-left: 2em;+ font-size: smaller; }++/* Header and footer lines. */++table.head { width: 100%;+ border-bottom: 1px dotted #808080;+ margin-bottom: 1em;+ font-size: smaller; }+td.head-vol { text-align: center; }+td.head-rtitle {+ text-align: right; }++table.foot { width: 100%;+ border-top: 1px dotted #808080;+ margin-top: 1em;+ font-size: smaller; }+td.foot-os { text-align: right; }++/* Sections and paragraphs. */++.manual-text {+ margin-left: 3.8em; }+.Nd { }+section.Sh { }+h1.Sh { margin-top: 1.2em;+ margin-bottom: 0.6em;+ margin-left: -3.2em; }+section.Ss { }+h2.Ss { margin-top: 1.2em;+ margin-bottom: 0.6em;+ margin-left: -1.2em;+ font-size: 105%; }+.Pp { margin: 0.6em 0em; }+.Sx { }+.Xr { }++/* Displays and lists. */++.Bd { }+.Bd-indent { margin-left: 3.8em; }++.Bl-bullet { list-style-type: disc;+ padding-left: 1em; }+.Bl-bullet > li { }+.Bl-dash { list-style-type: none;+ padding-left: 0em; }+.Bl-dash > li:before {+ content: "\2014 "; }+.Bl-item { list-style-type: none;+ padding-left: 0em; }+.Bl-item > li { }+.Bl-compact > li {+ margin-top: 0em; }++.Bl-enum { padding-left: 2em; }+.Bl-enum > li { }+.Bl-compact > li {+ margin-top: 0em; }++.Bl-diag { }+.Bl-diag > dt {+ font-style: normal;+ font-weight: bold; }+.Bl-diag > dd {+ margin-left: 0em; }+.Bl-hang { }+.Bl-hang > dt { }+.Bl-hang > dd {+ margin-left: 5.5em; }+.Bl-inset { }+.Bl-inset > dt { }+.Bl-inset > dd {+ margin-left: 0em; }+.Bl-ohang { }+.Bl-ohang > dt { }+.Bl-ohang > dd {+ margin-left: 0em; }+.Bl-tag { margin-top: 0.6em;+ margin-left: 5.5em; }+.Bl-tag > dt {+ float: left;+ margin-top: 0em;+ margin-left: -5.5em;+ padding-right: 0.5em;+ vertical-align: top; }+.Bl-tag > dd {+ clear: right;+ column-count: 1; /* Force block formatting context. */+ width: 100%;+ margin-top: 0em;+ margin-left: 0em;+ margin-bottom: 0.6em;+ vertical-align: top; }+.Bl-compact { margin-top: 0em; }+.Bl-compact > dd {+ margin-bottom: 0em; }+.Bl-compact > dt {+ margin-top: 0em; }++.Bl-column { }+.Bl-column > tbody > tr { }+.Bl-column > tbody > tr > td {+ margin-top: 1em; }+.Bl-compact > tbody > tr > td {+ margin-top: 0em; }++.Rs { font-style: normal;+ font-weight: normal; }+.RsA { }+.RsB { font-style: italic;+ font-weight: normal; }+.RsC { }+.RsD { }+.RsI { font-style: italic;+ font-weight: normal; }+.RsJ { font-style: italic;+ font-weight: normal; }+.RsN { }+.RsO { }+.RsP { }+.RsQ { }+.RsR { }+.RsT { text-decoration: underline; }+.RsU { }+.RsV { }++.eqn { }+.tbl td { vertical-align: middle; }++.HP { margin-left: 3.8em;+ text-indent: -3.8em; }++/* Semantic markup for command line utilities. */++table.Nm { }+code.Nm { font-style: normal;+ font-weight: bold;+ font-family: inherit; }+.Fl { font-style: normal;+ font-weight: bold;+ font-family: inherit; }+.Cm { font-style: normal;+ font-weight: bold;+ font-family: inherit; }+.Ar { font-style: italic;+ font-weight: normal; }+.Op { display: inline; }+.Ic { font-style: normal;+ font-weight: bold;+ font-family: inherit; }+.Ev { font-style: normal;+ font-weight: normal;+ font-family: monospace; }+.Pa { font-style: italic;+ font-weight: normal; }++/* Semantic markup for function libraries. */++.Lb { }+code.In { font-style: normal;+ font-weight: bold;+ font-family: inherit; }+a.In { }+.Fd { font-style: normal;+ font-weight: bold;+ font-family: inherit; }+.Ft { font-style: italic;+ font-weight: normal; }+.Fn { font-style: normal;+ font-weight: bold;+ font-family: inherit; }+.Fa { font-style: italic;+ font-weight: normal; }+.Vt { font-style: italic;+ font-weight: normal; }+.Va { font-style: italic;+ font-weight: normal; }+.Dv { font-style: normal;+ font-weight: normal;+ font-family: monospace; }+.Er { font-style: normal;+ font-weight: normal;+ font-family: monospace; }++/* Various semantic markup. */++.An { }+.Lk { }+.Mt { }+.Cd { font-style: normal;+ font-weight: bold;+ font-family: inherit; }+.Ad { font-style: italic;+ font-weight: normal; }+.Ms { font-style: normal;+ font-weight: bold; }+.St { }+.Ux { }++/* Physical markup. */++.Bf { display: inline; }+.No { font-style: normal;+ font-weight: normal; }+.Em { font-style: italic;+ font-weight: normal; }+.Sy { font-style: normal;+ font-weight: bold; }+.Li { font-style: normal;+ font-weight: normal;+ font-family: monospace; }++/* Tooltip support. */++h1.Sh, h2.Ss { position: relative; }+.An, .Ar, .Cd, .Cm, .Dv, .Em, .Er, .Ev, .Fa, .Fd, .Fl, .Fn, .Ft,+.Ic, code.In, .Lb, .Lk, .Ms, .Mt, .Nd, code.Nm, .Pa, .Rs,+.St, .Sx, .Sy, .Va, .Vt, .Xr {+ display: inline-block;+ position: relative; }++ /*+.An::before { content: "An"; }+.Ar::before { content: "Ar"; }+.Cd::before { content: "Cd"; }+.Cm::before { content: "Cm"; }+.Dv::before { content: "Dv"; }+.Em::before { content: "Em"; }+.Er::before { content: "Er"; }+.Ev::before { content: "Ev"; }+.Fa::before { content: "Fa"; }+.Fd::before { content: "Fd"; }+.Fl::before { content: "Fl"; }+.Fn::before { content: "Fn"; }+.Ft::before { content: "Ft"; }+.Ic::before { content: "Ic"; }+code.In::before { content: "In"; }+.Lb::before { content: "Lb"; }+.Lk::before { content: "Lk"; }+.Ms::before { content: "Ms"; }+.Mt::before { content: "Mt"; }+.Nd::before { content: "Nd"; }+code.Nm::before { content: "Nm"; }+.Pa::before { content: "Pa"; }+.Rs::before { content: "Rs"; }+h1.Sh::before { content: "Sh"; }+h2.Ss::before { content: "Ss"; }+.St::before { content: "St"; }+.Sx::before { content: "Sx"; }+.Sy::before { content: "Sy"; }+.Va::before { content: "Va"; }+.Vt::before { content: "Vt"; }+.Xr::before { content: "Xr"; }++.An::before, .Ar::before, .Cd::before, .Cm::before,+.Dv::before, .Em::before, .Er::before, .Ev::before,+.Fa::before, .Fd::before, .Fl::before, .Fn::before, .Ft::before,+.Ic::before, code.In::before, .Lb::before, .Lk::before,+.Ms::before, .Mt::before, .Nd::before, code.Nm::before,+.Pa::before, .Rs::before,+h1.Sh::before, h2.Ss::before, .St::before, .Sx::before, .Sy::before,+.Va::before, .Vt::before, .Xr::before {+ opacity: 0;+ transition: .15s ease opacity;+ pointer-events: none;+ position: absolute;+ bottom: 100%;+ box-shadow: 0 0 .35em var(--fg);+ padding: .15em .25em;+ white-space: nowrap;+ font-family: Helvetica,Arial,sans-serif;+ font-style: normal;+ font-weight: bold;+ background: var(--bg);+ color: var(--fg); }+.An:hover::before, .Ar:hover::before, .Cd:hover::before, .Cm:hover::before,+.Dv:hover::before, .Em:hover::before, .Er:hover::before, .Ev:hover::before,+.Fa:hover::before, .Fd:hover::before, .Fl:hover::before, .Fn:hover::before,+.Ft:hover::before, .Ic:hover::before, code.In:hover::before,+.Lb:hover::before, .Lk:hover::before, .Ms:hover::before, .Mt:hover::before,+.Nd:hover::before, code.Nm:hover::before, .Pa:hover::before,+.Rs:hover::before, h1.Sh:hover::before, h2.Ss:hover::before, .St:hover::before,+.Sx:hover::before, .Sy:hover::before, .Va:hover::before, .Vt:hover::before,+.Xr:hover::before {+ opacity: 1;+ pointer-events: inherit; }+ */++/* Overrides to avoid excessive margins on small devices. */++@media (max-width: 37.5em) {+.manual-text {+ margin-left: 0.5em; }+h1.Sh, h2.Ss { margin-left: 0em; }+.Bd-indent { margin-left: 2em; }+.Bl-hang > dd {+ margin-left: 2em; }+.Bl-tag { margin-left: 2em; }+.Bl-tag > dt {+ margin-left: -2em; }+.HP { margin-left: 2em;+ text-indent: -2em; }+}++/* Overrides for a dark color scheme for accessibility. */++@media (prefers-color-scheme: dark) {+html { --bg: #1E1F21;+ --fg: #EEEFF1; }+:link { color: #BAD7FF; }+:visited { color: #F6BAFF; }+}++/** Customizations **/+html {+ max-width: 100%;+}++body {+ font-family: monospace;+ font-size: 14px;+ margin-left: 4ex;+ max-width: 100ex;+ line-height: 1.4;+}++table.head, table.foot {+ border-bottom: none;+ border-top: none;+ color: #999;+ font-size: inherit;+ margin: 3px 0 10px 0;+ text-transform: uppercase;+}++.Ev {+ font-style: italic;+}++.permalink {+ border-bottom: none;+}
mdoc.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: mdoc-version: 0.1.1.4+version: 0.2.0.0 license: AGPL-3 license-file: COPYING maintainer: Pat Brisbin@@ -17,7 +17,7 @@ . To pretty-print parsed (or constructed) man-page data, .- * Use @prettyMdoc@ from the @Mdoc@ module and @putDoc@ in "Mdoc.Gen"+ * Use @prettyMdoc@ and @putMdoc@ from the @Mdoc@ module . To generate a man-page from a supported parser library, check the appropriate integration module,@@ -31,8 +31,14 @@ category: Text build-type: Simple extra-source-files:- data/man1.template- data/man5.template+ examples/crontab.5+ examples/example.1+ examples/examplerc.5+ examples/grep.1+ examples/mdoc-dump.1+ examples/mdoc-dump.1.html+ examples/person.5+ examples/style.css extra-doc-files: README.md@@ -47,53 +53,45 @@ Autodocodec.Schema.Mdoc Env.Mdoc Mdoc+ Mdoc.Data.Argument+ Mdoc.Data.Config+ Mdoc.Data.Described+ Mdoc.Data.EnvVar+ Mdoc.Data.Flag+ Mdoc.Data.List+ Mdoc.Data.Named+ Mdoc.Data.Option+ Mdoc.Data.Optionality+ Mdoc.Data.Page+ Mdoc.Data.Positional+ Mdoc.Data.Synopsis Mdoc.Detect Mdoc.Dump.Diff Mdoc.Dump.Env Mdoc.Dump.Main Mdoc.Dump.Options- Mdoc.Gen- Mdoc.Gen.Argument- Mdoc.Gen.Config- Mdoc.Gen.CrossRef- Mdoc.Gen.Described- Mdoc.Gen.Description- Mdoc.Gen.Environment- Mdoc.Gen.EnvVar- Mdoc.Gen.ExitStatus- Mdoc.Gen.File- Mdoc.Gen.Flag- Mdoc.Gen.Man1- Mdoc.Gen.Man5- Mdoc.Gen.Name- Mdoc.Gen.Option- Mdoc.Gen.Optionality- Mdoc.Gen.Synopsis- Mdoc.Gen.Template+ Mdoc.Examples.Grep+ Mdoc.Examples.OptEnvConf+ Mdoc.Examples.Person Mdoc.Input- Mdoc.Interpolated- Mdoc.Interpolation- Mdoc.MacroArg- Mdoc.MacroName- Mdoc.MdocLine Mdoc.Optics Mdoc.Parse- Mdoc.Parse.Interpolation Mdoc.Parse.MacroArg Mdoc.Parse.MacroName+ Mdoc.Parse.Mdoc Mdoc.Parse.MdocLine Mdoc.Parse.TableLine Mdoc.Parse.TroffMacro Mdoc.Prelude Mdoc.Pretty- Mdoc.Pretty.Interpolation- Mdoc.Pretty.MacroArg- Mdoc.Pretty.MacroName- Mdoc.Pretty.MdocLine- Mdoc.Pretty.TableLine- Mdoc.Pretty.TroffMacro- Mdoc.TableLine- Mdoc.TroffMacro+ Mdoc.Syntax+ Mdoc.Syntax.MacroArg+ Mdoc.Syntax.MacroName+ Mdoc.Syntax.Mdoc+ Mdoc.Syntax.MdocLine+ Mdoc.Syntax.TableLine+ Mdoc.Syntax.TroffMacro+ Mdoc.Template Mdoc.UpdateMdocdate OptEnvConf.Mdoc Options.Applicative.Mdoc@@ -134,8 +132,9 @@ opt-env-conf >=0.8.0.0, optics >=0.4.2.1, optparse-applicative >=0.18.1.0,- prettyprinter >=1.7.1,+ prettyprinter >=1.7.2, prettyprinter-ansi-terminal >=1.1.3,+ stache >=2.3.4, text >=2.1.1, time >=1.12.2, zlib >=0.7.1.0@@ -197,15 +196,14 @@ hs-source-dirs: test other-modules: Autodocodec.Schema.MdocSpec- Mdoc.Gen.DescriptionSpec- Mdoc.Gen.ExitStatusSpec- Mdoc.Gen.FlagSpec- Mdoc.GenSpec+ Mdoc.Data.ConfigSpec+ Mdoc.Data.PositionalSpec+ Mdoc.Data.SynopsisSpec+ Mdoc.ExamplesSpec Mdoc.Parse.MacroArgSpec Mdoc.Parse.MdocLineSpec Mdoc.Parse.TableLineSpec Mdoc.Parse.TroffMacroSpec- Mdoc.Test.Fixtures Mdoc.Test.Parse Mdoc.Test.Render Mdoc.UpdateMdocdateSpec@@ -231,16 +229,12 @@ build-depends: aeson >=2.2.3.0,- autodocodec >=0.4.2.2, autodocodec-schema >=0.2.0.1, base >=4.19.2.0 && <5, bytestring >=0.12.1.0,- envparse >=0.6.0, filepath >=1.4.301.0, hspec >=2.11.12, hspec-golden >=0.2.2.0, mdoc,- opt-env-conf >=0.8.0.0,- optparse-applicative >=0.18.1.0, text >=2.1.1, time >=1.12.2
src/Autodocodec/Schema/Mdoc.hs view
@@ -9,47 +9,12 @@ -- Stability : experimental -- Portability : POSIX ----- A small, semi-representative, not type-checked example:------ @--- data Person = Person--- { name :: Text--- , age :: Int--- }------ instance HasCodec Person where--- codec = object \"Person\" $ Person--- \<$> requiredField "name" "Their name" .= (.name)--- \<*> requiredField "age" "Their age" .= (.age)------ schema :: JSONSchema--- schema = jsonSchemaViaCodec @Person--- @------ @--- .\" Generates this mandoc source--- .Sh DESCIPTION--- .Bl -tag -width indent--- .It Cm age : number--- Their age--- .It Cm name : string--- Their name--- .El--- @------ Which renders something like:------ @--- DESCRIPTION------ age : object Their age------ name : string Their name------ @+-- See "Mdoc.Examples.Person". module Autodocodec.Schema.Mdoc- ( addToMan5- , addToMan5ViaCodec+ ( getPage+ , getPageViaCodec++ -- * Re-used by "OptEnvConf.Mdoc" , getConfigs ) where @@ -64,53 +29,17 @@ import Autodocodec.Schema qualified as JSONSchema import Data.Aeson (Value) import Data.Aeson qualified as Aeson-import Data.List (intercalate)-import Data.Text qualified as T-import Mdoc.Gen.Config-import Mdoc.Gen.Described-import Mdoc.Gen.Man5-import Mdoc.Gen.Optionality+import Mdoc.Data.Config+import Mdoc.Data.Described+import Mdoc.Data.Optionality+import Mdoc.Data.Page import Mdoc.Optics --- | Add configuration values to a 'Man5'------ This uses 'getConfigs' without prefix, resulting in output like:------ @--- foo : string--- A foo field that is string------ bar : number--- A bar field that is a number--- @------ for top-level object, or------ @--- : string--- @------ for a top-level primitive------ If the 'JSONSchema' has a top-level @$comment@, and the 'Man5' doesn't yet--- have a description, that will also be set.-addToMan5 :: JSONSchema -> Man5 -> Man5-addToMan5 js m =- m- & field @"name" % field @"description" %~ getComment js- & field @"configs" <>~ getConfigs Nothing js---- | Add to a 'Man5' from the schema of any @a@ with 'HasCodec'-addToMan5ViaCodec :: forall a. HasCodec a => Man5 -> Man5-addToMan5ViaCodec = addToMan5 $ jsonSchemaViaCodec @a+getPage :: JSONSchema -> Page+getPage js = foldr addConfig mempty $ getConfigs Nothing js -getComment :: JSONSchema -> String -> String-getComment js existing = case js of- CommentSchema comment _- | null existing- , not $ T.null comment ->- unpack comment- _ -> existing+getPageViaCodec :: forall a. HasCodec a => Page+getPageViaCodec = getPage $ jsonSchemaViaCodec @a getConfigs :: Maybe (NonEmpty String) -> JSONSchema -> [Described Config] getConfigs mPrefix = uncurry (getConfigs1 mPrefix) . simplifyJSONSchema@@ -143,7 +72,6 @@ Config { name = renderPrefix <$> mPrefix , schema = schema.item- , exampleLines = Nothing } pure $ config <$ schema@@ -169,14 +97,13 @@ prefix = case (mPrefix, pschema) of (Nothing, ListOf {}) -> pure "[]" <> member.item.keys (Nothing, _) -> member.item.keys- (Just p, ListOf {}) -> onLast (<> "[]") p <> member.item.keys+ (Just p, ListOf {}) -> (p & last1 <>~ "[]") <> member.item.keys (Just p, _) -> p <> member.item.keys config = Config { name = Just $ renderPrefix prefix , schema = member.item.schema- , exampleLines = Nothing } simplifyJSONSchema :: JSONSchema -> (Described Schema, [Described ObjectMember])@@ -208,7 +135,7 @@ JSONSchema.Required -> Required _ -> Optional , multiple = False- , helpLines = nonEmpty . lines . unpack =<< mcomment+ , help = textToMdoc =<< mcomment } ] ObjectAllOfSchema os -> concatMap simplifyObjectSchema $ toList os@@ -224,10 +151,10 @@ primitive :: Schema -> (Described Schema, [a]) primitive schema = (required schema, []) --- | 'ValueSchema' is only used for @const {value}@; e.g. it must match the--- @Value@ literally. We don't render complex values, but rendering simple types--- is how an enum, defined as @[{const:error, const:warning}]@, is correctly--- rendered as @error|warning@.+-- | 'ValueSchema' is only used for @const {value}@; i.e. it must match the+-- given @Value@ literally. We don't render complex values, but rendering simple+-- types is how an enum, defined as @[{const:error, const:warning}]@, is+-- correctly rendered as @error|warning@. constSchema :: Value -> Schema constSchema = \case Aeson.Object {} -> "json"
src/Env/Mdoc.hs view
@@ -7,67 +7,28 @@ -- Stability : experimental -- Portability : POSIX ----- A small, semi-representative, not type-checked example:------ @--- -- This input parser--- parser :: Parser Error Options--- parser = Option--- \<$> var str \"FOO\" (help "Use foo")--- \<*> switch \"DEBUG\" (help "Log more verbosely")--- @------ @--- .\" Generates this mandoc source--- .Sh ENVIRONMENT--- The following environment variables affect the execution of--- .Nm--- :--- .Bl -tag -width \"DEBUG\"--- .It Cm DEBUG--- Use foo--- .It Cm FOO--- Log more verbosely--- @------ Which renders something like:------ @--- ENVIRONMENT--- The following environment variables affect the execution of thing:------ DEBUG Log more verbosely------ FOO Use foo--- @------ For something more complete, see "Mdoc.GenSpec".+-- See "Mdoc.Examples.Grep". module Env.Mdoc- ( addToMan1+ ( getPage ) where import Mdoc.Prelude import Env.Internal.Free import Env.Internal.Parser-import Mdoc.Gen.Described-import Mdoc.Gen.EnvVar-import Mdoc.Gen.Man1-import Mdoc.Gen.Optionality-import Mdoc.Optics+import Mdoc.Data.Described+import Mdoc.Data.EnvVar+import Mdoc.Data.Optionality+import Mdoc.Data.Page --- | Add environment variables to a 'Man1'-addToMan1 :: Parser e a -> Man1 -> Man1-addToMan1 p m = m & field @"environment" <>~ envs- where- envs = foldAlt varToEnvVar $ unParser p+getPage :: Parser e a -> Page+getPage = flip appEndo mempty . foldAlt (Endo . addEnvVar . describeVarF) . unParser -varToEnvVar :: VarF e a -> [Described EnvVar]-varToEnvVar v =- [ Described- { item = EnvVar {names = pure $ varfName v, argument = Nothing}- , optionality = maybe Required Defaulted (varfHelpDef v)- , multiple = False- , helpLines = nonEmpty . lines =<< varfHelp v- }- ]+describeVarF :: VarF e a -> Described EnvVar+describeVarF v =+ Described+ { item = EnvVar {names = pure $ varfName v, argument = Nothing}+ , optionality = maybe Required Defaulted (varfHelpDef v)+ , multiple = False+ , help = textToMdoc . pack =<< varfHelp v+ }
src/Mdoc.hs view
@@ -7,27 +7,45 @@ -- Stability : experimental -- Portability : POSIX module Mdoc- ( Mdoc (..)- , parseMdoc- , prettyMdoc+ ( -- * Types+ Mdoc (..)+ , MdocLine (..)+ , MacroArg (..)+ , MacroName (..)++ -- * Printing+ , putMdoc++ -- * Building+ , Named+ , name++ -- * Rendering+ , RenderResult (..)+ , renderTemplate+ , renderTemplateThrow++ -- ** Templates+ , Template+ , man1+ , man5+ , custom++ -- * Util+ , updateMdocdate ) where import Mdoc.Prelude -import Mdoc.MdocLine-import Mdoc.Parse-import Mdoc.Parse.MdocLine+import Mdoc.Data.Named import Mdoc.Pretty-import Mdoc.Pretty.MdocLine--newtype Mdoc = Mdoc- { lines :: [MdocLine]- }- deriving stock (Eq, Generic, Show)- deriving newtype (Monoid, Semigroup)--parseMdoc :: Parser Mdoc-parseMdoc = Mdoc <$> sepEndBy parseMdocLine eol+import Mdoc.Syntax+import Mdoc.Template+import Mdoc.UpdateMdocdate+import System.IO (stdout) -prettyMdoc :: Mdoc -> Doc Ann-prettyMdoc mdoc = vsep $ map prettyMdocLine mdoc.lines+-- | Render an 'Mdoc' with 'ColorAuto' to @stdout@+--+-- For more flexibility, use "Mdoc.Pretty" directly.+putMdoc :: MonadIO m => Mdoc -> m ()+putMdoc = putDoc ColorAuto stdout . prettyMdoc
+ src/Mdoc/Data/Argument.hs view
@@ -0,0 +1,74 @@+-- |+--+-- Module : Mdoc.Data.Argument+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Data.Argument+ ( Argument (..)+ , ShortArg (..)+ , LongArg (..)+ ) where++import Mdoc.Prelude++import Data.Text qualified as T+import Mdoc.Data.Optionality+import Mdoc.Pretty+import Mdoc.Syntax++data Argument = Argument+ { index :: Int+ , schema :: String+ , optionality :: Optionality+ }+ deriving stock (Eq, Ord, Show)+ deriving (ToJSON) via (Rendered Argument)++instance IsString Argument where+ fromString schema =+ Argument+ { index = 0+ , schema+ , optionality = Required+ }++instance Pretty Argument where+ pretty Argument {schema, optionality} = case optionality of+ Required -> "Ar" <+> pretty schema+ _ -> "Op Ar" <+> pretty schema++data ShortArg = ShortArg+ { name :: Char+ , argument :: Argument+ }++instance Pretty ShortArg where+ pretty (ShortArg {name, argument}) =+ prefix (pretty $ esc $ T.singleton name)+ <+> pretty Ar+ <+> pretty argument.schema+ where+ prefix :: Doc ann -> Doc ann+ prefix = case argument.optionality of+ Required -> id+ _ -> (<+> "Op")++data LongArg = LongArg+ { name :: String+ , argument :: Argument+ }++instance Pretty LongArg where+ pretty LongArg {name, argument} =+ prefix (pretty (esc $ pack name))+ <+> pretty Ns+ <+> pretty Ar+ <+> pretty argument.schema+ where+ prefix :: Doc ann -> Doc ann+ prefix = case argument.optionality of+ Required -> (<> "=")+ _ -> (<+> "Ns Op Cm")
+ src/Mdoc/Data/Config.hs view
@@ -0,0 +1,45 @@+-- |+--+-- Module : Mdoc.Data.Config+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Data.Config+ ( Config (..)+ , Schema (..)+ ) where++import Mdoc.Prelude++import Mdoc.Pretty++data Config = Config+ { name :: Maybe String+ , schema :: Schema+ }+ deriving stock (Eq, Ord, Show)+ deriving (ToJSON) via (Rendered Config)++instance Pretty Config where+ pretty c = maybe id prefix c.name $ ":" <+> pretty c.schema+ where+ prefix :: String -> Doc ann -> Doc ann+ prefix n x = "Cm" <+> pretty (esc $ pack n) <+> x++data Schema+ = Simple Text+ | AnyOf [Schema]+ | ListOf Schema+ deriving stock (Eq, Ord, Show)++instance IsString Schema where+ fromString = Simple . pack++instance Pretty Schema where+ pretty = \case+ Simple t -> "Ar" <+> pretty (esc t)+ AnyOf ss -> mconcat $ punctuate " Ns | Ns " $ map pretty ss+ ListOf s@(AnyOf {}) -> "(" <+> pretty s <+> ") Ns []"+ ListOf s -> pretty s <+> "Ns []"
+ src/Mdoc/Data/Described.hs view
@@ -0,0 +1,90 @@+-- |+--+-- Module : Mdoc.Data.Described+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Data.Described+ ( Described (..)+ , required+ , redescribe+ , setHelpText+ , textToMdoc+ ) where++import Mdoc.Prelude++import Data.Aeson (object, (.=))+import Data.Function (on)+import Data.Text qualified as T+import Mdoc.Data.Optionality+import Mdoc.Optics+import Mdoc.Pretty+import Mdoc.Syntax++data Described a = Described+ { item :: a+ , optionality :: Optionality+ , multiple :: Bool+ , help :: Maybe Mdoc+ }+ deriving stock (Functor, Generic, Show)++instance Eq a => Eq (Described a) where+ (==) = (==) `on` (.item)++instance Ord a => Ord (Described a) where+ compare = comparing (.item)++instance Pretty a => Pretty (Described a) where+ pretty d =+ vsep+ $ catMaybes+ [ Just $ ".It" <+> pretty d.item+ , pretty <$> d.help+ ]++instance ToJSON a => ToJSON (Described a) where+ toJSON d =+ object+ [ "head" .= d.item+ , "body" .= d.help+ ]++-- | Describe an item as 'Required', singular, without help+required :: a -> Described a+required item =+ Described+ { item+ , optionality = Required+ , multiple = False+ , help = Nothing+ }++-- | Concat a described list into a single item+--+-- NB. The element descriptions are discarded and 'required' is used. We could+-- get clever (e.g. any required -> required, concatenat help, etc) but it's+-- just not useful in the project to do so.+redescribe :: ([a] -> b) -> [Described a] -> Described b+redescribe f = required . f . map (.item)++setHelp :: Mdoc -> Described a -> Described a+setHelp x = field @"help" ?~ x++-- | Set a 'Described's 'helpLines' from a 'Text'+setHelpText :: Text -> Described a -> Described a+setHelpText = maybe id setHelp . textToMdoc++textToMdoc :: Text -> Maybe Mdoc+textToMdoc =+ fmap+ ( Mdoc+ . intersperse (MacroLine Pp [])+ . map (TextLine . esc)+ . toList+ )+ . nonEmpty+ . T.lines
+ src/Mdoc/Data/EnvVar.hs view
@@ -0,0 +1,37 @@+-- |+--+-- Module : Mdoc.Data.EnvVar+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Data.EnvVar+ ( EnvVar (..)+ ) where++import Mdoc.Prelude++import Mdoc.Data.Argument+import Mdoc.Pretty++data EnvVar = EnvVar+ { names :: NonEmpty String+ , argument :: Maybe Argument+ }+ deriving stock (Eq, Ord, Show)+ deriving (ToJSON) via (Rendered EnvVar)++instance Pretty EnvVar where+ pretty e =+ mconcat+ $ punctuate comma+ $ map ev (init e.names) <> [evArg $ last e.names]+ where+ -- All but last Ev without arg+ ev :: String -> Doc ann+ ev n = "Ev" <+> pretty (esc $ pack n)++ -- Include Arg, long-style on final Ev only+ evArg :: String -> Doc ann+ evArg n = maybe (ev n) (("Ev" <+>) . pretty . LongArg n) e.argument
+ src/Mdoc/Data/Flag.hs view
@@ -0,0 +1,67 @@+-- |+--+-- Module : Mdoc.Data.Flag+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Data.Flag+ ( Flag (..)+ , Flag1 (..)+ , mapFlag+ , mapFlag1+ , getShort+ , getLong+ ) where++import Mdoc.Prelude++import Data.Text qualified as T+import Mdoc.Pretty++data Flag+ = Flag Char [Flag]+ | GNUFlag String [Flag]+ deriving stock (Eq, Show)++instance Pretty Flag where+ pretty =+ mconcat+ . punctuate " , "+ . mapFlag shortSwitch longSwitch++newtype Flag1 = Flag1+ { unwrap :: Flag+ }++instance Pretty Flag1 where+ pretty = mapFlag1 shortSwitch longSwitch . (.unwrap)++shortSwitch :: Char -> Doc ann+shortSwitch c = "Fl" <+> pretty (esc $ T.singleton c)++longSwitch :: String -> Doc ann+longSwitch s = "Fl Fl" <+> pretty (esc $ pack s)++mapFlag :: (Char -> a) -> (String -> a) -> Flag -> [a]+mapFlag fShort fLong = go+ where+ go = \case+ Flag c as -> fShort c : mconcat (map go as)+ GNUFlag s as -> fLong s : mconcat (map go as)++mapFlag1 :: (Char -> a) -> (String -> a) -> Flag -> a+mapFlag1 fShort fLong = \case+ Flag c _ -> fShort c+ GNUFlag s _ -> fLong s++getShort :: Flag -> Maybe Char+getShort flag = case flag of+ Flag c _ -> Just c+ _ -> Nothing++getLong :: Flag -> Maybe String+getLong flag = case flag of+ Flag {} -> Nothing+ GNUFlag s _ -> Just s
+ src/Mdoc/Data/List.hs view
@@ -0,0 +1,84 @@+-- |+--+-- Module : Mdoc.Data.List+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Data.List+ ( List+ , fromNonEmpty+ , singleton++ -- * Width+ , Width (..)+ , Indent+ , ByItem+ ) where++import Mdoc.Prelude++import Data.Aeson (object, (.=))+import Data.Kind (Constraint, Type)+import Data.List.NonEmpty qualified as NE+import Data.Text qualified as T+import Mdoc.Data.Described+import Mdoc.Pretty+import Mdoc.Syntax++type List :: forall {k}. k -> Type -> Type+newtype List t a = List+ { items :: NonEmpty (Described a)+ }+ deriving stock (Eq, Generic, Show)+ deriving (Semigroup) via Generically (List t a)++instance (Ord a, ToJSON a, Width t a) => ToJSON (List t a) where+ toJSON l =+ object+ [ "width" .= renderedWidth (Proxy @t) items+ , "items" .= items+ ]+ where+ items :: NonEmpty (Described a)+ items = NE.sort $ NE.nub l.items++fromNonEmpty :: NonEmpty (Described a) -> List t a+fromNonEmpty = foldMap1 singleton++singleton :: Described a -> List t a+singleton described = List {items = pure described}++data Indent++data ByItem++type Width :: forall {k}. k -> Type -> Constraint+class Width t a where+ renderedWidth :: Proxy t -> NonEmpty (Described a) -> MacroArg++instance Width Indent a where+ renderedWidth _ _ = "indent"++instance Pretty a => Width ByItem a where+ renderedWidth _ =+ Quoted+ . esc+ . maximumBy (comparing T.length)+ . fmap headWidth++headWidth :: Pretty a => Described a -> Text+headWidth = go . T.words . renderPlain . pretty . (.item)+ where+ go :: [Text] -> Text+ go = \case+ [] -> ""+ ("Ev" : rest) -> go rest+ ("Ns" : rest) -> go rest+ ("Ar" : rest) -> go rest+ ("Op" : rest) -> "[" <> go rest <> "]"+ ("Fl" : rest) -> "-" <> go rest+ ("|" : rest) -> "|" <> go rest -- assume Ns-wrapped+ ("," : rest) -> " , " <> go rest -- assume not Ns-wrapped+ (x : rest) -> x <> go rest
+ src/Mdoc/Data/Named.hs view
@@ -0,0 +1,47 @@+-- |+--+-- Module : Mdoc.Data.Named+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Data.Named+ ( Named (..)+ , name+ , addSecondary+ ) where++import Mdoc.Prelude++import Data.Aeson (object, (.=))+import Data.Text qualified as T+import Mdoc.Data.Page+import Mdoc.Optics++data Named = Named+ { names :: NonEmpty Text+ , description :: Text+ , page :: Page+ }+ deriving stock (Eq, Generic, Show)++instance ToJSON Named where+ toJSON named =+ object+ [ "title" .= T.toUpper (esc $ head named.names)+ , "name"+ .= object+ [ "init" .= map esc (init named.names)+ , "last" .= esc (last named.names)+ , "description" .= esc named.description+ ]+ , "page" .= named.page+ ]++name :: Text -> Text -> Page -> Named+name primary description page =+ Named {names = pure primary, description, page}++addSecondary :: Text -> Named -> Named+addSecondary x = field @"names" <>~ pure x
+ src/Mdoc/Data/Option.hs view
@@ -0,0 +1,50 @@+-- |+--+-- Module : Mdoc.Data.Option+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Data.Option+ ( Option (..)+ , Option1 (..)+ ) where++import Mdoc.Prelude++import Mdoc.Data.Argument+import Mdoc.Data.Flag+import Mdoc.Pretty++data Option = Option+ { flag :: Flag+ , argument :: Argument+ }+ deriving stock (Eq, Show)++instance Pretty Option where+ pretty o =+ mconcat+ $ punctuate " , "+ $ mapFlag+ (\c -> shortArg c o.argument)+ (\s -> longArg s o.argument)+ o.flag++newtype Option1 = Option1+ { unwrap :: Option+ }++instance Pretty Option1 where+ pretty (Option1 o) =+ mapFlag1+ (\c -> shortArg c o.argument)+ (\s -> longArg s o.argument)+ o.flag++shortArg :: Char -> Argument -> Doc ann+shortArg c argument = "Fl" <+> pretty (ShortArg c argument)++longArg :: String -> Argument -> Doc ann+longArg s argument = "Fl Fl" <+> pretty (LongArg s argument)
+ src/Mdoc/Data/Optionality.hs view
@@ -0,0 +1,19 @@+-- |+--+-- Module : Mdoc.Data.Optionality+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Data.Optionality+ ( Optionality (..)+ ) where++import Mdoc.Prelude++data Optionality+ = Optional+ | Required+ | Defaulted String+ deriving stock (Eq, Ord, Show)
+ src/Mdoc/Data/Page.hs view
@@ -0,0 +1,83 @@+-- |+--+-- Module : Mdoc.Data.Page+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Data.Page+ ( Page++ -- * Adding to @SYNOPSIS@ / @DESCRIPTION@+ , addSwitch+ , addOption+ , addArgument+ , addConfig++ -- * @ENVIRONMENT@+ , addEnvVar++ -- * Other, rarel-used elements+ , setSynopsis+ , setPrologue+ , setEpilogue+ ) where++import Mdoc.Prelude++import Mdoc.Data.Argument+import Mdoc.Data.Config+import Mdoc.Data.Described+import Mdoc.Data.EnvVar+import Mdoc.Data.List (ByItem, Indent, List)+import Mdoc.Data.List qualified as List+import Mdoc.Data.Positional+import Mdoc.Data.Synopsis (Synopsis (..))+import Mdoc.Data.Synopsis qualified as Synopsis+import Mdoc.Optics+import Mdoc.Syntax++data Page = Page+ { synopsis :: Maybe Synopsis+ , prologue :: Maybe Mdoc+ , options :: Maybe (List Indent Positional)+ , configs :: Maybe (List Indent Config)+ , environment :: Maybe (List ByItem EnvVar)+ , epilogue :: Maybe Mdoc+ }+ deriving stock (Eq, Generic, Show)+ deriving anyclass (ToJSON)+ deriving (Monoid, Semigroup) via Generically Page++addSwitch :: Described Flag -> Page -> Page+addSwitch = addPositional . fmap PositionalSwitch++addOption :: Described Option -> Page -> Page+addOption = addPositional . fmap PositionalOption++addArgument :: Described Argument -> Page -> Page+addArgument = addPositional . fmap PositionalArgument++addPositional :: Described Positional -> Page -> Page+addPositional described m =+ m+ & field @"synopsis" <?>~ Synopsis.singleton described+ & field @"options" <?>~ List.singleton described++addConfig :: Described Config -> Page -> Page+addConfig described m =+ m & field @"configs" <?>~ List.singleton described++addEnvVar :: Described EnvVar -> Page -> Page+addEnvVar described m =+ m & field @"environment" <?>~ List.singleton described++setSynopsis :: Mdoc -> Page -> Page+setSynopsis s = field @"synopsis" ?~ SynopsisCustom s++setPrologue :: Mdoc -> Page -> Page+setPrologue p = field @"prologue" ?~ p++setEpilogue :: Mdoc -> Page -> Page+setEpilogue p = field @"epilogue" ?~ p
+ src/Mdoc/Data/Positional.hs view
@@ -0,0 +1,65 @@+-- |+--+-- Module : Mdoc.Data.Positional+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Data.Positional+ ( Positional (..)+ , Flag (..)+ , Flag1 (..)+ , Option (..)+ , Option1 (..)+ , Argument (..)+ , ShortArg (..)+ , LongArg (..)+ ) where++import Mdoc.Prelude++import Data.Char (isLower, toLower)+import Mdoc.Data.Argument+import Mdoc.Data.Flag+import Mdoc.Data.Option+import Mdoc.Pretty++data Positional+ = PositionalSwitch Flag+ | PositionalOption Option+ | PositionalArgument Argument+ deriving stock (Show)+ deriving (ToJSON) via (Rendered Positional)++instance Eq Positional where+ (==) = curry $ \case+ (PositionalSwitch f1, PositionalSwitch f2) -> f1 == f2+ (PositionalOption o1, PositionalOption o2) -> o1.flag == o2.flag+ (PositionalArgument a1, PositionalArgument a2) -> a1.schema == a2.schema+ _ -> False++instance Ord Positional where+ compare = curry $ \case+ (PositionalSwitch f1, PositionalSwitch f2) -> compareFlags f1 f2+ (PositionalOption o1, PositionalOption o2) -> compareFlags o1.flag o2.flag+ (PositionalArgument a1, PositionalArgument a2) -> comparing (.index) a1 a2+ (PositionalSwitch f, PositionalOption o) -> compareFlags f o.flag+ (PositionalOption o, PositionalSwitch f) -> compareFlags o.flag f+ (_, PositionalArgument {}) -> LT+ (PositionalArgument {}, _) -> GT++instance Pretty Positional where+ pretty = \case+ PositionalSwitch f -> pretty f+ PositionalOption o -> pretty o+ PositionalArgument a -> pretty a++compareFlags :: Flag -> Flag -> Ordering+compareFlags = comparing @(Int, String, Bool) $ \case+ -- 1. short before long+ -- | 2. case-insensitive alphabetically+ -- | | 3. upper before lower+ -- | | |+ Flag c _ -> (1, [toLower c], isLower c)+ GNUFlag s _ -> (2, map toLower s, False)
+ src/Mdoc/Data/Synopsis.hs view
@@ -0,0 +1,95 @@+-- |+--+-- Module : Mdoc.Data.Synopsis+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Data.Synopsis+ ( Synopsis (..)+ , fromList+ , singleton+ ) where++import Mdoc.Prelude++import Data.Char (toLower)+import Data.List (sort, sortOn)+import Mdoc.Data.Described+import Mdoc.Data.Flag+import Mdoc.Data.Optionality+import Mdoc.Data.Positional+import Mdoc.Optics+import Mdoc.Pretty+import Mdoc.Syntax++data Synopsis+ = Synopsis [Described Positional]+ | SynopsisCustom Mdoc+ deriving stock (Eq, Show)+ deriving (ToJSON) via (Rendered Synopsis)++instance Semigroup Synopsis where+ _ <> a@SynopsisCustom {} = a+ a@SynopsisCustom {} <> _ = a+ Synopsis a <> Synopsis b = Synopsis $ a <> b++instance Monoid Synopsis where+ mempty = Synopsis mempty++instance Pretty Synopsis where+ pretty = \case+ Synopsis ps -> pretty $ buildUsage ps+ SynopsisCustom ls -> pretty ls++fromList :: [Described Positional] -> Synopsis+fromList = foldMap singleton++singleton :: Described Positional -> Synopsis+singleton = Synopsis . pure++data Usage ann = Usage+ { chars :: [Char]+ , shorts :: [Doc ann]+ , longs :: [Doc ann]+ , args :: [Doc ann]+ }+ deriving stock (Generic, Show)+ deriving (Monoid, Semigroup) via Generically (Usage ann)+ deriving (ToJSON) via (Rendered (Usage ann))++instance Pretty (Usage ann) where+ pretty u =+ unAnnotate+ $ vsep+ $ catMaybes+ [ Just ".Nm"+ , Just ".Bk -words"+ , (".Op Fl" <+>) . pretty . esc . pack . toList <$> nonEmpty u.chars+ , vsep . toList <$> nonEmpty (u.shorts <> u.longs <> u.args)+ , Just ".Ek"+ ]++buildUsage :: [Described Positional] -> Usage ann+buildUsage = foldl go mempty . sort++go :: Usage ann -> Described Positional -> Usage ann+go acc d = case d.item of+ PositionalSwitch f -> case f of+ Flag c _ -> acc & field @"chars" %~ sortOn toLower . (<> [c])+ GNUFlag {} -> acc & field @"longs" <>~ [opLine $ pretty $ Flag1 f]+ PositionalOption o ->+ let doc = opLine $ pretty $ Option1 o+ in case o.flag of+ Flag {} -> acc & field @"shorts" <>~ [doc]+ GNUFlag {} -> acc & field @"longs" <>~ [doc]+ PositionalArgument a -> acc & field @"args" <>~ [opLine $ ellipsis $ pretty a]+ where+ opLine = case d.optionality of+ Required -> ("." <>)+ _ -> (".Op" <+>)++ ellipsis+ | d.multiple = (<+> "...")+ | otherwise = id
src/Mdoc/Dump/Diff.hs view
@@ -13,7 +13,7 @@ ) where -import Mdoc.Prelude+import Mdoc.Prelude hiding (First) import Data.Algorithm.Diff import Data.Function (on)
src/Mdoc/Dump/Env.hs view
@@ -17,6 +17,7 @@ import Prelude +import Data.String (IsString) import Env import Mdoc.Pretty (Color (..), readColor) @@ -28,7 +29,7 @@ parseEnv :: IO Env parseEnv = Env.parse (header envInfo) envParser -envInfo :: String+envInfo :: IsString s => s envInfo = "parse and dump an mdoc file" envParser :: Parser Error Env
src/Mdoc/Dump/Main.hs view
@@ -20,7 +20,7 @@ import Mdoc.Input import Mdoc.Parse (exitParseError) import Mdoc.Pretty (Ann (..), putDoc, renderPlain)-import Mdoc.UpdateMdocdate+import Mdoc.Syntax import Prettyprinter import System.Exit (exitFailure) import System.IO (stderr, stdout)
src/Mdoc/Dump/Options.hs view
@@ -19,6 +19,7 @@ import Prelude +import Data.String (IsString) import Mdoc.Dump.Env import Mdoc.Pretty (Color (..), readColor, showColor) import Options.Applicative@@ -45,7 +46,7 @@ , debug = env.debug || opt.debug } -optionsInfo :: String+optionsInfo :: IsString s => s optionsInfo = envInfo optionsParser :: Parser Options
+ src/Mdoc/Examples/Grep.hs view
@@ -0,0 +1,88 @@+-- |+--+-- Module : Mdoc.Examples.Grep+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Examples.Grep+ ( grep1+ ) where++import Mdoc.Prelude++import Env qualified+import Env.Mdoc qualified as Env+import Mdoc.Data.Named+import Mdoc.Data.Page+import Mdoc.Syntax+import Options.Applicative qualified as Opt+import Options.Applicative.Mdoc qualified as Opt++-- | Recreates <https://github.com/arp242/bsdgrep/blob/master/grep.1>+grep1 :: Named+grep1 =+ mempty+ & (<> Opt.getPage grepOpt)+ & (<> Env.getPage grepEnv)+ & setEpilogue+ ( Mdoc+ [ MacroLine Sh ["SEE ALSO"]+ , MacroLine Xr ["ed", "1", ","]+ , MacroLine Xr ["ex", "1", ","]+ , MacroLine Xr ["sed", "1", ","]+ , MacroLine Xr ["zgrep", "1", ","]+ , MacroLine Xr ["re_format", "7"]+ ]+ )+ & name "grep" "file pattern searcher"+ & addSecondary "egrep"+ & addSecondary "fgrep"+ & addSecondary "rgrep"++{- FOURMOLU_DISABLE -}+grepOpt :: Opt.Parser ()+grepOpt = void $ (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)+ <$> Opt.optional (Opt.option (Opt.auto @Int) (mconcat [Opt.short 'A', Opt.metavar "num", Opt.help "Print num lines of trailing context after each match. See also the -B and -C options."]))+ <*> Opt.optional (Opt.switch (mconcat [Opt.short 'a', Opt.help "Treat all files as ASCII text. Normally grep will simply print “Binary file ... matches” if files contain binary characters. Use of this option forces grep to output lines matching the specified pattern."]))+ <*> Opt.optional (Opt.option (Opt.auto @Int) (mconcat [Opt.short 'B', Opt.metavar "num", Opt.help "Print num lines of leading context before each match. See also the -A and -C options."]))+ <*> Opt.optional (Opt.switch (mconcat [Opt.short 'b', Opt.help "Each output line is preceded by its position (in bytes) in the file. If option -o is also specified, the position of the matched pattern is displayed."]))+ <*> Opt.optional (Opt.option (Opt.auto @Int) (mconcat [Opt.short 'C', Opt.long "context", Opt.metavar "num", Opt.help "Print num lines of leading and trailing context surrounding each match. The default is 2 and is equivalent to -A 2 -B 2. Note: no whitespace may be given between the option and its argument."]))+ <*> Opt.optional (Opt.switch (mconcat [Opt.short 'c', Opt.help "Only a count of selected lines is written to standard output."]))+ <*> Opt.optional (Opt.switch (mconcat [Opt.short 'E', Opt.help "Interpret pattern as an extended regular expression (i.e. force grep to behave as egrep)."]))+ <*> Opt.optional (Opt.option (Opt.str @String) (mconcat [Opt.short 'e', Opt.metavar "pattern", Opt.help "Specify a pattern used during the search of the input: an input line is selected if it matches any of the specified patterns. This option is most useful when multiple -e options are used to specify multiple patterns, or when a pattern begins with a dash (‘-’)."]))+ <*> Opt.optional (Opt.switch (mconcat [Opt.short 'F', Opt.help "Interpret pattern as a set of fixed strings (i.e. force grep to behave as fgrep)."]))+ <*> Opt.optional (Opt.option (Opt.str @String) (mconcat [Opt.short 'f', Opt.metavar "file", Opt.help "Read one or more newline separated patterns from file. Empty pattern lines match every input line. Newlines are not considered part of a pattern. If file is empty, nothing is matched."]))+ <*> Opt.optional (Opt.switch (mconcat [Opt.short 'G', Opt.help "Interpret pattern as a basic regular expression (i.e. force grep to behave as traditional grep)."]))+ <*> Opt.optional (Opt.switch (mconcat [Opt.short 'H', Opt.help "Always print filename headers (i.e. filenames) with output lines."]))+ <*> Opt.optional (Opt.switch (mconcat [Opt.short 'h', Opt.help "Never print filename headers (i.e. filenames) with output lines."]))+ <*> Opt.optional (Opt.switch (mconcat [Opt.short 'I', Opt.help "Ignore binary files."]))+ <*> Opt.optional (Opt.switch (mconcat [Opt.short 'i', Opt.help "Perform case insensitive matching. By default, grep is case sensitive."]))+ <*> Opt.optional (Opt.switch (mconcat [Opt.short 'L', Opt.help "Only the names of files not containing selected lines are written to standard output. Pathnames are listed once per file searched. If the standard input is searched, the string “(standard input)” is written."]))+ <*> Opt.optional (Opt.switch (mconcat [Opt.short 'l', Opt.help "Only the names of files containing selected lines are written to standard output. grep will only search a file until a match has been found, making searches potentially less expensive. Pathnames are listed once per file searched. If the standard input is searched, the string “(standard input)” is written."]))+ <*> Opt.optional (Opt.option (Opt.auto @Int) (mconcat [Opt.short 'm', Opt.metavar "num", Opt.help "Stop after finding at least one match on num different lines."]))+ <*> Opt.optional (Opt.switch (mconcat [Opt.short 'n', Opt.help "Each output line is preceded by its relative line number in the file, starting at line 1. The line number counter is reset for each file processed. This option is ignored if -c, -L, -l, or -q is specified."]))+ <*> Opt.optional (Opt.switch (mconcat [Opt.short 'o', Opt.help "Print each match, but only the match, not the entire line."]))+ <*> Opt.optional (Opt.switch (mconcat [Opt.short 'q', Opt.help "Quiet mode: suppress normal output. grep will only search a file until a match has been found, making searches potentially less expensive."]))+ <*> Opt.optional (Opt.switch (mconcat [Opt.short 'R', Opt.help "Recursively search subdirectories listed. If no file is given, grep searches the current working directory."]))+ <*> Opt.optional (Opt.switch (mconcat [Opt.short 's', Opt.help "Silent mode. Nonexistent and unreadable files are ignored (i.e. their error messages are suppressed)."]))+ <*> Opt.optional (Opt.switch (mconcat [Opt.short 'U', Opt.help "Search binary files, but do not attempt to print them."]))+ <*> Opt.optional (Opt.switch (mconcat [Opt.short 'V', Opt.help "Display version information. All other options are ignored."]))+ <*> Opt.optional (Opt.switch (mconcat [Opt.short 'v', Opt.help "Selected lines are those not matching any of the specified patterns."]))+ <*> Opt.optional (Opt.switch (mconcat [Opt.short 'w', Opt.help "The expression is searched for as a word (as if surrounded by ‘[[:<:]]’ and ‘[[:>:]]’; see re_format(7))."]))+ <*> Opt.optional (Opt.switch (mconcat [Opt.short 'x', Opt.help "Only input lines selected against an entire fixed string or regular expression are considered to be matching lines."]))+ <*> Opt.optional (Opt.switch (mconcat [Opt.short 'Z', Opt.help "Force grep to behave as zgrep."]))+ <*> Opt.optional (Opt.option (Opt.str @String) (mconcat [Opt.long "binary-files", Opt.metavar "value", Opt.help "Controls searching and printing of binary files. Options are binary, the default: search binary files but do not print them; without-match: do not search binary files; and text: treat all files as text."]))+ <*> Opt.optional (Opt.option (Opt.str @String) (mconcat [Opt.long "label", Opt.metavar "name", Opt.help "Print name instead of the filename before lines."]))+ <*> Opt.optional (Opt.switch (mconcat [Opt.long "line-buffered", Opt.help "Force output to be line buffered. By default, output is line buffered when standard output is a terminal and block buffered otherwise."]))+ <*> Opt.optional (Opt.switch (mconcat [Opt.long "null", Opt.help "Output a zero byte instead of the character that normally follows a file name. This option makes the output unambiguous, even in the presence of file names containing unusual characters like newlines. This is similar to the -print0 primary in find(1)."]))+ <*> Opt.optional (Opt.argument (Opt.str @String) (mconcat [Opt.metavar "pattern"]))+ <*> Opt.many (Opt.argument (Opt.str @String) (mconcat [Opt.metavar "file"]))++grepEnv :: Env.Parser Env.Error ()+grepEnv = void $ (,,)+ <$> (Env.var @Env.Error @Text) Env.str "GREP_COLOR" (Env.help "This variable specifies the color used to highlight matched (non-empty) text.")+ <*> (Env.var @Env.Error @Text) Env.str "GREP_OPTIONS" (Env.help "This variable specifies default options to be placed in front of any explicit options. It may cause problems with portable scripts.")+ <*> (Env.var @Env.Error @Text) Env.str "TERM" (Env.help "This variable specifies the type name of the terminal, console or display-device type to be used. See term(7).")+{- FOURMOLU_ENABLE -}
+ src/Mdoc/Examples/OptEnvConf.hs view
@@ -0,0 +1,74 @@+-- |+--+-- Module : Mdoc.Examples.OptEnvConf+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Examples.OptEnvConf+ ( conf5+ , example1+ , example5+ ) where++import Mdoc.Prelude++import Mdoc.Data.Named+import Mdoc.Data.Page+import Mdoc.Syntax+import OptEnvConf qualified+import OptEnvConf.Mdoc qualified as OptEnvConf++conf5 :: Named+conf5 =+ mempty+ & (<> OptEnvConf.getPage confParser)+ & setSynopsis+ ( Mdoc+ [ MacroLine Bl ["-tag", "-width", "indent", "-compact"]+ , MacroLine It [Callable Pa, "/etc/cron.daily", ","]+ , MacroLine It [Callable Pa, "/etc/cron.hourly", ","]+ , MacroLine It [Callable Pa, "/etc/cron.weekly"]+ , MacroLine El []+ ]+ )+ & name "crontab" "tables for driving cron"++{- FOURMOLU_DISABLE -}+confParser :: OptEnvConf.Parser ()+confParser = void $ (,)+ <$> OptEnvConf.setting [OptEnvConf.conf @String "foo", OptEnvConf.help "Foo's the fooing of fooers"]+ <*> OptEnvConf.subConfig "bar" ((,)+ <$> OptEnvConf.setting [OptEnvConf.conf @Bool "baz", OptEnvConf.help "Bar's baz of bazzle"]+ <*> OptEnvConf.setting [OptEnvConf.conf @[Int] "bat", OptEnvConf.help "Bar's bat is better than that"])+{- FOURMOLU_ENABLE -}++example1 :: Named+example1 =+ mempty+ & (<> OptEnvConf.getPage exampleParser)+ & name "example" "opt-env-conf example"++example5 :: Named+example5 =+ mempty+ & (<> OptEnvConf.getPage exampleParser)+ & setSynopsis+ ( Mdoc+ [ MacroLine Bl ["-tag", "-width", "indent", "-compact"]+ , MacroLine It [Callable Pa, ".examplerc.yaml"]+ , MacroLine El []+ ]+ )+ & name "examplerc" "opt-env-conf example config"++{- FOURMOLU_DISABLE -}+exampleParser :: OptEnvConf.Parser (Bool, Bool, Text, Text, [Text])+exampleParser = (,,,,)+ <$> OptEnvConf.setting [OptEnvConf.env "DEBUG", OptEnvConf.conf "debug", OptEnvConf.switch True, OptEnvConf.long "debug", OptEnvConf.help "Enable debug", OptEnvConf.value False]+ <*> OptEnvConf.setting [OptEnvConf.conf "verbose", OptEnvConf.switch True, OptEnvConf.short 'v', OptEnvConf.long "verbose", OptEnvConf.value False]+ <*> OptEnvConf.setting [OptEnvConf.env "INPUT", OptEnvConf.option, OptEnvConf.reader OptEnvConf.str, OptEnvConf.short 'i', OptEnvConf.metavar "INPUT"]+ <*> OptEnvConf.setting [OptEnvConf.conf "file", OptEnvConf.argument, OptEnvConf.reader OptEnvConf.str, OptEnvConf.metavar "FILE"]+ <*> OptEnvConf.many (OptEnvConf.setting [OptEnvConf.argument, OptEnvConf.reader OptEnvConf.str, OptEnvConf.metavar "FILE"])+{- FOURMOLU_ENABLE -}
+ src/Mdoc/Examples/Person.hs view
@@ -0,0 +1,64 @@+-- |+--+-- Module : Mdoc.Examples.Person+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Examples.Person+ ( person5+ ) where++import Mdoc.Prelude++import Autodocodec (HasCodec (..), object, optionalField, requiredField, (.=))+import Autodocodec.Schema.Mdoc (getPageViaCodec)+import Mdoc.Data.Named+import Mdoc.Data.Page+import Mdoc.Syntax++data Person = Person+ { name :: Text+ , age :: Int+ , address :: Maybe Address+ , hobbies :: Maybe [Text]+ }++{- FOURMOLU_DISABLE -}+instance HasCodec Person where+ codec = object "Person" $ Person+ <$> requiredField "name" "Their name" .= (.name)+ <*> requiredField "age" "Their age" .= (.age)+ <*> optionalField "address" "Their address" .= (.address)+ <*> optionalField "hobbies" "Their hobbies" .= (.hobbies)+{- FOURMOLU_ENABLE -}++data Address = Address+ { street :: Text+ , city :: Text+ , state :: Text+ , postalCode :: Text+ }++{- FOURMOLU_DISABLE -}+instance HasCodec Address where+ codec = object "Address" $ Address+ <$> requiredField "street" "The street" .= (.street)+ <*> requiredField "city" "The city" .= (.city)+ <*> requiredField "state" "The state" .= (.state)+ <*> requiredField "postalCode" "The postal code" .= (.postalCode)+{- FOURMOLU_ENABLE -}++person5 :: Named+person5 =+ mempty+ & (<> getPageViaCodec @Person)+ & setSynopsis+ ( Mdoc+ [ MacroLine Bl ["-tag", "-width", "indent", "-compact"]+ , MacroLine It [Callable Pa, "person.schema.json"]+ , MacroLine El []+ ]+ )+ & name "person" "person example via Codec"
− src/Mdoc/Gen.hs
@@ -1,76 +0,0 @@--- |------ Module : Mdoc.Gen--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Gen- ( genMan1- , genMan5- , genMan1Template- , genMan5Template- , putMdoc- ) where--import Mdoc.Prelude--import Data.Text qualified as T-import Mdoc-import Mdoc.Gen.CrossRef-import Mdoc.Gen.Description-import Mdoc.Gen.Environment-import Mdoc.Gen.ExitStatus-import Mdoc.Gen.File-import Mdoc.Gen.Man1-import Mdoc.Gen.Man5-import Mdoc.Gen.Name-import Mdoc.Gen.Synopsis-import Mdoc.Gen.Template-import Mdoc.Pretty-import System.IO (stdout)--genMan1 :: MonadIO m => Man1 -> m Mdoc-genMan1 = genMan1Template TemplateBuiltin1--genMan5 :: MonadIO m => Man5 -> m Mdoc-genMan5 = genMan5Template TemplateBuiltin5--genMan1Template :: MonadIO m => Template -> Man1 -> m Mdoc-genMan1Template t man1 = interpolateTemplate vs t- where- vs =- InterpolationValues- { docTitle = T.toUpper $ pack man1.name.primary- , docSection = 1- , name = nameMdocLines man1.name- , synopsis = man1Synopsis man1- , description = man1Description man1- , environment = nonEmpty $ man1Environment man1- , files = renderFiles <$> nonEmpty man1.files- , exitStatus = renderExitStatuses <$> man1.exitStatus- , seeAlso = renderCrossRefs <$> nonEmpty man1.seeAlso- }--genMan5Template :: MonadIO m => Template -> Man5 -> m Mdoc-genMan5Template t man5 = interpolateTemplate vs t- where- vs =- InterpolationValues- { docTitle = T.toUpper $ pack man5.name.primary- , docSection = 5- , name = nameMdocLines man5.name- , synopsis = man5Synopsis man5- , description = man5Description man5- , environment = Nothing -- unused- , files = Nothing -- unused- , exitStatus = Nothing -- unused- , seeAlso = renderCrossRefs <$> nonEmpty man5.seeAlso- }---- | Render an 'Mdoc' with 'ColorAuto' to @stdout@------ For more flexibility, use "Mdoc.Pretty" directly.-putMdoc :: MonadIO m => Mdoc -> m ()-putMdoc = putDoc ColorAuto stdout . prettyMdoc
− src/Mdoc/Gen/Argument.hs
@@ -1,58 +0,0 @@--- |------ Module : Mdoc.Gen.Argument--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Gen.Argument- ( Argument (..)- , renderArgument- , renderArgumentForShort- , renderArgumentForLong- ) where--import Mdoc.Prelude--import Data.Text qualified as T-import Mdoc.Gen.Optionality-import Mdoc.MacroArg-import Mdoc.MacroName--data Argument = Argument- { schema :: String- , optionality :: Optionality- }- deriving stock (Eq, Show)--instance IsString Argument where- fromString schema =- Argument- { schema- , optionality = Required- }--renderArgument :: Argument -> [MacroArg]-renderArgument Argument {schema} = [Callable Ar, Bare $ esc $ pack schema]--renderArgumentForShort :: Char -> Argument -> [MacroArg]-renderArgumentForShort c arg@Argument {optionality} =- case optionality of- Required -> Bare (esc $ T.singleton c) : renderArgument arg- _ -> [Bare $ esc $ T.singleton c, Callable Op] <> renderArgument arg--renderArgumentForLong :: String -> Argument -> [MacroArg]-renderArgumentForLong x arg@Argument {optionality} =- prefix <> [Callable Ns] <> renderArgument arg- where- prefix =- case optionality of- Required -> [Bare $ esc $ pack $ x <> "="]- _ ->- [ Bare $ esc $ pack x- , Callable Ns- , Callable Op- , Callable Cm- , Bare "="- ]
− src/Mdoc/Gen/Config.hs
@@ -1,58 +0,0 @@--- |------ Module : Mdoc.Gen.Config--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Gen.Config- ( Config (..)- , renderConfig-- -- * Schema- , Schema (..)- ) where--import Mdoc.Prelude--import Data.List (intercalate)-import Mdoc.MacroArg-import Mdoc.MacroName--data Config = Config- { name :: Maybe String- , schema :: Schema- , exampleLines :: Maybe (NonEmpty String)- }- deriving stock (Eq, Show)--renderConfig :: Config -> [MacroArg]-renderConfig c =- nameArgs <> [":"] <> schemaArgs c.schema- where- nameArgs =- maybe- []- ( \n ->- [ Callable Cm- , Bare $ esc $ pack n- ]- )- c.name--data Schema- = Simple Text- | AnyOf [Schema]- | ListOf Schema- deriving stock (Eq, Show)--instance IsString Schema where- fromString = Simple . pack--schemaArgs :: Schema -> [MacroArg]-schemaArgs = \case- Simple t -> [Callable Ar, Bare $ esc t]- AnyOf ss -> intercalate [Callable Ns, "|", Callable Ns] $ map schemaArgs ss- ListOf s@(AnyOf {}) -> ["("] <> schemaArgs s <> [")", Callable Ns, "[]"]- ListOf s -> schemaArgs s <> [Callable Ns, "[]"]
− src/Mdoc/Gen/CrossRef.hs
@@ -1,44 +0,0 @@--- |------ Module : Mdoc.Gen.CrossRef--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Gen.CrossRef- ( CrossRef (..)- , renderCrossRefs- ) where--import Mdoc.Prelude--import Data.List.NonEmpty qualified as NE-import Mdoc.MacroArg-import Mdoc.MacroName-import Mdoc.MdocLine--data CrossRef = CrossRef- { name :: String- , section :: Int -- TODO enum- }- deriving stock (Eq, Show)--instance Ord CrossRef where- -- SEE ALSO is sorted section then name- compare = comparing $ \x -> (x.section, x.name)--renderCrossRefs :: NonEmpty CrossRef -> NonEmpty MdocLine-renderCrossRefs = go . NE.sort- where- go ne = map xr_ (init ne) |: xr (last ne)---- | @.Xr@ for a single (or final) cross reference-xr :: CrossRef -> MdocLine-xr CrossRef {name, section} =- MacroLine Xr [Bare $ esc $ pack name, Bare $ esc $ pack $ show section]---- | @.Xr@ for leading cross references with trailing comma-xr_ :: CrossRef -> MdocLine-xr_ CrossRef {name, section} =- MacroLine Xr [Bare $ esc $ pack name, Bare $ esc $ pack $ show section, ","]
− src/Mdoc/Gen/Described.hs
@@ -1,85 +0,0 @@--- |------ Module : Mdoc.Gen.Described--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Gen.Described- ( Described (..)- , required- , redescribe- , setHelpLines- , setHelpText- , partitionDescribed- , renderDescribedItems- , renderDescribedItem- ) where--import Mdoc.Prelude--import Data.List (intersperse)-import Mdoc.Gen.Optionality-import Mdoc.MacroArg-import Mdoc.MacroName-import Mdoc.MdocLine-import Mdoc.Optics--data Described a = Described- { item :: a- , optionality :: Optionality- , multiple :: Bool- , helpLines :: Maybe (NonEmpty String)- }- deriving stock (Eq, Functor, Generic, Show)---- | Describe an item as 'Required', singular, without help-required :: a -> Described a-required item =- Described- { item- , optionality = Required- , multiple = False- , helpLines = Nothing- }---- | Concat a described list into a single item------ NB. The element descriptions are discarded and 'required' is used. We could--- get clever (e.g. any required -> required, concatenat help, etc) but it's--- just not useful in the project to do so.-redescribe :: ([a] -> b) -> [Described a] -> Described b-redescribe f = required . f . map (.item)--setHelpLines :: NonEmpty String -> Described a -> Described a-setHelpLines x = field @"helpLines" ?~ x---- | Set a 'Described's 'helpLines' from a 'Text'-setHelpText :: Text -> Described a -> Described a-setHelpText = maybe id setHelpLines . nonEmpty . lines . unpack--partitionDescribed :: [Described (Either a b)] -> ([Described a], [Described b])-partitionDescribed = go ([], [])- where- go acc [] = acc- go (as, bs) (d : ds) = case d.item of- Left a -> go (as <> [a <$ d], bs) ds- Right b -> go (as, bs <> [b <$ d]) ds--renderDescribedItems- :: Foldable t- => (a -> [MacroArg])- -> t (Described a)- -> [MdocLine]-renderDescribedItems f = concatMap (renderDescribedItem f) . toList---- TODO: add "Default:" line--- TODO: add "This option may be specified multiple times" line-renderDescribedItem :: (a -> [MacroArg]) -> Described a -> [MdocLine]-renderDescribedItem f d = MacroLine It (f d.item) : descriptionLines- where- descriptionLines =- intersperse (MacroLine Pp [])- $ map (TextLine . esc . pack)- $ maybe [] toList d.helpLines
− src/Mdoc/Gen/Description.hs
@@ -1,99 +0,0 @@--- |------ Module : Mdoc.Gen.Description--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Gen.Description- ( man1Description- , man5Description-- -- * Exported for testing- , switchLines- , optionLines- , configLines- ) where--import Mdoc.Prelude--import Data.List (nubBy, sortOn)-import Mdoc.Gen.Argument-import Mdoc.Gen.Config-import Mdoc.Gen.Described-import Mdoc.Gen.Flag-import Mdoc.Gen.Man1 (Man1 (..))-import Mdoc.Gen.Man5 (Man5 (..))-import Mdoc.Gen.Option-import Mdoc.MacroName-import Mdoc.MdocLine--man1Description :: Man1 -> NonEmpty MdocLine-man1Description m = case nonEmpty items of- Nothing -> pure $ TextLine "This program accepts no options"- Just neItems ->- sconcat- $ pure (TextLine "The options are as follows:")- :| [ pure $ MacroLine Bl ["-tag", "-width", "indent"]- , neItems- , pure $ MacroLine El []- ]- where- items = optionsLines m.switches m.options <> argumentsLines m.arguments--man5Description :: Man5 -> NonEmpty MdocLine-man5Description m =- case nonEmpty $ configsLines m.configs of- Nothing -> TextLine "Config file for" :| [MacroLine Nm []]- Just neItems ->- sconcat- $ pure (MacroLine Bl ["-tag", "-width", "indent"])- :| [neItems, pure $ MacroLine El []]--optionsLines :: [Described Flag] -> [Described Option] -> [MdocLine]-optionsLines switches options =- concatMap snd- $ sortOn fst- $ map switchLines switches- <> map optionLines options--switchLines :: Described Flag -> (Flag, [MdocLine])-switchLines d =- ( d.item- , renderDescribedItem (`renderFlag` Nothing) d- )--optionLines :: Described Option -> (Flag, [MdocLine])-optionLines d =- ( d.item.flag- , renderDescribedItem ((`renderFlag` (Just d.item.argument)) . (.flag)) d- )--argumentsLines :: [Described Argument] -> [MdocLine]-argumentsLines = renderDescribedItems renderArgument . nubBy sameArg- where- -- For usage like: PATH [PATH ...], avoid rendering PATH twice in DESCRIPTION- sameArg a b =- and- [ a.item.schema == b.item.schema- , a.helpLines == b.helpLines- ]--configsLines :: [Described Config] -> [MdocLine]-configsLines = concatMap configLines . sortOn (.item.name)--configLines :: Described Config -> [MdocLine]-configLines d = renderDescribedItem renderConfig d <> exampleLines- where- exampleLines :: [MdocLine]- exampleLines = case d.item.exampleLines of- Nothing -> []- Just ls ->- concat- [ [MacroLine Pp []]- , [TextLine "Example:"]- , [MacroLine Bd ["-literal", "-offset", "indent"]]- , map (TextLine . esc . pack) $ toList ls- , [MacroLine Ed []]- ]
− src/Mdoc/Gen/EnvVar.hs
@@ -1,36 +0,0 @@--- |------ Module : Mdoc.Gen.EnvVar--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Gen.EnvVar- ( EnvVar (..)- , renderEnv- ) where--import Mdoc.Prelude--import Data.List (intercalate)-import Mdoc.Gen.Argument-import Mdoc.MacroArg-import Mdoc.MacroName--data EnvVar = EnvVar- { names :: NonEmpty String- , argument :: Maybe Argument- }- deriving stock (Eq, Show)--renderEnv :: EnvVar -> [MacroArg]-renderEnv e = intercalate [Bare ","] $ map ev (init e.names) <> [ev_ $ last e.names]- where- -- All but last Ev without arg- ev n = [Callable Ev, Bare $ esc $ pack n]-- -- Include Arg, long-style on final Ev only- ev_ n = case e.argument of- Nothing -> ev n- Just argument -> Callable Ev : renderArgumentForLong n argument
− src/Mdoc/Gen/Environment.hs
@@ -1,38 +0,0 @@--- |------ Module : Mdoc.Gen.Environment--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Gen.Environment- ( man1Environment- ) where--import Mdoc.Prelude--import Data.List (sortOn)-import Mdoc.Gen.Described-import Mdoc.Gen.EnvVar-import Mdoc.Gen.Man1-import Mdoc.MacroArg-import Mdoc.MacroName-import Mdoc.MdocLine--man1Environment :: Man1 -> [MdocLine]-man1Environment m =- case nonEmpty $ sortOn (head . (.item.names)) m.environment of- Nothing -> []- Just ne ->- let- longest :: String- longest = maximumBy (comparing length) $ head . (.item.names) <$> ne- in- concat- [ [TextLine "The following environment variables affect the execution of"]- , [MacroLine Nm [":"]]- , [MacroLine Bl ["-tag", "-width", Quoted $ esc $ pack longest]]- , renderDescribedItems renderEnv ne- , [MacroLine El []]- ]
− src/Mdoc/Gen/ExitStatus.hs
@@ -1,38 +0,0 @@--- |------ Module : Mdoc.Gen.ExitStatus--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Gen.ExitStatus- ( NonZeroStatus (..)- , renderExitStatuses- ) where--import Mdoc.Prelude--import Mdoc.MacroName-import Mdoc.MdocLine--data NonZeroStatus = NonZeroStatus- { status :: Text- -- ^ For example, @\">0\"@- , condition :: Text- -- ^ For example, @\"if an error occurs\"@- }- deriving stock (Eq, Generic, Show)--renderExitStatuses :: NonEmpty NonZeroStatus -> NonEmpty MdocLine-renderExitStatuses nzs =- TextLine "The"- :| concat- [ [MacroLine Nm []]- , [TextLine "utility exits 0 on success,"]- , map middleLine (init nzs)- , [finaleLine $ last nzs]- ]- where- middleLine nz = TextLine $ nz.status <> " " <> nz.condition <> ","- finaleLine nz = TextLine $ "and " <> nz.status <> " " <> nz.condition <> "."
− src/Mdoc/Gen/File.hs
@@ -1,63 +0,0 @@--- |------ Module : Mdoc.Gen.File--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Gen.File- ( File (..)- , renderFiles- , renderFilesCompact- ) where--import Mdoc.Prelude--import Data.List.NonEmpty qualified as NE-import Mdoc.MacroArg-import Mdoc.MacroName-import Mdoc.MdocLine--data File = File- { path :: FilePath- , description :: Maybe String- }- deriving stock (Eq, Generic, Ord, Show)--instance IsString File where- fromString path = File {path, description = Nothing}---- | Render a list of 'File' with descriptions, e.g. for @FILES@-renderFiles :: NonEmpty File -> NonEmpty MdocLine-renderFiles ne =- MacroLine Bl ["-tag", "-width", Bare $ esc $ pack longestName, "-compact"]- :| concat- [ concatMap renderFileItem (toList $ NE.sort ne)- , [MacroLine El []]- ]- where- longestName :: String- longestName = maximumBy (comparing length) $ (.path) <$> ne--renderFileItem :: File -> [MdocLine]-renderFileItem File {path, description} =- [MacroLine It [Callable Pa, Bare $ esc $ pack path]]- <> maybe [] (pure . TextLine . esc . pack) description---- | Render a list of 'File' compactly, e.g. for synopsis-renderFilesCompact :: NonEmpty File -> NonEmpty MdocLine-renderFilesCompact = go . NE.sort- where- go ne =- MacroLine Bl ["-tag", "-width", "indent", "-compact"]- :| concat- [ map pa_ (init ne) <> [pa $ last ne]- , [MacroLine El []]- ]--pa :: File -> MdocLine-pa File {path} = MacroLine It [Callable Pa, Bare $ esc $ pack path]--pa_ :: File -> MdocLine-pa_ File {path} = MacroLine It [Callable Pa, Bare $ esc $ pack path, ","]
− src/Mdoc/Gen/Flag.hs
@@ -1,58 +0,0 @@--- |------ Module : Mdoc.Gen.Flag--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Gen.Flag- ( Flag (..)- , renderFlag- , renderShort- , renderLong- ) where--import Mdoc.Prelude--import Data.Char (isLower, toLower)-import Data.List (intercalate)-import Data.Text qualified as T-import Mdoc.Gen.Argument-import Mdoc.MacroArg-import Mdoc.MacroName--data Flag- = Flag Char [Flag]- | GNUFlag String [Flag]- deriving stock (Eq, Show)--instance Ord Flag where- compare = comparing @(Int, String, Bool) $ \case- -- 1. short before long- -- | 2. case-insensitive alphabetically- -- | | 3. upper before lower- -- | | |- Flag c _ -> (1, [toLower c], isLower c)- GNUFlag s _ -> (2, map toLower s, False)--renderFlag :: Flag -> Maybe Argument -> [MacroArg]-renderFlag flag margument =- intercalate [Bare ","]- $ map ([Callable Fl] <>)- $ go flag- where- go :: Flag -> [[MacroArg]]- go = \case- Flag c as -> renderShort c margument : concatMap go as- GNUFlag s as -> renderLong s margument : concatMap go as--renderShort :: Char -> Maybe Argument -> [MacroArg]-renderShort c = \case- Nothing -> [Bare $ esc $ T.singleton c]- Just argument -> renderArgumentForShort c argument--renderLong :: String -> Maybe Argument -> [MacroArg]-renderLong s = \case- Nothing -> [Callable Fl, Bare $ esc $ pack s]- Just argument -> [Callable Fl] <> renderArgumentForLong s argument
− src/Mdoc/Gen/Man1.hs
@@ -1,69 +0,0 @@--- |------ Module : Mdoc.Gen.Man1--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Gen.Man1- ( Man1 (..)- , baseMan1-- -- * Manual modification- , addFile- , addCrossRef- , addExitStatus- ) where--import Mdoc.Prelude--import Mdoc.Gen.Argument-import Mdoc.Gen.CrossRef-import Mdoc.Gen.Described-import Mdoc.Gen.EnvVar-import Mdoc.Gen.ExitStatus-import Mdoc.Gen.File-import Mdoc.Gen.Flag-import Mdoc.Gen.Name-import Mdoc.Gen.Option-import Mdoc.Optics--data Man1 = Man1- { name :: Name- , switches :: [Described Flag]- , options :: [Described Option]- , arguments :: [Described Argument]- , environment :: [Described EnvVar]- , files :: [File]- , exitStatus :: Maybe (NonEmpty NonZeroStatus)- , seeAlso :: [CrossRef]- }- deriving stock (Eq, Generic, Show)--baseMan1 :: String -> String -> Man1-baseMan1 name nameDescription =- Man1- { name =- Name- { primary = name- , secondaries = []- , description = nameDescription- }- , switches = []- , options = []- , arguments = []- , environment = []- , files = []- , exitStatus = Nothing- , seeAlso = []- }--addFile :: FilePath -> Maybe String -> Man1 -> Man1-addFile path description = field @"files" <>~ [File {path, description}]--addCrossRef :: String -> Int -> Man1 -> Man1-addCrossRef name section = field @"seeAlso" <>~ [CrossRef {name, section}]--addExitStatus :: NonZeroStatus -> Man1 -> Man1-addExitStatus nz = field @"exitStatus" %~ Just . maybe (pure nz) (<> pure nz)
− src/Mdoc/Gen/Man5.hs
@@ -1,42 +0,0 @@--- |------ Module : Mdoc.Gen.Man5--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Gen.Man5- ( Man5 (..)- , baseMan5- ) where--import Mdoc.Prelude--import Mdoc.Gen.Config-import Mdoc.Gen.CrossRef-import Mdoc.Gen.Described-import Mdoc.Gen.File-import Mdoc.Gen.Name--data Man5 = Man5- { name :: Name- , files :: NonEmpty File- , configs :: [Described Config]- , seeAlso :: [CrossRef]- }- deriving stock (Eq, Generic, Show)--baseMan5 :: String -> String -> File -> Man5-baseMan5 name nameDescription file =- Man5- { name =- Name- { primary = name- , secondaries = []- , description = nameDescription- }- , files = pure file- , configs = []- , seeAlso = []- }
− src/Mdoc/Gen/Name.hs
@@ -1,49 +0,0 @@--- |------ Module : Mdoc.Gen.Name--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Gen.Name- ( Name (..)- , nameMdocLines- ) where--import Mdoc.Prelude--import Data.Text qualified as T-import Mdoc.MacroArg-import Mdoc.MacroName-import Mdoc.MdocLine (MdocLine (..))--data Name = Name- { primary :: String- , secondaries :: [String]- , description :: String- }- deriving stock (Eq, Generic, Show)--nameMdocLines :: Name -> NonEmpty MdocLine-nameMdocLines n =- maybe- (nameLines n)- (nameLines n <>)- $ nonEmpty- $ descriptionLines n.description--nameLines :: Name -> NonEmpty MdocLine-nameLines Name {primary, secondaries} =- case nonEmpty secondaries of- Nothing -> pure $ nm primary- Just ne -> map nm_ (primary : init ne) |: nm (last ne)- where- nm :: String -> MdocLine- nm x = MacroLine Nm [Bare $ esc $ pack x]-- nm_ :: String -> MdocLine- nm_ x = MacroLine Nm [Bare $ esc $ pack x, Bare ","]--descriptionLines :: String -> [MdocLine]-descriptionLines d = [MacroLine Nd $ map (Bare . esc) $ T.words $ pack d]
− src/Mdoc/Gen/Option.hs
@@ -1,22 +0,0 @@--- |------ Module : Mdoc.Gen.Option--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Gen.Option- ( Option (..)- ) where--import Mdoc.Prelude--import Mdoc.Gen.Argument-import Mdoc.Gen.Flag--data Option = Option- { flag :: Flag- , argument :: Argument- }- deriving stock (Eq, Show)
− src/Mdoc/Gen/Optionality.hs
@@ -1,38 +0,0 @@--- |------ Module : Mdoc.Gen.Optionality--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Gen.Optionality- ( Optionality (..)- , opLine- ) where--import Mdoc.Prelude--import Mdoc.MacroArg-import Mdoc.MacroName-import Mdoc.MdocLine--data Optionality- = Optional- | Required- | Defaulted String- deriving stock (Eq, Show)---- | Render a macro line as @.Op@ or not------ >>> opLine Fl ["A", Ar, "num"] Required--- .Fl A Ar num--- -A num------ >>> opLine Fl ["A", Ar, "num"] Optional--- .Op Fl A Ar num--- [-A num]-opLine :: MacroName -> [MacroArg] -> Optionality -> MdocLine-opLine n args = \case- Required -> MacroLine n args- _ -> MacroLine Op $ Callable n : args
− src/Mdoc/Gen/Synopsis.hs
@@ -1,77 +0,0 @@-{-# OPTIONS_GHC -Wno-ambiguous-fields #-}---- | <https://mandoc.bsd.lv/mdoc/style/options.html>-module Mdoc.Gen.Synopsis- ( man1Synopsis- , man5Synopsis- ) where--import Mdoc.Prelude--import Data.Char (toLower)-import Data.List (sortOn)-import Mdoc.Gen.Argument-import Mdoc.Gen.Described-import Mdoc.Gen.File-import Mdoc.Gen.Flag-import Mdoc.Gen.Man1-import Mdoc.Gen.Man5-import Mdoc.Gen.Name-import Mdoc.Gen.Option-import Mdoc.Gen.Optionality-import Mdoc.MacroArg-import Mdoc.MacroName-import Mdoc.MdocLine--man1Synopsis :: Man1 -> NonEmpty MdocLine-man1Synopsis m =- MacroLine Nm [Bare $ esc $ pack $ m.name.primary]- :| concat- [ [MacroLine Bk ["-words"]]- , maybe [] (pure . shortsLine) $ shortSwitchChars m.switches- , mapMaybe shortOptionLine m.options- , map snd- $ sortOn fst- $ mapMaybe longSwitchLine m.switches- <> mapMaybe longOptionLine m.options- , map argLine m.arguments- , [MacroLine Ek []]- ]--shortsLine :: NonEmpty Char -> MdocLine-shortsLine cs = MacroLine Op [Callable Fl, Bare $ esc $ pack $ toList cs]--man5Synopsis :: Man5 -> NonEmpty MdocLine-man5Synopsis m = renderFilesCompact m.files--shortSwitchChars :: [Described Flag] -> Maybe (NonEmpty Char)-shortSwitchChars = nonEmpty . sortOn toLower . mapMaybe (\d -> withShort d.item id)--shortOptionLine :: Described Option -> Maybe MdocLine-shortOptionLine d = withShort d.item.flag $ \c ->- opLine Fl (renderShort c $ Just d.item.argument) d.optionality--longSwitchLine :: Described Flag -> Maybe (String, MdocLine)-longSwitchLine d = withLong d.item $ \s ->- (s, opLine Fl (renderLong s Nothing) d.optionality)--longOptionLine :: Described Option -> Maybe (String, MdocLine)-longOptionLine d = withLong d.item.flag $ \s ->- (s, opLine Fl (renderLong s $ Just d.item.argument) d.optionality)--argLine :: Described Argument -> MdocLine-argLine d = opLine Ar margs d.optionality- where- margs- | d.multiple = [Bare $ esc $ pack d.item.schema, "..."]- | otherwise = [Bare $ esc $ pack d.item.schema]--withShort :: Flag -> (Char -> a) -> Maybe a-withShort flag f = case flag of- Flag c _ -> Just $ f c- _ -> Nothing--withLong :: Flag -> (String -> a) -> Maybe a-withLong flag f = case flag of- GNUFlag s _ -> Just $ f s- _ -> Nothing
− src/Mdoc/Gen/Template.hs
@@ -1,80 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}---- |------ Module : Mdoc.Gen.Template--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Gen.Template- ( Template (..)- , TemplateContents (..)- , InterpolationValues (..)- , interpolateTemplate- ) where--import Mdoc.Prelude--import Data.ByteString.Lazy qualified as BSL-import Data.FileEmbed (embedFileRelative)-import Mdoc-import Mdoc.Input-import Mdoc.Interpolated-import Mdoc.Parse-import Mdoc.UpdateMdocdate--data Template- = TemplateBuiltin1- | TemplateBuiltin5- | TemplateFile FilePath- | TemplateBytes TemplateContents--data TemplateContents = TemplateContents- { name :: String- -- ^ Used in parse errors- , bytes :: BSL.ByteString- }--interpolateTemplate- :: MonadIO m- => InterpolationValues- -> Template- -> m Mdoc-interpolateTemplate vs = \case- TemplateBuiltin1 -> interpolateTemplateContents vs builtin1- TemplateBuiltin5 -> interpolateTemplateContents vs builtin5- TemplateFile fp -> interpolateTemplateContents vs =<< getTemplateContents fp- TemplateBytes c -> interpolateTemplateContents vs c--interpolateTemplateContents- :: MonadIO m- => InterpolationValues- -> TemplateContents- -> m Mdoc-interpolateTemplateContents vs c = do- mdoc <-- either exitParseError (pure . interpolate vs)- $ parseMdocBytes c.name c.bytes-- updateMdocdate mdoc--getTemplateContents :: MonadIO m => FilePath -> m TemplateContents-getTemplateContents name = do- bytes <- liftIO $ BSL.readFile name- pure TemplateContents {name, bytes}--builtin1 :: TemplateContents-builtin1 =- TemplateContents- { name = "data/man1.template"- , bytes = BSL.fromStrict $(embedFileRelative "data/man1.template")- }--builtin5 :: TemplateContents-builtin5 =- TemplateContents- { name = "data/man5.template"- , bytes = BSL.fromStrict $(embedFileRelative "data/man5.template")- }
src/Mdoc/Input.hs view
@@ -20,9 +20,10 @@ import Data.ByteString.Lazy qualified as BSL import Data.Text.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode)-import Mdoc import Mdoc.Detect import Mdoc.Parse+import Mdoc.Parse.Mdoc+import Mdoc.Syntax.Mdoc import System.FilePath (takeExtension) data Input = Input
− src/Mdoc/Interpolated.hs
@@ -1,66 +0,0 @@--- |------ Module : Mdoc.Interpolated--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Interpolated- ( InterpolationValues (..)- , Interpolated (..)- )-where--import Mdoc.Prelude--import Mdoc-import Mdoc.Interpolation-import Mdoc.MacroArg-import Mdoc.MacroName-import Mdoc.MdocLine--data InterpolationValues = InterpolationValues- { docTitle :: Text- , docSection :: Int- -- ^ TODO: ManSection enum- , name :: NonEmpty MdocLine- , synopsis :: NonEmpty MdocLine- , description :: NonEmpty MdocLine- , environment :: Maybe (NonEmpty MdocLine)- , files :: Maybe (NonEmpty MdocLine)- , exitStatus :: Maybe (NonEmpty MdocLine)- , seeAlso :: Maybe (NonEmpty MdocLine)- }--class Interpolated a where- interpolate :: InterpolationValues -> a -> a--instance Interpolated [MacroArg] where- interpolate v = concatMap go- where- go = \case- InterpolatedArg DocTitle -> [Bare $ esc v.docTitle]- InterpolatedArg DocSection -> [Bare $ esc $ pack $ show v.docSection]- arg -> [arg]--instance Interpolated [MdocLine] where- interpolate v = concatMap go- where- go = \case- MacroLine m args -> [MacroLine m $ interpolate v args]- InterpolatedLine Name -> toList v.name- InterpolatedLine Synopsis -> toList v.synopsis- InterpolatedLine Description -> toList v.description- InterpolatedLine Environment ->- maybe [] ((MacroLine Sh ["ENVIRONMENT"] :) . toList) v.environment- InterpolatedLine Files ->- maybe [] ((MacroLine Sh ["FILES"] :) . toList) v.files- InterpolatedLine ExitStatus ->- maybe [MacroLine Ex ["-std"]] toList v.exitStatus- InterpolatedLine SeeAlso ->- maybe [] ((MacroLine Sh ["SEE", "ALSO"] :) . toList) v.seeAlso- line -> [line]--instance Interpolated Mdoc where- interpolate v mdoc = mdoc {lines = interpolate v mdoc.lines}
− src/Mdoc/Interpolation.hs
@@ -1,38 +0,0 @@--- |------ Module : Mdoc.Interpolation--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Interpolation- ( Interpolation (..)- , interpolationToText- ) where--import Mdoc.Prelude--data Interpolation- = DocTitle- | DocSection- | Name- | Synopsis- | Description- | Environment- | Files- | ExitStatus- | SeeAlso- deriving stock (Eq, Show)--interpolationToText :: Interpolation -> Text-interpolationToText = \case- DocTitle -> "docTitle"- DocSection -> "docSection"- Name -> "name"- Synopsis -> "synopsis"- Description -> "description"- Environment -> "environment"- Files -> "files"- ExitStatus -> "exitStatus"- SeeAlso -> "seeAlso"
− src/Mdoc/MacroArg.hs
@@ -1,38 +0,0 @@--- |------ Module : Mdoc.MacroArg--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.MacroArg- ( MacroArg (..)-- -- * Lenses- , _Mdocdate- ) where--import Mdoc.Prelude--import Data.Time (Day)-import Mdoc.Interpolation-import Mdoc.MacroName-import Mdoc.Optics--data MacroArg- = Mdocdate (Maybe Day)- | InterpolatedArg Interpolation- | Callable MacroName- | Quoted Text- | QuotedComma Text- | Bare Text- deriving stock (Eq, Show)--instance IsString MacroArg where- fromString = Bare . pack--_Mdocdate :: Prism' MacroArg (Maybe Day)-_Mdocdate = prism Mdocdate $ \case- Mdocdate day -> Right day- other -> Left other
− src/Mdoc/MacroName.hs
@@ -1,149 +0,0 @@--- |------ Module : Mdoc.MacroName--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.MacroName- ( MacroName (..)- , macroNameText- ) where--import Mdoc.Prelude--import Data.Text qualified as T--data MacroName- = PercentA- | PercentB- | PercentC- | PercentD- | PercentI- | PercentJ- | PercentN- | PercentO- | PercentP- | PercentQ- | PercentR- | PercentT- | PercentU- | PercentV- | Ac- | Ad- | An- | Ao- | Ap- | Aq- | Ar- | At- | Bc- | Bd- | Bf- | Bk- | Bl- | Bq- | Brc- | Brq- | Bsx- | Bt- | Bx- | Cd- | Cm- | D1- | Db- | Dc- | Dd- | Dl- | Do- | Dq- | Dt- | Dv- | Dx- | Ec- | Ed- | Ef- | Ek- | El- | Em- | En- | Eo- | Er- | Es- | Ev- | Ex- | Fa- | Fc- | Fd- | Fl- | Fn- | Fo- | Fr- | Ft- | Fx- | Hf- | Ic- | In- | It- | Lb- | Li- | Lk- | Lp- | Ms- | Mt- | Nd- | Nm- | No- | Ns- | Nx- | Oc- | Oo- | Op- | Os- | Ot- | Ox- | Pa- | Pc- | Pf- | Po- | Pp- | Pq- | Qc- | Ql- | Qo- | Qq- | Re- | Rs- | Rv- | Sc- | Sh- | Sm- | So- | Sq- | Ss- | St- | Sx- | Sy- | Ta- | Tg- | Tn- | Ud- | Ux- | Va- | Vt- | Xc- | Xo- | Xr- | Troff'ad- | Troff'br- | Troff'sp- deriving stock (Bounded, Enum, Eq, Show)--macroNameText :: MacroName -> Text-macroNameText n = fromMaybe shown $ percent <|> troff <|> bug- where- shown = pack $ show n- percent = ("%" <>) <$> T.stripPrefix "Percent" shown- troff = T.stripPrefix "Troff'" shown- bug = T.stripPrefix "Bug" shown
− src/Mdoc/MdocLine.hs
@@ -1,37 +0,0 @@--- |------ Module : Mdoc.MdocLine--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.MdocLine- ( MdocLine (..)-- -- * Lenses- , _Dd- ) where--import Mdoc.Prelude--import Mdoc.Interpolation-import Mdoc.MacroArg-import Mdoc.MacroName-import Mdoc.Optics-import Mdoc.TableLine-import Mdoc.TroffMacro--data MdocLine- = Comment Text- | MacroLine MacroName [MacroArg]- | TextLine Text- | TableLines [TableLine]- | TroffMacro TroffMacro- | InterpolatedLine Interpolation- deriving stock (Eq, Show)--_Dd :: Prism' MdocLine [MacroArg]-_Dd = prism (MacroLine Dd) $ \case- MacroLine Dd args -> Right args- other -> Left other
src/Mdoc/Optics.hs view
@@ -9,9 +9,13 @@ module Mdoc.Optics ( field + -- * Missing Optics+ , last1+ -- * Application , (%) , traversed+ , to -- * Access , (^.)@@ -21,18 +25,29 @@ , (?~) , (%~) , (<>~)+ , (<?>~) -- * Construction+ , Lens'+ , lens , Prism' , prism ) where -import Prelude+import Mdoc.Prelude import Data.Generics.Product.Fields import Optics +last1 :: Lens' (NonEmpty a) a+last1 = lens last $ \x y -> init x |: y+ (<>~) :: Semigroup b => Lens' a b -> b -> a -> a l <>~ w = l %~ (<> w) infixr 4 <>~++(<?>~) :: Semigroup b => Lens' a (Maybe b) -> b -> a -> a+l <?>~ w = l <>~ Just w++infixr 4 <?>~
− src/Mdoc/Parse/Interpolation.hs
@@ -1,41 +0,0 @@--- |------ Module : Mdoc.Parse.Interpolation--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Parse.Interpolation- ( parseInterpolationArg- , parseInterpolationLine- ) where--import Mdoc.Prelude--import Mdoc.Interpolation-import Mdoc.Parse--parseInterpolationArg :: Parser Interpolation-parseInterpolationArg =- string "{{" *> choice names <* string "}}" <?> "valid interpolation"- where- names :: [Parser Interpolation]- names = map (parseAs interpolationToText) [DocTitle, DocSection]--parseInterpolationLine :: Parser Interpolation-parseInterpolationLine =- string "{{" *> choice (map try names) <* string "}}" <?> "valid interpolation"- where- names :: [Parser Interpolation]- names =- map- (parseAs interpolationToText)- [ Name- , Synopsis- , Description- , Environment- , Files- , ExitStatus- , SeeAlso- ]
src/Mdoc/Parse/MacroArg.hs view
@@ -13,16 +13,14 @@ import Mdoc.Prelude import Data.Time (fromGregorian)-import Mdoc.MacroArg import Mdoc.Parse-import Mdoc.Parse.Interpolation import Mdoc.Parse.MacroName+import Mdoc.Syntax.MacroArg parseMacroArg :: Parser MacroArg parseMacroArg = choice [ mdocDate- , interpolated , try quotedComma <|> quoted , try callable <|> bare ]@@ -56,9 +54,6 @@ , 12 <$ string "December" ] <?> "month name (e.g. January)"--interpolated :: Parser MacroArg-interpolated = InterpolatedArg <$> parseInterpolationArg callable :: Parser MacroArg callable = Callable <$> parseMacroName <* peek space1 <?> "callable macro"
src/Mdoc/Parse/MacroName.hs view
@@ -12,8 +12,8 @@ import Mdoc.Prelude -import Mdoc.MacroName import Mdoc.Parse+import Mdoc.Syntax.MacroName parseMacroName :: Parser MacroName parseMacroName = choice names <?> "macro name"
+ src/Mdoc/Parse/Mdoc.hs view
@@ -0,0 +1,20 @@+-- |+--+-- Module : Mdoc.Parse.Mdoc+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Parse.Mdoc+ ( parseMdoc+ ) where++import Mdoc.Prelude++import Mdoc.Parse+import Mdoc.Parse.MdocLine+import Mdoc.Syntax.Mdoc++parseMdoc :: Parser Mdoc+parseMdoc = Mdoc <$> sepEndBy parseMdocLine eol
src/Mdoc/Parse/MdocLine.hs view
@@ -12,13 +12,12 @@ import Mdoc.Prelude -import Mdoc.MdocLine import Mdoc.Parse-import Mdoc.Parse.Interpolation import Mdoc.Parse.MacroArg import Mdoc.Parse.MacroName import Mdoc.Parse.TableLine import Mdoc.Parse.TroffMacro+import Mdoc.Syntax.MdocLine parseMdocLine :: Parser MdocLine parseMdocLine =@@ -28,7 +27,6 @@ , try $ TroffMacro <$> parseTroffMacro , TableLines <$> parseTableLines , macroLine <* hspace- , InterpolatedLine <$> parseInterpolationLine , textLine ]
src/Mdoc/Parse/TableLine.hs view
@@ -14,7 +14,7 @@ import Data.Text qualified as T import Mdoc.Parse-import Mdoc.TableLine+import Mdoc.Syntax.TableLine parseTableLines :: Parser [TableLine] parseTableLines = do
src/Mdoc/Parse/TroffMacro.hs view
@@ -17,7 +17,7 @@ import Data.Set qualified as Set import Data.Text qualified as T import Mdoc.Parse-import Mdoc.TroffMacro+import Mdoc.Syntax.TroffMacro parseTroffMacro :: Parser TroffMacro parseTroffMacro =
src/Mdoc/Prelude.hs view
@@ -8,40 +8,55 @@ -- Portability : POSIX module Mdoc.Prelude ( module X+ , throwIO , guarded- , onLast , esc ) where import Prelude as X hiding (head, init, last, tail) import Control.Applicative as X (Alternative, asum, (<|>))+import Control.Exception as X (Exception)+import Control.Exception qualified as Ex import Control.Monad as X (guard, unless, void, when, (<=<)) import Control.Monad.IO.Class as X (MonadIO (..)) import Control.Monad.Trans as X (MonadTrans (..))+import Data.Aeson as X (ToJSON (..)) import Data.Bifunctor as X (bimap, first, second)-import Data.Foldable as X (for_, toList)+import Data.Foldable as X (for_, toList, traverse_) import Data.Foldable1 as X (foldMap1, maximumBy) import Data.Function as X ((&)) import Data.Functor as X ((<&>)) import Data.Functor.Identity as X (Identity)-import Data.List.NonEmpty as X (NonEmpty (..), head, init, last, nonEmpty, tail)+import Data.List as X (intercalate, intersperse)+import Data.List.NonEmpty as X+ ( NonEmpty (..)+ , head+ , init+ , last+ , nonEmpty+ , some1+ , tail+ ) import Data.List.NonEmpty.Extra as X ((|:)) import Data.Maybe as X (catMaybes, fromMaybe, isJust, isNothing, mapMaybe)+import Data.Monoid as X (Alt (..)) import Data.Ord as X (comparing)-import Data.Semigroup as X (sconcat)+import Data.Proxy as X (Proxy (..))+import Data.Semigroup as X (Any (..), Endo (..), First (..), sconcat) import Data.Set as X (Set) import Data.String as X (IsString (..)) import Data.Text as X (Text, pack, unpack) import Data.Text qualified as T-import Data.Void as X (Void)+import Data.Void as X (Void, absurd)+import Debug.Trace as X import GHC.Generics as X (Generic, Generically (..)) +throwIO :: (Exception e, MonadIO m) => e -> m a+throwIO = liftIO . Ex.throwIO+ guarded :: Alternative f => (a -> Bool) -> a -> f a guarded p a = a <$ guard (p a)--onLast :: (a -> a) -> NonEmpty a -> NonEmpty a-onLast f ne = init ne |: f (last ne) esc :: Text -> Text esc =
src/Mdoc/Pretty.hs view
@@ -18,8 +18,12 @@ -- * Re-exports , module Prettyprinter+ , module Prettyprinter.Util - -- * Rendering+ -- * Rendering 'ToJSON' via 'Pretty'+ , Rendered (..)++ -- * Rendering 'Doc a' to 'Text' , putDoc , renderDoc , renderColor@@ -28,11 +32,13 @@ import Mdoc.Prelude +import Data.Aeson (Value) import Data.Text.IO qualified as T import Prettyprinter import Prettyprinter.Render.Terminal (AnsiStyle, bold, color, colorDull) import Prettyprinter.Render.Terminal qualified as Ansi import Prettyprinter.Render.Text qualified as Text+import Prettyprinter.Util import System.IO (Handle, hIsTerminalDevice) data Ann@@ -92,7 +98,7 @@ ColorAlways -> pure True ColorNever -> pure False - liftIO $ T.hPutStr h $ renderDoc useColor doc+ liftIO $ T.hPutStrLn h $ renderDoc useColor doc renderDoc :: Bool -> Doc Ann -> Text renderDoc useColor doc@@ -101,15 +107,13 @@ renderColor :: Doc Ann -> Text renderColor =- (<> "\n")- . Ansi.renderStrict+ Ansi.renderStrict . layoutPretty defaultLayoutOptions . reAnnotate annToAnsi renderPlain :: Doc Ann -> Text renderPlain =- (<> "\n")- . Text.renderStrict+ Text.renderStrict . layoutPretty defaultLayoutOptions annToAnsi :: Ann -> AnsiStyle@@ -126,3 +130,22 @@ AnnDiffAddition -> colorDull Ansi.Green AnnDiffDeletion -> colorDull Ansi.Red AnnDiffContext -> colorDull Ansi.White++-- | Newtype for rendering to a JSON 'String' via 'Pretty'+--+-- @+-- data SomethingWithPretty+-- deriving 'ToJSON' via ('Rendered' SomethingWithPretty)+-- @+newtype Rendered a = Rendered+ { unwrap :: a+ }+ deriving stock (Eq, Functor, Show)+ deriving newtype (Monoid, Pretty, Semigroup)++instance Pretty a => ToJSON (Rendered a) where+ toJSON = toJSON . renderJSON . (.unwrap)+ toEncoding = toEncoding . renderJSON . (.unwrap)++renderJSON :: Pretty a => a -> Value+renderJSON = toJSON . renderPlain . pretty
− src/Mdoc/Pretty/Interpolation.hs
@@ -1,22 +0,0 @@--- |------ Module : Mdoc.Pretty.Interpolation--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Pretty.Interpolation- ( prettyInterpolation- ) where--import Mdoc.Prelude--import Mdoc.Interpolation-import Mdoc.Pretty--prettyInterpolation :: Interpolation -> Doc Ann-prettyInterpolation i =- annotate AnnSymbol "{{"- <> annotate AnnSpecial (pretty $ interpolationToText i)- <> annotate AnnSymbol "}}"
− src/Mdoc/Pretty/MacroArg.hs
@@ -1,53 +0,0 @@--- |------ Module : Mdoc.Pretty.MacroArg--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Pretty.MacroArg- ( prettyMacroArg- ) where--import Mdoc.Prelude--import Data.Text qualified as T-import Data.Time (defaultTimeLocale, formatTime)-import Mdoc.MacroArg-import Mdoc.Pretty-import Mdoc.Pretty.Interpolation-import Mdoc.Pretty.MacroName--prettyMacroArg :: MacroArg -> Doc Ann-prettyMacroArg = \case- Mdocdate md ->- mconcat- [ annotate AnnSymbol "$"- , annotate AnnSpecial "Mdocdate"- , maybe- ""- ( (annotate AnnSymbol ":" <+>)- . annotate AnnArgument- . pretty- . formatTime defaultTimeLocale "%B %e %Y "- )- md- , annotate AnnSymbol "$"- ]- Callable name -> annotate AnnKeyword (prettyMacroName name)- Quoted x ->- mconcat- [ annotate AnnQuote $ pretty '"'- , annotate AnnQuoted $ pretty $ T.replace "\"" "\\\"" x- , annotate AnnQuote $ pretty '"'- ]- QuotedComma x ->- mconcat- [ annotate AnnQuote $ pretty '"'- , annotate AnnQuoted $ pretty $ T.replace "\"" "\\\"" x- , annotate AnnQuote $ pretty '"'- , pretty ("," :: Text)- ]- InterpolatedArg i -> prettyInterpolation i- Bare x -> pretty x
− src/Mdoc/Pretty/MacroName.hs
@@ -1,19 +0,0 @@--- |------ Module : Mdoc.Pretty.MacroName--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Pretty.MacroName- ( prettyMacroName- ) where--import Mdoc.Prelude--import Mdoc.MacroName-import Mdoc.Pretty--prettyMacroName :: MacroName -> Doc Ann-prettyMacroName = pretty . macroNameText
− src/Mdoc/Pretty/MdocLine.hs
@@ -1,34 +0,0 @@--- |------ Module : Mdoc.Pretty.MdocLine--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Pretty.MdocLine- ( prettyMdocLine- ) where--import Mdoc.Prelude--import Mdoc.MdocLine-import Mdoc.Pretty-import Mdoc.Pretty.Interpolation-import Mdoc.Pretty.MacroArg-import Mdoc.Pretty.MacroName-import Mdoc.Pretty.TableLine-import Mdoc.Pretty.TroffMacro--prettyMdocLine :: MdocLine -> Doc Ann-prettyMdocLine = \case- Comment x -> annotate AnnComment $ ".\\\" " <> pretty x- MacroLine name args ->- hsep- $ annotate AnnComment "."- <> annotate AnnCommand (prettyMacroName name)- : map prettyMacroArg args- TextLine x -> pretty x- TableLines ls -> prettyTableLines ls- TroffMacro m -> prettyTroffMacro m- InterpolatedLine i -> prettyInterpolation i
− src/Mdoc/Pretty/TableLine.hs
@@ -1,19 +0,0 @@--- |------ Module : Mdoc.Pretty.TableLine--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Pretty.TableLine- ( prettyTableLines- ) where--import Mdoc.Prelude--import Mdoc.Pretty-import Mdoc.TableLine--prettyTableLines :: [TableLine] -> Doc Ann-prettyTableLines ls = vsep $ ".TS" : map (pretty . (.unwrap)) ls <> [".TE"]
− src/Mdoc/Pretty/TroffMacro.hs
@@ -1,31 +0,0 @@--- |------ Module : Mdoc.Pretty.TroffMacro--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Pretty.TroffMacro- ( prettyTroffMacro- ) where--import Mdoc.Prelude--import Mdoc.Pretty-import Mdoc.TroffMacro--prettyTroffMacro :: TroffMacro -> Doc Ann-prettyTroffMacro = \case- TroffMacroDefineS name mValue ->- annotate AnnKeyword ".ds"- <+> pretty name- <> maybe "" ((" " <>) . pretty) mValue- TroffMacroDefine name mEnd ->- annotate AnnKeyword ".de"- <+> pretty name- <> maybe "" ((" " <>) . pretty) mEnd- TroffMacroCall name args ->- annotate AnnKeyword (pretty $ "." <> name)- <> hsep (punctuate " " (map pretty args))- TroffMacroEnd t -> pretty t
+ src/Mdoc/Syntax.hs view
@@ -0,0 +1,19 @@+-- |+--+-- Module : Mdoc.Syntax+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Syntax+ ( module Mdoc.Syntax.Mdoc+ , module Mdoc.Syntax.MdocLine+ , module Mdoc.Syntax.MacroArg+ , module Mdoc.Syntax.MacroName+ ) where++import Mdoc.Syntax.MacroArg+import Mdoc.Syntax.MacroName+import Mdoc.Syntax.Mdoc+import Mdoc.Syntax.MdocLine
+ src/Mdoc/Syntax/MacroArg.hs view
@@ -0,0 +1,77 @@+-- |+--+-- Module : Mdoc.Syntax.MacroArg+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Syntax.MacroArg+ ( MacroArg (..)++ -- * Lenses+ , _Mdocdate++ -- * Pretty+ , prettyMacroArg+ ) where++import Mdoc.Prelude++import Data.Text qualified as T+import Data.Time (Day, defaultTimeLocale, formatTime)+import Mdoc.Optics+import Mdoc.Pretty+import Mdoc.Syntax.MacroName++data MacroArg+ = Mdocdate (Maybe Day)+ | Callable MacroName+ | Quoted Text+ | QuotedComma Text+ | Bare Text+ deriving stock (Eq, Show)+ deriving (ToJSON) via (Rendered MacroArg)++instance IsString MacroArg where+ fromString = Bare . pack++_Mdocdate :: Prism' MacroArg (Maybe Day)+_Mdocdate = prism Mdocdate $ \case+ Mdocdate day -> Right day+ other -> Left other++prettyMacroArg :: MacroArg -> Doc Ann+prettyMacroArg = \case+ Mdocdate md ->+ mconcat+ [ annotate AnnSymbol "$"+ , annotate AnnSpecial "Mdocdate"+ , maybe+ ""+ ( (annotate AnnSymbol ":" <+>)+ . annotate AnnArgument+ . pretty+ . formatTime defaultTimeLocale "%B %e %Y "+ )+ md+ , annotate AnnSymbol "$"+ ]+ Callable name -> annotate AnnKeyword (prettyMacroName name)+ Quoted x ->+ mconcat+ [ annotate AnnQuote $ pretty '"'+ , annotate AnnQuoted $ pretty $ T.replace "\"" "\\\"" x+ , annotate AnnQuote $ pretty '"'+ ]+ QuotedComma x ->+ mconcat+ [ annotate AnnQuote $ pretty '"'+ , annotate AnnQuoted $ pretty $ T.replace "\"" "\\\"" x+ , annotate AnnQuote $ pretty '"'+ , pretty ("," :: Text)+ ]+ Bare x -> pretty x++instance Pretty MacroArg where+ pretty = unAnnotate . prettyMacroArg
+ src/Mdoc/Syntax/MacroName.hs view
@@ -0,0 +1,159 @@+-- |+--+-- Module : Mdoc.Syntax.MacroName+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Syntax.MacroName+ ( MacroName (..)+ , macroNameText++ -- * Pretty+ , prettyMacroName+ ) where++import Mdoc.Prelude++import Data.Text qualified as T+import Mdoc.Pretty++data MacroName+ = PercentA+ | PercentB+ | PercentC+ | PercentD+ | PercentI+ | PercentJ+ | PercentN+ | PercentO+ | PercentP+ | PercentQ+ | PercentR+ | PercentT+ | PercentU+ | PercentV+ | Ac+ | Ad+ | An+ | Ao+ | Ap+ | Aq+ | Ar+ | At+ | Bc+ | Bd+ | Bf+ | Bk+ | Bl+ | Bq+ | Brc+ | Brq+ | Bsx+ | Bt+ | Bx+ | Cd+ | Cm+ | D1+ | Db+ | Dc+ | Dd+ | Dl+ | Do+ | Dq+ | Dt+ | Dv+ | Dx+ | Ec+ | Ed+ | Ef+ | Ek+ | El+ | Em+ | En+ | Eo+ | Er+ | Es+ | Ev+ | Ex+ | Fa+ | Fc+ | Fd+ | Fl+ | Fn+ | Fo+ | Fr+ | Ft+ | Fx+ | Hf+ | Ic+ | In+ | It+ | Lb+ | Li+ | Lk+ | Lp+ | Ms+ | Mt+ | Nd+ | Nm+ | No+ | Ns+ | Nx+ | Oc+ | Oo+ | Op+ | Os+ | Ot+ | Ox+ | Pa+ | Pc+ | Pf+ | Po+ | Pp+ | Pq+ | Qc+ | Ql+ | Qo+ | Qq+ | Re+ | Rs+ | Rv+ | Sc+ | Sh+ | Sm+ | So+ | Sq+ | Ss+ | St+ | Sx+ | Sy+ | Ta+ | Tg+ | Tn+ | Ud+ | Ux+ | Va+ | Vt+ | Xc+ | Xo+ | Xr+ | Troff'ad+ | Troff'br+ | Troff'sp+ deriving stock (Bounded, Enum, Eq, Show)++macroNameText :: MacroName -> Text+macroNameText n = fromMaybe shown $ percent <|> troff <|> bug+ where+ shown = pack $ show n+ percent = ("%" <>) <$> T.stripPrefix "Percent" shown+ troff = T.stripPrefix "Troff'" shown+ bug = T.stripPrefix "Bug" shown++prettyMacroName :: MacroName -> Doc Ann+prettyMacroName = pretty . macroNameText++instance Pretty MacroName where+ pretty = unAnnotate . prettyMacroName
+ src/Mdoc/Syntax/Mdoc.hs view
@@ -0,0 +1,32 @@+-- |+--+-- Module : Mdoc.Syntax.Mdoc+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Syntax.Mdoc+ ( Mdoc (..)++ -- * Pretty+ , prettyMdoc+ ) where++import Mdoc.Prelude++import Mdoc.Pretty+import Mdoc.Syntax.MdocLine++newtype Mdoc = Mdoc+ { lines :: [MdocLine]+ }+ deriving stock (Eq, Generic, Show)+ deriving newtype (Monoid, Semigroup)+ deriving (ToJSON) via (Rendered Mdoc)++prettyMdoc :: Mdoc -> Doc Ann+prettyMdoc mdoc = vsep $ map prettyMdocLine mdoc.lines++instance Pretty Mdoc where+ pretty = unAnnotate . prettyMdoc
+ src/Mdoc/Syntax/MdocLine.hs view
@@ -0,0 +1,54 @@+-- |+--+-- Module : Mdoc.Syntax.MdocLine+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Syntax.MdocLine+ ( MdocLine (..)++ -- * Lenses+ , _Dd++ -- * Pretty+ , prettyMdocLine+ ) where++import Mdoc.Prelude++import Mdoc.Optics+import Mdoc.Pretty+import Mdoc.Syntax.MacroArg+import Mdoc.Syntax.MacroName+import Mdoc.Syntax.TableLine+import Mdoc.Syntax.TroffMacro++data MdocLine+ = Comment Text+ | MacroLine MacroName [MacroArg]+ | TextLine Text+ | TableLines [TableLine]+ | TroffMacro TroffMacro+ deriving stock (Eq, Show)++_Dd :: Prism' MdocLine [MacroArg]+_Dd = prism (MacroLine Dd) $ \case+ MacroLine Dd args -> Right args+ other -> Left other++prettyMdocLine :: MdocLine -> Doc Ann+prettyMdocLine = \case+ Comment x -> annotate AnnComment $ ".\\\" " <> pretty x+ MacroLine name args ->+ hsep+ $ annotate AnnComment "."+ <> annotate AnnCommand (prettyMacroName name)+ : map prettyMacroArg args+ TextLine x -> reflow x+ TableLines ls -> prettyTableLines ls+ TroffMacro m -> prettyTroffMacro m++instance Pretty MdocLine where+ pretty = unAnnotate . prettyMdocLine
+ src/Mdoc/Syntax/TableLine.hs view
@@ -0,0 +1,26 @@+-- |+--+-- Module : Mdoc.Syntax.TableLine+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Syntax.TableLine+ ( TableLine (..)++ -- * Pretty+ , prettyTableLines+ ) where++import Mdoc.Prelude++import Mdoc.Pretty++newtype TableLine = TableLine+ { unwrap :: Text+ }+ deriving stock (Eq, Show)++prettyTableLines :: [TableLine] -> Doc Ann+prettyTableLines ls = vsep $ ".TS" : map (pretty . (.unwrap)) ls <> [".TE"]
+ src/Mdoc/Syntax/TroffMacro.hs view
@@ -0,0 +1,43 @@+-- |+--+-- Module : Mdoc.Syntax.TroffMacro+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Syntax.TroffMacro+ ( TroffMacro (..)++ -- * Pretty+ , prettyTroffMacro+ ) where++import Mdoc.Prelude++import Mdoc.Pretty++data TroffMacro+ = TroffMacroDefineS Text (Maybe Text)+ | TroffMacroDefine Text (Maybe Text)+ | TroffMacroCall Text [Text]+ | TroffMacroEnd Text+ deriving stock (Eq, Show)++prettyTroffMacro :: TroffMacro -> Doc Ann+prettyTroffMacro = \case+ TroffMacroDefineS name mValue ->+ annotate AnnKeyword ".ds"+ <+> pretty name+ <> maybe "" ((" " <>) . pretty) mValue+ TroffMacroDefine name mEnd ->+ annotate AnnKeyword ".de"+ <+> pretty name+ <> maybe "" ((" " <>) . pretty) mEnd+ TroffMacroCall name args ->+ annotate AnnKeyword (pretty $ "." <> name)+ <> hsep (punctuate " " (map pretty args))+ TroffMacroEnd t -> pretty t++instance Pretty TroffMacro where+ pretty = unAnnotate . prettyTroffMacro
− src/Mdoc/TableLine.hs
@@ -1,18 +0,0 @@--- |------ Module : Mdoc.TableLine--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.TableLine- ( TableLine (..)- ) where--import Mdoc.Prelude--newtype TableLine = TableLine- { unwrap :: Text- }- deriving stock (Eq, Show)
+ src/Mdoc/Template.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE TemplateHaskell #-}++-- |+--+-- Module : Mdoc.Template+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Template+ ( Template+ , RenderResult (..)+ , renderTemplate+ , renderTemplateThrow++ -- * Warnings+ , MustacheWarning+ , putMustacheWarnings+ , displayMustacheWarnings+ , displayMustacheWarning++ -- * Templates+ , custom+ , man1+ , man5+ ) where++import Mdoc.Prelude++import Data.FileEmbed+import Data.Text.Encoding (decodeUtf8)+import Data.Text.Lazy.Encoding (encodeUtf8)+import Mdoc.Data.Named+import Mdoc.Input+import Mdoc.Parse+import Mdoc.Syntax+import System.IO (hPutStrLn, stderr)+import Text.Mustache++data RenderResult+ = Rendered Mdoc+ | RenderedWarnings (NonEmpty MustacheWarning) Mdoc+ | RenderedError ParseError++renderTemplate :: Template -> Named -> RenderResult+renderTemplate t named =+ let+ (warnings, rendered) = renderMustacheW t $ toJSON named+ parsed = parseMdocBytes "<input>" $ encodeUtf8 rendered+ in+ case parsed of+ Left err -> RenderedError err+ Right mdoc -> case nonEmpty warnings of+ Nothing -> Rendered mdoc+ Just ne -> RenderedWarnings ne mdoc++renderTemplateThrow :: MonadIO m => Template -> Named -> m Mdoc+renderTemplateThrow t named = case renderTemplate t named of+ Rendered mdoc -> pure mdoc+ RenderedWarnings ne mdoc -> mdoc <$ putMustacheWarnings ne+ RenderedError err -> throwIO err++custom :: MonadIO m => FilePath -> m Template+custom = compileMustacheFile++man1 :: Template+man1 =+ either (error . errorBundlePretty) id+ $ compileMustacheText "man1"+ $ decodeUtf8 $(embedFile "data/man1.template")++man5 :: Template+man5 =+ either (error . errorBundlePretty) id+ $ compileMustacheText "man5"+ $ decodeUtf8 $(embedFile "data/man5.template")++putMustacheWarnings :: MonadIO m => NonEmpty MustacheWarning -> m ()+putMustacheWarnings = liftIO . hPutStrLn stderr . displayMustacheWarnings++displayMustacheWarnings :: NonEmpty MustacheWarning -> String+displayMustacheWarnings =+ unlines+ . ("Mustache template warnings:" :)+ . map (("- " <>) . displayMustacheWarning)+ . toList
− src/Mdoc/TroffMacro.hs
@@ -1,20 +0,0 @@--- |------ Module : Mdoc.TroffMacro--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.TroffMacro- ( TroffMacro (..)- ) where--import Mdoc.Prelude--data TroffMacro- = TroffMacroDefineS Text (Maybe Text)- | TroffMacroDefine Text (Maybe Text)- | TroffMacroCall Text [Text]- | TroffMacroEnd Text- deriving stock (Eq, Show)
src/Mdoc/UpdateMdocdate.hs view
@@ -14,10 +14,10 @@ import Mdoc.Prelude import Data.Time (Day, getCurrentTime, utctDay)-import Mdoc (Mdoc)-import Mdoc.MacroArg (_Mdocdate)-import Mdoc.MdocLine (_Dd) import Mdoc.Optics+import Mdoc.Syntax.MacroArg (_Mdocdate)+import Mdoc.Syntax.Mdoc+import Mdoc.Syntax.MdocLine (_Dd) updateMdocdate :: MonadIO m => Mdoc -> m Mdoc updateMdocdate mdoc = do
src/OptEnvConf/Mdoc.hs view
@@ -7,87 +7,22 @@ -- Stability : experimental -- Portability : POSIX ----- A small, semi-representative, not type-checked example:------ @--- -- This input parser--- parser :: Parser Options--- parser = Option--- \<$> setting [short 'C', long "context", help "Include context" <> metavar "num"]--- \<*> setting [short 'v', long "debug", env \"DEBUG\", help "Log more verbosely"]--- \<*> some1 (setting [argument, metavar "file"])--- @------ @--- .\" Generates this mandoc source--- .Sh SYNOPSIS--- .Nm--- .Op Fl Ar Cv--- .Op Fl Fl debug--- .Ar file--- .Op Ar file ...--- .Sh DESCRIPTION--- The options are as follows:--- .Bl -tag -width indent--- .It Fl C Ar num--- Include context--- .It Fl v | Fl Fl verbose--- Log more verbosely--- .It Ar file--- .El--- .Sh ENVIRONMENT--- The following environment variables affect the execution of--- .Bl -tag -width \"DEBUG\"--- .It Cm DEBUG--- Log more verbosely--- .El--- .Sh EXIT STATUS--- .Ex -std--- @------ Which renders something like:------ @--- SYNOPSIS--- thing [-Cv] [--debug] file [file ...]------ DESCRIPTION--- The options are as follows:------ -C Include context------ -v | --debug Log more verbosely------ file------ ENVIRONMENT--- The following environment variables affect the execution of thing:------ DEBUG Log more verbosely------ EXIT STATUS--- The thing utility exits 0 for success, and >0 if an error occurs.--- @------ For something more complete, see "Mdoc.GenSpec".+-- See "Mdoc.Examples.OptEnvConf". module OptEnvConf.Mdoc- ( addToMan1- , addToMan5+ ( getPage ) where import Mdoc.Prelude import Autodocodec.Schema.Mdoc qualified as JSONSchema-import Mdoc.Gen.Argument-import Mdoc.Gen.Config-import Mdoc.Gen.Described-import Mdoc.Gen.EnvVar-import Mdoc.Gen.Flag-import Mdoc.Gen.Man1-import Mdoc.Gen.Man5-import Mdoc.Gen.Option-import Mdoc.Gen.Optionality-import Mdoc.Optics+import Mdoc.Data.Argument+import Mdoc.Data.Config+import Mdoc.Data.Described+import Mdoc.Data.EnvVar+import Mdoc.Data.Flag+import Mdoc.Data.Option+import Mdoc.Data.Optionality+import Mdoc.Data.Page import OptEnvConf (ConfDoc (..), EnvDoc (..), OptDoc (..), Parser) import OptEnvConf.Args (Dashed (..)) import OptEnvConf.Doc@@ -97,87 +32,83 @@ , parserOptDocs ) -addToMan1 :: Parser a -> Man1 -> Man1-addToMan1 p m =- m- & field @"switches" <>~ switches- & field @"options" <>~ options- & field @"arguments" <>~ getParserArgs p- & field @"environment" <>~ getParserEnvs p+getPage :: Parser a -> Page+getPage p =+ flip appEndo mempty+ $ mconcat+ [ foldMap (Endo . either addSwitch addOption . splitEither) $ getParserOpts p+ , foldMap (Endo . addArgument) $ getParserArgs p+ , foldMap (Endo . addEnvVar) $ getParserEnvs p+ , foldMap (Endo . addConfig) $ getParserConfs p+ ] where- (switches, options) = partitionDescribed $ getParserOpts p--addToMan5 :: Parser a -> Man5 -> Man5-addToMan5 p m = m & field @"configs" <>~ getParserConfs p+ splitEither :: Described (Either a b) -> Either (Described a) (Described b)+ splitEither d = case d.item of+ Left a -> Left $ a <$ d+ Right b -> Right $ b <$ d getParserOpts :: Parser a -> [Described (Either Flag Option)]-getParserOpts = walkNonCommandDocs (maybe [] optDocToOpt) . parserOptDocs+getParserOpts = walkNonCommandDocs 0 (maybe [] . optDocToOpt) . parserOptDocs getParserArgs :: Parser a -> [Described Argument]-getParserArgs = walkNonCommandDocs (maybe [] optDocToArg) . parserOptDocs+getParserArgs = walkNonCommandDocs 0 (maybe [] . optDocToArg) . parserOptDocs getParserEnvs :: Parser a -> [Described EnvVar]-getParserEnvs = walkNonCommandDocs envDocToEnvVar . parserEnvDocs+getParserEnvs = walkNonCommandDocs 0 envDocToEnvVar . parserEnvDocs -- getParserCmds :: Parser a -> [Command] -- getParserCmds = walkCommandDocs commandDocToCommand . parserOptDocs getParserConfs :: Parser a -> [Described Config]-getParserConfs = walkNonCommandDocs confToConfig . parserConfDocs+getParserConfs = walkNonCommandDocs 0 confToConfig . parserConfDocs -optDocToOpt :: OptDoc -> [Described (Either Flag Option)]-optDocToOpt doc =+optDocToOpt :: Int -> OptDoc -> [Described (Either Flag Option)]+optDocToOpt _ doc = fromMaybe [] $ do flag <- dashedFlags $ optDocDasheds doc let item = case optDocMetavar doc of Nothing -> Left flag- Just schema ->- let- argument = Argument {schema, optionality = Required}- option = Option {flag, argument}- in- Right option+ Just schema -> Right $ Option {flag, argument = fromString schema} pure [ Described { item , optionality = maybe Required Defaulted $ optDocDefault doc , multiple = False- , helpLines = nonEmpty . lines =<< optDocHelp doc+ , help = textToMdoc . pack =<< optDocHelp doc } ] -optDocToArg :: OptDoc -> [Described Argument]-optDocToArg doc =+optDocToArg :: Int -> OptDoc -> [Described Argument]+optDocToArg index doc = case (optDocDasheds doc, optDocMetavar doc) of ([], Just schema) -> [ Described { item = Argument- { schema+ { index+ , schema , optionality = Required } , optionality = maybe Required Defaulted $ optDocDefault doc , multiple = False- , helpLines = nonEmpty . lines =<< optDocHelp doc+ , help = textToMdoc . pack =<< optDocHelp doc } ] _ -> [] -envDocToEnvVar :: EnvDoc -> [Described EnvVar]-envDocToEnvVar doc =+envDocToEnvVar :: Int -> EnvDoc -> [Described EnvVar]+envDocToEnvVar _ doc = [ Described { item = EnvVar { names = envDocVars doc- , argument =- envDocMetavar doc <&> \schema ->- Argument {schema, optionality = Required}+ , argument = envDocMetavar doc <&> fromString } , optionality = maybe Required Defaulted $ envDocDefault doc , multiple = False- , helpLines = nonEmpty . lines =<< envDocHelp doc+ , help = textToMdoc . pack =<< envDocHelp doc } ] @@ -195,8 +126,8 @@ -- } -- ] -confToConfig :: ConfDoc -> [Described Config]-confToConfig doc =+confToConfig :: Int -> ConfDoc -> [Described Config]+confToConfig _ doc = concatMap (\(keys, js) -> addMeta $ JSONSchema.getConfigs (Just keys) js) $ toList $ confDocKeys doc@@ -208,7 +139,7 @@ d { optionality = maybe Required Defaulted $ confDocDefault doc , multiple = False- , helpLines = nonEmpty . lines =<< confDocHelp doc+ , help = textToMdoc . pack =<< confDocHelp doc } : ds @@ -232,14 +163,15 @@ -- AnyDocsOr ds -> concatMap (walkCommandDocs f) ds -- AnyDocsSingle {} -> [] -walkNonCommandDocs :: (a -> [Described b]) -> AnyDocs a -> [Described b]-walkNonCommandDocs f = \case+walkNonCommandDocs+ :: Int -> (Int -> a -> [Described b]) -> AnyDocs a -> [Described b]+walkNonCommandDocs index f = \case AnyDocsCommands {} -> []- AnyDocsAnd ds -> concatMap (walkNonCommandDocs f) ds- AnyDocsOr ds -> concatMap (map mkMultiple . walkNonCommandDocs f) ds- AnyDocsSingle d -> f d+ AnyDocsAnd ds -> concatMap (walkNonCommandDocs (index + 1) f) ds+ AnyDocsOr ds -> concatMap (map mkMultiple . walkNonCommandDocs (index + 1) f) ds+ AnyDocsSingle d -> f index d where -- This is suspect, but it seems we can't distinguish if the Or is being used- -- to indicate some/many or optionality. We'll just do treat it as both since- -- it passes our current tests.+ -- to indicate some/many or optionality. We'll just treat it as both since it+ -- passes our current tests. mkMultiple d = d {optionality = Optional, multiple = True}
src/Options/Applicative/Mdoc.hs view
@@ -9,125 +9,51 @@ -- Stability : experimental -- Portability : POSIX ----- A small, semi-representative, not type-checked example:------ @--- -- This input parser--- parser :: Parser Options--- parser = Option--- \<$> option str (short 'C' <> long "context" <> help "Include context" <> metavar "num"--- \<*> switch (short 'v' <> long "debug" <> help "Log more verbosely")--- \<*> some1 (argument (metavar "file"))--- @------ @--- .\" Generates this mandoc source--- .Sh SYNOPSIS--- .Nm--- .Op Fl Ar Cv--- .Op Fl Fl debug--- .Ar file--- .Op Ar file ...--- .Sh DESCRIPTION--- The options are as follows:--- .Bl ...--- .It Fl C Ar num--- Include context--- .It Fl v | Fl Fl verbose--- Log more verbosely--- .It Ar file--- .El--- .Sh EXIT STATUS--- .Ex -std--- @------ Which renders something like:------ @--- SYNOPSIS--- thing [-Cv] [--debug] file [file ...]------ DESCRIPTION--- The options are as follows:------ -C Include context------ -v | --debug Log more verbosely------ file------ EXIT STATUS--- The thing utility exits 0 for success, and >0 if an error occurs.--- @------ For something more complete, see "Mdoc.GenSpec".+-- See "Mdoc.Examples.Grep". module Options.Applicative.Mdoc- ( addToMan1+ ( getPage ) where import Mdoc.Prelude import Data.List (sort)-import Mdoc.Gen.Argument-import Mdoc.Gen.Described-import Mdoc.Gen.Flag-import Mdoc.Gen.Man1 (Man1 (..))-import Mdoc.Gen.Option-import Mdoc.Gen.Optionality-import Mdoc.Optics+import Mdoc.Data.Argument+import Mdoc.Data.Described+import Mdoc.Data.Flag+import Mdoc.Data.Option+import Mdoc.Data.Optionality+import Mdoc.Data.Page import Options.Applicative (Parser) import Options.Applicative.Common (treeMapParser) import Options.Applicative.Help.Chunk (Chunk (..), unChunk) import Options.Applicative.Help.Pretty (Doc) import Options.Applicative.Types qualified as O import Prettyprinter qualified as Pretty-import Prettyprinter.Render.String qualified as Pretty---- | Only the bits we work on here------ We walk the options, building up one of these from empty, then we append what--- we got to the same fields on the input 'Man1'.-data SubMan1 = SubMan1- { switches :: [Described Flag]- , options :: [Described Option]- , arguments :: [Described Argument]- }- deriving stock (Generic)- deriving (Monoid, Semigroup) via Generically SubMan1--toSub :: Man1 -> SubMan1-toSub Man1 {switches, options, arguments} =- SubMan1 {switches, options, arguments}--fromSub :: Man1 -> SubMan1 -> Man1-fromSub m SubMan1 {switches, options, arguments} =- m- & field @"switches" <>~ switches- & field @"options" <>~ options- & field @"arguments" <>~ arguments+import Prettyprinter.Render.Text qualified as Pretty -addToMan1 :: Parser a -> Man1 -> Man1-addToMan1 p base =- fromSub base- $ foldOptTree (toSub base) optionToMan1- $ treeMapParser (const void) p+getPage :: Parser a -> Page+getPage p = foldOptTree 0 mempty optionToMan1 $ treeMapParser (const void) p -optionToMan1 :: SubMan1 -> Described (O.Option x) -> SubMan1-optionToMan1 acc d = case O.optMain o of+optionToMan1+ :: Int+ -> Page+ -> Described (O.Option x)+ -> Page+optionToMan1 index acc d = case O.optMain o of O.OptReader onames _ _ -> fromMaybe acc $ do flag <- optFlags onames schema <- metavar let- argument = Argument {schema, optionality = Required}+ argument = Argument {index, schema, optionality = Required} option = Option {flag, argument}- pure $ acc {options = acc.options <> [option <$ d]}+ pure $ addOption (option <$ d) acc O.FlagReader onames _ -> fromMaybe acc $ do flag <- optFlags onames- pure $ acc {switches = acc.switches <> [flag <$ d]}+ pure $ addSwitch (flag <$ d) acc O.ArgReader {} -> fromMaybe acc $ do schema <- metavar- let argument = Argument {schema, optionality = Required}- pure $ acc {arguments = acc.arguments <> [argument <$ d]}+ let argument = Argument {index, schema, optionality = Required}+ pure $ addArgument (argument <$ d) acc O.CmdReader {} -> acc -- TODO where o = d.item@@ -147,42 +73,39 @@ O.OptLong x -> GNUFlag x xs foldOptTree- :: SubMan1- -> ( SubMan1- -> Described (O.Option x)- -> SubMan1- )+ :: Int+ -> Page+ -> (Int -> Page -> Described (O.Option x) -> Page) -> O.OptTree (O.Option x)- -> SubMan1-foldOptTree acc f = \case+ -> Page+foldOptTree index acc f = \case O.Leaf o -> case O.optVisibility o of O.Visible ->- f acc+ f index acc $ Described { item = o , optionality = maybe Required Defaulted (O.optShowDefault o) , multiple = False- , helpLines = nonEmpty $ maybe [] lines $ docToString $ O.optHelp o+ , help = textToMdoc =<< docToText (O.optHelp o) } O.Internal -> acc O.Hidden -> acc- O.MultNode ts ->- maybe acc (foldMap1 $ foldOptTree mempty f) $ nonEmpty ts- O.AltNode O.MarkDefault ts ->- maybe acc (foldMap1 $ foldOptTree mempty fAsOptional) $ nonEmpty ts- O.AltNode O.NoDefault ts ->- maybe acc (foldMap1 $ foldOptTree mempty fAsRequired) $ nonEmpty ts- O.BindNode t -> foldOptTree acc fAsMultiple t+ O.MultNode ts -> recur f ts+ O.AltNode O.MarkDefault ts -> recur fAsOptional ts+ O.AltNode O.NoDefault ts -> recur fAsRequired ts+ O.BindNode t -> foldOptTree (index + 1) acc fAsMultiple t where- fAsOptional m d = f m $ d {optionality = Optional}- fAsRequired m d = f m $ d {optionality = Required}- fAsMultiple m d = f m $ d {multiple = True}+ recur g = maybe acc (foldMap1 $ foldOptTree (index + 1) acc g) . nonEmpty -docToString :: Chunk Doc -> Maybe String-docToString =+ fAsOptional i m d = f i m $ d {optionality = Optional}+ fAsRequired i m d = f i m $ d {optionality = Required}+ fAsMultiple i m d = f i m $ d {multiple = True}++docToText :: Chunk Doc -> Maybe Text+docToText = fmap- ( Pretty.renderString+ ( Pretty.renderStrict . Pretty.layoutPretty Pretty.defaultLayoutOptions {Pretty.layoutPageWidth = Pretty.Unbounded} )
test/Autodocodec/Schema/MdocSpec.hs view
@@ -13,159 +13,148 @@ import Mdoc.Prelude import Autodocodec.Schema- ( JSONSchema (..)- , KeyRequirement (..)- , ObjectSchema (..)- ) import Autodocodec.Schema.Mdoc import Data.Aeson qualified as Aeson import Data.List.NonEmpty qualified as NE-import Mdoc.Gen.Config-import Mdoc.Gen.Described-import Mdoc.MdocLine+import Mdoc.Pretty import Mdoc.Test.Render import Test.Hspec spec :: Spec spec = do- describe "getConfigs" $ do+ it "primitive" $ do+ schemaDoc BoolSchema+ `shouldRender` [".It : Ar boolean"]++ it "array of primitive" $ do+ schemaDoc (ArraySchema BoolSchema)+ `shouldRender` [".It : Ar boolean Ns []"]++ it "array of any-of" $ do let- renderJSONSchema :: JSONSchema -> [MdocLine]- renderJSONSchema =- renderDescribedItems renderConfig . getConfigs Nothing+ js :: JSONSchema+ js = ArraySchema (AnyOfSchema $ StringSchema :| [BoolSchema]) - renderJSONSchemaAt :: NonEmpty String -> JSONSchema -> [MdocLine]- renderJSONSchemaAt keys =- renderDescribedItems renderConfig . getConfigs (Just keys)+ schemaDoc js+ `shouldRender` [".It : ( Ar string Ns | Ns Ar boolean ) Ns []"] - it "primitive" $ do- renderJSONSchema BoolSchema- `shouldRender` [".It : Ar boolean"]+ it "any-of with array" $ do+ let+ js :: JSONSchema+ js = AnyOfSchema $ StringSchema :| [ArraySchema BoolSchema] - it "array of primitive" $ do- renderJSONSchema (ArraySchema BoolSchema)- `shouldRender` [".It : Ar boolean Ns []"]+ schemaDoc js+ `shouldRender` [".It : Ar string Ns | Ns Ar boolean Ns []"] - it "array of any-of" $ do- let- js :: JSONSchema- js = ArraySchema (AnyOfSchema $ StringSchema :| [BoolSchema])+ it "log-level example" $ do+ let+ keys :: NonEmpty String+ keys = "log" :| ["level"] - renderJSONSchema js- `shouldRender` [".It : ( Ar string Ns | Ns Ar boolean ) Ns []"]+ js :: JSONSchema+ js =+ AnyOfSchema+ $ ValueSchema (Aeson.String "info")+ :| [ ValueSchema (Aeson.String "warn")+ , ValueSchema (Aeson.String "error")+ ] - it "any-of with array" $ do- let- js :: JSONSchema- js = AnyOfSchema $ StringSchema :| [ArraySchema BoolSchema]+ schemaDocAt keys js+ `shouldRender` [".It Cm log.level : Ar info Ns | Ns Ar warn Ns | Ns Ar error"] - renderJSONSchema js- `shouldRender` [".It : Ar string Ns | Ns Ar boolean Ns []"]+ it "renders types with comments" $ do+ let+ keys :: NonEmpty String+ keys = pure "name" - it "log-level example"- $ do- let- keys :: NonEmpty String- keys = "log" :| ["level"]+ js :: JSONSchema+ js = CommentSchema "The person's name" StringSchema - js :: JSONSchema- js =- AnyOfSchema- $ ValueSchema (Aeson.String "info")- :| [ ValueSchema (Aeson.String "warn")- , ValueSchema (Aeson.String "error")- ]+ schemaDocAt keys js+ `shouldRender` [ ".It Cm name : Ar string"+ , "The person's name"+ ] - renderJSONSchemaAt keys js- `shouldRender` [".It Cm log.level : Ar info Ns | Ns Ar warn Ns | Ns Ar error"]+ context "objects" $ do+ let+ key :: Text -> JSONSchema -> ObjectSchema+ key k s = ObjectKeySchema k Required s Nothing - it "renders types with comments" $ do- let- keys :: NonEmpty String- keys = pure "name"+ keyComment :: Text -> Text -> JSONSchema -> ObjectSchema+ keyComment k d s = ObjectKeySchema k Required s $ Just d - js :: JSONSchema- js = CommentSchema "The person's name" StringSchema+ object :: [ObjectSchema] -> JSONSchema+ object = ObjectSchema . ObjectAllOfSchema . NE.fromList - renderJSONSchemaAt keys js- `shouldRender` [ ".It Cm name : Ar string"- , "The person's name"- ]+ it "special case, any" $ do+ schemaDoc (ObjectSchema ObjectAnySchema)+ `shouldRender` [".It : Ar any"] - context "objects" $ do+ it "one-level" $ do let- key :: Text -> JSONSchema -> ObjectSchema- key k s = ObjectKeySchema k Required s Nothing+ js :: JSONSchema+ js =+ object+ [ key "foo" StringSchema+ , key "bar" BoolSchema+ , key "baz" (RefSchema "custom")+ ] - keyComment :: Text -> Text -> JSONSchema -> ObjectSchema- keyComment k d s = ObjectKeySchema k Required s $ Just d+ schemaDoc js+ `shouldRender` [ ".It Cm foo : Ar string"+ , ".It Cm bar : Ar boolean"+ , ".It Cm baz : Ar custom"+ ] - object :: [ObjectSchema] -> JSONSchema- object = ObjectSchema . ObjectAllOfSchema . NE.fromList+ it "multi-level" $ do+ let+ js :: JSONSchema+ js = object [key "foo" (object [key "bar" (object [key "baz" StringSchema])])] - it "special case, any" $ do- renderJSONSchema (ObjectSchema ObjectAnySchema)- `shouldRender` [".It : Ar any"]+ schemaDoc js+ `shouldRender` [ ".It Cm foo : Ar object"+ , ".It Cm foo.bar : Ar object"+ , ".It Cm foo.bar.baz : Ar string"+ ] - it "one-level" $ do- let- js :: JSONSchema- js =- object- [ key "foo" StringSchema- , key "bar" BoolSchema- , key "baz" (RefSchema "custom")+ it "list of object at key" $ do+ let+ js :: JSONSchema+ js =+ ArraySchema+ $ object+ [ key "name" StringSchema+ , keyComment "admin" "Admin?" BoolSchema ] - renderJSONSchema js- `shouldRender` [ ".It Cm foo : Ar string"- , ".It Cm bar : Ar boolean"- , ".It Cm baz : Ar custom"- ]-- it "multi-level" $ do- let- js :: JSONSchema- js = object [key "foo" (object [key "bar" (object [key "baz" StringSchema])])]-- renderJSONSchema js- `shouldRender` [ ".It Cm foo : Ar object"- , ".It Cm foo.bar : Ar object"- , ".It Cm foo.bar.baz : Ar string"- ]+ schemaDoc js+ `shouldRender` [ ".It Cm [].name : Ar string"+ , ".It Cm [].admin : Ar boolean"+ , "Admin?"+ ] - it "list of object at key" $ do- let- js :: JSONSchema- js =- ArraySchema- $ object- [ key "name" StringSchema- , keyComment "admin" "Admin?" BoolSchema- ]+ it "list of object at key" $ do+ let+ keys :: NonEmpty String+ keys = pure "people" - renderJSONSchema js- `shouldRender` [ ".It Cm [].name : Ar string"- , ".It Cm [].admin : Ar boolean"- , "Admin?"- ]+ js :: JSONSchema+ js =+ ArraySchema+ $ object+ [ key "name" StringSchema+ , keyComment "admin" "Admin?" BoolSchema+ ] - it "list of object at key" $ do- let- keys :: NonEmpty String- keys = pure "people"+ schemaDocAt keys js+ `shouldRender` [ ".It Cm people : Ar object Ns []"+ , ".It Cm people[].name : Ar string"+ , ".It Cm people[].admin : Ar boolean"+ , "Admin?"+ ] - js :: JSONSchema- js =- ArraySchema- $ object- [ key "name" StringSchema- , keyComment "admin" "Admin?" BoolSchema- ]+schemaDoc :: JSONSchema -> Doc ann+schemaDoc = vsep . map pretty . getConfigs Nothing - renderJSONSchemaAt keys js- `shouldRender` [ ".It Cm people : Ar object Ns []"- , ".It Cm people[].name : Ar string"- , ".It Cm people[].admin : Ar boolean"- , "Admin?"- ]+schemaDocAt :: NonEmpty String -> JSONSchema -> Doc ann+schemaDocAt keys = vsep . map pretty . getConfigs (Just keys)
+ test/Mdoc/Data/ConfigSpec.hs view
@@ -0,0 +1,40 @@+-- |+--+-- Module : Mdoc.Data.ConfigSpec+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Data.ConfigSpec+ ( spec+ ) where++import Mdoc.Prelude++import Mdoc.Data.Config+import Mdoc.Data.Described+import Mdoc.Data.Optionality+import Mdoc.Syntax+import Mdoc.Test.Render+import Test.Hspec++spec :: Spec+spec = do+ it "renders with literal examples" $ do+ let config =+ Described+ { item =+ Config+ { name = Just "git.push"+ , schema = Simple "boolean"+ }+ , optionality = Required+ , multiple = False+ , help = Just $ Mdoc [TextLine "Push to git remote"]+ }++ config+ `shouldRender` [ ".It Cm git.push : Ar boolean"+ , "Push to git remote"+ ]
+ test/Mdoc/Data/PositionalSpec.hs view
@@ -0,0 +1,87 @@+module Mdoc.Data.PositionalSpec+ ( spec+ ) where++import Mdoc.Prelude++import Data.List (sort)+import Mdoc.Data.Positional+import Test.Hspec++spec :: Spec+spec = do+ describe "Ord" $ do+ it "sorts short before long, capital-then-lower together" $ do+ let+ unsorted =+ [ PositionalSwitch $ Flag 'q' []+ , PositionalSwitch $ Flag 'e' []+ , PositionalSwitch $ Flag 'n' []+ , PositionalSwitch $ Flag 'G' []+ , PositionalSwitch $ Flag 'b' []+ , PositionalSwitch $ Flag 'A' []+ , PositionalSwitch $ Flag 'I' []+ , PositionalSwitch $ Flag 's' []+ , PositionalSwitch $ GNUFlag "binary-files" []+ , PositionalSwitch $ Flag 'B' []+ , PositionalSwitch $ GNUFlag "line-buffered" []+ , PositionalSwitch $ Flag 'L' []+ , PositionalSwitch $ Flag 'F' []+ , PositionalSwitch $ GNUFlag "null" []+ , PositionalSwitch $ Flag 'w' []+ , PositionalSwitch $ Flag 'o' []+ , PositionalSwitch $ Flag 'Z' []+ , PositionalSwitch $ Flag 'x' []+ , PositionalSwitch $ Flag 'E' []+ , PositionalSwitch $ Flag 'v' []+ , PositionalSwitch $ GNUFlag "label" []+ , PositionalSwitch $ Flag 'h' []+ , PositionalSwitch $ Flag 'c' []+ , PositionalSwitch $ Flag 'U' []+ , PositionalSwitch $ Flag 'H' []+ , PositionalSwitch $ Flag 'l' []+ , PositionalSwitch $ Flag 'V' []+ , PositionalSwitch $ Flag 'f' []+ , PositionalSwitch $ Flag 'C' [GNUFlag "context" []]+ , PositionalSwitch $ Flag 'i' []+ , PositionalSwitch $ Flag 'a' []+ , PositionalSwitch $ Flag 'm' []+ , PositionalSwitch $ Flag 'R' []+ ]+ sorted =+ [ PositionalSwitch $ Flag 'A' []+ , PositionalSwitch $ Flag 'a' []+ , PositionalSwitch $ Flag 'B' []+ , PositionalSwitch $ Flag 'b' []+ , PositionalSwitch $ Flag 'C' [GNUFlag "context" []]+ , PositionalSwitch $ Flag 'c' []+ , PositionalSwitch $ Flag 'E' []+ , PositionalSwitch $ Flag 'e' []+ , PositionalSwitch $ Flag 'F' []+ , PositionalSwitch $ Flag 'f' []+ , PositionalSwitch $ Flag 'G' []+ , PositionalSwitch $ Flag 'H' []+ , PositionalSwitch $ Flag 'h' []+ , PositionalSwitch $ Flag 'I' []+ , PositionalSwitch $ Flag 'i' []+ , PositionalSwitch $ Flag 'L' []+ , PositionalSwitch $ Flag 'l' []+ , PositionalSwitch $ Flag 'm' []+ , PositionalSwitch $ Flag 'n' []+ , PositionalSwitch $ Flag 'o' []+ , PositionalSwitch $ Flag 'q' []+ , PositionalSwitch $ Flag 'R' []+ , PositionalSwitch $ Flag 's' []+ , PositionalSwitch $ Flag 'U' []+ , PositionalSwitch $ Flag 'V' []+ , PositionalSwitch $ Flag 'v' []+ , PositionalSwitch $ Flag 'w' []+ , PositionalSwitch $ Flag 'x' []+ , PositionalSwitch $ Flag 'Z' []+ , PositionalSwitch $ GNUFlag "binary-files" []+ , PositionalSwitch $ GNUFlag "label" []+ , PositionalSwitch $ GNUFlag "line-buffered" []+ , PositionalSwitch $ GNUFlag "null" []+ ]++ sort unsorted `shouldBe` sorted
+ test/Mdoc/Data/SynopsisSpec.hs view
@@ -0,0 +1,28 @@+-- |+--+-- Module : Mdoc.Data.SynopsisSpec+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Data.SynopsisSpec+ ( spec+ ) where++import Mdoc.Prelude++import Mdoc.Data.Synopsis qualified as Synopsis+import Mdoc.Test.Render+import Test.Hspec++spec :: Spec+spec = do+ it "renders an empty synopsis" $ do+ let synopsis = Synopsis.fromList []++ synopsis+ `shouldRender` [ ".Nm"+ , ".Bk -words"+ , ".Ek"+ ]
+ test/Mdoc/ExamplesSpec.hs view
@@ -0,0 +1,68 @@+{-# OPTIONS_GHC -Wno-ambiguous-fields #-}++-- |+--+-- Module : Mdoc.ExamplesSpec+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.ExamplesSpec+ ( spec+ ) where++import Mdoc.Prelude++import Data.ByteString.Lazy qualified as BSL+import Data.Text.IO qualified as T+import Data.Time (fromGregorian)+import Mdoc+import Mdoc.Data.Named+import Mdoc.Examples.Grep+import Mdoc.Examples.OptEnvConf+import Mdoc.Examples.Person+import Mdoc.Input (parseMdocBytes)+import Mdoc.Parse (errorBundlePretty, exitParseError)+import Mdoc.Pretty (renderPlain)+import Mdoc.Syntax+import Mdoc.Template+import Mdoc.UpdateMdocdate (updateMdocdateTo)+import System.FilePath ((<.>), (</>))+import Test.Hspec+import Test.Hspec.Golden++spec :: Spec+spec = do+ it "grep.1" $ exampleGolden man1 grep1 1+ it "example.1" $ exampleGolden man1 example1 1+ it "conf.5" $ exampleGolden man5 conf5 5+ it "example.5" $ exampleGolden man5 example5 5+ it "person.5" $ exampleGolden man5 person5 5++exampleGolden :: Template -> Named -> Int -> IO (Golden Mdoc)+exampleGolden template named section = do+ case renderTemplate template named of+ Rendered mdoc -> do+ pure @IO+ Golden+ { output = fixMdocDate mdoc+ , encodePretty = unpack . renderPlain . prettyMdoc+ , writeToFile = \fp -> T.writeFile fp . (<> "\n") . renderPlain . prettyMdoc+ , readFromFile = \fp -> either exitParseError pure . parseMdocBytes fp =<< BSL.readFile fp+ , goldenFile = "examples" </> path+ , actualFile = Nothing+ , failFirstTime = False+ }+ RenderedWarnings ne _ -> do+ expectationFailure $ displayMustacheWarnings ne+ error "unreachable"+ RenderedError err -> do+ expectationFailure $ errorBundlePretty err+ error "unreachable"+ where+ path :: FilePath+ path = unpack (head named.names) <.> show section++fixMdocDate :: Mdoc -> Mdoc+fixMdocDate = updateMdocdateTo $ fromGregorian 2026 9 20
− test/Mdoc/Gen/DescriptionSpec.hs
@@ -1,48 +0,0 @@--- |------ Module : Mdoc.Gen.DescriptionSpec--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Gen.DescriptionSpec- ( spec- ) where--import Mdoc.Prelude--import Mdoc.Gen.Config-import Mdoc.Gen.Described-import Mdoc.Gen.Description-import Mdoc.Gen.Optionality-import Mdoc.Test.Render-import Test.Hspec--spec :: Spec-spec = do- describe "configLines" $ do- it "renders with literal examples" $ do- let config =- Described- { item =- Config- { name = Just "git.push"- , schema = Simple "boolean"- , exampleLines = Just $ "# disable pushing" :| ["git.push: false"]- }- , optionality = Required- , multiple = False- , helpLines = Just $ pure "Push to git remote"- }-- configLines config- `shouldRender` [ ".It Cm git.push : Ar boolean"- , "Push to git remote"- , ".Pp"- , "Example:"- , ".Bd -literal -offset indent"- , "# disable pushing"- , "git.push: false"- , ".Ed"- ]
− test/Mdoc/Gen/ExitStatusSpec.hs
@@ -1,51 +0,0 @@--- |------ Module : Mdoc.Gen.ExitStatusSpec--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Gen.ExitStatusSpec- ( spec- ) where--import Mdoc.Prelude--import Mdoc.Gen.ExitStatus-import Mdoc.Test.Render-import Test.Hspec--spec :: Spec-spec = do- describe "renderExitStatuses" $ do- it "can re-create Ex -std format" $ do- let nzs = pure $ NonZeroStatus ">0" "if an error occurs"-- renderExitStatuses nzs- `shouldRender` [ "The"- , ".Nm"- , "utility exits 0 on success,"- , "and >0 if an error occurs."- ]-- it "is flexible to more non-zero statuses" $ do- -- https://github.com/ocharles/weeder#exit-codes- let nzs =- NonZeroStatus "228" "if one or more weeds found"- :| [ NonZeroStatus "1" "for generic failing exit code"- , NonZeroStatus "2" "due to failure to read HIE file due to GHC version mismatch"- , NonZeroStatus "3" "due to failure to parse config file"- , NonZeroStatus "4" "when no HIE files found"- ]-- renderExitStatuses nzs- `shouldRender` [ "The"- , ".Nm"- , "utility exits 0 on success,"- , "228 if one or more weeds found,"- , "1 for generic failing exit code,"- , "2 due to failure to read HIE file due to GHC version mismatch,"- , "3 due to failure to parse config file,"- , "and 4 when no HIE files found."- ]
− test/Mdoc/Gen/FlagSpec.hs
@@ -1,95 +0,0 @@--- |------ Module : Mdoc.Gen.FlagSpec--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Gen.FlagSpec- ( spec- ) where--import Mdoc.Prelude--import Data.List (sort)-import Mdoc.Gen.Flag-import Test.Hspec--spec :: Spec-spec = do- describe "Ord" $ do- it "sorts short before long, capital-then-lower together" $ do- let- unsorted =- [ Flag 'q' []- , Flag 'e' []- , Flag 'n' []- , Flag 'G' []- , Flag 'b' []- , Flag 'A' []- , Flag 'I' []- , Flag 's' []- , GNUFlag "binary-files" []- , Flag 'B' []- , GNUFlag "line-buffered" []- , Flag 'L' []- , Flag 'F' []- , GNUFlag "null" []- , Flag 'w' []- , Flag 'o' []- , Flag 'Z' []- , Flag 'x' []- , Flag 'E' []- , Flag 'v' []- , GNUFlag "label" []- , Flag 'h' []- , Flag 'c' []- , Flag 'U' []- , Flag 'H' []- , Flag 'l' []- , Flag 'V' []- , Flag 'f' []- , Flag 'C' [GNUFlag "context" []]- , Flag 'i' []- , Flag 'a' []- , Flag 'm' []- , Flag 'R' []- ]- sorted =- [ Flag 'A' []- , Flag 'a' []- , Flag 'B' []- , Flag 'b' []- , Flag 'C' [GNUFlag "context" []]- , Flag 'c' []- , Flag 'E' []- , Flag 'e' []- , Flag 'F' []- , Flag 'f' []- , Flag 'G' []- , Flag 'H' []- , Flag 'h' []- , Flag 'I' []- , Flag 'i' []- , Flag 'L' []- , Flag 'l' []- , Flag 'm' []- , Flag 'n' []- , Flag 'o' []- , Flag 'q' []- , Flag 'R' []- , Flag 's' []- , Flag 'U' []- , Flag 'V' []- , Flag 'v' []- , Flag 'w' []- , Flag 'x' []- , Flag 'Z' []- , GNUFlag "binary-files" []- , GNUFlag "label" []- , GNUFlag "line-buffered" []- , GNUFlag "null" []- ]-- sort unsorted `shouldBe` sorted
− test/Mdoc/GenSpec.hs
@@ -1,89 +0,0 @@-{-# OPTIONS_GHC -Wno-ambiguous-fields #-}---- |------ Module : Mdoc.GenSpec--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.GenSpec- ( spec- ) where--import Mdoc.Prelude--import Autodocodec.Schema.Mdoc qualified as JSONSchema-import Data.ByteString.Lazy qualified as BSL-import Data.Text.IO qualified as T-import Data.Time (fromGregorian)-import Env.Mdoc qualified as Env-import Mdoc-import Mdoc.Gen-import Mdoc.Gen.Man1-import Mdoc.Gen.Man5-import Mdoc.Gen.Name-import Mdoc.Input (parseMdocBytes)-import Mdoc.Parse (exitParseError)-import Mdoc.Pretty (renderPlain)-import Mdoc.Test.Fixtures-import Mdoc.UpdateMdocdate (updateMdocdateTo)-import OptEnvConf.Mdoc qualified as OptEnvConf-import Options.Applicative.Mdoc qualified as OA-import System.FilePath ((<.>), (</>))-import Test.Hspec-import Test.Hspec.Golden--spec :: Spec-spec = do- describe "genMan1" $ do- it "grep.1"- $ goldenMan1- $ grepBase- & OA.addToMan1 grepOpt- & Env.addToMan1 grepEnv-- it "example.1"- $ goldenMan1- $ exampleBase1- & OptEnvConf.addToMan1 exampleOptEnvConf-- describe "genMan5" $ do- it "examplerc.5"- $ goldenMan5- $ exampleBase5- & OptEnvConf.addToMan5 exampleOptEnvConf-- it "conf.5"- $ goldenMan5- $ confBase- & OptEnvConf.addToMan5 confConf-- it "person.5"- $ goldenMan5- $ personBase- & JSONSchema.addToMan5 personJSONSchema--goldenMan1 :: Man1 -> IO (Golden Mdoc)-goldenMan1 man1 = goldenMan (man1.name.primary <.> "1") <$> genMan1 man1--goldenMan5 :: Man5 -> IO (Golden Mdoc)-goldenMan5 man5 = goldenMan (man5.name.primary <.> "5") <$> genMan5 man5--goldenMan :: FilePath -> Mdoc -> Golden Mdoc-goldenMan path mdoc =- Golden- { output- , encodePretty = unpack . renderPlain . prettyMdoc- , writeToFile = \fp -> T.writeFile fp . renderPlain . prettyMdoc- , readFromFile = \fp -> either exitParseError pure . parseMdocBytes fp =<< BSL.readFile fp- , goldenFile = "examples" </> path- , actualFile = Nothing- , failFirstTime = False- }- where- output = fixMdocDate mdoc--fixMdocDate :: Mdoc -> Mdoc-fixMdocDate = updateMdocdateTo $ fromGregorian 2026 9 20
test/Mdoc/Parse/MacroArgSpec.hs view
@@ -13,10 +13,9 @@ import Mdoc.Prelude import Data.Time (fromGregorian)-import Mdoc.Interpolation-import Mdoc.MacroArg import Mdoc.Parse import Mdoc.Parse.MacroArg+import Mdoc.Syntax import Mdoc.Test.Parse import Test.Hspec @@ -33,7 +32,3 @@ $ Mdocdate $ Just $ fromGregorian 2020 10 1-- it "parses interpolated arguments" $ do- parseTest (parseMacroArg <* eol <* eof) ["{{docTitle}}"]- $ InterpolatedArg DocTitle
test/Mdoc/Parse/MdocLineSpec.hs view
@@ -10,12 +10,9 @@ import Mdoc.Prelude -import Mdoc.Interpolation-import Mdoc.MacroArg-import Mdoc.MacroName-import Mdoc.MdocLine import Mdoc.Parse import Mdoc.Parse.MdocLine+import Mdoc.Syntax import Mdoc.Test.Parse import Test.Hspec @@ -65,22 +62,3 @@ , "format" , "for" ]-- for_- [ ("name", Name)- , ("synopsis", Synopsis)- , ("description", Description)- ]- $ \(t, i) ->- it ("parses " <> unpack t <> " as a line interpolation") $ do- parseTest (parseMdocLine <* eol <* eof) ["{{" <> t <> "}}"]- $ InterpolatedLine i-- for_- [ ("docTitle", DocTitle)- , ("docSection", DocSection)- ]- $ \(t, i) ->- it ("parses " <> unpack t <> " as an arg interpolation") $ do- parseTest (parseMdocLine <* eol <* eof) [".Cm Ar {{" <> t <> "}} . foo"]- $ MacroLine Cm [Callable Ar, InterpolatedArg i, ".", "foo"]
test/Mdoc/Parse/TableLineSpec.hs view
@@ -14,7 +14,7 @@ import Mdoc.Parse import Mdoc.Parse.TableLine-import Mdoc.TableLine+import Mdoc.Syntax.TableLine import Mdoc.Test.Parse import Test.Hspec
test/Mdoc/Parse/TroffMacroSpec.hs view
@@ -14,8 +14,8 @@ import Mdoc.Parse import Mdoc.Parse.TroffMacro+import Mdoc.Syntax.TroffMacro import Mdoc.Test.Parse-import Mdoc.TroffMacro import Test.Hspec spec :: Spec
− test/Mdoc/Test/Fixtures.hs
@@ -1,173 +0,0 @@-{-# OPTIONS_GHC -Wno-ambiguous-fields #-}---- |------ Module : Mdoc.Test.Fixtures--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Mdoc.Test.Fixtures- ( grepBase- , grepOpt- , grepEnv- , confBase- , confConf- , exampleBase1- , exampleBase5- , exampleOptEnvConf- , personBase- , personJSONSchema- ) where--import Mdoc.Prelude--import Autodocodec (HasCodec (..), object, optionalField, requiredField, (.=))-import Autodocodec.Schema (JSONSchema, jsonSchemaViaCodec)-import Env qualified-import Mdoc.Gen.CrossRef-import Mdoc.Gen.Man1-import Mdoc.Gen.Man5-import Mdoc.Gen.Name-import OptEnvConf qualified-import Options.Applicative qualified as OA--grepBase :: Man1-grepBase =- (baseMan1 "" "")- { name =- Name- { primary = "grep"- , secondaries = ["egrep", "fgrep", "rgrep"]- , description = "file pattern searcher"- }- , seeAlso =- [ CrossRef "ed" 1- , CrossRef "ex" 1- , CrossRef "sed" 1- , CrossRef "zgrep" 1- , CrossRef "re_format" 7- ]- }--{- FOURMOLU_DISABLE -}-grepOpt :: OA.Parser ()-grepOpt = void $ (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)- <$> OA.optional (OA.option (OA.auto @Int) (mconcat [OA.short 'A', OA.metavar "num", OA.help "Print num lines of trailing context after each match. See also the -B and -C options."]))- <*> OA.optional (OA.switch (mconcat [OA.short 'a', OA.help "Treat all files as ASCII text. Normally grep will simply print “Binary file ... matches” if files contain binary characters. Use of this option forces grep to output lines matching the specified pattern."]))- <*> OA.optional (OA.option (OA.auto @Int) (mconcat [OA.short 'B', OA.metavar "num", OA.help "Print num lines of leading context before each match. See also the -A and -C options."]))- <*> OA.optional (OA.switch (mconcat [OA.short 'b', OA.help "Each output line is preceded by its position (in bytes) in the file. If option -o is also specified, the position of the matched pattern is displayed."]))- <*> OA.optional (OA.option (OA.auto @Int) (mconcat [OA.short 'C', OA.long "context", OA.metavar "num", OA.help "Print num lines of leading and trailing context surrounding each match. The default is 2 and is equivalent to -A 2 -B 2. Note: no whitespace may be given between the option and its argument."]))- <*> OA.optional (OA.switch (mconcat [OA.short 'c', OA.help "Only a count of selected lines is written to standard output."]))- <*> OA.optional (OA.switch (mconcat [OA.short 'E', OA.help "Interpret pattern as an extended regular expression (i.e. force grep to behave as egrep)."]))- <*> OA.optional (OA.option (OA.str @String) (mconcat [OA.short 'e', OA.metavar "pattern", OA.help "Specify a pattern used during the search of the input: an input line is selected if it matches any of the specified patterns. This option is most useful when multiple -e options are used to specify multiple patterns, or when a pattern begins with a dash (‘-’)."]))- <*> OA.optional (OA.switch (mconcat [OA.short 'F', OA.help "Interpret pattern as a set of fixed strings (i.e. force grep to behave as fgrep)."]))- <*> OA.optional (OA.option (OA.str @String) (mconcat [OA.short 'f', OA.metavar "file", OA.help "Read one or more newline separated patterns from file. Empty pattern lines match every input line. Newlines are not considered part of a pattern. If file is empty, nothing is matched."]))- <*> OA.optional (OA.switch (mconcat [OA.short 'G', OA.help "Interpret pattern as a basic regular expression (i.e. force grep to behave as traditional grep)."]))- <*> OA.optional (OA.switch (mconcat [OA.short 'H', OA.help "Always print filename headers (i.e. filenames) with output lines."]))- <*> OA.optional (OA.switch (mconcat [OA.short 'h', OA.help "Never print filename headers (i.e. filenames) with output lines."]))- <*> OA.optional (OA.switch (mconcat [OA.short 'I', OA.help "Ignore binary files."]))- <*> OA.optional (OA.switch (mconcat [OA.short 'i', OA.help "Perform case insensitive matching. By default, grep is case sensitive."]))- <*> OA.optional (OA.switch (mconcat [OA.short 'L', OA.help "Only the names of files not containing selected lines are written to standard output. Pathnames are listed once per file searched. If the standard input is searched, the string “(standard input)” is written."]))- <*> OA.optional (OA.switch (mconcat [OA.short 'l', OA.help "Only the names of files containing selected lines are written to standard output. grep will only search a file until a match has been found, making searches potentially less expensive. Pathnames are listed once per file searched. If the standard input is searched, the string “(standard input)” is written."]))- <*> OA.optional (OA.option (OA.auto @Int) (mconcat [OA.short 'm', OA.metavar "num", OA.help "Stop after finding at least one match on num different lines."]))- <*> OA.optional (OA.switch (mconcat [OA.short 'n', OA.help "Each output line is preceded by its relative line number in the file, starting at line 1. The line number counter is reset for each file processed. This option is ignored if -c, -L, -l, or -q is specified."]))- <*> OA.optional (OA.switch (mconcat [OA.short 'o', OA.help "Print each match, but only the match, not the entire line."]))- <*> OA.optional (OA.switch (mconcat [OA.short 'q', OA.help "Quiet mode: suppress normal output. grep will only search a file until a match has been found, making searches potentially less expensive."]))- <*> OA.optional (OA.switch (mconcat [OA.short 'R', OA.help "Recursively search subdirectories listed. If no file is given, grep searches the current working directory."]))- <*> OA.optional (OA.switch (mconcat [OA.short 's', OA.help "Silent mode. Nonexistent and unreadable files are ignored (i.e. their error messages are suppressed)."]))- <*> OA.optional (OA.switch (mconcat [OA.short 'U', OA.help "Search binary files, but do not attempt to print them."]))- <*> OA.optional (OA.switch (mconcat [OA.short 'V', OA.help "Display version information. All other options are ignored."]))- <*> OA.optional (OA.switch (mconcat [OA.short 'v', OA.help "Selected lines are those not matching any of the specified patterns."]))- <*> OA.optional (OA.switch (mconcat [OA.short 'w', OA.help "The expression is searched for as a word (as if surrounded by ‘[[:<:]]’ and ‘[[:>:]]’; see re_format(7))."]))- <*> OA.optional (OA.switch (mconcat [OA.short 'x', OA.help "Only input lines selected against an entire fixed string or regular expression are considered to be matching lines."]))- <*> OA.optional (OA.switch (mconcat [OA.short 'Z', OA.help "Force grep to behave as zgrep."]))- <*> OA.optional (OA.option (OA.str @String) (mconcat [OA.long "binary-files", OA.metavar "value", OA.help "Controls searching and printing of binary files. Options are binary, the default: search binary files but do not print them; without-match: do not search binary files; and text: treat all files as text."]))- <*> OA.optional (OA.option (OA.str @String) (mconcat [OA.long "label", OA.metavar "name", OA.help "Print name instead of the filename before lines."]))- <*> OA.optional (OA.switch (mconcat [OA.long "line-buffered", OA.help "Force output to be line buffered. By default, output is line buffered when standard output is a terminal and block buffered otherwise."]))- <*> OA.optional (OA.switch (mconcat [OA.long "null", OA.help "Output a zero byte instead of the character that normally follows a file name. This option makes the output unambiguous, even in the presence of file names containing unusual characters like newlines. This is similar to the -print0 primary in find(1)."]))- <*> OA.optional (OA.argument (OA.str @String) (mconcat [OA.metavar "pattern"]))- <*> OA.many (OA.argument (OA.str @String) (mconcat [OA.metavar "file"]))--grepEnv :: Env.Parser Env.Error ()-grepEnv = void $ (,,)- <$> (Env.var @Env.Error @Text) Env.str "GREP_COLOR" (Env.help "This variable specifies the color used to highlight matched (non-empty) text.")- <*> (Env.var @Env.Error @Text) Env.str "GREP_OPTIONS" (Env.help "This variable specifies default options to be placed in front of any explicit options. It may cause problems with portable scripts.")- <*> (Env.var @Env.Error @Text) Env.str "TERM" (Env.help "This variable specifies the type name of the terminal, console or display-device type to be used. See term(7).")-{- FOURMOLU_ENABLE -}--confBase :: Man5-confBase =- (baseMan5 "" "" "")- { name =- Name- { primary = "crontab"- , secondaries = []- , description = "tables for driving cron"- }- , files = fromString . ("/etc/cron." <>) <$> ("daily" :| ["hourly", "weekly"])- }--{- FOURMOLU_DISABLE -}-confConf :: OptEnvConf.Parser ()-confConf = void $ (,)- <$> OptEnvConf.setting [OptEnvConf.conf @String "foo", OptEnvConf.help "Foo's the fooing of fooers"]- <*> OptEnvConf.subConfig "bar" ((,)- <$> OptEnvConf.setting [OptEnvConf.conf @Bool "baz", OptEnvConf.help "Bar's baz of bazzle"]- <*> OptEnvConf.setting [OptEnvConf.conf @[Int] "bat", OptEnvConf.help "Bar's bat is better than that"])-{- FOURMOLU_ENABLE -}--exampleBase1 :: Man1-exampleBase1 = baseMan1 "example" "opt-env-conf example"--exampleBase5 :: Man5-exampleBase5 = baseMan5 "examplerc" "opt-env-conf example config" ".examplerc.yaml"--{- FOURMOLU_DISABLE -}-exampleOptEnvConf :: OptEnvConf.Parser (Bool, Bool, Text, Text, [Text])-exampleOptEnvConf = (,,,,)- <$> OptEnvConf.setting [OptEnvConf.env "DEBUG", OptEnvConf.conf "debug", OptEnvConf.switch True, OptEnvConf.long "debug", OptEnvConf.help "Enable debug", OptEnvConf.value False]- <*> OptEnvConf.setting [OptEnvConf.conf "verbose", OptEnvConf.switch True, OptEnvConf.short 'v', OptEnvConf.long "verbose", OptEnvConf.value False]- <*> OptEnvConf.setting [OptEnvConf.env "INPUT", OptEnvConf.option, OptEnvConf.reader OptEnvConf.str, OptEnvConf.short 'i', OptEnvConf.metavar "INPUT"]- <*> OptEnvConf.setting [OptEnvConf.conf "file", OptEnvConf.argument, OptEnvConf.reader OptEnvConf.str, OptEnvConf.metavar "FILE"]- <*> OptEnvConf.many (OptEnvConf.setting [OptEnvConf.argument, OptEnvConf.reader OptEnvConf.str, OptEnvConf.metavar "FILE"])-{- FOURMOLU_ENABLE -}--data Person = Person- { name :: Text- , age :: Int- , address :: Maybe Address- , hobbies :: Maybe [Text]- }--{- FOURMOLU_DISABLE -}-instance HasCodec Person where- codec = object "Person" $ Person- <$> requiredField "name" "Their name" .= (.name)- <*> requiredField "age" "Their age" .= (.age)- <*> optionalField "address" "Their address" .= (.address)- <*> optionalField "hobbies" "Their hobbies" .= (.hobbies)-{- FOURMOLU_ENABLE -}--data Address = Address- { street :: Text- , city :: Text- , state :: Text- , postalCode :: Text- }--{- FOURMOLU_DISABLE -}-instance HasCodec Address where- codec = object "Address" $ Address- <$> requiredField "street" "The street" .= (.street)- <*> requiredField "city" "The city" .= (.city)- <*> requiredField "state" "The state" .= (.state)- <*> requiredField "postalCode" "The postal code" .= (.postalCode)-{- FOURMOLU_ENABLE -}--personBase :: Man5-personBase = baseMan5 "person" "person example via Codec" "person.schema.json"--personJSONSchema :: JSONSchema-personJSONSchema = jsonSchemaViaCodec @Person
test/Mdoc/Test/Render.hs view
@@ -1,34 +1,23 @@+-- |+--+-- Module : Mdoc.Test.Render+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX module Mdoc.Test.Render- ( IsMdoc (..)- , shouldRender+ ( shouldRender ) where import Mdoc.Prelude -import Mdoc-import Mdoc.MdocLine+import Data.Text qualified as T import Mdoc.Pretty import Test.Hspec -class IsMdoc a where- toMdoc :: a -> Mdoc--instance IsMdoc Mdoc where- toMdoc = id--instance IsMdoc [MdocLine] where- toMdoc = Mdoc--instance IsMdoc (NonEmpty MdocLine) where- toMdoc = Mdoc . toList--instance IsMdoc MdocLine where- toMdoc = Mdoc . pure--shouldRender :: IsMdoc a => a -> [Text] -> Expectation-shouldRender a lns = actual `shouldBe` expected- where- actual = renderPlain $ prettyMdoc $ toMdoc a- expected = mconcat $ map (<> "\n") lns+shouldRender :: (HasCallStack, Pretty a) => a -> [Text] -> Expectation+shouldRender a lns =+ renderPlain (pretty a) `shouldBe` T.intercalate "\n" lns infix 1 `shouldRender`
test/Mdoc/UpdateMdocdateSpec.hs view
@@ -13,10 +13,7 @@ import Mdoc.Prelude import Data.Time (fromGregorian)-import Mdoc-import Mdoc.MacroArg-import Mdoc.MacroName-import Mdoc.MdocLine+import Mdoc.Syntax import Mdoc.UpdateMdocdate import Test.Hspec
test/MdocSpec.hs view
@@ -13,9 +13,7 @@ import Mdoc.Prelude import Mdoc-import Mdoc.MacroArg-import Mdoc.MacroName-import Mdoc.MdocLine+import Mdoc.Parse.Mdoc import Mdoc.Test.Parse import Test.Hspec