qq

test/Gyehoek/Test/Sexp/QQ.hs

@@ -0,0 +1,47 @@
+module Gyehoek.Test.Sexp.QQ where
+
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit
+import Gyehoek.Sexp.QQ (sx)
+import Data.Function (on)
+import Gyehoek.Sexp.Syntax
+import Data.Coerce (coerce)
+
+
+newtype EquivDatum = MkEquiv Datum
+  deriving newtype (Show)
+
+instance Eq EquivDatum where
+  (==) = (==) `on` (stripAnn . coerce)
+
+assertEquiv
+  :: HasCallStack
+  => String -> Datum -> Datum -> Assertion
+assertEquiv prefix = assertEqual prefix `on` MkEquiv
+
+equivto :: HasCallStack => Datum -> Datum -> Assertion
+equivto = assertEquiv ""
+
+test_qq :: TestTree
+test_qq = testGroup "sexp quasiquoter"
+  [ testCase "quotation" do
+      equivto (Symbol "abc") [sx|abc|]
+      equivto (List [Symbol "a", 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 simple" do
+      equivto [sx|(a b c d e f g)|]
+        let metas = Symbol <$> ["c","d","e"]
+        in [sx|(a b ##{metas} f g)|]
+  , testCase "splicing multiple" do
+      equivto [sx|(a (b c d) e f g)|]
+        let
+          e1 = Symbol "c"
+          e2 = Symbol <$> ["e","f"]
+        in [sx|(a (b #{e1} d) ##{e2} g)|]
+  ]