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.
pull/107/head
Evan Rutledge Borden 2018-01-15 16:02:14 -05:00
parent 7892b0e42d
commit 778381bbb8
2 changed files with 7 additions and 1 deletions

View File

@ -355,6 +355,9 @@ func (x:xr) = x
#pending #pending
func (x:+:xr) = x func (x:+:xr) = x
#test normal infix constructor
func (x `Foo` xr) = x
############################################################################### ###############################################################################
############################################################################### ###############################################################################

View File

@ -13,6 +13,7 @@ where
import Language.Haskell.Brittany.Internal.Types import Language.Haskell.Brittany.Internal.Types
import Language.Haskell.Brittany.Internal.LayouterBasics import Language.Haskell.Brittany.Internal.LayouterBasics
import Data.Char (isAlpha)
import RdrName ( RdrName(..) ) import RdrName ( RdrName(..) )
import GHC ( Located, runGhc, GenLocated(L), moduleNameString ) import GHC ( Located, runGhc, GenLocated(L), moduleNameString )
import HsSyn import HsSyn
@ -80,7 +81,9 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
let nameDoc = lrdrNameToText lname let nameDoc = lrdrNameToText lname
leftDoc <- colsWrapPat =<< layoutPat left leftDoc <- colsWrapPat =<< layoutPat left
rightDoc <- colsWrapPat =<< layoutPat right 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 return $ Seq.empty Seq.|> leftDoc Seq.|> middle Seq.|> rightDoc
ConPatIn lname (RecCon (HsRecFields [] Nothing)) -> do ConPatIn lname (RecCon (HsRecFields [] Nothing)) -> do
-- Abc{} -> expr -- Abc{} -> expr