Upgrade to GHC 9 (#68)

Unfortunately I don't have the resources to support earlier versions of GHC, so this is a strict upgrade. Fixes #65.
ocharles · Oct 11, 2021 · d0c69bb · d0c69bb
1 parent 6749116
commit d0c69bb
Show file tree

Hide file tree

Showing 7 changed files with 70 additions and 47 deletions.
diff --git a/.github/workflows/nix-build.yml b/.github/workflows/nix-build.yml
@@ -14,4 +14,4 @@ jobs:
       with:
         name: weeder
         signingKey: 7Pn6R7tF95HC2INHlVsphnqzZNT8Zmx3GBoqtwIvvH5F1SYlqVocPnR8aDds2qw4aYbNFGpMhpyY8G79e2OXcg==
-    - run: nix-build -A hsPkgs.weeder.components.exes
+    - run: nix-build -A hsPkgs.weeder.components.exes --argstr compiler-nix-name 'ghc901'
diff --git a/default.nix b/default.nix
@@ -1,20 +1,36 @@
-let 
+{ compiler-nix-name ? "ghc901" }:
+let
   haskellNix = import (import ./nix/sources.nix)."haskell.nix" {};
 
   nixpkgsSrc = haskellNix.sources.nixpkgs-2009;
 
   nixpkgsArgs = haskellNix.nixpkgsArgs;
 
-  compiler-nix-name = "ghc884";
-
   pkgs = import nixpkgsSrc nixpkgsArgs;
 
-in 
+in
 pkgs.haskell-nix.project {
   inherit compiler-nix-name;
 
   src = pkgs.haskell-nix.haskellLib.cleanGit {
     name = "weeder";
     src = ./.;
   };
+
+  modules = [(pkgs.lib.optionalAttrs (compiler-nix-name == "ghc901") {
+    nonReinstallablePkgs = [
+      "rts" "ghc-heap" "ghc-prim" "integer-gmp" "integer-simple" "base"
+      "deepseq" "array" "ghc-boot-th" "pretty" "template-haskell"
+      # ghcjs custom packages
+      "ghcjs-prim" "ghcjs-th"
+      "ghc-bignum" "exceptions" "stm"
+      "ghc-boot"
+      "ghc" "Cabal" "Win32" "array" "binary" "bytestring" "containers"
+      "directory" "filepath" "ghc-boot" "ghc-compact" "ghc-prim"
+      # "ghci" "haskeline"
+      "hpc"
+      "mtl" "parsec" "process" "text" "time" "transformers"
+      "unix" "xhtml" "terminfo"
+    ];
+  })];
 }
diff --git 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
@@ -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
@@ -48,31 +48,32 @@ 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
   , isTvOcc
   , 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
@@ -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
@@ -19,14 +19,14 @@ extra-doc-files:
 library
   build-depends:
     , algebraic-graphs     ^>= 0.4 || ^>= 0.5
-    , base                 ^>= 4.13.0.0 || ^>= 4.14.0.0
+    , base                 ^>= 4.15.0.0
     , bytestring           ^>= 0.10.9.0 || ^>= 0.11.0.0
     , containers           ^>= 0.6.2.1
     , dhall                ^>= 1.30.0 || ^>= 1.31.0 || ^>= 1.32.0 || ^>= 1.33.0 || ^>= 1.34.0 || ^>= 1.35.0 || ^>= 1.36.0 || ^>= 1.37.0 || ^>= 1.40.0
     , directory            ^>= 1.3.3.2
     , filepath             ^>= 1.4.2.1
-    , generic-lens         ^>= 1.1.0.0 || ^>= 1.2.0.0 || ^>= 2.0.0.0 || ^>= 2.2.0.0
-    , ghc                  ^>= 8.8.1 || ^>= 8.10
+    , generic-lens         ^>= 2.2.0.0
+    , ghc                  ^>= 9.0
     , lens                 ^>= 4.18.1 || ^>= 4.19 || ^>= 5.0.1
     , mtl                  ^>= 2.2.2
     , optparse-applicative ^>= 0.14.3.0 || ^>= 0.15.1.0 || ^>= 0.16.0.0