57 lines
1.4 KiB
Haskell
57 lines
1.4 KiB
Haskell
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)|]
|
|
]
|