{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}

module Main (main) where

import Composite
import Composite.Fcf
import Composite.TH
import Data.Functor.Contravariant
import Data.Functor.Identity
import Data.Vinyl
import Test.Tasty
import Test.Tasty.HUnit

withLensesAndProxies
  [d|
    type A = "a" :-> String

    type B = "b" :-> Int

    type C = "c" :-> ()

    type D = "d" :-> (String, Int)
    |]

type RecA = Record '[A, B, C]

type RecB = Record '[B, C, D]

type RecDiffAB = Record '[A]

type RecDiffBA = Record '[D]

type RecUnionAB = Record '[A, B, C, D]

type RecIntersectionAB = Record '[B, C]

recA :: RecA
recA = "foo" :*: 5 :*: () :*: RNil

recB :: RecB
recB = 5 :*: () :*: ("bar", 4) :*: RNil

recDiffAB :: RecDiffAB
recDiffAB = "foo" :*: RNil

recDiffBA :: RecDiffBA
recDiffBA = ("bar", 4) :*: RNil

recUnionAB :: RecUnionAB
recUnionAB = "foo" :*: 5 :*: () :*: ("bar", 4) :*: RNil

recIntersectionAB :: RecIntersectionAB
recIntersectionAB = 5 :*: () :*: RNil

tests :: TestTree
tests =
  testGroup
    "Casting operations"
    [ testCase "difference" $ do
        let x = difference recA recB
        assertEqual "" recDiffAB x
        let x = difference recB recA
        assertEqual "" recDiffBA x,
      testCase "union" $ do
        let x = recA `union` recB
        assertEqual "" recUnionAB (rcast x)
        let x = recB `union` recA
        assertEqual "" recUnionAB x,
      testCase "intersection" $ do
        let x = intersection recA recB
        assertEqual "" recIntersectionAB x
        let x = intersection recB recA
        assertEqual "" recIntersectionAB x
    ]

main :: IO ()
main = defaultMain tests