diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,5 @@ +## [2.4.1](https://github.com/haskell-github-trust/effectful-cli/compare/2.4.0...2.4.1) (2026-10-31) + ## [2.4.0](https://github.com/haskell-github-trust/effectful-cli/compare/2.3.0...2.4.0) (2026-10-31) ### Features diff --git a/effectful-cli.cabal b/effectful-cli.cabal --- a/effectful-cli.cabal +++ b/effectful-cli.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: effectful-cli -version: 0.2.4.0 +version: 0.2.4.1 synopsis: CLI helpers for the effectful ecosystem description: Please see the README at https://github.com/haskell-github-trust/effectful-cli category: CLI diff --git a/src/Data/CLI/Args.hs b/src/Data/CLI/Args.hs --- a/src/Data/CLI/Args.hs +++ b/src/Data/CLI/Args.hs @@ -48,13 +48,19 @@ -- * info otherwise -- -- @since 0.1.0.0 -getLogLevel :: CLIArgs c -> LogLevel +getLogLevel + :: CLIArgs c + -- ^ parsed options + -> LogLevel getLogLevel a = fromMaybe (if _debug a then LevelDebug else LevelInfo) (_logLevel a) -- | Print the version string to stdout. -- -- @since 0.1.0.0 -showVersion :: String -> IO () +showVersion + :: String + -- ^ version + -> IO () showVersion = putStrLn -- | Print the version if @--version@ was passed, otherwise run the parsed command. @@ -62,21 +68,32 @@ -- @since 0.1.0.0 versionOrCommand :: String + -- ^ version -> CLIArgs c + -- ^ parsed options -> (c -> IO ()) + -- ^ command runner -> IO () versionOrCommand v a run = either (const (showVersion v)) run (_command a) -- | Parser for the common CLI options, wrapping the given command parser. -- -- @since 0.1.0.0 -argParser :: Parser c -> Parser (CLIArgs c) +argParser + :: Parser c + -- ^ command parser + -> Parser (CLIArgs c) argParser = argParserWith defaultHelpStyle -- | 'argParser' with a custom t'HelpStyle'. -- -- @since 0.2.2.0 -argParserWith :: HelpStyle -> Parser c -> Parser (CLIArgs c) +argParserWith + :: HelpStyle + -- ^ help style + -> Parser c + -- ^ command parser + -> Parser (CLIArgs c) argParserWith s cmdParser = CLIArgs <$> optional diff --git a/src/Data/CLI/Impl.hs b/src/Data/CLI/Impl.hs --- a/src/Data/CLI/Impl.hs +++ b/src/Data/CLI/Impl.hs @@ -76,7 +76,14 @@ -- | Render a string with the selected style of a t'HelpStyle'. -- -- @since 0.2.2.0 -styled :: (HelpStyle -> AnsiStyle) -> HelpStyle -> String -> Doc +styled + :: (HelpStyle -> AnsiStyle) + -- ^ style selector, e.g. '_styleValue' + -> HelpStyle + -- ^ style set to select from + -> String + -- ^ text to render + -> Doc styled f s | f s == mempty = pretty | otherwise = annotate (f s) . pretty @@ -94,7 +101,10 @@ -- 'colorEnabled' is false. -- -- @since 0.2.2.0 -execCLIParser :: ParserInfo a -> IO a +execCLIParser + :: ParserInfo a + -- ^ top-level parser, e.g. from 'usage' + -> IO a execCLIParser pinfo = do c <- colorEnabled res <- execParserPure (prefs showHelpOnEmpty) pinfo <$> getArgs @@ -108,13 +118,21 @@ -- | Error for 'succ' called on 'maxBound' of the named enum. -- -- @since 0.1.0.0 -unboundEnumError :: String -> a +unboundEnumError + :: String + -- ^ enum type name + -> a unboundEnumError name = error (printf "%s.Enum: succ invoked on maxBound" name) -- | Turn a megaparsec parser into a 'ReadM', requiring the whole input to be consumed. -- -- @since 0.1.0.0 -fromParsec :: String -> Parsec Void String a -> ReadM a +fromParsec + :: String + -- ^ input name used in parse error messages + -> Parsec Void String a + -- ^ parser for the whole value + -> ReadM a fromParsec name p = eitherReader (first errorBundlePretty . runParser (p <* eof) name) -- | Accept a value either as a positional argument or as a @-c@/@--name@ option. @@ -122,10 +140,15 @@ -- @since 0.1.0.0 argOrOpt :: String + -- ^ long option name, also the uppercased metavar -> Char + -- ^ short option -> String + -- ^ help text -> Either (Parsec Void String a) (ReadM a) + -- ^ value reader, as a megaparsec parser or a 'ReadM' -> [String] + -- ^ shell completion candidates -> Parser a argOrOpt name c h p cs = argument r (metavar var <> completeWith cs) @@ -137,7 +160,10 @@ -- | Parser for a command that takes no arguments. -- -- @since 0.1.0.0 -noArgs :: a -> Parser a +noArgs + :: a + -- ^ command value + -> Parser a noArgs = pure -- | @-f@/@--force@ switch. @@ -160,7 +186,14 @@ -- | @--name@/@--no-name@ switch pair; the last occurrence wins, otherwise the default. -- -- @since 0.2.2.0 -reversibleSwitch :: Bool -> String -> String -> Parser Bool +reversibleSwitch + :: Bool + -- ^ default when neither switch is given + -> String + -- ^ long switch name, @no-@ prefixed for the negation + -> String + -- ^ help text + -> Parser Bool reversibleSwitch def name h = last <$> some (flag' True (long name <> help h) <|> flag' False (long ("no-" <> name) <> hidden)) @@ -175,26 +208,56 @@ -- | Build a subcommand from a 'Command' instance. -- -- @since 0.1.0.0 -mkCommand :: Command c e a => a -> Mod CommandFields a +mkCommand + :: Command c e a + => a + -- ^ command value + -> Mod CommandFields a mkCommand a = command (cmdname a) (info (parser a) (progDesc (doc a))) -- | Build subcommands for every value of an enum, sorted by name and wrapped with the given constructor. -- -- @since 0.1.0.0 mkCommands - :: Bounded a => Command c e a => Command c e b => Enum a => (a -> b) -> Mod CommandFields b + :: Bounded a + => Command c e a + => Command c e b + => Enum a + => (a -> b) + -- ^ wrapping constructor + -> Mod CommandFields b mkCommands f = foldMap (mkCommand . f) (sortOn cmdname [minBound ..]) -- | Top-level t'ParserInfo' with @--help@ and a header showing name, description and version. -- -- @since 0.1.0.0 -usage :: String -> String -> String -> Parser a -> ParserInfo a +usage + :: String + -- ^ program name + -> String + -- ^ version + -> String + -- ^ description + -> Parser a + -- ^ arguments parser + -> ParserInfo a usage = usageWith defaultHelpStyle -- | 'usage' with a custom t'HelpStyle'. -- -- @since 0.2.2.0 -usageWith :: HelpStyle -> String -> String -> String -> Parser a -> ParserInfo a +usageWith + :: HelpStyle + -- ^ help style + -> String + -- ^ program name + -> String + -- ^ version + -> String + -- ^ description + -> Parser a + -- ^ arguments parser + -> ParserInfo a usageWith s name version hdr p = info (p <**> helper) diff --git a/src/Data/Error/CLI.hs b/src/Data/Error/CLI.hs --- a/src/Data/Error/CLI.hs +++ b/src/Data/Error/CLI.hs @@ -25,7 +25,10 @@ -- | Render a 'CLIError' as a human-readable message. -- -- @since 0.1.0.0 -displayCLIError :: CLIError -> Text +displayCLIError + :: CLIError + -- ^ error to render + -> Text displayCLIError (InputError s) = "input error: " <> s displayCLIError (NotFoundError s) = "not found: " <> s displayCLIError (NotImplemented s) = "not implemented: " <> s diff --git a/src/Effectful/CLI/Conc.hs b/src/Effectful/CLI/Conc.hs --- a/src/Effectful/CLI/Conc.hs +++ b/src/Effectful/CLI/Conc.hs @@ -36,6 +36,7 @@ :: Concurrent :> es => Traversable t => t (Eff es a) + -- ^ actions -> Eff es (t a) runConcurrently = mapConcurrently id @@ -46,6 +47,7 @@ :: Concurrent :> es => Foldable t => t (Eff es a) + -- ^ actions -> Eff es () runConcurrently_ = mapConcurrently_ id @@ -56,8 +58,11 @@ :: Concurrent :> es => Traversable t => Int + -- ^ maximum number of concurrent actions -> (a -> Eff es b) + -- ^ action for each element -> t a + -- ^ elements -> Eff es (t b) batchConcurrently = pooledMapConcurrentlyN @@ -68,8 +73,11 @@ :: Concurrent :> es => Foldable f => Int + -- ^ maximum number of concurrent actions -> (a -> Eff es b) + -- ^ action for each element -> f a + -- ^ elements -> Eff es () batchConcurrently_ = pooledMapConcurrentlyN_ @@ -80,8 +88,11 @@ :: Concurrent :> es => Traversable t => Int + -- ^ maximum number of concurrent actions -> (Int -> a -> Eff es b) + -- ^ action for each element -> t a + -- ^ elements -> Eff es (t b) batchConcurrentlyWithIndex n f = batchConcurrently n (uncurry f) . snd . mapAccumL (\i x -> (i + 1, (i, x))) 1 @@ -93,7 +104,10 @@ :: Concurrent :> es => Foldable f => Int + -- ^ maximum number of concurrent actions -> (Int -> a -> Eff es b) + -- ^ action for each element -> f a + -- ^ elements -> Eff es () batchConcurrentlyWithIndex_ n f = batchConcurrently_ n (uncurry f) . zip [1 ..] . toList diff --git a/src/Effectful/CLI/Exception.hs b/src/Effectful/CLI/Exception.hs --- a/src/Effectful/CLI/Exception.hs +++ b/src/Effectful/CLI/Exception.hs @@ -11,5 +11,12 @@ -- | Catch 'IOException's raised by an action and rethrow them as @e@ via the given constructor. -- -- @since 0.2.1.0 -rethrowIO :: Error e :> es => Show e => (IOException -> e) -> Eff es a -> Eff es a +rethrowIO + :: Error e :> es + => Show e + => (IOException -> e) + -- ^ application error constructor + -> Eff es a + -- ^ action that may raise an 'IOException' + -> Eff es a rethrowIO f = handle (throwError . f) diff --git a/src/Effectful/CLI/IO.hs b/src/Effectful/CLI/IO.hs --- a/src/Effectful/CLI/IO.hs +++ b/src/Effectful/CLI/IO.hs @@ -40,31 +40,52 @@ -- | Print to stdout without a trailing newline. -- -- @since 0.1.0.0 -printOutput :: IOE :> es => Text -> Eff es () +printOutput + :: IOE :> es + => Text + -- ^ text to print + -> Eff es () printOutput = liftIO . T.putStr -- | Print to stdout with a trailing newline. -- -- @since 0.1.0.0 -printOutputLn :: IOE :> es => Text -> Eff es () +printOutputLn + :: IOE :> es + => Text + -- ^ text to print + -> Eff es () printOutputLn = liftIO . T.putStrLn -- | Print to stderr without a trailing newline. -- -- @since 0.1.0.0 -printError :: IOE :> es => Text -> Eff es () +printError + :: IOE :> es + => Text + -- ^ text to print + -> Eff es () printError = liftIO . T.hPutStr stderr -- | Print lines to stdout, each followed by a newline. -- -- @since 0.1.0.0 -printLines :: IOE :> es => Foldable f => f Text -> Eff es () +printLines + :: IOE :> es + => Foldable f + => f Text + -- ^ lines to print + -> Eff es () printLines = printOutput . T.unlines . toList -- | Read a line from stdin after printing an optional prompt to stderr. -- -- @since 0.1.0.0 -prompt :: IOE :> es => Maybe Text -> Eff es Text +prompt + :: IOE :> es + => Maybe Text + -- ^ prompt text, followed by @> @ + -> Eff es Text prompt p = liftIO $ do T.hPutStr stderr (fromMaybe "" p <> "> ") hFlush stderr @@ -74,7 +95,13 @@ -- -- @since 0.1.0.0 prompt' - :: Error CLIError :> es => IOE :> es => Maybe Text -> Parsec Void Text a -> Eff es a + :: Error CLIError :> es + => IOE :> es + => Maybe Text + -- ^ prompt text + -> Parsec Void Text a + -- ^ answer parser + -> Eff es a prompt' p parser = prompt p >>= either (throwError . InputError . T.pack . errorBundlePretty) pure @@ -97,7 +124,13 @@ -- @since 0.1.0.0 withConfirm :: forall c es a - . CLIConfig c => Error CLIError :> es => IOE :> es => Reader c :> es => Eff es a -> Eff es a + . CLIConfig c + => Error CLIError :> es + => IOE :> es + => Reader c :> es + => Eff es a + -- ^ action to confirm + -> Eff es a withConfirm action = do c <- ask @c when (autoDecline c) $ throwError (UserCanceled (Just "auto-declined")) @@ -109,7 +142,11 @@ -- | Open a file or URL with @xdg-open@. -- -- @since 0.1.0.0 -autoOpen :: Process :> es => String -> Eff es () +autoOpen + :: Process :> es + => String + -- ^ file path or URL + -> Eff es () autoOpen arg = callProcess "xdg-open" [arg] -- | Let the user pick one item from a table; a single item is returned without prompting, none throws 'NotFoundError'. @@ -119,7 +156,15 @@ :: Error CLIError :> es => IOE :> es => Foldable f - => Text -> [Text] -> (a -> [Text]) -> f a -> Eff es a + => Text + -- ^ item kind, used as prompt and in the not-found error + -> [Text] + -- ^ table headers + -> (a -> [Text]) + -- ^ table row of an item + -> f a + -- ^ items to choose from + -> Eff es a chooseItem name headers row = go . toList where go [] = throwError (NotFoundError ("no item found for " <> name)) @@ -136,7 +181,12 @@ -- | Turn a 1-based (or negative, from the end) user index into a 0-based one. -- -- @since 0.1.0.0 -resolveIndex :: Int -> Int -> Either CLIError Int +resolveIndex + :: Int + -- ^ number of items + -> Int + -- ^ user index + -> Either CLIError Int resolveIndex len i | i >= 1 && i <= len = Right (i - 1) | i <= -1 && i >= -len = Right (len + i) diff --git a/src/Effectful/CLI/Sleep.hs b/src/Effectful/CLI/Sleep.hs --- a/src/Effectful/CLI/Sleep.hs +++ b/src/Effectful/CLI/Sleep.hs @@ -23,7 +23,12 @@ -- | Sleep for the given number of milliseconds. -- -- @since 0.1.0.0 -msleep :: IOE :> es => Logger :> es => Int -> Eff es () +msleep + :: IOE :> es + => Logger :> es + => Int + -- ^ milliseconds + -> Eff es () msleep n = do logDebugN (T.pack (printf "sleeping for %dms" n)) liftIO (threadDelay (n * 1000)) @@ -31,7 +36,12 @@ -- | Sleep for the given number of seconds. -- -- @since 0.1.0.0 -sleep :: IOE :> es => Logger :> es => Int -> Eff es () +sleep + :: IOE :> es + => Logger :> es + => Int + -- ^ seconds + -> Eff es () sleep n = do logDebugN (T.pack (printf "sleeping for %ds" n)) liftIO (threadDelay (n * 1000000)) @@ -39,7 +49,12 @@ -- | Sleep until the given local time. -- -- @since 0.1.0.0 -sleepUntil :: IOE :> es => Logger :> es => LocalTime -> Eff es () +sleepUntil + :: IOE :> es + => Logger :> es + => LocalTime + -- ^ wake-up time + -> Eff es () sleepUntil t = do logInfoN (T.pack ("sleeping until " <> formatTime defaultTimeLocale "%R" t)) now <- getLocalTime diff --git a/src/Effectful/Logger.hs b/src/Effectful/Logger.hs --- a/src/Effectful/Logger.hs +++ b/src/Effectful/Logger.hs @@ -51,19 +51,35 @@ -- | Run the t'Logger' effect with the given log callback. -- -- @since 0.1.0.0 -runLogger :: IOE :> es => LogFunc -> Eff (Logger : es) a -> Eff es a +runLogger + :: IOE :> es + => LogFunc + -- ^ log callback + -> Eff (Logger : es) a + -- ^ action using the logger + -> Eff es a runLogger = evalStaticRep . Logger -- | Run the t'Logger' effect, writing to stderr. -- -- @since 0.1.0.0 -runStderrLogger :: IOE :> es => Eff (Logger : es) a -> Eff es a +runStderrLogger + :: IOE :> es + => Eff (Logger : es) a + -- ^ action using the logger + -> Eff es a runStderrLogger = runLogger (defaultOutput stderr) -- | Run the t'Logger' effect, emitting OpenTelemetry log records. -- -- @since 0.1.0.0 -runOTelLogger :: IOE :> es => OTel.Logger -> Eff (Logger : es) a -> Eff es a +runOTelLogger + :: IOE :> es + => OTel.Logger + -- ^ OpenTelemetry logger + -> Eff (Logger : es) a + -- ^ action using the logger + -> Eff es a runOTelLogger = runLogger . OTel.makeOTelLogCallback instance Logger :> es => MonadLogger (Eff es) where