From 9fcfe127b67a71e1ea36ee3eecc9d01ec84cba81 Mon Sep 17 00:00:00 2001 From: drlkf Date: Tue, 27 Oct 2026 14:13:07 +0100 Subject: [PATCH] feat: add reversible cli switches --- AGENTS.md | 11 ++++++++--- src/Data/CLI/Impl.hs | 8 ++++++++ test/Spec.hs | 9 ++++++++- 3 files changed, 24 insertions(+), 4 deletions(-) diff --git a/AGENTS.md b/AGENTS.md index 4323593..0ba5f25 100644 --- a/AGENTS.md +++ b/AGENTS.md @@ -2,7 +2,7 @@ Haskell library (stack + hpack). Edit `package.yaml`, never generated `.cabal`. -## Commands +# Commands - build and test (GHC 9.10): `stack build --test --ghc-options=-Werror` - build and test (GHC 9.12): add `--stack-yaml stack-ghc-9.12.yaml` @@ -11,17 +11,22 @@ Haskell library (stack + hpack). Edit `package.yaml`, never generated `.cabal`. CI (`.github/workflows/ci.yml`) runs all of the above; keep it green. -## Style +# Style - `fmap` over `map`, `<>` over `++` (enforced by hlint) - curried constraints: `Read a => Ord a => a`, not `(Read a, Ord a) => a`; not enforced by tooling; constraint aliases such as `CLIEffects` stay tuples - `-Wredundant-constraints` on: only add `Show e` for `throwError` where needed -## Dependencies +# Dependencies - public Hackage only: no git or private `extra-deps`. - `http-client-effectful-1.0.0` caps `effectful < 2.7`; GHC 9.12 nightly config relaxes bounds with `allow-newer-deps` instead of pinning older - `package.yaml` version bounds span the versions both CI configs resolve; widen them when a snapshot moves + +# Versioning + +Do not edit this package's version files or `@since` comments, they are +generated by CI. diff --git a/src/Data/CLI/Impl.hs b/src/Data/CLI/Impl.hs index 8313db2..655ff8c 100644 --- a/src/Data/CLI/Impl.hs +++ b/src/Data/CLI/Impl.hs @@ -6,6 +6,7 @@ module Data.CLI.Impl ( noArgs, forceSwitch, noopSwitch, + reversibleSwitch, uuidArg, mkCommand, mkCommands, @@ -70,6 +71,13 @@ forceSwitch = switch (short 'f' <> long "force" <> help "force unsafe behavior") noopSwitch :: Parser Bool noopSwitch = switch (short 'n' <> long "noop" <> help "do not perform any real action") +-- | @--name@/@--no-name@ switch pair; the last occurrence wins, otherwise the default. +reversibleSwitch :: Bool -> String -> String -> Parser Bool +reversibleSwitch def name h = + last + <$> some (flag' True (long name <> help h) <|> flag' False (long ("no-" <> name) <> hidden)) + <|> pure def + -- | UUID given as a positional argument or @-u@/@--uuid@. -- -- @since 0.1.0.0 diff --git a/test/Spec.hs b/test/Spec.hs index 06bc4ea..29a8789 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} -import Data.CLI.Impl (fromParsec) +import Data.CLI.Impl (fromParsec, reversibleSwitch) import Data.Error.CLI (CLIError (..), displayCLIError) import Effectful (Eff, IOE, liftIO, runEff) import Effectful.CLI.Conc (batchConcurrentlyWithIndex) @@ -78,3 +78,10 @@ main = hspec $ do it "rejects an invalid input" $ parse ["ko"] `shouldBe` Nothing + + describe "reversibleSwitch" + $ it "uses the default or the last occurrence" + $ let p = info (reversibleSwitch True "labels" "show labels") mempty + parse = getParseResult . execParserPure defaultPrefs p + in fmap parse [[], ["--no-labels"], ["--no-labels", "--labels"], ["--labels", "--no-labels"]] + `shouldBe` fmap Just [True, False, True, False]