updates for GHC HEAD

Author: shayne-fletcher

hlint.cabal

@@ -81,16 +81,16 @@ library
         deriving-aeson >= 0.2,
         filepattern >= 0.1.1
 
-    if !flag(ghc-lib) && impl(ghc >= 9.12.1) && impl(ghc < 9.13.0)
+    if !flag(ghc-lib) && impl(ghc >= 9.14.1) && impl(ghc < 9.15.0)
       build-depends:
-        ghc == 9.12.*,
+        ghc == 9.14.*,
         ghc-boot-th,
         ghc-boot
     else
       build-depends:
-          ghc-lib-parser == 9.12.*
+          ghc-lib-parser == 9.14.*
     build-depends:
-        ghc-lib-parser-ex >= 9.12 && < 9.13
+        ghc-lib-parser-ex >= 9.14 && < 9.15
 
     if flag(gpl)
         build-depends: hscolour >= 1.21
@@ -185,3 +185,5 @@ executable hlint
     ghc-options:        -rtsopts -with-rtsopts=-A32m
     if flag(threaded)
         ghc-options:    -threaded
+    if os(darwin)
+        ld-options:     -framework Security

src/Config/Compute.hs

@@ -9,6 +9,7 @@ import GHC.Util
 import Config.Type
 import Fixity
 import Data.Generics.Uniplate.DataOnly
+import Data.List.NonEmpty(NonEmpty(..))
 import GHC.Hs hiding (Warning)
 import GHC.Types.Name.Reader
 import GHC.Types.Name
@@ -56,7 +57,7 @@ findBind FunBind{fun_id, fun_matches} = findExp (unLoc fun_id) [] $ HsLam noAnn
 findBind _ = []
 
 findExp :: IdP GhcPs -> [String] -> HsExpr GhcPs -> [Setting]
-findExp name vs (HsLam _ LamSingle MG{mg_alts=L _ [L _ Match{m_pats=L _ pats, m_grhss=GRHSs{grhssGRHSs=[L _ (GRHS _ [] x)], grhssLocalBinds=(EmptyLocalBinds _)}}]})
+findExp name vs (HsLam _ LamSingle MG{mg_alts=L _ [L _ Match{m_pats=L _ pats, m_grhss=GRHSs{grhssGRHSs=(L _ (GRHS _ [] x) :| []), grhssLocalBinds=(EmptyLocalBinds _)}}]})
     = if length pats == length ps then findExp name (vs++ps) $ unLoc x else []
     where ps = [rdrNameStr x | L _ (VarPat _ x) <- pats]
 findExp name vs HsLam{} = []

src/GHC/Util/Brackets.hs

@@ -35,7 +35,7 @@ instance Brackets (LocatedA (HsExpr GhcPs)) where
 
   isAtom (L _ x) = case x of
       HsVar{} -> True
-      HsUnboundVar{} -> True
+      HsHole{} -> True
       -- Only relevant for OverloadedRecordDot extension
       HsGetField{} -> True
       HsOverLabel{} -> True
@@ -59,12 +59,10 @@ instance Brackets (LocatedA (HsExpr GhcPs)) where
       _  -> False
       where
         isNegativeLit (HsInt _ i) = il_neg i
-        isNegativeLit (HsRat _ f _) = fl_neg f
         isNegativeLit (HsFloatPrim _ f) = fl_neg f
         isNegativeLit (HsDoublePrim _ f) = fl_neg f
         isNegativeLit (HsIntPrim _ x) = x < 0
         isNegativeLit (HsInt64Prim _ x) = x < 0
-        isNegativeLit (HsInteger _ x _) = x < 0
         isNegativeLit _ = False
         isNegativeOverLit OverLit {ol_val=HsIntegral i} = il_neg i
         isNegativeOverLit OverLit {ol_val=HsFractional f} = fl_neg f
@@ -119,7 +117,7 @@ instance Brackets (LocatedA (Pat GhcPs)) where
     ConPat _ _ RecCon{} -> False
     -- Before we only checked args, but not type args, resulting in a
     -- false positive for things like (Proxy @a)
