Works on GHC 9

This commit is contained in:
Ollie Charles 2021-08-28 15:11:30 +01:00
parent 05926e017d
commit c7fb3d94a8
7 changed files with 51 additions and 46 deletions

View File

@ -14,6 +14,4 @@ jobs:
with:
name: weeder
signingKey: 7Pn6R7tF95HC2INHlVsphnqzZNT8Zmx3GBoqtwIvvH5F1SYlqVocPnR8aDds2qw4aYbNFGpMhpyY8G79e2OXcg==
- run: nix-build -A hsPkgs.weeder.components.exes --argstr compiler-nix-name 'ghc884'
- run: nix-build -A hsPkgs.weeder.components.exes --argstr compiler-nix-name 'ghc8104'
- run: nix-build -A hsPkgs.weeder.components.exes --argstr compiler-nix-name 'ghc901'

View File

@ -1,5 +1,5 @@
{ compiler-nix-name ? "ghc884" }:
let
{ compiler-nix-name ? "ghc901" }:
let
haskellNix = import (import ./nix/sources.nix)."haskell.nix" {};
nixpkgsSrc = haskellNix.sources.nixpkgs-2009;
@ -8,7 +8,7 @@ let
pkgs = import nixpkgsSrc nixpkgsArgs;
in
in
pkgs.haskell-nix.project {
inherit compiler-nix-name;

View File

@ -1,2 +1,8 @@
module Main ( main ) where
import Weeder.Main
-- weeder
import qualified Weeder.Main
main :: IO ()
main = Weeder.Main.main

View File

@ -1,10 +1,10 @@
let
hsPkgs = import ./default.nix;
hsPkgs = import ./default.nix {};
in
hsPkgs.shellFor {
withHoogle = true;
tools = { cabal = "3.2.0.0"; haskell-language-server = "latest"; };
# tools = { cabal = "3.2.0.0"; haskell-language-server = "latest"; };
exactDeps = true;
}

View File

@ -48,23 +48,24 @@ import qualified Data.Set as Set
import Data.Generics.Labels ()
-- ghc
import Avail ( AvailInfo( Avail, AvailTC ) )
import FieldLabel ( FieldLbl( FieldLabel, flSelector ) )
import HieTypes
import GHC.Types.Avail ( AvailInfo( Avail, AvailTC ) )
import GHC.Types.FieldLabel ( FieldLbl( FieldLabel, flSelector ) )
import GHC.Iface.Ext.Types
( BindType( RegularBind )
, ContextInfo( Decl, ValBind, PatternBind, Use, TyDecl, ClassTyDecl )
, DeclType( DataDec, ClassDec, ConDec )
, HieAST( Node, nodeInfo, nodeChildren, nodeSpan )
, HieAST( Node, nodeChildren, nodeSpan, sourcedNodeInfo )
, HieASTs( HieASTs )
, HieFile( HieFile, hie_asts, hie_exports, hie_module, hie_hs_file )
, IdentifierDetails( IdentifierDetails, identInfo )
, NodeInfo( NodeInfo, nodeIdentifiers, nodeAnnotations )
, NodeInfo( nodeIdentifiers, nodeAnnotations )
, Scope( ModuleScope )
, getSourcedNodeInfo
)
import Module ( Module, moduleStableString )
import Name ( Name, nameModule_maybe, nameOccName )
import OccName
( OccName
import GHC.Unit.Module ( Module, moduleStableString )
import GHC.Types.Name
( Name, nameModule_maybe, nameOccName
, OccName
, isDataOcc
, isDataSymOcc
, isTcOcc
@ -72,7 +73,7 @@ import OccName
, isVarOcc
, occNameString
)
import SrcLoc ( RealSrcSpan, realSrcSpanEnd, realSrcSpanStart )
import GHC.Types.SrcLoc ( RealSrcSpan, realSrcSpanEnd, realSrcSpanStart )
-- lens
import Control.Lens ( (%=) )
@ -262,8 +263,8 @@ topLevelAnalysis n@Node{ nodeChildren } = do
analyseBinding :: ( Alternative m, MonadState Analysis m ) => HieAST a -> m ()
analyseBinding n@Node{ nodeSpan, nodeInfo = NodeInfo{ nodeAnnotations } } = do
guard $ ( "FunBind", "HsBindLR" ) `Set.member` nodeAnnotations
analyseBinding n@Node{ nodeSpan, sourcedNodeInfo } = do
guard $ any (Set.member ("FunBind", "HsBindLR") . nodeAnnotations) $ getSourcedNodeInfo sourcedNodeInfo
for_ ( findDeclarations n ) \d -> do
define d nodeSpan
@ -272,22 +273,22 @@ analyseBinding n@Node{ nodeSpan, nodeInfo = NodeInfo{ nodeAnnotations } } = do
analyseRewriteRule :: ( Alternative m, MonadState Analysis m ) => HieAST a -> m ()
analyseRewriteRule n@Node{ nodeInfo = NodeInfo{ nodeAnnotations } } = do
guard ( ( "HsRule", "RuleDecl" ) `Set.member` nodeAnnotations )
analyseRewriteRule n@Node{ sourcedNodeInfo } = do
guard $ any (Set.member ("HsRule", "RuleDecl") . nodeAnnotations) $ getSourcedNodeInfo sourcedNodeInfo
for_ ( uses n ) addImplicitRoot
analyseInstanceDeclaration :: ( Alternative m, MonadState Analysis m ) => HieAST a -> m ()
analyseInstanceDeclaration n@Node{ nodeInfo = NodeInfo{ nodeAnnotations } } = do
guard ( ( "ClsInstD", "InstDecl" ) `Set.member` nodeAnnotations )
analyseInstanceDeclaration n@Node{ sourcedNodeInfo } = do
guard $ any (Set.member ("ClsInstD", "InstDecl") . nodeAnnotations) $ getSourcedNodeInfo sourcedNodeInfo
traverse_ addImplicitRoot ( uses n )
analyseClassDeclaration :: ( Alternative m, MonadState Analysis m ) => HieAST a -> m ()
analyseClassDeclaration n@Node{ nodeInfo = NodeInfo{ nodeAnnotations } } = do
guard ( ( "ClassDecl", "TyClDecl" ) `Set.member` nodeAnnotations )
analyseClassDeclaration n@Node{ sourcedNodeInfo } = do
guard $ any (Set.member ("ClassDecl", "TyClDecl") . nodeAnnotations) $ getSourcedNodeInfo sourcedNodeInfo
for_ ( findIdentifiers isClassDeclaration n ) $
for_ ( findIdentifiers ( const True ) n ) . addDependency
@ -304,8 +305,8 @@ analyseClassDeclaration n@Node{ nodeInfo = NodeInfo{ nodeAnnotations } } = do
analyseDataDeclaration :: ( Alternative m, MonadState Analysis m ) => HieAST a -> m ()
analyseDataDeclaration n@Node { nodeInfo = NodeInfo{ nodeAnnotations } } = do
guard ( ( "DataDecl", "TyClDecl" ) `Set.member` nodeAnnotations )
analyseDataDeclaration n@Node{ sourcedNodeInfo } = do
guard $ any (Set.member ("DataDecl", "TyClDecl") . nodeAnnotations) $ getSourcedNodeInfo sourcedNodeInfo
for_
( foldMap
@ -331,16 +332,16 @@ analyseDataDeclaration n@Node { nodeInfo = NodeInfo{ nodeAnnotations } } = do
constructors :: HieAST a -> Seq ( HieAST a )
constructors n@Node { nodeChildren, nodeInfo = NodeInfo{ nodeAnnotations } } =
if any ( \( _, t ) -> t == "ConDecl" ) nodeAnnotations then
constructors n@Node{ nodeChildren, sourcedNodeInfo } =
if any (any (\( _, t) -> t == "ConDecl" ) . nodeAnnotations) (getSourcedNodeInfo sourcedNodeInfo) then
pure n
else
foldMap constructors nodeChildren
analysePatternSynonyms :: ( Alternative m, MonadState Analysis m ) => HieAST a -> m ()
analysePatternSynonyms n@Node{ nodeInfo = NodeInfo{ nodeAnnotations } } = do
guard $ ( "PatSynBind", "HsBindLR" ) `Set.member` nodeAnnotations
analysePatternSynonyms n@Node{ sourcedNodeInfo } = do
guard $ any (Set.member ("PatSynBind", "HsBindLR") . nodeAnnotations) $ getSourcedNodeInfo sourcedNodeInfo
for_ ( findDeclarations n ) $ for_ ( uses n ) . addDependency
@ -366,7 +367,7 @@ findIdentifiers
:: ( Set ContextInfo -> Bool )
-> HieAST a
-> Seq Declaration
findIdentifiers f Node{ nodeInfo = NodeInfo{ nodeIdentifiers }, nodeChildren } =
findIdentifiers f Node{ sourcedNodeInfo, nodeChildren } =
foldMap
( \case
( Left _, _ ) ->
@ -379,8 +380,7 @@ findIdentifiers f Node{ nodeInfo = NodeInfo{ nodeIdentifiers }, nodeChildren } =
else
mempty
)
( Map.toList nodeIdentifiers )
(foldMap (Map.toList . nodeIdentifiers) (getSourcedNodeInfo sourcedNodeInfo))
<> foldMap ( findIdentifiers f ) nodeChildren

View File

@ -35,13 +35,13 @@ import System.Directory ( canonicalizePath, doesDirectoryExist, doesFileExist, d
import System.FilePath ( isExtensionOf )
-- ghc
import HieBin ( HieFileResult( HieFileResult, hie_file_result ), readHieFileWithVersion )
import HieTypes ( HieFile( hie_hs_file ), hieVersion )
import Module ( moduleName, moduleNameString )
import NameCache ( initNameCache, NameCache )
import OccName ( occNameString )
import SrcLoc ( RealSrcLoc, realSrcSpanStart, srcLocLine )
import UniqSupply ( mkSplitUniqSupply )
import GHC.Iface.Ext.Binary ( HieFileResult( HieFileResult, hie_file_result ), NameCacheUpdater( NCU ), readHieFileWithVersion )
import GHC.Iface.Ext.Types ( HieFile( hie_hs_file ), hieVersion )
import GHC.Unit.Module ( moduleName, moduleNameString )
import GHC.Types.Name.Cache ( initNameCache, NameCache )
import GHC.Types.Name ( occNameString )
import GHC.Types.SrcLoc ( RealSrcLoc, realSrcSpanStart, srcLocLine )
import GHC.Types.Unique.Supply ( mkSplitUniqSupply )
-- regex-tdfa
import Text.Regex.TDFA ( (=~) )
@ -218,9 +218,9 @@ getFilesIn ext path = do
-- | Read a .hie file, exiting if it's an incompatible version.
readCompatibleHieFileOrExit :: NameCache -> FilePath -> IO HieFile
readCompatibleHieFileOrExit nameCache path = do
res <- readHieFileWithVersion (\ (v, _) -> v == hieVersion) nameCache path
res <- readHieFileWithVersion (\(v, _) -> v == hieVersion) (NCU (\f -> return $ snd $ f nameCache)) path
case res of
Right ( HieFileResult{ hie_file_result }, _ ) ->
Right HieFileResult{ hie_file_result } ->
return hie_file_result
Left ( v, _ghcVersion ) -> do
putStrLn $ "incompatible hie file: " <> path
@ -241,3 +241,4 @@ infixr 5 ==>
(==>) :: Bool -> Bool -> Bool
True ==> x = x
False ==> _ = True

View File

@ -26,7 +26,7 @@ library
, directory ^>= 1.3.3.2
, filepath ^>= 1.4.2.1
, generic-lens ^>= 2.2.0.0
, ghc ^>= 8.8.1 || ^>= 8.10 || ^>= 9.0
, ghc ^>= 9.0
, lens ^>= 4.18.1 || ^>= 4.19 || ^>= 5.0
, mtl ^>= 2.2.2
, optparse-applicative ^>= 0.14.3.0 || ^>= 0.15.1.0 || ^>= 0.16.0.0
@ -53,7 +53,7 @@ executable weeder
, containers ^>= 0.6.2.1
, directory ^>= 1.3.3.2
, filepath ^>= 1.4.2.1
, ghc ^>= 8.8.1 || ^>= 8.10 || ^>= 9.0
, ghc ^>= 9.0
, optparse-applicative ^>= 0.14.3.0 || ^>= 0.15.1.0 || ^>= 0.16.0.0
, transformers ^>= 0.5.6.2
, weeder