Support NamedFieldPuns (#84)

chrisdone · Jan 23, 2025 · d8a8ba2 · d8a8ba2
1 parent 698449d
commit d8a8ba2
Show file tree

Hide file tree

Showing 2 changed files with 8 additions and 1 deletion.
diff --git a/examples/34-field-puns.hell b/examples/34-field-puns.hell
@@ -0,0 +1,6 @@
+data Foo = Foo { bar, mu :: Int }
+main = do
+  let bar = 123
+  let mu = 666
+  let r = Main.Foo{bar,mu}
+  IO.print $ Record.get @"bar" @Int r
diff --git a/src/Hell.hs b/src/Hell.hs
@@ -391,6 +391,7 @@ makeConstructRecord qname fields =
     $ map
       ( \case
           HSE.FieldUpdate _ (HSE.UnQual _ (HSE.Ident _ i)) expr -> (i, expr)
+          HSE.FieldPun _ v@(HSE.UnQual _ (HSE.Ident l' i)) -> (i, HSE.Var l' v)
           f -> error $ "Invalid field: " ++ show f
       )
       fields
@@ -2112,7 +2113,7 @@ data File = File {
 parseFile :: String -> IO (Either String File)
 parseFile filePath = do
   string <- ByteString.readFile filePath
-  pure $ case HSE.parseModuleWithMode HSE.defaultParseMode {HSE.parseFilename = filePath, HSE.extensions = HSE.extensions HSE.defaultParseMode ++ [HSE.EnableExtension HSE.PatternSignatures, HSE.EnableExtension HSE.DataKinds, HSE.EnableExtension HSE.BlockArguments, HSE.EnableExtension HSE.TypeApplications]} (Text.unpack (dropShebang (Text.decodeUtf8 string))) >>= parseModule of
+  pure $ case HSE.parseModuleWithMode HSE.defaultParseMode {HSE.parseFilename = filePath, HSE.extensions = HSE.extensions HSE.defaultParseMode ++ [HSE.EnableExtension HSE.PatternSignatures, HSE.EnableExtension HSE.DataKinds, HSE.EnableExtension HSE.BlockArguments, HSE.EnableExtension HSE.TypeApplications, HSE.EnableExtension HSE.NamedFieldPuns]} (Text.unpack (dropShebang (Text.decodeUtf8 string))) >>= parseModule of
     HSE.ParseFailed l e -> Left $ "Parse error: " <> HSE.prettyPrint l <> ": " <> e
     HSE.ParseOk file -> Right file