start migration to ghc9 (#410)

* start migration to ghc9

* add ghc9 support for polysemy-plugin

* bump doctest version in package.yaml

* fix doctest message containing incorrect spaces

Co-authored-by: funketh <theodor.k.funke@gmail.com>

flake.lock

@@ -2,11 +2,11 @@
   "nodes": {
     "flake-utils": {
       "locked": {
-        "lastModified": 1614513358,
-        "narHash": "sha256-LakhOx3S1dRjnh0b5Dg3mbZyH0ToC9I8Y2wKSkBaTzU=",
+        "lastModified": 1618217525,
+        "narHash": "sha256-WGrhVczjXTiswQaoxQ+0PTfbLNeOQM6M36zvLn78AYg=",
         "owner": "numtide",
         "repo": "flake-utils",
-        "rev": "5466c5bbece17adaab2d82fae80b46e807611bf3",
+        "rev": "c6169a2772643c4a93a0b5ac1c61e296cba68544",
         "type": "github"
       },
       "original": {
@@ -15,26 +15,43 @@
         "type": "github"
       }
     },
-    "nixpkgs": {
-      "locked": {
-        "lastModified": 1615483480,
-        "narHash": "sha256-Y5Bg5WXZf/jpfb0XTgsunt8GwtPXZhT7Ka3MNnA4IdQ=",
-        "owner": "NixOs",
-        "repo": "nixpkgs",
-        "rev": "6be212cce73f4ce4f65375fbdebcf0b87b182bc0",
-        "type": "github"
-      },
-      "original": {
-        "owner": "NixOs",
-        "ref": "nixos-20.09",
-        "repo": "nixpkgs",
-        "type": "github"
-      }
-    },
     "root": {
       "inputs": {
         "flake-utils": "flake-utils",
-        "nixpkgs": "nixpkgs"
+        "stable": "stable",
+        "unstable": "unstable"
+      }
+    },
+    "stable": {
+      "locked": {
+        "lastModified": 1618441087,
+        "narHash": "sha256-NIuHLPxSNu5OXf9T/bY+pY7mgUVRdbFFjJfMUIM7CPw=",
+        "owner": "nixos",
+        "repo": "nixpkgs",
+        "rev": "389249fa9b35b3071b4ccf71a3c065e7791934df",
+        "type": "github"
+      },
+      "original": {
+        "owner": "nixos",
+        "ref": "nixos-20.09",
+        "repo": "nixpkgs",
+        "type": "github"
+      }
+    },
+    "unstable": {
+      "locked": {
+        "lastModified": 1618499499,
+        "narHash": "sha256-2DFWiEnI7JcgM3qKMTGEcq0VrsyutaYMDOCbCF7dDiA=",
+        "owner": "nixos",
+        "repo": "nixpkgs",
+        "rev": "5268ee2ebacbc73875be42d71e60c2b5c1b5a1c7",
+        "type": "github"
+      },
+      "original": {
+        "owner": "nixos",
+        "ref": "nixpkgs-unstable",
+        "repo": "nixpkgs",
+        "type": "github"
       }
     }
   },

flake.nix

@@ -2,27 +2,40 @@
   description = "Higher-order, low-boilerplate free monads.";
 
   inputs = {
-    nixpkgs.url = github:NixOs/nixpkgs/nixos-20.09;
+    stable.url = github:nixos/nixpkgs/nixos-20.09;
+    unstable.url = github:nixos/nixpkgs/nixpkgs-unstable;
     flake-utils.url = github:numtide/flake-utils;
   };
 
-  outputs = { nixpkgs, flake-utils, ... }:
+  outputs = { stable, unstable, flake-utils, ... }:
   flake-utils.lib.eachSystem ["x86_64-linux"] (system:
   let
-    overlay = import ./nix/overlay.nix;
+    hsPkgs = nixpkgs: compiler: import ./nix/overlay.nix { inherit system nixpkgs compiler; };
 
-    pkgs = import nixpkgs {
-      inherit system;
-      overlays = [overlay];
+    ghc865 = hsPkgs stable "ghc865";
+    ghc884 = hsPkgs unstable "ghc884";
+    ghc8104 = hsPkgs unstable "ghc8104";
+    ghc901 = hsPkgs unstable "ghc901";
+
+    packages = {
+      inherit (ghc8104) polysemy polysemy-plugin;
+      polysemy-865 = ghc865.polysemy;
+      polysemy-plugin-865 = ghc865.polysemy-plugin;
+      polysemy-884 = ghc884.polysemy;
+      polysemy-plugin-884 = ghc884.polysemy-plugin;
+      polysemy-8104 = ghc8104.polysemy;
+      polysemy-plugin-8104 = ghc8104.polysemy-plugin;
+      polysemy-901 = ghc901.polysemy;
+      polysemy-plugin-901 = ghc901.polysemy-plugin;
     };
   in {
-    packages = { inherit (pkgs.haskellPackages) polysemy polysemy-plugin; };
+    inherit packages;
 
-    defaultPackage = pkgs.haskellPackages.polysemy;
+    defaultPackage = ghc8104.polysemy;
 
-    devShell = pkgs.haskellPackages.shellFor {
+    devShell = ghc8104.shellFor {
       packages = _: [];
-      buildInputs = with pkgs.haskellPackages; [
+      buildInputs = with ghc8104; [
         cabal-install
         haskell-language-server
         ghcid
@@ -30,8 +43,6 @@
       withHoogle = true;
     };
 
-    checks = {
-      inherit (pkgs.haskellPackages) polysemy polysemy-plugin;
-    };
+    checks = packages;
   });
 }

nix/overlay.nix

@@ -1,32 +1,24 @@
+{
+  system,
+  nixpkgs,
+  compiler,
+}:
 let
-  pkgOverrides = pkgs: self: super:
+  overrides = pkgs: self: super:
   let
     filter = pkgs.nix-gitignore.gitignoreSourcePure [./source-filter];
-    c2n = name: src: self.callCabal2nixWithOptions name (filter src) "" {};
+    c2n = name: src: pkgs.haskell.lib.disableLibraryProfiling (self.callCabal2nix name (filter src) {});
     hackage = pkg: ver: sha256: self.callHackageDirect { inherit pkg ver sha256; } {};
   in {
-    polysemy = c2n "polysemy" ../.;
+    polysemy = pkgs.haskell.lib.dontCheck (c2n "polysemy" ../.);
     polysemy-plugin = c2n "polysemy-plugin" ../polysemy-plugin;
     first-class-families =
       hackage "first-class-families" "0.8.0.1" "0h1rxbc7zsxrlhx5xcl58wjx3qi2wny8wb3sk7c1qnydf4ckcckz";
     dump-core = hackage "dump-core" "0.1.3.2" "1mi8p736yn00z549pwnjv4ydwbs8mwg6dla3ly447c027nq8py6g";
     monadLib = hackage "monadLib" "3.10" "1v4ynjcb963s3lfw3v71qdzvld1mmz1faf8swhvicma5jbvwchy2";
+    type-errors-pretty = pkgs.haskell.lib.doJailbreak super.type-errors-pretty;
   };
+
+  pkgs = import nixpkgs { inherit system; };
 in
-  self: super: {
-    haskell = super.haskell // (
-      let 
-        p = super.haskell.packages;
-        overrides = pkgOverrides self;
-      in {
-        packages = p // {
-          ghc865 = p.ghc865.override { inherit overrides; };
-          ghc883 = p.ghc883.override { inherit overrides; };
-          ghc884 = p.ghc884.override { inherit overrides; };
-          ghc8101 = p.ghc8101.override { inherit overrides; };
-          ghc8102 = p.ghc8102.override { inherit overrides; };
-        };
-      }
-    );
-    haskellPackages = self.haskell.packages.ghc884;
-  }
+  pkgs.haskell.packages.${compiler}.override { overrides = overrides pkgs; }

package.yaml

@@ -109,7 +109,7 @@ tests:
     - polysemy
     - inspection-testing >= 0.4.2 && < 0.5
     - hspec >= 2.6.0 && < 3
-    - doctest >= 0.16.0.1 && < 0.17
+    - doctest >= 0.16.0.1 && < 0.19
     generated-other-modules:
     - Build_doctests
 

polysemy-plugin/package.yaml

@@ -18,7 +18,7 @@ description:         Please see the README on GitHub at <https://github.com/isov
 
 dependencies:
 - base >= 4.9 && < 5
-- ghc >= 8.6.5 && < 9
+- ghc >= 8.6.5 && < 10
 - ghc-tcplugins-extra >= 0.3 && < 0.5
 - polysemy >= 1.3
 - syb >= 0.7 && < 0.8
@@ -64,7 +64,7 @@ tests:
     - hspec >= 2.6.0 && < 3
     - should-not-typecheck >= 2.1.0 && < 3
     - inspection-testing >= 0.4.2 && < 0.5
-    - doctest >= 0.16.0.1 && < 0.17
+    - doctest >= 0.16.0.1 && < 0.19
     generated-other-modules:
     - Build_doctests
 

polysemy-plugin/polysemy-plugin.cabal

@@ -66,7 +66,7 @@ library
   build-depends:
       base >=4.9 && <5
     , containers >=0.5 && <0.7
-    , ghc >=8.6.5 && <9
+    , ghc >=8.6.5 && <10
     , ghc-tcplugins-extra >=0.3 && <0.5
     , polysemy >=1.3
     , syb ==0.7.*
@@ -111,8 +111,8 @@ test-suite polysemy-plugin-test
   build-depends:
       base >=4.9 && <5
     , containers >=0.5 && <0.7
-    , doctest >=0.16.0.1 && <0.17
-    , ghc >=8.6.5 && <9
+    , doctest >=0.16.0.1 && <0.19
+    , ghc >=8.6.5 && <10
     , ghc-tcplugins-extra >=0.3 && <0.5
     , hspec >=2.6.0 && <3
     , inspection-testing >=0.4.2 && <0.5

polysemy-plugin/src/Polysemy/Plugin.hs

@@ -63,7 +63,11 @@ module Polysemy.Plugin
 
 import Polysemy.Plugin.Fundep
 
+#if __GLASGOW_HASKELL__ >= 900
+import GHC.Plugins
+#else
 import GhcPlugins
+#endif
 
 ------------------------------------------------------------------------------
 plugin :: Plugin

polysemy-plugin/src/Polysemy/Plugin/Fundep.hs

@@ -44,6 +44,14 @@ import qualified Data.Set as S
 import           Polysemy.Plugin.Fundep.Stuff
 import           Polysemy.Plugin.Fundep.Unification
 import           Polysemy.Plugin.Fundep.Utils
+#if __GLASGOW_HASKELL__ >= 900
+import           GHC.Tc.Types.Evidence
+import           GHC.Tc.Plugin (TcPluginM, tcPluginIO)
+import           GHC.Tc.Types
+import           GHC.Tc.Types.Constraint
+import           GHC.Tc.Solver.Monad hiding (tcLookupClass)
+import           GHC.Core.Type
+#else
 import           TcEvidence
 import           TcPluginM (TcPluginM, tcPluginIO)
 import           TcRnTypes
@@ -52,6 +60,7 @@ import           Constraint
 #endif
 import           TcSMonad hiding (tcLookupClass)
 import           Type
+#endif
 
 
 

polysemy-plugin/src/Polysemy/Plugin/Fundep/Stuff.hs

@@ -7,14 +7,23 @@ module Polysemy.Plugin.Fundep.Stuff
   ) where
 
 import Data.Kind (Type)
-import FastString (fsLit)
 import GHC (Name, Class, TyCon, mkModuleName)
 import GHC.TcPluginM.Extra (lookupModule, lookupName)
+#if __GLASGOW_HASKELL__ >= 900
+import GHC.Data.FastString (fsLit)
+import GHC.Types.Name.Occurrence (mkTcOcc)
+import GHC.Tc.Plugin (TcPluginM, tcLookupClass, tcLookupTyCon, unsafeTcPluginTcM)
+import GHC.Plugins (getDynFlags, unitState)
+import GHC.Unit.State (lookupModuleWithSuggestions, LookupResult (..))
+import GHC.Utils.Outputable (pprPanic, empty, text, (<+>), ($$))
+#else
+import FastString (fsLit)
 import OccName (mkTcOcc)
 import TcPluginM (TcPluginM, tcLookupClass, tcLookupTyCon, unsafeTcPluginTcM)
 import GhcPlugins (getDynFlags)
 import Packages (lookupModuleWithSuggestions, LookupResult (..))
 import Outputable (pprPanic, empty, text, (<+>), ($$))
+#endif
 
 
 
@@ -55,7 +64,14 @@ polysemyStuff = do
          $$ text "Probable fix: add `polysemy` to your cabal `build-depends`"
          $$ text "--------------------------------------------------------------------------------"
          $$ text ""
-  case lookupModuleWithSuggestions dflags (mkModuleName "Polysemy") Nothing of
+  case lookupModuleWithSuggestions
+#if __GLASGOW_HASKELL__ >= 900
+    (unitState dflags)
+#else
+    dflags
+#endif
+    (mkModuleName "Polysemy")
+    Nothing of
     LookupHidden _ _ -> error_msg
     LookupNotFound _ -> error_msg
 #if __GLASGOW_HASKELL__ >= 806

polysemy-plugin/src/Polysemy/Plugin/Fundep/Unification.hs

@@ -5,13 +5,20 @@ module Polysemy.Plugin.Fundep.Unification where
 import           Data.Bool
 import           Data.Function (on)
 import qualified Data.Set as S
-#if __GLASGOW_HASKELL__ >= 810
+#if __GLASGOW_HASKELL__ >= 900
+import           GHC.Tc.Types.Constraint
+#elif __GLASGOW_HASKELL__ >= 810
 import           Constraint
 #else
 import           TcRnTypes
 #endif
 
+#if __GLASGOW_HASKELL__ >= 900
+import           GHC.Core.Type
+#else
 import           Type
+#endif
+
 
 
 ------------------------------------------------------------------------------

polysemy-plugin/test/TypeErrors.hs

@@ -21,8 +21,8 @@ module TypeErrors where
 -- ...
 -- ... Couldn't match expected type ...Sem r Bool... with actual type ...Bool...
 -- ...
--- ... Couldn't match expected type ...Maybe a0...
--- ... with actual type ...Sem r0 s0...
+-- ... Couldn't match expected type...Maybe a0...
+-- ... with actual type...Sem r0 s0...
 -- ...
 missingFmap = ()
 

src/Polysemy/Internal.hs

@@ -267,7 +267,7 @@ instance Functor (Sem f) where
 
 
 instance Applicative (Sem f) where
-  pure a = Sem $ const $ pure a
+  pure a = Sem $ \_ -> pure a
   {-# INLINE pure #-}
 
   Sem f <*> Sem a = Sem $ \k -> f k <*> a k

src/Polysemy/Internal/Combinators.hs

@@ -59,7 +59,7 @@ firstOrder higher f = higher $ \(e :: e (Sem rInitial) x) ->
 -- transforming it into other effects inside of @r@.
 interpret
     :: FirstOrder e "interpret"
-    => (∀ x rInitial. e (Sem rInitial) x -> Sem r x)
+    => (∀ rInitial x. e (Sem rInitial) x -> Sem r x)
        -- ^ A natural transformation from the handled effect to other effects
        -- already in 'Sem'.
     -> Sem (e ': r) a
@@ -75,7 +75,7 @@ interpret = firstOrder interpretH
 --
 -- See the notes on 'Tactical' for how to use this function.
 interpretH
-    :: (∀ x rInitial . e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
+    :: (∀ rInitial x . e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
        -- ^ A natural transformation from the handled effect to other effects
        -- already in 'Sem'.
     -> Sem (e ': r) a

src/Polysemy/Internal/TH/Common.hs

@@ -215,7 +215,11 @@ missingEffArgs name = fail $ show
       )
   where
     base = capturableBase name
+#if MIN_VERSION_template_haskell(2,17,0)
+    args = flip PlainTV () . mkName <$> ["m", "a"]
+#else
     args = PlainTV . mkName <$> ["m", "a"]
+#endif
 
 notDataCon :: Name -> Q a
 notDataCon name = fail $ show
@@ -226,12 +230,20 @@ notDataCon name = fail $ show
 -- TH utilities --------------------------------------------------------------
 ------------------------------------------------------------------------------
 
+arrows :: Type -> Bool
+arrows = \case
+  ArrowT -> True
+#if MIN_VERSION_template_haskell(2,17,0)
+  AppT MulArrowT _ -> True
+#endif
+  _ -> False
+
 ------------------------------------------------------------------------------
 -- | Pattern constructing function type and matching on one that may contain
 -- type annotations on arrow itself.
 infixr 1 :->
 pattern (:->) :: Type -> Type -> Type
-pattern a :-> b <- (removeTyAnns -> ArrowT) `AppT` a `AppT` b where
+pattern a :-> b <- (arrows . removeTyAnns -> True) `AppT` a `AppT` b where
   a :-> b = ArrowT `AppT` a `AppT` b
 
 
@@ -249,8 +261,13 @@ capturableTVars = everywhere $ mkT $ \case
   VarT n          -> VarT $ capturableBase n
   ForallT bs cs t -> ForallT (goBndr <$> bs) (capturableTVars <$> cs) t
     where
+#if MIN_VERSION_template_haskell(2,17,0)
+      goBndr (PlainTV n flag) = PlainTV (capturableBase n) flag
+      goBndr (KindedTV n flag k) = KindedTV (capturableBase n) flag $ capturableTVars k
+#else
       goBndr (PlainTV n   ) = PlainTV $ capturableBase n
       goBndr (KindedTV n k) = KindedTV (capturableBase n) $ capturableTVars k
+#endif
   t -> t
 
 
@@ -274,8 +291,13 @@ simplifyKinds = everywhere $ mkT $ \case
   SigT t VarT{}   -> t
   ForallT bs cs t -> ForallT (goBndr <$> bs) (simplifyKinds <$> cs) t
     where
-      goBndr (KindedTV n StarT ) = PlainTV n
+#if MIN_VERSION_template_haskell(2,17,0)
+      goBndr (KindedTV n flag StarT) = PlainTV n flag
+      goBndr (KindedTV n flag VarT{}) = PlainTV n flag
+#else
+      goBndr (KindedTV n StarT) = PlainTV n
       goBndr (KindedTV n VarT{}) = PlainTV n
+#endif
       goBndr b = b
   t -> t
 

src/Polysemy/Internal/TH/Effect.hs

@@ -108,7 +108,7 @@ makeSem_ :: Name -> Q [Dec]
 makeSem_ = genFreer False
 -- NOTE(makeSem_):
 -- This function uses an ugly hack to work --- it changes names in data
--- constructor's type to capturable ones. This allows user to provide them to
+-- constructor's type to capturable ones. This allows users to provide them to
 -- us from their signature through 'forall' with 'ScopedTypeVariables'
 -- enabled, so that we can compile liftings of constructors with ambiguous
 -- type arguments (see issue #48).

src/Polysemy/Internal/Tactics.hs

@@ -127,7 +127,7 @@ newtype Inspector f = Inspector
 
 ------------------------------------------------------------------------------
 -- | Lift a value into 'Tactical'.
-pureT :: a -> Tactical e m r a
+pureT :: Functor f => a -> Sem (WithTactics e f m r) (f a)
 pureT a = do
   istate <- getInitialStateT
   pure $ a <$ istate