{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}

module HUnits where

import Network.URI.Slug ()
import Relude
import Symantic qualified as Sym
import Test.Tasty
import Test.Tasty.HUnit

import Examples.Ex01 qualified as Ex01
import Examples.Ex02 qualified as Ex02
import Text.Printf (printf)
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"]
                ]
              )
            ]
        , testGenerator
            "Ex02"
            Ex02.site
            [
              ( Ex02.model0
              ,
                [ Gen ["static"] $ Ex02.SiteStatic
                , Gen ["feed"] $ Ex02.SiteFeeds
                , Gen ["filter", "all"] $ Ex02.SiteFilter Ex02.Filter{filterLang = Nothing, filterTag = Nothing}
                , Gen ["filter", "all", "tag0"] $ Ex02.SiteFilter Ex02.Filter{filterLang = Nothing, filterTag = Just (Ex02.Tag{Ex02.unTag = "tag0"})}
                , Gen ["filter", "fr"] $ Ex02.SiteFilter Ex02.Filter{filterLang = Just Ex02.LangEn, filterTag = Nothing}
                , Gen ["filter", "fr", "tag0"] $ Ex02.SiteFilter Ex02.Filter{filterLang = Just Ex02.LangEn, filterTag = Just (Ex02.Tag{Ex02.unTag = "tag0"})}
                , Gen ["filter", "en"] $ Ex02.SiteFilter Ex02.Filter{filterLang = Just Ex02.LangFr, filterTag = Nothing}
                , Gen ["filter", "en", "tag0"] $ Ex02.SiteFilter Ex02.Filter{filterLang = Just Ex02.LangFr, filterTag = Just (Ex02.Tag{Ex02.unTag = "tag0"})}
                ]
              )
            ]
        ]
    , testGroup
        "CoderIsomorphism"
        [ testCoderIsomorphism "Ex01" Ex01.site ()
        , testCoderIsomorphism "Ex02" Ex02.site Ex02.model0
        ]
    , 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"]
                ]
              )
            ]
        , testDecoder
            "Ex02"
            Ex02.site
            [
              ( Ex02.model0
              ,
                [ Gen ["static"] $ Ex02.SiteStatic
                , Gen
                    ["filter", "all", "tag0"]
                    $ Ex02.SiteFilter
                      Ex02.Filter
                        { Ex02.filterLang = Nothing
                        , Ex02.filterTag = Just (Ex02.Tag "tag0")
                        }
                ]
              )
            ]
        ]
    ]

testGenerator ::
  Eq a =>
  Show a =>
  String ->
  Sym.Reader model Generator a ->
  [(model, [Gen a])] ->
  TestTree
testGenerator tn site models =
  testGroup
    tn
    [ testCase (printf "Model%02d" modelNum) do
      generate (Sym.unReader site model) @?= expectedGens
    | (modelNum, (model, expectedGens)) <- ol models
    ]

testCoderIsomorphism ::
  Eq a =>
  Show a =>
  String ->
  (forall repr. Testable model repr => Sym.Reader model repr a) ->
  model ->
  TestTree
testCoderIsomorphism tn site model =
  testGroup tn $
    [ testGroup (printf "Url%d" urlNum) $
      [ ( testCase "decode . encode" do
            decode @() decoder (encode encoder genValue)
              >>= (@?= Right genValue)
        )
      , ( testCase "encode . decode" do
            dec <- decode @() decoder genSlugs
            encode encoder <$> dec @?= Right genSlugs
        )
      ]
    | (urlNum, Gen{..}) <- ol $ generate (Sym.unReader site model)
    ]
  where
    decoder = Sym.unReader site model
    encoder = Sym.unReader site model

testDecoder ::
  Eq a =>
  Show a =>
  String ->
  Sym.Reader model (Decoder ()) a ->
  [(model, [Gen a])] ->
  TestTree
testDecoder tn site models =
  testGroup
    tn
    [ testGroup
      (printf "Model%d" modelNum)
      [ testCase (printf "Gen%d" genNum) do
        decode (Sym.unReader site model) genSlugs
          >>= (@?= Right genValue)
      | (genNum, Gen{..}) <- ol expectedGens
      ]
    | (modelNum, (model, expectedGens)) <- ol models
    ]

testEncoder :: String -> Sym.Reader model Encoder a -> [(model, [Gen a])] -> TestTree
testEncoder tn site models =
  testGroup
    tn
    [ testGroup
      (printf "Model%d" modelNum)
      [ testCase (printf "Gen%d" genNum) do
        encode (Sym.unReader site model) genValue @?= genSlugs
      | (genNum, Gen{..}) <- ol expectedGens
      ]
    | (modelNum, (model, expectedGens)) <- ol models
    ]