mdoc 0.3.2.0 → 0.4.0.0

raw patch · 15 files changed

+291/−134 lines, 15 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• examples/mandoc.1 +54/−0
• mdoc.cabal +3/−2
• src/Autodocodec/Schema/Mdoc.hs +22/−2
• src/Env/Mdoc.hs +1/−0
• src/Mdoc/Data/Described.hs +0/−31
• src/Mdoc/Data/List.hs +1/−1
• src/Mdoc/Data/Page.hs +27/−16
• src/Mdoc/Data/Positional.hs +13/−0
• src/Mdoc/Data/Synopsis.hs +71/−39
• src/Mdoc/Examples/Mandoc.hs +74/−0
• src/Mdoc/Prelude.hs +9/−1
• src/OptEnvConf/Mdoc.hs +2/−6
• src/Options/Applicative/Mdoc.hs +12/−12
• test/Mdoc/Data/SynopsisSpec.hs +0/−24
• test/Mdoc/ExamplesSpec.hs +2/−0

@@ -0,0 +1,54 @@+.\" vim: ft=nroff.mustache+.Dd $Mdocdate: September 20 2026 $+.Dt MANDOC 1+.Os+.Sh NAME+.Nm mandoc+.Nd format manual pages+.Sh SYNOPSIS+.Nm+.Bk -words+.Op Fl ac+.Op Fl I Ar os=name+.Op Fl K Ar encoding+.Op Fl O Ar options+.Op Fl T Ar output+.Op Fl W Ar level+.Op Fl Fl mdoc | Fl Fl man+.Op Ar file ...+.Ek+.Sh DESCRIPTION+The options are as follows:+.Bl -tag -width indent+.It Fl a+If the standard output is a terminal device and \-c is not specified, use+less(1) to paginate the output, just like man(1) would.+.It Fl c+Copy the formatted manual pages to the standard output without using less(1) to+paginate them. This is the default. It can be specified to override \-a.+.It Fl I Ar os=name+Override the default operating system name for the mdoc(7) Os and for the man(7)+TH macro.+.It Fl K Ar encoding+Specify the input encoding. The supported encoding arguments are us\-ascii,+iso\-8859\-1, and utf\-8. If not specified, autodetection uses the first match+in the following list:+.It Fl O Ar options+Comma\-separated output options. See the descriptions of the individual output+formats for supported options.+.It Fl T Ar output+Select the output format. Supported values for the output argument are ascii,+html, the default of locale, man, markdown, tree, and utf8.+.It Fl W Ar level+Specify the minimum message level to be reported on the standard error output+and to affect the exit status.+.It Fl Fl man+With \-man, all input files are interpreted as man(7).+.It Fl Fl mdoc+With \-mdoc, all input files are interpreted as mdoc(7).+.It Ar file+Read from the given input file. If multiple files are specified, they are+processed in the given order. If unspecified, mandoc reads from standard input.+.El+.Sh EXIT STATUS+.Ex -std

@@ -1,6 +1,6 @@ cabal-version:      1.18 name:               mdoc-version:            0.3.2.0+version:            0.4.0.0 license:            AGPL-3 license-file:       COPYING maintainer:         Pat Brisbin@@ -38,6 +38,7 @@     examples/example.1     examples/examplerc.5     examples/grep.1+    examples/mandoc.1     examples/mdoc-dump.1     examples/mdoc-dump.1.html     examples/pass.1@@ -77,6 +78,7 @@         Mdoc.Dump.Options         Mdoc.Examples.Docker         Mdoc.Examples.Grep+        Mdoc.Examples.Mandoc         Mdoc.Examples.OptEnvConf         Mdoc.Examples.Pass         Mdoc.Examples.Person@@ -205,7 +207,6 @@         Autodocodec.Schema.MdocSpec         Mdoc.Data.ConfigSpec         Mdoc.Data.PositionalSpec-        Mdoc.Data.SynopsisSpec         Mdoc.ExamplesSpec         Mdoc.Parse.MacroArgSpec         Mdoc.Parse.MdocLineSpec

