settei-optparse-applicative (empty) → 0.1.0.0

raw patch · 6 files changed

+455/−0 lines, 6 filesdep +basedep +containersdep +generic-lens

Dependencies added: base, containers, generic-lens, optparse-applicative, settei, settei-env, settei-optparse-applicative, tasty, tasty-hunit, text

Files

• CHANGELOG.md +6/−0
• LICENSE +28/−0
• settei-optparse-applicative.cabal +62/−0
• src/Settei/Optparse.hs +208/−0
• test/Main.hs +7/−0
• test/Settei/OptparseTest.hs +144/−0

@@ -0,0 +1,6 @@+# Changelog for settei-optparse-applicative++## 0.1.0.0 — 2026-07-18++- Initial experimental release.+- Add ordered generic and named command-line overrides for optparse-applicative 0.19.

@@ -0,0 +1,28 @@+Copyright (c) 2026, shinzui+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+   this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,62 @@+cabal-version:   3.8+name:            settei-optparse-applicative+version:         0.1.0.0+synopsis:        optparse-applicative sources for Settei+description:+  Parse generic and named command-line overrides into provenance-aware Settei+  source fragments while preserving occurrence order.++homepage:        https://github.com/shinzui/settei+bug-reports:     https://github.com/shinzui/settei/issues+license:         BSD-3-Clause+license-file:    LICENSE+author:          shinzui+maintainer:      shinzui+category:        Configuration+build-type:      Simple+tested-with:     GHC ==9.12.4+extra-doc-files: CHANGELOG.md++source-repository head+  type:     git+  location: https://github.com/shinzui/settei.git++common common+  default-language:   GHC2024+  default-extensions:+    DeriveAnyClass+    DuplicateRecordFields+    OverloadedLabels+    OverloadedStrings++  ghc-options:        -Wall -Wcompat++library+  import:          common+  hs-source-dirs:  src+  exposed-modules: Settei.Optparse+  build-depends:+    , base                  >=4.21    && <5+    , containers            >=0.6.8   && <0.8+    , generic-lens          >=2.2     && <2.4+    , optparse-applicative  >=0.19    && <0.20+    , settei                ==0.1.0.0+    , text                  >=2.1     && <2.2++test-suite settei-optparse-applicative-tests+  import:         common+  type:           exitcode-stdio-1.0+  hs-source-dirs: test+  main-is:        Main.hs+  other-modules:  Settei.OptparseTest+  build-depends:+    , base                         >=4.21    && <5+    , containers                   >=0.6.8   && <0.8+    , generic-lens                 >=2.2     && <2.4+    , optparse-applicative         >=0.19    && <0.20+    , settei                       ==0.1.0.0+    , settei-env                   ==0.1.0.0+    , settei-optparse-applicative  ==0.1.0.0+    , tasty                        >=1.5     && <1.6+    , tasty-hunit                  >=0.10.2  && <0.11+    , text                         >=2.1     && <2.2

