{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE UndecidableInstances #-}

module HUnits where

import Network.URI.Slug ()
import Relude
import Test.Tasty
import Test.Tasty.HUnit

import Examples.Ex01 qualified as Ex01
import Utils
import Webc

test :: TestTree
test =
  testGroup
    "HUnits"
    [ testGroup
        "Generator"
        [ testGenerator
            "Ex01"
            Ex01.site
            [ Gen ["index.html"] $ Ex01.Index
            , Gen ["about.html"] $ Ex01.About
            , Gen ["user", "contact.html"] $ Ex01.Contact "user"
            , Gen ["post"] $ Ex01.Post []
            , Gen ["post", "dir"] $ Ex01.Post ["dir"]
            , Gen ["post", "dir", "dir"] $ Ex01.Post ["dir", "dir"]
            ]
            [ Ex01.Index
            , Ex01.About
            , Ex01.Contact "user"
            , Ex01.Post []
            , Ex01.Post ["dir"]
            , Ex01.Post ["dir", "dir"]
            ]
        ]
    , testGroup
        "CoderIsomorphism"
        [ testCoderIsomorphism "Ex01" Ex01.site
        ]
    , testGroup
        "Encoder"
        [ testEncoder
            "Ex01"
            Ex01.site
            [ Gen ["index.html"] $ Ex01.Index
            , Gen ["about.html"] $ Ex01.About
            , Gen ["user", "contact.html"] $ Ex01.Contact "user"
            , Gen ["post", "a", "b"] $ Ex01.Post ["a", "b"]
            ]
        ]
    , testGroup
        "Decoder"
        [ testDecoder
            "Ex01"
            Ex01.site
            [ Gen ["index.html"] $ Ex01.Index
            , Gen ["about.html"] $ Ex01.About
            , Gen ["user", "contact.html"] $ Ex01.Contact "user"
            , Gen ["post", "a", "b"] $ Ex01.Post ["a", "b"]
            ]
        ]
    ]

testGenerator ::
  Eq a =>
  Show a =>
  String ->
  Generator a ->
  {-expected-} [Gen a] ->
  {-expected-} [a] ->
  TestTree
testGenerator tn site expectedCheck expectedValues =
  testGroup
    tn
    [ testCase "generate" $ gen @?= expectedCheck
    , testCase "generateValues" $ genValue <$> gen @?= expectedValues
    ]
  where
    gen = generate site

testCoderIsomorphism ::
  Eq a =>
  Show a =>
  String ->
  (forall repr. Testable repr => repr a) ->
  TestTree
testCoderIsomorphism tn site =
  testGroup tn $
    zipWith
      ( \n Gen{..} ->
          testGroup n $
            [ (testCase "decode . encode" $ decode site (encode site genValue) @?= Right genValue)
            , (testCase "encode . decode" $ encode site <$> decode site genSlugs @?= Right genSlugs)
            ]
      )
      (show <$> [1 :: Int ..])
      (generate site)

testDecoder :: (Eq a, Show a) => String -> Decoder a -> [Gen a] -> TestTree
testDecoder tn site as =
  testGroup tn $
    zipWith
      (\n Gen{..} -> testCase n $ decode site genSlugs @?= Right genValue)
      (show <$> [1 :: Int ..])
      as

testEncoder :: String -> Encoder a -> [Gen a] -> TestTree
testEncoder tn site as =
  testGroup tn $
    zipWith
      (\n Gen{..} -> testCase n $ encode site genValue @?= genSlugs)
      (show <$> [1 :: Int ..])
      as