opt-env-conf-test-0.0.0.2: src/OptEnvConf/Test.hs

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module OptEnvConf.Test
  ( -- * Lint test
    settingsLintSpec,
    parserLintSpec,
    parserLintTest,

    -- * Parse tests
    settingsParserArgsTest,
    parserArgsTest,
    settingsParserEnvTest,
    parserEnvTest,
    settingsParserConfTest,
    parserConfTest,
    settingsParserTest,
    parserTest,

    -- * Completion tests
    settingsParserCompletionTest,
    settingsParserCompletionDescriptionTest,
    parserCompletionTest,
    parserCompletionDescriptionTest,

    -- * Reference documentation
    goldenSettingsReferenceDocumentationSpec,
    goldenParserReferenceDocumentationSpec,
    pureGoldenReferenceDocumentation,

    -- * Nix options
    goldenSettingsNixOptionsSpec,
    goldenParserNixOptionsSpec,
    pureGoldenNixOptions,
    module OptEnvConf,
  )
where

import Data.Aeson as JSON
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Stack (HasCallStack, withFrozenCallStack)
import OptEnvConf
import OptEnvConf.Args
import OptEnvConf.Completion
import OptEnvConf.EnvMap as EnvMap
import OptEnvConf.Error
import OptEnvConf.Lint
import Test.Syd
import Text.Colour

settingsLintSpec :: forall a. (HasCallStack) => (HasParser a) => Spec
settingsLintSpec = withFrozenCallStack $ parserLintSpec (settingsParser @a)

parserLintSpec :: forall a. (HasCallStack) => Parser a -> Spec
parserLintSpec parser =
  withFrozenCallStack $
    specify "pass the lint test" $
      parserLintTest parser

parserLintTest :: Parser a -> IO ()
parserLintTest parser =
  case lintParser parser of
    Nothing -> pure ()
    Just errs ->
      expectationFailure $ T.unpack $ renderChunksText With24BitColours $ renderLintErrors errs

settingsParserArgsTest :: (Show a, Eq a, HasParser a) => [String] -> a -> IO ()
settingsParserArgsTest = parserArgsTest settingsParser

parserArgsTest :: (Show a, Eq a) => Parser a -> [String] -> a -> IO ()
parserArgsTest parser args = parserTest parser args [] Nothing

settingsParserEnvTest :: (Show a, Eq a, HasParser a) => [(String, String)] -> a -> IO ()
settingsParserEnvTest = parserEnvTest settingsParser

parserEnvTest :: (Show a, Eq a) => Parser a -> [(String, String)] -> a -> IO ()
parserEnvTest parser envVars = parserTest parser [] envVars Nothing

settingsParserConfTest :: (Show a, Eq a, HasParser a) => JSON.Object -> a -> IO ()
settingsParserConfTest = parserConfTest settingsParser

parserConfTest :: (Show a, Eq a) => Parser a -> JSON.Object -> a -> IO ()
parserConfTest parser obj = parserTest parser [] [] (Just obj)

settingsParserTest :: (Show a, Eq a, HasParser a) => [String] -> [(String, String)] -> Maybe JSON.Object -> a -> IO ()
settingsParserTest = parserTest settingsParser

parserTest :: (Show a, Eq a) => Parser a -> [String] -> [(String, String)] -> Maybe JSON.Object -> a -> IO ()
parserTest parser args envVars mObject expected = do
  errOrActual <- runParserOn Nothing parser (parseArgs args) (EnvMap.parse envVars) mObject
  case errOrActual of
    Left errs -> expectationFailure $ T.unpack $ renderChunksText With24BitColours $ renderErrors errs
    Right actual -> actual `shouldBe` expected

settingsParserCompletionTest :: forall a. (HasParser a) => Int -> [String] -> [Completion String] -> IO ()
settingsParserCompletionTest = parserCompletionTest (settingsParser @a)

settingsParserCompletionDescriptionTest :: forall a. (HasParser a) => Int -> [String] -> [String] -> IO ()
settingsParserCompletionDescriptionTest = parserCompletionDescriptionTest (settingsParser @a)

parserCompletionTest :: Parser a -> Int -> [String] -> [Completion String] -> IO ()
parserCompletionTest p ix ws expected = do
  let arg = fromMaybe "" $ listToMaybe $ drop ix ws
  let completions = pureCompletionQuery p ix ws
  evaluatedCompletions <- evalCompletions arg completions
  evaluatedCompletions `shouldBe` expected

parserCompletionDescriptionTest :: Parser a -> Int -> [String] -> [String] -> IO ()
parserCompletionDescriptionTest p ix ws descriptions = do
  let completions = pureCompletionQuery p ix ws
  map completionDescription completions `shouldBe` map Just descriptions

goldenSettingsReferenceDocumentationSpec :: forall a. (HasCallStack) => (HasParser a) => FilePath -> String -> Spec
goldenSettingsReferenceDocumentationSpec path progname = withFrozenCallStack $ goldenParserReferenceDocumentationSpec (settingsParser @a) path progname

goldenParserReferenceDocumentationSpec :: (HasCallStack) => Parser a -> FilePath -> String -> Spec
goldenParserReferenceDocumentationSpec parser path progname = withFrozenCallStack $ do
  specify "produces the same reference documentation as before" $
    pureGoldenReferenceDocumentation path progname parser

pureGoldenReferenceDocumentation :: FilePath -> String -> Parser a -> GoldenTest Text
pureGoldenReferenceDocumentation path progname parser =
  pureGoldenTextFile path $
    renderChunksText With24BitColours $
      renderReferenceDocumentation progname $
        parserDocs parser

goldenSettingsNixOptionsSpec :: forall a. (HasCallStack) => (HasParser a) => FilePath -> Spec
goldenSettingsNixOptionsSpec path = withFrozenCallStack $ goldenParserNixOptionsSpec (settingsParser @a) path

goldenParserNixOptionsSpec :: (HasCallStack) => Parser a -> FilePath -> Spec
goldenParserNixOptionsSpec parser path = withFrozenCallStack $ do
  specify "produces the nix options as before" $
    pureGoldenNixOptions path parser

pureGoldenNixOptions :: FilePath -> Parser a -> GoldenTest Text
pureGoldenNixOptions path parser =
  pureGoldenTextFile path $
    renderParserNixOptions parser