summaryrefslogtreecommitdiff
path: root/testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.hs
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.hs')
-rw-r--r--testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.hs40
1 files changed, 40 insertions, 0 deletions
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.hs b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.hs
new file mode 100644
index 0000000000..cc76b469d5
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE AllowAmbiguousTypes, FunctionalDependencies, ScopedTypeVariables, PolyKinds, TypeApplications, DataKinds #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedRecordDot, OverloadedRecordUpdate #-}
+{-# LANGUAGE RebindableSyntax #-}
+import Prelude
+
+class HasField x r a | x r -> a where
+ hasField :: r -> (a -> r, a)
+
+getField :: forall x r a . HasField x r a => r -> a
+getField = snd . hasField @x -- Note: a.x = is getField @"x" a.
+
+setField :: forall x r a . HasField x r a => r -> a -> r
+setField = fst . hasField @x -- Note : a{x = b} is setField @"x" a b.
+
+-- 'Foo' has 'foo' field of type 'Bar'
+data Foo = Foo { foo :: Bar } deriving (Show, Eq)
+instance HasField "foo" Foo Bar where
+ hasField r = (\x -> case r of Foo { .. } -> Foo { foo = x, .. }, foo r)
+
+-- 'Bar' has a 'bar' field of type 'Baz'
+data Bar = Bar { bar :: Baz } deriving (Show, Eq)
+instance HasField "bar" Bar Baz where
+ hasField r = (\x -> case r of Bar { .. } -> Bar { bar = x, .. }, bar r)
+
+-- 'Baz' has a 'baz' field of type 'Quux'
+data Baz = Baz { baz :: Quux } deriving (Show, Eq)
+instance HasField "baz" Baz Quux where
+ hasField r = (\x -> case r of Baz { .. } -> Baz { baz = x, .. }, baz r)
+
+-- 'Quux' has a 'quux' field of type 'Int'
+data Quux = Quux { quux :: Int } deriving (Show, Eq)
+instance HasField "quux" Quux Int where
+ hasField r = (\x -> case r of Quux { .. } -> Quux { quux = x, .. }, quux r)
+
+main = do
+ let a = Foo { foo = Bar{ bar = Baz { baz = Quux { quux = 42 } } } }
+ let quux = "Expecto patronum!"
+ print $ a{foo.bar.baz.quux} -- Type error. Does a{foo.bar.baz.quux} get underlined?