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

module OptEnvConf.Test
  ( settingsLintSpec,
    parserLintSpec,
    parserLintTest,
    goldenSettingsReferenceDocumentationSpec,
    goldenParserReferenceDocumentationSpec,
    pureGoldenReferenceDocumentation,
  )
where

import Data.Text (Text)
import qualified Data.Text as T
import GHC.Stack (HasCallStack, withFrozenCallStack)
import OptEnvConf
import OptEnvConf.Lint
import Test.Syd
import Text.Colour

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

parserLintSpec :: forall a. (HasCallStack) => Parser a -> Spec
parserLintSpec :: forall a. HasCallStack => Parser a -> Spec
parserLintSpec Parser a
parser =
  (HasCallStack => Spec) -> Spec
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Spec) -> Spec) -> (HasCallStack => Spec) -> Spec
forall a b. (a -> b) -> a -> b
$
    String -> IO () -> Spec
forall (outers :: [*]) inner test.
(HasCallStack, IsTest test, Arg1 test ~ (), Arg2 test ~ inner) =>
String -> test -> TestDefM outers inner ()
specify String
"pass the lint test" (IO () -> Spec) -> IO () -> Spec
forall a b. (a -> b) -> a -> b
$
      Parser a -> IO ()
forall a. Parser a -> IO ()
parserLintTest Parser a
parser

parserLintTest :: Parser a -> IO ()
parserLintTest :: forall a. Parser a -> IO ()
parserLintTest Parser a
parser =
  case Parser a -> Maybe (NonEmpty LintError)
forall a. Parser a -> Maybe (NonEmpty LintError)
lintParser Parser a
parser of
    Maybe (NonEmpty LintError)
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just NonEmpty LintError
errs ->
      String -> IO ()
forall a. HasCallStack => String -> IO a
expectationFailure (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ TerminalCapabilities -> [Chunk] -> Text
forall (f :: * -> *).
Foldable f =>
TerminalCapabilities -> f Chunk -> Text
renderChunksText TerminalCapabilities
With24BitColours ([Chunk] -> Text) -> [Chunk] -> Text
forall a b. (a -> b) -> a -> b
$ NonEmpty LintError -> [Chunk]
renderLintErrors NonEmpty LintError
errs

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

goldenParserReferenceDocumentationSpec :: (HasCallStack) => Parser a -> FilePath -> String -> Spec
goldenParserReferenceDocumentationSpec :: forall a. HasCallStack => Parser a -> String -> String -> Spec
goldenParserReferenceDocumentationSpec Parser a
parser String
path String
progname = (HasCallStack => Spec) -> Spec
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Spec) -> Spec) -> (HasCallStack => Spec) -> Spec
forall a b. (a -> b) -> a -> b
$ do
  String -> GoldenTest Text -> Spec
forall (outers :: [*]) inner test.
(HasCallStack, IsTest test, Arg1 test ~ (), Arg2 test ~ inner) =>
String -> test -> TestDefM outers inner ()
specify String
"produces the same reference documentation as before" (GoldenTest Text -> Spec) -> GoldenTest Text -> Spec
forall a b. (a -> b) -> a -> b
$
    String -> String -> Parser a -> GoldenTest Text
forall a. String -> String -> Parser a -> GoldenTest Text
pureGoldenReferenceDocumentation String
path String
progname Parser a
parser

pureGoldenReferenceDocumentation :: FilePath -> String -> Parser a -> GoldenTest Text
pureGoldenReferenceDocumentation :: forall a. String -> String -> Parser a -> GoldenTest Text
pureGoldenReferenceDocumentation String
path String
progname Parser a
parser =
  String -> Text -> GoldenTest Text
pureGoldenTextFile String
path (Text -> GoldenTest Text) -> Text -> GoldenTest Text
forall a b. (a -> b) -> a -> b
$
    TerminalCapabilities -> [Chunk] -> Text
forall (f :: * -> *).
Foldable f =>
TerminalCapabilities -> f Chunk -> Text
renderChunksText TerminalCapabilities
With24BitColours ([Chunk] -> Text) -> [Chunk] -> Text
forall a b. (a -> b) -> a -> b
$
      String -> AnyDocs SetDoc -> [Chunk]
renderReferenceDocumentation String
progname (AnyDocs SetDoc -> [Chunk]) -> AnyDocs SetDoc -> [Chunk]
forall a b. (a -> b) -> a -> b
$
        Parser a -> AnyDocs SetDoc
forall a. Parser a -> AnyDocs SetDoc
parserDocs Parser a
parser