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

module GHC.Iface.Ext.Debug where

import GHC.Prelude

import GHC.Types.SrcLoc
import GHC.Unit.Module
import GHC.Data.FastString
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 FastString (HieAST TypeIndex))
forall a.
(Outputable a, Eq a, Ord a) =>
Diff a -> Diff (Map FastString (HieAST a))
External instance of the constraint type Ord TypeIndex
External instance of the constraint type Eq TypeIndex
External instance of the constraint type Outputable TypeIndex
diffAsts Diff TypeIndex
forall a. (Outputable a, Eq a) => Diff a
External instance of the constraint type Eq TypeIndex
External instance of the constraint type Outputable TypeIndex
eqDiff Diff (Map FastString (HieAST TypeIndex))
-> (HieFile -> Map FastString (HieAST TypeIndex)) -> Diff HieFile
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (HieASTs TypeIndex -> Map FastString (HieAST TypeIndex)
forall a. HieASTs a -> Map FastString (HieAST a)
getAsts (HieASTs TypeIndex -> Map FastString (HieAST TypeIndex))
-> (HieFile -> HieASTs TypeIndex)
-> HieFile
-> Map FastString (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 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)
Evidence bound by a type signature of the constraint type Ord a
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a type signature of the constraint type Ord a
Evidence bound by a type signature of the constraint type Outputable 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 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)
Evidence bound by a type signature of the constraint type Ord a
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a type signature of the constraint type Ord a
Evidence bound by a type signature of the constraint type Outputable 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
External instance of the constraint type Eq Span
/= Span
span2 = [[SDoc] -> SDoc
hsep [SDoc
"Spans", Span -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable Span
ppr Span
span1, SDoc
"and", Span -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable Span
ppr Span
span2, SDoc
"differ"]]
      | Bool
otherwise = []
    infoDiff' :: NodeInfo a -> NodeInfo a -> [SDoc]
infoDiff' NodeInfo a
i1 NodeInfo a
i2
      = (Diff (FastString, FastString) -> Diff [(FastString, FastString)]
forall a. Diff a -> Diff [a]
diffList Diff (FastString, FastString)
forall a. (Outputable a, Eq a) => Diff a
External instance of the constraint type forall a b. (Eq a, Eq b) => Eq (a, b)
External instance of the constraint type Eq FastString
External instance of the constraint type Eq FastString
External instance of the constraint type forall a b. (Outputable a, Outputable b) => Outputable (a, b)
External instance of the constraint type Outputable FastString
External instance of the constraint type Outputable FastString
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
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]
Evidence bound by a type signature of the constraint type Ord a
Evidence bound by a type signature of the constraint type Outputable a
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
External instance of the constraint type Eq NodeOrigin
External instance of the constraint type Outputable NodeOrigin
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
vcat [SDoc
"In Node:",(NodeIdentifiers a, Span) -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type forall a b. (Outputable a, Outputable b) => Outputable (a, b)
External instance of the constraint type forall key elt.
(Outputable key, Outputable elt) =>
Outputable (Map key elt)
External instance of the constraint type forall a b. (Outputable a, Outputable b) => Outputable (Either a b)
External instance of the constraint type Outputable ModuleName
External instance of the constraint type Outputable Name
External instance of the constraint type forall a. Outputable a => Outputable (IdentifierDetails a)
Evidence bound by a type signature of the constraint type Outputable a
External instance of the constraint type Outputable Span
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
External instance of the constraint type forall a b. (Outputable a, Outputable b) => Outputable (a, b)
External instance of the constraint type forall key elt.
(Outputable key, Outputable elt) =>
Outputable (Map key elt)
External instance of the constraint type forall a b. (Outputable a, Outputable b) => Outputable (Either a b)
External instance of the constraint type Outputable ModuleName
External instance of the constraint type Outputable Name
External instance of the constraint type forall a. Outputable a => Outputable (IdentifierDetails a)
Evidence bound by a type signature of the constraint type Outputable a
External instance of the constraint type Outputable Span
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
External instance of the constraint type forall a. Outputable a => Outputable [a]
External instance of the constraint type forall a b. (Outputable a, Outputable b) => Outputable (a, b)
External instance of the constraint type forall a b. (Outputable a, Outputable b) => Outputable (Either a b)
External instance of the constraint type Outputable ModuleName
External instance of the constraint type Outputable HieName
External instance of the constraint type forall a. Outputable a => Outputable (IdentifierDetails a)
Evidence bound by a type signature of the constraint type Outputable a
ppr (NodeIdentifiers a -> [(DiffIdent, IdentifierDetails a)]
forall a.
Ord a =>
NodeIdentifiers a -> [(DiffIdent, IdentifierDetails a)]
Evidence bound by a type signature of the constraint type Ord 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
External instance of the constraint type forall a. Outputable a => Outputable [a]
External instance of the constraint type forall a b. (Outputable a, Outputable b) => Outputable (a, b)
External instance of the constraint type forall a b. (Outputable a, Outputable b) => Outputable (Either a b)
External instance of the constraint type Outputable ModuleName
External instance of the constraint type Outputable HieName
External instance of the constraint type forall a. Outputable a => Outputable (IdentifierDetails a)
Evidence bound by a type signature of the constraint type Outputable a
ppr (NodeIdentifiers a -> [(DiffIdent, IdentifierDetails a)]
forall a.
Ord a =>
NodeIdentifiers a -> [(DiffIdent, IdentifierDetails a)]
Evidence bound by a type signature of the constraint type Ord 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]
External instance of the constraint type forall a. Eq a => Eq (IdentifierDetails a)
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a type signature of the constraint type Ord a
External instance of the constraint type Eq ModuleName
External instance of the constraint type forall a. Outputable a => Outputable (IdentifierDetails a)
Evidence bound by a type signature of the constraint type Outputable a
External instance of the constraint type Outputable ModuleName
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)]
Evidence bound by a type signature of the constraint type Ord 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]
Evidence bound by a type signature of the constraint type Eq a
Evidence bound by a type signature of the constraint type Outputable a
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
Evidence bound by a type signature of the constraint type Eq a
Evidence bound by a type signature of the constraint type Outputable 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
External instance of the constraint type forall a b. (Eq a, Eq b) => Eq (a, b)
External instance of the constraint type forall unit. Eq unit => Eq (GenModule unit)
External instance of the constraint type Eq (GenUnit UnitId)
External instance of the constraint type Eq OccName
External instance of the constraint type forall a b. (Outputable a, Outputable b) => Outputable (a, b)
External instance of the constraint type Outputable Module
External instance of the constraint type Outputable OccName
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
External instance of the constraint type Eq OccName
External instance of the constraint type Outputable OccName
eqDiff OccName
o OccName
o'
      (HieName, HieName)
