mdoc 0.3.0.0 → 0.3.1.0
raw patch · 4 files changed
+94/−130 lines, 4 files
Files
- mdoc.cabal +1/−1
- src/Mdoc/Data/Described.hs +1/−1
- src/OptEnvConf/Mdoc.hs +89/−125
- src/Options/Applicative/Mdoc.hs +3/−3
mdoc.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: mdoc-version: 0.3.0.0+version: 0.3.1.0 license: AGPL-3 license-file: COPYING maintainer: Pat Brisbin
src/Mdoc/Data/Described.hs view
@@ -29,7 +29,7 @@ , multiple :: Bool , help :: Maybe Mdoc }- deriving stock (Functor, Generic, Show)+ deriving stock (Foldable, Functor, Generic, Show, Traversable) instance Eq a => Eq (Described a) where (==) = (==) `on` (.item)
src/OptEnvConf/Mdoc.hs view
@@ -15,7 +15,10 @@ import Mdoc.Prelude import Autodocodec.Schema.Mdoc qualified as JSONSchema+import Control.Monad (foldM)+import Control.Monad.State (MonadState (..), evalState, modify) import Mdoc.Data.Argument+import Mdoc.Data.Command import Mdoc.Data.Config import Mdoc.Data.Described import Mdoc.Data.EnvVar@@ -23,125 +26,106 @@ import Mdoc.Data.Option import Mdoc.Data.Optionality import Mdoc.Data.Page-import OptEnvConf (ConfDoc (..), EnvDoc (..), OptDoc (..), Parser)+import OptEnvConf (CommandDoc (..), Parser, SetDoc (..)) import OptEnvConf.Args (Dashed (..))-import OptEnvConf.Doc- ( AnyDocs (..)- , parserConfDocs- , parserEnvDocs- , parserOptDocs- )+import OptEnvConf.Doc (AnyDocs (..), parserDocs) getPage :: Parser a -> Page-getPage p =- flip appEndo mempty- $ mconcat- [ foldMap (Endo . either addSwitch addOption . splitEither) $ getParserOpts p- , foldMap (Endo . addArgument) $ getParserArgs p- , foldMap (Endo . addEnvVar) $ getParserEnvs p- , foldMap (Endo . addConfig) $ getParserConfs p- ]- where- splitEither :: Described (Either a b) -> Either (Described a) (Described b)- splitEither d = case d.item of- Left a -> Left $ a <$ d- Right b -> Right $ b <$ d--getParserOpts :: Parser a -> [Described (Either Flag Option)]-getParserOpts = walkNonCommandDocs 0 (maybe [] . optDocToOpt) . parserOptDocs--getParserArgs :: Parser a -> [Described Argument]-getParserArgs = walkNonCommandDocs 0 (maybe [] . optDocToArg) . parserOptDocs--getParserEnvs :: Parser a -> [Described EnvVar]-getParserEnvs = walkNonCommandDocs 0 envDocToEnvVar . parserEnvDocs+getPage = foldSetDocs addToPage . parserDocs --- getParserCmds :: Parser a -> [Command]--- getParserCmds = walkCommandDocs commandDocToCommand . parserOptDocs+getCommand :: Int -> CommandDoc (Maybe SetDoc) -> Command+getCommand index doc =+ Command+ { index+ , name = commandDocArgument doc+ , description = textToMdoc $ pack $ commandDocHelp doc+ , synopsis = getSynopsis $ foldSetDocs addToPage $ commandDocs doc+ } -getParserConfs :: Parser a -> [Described Config]-getParserConfs = walkNonCommandDocs 0 confToConfig . parserConfDocs+addToPage+ :: Int+ -> Page+ -> Either [CommandDoc (Maybe SetDoc)] (Described SetDoc)+ -> Page+addToPage index acc = \case+ Left cdocs -> addCommands (zipWith getCommand [1 ..] cdocs) acc+ Right d ->+ flip appEndo acc+ $ mconcat+ $ catMaybes+ [ Endo . addSwitch <$> traverse setDocToFlag d+ , Endo . addOption <$> traverse setDocToOption d+ , Endo . addArgument <$> traverse (setDocToArgument index) d+ , Endo . addEnvVar <$> traverse setDocToEnvVar d+ , Just $ foldMap (Endo . addConfig) $ traverse setDocToConfigs d+ ] -optDocToOpt :: Int -> OptDoc -> [Described (Either Flag Option)]-optDocToOpt _ doc =- fromMaybe [] $ do- flag <- dashedFlags $ optDocDasheds doc+setDocToFlag :: SetDoc -> Maybe Flag+setDocToFlag doc = do+ flag <- dashedFlags $ setDocDasheds doc+ flag <$ guard (isNothing $ setDocMetavar doc) - let item = case optDocMetavar doc of- Nothing -> Left flag- Just schema -> Right $ Option {flag, argument = fromString schema}+setDocToOption :: SetDoc -> Maybe Option+setDocToOption doc = do+ flag <- dashedFlags $ setDocDasheds doc+ schema <- setDocMetavar doc+ pure $ Option {flag, argument = fromString schema} - pure- [ Described- { item- , optionality = maybe Required Defaulted $ optDocDefault doc- , multiple = False- , help = textToMdoc . pack =<< optDocHelp doc- }- ]+setDocToArgument :: Int -> SetDoc -> Maybe Argument+setDocToArgument index doc = do+ guard $ null $ setDocDasheds doc+ schema <- setDocMetavar doc+ pure $ Argument {index, schema, optionality = Required} -optDocToArg :: Int -> OptDoc -> [Described Argument]-optDocToArg index doc =- case (optDocDasheds doc, optDocMetavar doc) of- ([], Just schema) ->- [ Described- { item =- Argument- { index- , schema- , optionality = Required- }- , optionality = maybe Required Defaulted $ optDocDefault doc- , multiple = False- , help = textToMdoc . pack =<< optDocHelp doc- }- ]- _ -> []+setDocToEnvVar :: SetDoc -> Maybe EnvVar+setDocToEnvVar doc = do+ names <- setDocEnvVars doc+ pure $ EnvVar {names, argument = setDocMetavar doc <&> fromString} -envDocToEnvVar :: Int -> EnvDoc -> [Described EnvVar]-envDocToEnvVar _ doc =- [ Described- { item =- EnvVar- { names = envDocVars doc- , argument = envDocMetavar doc <&> fromString- }- , optionality = maybe Required Defaulted $ envDocDefault doc- , multiple = False- , help = textToMdoc . pack =<< envDocHelp doc- }- ]+setDocToConfigs :: SetDoc -> [Config]+setDocToConfigs =+ map (.item)+ . concatMap (\(keys, js) -> JSONSchema.getConfigs (Just keys) js)+ . maybe [] toList+ . setDocConfKeys --- 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--- }--- ]+foldSetDocs+ :: (Int -> Page -> Either [CommandDoc (Maybe SetDoc)] (Described SetDoc) -> Page)+ -> AnyDocs (Maybe SetDoc)+ -> Page+foldSetDocs f = flip evalState 0 . foldSetDocsM f mempty -confToConfig :: Int -> ConfDoc -> [Described Config]-confToConfig _ doc =- concatMap (\(keys, js) -> addMeta $ JSONSchema.getConfigs (Just keys) js)- $ toList- $ confDocKeys doc- where- addMeta :: [Described Config] -> [Described Config]- addMeta = \case- [] -> []- (d : ds) ->- d- { optionality = maybe Required Defaulted $ confDocDefault doc+foldSetDocsM+ :: MonadState Int m+ => (Int -> Page -> Either [CommandDoc (Maybe SetDoc)] (Described SetDoc) -> Page)+ -> Page+ -> AnyDocs (Maybe SetDoc)+ -> m Page+foldSetDocsM f acc = \case+ AnyDocsCommands _ cdocs -> do+ index <- get+ modify (+ 1)+ pure $ f index acc $ Left cdocs+ AnyDocsAnd ds -> foldM (foldSetDocsM f) acc ds+ AnyDocsOr ds -> foldM (foldSetDocsM fAsMultiple) acc ds+ AnyDocsSingle Nothing -> pure acc -- hidden/internal+ AnyDocsSingle (Just d) -> do+ index <- get+ modify (+ 1)+ pure+ $ f index acc+ $ Right+ $ Described+ { item = d+ , optionality = maybe Required Defaulted (setDocDefault d) , multiple = False- , help = textToMdoc . pack =<< confDocHelp doc+ , help = textToMdoc . pack =<< setDocHelp d }- : ds+ 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 treat it as both since it+ -- passes our current tests.+ fAsMultiple i m e = f i m $ second (\d -> d {optionality = Optional, multiple = True}) e dashedFlags :: [Dashed] -> Maybe Flag dashedFlags = fmap go . nonEmpty@@ -155,23 +139,3 @@ 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- :: Int -> (Int -> a -> [Described b]) -> AnyDocs a -> [Described b]-walkNonCommandDocs index f = \case- AnyDocsCommands {} -> []- AnyDocsAnd ds -> concatMap (walkNonCommandDocs (index + 1) f) ds- AnyDocsOr ds -> concatMap (map mkMultiple . walkNonCommandDocs (index + 1) f) ds- AnyDocsSingle d -> f index d- where- -- This is suspect, but it seems we can't distinguish if the Or is being used- -- to indicate some/many or optionality. We'll just treat it as both since it- -- passes our current tests.- mkMultiple d = d {optionality = Optional, multiple = True}
src/Options/Applicative/Mdoc.hs view
@@ -35,7 +35,7 @@ import Prettyprinter.Render.Text qualified as Pretty getPage :: Parser a -> Page-getPage p = foldOptTree optionToMan1 $ treeMapParser (const void) p+getPage p = foldOptTree addToPage $ treeMapParser (const void) p getCommand :: Int -> String -> O.ParserInfo x -> Command getCommand index name pinfo =@@ -53,12 +53,12 @@ , O.infoFooter pinfo ] -optionToMan1+addToPage :: Int -> Page -> Described (O.Option x) -> Page-optionToMan1 index acc d = case O.optMain o of+addToPage index acc d = case O.optMain o of O.OptReader onames _ _ -> fromMaybe acc $ do flag <- optFlags onames schema <- metavar