-    ConPat _ _ (PrefixCon [] []) -> True
+    ConPat _ _ (PrefixCon []) -> True
     VarPat{} -> True
     WildPat{} -> True
     SumPat{} -> True
@@ -131,8 +129,6 @@ instance Brackets (LocatedA (Pat GhcPs)) where
       isSignedLit HsInt{} = True
       isSignedLit HsIntPrim{} = True
       isSignedLit HsInt64Prim{} = True
-      isSignedLit HsInteger{} = True
-      isSignedLit HsRat{} = True
       isSignedLit HsFloatPrim{} = True
       isSignedLit HsDoublePrim{} = True
       isSignedLit _ = False

src/GHC/Util/FreeVars.hs

@@ -18,6 +18,7 @@ import Data.Generics.Uniplate.DataOnly
 import Data.Monoid
 import Data.Semigroup
 import Data.List.Extra
+import Data.List.NonEmpty(toList)
 import Data.Set (Set)
 import Data.Set qualified as Set
 import Prelude
@@ -97,7 +98,7 @@ unqualNames _ = []
 
 instance FreeVars (LocatedA (HsExpr GhcPs)) where
   freeVars (L _ (HsVar _ x)) = Set.fromList $ unqualNames x -- Variable.
-  freeVars (L _ (HsUnboundVar _ x)) = Set.fromList [rdrNameOcc x] -- Unbound variable; also used for "holes".
+  freeVars (L _ (HsHole (HoleVar (L _ x)))) = Set.fromList [rdrNameOcc x] -- Unbound variable; also used for "holes".
   freeVars (L _ (HsLam _ LamSingle mg)) = free (allVars mg) -- Lambda abstraction. Currently always a single match.
   freeVars (L _ (HsLam _ _ MG{mg_alts=(L _ ms)})) = free (allVars ms) -- Lambda case
   freeVars (L _ (HsCase _ of_ MG{mg_alts=(L _ ms)})) = freeVars of_ ^+ free (allVars ms) -- Case expr.
@@ -123,7 +124,7 @@ instance FreeVars (LocatedA (HsExpr GhcPs)) where
     case flds of
       RegularRecUpdFields _ fs -> Set.unions $ freeVars e : map freeVars fs
       OverloadedRecUpdFields _ ps -> Set.unions $ freeVars e : map freeVars ps
-  freeVars (L _ (HsMultiIf _ grhss)) = free (allVars grhss) -- Multi-way if.
+  freeVars (L _ (HsMultiIf _ grhss)) = free (allVars (toList grhss)) -- Multi-way if.
   freeVars (L _ (HsTypedBracket _ e)) = freeVars e
   freeVars (L _ (HsUntypedBracket _ (ExpBr _ e))) = freeVars e
   freeVars (L _ (HsUntypedBracket _ (VarBr _ _ v))) = Set.fromList [occName (unLoc v)]
@@ -240,7 +241,7 @@ instance AllVars (HsStmtContext (GenLocated SrcSpanAnnN RdrName)) where
   allVars _ = mempty
 
 instance AllVars (GRHSs GhcPs (LocatedA (HsExpr GhcPs))) where
-  allVars (GRHSs _ grhss binds) = inVars binds (mconcatMap allVars grhss)
+  allVars (GRHSs _ grhss binds) = inVars binds (mconcatMap allVars (toList grhss))
 
 instance AllVars (LocatedAn NoEpAnns (GRHS GhcPs (LocatedA (HsExpr GhcPs)))) where
   allVars (L _ (GRHS _ guards expr)) = Vars (bound gs) (free gs ^+ (freeVars expr ^- bound gs)) where gs = allVars guards

src/GHC/Util/HsExpr.hs

@@ -33,6 +33,7 @@ import Control.Monad.Trans.Writer.CPS
 import Data.Data
 import Data.Generics.Uniplate.DataOnly
 import Data.List.Extra
+import Data.List.NonEmpty(NonEmpty(..), fromList, toList)
 import Data.Tuple.Extra
 import Data.Maybe
 
