diff options
| author | alexwl <alexey.a.kiryushin@gmail.com> | 2018-12-23 17:59:00 +0300 | 
|---|---|---|
| committer | alexwl <alexey.a.kiryushin@gmail.com> | 2018-12-23 17:59:00 +0300 | 
| commit | e6d0b7bf0954f941357d77e8158aa52bb1c96686 (patch) | |
| tree | bb32dfaac36af2c009bbf2158f6ac5e9745f8fe6 /src/HaskellCodeExplorer | |
| parent | 27024fa57469af22d5b39309042f203c7b2efc5e (diff) | |
Add support for GHC 8.6.3
Diffstat (limited to 'src/HaskellCodeExplorer')
| -rw-r--r-- | src/HaskellCodeExplorer/AST/RenamedSource.hs | 148 | ||||
| -rw-r--r-- | src/HaskellCodeExplorer/AST/TypecheckedSource.hs | 511 | ||||
| -rw-r--r-- | src/HaskellCodeExplorer/GhcUtils.hs | 230 | ||||
| -rw-r--r-- | src/HaskellCodeExplorer/ModuleInfo.hs | 27 | ||||
| -rw-r--r-- | src/HaskellCodeExplorer/PackageInfo.hs | 2 | 
5 files changed, 803 insertions, 115 deletions
diff --git a/src/HaskellCodeExplorer/AST/RenamedSource.hs b/src/HaskellCodeExplorer/AST/RenamedSource.hs index 52e92e6..90f9ceb 100644 --- a/src/HaskellCodeExplorer/AST/RenamedSource.hs +++ b/src/HaskellCodeExplorer/AST/RenamedSource.hs @@ -132,8 +132,13 @@ namesFromRenamedSource =  fieldOccName :: Bool -> FieldOcc GhcRn -> NameOccurrence  #else  fieldOccName :: Bool -> FieldOcc Name -> NameOccurrence -#endif     +#endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +fieldOccName _ (XFieldOcc _) = undefined +fieldOccName isBinder (FieldOcc name (L span _)) = +#else  fieldOccName isBinder (FieldOcc (L span _) name) = +#endif    NameOccurrence      { locatedName = L span (Just name)      , description = "FieldOcc" @@ -147,6 +152,9 @@ conDeclFieldNames :: ConDeclField Name -> [NameOccurrence]  #endif      conDeclFieldNames ConDeclField {..} =    map (fieldOccName True . unLoc) cd_fld_names +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +conDeclFieldNames _ = []     +#endif      #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)  hsRecFieldExprNames :: HsRecField' (FieldOcc GhcRn) (LHsExpr GhcRn) -> [NameOccurrence] @@ -164,14 +172,19 @@ hsRecAmbFieldExprNames HsRecField {..} =    let (L span recField) = hsRecFieldLbl        mbName =          case recField of -          Ambiguous _ _ -> Nothing +          Ambiguous _ _ -> Nothing           +#if MIN_VERSION_GLASGOW_HASKELL(8,6,3,0) +          Unambiguous name _ -> Just name +          _ -> Nothing +#else            Unambiguous _ name -> Just name +#endif               in [ NameOccurrence            { locatedName = L span mbName            , description = "AmbiguousFieldOcc"            , isBinder = False            } -      ] +      ]        #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)  hsRecFieldPatNames :: HsRecField' (FieldOcc GhcRn) (LPat GhcRn) -> [NameOccurrence] @@ -184,8 +197,12 @@ hsRecFieldPatNames HsRecField {..} = [fieldOccName False $ unLoc hsRecFieldLbl]  hsExprNames :: LHsExpr GhcRn -> [NameOccurrence]  #else  hsExprNames :: LHsExpr Name -> [NameOccurrence] -#endif     +#endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +hsExprNames (L _span (HsVar _ name)) = +#else  hsExprNames (L _span (HsVar name)) = +#endif    [ NameOccurrence      { locatedName = Just <$> name      , description = "HsVar" @@ -201,28 +218,44 @@ hsExprNames (L span (ExplicitList _ _ exprs))        }      ]    | otherwise = [] +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +hsExprNames (L _span (RecordCon _ name _)) = +#else  hsExprNames (L _span (RecordCon name _conLike _instFun _binds)) = +#endif    [ NameOccurrence      { locatedName = Just <$> name      , description = "RecordCon"      , isBinder = False      }    ] +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +hsExprNames (L _span (HsRecFld _ (Unambiguous name (L span _)))) = +#else  hsExprNames (L _span (HsRecFld (Unambiguous (L span _) name))) = +#endif    [ NameOccurrence      { locatedName = L span (Just name)      , description = "HsRecFld"      , isBinder = False      }    ] +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +hsExprNames (L _span (HsRecFld _ (Ambiguous _name (L span _)))) = +#else  hsExprNames (L _span (HsRecFld (Ambiguous (L span _) _name))) = +#endif    [ NameOccurrence      { locatedName = L span Nothing      , description = "HsRecFld"      , isBinder = False      }    ] +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)   +hsExprNames (L span (HsRnBracketOut _ (VarBr _ quote name) _)) = +#else  hsExprNames (L span (HsRnBracketOut (VarBr quote name) _)) = +#endif    case span of      RealSrcSpan realSpan ->        let start = realSrcSpanStart realSpan @@ -278,7 +311,11 @@ bindNames :: LHsBindLR GhcRn GhcRn -> [NameOccurrence]  #else  bindNames :: LHsBindLR Name Name -> [NameOccurrence]  #endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +bindNames (L _span (PatSynBind _ PSB {..})) = +#else  bindNames (L _span (PatSynBind PSB {..})) = +#endif    [ NameOccurrence        { locatedName = Just <$> psb_id        , description = "PatSynBind" @@ -318,8 +355,12 @@ importNames =  patNames :: LPat GhcRn -> [NameOccurrence]  #else  patNames :: LPat Name -> [NameOccurrence] -#endif     +#endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +patNames (L _span (VarPat _ name)) = +#else  patNames (L _span (VarPat name)) = +#endif    [ NameOccurrence      { locatedName = Just <$> name      , description = "VarPat" @@ -333,14 +374,22 @@ patNames (L _span (ConPatIn name _)) =      , isBinder = False      }    ] +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)   +patNames (L _span (AsPat _ name _)) = +#else  patNames (L _span (AsPat name _)) = +#endif    [ NameOccurrence      { locatedName = Just <$> name      , description = "AsPat"      , isBinder = True      }    ] +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)     +patNames (L _span (NPlusKPat _ name _ _ _ _)) = +#else  patNames (L _span (NPlusKPat name _ _ _ _ _)) = +#endif    [ NameOccurrence      { locatedName = Just <$> name      , description = "NPlusKPat" @@ -354,8 +403,13 @@ patNames _ = []  sigNames :: LSig GhcRn -> [NameOccurrence]  #else  sigNames :: LSig Name -> [NameOccurrence] -#endif     +#endif + +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +sigNames (L _span (TypeSig _ names _)) = +#else  sigNames (L _span (TypeSig names _)) = +#endif    map      (\n ->          NameOccurrence @@ -364,9 +418,11 @@ sigNames (L _span (TypeSig names _)) =          , isBinder = False          })      names -#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)     -sigNames (L _span (PatSynSig names _)) = -  map (\name -> NameOccurrence (Just <$> name) "PatSynSig" False) names +     +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +sigNames (L _span (PatSynSig _ names _)) = map (\name -> NameOccurrence (Just <$> name) "PatSynSig" False) names     +#elif MIN_VERSION_GLASGOW_HASKELL(8,2,2,0) +sigNames (L _span (PatSynSig names _)) = map (\name -> NameOccurrence (Just <$> name) "PatSynSig" False) names  #else  sigNames (L _span (PatSynSig name _)) =    [ NameOccurrence @@ -376,7 +432,11 @@ sigNames (L _span (PatSynSig name _)) =      }    ]  #endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +sigNames (L _span (ClassOpSig _ _ names _)) = +#else  sigNames (L _span (ClassOpSig _ names _)) = +#endif    map      (\n ->          NameOccurrence @@ -385,7 +445,11 @@ sigNames (L _span (ClassOpSig _ names _)) =          , isBinder = True          })      names +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +sigNames (L _span (FixSig _ (FixitySig _ names _))) = +#else  sigNames (L _span (FixSig (FixitySig names _))) = +#endif    map      (\n ->          NameOccurrence @@ -394,21 +458,33 @@ sigNames (L _span (FixSig (FixitySig names _))) =          , isBinder = False          })      names +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +sigNames (L _span (InlineSig _ name _)) = +#else  sigNames (L _span (InlineSig name _)) = +#endif    [ NameOccurrence      { locatedName = Just <$> name      , description = "InlineSig"      , isBinder = False      }    ] +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +sigNames (L _span (SpecSig _ name _ _)) = +#else  sigNames (L _span (SpecSig name _ _)) = +#endif    [ NameOccurrence      { locatedName = Just <$> name      , description = "SpecSig"      , isBinder = False      }    ] +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)   +sigNames (L _span (MinimalSig _ _ (L _ boolFormula))) = +#else  sigNames (L _span (MinimalSig _ (L _ boolFormula))) = +#endif    map      (\n ->          NameOccurrence @@ -431,7 +507,9 @@ hsTypeNames :: LHsType GhcRn -> [NameOccurrence]  #else  hsTypeNames :: LHsType Name -> [NameOccurrence]  #endif  -#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0) +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +hsTypeNames (L _span (HsTyVar _ _promoted name)) =     +#elif MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)  hsTypeNames (L _span (HsTyVar _promoted name)) =  #else  hsTypeNames (L _span (HsTyVar name)) = @@ -442,7 +520,11 @@ hsTypeNames (L _span (HsTyVar name)) =      , isBinder = False      }    ] +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)   +hsTypeNames (L span (HsTyLit _ lit)) = +#else  hsTypeNames (L span (HsTyLit lit)) = +#endif    let kind =          case lit of            HsNumTy _ _ -> typeNatKind @@ -453,14 +535,22 @@ hsTypeNames (L span (HsTyLit lit)) =         , kind = kind         }       ] +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)      +hsTypeNames (L _span (HsOpTy _ _ name _)) = +#else  hsTypeNames (L _span (HsOpTy _ name _)) = +#endif    [ NameOccurrence      { locatedName = Just <$> name      , description = "HsOpTy"      , isBinder = False      }    ] +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)   +hsTypeNames (L span (HsTupleTy _ tupleSort types)) +#else  hsTypeNames (L span (HsTupleTy tupleSort types)) +#endif    | null types =      let sort =            case tupleSort of @@ -486,20 +576,32 @@ hsTyVarBndrNames :: HsTyVarBndr GhcRn -> [NameOccurrence]  #else  hsTyVarBndrNames :: HsTyVarBndr Name -> [NameOccurrence]  #endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)   +hsTyVarBndrNames (UserTyVar _ n) = +#else  hsTyVarBndrNames (UserTyVar n) = +#endif      [ NameOccurrence      { locatedName = Just <$> n      , description = "UserTyVar"      , isBinder = True      }    ] +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)     +hsTyVarBndrNames (KindedTyVar _ n _) = +#else  hsTyVarBndrNames (KindedTyVar n _) = +#endif    [ NameOccurrence      { locatedName = Just <$> n      , description = "KindedTyVar"      , isBinder = True      }    ] +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +hsTyVarBndrNames _ = [] +#endif     +    #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)  tyClDeclNames :: LTyClDecl GhcRn -> [NameOccurrence] @@ -543,7 +645,7 @@ tyClDeclNames _ = []  familyDeclNames :: FamilyDecl GhcRn -> [NameOccurrence]  #else  familyDeclNames :: FamilyDecl Name -> [NameOccurrence] -#endif     +#endif  familyDeclNames FamilyDecl {..} =    [ NameOccurrence      { locatedName = Just <$> fdLName @@ -551,7 +653,9 @@ familyDeclNames FamilyDecl {..} =      , isBinder = True      }    ] - +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +familyDeclNames _ = [] +#endif  #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)  familyEqNames :: FamEqn GhcRn (HsTyPats GhcRn) (LHsType GhcRn) -> [NameOccurrence] @@ -562,6 +666,9 @@ familyEqNames FamEqn {feqn_tycon = tyCon} =      , isBinder = False      }    ] +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +familyEqNames _ = [] +#endif  dataEqNames :: FamEqn GhcRn (HsTyPats GhcRn) (HsDataDefn GhcRn) -> [NameOccurrence]  dataEqNames FamEqn {feqn_tycon = tyCon} = @@ -571,6 +678,10 @@ dataEqNames FamEqn {feqn_tycon = tyCon} =      , isBinder = False      }    ] +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +dataEqNames _ = [] +#endif +  #else      tyFamilyEqNames :: TyFamEqn Name (HsTyPats Name) -> [NameOccurrence]  tyFamilyEqNames TyFamEqn {tfe_tycon = tyCon} = @@ -598,7 +709,7 @@ dataFamInstDeclNames DataFamInstDecl {dfid_tycon = tyCon} =      , isBinder = False      }    ] -#endif  +#endif  #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)  conDeclNames :: ConDecl GhcRn -> [NameOccurrence] @@ -623,6 +734,9 @@ conDeclNames con =          , isBinder = True          }        ] +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)       +    _ -> [] +#endif  #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)  foreignDeclNames :: ForeignDecl GhcRn -> [NameOccurrence] @@ -642,13 +756,20 @@ roleAnnotationNames :: RoleAnnotDecl GhcRn -> [NameOccurrence]  #else  roleAnnotationNames :: RoleAnnotDecl Name -> [NameOccurrence]  #endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)     +roleAnnotationNames (RoleAnnotDecl _ n _) = +#else  roleAnnotationNames (RoleAnnotDecl n _) = +#endif    [ NameOccurrence        { locatedName = Just <$> n        , description = "RoleAnnotDecl"        , isBinder = False        }    ] +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +roleAnnotationNames _ = [] +#endif  #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)  injectivityAnnotationNames :: InjectivityAnn GhcRn -> [NameOccurrence] @@ -665,3 +786,4 @@ injectivityAnnotationNames (InjectivityAnn lhsName rhsNames) =          , description = "InjectivityAnn"          , isBinder = False          } +         diff --git a/src/HaskellCodeExplorer/AST/TypecheckedSource.hs b/src/HaskellCodeExplorer/AST/TypecheckedSource.hs index 6f9a4cf..02f406b 100644 --- a/src/HaskellCodeExplorer/AST/TypecheckedSource.hs +++ b/src/HaskellCodeExplorer/AST/TypecheckedSource.hs @@ -1,5 +1,4 @@  {-# LANGUAGE CPP #-} -{-# LANGUAGE TupleSections #-}  {-# LANGUAGE NamedFieldPuns #-}  {-# LANGUAGE DuplicateRecordFields #-}  {-# LANGUAGE ScopedTypeVariables #-} @@ -78,6 +77,14 @@ import HsSyn    , PatSynBind(..)    , StmtLR(..)    , selectorAmbiguousFieldOcc +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +  , RecordConTc (..) +  , RecordUpdTc (..) +  , ListPatTc (..) +  , OverLitTc (..) +  , MatchGroupTc (..) +  , NHsValBindsLR (..)   +#endif    )  import HscTypes (TypeEnv, lookupTypeEnv)  #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) @@ -175,11 +182,16 @@ data ExprSort    deriving (Show, Eq)  exprSort :: HsExpr a -> ExprSort -exprSort (HsVar _) = Simple -exprSort (HsIPVar _) = Simple -exprSort (HsOverLit _) = Simple -exprSort (HsLit _) = Simple +exprSort HsVar {} = Simple +exprSort HsIPVar {} = Simple +exprSort HsOverLit {} = Simple +exprSort HsLit {} = Simple + +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +exprSort (ExplicitTuple _ args _) +#else  exprSort (ExplicitTuple args _) +#endif    | null args = Simple    | otherwise = Composite     exprSort (ExplicitList _ _ args)  @@ -187,14 +199,23 @@ exprSort (ExplicitList _ _ args)    | otherwise = Composite       exprSort _ = Composite +  patSort :: Pat a -> ExprSort -patSort (WildPat _typ) = Simple -patSort (LitPat _lit) = Simple +patSort WildPat {} = Simple +patSort LitPat {} = Simple  patSort NPat {} = Simple -patSort (ListPat pats _ _)  +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +patSort (ListPat _ pats) +#else +patSort (ListPat pats _ _) +#endif    | null pats = Simple -  | otherwise = Composite        +  | otherwise = Composite +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)     +patSort (TuplePat  _ pats _) +#else  patSort (TuplePat pats _ _) +#endif    | null pats = Simple    | otherwise = Composite  patSort _ = Composite @@ -557,29 +578,42 @@ foldLHsExpr :: LHsExpr GhcTc -> State ASTState (Maybe Type)  #else  foldLHsExpr :: LHsExpr Id -> State ASTState (Maybe Type)  #endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLHsExpr (L _span (XExpr _)) = return Nothing +foldLHsExpr (L _ (HsOverLit _ (XOverLit _))) = return Nothing +foldLHsExpr (L _ (HsLam _ (XMatchGroup _))) = return Nothing +foldLHsExpr (L _ (HsLamCase _ (XMatchGroup _))) = return Nothing +foldLHsExpr (L _ (HsCase _ _ (XMatchGroup _))) = return Nothing +foldLHsExpr (L span (HsVar _ (L _ identifier))) = +#else  foldLHsExpr (L span (HsVar (L _ identifier))) = +#endif    restoreTidyEnv $ do      (identifier', mbTypes) <- tidyIdentifier identifier      addIdentifierToIdSrcSpanMap span identifier' mbTypes      return . Just . varType $ identifier' -foldLHsExpr (L _ (HsUnboundVar _)) = return Nothing +foldLHsExpr (L _ HsUnboundVar {}) = return Nothing  #if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0) +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLHsExpr (L _ (HsConLikeOut _ conLike)) = +#else  foldLHsExpr (L _ (HsConLikeOut conLike)) = -  restoreTidyEnv $ do     -    let mbType = varType <$> conLikeWrapId_maybe conLike     -    mbType' <- maybe (return Nothing) (fmap Just . tidyType) mbType     -    return mbType'  #endif -foldLHsExpr (L _ (HsRecFld _)) = return Nothing -#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0) -foldLHsExpr (L _ (HsOverLabel _ _)) = return Nothing -#else -foldLHsExpr (L _ (HsOverLabel _)) = return Nothing +  restoreTidyEnv $ do +    let mbType = varType <$> conLikeWrapId_maybe conLike +    mbType' <- maybe (return Nothing) (fmap Just . tidyType) mbType +    return mbType'  #endif -foldLHsExpr (L span expr@(HsIPVar _)) = do +foldLHsExpr (L _ HsRecFld {}) = return Nothing +foldLHsExpr (L _ HsOverLabel {}) = return Nothing +foldLHsExpr (L span expr@HsIPVar {}) = do    addExprInfo span Nothing "HsIPVar" (exprSort expr)    return Nothing +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLHsExpr (L span (HsOverLit _ (OverLit (OverLitTc _ ol_type) _ _))) = +#else  foldLHsExpr (L span (HsOverLit OverLit {ol_type})) = +#endif    restoreTidyEnv $ do      typ <- tidyType ol_type      addExprInfo @@ -590,7 +624,11 @@ foldLHsExpr (L span (HsOverLit OverLit {ol_type})) =           then Simple           else Composite)      return $ Just typ +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)     +foldLHsExpr (L span (HsLit _ lit)) = +#else  foldLHsExpr (L span (HsLit lit)) = +#endif    restoreTidyEnv $ do      typ <- tidyType $ hsLitType lit      addExprInfo @@ -601,14 +639,22 @@ foldLHsExpr (L span (HsLit lit)) =           then Simple           else Composite)      return $ Just typ +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLHsExpr (L span expr@(HsLam _ (MG (MatchGroupTc {..}) mg_alts _))) = +#else  foldLHsExpr (L span expr@(HsLam MG {..})) = +#endif    restoreTidyEnv $ do      typ <- tidyType $ mkFunTys mg_arg_tys mg_res_ty      addExprInfo span (Just typ) "HsLam" (exprSort expr)      mapM_ foldLMatch $ unLoc mg_alts      return $ Just typ -#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)     +#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0) +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLHsExpr (L span expr@(HsLamCase _ (MG (MatchGroupTc {..}) mg_alts _))) = +#else  foldLHsExpr (L span expr@(HsLamCase MG {..})) = +#endif  #else  foldLHsExpr (L span expr@(HsLamCase _typ MG {..})) =  #endif @@ -617,52 +663,82 @@ foldLHsExpr (L span expr@(HsLamCase _typ MG {..})) =      addExprInfo span (Just typ) "HsLamCase" (exprSort expr)      mapM_ foldLMatch $ unLoc mg_alts      return $ Just typ +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)     +foldLHsExpr (L span expr@(HsApp _ fun arg)) = do +#else  foldLHsExpr (L span expr@(HsApp fun arg)) = do +#endif    funTy <- foldLHsExpr fun    _argTy <- foldLHsExpr arg -  typ <- fromMaybe (return Nothing) (funResultTySafe span "HsApp" <$> funTy) +  typ <- maybe (return Nothing) (funResultTySafe span "HsApp") funTy        addExprInfo span typ "HsApp" (exprSort expr)    return typ +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLHsExpr (L span ex@(HsAppType _ expr)) = do +#else  foldLHsExpr (L _ (HsAppType _ _)) = return Nothing  foldLHsExpr (L span ex@(HsAppTypeOut expr _)) = do +#endif    typ <- foldLHsExpr expr -  addExprInfo span typ "HsAppTypeOut" (exprSort ex) -  return typ   +  addExprInfo span typ "HsAppType" (exprSort ex) +  return typ +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)   +foldLHsExpr (L span expr@(OpApp _ left op right)) = do +#else  foldLHsExpr (L span expr@(OpApp left op _fixity right)) = do +#endif    opTyp <- foldLHsExpr op -  typ <- fromMaybe (return Nothing) (funResultTy2Safe span "HsApp" <$> opTyp) +  typ <- maybe (return Nothing) (funResultTy2Safe span "HsApp") opTyp      _ <- foldLHsExpr left    _ <- foldLHsExpr right    addExprInfo span typ "OpApp" (exprSort expr)    return typ +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)       +foldLHsExpr (L span e@(NegApp _ expr _syntaxExp)) = do +#else  foldLHsExpr (L span e@(NegApp expr _syntaxExp)) = do +#endif    typ <- foldLHsExpr expr    addExprInfo span typ "NegApp" (exprSort e)    return typ +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)         +foldLHsExpr (L _span (HsPar _ expr)) = foldLHsExpr expr +#else  foldLHsExpr (L _span (HsPar expr)) = foldLHsExpr expr +#endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLHsExpr (L span expr@(SectionL _ operand operator)) = do +#else  foldLHsExpr (L span expr@(SectionL operand operator)) = do +#endif    opType <- foldLHsExpr operator    _ <- foldLHsExpr operand -  mbTypes <- -    fromMaybe (return Nothing) (splitFunTy2Safe span "SectionL" <$> opType) +  mbTypes <- maybe (return Nothing) (splitFunTy2Safe span "SectionL") opType        let typ =          case mbTypes of            Just (_arg1, arg2, res) -> Just $ mkFunTy arg2 res            Nothing -> Nothing    addExprInfo span typ "SectionL" (exprSort expr)    return typ +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLHsExpr (L span e@(SectionR _ operator operand)) = do +#else  foldLHsExpr (L span e@(SectionR operator operand)) = do +#endif    opType <- foldLHsExpr operator    _ <- foldLHsExpr operand -  mbTypes <- -    fromMaybe (return Nothing) (splitFunTy2Safe span "SectionR" <$> opType) +  mbTypes <- maybe (return Nothing) (splitFunTy2Safe span "SectionR") opType        let typ =          case mbTypes of            Just (arg1, _arg2, res) -> Just $ mkFunTy arg1 res            Nothing -> Nothing    addExprInfo span typ "SectionR" (exprSort e)    return typ +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLHsExpr (L span e@(ExplicitTuple _ tupArgs boxity)) = do +#else  foldLHsExpr (L span e@(ExplicitTuple tupArgs boxity)) = do +#endif    tupleArgs <- mapM foldLHsTupArg tupArgs    let tupleSectionArgTys =          mapM fst . filter ((== TupArgMissing) . snd) $ tupleArgs @@ -672,24 +748,36 @@ foldLHsExpr (L span e@(ExplicitTuple tupArgs boxity)) = do    tidyEnv <- astStateTidyEnv <$> get    addExprInfo      span -    ((snd . tidyOpenType tidyEnv) <$> resultType) +    (snd . tidyOpenType tidyEnv <$> resultType)      "ExplicitTuple"      (exprSort e)    return resultType  #if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0) +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLHsExpr (L _span (ExplicitSum _ _ _ expr)) = do +#else  foldLHsExpr (L _span (ExplicitSum _ _ expr _types)) = do +#endif    -- TODO    _ <- foldLHsExpr expr    return Nothing     -#endif     +#endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLHsExpr (L span e@(HsCase _ expr (MG (MatchGroupTc {..}) mg_alts _))) = +#else  foldLHsExpr (L span e@(HsCase expr MG {..})) = +#endif    restoreTidyEnv $ do      typ <- tidyType mg_res_ty      _ <- foldLHsExpr expr      mapM_ foldLMatch (unLoc mg_alts)      addExprInfo span (Just typ) "HsCase" (exprSort e)      return $ Just typ +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLHsExpr (L span e@(HsIf _ _mbSynExpr condExpr thenExpr elseExpr)) = do +#else  foldLHsExpr (L span e@(HsIf _mbSynExpr condExpr thenExpr elseExpr)) = do +#endif    _ <- foldLHsExpr condExpr    typ <- foldLHsExpr thenExpr    _ <- foldLHsExpr elseExpr @@ -701,12 +789,20 @@ foldLHsExpr (L span e@(HsMultiIf typ grhss)) =      addExprInfo span (Just typ') "HsMultiIf" (exprSort e)      mapM_ foldLGRHS grhss      return $ Just typ' +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)     +foldLHsExpr (L span e@(HsLet _ (L _ binds) expr)) = do +#else  foldLHsExpr (L span e@(HsLet (L _ binds) expr)) = do +#endif    _ <- foldHsLocalBindsLR binds    typ <- foldLHsExpr expr    addExprInfo span typ "HsLet" (exprSort e)    return typ +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)       +foldLHsExpr (L span expr@(HsDo typ _context (L _ stmts))) = +#else  foldLHsExpr (L span expr@(HsDo _context (L _ stmts) typ)) = +#endif    restoreTidyEnv $ do      typ' <- tidyType typ      addExprInfo span (Just typ') "HsDo" (exprSort expr) @@ -718,20 +814,31 @@ foldLHsExpr (L span (ExplicitList typ _syntaxExpr exprs)) =      unless (null exprs) $ addExprInfo span (Just typ') "ExplicitList" Composite      mapM_ foldLHsExpr exprs      return $ Just typ' +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +#else  foldLHsExpr (L span e@(ExplicitPArr typ exprs)) =    restoreTidyEnv $ do      typ' <- tidyType typ      addExprInfo span (Just typ') "ExplicitPArr" (exprSort e)      mapM_ foldLHsExpr exprs      return $ Just typ' +#endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLHsExpr (L span e@(RecordCon (RecordConTc _ conExpr) _ binds)) = do +#else  foldLHsExpr (L span e@(RecordCon (L _ _) _conLike conExpr binds)) = do +#endif      mbConType <-        fmap (snd . splitFunTys) <$>        foldLHsExpr (L (UnhelpfulSpan $ mkFastString "RecordCon") conExpr)      addExprInfo span mbConType "RecordCon" (exprSort e)      _ <- foldHsRecFields binds      return mbConType +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)     +foldLHsExpr (L span e@(RecordUpd (RecordUpdTc cons _inputTys outTys _wrapper) expr binds)) = +#else  foldLHsExpr (L span e@(RecordUpd expr binds cons _inputTys outTys _wrapper)) = +#endif    restoreTidyEnv $ do         -- cons is a non-empty list of DataCons that have  all the upd'd fields      let typ = conLikeResTy (head cons) outTys @@ -740,10 +847,14 @@ foldLHsExpr (L span e@(RecordUpd expr binds cons _inputTys outTys _wrapper)) =      _ <- foldLHsExpr expr      mapM_ foldLHsRecUpdField binds      return $ Just typ' +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLHsExpr (L span e@(ExprWithTySig _ expr)) = do +#else  foldLHsExpr (L _span (ExprWithTySig _expr _type)) = return Nothing  foldLHsExpr (L span e@(ExprWithTySigOut expr _type)) = do +#endif    typ <- foldLHsExpr expr -  addExprInfo span typ "ExprWithTySigOut" (exprSort e) +  addExprInfo span typ "ExprWithTySig" (exprSort e)    return typ  foldLHsExpr (L span e@(ArithSeq postTcExpr _mbSyntaxExpr seqInfo)) = do    typ <- @@ -758,23 +869,38 @@ foldLHsExpr (L span e@(ArithSeq postTcExpr _mbSyntaxExpr seqInfo)) = do          foldLHsExpr expr1 >> foldLHsExpr expr2 >> foldLHsExpr expr3    addExprInfo span typ "ArithSeq" (exprSort e)    return typ +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +#else      foldLHsExpr (L span e@(PArrSeq postTcExpr _seqInfo)) = do    typ <- foldLHsExpr (L (UnhelpfulSpan $ mkFastString "PArrSeq") postTcExpr)    addExprInfo span typ "ArithSeq" (exprSort e)    return typ +#endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLHsExpr (L span e@(HsSCC _ _sourceText _fastString expr)) = do +#else  foldLHsExpr (L span e@(HsSCC _sourceText _fastString expr)) = do +#endif    typ <- foldLHsExpr expr    addExprInfo span typ "HsSCC" (exprSort e)    return typ +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLHsExpr (L span e@(HsCoreAnn _ _sourceText _fastString expr)) = do +#else  foldLHsExpr (L span e@(HsCoreAnn _sourceText _fastString expr)) = do +#endif    typ <- foldLHsExpr expr    addExprInfo span typ "HsCoreAnn" (exprSort e)    return typ -foldLHsExpr (L _span (HsBracket _bracket)) = return Nothing -foldLHsExpr (L _span (HsRnBracketOut _ _)) = return Nothing -foldLHsExpr (L _span (HsTcBracketOut _bracket _splice)) = return Nothing -foldLHsExpr (L _span (HsSpliceE _)) = return Nothing +foldLHsExpr (L _span HsBracket {}) = return Nothing +foldLHsExpr (L _span HsRnBracketOut {}) = return Nothing +foldLHsExpr (L _span HsTcBracketOut {}) = return Nothing +foldLHsExpr (L _span HsSpliceE {}) = return Nothing +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLHsExpr (L span expr@(HsProc _ pat cmd)) = do +#else  foldLHsExpr (L span expr@(HsProc pat cmd)) = do +#endif    _ <- foldLPat pat    _ <- foldLHsCmdTop cmd    addExprInfo span Nothing "HsProc" (exprSort expr) @@ -789,29 +915,45 @@ foldLHsExpr (L span e@(HsStatic expr)) = do    return typ  foldLHsExpr (L _ HsArrForm {}) = return Nothing  foldLHsExpr (L _ HsArrApp {}) = return Nothing +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLHsExpr (L span e@(HsTick _ _ expr)) = do +#else  foldLHsExpr (L span e@(HsTick _ expr)) = do +#endif    typ <- foldLHsExpr expr    addExprInfo span typ "HsTick" (exprSort e)    return typ +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)   +foldLHsExpr (L span e@(HsBinTick _ _ _ expr)) = do +#else  foldLHsExpr (L span e@(HsBinTick _ _ expr)) = do +#endif    typ <- foldLHsExpr expr    addExprInfo span typ "HsBinTick" (exprSort e)    return typ +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)     +foldLHsExpr (L span e@(HsTickPragma _ _ _ _ expr)) = do +#else  foldLHsExpr (L span e@(HsTickPragma _ _ _ expr)) = do +#endif    typ <- foldLHsExpr expr    addExprInfo span typ "HsTickPragma" (exprSort e)    return typ -foldLHsExpr (L _span EWildPat) = return Nothing -foldLHsExpr (L _span (EAsPat _ _)) = return Nothing -foldLHsExpr (L _span (EViewPat _ _)) = return Nothing -foldLHsExpr (L _span (ELazyPat _)) = return Nothing +foldLHsExpr (L _span EWildPat {}) = return Nothing +foldLHsExpr (L _span EAsPat {}) = return Nothing +foldLHsExpr (L _span EViewPat {}) = return Nothing +foldLHsExpr (L _span ELazyPat {}) = return Nothing +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLHsExpr (L span (HsWrap _ wrapper expr)) = +#else  foldLHsExpr (L span (HsWrap wrapper expr)) = +#endif    restoreHsWrapper $ do      case exprSort expr of        Simple -> modify' (\s -> s {astStateHsWrapper = Just wrapper})        Composite -> return () -- Not sure if it is possible      typ <- foldLHsExpr (L span expr) -    return $ applyWrapper wrapper <$> typ +    return $ applyWrapper wrapper <$> typ      #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)  foldHsRecFields :: HsRecFields GhcTc (LHsExpr GhcTc) -> State ASTState (Maybe Type) @@ -831,7 +973,12 @@ foldLHsRecField :: LHsRecField GhcTc (LHsExpr GhcTc) -> State ASTState (Maybe Ty  #else  foldLHsRecField :: LHsRecField Id (LHsExpr Id) -> State ASTState (Maybe Type)  #endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)     +foldLHsRecField (L _span (HsRecField (L _idSpan (XFieldOcc _)) _ _)) = return Nothing +foldLHsRecField (L span (HsRecField (L idSpan (FieldOcc identifier _)) arg pun)) = +#else  foldLHsRecField (L span (HsRecField (L idSpan (FieldOcc _ identifier)) arg pun)) = +#endif    restoreTidyEnv $ do      (identifier', mbTypes) <- tidyIdentifier identifier      addIdentifierToIdSrcSpanMap idSpan identifier' mbTypes @@ -872,7 +1019,12 @@ foldLHsTupArg :: LHsTupArg GhcTc -> State ASTState (Maybe Type, TupArg)  #else  foldLHsTupArg :: LHsTupArg Id -> State ASTState (Maybe Type, TupArg)  #endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLHsTupArg (L _span (XTupArg _)) = return (Nothing, TupArgMissing) +foldLHsTupArg (L _span (Present _ expr)) = +#else  foldLHsTupArg (L _span (Present expr)) = +#endif    restoreTidyEnv $ do      typ <- foldLHsExpr expr      typ' <- @@ -893,7 +1045,10 @@ foldLMatch :: LMatch Id (LHsExpr Id) -> State ASTState (Maybe Type)  foldLMatch (L _span Match {..}) = do    mapM_ foldLPat m_pats    _ <- foldGRHSs m_grhss -  return Nothing     +  return Nothing +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLMatch (L _span _) = return Nothing     +#endif  #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)        foldLMatchCmd :: LMatch GhcTc (LHsCmd GhcTc) -> State ASTState (Maybe Type) @@ -904,6 +1059,9 @@ foldLMatchCmd (L _span Match {..}) = do    mapM_ foldLPat m_pats    _ <- foldGRHSsCmd m_grhss    return Nothing +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLMatchCmd (L _span _) = return Nothing     +#endif  #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)        foldGRHSsCmd :: GRHSs GhcTc (LHsCmd GhcTc) -> State ASTState (Maybe Type) @@ -914,6 +1072,9 @@ foldGRHSsCmd GRHSs {..} = do    mapM_ foldLGRHSCmd grhssGRHSs    _ <- foldHsLocalBindsLR (unLoc grhssLocalBinds)    return Nothing +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldGRHSsCmd (_) = return Nothing     +#endif    #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)  foldGRHSs :: GRHSs GhcTc (LHsExpr GhcTc) -> State ASTState (Maybe Type) @@ -924,28 +1085,52 @@ foldGRHSs GRHSs {..} = do    mapM_ foldLGRHS grhssGRHSs    _ <- foldHsLocalBindsLR (unLoc grhssLocalBinds)    return Nothing +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldGRHSs (_) = return Nothing     +#endif  #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)  foldLStmtLR :: LStmtLR GhcTc GhcTc (LHsExpr GhcTc) -> State ASTState (Maybe Type)  #else  foldLStmtLR :: LStmtLR Id Id (LHsExpr Id) -> State ASTState (Maybe Type)  #endif -foldLStmtLR (L span (LastStmt body _ _)) =   +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLStmtLR (L _span (XStmtLR _)) = return Nothing +foldLStmtLR (L span (LastStmt _ body _ _)) = +#else +foldLStmtLR (L span (LastStmt body _ _)) = +#endif    do typ <- foldLHsExpr body       addExprInfo span typ "LastStmt" Composite       return typ +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLStmtLR (L _span (BindStmt _ pat body _ _)) = do +#else  foldLStmtLR (L _span (BindStmt pat body _ _ _)) = do +#endif    _ <- foldLPat pat    _ <- foldLHsExpr body    return Nothing -foldLStmtLR (L span (BodyStmt body _ _ _)) = do +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)   +foldLStmtLR (L span (BodyStmt _ body _ _)) = do +#else +foldLStmtLR (L span (BodyStmt body _  _ _)) = do +#endif    mbTyp <- foldLHsExpr body    addExprInfo span mbTyp "BodyStmt" Composite    return mbTyp +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)   +foldLStmtLR (L _ (LetStmt _ (L _ binds))) = do +#else  foldLStmtLR (L _ (LetStmt (L _ binds))) = do +#endif    _ <- foldHsLocalBindsLR binds    return Nothing +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)     +foldLStmtLR (L _ (ParStmt _ blocks _ _)) = do +#else  foldLStmtLR (L _ (ParStmt blocks _ _ _)) = do +#endif    mapM_ foldParStmtBlock blocks    return Nothing  foldLStmtLR (L _ TransStmt {..}) = do @@ -956,30 +1141,45 @@ foldLStmtLR (L _ TransStmt {..}) = do  foldLStmtLR (L _span RecStmt {..}) = do    mapM_ foldLStmtLR recS_stmts    return Nothing +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLStmtLR (L span (ApplicativeStmt typ args _)) = +#else  foldLStmtLR (L span (ApplicativeStmt args _ typ)) = +#endif    restoreTidyEnv $ do      typ' <- tidyType typ      mapM_ (foldApplicativeArg . snd) args      addExprInfo span (Just typ') "ApplicativeStmt" Composite      return Nothing -#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldApplicativeArg :: ApplicativeArg GhcTc -> State ASTState (Maybe Type)     +#elif MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)  foldApplicativeArg :: ApplicativeArg GhcTc GhcTc -> State ASTState (Maybe Type)  #else  foldApplicativeArg :: ApplicativeArg Id Id -> State ASTState (Maybe Type)  #endif  foldApplicativeArg appArg =    case appArg of -#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)     +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +    XApplicativeArg _ -> return Nothing +    ApplicativeArgOne _ pat expr _bool -> do +#else      ApplicativeArgOne pat expr _bool -> do +#endif  #else      ApplicativeArgOne pat expr -> do  #endif        _ <- foldLPat pat        _ <- foldLHsExpr expr        return Nothing +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)             +    ApplicativeArgMany _ exprStmts _ pat -> do +#else      ApplicativeArgMany exprStmts _ pat -> do -      _ <- mapM_ foldLStmtLR exprStmts +#endif +      mapM_ foldLStmtLR exprStmts        _ <- foldLPat pat        return Nothing    #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) @@ -987,23 +1187,44 @@ foldLStmtLRCmd ::       LStmtLR GhcTc GhcTc (LHsCmd GhcTc) -> State ASTState (Maybe Type)  #else  foldLStmtLRCmd :: LStmtLR Id Id (LHsCmd Id) -> State ASTState (Maybe Type) -#endif                   +#endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLStmtLRCmd (L _ (XStmtLR _)) = return Nothing +foldLStmtLRCmd (L span (LastStmt _ body _syntaxExpr _)) = do +#else  foldLStmtLRCmd (L span (LastStmt body _syntaxExpr _)) = do +#endif    typ <- foldLHsCmd body    addExprInfo span typ "LastStmt Cmd" Composite    return typ +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLStmtLRCmd (L _ (BindStmt _ pat body _ _)) = do +#else  foldLStmtLRCmd (L _ (BindStmt pat body _ _ _)) = do +#endif    _ <- foldLPat pat    _ <- foldLHsCmd body    return Nothing +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)   +foldLStmtLRCmd (L span (BodyStmt _ body _ _)) = do +#else  foldLStmtLRCmd (L span (BodyStmt body _ _ _)) = do +#endif    typ <- foldLHsCmd body    addExprInfo span typ "BodyStmt Cmd" Composite    return typ +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)   +foldLStmtLRCmd (L _ (LetStmt _ (L _ binds))) = do +#else  foldLStmtLRCmd (L _ (LetStmt (L _ binds))) = do +#endif    _ <- foldHsLocalBindsLR binds    return Nothing +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)     +foldLStmtLRCmd (L _ (ParStmt _ blocks _ _)) = do +#else  foldLStmtLRCmd (L _ (ParStmt blocks _ _ _)) = do +#endif    mapM_ foldParStmtBlock blocks    return Nothing  foldLStmtLRCmd (L _ TransStmt {..}) = do @@ -1014,7 +1235,11 @@ foldLStmtLRCmd (L _ TransStmt {..}) = do  foldLStmtLRCmd (L _ RecStmt {..}) = do    mapM_ foldLStmtLRCmd recS_stmts    return Nothing +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLStmtLRCmd (L span (ApplicativeStmt typ args _)) = +#else  foldLStmtLRCmd (L span (ApplicativeStmt args _ typ)) = +#endif    restoreTidyEnv $ do      typ' <- tidyType typ      mapM_ (foldApplicativeArg . snd) args @@ -1026,7 +1251,12 @@ foldLGRHS :: LGRHS GhcTc (LHsExpr GhcTc) -> State ASTState (Maybe Type)  #else  foldLGRHS :: LGRHS Id (LHsExpr Id) -> State ASTState (Maybe Type)  #endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)   +foldLGRHS (L _span (XGRHS _)) = return Nothing +foldLGRHS (L _span (GRHS _ guards body)) = do +#else  foldLGRHS (L _span (GRHS guards body)) = do +#endif    typ <- foldLHsExpr body    mapM_ foldLStmtLR guards    return typ @@ -1036,7 +1266,12 @@ foldLGRHSCmd :: LGRHS GhcTc (LHsCmd GhcTc) -> State ASTState (Maybe Type)  #else  foldLGRHSCmd :: LGRHS Id (LHsCmd Id) -> State ASTState (Maybe Type)  #endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)   +foldLGRHSCmd (L _span (XGRHS _)) = return Nothing +foldLGRHSCmd (L _span (GRHS _ guards body)) = do +#else  foldLGRHSCmd (L _span (GRHS guards body)) = do +#endif    typ <- foldLHsCmd body    mapM_ foldLStmtLR guards    return typ    @@ -1046,7 +1281,12 @@ foldParStmtBlock :: ParStmtBlock GhcTc GhcTc -> State ASTState (Maybe Type)  #else  foldParStmtBlock :: ParStmtBlock Id Id -> State ASTState (Maybe Type)  #endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)   +foldParStmtBlock (XParStmtBlock _) = return Nothing +foldParStmtBlock (ParStmtBlock _ exprStmts _ids _syntaxExpr) = do +#else  foldParStmtBlock (ParStmtBlock exprStmts _ids _syntaxExpr) = do +#endif    mapM_ foldLStmtLR exprStmts    return Nothing @@ -1055,21 +1295,35 @@ foldHsLocalBindsLR :: HsLocalBindsLR GhcTc GhcTc -> State ASTState (Maybe Type)  #else  foldHsLocalBindsLR :: HsLocalBindsLR Id Id -> State ASTState (Maybe Type)  #endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)   +foldHsLocalBindsLR (XHsLocalBindsLR _) = return Nothing +foldHsLocalBindsLR (HsValBinds _ binds) = do +#else  foldHsLocalBindsLR (HsValBinds binds) = do +#endif    _ <- foldHsValBindsLR binds    return Nothing -foldHsLocalBindsLR (HsIPBinds _binds) = return Nothing -foldHsLocalBindsLR EmptyLocalBinds = return Nothing +foldHsLocalBindsLR HsIPBinds {} = return Nothing +foldHsLocalBindsLR EmptyLocalBinds {} = return Nothing  #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)    foldHsValBindsLR :: HsValBindsLR GhcTc GhcTc -> State ASTState (Maybe Type)  #else  foldHsValBindsLR :: HsValBindsLR Id Id -> State ASTState (Maybe Type)  #endif + +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldHsValBindsLR (ValBinds _ _binds _) = do   +  return Nothing +foldHsValBindsLR (XValBindsLR (NValBinds binds _)) = do +  _ <- mapM_ (foldLHsBindsLR . snd) binds +  return Nothing       +#else      foldHsValBindsLR (ValBindsIn _ _) = return Nothing  foldHsValBindsLR (ValBindsOut binds _) = do -  _ <- mapM_ (foldLHsBindsLR . snd) binds +  mapM_ (foldLHsBindsLR . snd) binds    return Nothing +#endif    #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)    foldLHsBindsLR :: LHsBinds GhcTc -> State ASTState () @@ -1078,7 +1332,7 @@ foldLHsBindsLR :: LHsBinds Id -> State ASTState ()  #endif  foldLHsBindsLR = mapM_ (`foldLHsBindLR` Nothing) . bagToList -#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)   +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)  foldLHsBindLR :: LHsBindLR GhcTc GhcTc                -> Maybe Id -- ^ Polymorphic id                -> State ASTState (Maybe Type) @@ -1087,6 +1341,10 @@ foldLHsBindLR :: LHsBindLR Id Id                -> Maybe Id -- ^ Polymorphic id                -> State ASTState (Maybe Type)  #endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLHsBindLR (L _span (XHsBindsLR _)) _ = return Nothing +foldLHsBindLR (L _span (PatSynBind _ (XPatSynBind _))) _ = return Nothing +#endif  foldLHsBindLR (L _span FunBind {..}) mbPolyId    | mg_origin fun_matches == FromSource =      restoreTidyEnv $ do @@ -1108,8 +1366,7 @@ foldLHsBindLR (L _ PatBind {..}) _ = do    return Nothing  foldLHsBindLR (L _ VarBind {..}) _ = return Nothing  foldLHsBindLR (L _ AbsBinds {..}) _ = do -  _ <- -    mapM_ (\(bind, typ) -> foldLHsBindLR bind (Just typ)) $ +  mapM_ (\(bind, typ) -> foldLHsBindLR bind (Just typ)) $      zip (bagToList abs_binds) (map abe_poly abs_exports)    return Nothing  #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) @@ -1118,7 +1375,11 @@ foldLHsBindLR (L _ AbsBindsSig {..}) _ = do    _ <- foldLHsBindLR abs_sig_bind (Just abs_sig_export)    return Nothing  #endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLHsBindLR (L _ (PatSynBind _ PSB {..})) _ = +#else  foldLHsBindLR (L _ (PatSynBind PSB {..})) _ = +#endif    restoreTidyEnv $ do      _ <- foldLPat psb_def      _ <- @@ -1151,7 +1412,14 @@ foldLPat :: LPat GhcTc -> State ASTState (Maybe Type)  #else  foldLPat :: LPat Id -> State ASTState (Maybe Type)  #endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLPat (L _span (XPat _)) = return Nothing +foldLPat (L _ (NPat _ (L _ (XOverLit _)) _ _)) = return Nothing +foldLPat (L _ (NPlusKPat _ (L _ _) (L _ (XOverLit _)) _ _ _)) = return Nothing +foldLPat (L span (VarPat _ (L _ identifier))) = do +#else  foldLPat (L span (VarPat (L _ identifier))) = do +#endif    (identifier', _) <- tidyIdentifier identifier    addIdentifierToIdSrcSpanMap span identifier' Nothing    return . Just . varType $ identifier' @@ -1159,43 +1427,74 @@ foldLPat (L span pat@(WildPat typ)) = do    typ' <- tidyType typ    addExprInfo span (Just typ') "WildPat" (patSort pat)    return $ Just typ' +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)   +foldLPat (L span p@(LazyPat _ pat)) = do +#else  foldLPat (L span p@(LazyPat pat)) = do +#endif    mbType <- foldLPat pat    addExprInfo span mbType "LazyPat" (patSort p)    return mbType +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLPat (L span p@(AsPat _ (L idSpan identifier) pat)) = do +#else  foldLPat (L span p@(AsPat (L idSpan identifier) pat)) = do +#endif    (identifier', _) <- tidyIdentifier identifier    addIdentifierToIdSrcSpanMap idSpan identifier' Nothing    addExprInfo span (Just . varType $ identifier') "AsPat" (patSort p)    _ <- foldLPat pat    return . Just . varType $ identifier' -foldLPat (L _span (ParPat pat)) = foldLPat pat   +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)   +foldLPat (L _span (ParPat _ pat)) = foldLPat pat +#else +foldLPat (L _span (ParPat pat)) = foldLPat pat +#endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)   +foldLPat (L span p@(BangPat _ pat)) = do +#else  foldLPat (L span p@(BangPat pat)) = do +#endif    typ <- foldLPat pat    addExprInfo span typ "BangPat" (patSort p)    return typ +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLPat (L span p@(ListPat (ListPatTc typ _) pats)) = do +#else  foldLPat (L span p@(ListPat pats typ _)) = do +#endif    typ' <- tidyType typ    let listType = mkListTy typ'    addExprInfo span (Just listType) "ListPat" (patSort p) -  _ <- mapM_ foldLPat pats +  mapM_ foldLPat pats    return $ Just listType +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLPat (L span pat@(TuplePat types pats boxity)) = do +#else  foldLPat (L span pat@(TuplePat pats boxity types)) = do +#endif    typ' <- tidyType $ mkTupleTy boxity types    addExprInfo span (Just typ') "TuplePat" (patSort pat) -  _ <- mapM_ foldLPat pats +  mapM_ foldLPat pats    return $ Just typ'  #if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0) +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)     +foldLPat (L _span (SumPat _ pat _ _)) = do +#else  foldLPat (L _span (SumPat pat _ _ _types)) = do +#endif    -- TODO    _ <- foldLPat pat    return Nothing    #endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +#else  foldLPat (L span pat@(PArrPat pats typ)) = do    typ' <- tidyType typ    addExprInfo span (Just typ') "PArrPat" (patSort pat) -  _ <- mapM_ foldLPat pats +  mapM_ foldLPat pats    return $ Just typ' +#endif    foldLPat (L _span (ConPatIn _ _)) = return Nothing  foldLPat (L span pat@ConPatOut {..}) = do    let (L idSpan conLike) = pat_con  @@ -1210,14 +1509,22 @@ foldLPat (L span pat@ConPatOut {..}) = do    addExprInfo span (Just typ') "ConPatOut" (patSort pat)    _ <- foldHsConPatDetails pat_args    return . Just . varType $ identifier' +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)     +foldLPat (L span p@(ViewPat typ expr pat)) = do +#else  foldLPat (L span p@(ViewPat expr pat typ)) = do +#endif    typ' <- tidyType typ    addExprInfo span (Just typ') "ViewPat" (patSort p)    _ <- foldLPat pat    _ <- foldLHsExpr expr    return $ Just typ' -foldLPat (L _ (SplicePat _)) = return Nothing +foldLPat (L _ SplicePat {}) = return Nothing +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)   +foldLPat (L span (LitPat _ hsLit)) = do +#else  foldLPat (L span (LitPat hsLit)) = do +#endif    typ' <- tidyType $ hsLitType hsLit    addExprInfo      span @@ -1227,11 +1534,19 @@ foldLPat (L span (LitPat hsLit)) = do         then Simple         else Composite)    return $ Just typ' +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)   +foldLPat (L span pat@(NPat _ (L _spanLit (OverLit (OverLitTc {..}) _ _)) _ _)) = do +#else  foldLPat (L span pat@(NPat (L _spanLit OverLit {ol_type}) _ _ _)) = do +#endif    typ' <- tidyType ol_type    addExprInfo span (Just typ') "NPat" (patSort pat)    return $ Just ol_type +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLPat (L span pat@(NPlusKPat typ (L idSpan identifier) (L litSpan (OverLit (OverLitTc {..}) _ _)) _ _ _)) = do +#else  foldLPat (L span pat@(NPlusKPat (L idSpan identifier) (L litSpan OverLit {ol_type}) _ _ _ typ)) = do +#endif    (identifier', _) <- tidyIdentifier identifier    addIdentifierToIdSrcSpanMap idSpan identifier' Nothing    typ' <- tidyType typ @@ -1245,12 +1560,23 @@ foldLPat (L span pat@(NPlusKPat (L idSpan identifier) (L litSpan OverLit {ol_typ         then Simple         else Composite)    return $ Just typ' +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLPat (L _span (SigPat typ pat)) = do +  typ' <- tidyType typ +  _ <- foldLPat pat +  return $ Just typ'     +#else  foldLPat (L _span (SigPatIn _ _)) = return Nothing    foldLPat (L _span (SigPatOut pat typ)) = do    typ' <- tidyType typ    _ <- foldLPat pat    return $ Just typ' +#endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)   +foldLPat (L span p@(CoPat _ _ pat typ)) = do +#else  foldLPat (L span p@(CoPat _ pat typ)) = do +#endif    typ' <- tidyType typ    addExprInfo span (Just typ') "CoPat" (patSort p)    _ <- foldLPat (L span pat) @@ -1266,7 +1592,7 @@ foldHsConPatDetails    -> State ASTState (Maybe Type)  #endif    foldHsConPatDetails (PrefixCon args) = do -  _ <- mapM_ foldLPat args +  mapM_ foldLPat args    return Nothing  foldHsConPatDetails (RecCon rec) = do    _ <- foldHsRecFieldsPat rec @@ -1286,7 +1612,7 @@ foldHsRecFieldsPat HsRecFields {..} = do          case rec_dotdot of            Just i -> take i            Nothing -> id -  _ <- mapM_ foldLHsRecFieldPat $ onlyUserWritten rec_flds +  mapM_ foldLHsRecFieldPat $ onlyUserWritten rec_flds    return Nothing  #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) @@ -1294,18 +1620,30 @@ foldLHsRecFieldPat :: LHsRecField GhcTc (LPat GhcTc) -> State ASTState (Maybe Ty  #else  foldLHsRecFieldPat :: LHsRecField Id (LPat Id) -> State ASTState (Maybe Type)  #endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLHsRecFieldPat (L _ (HsRecField (L idSpan (FieldOcc identifier _)) arg pun)) = do +#else  foldLHsRecFieldPat (L _ (HsRecField (L idSpan (FieldOcc _ identifier)) arg pun)) = do +#endif    (identifier', mbTypes) <- tidyIdentifier identifier    addIdentifierToIdSrcSpanMap idSpan identifier' mbTypes    unless pun $ void $ foldLPat arg    return . Just . varType $ identifier' +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLHsRecFieldPat (L _ (HsRecField (L _idSpan (XFieldOcc _)) _arg _pun)) = return Nothing     +#endif      #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)  foldLHsCmdTop :: LHsCmdTop GhcTc -> State ASTState (Maybe Type)  #else  foldLHsCmdTop :: LHsCmdTop Id -> State ASTState (Maybe Type)  #endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)   +foldLHsCmdTop (L _span (XCmdTop _)) = return Nothing +foldLHsCmdTop (L span (HsCmdTop _ cmd)) = do +#else  foldLHsCmdTop (L span (HsCmdTop cmd _ _ _)) = do +#endif    mbTyp <- foldLHsCmd cmd    addExprInfo span mbTyp "HsCmdTop" Composite    return mbTyp @@ -1315,44 +1653,87 @@ foldLHsCmd :: LHsCmd GhcTc -> State ASTState (Maybe Type)  #else  foldLHsCmd :: LHsCmd Id -> State ASTState (Maybe Type)  #endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)       +foldLHsCmd (L _ (XCmd _)) = return Nothing +foldLHsCmd (L _ (HsCmdLam _ (XMatchGroup _))) = return Nothing +foldLHsCmd (L _ (HsCmdCase _ _ (XMatchGroup _))) = return Nothing +foldLHsCmd (L _ (HsCmdArrApp _ expr1 expr2 _ _)) = do +#else  foldLHsCmd (L _ (HsCmdArrApp expr1 expr2 _ _ _)) = do +#endif    _ <- foldLHsExpr expr1    _ <- foldLHsExpr expr2    return Nothing -#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)   +#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0) +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)       +foldLHsCmd (L _ (HsCmdArrForm _ expr _  _ topCmds)) = do +#else  foldLHsCmd (L _ (HsCmdArrForm expr _  _ topCmds)) = do +#endif  #else  foldLHsCmd (L _ (HsCmdArrForm expr _ topCmds)) = do  #endif    _ <- foldLHsExpr expr -  _ <- mapM_ foldLHsCmdTop topCmds -  return Nothing   +  mapM_ foldLHsCmdTop topCmds +  return Nothing +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLHsCmd (L _ (HsCmdApp _ cmd expr)) = do +#else  foldLHsCmd (L _ (HsCmdApp cmd expr)) = do +#endif    _ <- foldLHsCmd cmd    _ <- foldLHsExpr expr    return Nothing +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLHsCmd (L _ (HsCmdLam _ MG {..})) = do +#else  foldLHsCmd (L _ (HsCmdLam MG {..})) = do +#endif    mapM_ foldLMatchCmd $ unLoc mg_alts    return Nothing +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)   +foldLHsCmd (L _ (HsCmdCase _ expr MG {..})) = do +#else  foldLHsCmd (L _ (HsCmdCase expr MG {..})) = do +#endif    _ <- foldLHsExpr expr    mapM_ foldLMatchCmd $ unLoc mg_alts -  return Nothing    +  return Nothing +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +foldLHsCmd (L _ (HsCmdPar _ cmd)) = do +#else  foldLHsCmd (L _ (HsCmdPar cmd)) = do +#endif    _ <- foldLHsCmd cmd    return Nothing +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)   +foldLHsCmd (L _ (HsCmdIf _ _ expr cmd1 cmd2)) = do +#else  foldLHsCmd (L _ (HsCmdIf _ expr cmd1 cmd2)) = do +#endif    _ <- foldLHsCmd cmd1    _ <- foldLHsCmd cmd2    _ <- foldLHsExpr expr    return Nothing +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)     +foldLHsCmd (L _ (HsCmdLet _ (L _ binds) cmd)) = do +#else  foldLHsCmd (L _ (HsCmdLet (L _ binds) cmd)) = do +#endif    _ <- foldLHsCmd cmd    _ <- foldHsLocalBindsLR binds    return Nothing +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)       +foldLHsCmd (L _ (HsCmdDo _ stmts)) = do +#else  foldLHsCmd (L _ (HsCmdDo stmts _)) = do +#endif    mapM_ foldLStmtLRCmd $ unLoc stmts    return Nothing +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)       +foldLHsCmd (L span (HsCmdWrap _ _ cmd)) = do +#else  foldLHsCmd (L span (HsCmdWrap _ cmd)) = do +#endif        _ <- foldLHsCmd (L span cmd)    return Nothing diff --git a/src/HaskellCodeExplorer/GhcUtils.hs b/src/HaskellCodeExplorer/GhcUtils.hs index 3a4ec26..3ac1f86 100644 --- a/src/HaskellCodeExplorer/GhcUtils.hs +++ b/src/HaskellCodeExplorer/GhcUtils.hs @@ -69,7 +69,6 @@ import qualified Data.Generics.Uniplate.Data()  import qualified Data.HashMap.Strict as HM  import qualified Data.List as L  import Data.Maybe (fromMaybe, isJust, mapMaybe) -import Data.Ord (comparing)  import qualified Data.Text as T  import DataCon (dataConWorkId, flSelector)  import Documentation.Haddock.Parser (overIdentifier, parseParas) @@ -103,10 +102,9 @@ import GHC    , IE(..)      , TyThing(..)    , LHsDecl   -  , HsDecl(..)   +  , HsDecl(..)    , DocDecl(..)      , ConDecl(..) -  , PostRn      , HsConDetails(..)      , ConDeclField(..)      , DataFamInstDecl(..) @@ -119,8 +117,16 @@ import GHC    , getLoc    , hsSigType    , getConNames +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +  , NHsValBindsLR(..) +  , getConArgs +  , unpackHDS +  , NoExt(..) +  , extFieldOcc   +#else    , getConDetails    , selectorFieldOcc +#endif  #if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)        , tyClGroupTyClDecls    , LIEWrappedName @@ -275,11 +281,32 @@ instanceDeclToText :: DynFlags -> InstDecl Name -> T.Text  #endif  instanceDeclToText flags decl =    case decl of -    ClsInstD ClsInstDecl {..} -> T.append "instance " (toText flags cid_poly_ty) -#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +    XInstDecl _ -> "" +    ClsInstD _ (XClsInstDecl _) -> "" +    ClsInstD _ ClsInstDecl {..} -> +#else +    ClsInstD ClsInstDecl {..} -> +#endif +      T.append "instance " (toText flags cid_poly_ty) + +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +    DataFamInstD _ di -> +      let args = +            T.intercalate " " . map (toText flags) .  feqn_pats  . hsib_body . dfid_eqn $ di +       in T.concat +            ["data instance ", toText flags (unLoc $ feqn_tycon . hsib_body . dfid_eqn $ di), " ", args] +    TyFamInstD _ ti -> +      let args = +            T.intercalate " " . +            map (toText flags) . feqn_pats . hsib_body . tfid_eqn $ +            ti +       in T.concat +            ["type instance ", toText flags $ tyFamInstDeclName ti, " ", args] +#elif MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)      DataFamInstD di ->        let args = -            T.intercalate " " . map (toText flags) .  feqn_pats  .hsib_body . dfid_eqn $ di +            T.intercalate " " . map (toText flags) .  feqn_pats  . hsib_body . dfid_eqn $ di         in T.concat              ["data instance ", toText flags (unLoc $ feqn_tycon . hsib_body . dfid_eqn $ di), " ", args]      TyFamInstD ti -> @@ -313,7 +340,7 @@ tyClDeclPrefix tyClDecl =        isNewTy DataDecl {tcdDataDefn = HsDataDefn {dd_ND = NewType}} = True        isNewTy _ = False     in case tyClDecl of -        FamDecl _ +        FamDecl {}            | isDataFamilyDecl tyClDecl -> "data family "            | otherwise -> "type family "          SynDecl {} -> "type " @@ -321,6 +348,9 @@ tyClDeclPrefix tyClDecl =            | isNewTy tyClDecl -> "newtype "            | otherwise -> "data "          ClassDecl {} -> "class " +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +        XTyClDecl _ -> "" +#endif      demangleOccName :: Name -> T.Text  demangleOccName name @@ -411,7 +441,11 @@ hsGroupVals :: HsGroup Name -> [GenLocated SrcSpan (HsBindLR Name Name)]  hsGroupVals hsGroup =    filter (isGoodSrcSpan . getLoc) $    case hs_valds hsGroup of +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)     +    XValBindsLR (NValBinds binds _) -> concatMap (bagToList . snd) binds +#else      ValBindsOut binds _ -> concatMap (bagToList . snd) binds +#endif      _ -> []  hsPatSynDetails :: HsPatSynDetails a -> [a] @@ -450,15 +484,36 @@ ieLocNames :: IE pass -> [Located (IdP pass)]  #else  ieLocNames :: IE Name -> [Located Name]  #endif -ieLocNames (IEVar n) = [unwrapName n] -ieLocNames (IEThingAbs n) = [unwrapName n] -ieLocNames (IEThingAll n) = [unwrapName n] + +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +ieLocNames (XIE _) = [] +ieLocNames (IEVar _ n) = +#else +ieLocNames (IEVar n) =  +#endif +  [unwrapName n] +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +ieLocNames (IEThingAbs _ n) = +#else +ieLocNames (IEThingAbs n) = +#endif +  [unwrapName n] +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +ieLocNames (IEThingAll _ n) = +#else +ieLocNames (IEThingAll n) = +#endif +  [unwrapName n] +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +ieLocNames (IEThingWith _ n _ ns labels) = +#else  ieLocNames (IEThingWith n _ ns labels) = +#endif    unwrapName n : (map unwrapName ns ++ map (fmap flSelector) labels) -ieLocNames (IEModuleContents (L _ _)) = [] -ieLocNames (IEGroup _ _) = [] -ieLocNames (IEDoc _) = [] -ieLocNames (IEDocNamed _) = [] +ieLocNames IEModuleContents {} = [] +ieLocNames IEGroup {} = [] +ieLocNames IEDoc {} = [] +ieLocNames IEDocNamed {} = []  --------------------------------------------------------------------------------  -- Lookups @@ -959,10 +1014,19 @@ collectDocs = go Nothing []    where      go Nothing _ [] = []      go (Just prev) docs [] = finished prev docs [] +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +    go prev docs (L _ (DocD _ (DocCommentNext str)):ds) +#else      go prev docs (L _ (DocD (DocCommentNext str)):ds) +#endif +        | Nothing <- prev = go Nothing (str : docs) ds        | Just decl <- prev = finished decl docs (go Nothing [str] ds) +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)         +    go prev docs (L _ (DocD _ (DocCommentPrev str)):ds) = go prev (str : docs) ds +#else      go prev docs (L _ (DocD (DocCommentPrev str)):ds) = go prev (str : docs) ds +#endif      go Nothing docs (d:ds) = go (Just d) docs ds      go (Just prev) docs (d:ds) = finished prev docs (go (Just d) [] ds)      finished decl docs rest = (decl, reverse docs) : rest @@ -973,33 +1037,62 @@ ungroup :: HsGroup GhcRn -> [LHsDecl GhcRn]  ungroup :: HsGroup Name -> [LHsDecl Name]  #endif  ungroup group_ = -#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0) +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +  mkDecls (tyClGroupTyClDecls . hs_tyclds) (TyClD NoExt) group_ ++   +#elif MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)    mkDecls (tyClGroupTyClDecls . hs_tyclds) TyClD group_ ++    #else    mkDecls (tyClGroupConcat . hs_tyclds) TyClD group_ ++  #endif + +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +  mkDecls hs_derivds (DerivD NoExt) group_ ++ +  mkDecls hs_defds (DefD NoExt) group_ ++ +  mkDecls hs_fords (ForD NoExt) group_ ++ +  mkDecls hs_docs (DocD NoExt) group_ ++   +#else    mkDecls hs_derivds DerivD group_ ++    mkDecls hs_defds DefD group_ ++    mkDecls hs_fords ForD group_ ++    mkDecls hs_docs DocD group_ ++ -#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)   +#endif +   +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +  mkDecls hsGroupInstDecls (InstD NoExt) group_ ++ +#elif MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)      mkDecls hsGroupInstDecls InstD group_ ++  #else    mkDecls hs_instds InstD group_ ++  #endif + +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +  mkDecls (typesigs . hs_valds) (SigD NoExt) group_ ++ +  mkDecls (valbinds . hs_valds) (ValD NoExt) group_ +#else    mkDecls (typesigs . hs_valds) SigD group_ ++    mkDecls (valbinds . hs_valds) ValD group_ +#endif   + +      where +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)     +    typesigs (XValBindsLR (NValBinds _ sigs)) = filter isUserLSig sigs +#else      typesigs (ValBindsOut _ sigs) = filter isUserLSig sigs +#endif      typesigs _ = [] +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)         +    valbinds (XValBindsLR (NValBinds binds _)) = concatMap bagToList . snd . unzip $ binds +#else      valbinds (ValBindsOut binds _) = concatMap bagToList . snd . unzip $ binds +#endif      valbinds _ = []  mkDecls :: (a -> [Located b]) -> (b -> c) -> a -> [Located c]  mkDecls field con struct = [L loc (con decl) | L loc decl <- field struct]  sortByLoc :: [Located a] -> [Located a] -sortByLoc = L.sortBy (comparing getLoc) +sortByLoc = L.sortOn getLoc  #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)  classDeclDocs :: TyClDecl GhcRn -> [(LHsDecl GhcRn, [HsDocString])] @@ -1009,10 +1102,18 @@ classDeclDocs :: TyClDecl Name -> [(LHsDecl Name, [HsDocString])]  classDeclDocs class_ = collectDocs . sortByLoc $ decls    where      decls = docs ++ defs ++ sigs ++ ats +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)     +    docs = mkDecls tcdDocs (DocD NoExt) class_ +    defs = mkDecls (bagToList . tcdMeths) (ValD NoExt) class_ +    sigs = mkDecls tcdSigs (SigD NoExt) class_ +    ats = mkDecls tcdATs ((TyClD NoExt) . (FamDecl NoExt)) class_ +#else      docs = mkDecls tcdDocs DocD class_      defs = mkDecls (bagToList . tcdMeths) ValD class_      sigs = mkDecls tcdSigs SigD class_      ats = mkDecls tcdATs (TyClD . FamDecl) class_ +#endif +  #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)  conDeclDocs :: ConDecl GhcRn -> [(Name, [HsDocString], SrcSpan)] @@ -1025,18 +1126,30 @@ conDeclDocs conDecl =    conDecl  #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) -selectorDocs :: ConDecl pass -> [(PostRn pass (IdP pass), [HsDocString], SrcSpan)] +selectorDocs :: ConDecl GhcRn -> [(Name, [HsDocString], SrcSpan)]  #else -selectorDocs :: ConDecl name -> [(PostRn name name, [HsDocString], SrcSpan)] +selectorDocs :: ConDecl Name -> [(Name, [HsDocString], SrcSpan)]  #endif  selectorDocs con = +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)   +  case getConArgs con of +#else    case getConDetails con of +#endif      RecCon (L _ flds) ->        concatMap +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +        (\(L _ (ConDeclField _ fieldOccs _ mbDoc)) -> +#else          (\(L _ (ConDeclField fieldOccs _ mbDoc)) -> +#endif             map               (\(L span f) -> +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +                (extFieldOcc f, maybe [] ((: []) . unLoc) mbDoc, span)) +#else                  (selectorFieldOcc f, maybe [] ((: []) . unLoc) mbDoc, span)) +#endif               fieldOccs)          flds      _ -> [] @@ -1050,14 +1163,27 @@ subordinateNamesWithDocs =      concatMap      (\(L span tyClDecl) ->         case tyClDecl of +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +         TyClD _ classDecl@ClassDecl {..} -> +#else           TyClD classDecl@ClassDecl {..} -> +#endif             concatMap               (\(L _ decl, docs) -> map (, docs, span) $ getMainDeclBinder decl) $             classDeclDocs classDecl +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +         TyClD _ DataDecl {..} -> +#else           TyClD DataDecl {..} -> +#endif             concatMap (\(L _ con) -> conDeclDocs con ++ selectorDocs con) $             dd_cons tcdDataDefn +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +         InstD _ (DataFamInstD _ DataFamInstDecl {..}) -> +#else           InstD (DataFamInstD DataFamInstDecl {..}) -> +#endif +  #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)                            concatMap (conDeclDocs . unLoc) . dd_cons . feqn_rhs  . hsib_body $ dfid_eqn  #else @@ -1076,14 +1202,35 @@ getMainDeclBinder :: HsDecl pass -> [IdP pass]  #else  getMainDeclBinder :: HsDecl name -> [name]  #endif -getMainDeclBinder (TyClD d) = [tcdName d] +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +getMainDeclBinder (TyClD _ d) = +#else +getMainDeclBinder (TyClD d) = +#endif +  [tcdName d] +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +getMainDeclBinder (ValD _ d) = +#else  getMainDeclBinder (ValD d) = +#endif    case collectHsBindBinders d of      [] -> []      (name:_) -> [name] +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +getMainDeclBinder (SigD _ d) = sigNameNoLoc d +#else  getMainDeclBinder (SigD d) = sigNameNoLoc d +#endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +getMainDeclBinder (ForD _ (ForeignImport _ name _ _)) = [unLoc name] +#else  getMainDeclBinder (ForD (ForeignImport name _ _ _)) = [unLoc name] +#endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +getMainDeclBinder (ForD _ ForeignExport {}) = [] +#else  getMainDeclBinder (ForD ForeignExport {}) = [] +#endif  getMainDeclBinder _ = []  #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) @@ -1091,20 +1238,45 @@ sigNameNoLoc :: Sig pass -> [IdP pass]  #else      sigNameNoLoc :: Sig name -> [name]  #endif -sigNameNoLoc (TypeSig      ns _)       = map unLoc ns -sigNameNoLoc (ClassOpSig _ ns _)       = map unLoc ns -#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0) -sigNameNoLoc (PatSynSig    ns _)        = map unLoc ns +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +sigNameNoLoc (TypeSig _ ns _) = map unLoc ns +#else +sigNameNoLoc (TypeSig ns _) = map unLoc ns +#endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +sigNameNoLoc (ClassOpSig _ _ ns _) = map unLoc ns +#else +sigNameNoLoc (ClassOpSig _ ns _) = map unLoc ns +#endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +sigNameNoLoc (PatSynSig _ ns _) = map unLoc ns +#elif MIN_VERSION_GLASGOW_HASKELL(8,2,2,0) +sigNameNoLoc (PatSynSig ns _) = map unLoc ns +#else +sigNameNoLoc (PatSynSig n _) = [unLoc n] +#endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +sigNameNoLoc (SpecSig _ n _ _) = [unLoc n] +#else +sigNameNoLoc (SpecSig n _ _) = [unLoc n] +#endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +sigNameNoLoc (InlineSig _ n _) = [unLoc n]  #else -sigNameNoLoc (PatSynSig    n _)        = [unLoc n] +sigNameNoLoc (InlineSig n _) = [unLoc n]  #endif -sigNameNoLoc (SpecSig      n _ _)      = [unLoc n] -sigNameNoLoc (InlineSig    n _)        = [unLoc n] +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +sigNameNoLoc (FixSig _ (FixitySig _ ns _)) = map unLoc ns +#else  sigNameNoLoc (FixSig (FixitySig ns _)) = map unLoc ns +#endif  sigNameNoLoc _                         = []  clsInstDeclSrcSpan :: ClsInstDecl a -> SrcSpan  clsInstDeclSrcSpan ClsInstDecl {cid_poly_ty = ty} = getLoc (hsSigType ty) +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +clsInstDeclSrcSpan (XClsInstDecl _) = UnhelpfulSpan "XClsinstdecl" +#endif  hsDocsToDocH :: DynFlags -> GlobalRdrEnv -> [HsDocString] -> Doc Name  hsDocsToDocH flags rdrEnv = @@ -1116,7 +1288,11 @@ hsDocsToDocH flags rdrEnv =  #else      . parseParas  #endif +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)     +    . concatMap unpackHDS +#else      . concatMap (unpackFS . (\(HsDocString s) -> s)) +#endif  parseIdent :: DynFlags -> String -> Maybe RdrName  parseIdent dflags str0 = diff --git a/src/HaskellCodeExplorer/ModuleInfo.hs b/src/HaskellCodeExplorer/ModuleInfo.hs index e908af2..a97d758 100644 --- a/src/HaskellCodeExplorer/ModuleInfo.hs +++ b/src/HaskellCodeExplorer/ModuleInfo.hs @@ -25,7 +25,6 @@ import qualified Data.IntMap.Strict as IM  import qualified Data.IntervalMap.Strict as IVM  import qualified Data.List as L hiding (span)  import Data.Maybe (fromMaybe, mapMaybe) -import Data.Ord (comparing)  #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)  import HsExtension (GhcRn)  #endif @@ -241,7 +240,7 @@ createModuleInfo (fileMap, defSiteMap, moduleNameMap) (flags, typecheckedModule,                     (HM.fromList .                      (( HCE.HaskellFilePath $ HCE.getHaskellModulePath modulePath                       , modulePath) :) . -                    map (\includedFile -> (includedFile, modulePath)) $ +                    map (, modulePath) $                      includedFiles)                     fileMap                 , HM.union (HM.singleton modulePath defSites) defSiteMap @@ -279,9 +278,11 @@ prepareSourceCode ::    -> (HCE.SourceCodeTransformation, T.Text)  prepareSourceCode sourceCodePreprocessing originalSourceCode modSum modulePath =    let sourceCodeAfterPreprocessing = -        case TE.decodeUtf8' -               (fromMaybe (error "ms_hspp_buf is Nothing") $ -                stringBufferToByteString <$> ms_hspp_buf modSum) of +        case TE.decodeUtf8' $ +             maybe +               (error "ms_hspp_buf is Nothing") +               stringBufferToByteString +               (ms_hspp_buf modSum) of            Right text -> T.replace "\t" "        " text            Left err ->              error $ @@ -322,12 +323,12 @@ createDefinitionSiteMap flags currentPackageId compId defSiteMap fileMap globalR  #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)        allDecls :: [GenLocated SrcSpan (HsDecl GhcRn)]  #endif -      allDecls = L.sortBy (comparing getLoc) . ungroup $ hsGroup +      allDecls = L.sortOn getLoc . ungroup $ hsGroup        (instanceDeclsWithDocs, valueAndTypeDeclsWithDocs) =          L.partition            (\(L _ decl, _) ->               case decl of -               InstD _ -> True +               InstD {} -> True                 _ -> False) $          collectDocs allDecls        -------------------------------------------------------------------------------- @@ -340,7 +341,11 @@ createDefinitionSiteMap flags currentPackageId compId defSiteMap fileMap globalR          mapMaybe            (\(L _n decl, docs) ->               case decl of +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)                +               InstD _ (ClsInstD _ inst) -> Just (clsInstDeclSrcSpan inst, docs) +#else                   InstD (ClsInstD inst) -> Just (clsInstDeclSrcSpan inst, docs) +#endif                   _ -> Nothing) $          instanceDeclsWithDocs        nameLocation :: Maybe SrcSpan -> Name -> HCE.LocationInfo @@ -563,7 +568,7 @@ createDeclarations flags hsGroup typeEnv exportedSet transformation =                (lineNumber loc)        fords = map foreignFunToDeclaration $ hs_fords hsGroup        -------------------------------------------------------------------------------- -   in L.sortBy (comparing HCE.lineNumber) $ vals ++ tyclds ++ insts ++ fords +   in L.sortOn HCE.lineNumber $ vals ++ tyclds ++ insts ++ fords  foldAST :: Environment -> TypecheckedModule -> SourceInfo  foldAST environment typecheckedModule = @@ -616,7 +621,11 @@ foldAST environment typecheckedModule =                (\(L span ie) ->  #endif                   case ie of +#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +                   IEModuleContents _ (L _ modName) -> +#else                     IEModuleContents (L _ modName) -> +#endif                       Just                         ( modName                         , span @@ -632,7 +641,7 @@ foldAST environment typecheckedModule =        addImportedAndExportedModulesToIdOccMap ::             HCE.IdentifierOccurrenceMap -> HCE.IdentifierOccurrenceMap        addImportedAndExportedModulesToIdOccMap = -        IM.map (L.sortBy $ comparing fst) . +        IM.map (L.sortOn fst) .          addModules            (envTransformation environment)            (importedModules ++ exportedModules) diff --git a/src/HaskellCodeExplorer/PackageInfo.hs b/src/HaskellCodeExplorer/PackageInfo.hs index 2b1eeac..46b02c4 100644 --- a/src/HaskellCodeExplorer/PackageInfo.hs +++ b/src/HaskellCodeExplorer/PackageInfo.hs @@ -443,7 +443,7 @@ indexBuildComponent sourceCodePreprocessing currentPackageId componentId deps@(f        (flags', _, _) <-          parseDynamicFlagsCmdLine            flags -          (L.map noLoc . L.filter ((/=) "-Werror") $ options) -- -Werror flag makes warnings fatal  +          (L.map noLoc . L.filter ("-Werror" /=) $ options) -- -Werror flag makes warnings fatal         (flags'', _) <- liftIO $ initPackages flags'        logFn <- askLoggerIO        let logAction ::  | 
