As pattern desugaring fails for non-invertible patterns (e.g., unidirectional pattern synonyms)

[RyanGlScott]

This code is perfectly valid:

pattern Unit :: ()
pattern Unit <- ()
{-# COMPLETE Unit #-}

f :: () -> ()
f u@Unit = u

Despite this, th-desugar will desugar it into code which does not typecheck:

{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -ddump-splices #-}
module Bug where

import Language.Haskell.TH.Desugar

pattern Unit :: ()
pattern Unit <- ()
{-# COMPLETE Unit #-}

$(do decs <- [d| f :: () -> ()
                 f u@Unit = u
               |]
     ddecs <- dsDecs decs
     pure $ sweeten ddecs)

[1 of 1] Compiling Bug              ( Bug.hs, interpreted ) [Source file changed]
Bug.hs:(12,2)-(16,26): Splicing declarations
    do decs_a3yC <- [d| f_a3yA :: () -> ()
                        f_a3yA u_a3yB@Unit = u_a3yB |]
       ddecs_a3yD <- dsDecs decs_a3yC
       pure $ sweeten ddecs_a3yD
  ======>
    f_a3zH :: () -> ()
    f_a3zH Unit = let u_a3zI = Unit in u_a3zI

Bug.hs:12:2: error:
    • non-bidirectional pattern synonym ‘Unit’ used in an expression
    • In the expression: Unit
      In an equation for ‘u_a3zI’: u_a3zI = Unit
      In the expression: let u_a3zI = Unit in u_a3zI
   |
12 | $(do decs <- [d| f :: () -> ()
   |  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^...

The problem is that the as pattern is desugared to a let binding that binds the new variable to an expression, where the expression is obtained by inverting a pattern to an expression. This works reasonably well for many sorts of patterns, but it does not work for non-invertible patterns such as unidirectional pattern synonyms (e.g., Unit).

[RyanGlScott]

A similar problem would present itself if we were to add Or patterns to th-desugar's DPat, as Or patterns are also not invertible.