{-# 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
        "Layouter"
        [ testLayouter
            "Ex01"
            Ex01.site
            [ Node (LayoutNodeSlug Ex01.Index ["index.html"]) []
            , Node (LayoutNodeSlug Ex01.About ["about.html"]) []
            , Node (LayoutNodeSlug (Ex01.Contact "<user>") ["<user>", "contact.html"]) []
            ]
            [ Ex01.Index
            , Ex01.About
            , Ex01.Contact "<user>"
            ]
        ]
    , testGroup
        "CoderIsomorphism"
        [ testCoderIsomorphism "Ex01" Ex01.site
        ]
    , testGroup
        "Encoder"
        [ testEncoder
            "Ex01"
            Ex01.site
            [ (Ex01.Index, ["index.html"])
            , (Ex01.About, ["about.html"])
            ]
        ]
    ]

testLayouter ::
  Eq a =>
  Show a =>
  String ->
  Layouter a ->
  {-expected-} (Forest (LayoutNode a)) ->
  {-expected-} [a] ->
  TestTree
testLayouter tn site expectedLayout expectedRoutes =
  let lay = layouter site
   in testGroup
        tn
        [ testCase "TreeLayout" $ layout lay @?= expectedLayout
        , testCase "ReachableRoutes" $ usedRoutes lay @?= expectedRoutes
        ]

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 (usedRoutes site) (usedSlugs 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