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

module HUnits where

import Data.Tree
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
            [ Node (GeneratorNode Ex01.Index ["index.html"]) []
            , Node (GeneratorNode Ex01.About ["about.html"]) []
            , Node (GeneratorNode (Ex01.Contact "user") ["user", "contact.html"]) []
            , Node (GeneratorNode (Ex01.Post []) ["post"]) []
            , Node (GeneratorNode (Ex01.Post ["dir"]) ["post", "dir"]) []
            , Node (GeneratorNode (Ex01.Post ["dir", "dir"]) ["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
            [ (Ex01.Index, ["index.html"])
            , (Ex01.About, ["about.html"])
            , (Ex01.Contact "user", ["user", "contact.html"])
            , (Ex01.Post ["a", "b"], ["post", "a", "b"])
            ]
        ]
    , testGroup
        "Decoder"
        [ testDecoder
            "Ex01"
            Ex01.site
            [ (Ex01.Index, ["index.html"])
            , (Ex01.About, ["about.html"])
            , (Ex01.Contact "user", ["user", "contact.html"])
            , (Ex01.Post ["a", "b"], ["post", "a", "b"])
            ]
        ]
    ]

testGenerator ::
  Eq a =>
  Show a =>
  String ->
  Generator a ->
  {-expected-} (Forest (GeneratorNode a)) ->
  {-expected-} [a] ->
  TestTree
testGenerator tn site expectedCheck expectedValues =
  let lay = generator site
   in testGroup
        tn
        [ testCase "generate" $ generate lay @?= expectedCheck
        , testCase "generateValues" $ generateValues lay @?= expectedValues
        ]

testCoderIsomorphism ::
  Eq a =>
  Show a =>
  String ->
  (forall repr. Testable repr => repr a) ->
  TestTree
testCoderIsomorphism tn site =
  testGroup tn $
    zipWith
      ( \n (a, slugs) ->
          testGroup n $
            [ (testCase "decode . encode" $ decode site (encode site a) @?= Right a)
            , (testCase "encode . decode" $ encode site <$> decode site slugs @?= Right slugs)
            ]
      )
      (show <$> [1 :: Int ..])
      (zip (generateValues site) (generateSlugs site))

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

testEncoder :: String -> Encoder a -> [(a, [Slug])] -> TestTree
testEncoder tn site as =
  testGroup tn $
    zipWith
      (\n (a, expected) -> testCase n $ encode site a @?= expected)
      (show <$> [1 :: Int ..])
      as