mdoc (empty) → 0.1.0.0
raw patch · 69 files changed
+4105/−0 lines, 69 filesdep +Diffdep +aesondep +autodocodec-schema
Dependencies added: Diff, aeson, autodocodec-schema, base, bytestring, containers, envparse, extra, file-embed, filepath, generic-optics, hspec, hspec-golden, mdoc, megaparsec, mtl, opt-env-conf, optics, optparse-applicative, prettyprinter, prettyprinter-ansi-terminal, semigroups, text, time, zlib
Files
- CHANGELOG.md +1/−0
- README.lhs +82/−0
- README.md +82/−0
- dump/Main.hs +5/−0
- mdoc.cabal +207/−0
- src/Env/Mdoc.hs +38/−0
- src/Mdoc.hs +33/−0
- src/Mdoc/Detect.hs +62/−0
- src/Mdoc/Dump/Diff.hs +103/−0
- src/Mdoc/Dump/Env.hs +42/−0
- src/Mdoc/Dump/Main.hs +67/−0
- src/Mdoc/Dump/Options.hs +93/−0
- src/Mdoc/Gen.hs +76/−0
- src/Mdoc/Gen/Argument.hs +61/−0
- src/Mdoc/Gen/Config.hs +55/−0
- src/Mdoc/Gen/CrossRef.hs +43/−0
- src/Mdoc/Gen/Described.hs +46/−0
- src/Mdoc/Gen/Description.hs +99/−0
- src/Mdoc/Gen/EnvVar.hs +36/−0
- src/Mdoc/Gen/Environment.hs +30/−0
- src/Mdoc/Gen/ExitStatus.hs +30/−0
- src/Mdoc/Gen/File.hs +63/−0
- src/Mdoc/Gen/Flag.hs +64/−0
- src/Mdoc/Gen/Man1.hs +69/−0
- src/Mdoc/Gen/Man5.hs +42/−0
- src/Mdoc/Gen/Name.hs +49/−0
- src/Mdoc/Gen/Option.hs +22/−0
- src/Mdoc/Gen/Optionality.hs +19/−0
- src/Mdoc/Gen/Synopsis.hs +94/−0
- src/Mdoc/Gen/Template.hs +80/−0
- src/Mdoc/Input.hs +67/−0
- src/Mdoc/Interpolated.hs +69/−0
- src/Mdoc/Interpolation.hs +38/−0
- src/Mdoc/MacroArg.hs +38/−0
- src/Mdoc/MacroName.hs +149/−0
- src/Mdoc/MdocLine.hs +37/−0
- src/Mdoc/Optics.hs +36/−0
- src/Mdoc/Parse.hs +112/−0
- src/Mdoc/Parse/Interpolation.hs +41/−0
- src/Mdoc/Parse/MacroArg.hs +73/−0
- src/Mdoc/Parse/MacroName.hs +22/−0
- src/Mdoc/Parse/MdocLine.hs +45/−0
- src/Mdoc/Parse/TableLine.hs +23/−0
- src/Mdoc/Parse/TroffMacro.hs +65/−0
- src/Mdoc/Prelude.hs +45/−0
- src/Mdoc/Pretty.hs +110/−0
- src/Mdoc/Pretty/Interpolation.hs +22/−0
- src/Mdoc/Pretty/MacroArg.hs +53/−0
- src/Mdoc/Pretty/MacroName.hs +19/−0
- src/Mdoc/Pretty/MdocLine.hs +34/−0
- src/Mdoc/Pretty/TableLine.hs +19/−0
- src/Mdoc/Pretty/TroffMacro.hs +31/−0
- src/Mdoc/TableLine.hs +18/−0
- src/Mdoc/TroffMacro.hs +20/−0
- src/Mdoc/UpdateMdocdate.hs +28/−0
- src/OptEnvConf/Mdoc.hs +223/−0
- src/Options/Applicative/Mdoc.hs +136/−0
- test/Mdoc/Gen/DescriptionSpec.hs +54/−0
- test/Mdoc/Gen/ExitStatusSpec.hs +50/−0
- test/Mdoc/GenSpec.hs +83/−0
- test/Mdoc/Parse/MacroArgSpec.hs +39/−0
- test/Mdoc/Parse/MdocLineSpec.hs +86/−0
- test/Mdoc/Parse/TableLineSpec.hs +54/−0
- test/Mdoc/Parse/TroffMacroSpec.hs +57/−0
- test/Mdoc/Test/Fixtures.hs +123/−0
- test/Mdoc/Test/Parse.hs +23/−0
- test/Mdoc/UpdateMdocdateSpec.hs +44/−0
- test/MdocSpec.hs +116/−0
- test/Spec.hs +10/−0
+ CHANGELOG.md view
@@ -0,0 +1,1 @@+See https://codeberg.org/pbrisbin/mdoc/releases
+ README.lhs view
@@ -0,0 +1,82 @@+# mdoc++A library for defining, parsing, generating, and pretty-printing documents in+the [`mdoc(7)`][mdoc.7] language.++[mdoc.7]: https://mandoc.bsd.lv/man/mdoc.7.html++## Motivation++This project aims to automate generating man-pages from your existing option,+environment, and configuration parsers. Compared to other libraries that do+this, the goals of this project are to generate man-pages that are:++* **Detailed**: the generated man-pages should have as much information as we+ can glean from parser definitions. And it should be convenient to supply+ additional content to be placed within, instead of, or around what has been+ generated. And it should be possible to specify that extra content as simple+ text, `Mdoc` AST fragments, or as `Mdoc` values parsed from a file.++* **Conventional**: the generated man-pages should follow all `mdoc(7)`+ conventions and rules. Items should be presented in property-sorted definition+ lists with smart widths. Generation for options and environment variables vs+ configuration should occur in sections 1 and 5, respectively.++In short, we allow you to maintain the high level of detail and quality that one+gets from writing a man-page by hand, while avoiding the hassle of updating+multiple places when your options, environment, or configuration parsers change.++## Usage++This project includes the executable [`mdoc-dump(1)`][mdoc-dump.1]. This+`README` is a Literate Haskell file that generates a man-page from its+`optparse-applicative` and `envparse` parsers:++[mdoc-dump.1]: ./examples/mdoc-dump.1++```haskell+import Prelude++import Data.Function ((&))+import Env.Mdoc qualified as Env+import Mdoc.Gen+import Mdoc.Gen.Man1+import Mdoc.Dump.Env (envParser)+import Mdoc.Dump.Options (optionsInfo, optionsParser)+import Options.Applicative.Mdoc qualified as Opt++mdocDump1 :: Man1+mdocDump1 =+ baseMan1 "mdoc-dump" optionsInfo+ & Opt.addToMan1 optionsParser+ & Env.addToMan1 envParser+ & addCrossRef "mdoc" 7++main :: IO ()+main = putMdoc =<< genMan1 mdocDump1+```++<details>+<summary>Pretty-printed `mdoc(7)` syntax</summary>++++</details>++<details>+<summary>Viewed using `man`</summary>++++</details>++<details>+<summary>Converted to HTML using `mandoc`</summary>++++</details>++## LICENSE++This project is licensed AGPLv3. See [COPYING](./COPYING).
+ README.md view
@@ -0,0 +1,82 @@+# mdoc++A library for defining, parsing, generating, and pretty-printing documents in+the [`mdoc(7)`][mdoc.7] language.++[mdoc.7]: https://mandoc.bsd.lv/man/mdoc.7.html++## Motivation++This project aims to automate generating man-pages from your existing option,+environment, and configuration parsers. Compared to other libraries that do+this, the goals of this project are to generate man-pages that are:++* **Detailed**: the generated man-pages should have as much information as we+ can glean from parser definitions. And it should be convenient to supply+ additional content to be placed within, instead of, or around what has been+ generated. And it should be possible to specify that extra content as simple+ text, `Mdoc` AST fragments, or as `Mdoc` values parsed from a file.++* **Conventional**: the generated man-pages should follow all `mdoc(7)`+ conventions and rules. Items should be presented in property-sorted definition+ lists with smart widths. Generation for options and environment variables vs+ configuration should occur in sections 1 and 5, respectively.++In short, we allow you to maintain the high level of detail and quality that one+gets from writing a man-page by hand, while avoiding the hassle of updating+multiple places when your options, environment, or configuration parsers change.++## Usage++This project includes the executable [`mdoc-dump(1)`][mdoc-dump.1]. This+`README` is a Literate Haskell file that generates a man-page from its+`optparse-applicative` and `envparse` parsers:++[mdoc-dump.1]: ./examples/mdoc-dump.1++```haskell+import Prelude++import Data.Function ((&))+import Env.Mdoc qualified as Env+import Mdoc.Gen+import Mdoc.Gen.Man1+import Mdoc.Dump.Env (envParser)+import Mdoc.Dump.Options (optionsInfo, optionsParser)+import Options.Applicative.Mdoc qualified as Opt++mdocDump1 :: Man1+mdocDump1 =+ baseMan1 "mdoc-dump" optionsInfo+ & Opt.addToMan1 optionsParser+ & Env.addToMan1 envParser+ & addCrossRef "mdoc" 7++main :: IO ()+main = putMdoc =<< genMan1 mdocDump1+```++<details>+<summary>Pretty-printed `mdoc(7)` syntax</summary>++++</details>++<details>+<summary>Viewed using `man`</summary>++++</details>++<details>+<summary>Converted to HTML using `mandoc`</summary>++++</details>++## LICENSE++This project is licensed AGPLv3. See [COPYING](./COPYING).
+ dump/Main.hs view
@@ -0,0 +1,5 @@+module Main+ ( main+ ) where++import Mdoc.Dump.Main
+ mdoc.cabal view
@@ -0,0 +1,207 @@+cabal-version: 1.18+name: mdoc+version: 0.1.0.0+license: AGPL-3+maintainer: Pat Brisbin+synopsis: Parser and pretty-printer for the mdoc(7) language+description: Please see README.md+build-type: Simple+extra-doc-files:+ README.md+ CHANGELOG.md++library+ exposed-modules:+ Env.Mdoc+ Mdoc+ 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.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.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.UpdateMdocdate+ OptEnvConf.Mdoc+ Options.Applicative.Mdoc++ hs-source-dirs: src+ other-modules: Paths_mdoc+ default-language: GHC2021+ default-extensions:+ DataKinds DeriveAnyClass DerivingStrategies DerivingVia+ DuplicateRecordFields GADTs LambdaCase NoFieldSelectors+ NoImplicitPrelude NoMonomorphismRestriction OverloadedRecordDot+ OverloadedStrings RecordWildCards TypeFamilies QuasiQuotes++ ghc-options:+ -fignore-optim-changes -fwrite-ide-info -Weverything+ -Wno-all-missed-specialisations -Wno-missed-specialisations+ -Wno-missing-exported-signatures -Wno-missing-import-lists+ -Wno-missing-kind-signatures -Wno-missing-local-signatures+ -Wno-missing-role-annotations -Wno-missing-safe-haskell-mode+ -Wno-monomorphism-restriction -Wno-prepositive-qualified-module+ -Wno-safe -Wno-unsafe -optP-Wno-nonportable-include-path++ build-depends:+ Diff >=0.5,+ aeson >=2.2.3.0,+ autodocodec-schema >=0.2.0.1,+ base >=4.19.2.0 && <5,+ bytestring >=0.12.1.0,+ containers >=0.6.8,+ envparse >=0.6.0,+ extra >=1.7.16,+ file-embed >=0.0.16.0,+ filepath >=1.4.301.0,+ generic-optics >=2.2.1.0,+ megaparsec >=9.6.1,+ mtl >=2.3.1,+ opt-env-conf >=0.8.0.0,+ optics >=0.4.2.1,+ optparse-applicative >=0.18.1.0,+ prettyprinter >=1.7.1,+ prettyprinter-ansi-terminal >=1.1.3,+ semigroups >=0.20,+ text >=2.1.1,+ time >=1.12.2,+ zlib >=0.7.1.0++executable mdoc-dump+ main-is: Main.hs+ hs-source-dirs: dump+ other-modules: Paths_mdoc+ default-language: GHC2021+ default-extensions:+ DataKinds DeriveAnyClass DerivingStrategies DerivingVia+ DuplicateRecordFields GADTs LambdaCase NoFieldSelectors+ NoImplicitPrelude NoMonomorphismRestriction OverloadedRecordDot+ OverloadedStrings RecordWildCards TypeFamilies QuasiQuotes++ ghc-options:+ -fignore-optim-changes -fwrite-ide-info -Weverything+ -Wno-all-missed-specialisations -Wno-missed-specialisations+ -Wno-missing-exported-signatures -Wno-missing-import-lists+ -Wno-missing-kind-signatures -Wno-missing-local-signatures+ -Wno-missing-role-annotations -Wno-missing-safe-haskell-mode+ -Wno-monomorphism-restriction -Wno-prepositive-qualified-module+ -Wno-safe -Wno-unsafe -optP-Wno-nonportable-include-path -threaded+ -rtsopts -with-rtsopts=-N++ build-depends:+ base >=4.19.2.0 && <5,+ mdoc++test-suite readme+ type: exitcode-stdio-1.0+ main-is: README.lhs+ build-tool-depends: markdown-unlit:markdown-unlit+ other-modules: Paths_mdoc+ default-language: GHC2021+ default-extensions:+ DataKinds DeriveAnyClass DerivingStrategies DerivingVia+ DuplicateRecordFields GADTs LambdaCase NoFieldSelectors+ NoImplicitPrelude NoMonomorphismRestriction OverloadedRecordDot+ OverloadedStrings RecordWildCards TypeFamilies QuasiQuotes++ ghc-options:+ -fignore-optim-changes -fwrite-ide-info -Weverything+ -Wno-all-missed-specialisations -Wno-missed-specialisations+ -Wno-missing-exported-signatures -Wno-missing-import-lists+ -Wno-missing-kind-signatures -Wno-missing-local-signatures+ -Wno-missing-role-annotations -Wno-missing-safe-haskell-mode+ -Wno-monomorphism-restriction -Wno-prepositive-qualified-module+ -Wno-safe -Wno-unsafe -optP-Wno-nonportable-include-path -pgmL+ markdown-unlit++ build-depends:+ base >=4.19.2.0 && <5,+ mdoc++test-suite spec+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: test+ other-modules:+ Mdoc.Gen.DescriptionSpec+ Mdoc.Gen.ExitStatusSpec+ Mdoc.GenSpec+ Mdoc.Parse.MacroArgSpec+ Mdoc.Parse.MdocLineSpec+ Mdoc.Parse.TableLineSpec+ Mdoc.Parse.TroffMacroSpec+ Mdoc.Test.Fixtures+ Mdoc.Test.Parse+ Mdoc.UpdateMdocdateSpec+ MdocSpec+ Paths_mdoc++ default-language: GHC2021+ default-extensions:+ DataKinds DeriveAnyClass DerivingStrategies DerivingVia+ DuplicateRecordFields GADTs LambdaCase NoFieldSelectors+ NoImplicitPrelude NoMonomorphismRestriction OverloadedRecordDot+ OverloadedStrings RecordWildCards TypeFamilies QuasiQuotes++ ghc-options:+ -fignore-optim-changes -fwrite-ide-info -Weverything+ -Wno-all-missed-specialisations -Wno-missed-specialisations+ -Wno-missing-exported-signatures -Wno-missing-import-lists+ -Wno-missing-kind-signatures -Wno-missing-local-signatures+ -Wno-missing-role-annotations -Wno-missing-safe-haskell-mode+ -Wno-monomorphism-restriction -Wno-prepositive-qualified-module+ -Wno-safe -Wno-unsafe -optP-Wno-nonportable-include-path -threaded+ -rtsopts -with-rtsopts=-N++ build-depends:+ 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/Env/Mdoc.hs view
@@ -0,0 +1,38 @@+-- |+--+-- Module : Env.Mdoc+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Env.Mdoc+ ( addToMan1+ ) 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++addToMan1 :: Parser e a -> Man1 -> Man1+addToMan1 p base =+ base+ { environment = base.environment <> envs+ }+ where+ envs = foldAlt varToEnvVar $ unParser p++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+ }+ ]
+ src/Mdoc.hs view
@@ -0,0 +1,33 @@+-- |+--+-- Module : Mdoc+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc+ ( Mdoc (..)+ , parseMdoc+ , prettyMdoc+ ) where++import Mdoc.Prelude++import Mdoc.MdocLine+import Mdoc.Parse+import Mdoc.Parse.MdocLine+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++prettyMdoc :: Mdoc -> Doc Ann+prettyMdoc mdoc = vsep $ map prettyMdocLine mdoc.lines
+ src/Mdoc/Detect.hs view
@@ -0,0 +1,62 @@+-- |+--+-- Module : Mdoc.Detect+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Detect+ ( Unparsable (..)+ , detectParsable+ , prettyUnparsable+ ) where++import Mdoc.Prelude++import Data.List.NonEmpty qualified as NE+import Data.Text qualified as T+import Mdoc.Pretty (Ann (..))+import Prettyprinter++data Unparsable+ = KnownBug+ | NotMdoc Text++prettyUnparsable :: Unparsable -> Doc Ann+prettyUnparsable = \case+ NotMdoc m ->+ "first macro is not"+ <+> annotate AnnKeyword ".Dd"+ <+> "or"+ <+> annotate AnnKeyword ".Dt"+ <+> " (saw "+ <> annotate AnnKeyword (pretty m)+ <> ")"+ KnownBug -> "known bug in this mdoc source"++detectParsable :: String -> Text -> Maybe Unparsable+detectParsable name txt =+ knownBug name <|> notMdoc (mapMaybe toMacro $ T.lines txt)++knownBug :: String -> Maybe Unparsable+knownBug name = KnownBug <$ guard (name `elem` knownBad)++knownBad :: [String]+knownBad =+ [ "/usr/share/man/man1/xkbcli-how-to-type.1.gz" -- https://github.com/xkbcommon/libxkbcommon/pull/863+ , "/usr/share/man/man3/archive_entry_paths.3.gz" -- https://github.com/libarchive/libarchive/pull/2746+ , "/usr/share/man/man5/crypt.5.gz" -- .if in .de macros+ ]++notMdoc :: [Text] -> Maybe Unparsable+notMdoc ms = do+ m <- NE.head <$> nonEmpty ms+ NotMdoc m <$ guard (m `notElem` [".Dd", ".Dt"])++toMacro :: Text -> Maybe Text+toMacro t+ | ".\\\"" `T.isPrefixOf` t = Nothing -- comment+ | "." == t = Nothing -- standalone dot+ | "." `T.isPrefixOf` t = NE.head <$> nonEmpty (T.words t)+ | otherwise = Nothing
+ src/Mdoc/Dump/Diff.hs view
@@ -0,0 +1,103 @@+-- |+--+-- Module : Mdoc.Dump.Diff+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Dump.Diff+ ( Differences (..)+ , getDifferences+ , prettyDifferences+ )+where++import Mdoc.Prelude++import Data.Algorithm.Diff+import Data.Function (on)+import Data.List.NonEmpty qualified as NE+import Data.Text qualified as T+import Mdoc.Pretty++data Differences+ = NoDifferences+ | Differences [Diff Text]++getDifferences :: Text -> Text -> Differences+getDifferences a b+ | all isBoth diff = NoDifferences+ | otherwise = Differences diff+ where+ cmp = (==) `on` normalize+ diff = (getDiffBy cmp `on` T.lines) a b++normalize :: Text -> Text+normalize = T.replace ".\\\" " ".\\\"" . collapseSpaces . T.strip++collapseSpaces :: Text -> Text+collapseSpaces t+ | "." `T.isPrefixOf` t = T.unwords $ T.words t+ | otherwise = t++isBoth :: Diff a -> Bool+isBoth (Both {}) = True+isBoth _ = False++prettyDifferences :: String -> Differences -> Doc Ann+prettyDifferences name = \case+ NoDifferences -> annotate AnnComment "No differences"+ Differences diffs ->+ vsep+ $ [ "Differences in rendered output:"+ , annotate AnnFile $ "--- a" <> pretty (ensureSlash name)+ , annotate AnnFile $ "+++ b" <> pretty (ensureSlash name)+ ]+ <> map prettyDiff (collapse diffs)++ensureSlash :: String -> String+ensureSlash = \case+ x@('/' : _) -> x+ x -> '/' : x++prettyDiff :: Diff Text -> Doc Ann+prettyDiff = \case+ First x -> annotate AnnDiffAddition $ "-" <+> pretty x+ Second x -> annotate AnnDiffDeletion $ "+" <+> pretty x+ Both x _ -> annotate AnnDiffContext $ " " <+> pretty x++-- | Collapse groups of only context, eliding all but the first and last line+collapse :: [Diff Text] -> [Diff Text]+collapse = concatMap elide . NE.groupBy shouldGroup++elide :: NonEmpty (Diff Text) -> [Diff Text]+elide ne@(x :| _) = case (x, length ne) of+ (Both {}, n)+ | n > 3 ->+ [ NE.head ne+ , ellipseLine $ n - 2+ , NE.last ne+ ]+ _ -> toList ne++-- | Show omitted lines+--+-- This will only ever be used with an @n >= 2@, so the 0-vs-1-vs-n language+-- doesn't matter, but we do it anyway in case we mess up in the future.+ellipseLine :: Int -> Diff Text+ellipseLine n = Both msg msg+ where+ msg = case n of+ 0 -> "... no lines omitted ..." -- doesn't happen+ 1 -> "... 1 line omitted ..."+ _ -> "... " <> pack (show n) <> " lines omitted ..."++-- | Create groups of either only context or only additions/deletions+shouldGroup :: Diff Text -> Diff Text -> Bool+shouldGroup (First {}) (First {}) = True+shouldGroup (First {}) (Second {}) = True+shouldGroup (Second {}) (Second {}) = True+shouldGroup (Second {}) (First {}) = True+shouldGroup (Both {}) (Both {}) = True+shouldGroup _ _ = False
+ src/Mdoc/Dump/Env.hs view
@@ -0,0 +1,42 @@+-- |+--+-- Module : Mdoc.Dump.Env+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Dump.Env+ ( Env (..)+ , parseEnv++ -- * For man-page generation+ , envInfo+ , envParser+ ) where++import Prelude++import Env+import Mdoc.Pretty (Color (..), readColor)++data Env = Env+ { color :: Maybe Color+ , debug :: Bool+ }++parseEnv :: IO Env+parseEnv = Env.parse (header envInfo) envParser++envInfo :: String+envInfo = "parse and dump an mdoc file"++envParser :: Parser Error Env+envParser =+ Env.prefixed "MDOC_DUMP_"+ $ Env+ <$> optional colorEnv+ <*> switch "DEBUG" (help "Log more verbosely")++colorEnv :: Parser Error Color+colorEnv = var (eitherReader readColor) "COLOR" $ help "When to colorize the output"
+ src/Mdoc/Dump/Main.hs view
@@ -0,0 +1,67 @@+-- |+--+-- Module : Mdoc.Dump.Main+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Dump.Main+ ( main+ )+where++import Mdoc.Prelude++import Mdoc+import Mdoc.Detect+import Mdoc.Dump.Diff+import Mdoc.Dump.Options+import Mdoc.Input+import Mdoc.Parse (exitParseError)+import Mdoc.Pretty (Ann (..), Color (..), putDoc, renderPlain)+import Mdoc.UpdateMdocdate+import Prettyprinter+import System.Exit (exitFailure)+import System.IO (stderr, stdout)++main :: IO ()+main = do+ options <- parseOptions++ let+ color = fromMaybe ColorAuto options.color++ postProcess mdoc =+ if options.updateMdocdate+ then updateMdocdate mdoc+ else pure mdoc++ forInputs_ options.input $ \input -> do+ case input.parsed of+ SkipParse reason ->+ when options.debug+ $ putDoc color stderr+ $ annotate AnnFile (pretty input.name)+ <> ":"+ <+> "refusing to parse"+ <+> prettyUnparsable reason+ ParseError err -> exitParseError err+ Parsed mdoc -> do+ mdoc' <- postProcess mdoc+ putDoc color stdout $ prettyMdoc mdoc'++ -- NB. The --check option operates on mdoc before any --update-mdocdate+ -- changes. Unclear what the least surprising behavior is here.+ when options.check $ do+ let+ src = input.source+ txt = renderPlain $ prettyMdoc mdoc+ diffs = getDifferences src txt++ case diffs of+ NoDifferences ->+ putDoc color stdout $ prettyDifferences input.name diffs+ Differences {} -> do+ putDoc color stderr $ prettyDifferences input.name diffs+ exitFailure
+ src/Mdoc/Dump/Options.hs view
@@ -0,0 +1,93 @@+{-# OPTIONS_GHC -Wno-ambiguous-fields #-}++-- |+--+-- Module : Mdoc.Dump.Options+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Dump.Options+ ( Options (..)+ , parseOptions++ -- * For man-page generation+ , optionsInfo+ , optionsParser+ ) where++import Prelude++import Mdoc.Dump.Env+import Mdoc.Pretty (Color (..), readColor)+import Options.Applicative++data Options = Options+ { check :: Bool+ , updateMdocdate :: Bool+ , color :: Maybe Color+ , debug :: Bool+ , input :: [FilePath]+ }++parseOptions :: IO Options+parseOptions = do+ env <- parseEnv+ opt <-+ execParser+ $ info (optionsParser <**> helper)+ $ fullDesc <> progDesc optionsInfo++ pure+ (opt :: Options)+ { color = opt.color <|> env.color+ , debug = env.debug || opt.debug+ }++optionsInfo :: String+optionsInfo = envInfo++optionsParser :: Parser Options+optionsParser =+ Options+ <$> switch+ ( mconcat+ [ short 'c'+ , long "check"+ , help "Check that re-rendering parsed as mdoc matches input"+ ]+ )+ <*> switch+ ( mconcat+ [ long "update-mdocdate"+ , help "Update any $Mdocdate$ macros in the output"+ ]+ )+ <*> optional+ ( option+ (eitherReader readColor)+ ( mconcat+ [ long "color"+ , help "When to colorize the output"+ , metavar "auto|always|never"+ ]+ )+ )+ <*> switch+ ( mconcat+ [ short 'v'+ , long "debug"+ , help "Log more verbosely"+ ]+ )+ <*> many+ ( argument+ str+ ( mconcat+ [ metavar "FILE"+ , help+ "Read from the given file (if specified multiple times, output is concatenated; if none are specified, stdin is read)"+ ]+ )+ )
+ src/Mdoc/Gen.hs view
@@ -0,0 +1,76 @@+-- |+--+-- 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 view
@@ -0,0 +1,61 @@+-- |+--+-- 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} =+ case optionality of+ Required ->+ [ Bare $ esc $ pack $ x <> "="+ , Callable Ns+ ]+ <> renderArgument arg+ _ ->+ [ Bare $ esc $ pack x+ , Callable Ns+ , Callable Op+ , Callable Cm+ , Bare "="+ , Callable Ns+ ]+ <> renderArgument arg
+ src/Mdoc/Gen/Config.hs view
@@ -0,0 +1,55 @@+-- |+--+-- 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 :: String+ , schema :: Schema+ , exampleLines :: Maybe (NonEmpty String)+ }+ deriving stock (Eq, Show)++renderConfig :: Config -> [MacroArg]+renderConfig c =+ [ Callable Cm+ , Bare $ esc $ pack c.name+ , Callable Ns+ , ":"+ ]+ <> schemaArgs c.schema++data Schema+ = Simple Text+ | AnyOf [Schema]+ | ListOf Schema+ | Object Text 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, "[]"]+ Object k s -> ["{", Callable Ar, Bare $ esc k, ","] <> schemaArgs s <> ["}"]
+ src/Mdoc/Gen/CrossRef.hs view
@@ -0,0 +1,43 @@+-- |+--+-- 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+ a `compare` b = a.section `compare` b.section <> a.name `compare` b.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 view
@@ -0,0 +1,46 @@+-- |+--+-- 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 (..)+ , renderDescribedItems+ , renderDescribedItem+ ) where++import Mdoc.Prelude++import Data.List (intersperse)+import Mdoc.Gen.Optionality+import Mdoc.MacroArg+import Mdoc.MacroName+import Mdoc.MdocLine++data Described a = Described+ { item :: a+ , optionality :: Optionality+ , multiple :: Bool+ , helpLines :: Maybe (NonEmpty String)+ }+ deriving stock (Eq, Functor, Generic, Show)++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 view
@@ -0,0 +1,99 @@+-- |+--+-- 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 -> (FlagOrder, [MdocLine])+switchLines d =+ ( flagOrder d.item+ , renderDescribedItem (`renderFlag` Nothing) d+ )++optionLines :: Described Option -> (FlagOrder, [MdocLine])+optionLines d =+ ( flagOrder 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 view
@@ -0,0 +1,36 @@+-- |+--+-- 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 view
@@ -0,0 +1,30 @@+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 view
@@ -0,0 +1,30 @@+module Mdoc.Gen.ExitStatus+ ( NonZeroStatus (..)+ , renderExitStatuses+ ) where++import Mdoc.Prelude++import Mdoc.MacroName+import Mdoc.MdocLine++data NonZeroStatus = NonZeroStatus+ { status :: Text+ -- ^ @>0@+ , condition :: Text+ -- ^ @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 view
@@ -0,0 +1,63 @@+-- |+--+-- 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 view
@@ -0,0 +1,64 @@+-- |+--+-- 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 (..)+ , FlagOrder+ , flagOrder+ , 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)++data FlagOrder = FlagOrder+ { _byType :: Int+ , _byNameLower :: String+ , _byUpperThenLower :: Bool+ }+ deriving stock (Eq, Ord)++-- | Shorts before longs, capital then lower together+flagOrder :: Flag -> FlagOrder+flagOrder = \case+ Flag c _ -> FlagOrder 1 [toLower c] $ isLower c+ GNUFlag s _ -> FlagOrder 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 view
@@ -0,0 +1,69 @@+-- |+--+-- 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 view
@@ -0,0 +1,42 @@+-- |+--+-- 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 view
@@ -0,0 +1,49 @@+-- |+--+-- 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 view
@@ -0,0 +1,22 @@+-- |+--+-- 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 view
@@ -0,0 +1,19 @@+-- |+--+-- 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 (..)+ ) where++import Mdoc.Prelude++data Optionality+ = Optional+ | Required+ | Defaulted String+ deriving stock (Eq, Show)
+ src/Mdoc/Gen/Synopsis.hs view
@@ -0,0 +1,94 @@+{-# 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 [] (\cs -> [MacroLine Op [Callable Fl, Bare $ esc $ pack $ toList cs]])+ $ 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 []]+ ]++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 ->+ let margs = renderShort c $ Just d.item.argument+ in case d.optionality of+ Required -> MacroLine Fl margs+ _ -> MacroLine Op $ Callable Fl : margs++longSwitchLine :: Described Flag -> Maybe (String, MdocLine)+longSwitchLine d = withLong d.item $ \s ->+ let+ margs = renderLong s Nothing+ mline = case d.optionality of+ Required -> MacroLine Fl margs+ _ -> MacroLine Op $ Callable Fl : margs+ in+ (s, mline)++longOptionLine :: Described Option -> Maybe (String, MdocLine)+longOptionLine d = withLong d.item.flag $ \s ->+ let+ margs = renderLong s $ Just d.item.argument+ mline = case d.optionality of+ Required -> MacroLine Fl margs+ _ -> MacroLine Op $ Callable Fl : margs+ in+ (s, mline)++argLine :: Described Argument -> MdocLine+argLine d =+ case d.optionality of+ Required -> MacroLine Ar margs+ Optional -> MacroLine Op $ Callable Ar : margs+ Defaulted {} -> MacroLine Op $ Callable Ar : margs+ 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 view
@@ -0,0 +1,80 @@+{-# 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
@@ -0,0 +1,67 @@+-- |+--+-- Module : Mdoc.Input+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Input+ ( Input (..)+ , Parsed (..)+ , forInputs_+ , parseMdocBytes+ ) where++import Mdoc.Prelude++import Codec.Compression.GZip qualified as GZip+import Data.ByteString.Lazy (LazyByteString)+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 System.FilePath (takeExtension)++data Input = Input+ { name :: String+ , source :: Text+ , parsed :: Parsed+ }++data Parsed+ = SkipParse Unparsable+ | ParseError ParseError+ | Parsed Mdoc++forInputs_ :: MonadIO m => [FilePath] -> (Input -> m a) -> m ()+forInputs_ inputs f = case inputs of+ [] -> void . f . mkInput "<stdin>" =<< liftIO BSL.getContents+ paths -> for_ paths $ \path -> do+ f . mkInput path =<< liftIO (BSL.readFile path)++mkInput :: String -> LazyByteString -> Input+mkInput name bytes =+ let+ source = decodeUtf8With lenientDecode $ BSL.toStrict bytes+ parsed = either ParseError Parsed $ parseMdocBytes name bytes+ input p = Input {name, source, parsed = p}+ in+ input $ maybe parsed SkipParse $ detectParsable name source++parseMdocBytes+ :: FilePath+ -- ^ Path used for parse errors and detecting gzip+ -> LazyByteString+ -> Either ParseError Mdoc+parseMdocBytes path =+ runParser parseMdoc path+ . decodeUtf8With lenientDecode+ . BSL.toStrict+ . decompress+ where+ decompress+ | takeExtension path == ".gz" = GZip.decompress+ | otherwise = id
+ src/Mdoc/Interpolated.hs view
@@ -0,0 +1,69 @@+-- |+--+-- 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 -> case v.environment of+ Nothing -> []+ Just es -> MacroLine Sh ["ENVIRONMENT"] : toList es+ InterpolatedLine Files -> case v.files of+ Nothing -> []+ Just fs -> MacroLine Sh ["FILES"] : toList fs+ InterpolatedLine ExitStatus ->+ maybe [MacroLine Ex ["-std"]] toList v.exitStatus+ InterpolatedLine SeeAlso -> case v.seeAlso of+ Nothing -> []+ Just crs -> MacroLine Sh ["SEE", "ALSO"] : toList crs+ line -> [line]++instance Interpolated Mdoc where+ interpolate v mdoc = mdoc {lines = interpolate v mdoc.lines}
+ src/Mdoc/Interpolation.hs view
@@ -0,0 +1,38 @@+-- |+--+-- 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 view
@@ -0,0 +1,38 @@+-- |+--+-- 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 view
@@ -0,0 +1,149 @@+-- |+--+-- 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 view
@@ -0,0 +1,37 @@+-- |+--+-- 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
@@ -0,0 +1,36 @@+-- |+--+-- Module : Mdoc.Optics+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Optics+ ( field++ -- * Application+ , (%)+ , traversed++ -- * Access+ , (^.)++ -- * Updates+ , (.~)+ , (?~)+ , (%~)+ , (<>~)++ -- * Construction+ , Prism'+ , prism+ ) where++import Prelude++import Data.Generics.Product.Fields+import Optics++(<>~) :: Semigroup b => Lens' a b -> b -> a -> a+l <>~ w = l %~ (<> w)
+ src/Mdoc/Parse.hs view
@@ -0,0 +1,112 @@+-- |+--+-- Module : Mdoc.Parse+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Parse+ ( Parser+ , ParseError+ , MacroState (..)+ , runParser+ , exitParseError++ -- * Megaparsec re-exports+ , module Text.Megaparsec+ , module Text.Megaparsec.Char++ -- * High-level helpers+ , macroCall++ -- * Low-level helpers+ , restOfWord+ , restOfLine+ , digits+ , quotedBy+ , escaped+ , peek+ , parseAs+ ) where++import Mdoc.Prelude++import Control.Monad.State.Strict (StateT, evalState)+import Data.Char (isSpace)+import Data.Monoid (Last (..))+import Data.Semigroup.Generic (GenericSemigroupMonoid (..))+import System.Exit (exitFailure)+import System.IO (hPutStrLn, stderr)+import Text.Megaparsec hiding (ParseError, parseTest, runParser)+import Text.Megaparsec.Char+import Text.Read (readMaybe)++type Parser a = ParsecT Void Text (StateT MacroState Identity) a++runParser :: Parser a -> String -> Text -> Either ParseError a+runParser p name input =+ flip evalState mempty $ runParserT (p <* eof) name input++exitParseError :: MonadIO m => ParseError -> m a+exitParseError err = liftIO $ do+ hPutStrLn stderr $ errorBundlePretty err+ exitFailure++data MacroState = MacroState+ { defined :: Set Text+ -- ^ Macros that have been defined so far+ , nextClose :: Last Text+ -- ^ If in a macro definition with custom closer, this is it+ }+ deriving stock (Generic)+ deriving (Monoid, Semigroup) via GenericSemigroupMonoid MacroState++type ParseError = ParseErrorBundle Text Void++-- | Flexibly parse a macro call+--+-- Parses+--+-- @+-- .{Name}[ {Arg}...]+-- @+--+-- And passes @Name@ and @[Arg]@ to the given constructor.+macroCall+ :: (name -> [arg] -> a)+ -- ^ Constructor given name and args+ -> Parser name+ -- ^ Parser for the macro name (not including the leading @.@)+ -> Parser arg+ -- ^ Parser for an individual argument+ -> Parser a+macroCall f pName pArg = do+ name <- char '.' *> pName+ args <- manyTill (hspace1 *> pArg) (peek $ hspace >> eol)+ pure $ f name args++restOfWord :: Parser Text+restOfWord = pack <$> some (satisfy $ not . isSpace) <?> "rest of word"++restOfLine :: Parser Text+restOfLine = pack <$> manyTill anySingle (peek eol) <?> "rest of line"++digits :: Parser Int+digits = do+ s <- some digitChar+ maybe (fail $ "String " <> s <> " did not parse as Int") pure $ readMaybe s++quotedBy :: Char -> Parser Text+quotedBy c = do+ str <- char c *> manyTill (try (escaped c) <|> noneOf [c]) (char c)+ pure $ pack str++escaped :: Char -> Parser Char+escaped c = char '\\' *> char c++peek :: Parser a -> Parser a+peek p = lookAhead $ try p++parseAs :: (a -> Text) -> a -> Parser a+parseAs f a = a <$ string (f a)
+ src/Mdoc/Parse/Interpolation.hs view
@@ -0,0 +1,41 @@+-- |+--+-- 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
@@ -0,0 +1,73 @@+-- |+--+-- Module : Mdoc.Parse.MacroArg+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Parse.MacroArg+ ( parseMacroArg+ ) where++import Mdoc.Prelude++import Data.Time (fromGregorian)+import Mdoc.MacroArg+import Mdoc.Parse+import Mdoc.Parse.Interpolation+import Mdoc.Parse.MacroName++parseMacroArg :: Parser MacroArg+parseMacroArg =+ choice+ [ mdocDate+ , interpolated+ , try quotedComma <|> quoted+ , try callable <|> bare+ ]+ <?> "macro argument"++mdocDate :: Parser MacroArg+mdocDate = do+ void $ string "$Mdocdate"+ arg <- optional $ do+ m <- char ':' *> hspace *> month+ d <- hspace1 *> digits+ y <- hspace1 *> digits+ pure $ fromGregorian (fromIntegral y) m d+ void $ hspace *> char '$'+ pure $ Mdocdate arg+ where+ month :: Parser Int+ month =+ choice+ [ 1 <$ string "January"+ , 2 <$ string "February"+ , 3 <$ string "March"+ , 4 <$ string "April"+ , 5 <$ string "May"+ , 6 <$ string "June"+ , 7 <$ string "July"+ , 8 <$ string "August"+ , 9 <$ string "September"+ , 10 <$ string "October"+ , 11 <$ string "November"+ , 12 <$ string "December"+ ]+ <?> "month name (e.g. January)"++interpolated :: Parser MacroArg+interpolated = InterpolatedArg <$> parseInterpolationArg++callable :: Parser MacroArg+callable = Callable <$> parseMacroName <* peek space1 <?> "callable macro"++quotedComma :: Parser MacroArg+quotedComma = QuotedComma <$> quotedBy '"' <* char ','++quoted :: Parser MacroArg+quoted = Quoted <$> quotedBy '"'++bare :: Parser MacroArg+bare = Bare <$> restOfWord <?> "bare word"
+ src/Mdoc/Parse/MacroName.hs view
@@ -0,0 +1,22 @@+-- |+--+-- Module : Mdoc.Parse.MacroName+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Parse.MacroName+ ( parseMacroName+ ) where++import Mdoc.Prelude++import Mdoc.MacroName+import Mdoc.Parse++parseMacroName :: Parser MacroName+parseMacroName = choice names <?> "macro name"+ where+ names :: [Parser MacroName]+ names = map (parseAs macroNameText) [minBound .. maxBound]
+ src/Mdoc/Parse/MdocLine.hs view
@@ -0,0 +1,45 @@+-- |+--+-- Module : Mdoc.Parse.MdocLine+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Parse.MdocLine+ ( parseMdocLine+ ) where++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++parseMdocLine :: Parser MdocLine+parseMdocLine =+ choice+ [ try comment+ , try dot <* hspace+ , try $ TroffMacro <$> parseTroffMacro+ , TableLines <$> parseTableLines+ , macroLine <* hspace+ , InterpolatedLine <$> parseInterpolationLine+ , textLine+ ]++comment :: Parser MdocLine+comment = string ".\\\"" *> hspace *> (Comment <$> restOfLine) <?> "comment"++dot :: Parser MdocLine+dot = TextLine <$> string "." <* peek (hspace >> eol) <?> "standalone dot"++macroLine :: Parser MdocLine+macroLine = macroCall MacroLine parseMacroName parseMacroArg++textLine :: Parser MdocLine+textLine = TextLine <$> restOfLine <?> "text line"
+ src/Mdoc/Parse/TableLine.hs view
@@ -0,0 +1,23 @@+-- |+--+-- Module : Mdoc.Parse.TableLine+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Parse.TableLine+ ( parseTableLines+ ) where++import Mdoc.Prelude++import Data.Text qualified as T+import Mdoc.Parse+import Mdoc.TableLine++parseTableLines :: Parser [TableLine]+parseTableLines = do+ void $ string ".TS" >> eol+ str <- manyTill anySingle $ string ".TE" >> peek eol+ pure $ map TableLine $ T.lines $ pack str
+ src/Mdoc/Parse/TroffMacro.hs view
@@ -0,0 +1,65 @@+-- |+--+-- Module : Mdoc.Parse.TroffMacro+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Parse.TroffMacro+ ( parseTroffMacro+ ) where++import Mdoc.Prelude++import Control.Monad.State.Strict (get, modify)+import Data.Monoid (Last (..))+import Data.Set qualified as Set+import Data.Text qualified as T+import Mdoc.Parse+import Mdoc.TroffMacro++parseTroffMacro :: Parser TroffMacro+parseTroffMacro =+ choice+ [ try troffMacroDefine+ , try troffMacroDefineS+ , try troffMacroCall+ , try troffMacroEnd+ ]++troffMacroDefine :: Parser TroffMacro+troffMacroDefine = do+ void $ string ".de" >> hspace1+ name <- restOfWord+ mClose <- optional $ hspace1 *> restOfWord+ lift+ $ modify (<> mempty {defined = Set.singleton name, nextClose = Last mClose})+ pure $ TroffMacroDefine name mClose++troffMacroDefineS :: Parser TroffMacro+troffMacroDefineS = do+ void $ string ".ds" >> hspace1+ name <- restOfWord+ value <- optional $ hspace1 *> restOfLine+ lift $ modify (<> mempty {defined = Set.singleton name})+ pure $ TroffMacroDefineS name value++troffMacroCall :: Parser TroffMacro+troffMacroCall = do+ s <- lift get+ let+ names = toList s.defined+ pName =+ choice (map string names)+ <?> "custom macro "+ <> unpack (T.intercalate "|" names)+ macroCall TroffMacroCall pName restOfWord++troffMacroEnd :: Parser TroffMacro+troffMacroEnd = do+ s <- lift get+ t <- case getLast s.nextClose of+ Nothing -> string ".."+ Just cl -> char '.' *> string cl+ TroffMacroEnd t <$ peek (hspace >> eol)
+ src/Mdoc/Prelude.hs view
@@ -0,0 +1,45 @@+-- |+--+-- Module : Mdoc.Prelude+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Prelude+ ( module X+ , guarded+ , esc+ ) where++import Prelude as X hiding (head, init, last, tail)++import Control.Applicative as X (Alternative, asum, (<|>))+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.Bifunctor as X (bimap, first, second)+import Data.Foldable as X (for_, toList)+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.NonEmpty.Extra as X ((|:))+import Data.Maybe as X (catMaybes, fromMaybe, isJust, isNothing, mapMaybe)+import Data.Ord as X (comparing)+import Data.Semigroup as X (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 GHC.Generics as X (Generic, Generically (..))++guarded :: Alternative f => (a -> Bool) -> a -> f a+guarded p a = a <$ guard (p a)++esc :: Text -> Text+esc =+ T.replace "\\n" "\\\\n"+ . T.replace "-" "\\-"
+ src/Mdoc/Pretty.hs view
@@ -0,0 +1,110 @@+-- |+--+-- Module : Mdoc.Pretty+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Pretty+ ( -- * @--color@ option+ Color (..)+ , readColor+ , showColor++ -- * Annotations used in this project+ , Ann (..)+ , annToAnsi++ -- * Re-exports+ , module Prettyprinter++ -- * Rendering+ , putDoc+ , renderDoc+ , renderColor+ , renderPlain+ ) where++import Mdoc.Prelude++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 System.IO (Handle, hIsTerminalDevice)++data Ann+ = AnnComment+ | AnnCommand+ | AnnKeyword+ | AnnSymbol+ | AnnArgument+ | AnnQuote+ | AnnQuoted+ | AnnSpecial+ | AnnFile+ | AnnDiffAddition+ | AnnDiffDeletion+ | AnnDiffContext++data Color+ = ColorAuto+ | ColorAlways+ | ColorNever++readColor :: String -> Either String Color+readColor = \case+ "auto" -> Right ColorAuto+ "always" -> Right ColorAlways+ "never" -> Right ColorNever+ other -> Left $ "Unknown color: " <> other <> ", expected auto|always|never"++showColor :: Color -> String+showColor = \case+ ColorAuto -> "auto"+ ColorAlways -> "always"+ ColorNever -> "never"++putDoc :: MonadIO m => Color -> Handle -> Doc Ann -> m ()+putDoc c h doc = do+ useColor <- case c of+ ColorAuto -> liftIO $ hIsTerminalDevice h+ ColorAlways -> pure True+ ColorNever -> pure False++ liftIO $ T.hPutStr h $ renderDoc useColor doc++renderDoc :: Bool -> Doc Ann -> Text+renderDoc useColor doc+ | useColor = renderColor doc+ | otherwise = renderPlain doc++renderColor :: Doc Ann -> Text+renderColor =+ (<> "\n")+ . Ansi.renderStrict+ . layoutPretty defaultLayoutOptions+ . reAnnotate annToAnsi++renderPlain :: Doc Ann -> Text+renderPlain =+ (<> "\n")+ . Text.renderStrict+ . layoutPretty defaultLayoutOptions++annToAnsi :: Ann -> AnsiStyle+annToAnsi = \case+ AnnComment -> colorDull Ansi.White+ AnnCommand -> colorDull Ansi.Blue+ AnnKeyword -> color Ansi.Black+ AnnSymbol -> colorDull Ansi.White+ AnnArgument -> colorDull Ansi.Green+ AnnQuote -> colorDull Ansi.White+ AnnQuoted -> colorDull Ansi.Green+ AnnSpecial -> colorDull Ansi.Magenta+ AnnFile -> bold+ AnnDiffAddition -> colorDull Ansi.Green+ AnnDiffDeletion -> colorDull Ansi.Red+ AnnDiffContext -> colorDull Ansi.White
+ src/Mdoc/Pretty/Interpolation.hs view
@@ -0,0 +1,22 @@+-- |+--+-- 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 view
@@ -0,0 +1,53 @@+-- |+--+-- 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 view
@@ -0,0 +1,19 @@+-- |+--+-- 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 view
@@ -0,0 +1,34 @@+-- |+--+-- 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 view
@@ -0,0 +1,19 @@+-- |+--+-- 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 view
@@ -0,0 +1,31 @@+-- |+--+-- 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/TableLine.hs view
@@ -0,0 +1,18 @@+-- |+--+-- 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/TroffMacro.hs view
@@ -0,0 +1,20 @@+-- |+--+-- 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
@@ -0,0 +1,28 @@+-- |+--+-- Module : Mdoc.UpdateMdocdate+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.UpdateMdocdate+ ( updateMdocdate+ , updateMdocdateTo+ ) where++import Mdoc.Prelude++import Data.Time (Day, getCurrentTime, utctDay)+import Mdoc (Mdoc)+import Mdoc.MacroArg (_Mdocdate)+import Mdoc.MdocLine (_Dd)+import Mdoc.Optics++updateMdocdate :: MonadIO m => Mdoc -> m Mdoc+updateMdocdate mdoc = do+ d <- liftIO $ utctDay <$> getCurrentTime+ pure $ updateMdocdateTo d mdoc++updateMdocdateTo :: Day -> Mdoc -> Mdoc+updateMdocdateTo d = field @"lines" % traversed % _Dd % traversed % _Mdocdate ?~ d
+ src/OptEnvConf/Mdoc.hs view
@@ -0,0 +1,223 @@+-- |+--+-- Module : OptEnvConf.Mdoc+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module OptEnvConf.Mdoc+ ( addToMan1+ , addToMan5+ ) where++import Mdoc.Prelude++import Autodocodec.Schema (JSONSchema (..))+import Data.Aeson qualified as Aeson+import Data.List (intercalate)+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 OptEnvConf (ConfDoc (..), EnvDoc (..), OptDoc (..), Parser)+import OptEnvConf.Args (Dashed (..))+import OptEnvConf.Doc+ ( AnyDocs (..)+ , parserConfDocs+ , parserEnvDocs+ , parserOptDocs+ )++addToMan1 :: Parser a -> Man1 -> Man1+addToMan1 p base =+ base+ { switches = base.switches <> switches+ , options = base.options <> options+ , arguments = base.arguments <> getParserArgs p+ , environment = base.environment <> getParserEnvs p+ }+ where+ (switches, options) = partitionDescribed $ getParserOpts p++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++addToMan5 :: Parser a -> Man5 -> Man5+addToMan5 p base =+ base+ { configs = base.configs <> getParserConfs p+ }++getParserOpts :: Parser a -> [Described (Either Flag Option)]+getParserOpts = walkNonCommandDocs (maybe [] optDocToOpt) . parserOptDocs++getParserArgs :: Parser a -> [Described Argument]+getParserArgs = walkNonCommandDocs (maybe [] optDocToArg) . parserOptDocs++getParserEnvs :: Parser a -> [Described EnvVar]+getParserEnvs = walkNonCommandDocs envDocToEnvVar . parserEnvDocs++-- getParserCmds :: Parser a -> [Command]+-- getParserCmds = walkCommandDocs commandDocToCommand . parserOptDocs++getParserConfs :: Parser a -> [Described Config]+getParserConfs = walkNonCommandDocs confToConfig . parserConfDocs++optDocToOpt :: 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++ pure+ [ Described+ { item+ , optionality = maybe Required Defaulted $ optDocDefault doc+ , multiple = False+ , helpLines = nonEmpty . lines =<< optDocHelp doc+ }+ ]++optDocToArg :: OptDoc -> [Described Argument]+optDocToArg doc =+ case (optDocDasheds doc, optDocMetavar doc) of+ ([], Just schema) ->+ [ Described+ { item =+ Argument+ { schema+ , optionality = Required+ }+ , optionality = maybe Required Defaulted $ optDocDefault doc+ , multiple = False+ , helpLines = nonEmpty . lines =<< optDocHelp doc+ }+ ]+ _ -> []++envDocToEnvVar :: EnvDoc -> [Described EnvVar]+envDocToEnvVar doc =+ [ Described+ { item =+ EnvVar+ { names = envDocVars doc+ , argument =+ envDocMetavar doc <&> \schema ->+ Argument {schema, optionality = Required}+ }+ , optionality = maybe Required Defaulted $ envDocDefault doc+ , multiple = False+ , helpLines = nonEmpty . lines =<< envDocHelp doc+ }+ ]++-- commandDocToCommand :: CommandDoc (Maybe OptDoc) -> [Command]+-- commandDocToCommand c =+-- [ Command+-- { name = commandDocArgument c+-- , help = Just $ commandDocHelp c+-- , opts = walkNonCommandDocs 0 (maybe [] . optDocToOpt) $ commandDocs c+-- , args = walkNonCommandDocs 0 (maybe [] . optDocToArg) $ commandDocs c+-- , visible = True+-- , required = True+-- , multiple = False+-- , def = Nothing+-- }+-- ]++confToConfig :: ConfDoc -> [Described Config]+confToConfig doc = map (uncurry go . first toList) $ toList $ confDocKeys doc+ where+ go :: [String] -> JSONSchema -> Described Config+ go keys jSchema =+ Described+ { item =+ Config+ { name = intercalate "." keys+ , schema = simplifySchema jSchema+ , exampleLines = nonEmpty $ confDocExamples doc+ }+ , optionality = maybe Required Defaulted $ confDocDefault doc+ , multiple = False+ , helpLines = nonEmpty . lines =<< confDocHelp doc+ }++simplifySchema :: JSONSchema -> Schema+simplifySchema = \case+ AnySchema -> "any"+ NullSchema -> "null"+ BoolSchema -> "boolean"+ StringSchema {} -> "string"+ IntegerSchema {} -> "number"+ NumberSchema {} -> "number"+ ArraySchema s -> ListOf $ simplifySchema s+ MapSchema s -> simplifySchema s+ ObjectSchema {} -> "object"+ -- This is only used for `const`, it must match `Value` literally+ ValueSchema v -> case v of+ Aeson.Object {} -> "json"+ Aeson.Array {} -> "json"+ Aeson.String t -> Simple t+ Aeson.Number n -> Simple $ pack $ show n+ Aeson.Bool b -> Simple $ pack $ show b+ Aeson.Null -> "null"+ AnyOfSchema ss -> anyOf $ toList ss+ OneOfSchema ss -> anyOf $ toList ss+ CommentSchema c _ -> Simple c+ RefSchema t -> Simple t+ WithDefSchema _ s -> simplifySchema s+ where+ -- Work around bug in opt-env-conf where all configs are null|x+ anyOf [NullSchema, s] = simplifySchema s+ anyOf ss = AnyOf $ map simplifySchema ss++dashedFlags :: [Dashed] -> Maybe Flag+dashedFlags = fmap go . nonEmpty+ where+ go :: NonEmpty Dashed -> Flag+ go ne =+ let aliases = map (aliasedAs []) $ tail ne+ in aliasedAs aliases $ head ne++ aliasedAs :: [Flag] -> Dashed -> Flag+ aliasedAs xs = \case+ DashedShort x -> Flag x xs+ DashedLong x -> GNUFlag (toList x) xs++-- walkCommandDocs :: (CommandDoc a -> [b]) -> AnyDocs a -> [b]+-- walkCommandDocs f = \case+-- AnyDocsCommands _mDefault cmds -> concatMap f cmds+-- AnyDocsAnd ds -> concatMap (walkCommandDocs f) ds+-- AnyDocsOr ds -> concatMap (walkCommandDocs f) ds+-- AnyDocsSingle {} -> []++walkNonCommandDocs :: (a -> [Described b]) -> AnyDocs a -> [Described b]+walkNonCommandDocs f = \case+ AnyDocsCommands {} -> []+ AnyDocsAnd ds -> concatMap (walkNonCommandDocs f) ds+ AnyDocsOr ds -> concatMap (map mkMultiple . walkNonCommandDocs f) ds+ AnyDocsSingle d -> f 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.+ mkMultiple d = d {optionality = Optional, multiple = True}
+ src/Options/Applicative/Mdoc.hs view
@@ -0,0 +1,136 @@+{-# OPTIONS_GHC -Wno-ambiguous-fields #-}++-- |+--+-- Module : Options.Applicative.Mdoc+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Options.Applicative.Mdoc+ ( addToMan1+ ) 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 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+ { switches = m.switches <> switches+ , options = m.options <> options+ , arguments = m.arguments <> arguments+ }++addToMan1 :: Parser a -> Man1 -> Man1+addToMan1 p base =+ fromSub base+ $ foldOptTree (toSub base) optionToMan1+ $ treeMapParser (const void) p++optionToMan1 :: SubMan1 -> Described (O.Option x) -> SubMan1+optionToMan1 acc d = case O.optMain o of+ O.OptReader onames _ _ -> fromMaybe acc $ do+ flag <- optFlags onames+ schema <- metavar+ let+ argument = Argument {schema, optionality = Required}+ option = Option {flag, argument}+ pure $ acc {options = acc.options <> [option <$ d]}+ O.FlagReader onames _ -> fromMaybe acc $ do+ flag <- optFlags onames+ pure $ acc {switches = acc.switches <> [flag <$ d]}+ O.ArgReader {} -> fromMaybe acc $ do+ schema <- metavar+ let argument = Argument {schema, optionality = Required}+ pure $ acc {arguments = acc.arguments <> [argument <$ d]}+ O.CmdReader {} -> acc -- TODO+ where+ o = d.item+ metavar = guarded (not . null) $ O.optMetaVar o++optFlags :: [O.OptName] -> Maybe Flag+optFlags = fmap go . nonEmpty . sort+ where+ go :: NonEmpty O.OptName -> Flag+ go ne =+ let aliases = map (aliasedAs []) $ tail ne+ in aliasedAs aliases $ head ne++ aliasedAs :: [Flag] -> O.OptName -> Flag+ aliasedAs xs = \case+ O.OptShort x -> Flag x xs+ O.OptLong x -> GNUFlag x xs++foldOptTree+ :: SubMan1+ -> ( SubMan1+ -> Described (O.Option x)+ -> SubMan1+ )+ -> O.OptTree (O.Option x)+ -> SubMan1+foldOptTree acc f = \case+ O.Leaf o ->+ case O.optVisibility o of+ O.Visible ->+ f acc+ $ Described+ { item = o+ , optionality = maybe Required Defaulted (O.optShowDefault o)+ , multiple = False+ , helpLines = nonEmpty $ maybe [] lines $ docToString $ 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+ 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}++docToString :: Chunk Doc -> Maybe String+docToString =+ fmap+ ( Pretty.renderString+ . Pretty.layoutPretty+ Pretty.defaultLayoutOptions {Pretty.layoutPageWidth = Pretty.Unbounded}+ )+ . unChunk
+ test/Mdoc/Gen/DescriptionSpec.hs view
@@ -0,0 +1,54 @@+-- |+--+-- 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.MdocLine+import Mdoc.Pretty+import Mdoc.Pretty.MdocLine+import Test.Hspec++spec :: Spec+spec = do+ describe "configLines" $ do+ it "renders with literal examples" $ do+ let config =+ Described+ { item =+ Config+ { name = "git.push"+ , schema = Simple "boolean"+ , exampleLines = Just $ "# disable pushing" :| ["git.push: false"]+ }+ , optionality = Required+ , multiple = False+ , helpLines = Just $ pure "Push to git remote"+ }++ render (configLines config)+ `shouldBe` mconcat+ [ ".It Cm git.push Ns : Ar boolean\n"+ , "Push to git remote\n"+ , ".Pp\n"+ , "Example:\n"+ , ".Bd -literal -offset indent\n"+ , "# disable pushing\n"+ , "git.push: false\n"+ , ".Ed\n"+ ]++render :: [MdocLine] -> Text+render = renderPlain . vsep . map prettyMdocLine
+ test/Mdoc/Gen/ExitStatusSpec.hs view
@@ -0,0 +1,50 @@+module Mdoc.Gen.ExitStatusSpec+ ( spec+ ) where++import Mdoc.Prelude++import Mdoc.Gen.ExitStatus+import Mdoc.MdocLine+import Mdoc.Pretty+import Mdoc.Pretty.MdocLine+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"++ render (renderExitStatuses nzs)+ `shouldBe` mconcat+ [ "The\n"+ , ".Nm\n"+ , "utility exits 0 on success,\n"+ , "and >0 if an error occurs.\n"+ ]++ 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"+ ]++ render (renderExitStatuses nzs)+ `shouldBe` mconcat+ [ "The\n"+ , ".Nm\n"+ , "utility exits 0 on success,\n"+ , "228 if one or more weeds found,\n"+ , "1 for generic failing exit code,\n"+ , "2 due to failure to read HIE file due to GHC version mismatch,\n"+ , "3 due to failure to parse config file,\n"+ , "and 4 when no HIE files found.\n"+ ]++render :: NonEmpty MdocLine -> Text+render = renderPlain . vsep . map prettyMdocLine . toList
+ test/Mdoc/GenSpec.hs view
@@ -0,0 +1,83 @@+{-# 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 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++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
@@ -0,0 +1,39 @@+-- |+--+-- Module : Mdoc.Parse.MacroArgSpec+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Parse.MacroArgSpec+ ( spec+ ) where++import Mdoc.Prelude++import Data.Time (fromGregorian)+import Mdoc.Interpolation+import Mdoc.MacroArg+import Mdoc.Parse+import Mdoc.Parse.MacroArg+import Mdoc.Test.Parse+import Test.Hspec++spec :: Spec+spec = do+ describe "parseMacroArg" $ do+ it "parses the mdoc date macro" $ do+ parseTest (parseMacroArg <* eol <* eof) ["$Mdocdate$"] $ Mdocdate Nothing++ it "parses the mdoc date macro with explicit date" $ do+ parseTest+ (parseMacroArg <* eol <* eof)+ ["$Mdocdate: October 1 2020 $"]+ $ Mdocdate+ $ Just+ $ fromGregorian 2020 10 1++ it "parses interpolated arguments" $ do+ parseTest (parseMacroArg <* eol <* eof) ["{{docTitle}}"]+ $ InterpolatedArg DocTitle
+ test/Mdoc/Parse/MdocLineSpec.hs view
@@ -0,0 +1,86 @@+-- |+--+-- Module : Mdoc.Parse.MdocLineSpec+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Parse.MdocLineSpec (spec) where++import Mdoc.Prelude++import Mdoc.Interpolation+import Mdoc.MacroArg+import Mdoc.MacroName+import Mdoc.MdocLine+import Mdoc.Parse+import Mdoc.Parse.MdocLine+import Mdoc.Test.Parse+import Test.Hspec++spec :: Spec+spec = do+ describe "parseMdocLine" $ do+ it "parses comments with whitespace" $ do+ parseTest (parseMdocLine <* eol <* eof) [".\\\" Example mdoc"]+ $ Comment "Example mdoc"++ it "parses comments without whitespace" $ do+ parseTest (parseMdocLine <* eol <* eof) [".\\\"Example mdoc"]+ $ Comment "Example mdoc"++ it "parses standalone dots" $ do+ parseTest (parseMdocLine <* eol <* eof) ["."] $ TextLine "."++ it "parses cross-references with trailing space" $ do+ parseTest (parseMdocLine <* eol <* eof) [".Xr rcup 1 "]+ $ MacroLine Xr ["rcup", "1"]++ it "doesn't misinterpret callables that are part of words" $ do+ parseTest (parseMdocLine <* eol <* eof) [".An Archy Bunker"]+ $ MacroLine An ["Archy", "Bunker"]++ it "handles quoted arguments" $ do+ parseTest+ (parseMdocLine <* eol <* eof)+ [".An \"Joe Smith\" Aq Mt jsmith@gmail.com"]+ $ MacroLine An [Quoted "Joe Smith", Callable Aq, Callable Mt, "jsmith@gmail.com"]++ it "handles quoted arguments with escapes" $ do+ parseTest (parseMdocLine <* eol <* eof) [".Nm \"xkbcli\\-interactive\\-x11\""]+ $ MacroLine Nm [Quoted "xkbcli\\-interactive\\-x11"]++ it "handles puncuation after quotes" $ do+ parseTest+ (parseMdocLine <* eol <* eof)+ [".Po including \"pax restricted\", the default tar format for"]+ $ MacroLine+ Po+ [ "including"+ , QuotedComma "pax restricted"+ , "the"+ , "default"+ , "tar"+ , "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
@@ -0,0 +1,54 @@+-- |+--+-- Module : Mdoc.Parse.TableLineSpec+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Parse.TableLineSpec+ ( spec+ ) where++import Mdoc.Prelude++import Mdoc.Parse+import Mdoc.Parse.TableLine+import Mdoc.TableLine+import Mdoc.Test.Parse+import Test.Hspec++spec :: Spec+spec = do+ describe "parseTableLine" $ do+ it "parses opaque table lines" $ do+ parseTest+ (parseTableLines <* eol <* eof)+ [ ".TS"+ , "allbox;"+ , "lb lb lb"+ , "l l l."+ , "Interface\tAttribute\tValue"+ , "T{"+ , ".Nm crypt"+ , "T}\tThread safety\tMT-Unsafe race:crypt"+ , "T{"+ , ".Nm crypt_r ,"+ , ".Nm crypt_rn ,"+ , ".Nm crypt_ra"+ , "T}\tThread safety\tMT-Safe"+ , ".TE"+ ]+ [ TableLine "allbox;"+ , TableLine "lb lb lb"+ , TableLine "l l l."+ , TableLine "Interface\tAttribute\tValue"+ , TableLine "T{"+ , TableLine ".Nm crypt"+ , TableLine "T}\tThread safety\tMT-Unsafe race:crypt"+ , TableLine "T{"+ , TableLine ".Nm crypt_r ,"+ , TableLine ".Nm crypt_rn ,"+ , TableLine ".Nm crypt_ra"+ , TableLine "T}\tThread safety\tMT-Safe"+ ]
+ test/Mdoc/Parse/TroffMacroSpec.hs view
@@ -0,0 +1,57 @@+-- |+--+-- Module : Mdoc.Parse.TroffMacroSpec+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Parse.TroffMacroSpec+ ( spec+ ) where++import Mdoc.Prelude++import Mdoc.Parse+import Mdoc.Parse.TroffMacro+import Mdoc.Test.Parse+import Mdoc.TroffMacro+import Test.Hspec++spec :: Spec+spec = do+ describe "parseTroffMacro" $ do+ context "Troff .de macros" $ do+ it "handles implicit end, and calling macros" $ do+ parseTest+ (sepEndBy parseTroffMacro eol)+ [ ".de mymacro"+ , ".."+ , ".mymacro"+ ]+ [ TroffMacroDefine "mymacro" Nothing+ , TroffMacroEnd ".."+ , TroffMacroCall "mymacro" []+ ]++ it "handles explicit end, and calling macros" $ do+ parseTest+ (sepEndBy parseTroffMacro eol)+ [ ".de mymacro endmacro"+ , ".endmacro"+ ]+ [ TroffMacroDefine "mymacro" (Just "endmacro")+ , TroffMacroEnd "endmacro"+ ]++ it "handles macros with arguments" $ do+ parseTest+ (sepEndBy parseTroffMacro eol)+ [ ".de mymacro"+ , ".."+ , ".mymacro foo"+ ]+ [ TroffMacroDefine "mymacro" Nothing+ , TroffMacroEnd ".."+ , TroffMacroCall "mymacro" ["foo"]+ ]
+ test/Mdoc/Test/Fixtures.hs view
@@ -0,0 +1,123 @@+{-# OPTIONS_GHC -Wno-ambiguous-fields #-}++module Mdoc.Test.Fixtures+ ( grepBase+ , grepOpt+ , grepEnv+ , confBase+ , confConf+ , exampleBase1+ , exampleBase5+ , exampleOptEnvConf+ ) where++import Mdoc.Prelude++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 -}
+ test/Mdoc/Test/Parse.hs view
@@ -0,0 +1,23 @@+-- |+--+-- Module : Mdoc.Test.Parse+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.Test.Parse+ ( parseTest+ ) where++import Mdoc.Prelude++import Mdoc.Parse+import Test.Hspec++parseTest+ :: (Eq a, HasCallStack, Show a) => Parser a -> [Text] -> a -> Expectation+parseTest p input expected = do+ case runParser p "<test>" (mconcat $ map (<> "\n") input) of+ Left err -> expectationFailure $ "Unexpected ParseError:\n" <> errorBundlePretty err+ Right actual -> actual `shouldBe` expected
+ test/Mdoc/UpdateMdocdateSpec.hs view
@@ -0,0 +1,44 @@+-- |+--+-- Module : Mdoc.UpdateMdocdateSpec+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Mdoc.UpdateMdocdateSpec+ ( spec+ ) where++import Mdoc.Prelude++import Data.Time (fromGregorian)+import Mdoc+import Mdoc.MacroArg+import Mdoc.MacroName+import Mdoc.MdocLine+import Mdoc.UpdateMdocdate+import Test.Hspec++spec :: Spec+spec = do+ describe "updateMdocdateTo" $ do+ it "updates all Dd lines in an Mdoc" $ do+ let+ d1 = fromGregorian 2023 10 5+ d2 = fromGregorian 2020 1 10+ mdoc =+ Mdoc+ { lines =+ [ MacroLine Dd [Mdocdate Nothing]+ , MacroLine Dd [Mdocdate (Just d1)]+ ]+ }++ updateMdocdateTo d2 mdoc+ `shouldBe` Mdoc+ { lines =+ [ MacroLine Dd [Mdocdate (Just d2)]+ , MacroLine Dd [Mdocdate (Just d2)]+ ]+ }
+ test/MdocSpec.hs view
@@ -0,0 +1,116 @@+-- |+--+-- Module : MdocSpec+-- Copyright : (c) 2026 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module MdocSpec+ ( spec+ ) where++import Mdoc.Prelude++import Mdoc+import Mdoc.MacroArg+import Mdoc.MacroName+import Mdoc.MdocLine+import Mdoc.Test.Parse+import Test.Hspec++spec :: Spec+spec = do+ describe "parseMdoc" $ do+ it "parses a complete example" $ do+ parseTest+ parseMdoc+ [ ".Dd $Mdocdate$"+ , ".Dt PROGNAME section"+ , ".Os"+ , ".Sh NAME"+ , ".Nm progname"+ , ".Nd one line about what it does"+ , ".\\\" .Sh LIBRARY"+ , ".\\\" For sections 2, 3, and 9 only."+ , ".\\\" Not used in OpenBSD."+ , ".Sh SYNOPSIS"+ , ".Nm progname"+ , ".Op Fl options"+ , ".Ar"+ , ".Sh DESCRIPTION"+ , "The"+ , ".Nm"+ , "utility processes files ..."+ , ".\\\" .Sh CONTEXT"+ , ".\\\" For section 9 functions only."+ , ".\\\" .Sh IMPLEMENTATION NOTES"+ , ".\\\" Not used in OpenBSD."+ , ".\\\" .Sh RETURN VALUES"+ , ".\\\" For sections 2, 3, and 9 function return values only."+ , ".\\\" .Sh ENVIRONMENT"+ , ".\\\" For sections 1, 6, 7, and 8 only."+ , ".\\\" .Sh FILES"+ , ".\\\" .Sh EXIT STATUS"+ , ".\\\" For sections 1, 6, and 8 only."+ , ".\\\" .Sh EXAMPLES"+ , ".\\\" .Sh DIAGNOSTICS"+ , ".\\\" For sections 1, 4, 6, 7, 8, and 9 printf/stderr messages only."+ , ".\\\" .Sh ERRORS"+ , ".\\\" For sections 2, 3, 4, and 9 errno settings only."+ , ".\\\" .Sh SEE ALSO"+ , ".\\\" .Xr foobar 1"+ , ".\\\" .Sh STANDARDS"+ , ".\\\" .Sh HISTORY"+ , ".\\\" .Sh AUTHORS"+ , ".\\\" .Sh CAVEATS"+ , ".\\\" .Sh BUGS"+ , ".\\\" .Sh SECURITY CONSIDERATIONS"+ , ".\\\" Not used in OpenBSD."+ ]+ $ Mdoc+ { lines =+ [ MacroLine Dd [Mdocdate Nothing]+ , MacroLine Dt ["PROGNAME", "section"]+ , MacroLine Os []+ , MacroLine Sh ["NAME"]+ , MacroLine Nm ["progname"]+ , MacroLine Nd ["one", "line", "about", "what", "it", "does"]+ , Comment ".Sh LIBRARY"+ , Comment "For sections 2, 3, and 9 only."+ , Comment "Not used in OpenBSD."+ , MacroLine Sh ["SYNOPSIS"]+ , MacroLine Nm ["progname"]+ , MacroLine Op [Callable Fl, "options"]+ , MacroLine Ar []+ , MacroLine Sh ["DESCRIPTION"]+ , TextLine "The"+ , MacroLine Nm []+ , TextLine "utility processes files ..."+ , Comment ".Sh CONTEXT"+ , Comment "For section 9 functions only."+ , Comment ".Sh IMPLEMENTATION NOTES"+ , Comment "Not used in OpenBSD."+ , Comment ".Sh RETURN VALUES"+ , Comment "For sections 2, 3, and 9 function return values only."+ , Comment ".Sh ENVIRONMENT"+ , Comment "For sections 1, 6, 7, and 8 only."+ , Comment ".Sh FILES"+ , Comment ".Sh EXIT STATUS"+ , Comment "For sections 1, 6, and 8 only."+ , Comment ".Sh EXAMPLES"+ , Comment ".Sh DIAGNOSTICS"+ , Comment "For sections 1, 4, 6, 7, 8, and 9 printf/stderr messages only."+ , Comment ".Sh ERRORS"+ , Comment "For sections 2, 3, 4, and 9 errno settings only."+ , Comment ".Sh SEE ALSO"+ , Comment ".Xr foobar 1"+ , Comment ".Sh STANDARDS"+ , Comment ".Sh HISTORY"+ , Comment ".Sh AUTHORS"+ , Comment ".Sh CAVEATS"+ , Comment ".Sh BUGS"+ , Comment ".Sh SECURITY CONSIDERATIONS"+ , Comment "Not used in OpenBSD."+ ]+ }
+ test/Spec.hs view
@@ -0,0 +1,10 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -Wno-missing-export-lists #-}++-- |+--+-- Module : Main+-- Copyright : (c) 2025 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX