effectful-cli 0.2.2.0 → 0.2.3.0

raw patch · 5 files changed

+150/−10 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• effectful-cli.cabal +1/−1
• src/Data/CLI/Args.hs +25/−5
• src/Data/CLI/Impl.hs +105/−3
• test/Spec.hs +13/−1

@@ -1,3 +1,9 @@+## [2.3.0](https://github.com/haskell-github-trust/effectful-cli/compare/2.2.0...2.3.0) (2026-10-28)++### Features++* add color to helper texts ([c215283](https://github.com/haskell-github-trust/effectful-cli/commit/c215283d77c51d7bf4921f38e003e546e7cac8f6))+ ## [2.2.0](https://github.com/haskell-github-trust/effectful-cli/compare/2.1.0...2.2.0) (2026-10-27)  ### Features

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           effectful-cli-version:        0.2.2.0+version:        0.2.3.0 synopsis:       CLI helpers for the effectful ecosystem description:    Please see the README at https://github.com/haskell-github-trust/effectful-cli category:       CLI

@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -- | Global command-line options shared by all commands. module Data.CLI.Args (   CLIArgs (..),@@ -5,12 +7,14 @@   showVersion,   versionOrCommand,   argParser,+  argParserWith, ) where  import Control.Monad.Logger (LogLevel (..))-import Data.List (intercalate)+import Data.CLI.Impl (HelpStyle (..), defaultHelpStyle, styled) import Data.Maybe (fromMaybe) import Options.Applicative+import Options.Applicative.Help.Pretty (punctuate, (<+>))  -- | Parsed global options, with the command of type @c@. --@@ -67,7 +71,13 @@ -- -- @since 0.1.0.0 argParser :: Parser c -> Parser (CLIArgs c)-argParser cmdParser =+argParser = argParserWith defaultHelpStyle++-- | 'argParser' with a custom t'HelpStyle'.+--+-- @since 0.2.2.0+argParserWith :: HelpStyle -> Parser c -> Parser (CLIArgs c)+argParserWith s cmdParser =   CLIArgs     <$> optional       ( option@@ -75,12 +85,20 @@           ( short 'l'               <> long "log-level"               <> metavar "LEVEL"-              <> help ("Log level: " <> intercalate ", " (fmap fst logLevels))+              <> helpDoc (Just ("Log level:" <+> mconcat (punctuate ", " (fmap (val . fst) logLevels))))           )       )-    <*> switch (short 'd' <> long "debug" <> help "Enable debug output (overruled by -l)")+    <*> switch+      ( short 'd'+          <> long "debug"+          <> helpDoc (Just ("Enable debug output (overruled by" <+> val "-l" <> ")"))+      )     <*> switch (short 'y' <> long "yes" <> help "Auto-accept all prompts")-    <*> switch (short 'n' <> long "no" <> help "Auto-decline all prompts (overrides -y/--yes)")+    <*> switch+      ( short 'n'+          <> long "no"+          <> helpDoc (Just ("Auto-decline all prompts (overrides" <+> val "-y/--yes" <> ")"))+      )     <*> optional       ( strOption           (short 'c' <> long "config" <> metavar "PATH" <> help "Path to the configuration file")@@ -90,3 +108,5 @@               <|> Right             <$> cmdParser         )+ where+  val = styled _styleValue s

