mirror of
https://github.com/polysemy-research/polysemy.git
synced 2024-09-11 10:36:40 +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": {
|
"nodes": {
|
||||||
"flake-utils": {
|
"flake-utils": {
|
||||||
"locked": {
|
"locked": {
|
||||||
"lastModified": 1618217525,
|
"lastModified": 1637014545,
|
||||||
"narHash": "sha256-WGrhVczjXTiswQaoxQ+0PTfbLNeOQM6M36zvLn78AYg=",
|
"narHash": "sha256-26IZAc5yzlD9FlDT54io1oqG/bBoyka+FJk5guaX4x4=",
|
||||||
"owner": "numtide",
|
"owner": "numtide",
|
||||||
"repo": "flake-utils",
|
"repo": "flake-utils",
|
||||||
"rev": "c6169a2772643c4a93a0b5ac1c61e296cba68544",
|
"rev": "bba5dcc8e0b20ab664967ad83d24d64cb64ec4f4",
|
||||||
"type": "github"
|
"type": "github"
|
||||||
},
|
},
|
||||||
"original": {
|
"original": {
|
||||||
@ -15,36 +15,53 @@
|
|||||||
"type": "github"
|
"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": {
|
"root": {
|
||||||
"inputs": {
|
"inputs": {
|
||||||
"flake-utils": "flake-utils",
|
"flake-utils": "flake-utils",
|
||||||
"stable": "stable",
|
"nixpkgs_2009": "nixpkgs_2009",
|
||||||
|
"nixpkgs_2105": "nixpkgs_2105",
|
||||||
"unstable": "unstable"
|
"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": {
|
"unstable": {
|
||||||
"locked": {
|
"locked": {
|
||||||
"lastModified": 1618499499,
|
"lastModified": 1637453606,
|
||||||
"narHash": "sha256-2DFWiEnI7JcgM3qKMTGEcq0VrsyutaYMDOCbCF7dDiA=",
|
"narHash": "sha256-Gy6cwUswft9xqsjWxFYEnx/63/qzaFUwatcbV5GF/GQ=",
|
||||||
"owner": "nixos",
|
"owner": "nixos",
|
||||||
"repo": "nixpkgs",
|
"repo": "nixpkgs",
|
||||||
"rev": "5268ee2ebacbc73875be42d71e60c2b5c1b5a1c7",
|
"rev": "8afc4e543663ca0a6a4f496262cd05233737e732",
|
||||||
"type": "github"
|
"type": "github"
|
||||||
},
|
},
|
||||||
"original": {
|
"original": {
|
||||||
|
58
flake.nix
58
flake.nix
@ -2,47 +2,51 @@
|
|||||||
description = "Higher-order, low-boilerplate free monads.";
|
description = "Higher-order, low-boilerplate free monads.";
|
||||||
|
|
||||||
inputs = {
|
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;
|
unstable.url = github:nixos/nixpkgs/nixpkgs-unstable;
|
||||||
flake-utils.url = github:numtide/flake-utils;
|
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:
|
flake-utils.lib.eachSystem ["x86_64-linux"] (system:
|
||||||
|
with unstable.lib;
|
||||||
let
|
let
|
||||||
hsPkgs = nixpkgs: compiler: import ./nix/overlay.nix { inherit system nixpkgs compiler; };
|
hsPkgs = nixpkgs: compiler: import ./nix/overlay.nix { inherit system nixpkgs compiler; };
|
||||||
|
|
||||||
ghc865 = hsPkgs stable "ghc865";
|
ghcs = {
|
||||||
ghc884 = hsPkgs unstable "ghc884";
|
"865" = hsPkgs nixpkgs_2009 "ghc865";
|
||||||
ghc8104 = hsPkgs unstable "ghc8104";
|
"884" = hsPkgs nixpkgs_2105 "ghc884";
|
||||||
ghc901 = hsPkgs unstable "ghc901";
|
"8107" = hsPkgs unstable "ghc8107";
|
||||||
|
"901" = hsPkgs unstable "ghc901";
|
||||||
packages = {
|
"921" = hsPkgs unstable "ghc921";
|
||||||
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 {
|
|
||||||
inherit packages;
|
|
||||||
|
|
||||||
defaultPackage = ghc8104.polysemy;
|
mkPackages = version: {
|
||||||
|
"polysemy-${version}" = ghcs.${version}.polysemy;
|
||||||
|
"polysemy-plugin-${version}" = ghcs.${version}.polysemy-plugin;
|
||||||
|
};
|
||||||
|
|
||||||
devShell = ghc8104.shellFor {
|
packages =
|
||||||
packages = _: [];
|
foldl' (l: r: l // r) { inherit (ghcs."8107") polysemy polysemy-plugin; } (map mkPackages (attrNames ghcs));
|
||||||
buildInputs = with ghc8104; [
|
|
||||||
|
mkDevShell = extra: ghc: ghc.shellFor {
|
||||||
|
packages = p: [p.polysemy p.polysemy-plugin];
|
||||||
|
buildInputs = with ghc; [
|
||||||
cabal-install
|
cabal-install
|
||||||
haskell-language-server
|
] ++ (if extra then [ghcid haskell-language-server] else []);
|
||||||
ghcid
|
withHoogle = extra;
|
||||||
];
|
|
||||||
withHoogle = true;
|
|
||||||
};
|
};
|
||||||
|
|
||||||
|
devShells = mapAttrs' (n: g: nameValuePair "ghc${n}" (mkDevShell (n != "921") g)) ghcs;
|
||||||
|
|
||||||
|
in {
|
||||||
|
inherit packages devShells;
|
||||||
|
|
||||||
|
defaultPackage = packages.polysemy;
|
||||||
|
|
||||||
|
devShell = devShells.ghc8107;
|
||||||
|
|
||||||
checks = packages;
|
checks = packages;
|
||||||
});
|
});
|
||||||
}
|
}
|
||||||
|
@ -6,16 +6,32 @@
|
|||||||
let
|
let
|
||||||
overrides = pkgs: self: super:
|
overrides = pkgs: self: super:
|
||||||
let
|
let
|
||||||
|
inherit (builtins) splitVersion;
|
||||||
|
inherit (pkgs.lib) compare compareLists;
|
||||||
|
hs = pkgs.haskell.lib;
|
||||||
|
jailbreak = hs.doJailbreak;
|
||||||
|
|
||||||
filter = pkgs.nix-gitignore.gitignoreSourcePure [./source-filter];
|
filter = pkgs.nix-gitignore.gitignoreSourcePure [./source-filter];
|
||||||
|
|
||||||
c2n = name: src: pkgs.haskell.lib.disableLibraryProfiling (self.callCabal2nix 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; } {};
|
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 {
|
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 = c2n "polysemy" ../.;
|
||||||
polysemy-plugin = c2n "polysemy-plugin" ../polysemy-plugin;
|
polysemy-plugin = c2n "polysemy-plugin" ../polysemy-plugin;
|
||||||
first-class-families =
|
primitive = if92 super.primitive jailbreak;
|
||||||
hackage "first-class-families" "0.8.0.1" "0h1rxbc7zsxrlhx5xcl58wjx3qi2wny8wb3sk7c1qnydf4ckcckz";
|
type-errors = if92 super.type-errors hs.dontCheck;
|
||||||
dump-core = hackage "dump-core" "0.1.3.2" "1mi8p736yn00z549pwnjv4ydwbs8mwg6dla3ly447c027nq8py6g";
|
|
||||||
monadLib = hackage "monadLib" "3.10" "1v4ynjcb963s3lfw3v71qdzvld1mmz1faf8swhvicma5jbvwchy2";
|
|
||||||
};
|
};
|
||||||
|
|
||||||
pkgs = import nixpkgs { inherit system; };
|
pkgs = import nixpkgs { inherit system; };
|
||||||
|
@ -13,9 +13,17 @@ import GHC.TcPluginM.Extra (lookupModule, lookupName)
|
|||||||
import GHC.Data.FastString (fsLit)
|
import GHC.Data.FastString (fsLit)
|
||||||
import GHC.Types.Name.Occurrence (mkTcOcc)
|
import GHC.Types.Name.Occurrence (mkTcOcc)
|
||||||
import GHC.Tc.Plugin (TcPluginM, tcLookupClass, tcLookupTyCon, unsafeTcPluginTcM)
|
import GHC.Tc.Plugin (TcPluginM, tcLookupClass, tcLookupTyCon, unsafeTcPluginTcM)
|
||||||
import GHC.Plugins (getDynFlags, unitState)
|
import GHC.Plugins (getDynFlags)
|
||||||
import GHC.Unit.State (lookupModuleWithSuggestions, LookupResult (..))
|
import GHC.Unit.State (lookupModuleWithSuggestions, LookupResult (..), UnitState)
|
||||||
import GHC.Utils.Outputable (pprPanic, text, (<+>), ($$))
|
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
|
#else
|
||||||
import FastString (fsLit)
|
import FastString (fsLit)
|
||||||
import OccName (mkTcOcc)
|
import OccName (mkTcOcc)
|
||||||
@ -45,13 +53,29 @@ polysemyStuffLocations = PolysemyStuff
|
|||||||
, semTyCon = ("Polysemy.Internal", "Sem")
|
, 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'.
|
-- | Lookup all of the 'PolysemyStuff'.
|
||||||
polysemyStuff :: TcPluginM (PolysemyStuff 'Things)
|
polysemyStuff :: TcPluginM (PolysemyStuff 'Things)
|
||||||
polysemyStuff = do
|
polysemyStuff = do
|
||||||
|
#if __GLASGOW_HASKELL__ >= 900
|
||||||
|
theUnitState <- getUnitState
|
||||||
|
#else
|
||||||
dflags <- unsafeTcPluginTcM getDynFlags
|
dflags <- unsafeTcPluginTcM getDynFlags
|
||||||
|
#endif
|
||||||
let error_msg = pprPanic "polysemy-plugin"
|
let error_msg = pprPanic "polysemy-plugin"
|
||||||
$ text ""
|
$ text ""
|
||||||
$$ text "--------------------------------------------------------------------------------"
|
$$ text "--------------------------------------------------------------------------------"
|
||||||
@ -62,7 +86,7 @@ polysemyStuff = do
|
|||||||
$$ text ""
|
$$ text ""
|
||||||
case lookupModuleWithSuggestions
|
case lookupModuleWithSuggestions
|
||||||
#if __GLASGOW_HASKELL__ >= 900
|
#if __GLASGOW_HASKELL__ >= 900
|
||||||
(unitState dflags)
|
theUnitState
|
||||||
#else
|
#else
|
||||||
dflags
|
dflags
|
||||||
#endif
|
#endif
|
||||||
|
@ -6,6 +6,7 @@ import Data.Bool
|
|||||||
import Data.Function (on)
|
import Data.Function (on)
|
||||||
import Data.Set (Set)
|
import Data.Set (Set)
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
|
|
||||||
#if __GLASGOW_HASKELL__ >= 900
|
#if __GLASGOW_HASKELL__ >= 900
|
||||||
import GHC.Tc.Types.Constraint
|
import GHC.Tc.Types.Constraint
|
||||||
#elif __GLASGOW_HASKELL__ >= 810
|
#elif __GLASGOW_HASKELL__ >= 810
|
||||||
@ -72,17 +73,23 @@ unify solve_ctx = tryUnifyUnivarsButNotSkolems skolems
|
|||||||
InterpreterUse _ s -> s
|
InterpreterUse _ s -> s
|
||||||
FunctionDef 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 :: Set TyVar -> Type -> Type -> Maybe TCvSubst
|
||||||
tryUnifyUnivarsButNotSkolems skolems goal inst =
|
tryUnifyUnivarsButNotSkolems skolems goal inst =
|
||||||
case tcUnifyTysFG
|
case tcUnifyTysFG
|
||||||
(bool BindMe Skolem . flip S.member skolems)
|
(bool BINDME APART . flip S.member skolems)
|
||||||
[inst]
|
[inst]
|
||||||
[goal] of
|
[goal] of
|
||||||
Unifiable subst -> pure subst
|
Unifiable subst -> pure subst
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- | A wrapper for two types that we want to say have been unified.
|
-- | A wrapper for two types that we want to say have been unified.
|
||||||
data Unification = Unification
|
data Unification = Unification
|
||||||
|
@ -1,4 +1,5 @@
|
|||||||
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
|
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
|
||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
|
||||||
module TypeErrors where
|
module TypeErrors where
|
||||||
|
|
||||||
@ -38,6 +39,8 @@ missingFmap = ()
|
|||||||
-- ...
|
-- ...
|
||||||
insertAtUnprovidedIndex = ()
|
insertAtUnprovidedIndex = ()
|
||||||
|
|
||||||
|
#if __GLASGOW_HASKELL__ < 902
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- >>> :{
|
-- >>> :{
|
||||||
@ -74,3 +77,5 @@ insertAtWrongIndex = ()
|
|||||||
-- ...e1 : State s : e3 : Reader i : e4 : r
|
-- ...e1 : State s : e3 : Reader i : e4 : r
|
||||||
-- ...
|
-- ...
|
||||||
insertAtAndRaiseWrongIndex = ()
|
insertAtAndRaiseWrongIndex = ()
|
||||||
|
|
||||||
|
#endif
|
||||||
|
@ -36,31 +36,6 @@ infixr 4 %
|
|||||||
type family (%) (t :: k1) (b :: k2) :: ErrorMessage where
|
type family (%) (t :: k1) (b :: k2) :: ErrorMessage where
|
||||||
t % b = ToErrorMessage t ':$$: ToErrorMessage b
|
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
|
data FirstOrderErrorFcf :: k -> Symbol -> Exp Constraint
|
||||||
type instance Eval (FirstOrderErrorFcf e fn) = $(te[t|
|
type instance Eval (FirstOrderErrorFcf e fn) = $(te[t|
|
||||||
UnlessPhantom
|
UnlessPhantom
|
||||||
|
@ -2,16 +2,17 @@
|
|||||||
{-# LANGUAGE UndecidableInstances #-}
|
{-# LANGUAGE UndecidableInstances #-}
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
|
||||||
{-# OPTIONS_HADDOCK not-home #-}
|
{-# OPTIONS_HADDOCK not-home #-}
|
||||||
|
|
||||||
module Polysemy.Internal.Index where
|
module Polysemy.Internal.Index where
|
||||||
|
|
||||||
import GHC.TypeLits (Nat)
|
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.CustomErrors (type (%), type (<>))
|
||||||
import Polysemy.Internal.Sing (SList (SEnd, SCons))
|
import Polysemy.Internal.Sing (SList (SCons, SEnd))
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
-- | Infer a partition of the result type @full@ so that for the fixed segments
|
-- | 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)
|
insertAtIndex = SCons (insertAtIndex @_ @index @head @tail @oldTail @full)
|
||||||
{-# INLINE insertAtIndex #-}
|
{-# 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)
|
instance {-# INCOHERENT #-} TypeError (InsertAtFailure index oldTail head full)
|
||||||
=> InsertAtIndex index head tail oldTail full inserted where
|
=> InsertAtIndex index head tail oldTail full inserted where
|
||||||
insertAtIndex = error "unreachable"
|
insertAtIndex = error "unreachable"
|
||||||
|
|
||||||
|
#endif
|
||||||
|
|
||||||
type family InsertAtUnprovidedIndex where
|
type family InsertAtUnprovidedIndex where
|
||||||
InsertAtUnprovidedIndex = TypeError (
|
InsertAtUnprovidedIndex = TypeError (
|
||||||
"insertAt: You must provide the index at which the effects should be inserted as a type application."
|
"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