From 778381bbb83a1b2a7dd16672ed43ee191c5406cf Mon Sep 17 00:00:00 2001
From: Evan Rutledge Borden <evan@evan-borden.com>
Date: Mon, 15 Jan 2018 16:02:14 -0500
Subject: [PATCH] Fix infix constructor pattern matching for normal
constructors
Brittany was previously only support symbol based infix constructors. It
is common in some libraries (for example Esqueleto) to pattern match on
normal constructors as infix. Brittany was failing in this case by not
wrapping the constructor name in back ticks/spaces. Backticks and spaces
have been added in the case where the constructor contains any alpha
characters.
---
src-literatetests/10-tests.blt | 3 +++
src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs | 5 ++++-
2 files changed, 7 insertions(+), 1 deletion(-)
diff --git a/src-literatetests/10-tests.blt b/src-literatetests/10-tests.blt
index a3d8591..6659847 100644
--- a/src-literatetests/10-tests.blt
+++ b/src-literatetests/10-tests.blt
@@ -355,6 +355,9 @@ func (x:xr) = x
#pending
func (x:+:xr) = x
+#test normal infix constructor
+func (x `Foo` xr) = x
+
###############################################################################
###############################################################################
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs
index ebdd91d..2f881a0 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs
+++ b/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs
@@ -13,6 +13,7 @@ where
import Language.Haskell.Brittany.Internal.Types
import Language.Haskell.Brittany.Internal.LayouterBasics
+import Data.Char (isAlpha)
import RdrName ( RdrName(..) )
import GHC ( Located, runGhc, GenLocated(L), moduleNameString )
import HsSyn
@@ -80,7 +81,9 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
let nameDoc = lrdrNameToText lname
leftDoc <- colsWrapPat =<< layoutPat left
rightDoc <- colsWrapPat =<< layoutPat right
- middle <- docLit nameDoc
+ middle <- docLit $ if Text.any isAlpha nameDoc
+ then Text.pack " `" <> nameDoc <> Text.pack "` "
+ else nameDoc
return $ Seq.empty Seq.|> leftDoc Seq.|> middle Seq.|> rightDoc
ConPatIn lname (RecCon (HsRecFields [] Nothing)) -> do
-- Abc{} -> expr