@@ -57,7 +58,7 @@ dotApps (x : xs) = dotApp x (dotApps xs)
 
 -- | @lambda [p0, p1..pn] body@ makes @\p1 p1 .. pn -> body@
 lambda :: [LPat GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs
-lambda vs body = noLocA $ HsLam noAnn LamSingle (MG (Generated OtherExpansion DoPmc) (noLocA [noLocA $ Match noExtField (LamAlt LamSingle) (L noSpanAnchor vs) (GRHSs emptyComments [noLocA $ GRHS noAnn [] body] (EmptyLocalBinds noExtField))]))
+lambda vs body = noLocA $ HsLam noAnn LamSingle (MG (Generated OtherExpansion DoPmc) (noLocA [noLocA $ Match noExtField (LamAlt LamSingle) (L noSpanAnchor vs) (GRHSs emptyComments (noLocA (GRHS noAnn [] body) :| []) (EmptyLocalBinds noExtField))]))
 
 -- | 'paren e' wraps 'e' in parens if 'e' is non-atomic.
 paren :: LHsExpr GhcPs -> LHsExpr GhcPs
@@ -124,7 +125,7 @@ simplifyExp (L l (OpApp _ x op y)) | isDol op = L l (HsApp noExtField x (nlHsPar
 simplifyExp e@(L _ (HsLet _ ((HsValBinds _ (ValBinds _ binds []))) z)) =
   -- An expression of the form, 'let x = y in z'.
   case binds of
-    [L _ (FunBind _ _ (MG _ (L _ [L _ (Match _(FunRhs (L _ x) _ _ _) (L _ []) (GRHSs _ [L _ (GRHS _ [] y)] ((EmptyLocalBinds _))))])))]
+    [L _ (FunBind _ _ (MG _ (L _ [L _ (Match _(FunRhs (L _ x) _ _ _) (L _ []) (GRHSs _ (L _ (GRHS _ [] y) :| []) ((EmptyLocalBinds _))))])))]
          -- If 'x' is not in the free variables of 'y', beta-reduce to
          -- 'z[(y)/x]'.
       | occNameStr x `notElem` vars y && length [() | Unqual a <- universeBi z, a == rdrNameOcc x] <= 1 ->
@@ -251,12 +252,11 @@ niceLambdaR parent = go
     -- Base case. Just a good old fashioned lambda.
     go ss e =
       let grhs = noLocA $ GRHS noAnn [] e :: LGRHS GhcPs (LHsExpr GhcPs)
-          grhss = GRHSs {grhssExt = emptyComments, grhssGRHSs=[grhs], grhssLocalBinds=EmptyLocalBinds noExtField}
+          grhss = GRHSs {grhssExt = emptyComments, grhssGRHSs=fromList [grhs], grhssLocalBinds=EmptyLocalBinds noExtField}
           match = noLocA $ Match {m_ext=noExtField, m_ctxt=LamAlt LamSingle, m_pats=noLocA $ map strToPat ss, m_grhss=grhss} :: LMatch GhcPs (LHsExpr GhcPs)
           matchGroup = MG {mg_ext=Generated OtherExpansion SkipPmc, mg_alts=noLocA [match]}
       in (noLocA $ HsLam noAnn LamSingle matchGroup, const [])
 
-
 -- 'case' and 'if' expressions have branches, nothing else does (this
 -- doesn't consider 'HsMultiIf' perhaps it should?).
 replaceBranches :: LHsExpr GhcPs -> ([LHsExpr GhcPs], [LHsExpr GhcPs] -> LHsExpr GhcPs)
@@ -266,12 +266,12 @@ replaceBranches (L s (HsCase _ a (MG FromSource (L l bs)))) =
   (concatMap f bs, L s . HsCase noAnn a . MG (Generated OtherExpansion SkipPmc). L l . g bs)
   where
     f :: LMatch GhcPs (LHsExpr GhcPs) -> [LHsExpr GhcPs]
-    f (L _ (Match _ CaseAlt _ (GRHSs _ xs _))) = [x | (L _ (GRHS _ _ x)) <- xs]
+    f (L _ (Match _ CaseAlt _ (GRHSs _ xs _))) = [x | (L _ (GRHS _ _ x)) <- toList xs]
     f _ = error "GHC.Util.HsExpr.replaceBranches: unexpected XMatch"
 
     g :: [LMatch GhcPs (LHsExpr GhcPs)] -> [LHsExpr GhcPs] -> [LMatch GhcPs (LHsExpr GhcPs)]
     g (L s1 (Match _ CaseAlt a (GRHSs _ ns b)) : rest) xs =
-      L s1 (Match noExtField CaseAlt a (GRHSs emptyComments [L a (GRHS noAnn gs x) | (L a (GRHS _ gs _), x) <- zip ns as] b)) : g rest bs
+      L s1 (Match noExtField CaseAlt a (GRHSs emptyComments (fromList [L a (GRHS noAnn gs x) | (L a (GRHS _ gs _), x) <- zip (toList ns) as]) b)) : g rest bs
       where  (as, bs) = splitAt (length ns) xs
     g [] [] = []
     g _ _ = error "GHC.Util.HsExpr.replaceBranches': internal invariant failed, lists are of differing lengths"

src/GHC/Util/Unify.hs

@@ -120,6 +120,9 @@ unify' nm root x y
     | Just (x :: EpAnn AnnExplicitSum) <- cast x = Just mempty
     | Just (x :: EpAnn AnnFieldLabel) <- cast x = Just mempty
     | Just (x :: EpAnn (AnnList [EpToken ","])) <- cast x = Just mempty
+    | Just (x :: EpAnn (AnnList ())) <- cast x = Just mempty
+    | Just (x :: EpAnn (AnnList (EpToken "where"))) <- cast x = Just mempty
+    | Just (x :: EpAnn (AnnList (EpToken "hiding", [EpToken ","]))) <- cast x = Just mempty
     | Just (x :: EpAnn AnnListItem) <- cast x = Just mempty
     | Just (x :: EpAnn AnnParen) <- cast x = Just mempty
     | Just (x :: EpAnn AnnPragma) <- cast x = Just mempty
@@ -130,22 +133,38 @@ unify' nm root x y
     | Just (x :: EpAnn EpAnnHsCase) <- cast x = Just mempty
     | Just (x :: EpAnn EpAnnImportDecl) <- cast x = Just mempty
     | Just (x :: EpAnn EpAnnSumPat) <- cast x = Just mempty
-    | Just (x :: EpAnn EpAnnUnboundVar) <- cast x = Just mempty
     | Just (x :: EpAnn GrhsAnn) <- cast x = Just mempty
     | Just (x :: EpAnn HsRuleAnn) <- cast x = Just mempty
     | Just (x :: EpAnn NameAnn) <- cast x = Just mempty
     | Just (x :: EpAnn NoEpAnns) <- cast x = Just mempty
-    | Just (x :: EpToken "let") <- cast x = Just mempty
-    | Just (x :: EpToken "in") <- cast x = Just mempty
-    | Just (x :: EpToken "@") <- cast x = Just mempty
+    | Just (x :: EpToken "|") <- cast x = Just mempty
+    | Just (x :: EpToken ",") <- cast x = Just mempty
+    | Just (x :: EpToken ";") <- cast x = Just mempty
+    | Just (x :: EpToken "`") <- cast x = Just mempty
+    | Just (x :: EpToken ".") <- cast x = Just mempty
+    | Just (x :: EpToken "\\") <- cast x = Just mempty
     | Just (x :: EpToken "(") <- cast x = Just mempty
     | Just (x :: EpToken ")") <- cast x = Just mempty
+    | Just (x :: EpToken "@") <- cast x = Just mempty
+    | Just (x :: EpToken "#-}") <- cast x = Just mempty
+    | Just (x :: EpToken "if") <- cast x = Just mempty
+    | Just (x :: EpToken "then") <- cast x = Just mempty
+    | Just (x :: EpToken "let") <- cast x = Just mempty
+    | Just (x :: EpToken "else") <- cast x = Just mempty
+    | Just (x :: EpToken "case") <- cast x = Just mempty
+    | Just (x :: EpToken "of") <- cast x = Just mempty
+    | Just (x :: EpToken "in") <- cast x = Just mempty
     | Just (x :: EpToken "type") <- cast x = Just mempty
     | Just (x :: EpToken "%") <- cast x = Just mempty
     | Just (x :: EpToken "%1") <- cast x = Just mempty
-    | Just (x :: EpToken "⊸") <- cast x = Just mempty
+    | Just (x :: EpToken "proc") <- cast x = Just mempty
+    | Just (x :: EpToken "static") <- cast x = Just mempty
+    | Just (x :: EpToken "qualified") <- cast x = Just mempty
+    | Just (x :: EpToken "safe") <- cast x = Just mempty
+    | Just (x :: EpToken "as") <- cast x = Just mempty
+    | Just (x :: EpToken "import") <- cast x = Just mempty
     | Just (x :: EpUniToken "->" "→") <- cast x = Just mempty
-    | Just (x :: TokenLocation) <- cast y = Just mempty
+    | Just (x :: EpUniToken "::" "∷") <- cast x = Just mempty
     | Just (y :: SrcSpan) <- cast y = Just mempty
 
     | otherwise = unifyDef' nm x y

src/GHC/Util/View.hs

@@ -13,6 +13,7 @@ import GHC.Types.SrcLoc
 import GHC.Types.Basic
 import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader
 import GHC.Util.Brackets
+import Data.List.NonEmpty(NonEmpty(..))
 
 fromParen :: LocatedA (HsExpr GhcPs) -> LocatedA (HsExpr GhcPs)
 fromParen x = maybe x fromParen $ remParen x
@@ -33,7 +34,7 @@ data LamConst1 = NoLamConst1 | LamConst1 (LocatedA (HsExpr GhcPs))
 
 instance View (LocatedA (HsExpr GhcPs)) LamConst1 where
   view (fromParen -> (L _ (HsLam _ _ (MG FromSource (L _ [L _ (Match _ (LamAlt _) (L _ [L _ WildPat {}])
-    (GRHSs _ [L _ (GRHS _ [] x)] ((EmptyLocalBinds _))))]))))) = LamConst1 x
+    (GRHSs _ (L _ (GRHS _ [] x) :| []) ((EmptyLocalBinds _))))]))))) = LamConst1 x
   view _ = NoLamConst1
 
 instance View (LocatedA (HsExpr GhcPs)) RdrName_ where
