{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE OverloadedStrings  #-}

{-
Functions to validate and check .hie file ASTs generated by GHC.
-}

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
          ]

-- | Look for any identifiers which occur outside of their supposed scopes.
-- Returns a list of error messages.
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
    -- We use a refmap for most of the computation

    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 -> []

    -- Check if all the names occur in their calculated scopes
    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)
          -- We validate scopes for names which are defined locally, and occur
          -- in this span, or are evidence variables
            = 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))
                   -- If we don't get any scopes for a local name or
                   -- an evidence variable, then its an error.
                   -- We can ignore other kinds of derived names as
                   -- long as we take evidence vars into account
                   -> 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 = []