@@ -0,0 +1,208 @@+-- |+-- Module: Settei.Optparse+-- Description: optparse-applicative parsers that produce ordered Settei sources.+module Settei.Optparse+  ( CliOverride,+    ExplainMode (..),+    SetteiOptions (..),+    cliOverride,+    cliOverrideKey,+    cliOverrideSpelling,+    cliOverrideValue,+    cliSources,+    configPathOptions,+    configPathOptionsWith,+    explainModeOptions,+    explainModeOptionsWith,+    namedOption,+    overrideOptions,+    overrideOptionsWith,+    setteiOptions,+  )+where++import Control.Applicative qualified as Applicative+import Data.Generics.Labels ()+import Data.List.NonEmpty qualified as NonEmpty+import Data.Map.Strict qualified as Map+import Data.Text qualified as Text+import Options.Applicative (FlagFields, Mod, OptionFields, Parser)+import Options.Applicative qualified as Options+import Settei+import Settei.Prelude++-- | One parsed @--set KEY=VALUE@ override.+--+-- The constructor stays private because 'spelling' is safe origin text and must never+-- contain the raw value of a potentially secret setting.+data CliOverride = CliOverride+  { key :: !Key,+    value :: !RawValue,+    spelling :: !Text+  }+  deriving stock (Generic, Eq)++-- | Whether an application should print a configuration explanation.+data ExplainMode = NoExplain | ExplainText | ExplainJson+  deriving stock (Generic, Eq, Ord, Show)++-- | Reusable configuration and diagnostic command-line options.+data SetteiOptions = SetteiOptions+  { configPaths :: ![FilePath],+    overrides :: ![CliOverride],+    explainMode :: !ExplainMode+  }+  deriving stock (Generic, Eq)++data ConfigurationOptions = ConfigurationOptions+  { configPaths :: ![FilePath],+    overrides :: ![CliOverride]+  }+  deriving stock (Generic, Eq)++newtype DiagnosticOptions = DiagnosticOptions+  { explainMode :: ExplainMode+  }+  deriving stock (Generic, Eq)++-- | Construct an override programmatically while keeping its origin spelling secret-safe.+cliOverride :: Key -> Text -> CliOverride+cliOverride key value =+  CliOverride+    { key,+      value = RawText value,+      spelling = "--set " <> renderKey key+    }++-- | Return the target key.+cliOverrideKey :: CliOverride -> Key+cliOverrideKey value = value ^. #key++-- | Return the raw text value for core decoding.+cliOverrideValue :: CliOverride -> RawValue+cliOverrideValue value = value ^. #value++-- | Return a safe spelling that names the option and key but omits its value.+cliOverrideSpelling :: CliOverride -> Text+cliOverrideSpelling value = value ^. #spelling++-- | Parse zero or more generic @--set KEY=VALUE@ overrides.+overrideOptions :: Parser [CliOverride]+overrideOptions =+  overrideOptionsWith+    ( Options.long "set"+        <> Options.metavar "KEY=VALUE"+        <> Options.help "Override one configuration key"+    )++-- | Parse generic overrides using caller-supplied option metadata.+overrideOptionsWith :: Mod OptionFields CliOverride -> Parser [CliOverride]+overrideOptionsWith modifiers = Applicative.many (Options.option overrideReader modifiers)++-- | Convert parsed overrides to low-to-high source fragments.+--+-- Each fragment has its own occurrence annotation, so repeated keys retain their full+-- shadow trace and the final list item wins under normal core resolution.+cliSources :: Text -> [CliOverride] -> [Source]+cliSources sourceLabel overrides =+  zipWith (sourceForOverride sourceLabel) [1 :: Int ..] overrides++-- | Parse one optional named flag as a source fragment.+--+-- The supplied spelling should be safe display text such as @--port@. The caller controls+-- the target key and all optparse-applicative metadata.+namedOption :: Text -> Key -> Mod OptionFields Text -> Parser (Maybe Source)+namedOption spelling key modifiers =+  fmap (namedSource spelling key) <$> Applicative.optional (Options.strOption modifiers)++-- | Parse zero or more @--config PATH@ occurrences without opening any file.+configPathOptions :: Parser [FilePath]+configPathOptions =+  configPathOptionsWith+    ( Options.long "config"+        <> Options.metavar "PATH"+        <> Options.help "Read configuration from PATH"+    )++-- | Parse config paths using caller-supplied option metadata.+configPathOptionsWith :: Mod OptionFields FilePath -> Parser [FilePath]+configPathOptionsWith modifiers = Applicative.many (Options.strOption modifiers)++-- | Parse the default mutually exclusive explanation flags.+explainModeOptions :: Parser ExplainMode+explainModeOptions =+  explainModeOptionsWith+    (Options.long "explain-config" <> Options.help "Explain the resolved configuration as text")+    (Options.long "explain-config-json" <> Options.help "Explain the resolved configuration as JSON")++-- | Parse caller-named mutually exclusive text and JSON explanation flags.+explainModeOptionsWith :: Mod FlagFields ExplainMode -> Mod FlagFields ExplainMode -> Parser ExplainMode+explainModeOptionsWith textModifiers jsonModifiers =+  Options.flag' ExplainText textModifiers+    Applicative.<|> Options.flag' ExplainJson jsonModifiers+    Applicative.<|> pure NoExplain++-- | Parse the reusable Configuration and Diagnostics option groups.+setteiOptions :: Parser SetteiOptions+setteiOptions = assemble <$> configurationOptions <*> diagnosticOptions+  where+    assemble configuration diagnostics =+      SetteiOptions+        { configPaths = configuration ^. #configPaths,+          overrides = configuration ^. #overrides,+          explainMode = diagnostics ^. #explainMode+        }++configurationOptions :: Parser ConfigurationOptions+configurationOptions =+  Options.parserOptionGroup+    "Configuration"+    (ConfigurationOptions <$> configPathOptions <*> overrideOptions)++diagnosticOptions :: Parser DiagnosticOptions+diagnosticOptions =+  Options.parserOptionGroup+    "Diagnostics"+    (DiagnosticOptions <$> explainModeOptions)++overrideReader :: Options.ReadM CliOverride+overrideReader = Options.eitherReader $ \input ->+  let rendered = Text.pack input+      (keyText, assignment) = Text.breakOn "=" rendered+   in if Text.null assignment+        then Left "expected KEY=VALUE"+        else case parseKey keyText of+          Left keyError -> Left ("invalid configuration key: " <> show keyError)+          Right key -> Right (cliOverride key (Text.drop 1 assignment))++sourceForOverride :: Text -> Int -> CliOverride -> Source+sourceForOverride sourceLabel occurrence override =+  annotateSource+    ( Map.fromList+        [ ("command-line.option", "--set"),+          ("command-line.occurrence", Text.pack (show occurrence)),+          ("command-line.spelling", override ^. #spelling)+        ]+    )+    ( source+        (sourceLabel <> " --set #" <> Text.pack (show occurrence))+        CommandLineSource+        (rawValueAt (override ^. #key) (override ^. #value))+    )++namedSource :: Text -> Key -> Text -> Source+namedSource spelling key value =+  annotateSource+    ( Map.fromList+        [ ("command-line.option", spelling),+          ("command-line.spelling", spelling)+        ]+    )+    (source spelling CommandLineSource (rawValueAt key (RawText value)))++rawValueAt :: Key -> RawValue -> RawValue+rawValueAt key value =+  foldr+    (\segment child -> RawObject (Map.singleton segment child))+    value+    (NonEmpty.toList (keySegments key))

