diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs index a654cb384303173756464599e88ee6397c176e8a..65be9831770dab78bbfba6750d7d1df54fee2177 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs @@ -14,7 +14,7 @@ import Language.Haskell.TH.Syntax import Data.Word ( Word8 ) import Data.Char ( toLower, chr) import GHC.Show ( showMultiLineString ) -import GHC.Lexeme( startsVarSym ) +import GHC.Lexeme( isVarSymChar ) import Data.Ratio ( numerator, denominator ) import Data.Foldable ( toList ) import Prelude hiding ((<>)) @@ -122,8 +122,8 @@ isSymOcc :: Name -> Bool isSymOcc n = case nameBase n of [] -> True -- Empty name; weird - (c:_) -> startsVarSym c - -- c.f. OccName.startsVarSym in GHC itself + (c:_) -> isVarSymChar c + -- c.f. isVarSymChar in GHC itself pprInfixExp :: Exp -> Doc pprInfixExp (VarE v) = pprName' Infix v @@ -471,7 +471,8 @@ ppr_dec _ (PatSynD name args dir pat) pprNameArgs | InfixPatSyn a1 a2 <- args = ppr a1 <+> pprName' Infix name <+> ppr a2 | otherwise = pprName' Applied name <+> ppr args pprPatRHS | ExplBidir cls <- dir = hang (ppr pat <+> text "where") - nestDepth (pprName' Applied name <+> ppr cls) + nestDepth + (vcat $ (pprName' Applied name <+>) . ppr <$> cls) | otherwise = ppr pat ppr_dec _ (PatSynSigD name ty) = pprPatSynSig name ty diff --git a/testsuite/tests/th/T24111.hs b/testsuite/tests/th/T24111.hs new file mode 100644 index 0000000000000000000000000000000000000000..8296f28992e688910b445288f5070c17d60b5c4d --- /dev/null +++ b/testsuite/tests/th/T24111.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE Haskell2010, PatternSynonyms, TemplateHaskell, ViewPatterns #-} + +import Language.Haskell.TH (runQ) +import Language.Haskell.TH.Ppr (pprint) + +main = do + runQ [d|pattern (:+) :: Int -> Int -> (Int, Int); + pattern x :+ y = (x, y)|] >>= putStrLn . pprint + runQ [d|pattern A :: Int -> String; + pattern A n <- (read -> n) where { + A 0 = "hi"; + A 1 = "bye"}|] >>= putStrLn . pprint diff --git a/testsuite/tests/th/T24111.stdout b/testsuite/tests/th/T24111.stdout new file mode 100644 index 0000000000000000000000000000000000000000..1a30bb8fd79090f5b6b09b5ca03cbb3291923727 --- /dev/null +++ b/testsuite/tests/th/T24111.stdout @@ -0,0 +1,7 @@ +pattern (:+_0) :: GHC.Types.Int -> + GHC.Types.Int -> (GHC.Types.Int, GHC.Types.Int) +pattern x_1 :+_0 y_2 = (x_1, y_2) +pattern A_0 :: GHC.Types.Int -> GHC.Base.String +pattern A_0 n_1 <- (Text.Read.read -> n_1) where + A_0 0 = "hi" + A_0 1 = "bye" diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index cdcdd479798ec08c088aa4f546a755269f482f32..7f016b50d4aa00517f3c896a914a2196f49342cc 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -597,3 +597,4 @@ test('T23962', normal, compile_and_run, ['']) test('T23968', normal, compile_and_run, ['']) test('T23971', normal, compile_and_run, ['']) test('T23986', normal, compile_and_run, ['']) +test('T24111', normal, compile_and_run, [''])