@@ -54,12 +55,12 @@ instance View (LocatedA (Pat GhcPs)) PVar_ where
   view _ = NoPVar_
 
 instance View (LocatedA (Pat GhcPs)) PApp_ where
-  view (fromPParen -> L _ (ConPat _ (L _ x) (PrefixCon _ args))) =
+  view (fromPParen -> L _ (ConPat _ (L _ x) (PrefixCon args))) =
     PApp_ (occNameStr x) args
   view (fromPParen -> L _ (ConPat _ (L _ x) (InfixCon lhs rhs))) =
     PApp_ (occNameStr x) [lhs, rhs]
   view _ = NoPApp_
 
 -- A lambda with no guards and no where clauses
 pattern SimpleLambda :: [LocatedA (Pat GhcPs)] -> LocatedA (HsExpr GhcPs) -> LocatedA (HsExpr GhcPs)
-pattern SimpleLambda vs body <- L _ (HsLam _ LamSingle (MG _ (L _ [L _ (Match _ _ (L _ vs) (GRHSs _ [L _ (GRHS _ [] body)] ((EmptyLocalBinds _))))])))
+pattern SimpleLambda vs body <- L _ (HsLam _ LamSingle (MG _ (L _ [L _ (Match _ _ (L _ vs) (GRHSs _ (L _ (GRHS _ [] body) :| []) ((EmptyLocalBinds _))))])))

