mdoc 0.4.1.1 → 0.4.1.2
raw patch · 9 files changed
+330/−262 lines, 9 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- examples/docker.1 +6/−10
- mdoc.cabal +1/−1
- src/Autodocodec/Schema/Mdoc.hs +40/−42
- src/Mdoc/Examples/Docker.hs +32/−30
- src/Mdoc/Examples/Grep.hs +39/−39
- src/Mdoc/Examples/OptEnvConf.hs +27/−23
- src/OptEnvConf/Mdoc.hs +4/−1
- test/Autodocodec/Schema/MdocSpec.hs +178/−114
- test/Mdoc/Test/Render.hs +3/−2
examples/docker.1 view
@@ -23,12 +23,12 @@ .Pp .Nm .Cm run-.Pp-.Nm-.Cm exec-.Pp-.Nm-.Cm ps+.Bk -words+.Op Fl a Ar list+.Ar IMAGE+.Op Ar COMMAND ...+.Op Ar ARG ...+.Ek .Sh DESCRIPTION The options are as follows: .Bl -tag -width indent@@ -65,10 +65,6 @@ .Bl -tag -width indent .It Cm run Create and run a new container from an image-.It Cm exec-Execute a command in a running container-.It Cm ps-List containers .El .Sh EXIT STATUS .Ex -std
mdoc.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: mdoc-version: 0.4.1.1+version: 0.4.1.2 license: AGPL-3 license-file: COPYING maintainer: Pat Brisbin
src/Autodocodec/Schema/Mdoc.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+{-# OPTIONS_GHC -Wno-ambiguous-fields #-} -- | --@@ -43,16 +44,12 @@ getPageViaCodec = getPage $ jsonSchemaViaCodec @a getConfigs :: Maybe (NonEmpty String) -> JSONSchema -> [Described Config]-getConfigs mPrefix = uncurry (getConfigs1 mPrefix) . simplifyJSONSchema+getConfigs mPrefix = getConfigs1 mPrefix . simplifyJSONSchema -getConfigs1- :: Maybe (NonEmpty String)- -> Described Schema- -> [Described ObjectMember]- -> [Described Config]-getConfigs1 mPrefix schema members =+getConfigs1 :: Maybe (NonEmpty String) -> Simplified -> [Described Config]+getConfigs1 mPrefix Simplified {comment, schema, members} = maybe id (:) mParent- $ concatMap (describeObjectMember schema.item mPrefix) members+ $ concatMap (describeObjectMember schema mPrefix) members where mParent = do -- This makes sure the no-prefix + complex case doesn't look like:@@ -68,15 +65,27 @@ -- baz : that -- guard $ isJust mPrefix || null members+ pure+ $ Described+ { item = Config {name = renderPrefix <$> mPrefix, schema}+ , optionality = Required+ , multiple = False+ , help = textToMdoc =<< comment+ , example = Nothing+ } - let config =- Config- { name = renderPrefix <$> mPrefix- , schema = schema.item- }+data Simplified = Simplified+ { comment :: Maybe Text+ , schema :: Schema+ , members :: [Described ObjectMember]+ } - pure $ config <$ schema+setComment :: Text -> Simplified -> Simplified+setComment c s = s {comment = Just c} +mapSchema :: (Schema -> Schema) -> Simplified -> Simplified+mapSchema f s = s {schema = f s.schema}+ data ObjectMember = ObjectMember { keys :: NonEmpty String , schema :: Schema@@ -107,7 +116,7 @@ , schema = member.item.schema } -simplifyJSONSchema :: JSONSchema -> (Described Schema, [Described ObjectMember])+simplifyJSONSchema :: JSONSchema -> Simplified simplifyJSONSchema = \case AnySchema -> primitive "any" NullSchema -> primitive "null"@@ -116,20 +125,20 @@ IntegerSchema {} -> primitive "number" NumberSchema {} -> primitive "number" MapSchema s -> simplifyJSONSchema s- ArraySchema s -> first (fmap ListOf) $ simplifyJSONSchema s- ObjectSchema ObjectAnySchema -> (required "any", [])- ObjectSchema os -> (required "object", simplifyObjectSchema os)+ ArraySchema s -> mapSchema ListOf $ simplifyJSONSchema s+ ObjectSchema ObjectAnySchema -> Simplified Nothing "any" []+ ObjectSchema os -> Simplified Nothing "object" $ simplifyObjectSchema os ValueSchema v -> primitive $ constSchema v AnyOfSchema ss -> anyOf ss OneOfSchema ss -> anyOf ss- CommentSchema c s -> first (\d -> d {help = textToMdoc c}) $ simplifyJSONSchema s+ CommentSchema c s -> setComment c $ simplifyJSONSchema s RefSchema t -> primitive $ Simple t WithDefSchema _ s -> simplifyJSONSchema s simplifyObjectSchema :: ObjectSchema -> [Described ObjectMember] simplifyObjectSchema = \case ObjectKeySchema k reqd s mcomment ->- let (Described {item = schema}, members) = simplifyJSONSchema s+ let Simplified {schema, members} = simplifyJSONSchema s in [ Described { item = ObjectMember {keys = pure $ unpack k, schema, members} , optionality = case reqd of@@ -145,22 +154,21 @@ ObjectOneOfSchema os -> concatMap simplifyObjectSchema $ toList os ObjectAnySchema -> error "panic! we should not have hit this case" --- Work around bug in opt-env-conf where all configs are null|x-anyOf :: NonEmpty JSONSchema -> (Described Schema, [Described ObjectMember])+-- Work around bug in opt-env-conf where all schemas are null|x+anyOf :: NonEmpty JSONSchema -> Simplified anyOf (NullSchema :| [s]) = simplifyJSONSchema s-anyOf ss = bimap redescribe concat $ unzip $ toList ne+anyOf ss =+ Simplified+ { comment = Nothing+ , schema = AnyOf $ toList $ (.schema) <$> ne+ , members = concat $ toList $ (.members) <$> ne+ } where- ne :: NonEmpty (Described Schema, [Described ObjectMember])+ ne :: NonEmpty Simplified 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, [])+primitive :: Schema -> Simplified+primitive schema = Simplified Nothing schema [] -- | 'ValueSchema' is only used for @const {value}@; i.e. it must match the -- given @Value@ literally. We don't render complex values, but rendering simple@@ -177,13 +185,3 @@ renderPrefix :: NonEmpty String -> String renderPrefix = intercalate "." . toList--required :: a -> Described a-required item =- Described- { item- , optionality = Required- , multiple = False- , help = Nothing- , example = Nothing- }
src/Mdoc/Examples/Docker.hs view
@@ -4,42 +4,44 @@ import Mdoc.Prelude -import Mdoc.Data.Named-import OptEnvConf qualified-import OptEnvConf.Mdoc qualified as OptEnvConf+import Mdoc+import OptEnvConf hiding (name)+import OptEnvConf.Mdoc docker1 :: Named-docker1 =- mempty- & (<> OptEnvConf.getPage dockerOpt)- & name "docker" "a self-sufficient runtime for containers"+docker1 = getPage dockerOpt & name "docker" "a self-sufficient runtime for containers" {- FOURMOLU_DISABLE -}-dockerOpt :: OptEnvConf.Parser ()+dockerOpt :: Parser () dockerOpt = void $ (,,,,,,,,,,,,)- <$> OptEnvConf.optional (OptEnvConf.setting [OptEnvConf.option, OptEnvConf.reader (OptEnvConf.str @Text), OptEnvConf.long "config", OptEnvConf.metavar "string", OptEnvConf.help "Location of client config files", OptEnvConf.value "~/.docker"])- <*> OptEnvConf.optional (OptEnvConf.setting [OptEnvConf.option, OptEnvConf.reader (OptEnvConf.str @Text), OptEnvConf.short 'c', OptEnvConf.long "context", OptEnvConf.metavar "string", OptEnvConf.help "Name of the context to use to connect to the daemon (overrides DOCKER_HOST env var and default context set with \"docker context use\")"])- <*> OptEnvConf.setting [OptEnvConf.switch True, OptEnvConf.value False, OptEnvConf.short 'D', OptEnvConf.long "debug", OptEnvConf.help "Enable debug mode"]- <*> OptEnvConf.optional (OptEnvConf.setting [OptEnvConf.option, OptEnvConf.reader (OptEnvConf.str @Text), OptEnvConf.short 'H', OptEnvConf.long "host", OptEnvConf.metavar "string", OptEnvConf.help "Daemon socket to connect to"])- <*> OptEnvConf.optional (OptEnvConf.setting [OptEnvConf.option, OptEnvConf.reader (OptEnvConf.str @Text), OptEnvConf.short 'l', OptEnvConf.long "log-level", OptEnvConf.metavar "string", OptEnvConf.help "Set the logging level (\"debug\", \"info\", \"warn\", \"error\", \"fatal\")", OptEnvConf.value "info"])- <*> OptEnvConf.setting [OptEnvConf.switch True, OptEnvConf.value False, OptEnvConf.long "tls", OptEnvConf.help "Use TLS; implied by --tlsverify"]- <*> OptEnvConf.optional (OptEnvConf.setting [OptEnvConf.option, OptEnvConf.reader (OptEnvConf.str @Text), OptEnvConf.long "tlscacert", OptEnvConf.metavar "string", OptEnvConf.help "Trust certs signed only by this CA", OptEnvConf.value "~/.docker/ca.pem"])- <*> OptEnvConf.optional (OptEnvConf.setting [OptEnvConf.option, OptEnvConf.reader (OptEnvConf.str @Text), OptEnvConf.long "tlscert", OptEnvConf.metavar "string", OptEnvConf.help "Path to TLS certificate file", OptEnvConf.value "~/.docker/cert.pem"])- <*> OptEnvConf.optional (OptEnvConf.setting [OptEnvConf.option, OptEnvConf.reader (OptEnvConf.str @Text), OptEnvConf.long "tlskey", OptEnvConf.metavar "string", OptEnvConf.help "Path to TLS key file", OptEnvConf.value "~/.docker/key.pem"])- <*> OptEnvConf.setting [OptEnvConf.switch True, OptEnvConf.value False, OptEnvConf.long "tlsverify", OptEnvConf.help "Use TLS and verify the remote"]- <*> OptEnvConf.setting [OptEnvConf.switch True, OptEnvConf.value False, OptEnvConf.short 'v', OptEnvConf.long "version", OptEnvConf.help "Print version information and quit"]- <*> OptEnvConf.commands- [ OptEnvConf.command "run" "Create and run a new container from an image" runOpt- , OptEnvConf.command "exec" "Execute a command in a running container" execOpt- , OptEnvConf.command "ps" "List containers" psOpt+ <$> option' [ long "config", metavar "string", help "Location of client config files", value "~/.docker"]+ <*> optional (option' [short 'c', long "context", metavar "string", help "Name of the context to use to connect to the daemon (overrides DOCKER_HOST env var and default context set with \"docker context use\")"])+ <*> switch' [short 'D', long "debug", help "Enable debug mode"]+ <*> optional (option' [short 'H', long "host", metavar "string", help "Daemon socket to connect to"])+ <*> option' [short 'l', long "log-level", metavar "string", help "Set the logging level (\"debug\", \"info\", \"warn\", \"error\", \"fatal\")", value "info"]+ <*> switch' [ long "tls", help "Use TLS; implied by --tlsverify"]+ <*> option' [ long "tlscacert", metavar "string", help "Trust certs signed only by this CA", value "~/.docker/ca.pem"]+ <*> option' [ long "tlscert", metavar "string", help "Path to TLS certificate file", value "~/.docker/cert.pem"]+ <*> option' [ long "tlskey", metavar "string", help "Path to TLS key file", value "~/.docker/key.pem"]+ <*> switch' [ long "tlsverify", help "Use TLS and verify the remote"]+ <*> switch' [short 'v', long "version", help "Print version information and quit"]+ <*> commands+ [ command "run" "Create and run a new container from an image" runOpt ] -runOpt :: OptEnvConf.Parser ()-runOpt = pure ()+runOpt :: Parser ()+runOpt = void $ (,,,)+ <$> optional (option' [short 'a', long "attach", metavar "list", help "Attach to STDIN, STDOUT or STDERR"])+ <*> argument' [ metavar "IMAGE"]+ <*> optional (argument' [ metavar "COMMAND"])+ <*> many (argument' [ metavar "ARG"])+{- FOURMOLU_ENABLE -} -execOpt :: OptEnvConf.Parser ()-execOpt = pure ()+option' :: [Builder Text] -> Parser Text+option' xs = setting $ [option, reader str] <> xs -psOpt :: OptEnvConf.Parser ()-psOpt = pure ()-{- FOURMOLU_ENABLE -}+argument' :: [Builder Text] -> Parser Text+argument' xs = setting $ [argument, reader str] <> xs++switch' :: [Builder Bool] -> Parser Bool+switch' xs = setting $ [switch True, value False] <> xs
src/Mdoc/Examples/Grep.hs view
@@ -17,14 +17,14 @@ import Mdoc.Data.Named import Mdoc.Data.Page import Mdoc.Syntax-import Options.Applicative qualified as Opt-import Options.Applicative.Mdoc qualified as Opt+import Options.Applicative+import Options.Applicative.Mdoc -- | Recreates <https://github.com/arp242/bsdgrep/blob/master/grep.1> grep1 :: Named grep1 = mempty- & (<> Opt.getPage grepOpt)+ & (<> getPage grepOpt) & (<> Env.getPage grepEnv) & setEpilogue ( Mdoc@@ -42,43 +42,43 @@ & addSecondary "rgrep" {- FOURMOLU_DISABLE -}-grepOpt :: Opt.Parser ()+grepOpt :: Parser () grepOpt = void $ (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)- <$> Opt.optional (Opt.option (Opt.auto @Int) (mconcat [Opt.short 'A', Opt.metavar "num", Opt.help "Print num lines of trailing context after each match. See also the -B and -C options."]))- <*> Opt.optional (Opt.switch (mconcat [Opt.short 'a', Opt.help "Treat all files as ASCII text. Normally grep will simply print “Binary file ... matches” if files contain binary characters. Use of this option forces grep to output lines matching the specified pattern."]))- <*> Opt.optional (Opt.option (Opt.auto @Int) (mconcat [Opt.short 'B', Opt.metavar "num", Opt.help "Print num lines of leading context before each match. See also the -A and -C options."]))- <*> Opt.optional (Opt.switch (mconcat [Opt.short 'b', Opt.help "Each output line is preceded by its position (in bytes) in the file. If option -o is also specified, the position of the matched pattern is displayed."]))- <*> Opt.optional (Opt.option (Opt.auto @Int) (mconcat [Opt.short 'C', Opt.long "context", Opt.metavar "num", Opt.help "Print num lines of leading and trailing context surrounding each match. The default is 2 and is equivalent to -A 2 -B 2. Note: no whitespace may be given between the option and its argument."]))- <*> Opt.optional (Opt.switch (mconcat [Opt.short 'c', Opt.help "Only a count of selected lines is written to standard output."]))- <*> Opt.optional (Opt.switch (mconcat [Opt.short 'E', Opt.help "Interpret pattern as an extended regular expression (i.e. force grep to behave as egrep)."]))- <*> Opt.optional (Opt.option (Opt.str @String) (mconcat [Opt.short 'e', Opt.metavar "pattern", Opt.help "Specify a pattern used during the search of the input: an input line is selected if it matches any of the specified patterns. This option is most useful when multiple -e options are used to specify multiple patterns, or when a pattern begins with a dash (‘-’)."]))- <*> Opt.optional (Opt.switch (mconcat [Opt.short 'F', Opt.help "Interpret pattern as a set of fixed strings (i.e. force grep to behave as fgrep)."]))- <*> Opt.optional (Opt.option (Opt.str @String) (mconcat [Opt.short 'f', Opt.metavar "file", Opt.help "Read one or more newline separated patterns from file. Empty pattern lines match every input line. Newlines are not considered part of a pattern. If file is empty, nothing is matched."]))- <*> Opt.optional (Opt.switch (mconcat [Opt.short 'G', Opt.help "Interpret pattern as a basic regular expression (i.e. force grep to behave as traditional grep)."]))- <*> Opt.optional (Opt.switch (mconcat [Opt.short 'H', Opt.help "Always print filename headers (i.e. filenames) with output lines."]))- <*> Opt.optional (Opt.switch (mconcat [Opt.short 'h', Opt.help "Never print filename headers (i.e. filenames) with output lines."]))- <*> Opt.optional (Opt.switch (mconcat [Opt.short 'I', Opt.help "Ignore binary files."]))- <*> Opt.optional (Opt.switch (mconcat [Opt.short 'i', Opt.help "Perform case insensitive matching. By default, grep is case sensitive."]))- <*> Opt.optional (Opt.switch (mconcat [Opt.short 'L', Opt.help "Only the names of files not containing selected lines are written to standard output. Pathnames are listed once per file searched. If the standard input is searched, the string “(standard input)” is written."]))- <*> Opt.optional (Opt.switch (mconcat [Opt.short 'l', Opt.help "Only the names of files containing selected lines are written to standard output. grep will only search a file until a match has been found, making searches potentially less expensive. Pathnames are listed once per file searched. If the standard input is searched, the string “(standard input)” is written."]))- <*> Opt.optional (Opt.option (Opt.auto @Int) (mconcat [Opt.short 'm', Opt.metavar "num", Opt.help "Stop after finding at least one match on num different lines."]))- <*> Opt.optional (Opt.switch (mconcat [Opt.short 'n', Opt.help "Each output line is preceded by its relative line number in the file, starting at line 1. The line number counter is reset for each file processed. This option is ignored if -c, -L, -l, or -q is specified."]))- <*> Opt.optional (Opt.switch (mconcat [Opt.short 'o', Opt.help "Print each match, but only the match, not the entire line."]))- <*> Opt.optional (Opt.switch (mconcat [Opt.short 'q', Opt.help "Quiet mode: suppress normal output. grep will only search a file until a match has been found, making searches potentially less expensive."]))- <*> Opt.optional (Opt.switch (mconcat [Opt.short 'R', Opt.help "Recursively search subdirectories listed. If no file is given, grep searches the current working directory."]))- <*> Opt.optional (Opt.switch (mconcat [Opt.short 's', Opt.help "Silent mode. Nonexistent and unreadable files are ignored (i.e. their error messages are suppressed)."]))- <*> Opt.optional (Opt.switch (mconcat [Opt.short 'U', Opt.help "Search binary files, but do not attempt to print them."]))- <*> Opt.optional (Opt.switch (mconcat [Opt.short 'V', Opt.help "Display version information. All other options are ignored."]))- <*> Opt.optional (Opt.switch (mconcat [Opt.short 'v', Opt.help "Selected lines are those not matching any of the specified patterns."]))- <*> Opt.optional (Opt.switch (mconcat [Opt.short 'w', Opt.help "The expression is searched for as a word (as if surrounded by ‘[[:<:]]’ and ‘[[:>:]]’; see re_format(7))."]))- <*> Opt.optional (Opt.switch (mconcat [Opt.short 'x', Opt.help "Only input lines selected against an entire fixed string or regular expression are considered to be matching lines."]))- <*> Opt.optional (Opt.switch (mconcat [Opt.short 'Z', Opt.help "Force grep to behave as zgrep."]))- <*> Opt.optional (Opt.option (Opt.str @String) (mconcat [Opt.long "binary-files", Opt.metavar "value", Opt.help "Controls searching and printing of binary files. Options are binary, the default: search binary files but do not print them; without-match: do not search binary files; and text: treat all files as text."]))- <*> Opt.optional (Opt.option (Opt.str @String) (mconcat [Opt.long "label", Opt.metavar "name", Opt.help "Print name instead of the filename before lines."]))- <*> Opt.optional (Opt.switch (mconcat [Opt.long "line-buffered", Opt.help "Force output to be line buffered. By default, output is line buffered when standard output is a terminal and block buffered otherwise."]))- <*> Opt.optional (Opt.switch (mconcat [Opt.long "null", Opt.help "Output a zero byte instead of the character that normally follows a file name. This option makes the output unambiguous, even in the presence of file names containing unusual characters like newlines. This is similar to the -print0 primary in find(1)."]))- <*> Opt.optional (Opt.argument (Opt.str @String) (mconcat [Opt.metavar "pattern"]))- <*> Opt.many (Opt.argument (Opt.str @String) (mconcat [Opt.metavar "file"]))+ <$> optional (option (auto @Int) (mconcat [short 'A', metavar "num", help "Print num lines of trailing context after each match. See also the -B and -C options."]))+ <*> optional (switch (mconcat [short 'a', 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."]))+ <*> optional (option (auto @Int) (mconcat [short 'B', metavar "num", help "Print num lines of leading context before each match. See also the -A and -C options."]))+ <*> optional (switch (mconcat [short 'b', 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."]))+ <*> optional (option (auto @Int) (mconcat [short 'C', long "context", metavar "num", 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."]))+ <*> optional (switch (mconcat [short 'c', help "Only a count of selected lines is written to standard output."]))+ <*> optional (switch (mconcat [short 'E', help "Interpret pattern as an extended regular expression (i.e. force grep to behave as egrep)."]))+ <*> optional (option (str @String) (mconcat [short 'e', metavar "pattern", 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 (‘-’)."]))+ <*> optional (switch (mconcat [short 'F', help "Interpret pattern as a set of fixed strings (i.e. force grep to behave as fgrep)."]))+ <*> optional (option (str @String) (mconcat [short 'f', metavar "file", 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."]))+ <*> optional (switch (mconcat [short 'G', help "Interpret pattern as a basic regular expression (i.e. force grep to behave as traditional grep)."]))+ <*> optional (switch (mconcat [short 'H', help "Always print filename headers (i.e. filenames) with output lines."]))+ <*> optional (switch (mconcat [short 'h', help "Never print filename headers (i.e. filenames) with output lines."]))+ <*> optional (switch (mconcat [short 'I', help "Ignore binary files."]))+ <*> optional (switch (mconcat [short 'i', help "Perform case insensitive matching. By default, grep is case sensitive."]))+ <*> optional (switch (mconcat [short 'L', 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."]))+ <*> optional (switch (mconcat [short 'l', 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."]))+ <*> optional (option (auto @Int) (mconcat [short 'm', metavar "num", help "Stop after finding at least one match on num different lines."]))+ <*> optional (switch (mconcat [short 'n', 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."]))+ <*> optional (switch (mconcat [short 'o', help "Print each match, but only the match, not the entire line."]))+ <*> optional (switch (mconcat [short 'q', help "Quiet mode: suppress normal output. grep will only search a file until a match has been found, making searches potentially less expensive."]))+ <*> optional (switch (mconcat [short 'R', help "Recursively search subdirectories listed. If no file is given, grep searches the current working directory."]))+ <*> optional (switch (mconcat [short 's', help "Silent mode. Nonexistent and unreadable files are ignored (i.e. their error messages are suppressed)."]))+ <*> optional (switch (mconcat [short 'U', help "Search binary files, but do not attempt to print them."]))+ <*> optional (switch (mconcat [short 'V', help "Display version information. All other options are ignored."]))+ <*> optional (switch (mconcat [short 'v', help "Selected lines are those not matching any of the specified patterns."]))+ <*> optional (switch (mconcat [short 'w', help "The expression is searched for as a word (as if surrounded by ‘[[:<:]]’ and ‘[[:>:]]’; see re_format(7))."]))+ <*> optional (switch (mconcat [short 'x', help "Only input lines selected against an entire fixed string or regular expression are considered to be matching lines."]))+ <*> optional (switch (mconcat [short 'Z', help "Force grep to behave as zgrep."]))+ <*> optional (option (str @String) (mconcat [long "binary-files", metavar "value", 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."]))+ <*> optional (option (str @String) (mconcat [long "label", metavar "name", help "Print name instead of the filename before lines."]))+ <*> optional (switch (mconcat [long "line-buffered", help "Force output to be line buffered. By default, output is line buffered when standard output is a terminal and block buffered otherwise."]))+ <*> optional (switch (mconcat [long "null", 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)."]))+ <*> optional (argument (str @String) (mconcat [metavar "pattern"]))+ <*> many (argument (str @String) (mconcat [metavar "file"])) grepEnv :: Env.Parser Env.Error () grepEnv = void $ (,,)
src/Mdoc/Examples/OptEnvConf.hs view
@@ -17,13 +17,13 @@ import Mdoc.Data.Named import Mdoc.Data.Page import Mdoc.Syntax-import OptEnvConf qualified-import OptEnvConf.Mdoc qualified as OptEnvConf+import OptEnvConf hiding (name)+import OptEnvConf.Mdoc conf5 :: Named conf5 = mempty- & (<> OptEnvConf.getPage confParser)+ & (<> getPage confParser) & setSynopsis ( Mdoc [ MacroLine Bl ["-tag", "-width", "indent", "-compact"]@@ -36,24 +36,24 @@ & name "crontab" "tables for driving cron" {- FOURMOLU_DISABLE -}-confParser :: OptEnvConf.Parser ()+confParser :: Parser () confParser = void $ (,)- <$> OptEnvConf.setting [OptEnvConf.conf @String "foo", OptEnvConf.help "Foo's the fooing of fooers"]- <*> OptEnvConf.subConfig "bar" ((,)- <$> OptEnvConf.setting [OptEnvConf.conf @Bool "baz", OptEnvConf.help "Bar's baz of bazzle"]- <*> OptEnvConf.setting [OptEnvConf.conf @[Int] "bat", OptEnvConf.help "Bar's bat is better than that"])+ <$> setting [conf @String "foo", help "Foo's the fooing of fooers"]+ <*> subConfig "bar" ((,)+ <$> setting [conf @Bool "baz", help "Bar's baz of bazzle"]+ <*> setting [conf @[Int] "bat", help "Bar's bat is better than that"]) {- FOURMOLU_ENABLE -} example1 :: Named example1 = mempty- & (<> OptEnvConf.getPage exampleParser)+ & (<> getPage exampleParser) & name "example" "opt-env-conf example" examplerc5 :: Named examplerc5 = mempty- & (<> OptEnvConf.getPage exampleParser)+ & (<> getPage exampleParser) & setSynopsis ( Mdoc [ MacroLine Bl ["-tag", "-width", "indent", "-compact"]@@ -64,18 +64,22 @@ & name "examplerc" "opt-env-conf example config" {- FOURMOLU_DISABLE -}-exampleParser :: OptEnvConf.Parser ()+exampleParser :: Parser () exampleParser = void $ (,,,,,)- <$> OptEnvConf.setting [OptEnvConf.env "DEBUG", OptEnvConf.conf "debug", OptEnvConf.switch True, OptEnvConf.long "debug", OptEnvConf.help "Enable debug", OptEnvConf.value False- , OptEnvConf.example "# enable debug"- , OptEnvConf.example "debug: true"- ]- <*> OptEnvConf.setting [OptEnvConf.conf "verbose", OptEnvConf.switch True, OptEnvConf.short 'v', OptEnvConf.long "verbose", OptEnvConf.value False]- <*>- ( OptEnvConf.setting [OptEnvConf.switch True, OptEnvConf.short 'a', OptEnvConf.long "apple", OptEnvConf.value False, OptEnvConf.help "Use apples"]- <|> OptEnvConf.setting [OptEnvConf.switch True, OptEnvConf.short 'b', OptEnvConf.long "banana", OptEnvConf.value False, OptEnvConf.help "Use bananas"]- )- <*> OptEnvConf.optional (OptEnvConf.setting [OptEnvConf.env "INPUT", OptEnvConf.option, OptEnvConf.reader $ OptEnvConf.str @Text, OptEnvConf.short 'i', OptEnvConf.metavar "INPUT"])- <*> OptEnvConf.setting [OptEnvConf.conf "file", OptEnvConf.argument, OptEnvConf.reader $ OptEnvConf.str @Text, OptEnvConf.metavar "FILE"]- <*> OptEnvConf.many (OptEnvConf.setting [OptEnvConf.argument, OptEnvConf.reader $ OptEnvConf.str @Text, OptEnvConf.metavar "FILE"])+ <$> switch' [ long "debug", help "Enable debug", env "DEBUG", conf "debug", example "# enable debug" , example "debug: true"]+ <*> switch' [short 'v', long "verbose", conf "verbose"]+ <*> ( switch' [short 'a', long "apple", help "Use apples"]+ <|> switch' [short 'b', long "banana", help "Use bananas"])+ <*> optional (option' [short 'i', metavar "INPUT", env "INPUT"])+ <*> argument' [ metavar "FILE", conf "file"]+ <*> many (argument' [ metavar "FILE"]) {- FOURMOLU_ENABLE -}++option' :: [Builder Text] -> Parser Text+option' xs = setting $ [option, reader str] <> xs++argument' :: [Builder Text] -> Parser Text+argument' xs = setting $ [argument, reader str] <> xs++switch' :: [Builder Bool] -> Parser Bool+switch' xs = setting $ [switch True, value False] <> xs
src/OptEnvConf/Mdoc.hs view
@@ -34,7 +34,7 @@ -- +------------+-----------------+------------------+----------+ -- | 'many' | option | @[option]@ | no | -- +------------+-----------------+------------------+----------+--- | 'many' | argument | @argument ...@ | yes |+-- | 'many' | argument | @[argument ...]@ | yes | -- +------------+-----------------+------------------+----------+ -- -- Any behavior here is wrong; we do this primarily because a @SYNOPSIS@ with a@@ -93,17 +93,20 @@ setDocToFlag :: SetDoc -> Maybe Flag setDocToFlag doc = do+ guard $ setDocTrySwitch doc flag <- dashedFlags $ setDocDasheds doc flag <$ guard (isNothing $ setDocMetavar doc) setDocToOption :: SetDoc -> Maybe Option setDocToOption doc = do+ guard $ setDocTryOption doc flag <- dashedFlags $ setDocDasheds doc schema <- setDocMetavar doc pure $ Option {flag, argument = fromString schema} setDocToArgument :: Int -> SetDoc -> Maybe Argument setDocToArgument index doc = do+ guard $ setDocTryArgument doc guard $ null $ setDocDasheds doc schema <- setDocMetavar doc pure $ Argument {index, schema, optionality = Required}
test/Autodocodec/Schema/MdocSpec.hs view
@@ -14,147 +14,211 @@ import Autodocodec.Schema import Autodocodec.Schema.Mdoc-import Data.Aeson qualified as Aeson-import Data.List.NonEmpty qualified as NE-import Mdoc.Pretty+import Data.Aeson (Result (..), Value, fromJSON, object, (.=)) import Mdoc.Test.Render import Test.Hspec +t :: Text -> Text+t = id+ spec :: Spec spec = do it "primitive" $ do- schemaDoc BoolSchema- `shouldRender` [".It : Ar boolean"]+ assertSchemaRenders+ (object ["type" .= t "boolean"])+ [".It : Ar boolean"] + it "primitive with comment" $ do+ assertSchemaAtRenders+ (pure "name")+ ( object+ [ "$comment" .= t "The person's name"+ , "type" .= t "string"+ ]+ )+ [ ".It Cm name : Ar string"+ , "The person's name"+ ]+ it "array of primitive" $ do- schemaDoc (ArraySchema BoolSchema)- `shouldRender` [".It : Ar boolean Ns []"]+ assertSchemaRenders+ ( object+ [ "type" .= t "array"+ , "items" .= object ["type" .= t "boolean"]+ ]+ )+ [".It : Ar boolean Ns []"] it "array of any-of" $ do- let- js :: JSONSchema- js = ArraySchema (AnyOfSchema $ StringSchema :| [BoolSchema])-- schemaDoc js- `shouldRender` [".It : ( Ar string Ns | Ns Ar boolean ) Ns []"]+ assertSchemaRenders+ ( object+ [ "type" .= t "array"+ , "items"+ .= object+ [ "anyOf"+ .= [ object ["type" .= t "string"]+ , object ["type" .= t "boolean"]+ ]+ ]+ ]+ )+ [".It : ( Ar string Ns | Ns Ar boolean ) Ns []"] it "any-of with array" $ do- let- js :: JSONSchema- js = AnyOfSchema $ StringSchema :| [ArraySchema BoolSchema]-- schemaDoc js- `shouldRender` [".It : Ar string Ns | Ns Ar boolean Ns []"]+ assertSchemaRenders+ ( object+ [ "anyOf"+ .= [ object ["type" .= t "string"]+ , object+ [ "type" .= t "array"+ , "items" .= object ["type" .= t "boolean"]+ ]+ ]+ ]+ )+ [".It : Ar string Ns | Ns Ar boolean Ns []"] it "log-level example" $ do- let- keys :: NonEmpty String- keys = "log" :| ["level"]-- js :: JSONSchema- js =- AnyOfSchema- $ ValueSchema (Aeson.String "info")- :| [ ValueSchema (Aeson.String "warn")- , ValueSchema (Aeson.String "error")- ]-- schemaDocAt keys js- `shouldRender` [".It Cm log.level : Ar info Ns | Ns Ar warn Ns | Ns Ar error"]-- it "renders types with comments" $ do- let- keys :: NonEmpty String- keys = pure "name"-- js :: JSONSchema- js = CommentSchema "The person's name" StringSchema-- schemaDocAt keys js- `shouldRender` [ ".It Cm name : Ar string"- , "The person's name"- ]+ assertSchemaAtRenders+ ("log" :| ["level"])+ ( object+ [ "anyOf"+ .= [ object ["const" .= t "info"]+ , object ["const" .= t "warn"]+ , object ["const" .= t "error"]+ ]+ ]+ )+ [".It Cm log.level : Ar info Ns | Ns Ar warn Ns | Ns Ar error"] context "objects" $ do- let- key :: Text -> JSONSchema -> ObjectSchema- key k s = ObjectKeySchema k Required s Nothing-- keyComment :: Text -> Text -> JSONSchema -> ObjectSchema- keyComment k d s = ObjectKeySchema k Required s $ Just d-- object :: [ObjectSchema] -> JSONSchema- object = ObjectSchema . ObjectAllOfSchema . NE.fromList- it "special case, any" $ do- schemaDoc (ObjectSchema ObjectAnySchema)- `shouldRender` [".It : Ar any"]+ assertSchemaRenders+ (object ["type" .= t "object"])+ [".It : Ar any"] it "one-level" $ do- let- js :: JSONSchema- js =- object- [ key "foo" StringSchema- , key "bar" BoolSchema- , key "baz" (RefSchema "custom")+ assertSchemaRenders+ ( object+ [ "type" .= t "object"+ , "properties"+ .= object+ [ "foo" .= object ["type" .= t "string"]+ , "bar" .= object ["type" .= t "boolean"]+ , "baz" .= object ["$ref" .= t "#/$defs/custom"]+ ] ]-- schemaDoc js- `shouldRender` [ ".It Cm foo : Ar string"- , ".It Cm bar : Ar boolean"- , ".It Cm baz : Ar custom"- ]+ )+ [ ".It Cm bar : Ar boolean"+ , ".It Cm baz : Ar custom"+ , ".It Cm foo : Ar string"+ ] it "multi-level" $ do- let- js :: JSONSchema- js = object [key "foo" (object [key "bar" (object [key "baz" StringSchema])])]-- schemaDoc js- `shouldRender` [ ".It Cm foo : Ar object"- , ".It Cm foo.bar : Ar object"- , ".It Cm foo.bar.baz : Ar string"- ]+ assertSchemaRenders+ ( object+ [ "type" .= t "object"+ , "properties"+ .= object+ [ "foo"+ .= object+ [ "type" .= t "object"+ , "properties"+ .= object+ [ "bar"+ .= object+ [ "type" .= t "object"+ , "properties"+ .= object+ [ "baz"+ .= object+ [ "type" .= t "string"+ ]+ ]+ ]+ ]+ ]+ ]+ ]+ )+ [ ".It Cm foo : Ar object"+ , ".It Cm foo.bar : Ar object"+ , ".It Cm foo.bar.baz : Ar string"+ ] it "list of object at key" $ do- let- js :: JSONSchema- js =- ArraySchema- $ object- [ key "name" StringSchema- , keyComment "admin" "Admin?" BoolSchema- ]-- schemaDoc js- `shouldRender` [ ".It Cm [].name : Ar string"- , ".It Cm [].admin : Ar boolean"- , "Admin?"- ]+ assertSchemaRenders+ ( object+ [ "type" .= t "array"+ , "items"+ .= object+ [ "type" .= t "object"+ , "properties"+ .= object+ [ "name"+ .= object+ [ "type" .= t "string"+ ]+ , "admin"+ .= object+ [ "$comment" .= t "Admin?"+ , "type" .= t "boolean"+ ]+ ]+ ]+ ]+ )+ [ ".It Cm [].admin : Ar boolean"+ , "Admin?"+ , ".It Cm [].name : Ar string"+ ] it "list of object at key" $ do- let- keys :: NonEmpty String- keys = pure "people"+ assertSchemaAtRenders+ (pure "people")+ ( object+ [ "type" .= t "array"+ , "items"+ .= object+ [ "type" .= t "object"+ , "properties"+ .= object+ [ "name"+ .= object+ [ "type" .= t "string"+ ]+ , "admin"+ .= object+ [ "$comment" .= t "Admin?"+ , "type" .= t "boolean"+ ]+ ]+ ]+ ]+ )+ [ ".It Cm people : Ar object Ns []"+ , ".It Cm people[].admin : Ar boolean"+ , "Admin?"+ , ".It Cm people[].name : Ar string"+ ] - js :: JSONSchema- js =- ArraySchema- $ object- [ key "name" StringSchema- , keyComment "admin" "Admin?" BoolSchema- ]+assertSchemaRenders :: HasCallStack => Value -> [Text] -> Expectation+assertSchemaRenders bs x = do+ js <- case fromJSON @JSONSchema bs of+ Error err -> do+ expectationFailure err+ error "unreachable"+ Success js -> pure js - schemaDocAt keys js- `shouldRender` [ ".It Cm people : Ar object Ns []"- , ".It Cm people[].name : Ar string"- , ".It Cm people[].admin : Ar boolean"- , "Admin?"- ]+ prettyDescribeds (getConfigs Nothing js) `shouldRender` x -schemaDoc :: JSONSchema -> Doc ann-schemaDoc = prettyDescribeds . getConfigs Nothing+assertSchemaAtRenders+ :: HasCallStack => NonEmpty String -> Value -> [Text] -> Expectation+assertSchemaAtRenders keys bs x = do+ js <- case fromJSON @JSONSchema bs of+ Error err -> do+ expectationFailure err+ error "unreachable"+ Success js -> pure js -schemaDocAt :: NonEmpty String -> JSONSchema -> Doc ann-schemaDocAt keys = prettyDescribeds . getConfigs (Just keys)+ prettyDescribeds (getConfigs (Just keys) js) `shouldRender` x
test/Mdoc/Test/Render.hs view
@@ -15,6 +15,7 @@ import Mdoc.Prelude +import Data.List (sort) import Data.Text qualified as T import Mdoc.Data.Described import Mdoc.Pretty@@ -26,8 +27,8 @@ infix 1 `shouldRender` -prettyDescribeds :: Pretty a => [Described a] -> Doc ann-prettyDescribeds = vsep . map prettyDescribed+prettyDescribeds :: (Ord a, Pretty a) => [Described a] -> Doc ann+prettyDescribeds = vsep . map prettyDescribed . sort -- | @Described@ is rendered to JSON and formatted in-template, so we don't want -- to have a misleading 'Pretty' instance. So we use this instead.