{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module OptEnvConf.APISpec (spec) where import Autodocodec import Data.Map (Map) import Data.Text (Text) import Data.Version import GHC.Stack (HasCallStack, withFrozenCallStack) import OptEnvConf import OptEnvConf.Test import OptEnvConf.TestUtils import Test.Syd import Text.Colour import Text.Show.Pretty as Pretty spec :: Spec spec = do exampleParserSpec "empty" "empty parser" emptyParser exampleParserSpec "many-args" "many args parser" manyArgsParser exampleParserSpec "some-args" "some args parser" someArgsParser exampleParserSpec "optional" "optional argument" optionalParser exampleParserSpec "big-config" "example with a big configuration" bigConfigParser exampleParserSpec "sub-settings" "example with a sub settings" subSettingsParser exampleParserSpec "hidden" "example with hidden settings" hiddenParser exampleParserSpec "enable-disable" "enableDisableSwitch example" enableDisableParser exampleParserSpec "yes-no" "yesNoSwitch example" yesNoParser exampleParserSpec "enable-disable-optional" "enableDisableSwitch' example" enableDisableParser' exampleParserSpec "yes-no-optional" "yesNoSwitch' example" yesNoParser' exampleParserSpec "verbose" "verbosity example" verboseParser exampleParserSpec "same-help" "example where multiple options use the same help string" sameHelpParser exampleParserSpec "sum-type" "Sum type example" sumTypeParser exampleParserSpec "secret" "Secrets example" secretParser exampleParserSpec "with-default" "withDefault example" withDefaultParser exampleParserSpec "greet" "hello world example" greetParser exampleParserSpec "three-commands" "example with three commands" threeCommandsParser exampleParserSpec "sub-commands" "example with subcommands" subCommandsParser exampleParserSpec :: (HasCallStack) => FilePath -> String -> Parser a -> Spec exampleParserSpec dir progDesc p = withFrozenCallStack $ describe dir $ do let version = makeVersion [0, 0, 0] it "passes the linter" $ parserLintTest p it "shows the parser in the same way" $ goldenStringFile ("test_resources/docs/" <> dir <> "/show.txt") $ case Pretty.parseValue (showParserABit (parserEraseSrcLocs p)) of Nothing -> expectationFailure "Error parsing value" Just v -> pure $ Pretty.valToStr v it "produces the same docs structure as before" $ pureGoldenStringFile ("test_resources/docs/" <> dir <> "/docs.txt") $ ppShow $ parserDocs p it "produces the same opt docs structure as before" $ pureGoldenStringFile ("test_resources/docs/" <> dir <> "/opt-docs.txt") $ ppShow $ parserOptDocs p it "produces the same env docs structure as before" $ pureGoldenStringFile ("test_resources/docs/" <> dir <> "/env-docs.txt") $ ppShow $ parserConfDocs p it "produces the same conf docs structure as before" $ pureGoldenStringFile ("test_resources/docs/" <> dir <> "/config-docs.txt") $ ppShow $ parserEnvDocs p it "documents the version page in the same way" $ pureGoldenChunksFile ("test_resources/docs/" <> dir <> "/version.txt") $ renderVersionPage dir version it "documents the help page in the same way" $ pureGoldenChunksFile ("test_resources/docs/" <> dir <> "/help.txt") $ renderHelpPage dir version progDesc $ parserDocs p it "documents the short opt parser in the same way" $ pureGoldenChunksFile ("test_resources/docs/" <> dir <> "/opt-short.txt") $ renderShortOptDocs dir $ parserOptDocs p it "documents the long opt parser in the same way" $ pureGoldenChunksFile ("test_resources/docs/" <> dir <> "/opt-long.txt") $ renderLongOptDocs $ parserOptDocs p it "documents the env parser in the same way" $ pureGoldenChunksFile ("test_resources/docs/" <> dir <> "/env.txt") $ renderEnvDocs $ parserEnvDocs p it "documents the conf parser in the same way" $ pureGoldenChunksFile ("test_resources/docs/" <> dir <> "/config.txt") $ renderConfDocs $ parserConfDocs p it "documents the man page in the same way" $ pureGoldenTextFile ("test_resources/docs/" <> dir <> "/man.txt") $ renderChunksText WithoutColours $ renderManPage dir version progDesc $ parserDocs p it "renders the reference documentation in the same way" $ pureGoldenChunksFile ("test_resources/docs/" <> dir <> "/reference.txt") $ renderReferenceDocumentation dir $ parserDocs p it "renders the Nix options the same way" $ pureGoldenTextFile ("test_resources/docs/" <> dir <> "/nix-options.nix") $ renderParserNixOptions p sameHelpParser :: Parser (Either Int String, Bool) sameHelpParser = withoutConfig $ let h = help "int or string" in (,) <$> choice [ Left <$> setting [ h, name "int", reader auto, metavar "INT" ], Right <$> setting [ h, name "string", reader str, metavar "STR" ] ] <*> yesNoSwitch [ h, name "other", value True ] data SumType = SumTypeA | SumTypeB deriving (Show) instance HasCodec SumType where codec = bimapCodec parseSumType renderSumType codec parseSumType :: String -> Either String SumType parseSumType = \case "a" -> pure SumTypeA "b" -> pure SumTypeB s -> Left $ unwords ["Unknown 'SumType':", s] renderSumType :: SumType -> String renderSumType = \case SumTypeA -> "a" SumTypeB -> "b" sumTypeParser :: Parser SumType sumTypeParser = withoutConfig $ let h = help "example" in choice [ setting [ help "a", switch SumTypeA, short 'a' ], setting [ help "b", switch SumTypeB, short 'b' ], setting [ h, reader $ eitherReader parseSumType, env "sum-type", metavar "SUM_TYPE" ], setting [ h, conf "sum-type" ], setting [ h, valueWithShown renderSumType SumTypeA ] ] secretParser :: Parser (Text, Text, Text, Text, Text) secretParser = withoutConfig $ (,,,,) <$> secretTextFileSetting [ help "First example secret", name "first-secret-file" ] <*> secretTextFileOrBareSetting [ help "Second example secret, bare or in a file", name "second-secret" ] <*> secretTextFileOrBareSetting [ help "Second example secret, bare or in a file, only option", option, long "second-secret" ] <*> secretTextFileOrBareSetting [ help "Second example secret, bare or in a file, only env", env "second-secret" ] <*> secretTextFileOrBareSetting [ help "Second example secret, bare or in a file, only conf", conf "second-secret" ] data FirstOrSecond = First | Second deriving (Show) instance HasParser FirstOrSecond where settingsParser = -- This version has no default value, so we can add one with 'withDefault' choice [ setting [ help "first", switch First, short 'f', long "first" ], setting [ help "second", switch Second, short 's', long "second" ] ] withDefaultParser :: Parser FirstOrSecond withDefaultParser = withDefault Second settingsParser data Greet = Greet !String !String !Bool greetParser :: Parser Greet greetParser = subEnv "GREET_" $ withLocalYamlConfig $ Greet <$> setting [ reader str, option, short 'g', long "greeting", metavar "GREETING", env "GREETING", conf "greeting", value "Hello", example "Greetings", help "Greeting to use" ] <*> setting [ reader str, argument, help "Who to greet", value "world", metavar "SUBJECT" ] <*> setting [ reader exists, switch True, short 'p', long "polite", env "POLITE", conf "polite", metavar "ANY", value False, help "Whether to be polite" ] data BigConfig = BigConfig { bigConfigMap :: Map String (Map String Int), bigConfigSubObject :: Maybe Text } instance HasCodec BigConfig where codec = object "BigConfig" $ BigConfig <$> requiredField' "map" .= bigConfigMap <*> optionalField' "sub" .= bigConfigSubObject bigConfigParser :: Parser BigConfig bigConfigParser = withLocalYamlConfig $ setting [ conf "big", help "big configuration object" ] subSettingsParser :: Parser String subSettingsParser = withLocalYamlConfig $ subAll "foo" $ subAll "bar" $ setting [ reader str, name "quux", help "Example with sub-settings", metavar "STR" ] manyArgsParser :: Parser [String] manyArgsParser = many ( setting [ reader str, argument, help "Argument", metavar "ARGUMENT" ] ) someArgsParser :: Parser [String] someArgsParser = some ( setting [ reader str, argument, help "Argument", metavar "ARGUMENT" ] ) data Optional = Optional (Maybe String) optionalParser :: Parser Optional optionalParser = Optional <$> optional ( setting [ reader str, argument, help "Argument", metavar "ARGUMENT" ] ) data Hidden = Hidden String hiddenParser :: Parser Hidden hiddenParser = Hidden <$> setting [ reader str, argument, hidden, metavar "STR", value "default", help "Example of a hidden setting" ] data EnableDisable = EnableDisable Bool enableDisableParser :: Parser EnableDisable enableDisableParser = withoutConfig $ EnableDisable <$> enableDisableSwitch [ long "example", help "Example of an enable/disable switch", env "EXAMPLE", conf "example", value True ] enableDisableParser' :: Parser (Maybe EnableDisable) enableDisableParser' = withoutConfig $ fmap EnableDisable <$> optional ( enableDisableSwitch [ long "example", help "Example of an enable/disable switch", env "EXAMPLE", conf "example" ] ) data YesNo = YesNo Bool yesNoParser :: Parser YesNo yesNoParser = withoutConfig $ YesNo <$> yesNoSwitch [ long "example", help "Example of a yes/no switch", env "EXAMPLE", conf "example", value True ] yesNoParser' :: Parser (Maybe YesNo) yesNoParser' = withoutConfig $ fmap YesNo <$> optional ( yesNoSwitch [ long "example", help "Example of a yes/no switch", env "EXAMPLE", conf "example" ] ) data Empty = Empty emptyParser :: Parser Empty emptyParser = pure Empty data ThreeCommands = One !String | Two !Int !Bool | Three threeCommandsParser :: Parser ThreeCommands threeCommandsParser = withoutConfig $ commands [ command "one" "first" $ One <$> setting [ help "argument", reader str, metavar "STR", argument ], command "two" "second" $ Two <$> setting [ help "number", reader auto, option, metavar "INT", name "number", short 'n', shownExample 5 ] <*> enableDisableSwitch [ help "enable extra", name "enable", value False ], command "three-very-long-command-name" "third" (pure Three), defaultCommand "one" ] data SubCommands = Top !String | Sub !Sub1 !Sub2 subCommandsParser :: Parser SubCommands subCommandsParser = withLocalYamlConfig $ commands [ command "top" "command without subcommands" $ Top <$> setting [ help "name", reader str, metavar "NAME", name "name", example "john" ], command "sub" "command with subcommands" $ Sub <$> sub1Parser <*> sub2Parser ] data Sub1 = A | B sub1Parser :: Parser Sub1 sub1Parser = commands [ command "a" "A" $ pure A, command "b" "B" $ pure B ] data Sub2 = C | D sub2Parser :: Parser Sub2 sub2Parser = commands [ command "c" "C" $ pure C, command "d" "D" $ pure D, defaultCommand "c" ] verboseParser :: Parser Int verboseParser = length <$> many ( setting [ help "Verbosity level. Use multiple to increase verbosity", short 'v', switch () ] )