src/Hint/Bracket.hs

@@ -245,24 +245,14 @@ bracketError :: (Outputable a, Outputable b, Brackets (LocatedA b)) => String ->
 bracketError msg o x =
   warn msg (reLoc o) (reLoc x) [Replace (findType x) (toSSA o) [("x", toSSA x)] "x"]
 
-fieldDecl ::  LConDeclField GhcPs -> [Idea]
-fieldDecl o@(L loc f@ConDeclField{cd_fld_type=v@(L l (HsParTy _ c))}) =
-   let r = L loc (f{cd_fld_type=c}) :: LConDeclField GhcPs in
+fieldDecl ::  LHsConDeclRecField GhcPs -> [Idea]
+fieldDecl o@(L loc f@HsConDeclRecField{cdrf_spec = CDF{cdf_bang = NoSrcStrict, cdf_type = v@(L l (HsParTy _ c))}}) =
+    let r = L loc (f{cdrf_spec = (cdrf_spec f){cdf_type = c}}) :: LHsConDeclRecField GhcPs in
    [rawIdea Suggestion "Redundant bracket" (locA l)
-    (showSDocUnsafe $ ppr_fld o) -- Note this custom printer!
-    (Just (showSDocUnsafe $ ppr_fld r))
+    (showSDocUnsafe $ ppr o)
+    (Just (showSDocUnsafe $ ppr r))
     []
     [Replace Type (toSSA v) [("x", toSSA c)] "x"]]