_ -> Diff HieName
forall a. (Outputable a, Eq a) => Diff a
External instance of the constraint type Eq HieName
External instance of the constraint type Outputable HieName
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
External instance of the constraint type forall a b. (Eq a, Eq b) => Eq (Either a b)
Evidence bound by a type signature of the constraint type Eq a
External instance of the constraint type Eq HieName
External instance of the constraint type forall a b. (Outputable a, Outputable b) => Outputable (Either a b)
Evidence bound by a type signature of the constraint type Outputable a
External instance of the constraint type Outputable HieName
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]
External instance of the constraint type forall a b c. (Ord a, Ord b, Ord c) => Ord (a, b, c)
External instance of the constraint type forall a b. (Ord a, Ord b) => Ord (Either a b)
External instance of the constraint type Ord ModuleName
External instance of the constraint type Ord OccName
External instance of the constraint type forall a. Ord a => Ord (Set a)
External instance of the constraint type Ord ContextInfo
External instance of the constraint type forall a. Ord a => Ord (Maybe a)
Evidence bound by a type signature of the constraint type Ord 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)
External instance of the constraint type forall a. Functor (Either 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)
External instance of the constraint type forall a. Functor (Either a)
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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Evidence bound by a type signature of the constraint type Functor f
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
Evidence bound by a type signature of the constraint type Functor f
<$> 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] -> TypeIndex
forall (t :: * -> *) a. Foldable t => t a -> TypeIndex
External instance of the constraint type Foldable []
length [a]
xs TypeIndex -> TypeIndex -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq TypeIndex
== [a] -> TypeIndex
forall (t :: * -> *) a. Foldable t => t a -> TypeIndex
External instance of the constraint type Foldable []
length [a]
ys = [[SDoc]] -> [SDoc]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
External instance of the constraint type Foldable []
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
Evidence bound by a type signature of the constraint type Eq a
== a
b = []
  | Bool