@@ -0,0 +1,7 @@+module Main (main) where++import Settei.OptparseTest qualified+import Test.Tasty (defaultMain, testGroup)++main :: IO ()+main = defaultMain (testGroup "settei-optparse-applicative" [Settei.OptparseTest.tests])

@@ -0,0 +1,144 @@+module Settei.OptparseTest (tests) where++import Data.Generics.Labels ()+import Data.List.NonEmpty qualified as NonEmpty+import Data.Map.Strict qualified as Map+import Data.Text qualified as Text+import Options.Applicative qualified as Options+import Settei+import Settei.Env+import Settei.Optparse+import Settei.Prelude+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "Settei.Optparse"+    [ testCase "final repeated --set wins with shadow trace" $ do+        overrides <- expectParse overrideOptions ["--set", "service.port=9000", "--set", "service.port=9001"]+        environment <- environmentPort 8000+        result <-+          expectResolution+            ( resolve+                defaultResolveOptions+                ([portSource "built-in" BuiltInSource 6000, portSource "file" (FileSource "memory") 7000, environment] <> cliSources "arguments" overrides)+                (required portSetting)+            )+        result ^. #value @?= 9001+        case result ^. #report . #nodes . at servicePort of+          Just node -> do+            node ^. #origin . _Just . #annotations . at "command-line.occurrence" @?= Just "2"+            fmap (^. #name) (node ^. #shadowed)+              @?= ["arguments --set #1", "environment", "file", "built-in"]+          Nothing -> fail "expected the resolved port node",+      testCase "execParserPure rejects an invalid key" $ do+        let parsed = parse overrideOptions ["--set", "service..port=9000"]+        assertBool "invalid key unexpectedly parsed" (Options.getParseResult parsed == Nothing),+      testCase "malformed final CLI value does not fall back" $ do+        overrides <- expectParse overrideOptions ["--set", "service.port=9000", "--set", "service.port=broken"]+        environment <- environmentPort 8000+        case resolve defaultResolveOptions (environment : cliSources "arguments" overrides) (required portSetting) of+          Left errors -> case NonEmpty.toList errors of+            [DecodeError problem] -> do+              problem ^. #origin . #name @?= "arguments --set #2"+              problem ^. #origin . #annotations . at "command-line.occurrence" @?= Just "2"+            _ -> fail "expected one CLI decode error"+          Right _ -> fail "expected the malformed final override to fail",+      testCase "secret override spelling omits the value" $ do+        overrides <- expectParse overrideOptions ["--set", "database.password=" <> Text.unpack secretSentinel]+        result <- expectResolution (resolve defaultResolveOptions (cliSources "arguments" overrides) (required passwordSetting))+        let textOutput = renderResolutionText (result ^. #report)+            jsonOutput = renderResolutionJson (result ^. #report)+        assertBool "secret reached text output" (not (secretSentinel `Text.isInfixOf` textOutput))+        assertBool "secret reached JSON output" (not (secretSentinel `Text.isInfixOf` jsonOutput))+        case overrides of+          [override] -> cliOverrideSpelling override @?= "--set database.password"+          _ -> fail "expected one secret override",+      testCase "named option produces an optional source fragment" $ do+        input <-+          expectParse+            (namedOption "--port" servicePort (Options.long "port" <> Options.metavar "PORT"))+            ["--port", "8080"]+        case input of+          Nothing -> fail "expected the named option source"+          Just sourceValue -> do+            result <- expectResolution (resolve defaultResolveOptions [sourceValue] (required portSetting))+            result ^. #value @?= 8080,+      testCase "setteiOptions parses grouped paths, overrides, and diagnostics" $ do+        parsed <-+          expectParse+            setteiOptions+            [ "--config",+              "base.yaml",+              "--config",+              "local.yaml",+              "--set",+              "service.port=8080",+              "--explain-config-json"+            ]+        parsed ^. #configPaths @?= ["base.yaml", "local.yaml"]+        length (parsed ^. #overrides) @?= 1+        parsed ^. #explainMode @?= ExplainJson,+      testCase "explanation modes are mutually exclusive" $ do+        let parsed = parse explainModeOptions ["--explain-config", "--explain-config-json"]+        assertBool "both explanation modes unexpectedly parsed" (Options.getParseResult parsed == Nothing),+      testCase "help groups configuration and diagnostics by intent" $ do+        let parserInfo = Options.info (setteiOptions Options.<**> Options.helper) Options.fullDesc+        case Options.execParserPure Options.defaultPrefs parserInfo ["--help"] of+          Options.Failure failure -> do+            let (helpText, _) = Options.renderFailure failure "settei-example"+            assertBool "Configuration group missing" ("Configuration" `Text.isInfixOf` Text.pack helpText)+            assertBool "Diagnostics group missing" ("Diagnostics" `Text.isInfixOf` Text.pack helpText)+          _ -> fail "expected --help to produce parser help"+    ]++parse :: Options.Parser a -> [String] -> Options.ParserResult a+parse parser arguments =+  Options.execParserPure Options.defaultPrefs (Options.info parser Options.fullDesc) arguments++expectParse :: Options.Parser a -> [String] -> IO a+expectParse parser arguments =+  case Options.getParseResult (parse parser arguments) of+    Nothing -> fail "expected command-line parsing to succeed"+    Just value -> pure value++expectResolution :: Either (NonEmpty ConfigError) a -> IO a+expectResolution = \case+  Left _ -> fail "expected configuration resolution to succeed"+  Right value -> pure value++environmentPort :: Int -> IO Source+environmentPort value =+  case envSource+    "environment"+    [binding (EnvName "SERVICE_PORT") servicePort]+    (envSnapshot [("SERVICE_PORT", Text.pack (show value))]) of+    Left _ -> fail "expected a valid environment source"+    Right sourceValue -> pure sourceValue++portSource :: Text -> SourceKind -> Int -> Source+portSource name kind value =+  source+    name+    kind+    (RawObject (Map.singleton "service" (RawObject (Map.singleton "port" (RawNumber (fromIntegral value))))))++portSetting :: Setting Int+portSetting = publicSetting servicePort "Service port" boundedIntegralDecoder++passwordSetting :: Setting Text+passwordSetting = secretSetting databasePassword "Database password" textDecoder++servicePort :: Key+servicePort = validKey "service.port"++databasePassword :: Key+databasePassword = validKey "database.password"++validKey :: Text -> Key+validKey value = either (error . show) id (parseKey value)++secretSentinel :: Text+secretSentinel = "never-render-this-cli-secret"