mirror of
https://github.com/polysemy-research/polysemy.git
synced 2024-10-26 02:49:58 +03:00
Support GHC 9.2
This commit is contained in:
parent
def5cc2204
commit
6a0125b9b7
63
flake.lock
63
flake.lock
@ -2,11 +2,11 @@
|
||||
"nodes": {
|
||||
"flake-utils": {
|
||||
"locked": {
|
||||
"lastModified": 1618217525,
|
||||
"narHash": "sha256-WGrhVczjXTiswQaoxQ+0PTfbLNeOQM6M36zvLn78AYg=",
|
||||
"lastModified": 1637014545,
|
||||
"narHash": "sha256-26IZAc5yzlD9FlDT54io1oqG/bBoyka+FJk5guaX4x4=",
|
||||
"owner": "numtide",
|
||||
"repo": "flake-utils",
|
||||
"rev": "c6169a2772643c4a93a0b5ac1c61e296cba68544",
|
||||
"rev": "bba5dcc8e0b20ab664967ad83d24d64cb64ec4f4",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
@ -15,36 +15,53 @@
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"nixpkgs_2009": {
|
||||
"locked": {
|
||||
"lastModified": 1636935165,
|
||||
"narHash": "sha256-J4smKTYTp8wJ57znUerWlS/QRgp0jcm/StcfIhsa5eA=",
|
||||
"owner": "nixos",
|
||||
"repo": "nixpkgs",
|
||||
"rev": "f7949198dcff52265b322ca8abf7450610e7e49e",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "nixos",
|
||||
"ref": "release-20.09",
|
||||
"repo": "nixpkgs",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"nixpkgs_2105": {
|
||||
"locked": {
|
||||
"lastModified": 1637497871,
|
||||
"narHash": "sha256-UXjWFjZSQW56Ax2fKspG0aezeRmV7j4WAbkbnZpIFtk=",
|
||||
"owner": "nixos",
|
||||
"repo": "nixpkgs",
|
||||
"rev": "d5c4e868ce3783a95bc1dd898777f09af7ff69ee",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "nixos",
|
||||
"ref": "release-21.05",
|
||||
"repo": "nixpkgs",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"root": {
|
||||
"inputs": {
|
||||
"flake-utils": "flake-utils",
|
||||
"stable": "stable",
|
||||
"nixpkgs_2009": "nixpkgs_2009",
|
||||
"nixpkgs_2105": "nixpkgs_2105",
|
||||
"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=",
|
||||
"lastModified": 1637453606,
|
||||
"narHash": "sha256-Gy6cwUswft9xqsjWxFYEnx/63/qzaFUwatcbV5GF/GQ=",
|
||||
"owner": "nixos",
|
||||
"repo": "nixpkgs",
|
||||
"rev": "5268ee2ebacbc73875be42d71e60c2b5c1b5a1c7",
|
||||
"rev": "8afc4e543663ca0a6a4f496262cd05233737e732",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
|
58
flake.nix
58
flake.nix
@ -2,47 +2,51 @@
|
||||
description = "Higher-order, low-boilerplate free monads.";
|
||||
|
||||
inputs = {
|
||||
stable.url = github:nixos/nixpkgs/nixos-20.09;
|
||||
nixpkgs_2009.url = github:nixos/nixpkgs/release-20.09;
|
||||
nixpkgs_2105.url = github:nixos/nixpkgs/release-21.05;
|
||||
unstable.url = github:nixos/nixpkgs/nixpkgs-unstable;
|
||||
flake-utils.url = github:numtide/flake-utils;
|
||||
};
|
||||
|
||||
outputs = { stable, unstable, flake-utils, ... }:
|
||||
outputs = { nixpkgs_2009, nixpkgs_2105, unstable, flake-utils, ... }:
|
||||
flake-utils.lib.eachSystem ["x86_64-linux"] (system:
|
||||
with unstable.lib;
|
||||
let
|
||||
hsPkgs = nixpkgs: compiler: import ./nix/overlay.nix { inherit system nixpkgs compiler; };
|
||||
|
||||
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;
|
||||
ghcs = {
|
||||
"865" = hsPkgs nixpkgs_2009 "ghc865";
|
||||
"884" = hsPkgs nixpkgs_2105 "ghc884";
|
||||
"8107" = hsPkgs unstable "ghc8107";
|
||||
"901" = hsPkgs unstable "ghc901";
|
||||
"921" = hsPkgs unstable "ghc921";
|
||||
};
|
||||
in {
|
||||
inherit packages;
|
||||
|
||||
defaultPackage = ghc8104.polysemy;
|
||||
mkPackages = version: {
|
||||
"polysemy-${version}" = ghcs.${version}.polysemy;
|
||||
"polysemy-plugin-${version}" = ghcs.${version}.polysemy-plugin;
|
||||
};
|
||||
|
||||
devShell = ghc8104.shellFor {
|
||||
packages = _: [];
|
||||
buildInputs = with ghc8104; [
|
||||
packages =
|
||||
foldl' (l: r: l // r) { inherit (ghcs."8107") polysemy polysemy-plugin; } (map mkPackages (attrNames ghcs));
|
||||
|
||||
mkDevShell = extra: ghc: ghc.shellFor {
|
||||
packages = p: [p.polysemy p.polysemy-plugin];
|
||||
buildInputs = with ghc; [
|
||||
cabal-install
|
||||
haskell-language-server
|
||||
ghcid
|
||||
];
|
||||
withHoogle = true;
|
||||
] ++ (if extra then [ghcid haskell-language-server] else []);
|
||||
withHoogle = extra;
|
||||
};
|
||||
|
||||
devShells = mapAttrs' (n: g: nameValuePair "ghc${n}" (mkDevShell (n != "921") g)) ghcs;
|
||||
|
||||
in {
|
||||
inherit packages devShells;
|
||||
|
||||
defaultPackage = packages.polysemy;
|
||||
|
||||
devShell = devShells.ghc8107;
|
||||
|
||||
checks = packages;
|
||||
});
|
||||
}
|
||||
|
@ -6,16 +6,32 @@
|
||||
let
|
||||
overrides = pkgs: self: super:
|
||||
let
|
||||
inherit (builtins) splitVersion;
|
||||
inherit (pkgs.lib) compare compareLists;
|
||||
hs = pkgs.haskell.lib;
|
||||
jailbreak = hs.doJailbreak;
|
||||
|
||||
filter = pkgs.nix-gitignore.gitignoreSourcePure [./source-filter];
|
||||
|
||||
c2n = name: src: pkgs.haskell.lib.disableLibraryProfiling (self.callCabal2nix name (filter src) {});
|
||||
hackage = pkg: ver: sha256: self.callHackageDirect { inherit pkg ver sha256; } {};
|
||||
|
||||
is92 = compareLists compare (splitVersion self.ghc.version) ["9" "2" "0"] >= 0;
|
||||
if92 = n: f: if is92 then f n else n;
|
||||
|
||||
fcf = hackage "first-class-families" "0.8.0.1" "0h1rxbc7zsxrlhx5xcl58wjx3qi2wny8wb3sk7c1qnydf4ckcckz";
|
||||
in {
|
||||
cabal-doctest =
|
||||
if is92
|
||||
then hackage "cabal-doctest" "1.0.9" "0irxfxy1qw7sif4408xdhqycddb4hs3hcf6xfxm65glsnmnmwl2i"
|
||||
else super.cabal-doctest;
|
||||
dump-core = hackage "dump-core" "0.1.3.2" "1mi8p736yn00z549pwnjv4ydwbs8mwg6dla3ly447c027nq8py6g";
|
||||
first-class-families = if92 fcf jailbreak;
|
||||
monadLib = hackage "monadLib" "3.10" "1v4ynjcb963s3lfw3v71qdzvld1mmz1faf8swhvicma5jbvwchy2";
|
||||
polysemy = 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";
|
||||
primitive = if92 super.primitive jailbreak;
|
||||
type-errors = if92 super.type-errors hs.dontCheck;
|
||||
};
|
||||
|
||||
pkgs = import nixpkgs { inherit system; };
|
||||
|
@ -13,9 +13,17 @@ import GHC.TcPluginM.Extra (lookupModule, lookupName)
|
||||
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, text, (<+>), ($$))
|
||||
import GHC.Plugins (getDynFlags)
|
||||
import GHC.Unit.State (lookupModuleWithSuggestions, LookupResult (..), UnitState)
|
||||
import GHC.Utils.Outputable (text, (<+>), ($$))
|
||||
#if __GLASGOW_HASKELL__ >= 902
|
||||
import GHC.Tc.Plugin (getTopEnv)
|
||||
import GHC.Utils.Panic (pprPanic)
|
||||
import GHC.Driver.Env (hsc_units)
|
||||
#else
|
||||
import GHC.Plugins (unitState)
|
||||
import GHC.Utils.Outputable(pprPanic)
|
||||
#endif
|
||||
#else
|
||||
import FastString (fsLit)
|
||||
import OccName (mkTcOcc)
|
||||
@ -45,13 +53,29 @@ polysemyStuffLocations = PolysemyStuff
|
||||
, semTyCon = ("Polysemy.Internal", "Sem")
|
||||
}
|
||||
|
||||
#if __GLASGOW_HASKELL__ >= 900
|
||||
------------------------------------------------------------------------------
|
||||
-- | GHC-version-dependent access of the UnitState
|
||||
getUnitState :: TcPluginM UnitState
|
||||
getUnitState = do
|
||||
#if __GLASGOW_HASKELL__ >= 902
|
||||
topState <- getTopEnv
|
||||
return (hsc_units topState)
|
||||
#else
|
||||
dflags <- unsafeTcPluginTcM getDynFlags
|
||||
return (unitState dflags)
|
||||
#endif
|
||||
#endif
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | Lookup all of the 'PolysemyStuff'.
|
||||
polysemyStuff :: TcPluginM (PolysemyStuff 'Things)
|
||||
polysemyStuff = do
|
||||
#if __GLASGOW_HASKELL__ >= 900
|
||||
theUnitState <- getUnitState
|
||||
#else
|
||||
dflags <- unsafeTcPluginTcM getDynFlags
|
||||
|
||||
#endif
|
||||
let error_msg = pprPanic "polysemy-plugin"
|
||||
$ text ""
|
||||
$$ text "--------------------------------------------------------------------------------"
|
||||
@ -62,7 +86,7 @@ polysemyStuff = do
|
||||
$$ text ""
|
||||
case lookupModuleWithSuggestions
|
||||
#if __GLASGOW_HASKELL__ >= 900
|
||||
(unitState dflags)
|
||||
theUnitState
|
||||
#else
|
||||
dflags
|
||||
#endif
|
||||
|
@ -6,6 +6,7 @@ import Data.Bool
|
||||
import Data.Function (on)
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as S
|
||||
|
||||
#if __GLASGOW_HASKELL__ >= 900
|
||||
import GHC.Tc.Types.Constraint
|
||||
#elif __GLASGOW_HASKELL__ >= 810
|
||||
@ -72,17 +73,23 @@ unify solve_ctx = tryUnifyUnivarsButNotSkolems skolems
|
||||
InterpreterUse _ s -> s
|
||||
FunctionDef s -> s
|
||||
|
||||
#if __GLASGOW_HASKELL__ >= 902
|
||||
#define BINDME (const BindMe)
|
||||
#define APART (const Apart)
|
||||
#else
|
||||
#define BINDME BindMe
|
||||
#define APART Skolem
|
||||
#endif
|
||||
|
||||
tryUnifyUnivarsButNotSkolems :: Set TyVar -> Type -> Type -> Maybe TCvSubst
|
||||
tryUnifyUnivarsButNotSkolems skolems goal inst =
|
||||
case tcUnifyTysFG
|
||||
(bool BindMe Skolem . flip S.member skolems)
|
||||
(bool BINDME APART . flip S.member skolems)
|
||||
[inst]
|
||||
[goal] of
|
||||
Unifiable subst -> pure subst
|
||||
_ -> Nothing
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | A wrapper for two types that we want to say have been unified.
|
||||
data Unification = Unification
|
||||
|
@ -1,4 +1,5 @@
|
||||
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module TypeErrors where
|
||||
|
||||
@ -38,6 +39,8 @@ missingFmap = ()
|
||||
-- ...
|
||||
insertAtUnprovidedIndex = ()
|
||||
|
||||
#if __GLASGOW_HASKELL__ < 902
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- |
|
||||
-- >>> :{
|
||||
@ -74,3 +77,5 @@ insertAtWrongIndex = ()
|
||||
-- ...e1 : State s : e3 : Reader i : e4 : r
|
||||
-- ...
|
||||
insertAtAndRaiseWrongIndex = ()
|
||||
|
||||
#endif
|
||||
|
@ -36,31 +36,6 @@ infixr 4 %
|
||||
type family (%) (t :: k1) (b :: k2) :: ErrorMessage where
|
||||
t % b = ToErrorMessage t ':$$: ToErrorMessage b
|
||||
|
||||
-- TODO(sandy): Put in type-errors
|
||||
type ShowTypeBracketed t = "(" <> t <> ")"
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | The constructor of the effect row --- it's either completely polymorphic,
|
||||
-- a nil, or a cons.
|
||||
data EffectRowCtor = TyVarR | NilR | ConsR
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | Given that @r@ isn't stuck, determine which constructor it has.
|
||||
type family UnstuckRState (r :: EffectRow) :: EffectRowCtor where
|
||||
UnstuckRState '[] = 'NilR
|
||||
UnstuckRState (_ ': _) = 'ConsR
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | Put brackets around @r@ if it's a cons.
|
||||
type family ShowRQuoted (rstate :: EffectRowCtor) (r :: EffectRow) :: ErrorMessage where
|
||||
ShowRQuoted 'TyVarR r = 'ShowType r
|
||||
ShowRQuoted 'NilR r = 'ShowType r
|
||||
ShowRQuoted 'ConsR r = ShowTypeBracketed r
|
||||
|
||||
|
||||
data FirstOrderErrorFcf :: k -> Symbol -> Exp Constraint
|
||||
type instance Eval (FirstOrderErrorFcf e fn) = $(te[t|
|
||||
UnlessPhantom
|
||||
|
@ -2,16 +2,17 @@
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
{-# OPTIONS_HADDOCK not-home #-}
|
||||
|
||||
module Polysemy.Internal.Index where
|
||||
|
||||
import GHC.TypeLits (Nat)
|
||||
import Type.Errors (TypeError, ErrorMessage(ShowType))
|
||||
import Type.Errors (ErrorMessage (ShowType), TypeError)
|
||||
|
||||
import Polysemy.Internal.CustomErrors (type (<>), type (%))
|
||||
import Polysemy.Internal.Sing (SList (SEnd, SCons))
|
||||
import Polysemy.Internal.CustomErrors (type (%), type (<>))
|
||||
import Polysemy.Internal.Sing (SList (SCons, SEnd))
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | Infer a partition of the result type @full@ so that for the fixed segments
|
||||
@ -31,10 +32,17 @@ instance {-# INCOHERENT #-} (
|
||||
insertAtIndex = SCons (insertAtIndex @_ @index @head @tail @oldTail @full)
|
||||
{-# INLINE insertAtIndex #-}
|
||||
|
||||
-- Broken on 9.2.
|
||||
-- It appears that instance matching is done with an abstract value for @oldTail@, thus not matching the correct
|
||||
-- instance and finding only this one, causing a false positive for the @TypeError@.
|
||||
#if __GLASGOW_HASKELL__ < 902
|
||||
|
||||
instance {-# INCOHERENT #-} TypeError (InsertAtFailure index oldTail head full)
|
||||
=> InsertAtIndex index head tail oldTail full inserted where
|
||||
insertAtIndex = error "unreachable"
|
||||
|
||||
#endif
|
||||
|
||||
type family InsertAtUnprovidedIndex where
|
||||
InsertAtUnprovidedIndex = TypeError (
|
||||
"insertAt: You must provide the index at which the effects should be inserted as a type application."
|
||||
|
Loading…
Reference in New Issue
Block a user