From 2427e03e3526ca9dd8e466625a04cccb78317dd9 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Sat, 27 Feb 2021 23:17:25 -0800 Subject: [PATCH 1/2] Don't use record notation for single-field datacons --- .../src/Ide/Plugin/Tactic/CodeGen/Utils.hs | 3 ++- plugins/hls-tactics-plugin/test/GoldenSpec.hs | 1 + plugins/hls-tactics-plugin/test/golden/NewtypeRecord.hs | 7 +++++++ .../test/golden/NewtypeRecord.hs.expected | 7 +++++++ 4 files changed, 17 insertions(+), 1 deletion(-) create mode 100644 plugins/hls-tactics-plugin/test/golden/NewtypeRecord.hs create mode 100644 plugins/hls-tactics-plugin/test/golden/NewtypeRecord.hs.expected diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen/Utils.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen/Utils.hs index 577e9ab94a..86878f4852 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen/Utils.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen/Utils.hs @@ -21,7 +21,8 @@ mkCon dcon (fmap unLoc -> args) | dataConIsInfix dcon , (lhs : rhs : args') <- args = noLoc $ foldl' (@@) (op lhs (coerceName dcon_name) rhs) args' - | Just fields <- getRecordFields dcon = + | Just fields <- getRecordFields dcon + , length fields >= 2 = noLoc $ recordConE (coerceName dcon_name) $ do (arg, (field, _)) <- zip args fields pure (coerceName field, arg) diff --git a/plugins/hls-tactics-plugin/test/GoldenSpec.hs b/plugins/hls-tactics-plugin/test/GoldenSpec.hs index 7a8b63e0d8..97eec22a91 100644 --- a/plugins/hls-tactics-plugin/test/GoldenSpec.hs +++ b/plugins/hls-tactics-plugin/test/GoldenSpec.hs @@ -109,6 +109,7 @@ spec = do autoTest "GoldenArbitrary.hs" 25 13 autoTest "FmapBoth.hs" 2 12 autoTest "RecordCon.hs" 7 8 + autoTest "NewtypeRecord.hs" 6 8 autoTest "FmapJoin.hs" 2 14 autoTest "Fgmap.hs" 2 9 autoTest "FmapJoinInLet.hs" 4 19 diff --git a/plugins/hls-tactics-plugin/test/golden/NewtypeRecord.hs b/plugins/hls-tactics-plugin/test/golden/NewtypeRecord.hs new file mode 100644 index 0000000000..82b994b936 --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/NewtypeRecord.hs @@ -0,0 +1,7 @@ +newtype MyRecord a = Record + { field1 :: a + } + +blah :: (a -> Int) -> a -> MyRecord a +blah = _ + diff --git a/plugins/hls-tactics-plugin/test/golden/NewtypeRecord.hs.expected b/plugins/hls-tactics-plugin/test/golden/NewtypeRecord.hs.expected new file mode 100644 index 0000000000..4bbd4d283a --- /dev/null +++ b/plugins/hls-tactics-plugin/test/golden/NewtypeRecord.hs.expected @@ -0,0 +1,7 @@ +newtype MyRecord a = Record + { field1 :: a + } + +blah :: (a -> Int) -> a -> MyRecord a +blah _ = Record + From d121d15c9dc04857c4a79ec635f7aa1fba1dc262 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Sat, 27 Feb 2021 23:21:36 -0800 Subject: [PATCH 2/2] Comment as to why this new check is here --- .../hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen/Utils.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen/Utils.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen/Utils.hs index 86878f4852..eb728066bc 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen/Utils.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen/Utils.hs @@ -22,7 +22,7 @@ mkCon dcon (fmap unLoc -> args) , (lhs : rhs : args') <- args = noLoc $ foldl' (@@) (op lhs (coerceName dcon_name) rhs) args' | Just fields <- getRecordFields dcon - , length fields >= 2 = + , length fields >= 2 = -- record notation is unnatural on single field ctors noLoc $ recordConE (coerceName dcon_name) $ do (arg, (field, _)) <- zip args fields pure (coerceName field, arg)