ocharles/weeder
1
1
Fork 0
mirror of https://github.com/ocharles/weeder.git synced 2024-11-22 22:42:10 +03:00
Code Issues Projects Releases Wiki Activity

Upgrade to GHC 9.8.1

Browse Source
This commit is contained in:
Taylor Fausak 2024-01-24 13:39:54 -06:00
parent a959f2e35a
commit aa2c18d013
3 changed files with 40 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
src/Weeder.hs
View File

@ -59,9 +59,7 @@ import Data.Generics.Labels ()
import GHC.Data.FastString ( unpackFS )
import GHC.Types.Avail
( AvailInfo( Avail, AvailTC )
, GreName( NormalGreName, FieldGreName )
)
import GHC.Types.FieldLabel ( FieldLabel( FieldLabel, flSelector ) )
import GHC.Iface.Ext.Types
( BindType( RegularBind )
, ContextInfo( Decl, ValBind, PatternBind, Use, TyDecl, ClassTyDecl, EvidenceVarBind, RecField )
@ -171,8 +169,8 @@ data Analysis =
-- from its definition.
, 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
-- 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.
, exports :: Map Module ( Set Declaration )
-- ^ All exports for a given module.
@ -193,7 +191,7 @@ data Analysis =
instance Semigroup Analysis where
(<>) (Analysis a1 b1 c1 d1 e1 f1 g1) (Analysis a2 b2 c2 d2 e2 f2 g2)=
(<>) (Analysis a1 b1 c1 d1 e1 f1 g1) (Analysis a2 b2 c2 d2 e2 f2 g2)=
Analysis (a1 `overlay` a2) (Map.unionWith (<>) b1 b2) (c1 <> c2) (Map.unionWith (<>) d1 d2) (e1 <> e2) (f1 <> f2) (Map.unionWith (<>) g1 g2)
@ -219,7 +217,7 @@ data 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
InstanceRoot
Declaration -- ^ Declaration of the instance
Declaration -- ^ Declaration of the parent class
| -- | All exported declarations in a module are roots.
@ -256,7 +254,7 @@ initialGraph info =
asts = Map.elems hieAsts
decls = concatMap (toList . findIdentifiers' (const True)) asts
in if unusedTypes
then stars do
then stars do
(d, IdentifierDetails{identType}, _) <- decls
t <- maybe mzero pure identType
let ns = Set.toList $ typeToNames (lookupType hf t)
@ -277,7 +275,7 @@ analyseHieFile' :: ( MonadState Analysis m, MonadReader AnalysisInfo m ) => m ()
analyseHieFile' = do
HieFile{ hie_asts = HieASTs hieASTs, hie_exports, hie_module, hie_hs_file } <- asks currentHieFile
#modulePaths %= Map.insert hie_module hie_hs_file
g <- asks initialGraph
#dependencyGraph %= overlay g
@ -333,21 +331,14 @@ typeToNames (Roll t) = case t of
analyseExport :: MonadState Analysis m => Module -> AvailInfo -> m ()
analyseExport m = \case
Avail (NormalGreName name) ->
Avail name ->
traverse_ addExport $ nameToDeclaration name
Avail (FieldGreName (FieldLabel{ flSelector })) ->
traverse_ addExport $ nameToDeclaration flSelector
AvailTC name pieces -> do
for_ ( nameToDeclaration name ) addExport
for_ pieces \case
NormalGreName name' ->
traverse_ addExport $ nameToDeclaration name'
FieldGreName (FieldLabel{ flSelector }) ->
traverse_ addExport $ nameToDeclaration flSelector
for_ pieces $
traverse_ addExport . nameToDeclaration
where
@ -448,7 +439,7 @@ analyseInstanceDeclaration n@Node{ nodeSpan } = do
guard $ annsContain n ("ClsInstD", "InstDecl")
for_ ( findEvInstBinds n ) \(d, cs, ids, _) -> do
-- This makes instance declarations show up in
-- This makes instance declarations show up in
-- the output if type-class-roots is set to False.
define d nodeSpan
@ -498,7 +489,7 @@ analyseDataDeclaration n = do
when unusedTypes $
define dataTypeName (nodeSpan n)
-- Without connecting constructors to the data declaration TypeAliasGADT.hs
-- Without connecting constructors to the data declaration TypeAliasGADT.hs
-- fails with a false positive for A
conDecs <- for ( constructors n ) \constructor ->
for ( foldMap ( First . Just ) ( findIdentifiers ( any isConDec ) constructor ) ) \conDec -> do
@ -760,7 +751,7 @@ followEvidenceUses refMap d names =
in star d evBindSiteDecls
-- | Follow evidence uses listed under 'requestedEvidence' back to their
-- | 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 rf a@Analysis{ requestedEvidence, dependencyGraph } =

25
src/Weeder/Run.hs
View File

@ -7,7 +7,6 @@
module Weeder.Run ( runWeeder, Weed(..), formatWeed ) where
-- base
import Control.Applicative ( liftA2 )
import Control.Monad ( guard )
import Data.List ( sortOn )
import Data.Foldable ( fold, foldl' )
@ -19,10 +18,10 @@ import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
-- ghc
import GHC.Plugins
import GHC.Plugins
( occNameString
, moduleName
, moduleNameString
, moduleNameString
)
import GHC.Iface.Ext.Types ( HieFile( hie_asts ), getAsts )
import GHC.Iface.Ext.Utils (generateReferencesMap)
@ -63,7 +62,7 @@ formatWeed Weed{..} =
-- 'formatWeed', and the final 'Analysis'.
runWeeder :: Config -> [HieFile] -> ([Weed], Analysis)
runWeeder weederConfig@Config{ rootPatterns, typeClassRoots, rootInstances } hieFiles =
let
let
asts = concatMap (Map.elems . getAsts . hie_asts) hieFiles
rf = generateReferencesMap asts
@ -71,15 +70,15 @@ runWeeder weederConfig@Config{ rootPatterns, typeClassRoots, rootInstances } hie
analyses =
parMap rdeepseq (\hf -> execState (analyseHieFile weederConfig hf) emptyAnalysis) hieFiles
analyseEvidenceUses' =
analyseEvidenceUses' =
if typeClassRoots
then id
else analyseEvidenceUses rf
analysis1 =
analysis1 =
foldl' mappend mempty analyses
-- Evaluating 'analysis1' first allows us to begin analysis
-- Evaluating 'analysis1' first allows us to begin analysis
-- while hieFiles is still being read (since rf depends on all hie files)
analysis = analysis1 `pseq`
analyseEvidenceUses' analysis1
@ -140,20 +139,20 @@ runWeeder weederConfig@Config{ rootPatterns, typeClassRoots, rootInstances } hie
InstanceRoot d c -> typeClassRoots || matchingType
where
matchingType =
matchingType =
let mt = Map.lookup d prettyPrintedType
matches = maybe (const False) (flip matchTest) mt
in any (maybe True matches) filteredInstances
filteredInstances =
map instancePattern
. filter (maybe True (`matchTest` displayDeclaration c) . classPattern)
. filter (maybe True modulePathMatches . modulePattern)
filteredInstances =
map instancePattern
. filter (maybe True (`matchTest` displayDeclaration c) . classPattern)
. filter (maybe True modulePathMatches . modulePattern)
$ rootInstances
modulePathMatches p = maybe False (p `matchTest`) (Map.lookup ( declModule d ) modulePaths)
displayDeclaration :: Declaration -> String
displayDeclaration d =
displayDeclaration d =
moduleNameString ( moduleName ( declModule d ) ) <> "." <> occNameString ( declOccName d )

32
weeder.cabal
View File

@ -23,22 +23,22 @@ extra-source-files:
library
build-depends:
, algebraic-graphs ^>= 0.7
, async ^>= 2.2.0
, base ^>= 4.17.0.0 || ^>= 4.18.0.0
, bytestring ^>= 0.10.9.0 || ^>= 0.11.0.0
, containers ^>= 0.6.2.1
, directory ^>= 1.3.3.2
, filepath ^>= 1.4.2.1
, generic-lens ^>= 2.2.0.0
, ghc ^>= 9.4 || ^>= 9.6
, lens ^>= 5.1 || ^>= 5.2
, mtl ^>= 2.2.2 || ^>= 2.3
, optparse-applicative ^>= 0.14.3.0 || ^>= 0.15.1.0 || ^>= 0.16.0.0 || ^>= 0.17
, parallel ^>= 3.2.0.0
, regex-tdfa ^>= 1.2.0.0 || ^>= 1.3.1.0
, text ^>= 2.0.1
, toml-reader ^>= 0.2.0.0
, transformers ^>= 0.5.6.2 || ^>= 0.6
, async ^>= 2.2.5
, base ^>= 4.19.0.0
, bytestring ^>= 0.12.0.2
, containers ^>= 0.6.8
, directory ^>= 1.3.8.1
, filepath ^>= 1.4.100.4
, generic-lens ^>= 2.2.2.0
, ghc ^>= 9.8.1
, lens ^>= 5.2.3
, mtl ^>= 2.3.1
, optparse-applicative ^>= 0.18.1.0
, parallel ^>= 3.2.2.0
, regex-tdfa ^>= 1.3.2.2
, text ^>= 2.1
, toml-reader ^>= 0.2.1.0
, transformers ^>= 0.6.1.0
hs-source-dirs: src
exposed-modules:
Weeder