summaryrefslogtreecommitdiff
path: root/tests/examples/ghc86/T10934.hs
diff options
context:
space:
mode:
Diffstat (limited to 'tests/examples/ghc86/T10934.hs')
-rw-r--r--tests/examples/ghc86/T10934.hs38
1 files changed, 38 insertions, 0 deletions
diff --git a/tests/examples/ghc86/T10934.hs b/tests/examples/ghc86/T10934.hs
new file mode 100644
index 0000000..be64915
--- /dev/null
+++ b/tests/examples/ghc86/T10934.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE
+ ScopedTypeVariables
+ , DataKinds
+ , GADTs
+ , RankNTypes
+ , TypeOperators
+ , PolyKinds -- Comment out PolyKinds and the bug goes away.
+ #-}
+{-# OPTIONS_GHC -O #-}
+ -- The bug is in SimplUtils.abstractFloats, so we need -O to trigger it
+
+module KeyValue where
+
+data AccValidation err a = AccFailure err | AccSuccess a
+
+data KeyValueError = MissingValue
+
+type WithKeyValueError = AccValidation [KeyValueError]
+
+missing :: forall f rs. RecApplicative rs => Rec (WithKeyValueError :. f) rs
+missing = rpure missingField
+ where
+ missingField :: forall x. (WithKeyValueError :. f) x
+ missingField = Compose $ AccFailure [MissingValue]
+
+data Rec :: (u -> Type) -> [u] -> Type where
+ RNil :: Rec f '[]
+ (:&) :: !(f r) -> !(Rec f rs) -> Rec f (r ': rs)
+
+newtype Compose (f :: l -> Type) (g :: k -> l) (x :: k)
+ = Compose { getCompose :: f (g x) }
+
+type (:.) f g = Compose f g
+
+class RecApplicative rs where
+ rpure
+ :: (forall x. f x)
+ -> Rec f rs