{-
Functions to validate and check .hie file ASTs generated by GHC.
-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
module HieDebug where

import GhcPrelude

import SrcLoc
import Module
import FastString
import Outputable

import HieTypes
import HieBin
import HieUtils
import Name

import qualified Data.Map as M
import qualified Data.Set as S
import Data.Function    ( on )
import Data.List        ( sortOn )
import Data.Foldable    ( toList )

ppHies :: Outputable a => (HieASTs a) -> SDoc
ppHies :: HieASTs a -> SDoc
ppHies (HieASTs Map FastString (HieAST a)
asts) = (FastString -> HieAST a -> SDoc -> SDoc)
-> SDoc -> Map FastString (HieAST a) -> SDoc
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey FastString -> HieAST a -> SDoc -> SDoc
forall a a.
(Outputable a, Outputable a) =>
a -> HieAST a -> SDoc -> SDoc
go SDoc
"" Map FastString (HieAST a)
asts
  where
    go :: a -> HieAST a -> SDoc -> SDoc
go a
k HieAST a
a SDoc
rest = [SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$
      [ SDoc
"File: " SDoc -> SDoc -> SDoc
<> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
k
      , HieAST a -> SDoc
forall a. Outputable a => HieAST a -> SDoc
ppHie HieAST a
a
      , SDoc
rest
      ]

ppHie :: Outputable a => HieAST a -> SDoc
ppHie :: HieAST a -> SDoc
ppHie = Int -> HieAST a -> SDoc
forall a. Outputable a => Int -> HieAST a -> SDoc
go Int
0
  where
    go :: Int -> HieAST a -> SDoc
go Int
n (Node NodeInfo a
inf Span
sp [HieAST a]
children) = SDoc -> Int -> SDoc -> SDoc
hang SDoc
header Int
n SDoc
rest
      where
        rest :: SDoc
rest = [SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (HieAST a -> SDoc) -> [HieAST a] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> HieAST a -> SDoc
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)) [HieAST a]
children
        header :: SDoc
header = [SDoc] -> SDoc
hsep
          [ SDoc
"Node"
          , Span -> SDoc
forall a. Outputable a => a -> SDoc
ppr Span
sp
          , NodeInfo a -> SDoc
forall a. Outputable a => NodeInfo a -> SDoc
ppInfo NodeInfo a
inf
          ]

ppInfo :: Outputable a => NodeInfo a -> SDoc
ppInfo :: NodeInfo a -> SDoc
ppInfo NodeInfo a
ni = [SDoc] -> SDoc
hsep
  [ [(FastString, FastString)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([(FastString, FastString)] -> SDoc)
-> [(FastString, FastString)] -> SDoc
forall a b. (a -> b) -> a -> b
$ Set (FastString, FastString) -> [(FastString, FastString)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set (FastString, FastString) -> [(FastString, FastString)])
-> Set (FastString, FastString) -> [(FastString, FastString)]
forall a b. (a -> b) -> a -> b
$ NodeInfo a -> Set (FastString, FastString)
forall a. NodeInfo a -> Set (FastString, FastString)
nodeAnnotations NodeInfo a
ni
  , [a] -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([a] -> SDoc) -> [a] -> SDoc
forall a b. (a -> b) -> a -> b
$ NodeInfo a -> [a]
forall a. NodeInfo a -> [a]
nodeType NodeInfo a
ni
  , [(Identifier, IdentifierDetails a)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([(Identifier, IdentifierDetails a)] -> SDoc)
-> [(Identifier, IdentifierDetails a)] -> SDoc
forall a b. (a -> b) -> a -> b
$ Map Identifier (IdentifierDetails a)
-> [(Identifier, IdentifierDetails a)]
forall k a. Map k a -> [(k, a)]
M.toList (Map Identifier (IdentifierDetails a)
 -> [(Identifier, IdentifierDetails a)])
-> Map Identifier (IdentifierDetails a)
-> [(Identifier, IdentifierDetails a)]
forall a b. (a -> b) -> a -> b
$ NodeInfo a -> Map Identifier (IdentifierDetails a)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers NodeInfo a
ni
  ]

type Diff a = a -> a -> [SDoc]

diffFile :: Diff HieFile
diffFile :: Diff HieFile
diffFile = Diff Int -> Diff (Map FastString (HieAST Int))
forall a.
(Outputable a, Eq a, Ord a) =>
Diff a -> Diff (Map FastString (HieAST a))
diffAsts Diff Int
forall a. (Outputable a, Eq a) => Diff a
eqDiff Diff (Map FastString (HieAST Int))
-> (HieFile -> Map FastString (HieAST Int)) -> Diff HieFile
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (HieASTs Int -> Map FastString (HieAST Int)
forall a. HieASTs a -> Map FastString (HieAST a)
getAsts (HieASTs Int -> Map FastString (HieAST Int))
-> (HieFile -> HieASTs Int)
-> HieFile
-> Map FastString (HieAST Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieFile -> HieASTs Int
hie_asts)

diffAsts :: (Outputable a, Eq a, Ord a) => Diff a -> Diff (M.Map FastString (HieAST a))
diffAsts :: Diff a -> Diff (Map FastString (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 FastString (HieAST a) -> [HieAST a])
-> Diff (Map FastString (HieAST a))
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Map FastString (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 :: Diff a -> Diff (HieAST a)
diffAst Diff a
diffType (Node NodeInfo a
info1 Span
span1 [HieAST a]
xs1) (Node NodeInfo 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
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' :: [SDoc]
infoDiff'
      = (Diff (FastString, FastString) -> Diff [(FastString, FastString)]
forall a. Diff a -> Diff [a]
diffList Diff (FastString, FastString)
forall a. (Outputable a, Eq a) => Diff a
eqDiff Diff [(FastString, FastString)]
-> (NodeInfo a -> [(FastString, FastString)])
-> NodeInfo a
-> NodeInfo a
-> [SDoc]
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Set (FastString, FastString) -> [(FastString, FastString)]
forall a. Set a -> [a]
S.toAscList (Set (FastString, FastString) -> [(FastString, FastString)])
-> (NodeInfo a -> Set (FastString, FastString))
-> NodeInfo a
-> [(FastString, FastString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo a -> Set (FastString, FastString)
forall a. NodeInfo a -> Set (FastString, FastString)
nodeAnnotations)) NodeInfo a
info1 NodeInfo a
info2
     [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
info1 NodeInfo a
info2
     [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
info1 NodeInfo a
info2
    infoDiff :: [SDoc]
infoDiff = case [SDoc]
infoDiff' of
      [] -> []
      [SDoc]
xs -> [SDoc]
xs [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [[SDoc] -> SDoc
vcat [SDoc
"In Node:",(NodeIdentifiers a, Span) -> SDoc
forall a. Outputable a => a -> SDoc
ppr (NodeInfo a -> NodeIdentifiers a
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers NodeInfo a
info1,Span
span1)
                           , SDoc
"and", (NodeIdentifiers a, Span) -> SDoc
forall a. Outputable a => a -> SDoc
ppr (NodeInfo a -> NodeIdentifiers a
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers NodeInfo 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
$ NodeInfo a -> NodeIdentifiers a
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers NodeInfo 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
$ NodeInfo a -> NodeIdentifiers a
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers NodeInfo 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 :: 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
. ((Identifier, IdentifierDetails a)
 -> (DiffIdent, IdentifierDetails a))
-> [(Identifier, IdentifierDetails a)]
-> [(DiffIdent, IdentifierDetails a)]
forall a b. (a -> b) -> [a] -> [b]
map ((Name -> HieName)
-> (Identifier, IdentifierDetails a)
-> (DiffIdent, IdentifierDetails a)
forall (f :: * -> *) a b b.
Functor f =>
(a -> b) -> (f a, b) -> (f b, b)
first Name -> HieName
toHieName) ([(Identifier, IdentifierDetails a)]
 -> [(DiffIdent, IdentifierDetails a)])
-> (NodeIdentifiers a -> [(Identifier, IdentifierDetails a)])
-> NodeIdentifiers a
-> [(DiffIdent, IdentifierDetails a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeIdentifiers a -> [(Identifier, 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 (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 :: Diff a -> Diff [a]
diffList Diff a
f [a]
xs [a]
ys
  | [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
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 :: 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
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 :: HieAST a -> Either SDoc ()
validAst (Node NodeInfo a
_ Span
span [HieAST a]
children) = do
  [HieAST a] -> Either SDoc ()
forall a. [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 (m :: * -> *) a. Monad m => a -> m a
return ()
    checkSorted [HieAST a
_] = () -> Either SDoc ()
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
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 (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
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 FastString (HieAST a) -> [SDoc]
validateScopes :: Module -> Map FastString (HieAST a) -> [SDoc]
validateScopes Module
mod Map FastString (HieAST a)
asts = [SDoc]
validScopes
  where
    refMap :: Map Identifier [(Span, IdentifierDetails a)]
refMap = Map FastString (HieAST a)
-> Map Identifier [(Span, IdentifierDetails a)]
forall (f :: * -> *) a.
Foldable f =>
f (HieAST a) -> Map Identifier [(Span, IdentifierDetails a)]
generateReferencesMap Map FastString (HieAST a)
asts
    -- We use a refmap for most of the computation

    -- Check if all the names occur in their calculated scopes
    validScopes :: [SDoc]
validScopes = (Identifier -> [(Span, IdentifierDetails a)] -> [SDoc] -> [SDoc])
-> [SDoc] -> Map Identifier [(Span, IdentifierDetails a)] -> [SDoc]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey (\Identifier
k [(Span, IdentifierDetails a)]
a [SDoc]
b -> Identifier -> [(Span, IdentifierDetails a)] -> [SDoc]
forall (t :: * -> *) a a.
Foldable t =>
Either a Name -> t (Span, IdentifierDetails a) -> [SDoc]
valid Identifier
k [(Span, IdentifierDetails a)]
a [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [SDoc]
b) [] Map Identifier [(Span, IdentifierDetails a)]
refMap
    valid :: Either a Name -> t (Span, IdentifierDetails a) -> [SDoc]
valid (Left a
_) t (Span, IdentifierDetails a)
_ = []
    valid (Right Name
n) t (Span, IdentifierDetails a)
refs = ((Span, IdentifierDetails a) -> [SDoc])
-> t (Span, IdentifierDetails a) -> [SDoc]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Span, IdentifierDetails a) -> [SDoc]
forall a. (Span, IdentifierDetails a) -> [SDoc]
inScope t (Span, IdentifierDetails a)
refs
      where
        mapRef :: (a, IdentifierDetails a) -> Maybe [Scope]
mapRef = (ContextInfo -> Maybe [Scope]) -> Set ContextInfo -> Maybe [Scope]
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])
-> t (Span, IdentifierDetails a) -> Maybe [Scope]
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 t (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 FastString (HieAST a) -> Name -> Bool
forall a. Map FastString (HieAST a) -> Name -> Bool
definedInAsts Map FastString (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
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
            = case [Scope]
scopes of
              [] | (Module -> Name -> Bool
nameIsLocalOrFrom Module
mod Name
n
                   Bool -> Bool -> Bool
&& Bool -> Bool
not (OccName -> Bool
isDerivedOccName (OccName -> Bool) -> OccName -> Bool
forall a b. (a -> b) -> a -> b
$ Name -> OccName
nameOccName Name
n))
                   -- If we don't get any scopes for a local name then its an error.
                   -- We can ignore derived names.
                   -> SDoc -> [SDoc]
forall (m :: * -> *) a. Monad m => a -> m a
return (SDoc -> [SDoc]) -> SDoc -> [SDoc]
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
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 (m :: * -> *) a. Monad m => a -> m a
return (SDoc -> [SDoc]) -> SDoc -> [SDoc]
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
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 = []