shithub: MicroHs

Download patch

ref: e403ca5194a5787bf75fa8478b8bd7427f7d7690
parent: 706658c30b47dec721cbb955f33cb766342c7694
author: Lennart Augustsson <lennart@augustsson.net>
date: Thu Jan 2 06:16:30 EST 2025

Don't generate GetField/SetField for polymorphic fields.

--- a/src/MicroHs/Deriving.hs
+++ b/src/MicroHs/Deriving.hs
@@ -107,11 +107,16 @@
               rhs = eLam [eFld] conApp
       getName = mkGetName tycon fld
 
-  pure [ Sign [getName] $ eForall iks $ lhsToType (qtycon, iks) `tArrow` fldty
-       , Fcn getName $ map conEqnGet cs
-       , Instance hdrGet [BFcn igetField [eEqn [eDummy] $ EVar getName] ]
-       , Instance hdrSet [BFcn isetField $ map conEqnSet cs]
-       ]
+      -- XXX A hack, we can't handle forall yet.
+      validType (EForall _ _ _) = False
+      validType _ = True
+
+  pure $ [ Sign [getName] $ eForall iks $ lhsToType (qtycon, iks) `tArrow` fldty
+         , Fcn getName $ map conEqnGet cs ]
+    ++ if not (validType fldty) then [] else
+         [ Instance hdrGet [BFcn igetField [eEqn [eDummy] $ EVar getName] ]
+         , Instance hdrSet [BFcn isetField $ map conEqnSet cs]
+         ]
 
 nameHasField :: String
 nameHasField = "Data.Records.HasField"