@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -- | Helpers for building optparse-applicative parsers and subcommands. module Data.CLI.Impl (   unboundEnumError,@@ -11,6 +13,13 @@   mkCommand,   mkCommands,   usage,+  usageWith,+  HelpStyle (..),+  defaultHelpStyle,+  plainHelpStyle,+  styled,+  colorEnabled,+  execCLIParser, ) where  import Data.Bifunctor (first)@@ -21,9 +30,80 @@ import Data.UUID qualified as UUID import Data.Void (Void) import Options.Applicative+import Options.Applicative.Help.Pretty (+  AnsiStyle,+  Color (..),+  Doc,+  annotate,+  bold,+  color,+  pretty,+  unAnnotate,+  underlined,+  (<+>),+ )+import System.Environment (getArgs, lookupEnv)+import System.IO (hIsTerminalDevice, stderr, stdout) import Text.Megaparsec (Parsec, eof, errorBundlePretty, runParser) import Text.Printf (printf) +-- | ANSI styles applied to help texts.+--+-- @since 0.2.2.0+data HelpStyle = HelpStyle+  { _styleName :: AnsiStyle+  -- ^ program name in the header+  , _styleVersion :: AnsiStyle+  -- ^ version in the header+  , _styleValue :: AnsiStyle+  -- ^ accepted values and option references+  , _styleWarning :: AnsiStyle+  -- ^ dangerous behavior+  }++-- | Bold underlined name, green version, cyan values, bold red warnings.+--+-- @since 0.2.2.0+defaultHelpStyle :: HelpStyle+defaultHelpStyle = HelpStyle (bold <> underlined) (color Green) (color Cyan) (bold <> color Red)++-- | No styling.+--+-- @since 0.2.2.0+plainHelpStyle :: HelpStyle+plainHelpStyle = HelpStyle mempty mempty mempty mempty++-- | Render a string with the selected style of a t'HelpStyle'.+--+-- @since 0.2.2.0+styled :: (HelpStyle -> AnsiStyle) -> HelpStyle -> String -> Doc+styled f s+  | f s == mempty = pretty+  | otherwise = annotate (f s) . pretty++-- | Whether colors should be emitted: stdout and stderr are terminals and @NO_COLOR@ is unset or empty.+--+-- @since 0.2.2.0+colorEnabled :: IO Bool+colorEnabled = do+  noColor <- maybe False (not . null) <$> lookupEnv "NO_COLOR"+  ttys <- and <$> traverse hIsTerminalDevice [stdout, stderr]+  pure (ttys && not noColor)++-- | Like 'execParser', stripping help styles when 'colorEnabled' is false.+--+-- @since 0.2.2.0+execCLIParser :: ParserInfo a -> IO a+execCLIParser pinfo = do+  c <- colorEnabled+  res <- execParserPure defaultPrefs pinfo <$> getArgs+  handleParseResult (if c then res else strip res)+ where+  strip (Failure (ParserFailure f)) = Failure (ParserFailure (\p -> let (h, e, w) = f p in (plain h, e, w)))+  strip r = r+  plain (ParserHelp a b c d e f g h) = ParserHelp (u a) (u b) (u c) (u d) (u e) (u f) (u g) (u h)+  u = fmap unAnnotate+ -- | Error for 'succ' called on 'maxBound' of the named enum. -- -- @since 0.1.0.0@@ -63,7 +143,12 @@ -- -- @since 0.1.0.0 forceSwitch :: Parser Bool-forceSwitch = switch (short 'f' <> long "force" <> help "force unsafe behavior")+forceSwitch =+  switch+    ( short 'f'+        <> long "force"+        <> helpDoc (Just ("force" <+> styled _styleWarning defaultHelpStyle "unsafe" <+> "behavior"))+    )  -- | @-n@/@--noop@ switch for dry runs. --@@ -103,7 +188,24 @@ -- -- @since 0.1.0.0 usage :: String -> String -> String -> Parser a -> ParserInfo a-usage name version hdr p =+usage = usageWith defaultHelpStyle++-- | 'usage' with a custom t'HelpStyle'.+--+-- @since 0.2.2.0+usageWith :: HelpStyle -> String -> String -> String -> Parser a -> ParserInfo a+usageWith s name version hdr p =   info     (p <**> helper)-    (fullDesc <> progDesc hdr <> header (printf "%s - %s - version %s" name hdr version))+    ( fullDesc+        <> progDesc hdr+        <> headerDoc+          ( Just+              ( styled _styleName s name+                  <+> "-"+                  <+> pretty hdr+                  <+> "- version"+                  <+> styled _styleVersion s version+              )+          )+    )

@@ -1,8 +1,9 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} -import Data.CLI.Impl (fromParsec, reversibleSwitch)+import Data.CLI.Impl (fromParsec, plainHelpStyle, reversibleSwitch, usage, usageWith) import Data.Error.CLI (CLIError (..), displayCLIError)+import Data.List (isInfixOf) import Effectful (Eff, IOE, liftIO, runEff) import Effectful.CLI.Conc (batchConcurrentlyWithIndex) import Effectful.CLI.Exception (rethrowIO)@@ -85,3 +86,14 @@           parse = getParseResult . execParserPure defaultPrefs p        in fmap parse [[], ["--no-labels"], ["--no-labels", "--labels"], ["--labels", "--no-labels"]]             `shouldBe` fmap Just [True, False, True, False]++  describe "usage"+    $ it "styles the header unless plain"+    $ let render st = case execParserPure defaultPrefs (st "prog" "1.0" "desc" (pure ())) ["--help"] of+            Failure f -> fst (renderFailure f "prog")+            _ -> ""+       in ( "\ESC[" `isInfixOf` render usage+          , "\ESC[" `isInfixOf` render (usageWith plainHelpStyle)+          , "prog - desc - version 1.0" `isInfixOf` render (usageWith plainHelpStyle)+          )+            `shouldBe` (True, False, True)