From 91d57b07c4714086eb482cb15abf389eb2f000d5 Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Mon, 14 Sep 2020 14:21:51 +0200 Subject: [PATCH] Clean up haddocks --- src-tests/TestMain.hs | 4 +- src/UI/Butcher/Applicative/Flag.hs | 5 +- src/UI/Butcher/Applicative/Param.hs | 2 + src/UI/Butcher/Internal/Applicative.hs | 41 +++++++++++ src/UI/Butcher/Internal/ApplicativeTypes.hs | 2 + src/UI/Butcher/Internal/CommonTypes.hs | 13 ++-- src/UI/Butcher/Internal/Interactive.hs | 4 +- src/UI/Butcher/Internal/Monadic.hs | 79 ++++----------------- src/UI/Butcher/Monadic.hs | 13 ++++ src/UI/Butcher/Monadic/Command.hs | 2 +- src/UI/Butcher/Monadic/Flag.hs | 8 +-- src/UI/Butcher/Monadic/Param.hs | 67 ++--------------- 12 files changed, 100 insertions(+), 140 deletions(-) diff --git a/src-tests/TestMain.hs b/src-tests/TestMain.hs index 03e34f1..b9a3aca 100644 --- a/src-tests/TestMain.hs +++ b/src-tests/TestMain.hs @@ -173,8 +173,8 @@ testCmd3 :: CmdParser (StateS.State Int) () () testCmd3 = do addCmd "abc" $ do reorderStart - addSimpleFlagA "f" ["flong"] mempty (StateS.modify (+ 1)) - addSimpleFlagA "g" ["glong"] mempty (StateS.modify (+ 2)) + addSimpleBoolFlagA "f" ["flong"] mempty (StateS.modify (+ 1)) + addSimpleBoolFlagA "g" ["glong"] mempty (StateS.modify (+ 2)) reorderStop addCmdImpl () addCmd "def" $ do diff --git a/src/UI/Butcher/Applicative/Flag.hs b/src/UI/Butcher/Applicative/Flag.hs index 6497cc1..67cb249 100644 --- a/src/UI/Butcher/Applicative/Flag.hs +++ b/src/UI/Butcher/Applicative/Flag.hs @@ -42,6 +42,8 @@ import Debug.Trace +-- | flag-description monoid. You probably won't need to use the constructor; +-- mzero or any (<>) of flag(Help|Default) works well. data Flag a = Flag { _flag_help :: Maybe PP.Doc , _flag_default :: Maybe a @@ -83,6 +85,7 @@ wrapHidden f = case _flag_visibility f of Hidden -> PartHidden +-- | A no-parameter flag where non-occurence means False, occurence means True. addSimpleBoolFlag :: String -> [String] -> Flag Void -> CmdParser out Bool addSimpleBoolFlag shorts longs opts = fmap (not . null) $ addCmdPartMany ManyUpperBound1 (wrapHidden opts desc) parseF @@ -134,7 +137,7 @@ addSimpleCountFlag shorts longs flag = fmap length allStrs ) - +-- | One-argument flag, where the argument is parsed via its Read instance. addFlagReadParam :: forall out p . (Typeable p, Read p, Show p) diff --git a/src/UI/Butcher/Applicative/Param.hs b/src/UI/Butcher/Applicative/Param.hs index a3fcd00..20fe556 100644 --- a/src/UI/Butcher/Applicative/Param.hs +++ b/src/UI/Butcher/Applicative/Param.hs @@ -45,6 +45,8 @@ import UI.Butcher.Internal.Applicative import UI.Butcher.Internal.Pretty +-- | param-description monoid. You probably won't need to use the constructor; +-- mzero or any (<>) of param(Help|Default|Suggestion) works well. data Param p = Param { _param_default :: Maybe p , _param_help :: Maybe PP.Doc diff --git a/src/UI/Butcher/Internal/Applicative.hs b/src/UI/Butcher/Internal/Applicative.hs index 237d083..8fa10af 100644 --- a/src/UI/Butcher/Internal/Applicative.hs +++ b/src/UI/Butcher/Internal/Applicative.hs @@ -289,6 +289,10 @@ runCmdParserCoreFromDesc input desc parser = InputArgs{} -> return () +-- | If you have a higher-kinded config type (let's assume it is a plain +-- record) then this turns a record whose fields are @CmdParser@s over +-- different values into a CmdParser that returns a record with the parsed +-- values in the fields. traverseBarbie :: (Barbies.BareB c, Barbies.TraversableB (c Barbies.Covered)) => c Barbies.Covered (CmdParser out) @@ -298,6 +302,9 @@ traverseBarbie k = do pure $ Barbies.bstrip r +-- | Add part that is expected to occur exactly once in the input. +-- The EpsilonFlag specifies whether succeeding on empty input is permitted +-- or not. addCmdPart :: Typeable p => PartDesc @@ -305,6 +312,9 @@ addCmdPart -> CmdParser out p addCmdPart p f = liftAp $ CmdParserPartInp p (convertStringToInputParse f) id +-- | Add part that is not required to occur, and can occur as often as +-- indicated by 'ManyUpperBound'. The EpsilonFlag specifies whether succeeding +-- on empty input is permitted or not. addCmdPartMany :: Typeable p => ManyUpperBound @@ -314,6 +324,12 @@ addCmdPartMany addCmdPartMany b p f = liftAp $ CmdParserPartManyInp b p (convertStringToInputParse f) id +-- | Add part that is expected to occur exactly once in the input. +-- The EpsilonFlag specifies whether succeeding on empty input is permitted +-- or not. +-- +-- Only difference to 'addCmdPart' is that it accepts 'Input', i.e. can +-- behave differently for @String@ and @[String]@ input. addCmdPartInp :: Typeable p => PartDesc @@ -321,6 +337,13 @@ addCmdPartInp -> CmdParser out p addCmdPartInp p f = liftAp $ CmdParserPartInp p f id +-- | Add part that is not required to occur, and can occur as often as +-- indicated by 'ManyUpperBound'. +-- The EpsilonFlag specifies whether succeeding on empty input is permitted +-- or not. +-- +-- Only difference to 'addCmdPart' is that it accepts 'Input', i.e. can +-- behave differently for @String@ and @[String]@ input. addCmdPartManyInp :: Typeable p => ManyUpperBound @@ -329,9 +352,27 @@ addCmdPartManyInp -> CmdParser out [p] addCmdPartManyInp b p f = liftAp $ CmdParserPartManyInp b p f id +-- | Best explained via example: +-- +-- > do +-- > reorderStart +-- > bright <- addSimpleBoolFlag "" ["bright"] mempty +-- > yellow <- addSimpleBoolFlag "" ["yellow"] mempty +-- > reorderStop +-- > .. +-- +-- will accept any inputs "" "--bright" "--yellow" "--bright --yellow" "--yellow --bright". +-- +-- This works for any flags/params, but bear in mind that the results might +-- be unexpected because params may match on any input. +-- +-- Note that start/stop must occur in pairs, and it will be a runtime error +-- if you mess this up. Use 'toCmdDesc' if you want to check all parts +-- of your 'CmdParser' without providing inputs that provide 100% coverage. reorderStart :: CmdParser out () reorderStart = liftAp $ CmdParserReorderStart () +-- | See 'reorderStart' reorderStop :: CmdParser out () reorderStop = liftAp $ CmdParserReorderStop () diff --git a/src/UI/Butcher/Internal/ApplicativeTypes.hs b/src/UI/Butcher/Internal/ApplicativeTypes.hs index bdb25bf..b28c963 100644 --- a/src/UI/Butcher/Internal/ApplicativeTypes.hs +++ b/src/UI/Butcher/Internal/ApplicativeTypes.hs @@ -66,6 +66,8 @@ data CmdParserF out a | CmdParserReorderStart a | CmdParserReorderStop a +-- | The CmdParser monad type. It is a free applicative over some functor but +-- users of butcher don't need to know more than that 'CmdParser' is a 'Monad'. type CmdParser out = Ap (CmdParserF out) data EnrichedCmdParserF s out a diff --git a/src/UI/Butcher/Internal/CommonTypes.hs b/src/UI/Butcher/Internal/CommonTypes.hs index 6a01699..caa3bd9 100644 --- a/src/UI/Butcher/Internal/CommonTypes.hs +++ b/src/UI/Butcher/Internal/CommonTypes.hs @@ -64,6 +64,9 @@ data ManyUpperBound | ManyUpperBoundN deriving Eq +-- | Flag for command visibility. Hidden commands will not show up in generated +-- help documents or listed as alternatives for possible command completions +-- etc. data Visibility = Visible | Hidden deriving (Show, Eq) @@ -91,11 +94,8 @@ data Visibility = Visible | Hidden --------- -- | A representation/description of a command parser built via the --- 'CmdParser' monad. Can be transformed into a pretty Doc to display +-- @CmdParser@ monad. Can be transformed into a pretty Doc to display -- as usage/help via 'UI.Butcher.Monadic.Pretty.ppUsage' and related functions. --- --- Note that there is the '_cmd_out' accessor that contains @Maybe out@ which --- might be useful after successful parsing. data CommandDesc = CommandDesc { _cmd_mParent :: Maybe (Maybe String, CommandDesc) , _cmd_synopsis :: Maybe PP.Doc @@ -175,6 +175,11 @@ instance Show CommandDesc where -- +-- | Return type of the parsing function. This has a lot of fields, because +-- not only does it encode just parsing failure or success +-- (see @_ppi_value :: Either ParsingError (Maybe out)@) but also it encodes +-- information about partially succeeding parses. For example, the +-- '_ppi_inputSugg' field serves as a tab-completion value. data PartialParseInfo out = PartialParseInfo { _ppi_mainDesc :: CommandDesc , _ppi_localDesc :: CommandDesc diff --git a/src/UI/Butcher/Internal/Interactive.hs b/src/UI/Butcher/Internal/Interactive.hs index e5e9209..241a006 100644 --- a/src/UI/Butcher/Internal/Interactive.hs +++ b/src/UI/Butcher/Internal/Interactive.hs @@ -125,7 +125,7 @@ partDescComplsWithHelp mHelp = \case -- | Obtains a list of "expected"/potential strings for a command part --- described in the 'PartDesc'. In constrast to the 'simpleCompletion' +-- described in the 'PartDesc'. In constrast to the 'combinedCompletion' -- function this function does not take into account any current input, and -- consequently the output elements can in general not be appended to partial -- input to form valid input. @@ -148,7 +148,7 @@ partDescStrings = \case -- | Obtains a list of "expected"/potential strings for a command part --- described in the 'PartDesc'. In constrast to the 'simpleCompletion' +-- described in the 'PartDesc'. In constrast to the 'combinedCompletion' -- function this function does not take into account any current input, and -- consequently the output elements can in general not be appended to partial -- input to form valid input. diff --git a/src/UI/Butcher/Internal/Monadic.hs b/src/UI/Butcher/Internal/Monadic.hs index 7c7c17e..7a04500 100644 --- a/src/UI/Butcher/Internal/Monadic.hs +++ b/src/UI/Butcher/Internal/Monadic.hs @@ -29,10 +29,6 @@ module UI.Butcher.Internal.Monadic , reorderStop , toCmdDesc , traverseBarbie - -- , runCmdParser - -- , runCmdParserA - -- , runCmdParserCore - -- , runCmdParserCoreA , runCmdParserCoreFromDesc , runCmdParserCoreFromDescA , mapOut @@ -109,7 +105,7 @@ mModify f = mGet >>= mSet . f -- be the implicit top-level command. -- -- Adding a second synopsis will overwrite a previous synopsis; --- 'checkCmdParser' will check that you don't (accidentally) do this however. +-- 'toCmdDesc' will check that you don't (accidentally) do this however. addCmdSynopsis :: String -> CmdParser f out () addCmdSynopsis s = liftF $ CmdParserSynopsis s () @@ -117,7 +113,7 @@ addCmdSynopsis s = liftF $ CmdParserSynopsis s () -- will be the implicit top-level command. -- -- Adding a second document will overwrite a previous document; --- 'checkCmdParser' will check that you don't (accidentally) do this however. +-- 'toCmdDesc' will check that you don't (accidentally) do this however. addCmdHelp :: PP.Doc -> CmdParser f out () addCmdHelp s = liftF $ CmdParserHelp s () @@ -285,7 +281,7 @@ addCmdImpl o = liftF $ CmdParserImpl o () -- be unexpected because params may match on any input. -- -- Note that start/stop must occur in pairs, and it will be a runtime error --- if you mess this up. Use 'checkCmdParser' if you want to check all parts +-- if you mess this up. Use 'toCmdDesc' if you want to check all parts -- of your 'CmdParser' without providing inputs that provide 100% coverage. reorderStart :: CmdParser f out () reorderStart = liftF $ CmdParserReorderStart () @@ -294,8 +290,10 @@ reorderStart = liftF $ CmdParserReorderStart () reorderStop :: CmdParser f out () reorderStop = liftF $ CmdParserReorderStop () --- | Takes a barbie over a parser and returns a parser that returns parsed --- values, in the same structure. +-- | If you have a higher-kinded config type (let's assume it is a plain +-- record) then this turns a record whose fields are @CmdParser@s over +-- different values into a CmdParser that returns a record with the parsed +-- values in the fields. traverseBarbie :: (Barbies.BareB c, Barbies.TraversableB (c Barbies.Covered)) => c Barbies.Covered (CmdParser f out) @@ -498,70 +496,21 @@ data CoreInterpreterState f out = CoreInterpreterState } -{- -runCmdParser - :: forall out - . Maybe String -- ^ top-level command name - -> Input - -> CmdParser Identity out () - -> Either ParsingError (Maybe out) -runCmdParser mTopLevel initialInput initialParser = - let (_, _, _, r) = runCmdParserCore mTopLevel initialInput initialParser - in r - -runCmdParserA - :: forall f out - . Applicative f - => Maybe String -- ^ top-level command name - -> Input - -> CmdParser f out () - -> f (Either ParsingError (Maybe out)) -runCmdParserA mTopLevel initialInput initialParser = - let f (_, _, r) = r - in f <$> snd (runCmdParserCoreA mTopLevel initialInput initialParser) - - -runCmdParserCore - :: forall out - . Maybe String -- ^ top-level command name - -> Input - -> CmdParser Identity out () - -> (CommandDesc, CommandDesc, Input, Either ParsingError (Maybe out)) -runCmdParserCore mTopLevel initialInput initialParser = - let topDesc = case toCmdDesc mTopLevel initialParser of - Left err -> error err - Right d -> d - (finalDesc, finalInput, result) = - runCmdParserCoreFromDesc topDesc initialInput initialParser - in (topDesc, finalDesc, finalInput, result) - -runCmdParserCoreA - :: forall f out - . Applicative f - => Maybe String -- ^ top-level command name - -> Input - -> CmdParser f out () - -> (CommandDesc, f (CommandDesc, Input, Either ParsingError (Maybe out))) -runCmdParserCoreA mTopLevel initialInput initialParser = - let topDesc = case toCmdDesc mTopLevel initialParser of - Left err -> error err - Right d -> d - in (topDesc, runCmdParserCoreFromDescA topDesc initialInput initialParser) --} - -- | Run a @CmdParser@ on the given input, returning: -- -- a) A @CommandDesc ()@ that accurately represents the subcommand that was -- reached, even if parsing failed. Because this is returned always, the -- argument is @()@ because "out" requires a successful parse. -- --- b) Either an error or the result of a successful parse, including a proper +-- b) The remaining input, i.e. the left-over part that did not parse +-- successfully. +-- For some input "myprog foo bar -v --wrong" where parsing fails at +-- "--wrong", this will contain the full "-v --wrong". Useful for +-- interactive feedback stuff. + +-- c) Either an error or the result of a successful parse, including a proper -- "CommandDesc out" from which an "out" can be extracted (presuming that -- the command has an implementation). --- | Like 'runCmdParser', but also returning all input after the last --- successfully parsed subcommand. E.g. for some input --- "myprog foo bar -v --wrong" where parsing fails at "--wrong", this will --- contain the full "-v --wrong". Useful for interactive feedback stuff. runCmdParserCoreFromDesc :: CommandDesc -- ^ cached desc -> Input -- ^ input to be processed diff --git a/src/UI/Butcher/Monadic.hs b/src/UI/Butcher/Monadic.hs index a4ddb98..83b37db 100644 --- a/src/UI/Butcher/Monadic.hs +++ b/src/UI/Butcher/Monadic.hs @@ -98,6 +98,10 @@ runCmdParserSimpleString s p = case toCmdDesc Nothing p of maybe (Left "command has no implementation") Right $ outM +-- | Runs a 'CmdParser' on the given 'Input', returning the 'PartialParseInfo' +-- struct that encodes both general success/failure and that has additional +-- fields that are useful for interactive help or feedback to the user +-- (think something like "did you mean to use command foo?"). runCmdParser :: forall out . Maybe String -- ^ top-level command name @@ -110,6 +114,13 @@ runCmdParser mTopLevel input parser = Right d -> d in runCmdParserFromDesc topDesc input parser +-- | Runs a parser given 'Input', a 'CmdParser' and the 'CommandDesc' that was +-- derived from the 'CmdParser' using 'toCmdDesc'. +-- 'runCmdParser' will do both steps, but this is useful +-- a) if the 'CommandDesc' can be re-used because the 'Input' changes but the +-- 'CmdParser' does not. +-- b) because in some (rare) cases 'toCmdDesc' may fail, and calling it +-- explicitly allows handling that case properly. runCmdParserFromDesc :: forall out . CommandDesc @@ -121,6 +132,7 @@ runCmdParserFromDesc topDesc input parser = runCmdParserCoreFromDesc topDesc input parser in combinedCompletion input topDesc localDesc remainingInput result +-- | The Applicative-enabled version of 'runCmdParser'. runCmdParserA :: forall f out . Applicative f @@ -134,6 +146,7 @@ runCmdParserA mTopLevel input parser = Right d -> d in runCmdParserAFromDesc topDesc input parser +-- | The Applicative-enabled version of 'runCmdParserA'. runCmdParserAFromDesc :: forall f out . Applicative f diff --git a/src/UI/Butcher/Monadic/Command.hs b/src/UI/Butcher/Monadic/Command.hs index 6521f21..dbb1d89 100644 --- a/src/UI/Butcher/Monadic/Command.hs +++ b/src/UI/Butcher/Monadic/Command.hs @@ -12,7 +12,7 @@ -- -- > return () -- --- But not very interesting - you won't get an 'out' value from this (e.g. an +-- But not very interesting - you won't get an @out@ value from this (e.g. an -- IO-action to execute) when this matches (on the empty input). -- -- > do diff --git a/src/UI/Butcher/Monadic/Flag.hs b/src/UI/Butcher/Monadic/Flag.hs index dd0d58f..0fc30cb 100644 --- a/src/UI/Butcher/Monadic/Flag.hs +++ b/src/UI/Butcher/Monadic/Flag.hs @@ -17,8 +17,8 @@ module UI.Butcher.Monadic.Flag , flagDefault , flagHidden , addSimpleBoolFlag + , addSimpleBoolFlagA , addSimpleCountFlag - , addSimpleFlagA , addFlagReadParam , addFlagReadParams -- , addFlagReadParamA @@ -132,14 +132,14 @@ addSimpleBoolFlag addSimpleBoolFlag shorts longs flag = addSimpleBoolFlagAll shorts longs flag (pure ()) --- | Applicative-enabled version of 'addSimpleFlag' -addSimpleFlagA +-- | Applicative-enabled version of 'addSimpleBoolFlag' +addSimpleBoolFlagA :: String -- ^ short flag chars, i.e. "v" for -v -> [String] -- ^ list of long names, e.g. ["verbose"] -> Flag Void -- ^ properties -> f () -- ^ action to execute whenever this matches -> CmdParser f out () -addSimpleFlagA shorts longs flag act = +addSimpleBoolFlagA shorts longs flag act = void $ addSimpleBoolFlagAll shorts longs flag act addSimpleBoolFlagAll diff --git a/src/UI/Butcher/Monadic/Param.hs b/src/UI/Butcher/Monadic/Param.hs index c3b920c..0afd84b 100644 --- a/src/UI/Butcher/Monadic/Param.hs +++ b/src/UI/Butcher/Monadic/Param.hs @@ -21,13 +21,6 @@ module UI.Butcher.Monadic.Param , addParamNoFlagStrings , addParamRestOfInput , addParamRestOfInputRaw - , -- * Deprecated for more consistent naming - addReadParam - , addReadParamOpt - , addStringParam - , addStringParamOpt - , addStringParams - , addRestOfInputStringParam ) where @@ -107,15 +100,7 @@ addParamRead => String -- ^ paramater name, for use in usage/help texts -> Param a -- ^ properties -> CmdParser f out a -addParamRead = addReadParam -{-# DEPRECATED addReadParam "use 'addParamRead'" #-} -addReadParam - :: forall f out a - . (Applicative f, Typeable a, Show a, Text.Read.Read a) - => String -- ^ paramater name, for use in usage/help texts - -> Param a -- ^ properties - -> CmdParser f out a -addReadParam name par = addCmdPart desc parseF +addParamRead name par = addCmdPart desc parseF where desc :: PartDesc desc = @@ -136,15 +121,7 @@ addParamReadOpt => String -- ^ paramater name, for use in usage/help texts -> Param a -- ^ properties -> CmdParser f out (Maybe a) -addParamReadOpt = addReadParamOpt -{-# DEPRECATED addReadParamOpt "use 'addParamReadOpt'" #-} -addReadParamOpt - :: forall f out a - . (Applicative f, Typeable a, Text.Read.Read a) - => String -- ^ paramater name, for use in usage/help texts - -> Param a -- ^ properties - -> CmdParser f out (Maybe a) -addReadParamOpt name par = addCmdPart desc parseF +addParamReadOpt name par = addCmdPart desc parseF where desc :: PartDesc desc = @@ -167,15 +144,7 @@ addParamString => String -> Param String -> CmdParser f out String -addParamString = addStringParam -{-# DEPRECATED addStringParam "use 'addParamString'" #-} -addStringParam - :: forall f out - . (Applicative f) - => String - -> Param String - -> CmdParser f out String -addStringParam name par = addCmdPartInp desc parseF +addParamString name par = addCmdPartInp desc parseF where desc :: PartDesc desc = @@ -200,15 +169,7 @@ addParamStringOpt => String -> Param Void -> CmdParser f out (Maybe String) -addParamStringOpt = addStringParamOpt -{-# DEPRECATED addStringParamOpt "use 'addParamStringOpt'" #-} -addStringParamOpt - :: forall f out - . (Applicative f) - => String - -> Param Void - -> CmdParser f out (Maybe String) -addStringParamOpt name par = addCmdPartInp desc parseF +addParamStringOpt name par = addCmdPartInp desc parseF where desc :: PartDesc desc = @@ -235,15 +196,7 @@ addParamStrings => String -> Param Void -> CmdParser f out [String] -addParamStrings = addStringParams -{-# DEPRECATED addStringParams "use 'addParamStrings'" #-} -addStringParams - :: forall f out - . (Applicative f) - => String - -> Param Void - -> CmdParser f out [String] -addStringParams name par = addCmdPartManyInp ManyUpperBoundN desc parseF +addParamStrings name par = addCmdPartManyInp ManyUpperBoundN desc parseF where desc :: PartDesc desc = @@ -345,15 +298,7 @@ addParamRestOfInput => String -> Param Void -> CmdParser f out String -addParamRestOfInput = addRestOfInputStringParam -{-# DEPRECATED addRestOfInputStringParam "use 'addParamRestOfInput'" #-} -addRestOfInputStringParam - :: forall f out - . (Applicative f) - => String - -> Param Void - -> CmdParser f out String -addRestOfInputStringParam name par = addCmdPartInp desc parseF +addParamRestOfInput name par = addCmdPartInp desc parseF where desc :: PartDesc desc =