From b94070ac3b3ce24362b681f93cd4722b20920162 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Facundo=20Dom=C3=ADnguez?= <facundo.dominguez@tweag.io>
Date: Sun, 28 Jan 2024 19:27:34 -0300
Subject: [PATCH] Test desugaring of dollar sign

---
 .../ghc-api-tests/GhcApiTests.hs              | 26 +++++++++++++++++++
 1 file changed, 26 insertions(+)

diff --git a/liquidhaskell-boot/ghc-api-tests/GhcApiTests.hs b/liquidhaskell-boot/ghc-api-tests/GhcApiTests.hs
index 5cedea321f..a760358f3d 100644
--- a/liquidhaskell-boot/ghc-api-tests/GhcApiTests.hs
+++ b/liquidhaskell-boot/ghc-api-tests/GhcApiTests.hs
@@ -13,6 +13,7 @@ import           Liquid.GHC.API
     , occNameString
     , pAT_ERROR_ID
     , showPprQualified
+    , splitDollarApp
     )
 import           Test.Tasty
 import           Test.Tasty.HUnit
@@ -46,6 +47,7 @@ testTree =
       [ testCase "apiComments" testApiComments
       , testCase "caseDesugaring" testCaseDesugaring
       , testCase "numericLiteralDesugaring" testNumLitDesugaring
+      , testCase "dollarDesugaring" testDollarDesugaring
       ]
 
 -- Tests that Liquid.GHC.API.Extra.apiComments can retrieve the comments in
@@ -165,6 +167,30 @@ testNumLitDesugaring = do
       fail $ unlines $
         "Unexpected desugaring:" : map showPprQualified coreProgram
 
+-- | Tests that dollar sign desugars as Liquid Haskell expects.
+testDollarDesugaring :: IO ()
+testDollarDesugaring = do
+    let inputSource = unlines
+          [ "module DollarDesugaring where"
+          , "f :: ()"
+          , "f = (\\_ -> ()) $ 'a'"
+          ]
+
+        fBind (GHC.NonRec b _e) =
+          occNameString (GHC.occName b) == "f"
+        fBind _ = False
+
+        isExpectedDesugaring p = case find fBind p of
+          Just (GHC.NonRec _ e0)
+            | Just (Lam _ _, App _ (Lit (LitChar 'a'))) <- splitDollarApp e0
+            -> True
+          _ -> False
+
+    coreProgram <- compileToCore "DollarDesugaring" inputSource
+    unless (isExpectedDesugaring coreProgram) $
+      fail $ unlines $
+        "Unexpected desugaring:" : map showPprQualified coreProgram
+
 compileToCore :: String -> String -> IO [GHC.CoreBind]
 compileToCore modName inputSource = do
     now <- getCurrentTime