Simplify HsPatSynDetails

This is a pure refactoring.  Use HsConDetails to implement
HsPatSynDetails, instead of defining a whole new data type.
Less code, fewer types, all good.

3 files changed, 9 insertions, 52 deletions

diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs
index 47c2182a7a..de72878cda 100644
--- a/compiler/hsSyn/Convert.hs
+++ b/compiler/hsSyn/Convert.hs
@@ -367,12 +367,12 @@ cvtDec (TH.PatSynD nm args dir pat)
        ; returnJustL $ Hs.ValD $ PatSynBind $
            PSB nm' placeHolderType args' pat' dir' }
   where
-    cvtArgs (TH.PrefixPatSyn args) = Hs.PrefixPatSyn <$> mapM vNameL args
-    cvtArgs (TH.InfixPatSyn a1 a2) = Hs.InfixPatSyn <$> vNameL a1 <*> vNameL a2
+    cvtArgs (TH.PrefixPatSyn args) = Hs.PrefixCon <$> mapM vNameL args
+    cvtArgs (TH.InfixPatSyn a1 a2) = Hs.InfixCon <$> vNameL a1 <*> vNameL a2
     cvtArgs (TH.RecordPatSyn sels)
       = do { sels' <- mapM vNameL sels
            ; vars' <- mapM (vNameL . mkNameS . nameBase) sels
-           ; return $ Hs.RecordPatSyn $ zipWith RecordPatSynField sels' vars' }
+           ; return $ Hs.RecCon $ zipWith RecordPatSynField sels' vars' }
 
     cvtDir _ Unidir          = return Unidirectional
     cvtDir _ ImplBidir       = return ImplicitBidirectional
diff --git a/compiler/hsSyn/HsBinds.hs b/compiler/hsSyn/HsBinds.hs
index 0d06543d10..40617e33ef 100644
--- a/compiler/hsSyn/HsBinds.hs
+++ b/compiler/hsSyn/HsBinds.hs
@@ -716,11 +716,10 @@ instance (SourceTextX idR,
       ppr_simple syntax = syntax <+> ppr pat
 
       ppr_details = case details of
-          InfixPatSyn v1 v2 -> hsep [ppr v1, pprInfixOcc psyn, ppr v2]
-          PrefixPatSyn vs   -> hsep (pprPrefixOcc psyn : map ppr vs)
-          RecordPatSyn vs   ->
-            pprPrefixOcc psyn
-                      <> braces (sep (punctuate comma (map ppr vs)))
+          InfixCon v1 v2 -> hsep [ppr v1, pprInfixOcc psyn, ppr v2]
+          PrefixCon vs   -> hsep (pprPrefixOcc psyn : map ppr vs)
+          RecCon vs      -> pprPrefixOcc psyn
+                            <> braces (sep (punctuate comma (map ppr vs)))
 
       ppr_rhs = case dir of
           Unidirectional           -> ppr_simple (text "<-")
@@ -1137,12 +1136,7 @@ pprMinimalSig (L _ bf) = ppr (fmap unLoc bf)
 -}
 
 -- | Haskell Pattern Synonym Details
-data HsPatSynDetails a
-  = InfixPatSyn a a                    -- ^ Infix Pattern Synonym
-  | PrefixPatSyn [a]                   -- ^ Prefix Pattern Synonym
-  | RecordPatSyn [RecordPatSynField a] -- ^ Record Pattern Synonym
-  deriving Data
-
+type HsPatSynDetails arg = HsConDetails arg [RecordPatSynField arg]
 
 -- See Note [Record PatSyn Fields]
 -- | Record Pattern Synonym Field
@@ -1199,43 +1193,6 @@ instance Traversable RecordPatSynField where
           <$> f visible <*> f hidden
 
 
-instance Functor HsPatSynDetails where
-    fmap f (InfixPatSyn left right) = InfixPatSyn (f left) (f right)
-    fmap f (PrefixPatSyn args) = PrefixPatSyn (fmap f args)
-    fmap f (RecordPatSyn args) = RecordPatSyn (map (fmap f) args)
-
-instance Foldable HsPatSynDetails where
-    foldMap f (InfixPatSyn left right) = f left `mappend` f right
-    foldMap f (PrefixPatSyn args) = foldMap f args
-    foldMap f (RecordPatSyn args) = foldMap (foldMap f) args
-
-    foldl1 f (InfixPatSyn left right) = left `f` right
-    foldl1 f (PrefixPatSyn args) = Data.List.foldl1 f args
-    foldl1 f (RecordPatSyn args) =
-      Data.List.foldl1 f (map (Data.Foldable.foldl1 f) args)
-
-    foldr1 f (InfixPatSyn left right) = left `f` right
-    foldr1 f (PrefixPatSyn args) = Data.List.foldr1 f args
-    foldr1 f (RecordPatSyn args) =
-      Data.List.foldr1 f (map (Data.Foldable.foldr1 f) args)
-
-    length (InfixPatSyn _ _) = 2
-    length (PrefixPatSyn args) = Data.List.length args
-    length (RecordPatSyn args) = Data.List.length args
-
-    null (InfixPatSyn _ _) = False
-    null (PrefixPatSyn args) = Data.List.null args
-    null (RecordPatSyn args) = Data.List.null args
-
-    toList (InfixPatSyn left right) = [left, right]
-    toList (PrefixPatSyn args) = args
-    toList (RecordPatSyn args) = foldMap toList args
-
-instance Traversable HsPatSynDetails where
-    traverse f (InfixPatSyn left right) = InfixPatSyn <$> f left <*> f right
-    traverse f (PrefixPatSyn args) = PrefixPatSyn <$> traverse f args
-    traverse f (RecordPatSyn args) = RecordPatSyn <$> traverse (traverse f) args
-
 -- | Haskell Pattern Synonym Direction
 data HsPatSynDir id
   = Unidirectional
diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs
index 8f4c2feeb4..e3bc371aad 100644
--- a/compiler/hsSyn/HsUtils.hs
+++ b/compiler/hsSyn/HsUtils.hs
@@ -1070,7 +1070,7 @@ hsPatSynSelectors (ValBindsOut binds _)
 
 addPatSynSelector:: LHsBind p -> [IdP p] -> [IdP p]
 addPatSynSelector bind sels
-  | L _ (PatSynBind (PSB { psb_args = RecordPatSyn as })) <- bind
+  | L _ (PatSynBind (PSB { psb_args = RecCon as })) <- bind
   = map (unLoc . recordPatSynSelectorId) as ++ sels
   | otherwise = sels