Created
January 26, 2022 13:57
-
-
Save sheaf/87e3902c0321cb632ffa3ee03355a483 to your computer and use it in GitHub Desktop.
GHC bug 21010 reproducer
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| {-# LANGUAGE Haskell2010 #-} | |
| {-# LANGUAGE FlexibleInstances #-} | |
| {-# LANGUAGE TypeFamilies #-} | |
| module Bind ( CBind(..) ) where | |
| import BindA ( WrapMono(..), Constrained(Dom), withMonoCoercible ) | |
| class CBind m where | |
| (>>-) :: (Dom m a, Dom m b) => m a -> (a -> m b) -> m b | |
| instance CBind (WrapMono ()) where | |
| (>>-) = withMonoCoercible _ |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| {-# LANGUAGE Haskell2010 #-} | |
| {-# LANGUAGE FlexibleInstances #-} | |
| {-# LANGUAGE KindSignatures #-} | |
| {-# LANGUAGE TypeFamilies #-} | |
| module BindA ( WrapMono, Constrained(..), withMonoCoercible ) where | |
| import Internal ( Element, WrapMono(..), withMonoCoercible ) | |
| import Data.Kind ( Type, Constraint ) | |
| class Constrained (f :: Type -> Type) where | |
| type Dom f (a :: Type) :: Constraint | |
| instance Constrained (WrapMono mono) where | |
| type Dom (WrapMono mono) b = b ~ Element mono |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| {-# LANGUAGE Haskell2010 #-} | |
| {-# LANGUAGE DerivingStrategies #-} | |
| {-# LANGUAGE FlexibleContexts #-} | |
| {-# LANGUAGE KindSignatures #-} | |
| {-# LANGUAGE RankNTypes #-} | |
| {-# LANGUAGE RoleAnnotations #-} | |
| {-# LANGUAGE TypeFamilies #-} | |
| module Internal where | |
| import Data.Coerce ( Coercible) | |
| import Data.Kind ( Type ) | |
| type family Element (a :: Type) :: Type | |
| newtype WrapFunctor f (a :: Type) = WrapFunctor {runFunctor :: f a} | |
| type role WrapMono representational nominal | |
| newtype WrapMono mono b = WrapMono mono | |
| type instance Element (WrapMono mono b) = Element mono | |
| withMonoCoercible | |
| :: (Coercible (WrapMono mono (Element mono)) mono => r) | |
| -> r | |
| withMonoCoercible = \x -> x | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment