effectful-cli 0.2.5.0 → 0.2.6.0

raw patch · 8 files changed

+447/−7 lines, 8 filesdep +containersdep +directorydep +filepathPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: containers, directory, filepath, toml-parser

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• README.md +67/−0
• effectful-cli.cabal +10/−1
• src/Data/CLI/Config.hs +85/−0
• src/Effectful/CLI.hs +48/−0
• src/Effectful/CLI/Conc.hs +65/−6
• src/Effectful/CLI/Config.hs +139/−0
• test/Spec.hs +27/−0

@@ -1,3 +1,9 @@+## [2.6.0](https://github.com/haskell-github-trust/effectful-cli/compare/2.5.0...2.6.0) (2026-11-06)++### Features++* add config commands ([a21cd10](https://github.com/haskell-github-trust/effectful-cli/commit/a21cd10e8331b786ae877e78f6593314ae9242ee))+ ## [2.5.0](https://github.com/haskell-github-trust/effectful-cli/compare/2.4.2...2.5.0) (2026-11-05)  ### Features

@@ -4,6 +4,73 @@ effect constraints, concurrency, prompts, sleep/time, optparse-applicative helpers and a [monad-logger](https://hackage.haskell.org/package/monad-logger) bridge (stderr or OpenTelemetry). +## Quick start++Add the dependencies to `package.yaml`:++```yaml+dependencies:+  - effectful+  - effectful-cli+  - http-client-effectful+  - monad-logger+  - optparse-applicative+  - text+```++Minimal `Main.hs`, one `hello` subcommand logging to stderr:++```haskell+{-# LANGUAGE OverloadedStrings #-}++import Control.Monad.Logger (logInfoN)+import Data.CLI.Class+import Data.CLI.Impl (execCLIParser, mkCommand, usage)+import Data.Error.CLI (CLIError, displayCLIError)+import Data.Text qualified as T+import Data.Text.IO qualified as T+import Effectful+import Effectful.Error.Static (runErrorNoCallStack)+import Effectful.HttpClient (runHttpClientTls)+import Effectful.Logger (runStderrLogger)+import Effectful.Reader.Static (runReader)+import Options.Applicative (hsubparser, strArgument)++data Config = Config++instance CLIConfig Config where+  autoAccept _ = False+  autoDecline _ = False++newtype Hello = Hello String++instance Command Config CLIError Hello where+  cmdname _ = "hello"+  doc _ = "greet someone"+  parser _ = Hello <$> strArgument mempty+  runner (Hello name) = logInfoN ("hello " <> T.pack name)++main :: IO ()+main = do+  cmd <- execCLIParser+         (usage "hello" "0.1.0" "greeter" (hsubparser (mkCommand (Hello ""))))+  res <-+    runEff .+    runHttpClientTls .+    runStderrLogger .+    runReader Config .+    runErrorNoCallStack @CLIError .+    runErrorNoCallStack @CLIError $+    runner cmd+  either (T.putStrLn . displayCLIError) pure (res >>= id)+```++```sh+stack run -- hello world+```++See the `Effectful.CLI` module docs for the walkthrough.+ ## Build  ```sh

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           effectful-cli-version:        0.2.5.0+version:        0.2.6.0 synopsis:       CLI helpers for the effectful ecosystem description:    Please see the README at https://github.com/haskell-github-trust/effectful-cli category:       CLI@@ -24,10 +24,12 @@   exposed-modules:       Data.CLI.Args       Data.CLI.Class+      Data.CLI.Config       Data.CLI.Impl       Data.Error.CLI       Effectful.CLI       Effectful.CLI.Conc+      Effectful.CLI.Config       Effectful.CLI.Exception       Effectful.CLI.IO       Effectful.CLI.Sleep@@ -40,8 +42,11 @@   ghc-options: -Wall -Wextra -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints   build-depends:       base >=4.20 && <4.22+    , containers >=0.6.8 && <0.8+    , directory >=1.3.8 && <1.4     , effectful >=2.6.1 && <2.8     , effectful-core >=2.6.1 && <2.8+    , filepath >=1.4.300 && <1.6     , hs-opentelemetry-api ==1.0.*     , hs-opentelemetry-instrumentation-monad-logger ==1.0.*     , http-client-effectful ==1.0.*@@ -51,6 +56,7 @@     , table-layout ==1.0.*     , text ==2.1.*     , time >=1.12.2 && <1.15+    , toml-parser >=2.0.1 && <2.1     , uuid >=1.3.16 && <1.4   default-language: GHC2021 @@ -64,9 +70,12 @@   ghc-options: -Wall -Wextra -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N   build-depends:       base >=4.20 && <4.22+    , directory     , effectful     , effectful-cli+    , filepath     , hspec ==2.11.*     , megaparsec     , optparse-applicative+    , toml-parser   default-language: GHC2021

@@ -0,0 +1,85 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}++-- | Ready-made @show@/@get@/@set@ commands over the application's TOML config file.+module Data.CLI.Config (+  ConfigFile (..),+  ConfigCommand (..),+) where++import Data.CLI.Class (Command (..))+import Data.CLI.Impl (noArgs, unboundEnumError)+import Data.Error.CLI (CLIError (InputError))+import Data.Kind (Type)+import Data.Text (Text)+import Data.Text qualified as T+import Effectful.CLI.Config (getConfigKey, readConfigText, setConfigKey)+import Effectful.CLI.Exception (rethrowIO)+import Effectful.CLI.IO (printOutputLn)+import Effectful.Reader.Static (asks)+import GHC.Enum (boundedEnumFrom, boundedEnumFromThen)+import Options.Applicative (Parser, metavar, strArgument)+import Toml.Schema (FromValue)++-- | Application config @c@ that knows its config file and the type it decodes to.+--+-- @since 0.2.6.0+class FromValue (ConfigOf c) => ConfigFile c where+  -- | Type the config file decodes to; 'ConfigSet' refuses to write anything else.+  type ConfigOf c :: Type++  -- | Path of the config file.+  configFilePath :: c -> FilePath++-- | Config file commands for config @c@ and application error @e@. IO failures+-- are raised as 'InputError'.+--+-- @since 0.2.6.0+data ConfigCommand c e+  = -- | Print the config file.+    ConfigShow+  | -- | Print a dotted key's value.+    ConfigGet Text+  | -- | Set a dotted key to a TOML literal, or a string if not one.+    ConfigSet Text Text+  deriving (Eq, Show)++instance Bounded (ConfigCommand c e) where+  minBound = ConfigShow+  maxBound = ConfigSet mempty mempty++instance Enum (ConfigCommand c e) where+  fromEnum ConfigShow = 0+  fromEnum (ConfigGet _) = 1+  fromEnum (ConfigSet _ _) = 2++  toEnum 0 = minBound+  toEnum 1 = ConfigGet mempty+  toEnum 2 = maxBound+  toEnum _ = unboundEnumError "ConfigCommand"++  enumFrom = boundedEnumFrom+  enumFromThen = boundedEnumFromThen++instance ConfigFile c => Command c e (ConfigCommand c e) where+  cmdname ConfigShow = "show"+  cmdname (ConfigGet _) = "get"+  cmdname (ConfigSet _ _) = "set"++  doc ConfigShow = "Print the config file"+  doc (ConfigGet _) = "Print a dotted key's value (e.g. section.key)"+  doc (ConfigSet _ _) = "Set a dotted key to a TOML literal, or a string if not one"++  parser ConfigShow = noArgs ConfigShow+  parser (ConfigGet _) = ConfigGet <$> keyArg+  parser (ConfigSet _ _) = ConfigSet <$> keyArg <*> strArgument (metavar "VALUE")++  runner cmd = do+    path <- asks @c configFilePath+    rethrowIO (InputError . ("config file: " <>) . T.show) $ case cmd of+      ConfigShow -> printOutputLn . T.stripEnd =<< readConfigText path+      ConfigGet k -> printOutputLn =<< getConfigKey path k+      ConfigSet k v -> setConfigKey @(ConfigOf c) path k v++keyArg :: Parser Text+keyArg = strArgument (metavar "KEY")

@@ -1,4 +1,52 @@ -- | Effect stack available to command runners.+--+-- = Tutorial+--+-- Define a config implementing 'Data.CLI.Class.CLIConfig' and a command implementing+-- 'Data.CLI.Class.Command', then run its 'Data.CLI.Class.runner' with every effect of+-- 'CLIEffects' discharged:+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > import Data.CLI.Class+-- > import Data.CLI.Impl (execCLIParser, mkCommand, usage)+-- > import Data.Error.CLI (CLIError, displayCLIError)+-- > import Control.Monad.Logger (logInfoN)+-- > import Data.Text qualified as T+-- > import Data.Text.IO qualified as T+-- > import Effectful+-- > import Effectful.Error.Static (runErrorNoCallStack)+-- > import Effectful.HttpClient (runHttpClientTls)+-- > import Effectful.Logger (runStderrLogger)+-- > import Effectful.Reader.Static (runReader)+-- > import Options.Applicative (hsubparser, strArgument)+-- >+-- > data Config = Config+-- >+-- > instance CLIConfig Config where+-- >   autoAccept _ = False+-- >   autoDecline _ = False+-- >+-- > newtype Hello = Hello String+-- >+-- > instance Command Config CLIError Hello where+-- >   cmdname _ = "hello"+-- >   doc _ = "greet someone"+-- >   parser _ = Hello <$> strArgument mempty+-- >   runner (Hello name) = logInfoN ("hello " <> T.pack name)+-- >+-- > main :: IO ()+-- > main = do+-- >   cmd <- execCLIParser (usage "hello" "0.1.0" "greeter" (hsubparser (mkCommand (Hello ""))))+-- >   res <-+-- >     runEff . runHttpClientTls . runStderrLogger . runReader Config+-- >       . runErrorNoCallStack @CLIError . runErrorNoCallStack @CLIError+-- >       $ runner cmd+-- >   either (T.putStrLn . displayCLIError) pure (res >>= id)+--+-- Here the application error @e@ is 'CLIError' itself; use your own type and handle it+-- in the second 'Effectful.Error.Static.runErrorNoCallStack'. See "Data.CLI.Impl" for+-- more parser helpers and "Effectful.CLI.IO" for confirmation prompts. module Effectful.CLI (   CLIEffects, ) where

@@ -19,15 +19,74 @@ import Effectful (Eff, (:>)) import Effectful.Concurrent.Async (   Concurrent,-  concurrently,-  concurrently_,-  forConcurrently,-  forConcurrently_,-  mapConcurrently,-  mapConcurrently_,   pooledMapConcurrentlyN,   pooledMapConcurrentlyN_,  )+import Effectful.Concurrent.Async qualified as Async++-- | Run two actions concurrently and return both results.+concurrently+  :: Concurrent :> es+  => Eff es a+  -- ^ first action+  -> Eff es b+  -- ^ second action+  -> Eff es (a, b)+concurrently = Async.concurrently++-- | Like 'concurrently', discarding results.+concurrently_+  :: Concurrent :> es+  => Eff es a+  -- ^ first action+  -> Eff es b+  -- ^ second action+  -> Eff es ()+concurrently_ = Async.concurrently_++-- | Map an action over a container concurrently, without a concurrency limit.+mapConcurrently+  :: Concurrent :> es+  => Traversable t+  => (a -> Eff es b)+  -- ^ action for each element+  -> t a+  -- ^ elements+  -> Eff es (t b)+mapConcurrently = Async.mapConcurrently++-- | Like 'mapConcurrently', discarding results.+mapConcurrently_+  :: Concurrent :> es+  => Foldable f+  => (a -> Eff es b)+  -- ^ action for each element+  -> f a+  -- ^ elements+  -> Eff es ()+mapConcurrently_ = Async.mapConcurrently_++-- | 'mapConcurrently' with its arguments flipped.+forConcurrently+  :: Concurrent :> es+  => Traversable t+  => t a+  -- ^ elements+  -> (a -> Eff es b)+  -- ^ action for each element+  -> Eff es (t b)+forConcurrently = Async.forConcurrently++-- | Like 'forConcurrently', discarding results.+forConcurrently_+  :: Concurrent :> es+  => Foldable f+  => f a+  -- ^ elements+  -> (a -> Eff es b)+  -- ^ action for each element+  -> Eff es ()+forConcurrently_ = Async.forConcurrently_  -- | Run all actions concurrently and collect their results. --

