From c7fb3d94a8cd5e05f917d0a59483219a232976ae Mon Sep 17 00:00:00 2001 From: Ollie Charles Date: Sat, 28 Aug 2021 15:11:30 +0100 Subject: [PATCH] Works on GHC 9 --- .github/workflows/nix-build.yml | 2 -- default.nix | 6 ++-- exe-weeder/Main.hs | 8 ++++- shell.nix | 4 +-- src/Weeder.hs | 54 ++++++++++++++++----------------- src/Weeder/Main.hs | 19 ++++++------ weeder.cabal | 4 +-- 7 files changed, 51 insertions(+), 46 deletions(-) diff --git a/.github/workflows/nix-build.yml b/.github/workflows/nix-build.yml index 1246740..8adbb4f 100644 --- a/.github/workflows/nix-build.yml +++ b/.github/workflows/nix-build.yml @@ -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' diff --git a/default.nix b/default.nix index 5669cfa..cbb61ca 100644 --- a/default.nix +++ b/default.nix @@ -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; diff --git a/exe-weeder/Main.hs b/exe-weeder/Main.hs index 8fda7d6..110361a 100644 --- a/exe-weeder/Main.hs +++ b/exe-weeder/Main.hs @@ -1,2 +1,8 @@ module Main ( main ) where -import Weeder.Main + +-- weeder +import qualified Weeder.Main + + +main :: IO () +main = Weeder.Main.main diff --git a/shell.nix b/shell.nix index ad3c403..9b889b8 100644 --- a/shell.nix +++ b/shell.nix @@ -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; } diff --git a/src/Weeder.hs b/src/Weeder.hs index 1c75b8a..44e0fc8 100644 --- a/src/Weeder.hs +++ b/src/Weeder.hs @@ -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 diff --git a/src/Weeder/Main.hs b/src/Weeder/Main.hs index c2f17c9..58291fe 100644 --- a/src/Weeder/Main.hs +++ b/src/Weeder/Main.hs @@ -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 + diff --git a/weeder.cabal b/weeder.cabal index f268995..157f049 100644 --- a/weeder.cabal +++ b/weeder.cabal @@ -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