    {-# 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 = forall a.
    (Outputable a, Eq a, Ord a) =>
    Diff a -> Diff (Map HiePath (HieAST a))
    diffAsts forall a. (Outputable a, Eq a) => Diff a
    eqDiff forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` (forall a. HieASTs a -> Map HiePath (HieAST a)
    getAsts 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 = forall a. Diff a -> Diff [a]
    diffList (forall a. (Outputable a, Eq a, Ord a) => Diff a -> Diff (HieAST a)
    diffAst Diff a
    f) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` 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 forall a. [a] -> [a] -> [a]
    ++ [SDoc]
    spanDiff forall a. [a] -> [a] -> [a]
    ++ forall a. Diff a -> Diff [a]
    diffList (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 forall a. Eq a => a -> a -> Bool
    /= Span
    span2 = [[SDoc] -> SDoc
    hsep [SDoc
    "Spans", forall a. Outputable a => a -> SDoc
    ppr Span
    span1, SDoc
    "and", 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
          = (forall a. Diff a -> Diff [a]
    diffList forall a. (Outputable a, Eq a) => Diff a
    eqDiff forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` (forall a. Set a -> [a]
    S.toAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall a. NodeInfo a -> Set NodeAnnotation
    nodeAnnotations)) NodeInfo a
    i1 NodeInfo a
    i2
         forall a. [a] -> [a] -> [a]
    ++ (forall a. Diff a -> Diff [a]
    diffList Diff a
    diffType forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` forall a. NodeInfo a -> [a]
    nodeType) NodeInfo a
    i1 NodeInfo a
    i2
         forall a. [a] -> [a] -> [a]
    ++ (forall {a}.
    (Outputable a, Ord a) =>
    NodeIdentifiers a -> NodeIdentifiers a -> [SDoc]
    diffIdents forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` forall a. NodeInfo a -> NodeIdentifiers a
    nodeIdentifiers) NodeInfo a
    i1 NodeInfo a
    i2
        sinfoDiff :: SourcedNodeInfo a -> SourcedNodeInfo a -> [SDoc]
    sinfoDiff = forall a. Diff a -> Diff [a]
    diffList (\(NodeOrigin
    k1,NodeInfo a
    a) (NodeOrigin
    k2,NodeInfo a
    b) -> forall a. (Outputable a, Eq a) => Diff a
    eqDiff NodeOrigin
    k1 NodeOrigin
    k2 forall a. [a] -> [a] -> [a]
    ++ NodeInfo a -> NodeInfo a -> [SDoc]
    infoDiff' NodeInfo a
    a NodeInfo a
    b) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` (forall k a. Map k a -> [(k, a)]
    M.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
    . 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 forall a. [a] -> [a] -> [a]
    ++ [[SDoc] -> SDoc
    vcat [SDoc
    "In Node:",forall a. Outputable a => a -> SDoc
    ppr (forall a. SourcedNodeInfo a -> NodeIdentifiers a
    sourcedNodeIdents SourcedNodeInfo a
    info1,Span
    span1)
                               , SDoc
    "and", forall a. Outputable a => a -> SDoc
    ppr (forall a. SourcedNodeInfo a -> NodeIdentifiers a
    sourcedNodeIdents SourcedNodeInfo a
    info2,Span
    span2)
                            , SDoc
    "While comparing"
                            , forall a. Outputable a => a -> SDoc
    ppr (forall a.
    Ord a =>
    NodeIdentifiers a -> [(DiffIdent, IdentifierDetails a)]
    normalizeIdents forall a b. (a -> b) -> a -> b
    $ forall a. SourcedNodeInfo a -> NodeIdentifiers a
    sourcedNodeIdents SourcedNodeInfo a
    info1), SDoc
    "and"
                            , forall a. Outputable a => a -> SDoc
    ppr (forall a.
    Ord a =>
    NodeIdentifiers a -> [(DiffIdent, IdentifierDetails a)]
    normalizeIdents forall a b. (a -> b) -> a -> b
    $ forall a. SourcedNodeInfo a -> NodeIdentifiers a
    sourcedNodeIdents SourcedNodeInfo a
    info2)
                            ]
                      ]

        diffIdents :: NodeIdentifiers a -> NodeIdentifiers a -> [SDoc]
    diffIdents NodeIdentifiers a
    a NodeIdentifiers a
    b = (forall a. Diff a -> Diff [a]
    diffList forall {a} {a}.
    (Outputable a, Outputable a, Eq a, Eq a) =>
    (Either a HieName, a) -> (Either a HieName, a) -> [SDoc]
    diffIdent forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` 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) = forall {a}.
    (Outputable a, Eq a) =>
    Either a HieName -> Either a HieName -> [SDoc]
    diffName Either a HieName
    a Either a HieName
    c
                             forall a. [a] -> [a] -> [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
    _) -> 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
    _) -> forall a. (Outputable a, Eq a) => Diff a
    eqDiff OccName
    o OccName
    o'
          (HieName, HieName)
    _ -> forall a. (Outputable a, Eq a) => Diff a
    eqDiff HieName
    a HieName
    b
        diffName Either a HieName
    a Either a HieName
    b = 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 = forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn forall {f :: * -> *} {a}.
    Functor f =>
    (f HieName, IdentifierDetails a)
    -> (f OccName, Set ContextInfo, Maybe a)
    go forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall a b. (a -> b) -> [a] -> [b]
    map (forall {f :: * -> *} {a} {b} {b}.
    Functor f =>
    (a -> b) -> (f a, b) -> (f b, b)
    first Name -> HieName
    toHieName) forall b c a. (b -> c) -> (a -> b) -> a -> c
    . 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) = (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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> f HieName
    a,forall a. IdentifierDetails a -> Set ContextInfo
    identInfo IdentifierDetails a
    b,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
      | forall (t :: * -> *) a. Foldable t => t a -> TypeIndex
    length [a]
    xs forall a. Eq a => a -> a -> Bool
    == forall (t :: * -> *) a. Foldable t => t a -> TypeIndex
    length [a]
    ys = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat forall a b. (a -> b) -> a -> b
    $ 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 forall a. Eq a => a -> a -> Bool
    == a
    b = []
      | Bool
    otherwise = [[SDoc] -> SDoc
    hsep [forall a. Outputable a => a -> SDoc
    ppr a
    a, SDoc
    "and", 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
      forall {a}. [HieAST a] -> Either SDoc ()
    checkSorted [HieAST a]
    children
      forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ forall a. HieAST a -> Either SDoc ()
    validAst [HieAST a]
    children
      where
        checkSorted :: [HieAST a] -> Either SDoc ()
    checkSorted [] = forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        checkSorted [HieAST a
    _] = forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        checkSorted (HieAST a
    x:HieAST a
    y:[HieAST a]
    xs)
          | forall a. HieAST a -> Span
    nodeSpan HieAST a
    x Span -> Span -> Bool
    `leftOf` forall a. HieAST a -> Span
    nodeSpan HieAST a
    y = [HieAST a] -> Either SDoc ()
    checkSorted (HieAST a
    yforall a. a -> [a] -> [a]
    :[HieAST a]
    xs)
          | Bool
    otherwise = forall a b. a -> Either a b
    Left forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    hsep
              [ forall a. Outputable a => a -> SDoc
    ppr forall a b. (a -> b) -> a -> b
    $ forall a. HieAST a -> Span
    nodeSpan HieAST a
    x
              , SDoc
    "is not to the left of"
              , forall a. Outputable a => a -> SDoc
    ppr forall a b. (a -> b) -> a -> b
    $ forall a. HieAST a -> Span
    nodeSpan HieAST a
    y
              ]
        checkContainment :: [HieAST a] -> Either SDoc ()
    checkContainment [] = forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        checkContainment (HieAST a
    x:[HieAST a]
    xs)
          | Span
    span Span -> Span -> Bool
    `containsSpan` (forall a. HieAST a -> Span
    nodeSpan HieAST a
    x) = [HieAST a] -> Either SDoc ()
    checkContainment [HieAST a]
    xs
          | Bool
    otherwise = forall a b. a -> Either a b
    Left forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    hsep
              [ forall a. Outputable a => a -> SDoc
    ppr forall a b. (a -> b) -> a -> b
    $ Span
    span
              , SDoc
    "does not contain"
              , forall a. Outputable a => a -> SDoc
    ppr forall a b. (a -> b) -> a -> b
    $ 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 forall a. [a] -> [a] -> [a]
    ++ [SDoc]
    validEvs
      where
        refMap :: RefMap a
    refMap = 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 = forall k a. Map k a -> [k]
    M.keys
          forall a b. (a -> b) -> a -> b
    $ forall a k. (a -> Bool) -> Map k a -> Map k a
    M.filter (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ContextInfo -> Bool
    isEvidenceContext forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (forall a. Set a -> [a]
    S.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall a. IdentifierDetails a -> Set ContextInfo
    identInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
    . 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 forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Either ModuleName Name
    i RefMap a
    refMap of
            Maybe [(Span, IdentifierDetails a)]
    Nothing -> [SDoc
    "Impossible, ev"SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    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 (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ContextInfo -> Bool
    isEvidenceBind forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (forall a. Set a -> [a]
    S.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall a. IdentifierDetails a -> Set ContextInfo
    identInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall a b. (a, b) -> b
    snd) forall a b. (a -> b) -> a -> b
    $ [(Span, IdentifierDetails a)]
    refs)
              -> [SDoc
    "Evidence var" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    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 = 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 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 = 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 = forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap ContextInfo -> Maybe [Scope]
    getScopeFromContext forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall a. IdentifierDetails a -> Set ContextInfo
    identInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall a b. (a, b) -> b
    snd
            scopes :: [Scope]
    scopes = case forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap 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)
              |  (forall a. Map HiePath (HieAST a) -> Name -> Bool
    definedInAsts Map HiePath (HieAST a)
    asts Name
    n Bool -> Bool -> Bool
    || (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ContextInfo -> Bool
    isEvidenceContext (forall a. IdentifierDetails a -> Set ContextInfo
    identInfo IdentifierDetails a
    dets)))
              Bool -> Bool -> Bool
    && forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ContextInfo -> Bool
    isOccurrence (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 forall a b. (a -> b) -> a -> b
    $ Name -> OccName
    nameOccName Name
    n)
                        Bool -> Bool -> Bool
    || forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ContextInfo -> Bool
    isEvidenceContext (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
                       -> forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    hsep forall a b. (a -> b) -> a -> b
    $
                         [ SDoc
    "Locally defined Name", forall a. Outputable a => a -> SDoc
    ppr Name
    n,Name -> SDoc
    pprDefinedAt Name
    n , SDoc
    "at position", forall a. Outputable a => a -> SDoc
    ppr Span
    sp
                         , SDoc
    "Doesn't have a calculated scope: ", forall a. Outputable a => a -> SDoc
    ppr [Scope]
    scopes]
                     | Bool
    otherwise -> []
                  [Scope]
    _ -> if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Scope -> Span -> Bool
    `scopeContainsSpan` Span
    sp) [Scope]
    scopes
                       then []
                       else forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    hsep forall a b. (a -> b) -> a -> b
    $
                         [ SDoc
    "Name", forall a. Outputable a => a -> SDoc
    ppr Name
    n, Name -> SDoc
    pprDefinedAt Name
    n, SDoc
    "at position", forall a. Outputable a => a -> SDoc
    ppr Span
    sp
                         , SDoc
    "doesn't occur in calculated scope", forall a. Outputable a => a -> SDoc
    ppr [Scope]
    scopes]
              | Bool
    otherwise = []