@@ -0,0 +1,139 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Read and edit a TOML config file by dotted key (@github.project.team@).+module Effectful.CLI.Config (+  readConfigText,+  getConfigKey,+  setConfigKey,+  lookupKey,+  setKey,+  parseValue,+) where++import Control.Monad ((<=<))+import Data.Error.CLI (CLIError (..))+import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.IO qualified as T+import Effectful (Eff, IOE, liftIO, (:>))+import Effectful.Error.Static (Error, throwError)+import System.Directory (createDirectoryIfMissing, doesFileExist)+import System.FilePath (takeDirectory)+import Toml (+  Result (..),+  Table,+  Table' (..),+  Value,+  Value' (..),+  forgetTableAnns,+  prettyToml,+ )+import Toml qualified+import Toml.Pretty (prettyValue)+import Toml.Schema (FromValue)++-- | The config file's contents, empty if it does not exist.+--+-- @since 0.2.6.0+readConfigText+  :: IOE :> es+  => FilePath+  -> Eff es Text+readConfigText path = liftIO $ do+  exists <- doesFileExist path+  if exists then T.readFile path else pure ""++-- | Render a dotted key's value: strings unquoted, tables as TOML sections.+--+-- @since 0.2.6.0+getConfigKey+  :: IOE :> es+  => Error CLIError :> es+  => FilePath+  -> Text+  -> Eff es Text+getConfigKey path key =+  maybe (throwError (NotFoundError key)) (pure . render) . lookupKey (T.splitOn "." key)+    =<< readTable path+ where+  render (Text t) = t+  render (Table t) = T.stripEnd (T.show (prettyToml t))+  render v = T.show (prettyValue v)++-- | Set a dotted key to 'parseValue' of the raw input, creating intermediate+-- tables; the file is only written if the result still decodes as @a@.+-- Re-renders the whole file, dropping comments and formatting.+--+-- @since 0.2.6.0+setConfigKey+  :: forall a es+   . FromValue a+  => IOE :> es+  => Error CLIError :> es+  => FilePath+  -> Text+  -> Text+  -> Eff es ()+setConfigKey path key raw = do+  table <-+    either (throwError . InputError) pure . setKey (T.splitOn "." key) (parseValue raw)+      =<< readTable path+  let rendered = T.show (prettyToml table)+  case Toml.decode @a rendered of+    Failure es -> throwError (InputError ("invalid config: " <> T.pack (unlines es)))+    Success _ _ -> liftIO $ do+      createDirectoryIfMissing True (takeDirectory path)+      T.writeFile path rendered++readTable+  :: IOE :> es+  => Error CLIError :> es+  => FilePath+  -> Eff es Table+readTable =+  either (throwError . InputError . T.pack) (pure . forgetTableAnns) . Toml.parse+    <=< readConfigText++-- | Value at a dotted key path, the empty path being the whole table.+--+-- @since 0.2.6.0+lookupKey+  :: [Text]+  -> Table+  -> Maybe Value+lookupKey [] t = Just (Table t)+lookupKey (k : ks) (MkTable m) = case (ks, snd <$> Map.lookup k m) of+  ([], v) -> v+  (_, Just (Table t)) -> lookupKey ks t+  _ -> Nothing++-- | Set a value at a dotted key path, creating missing tables; fails when a+-- path segment is not a table.+--+-- @since 0.2.6.0+setKey+  :: [Text]+  -> Value+  -> Table+  -> Either Text Table+setKey [] _ _ = Left "empty key"+setKey [k] v (MkTable m) = Right (MkTable (Map.insert k ((), v) m))+setKey (k : ks) v (MkTable m) = case snd <$> Map.lookup k m of+  Nothing -> descend (MkTable mempty)+  Just (Table t) -> descend t+  Just _ -> Left (k <> " is not a table")+ where+  descend t = (\t' -> MkTable (Map.insert k ((), Table t') m)) <$> setKey ks v t++-- | A TOML literal (@true@, @42@, @["a"]@, @"x"@), else the raw text as a string.+--+-- @since 0.2.6.0+parseValue :: Text -> Value+parseValue raw =+  either+    (const (Text raw))+    (fromMaybe (Text raw) . lookupKey ["v"] . forgetTableAnns)+    (Toml.parse ("v = " <> raw))

@@ -13,13 +13,17 @@ import Data.List (isInfixOf) import Effectful (Eff, IOE, liftIO, runEff) import Effectful.CLI.Conc (batchConcurrentlyWithIndex)+import Effectful.CLI.Config (getConfigKey, lookupKey, parseValue, setConfigKey, setKey) import Effectful.CLI.Exception (rethrowIO) import Effectful.CLI.IO (resolveIndex) import Effectful.Concurrent (runConcurrent) import Effectful.Error.Static (Error, runErrorNoCallStack) import Options.Applicative+import System.Directory (getTemporaryDirectory, removeFile)+import System.FilePath ((</>)) import Test.Hspec import Text.Megaparsec.Char (string)+import Toml (Table, Table' (..), Value' (..))  isInputError :: Either CLIError a -> Bool isInputError (Left (InputError _)) = True@@ -113,3 +117,26 @@               <|> subparser (hidden <> command "b" (info (subparser (leaf "c")) (progDesc "b desc")))        in show (commandTree p)             `shouldBe` "a            a desc\nb            b desc\n  c            c desc"++  describe "config keys" $ do+    it "parses TOML literals, falling back to strings" $+      fmap parseValue ["true", "\"x\"", "plain"]+        `shouldBe` [Bool True, Text "x", Text "plain"]++    it "sets nested keys and reads them back" $+      ( lookupKey ["a", "b", "c"]+          =<< either (const Nothing) Just (setKey ["a", "b", "c"] (Text "t") (MkTable mempty))+      )+        `shouldBe` Just (Text "t")++    it "refuses to descend into a scalar" $+      (setKey ["a", "b"] (Bool True) =<< setKey ["a"] (Bool False) (MkTable mempty))+        `shouldBe` Left "a is not a table"++    it "writes then reads a key through the file" $ do+      path <- (</> "effectful-cli-config-test.toml") <$> getTemporaryDirectory+      r <- runEff . runErrorNoCallStack @CLIError $ do+        setConfigKey @Table path "a.b" "1"+        getConfigKey path "a.b"+      removeFile path+      r `shouldBe` Right "1"