otherwise = [[SDoc] -> SDoc
hsep [a -> SDoc
forall a. Outputable a => a -> SDoc
Evidence bound by a type signature of the constraint type Outputable a
ppr a
a, SDoc
"and", a -> SDoc
forall a. Outputable a => a -> SDoc
Evidence bound by a type signature of the constraint type Outputable a
ppr a
b, SDoc
"do not match"]]

validAst :: HieAST a -> Either SDoc ()
validAst :: HieAST a -> Either SDoc ()
validAst (Node SourcedNodeInfo 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 ()
External instance of the constraint type forall e. Monad (Either e)
External instance of the constraint type Foldable []
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
External instance of the constraint type forall e. Monad (Either e)
return ()
    checkSorted [HieAST a
_] = () -> Either SDoc ()
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall e. Monad (Either e)
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
External instance of the constraint type Outputable Span
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
External instance of the constraint type Outputable Span
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
External instance of the constraint type forall e. Monad (Either e)
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
External instance of the constraint type Outputable Span
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
External instance of the constraint type Outputable Span
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 [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [SDoc]
validEvs
  where
    refMap :: RefMap a
refMap = Map FastString (HieAST a) -> RefMap a
forall (f :: * -> *) a. Foldable f => f (HieAST a) -> RefMap a
External instance of the constraint type forall k. Foldable (Map k)
generateReferencesMap Map FastString (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
External instance of the constraint type Foldable []
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]
External instance of the constraint type Foldable []
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 :: Either ModuleName Name
i@(Right Name
ev) <- [Either ModuleName Name]
evs
      case Either ModuleName Name
-> RefMap a -> Maybe [(Span, IdentifierDetails a)]
forall k a. Ord k => k -> Map k a -> Maybe a
External instance of the constraint type forall a b. (Ord a, Ord b) => Ord (Either a b)
External instance of the constraint type Ord ModuleName
External instance of the constraint type Ord Name
M.lookup Either ModuleName Name
i RefMap a
refMap of
        Maybe [(Span, IdentifierDetails a)]
Nothing -> [SDoc
"Impossible, ev"SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable Name
ppr Name
ev SDoc -> SDoc -> SDoc
<+> 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
External instance of the constraint type Foldable []
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]
External instance of the constraint type Foldable []
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
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable Name
ppr Name
ev SDoc -> SDoc -> SDoc
<+> 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]
forall {t :: * -> *} {a} {a}.
Foldable t =>
Either a Name -> t (Span, IdentifierDetails a) -> [SDoc]
External instance of the constraint type Foldable []
valid Either ModuleName Name
k [(Span, IdentifierDetails a)]
a [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [SDoc]
b) [] RefMap 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]
Evidence bound by a type signature of the constraint type Foldable t
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
External instance of the constraint type forall a. Semigroup a => Monoid (Maybe a)
External instance of the constraint type forall a. Semigroup [a]
External instance of the constraint type Foldable Set
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
External instance of the constraint type forall a. Semigroup a => Monoid (Maybe a)
External instance of the constraint type forall a. Semigroup [a]
Evidence bound by a type signature of the constraint type Foldable t
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
External instance of the constraint type Foldable Set
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
External instance of the constraint type Foldable Set
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
External instance of the constraint type Foldable Set
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 (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad []
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
External instance of the constraint type Outputable Name
ppr Name
n,Name -> SDoc
pprDefinedAt Name
n , SDoc
"at position", Span -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable Span
ppr Span
sp
                     , SDoc
"Doesn't have a calculated scope: ", [Scope] -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type forall a. Outputable a => Outputable [a]
External instance of the constraint type Outputable Scope
ppr [Scope]
scopes]
                 | Bool
otherwise -> []
              [Scope]
_ -> if (Scope -> Bool) -> [Scope] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
External instance of the constraint type Foldable []
any (Scope -> Span -> Bool
`scopeContainsSpan` Span
sp) [Scope]
scopes
                   then []
                   else SDoc -> [SDoc]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad []
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
External instance of the constraint type Outputable Name
ppr Name
n, Name -> SDoc
pprDefinedAt Name
n, SDoc
"at position", Span -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable Span
ppr Span
sp
                     , SDoc
"doesn't occur in calculated scope", [Scope] -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type forall a. Outputable a => Outputable [a]
External instance of the constraint type Outputable Scope
ppr [Scope]
scopes]
          | Bool
otherwise = []