effectful-cli 0.1.0.2 → 0.2.0.0

raw patch · 6 files changed

+73/−39 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• effectful-cli.cabal +1/−1
• src/Data/Error/CLI.hs +9/−5
• src/Effectful/CLI/Conc.hs +15/−8
• src/Effectful/CLI/IO.hs +35/−25
• test/Spec.hs +2/−0

@@ -1,3 +1,14 @@+## [2.0.0](https://github.com/haskell-github-trust/effectful-cli/compare/1.0.2...2.0.0) (2026-10-26)++### ⚠ BREAKING CHANGES++* use Text instead of String where relevant++### Features++* support generic `Foldable` and `Traversable` structures ([64382ea](https://github.com/haskell-github-trust/effectful-cli/commit/64382ea50c9fde7fae8991afe74ae4e223c16333))+* use Text instead of String where relevant ([52450e3](https://github.com/haskell-github-trust/effectful-cli/commit/52450e36dd017d208ea5f9675cb89bfc39aee56e))+ ## [1.0.2](https://github.com/haskell-github-trust/effectful-cli/compare/1.0.1...1.0.2) (2026-10-26)  ## [1.0.1](https://github.com/haskell-github-trust/effectful-cli/compare/1.0.0...1.0.1) (2026-10-25)

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           effectful-cli-version:        0.1.0.2+version:        0.2.0.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,27 +1,31 @@+{-# LANGUAGE OverloadedStrings #-}+ -- | Errors common to CLI applications. module Data.Error.CLI (   CLIError (..),   displayCLIError, ) where +import Data.Text (Text)+ -- | Errors raised by CLI helpers. -- -- @since 0.1.0.0 data CLIError   = -- | Invalid user input.-    InputError String+    InputError Text   | -- | Requested item does not exist.-    NotFoundError String+    NotFoundError Text   | -- | Feature not implemented yet.-    NotImplemented String+    NotImplemented Text   | -- | User declined a confirmation, with an optional reason.-    UserCanceled (Maybe String)+    UserCanceled (Maybe Text)   deriving (Eq, Show)  -- | Render a 'CLIError' as a human-readable message. -- -- @since 0.1.0.0-displayCLIError :: CLIError -> String+displayCLIError :: CLIError -> Text displayCLIError (InputError s) = "input error: " <> s displayCLIError (NotFoundError s) = "not found: " <> s displayCLIError (NotImplemented s) = "not implemented: " <> s

@@ -14,6 +14,8 @@   batchConcurrentlyWithIndex_, ) where +import Data.Foldable (toList)+import Data.Traversable (mapAccumL) import Effectful (Eff, (:>)) import Effectful.Concurrent.Async (   Concurrent,@@ -52,10 +54,11 @@ -- @since 0.1.0.0 batchConcurrently   :: Concurrent :> es+  => Traversable t   => Int   -> (a -> Eff es b)-  -> [a]-  -> Eff es [b]+  -> t a+  -> Eff es (t b) batchConcurrently = pooledMapConcurrentlyN  -- | Like 'batchConcurrently', discarding results.@@ -63,9 +66,10 @@ -- @since 0.1.0.0 batchConcurrently_   :: Concurrent :> es+  => Foldable f   => Int   -> (a -> Eff es b)-  -> [a]+  -> f a   -> Eff es () batchConcurrently_ = pooledMapConcurrentlyN_ @@ -74,19 +78,22 @@ -- @since 0.1.0.0 batchConcurrentlyWithIndex   :: Concurrent :> es+  => Traversable t   => Int   -> (Int -> a -> Eff es b)-  -> [a]-  -> Eff es [b]-batchConcurrentlyWithIndex n f = batchConcurrently n (uncurry f) . zip [1 ..]+  -> t a+  -> Eff es (t b)+batchConcurrentlyWithIndex n f =+  batchConcurrently n (uncurry f) . snd . mapAccumL (\i x -> (i + 1, (i, x))) 1  -- | Like 'batchConcurrentlyWithIndex', discarding results. -- -- @since 0.1.0.0 batchConcurrentlyWithIndex_   :: Concurrent :> es+  => Foldable f   => Int   -> (Int -> a -> Eff es b)-  -> [a]+  -> f a   -> Eff es ()-batchConcurrentlyWithIndex_ n f = batchConcurrently_ n (uncurry f) . zip [1 ..]+batchConcurrentlyWithIndex_ n f = batchConcurrently_ n (uncurry f) . zip [1 ..] . toList

@@ -1,4 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE OverloadedStrings #-}  -- | Terminal output, prompts and confirmations. module Effectful.CLI.IO (@@ -18,14 +19,18 @@ import Control.Monad (unless, void, when) import Data.CLI.Class (CLIConfig (..)) import Data.Error.CLI (CLIError (..))+import Data.Foldable (toList) import Data.Functor (($>)) import Data.Maybe (fromMaybe)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.IO qualified as T import Data.Void (Void) import Effectful (Eff, IOE, liftIO, (:>)) import Effectful.Error.Static (Error, throwError) import Effectful.Process (Process, callProcess) import Effectful.Reader.Static (Reader, ask)-import System.IO (hFlush, hPutStr, stderr)+import System.IO (hFlush, stderr) import Text.Layout.Table (columnHeaderTableS, def, rowsG, tableString, titlesH, unicodeS) import Text.Megaparsec (Parsec, eof, errorBundlePretty, runParser, (<|>)) import Text.Megaparsec.Char (string')@@ -35,44 +40,45 @@ -- | Print to stdout without a trailing newline. -- -- @since 0.1.0.0-printOutput :: IOE :> es => String -> Eff es ()-printOutput = liftIO . putStr+printOutput :: IOE :> es => Text -> Eff es ()+printOutput = liftIO . T.putStr  -- | Print to stdout with a trailing newline. -- -- @since 0.1.0.0-printOutputLn :: IOE :> es => String -> Eff es ()-printOutputLn = liftIO . putStrLn+printOutputLn :: IOE :> es => Text -> Eff es ()+printOutputLn = liftIO . T.putStrLn  -- | Print to stderr without a trailing newline. -- -- @since 0.1.0.0-printError :: IOE :> es => String -> Eff es ()-printError = liftIO . hPutStr stderr+printError :: IOE :> es => Text -> Eff es ()+printError = liftIO . T.hPutStr stderr  -- | Print lines to stdout, each followed by a newline. -- -- @since 0.1.0.0-printLines :: IOE :> es => [String] -> Eff es ()-printLines = printOutput . unlines+printLines :: IOE :> es => Foldable f => f Text -> 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 String -> Eff es String+prompt :: IOE :> es => Maybe Text -> Eff es Text prompt p = liftIO $ do-  hPutStr stderr (fromMaybe "" p <> "> ")+  T.hPutStr stderr (fromMaybe "" p <> "> ")   hFlush stderr-  getLine+  T.getLine  -- | Prompt and parse the answer, throwing 'InputError' on parse failure. -- -- @since 0.1.0.0 prompt'-  :: Error CLIError :> es => IOE :> es => Maybe String -> Parsec Void String a -> Eff es a+  :: Error CLIError :> es => IOE :> es => Maybe Text -> Parsec Void Text a -> Eff es a prompt' p parser =   prompt p-    >>= either (throwError . InputError . errorBundlePretty) pure . runParser parser "prompt"+    >>= either (throwError . InputError . T.pack . errorBundlePretty) pure+      . runParser parser "prompt"  -- | Ask for confirmation; @y@, @yes@ or an empty answer mean yes. --@@ -112,16 +118,20 @@ chooseItem   :: Error CLIError :> es   => IOE :> es-  => String -> [String] -> (a -> [String]) -> [a] -> Eff es a-chooseItem name _ _ [] = throwError (NotFoundError ("no item found for " <> name))-chooseItem _ _ _ [x] = pure x-chooseItem name headers row xs = do-  let hs = "#" : headers-      rows = zipWith (\i x -> show i : row x) [1 :: Int ..] xs-  printOutputLn-    (tableString (columnHeaderTableS (fmap (const def) hs) unicodeS (titlesH hs) [rowsG rows]))-  i <- prompt' (Just name) (signed (pure ()) decimal)-  either throwError (pure . (xs !!)) (resolveIndex (length xs) i)+  => Foldable f+  => Text -> [Text] -> (a -> [Text]) -> f a -> Eff es a+chooseItem name headers row = go . toList+ where+  go [] = throwError (NotFoundError ("no item found for " <> name))+  go [x] = pure x+  go xs = pick xs+  pick xs = do+    let hs = "#" : fmap T.unpack headers+        rows = zipWith (\i x -> show i : fmap T.unpack (row x)) [1 :: Int ..] xs+    printOutputLn . T.pack $+      tableString (columnHeaderTableS (fmap (const def) hs) unicodeS (titlesH hs) [rowsG rows])+    i <- prompt' (Just name) (signed (pure ()) decimal)+    either throwError (pure . (xs !!)) (resolveIndex (length xs) i)  -- | Turn a 1-based (or negative, from the end) user index into a 0-based one. --@@ -130,4 +140,4 @@ resolveIndex len i   | i >= 1 && i <= len = Right (i - 1)   | i <= -1 && i >= -len = Right (len + i)-  | otherwise = Left (InputError (printf "index %d out of bounds" i))+  | otherwise = Left (InputError (T.pack $ printf "index %d out of bounds" i))

@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ import Data.CLI.Impl (fromParsec) import Data.Error.CLI (CLIError (..), displayCLIError) import Effectful (runEff)