tests again

test/Gyehoek/Test/Sexp.hs

@@ -0,0 +1,50 @@
+module Gyehoek.Test.Sexp (root) 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)|]
+  ]

test/Main.hs

@@ -4,6 +4,7 @@ import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.Silver.Interactive (defaultMain)
 import qualified Gyehoek.Test.Golden
 import Data.List (List)
+import qualified Gyehoek.Test.Sexp
 
 
 main :: IO ()
@@ -12,5 +13,6 @@ main = defaultMain =<< root
 root :: IO TestTree
 root = testGroup "test" <$> sequenceA
   [ Gyehoek.Test.Golden.root
+  , Gyehoek.Test.Sexp.root
   ]