content: {-# LANGUAGE ApplicativeDo #-}
  {-# LANGUAGE OverloadedLists #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE TypeApplications #-}
  
  module OptEnvConf.HelpSpec (spec) where
  
  import Control.Applicative
  import Data.GenValidity.Aeson ()
  import Data.Text (Text)
  import qualified Data.Text as T
  import Data.Version
  import Data.Word
  import OptEnvConf
  import OptEnvConf.Args as Args
  import OptEnvConf.Args.Gen ()
  import OptEnvConf.EnvMap.Gen ()
  import OptEnvConf.Error
  import OptEnvConf.TestUtils
  import Test.Syd
  import Text.Colour
  
  spec :: Spec
  spec = do
    -- Help parsing works at the top level
    helpSpec
      "toplevel-pure"
      []
    -- Help parsing needs to work even if provided settings are invalid
    helpSpec
      "toplevel-pure-with-invalid-port"
      ["--port", "notaport"]
    helpSpec
      "read"
      ["read"]
    helpSpec
      "create"
      ["create"]
    helpSpec
      "sub"
      ["sub"]
    helpSpec
      "sub-foo"
      ["sub", "foo"]
    helpSpec
      "sub-bar"
      ["sub", "bar"]
    -- Help parsing needs to work if you type in the wrong command too.
    helpSpec
      "wrong-command"
      ["quux"]
  
  data Instructions = Instructions !Settings !Dispatch
  
  instance HasParser Instructions where
    settingsParser =
      withLocalYamlConfig $
        Instructions
          <$> settingsParser
          <*> settingsParser
  
  data Dispatch
    = DispatchRead
    | DispatchCreate !String
    | DispatchWithSub !Sub
  
  instance HasParser Dispatch where
    settingsParser =
      commands
        [ command "read" "read command explanation" $ pure DispatchRead,
          command "create" "create command explanation" $
            DispatchCreate
              <$> setting
                [ help "The item to create",
                  reader str,
                  argument,
                  metavar "STR"
                ],
          command "sub" "command with subcommand" $ DispatchWithSub <$> settingsParser
        ]
  
  data Sub
    = SubFoo
    | SubBar
  
  instance HasParser Sub where
    settingsParser =
      commands
        [ command "foo" "foo explanation" $ pure SubFoo,
          command "bar" "bar explanation" $ pure SubBar
        ]
  
  data Settings = Settings
    { settingPort :: Word16,
      settingLogLevel :: String,
      settingPaymentSettings :: Maybe PaymentSettings
    }
  
  instance HasParser Settings where
    settingsParser = do
      settingPort <-
        setting
          [ help "port to serve requests on",
            reader auto,
            metavar "PORT",
            name "port",
            value 8080
          ]
      settingLogLevel <-
        setting
          [ help "minimal severity of log messages",
            reader str,
            metavar "LOG_LEVEL",
            name "log-level",
            value "DEBUG"
          ]
      settingPaymentSettings <- optional $ subSettings "payment"
      pure Settings {..}
  
  data PaymentSettings = PaymentSettings
    { paymentSetPublicKey :: String,
      paymentSetSecretKey :: Text,
      paymentSetCurrency :: Maybe String
    }
  
  instance HasParser PaymentSettings where
    settingsParser = do
      paymentSetPublicKey <-
        setting
          [ help "Public key",
            reader str,
            name "public-key",
            metavar "PUBLIC_KEY"
          ]
      paymentSetSecretKey <-
        secretTextFileSetting
          [ help "Secret key",
            name "secret-key",
            metavar "SECRET_KEY_FILE"
          ]
      paymentSetCurrency <-
        optional $
          setting
            [ help "Currency",
              reader str,
              name "currency",
              metavar "CURRENCY"
            ]
      pure PaymentSettings {..}
  
  helpSpec :: String -> [String] -> Spec
  helpSpec file args =
    it (unwords ["this help page in the same way for args:", show args]) $ do
      let version = makeVersion [0, 0, 0]
      let argMap = Args.parseArgs args
      let parser = settingsParser @Instructions
      errOrDocs <- runHelpParser Nothing argMap parser
      case errOrDocs of
        Left err -> expectationFailure $ T.unpack $ renderChunksText With24BitColours $ renderErrors err
        Right mCommandDoc -> do
          let progname = "example"
          pure $
            pureGoldenChunksFile ("test_resources/help/" <> file <> ".txt") $
              case mCommandDoc of
                Nothing -> renderHelpPage progname version "example program description" (parserDocs parser)
                Just (commandPath, commandDoc) -> renderCommandHelpPage progname commandPath commandDoc
  