module Gyehoek.Test.Sexp
  ( root
  , EquivSexp(..)
  , assertEquiv
  , equivto
  )
  where

import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit
import Language.Sexp.Located qualified as SL
import Language.SexpGrammar ()
import Gyehoek.Sexp (sx, equivalent)
import Data.Function (on)


root :: IO TestTree
root = pure . testGroup "sexp" $
  [ sxTree
  ]

newtype EquivSexp = MkEquiv SL.Sexp
  deriving newtype (Show)

instance Eq EquivSexp where
  MkEquiv x == MkEquiv y = equivalent x y

assertEquiv
  :: HasCallStack
  => String -> SL.Sexp -> SL.Sexp -> Assertion
assertEquiv prefix = assertEqual prefix `on` MkEquiv

equivto = assertEquiv ""

sxTree :: TestTree
sxTree = testGroup "sx"
  [ testCase "quotation" do
      equivto (SL.Symbol "abc") [sx|abc|]
      equivto (SL.ParenList [SL.Symbol "a", SL.Symbol "b"]) [sx|(a b)|]
  , testCase "antiquotation" do
      equivto [sx|123|]
        let meta = 123 :: Int
        in [sx|#{meta}|]
      equivto [sx|(blah (blah blah) blah)|]
        let meta = [sx|blah|]
        in [sx|(#{meta} (#{meta} #{meta}) #{meta})|]
  , testCase "splicing" do
      equivto [sx|(a b c d e f g)|]
        let metas = SL.Symbol <$> ["c","d","e"]
        in [sx|(a b ##{metas} f g)|]
      equivto [sx|(a (b c d) e f g)|]
        let
          e1 = SL.Symbol "c"
          e2 = SL.Symbol <$> ["e","f"]
        in [sx|(a (b #{e1} d) ##{e2} g)|]
  ]