@@ -34,6 +34,7 @@ import Mdoc.Data.Optionality import Mdoc.Data.Page import Mdoc.Optics+import Mdoc.Syntax (textToMdoc)  getPage :: JSONSchema -> Page getPage js = foldr addConfig mempty $ getConfigs Nothing js@@ -121,7 +122,7 @@   ValueSchema v -> primitive $ constSchema v   AnyOfSchema ss -> anyOf ss   OneOfSchema ss -> anyOf ss-  CommentSchema c s -> first (setHelpText c) $ simplifyJSONSchema s+  CommentSchema c s -> first (\d -> d {help = textToMdoc c}) $ simplifyJSONSchema s   RefSchema t -> primitive $ Simple t   WithDefSchema _ s -> simplifyJSONSchema s @@ -147,8 +148,17 @@ -- Work around bug in opt-env-conf where all configs are null|x anyOf :: NonEmpty JSONSchema -> (Described Schema, [Described ObjectMember]) anyOf (NullSchema :| [s]) = simplifyJSONSchema s-anyOf ss = bimap (redescribe AnyOf) concat $ unzip $ map simplifyJSONSchema $ toList ss+anyOf ss = bimap redescribe concat $ unzip $ toList ne+ where+  ne :: NonEmpty (Described Schema, [Described ObjectMember])+  ne = simplifyJSONSchema <$> ss +  s1 :: Described Schema+  s1 = fst $ head ne++  redescribe :: [Described Schema] -> Described Schema+  redescribe = (<$ s1) . AnyOf . map (.item)+ primitive :: Schema -> (Described Schema, [a]) primitive schema = (required schema, []) @@ -167,3 +177,13 @@  renderPrefix :: NonEmpty String -> String renderPrefix = intercalate "." . toList++required :: a -> Described a+required item =+  Described+    { item+    , optionality = Required+    , multiple = False+    , help = Nothing+    , example = Nothing+    }

@@ -20,6 +20,7 @@ import Mdoc.Data.EnvVar import Mdoc.Data.Optionality import Mdoc.Data.Page+import Mdoc.Syntax (textToMdoc)  getPage :: Parser e a -> Page getPage = flip appEndo mempty . foldAlt (Endo . addEnvVar . describeVarF) . unParser

@@ -8,17 +8,12 @@ -- Portability : POSIX module Mdoc.Data.Described   ( Described (..)-  , required-  , redescribe-  , setHelpText-  , textToMdoc   ) where  import Mdoc.Prelude  import Data.Function (on) import Mdoc.Data.Optionality-import Mdoc.Optics import Mdoc.Syntax  data Described a = Described@@ -36,29 +31,3 @@  instance Ord a => Ord (Described a) where   compare = comparing (.item)---- | Describe an item as 'Required', singular, without help-required :: a -> Described a-required item =-  Described-    { item-    , optionality = Required-    , multiple = False-    , help = Nothing-    , example = Nothing-    }---- | Concat a described list into a single item------ NB. The element descriptions are discarded and 'required' is used. We could--- get clever (e.g. any required -> required, concatenat help, etc) but it's--- just not useful in the project to do so.-redescribe :: ([a] -> b) -> [Described a] -> Described b-redescribe f = required . f . map (.item)--setHelp :: Mdoc -> Described a -> Described a-setHelp x = field @"help" ?~ x---- | Set a 'Described's 'helpLines' from a 'Text'-setHelpText :: Text -> Described a -> Described a-setHelpText = maybe id setHelp . textToMdoc

