summaryrefslogtreecommitdiff
path: root/tests/examples/pre-ghc86/overloadedrecflds_generics.hs
diff options
context:
space:
mode:
Diffstat (limited to 'tests/examples/pre-ghc86/overloadedrecflds_generics.hs')
-rw-r--r--tests/examples/pre-ghc86/overloadedrecflds_generics.hs50
1 files changed, 50 insertions, 0 deletions
diff --git a/tests/examples/pre-ghc86/overloadedrecflds_generics.hs b/tests/examples/pre-ghc86/overloadedrecflds_generics.hs
new file mode 100644
index 0000000..c2b4bd6
--- /dev/null
+++ b/tests/examples/pre-ghc86/overloadedrecflds_generics.hs
@@ -0,0 +1,50 @@
+-- Test that DuplicateRecordFields doesn't affect the metadata
+-- generated by GHC.Generics or Data.Data
+
+-- Based on a Stack Overflow post by bennofs
+-- (http://stackoverflow.com/questions/24474581)
+-- licensed under cc by-sa 3.0
+
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeFamilies #-}
+
+import GHC.Generics
+import Data.Data
+import Data.Proxy
+
+type family FirstSelector (f :: * -> *) :: Meta
+type instance FirstSelector (M1 D x f) = FirstSelector f
+type instance FirstSelector (M1 C x f) = FirstSelector f
+type instance FirstSelector (a :*: b) = FirstSelector a
+type instance FirstSelector (M1 S s f) = s
+
+data SelectorProxy (s :: Meta) (f :: * -> *) a = SelectorProxy
+type SelectorProxy' (s :: Meta) = SelectorProxy s Proxy ()
+
+-- Extract the first selector name using GHC.Generics
+firstSelectorName :: forall a. Selector (FirstSelector (Rep a))
+ => Proxy a -> String
+firstSelectorName _ =
+ selName (SelectorProxy :: SelectorProxy' (FirstSelector (Rep a)))
+
+-- Extract the list of selector names for a constructor using Data.Data
+selectorNames :: Data a => a -> [String]
+selectorNames = constrFields . toConstr
+
+data T = MkT { foo :: Int } deriving (Data, Generic)
+data U = MkU { foo :: Int, bar :: Bool } deriving (Data, Generic)
+
+main = do -- This should yield "foo", not "$sel:foo:MkT"
+ print (firstSelectorName (Proxy :: Proxy T))
+ -- Similarly this should yield "foo"
+ print (firstSelectorName (Proxy :: Proxy U))
+ -- This should yield ["foo"]
+ print (selectorNames (MkT 3))
+ -- And this should yield ["foo","bar"]
+ print (selectorNames (MkU 3 True))