packages feed

optparse-applicative 0.17.1.0 → 0.18.0.0

raw patch · 14 files changed

+165/−85 lines, 14 filesdep +prettyprinterdep +prettyprinter-ansi-terminaldep −ansi-wl-pprintdep ~base

Dependencies added: prettyprinter, prettyprinter-ansi-terminal

Dependencies removed: ansi-wl-pprint

Dependency ranges changed: base

Files

CHANGELOG.md view
@@ -1,5 +1,24 @@-## Version 0.17.1.0 (21 May 2023)+## Version 0.18.0.0 (22 May 2023) +- Move to 'prettyprinter` library for pretty printing.++  This is a potentially breaking change when one uses the '*Doc' family of functions+  (like `headerDoc`) from `Options.Applicative`. However, as versions of+  'ansi-wl-pprint > 1.0' export a compatible `Doc` type, this can be mitigated by+  using a recent version.++  One can also either import directly from `Options.Applicative.Help` or from the+  `Prettyprinter` module of 'prettyprinter'.++- Allow commands to be disambiguated in a similar manner to flags when the+  `disambiguate` modifier is used.++  This is a potentially breaking change as the internal `CmdReader` constructor+  has been adapted so it is able to be inspected to a greater degree to support+  finding prefix matches.++## Version 0.17.1.0 (22 May 2023)+ - Widen bounds for `ansi-wl-pprint`. This supports the use of `prettyprinter`   in a non-breaking way, as the `ansi-wl-pprint > 1.0` support the newer   library.@@ -11,6 +30,8 @@ - Add `simpleVersioner` utility for adding a '--version' option to a parser.  - Improve documentation.++- Drop support for GHC 7.0 and 7.2.  ## Version 0.17.0.0 (1 Feb 2022)
optparse-applicative.cabal view
@@ -1,5 +1,5 @@ name:                optparse-applicative-version:             0.17.1.0+version:             0.18.0.0 synopsis:            Utilities and combinators for parsing command line options description:     optparse-applicative is a haskell library for parsing options@@ -100,10 +100,11 @@                      , Options.Applicative.Types                      , Options.Applicative.Internal -  build-depends:       base                            == 4.*+  build-depends:       base                            >= 4.5 && < 5                      , transformers                    >= 0.2 && < 0.7                      , transformers-compat             >= 0.3 && < 0.8-                     , ansi-wl-pprint                  >= 0.6.8 && < 1.1+                     , prettyprinter                   >= 1.7 && < 1.8+                     , prettyprinter-ansi-terminal     >= 1.1 && < 1.2    if flag(process)     build-depends:     process                         >= 1.0 && < 1.7
src/Options/Applicative/BashCompletion.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -- | You don't need to import this module to enable bash completion. -- -- See@@ -114,11 +113,11 @@         -> return []          | otherwise         -> run_completer (crCompleter rdr)-      CmdReader _ ns p+      CmdReader _ ns          | argumentIsUnreachable reachability         -> return []          | otherwise-        -> return . add_cmd_help p $ filter_names ns+        -> return . with_cmd_help $ filter (is_completion . fst) ns      -- When doing enriched completions, add any help specified     -- to the completion variables (tab separated).@@ -133,29 +132,27 @@      -- When doing enriched completions, add the command description     -- to the completion variables (tab separated).-    add_cmd_help :: Functor f => (String -> Maybe (ParserInfo a)) -> f String -> f String-    add_cmd_help p = case richness of-      Standard ->-        id-      Enriched _ len ->-        fmap $ \cmd ->-          let h = p cmd >>= unChunk . infoProgDesc-          in  maybe cmd (\h' -> cmd ++ "\t" ++ render_line len h') h+    with_cmd_help :: Functor f => f (String, ParserInfo a) -> f String+    with_cmd_help =+      case richness of+        Standard ->+          fmap fst+        Enriched _ len ->+          fmap $ \(cmd, cmdInfo) ->+            let h = unChunk (infoProgDesc cmdInfo)+            in  maybe cmd (\h' -> cmd ++ "\t" ++ render_line len h') h      show_names :: [OptName] -> [String]-    show_names = filter_names . map showOption+    show_names = filter is_completion . map showOption      -- We only want to show a single line in the completion results description.     -- If there was a line break, it would come across as a different completion     -- possibility.     render_line :: Int -> Doc -> String-    render_line len doc = case lines (displayS (renderPretty 1 len doc) "") of+    render_line len doc = case lines (prettyString 1 len doc) of       [] -> ""       [x] -> x       x : _ -> x ++ "..."--    filter_names :: [String] -> [String]-    filter_names = filter is_completion      run_completer :: Completer -> IO [String]     run_completer c = runCompleter c (fromMaybe "" (listToMaybe ws''))
src/Options/Applicative/Builder.hs view
@@ -282,8 +282,8 @@ subparser m = mkParser d g rdr   where     Mod _ d g = metavar "COMMAND" `mappend` m-    (groupName, cmds, subs) = mkCommand m-    rdr = CmdReader groupName cmds subs+    (groupName, cmds) = mkCommand m+    rdr = CmdReader groupName cmds  -- | Builder for an argument parser. argument :: ReadM a -> Mod ArgumentFields a -> Parser a
src/Options/Applicative/Builder/Internal.hs view
@@ -152,8 +152,8 @@   , propShowGlobal = True   } -mkCommand :: Mod CommandFields a -> (Maybe String, [String], String -> Maybe (ParserInfo a))-mkCommand m = (group, map fst cmds, (`lookup` cmds))+mkCommand :: Mod CommandFields a -> (Maybe String, [(String, ParserInfo a)])+mkCommand m = (group, cmds)   where     Mod f _ _ = m     CommandFields cmds group = f (CommandFields [] Nothing)
src/Options/Applicative/Common.hs view
@@ -166,23 +166,28 @@   searchParser $ \opt -> do     when (isArg (optMain opt)) cut     case optMain opt of-      CmdReader _ _ f ->-        case (f arg, prefBacktrack prefs) of-          (Just subp, NoBacktrack) -> lift $ do+      CmdReader _ cs -> do+        subp <- hoistList (cmdMatches cs)+        case prefBacktrack prefs of+          NoBacktrack -> lift $ do             args <- get <* put []             fmap pure . lift $ enterContext arg subp *> runParserInfo subp args <* exitContext -          (Just subp, Backtrack) -> fmap pure . lift . StateT $ \args ->+          Backtrack -> fmap pure . lift . StateT $ \args ->             enterContext arg subp *> runParser (infoPolicy subp) CmdStart (infoParser subp) args <* exitContext -          (Just subp, SubparserInline) -> lift $ do+          SubparserInline -> lift $ do             lift $ enterContext arg subp             return $ infoParser subp -          (Nothing, _)  -> mzero       ArgReader rdr ->         fmap pure . lift . lift $ runReadM (crReader rdr) arg       _ -> mzero++  where+    cmdMatches cs+      | prefDisambiguate prefs = snd <$> filter (isPrefixOf arg . fst) cs+      | otherwise = maybeToList (lookup arg cs)  stepParser :: MonadP m => ParserPrefs -> ArgPolicy -> String            -> Parser a -> NondetT (StateT Args m) (Parser a)
src/Options/Applicative/Extra.hs view
@@ -89,8 +89,8 @@ hsubparser m = mkParser d g rdr   where     Mod _ d g = metavar "COMMAND" `mappend` m-    (groupName, cmds, subs) = mkCommand m-    rdr = CmdReader groupName cmds (fmap add_helper . subs)+    (groupName, cmds) = mkCommand m+    rdr = CmdReader groupName ((fmap . fmap) add_helper cmds)     add_helper pinfo = pinfo       { infoParser = infoParser pinfo <**> helper } @@ -317,10 +317,10 @@               OptReader ns _ _ -> fmap showOption ns               FlagReader ns _  -> fmap showOption ns               ArgReader _      -> []-              CmdReader _ ns _  | argumentIsUnreachable reachability+              CmdReader _ ns    | argumentIsUnreachable reachability                                -> []                                 | otherwise-                               -> ns+                               -> fst <$> ns       _         -> mempty
src/Options/Applicative/Help/Chunk.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} module Options.Applicative.Help.Chunk   ( Chunk(..)   , chunked@@ -116,7 +115,7 @@ -- > extractChunk . stringChunk = string stringChunk :: String -> Chunk Doc stringChunk "" = mempty-stringChunk s = pure (string s)+stringChunk s = pure (pretty s)  -- | Convert a paragraph into a 'Chunk'.  The resulting chunk is composed by the -- words of the original paragraph separated by softlines, so it will be
src/Options/Applicative/Help/Core.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} module Options.Applicative.Help.Core (   cmdDesc,   briefDesc,@@ -25,7 +24,7 @@ import Data.Function (on) import Data.List (sort, intersperse, groupBy) import Data.Foldable (any, foldl')-import Data.Maybe (catMaybes, fromMaybe, maybeToList)+import Data.Maybe (catMaybes, fromMaybe) #if !MIN_VERSION_base(4,8,0) import Data.Monoid (mempty) #endif@@ -58,7 +57,7 @@       meta =         stringChunk $ optMetaVar opt       descs =-        map (string . showOption) names+        map (pretty . showOption) names       descriptions =         listToChunk (intersperse (descSep style) descs)       desc@@ -95,12 +94,11 @@   where     desc _ opt =       case optMain opt of-        CmdReader gn cmds p ->+        CmdReader gn cmds ->           (,) gn $             tabulate (prefTabulateFill pprefs)-              [ (string cmd, align (extractChunk d))-                | cmd <- reverse cmds,-                  d <- maybeToList . fmap infoProgDesc $ p cmd+              [ (pretty nm, align (extractChunk (infoProgDesc cmd)))+              | (nm, cmd) <- reverse cmds               ]         _ -> mempty @@ -128,7 +126,7 @@       | otherwise =         filterOptional     style = OptDescStyle-      { descSep = string "|",+      { descSep = pretty '|',         descHidden = False,         descGlobal = False       }@@ -205,9 +203,9 @@         n = fst $ optDesc pprefs style info opt         h = optHelp opt         hdef = Chunk . fmap show_def . optShowDefault $ opt-        show_def s = parens (string "default:" <+> string s)+        show_def s = parens (pretty "default:" <+> pretty s)     style = OptDescStyle-      { descSep = string ",",+      { descSep = pretty ',',         descHidden = True,         descGlobal = global       }@@ -252,7 +250,7 @@     group_title _ = mempty      with_title :: String -> Chunk Doc -> Chunk Doc-    with_title title = fmap (string title .$.)+    with_title title = fmap (pretty title .$.)   parserGlobals :: ParserPrefs -> Parser a -> ParserHelp@@ -268,8 +266,8 @@ parserUsage pprefs p progn =   group $     hsep-      [ string "Usage:",-        string progn,+      [ pretty "Usage:",+        pretty progn,         hangAtIfOver 9 35 (extractChunk (briefDesc pprefs p))       ]
src/Options/Applicative/Help/Pretty.hs view
@@ -1,40 +1,41 @@ {-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} module Options.Applicative.Help.Pretty-  ( module Text.PrettyPrint.ANSI.Leijen+  ( module Prettyprinter+  , module Prettyprinter.Render.Terminal   , Doc-  , indent-  , renderPretty-  , displayS+  , SimpleDoc+   , (.$.)+  , (</>)+   , groupOrNestLine   , altSep   , hangAtIfOver++  , prettyString   ) where  #if !MIN_VERSION_base(4,11,0)-import           Data.Semigroup ((<>))+import           Data.Semigroup ((<>), mempty) #endif -import           Text.PrettyPrint.ANSI.Leijen hiding (Doc, (<$>), (<>), columns, indent, renderPretty, displayS)-import qualified Text.PrettyPrint.ANSI.Leijen as PP+import           Prettyprinter hiding (Doc)+import qualified Prettyprinter as PP+import qualified Prettyprinter.Render.String as PP+import           Prettyprinter.Render.Terminal  import           Prelude -type Doc = PP.Doc--indent :: Int -> PP.Doc -> PP.Doc-indent = PP.indent--renderPretty :: Float -> Int -> PP.Doc -> SimpleDoc-renderPretty = PP.renderPretty+type Doc = PP.Doc Prettyprinter.Render.Terminal.AnsiStyle+type SimpleDoc = SimpleDocStream AnsiStyle -displayS :: SimpleDoc -> ShowS-displayS = PP.displayS+linebreak :: Doc+linebreak = flatAlt line mempty  (.$.) :: Doc -> Doc -> Doc-(.$.) = (PP.<$>)-+x .$. y = x <> line <> y+(</>) :: Doc -> Doc -> Doc+x </> y = x <> softline <> y  -- | Apply the function if we're not at the --   start of our nesting level.@@ -58,7 +59,6 @@         then f doc         else g doc - -- | Render flattened text on this line, or start --   a new line before rendering any text. --@@ -81,7 +81,7 @@ --   next line. altSep :: Doc -> Doc -> Doc altSep x y =-  group (x <+> char '|' <> line) <//> y+  group (x <+> pretty '|' <> line) <> group linebreak <>  y   -- | Printer hacks to get nice indentation for long commands@@ -102,3 +102,18 @@       align d     else       linebreak <> ifAtRoot (indent i) d+++renderPretty :: Double -> Int -> Doc -> SimpleDocStream AnsiStyle+renderPretty ribbonFraction lineWidth+  = layoutSmart LayoutOptions+      { layoutPageWidth = AvailablePerLine lineWidth ribbonFraction }++prettyString :: Double -> Int -> Doc -> String+prettyString ribbonFraction lineWidth+  = streamToString+  . renderPretty ribbonFraction lineWidth++streamToString :: SimpleDocStream AnsiStyle -> String+streamToString stream =+  PP.renderShowS stream ""
src/Options/Applicative/Help/Types.hs view
@@ -42,6 +42,5 @@ -- | Convert a help text to 'String'. renderHelp :: Int -> ParserHelp -> String renderHelp cols-  = (`displayS` "")-  . renderPretty 1.0 cols+  = prettyString 1.0 cols   . helpText
src/Options/Applicative/Internal.hs view
@@ -18,6 +18,7 @@   , ListT   , takeListT   , runListT+  , hoistList    , NondetT   , cut@@ -172,9 +173,6 @@ bimapTStep _ _ TNil = TNil bimapTStep f g (TCons a x) = TCons (f a) (g x) -hoistList :: Monad m => [a] -> ListT m a-hoistList = foldr (\x xt -> ListT (return (TCons x xt))) mzero- takeListT :: Monad m => Int -> ListT m a -> ListT m a takeListT 0 = const mzero takeListT n = ListT . liftM (bimapTStep id (takeListT (n - 1))) . stepListT@@ -192,7 +190,7 @@          . stepListT  instance Monad m => Applicative (ListT m) where-  pure = hoistList . pure+  pure a = ListT (return (TCons a mzero))   (<*>) = ap  instance Monad m => Monad (ListT m) where@@ -263,3 +261,8 @@   return $ case xs' of     [x] -> Just x     _   -> Nothing++hoistList :: Alternative m => [a] -> m a+hoistList = foldr cons empty+  where+    cons x xs = pure x <|> xs
src/Options/Applicative/Types.hs view
@@ -242,14 +242,14 @@   -- ^ flag reader   | ArgReader (CReader a)   -- ^ argument reader-  | CmdReader (Maybe String) [String] (String -> Maybe (ParserInfo a))+  | CmdReader (Maybe String) [(String, ParserInfo a)]   -- ^ command reader  instance Functor OptReader where   fmap f (OptReader ns cr e) = OptReader ns (fmap f cr) e   fmap f (FlagReader ns x) = FlagReader ns (f x)   fmap f (ArgReader cr) = ArgReader (fmap f cr)-  fmap f (CmdReader n cs g) = CmdReader n cs ((fmap . fmap) f . g)+  fmap f (CmdReader n cs) = CmdReader n ((fmap . fmap . fmap) f cs)  -- | A @Parser a@ is an option parser returning a value of type 'a'. data Parser a
tests/test.hs view
@@ -28,7 +28,7 @@   import qualified Options.Applicative.Help as H-import           Options.Applicative.Help.Pretty (Doc, SimpleDoc(..))+import           Options.Applicative.Help.Pretty (Doc) import qualified Options.Applicative.Help.Pretty as Doc import           Options.Applicative.Help.Chunk import           Options.Applicative.Help.Levenshtein@@ -318,6 +318,49 @@       result = execParserPure (prefs disambiguate) i ["--ba"]   in  assertError result (\_ -> property succeeded) ++prop_disambiguate_in_same_subparsers :: Property+prop_disambiguate_in_same_subparsers = once $+  let p0 = subparser (command "oranges" (info (pure "oranges") idm) <> command "apples" (info (pure "apples") idm) <> metavar "B")+      i = info (p0 <**> helper) idm+      result = execParserPure (prefs disambiguate) i ["orang"]+  in  assertResult result ((===) "oranges")++prop_disambiguate_commands_in_separate_subparsers :: Property+prop_disambiguate_commands_in_separate_subparsers = once $+  let p2 = subparser (command "oranges" (info (pure "oranges") idm)  <> metavar "B")+      p1 = subparser (command "apples" (info (pure "apples") idm)  <> metavar "C")+      p0 = p1 <|> p2+      i = info (p0 <**> helper) idm+      result = execParserPure (prefs disambiguate) i ["orang"]+  in  assertResult result ((===) "oranges")++prop_fail_ambiguous_commands_in_same_subparser :: Property+prop_fail_ambiguous_commands_in_same_subparser = once $+  let p0 = subparser (command "oranges" (info (pure ()) idm) <> command "orangutans" (info (pure ()) idm) <> metavar "B")+      i = info (p0 <**> helper) idm+      result = execParserPure (prefs disambiguate) i ["orang"]+  in  assertError result (\_ -> property succeeded)++prop_fail_ambiguous_commands_in_separate_subparser :: Property+prop_fail_ambiguous_commands_in_separate_subparser = once $+  let p2 = subparser (command "oranges" (info (pure ()) idm)  <> metavar "B")+      p1 = subparser (command "orangutans" (info (pure ()) idm)  <> metavar "C")+      p0 = p1 <|> p2+      i = info (p0 <**> helper) idm+      result = execParserPure (prefs disambiguate) i ["orang"]+  in  assertError result (\_ -> property succeeded)++prop_without_disambiguation_same_named_commands_should_parse_in_order :: Property+prop_without_disambiguation_same_named_commands_should_parse_in_order = once $+  let p3 = subparser (command "b" (info (pure ()) idm)  <> metavar "B")+      p2 = subparser (command "a" (info (pure ()) idm)  <> metavar "B")+      p1 = subparser (command "a" (info (pure ()) idm)  <> metavar "C")+      p0 = (,,) <$> p1 <*> p2 <*> p3+      i = info (p0 <**> helper) idm+      result = execParserPure defaultPrefs i ["b", "a", "a"]+  in  assertResult result ((===) ((), (), ()))+ prop_completion :: Property prop_completion = once . ioProperty $   let p = (,)@@ -903,15 +946,14 @@             , "to fit the size of the terminal" ]) )   in checkHelpTextWith ExitSuccess (prefs (columns 50)) "formatting-long-subcommand" i ["hello-very-long-sub", "--help"] - ---  deriving instance Arbitrary a => Arbitrary (Chunk a)  -equalDocs :: Float -> Int -> Doc -> Doc -> Property-equalDocs f w d1 d2 = Doc.displayS (Doc.renderPretty f w d1) ""-                  === Doc.displayS (Doc.renderPretty f w d2) ""+equalDocs :: Double -> Int -> Doc -> Doc -> Property+equalDocs f w d1 d2 = Doc.prettyString f w d1+                  === Doc.prettyString f w d2  prop_listToChunk_1 :: [String] -> Property prop_listToChunk_1 xs = isEmpty (listToChunk xs) === null xs@@ -925,10 +967,10 @@ prop_extractChunk_2 :: Chunk String -> Property prop_extractChunk_2 x = extractChunk (fmap pure x) === x -prop_stringChunk_1 :: Positive Float -> Positive Int -> String -> Property+prop_stringChunk_1 :: Positive Double -> Positive Int -> String -> Property prop_stringChunk_1 (Positive f) (Positive w) s =   equalDocs f w (extractChunk (stringChunk s))-                (Doc.string s)+                (Doc.pretty s)  prop_stringChunk_2 :: String -> Property prop_stringChunk_2 s = isEmpty (stringChunk s) === null s