{-# LANGUAGE AllowAmbiguousTypes #-}
-- For Golden
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ImportQualifiedPost #-}
-- For Golden
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Goldens where

import Data.List qualified as List
import Relude
import Symantic qualified as Sym
import Symantic.Classes (ProductFunctor (..), SumFunctor (..))
import System.IO.Unsafe (unsafePerformIO)
import Test.Tasty
import Test.Tasty.Golden
import Text.Printf (printf)

import Examples.Ex01 qualified as Ex01
import Examples.Ex02 qualified as Ex02
import Paths_webc
import Utils
import Webc

test :: TestTree
test =
  testGroup
    "Goldens"
    [ testGroup
        "Generator"
        [ testGroup
          (printf "Site%03d" siteNum)
          [ goldenVsStringDiff
            (printf "Model%02d" modelNum)
            goldenDiff
            (getGoldenDir (printf "Generator/Site%03d/Model%02d/expected.txt" siteNum modelNum))
            do
              return $ fromString $ List.unlines $ show <$> generate (Sym.unReader site model)
          | (modelNum, model) <- ol models
          ]
        | (siteNum, Golden site models) <- ol goldens
        ]
    , testGroup
        "Encoder"
        [ testGroup
          (printf "Site%03d" siteNum)
          [ testGroup
            (printf "Model%02d" modelNum)
            [ goldenVsStringDiff
              (printf "Gen%03d" genNum)
              goldenDiff
              (getGoldenDir (printf "Encoder/Site%03d/Model%02d/Gen%03d.expected.txt" siteNum modelNum genNum))
              do
                return $ fromString $ show $ encode (Sym.unReader site model) genValue
            | (genNum, Gen{..}) <- ol $ generate (Sym.unReader site model)
            ]
          | (modelNum, model) <- ol models
          ]
        | (siteNum, Golden site models) <- ol goldens
        ]
    , testGroup
        "Compiler"
        [ testGroup
          (printf "Site%03d" siteNum)
          [ withResource
            ( compile
                (Sym.unReader site model)
                CompilerConf
                  { compilerConfSource = getGoldenDir (printf "Encoder/Site%03d/Model%02d/Source/" siteNum modelNum)
                  , compilerConfDest = getGoldenDir (printf "Encoder/Site%03d/Model%02d/Got/" siteNum modelNum)
                  }
            )
            (\_ -> return ())
            $ \io ->
              testGroup
                (printf "Model%02d" modelNum)
                [ do
                  goldenVsFileDiff
                    (printf "Route%03d" genNum)
                    goldenDiff
                    (getGoldenDir (printf "Encoder/Site%03d/Model%02d/Expected/%s.txt" siteNum modelNum slugs))
                    (getGoldenDir (printf "Encoder/Site%03d/Model%02d/Got/%s.txt" siteNum modelNum slugs))
                    io
                | --return $ fromString $ show $ encode (Sym.unReader site model) genValue
                (genNum, Gen{..}) <- ol $ generate (Sym.unReader site model)
                , let slugs = pathOfSlugs genSlugs
                ]
          | (modelNum, model) <- ol models
          ]
        | (siteNum, Golden site models) <- ol goldens
        ]
    ]

getGoldenDir :: FilePath -> FilePath
getGoldenDir p = unsafePerformIO $ getDataFileName $ "tests/Goldens/" <> p

goldenDiff :: FilePath -> FilePath -> [String]
goldenDiff ref new = ["diff", "-u", "-w", "-B", ref, new]

data Golden
  = forall a model.
    ( Show a
    , Typeable a
    , Renderable a
    ) =>
    Golden
      (forall repr. Testable model repr => Sym.Reader model repr a)
      [model]

instance (Renderable a, Renderable b) => Renderable (Either a b) where
  render Comp{..} =
    case compValue of
      Left x -> render Comp{compValue = x, ..}
      Right x -> render Comp{compValue = x, ..}
instance (Renderable a, Renderable b) => Renderable (a, b) where
  render Comp{compValue = (_x, y), ..} =
    --render Comp{compValue = x, ..} <|>
    render Comp{compValue = y, ..}

goldens :: [Golden]
goldens =
  [ Golden @() index [()]
  , Golden @()
      ("foo" </> index)
      [()]
  , Golden @(Either () ())
      ("root" </> ("foo" </> index <+> "bar" </> index))
      [()]
  , Golden @(Either () (), Either () ())
      ( "root"
          </> ("a" </> literalSlug "b" <+> "c" </> literalSlug "d")
          <.> ("A" </> literalSlug "B" <+> "C" </> literalSlug "D")
          <. index
      )
      [()]
  , Golden @Ex01.Site Ex01.site [()]
  , Golden @Ex02.Site Ex02.site [Ex02.model0]
  ]