-   where
-     -- If we call 'unsafePrettyPrint' on a field decl, we won't like
-     -- the output (e.g. "[foo, bar] :: T"). Here we use a custom
-     -- printer to work around (snarfed from Hs.Types.pprConDeclFields)
-     ppr_fld (L _ ConDeclField { cd_fld_names = ns, cd_fld_type = ty, cd_fld_doc = doc })
-       = pprMaybeWithDoc doc (ppr_names ns <+> dcolon <+> ppr ty)
-     ppr_fld (L _ (XConDeclField x)) = ppr x
-
-     ppr_names [n] = ppr n
-     ppr_names ns = sep (punctuate comma (map ppr ns))
 fieldDecl _ = []
 
 -- This function relies heavily on fixities having been applied to the

src/Hint/Lambda.hs

@@ -117,7 +117,9 @@ module Hint.Lambda(lambdaHint) where
 
 import Hint.Type (DeclHint, Idea, Note(RequiresExtension), suggest, warn, toSS, toSSA, suggestN, ideaNote, substVars, toRefactSrcSpan)
 import Util
+import Data.List qualified
 import Data.List.Extra
+import Data.List.NonEmpty(NonEmpty(..))
 import Data.Set (Set)
 import Data.Set qualified as Set
 import Refact.Types hiding (Match)
@@ -156,7 +158,7 @@ lambdaBind :: LHsBind GhcPs -> RType -> [Idea]
 lambdaBind
     o@(L _ origBind@FunBind {fun_id = funName@(L loc1 _), fun_matches =
         MG {mg_alts =
-            L _ [L _ (Match _ ctxt@(FunRhs _ Prefix _ _) (L _ pats) (GRHSs _ [L _ (GRHS _ [] origBody@(L loc2 _))] bind))]}}) rtype
+            L _ [L _ (Match _ ctxt@(FunRhs _ Prefix _ _) (L _ pats) (GRHSs _ (L _ (GRHS _ [] origBody@(L loc2 _)) :| []) bind))]}}) rtype
     | EmptyLocalBinds _ <- bind
     , isLambda $ fromParen origBody
     , null (universeBi pats :: [HsExpr GhcPs])
@@ -179,7 +181,7 @@ lambdaBind
     where
           reform :: [LPat GhcPs] -> LHsExpr GhcPs -> Located (HsDecl GhcPs)
           reform ps b = L (combineSrcSpans (locA loc1) (locA loc2)) $ ValD noExtField $
-             origBind {fun_matches = MG (Generated OtherExpansion SkipPmc) (noLocA [noLocA $ Match noExtField ctxt (L noSpanAnchor ps) $ GRHSs emptyComments [noLocA $ GRHS noAnn [] b] $ EmptyLocalBinds noExtField])}
+             origBind {fun_matches = MG (Generated OtherExpansion SkipPmc) (noLocA [noLocA $ Match noExtField ctxt (L noSpanAnchor ps) $ GRHSs emptyComments (noLocA (GRHS noAnn [] b) :| []) $ EmptyLocalBinds noExtField])}
 
           mkSubtsAndTpl newPats newBody = (sub, tpl)
             where
