diff options
3 files changed, 43 insertions, 0 deletions
diff --git a/testsuite/tests/simplCore/should_compile/T18346/MiniLens.hs b/testsuite/tests/simplCore/should_compile/T18346/MiniLens.hs new file mode 100644 index 0000000000..fb727b003b --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T18346/MiniLens.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE RankNTypes #-} + +module MiniLens ((^.), Getting, Lens', lens, view) where + +import Data.Functor.Const (Const(..)) + +type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t + +type Lens' s a = Lens s s a a + +lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b +lens sa sbt afb s = sbt s <$> afb (sa s) +{-# INLINE lens #-} + +type Getting r s a = (a -> Const r a) -> s -> Const r s + +view :: Getting a s a -> s -> a +view l = getConst . l Const +{-# INLINE view #-} + +(^.) :: s -> Getting a s a -> a +s ^. l = getConst (l Const s) +{-# INLINE (^.) #-} diff --git a/testsuite/tests/simplCore/should_compile/T18346/T18346.hs b/testsuite/tests/simplCore/should_compile/T18346/T18346.hs new file mode 100644 index 0000000000..d0dbf88cd6 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T18346/T18346.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE RankNTypes #-} + +module GHCBug (field) where + +import MiniLens ((^.), Getting, Lens', lens, view) + +t' :: Getting () () () +t' = lens id const +{-# NOINLINE t' #-} + +mlift :: Functor f => Getting b a b -> Lens' (f a) (f b) +mlift l = lens (fmap (^. l)) const +{-# INLINE mlift #-} + +newtype Field = F (Maybe () -> Maybe ()) + +field :: Field +field = F (view (mlift t')) diff --git a/testsuite/tests/simplCore/should_compile/T18346/all.T b/testsuite/tests/simplCore/should_compile/T18346/all.T new file mode 100644 index 0000000000..008ae05ba6 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T18346/all.T @@ -0,0 +1,2 @@ +test('T18346', [extra_files(['MiniLens.hs'])], multimod_compile, ['T18346.hs', '-v0']) + |