diff options
Diffstat (limited to 'src/HaskellCodeExplorer/AST')
| -rw-r--r-- | src/HaskellCodeExplorer/AST/RenamedSource.hs | 178 |
1 files changed, 35 insertions, 143 deletions
diff --git a/src/HaskellCodeExplorer/AST/RenamedSource.hs b/src/HaskellCodeExplorer/AST/RenamedSource.hs index cb0f132..bdbed89 100644 --- a/src/HaskellCodeExplorer/AST/RenamedSource.hs +++ b/src/HaskellCodeExplorer/AST/RenamedSource.hs @@ -204,70 +204,46 @@ hsRecFieldPatNames :: HsRecField' (FieldOcc Name) (LPat Name) -> [NameOccurrence #endif hsRecFieldPatNames HsRecField {..} = [fieldOccName False $ unLoc hsRecFieldLbl] -#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) hsExprNames :: LHsExpr GhcRn -> [NameOccurrence] -#else -hsExprNames :: LHsExpr Name -> [NameOccurrence] -#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 <$> reLocN name , description = "HsVar" , isBinder = False } ] -hsExprNames (L span (ExplicitList _ exprs)) +hsExprNames lhe@(L _ (ExplicitList _ exprs)) | null exprs = [ NameOccurrence - { locatedName = L span $ Just nilDataConName + { locatedName = L (getLocA lhe) $ Just nilDataConName , description = "ExplicitList" , isBinder = False } ] | 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 + { locatedName = Just <$> reLocN 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 +hsExprNames (L _span (HsRecFld _ (Unambiguous name located))) = [ NameOccurrence - { locatedName = L span (Just name) + { locatedName = L (getLocA located) (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 +hsExprNames (L _span (HsRecFld _ (Ambiguous _name located))) = [ NameOccurrence - { locatedName = L span Nothing + { locatedName = L (getLocA located) 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 +hsExprNames lhr@(L span (HsRnBracketOut _ (VarBr _ quote name) _)) = + case getLocA lhr of RealSrcSpan realSpan _ -> let start = realSrcSpanStart realSpan end = realSrcSpanEnd realSpan @@ -280,9 +256,9 @@ hsExprNames (L span (HsRnBracketOut (VarBr quote name) _)) = (srcLocFile start) (srcLocLine start) (srcLocCol start + offset) - span' = RealSrcSpan $ mkRealSrcSpan start' end + span' = RealSrcSpan (mkRealSrcSpan start' end) Nothing in [ NameOccurrence - { locatedName = L span' (Just name) + { locatedName = L span' (Just $ unLoc name) , description = "VarBr" , isBinder = False } @@ -290,52 +266,30 @@ hsExprNames (L span (HsRnBracketOut (VarBr quote name) _)) = _ -> [] hsExprNames _ = [] -#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) matchGroupNames :: MatchGroup GhcRn (LHsExpr GhcRn) -> [NameOccurrence] -#else -matchGroupNames :: MatchGroup Name (LHsExpr Name) -> [NameOccurrence] -#endif matchGroupNames = -#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0) mapMaybe (fmap toNameOcc . matchContextName . m_ctxt . unLoc) . -#else - mapMaybe (fmap toNameOcc . matchFixityName . m_fixity . unLoc) . -#endif unLoc . mg_alts where -#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0) --matchContextName :: HsMatchContext Name -> Maybe (Located Name) matchContextName (FunRhs name _ _bool) = Just name matchContextName _ = Nothing -#else - --matchFixityName :: MatchFixity Name -> Maybe (Located Name) - matchFixityName NonFunBindMatch = Nothing - matchFixityName (FunBindMatch name _bool) = Just name -#endif - --toNameOcc :: Located Name -> NameOccurrence + --toNameOcc :: LIdP GhcRn -> NameOccurrence toNameOcc n = NameOccurrence - {locatedName = Just <$> n, description = "Match", isBinder = True} + {locatedName = Just <$> reLocN n, description = "Match", isBinder = True} -#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) 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 + { locatedName = Just <$> reLocN psb_id , description = "PatSynBind" , isBinder = True } ] bindNames _ = [] -hsPatSynDetailsNames :: HsPatSynDetails (Located Name) -> [NameOccurrence] +hsPatSynDetailsNames :: HsPatSynDetails GhcRn -> [NameOccurrence] hsPatSynDetailsNames = map (\name -> @@ -363,30 +317,30 @@ importNames = patNames :: LPat GhcRn -> [NameOccurrence] -patNames (ghcDL -> (L _span (VarPat _ name))) = +patNames (L _span (VarPat _ name)) = [ NameOccurrence - { locatedName = Just <$> name + { locatedName = Just <$> reLocN name , description = "VarPat" , isBinder = True } ] -patNames (ghcDL -> (L _span (ConPat _ name _))) = +patNames (L _span (ConPat _ name _)) = [ NameOccurrence - { locatedName = Just <$> name + { locatedName = Just <$> reLocN name , description = "ConPatIn" , isBinder = False } ] -patNames (ghcDL -> (L _span (AsPat _ name _))) = +patNames (L _span (AsPat _ name _)) = [ NameOccurrence - { locatedName = Just <$> name + { locatedName = Just <$> reLocN name , description = "AsPat" , isBinder = True } ] -patNames (ghcDL -> (L _span (NPlusKPat _ name _ _ _ _))) = +patNames (L _span (NPlusKPat _ name _ _ _ _)) = [ NameOccurrence - { locatedName = Just <$> name + { locatedName = Just <$> reLocN name , description = "NPlusKPat" , isBinder = True } @@ -394,96 +348,56 @@ patNames (ghcDL -> (L _span (NPlusKPat _ name _ _ _ _))) = patNames _ = [] -#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) sigNames :: LSig GhcRn -> [NameOccurrence] -#else -sigNames :: LSig Name -> [NameOccurrence] -#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 - { locatedName = Just <$> n + { locatedName = Just <$> reLocN n , description = "TypeSig" , isBinder = 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 - { locatedName = Just <$> name - , description = "PatSynSig" - , isBinder = False - } - ] -#endif -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) +sigNames (L _span (PatSynSig _ names _)) = + map (\name -> NameOccurrence (Just <$> reLocN name) "PatSynSig" False) names sigNames (L _span (ClassOpSig _ _ names _)) = -#else -sigNames (L _span (ClassOpSig _ names _)) = -#endif map (\n -> NameOccurrence - { locatedName = Just <$> n + { locatedName = Just <$> reLocN n , description = "ClassOpSig" , 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 - { locatedName = Just <$> n + { locatedName = Just <$> reLocN n , description = "FixitySig" , 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 + { locatedName = Just <$> reLocN 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 + { locatedName = Just <$> reLocN 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 - { locatedName = Just <$> n + { locatedName = Just <$> reLocN n , description = "MinimalSig" , isBinder = False }) . @@ -497,55 +411,33 @@ sigNames (L _span (MinimalSig _ (L _ boolFormula))) = boolFormulaNames (Parens (L _ f)) = boolFormulaNames f sigNames (L _ _) = [] -#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) hsTypeNames :: LHsType GhcRn -> [NameOccurrence] -#else -hsTypeNames :: LHsType Name -> [NameOccurrence] -#endif -#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)) = -#endif [ NameOccurrence - { locatedName = Just <$> name + { locatedName = Just <$> reLocN name , description = "HsTyVar" , isBinder = False } ] -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) -hsTypeNames (L span (HsTyLit _ lit)) = -#else -hsTypeNames (L span (HsTyLit lit)) = -#endif +hsTypeNames lht@(L span (HsTyLit _ lit)) = let kind = case lit of HsNumTy _ _ -> naturalTy HsStrTy _ _ -> typeSymbolKind in [ TyLitOccurrence - { locatedName = L span Nothing + { locatedName = L (getLocA lht) Nothing , description = "HsTyLit" , 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 + { locatedName = Just <$> reLocN 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 |