{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module GHC.Iface.Ext.Debug where
import GHC.Prelude
import GHC.Types.SrcLoc
import GHC.Unit.Module
import GHC.Utils.Outputable
import GHC.Iface.Ext.Types
import GHC.Iface.Ext.Utils
import GHC.Types.Name
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Function ( on )
import Data.List ( sortOn )
type Diff a = a -> a -> [SDoc]
diffFile :: Diff HieFile
diffFile :: Diff HieFile
diffFile = Diff TypeIndex -> Diff (Map HiePath (HieAST TypeIndex))
forall a.
(Outputable a, Eq a, Ord a) =>
Diff a -> Diff (Map HiePath (HieAST a))
diffAsts Diff TypeIndex
forall a. (Outputable a, Eq a) => Diff a
eqDiff Diff (Map HiePath (HieAST TypeIndex))
-> (HieFile -> Map HiePath (HieAST TypeIndex)) -> Diff HieFile
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (HieASTs TypeIndex -> Map HiePath (HieAST TypeIndex)
forall a. HieASTs a -> Map HiePath (HieAST a)
getAsts (HieASTs TypeIndex -> Map HiePath (HieAST TypeIndex))
-> (HieFile -> HieASTs TypeIndex)
-> HieFile
-> Map HiePath (HieAST TypeIndex)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieFile -> HieASTs TypeIndex
hie_asts)
diffAsts :: (Outputable a, Eq a, Ord a) => Diff a -> Diff (M.Map HiePath (HieAST a))
diffAsts :: forall a.
(Outputable a, Eq a, Ord a) =>
Diff a -> Diff (Map HiePath (HieAST a))
diffAsts Diff a
f = Diff (HieAST a) -> Diff [HieAST a]
forall a. Diff a -> Diff [a]
diffList (Diff a -> Diff (HieAST a)
forall a. (Outputable a, Eq a, Ord a) => Diff a -> Diff (HieAST a)
diffAst Diff a
f) Diff [HieAST a]
-> (Map HiePath (HieAST a) -> [HieAST a])
-> Map HiePath (HieAST a)
-> Map HiePath (HieAST a)
-> [SDoc]
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Map HiePath (HieAST a) -> [HieAST a]
forall k a. Map k a -> [a]
M.elems
diffAst :: (Outputable a, Eq a,Ord a) => Diff a -> Diff (HieAST a)
diffAst :: forall a. (Outputable a, Eq a, Ord a) => Diff a -> Diff (HieAST a)
diffAst Diff a
diffType (Node SourcedNodeInfo a
info1 Span
span1 [HieAST a]
xs1) (Node SourcedNodeInfo a
info2 Span
span2 [HieAST a]
xs2) =
[SDoc]
infoDiff [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [SDoc]
spanDiff [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ Diff (HieAST a) -> Diff [HieAST a]
forall a. Diff a -> Diff [a]
diffList (Diff a -> Diff (HieAST a)
forall a. (Outputable a, Eq a, Ord a) => Diff a -> Diff (HieAST a)
diffAst Diff a
diffType) [HieAST a]
xs1 [HieAST a]
xs2
where
spanDiff :: [SDoc]
spanDiff
| Span
span1 Span -> Span -> Bool
forall a. Eq a => a -> a -> Bool
/= Span
span2 = [[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [SDoc
"Spans", Span -> SDoc
forall a. Outputable a => a -> SDoc
ppr Span
span1, SDoc
"and", Span -> SDoc
forall a. Outputable a => a -> SDoc
ppr Span
span2, SDoc
"differ"]]
| Bool
otherwise = []
infoDiff' :: NodeInfo a -> NodeInfo a -> [SDoc]
infoDiff' NodeInfo a
i1 NodeInfo a
i2
= (Diff NodeAnnotation -> Diff [NodeAnnotation]
forall a. Diff a -> Diff [a]
diffList Diff NodeAnnotation
forall a. (Outputable a, Eq a) => Diff a
eqDiff Diff [NodeAnnotation]
-> (NodeInfo a -> [NodeAnnotation])
-> NodeInfo a
-> NodeInfo a
-> [SDoc]
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Set NodeAnnotation -> [NodeAnnotation]
forall a. Set a -> [a]
S.toAscList (Set NodeAnnotation -> [NodeAnnotation])
-> (NodeInfo a -> Set NodeAnnotation)
-> NodeInfo a
-> [NodeAnnotation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo a -> Set NodeAnnotation
forall a. NodeInfo a -> Set NodeAnnotation
nodeAnnotations)) NodeInfo a
i1 NodeInfo a
i2
[SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ (Diff a -> Diff [a]
forall a. Diff a -> Diff [a]
diffList Diff a
diffType Diff [a]
-> (NodeInfo a -> [a]) -> NodeInfo a -> NodeInfo a -> [SDoc]
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` NodeInfo a -> [a]
forall a. NodeInfo a -> [a]
nodeType) NodeInfo a
i1 NodeInfo a
i2
[SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ (NodeIdentifiers a -> NodeIdentifiers a -> [SDoc]
forall {a}.
(Outputable a, Ord a) =>
NodeIdentifiers a -> NodeIdentifiers a -> [SDoc]
diffIdents (NodeIdentifiers a -> NodeIdentifiers a -> [SDoc])
-> (NodeInfo a -> NodeIdentifiers a)
-> NodeInfo a
-> NodeInfo a
-> [SDoc]
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` NodeInfo a -> NodeIdentifiers a
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers) NodeInfo a
i1 NodeInfo a
i2
sinfoDiff :: SourcedNodeInfo a -> SourcedNodeInfo a -> [SDoc]
sinfoDiff = Diff (NodeOrigin, NodeInfo a) -> Diff [(NodeOrigin, NodeInfo a)]
forall a. Diff a -> Diff [a]
diffList (\(NodeOrigin
k1,NodeInfo a
a) (NodeOrigin
k2,NodeInfo a
b) -> Diff NodeOrigin
forall a. (Outputable a, Eq a) => Diff a
eqDiff NodeOrigin
k1 NodeOrigin
k2 [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ NodeInfo a -> NodeInfo a -> [SDoc]
infoDiff' NodeInfo a
a NodeInfo a
b) Diff [(NodeOrigin, NodeInfo a)]
-> (SourcedNodeInfo a -> [(NodeOrigin, NodeInfo a)])
-> SourcedNodeInfo a
-> SourcedNodeInfo a
-> [SDoc]
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Map NodeOrigin (NodeInfo a) -> [(NodeOrigin, NodeInfo a)]
forall k a. Map k a -> [(k, a)]
M.toList (Map NodeOrigin (NodeInfo a) -> [(NodeOrigin, NodeInfo a)])
-> (SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a))
-> SourcedNodeInfo a
-> [(NodeOrigin, NodeInfo a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo)
infoDiff :: [SDoc]
infoDiff = case SourcedNodeInfo a -> SourcedNodeInfo a -> [SDoc]
sinfoDiff SourcedNodeInfo a
info1 SourcedNodeInfo a
info2 of
[] -> []
[SDoc]
xs -> [SDoc]
xs [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc
"In Node:",(NodeIdentifiers a, Span) -> SDoc
forall a. Outputable a => a -> SDoc
ppr (SourcedNodeInfo a -> NodeIdentifiers a
forall a. SourcedNodeInfo a -> NodeIdentifiers a
sourcedNodeIdents SourcedNodeInfo a
info1,Span
span1)
, SDoc
"and", (NodeIdentifiers a, Span) -> SDoc
forall a. Outputable a => a -> SDoc
ppr (SourcedNodeInfo a -> NodeIdentifiers a
forall a. SourcedNodeInfo a -> NodeIdentifiers a
sourcedNodeIdents SourcedNodeInfo a
info2,Span
span2)
, SDoc
"While comparing"
, [(DiffIdent, IdentifierDetails a)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (NodeIdentifiers a -> [(DiffIdent, IdentifierDetails a)]
forall a.
Ord a =>
NodeIdentifiers a -> [(DiffIdent, IdentifierDetails a)]
normalizeIdents (NodeIdentifiers a -> [(DiffIdent, IdentifierDetails a)])
-> NodeIdentifiers a -> [(DiffIdent, IdentifierDetails a)]
forall a b. (a -> b) -> a -> b
$ SourcedNodeInfo a -> NodeIdentifiers a
forall a. SourcedNodeInfo a -> NodeIdentifiers a
sourcedNodeIdents SourcedNodeInfo a
info1), SDoc
"and"
, [(DiffIdent, IdentifierDetails a)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (NodeIdentifiers a -> [(DiffIdent, IdentifierDetails a)]
forall a.
Ord a =>
NodeIdentifiers a -> [(DiffIdent, IdentifierDetails a)]
normalizeIdents (NodeIdentifiers a -> [(DiffIdent, IdentifierDetails a)])
-> NodeIdentifiers a -> [(DiffIdent, IdentifierDetails a)]
forall a b. (a -> b) -> a -> b
$ SourcedNodeInfo a -> NodeIdentifiers a
forall a. SourcedNodeInfo a -> NodeIdentifiers a
sourcedNodeIdents SourcedNodeInfo a
info2)
]
]
diffIdents :: NodeIdentifiers a -> NodeIdentifiers a -> [SDoc]
diffIdents NodeIdentifiers a
a NodeIdentifiers a
b = (Diff (DiffIdent, IdentifierDetails a)
-> Diff [(DiffIdent, IdentifierDetails a)]
forall a. Diff a -> Diff [a]
diffList Diff (DiffIdent, IdentifierDetails a)
forall {a} {a}.
(Outputable a, Outputable a, Eq a, Eq a) =>
(Either a HieName, a) -> (Either a HieName, a) -> [SDoc]
diffIdent Diff [(DiffIdent, IdentifierDetails a)]
-> (NodeIdentifiers a -> [(DiffIdent, IdentifierDetails a)])
-> NodeIdentifiers a
-> NodeIdentifiers a
-> [SDoc]
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` NodeIdentifiers a -> [(DiffIdent, IdentifierDetails a)]
forall a.
Ord a =>
NodeIdentifiers a -> [(DiffIdent, IdentifierDetails a)]
normalizeIdents) NodeIdentifiers a
a NodeIdentifiers a
b
diffIdent :: (Either a HieName, a) -> (Either a HieName, a) -> [SDoc]
diffIdent (Either a HieName
a,a
b) (Either a HieName
c,a
d) = Either a HieName -> Either a HieName -> [SDoc]
forall {a}.
(Outputable a, Eq a) =>
Either a HieName -> Either a HieName -> [SDoc]
diffName Either a HieName
a Either a HieName
c
[SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ Diff a
forall a. (Outputable a, Eq a) => Diff a
eqDiff a
b a
d
diffName :: Either a HieName -> Either a HieName -> [SDoc]
diffName (Right HieName
a) (Right HieName
b) = case (HieName
a,HieName
b) of
(ExternalName Module
m OccName
o SrcSpan
_, ExternalName Module
m' OccName
o' SrcSpan
_) -> Diff (Module, OccName)
forall a. (Outputable a, Eq a) => Diff a
eqDiff (Module
m,OccName
o) (Module
m',OccName
o')
(LocalName OccName
o SrcSpan
_, ExternalName Module
_ OccName
o' SrcSpan
_) -> Diff OccName
forall a. (Outputable a, Eq a) => Diff a
eqDiff OccName
o OccName
o'
(HieName, HieName)
_ -> Diff HieName
forall a. (Outputable a, Eq a) => Diff a
eqDiff HieName
a HieName
b
diffName Either a HieName
a Either a HieName
b = Either a HieName -> Either a HieName -> [SDoc]
forall a. (Outputable a, Eq a) => Diff a
eqDiff Either a HieName
a Either a HieName
b
type DiffIdent = Either ModuleName HieName
normalizeIdents :: Ord a => NodeIdentifiers a -> [(DiffIdent,IdentifierDetails a)]
normalizeIdents :: forall a.
Ord a =>
NodeIdentifiers a -> [(DiffIdent, IdentifierDetails a)]
normalizeIdents = ((DiffIdent, IdentifierDetails a)
-> (Either ModuleName OccName, Set ContextInfo, Maybe a))
-> [(DiffIdent, IdentifierDetails a)]
-> [(DiffIdent, IdentifierDetails a)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (DiffIdent, IdentifierDetails a)
-> (Either ModuleName OccName, Set ContextInfo, Maybe a)
forall {f :: * -> *} {a}.
Functor f =>
(f HieName, IdentifierDetails a)
-> (f OccName, Set ContextInfo, Maybe a)
go ([(DiffIdent, IdentifierDetails a)]
-> [(DiffIdent, IdentifierDetails a)])
-> (NodeIdentifiers a -> [(DiffIdent, IdentifierDetails a)])
-> NodeIdentifiers a
-> [(DiffIdent, IdentifierDetails a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Either ModuleName Name, IdentifierDetails a)
-> (DiffIdent, IdentifierDetails a))
-> [(Either ModuleName Name, IdentifierDetails a)]
-> [(DiffIdent, IdentifierDetails a)]
forall a b. (a -> b) -> [a] -> [b]
map ((Name -> HieName)
-> (Either ModuleName Name, IdentifierDetails a)
-> (DiffIdent, IdentifierDetails a)
forall {f :: * -> *} {a} {b} {b}.
Functor f =>
(a -> b) -> (f a, b) -> (f b, b)
first Name -> HieName
toHieName) ([(Either ModuleName Name, IdentifierDetails a)]
-> [(DiffIdent, IdentifierDetails a)])
-> (NodeIdentifiers a
-> [(Either ModuleName Name, IdentifierDetails a)])
-> NodeIdentifiers a
-> [(DiffIdent, IdentifierDetails a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeIdentifiers a
-> [(Either ModuleName Name, IdentifierDetails a)]
forall k a. Map k a -> [(k, a)]
M.toList
where
first :: (a -> b) -> (f a, b) -> (f b, b)
first a -> b
f (f a
a,b
b) = ((a -> b) -> f a -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
a, b
b)
go :: (f HieName, IdentifierDetails a)
-> (f OccName, Set ContextInfo, Maybe a)
go (f HieName
a,IdentifierDetails a
b) = (HieName -> OccName
hieNameOcc (HieName -> OccName) -> f HieName -> f OccName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f HieName
a,IdentifierDetails a -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo IdentifierDetails a
b,IdentifierDetails a -> Maybe a
forall a. IdentifierDetails a -> Maybe a
identType IdentifierDetails a
b)
diffList :: Diff a -> Diff [a]
diffList :: forall a. Diff a -> Diff [a]
diffList Diff a
f [a]
xs [a]
ys
| [a] -> TypeIndex
forall a. [a] -> TypeIndex
forall (t :: * -> *) a. Foldable t => t a -> TypeIndex
length [a]
xs TypeIndex -> TypeIndex -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> TypeIndex
forall a. [a] -> TypeIndex
forall (t :: * -> *) a. Foldable t => t a -> TypeIndex
length [a]
ys = [[SDoc]] -> [SDoc]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[SDoc]] -> [SDoc]) -> [[SDoc]] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ Diff a -> [a] -> [a] -> [[SDoc]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Diff a
f [a]
xs [a]
ys
| Bool
otherwise = [SDoc
"length of lists doesn't match"]
eqDiff :: (Outputable a, Eq a) => Diff a
eqDiff :: forall a. (Outputable a, Eq a) => Diff a
eqDiff a
a a
b
| a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b = []
| Bool
otherwise = [[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
a, SDoc
"and", a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
b, SDoc
"do not match"]]
validAst :: HieAST a -> Either SDoc ()
validAst :: forall a. HieAST a -> Either SDoc ()
validAst (Node SourcedNodeInfo a
_ Span
span [HieAST a]
children) = do
[HieAST a] -> Either SDoc ()
checkContainment [HieAST a]
children
[HieAST a] -> Either SDoc ()
forall {a}. [HieAST a] -> Either SDoc ()
checkSorted [HieAST a]
children
(HieAST a -> Either SDoc ()) -> [HieAST a] -> Either SDoc ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ HieAST a -> Either SDoc ()
forall a. HieAST a -> Either SDoc ()
validAst [HieAST a]
children
where
checkSorted :: [HieAST a] -> Either SDoc ()
checkSorted [] = () -> Either SDoc ()
forall a. a -> Either SDoc a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkSorted [HieAST a
_] = () -> Either SDoc ()
forall a. a -> Either SDoc a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkSorted (HieAST a
x:HieAST a
y:[HieAST a]
xs)
| HieAST a -> Span
forall a. HieAST a -> Span
nodeSpan HieAST a
x Span -> Span -> Bool
`leftOf` HieAST a -> Span
forall a. HieAST a -> Span
nodeSpan HieAST a
y = [HieAST a] -> Either SDoc ()
checkSorted (HieAST a
yHieAST a -> [HieAST a] -> [HieAST a]
forall a. a -> [a] -> [a]
:[HieAST a]
xs)
| Bool
otherwise = SDoc -> Either SDoc ()
forall a b. a -> Either a b
Left (SDoc -> Either SDoc ()) -> SDoc -> Either SDoc ()
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep
[ Span -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Span -> SDoc) -> Span -> SDoc
forall a b. (a -> b) -> a -> b
$ HieAST a -> Span
forall a. HieAST a -> Span
nodeSpan HieAST a
x
, SDoc
"is not to the left of"
, Span -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Span -> SDoc) -> Span -> SDoc
forall a b. (a -> b) -> a -> b
$ HieAST a -> Span
forall a. HieAST a -> Span
nodeSpan HieAST a
y
]
checkContainment :: [HieAST a] -> Either SDoc ()
checkContainment [] = () -> Either SDoc ()
forall a. a -> Either SDoc a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkContainment (HieAST a
x:[HieAST a]
xs)
| Span
span Span -> Span -> Bool
`containsSpan` (HieAST a -> Span
forall a. HieAST a -> Span
nodeSpan HieAST a
x) = [HieAST a] -> Either SDoc ()
checkContainment [HieAST a]
xs
| Bool
otherwise = SDoc -> Either SDoc ()
forall a b. a -> Either a b
Left (SDoc -> Either SDoc ()) -> SDoc -> Either SDoc ()
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep
[ Span -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Span -> SDoc) -> Span -> SDoc
forall a b. (a -> b) -> a -> b
$ Span
span
, SDoc
"does not contain"
, Span -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Span -> SDoc) -> Span -> SDoc
forall a b. (a -> b) -> a -> b
$ HieAST a -> Span
forall a. HieAST a -> Span
nodeSpan HieAST a
x
]
validateScopes :: Module -> M.Map HiePath (HieAST a) -> [SDoc]
validateScopes :: forall a. Module -> Map HiePath (HieAST a) -> [SDoc]
validateScopes Module
mod Map HiePath (HieAST a)
asts = [SDoc]
validScopes [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [SDoc]
validEvs
where
refMap :: RefMap a
refMap = Map HiePath (HieAST a) -> RefMap a
forall (f :: * -> *) a. Foldable f => f (HieAST a) -> RefMap a
generateReferencesMap Map HiePath (HieAST a)
asts
evs :: [Either ModuleName Name]
evs = RefMap a -> [Either ModuleName Name]
forall k a. Map k a -> [k]
M.keys
(RefMap a -> [Either ModuleName Name])
-> RefMap a -> [Either ModuleName Name]
forall a b. (a -> b) -> a -> b
$ ([(Span, IdentifierDetails a)] -> Bool) -> RefMap a -> RefMap a
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter ((ContextInfo -> Bool) -> [ContextInfo] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ContextInfo -> Bool
isEvidenceContext ([ContextInfo] -> Bool)
-> ([(Span, IdentifierDetails a)] -> [ContextInfo])
-> [(Span, IdentifierDetails a)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Span, IdentifierDetails a) -> [ContextInfo])
-> [(Span, IdentifierDetails a)] -> [ContextInfo]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Set ContextInfo -> [ContextInfo]
forall a. Set a -> [a]
S.toList (Set ContextInfo -> [ContextInfo])
-> ((Span, IdentifierDetails a) -> Set ContextInfo)
-> (Span, IdentifierDetails a)
-> [ContextInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentifierDetails a -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo (IdentifierDetails a -> Set ContextInfo)
-> ((Span, IdentifierDetails a) -> IdentifierDetails a)
-> (Span, IdentifierDetails a)
-> Set ContextInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Span, IdentifierDetails a) -> IdentifierDetails a
forall a b. (a, b) -> b
snd)) RefMap a
refMap
validEvs :: [SDoc]
validEvs = do
i@(Right ev) <- [Either ModuleName Name]
evs
case M.lookup i refMap of
Maybe [(Span, IdentifierDetails a)]
Nothing -> [SDoc
"Impossible, ev"SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
ev SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
"not found in refmap" ]
Just [(Span, IdentifierDetails a)]
refs
| Module -> Name -> Bool
nameIsLocalOrFrom Module
mod Name
ev
, Bool -> Bool
not ((ContextInfo -> Bool) -> [ContextInfo] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ContextInfo -> Bool
isEvidenceBind ([ContextInfo] -> Bool)
-> ([(Span, IdentifierDetails a)] -> [ContextInfo])
-> [(Span, IdentifierDetails a)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Span, IdentifierDetails a) -> [ContextInfo])
-> [(Span, IdentifierDetails a)] -> [ContextInfo]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Set ContextInfo -> [ContextInfo]
forall a. Set a -> [a]
S.toList (Set ContextInfo -> [ContextInfo])
-> ((Span, IdentifierDetails a) -> Set ContextInfo)
-> (Span, IdentifierDetails a)
-> [ContextInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentifierDetails a -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo (IdentifierDetails a -> Set ContextInfo)
-> ((Span, IdentifierDetails a) -> IdentifierDetails a)
-> (Span, IdentifierDetails a)
-> Set ContextInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Span, IdentifierDetails a) -> IdentifierDetails a
forall a b. (a, b) -> b
snd) ([(Span, IdentifierDetails a)] -> Bool)
-> [(Span, IdentifierDetails a)] -> Bool
forall a b. (a -> b) -> a -> b
$ [(Span, IdentifierDetails a)]
refs)
-> [SDoc
"Evidence var" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
ev SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
"not bound in refmap"]
| Bool
otherwise -> []
validScopes :: [SDoc]
validScopes = (Either ModuleName Name
-> [(Span, IdentifierDetails a)] -> [SDoc] -> [SDoc])
-> [SDoc] -> RefMap a -> [SDoc]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey (\Either ModuleName Name
k [(Span, IdentifierDetails a)]
a [SDoc]
b -> Either ModuleName Name -> [(Span, IdentifierDetails a)] -> [SDoc]
valid Either ModuleName Name
k [(Span, IdentifierDetails a)]
a [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [SDoc]
b) [] RefMap a
refMap
valid :: Either ModuleName Name -> [(Span, IdentifierDetails a)] -> [SDoc]
valid (Left ModuleName
_) [(Span, IdentifierDetails a)]
_ = []
valid (Right Name
n) [(Span, IdentifierDetails a)]
refs = ((Span, IdentifierDetails a) -> [SDoc])
-> [(Span, IdentifierDetails a)] -> [SDoc]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Span, IdentifierDetails a) -> [SDoc]
inScope [(Span, IdentifierDetails a)]
refs
where
mapRef :: (a, IdentifierDetails a) -> Maybe [Scope]
mapRef = (ContextInfo -> Maybe [Scope]) -> Set ContextInfo -> Maybe [Scope]
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ContextInfo -> Maybe [Scope]
getScopeFromContext (Set ContextInfo -> Maybe [Scope])
-> ((a, IdentifierDetails a) -> Set ContextInfo)
-> (a, IdentifierDetails a)
-> Maybe [Scope]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentifierDetails a -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo (IdentifierDetails a -> Set ContextInfo)
-> ((a, IdentifierDetails a) -> IdentifierDetails a)
-> (a, IdentifierDetails a)
-> Set ContextInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, IdentifierDetails a) -> IdentifierDetails a
forall a b. (a, b) -> b
snd
scopes :: [Scope]
scopes = case ((Span, IdentifierDetails a) -> Maybe [Scope])
-> [(Span, IdentifierDetails a)] -> Maybe [Scope]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Span, IdentifierDetails a) -> Maybe [Scope]
forall {a} {a}. (a, IdentifierDetails a) -> Maybe [Scope]
mapRef [(Span, IdentifierDetails a)]
refs of
Just [Scope]
xs -> [Scope]
xs
Maybe [Scope]
Nothing -> []
inScope :: (Span, IdentifierDetails a) -> [SDoc]
inScope (Span
sp, IdentifierDetails a
dets)
| (Map HiePath (HieAST a) -> Name -> Bool
forall a. Map HiePath (HieAST a) -> Name -> Bool
definedInAsts Map HiePath (HieAST a)
asts Name
n Bool -> Bool -> Bool
|| ((ContextInfo -> Bool) -> Set ContextInfo -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ContextInfo -> Bool
isEvidenceContext (IdentifierDetails a -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo IdentifierDetails a
dets)))
Bool -> Bool -> Bool
&& (ContextInfo -> Bool) -> Set ContextInfo -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ContextInfo -> Bool
isOccurrence (IdentifierDetails a -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo IdentifierDetails a
dets)
= case [Scope]
scopes of
[] | Module -> Name -> Bool
nameIsLocalOrFrom Module
mod Name
n
, ( Bool -> Bool
not (OccName -> Bool
isDerivedOccName (OccName -> Bool) -> OccName -> Bool
forall a b. (a -> b) -> a -> b
$ Name -> OccName
nameOccName Name
n)
Bool -> Bool -> Bool
|| (ContextInfo -> Bool) -> Set ContextInfo -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ContextInfo -> Bool
isEvidenceContext (IdentifierDetails a -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo IdentifierDetails a
dets))
-> SDoc -> [SDoc]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (SDoc -> [SDoc]) -> SDoc -> [SDoc]
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$
[ SDoc
"Locally defined Name", Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n,Name -> SDoc
pprDefinedAt Name
n , SDoc
"at position", Span -> SDoc
forall a. Outputable a => a -> SDoc
ppr Span
sp
, SDoc
"Doesn't have a calculated scope: ", [Scope] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Scope]
scopes]
| Bool
otherwise -> []
[Scope]
_ -> if (Scope -> Bool) -> [Scope] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Scope -> Span -> Bool
`scopeContainsSpan` Span
sp) [Scope]
scopes
then []
else SDoc -> [SDoc]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (SDoc -> [SDoc]) -> SDoc -> [SDoc]
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$
[ SDoc
"Name", Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n, Name -> SDoc
pprDefinedAt Name
n, SDoc
"at position", Span -> SDoc
forall a. Outputable a => a -> SDoc
ppr Span
sp
, SDoc
"doesn't occur in calculated scope", [Scope] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Scope]
scopes]
| Bool
otherwise = []