RFC.hs

-- |
--
-- Module      : Network.URI.Template.Test.RFC
-- Copyright   : (c) 2025 Patrick Brisbin
-- License     : AGPL-3
-- Maintainer  : pbrisbin@gmail.com
-- Stability   : experimental
-- Portability : POSIX
module Network.URI.Template.Test.RFC
  ( runRFCTests
  ) where

import Prelude

import Conduit
import Control.Monad (void)
import Data.Bifunctor (first)
import Data.Foldable (fold, for_, traverse_)
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Text (Text, unpack)
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Network.URI.Template.Expand
import Network.URI.Template.Internal
import Network.URI.Template.Internal.Parse (restOfLine)
import Network.URI.Template.Internal.Pretty
import Network.URI.Template.VarName
import Network.URI.Template.VarValue
import Test.Hspec
import Text.Megaparsec
import Text.Megaparsec.Char

runRFCTests :: HasCallStack => Spec
runRFCTests = do
  ecases <- runIO parseTestCases
  either (it "parsed examples" . expectationFailure) runTestCases ecases

runTestCases :: [TestCase] -> Spec
runTestCases tcs = traverse_ (runTestCase inputMaxWidth) tcs
 where
  inputMaxWidth =
    maximum -- unsafe: we don't expect empty test cases
      $ map (length . (.input))
      $ concatMap (.examples) tcs

runTestCase :: Int -> TestCase -> Spec
runTestCase inputMaxWidth tc = do
  context (renderPlain varDoc) $ do
    for_ tc.examples $ \e -> do
      it (pad inputMaxWidth e.input <> " => " <> unpack e.expected) $ do
        expandTemplate tc.vars e.template `shouldBe` e.expected
 where
  varMaxWidth =
    max inputMaxWidth
      $ maximum -- unsafe: we don't expect empty variables
      $ map (T.length . unVarName)
      $ Map.keys tc.vars

  varDoc =
    vsep
      [ "Variables"
      , indent 6
          $ vsep
          $ map (uncurry $ variablePretty varMaxWidth)
          $ Map.toList tc.vars
      , indent 4 "Examples"
      ]

pad :: Int -> String -> String
pad w s =
  let n = w - length s
  in  s <> if n > 0 then replicate n ' ' else ""

data TestCase = TestCase
  { vars :: Map VarName VarValue
  , examples :: [TestExample]
  }

data TestExample = TestExample
  { input :: String
  , template :: Template
  , expected :: Text
  }

parseTestCases :: IO (Either String [TestCase])
parseTestCases = do
  t <- T.readFile examples

  pure
    $ first (("RFC parse error:\n" <>) . errorBundlePretty)
    $ parse (some testCaseP <* eof) examples t
 where
  examples :: FilePath
  examples = "rfc/examples.txt"

type Parser = Parsec Void Text

testCaseP :: Parser TestCase
testCaseP =
  TestCase . fold
    <$> someTill (taggedP 'V' variableP) (lookAhead $ void (char 'E') <|> eof)
    <*> someTill (taggedP 'E' texampleP) (lookAhead $ void (char 'V') <|> eof)

taggedP :: Char -> Parser a -> Parser a
taggedP c p = char c *> char ' ' *> p <* hspace <* newline

texampleP :: Parser TestExample
texampleP = do
  (template, expected) <- (,) <$> templateP <*> (char ' ' *> restOfLine)
  pure
    TestExample
      { input = renderPlain $ templatePretty template
      , template
      , expected
      }