@@ -351,7 +353,7 @@ fromLambda x = ([], x)
 mkOrigPats :: Maybe String -> [LPat GhcPs] -> ([LPat GhcPs], [String])
 mkOrigPats funName pats = (zipWith munge vars pats', vars)
   where
-    (Set.unions -> used, pats') = unzip (map f pats)
+    (Set.unions -> used, pats') = Data.List.unzip (map f pats)
 
     -- Remove variables that occur in the function name or patterns with wildcards
     vars = filter (\s -> s `Set.notMember` used && Just s /= funName) substVars

src/Hint/ListRec.hs

@@ -35,6 +35,7 @@ import Hint.Type (DeclHint, Severity(Suggestion, Warning), idea, toSSA)
 
 import Data.Generics.Uniplate.DataOnly
 import Data.List.Extra
+import Data.List.NonEmpty(NonEmpty(..))
 import Data.Maybe
 import Data.Either.Extra
 import Control.Monad
@@ -140,7 +141,7 @@ asDo (view ->
                  L _ Match {  m_ctxt=(LamAlt LamSingle)
                             , m_pats=L _ [v@(L _ VarPat{})]
                             , m_grhss=GRHSs _
-                                        [L _ (GRHS _ [] rhs)]
+                                        (L _ (GRHS _ [] rhs) :| [])
                                         (EmptyLocalBinds _)}]}))
       ) =
   [ noLocA $ BindStmt noAnn v lhs
@@ -174,7 +175,7 @@ findCase x = do
   let ps12 = let (a, b) = splitAt p1 ps1 in map strToPat (a ++ xs : b) -- Function arguments.
       emptyLocalBinds = EmptyLocalBinds noExtField :: HsLocalBindsLR GhcPs GhcPs -- Empty where clause.
       gRHS e = noLocA $ GRHS noAnn [] e :: LGRHS GhcPs (LHsExpr GhcPs) -- Guarded rhs.
-      gRHSSs e = GRHSs emptyComments [gRHS e] emptyLocalBinds -- Guarded rhs set.
+      gRHSSs e = GRHSs emptyComments (gRHS e :| []) emptyLocalBinds -- Guarded rhs set.
       match e = Match{m_ext=noExtField,m_pats=noLocA ps12, m_grhss=gRHSSs e, ..} -- Match.
       matchGroup e = MG{mg_alts=noLocA [noLocA $ match e], mg_ext=Generated OtherExpansion SkipPmc, ..} -- Match group.
       funBind e = FunBind {fun_matches=matchGroup e, ..} :: HsBindLR GhcPs GhcPs -- Fun bind.
@@ -208,7 +209,7 @@ findBranch (L _ x) = do
   Match { m_ctxt = FunRhs {mc_fun=(L _ name)}
             , m_pats = ps
             , m_grhss =
-              GRHSs {grhssGRHSs=[L l (GRHS _ [] body)]
+              GRHSs {grhssGRHSs=(L l (GRHS _ [] body) :| [])
                         , grhssLocalBinds=EmptyLocalBinds _
                         }
             } <- pure x
@@ -227,6 +228,6 @@ readPat :: LPat GhcPs -> Maybe (Either String BList)
 readPat (view -> PVar_ x) = Just $ Left x
 readPat (L _ (ParPat _ (L _ (ConPat _ (L _ n) (InfixCon (view -> PVar_ x) (view -> PVar_ xs))))))
  | n == consDataCon_RDR = Just $ Right $ BCons x xs
-readPat (L _ (ConPat _ (L _ n) (PrefixCon [] [])))
+readPat (L _ (ConPat _ (L _ n) (PrefixCon [])))
   | n == nameRdrName nilDataConName = Just $ Right BNil
 readPat _ = Nothing