@@ -7,7 +7,7 @@ -- Stability   : experimental -- Portability : POSIX module Mdoc.Data.List-  ( List+  ( List (..)   , fromNonEmpty   , singleton 

@@ -15,6 +15,7 @@   , addSwitch   , addOption   , addArgument+  , addAlternation   , addCommand   , addCommands   , addConfig@@ -23,6 +24,7 @@   , addEnvVar      -- * Other, rarely-used elements+  , getPositionals   , getSynopsis   , setSynopsis   , setPrologue@@ -40,7 +42,7 @@ import Mdoc.Data.List qualified as List import Mdoc.Data.Optionality import Mdoc.Data.Positional-import Mdoc.Data.Synopsis (Synopsis (..))+import Mdoc.Data.Synopsis (Synopsis) import Mdoc.Data.Synopsis qualified as Synopsis import Mdoc.Optics import Mdoc.Syntax@@ -59,16 +61,7 @@   deriving (Monoid, Semigroup) via Generically Page  addSwitch :: Described Flag -> Page -> Page-addSwitch = addPositional . fmap PositionalSwitch . tweakOptionality- where-  -- Avoid showing a bunch of (default: False) for switches-  tweakOptionality :: Described a -> Described a-  tweakOptionality d =-    d-      { optionality = case d.optionality of-          Defaulted {} -> Optional-          o -> o-      }+addSwitch = addPositional . fmap PositionalSwitch  addOption :: Described Option -> Page -> Page addOption = addPositional . fmap PositionalOption@@ -76,12 +69,27 @@ addArgument :: Described Argument -> Page -> Page addArgument = addPositional . fmap PositionalArgument +addAlternation :: Optionality -> [Described Positional] -> Page -> Page+addAlternation o ps =+  appEndo+    $ mconcat+    $ Endo (field @"synopsis" <?>~ Synopsis.alternation o ps)+      : map (Endo . addPositionalOption) ps+ addPositional :: Described Positional -> Page -> Page-addPositional described m =-  m-    & field @"synopsis" <?>~ Synopsis.singleton described-    & field @"options" <?>~ List.singleton described+addPositional p =+  (field @"synopsis" <?>~ Synopsis.singleton (fixPositional p))+    . addPositionalOption p +addPositionalOption :: Described Positional -> Page -> Page+addPositionalOption p = field @"options" <?>~ List.singleton (fixPositional p)++-- Avoid showing a bunch of (default: False) for switches+fixPositional :: Described Positional -> Described Positional+fixPositional described = case (described.item, described.optionality) of+  (PositionalSwitch {}, Defaulted {}) -> described {optionality = Optional}+  _ -> described+ addCommand :: Command -> Page -> Page addCommand c m = m & field @"commands" <?>~ List.singleton c @@ -96,11 +104,14 @@ addEnvVar described m =   m & field @"environment" <?>~ List.singleton described +getPositionals :: Page -> [Described Positional]+getPositionals p = maybe [] (toList . (.items)) p.options+ getSynopsis :: Page -> Synopsis getSynopsis p = fromMaybe mempty p.synopsis  setSynopsis :: Mdoc -> Page -> Page-setSynopsis s = field @"synopsis" ?~ SynopsisCustom s+setSynopsis s = field @"synopsis" ?~ Synopsis.custom s  setPrologue :: Mdoc -> Page -> Page setPrologue p = field @"prologue" ?~ p

@@ -8,6 +8,7 @@ -- Portability : POSIX module Mdoc.Data.Positional   ( Positional (..)+  , Positional1 (..)   , Flag (..)   , Flag1 (..)   , Option (..)@@ -63,3 +64,15 @@   --           |  |            |   Flag c _ -> (1, [toLower c], isLower c)   GNUFlag s _ -> (2, map toLower s, False)++newtype Positional1 = Positional1+  { unwrap :: Positional+  }++instance Pretty Positional1 where+  pretty p = case p.unwrap of+    PositionalSwitch f -> case f of+      Flag c _ -> pretty c+      GNUFlag {} -> pretty $ Flag1 f+    PositionalOption o -> pretty $ Option1 o+    PositionalArgument a -> pretty a

@@ -7,9 +7,10 @@ -- Stability   : experimental -- Portability : POSIX module Mdoc.Data.Synopsis-  ( Synopsis (..)-  , fromList+  ( Synopsis   , singleton+  , alternation+  , custom   ) where  import Mdoc.Prelude@@ -25,7 +26,7 @@ import Mdoc.Syntax  data Synopsis-  = Synopsis [Described Positional]+  = Synopsis [SynopsisItem]   | SynopsisCustom Mdoc   deriving stock (Eq, Show)   deriving (ToJSON) via (Rendered Synopsis)@@ -40,33 +41,44 @@  instance Pretty Synopsis where   pretty = \case-    Synopsis ps -> pretty $ buildUsage ps+    Synopsis items -> renderUsage items     SynopsisCustom ls -> pretty ls -fromList :: [Described Positional] -> Synopsis-fromList = foldMap singleton+data SynopsisItem+  = Single (Described Positional)+  | Alternation Optionality [Described Positional]+  deriving stock (Eq, Show) +instance Ord SynopsisItem where+  compare = comparing getFirstPositional+   where+    getFirstPositional :: SynopsisItem -> Maybe (Described Positional)+    getFirstPositional = \case+      Single p -> Just p+      Alternation _ (p : _) -> Just p+      _ -> Nothing+ singleton :: Described Positional -> Synopsis-singleton = Synopsis . pure+singleton = Synopsis . pure . Single +alternation :: Optionality -> [Described Positional] -> Synopsis+alternation o = Synopsis . pure . Alternation o++custom :: Mdoc -> Synopsis+custom = SynopsisCustom+ data Usage ann = Usage   { chars :: [Char]-  , shorts :: [Doc ann]-  , longs :: [Doc ann]-  , args :: [Doc ann]+  , items :: [Doc ann]   }   deriving stock (Generic, Show)   deriving (Monoid, Semigroup) via Generically (Usage ann)-  deriving (ToJSON) via (Rendered (Usage ann)) -instance Pretty (Usage ann) where-  pretty u =-    unAnnotate-      $ vsep-      $ catMaybes-        [ (".Op Fl" <+>) . pretty . fixMacro . esc . pack . toList <$> nonEmpty u.chars-        , vsep . toList <$> nonEmpty (u.shorts <> u.longs <> u.args)-        ]+renderUsage :: [SynopsisItem] -> Doc ann+renderUsage = go . buildUsage+ where+  go u = vsep $ maybeToList (pChars <$> nonEmpty u.chars) <> u.items+  pChars cs = ".Op Fl" <+> pretty (fixMacro $ esc $ pack $ toList cs)  -- | Fix for when short-switches accidentally become a macro name --@@ -84,25 +96,45 @@   | t `elem` macroNames = "\\&" <> t   | otherwise = t -buildUsage :: [Described Positional] -> Usage ann-buildUsage = foldl go mempty . sort+buildUsage :: [SynopsisItem] -> Usage ann+buildUsage = foldl addUsage mempty . sort -go :: Usage ann -> Described Positional -> Usage ann-go acc d = case d.item of-  PositionalSwitch f -> case f of-    Flag c _ -> acc & field @"chars" %~ sortOn toLower . (<> [c])-    GNUFlag {} -> acc & field @"longs" <>~ [opLine $ pretty $ Flag1 f]-  PositionalOption o ->-    let doc = opLine $ pretty $ Option1 o-    in  case o.flag of-          Flag {} -> acc & field @"shorts" <>~ [doc]-          GNUFlag {} -> acc & field @"longs" <>~ [doc]-  PositionalArgument a -> acc & field @"args" <>~ [opLine $ ellipsis $ pretty a]- where-  opLine = case d.optionality of-    Required -> ("." <>)-    _ -> (".Op" <+>)+addUsage :: Usage ann -> SynopsisItem -> Usage ann+addUsage acc = \case+  Single d+    | Just c <- getPositionalSwitchChar d.item ->+        acc & field @"chars" %~ sortOn toLower . (<> [c])+    | otherwise ->+        acc+          & field @"items"+            <>~ [ opLine d+                    $ ellipsis d+                    $ pretty+                    $ Positional1 d.item+                ]+  Alternation o ps ->+    acc+      & field @"items"+        <>~ [ opLine' o+                $ mconcat+                $ punctuate " | "+                $ map (pretty . Positional1 . (.item)) ps+            ] -  ellipsis-    | d.multiple = (<+> "...")-    | otherwise = id+getPositionalSwitchChar :: Positional -> Maybe Char+getPositionalSwitchChar = \case+  PositionalSwitch (Flag c _) -> Just c+  _ -> Nothing++opLine :: Described a -> Doc ann -> Doc ann+opLine = opLine' . (.optionality)++opLine' :: Optionality -> Doc ann -> Doc ann+opLine' = \case+  Required -> ("." <>)+  _ -> (".Op" <+>)++ellipsis :: Described a -> Doc ann -> Doc ann+ellipsis d+  | d.multiple = (<+> "...")+  | otherwise = id

@@ -0,0 +1,74 @@+-- |+--+-- Module      : Mdoc.Examples.Mandoc+-- Copyright   : (c) 2026 Patrick Brisbin+-- License     : AGPL-3+-- Maintainer  : pbrisbin@gmail.com+-- Stability   : experimental+-- Portability : POSIX+module Mdoc.Examples.Mandoc+  ( mandoc1+  ) where++import Mdoc.Prelude++import Mdoc.Data.Named+import Options.Applicative+import Options.Applicative.Mdoc++-- | Recreates <https://man.openbsd.org/mandoc.1>+--+-- ..ish.+--+-- A couple things are not expressible in any Haskell options parsers:+--+-- Flag with a key=value argument marked-up separately:+--+-- @-I os=Name -> Fl I Cm os Ns = Ns Ar name@+--+-- Can only be marked-up as a single @Ar@:+--+-- @-I os=Name -> Fl I Ar os=name@+--+-- Single-dash long options:+--+-- @-mdoc, -man@+--+-- Must be:+--+-- @--mdoc --man@+--+-- A single exclusive option with one description/default:+--+-- @+-- -mdoc | -man+--     With -mdoc, this. With -man, that.+-- @+--+-- Must be separately-described options with @'<|>'@, and comes out as:+--+-- @+-- --mdoc+--     With --mdoc, this.+-- --man+--     With --man, that.+-- @+mandoc1 :: Named+mandoc1 = getPage mandocOpt & name "mandoc" "format manual pages"++{- FOURMOLU_DISABLE -}+mandocOpt :: Parser ()+mandocOpt = void $ (,,,,,,,,)+  <$> optional (switch (mconcat [short 'a', help "If the standard output is a terminal device and -c is not specified, use less(1) to paginate the output, just like man(1) would."]))+  <*> optional (switch (mconcat [short 'c', help "Copy the formatted manual pages to the standard output without using less(1) to paginate them. This is the default. It can be specified to override -a."]))+  <*> optional (option (str @String) (mconcat [short 'I', metavar "os=name", help "Override the default operating system name for the mdoc(7) Os and for the man(7) TH macro."]))+  <*> optional (option (str @String) (mconcat [short 'K', metavar "encoding", help "Specify the input encoding. The supported encoding arguments are us-ascii, iso-8859-1, and utf-8. If not specified, autodetection uses the first match in the following list:"]))+  <*> optional+    (   switch (mconcat [long "mdoc", help "With -mdoc, all input files are interpreted as mdoc(7)."])+    <|> switch (mconcat [long "man", help "With -man, all input files are interpreted as man(7)."])+    )+  <*> optional (option (str @String) (mconcat [short 'O', metavar "options", help "Comma-separated output options. See the descriptions of the individual output formats for supported options."]))+  <*> optional (option (str @String) (mconcat [short 'T', metavar "output", help "Select the output format. Supported values for the output argument are ascii, html, the default of locale, man, markdown, tree, and utf8."]))+  <*> optional (option (str @String) (mconcat [short 'W', metavar "level", help "Specify the minimum message level to be reported on the standard error output and to affect the exit status."]))+  <*> many (argument (str @String) (mconcat [metavar "file", help "Read from the given input file. If multiple files are specified, they are processed in the given order. If unspecified, mandoc reads from standard input."]))+{- FOURMOLU_ENABLE -}

@@ -39,7 +39,15 @@   , tail   ) import Data.List.NonEmpty.Extra as X ((|:))-import Data.Maybe as X (catMaybes, fromMaybe, isJust, isNothing, mapMaybe)+import Data.Maybe as X+  ( catMaybes+  , fromMaybe+  , isJust+  , isNothing+  , listToMaybe+  , mapMaybe+  , maybeToList+  ) import Data.Monoid as X (Alt (..)) import Data.Ord as X (comparing) import Data.Proxy as X (Proxy (..))

@@ -124,17 +124,13 @@         , example = exampleMdoc <$> nonEmpty (setDocExamples d)         }  where-  -- AnyDocsOr is used for Empty, Alt, and Many. The former two map to-  -- optionality while the latter maps to multiple. We don't have enough-  -- information to know what's what, so we treat such cases as both optional-  -- and multiple. I guess that's what OptEnvConf's own `--help` rendering must-  -- do, since it operates on the same lossy `AnyDocs` structure.+  -- This is crazy wrong but I keep adding shit based on test cases   fForOr i m e = f i m $ (<$> e) $ \d ->     d       { optionality = case d.optionality of           Required -> Optional           o -> o-      , multiple = True+      , multiple = null $ setDocDasheds d.item       }  exampleMdoc :: NonEmpty String -> Mdoc

@@ -26,6 +26,7 @@ import Mdoc.Data.Option import Mdoc.Data.Optionality import Mdoc.Data.Page+import Mdoc.Syntax (textToMdoc) import Options.Applicative (Parser) import Options.Applicative.Common (treeMapParser) import Options.Applicative.Help.Chunk (Chunk (..), unChunk)@@ -125,21 +126,20 @@             }       O.Internal -> pure acc       O.Hidden -> pure acc-  O.MultNode ts -> recur f ts-  O.AltNode O.MarkDefault ts -> recur fAsOptional ts-  O.AltNode O.NoDefault ts -> recur fAsRequired ts+  O.MultNode ts -> foldM (foldOptTreeM f) mempty ts+  O.AltNode at [t] -> foldOptTreeM (fAsAltNode at) acc t+  O.AltNode at ts -> do+    sub <- foldM (foldOptTreeM f) mempty ts+    pure $ addAlternation (altOptionality at) (getPositionals sub) acc   O.BindNode t -> foldOptTreeM fAsMultiple acc t  where-  recur-    :: MonadState Int m-    => (Int -> Page -> Described (O.Option x) -> Page)-    -> [O.OptTree (O.Option x)]-    -> m Page-  recur g = foldM (foldOptTreeM g) acc--  fAsOptional i m d = f i m $ d {optionality = Optional}-  fAsRequired i m d = f i m $ d {optionality = Required}+  fAsAltNode at i m d = f i m $ d {optionality = altOptionality at}   fAsMultiple i m d = f i m $ d {multiple = True}++altOptionality :: O.AltNodeType -> Optionality+altOptionality = \case+  O.MarkDefault -> Optional+  O.NoDefault -> Required  docToText :: Chunk Doc -> Maybe Text docToText =

@@ -1,24 +0,0 @@--- |------ Module      : Mdoc.Data.SynopsisSpec--- Copyright   : (c) 2026 Patrick Brisbin--- License     : AGPL-3--- Maintainer  : pbrisbin@gmail.com--- Stability   : experimental--- Portability : POSIX-module Mdoc.Data.SynopsisSpec-  ( spec-  ) where--import Mdoc.Prelude--import Mdoc.Data.Synopsis qualified as Synopsis-import Mdoc.Test.Render-import Test.Hspec--spec :: Spec-spec = do-  it "renders an empty synopsis" $ do-    let synopsis = Synopsis.fromList []--    synopsis `shouldRender` [""]

@@ -21,6 +21,7 @@ import Mdoc.Data.Named import Mdoc.Examples.Docker import Mdoc.Examples.Grep+import Mdoc.Examples.Mandoc import Mdoc.Examples.OptEnvConf import Mdoc.Examples.Pass import Mdoc.Examples.Person@@ -40,6 +41,7 @@   it "example.1" $ exampleGolden man1 example1 1   it "pass.1" $ exampleGolden man1 pass1 1   it "docker.1" $ exampleGolden man1 docker1 1+  it "mandoc.1" $ exampleGolden man1 mandoc1 1   it "conf.5" $ exampleGolden man5 conf5 5   it "examplerc.5" $ exampleGolden man5 examplerc5 5   it "person.5" $ exampleGolden man5 person5 5