1{-# LANGUAGE
2    ScopedTypeVariables
3  , DataKinds
4  , GADTs
5  , RankNTypes
6  , TypeOperators
7  , PolyKinds -- Comment out PolyKinds and the bug goes away.
8  #-}
9{-# OPTIONS_GHC -O #-}
10  -- The bug is in SimplUtils.abstractFloats, so we need -O to trigger it
11
12module KeyValue where
13
14data AccValidation err a = AccFailure err | AccSuccess a
15
16data KeyValueError = MissingValue
17
18type WithKeyValueError = AccValidation [KeyValueError]
19
20missing :: forall f rs. RecApplicative rs => Rec (WithKeyValueError :. f) rs
21missing = rpure missingField
22  where
23    missingField :: forall x. (WithKeyValueError :. f) x
24    missingField = Compose $ AccFailure [MissingValue]
25
26data Rec :: (u -> *) -> [u] -> * where
27  RNil :: Rec f '[]
28  (:&) :: !(f r) -> !(Rec f rs) -> Rec f (r ': rs)
29
30newtype Compose (f :: l -> *) (g :: k -> l) (x :: k)
31  = Compose { getCompose :: f (g x) }
32
33type (:.) f g = Compose f g
34
35class RecApplicative rs where
36  rpure
37    :: (forall x. f x)
38    -> Rec f rs
39