{-# language ApplicativeDo #-}
{-# language BlockArguments #-}
{-# language DeriveGeneric #-}
{-# language DeriveAnyClass #-}
{-# language FlexibleContexts #-}
{-# language LambdaCase #-}
{-# language NamedFieldPuns #-}
{-# language NoImplicitPrelude #-}
{-# language OverloadedLabels #-}
{-# language OverloadedStrings #-}
{-# language TupleSections #-}

module Weeder
  ( -- * Analysis
    Analysis(..)
  , analyseEvidenceUses
  , analyseHieFile
  , emptyAnalysis
  , outputableDeclarations

    -- ** Reachability
  , Root(..)
  , reachable

    -- * Declarations
  , Declaration(..)
  )
   where

-- algebraic-graphs
import Algebra.Graph ( Graph, edge, empty, overlay, vertex, stars, star, overlays )
import Algebra.Graph.ToGraph ( dfs )

-- base
import Control.Applicative ( Alternative )
import Control.Monad ( guard, msum, when, unless, mzero )
import Data.Traversable ( for )
import Data.Maybe ( mapMaybe )
import Data.Foldable ( for_, traverse_, toList )
import Data.Function ( (&) )
import Data.List ( intercalate )
import Data.Monoid ( First( First ), getFirst )
import GHC.Generics ( Generic )
import Prelude hiding ( span )

-- containers
import Data.Containers.ListUtils ( nubOrd )
import Data.Map.Strict ( Map )
import qualified Data.Map.Strict as Map
import Data.Sequence ( Seq )
import Data.Set ( Set )
import qualified Data.Set as Set
import Data.Tree (Tree)
import qualified Data.Tree as Tree

-- generic-lens
import Data.Generics.Labels ()

-- ghc
import GHC.Types.Avail ( AvailInfo, availName, availNames )
import GHC.Data.FastString ( unpackFS )
import GHC.Iface.Ext.Types
  ( BindType( RegularBind )
  , ContextInfo( Decl, ValBind, PatternBind, Use, TyDecl, ClassTyDecl, EvidenceVarBind, RecField )
  , DeclType( DataDec, ClassDec, ConDec, SynDec, FamDec )
  , EvVarSource ( EvInstBind, cls )
  , HieAST( Node, nodeChildren, nodeSpan, sourcedNodeInfo )
  , HieASTs( HieASTs )
  , HieFile( HieFile, hie_asts, hie_exports, hie_module, hie_hs_file, hie_types )
  , HieType( HTyVarTy, HAppTy, HTyConApp, HForAllTy, HFunTy, HQualTy, HLitTy, HCastTy, HCoercionTy )
  , HieArgs( HieArgs )
  , HieTypeFix( Roll )
  , IdentifierDetails( IdentifierDetails, identInfo, identType )
  , NodeAnnotation( NodeAnnotation, nodeAnnotType )
  , NodeInfo( nodeIdentifiers, nodeAnnotations )
  , Scope( ModuleScope )
  , RecFieldContext ( RecFieldOcc )
  , TypeIndex
  , getSourcedNodeInfo
  )
import GHC.Iface.Ext.Utils
  ( EvidenceInfo( EvidenceInfo, evidenceVar )
  , RefMap
  , findEvidenceUse
  , getEvidenceTree
  , hieTypeToIface
  , recoverFullType
  )
import GHC.Unit.Module ( Module, moduleStableString )
import GHC.Utils.Outputable ( defaultSDocContext, showSDocOneLine )
import GHC.Iface.Type
  ( ShowForAllFlag (ShowForAllWhen)
  , pprIfaceSigmaType
  , IfaceTyCon (IfaceTyCon, ifaceTyConName)
  )
import GHC.Types.Name
  ( Name, nameModule_maybe, nameOccName
  , OccName
  , isDataOcc
  , isDataSymOcc
  , isTcOcc
  , isTvOcc
  , isVarOcc
  , occNameString
  )
import GHC.Types.SrcLoc ( RealSrcSpan, realSrcSpanEnd, realSrcSpanStart, srcLocLine, srcLocCol )

-- lens
import Control.Lens ( (%=) )

-- mtl
import Control.Monad.State.Class ( MonadState )
import Control.Monad.Reader.Class ( MonadReader, asks )

-- parallel
import Control.Parallel.Strategies ( NFData )

-- transformers
import Control.Monad.Trans.Maybe ( runMaybeT )
import Control.Monad.Trans.Reader ( runReaderT )

-- weeder
import Weeder.Config ( Config, ConfigType( Config, typeClassRoots, unusedTypes ) )


data Declaration =
  Declaration
    { Declaration -> Module
declModule :: Module
      -- ^ The module this declaration occurs in.
    , Declaration -> OccName
declOccName :: OccName
      -- ^ The symbol name of a declaration.
    }
  deriving
    ( Declaration -> Declaration -> Bool
(Declaration -> Declaration -> Bool)
-> (Declaration -> Declaration -> Bool) -> Eq Declaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Declaration -> Declaration -> Bool
== :: Declaration -> Declaration -> Bool
$c/= :: Declaration -> Declaration -> Bool
/= :: Declaration -> Declaration -> Bool
Eq, Eq Declaration
Eq Declaration =>
(Declaration -> Declaration -> Ordering)
-> (Declaration -> Declaration -> Bool)
-> (Declaration -> Declaration -> Bool)
-> (Declaration -> Declaration -> Bool)
-> (Declaration -> Declaration -> Bool)
-> (Declaration -> Declaration -> Declaration)
-> (Declaration -> Declaration -> Declaration)
-> Ord Declaration
Declaration -> Declaration -> Bool
Declaration -> Declaration -> Ordering
Declaration -> Declaration -> Declaration
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Declaration -> Declaration -> Ordering
compare :: Declaration -> Declaration -> Ordering
$c< :: Declaration -> Declaration -> Bool
< :: Declaration -> Declaration -> Bool
$c<= :: Declaration -> Declaration -> Bool
<= :: Declaration -> Declaration -> Bool
$c> :: Declaration -> Declaration -> Bool
> :: Declaration -> Declaration -> Bool
$c>= :: Declaration -> Declaration -> Bool
>= :: Declaration -> Declaration -> Bool
$cmax :: Declaration -> Declaration -> Declaration
max :: Declaration -> Declaration -> Declaration
$cmin :: Declaration -> Declaration -> Declaration
min :: Declaration -> Declaration -> Declaration
Ord, (forall x. Declaration -> Rep Declaration x)
-> (forall x. Rep Declaration x -> Declaration)
-> Generic Declaration
forall x. Rep Declaration x -> Declaration
forall x. Declaration -> Rep Declaration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Declaration -> Rep Declaration x
from :: forall x. Declaration -> Rep Declaration x
$cto :: forall x. Rep Declaration x -> Declaration
to :: forall x. Rep Declaration x -> Declaration
Generic, Declaration -> ()
(Declaration -> ()) -> NFData Declaration
forall a. (a -> ()) -> NFData a
$crnf :: Declaration -> ()
rnf :: Declaration -> ()
NFData )


instance Show Declaration where
  show :: Declaration -> FilePath
show =
    Declaration -> FilePath
declarationStableName


declarationStableName :: Declaration -> String
declarationStableName :: Declaration -> FilePath
declarationStableName Declaration { Module
declModule :: Declaration -> Module
declModule :: Module
declModule, OccName
declOccName :: Declaration -> OccName
declOccName :: OccName
declOccName } =
  let
    namespace :: FilePath
namespace
      | OccName -> Bool
isVarOcc OccName
declOccName     = FilePath
"var"
      | OccName -> Bool
isTvOcc OccName
declOccName      = FilePath
"tv"
      | OccName -> Bool
isTcOcc OccName
declOccName      = FilePath
"tc"
      | OccName -> Bool
isDataOcc OccName
declOccName    = FilePath
"data"
      | OccName -> Bool
isDataSymOcc OccName
declOccName = FilePath
"dataSym"
      | Bool
otherwise                = FilePath
"unknown"

    in
    FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"$" [ FilePath
namespace, Module -> FilePath
moduleStableString Module
declModule, FilePath
"$", OccName -> FilePath
occNameString OccName
declOccName ]


-- | All information maintained by 'analyseHieFile'.
data Analysis =
  Analysis
    { Analysis -> Graph Declaration
dependencyGraph :: Graph Declaration
      -- ^ A graph between declarations, capturing dependencies.
    , Analysis -> Map Declaration (Set (Int, Int))
declarationSites :: Map Declaration (Set (Int, Int))
      -- ^ A partial mapping between declarations and their line numbers.
      -- This Map is partial as we don't always know where a Declaration was
      -- defined (e.g., it may come from a package without source code).
      -- We capture a set of sites, because a declaration may be defined in
      -- multiple locations, e.g., a type signature for a function separate
      -- from its definition.
    , Analysis -> Set Root
implicitRoots :: Set Root
      -- ^ Stores information on Declarations that may be automatically marked
      -- as always reachable. This is used, for example, to capture knowledge 
      -- not yet modelled in weeder, or to mark all instances of a class as 
      -- roots.
    , Analysis -> Map Module (Set Declaration)
exports :: Map Module ( Set Declaration )
      -- ^ All exports for a given module.
    , Analysis -> Map Module FilePath
modulePaths :: Map Module FilePath
      -- ^ A map from modules to the file path to the .hs file defining them.
    , Analysis -> Map Declaration FilePath
prettyPrintedType :: Map Declaration String
      -- ^ Used to match against the types of instances and to replace the
      -- appearance of declarations in the output
    , Analysis -> Map Declaration (Set Name)
requestedEvidence :: Map Declaration (Set Name)
      -- ^ Map from declarations to the names containing evidence uses that
      -- should be followed and treated as dependencies of the declaration.
      -- We use this to be able to delay analysing evidence uses until later,
      -- allowing us to begin the rest of the analysis before we have read all
      -- hie files.
    }
  deriving
    ( (forall x. Analysis -> Rep Analysis x)
-> (forall x. Rep Analysis x -> Analysis) -> Generic Analysis
forall x. Rep Analysis x -> Analysis
forall x. Analysis -> Rep Analysis x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Analysis -> Rep Analysis x
from :: forall x. Analysis -> Rep Analysis x
$cto :: forall x. Rep Analysis x -> Analysis
to :: forall x. Rep Analysis x -> Analysis
Generic, Analysis -> ()
(Analysis -> ()) -> NFData Analysis
forall a. (a -> ()) -> NFData a
$crnf :: Analysis -> ()
rnf :: Analysis -> ()
NFData )


instance Semigroup Analysis where
  <> :: Analysis -> Analysis -> Analysis
(<>) (Analysis Graph Declaration
a1 Map Declaration (Set (Int, Int))
b1 Set Root
c1 Map Module (Set Declaration)
d1 Map Module FilePath
e1 Map Declaration FilePath
f1 Map Declaration (Set Name)
g1) (Analysis Graph Declaration
a2 Map Declaration (Set (Int, Int))
b2 Set Root
c2 Map Module (Set Declaration)
d2 Map Module FilePath
e2 Map Declaration FilePath
f2 Map Declaration (Set Name)
g2)= 
    Graph Declaration
-> Map Declaration (Set (Int, Int))
-> Set Root
-> Map Module (Set Declaration)
-> Map Module FilePath
-> Map Declaration FilePath
-> Map Declaration (Set Name)
-> Analysis
Analysis (Graph Declaration
a1 Graph Declaration -> Graph Declaration -> Graph Declaration
forall a. Graph a -> Graph a -> Graph a
`overlay` Graph Declaration
a2) ((Set (Int, Int) -> Set (Int, Int) -> Set (Int, Int))
-> Map Declaration (Set (Int, Int))
-> Map Declaration (Set (Int, Int))
-> Map Declaration (Set (Int, Int))
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Set (Int, Int) -> Set (Int, Int) -> Set (Int, Int)
forall a. Semigroup a => a -> a -> a
(<>) Map Declaration (Set (Int, Int))
b1 Map Declaration (Set (Int, Int))
b2) (Set Root
c1 Set Root -> Set Root -> Set Root
forall a. Semigroup a => a -> a -> a
<> Set Root
c2) ((Set Declaration -> Set Declaration -> Set Declaration)
-> Map Module (Set Declaration)
-> Map Module (Set Declaration)
-> Map Module (Set Declaration)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Set Declaration -> Set Declaration -> Set Declaration
forall a. Semigroup a => a -> a -> a
(<>) Map Module (Set Declaration)
d1 Map Module (Set Declaration)
d2) (Map Module FilePath
e1 Map Module FilePath -> Map Module FilePath -> Map Module FilePath
forall a. Semigroup a => a -> a -> a
<> Map Module FilePath
e2) (Map Declaration FilePath
f1 Map Declaration FilePath
-> Map Declaration FilePath -> Map Declaration FilePath
forall a. Semigroup a => a -> a -> a
<> Map Declaration FilePath
f2) ((Set Name -> Set Name -> Set Name)
-> Map Declaration (Set Name)
-> Map Declaration (Set Name)
-> Map Declaration (Set Name)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Set Name -> Set Name -> Set Name
forall a. Semigroup a => a -> a -> a
(<>) Map Declaration (Set Name)
g1 Map Declaration (Set Name)
g2)


instance Monoid Analysis where
  mempty :: Analysis
mempty = Analysis
emptyAnalysis


data AnalysisInfo =
  AnalysisInfo
    { AnalysisInfo -> HieFile
currentHieFile :: HieFile
    , AnalysisInfo -> Config
weederConfig :: Config
    }


-- | The empty analysis - the result of analysing zero @.hie@ files.
emptyAnalysis :: Analysis
emptyAnalysis :: Analysis
emptyAnalysis = Graph Declaration
-> Map Declaration (Set (Int, Int))
-> Set Root
-> Map Module (Set Declaration)
-> Map Module FilePath
-> Map Declaration FilePath
-> Map Declaration (Set Name)
-> Analysis
Analysis Graph Declaration
forall a. Graph a
empty Map Declaration (Set (Int, Int))
forall a. Monoid a => a
mempty Set Root
forall a. Monoid a => a
mempty Map Module (Set Declaration)
forall a. Monoid a => a
mempty Map Module FilePath
forall a. Monoid a => a
mempty Map Declaration FilePath
forall a. Monoid a => a
mempty Map Declaration (Set Name)
forall a. Monoid a => a
mempty


-- | A root for reachability analysis.
data Root
  = -- | A given declaration is a root.
    DeclarationRoot Declaration
  | -- | We store extra information for instances in order to be able
    -- to specify e.g. all instances of a class as roots.
    InstanceRoot 
      Declaration -- ^ Declaration of the instance
      Declaration -- ^ Declaration of the parent class
  | -- | All exported declarations in a module are roots.
    ModuleRoot Module
  deriving
    ( Root -> Root -> Bool
(Root -> Root -> Bool) -> (Root -> Root -> Bool) -> Eq Root
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Root -> Root -> Bool
== :: Root -> Root -> Bool
$c/= :: Root -> Root -> Bool
/= :: Root -> Root -> Bool
Eq, Eq Root
Eq Root =>
(Root -> Root -> Ordering)
-> (Root -> Root -> Bool)
-> (Root -> Root -> Bool)
-> (Root -> Root -> Bool)
-> (Root -> Root -> Bool)
-> (Root -> Root -> Root)
-> (Root -> Root -> Root)
-> Ord Root
Root -> Root -> Bool
Root -> Root -> Ordering
Root -> Root -> Root
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Root -> Root -> Ordering
compare :: Root -> Root -> Ordering
$c< :: Root -> Root -> Bool
< :: Root -> Root -> Bool
$c<= :: Root -> Root -> Bool
<= :: Root -> Root -> Bool
$c> :: Root -> Root -> Bool
> :: Root -> Root -> Bool
$c>= :: Root -> Root -> Bool
>= :: Root -> Root -> Bool
$cmax :: Root -> Root -> Root
max :: Root -> Root -> Root
$cmin :: Root -> Root -> Root
min :: Root -> Root -> Root
Ord, (forall x. Root -> Rep Root x)
-> (forall x. Rep Root x -> Root) -> Generic Root
forall x. Rep Root x -> Root
forall x. Root -> Rep Root x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Root -> Rep Root x
from :: forall x. Root -> Rep Root x
$cto :: forall x. Rep Root x -> Root
to :: forall x. Rep Root x -> Root
Generic, Root -> ()
(Root -> ()) -> NFData Root
forall a. (a -> ()) -> NFData a
$crnf :: Root -> ()
rnf :: Root -> ()
NFData )


-- | Determine the set of all declaration reachable from a set of roots.
reachable :: Analysis -> Set Root -> Set Declaration
reachable :: Analysis -> Set Root -> Set Declaration
reachable Analysis{ Graph Declaration
dependencyGraph :: Analysis -> Graph Declaration
dependencyGraph :: Graph Declaration
dependencyGraph, Map Module (Set Declaration)
exports :: Analysis -> Map Module (Set Declaration)
exports :: Map Module (Set Declaration)
exports } Set Root
roots =
  [Declaration] -> Set Declaration
forall a. Ord a => [a] -> Set a
Set.fromList ( Graph Declaration
-> [ToVertex (Graph Declaration)] -> [ToVertex (Graph Declaration)]
forall t.
(ToGraph t, Ord (ToVertex t)) =>
t -> [ToVertex t] -> [ToVertex t]
dfs Graph Declaration
dependencyGraph ( (Root -> [Declaration]) -> Set Root -> [Declaration]
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Root -> [Declaration]
rootDeclarations Set Root
roots ) )

  where

    rootDeclarations :: Root -> [Declaration]
rootDeclarations = \case
      DeclarationRoot Declaration
d -> [ Declaration
d ]
      InstanceRoot Declaration
d Declaration
_ -> [ Declaration
d ] -- filter InstanceRoots in `Main.hs`
      ModuleRoot Module
m -> (Set Declaration -> [Declaration])
-> Maybe (Set Declaration) -> [Declaration]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Set Declaration -> [Declaration]
forall a. Set a -> [a]
Set.toList ( Module -> Map Module (Set Declaration) -> Maybe (Set Declaration)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Module
m Map Module (Set Declaration)
exports )


-- | The set of all declarations that could possibly
-- appear in the output.
outputableDeclarations :: Analysis -> Set Declaration
outputableDeclarations :: Analysis -> Set Declaration
outputableDeclarations Analysis{ Map Declaration (Set (Int, Int))
declarationSites :: Analysis -> Map Declaration (Set (Int, Int))
declarationSites :: Map Declaration (Set (Int, Int))
declarationSites } =
  Map Declaration (Set (Int, Int)) -> Set Declaration
forall k a. Map k a -> Set k
Map.keysSet Map Declaration (Set (Int, Int))
declarationSites


-- Generate an initial graph of the current HieFile.
initialGraph :: AnalysisInfo -> Graph Declaration
initialGraph :: AnalysisInfo -> Graph Declaration
initialGraph AnalysisInfo
info =
  let hf :: HieFile
hf@HieFile{ hie_asts :: HieFile -> HieASTs Int
hie_asts = HieASTs Map HiePath (HieAST Int)
hieAsts } = AnalysisInfo -> HieFile
currentHieFile AnalysisInfo
info
      Config{ Bool
unusedTypes :: forall a. ConfigType a -> Bool
unusedTypes :: Bool
unusedTypes } = AnalysisInfo -> Config
weederConfig AnalysisInfo
info
      asts :: [HieAST Int]
asts = Map HiePath (HieAST Int) -> [HieAST Int]
forall k a. Map k a -> [a]
Map.elems Map HiePath (HieAST Int)
hieAsts
      decls :: [(Declaration, IdentifierDetails Int, HieAST Int)]
decls = (HieAST Int -> [(Declaration, IdentifierDetails Int, HieAST Int)])
-> [HieAST Int]
-> [(Declaration, IdentifierDetails Int, HieAST Int)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Seq (Declaration, IdentifierDetails Int, HieAST Int)
-> [(Declaration, IdentifierDetails Int, HieAST Int)]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq (Declaration, IdentifierDetails Int, HieAST Int)
 -> [(Declaration, IdentifierDetails Int, HieAST Int)])
-> (HieAST Int
    -> Seq (Declaration, IdentifierDetails Int, HieAST Int))
-> HieAST Int
-> [(Declaration, IdentifierDetails Int, HieAST Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set ContextInfo -> Bool)
-> HieAST Int
-> Seq (Declaration, IdentifierDetails Int, HieAST Int)
forall a.
(Set ContextInfo -> Bool)
-> HieAST a -> Seq (Declaration, IdentifierDetails a, HieAST a)
findIdentifiers' (Bool -> Set ContextInfo -> Bool
forall a b. a -> b -> a
const Bool
True)) [HieAST Int]
asts
  in if Bool
unusedTypes
    then [(Declaration, [Declaration])] -> Graph Declaration
forall a. [(a, [a])] -> Graph a
stars do 
      (Declaration
d, IdentifierDetails{Maybe Int
identType :: forall a. IdentifierDetails a -> Maybe a
identType :: Maybe Int
identType}, HieAST Int
_) <- [(Declaration, IdentifierDetails Int, HieAST Int)]
decls
      Int
t <- [Int] -> (Int -> [Int]) -> Maybe Int -> [Int]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Int]
forall a. [a]
forall (m :: * -> *) a. MonadPlus m => m a
mzero Int -> [Int]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
identType
      let ns :: [Name]
ns = Set Name -> [Name]
forall a. Set a -> [a]
Set.toList (Set Name -> [Name]) -> Set Name -> [Name]
forall a b. (a -> b) -> a -> b
$ HieTypeFix -> Set Name
typeToNames (HieFile -> Int -> HieTypeFix
lookupType HieFile
hf Int
t)
          ds :: [Declaration]
ds = (Name -> Maybe Declaration) -> [Name] -> [Declaration]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Name -> Maybe Declaration
nameToDeclaration [Name]
ns
      Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not ([Declaration] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Declaration]
ds)
      pure (Declaration
d, [Declaration]
ds)
    else Graph Declaration
forall a. Monoid a => a
mempty


-- | Incrementally update 'Analysis' with information in a 'HieFile'.
analyseHieFile :: (MonadState Analysis m) => Config -> HieFile -> m ()
analyseHieFile :: forall (m :: * -> *).
MonadState Analysis m =>
Config -> HieFile -> m ()
analyseHieFile Config
weederConfig HieFile
hieFile =
  let info :: AnalysisInfo
info = HieFile -> Config -> AnalysisInfo
AnalysisInfo HieFile
hieFile Config
weederConfig
   in ReaderT AnalysisInfo m () -> AnalysisInfo -> m ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT AnalysisInfo m ()
forall (m :: * -> *).
(MonadState Analysis m, MonadReader AnalysisInfo m) =>
m ()
analyseHieFile' AnalysisInfo
info


analyseHieFile' :: ( MonadState Analysis m, MonadReader AnalysisInfo m ) => m ()
analyseHieFile' :: forall (m :: * -> *).
(MonadState Analysis m, MonadReader AnalysisInfo m) =>
m ()
analyseHieFile' = do
  HieFile{ hie_asts :: HieFile -> HieASTs Int
hie_asts = HieASTs Map HiePath (HieAST Int)
hieASTs, [AvailInfo]
hie_exports :: HieFile -> [AvailInfo]
hie_exports :: [AvailInfo]
hie_exports, Module
hie_module :: HieFile -> Module
hie_module :: Module
hie_module, FilePath
hie_hs_file :: HieFile -> FilePath
hie_hs_file :: FilePath
hie_hs_file } <- (AnalysisInfo -> HieFile) -> m HieFile
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks AnalysisInfo -> HieFile
currentHieFile
  #modulePaths %= Map.insert hie_module hie_hs_file
  
  Graph Declaration
g <- (AnalysisInfo -> Graph Declaration) -> m (Graph Declaration)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks AnalysisInfo -> Graph Declaration
initialGraph
  #dependencyGraph %= overlay g

  Map HiePath (HieAST Int) -> (HieAST Int -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Map HiePath (HieAST Int)
hieASTs HieAST Int -> m ()
forall (m :: * -> *).
(MonadState Analysis m, MonadReader AnalysisInfo m) =>
HieAST Int -> m ()
topLevelAnalysis

  [AvailInfo] -> (AvailInfo -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [AvailInfo]
hie_exports ( Module -> AvailInfo -> m ()
forall (m :: * -> *).
MonadState Analysis m =>
Module -> AvailInfo -> m ()
analyseExport Module
hie_module )


lookupType :: HieFile -> TypeIndex -> HieTypeFix
lookupType :: HieFile -> Int -> HieTypeFix
lookupType HieFile
hf Int
t = Int -> Array Int HieTypeFlat -> HieTypeFix
recoverFullType Int
t (Array Int HieTypeFlat -> HieTypeFix)
-> Array Int HieTypeFlat -> HieTypeFix
forall a b. (a -> b) -> a -> b
$ HieFile -> Array Int HieTypeFlat
hie_types HieFile
hf


lookupPprType :: MonadReader AnalysisInfo m => TypeIndex -> m String
lookupPprType :: forall (m :: * -> *).
MonadReader AnalysisInfo m =>
Int -> m FilePath
lookupPprType Int
t = do
  HieFile
hf <- (AnalysisInfo -> HieFile) -> m HieFile
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks AnalysisInfo -> HieFile
currentHieFile
  FilePath -> m FilePath
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> m FilePath)
-> (HieTypeFix -> FilePath) -> HieTypeFix -> m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieTypeFix -> FilePath
renderType (HieTypeFix -> m FilePath) -> HieTypeFix -> m FilePath
forall a b. (a -> b) -> a -> b
$ HieFile -> Int -> HieTypeFix
lookupType HieFile
hf Int
t

  where

    renderType :: HieTypeFix -> FilePath
renderType = SDocContext -> SDoc -> FilePath
showSDocOneLine SDocContext
defaultSDocContext (SDoc -> FilePath)
-> (HieTypeFix -> SDoc) -> HieTypeFix -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowForAllFlag -> IfaceType -> SDoc
pprIfaceSigmaType ShowForAllFlag
ShowForAllWhen (IfaceType -> SDoc)
-> (HieTypeFix -> IfaceType) -> HieTypeFix -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieTypeFix -> IfaceType
hieTypeToIface


-- | Names mentioned within the type.
typeToNames :: HieTypeFix -> Set Name
typeToNames :: HieTypeFix -> Set Name
typeToNames (Roll HieType HieTypeFix
t) = case HieType HieTypeFix
t of
  HTyVarTy Name
n -> Name -> Set Name
forall a. a -> Set a
Set.singleton Name
n

  HAppTy HieTypeFix
a (HieArgs [(Bool, HieTypeFix)]
args) ->
    HieTypeFix -> Set Name
typeToNames HieTypeFix
a Set Name -> Set Name -> Set Name
forall a. Semigroup a => a -> a -> a
<> [(Bool, HieTypeFix)] -> Set Name
hieArgsTypes [(Bool, HieTypeFix)]
args

  HTyConApp (IfaceTyCon{Name
ifaceTyConName :: IfaceTyCon -> Name
ifaceTyConName :: Name
ifaceTyConName}) (HieArgs [(Bool, HieTypeFix)]
args) ->
    Name -> Set Name
forall a. a -> Set a
Set.singleton Name
ifaceTyConName Set Name -> Set Name -> Set Name
forall a. Semigroup a => a -> a -> a
<> [(Bool, HieTypeFix)] -> Set Name
hieArgsTypes [(Bool, HieTypeFix)]
args

  HForAllTy ((Name, HieTypeFix), ForAllTyFlag)
_ HieTypeFix
a -> HieTypeFix -> Set Name
typeToNames HieTypeFix
a

  HFunTy HieTypeFix
_mult HieTypeFix
b HieTypeFix
c ->
    HieTypeFix -> Set Name
typeToNames HieTypeFix
b Set Name -> Set Name -> Set Name
forall a. Semigroup a => a -> a -> a
<> HieTypeFix -> Set Name
typeToNames HieTypeFix
c

  HQualTy HieTypeFix
a HieTypeFix
b ->
    HieTypeFix -> Set Name
typeToNames HieTypeFix
a Set Name -> Set Name -> Set Name
forall a. Semigroup a => a -> a -> a
<> HieTypeFix -> Set Name
typeToNames HieTypeFix
b

  HLitTy IfaceTyLit
_ -> Set Name
forall a. Monoid a => a
mempty

  HCastTy HieTypeFix
a -> HieTypeFix -> Set Name
typeToNames HieTypeFix
a

  HieType HieTypeFix
HCoercionTy -> Set Name
forall a. Monoid a => a
mempty

  where

    hieArgsTypes :: [(Bool, HieTypeFix)] -> Set Name
    hieArgsTypes :: [(Bool, HieTypeFix)] -> Set Name
hieArgsTypes = ((Bool, HieTypeFix) -> Set Name)
-> [(Bool, HieTypeFix)] -> Set Name
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (HieTypeFix -> Set Name
typeToNames (HieTypeFix -> Set Name)
-> ((Bool, HieTypeFix) -> HieTypeFix)
-> (Bool, HieTypeFix)
-> Set Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, HieTypeFix) -> HieTypeFix
forall a b. (a, b) -> b
snd) ([(Bool, HieTypeFix)] -> Set Name)
-> ([(Bool, HieTypeFix)] -> [(Bool, HieTypeFix)])
-> [(Bool, HieTypeFix)]
-> Set Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool, HieTypeFix) -> Bool)
-> [(Bool, HieTypeFix)] -> [(Bool, HieTypeFix)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool, HieTypeFix) -> Bool
forall a b. (a, b) -> a
fst


analyseExport :: MonadState Analysis m => Module -> AvailInfo -> m ()
analyseExport :: forall (m :: * -> *).
MonadState Analysis m =>
Module -> AvailInfo -> m ()
analyseExport Module
m AvailInfo
a = 
  (Name -> m ()) -> [Name] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Declaration -> m ()) -> Maybe Declaration -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Declaration -> m ()
forall (m :: * -> *). MonadState Analysis m => Declaration -> m ()
addExport (Maybe Declaration -> m ())
-> (Name -> Maybe Declaration) -> Name -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Maybe Declaration
nameToDeclaration) (AvailInfo -> Name
availName AvailInfo
a Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: AvailInfo -> [Name]
availNames AvailInfo
a)
  where

    addExport :: MonadState Analysis m => Declaration -> m ()
    addExport :: forall (m :: * -> *). MonadState Analysis m => Declaration -> m ()
addExport Declaration
d = ASetter
  Analysis
  Analysis
  (Map Module (Set Declaration))
  (Map Module (Set Declaration))
#exports ASetter
  Analysis
  Analysis
  (Map Module (Set Declaration))
  (Map Module (Set Declaration))
-> (Map Module (Set Declaration) -> Map Module (Set Declaration))
-> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Set Declaration -> Set Declaration -> Set Declaration)
-> Module
-> Set Declaration
-> Map Module (Set Declaration)
-> Map Module (Set Declaration)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Set Declaration -> Set Declaration -> Set Declaration
forall a. Semigroup a => a -> a -> a
(<>) Module
m ( Declaration -> Set Declaration
forall a. a -> Set a
Set.singleton Declaration
d )


-- | @addDependency x y@ adds the information that @x@ depends on @y@.
addDependency :: MonadState Analysis m => Declaration -> Declaration -> m ()
addDependency :: forall (m :: * -> *).
MonadState Analysis m =>
Declaration -> Declaration -> m ()
addDependency Declaration
x Declaration
y =
  #dependencyGraph %= overlay ( edge x y )


addImplicitRoot :: MonadState Analysis m => Declaration -> m ()
addImplicitRoot :: forall (m :: * -> *). MonadState Analysis m => Declaration -> m ()
addImplicitRoot Declaration
x =
  #implicitRoots %= Set.insert (DeclarationRoot x)


addInstanceRoot :: ( MonadState Analysis m, MonadReader AnalysisInfo m ) => Declaration -> TypeIndex -> Name -> m ()
addInstanceRoot :: forall (m :: * -> *).
(MonadState Analysis m, MonadReader AnalysisInfo m) =>
Declaration -> Int -> Name -> m ()
addInstanceRoot Declaration
x Int
t Name
cls = do
  Maybe Declaration -> (Declaration -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Name -> Maybe Declaration
nameToDeclaration Name
cls) \Declaration
cls' ->
    #implicitRoots %= Set.insert (InstanceRoot x cls')

  -- since instances will not appear in the output if typeClassRoots is True
  Config{ Bool
typeClassRoots :: forall a. ConfigType a -> Bool
typeClassRoots :: Bool
typeClassRoots } <- (AnalysisInfo -> Config) -> m Config
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks AnalysisInfo -> Config
weederConfig
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
typeClassRoots (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    FilePath
str <- Int -> m FilePath
forall (m :: * -> *).
MonadReader AnalysisInfo m =>
Int -> m FilePath
lookupPprType Int
t
    #prettyPrintedType %= Map.insert x str


define :: MonadState Analysis m => Declaration -> RealSrcSpan -> m ()
define :: forall (m :: * -> *).
MonadState Analysis m =>
Declaration -> RealSrcSpan -> m ()
define Declaration
decl RealSrcSpan
span =
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ( RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
span RealSrcLoc -> RealSrcLoc -> Bool
forall a. Eq a => a -> a -> Bool
/= RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
span ) do
    let start :: RealSrcLoc
start = RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
span
    let loc :: (Int, Int)
loc = (RealSrcLoc -> Int
srcLocLine RealSrcLoc
start, RealSrcLoc -> Int
srcLocCol RealSrcLoc
start)
    #declarationSites %= Map.insertWith Set.union decl ( Set.singleton loc)
    #dependencyGraph %= overlay ( vertex decl )


topLevelAnalysis :: ( MonadState Analysis m, MonadReader AnalysisInfo m ) => HieAST TypeIndex -> m ()
topLevelAnalysis :: forall (m :: * -> *).
(MonadState Analysis m, MonadReader AnalysisInfo m) =>
HieAST Int -> m ()
topLevelAnalysis n :: HieAST Int
n@Node{ [HieAST Int]
nodeChildren :: forall a. HieAST a -> [HieAST a]
nodeChildren :: [HieAST Int]
nodeChildren } = do
  Config{ Bool
unusedTypes :: forall a. ConfigType a -> Bool
unusedTypes :: Bool
unusedTypes } <- (AnalysisInfo -> Config) -> m Config
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks AnalysisInfo -> Config
weederConfig
  Maybe ()
analysed <-
    MaybeT m () -> m (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT
      ( [MaybeT m ()] -> MaybeT m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([MaybeT m ()] -> MaybeT m ()) -> [MaybeT m ()] -> MaybeT m ()
forall a b. (a -> b) -> a -> b
$
          [
            HieAST Int -> MaybeT m ()
forall (m :: * -> *).
(Alternative m, MonadState Analysis m,
 MonadReader AnalysisInfo m) =>
HieAST Int -> m ()
analyseStandaloneDeriving HieAST Int
n
          , HieAST Int -> MaybeT m ()
forall (m :: * -> *).
(Alternative m, MonadState Analysis m,
 MonadReader AnalysisInfo m) =>
HieAST Int -> m ()
analyseInstanceDeclaration HieAST Int
n
          , HieAST Int -> MaybeT m ()
forall (m :: * -> *) a.
(Alternative m, MonadState Analysis m,
 MonadReader AnalysisInfo m) =>
HieAST a -> m ()
analyseBinding HieAST Int
n
          , HieAST Int -> MaybeT m ()
forall (m :: * -> *) a.
(Alternative m, MonadState Analysis m) =>
HieAST a -> m ()
analyseRewriteRule HieAST Int
n
          , HieAST Int -> MaybeT m ()
forall (m :: * -> *) a.
(Alternative m, MonadState Analysis m,
 MonadReader AnalysisInfo m) =>
HieAST a -> m ()
analyseClassDeclaration HieAST Int
n
          , HieAST Int -> MaybeT m ()
forall (m :: * -> *).
(Alternative m, MonadState Analysis m,
 MonadReader AnalysisInfo m) =>
HieAST Int -> m ()
analyseDataDeclaration HieAST Int
n
          , HieAST Int -> MaybeT m ()
forall (m :: * -> *) a.
(Alternative m, MonadState Analysis m) =>
HieAST a -> m ()
analysePatternSynonyms HieAST Int
n
          ] [MaybeT m ()] -> [MaybeT m ()] -> [MaybeT m ()]
forall a. [a] -> [a] -> [a]
++ if Bool
unusedTypes then
          [ HieAST Int -> MaybeT m ()
forall (m :: * -> *) a.
(Alternative m, MonadState Analysis m) =>
HieAST a -> m ()
analyseTypeSynonym HieAST Int
n
          , HieAST Int -> MaybeT m ()
forall (m :: * -> *) a.
(Alternative m, MonadState Analysis m) =>
HieAST a -> m ()
analyseFamilyDeclaration HieAST Int
n
          , HieAST Int -> MaybeT m ()
forall (m :: * -> *) a.
(Alternative m, MonadState Analysis m) =>
HieAST a -> m ()
analyseFamilyInstance HieAST Int
n
          , HieAST Int -> MaybeT m ()
forall (m :: * -> *) a.
(Alternative m, MonadState Analysis m) =>
HieAST a -> m ()
analyseTypeSignature HieAST Int
n
          ] else []
      )

  case Maybe ()
analysed of
    Maybe ()
Nothing ->
      -- We didn't find a top level declaration here, check all this nodes
      -- children.
      (HieAST Int -> m ()) -> [HieAST Int] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ HieAST Int -> m ()
forall (m :: * -> *).
(MonadState Analysis m, MonadReader AnalysisInfo m) =>
HieAST Int -> m ()
topLevelAnalysis [HieAST Int]
nodeChildren

    Just () ->
      -- Top level analysis succeeded, there's nothing more to do for this node.
      () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


annsContain :: HieAST a -> (String, String) -> Bool
annsContain :: forall a. HieAST a -> (FilePath, FilePath) -> Bool
annsContain Node{ SourcedNodeInfo a
sourcedNodeInfo :: forall a. HieAST a -> SourcedNodeInfo a
sourcedNodeInfo :: SourcedNodeInfo a
sourcedNodeInfo } (FilePath, FilePath)
ann =
  (NodeInfo a -> Bool) -> Map NodeOrigin (NodeInfo a) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((FilePath, FilePath) -> Set (FilePath, FilePath) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (FilePath, FilePath)
ann (Set (FilePath, FilePath) -> Bool)
-> (NodeInfo a -> Set (FilePath, FilePath)) -> NodeInfo a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeAnnotation -> (FilePath, FilePath))
-> Set NodeAnnotation -> Set (FilePath, FilePath)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map NodeAnnotation -> (FilePath, FilePath)
unNodeAnnotation (Set NodeAnnotation -> Set (FilePath, FilePath))
-> (NodeInfo a -> Set NodeAnnotation)
-> NodeInfo a
-> Set (FilePath, FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo a -> Set NodeAnnotation
forall a. NodeInfo a -> Set NodeAnnotation
nodeAnnotations) (Map NodeOrigin (NodeInfo a) -> Bool)
-> Map NodeOrigin (NodeInfo a) -> Bool
forall a b. (a -> b) -> a -> b
$ SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo SourcedNodeInfo a
sourcedNodeInfo


analyseBinding :: ( Alternative m, MonadState Analysis m, MonadReader AnalysisInfo m ) => HieAST a -> m ()
analyseBinding :: forall (m :: * -> *) a.
(Alternative m, MonadState Analysis m,
 MonadReader AnalysisInfo m) =>
HieAST a -> m ()
analyseBinding n :: HieAST a
n@Node{ RealSrcSpan
nodeSpan :: forall a. HieAST a -> RealSrcSpan
nodeSpan :: RealSrcSpan
nodeSpan } = do
  let bindAnns :: Set (FilePath, FilePath)
bindAnns = [(FilePath, FilePath)] -> Set (FilePath, FilePath)
forall a. Ord a => [a] -> Set a
Set.fromList [(FilePath
"FunBind", FilePath
"HsBindLR"), (FilePath
"PatBind", FilePath
"HsBindLR")]
  Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ ((FilePath, FilePath) -> Bool) -> Set (FilePath, FilePath) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (HieAST a -> (FilePath, FilePath) -> Bool
forall a. HieAST a -> (FilePath, FilePath) -> Bool
annsContain HieAST a
n) Set (FilePath, FilePath)
bindAnns

  Seq Declaration -> (Declaration -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ( HieAST a -> Seq Declaration
forall a. HieAST a -> Seq Declaration
findDeclarations HieAST a
n ) \Declaration
d -> do
    Declaration -> RealSrcSpan -> m ()
forall (m :: * -> *).
MonadState Analysis m =>
Declaration -> RealSrcSpan -> m ()
define Declaration
d RealSrcSpan
nodeSpan

    HieAST a -> Declaration -> m ()
forall (m :: * -> *) a.
(MonadState Analysis m, MonadReader AnalysisInfo m) =>
HieAST a -> Declaration -> m ()
requestEvidence HieAST a
n Declaration
d

    Set Declaration -> (Declaration -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ( HieAST a -> Set Declaration
forall a. HieAST a -> Set Declaration
uses HieAST a
n ) ((Declaration -> m ()) -> m ()) -> (Declaration -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Declaration -> Declaration -> m ()
forall (m :: * -> *).
MonadState Analysis m =>
Declaration -> Declaration -> m ()
addDependency Declaration
d


analyseRewriteRule :: ( Alternative m, MonadState Analysis m ) => HieAST a -> m ()
analyseRewriteRule :: forall (m :: * -> *) a.
(Alternative m, MonadState Analysis m) =>
HieAST a -> m ()
analyseRewriteRule HieAST a
n = do
  Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ HieAST a -> (FilePath, FilePath) -> Bool
forall a. HieAST a -> (FilePath, FilePath) -> Bool
annsContain HieAST a
n (FilePath
"HsRule", FilePath
"RuleDecl")

  Set Declaration -> (Declaration -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ( HieAST a -> Set Declaration
forall a. HieAST a -> Set Declaration
uses HieAST a
n ) Declaration -> m ()
forall (m :: * -> *). MonadState Analysis m => Declaration -> m ()
addImplicitRoot


analyseInstanceDeclaration :: ( Alternative m, MonadState Analysis m, MonadReader AnalysisInfo m ) => HieAST TypeIndex -> m ()
analyseInstanceDeclaration :: forall (m :: * -> *).
(Alternative m, MonadState Analysis m,
 MonadReader AnalysisInfo m) =>
HieAST Int -> m ()
analyseInstanceDeclaration n :: HieAST Int
n@Node{ RealSrcSpan
nodeSpan :: forall a. HieAST a -> RealSrcSpan
nodeSpan :: RealSrcSpan
nodeSpan } = do
  Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ HieAST Int -> (FilePath, FilePath) -> Bool
forall a. HieAST a -> (FilePath, FilePath) -> Bool
annsContain HieAST Int
n (FilePath
"ClsInstD", FilePath
"InstDecl")

  Seq (Declaration, Set Name, IdentifierDetails Int, HieAST Int)
-> ((Declaration, Set Name, IdentifierDetails Int, HieAST Int)
    -> m ())
-> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ( HieAST Int
-> Seq (Declaration, Set Name, IdentifierDetails Int, HieAST Int)
forall a.
HieAST a
-> Seq (Declaration, Set Name, IdentifierDetails a, HieAST a)
findEvInstBinds HieAST Int
n ) \(Declaration
d, Set Name
cs, IdentifierDetails Int
ids, HieAST Int
_) -> do
    -- This makes instance declarations show up in 
    -- the output if type-class-roots is set to False.
    Declaration -> RealSrcSpan -> m ()
forall (m :: * -> *).
MonadState Analysis m =>
Declaration -> RealSrcSpan -> m ()
define Declaration
d RealSrcSpan
nodeSpan

    HieAST Int -> Declaration -> m ()
forall (m :: * -> *) a.
(MonadState Analysis m, MonadReader AnalysisInfo m) =>
HieAST a -> Declaration -> m ()
requestEvidence HieAST Int
n Declaration
d

    Set Declaration -> (Declaration -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ( HieAST Int -> Set Declaration
forall a. HieAST a -> Set Declaration
uses HieAST Int
n ) ((Declaration -> m ()) -> m ()) -> (Declaration -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Declaration -> Declaration -> m ()
forall (m :: * -> *).
MonadState Analysis m =>
Declaration -> Declaration -> m ()
addDependency Declaration
d

    case IdentifierDetails Int -> Maybe Int
forall a. IdentifierDetails a -> Maybe a
identType IdentifierDetails Int
ids of
      Just Int
t -> Set Name -> (Name -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Set Name
cs (Declaration -> Int -> Name -> m ()
forall (m :: * -> *).
(MonadState Analysis m, MonadReader AnalysisInfo m) =>
Declaration -> Int -> Name -> m ()
addInstanceRoot Declaration
d Int
t)
      Maybe Int
Nothing -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


analyseClassDeclaration :: ( Alternative m, MonadState Analysis m, MonadReader AnalysisInfo m ) => HieAST a -> m ()
analyseClassDeclaration :: forall (m :: * -> *) a.
(Alternative m, MonadState Analysis m,
 MonadReader AnalysisInfo m) =>
HieAST a -> m ()
analyseClassDeclaration n :: HieAST a
n@Node{ RealSrcSpan
nodeSpan :: forall a. HieAST a -> RealSrcSpan
nodeSpan :: RealSrcSpan
nodeSpan } = do
  Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ HieAST a -> (FilePath, FilePath) -> Bool
forall a. HieAST a -> (FilePath, FilePath) -> Bool
annsContain HieAST a
n (FilePath
"ClassDecl", FilePath
"TyClDecl")

  Seq Declaration -> (Declaration -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ( (Set ContextInfo -> Bool) -> HieAST a -> Seq Declaration
forall a. (Set ContextInfo -> Bool) -> HieAST a -> Seq Declaration
findIdentifiers Set ContextInfo -> Bool
isClassDeclaration HieAST a
n ) ((Declaration -> m ()) -> m ()) -> (Declaration -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Declaration
d -> do
    Declaration -> RealSrcSpan -> m ()
forall (m :: * -> *).
MonadState Analysis m =>
Declaration -> RealSrcSpan -> m ()
define Declaration
d RealSrcSpan
nodeSpan

    HieAST a -> Declaration -> m ()
forall (m :: * -> *) a.
(MonadState Analysis m, MonadReader AnalysisInfo m) =>
HieAST a -> Declaration -> m ()
requestEvidence HieAST a
n Declaration
d

    (Seq Declaration -> (Declaration -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ( (Set ContextInfo -> Bool) -> HieAST a -> Seq Declaration
forall a. (Set ContextInfo -> Bool) -> HieAST a -> Seq Declaration
findIdentifiers ( Bool -> Set ContextInfo -> Bool
forall a b. a -> b -> a
const Bool
True ) HieAST a
n ) ((Declaration -> m ()) -> m ())
-> (Declaration -> Declaration -> m ()) -> Declaration -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Declaration -> Declaration -> m ()
forall (m :: * -> *).
MonadState Analysis m =>
Declaration -> Declaration -> m ()
addDependency) Declaration
d

  where

    isClassDeclaration :: Set ContextInfo -> Bool
isClassDeclaration =
      Bool -> Bool
not (Bool -> Bool)
-> (Set ContextInfo -> Bool) -> Set ContextInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set ContextInfo -> Bool
forall a. Set a -> Bool
Set.null (Set ContextInfo -> Bool)
-> (Set ContextInfo -> Set ContextInfo) -> Set ContextInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContextInfo -> Bool) -> Set ContextInfo -> Set ContextInfo
forall a. (a -> Bool) -> Set a -> Set a
Set.filter \case
        Decl DeclType
ClassDec Maybe RealSrcSpan
_ ->
          Bool
True

        ContextInfo
_ ->
          Bool
False


analyseDataDeclaration :: ( Alternative m, MonadState Analysis m, MonadReader AnalysisInfo m ) => HieAST TypeIndex -> m ()
analyseDataDeclaration :: forall (m :: * -> *).
(Alternative m, MonadState Analysis m,
 MonadReader AnalysisInfo m) =>
HieAST Int -> m ()
analyseDataDeclaration HieAST Int
n = do
  Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ HieAST Int -> (FilePath, FilePath) -> Bool
forall a. HieAST a -> (FilePath, FilePath) -> Bool
annsContain HieAST Int
n (FilePath
"DataDecl", FilePath
"TyClDecl")

  Config{ Bool
unusedTypes :: forall a. ConfigType a -> Bool
unusedTypes :: Bool
unusedTypes } <- (AnalysisInfo -> Config) -> m Config
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks AnalysisInfo -> Config
weederConfig

  First Declaration -> (Declaration -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_
    ( (Declaration -> First Declaration)
-> Seq Declaration -> First Declaration
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
        ( Maybe Declaration -> First Declaration
forall a. Maybe a -> First a
First (Maybe Declaration -> First Declaration)
-> (Declaration -> Maybe Declaration)
-> Declaration
-> First Declaration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Declaration -> Maybe Declaration
forall a. a -> Maybe a
Just )
        ( (Set ContextInfo -> Bool) -> HieAST Int -> Seq Declaration
forall a. (Set ContextInfo -> Bool) -> HieAST a -> Seq Declaration
findIdentifiers ( (ContextInfo -> Bool) -> Set ContextInfo -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ContextInfo -> Bool
isDataDec ) HieAST Int
n )
    )
    \Declaration
dataTypeName -> do
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
unusedTypes (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        Declaration -> RealSrcSpan -> m ()
forall (m :: * -> *).
MonadState Analysis m =>
Declaration -> RealSrcSpan -> m ()
define Declaration
dataTypeName (HieAST Int -> RealSrcSpan
forall a. HieAST a -> RealSrcSpan
nodeSpan HieAST Int
n)

      -- Without connecting constructors to the data declaration TypeAliasGADT.hs 
      -- fails with a false positive for A
      Seq (First Declaration)
conDecs <- Seq (HieAST Int)
-> (HieAST Int -> m (First Declaration))
-> m (Seq (First Declaration))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for ( HieAST Int -> Seq (HieAST Int)
forall a. HieAST a -> Seq (HieAST a)
constructors HieAST Int
n ) \HieAST Int
constructor ->
        First Declaration
-> (Declaration -> m Declaration) -> m (First Declaration)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for ( (Declaration -> First Declaration)
-> Seq Declaration -> First Declaration
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ( Maybe Declaration -> First Declaration
forall a. Maybe a -> First a
First (Maybe Declaration -> First Declaration)
-> (Declaration -> Maybe Declaration)
-> Declaration
-> First Declaration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Declaration -> Maybe Declaration
forall a. a -> Maybe a
Just ) ( (Set ContextInfo -> Bool) -> HieAST Int -> Seq Declaration
forall a. (Set ContextInfo -> Bool) -> HieAST a -> Seq Declaration
findIdentifiers ( (ContextInfo -> Bool) -> Set ContextInfo -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ContextInfo -> Bool
isConDec ) HieAST Int
constructor ) ) \Declaration
conDec -> do
          Declaration -> Declaration -> m ()
forall (m :: * -> *).
MonadState Analysis m =>
Declaration -> Declaration -> m ()
addDependency Declaration
conDec Declaration
dataTypeName
          pure Declaration
conDec

      -- To keep acyclicity in record declarations
      let isDependent :: Declaration -> Bool
isDependent Declaration
d = Declaration -> Maybe Declaration
forall a. a -> Maybe a
Just Declaration
d Maybe Declaration -> Seq (Maybe Declaration) -> Bool
forall a. Eq a => a -> Seq a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (First Declaration -> Maybe Declaration)
-> Seq (First Declaration) -> Seq (Maybe Declaration)
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap First Declaration -> Maybe Declaration
forall a. First a -> Maybe a
getFirst Seq (First Declaration)
conDecs

      Set Declaration -> (Declaration -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ( HieAST Int -> Set Declaration
forall a. HieAST a -> Set Declaration
uses HieAST Int
n ) (\Declaration
d -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Declaration -> Bool
isDependent Declaration
d) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Declaration -> Declaration -> m ()
forall (m :: * -> *).
MonadState Analysis m =>
Declaration -> Declaration -> m ()
addDependency Declaration
dataTypeName Declaration
d)

  Seq (Declaration, Set Name, IdentifierDetails Int, HieAST Int)
-> ((Declaration, Set Name, IdentifierDetails Int, HieAST Int)
    -> m ())
-> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ( HieAST Int
-> Seq (Declaration, Set Name, IdentifierDetails Int, HieAST Int)
forall a.
HieAST a
-> Seq (Declaration, Set Name, IdentifierDetails a, HieAST a)
derivedInstances HieAST Int
n ) \(Declaration
d, Set Name
cs, IdentifierDetails Int
ids, HieAST Int
ast) -> do
    Declaration -> RealSrcSpan -> m ()
forall (m :: * -> *).
MonadState Analysis m =>
Declaration -> RealSrcSpan -> m ()
define Declaration
d (HieAST Int -> RealSrcSpan
forall a. HieAST a -> RealSrcSpan
nodeSpan HieAST Int
ast)

    HieAST Int -> Declaration -> m ()
forall (m :: * -> *) a.
(MonadState Analysis m, MonadReader AnalysisInfo m) =>
HieAST a -> Declaration -> m ()
requestEvidence HieAST Int
ast Declaration
d

    Set Declaration -> (Declaration -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ( HieAST Int -> Set Declaration
forall a. HieAST a -> Set Declaration
uses HieAST Int
ast ) ((Declaration -> m ()) -> m ()) -> (Declaration -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Declaration -> Declaration -> m ()
forall (m :: * -> *).
MonadState Analysis m =>
Declaration -> Declaration -> m ()
addDependency Declaration
d

    case IdentifierDetails Int -> Maybe Int
forall a. IdentifierDetails a -> Maybe a
identType IdentifierDetails Int
ids of
      Just Int
t -> Set Name -> (Name -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Set Name
cs (Declaration -> Int -> Name -> m ()
forall (m :: * -> *).
(MonadState Analysis m, MonadReader AnalysisInfo m) =>
Declaration -> Int -> Name -> m ()
addInstanceRoot Declaration
d Int
t)
      Maybe Int
Nothing -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  where

    isDataDec :: ContextInfo -> Bool
isDataDec = \case
      Decl DeclType
DataDec Maybe RealSrcSpan
_ -> Bool
True
      ContextInfo
_              -> Bool
False

    isConDec :: ContextInfo -> Bool
isConDec = \case
      Decl DeclType
ConDec Maybe RealSrcSpan
_ -> Bool
True
      ContextInfo
_             -> Bool
False


constructors :: HieAST a -> Seq ( HieAST a )
constructors :: forall a. HieAST a -> Seq (HieAST a)
constructors = FilePath -> HieAST a -> Seq (HieAST a)
forall a. FilePath -> HieAST a -> Seq (HieAST a)
findNodeTypes FilePath
"ConDecl"


derivedInstances :: HieAST a -> Seq (Declaration, Set Name, IdentifierDetails a, HieAST a)
derivedInstances :: forall a.
HieAST a
-> Seq (Declaration, Set Name, IdentifierDetails a, HieAST a)
derivedInstances HieAST a
n = FilePath -> HieAST a -> Seq (HieAST a)
forall a. FilePath -> HieAST a -> Seq (HieAST a)
findNodeTypes FilePath
"HsDerivingClause" HieAST a
n Seq (HieAST a)
-> (HieAST a
    -> Seq (Declaration, Set Name, IdentifierDetails a, HieAST a))
-> Seq (Declaration, Set Name, IdentifierDetails a, HieAST a)
forall a b. Seq a -> (a -> Seq b) -> Seq b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HieAST a
-> Seq (Declaration, Set Name, IdentifierDetails a, HieAST a)
forall a.
HieAST a
-> Seq (Declaration, Set Name, IdentifierDetails a, HieAST a)
findEvInstBinds


findNodeTypes :: String -> HieAST a -> Seq ( HieAST a )
findNodeTypes :: forall a. FilePath -> HieAST a -> Seq (HieAST a)
findNodeTypes FilePath
t n :: HieAST a
n@Node{ [HieAST a]
nodeChildren :: forall a. HieAST a -> [HieAST a]
nodeChildren :: [HieAST a]
nodeChildren, SourcedNodeInfo a
sourcedNodeInfo :: forall a. HieAST a -> SourcedNodeInfo a
sourcedNodeInfo :: SourcedNodeInfo a
sourcedNodeInfo } =
  if (NodeInfo a -> Bool) -> Map NodeOrigin (NodeInfo a) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((NodeAnnotation -> Bool) -> Set NodeAnnotation -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ( (FilePath
t FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
==) (FilePath -> Bool)
-> (NodeAnnotation -> FilePath) -> NodeAnnotation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> FilePath
unpackFS (FastString -> FilePath)
-> (NodeAnnotation -> FastString) -> NodeAnnotation -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeAnnotation -> FastString
nodeAnnotType) (Set NodeAnnotation -> Bool)
-> (NodeInfo a -> Set NodeAnnotation) -> NodeInfo a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo a -> Set NodeAnnotation
forall a. NodeInfo a -> Set NodeAnnotation
nodeAnnotations) (SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo SourcedNodeInfo a
sourcedNodeInfo) then
    HieAST a -> Seq (HieAST a)
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HieAST a
n

  else
    (HieAST a -> Seq (HieAST a)) -> [HieAST a] -> Seq (HieAST a)
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (FilePath -> HieAST a -> Seq (HieAST a)
forall a. FilePath -> HieAST a -> Seq (HieAST a)
findNodeTypes FilePath
t) [HieAST a]
nodeChildren


analyseStandaloneDeriving :: ( Alternative m, MonadState Analysis m, MonadReader AnalysisInfo m ) => HieAST TypeIndex -> m ()
analyseStandaloneDeriving :: forall (m :: * -> *).
(Alternative m, MonadState Analysis m,
 MonadReader AnalysisInfo m) =>
HieAST Int -> m ()
analyseStandaloneDeriving n :: HieAST Int
n@Node{ RealSrcSpan
nodeSpan :: forall a. HieAST a -> RealSrcSpan
nodeSpan :: RealSrcSpan
nodeSpan } = do
  Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ HieAST Int -> (FilePath, FilePath) -> Bool
forall a. HieAST a -> (FilePath, FilePath) -> Bool
annsContain HieAST Int
n (FilePath
"DerivDecl", FilePath
"DerivDecl")

  Seq (Declaration, Set Name, IdentifierDetails Int, HieAST Int)
-> ((Declaration, Set Name, IdentifierDetails Int, HieAST Int)
    -> m ())
-> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (HieAST Int
-> Seq (Declaration, Set Name, IdentifierDetails Int, HieAST Int)
forall a.
HieAST a
-> Seq (Declaration, Set Name, IdentifierDetails a, HieAST a)
findEvInstBinds HieAST Int
n) \(Declaration
d, Set Name
cs, IdentifierDetails Int
ids, HieAST Int
_) -> do
    Declaration -> RealSrcSpan -> m ()
forall (m :: * -> *).
MonadState Analysis m =>
Declaration -> RealSrcSpan -> m ()
define Declaration
d RealSrcSpan
nodeSpan

    HieAST Int -> Declaration -> m ()
forall (m :: * -> *) a.
(MonadState Analysis m, MonadReader AnalysisInfo m) =>
HieAST a -> Declaration -> m ()
requestEvidence HieAST Int
n Declaration
d

    Set Declaration -> (Declaration -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (HieAST Int -> Set Declaration
forall a. HieAST a -> Set Declaration
uses HieAST Int
n) ((Declaration -> m ()) -> m ()) -> (Declaration -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Declaration -> Declaration -> m ()
forall (m :: * -> *).
MonadState Analysis m =>
Declaration -> Declaration -> m ()
addDependency Declaration
d

    case IdentifierDetails Int -> Maybe Int
forall a. IdentifierDetails a -> Maybe a
identType IdentifierDetails Int
ids of
      Just Int
t -> Set Name -> (Name -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Set Name
cs (Declaration -> Int -> Name -> m ()
forall (m :: * -> *).
(MonadState Analysis m, MonadReader AnalysisInfo m) =>
Declaration -> Int -> Name -> m ()
addInstanceRoot Declaration
d Int
t)
      Maybe Int
Nothing -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


analyseTypeSynonym :: ( Alternative m, MonadState Analysis m ) => HieAST a -> m ()
analyseTypeSynonym :: forall (m :: * -> *) a.
(Alternative m, MonadState Analysis m) =>
HieAST a -> m ()
analyseTypeSynonym n :: HieAST a
n@Node{ RealSrcSpan
nodeSpan :: forall a. HieAST a -> RealSrcSpan
nodeSpan :: RealSrcSpan
nodeSpan } = do
  Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ HieAST a -> (FilePath, FilePath) -> Bool
forall a. HieAST a -> (FilePath, FilePath) -> Bool
annsContain HieAST a
n (FilePath
"SynDecl", FilePath
"TyClDecl")

  Seq Declaration -> (Declaration -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ( (Set ContextInfo -> Bool) -> HieAST a -> Seq Declaration
forall a. (Set ContextInfo -> Bool) -> HieAST a -> Seq Declaration
findIdentifiers Set ContextInfo -> Bool
isTypeSynonym HieAST a
n ) ((Declaration -> m ()) -> m ()) -> (Declaration -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Declaration
d -> do
    Declaration -> RealSrcSpan -> m ()
forall (m :: * -> *).
MonadState Analysis m =>
Declaration -> RealSrcSpan -> m ()
define Declaration
d RealSrcSpan
nodeSpan

    Set Declaration -> (Declaration -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (HieAST a -> Set Declaration
forall a. HieAST a -> Set Declaration
uses HieAST a
n) (Declaration -> Declaration -> m ()
forall (m :: * -> *).
MonadState Analysis m =>
Declaration -> Declaration -> m ()
addDependency Declaration
d)

  where

    isTypeSynonym :: Set ContextInfo -> Bool
isTypeSynonym =
      (ContextInfo -> Bool) -> Set ContextInfo -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any \case
        Decl DeclType
SynDec Maybe RealSrcSpan
_ -> Bool
True
        ContextInfo
_             -> Bool
False


analyseFamilyDeclaration :: ( Alternative m, MonadState Analysis m ) => HieAST a -> m ()
analyseFamilyDeclaration :: forall (m :: * -> *) a.
(Alternative m, MonadState Analysis m) =>
HieAST a -> m ()
analyseFamilyDeclaration n :: HieAST a
n@Node{ RealSrcSpan
nodeSpan :: forall a. HieAST a -> RealSrcSpan
nodeSpan :: RealSrcSpan
nodeSpan } = do
  Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ HieAST a -> (FilePath, FilePath) -> Bool
forall a. HieAST a -> (FilePath, FilePath) -> Bool
annsContain HieAST a
n (FilePath
"FamDecl", FilePath
"TyClDecl")

  Seq Declaration -> (Declaration -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ( (Set ContextInfo -> Bool) -> HieAST a -> Seq Declaration
forall a. (Set ContextInfo -> Bool) -> HieAST a -> Seq Declaration
findIdentifiers Set ContextInfo -> Bool
isFamDec HieAST a
n ) ((Declaration -> m ()) -> m ()) -> (Declaration -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Declaration
d -> do
    Declaration -> RealSrcSpan -> m ()
forall (m :: * -> *).
MonadState Analysis m =>
Declaration -> RealSrcSpan -> m ()
define Declaration
d RealSrcSpan
nodeSpan

    Set Declaration -> (Declaration -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (HieAST a -> Set Declaration
forall a. HieAST a -> Set Declaration
uses HieAST a
n) (Declaration -> Declaration -> m ()
forall (m :: * -> *).
MonadState Analysis m =>
Declaration -> Declaration -> m ()
addDependency Declaration
d)

  where

    isFamDec :: Set ContextInfo -> Bool
isFamDec =
      (ContextInfo -> Bool) -> Set ContextInfo -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any \case
        Decl DeclType
FamDec Maybe RealSrcSpan
_ -> Bool
True
        ContextInfo
_             -> Bool
False


analyseFamilyInstance :: ( Alternative m, MonadState Analysis m ) => HieAST a -> m ()
analyseFamilyInstance :: forall (m :: * -> *) a.
(Alternative m, MonadState Analysis m) =>
HieAST a -> m ()
analyseFamilyInstance HieAST a
n = do
  Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ HieAST a -> (FilePath, FilePath) -> Bool
forall a. HieAST a -> (FilePath, FilePath) -> Bool
annsContain HieAST a
n (FilePath
"TyFamInstD", FilePath
"InstDecl")

  Set Declaration -> (Declaration -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ( HieAST a -> Set Declaration
forall a. HieAST a -> Set Declaration
uses HieAST a
n ) Declaration -> m ()
forall (m :: * -> *). MonadState Analysis m => Declaration -> m ()
addImplicitRoot


analyseTypeSignature :: ( Alternative m, MonadState Analysis m ) => HieAST a -> m ()
analyseTypeSignature :: forall (m :: * -> *) a.
(Alternative m, MonadState Analysis m) =>
HieAST a -> m ()
analyseTypeSignature HieAST a
n = do
  Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ HieAST a -> (FilePath, FilePath) -> Bool
forall a. HieAST a -> (FilePath, FilePath) -> Bool
annsContain HieAST a
n (FilePath
"TypeSig", FilePath
"Sig")

  Seq Declaration -> (Declaration -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ((Set ContextInfo -> Bool) -> HieAST a -> Seq Declaration
forall a. (Set ContextInfo -> Bool) -> HieAST a -> Seq Declaration
findIdentifiers Set ContextInfo -> Bool
isTypeSigDecl HieAST a
n) ((Declaration -> m ()) -> m ()) -> (Declaration -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$
    Set Declaration -> (Declaration -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ( HieAST a -> Set Declaration
forall a. HieAST a -> Set Declaration
uses HieAST a
n ) ((Declaration -> m ()) -> m ())
-> (Declaration -> Declaration -> m ()) -> Declaration -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Declaration -> Declaration -> m ()
forall (m :: * -> *).
MonadState Analysis m =>
Declaration -> Declaration -> m ()
addDependency

  where

    isTypeSigDecl :: Set ContextInfo -> Bool
isTypeSigDecl =
      (ContextInfo -> Bool) -> Set ContextInfo -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any \case
        ContextInfo
TyDecl -> Bool
True
        ContextInfo
_      -> Bool
False


analysePatternSynonyms :: ( Alternative m, MonadState Analysis m ) => HieAST a -> m ()
analysePatternSynonyms :: forall (m :: * -> *) a.
(Alternative m, MonadState Analysis m) =>
HieAST a -> m ()
analysePatternSynonyms HieAST a
n = do
  Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ HieAST a -> (FilePath, FilePath) -> Bool
forall a. HieAST a -> (FilePath, FilePath) -> Bool
annsContain HieAST a
n (FilePath
"PatSynBind", FilePath
"HsBindLR")

  Seq Declaration -> (Declaration -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ( HieAST a -> Seq Declaration
forall a. HieAST a -> Seq Declaration
findDeclarations HieAST a
n ) ((Declaration -> m ()) -> m ()) -> (Declaration -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Set Declaration -> (Declaration -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ( HieAST a -> Set Declaration
forall a. HieAST a -> Set Declaration
uses HieAST a
n ) ((Declaration -> m ()) -> m ())
-> (Declaration -> Declaration -> m ()) -> Declaration -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Declaration -> Declaration -> m ()
forall (m :: * -> *).
MonadState Analysis m =>
Declaration -> Declaration -> m ()
addDependency


findEvInstBinds :: HieAST a -> Seq (Declaration, Set Name, IdentifierDetails a, HieAST a)
findEvInstBinds :: forall a.
HieAST a
-> Seq (Declaration, Set Name, IdentifierDetails a, HieAST a)
findEvInstBinds HieAST a
n = (\(Declaration
d, IdentifierDetails a
ids, HieAST a
ast) -> (Declaration
d, IdentifierDetails a -> Set Name
forall a. IdentifierDetails a -> Set Name
getClassNames IdentifierDetails a
ids, IdentifierDetails a
ids, HieAST a
ast)) ((Declaration, IdentifierDetails a, HieAST a)
 -> (Declaration, Set Name, IdentifierDetails a, HieAST a))
-> Seq (Declaration, IdentifierDetails a, HieAST a)
-> Seq (Declaration, Set Name, IdentifierDetails a, HieAST a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  (Set ContextInfo -> Bool)
-> HieAST a -> Seq (Declaration, IdentifierDetails a, HieAST a)
forall a.
(Set ContextInfo -> Bool)
-> HieAST a -> Seq (Declaration, IdentifierDetails a, HieAST a)
findIdentifiers'
    (   Bool -> Bool
not
      (Bool -> Bool)
-> (Set ContextInfo -> Bool) -> Set ContextInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set EvVarSource -> Bool
forall a. Set a -> Bool
Set.null
      (Set EvVarSource -> Bool)
-> (Set ContextInfo -> Set EvVarSource) -> Set ContextInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set ContextInfo -> Set EvVarSource
getEvVarSources
    ) HieAST a
n

  where

    getEvVarSources :: Set ContextInfo -> Set EvVarSource
    getEvVarSources :: Set ContextInfo -> Set EvVarSource
getEvVarSources = (Maybe EvVarSource -> Set EvVarSource)
-> Set (Maybe EvVarSource) -> Set EvVarSource
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Set EvVarSource
-> (EvVarSource -> Set EvVarSource)
-> Maybe EvVarSource
-> Set EvVarSource
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set EvVarSource
forall a. Monoid a => a
mempty EvVarSource -> Set EvVarSource
forall a. a -> Set a
Set.singleton) (Set (Maybe EvVarSource) -> Set EvVarSource)
-> (Set ContextInfo -> Set (Maybe EvVarSource))
-> Set ContextInfo
-> Set EvVarSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      (ContextInfo -> Maybe EvVarSource)
-> Set ContextInfo -> Set (Maybe EvVarSource)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map \case
        EvidenceVarBind a :: EvVarSource
a@EvInstBind{} Scope
ModuleScope Maybe RealSrcSpan
_ -> EvVarSource -> Maybe EvVarSource
forall a. a -> Maybe a
Just EvVarSource
a
        ContextInfo
_ -> Maybe EvVarSource
forall a. Maybe a
Nothing

    getClassNames :: IdentifierDetails a -> Set Name
    getClassNames :: forall a. IdentifierDetails a -> Set Name
getClassNames =
      (EvVarSource -> Name) -> Set EvVarSource -> Set Name
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map EvVarSource -> Name
cls
      (Set EvVarSource -> Set Name)
-> (IdentifierDetails a -> Set EvVarSource)
-> IdentifierDetails a
-> Set Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set ContextInfo -> Set EvVarSource
getEvVarSources
      (Set ContextInfo -> Set EvVarSource)
-> (IdentifierDetails a -> Set ContextInfo)
-> IdentifierDetails a
-> Set EvVarSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentifierDetails a -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo


findDeclarations :: HieAST a -> Seq Declaration
findDeclarations :: forall a. HieAST a -> Seq Declaration
findDeclarations =
  (Set ContextInfo -> Bool) -> HieAST a -> Seq Declaration
forall a. (Set ContextInfo -> Bool) -> HieAST a -> Seq Declaration
findIdentifiers
    (   Bool -> Bool
not
      (Bool -> Bool)
-> (Set ContextInfo -> Bool) -> Set ContextInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set ContextInfo -> Bool
forall a. Set a -> Bool
Set.null
      (Set ContextInfo -> Bool)
-> (Set ContextInfo -> Set ContextInfo) -> Set ContextInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContextInfo -> Bool) -> Set ContextInfo -> Set ContextInfo
forall a. (a -> Bool) -> Set a -> Set a
Set.filter \case
          -- Things that count as declarations
          ValBind BindType
RegularBind Scope
ModuleScope Maybe RealSrcSpan
_ -> Bool
True
          PatternBind Scope
ModuleScope Scope
_ Maybe RealSrcSpan
_       -> Bool
True
          Decl DeclType
_ Maybe RealSrcSpan
_                          -> Bool
True
          ContextInfo
TyDecl                            -> Bool
True
          ClassTyDecl{}                     -> Bool
True

          -- Anything else is not a declaration
          ContextInfo
_ -> Bool
False
    )


findIdentifiers
  :: ( Set ContextInfo -> Bool )
  -> HieAST a
  -> Seq Declaration
findIdentifiers :: forall a. (Set ContextInfo -> Bool) -> HieAST a -> Seq Declaration
findIdentifiers Set ContextInfo -> Bool
f = ((Declaration, IdentifierDetails a, HieAST a) -> Declaration)
-> Seq (Declaration, IdentifierDetails a, HieAST a)
-> Seq Declaration
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Declaration
d, IdentifierDetails a
_, HieAST a
_) -> Declaration
d) (Seq (Declaration, IdentifierDetails a, HieAST a)
 -> Seq Declaration)
-> (HieAST a -> Seq (Declaration, IdentifierDetails a, HieAST a))
-> HieAST a
-> Seq Declaration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set ContextInfo -> Bool)
-> HieAST a -> Seq (Declaration, IdentifierDetails a, HieAST a)
forall a.
(Set ContextInfo -> Bool)
-> HieAST a -> Seq (Declaration, IdentifierDetails a, HieAST a)
findIdentifiers' Set ContextInfo -> Bool
f


-- | Version of findIdentifiers containing more information,
-- namely the IdentifierDetails of the declaration and the
-- node it was found in.
findIdentifiers'
  :: ( Set ContextInfo -> Bool )
  -> HieAST a
  -> Seq (Declaration, IdentifierDetails a, HieAST a)
findIdentifiers' :: forall a.
(Set ContextInfo -> Bool)
-> HieAST a -> Seq (Declaration, IdentifierDetails a, HieAST a)
findIdentifiers' Set ContextInfo -> Bool
f n :: HieAST a
n@Node{ SourcedNodeInfo a
sourcedNodeInfo :: forall a. HieAST a -> SourcedNodeInfo a
sourcedNodeInfo :: SourcedNodeInfo a
sourcedNodeInfo, [HieAST a]
nodeChildren :: forall a. HieAST a -> [HieAST a]
nodeChildren :: [HieAST a]
nodeChildren } =
     ((Either ModuleName Name, IdentifierDetails a)
 -> Seq (Declaration, IdentifierDetails a, HieAST a))
-> [(Either ModuleName Name, IdentifierDetails a)]
-> Seq (Declaration, IdentifierDetails a, HieAST a)
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
       (\case
           ( Left ModuleName
_, IdentifierDetails a
_ ) ->
             Seq (Declaration, IdentifierDetails a, HieAST a)
forall a. Monoid a => a
mempty

           ( Right Name
name, ids :: IdentifierDetails a
ids@IdentifierDetails{ Set ContextInfo
identInfo :: forall a. IdentifierDetails a -> Set ContextInfo
identInfo :: Set ContextInfo
identInfo } ) ->
             if Set ContextInfo -> Bool
f Set ContextInfo
identInfo then
               (, IdentifierDetails a
ids, HieAST a
n) (Declaration -> (Declaration, IdentifierDetails a, HieAST a))
-> Seq Declaration
-> Seq (Declaration, IdentifierDetails a, HieAST a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Declaration -> Seq Declaration)
-> Maybe Declaration -> Seq Declaration
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Declaration -> Seq Declaration
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Maybe Declaration
nameToDeclaration Name
name)

             else
               Seq (Declaration, IdentifierDetails a, HieAST a)
forall a. Monoid a => a
mempty
           )
       ((NodeInfo a -> [(Either ModuleName Name, IdentifierDetails a)])
-> Map NodeOrigin (NodeInfo a)
-> [(Either ModuleName Name, IdentifierDetails a)]
forall m a. Monoid m => (a -> m) -> Map NodeOrigin a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Map (Either ModuleName Name) (IdentifierDetails a)
-> [(Either ModuleName Name, IdentifierDetails a)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map (Either ModuleName Name) (IdentifierDetails a)
 -> [(Either ModuleName Name, IdentifierDetails a)])
-> (NodeInfo a
    -> Map (Either ModuleName Name) (IdentifierDetails a))
-> NodeInfo a
-> [(Either ModuleName Name, IdentifierDetails a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo a -> Map (Either ModuleName Name) (IdentifierDetails a)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers) (SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo SourcedNodeInfo a
sourcedNodeInfo))
  Seq (Declaration, IdentifierDetails a, HieAST a)
-> Seq (Declaration, IdentifierDetails a, HieAST a)
-> Seq (Declaration, IdentifierDetails a, HieAST a)
forall a. Semigroup a => a -> a -> a
<> (HieAST a -> Seq (Declaration, IdentifierDetails a, HieAST a))
-> [HieAST a] -> Seq (Declaration, IdentifierDetails a, HieAST a)
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ( (Set ContextInfo -> Bool)
-> HieAST a -> Seq (Declaration, IdentifierDetails a, HieAST a)
forall a.
(Set ContextInfo -> Bool)
-> HieAST a -> Seq (Declaration, IdentifierDetails a, HieAST a)
findIdentifiers' Set ContextInfo -> Bool
f ) [HieAST a]
nodeChildren


uses :: HieAST a -> Set Declaration
uses :: forall a. HieAST a -> Set Declaration
uses =
    (Declaration -> Set Declaration)
-> Seq Declaration -> Set Declaration
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Declaration -> Set Declaration
forall a. a -> Set a
Set.singleton
  (Seq Declaration -> Set Declaration)
-> (HieAST a -> Seq Declaration) -> HieAST a -> Set Declaration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set ContextInfo -> Bool) -> HieAST a -> Seq Declaration
forall a. (Set ContextInfo -> Bool) -> HieAST a -> Seq Declaration
findIdentifiers ((ContextInfo -> Bool) -> Set ContextInfo -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ContextInfo -> Bool
isUse)

isUse :: ContextInfo -> Bool
isUse :: ContextInfo -> Bool
isUse = \case
  ContextInfo
Use -> Bool
True
  -- not RecFieldMatch and RecFieldDecl because they occur under
  -- data declarations, which we do not want to add as dependencies
  -- because that would make the graph no longer acyclic
  -- RecFieldAssign will be most likely accompanied by the constructor
  RecField RecFieldContext
RecFieldOcc Maybe RealSrcSpan
_ -> Bool
True
  ContextInfo
_ -> Bool
False


nameToDeclaration :: Name -> Maybe Declaration
nameToDeclaration :: Name -> Maybe Declaration
nameToDeclaration Name
name = do
  Module
m <- Name -> Maybe Module
nameModule_maybe Name
name
  return Declaration { declModule :: Module
declModule = Module
m, declOccName :: OccName
declOccName = Name -> OccName
nameOccName Name
name }


unNodeAnnotation :: NodeAnnotation -> (String, String)
unNodeAnnotation :: NodeAnnotation -> (FilePath, FilePath)
unNodeAnnotation (NodeAnnotation FastString
x FastString
y) = (FastString -> FilePath
unpackFS FastString
x, FastString -> FilePath
unpackFS FastString
y)


-- | Add evidence uses found under the given node to 'requestedEvidence'.
requestEvidence :: ( MonadState Analysis m, MonadReader AnalysisInfo m ) => HieAST a -> Declaration -> m ()
requestEvidence :: forall (m :: * -> *) a.
(MonadState Analysis m, MonadReader AnalysisInfo m) =>
HieAST a -> Declaration -> m ()
requestEvidence HieAST a
n Declaration
d = do
  Config{ Bool
typeClassRoots :: forall a. ConfigType a -> Bool
typeClassRoots :: Bool
typeClassRoots } <- (AnalysisInfo -> Config) -> m Config
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks AnalysisInfo -> Config
weederConfig

  -- If type-class-roots flag is set then we don't need to follow
  -- evidence uses as the binding sites will be roots anyway
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
typeClassRoots (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    #requestedEvidence %= Map.insertWith (<>) d (Set.fromList names)

  where

    names :: [Name]
names = [[Name]] -> [Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Name]] -> [Name])
-> (Tree [Name] -> [[Name]]) -> Tree [Name] -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree [Name] -> [[Name]]
forall a. Tree a -> [a]
Tree.flatten (Tree [Name] -> [Name]) -> Tree [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ HieAST a -> Tree [Name]
forall a. HieAST a -> Tree [Name]
evidenceUseTree HieAST a
n

    evidenceUseTree :: HieAST a -> Tree [Name]
    evidenceUseTree :: forall a. HieAST a -> Tree [Name]
evidenceUseTree Node{ SourcedNodeInfo a
sourcedNodeInfo :: forall a. HieAST a -> SourcedNodeInfo a
sourcedNodeInfo :: SourcedNodeInfo a
sourcedNodeInfo, [HieAST a]
nodeChildren :: forall a. HieAST a -> [HieAST a]
nodeChildren :: [HieAST a]
nodeChildren } = Tree.Node
      { rootLabel :: [Name]
Tree.rootLabel = (NodeInfo a -> [Name]) -> Map NodeOrigin (NodeInfo a) -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (NodeIdentifiers a -> [Name]
forall a. NodeIdentifiers a -> [Name]
findEvidenceUse (NodeIdentifiers a -> [Name])
-> (NodeInfo a -> NodeIdentifiers a) -> NodeInfo a -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo a -> NodeIdentifiers a
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers) (SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo SourcedNodeInfo a
sourcedNodeInfo)
      , subForest :: [Tree [Name]]
Tree.subForest = (HieAST a -> Tree [Name]) -> [HieAST a] -> [Tree [Name]]
forall a b. (a -> b) -> [a] -> [b]
map HieAST a -> Tree [Name]
forall a. HieAST a -> Tree [Name]
evidenceUseTree [HieAST a]
nodeChildren
      }


-- | Follow the given evidence use back to their instance bindings
followEvidenceUses :: RefMap TypeIndex -> Name -> [Declaration]
followEvidenceUses :: RefMap Int -> Name -> [Declaration]
followEvidenceUses RefMap Int
rf Name
name =
  let evidenceInfos :: [EvidenceInfo Int]
evidenceInfos = [EvidenceInfo Int]
-> (Tree (EvidenceInfo Int) -> [EvidenceInfo Int])
-> Maybe (Tree (EvidenceInfo Int))
-> [EvidenceInfo Int]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ([EvidenceInfo Int] -> [EvidenceInfo Int]
forall a. Ord a => [a] -> [a]
nubOrd ([EvidenceInfo Int] -> [EvidenceInfo Int])
-> (Tree (EvidenceInfo Int) -> [EvidenceInfo Int])
-> Tree (EvidenceInfo Int)
-> [EvidenceInfo Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (EvidenceInfo Int) -> [EvidenceInfo Int]
forall a. Tree a -> [a]
Tree.flatten) (RefMap Int -> Name -> Maybe (Tree (EvidenceInfo Int))
forall a. RefMap a -> Name -> Maybe (Tree (EvidenceInfo a))
getEvidenceTree RefMap Int
rf Name
name)
      -- Often, we get duplicates in the flattened evidence trees. Sometimes, it's
      -- just one or two elements and other times there are 5x as many
      instanceEvidenceInfos :: [EvidenceInfo Int]
instanceEvidenceInfos = [EvidenceInfo Int]
evidenceInfos [EvidenceInfo Int]
-> ([EvidenceInfo Int] -> [EvidenceInfo Int]) -> [EvidenceInfo Int]
forall a b. a -> (a -> b) -> b
& (EvidenceInfo Int -> Bool)
-> [EvidenceInfo Int] -> [EvidenceInfo Int]
forall a. (a -> Bool) -> [a] -> [a]
filter \case
        EvidenceInfo Name
_ RealSrcSpan
_ Int
_ (Just (EvInstBind Bool
_ Name
_, Scope
ModuleScope, Maybe RealSrcSpan
_)) -> Bool
True
        EvidenceInfo Int
_ -> Bool
False
  in (EvidenceInfo Int -> Maybe Declaration)
-> [EvidenceInfo Int] -> [Declaration]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Name -> Maybe Declaration
nameToDeclaration (Name -> Maybe Declaration)
-> (EvidenceInfo Int -> Name)
-> EvidenceInfo Int
-> Maybe Declaration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvidenceInfo Int -> Name
forall a. EvidenceInfo a -> Name
evidenceVar) [EvidenceInfo Int]
instanceEvidenceInfos


-- | Follow evidence uses listed under 'requestedEvidence' back to their
-- instance bindings, and connect their corresponding declaration to those bindings.
analyseEvidenceUses :: RefMap TypeIndex -> Analysis -> Analysis
analyseEvidenceUses :: RefMap Int -> Analysis -> Analysis
analyseEvidenceUses RefMap Int
rf a :: Analysis
a@Analysis{ Map Declaration (Set Name)
requestedEvidence :: Analysis -> Map Declaration (Set Name)
requestedEvidence :: Map Declaration (Set Name)
requestedEvidence, Graph Declaration
dependencyGraph :: Analysis -> Graph Declaration
dependencyGraph :: Graph Declaration
dependencyGraph } = do
  let combinedNames :: Set Name
combinedNames = [Set Name] -> Set Name
forall a. Monoid a => [a] -> a
mconcat (Map Declaration (Set Name) -> [Set Name]
forall k a. Map k a -> [a]
Map.elems Map Declaration (Set Name)
requestedEvidence)
      -- We combine all the names in all sets into one set, because the names
      -- are duplicated a lot. In one example, the number of elements in the
      -- combined sizes of all the sets are 16961625 as opposed to the
      -- number of elements by combining all sets into one: 200330, that's an
      -- 80x difference!
      declMap :: Map Name [Declaration]
declMap  = (Name -> [Declaration]) -> Set Name -> Map Name [Declaration]
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (RefMap Int -> Name -> [Declaration]
followEvidenceUses RefMap Int
rf) Set Name
combinedNames
      -- Map.! is safe because declMap contains all elements of v by definition
      graphs :: [Graph Declaration]
graphs = ((Declaration, Set Name) -> Graph Declaration)
-> [(Declaration, Set Name)] -> [Graph Declaration]
forall a b. (a -> b) -> [a] -> [b]
map (\(Declaration
d, Set Name
v) -> Declaration -> [Declaration] -> Graph Declaration
forall a. a -> [a] -> Graph a
star Declaration
d (([Declaration] -> [Declaration]
forall a. Ord a => [a] -> [a]
nubOrd ([Declaration] -> [Declaration]) -> [Declaration] -> [Declaration]
forall a b. (a -> b) -> a -> b
$ (Name -> [Declaration]) -> Set Name -> [Declaration]
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Map Name [Declaration]
declMap Map Name [Declaration] -> Name -> [Declaration]
forall k a. Ord k => Map k a -> k -> a
Map.!) Set Name
v)))
                 (Map Declaration (Set Name) -> [(Declaration, Set Name)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Declaration (Set Name)
requestedEvidence)
   in Analysis
a { dependencyGraph = overlays (dependencyGraph : graphs) }