HsToken for HsPar, ParPat, HsCmdPar (#19523)

This patch is a first step towards a simpler design for exact printing.

2 files changed, 24 insertions, 14 deletions

diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index b4e53efeb6..8786e03fd8 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -9,6 +9,8 @@
 {-# LANGUAGE TypeFamilies         #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE ViewPatterns         #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TypeApplications     #-}
 
 module ExactPrint
   (
@@ -31,6 +33,7 @@ import GHC.Utils.Outputable hiding ( (<>) )
 import GHC.Unit.Module.Warnings
 import GHC.Utils.Misc
 import GHC.Utils.Panic
+import GHC.TypeLits
 
 import Control.Monad.Identity
 import Control.Monad.RWS
@@ -585,6 +588,13 @@ markKw (AddEpAnn kw ss) = markKwA kw ss
 markKwA :: AnnKeywordId -> EpaLocation -> EPP ()
 markKwA kw aa = printStringAtAA aa (keywordToString (G kw))
 
+markToken :: forall tok. KnownSymbol tok => LHsToken tok GhcPs -> EPP ()
+markToken (L EpAnnNotUsed _) = return ()
+markToken (L (EpAnn (Anchor a a_op) _ _) _) = printStringAtAA aa (symbolVal (Proxy @tok))
+  where aa = case a_op of
+               UnchangedAnchor -> EpaSpan a
+               MovedAnchor dp  -> EpaDelta dp
+
 -- ---------------------------------------------------------------------
 
 markAnnList :: Bool -> EpAnn AnnList -> EPP () -> EPP ()
@@ -1791,7 +1801,7 @@ instance ExactPrint (HsExpr GhcPs) where
   getAnnotationEntry (HsAppType _ _ _)            = NoEntryVal
   getAnnotationEntry (OpApp an _ _ _)             = fromAnn an
   getAnnotationEntry (NegApp an _ _)              = fromAnn an
-  getAnnotationEntry (HsPar an _)                 = fromAnn an
+  getAnnotationEntry (HsPar an _ _ _)             = fromAnn an
   getAnnotationEntry (SectionL an _ _)            = fromAnn an
   getAnnotationEntry (SectionR an _ _)            = fromAnn an
   getAnnotationEntry (ExplicitTuple an _ _)       = fromAnn an
@@ -1876,11 +1886,11 @@ instance ExactPrint (HsExpr GhcPs) where
     markEpAnn an AnnMinus
     markAnnotated e
 
-  exact (HsPar an e) = do
-    markOpeningParen an
+  exact (HsPar _an lpar e rpar) = do
+    markToken lpar
     markAnnotated e
     debugM $ "HsPar closing paren"
-    markClosingParen an
+    markToken rpar
     debugM $ "HsPar done"
 
   -- exact (SectionL an expr op) = do
@@ -2289,7 +2299,7 @@ instance ExactPrint (HsCmd GhcPs) where
   getAnnotationEntry (HsCmdArrForm an _ _ _ _ ) = fromAnn an
   getAnnotationEntry (HsCmdApp an _ _ )         = fromAnn an
   getAnnotationEntry (HsCmdLam {})              = NoEntryVal
-  getAnnotationEntry (HsCmdPar an _)            = fromAnn an
+  getAnnotationEntry (HsCmdPar an _ _ _)        = fromAnn an
   getAnnotationEntry (HsCmdCase an _ _)         = fromAnn an
   getAnnotationEntry (HsCmdLamCase an _)        = fromAnn an
   getAnnotationEntry (HsCmdIf an _ _ _ _)       = fromAnn an
@@ -2371,10 +2381,10 @@ instance ExactPrint (HsCmd GhcPs) where
 --   markAST l (GHC.HsCmdLam _ match) = do
 --     setContext (Set.singleton LambdaExpr) $ do markMatchGroup l match
 
-  exact (HsCmdPar an e) = do
-    markOpeningParen an
+  exact (HsCmdPar _an lpar e rpar) = do
+    markToken lpar
     markAnnotated e
-    markClosingParen an
+    markToken rpar
 
   exact (HsCmdCase an e alts) = do
     markAnnKw an hsCaseAnnCase AnnCase
@@ -3618,7 +3628,7 @@ instance ExactPrint (Pat GhcPs) where
   getAnnotationEntry (VarPat _ _)             = NoEntryVal
   getAnnotationEntry (LazyPat an _)           = fromAnn an
   getAnnotationEntry (AsPat an _ _)           = fromAnn an
-  getAnnotationEntry (ParPat an _)            = fromAnn an
+  getAnnotationEntry (ParPat an _ _ _)        = fromAnn an
   getAnnotationEntry (BangPat an _)           = fromAnn an
   getAnnotationEntry (ListPat an _)           = fromAnn an
   getAnnotationEntry (TuplePat an _ _)        = fromAnn an
@@ -3647,10 +3657,10 @@ instance ExactPrint (Pat GhcPs) where
     markAnnotated n
     markEpAnn an AnnAt
     markAnnotated pat
-  exact (ParPat an pat) = do
-    markAnnKw an ap_open AnnOpenP
+  exact (ParPat _an lpar pat rpar) = do
+    markToken lpar
     markAnnotated pat
-    markAnnKw an ap_close AnnCloseP
+    markToken rpar
 
   exact (BangPat an pat) = do
     markEpAnn an AnnBang
diff --git a/utils/check-exact/Transform.hs b/utils/check-exact/Transform.hs
index 044af3c784..0e40a14d39 100644
--- a/utils/check-exact/Transform.hs
+++ b/utils/check-exact/Transform.hs
@@ -1135,11 +1135,11 @@ instance HasDecls (LocatedA (HsExpr GhcPs)) where
         return (L ll (HsLet x' binds' ex'))
 
   -- TODO: does this make sense? Especially as no hsDecls for HsPar
-  replaceDecls (L l (HsPar x e)) newDecls
+  replaceDecls (L l (HsPar x lpar e rpar)) newDecls
     = do
         logTr "replaceDecls HsPar"
         e' <- replaceDecls e newDecls
-        return (L l (HsPar x e'))
+        return (L l (HsPar x lpar e' rpar))
   replaceDecls old _new = error $ "replaceDecls (LHsExpr GhcPs) undefined for:" ++ showGhc old
 
 -- ---------------------------------------------------------------------