Construct record datacons in tactics

plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen.hs

@@ -18,7 +18,7 @@ import           Data.Traversable
 import           DataCon
 import           Development.IDE.GHC.Compat
 import           GHC.Exts
-import           GHC.SourceGen (RdrNameStr)
+import           GHC.SourceGen (recordCon, RdrNameStr)
 import           GHC.SourceGen.Binds
 import           GHC.SourceGen.Expr
 import           GHC.SourceGen.Overloaded
@@ -187,8 +187,8 @@ buildDataCon
     -> DataCon            -- ^ The data con to build
     -> [Type]             -- ^ Type arguments for the data con
     -> RuleM (Trace, LHsExpr GhcPs)
-buildDataCon jdg dc apps = do
-  let args = dataConInstOrigArgTys' dc apps
+buildDataCon jdg dc tyapps = do
+  let args = dataConInstOrigArgTys' dc tyapps
   (tr, sgs)
       <- fmap unzipTrace
        $ traverse ( \(arg, n) ->
@@ -210,6 +210,10 @@ mkCon dcon (fmap unLoc -> args)
   | dataConIsInfix dcon
   , (lhs : rhs : args') <- args =
       noLoc $ foldl' (@@) (op lhs (coerceName dcon_name) rhs) args'
+  | Just fields <- getRecordFields dcon =
+      noLoc $ recordConE (coerceName dcon_name) $ do
+        (arg, (field, _)) <- zip args fields
+        pure (coerceName field, arg)
   | otherwise =
       noLoc $ foldl' (@@) (bvar' $ occName dcon_name) args
   where

plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/GHC.hs

@@ -9,7 +9,7 @@ import           Control.Monad.State
 import qualified Data.Map as M
 import           Data.Maybe (isJust)
 import           Data.Traversable
-import qualified DataCon as DataCon
+import           DataCon
 import           Development.IDE.GHC.Compat
 import           Generics.SYB (mkT, everywhere)
 import           Ide.Plugin.Tactic.Types
@@ -88,6 +88,18 @@ freshTyvars t = do
       ) t
 
 
+------------------------------------------------------------------------------
+-- | Given a datacon, extract its record fields' names and types. Returns
+-- nothing if the datacon is not a record.
+getRecordFields :: DataCon -> Maybe [(OccName, CType)]
+getRecordFields dc =
+  case dataConFieldLabels dc of
+    [] -> Nothing
+    lbls -> for lbls $ \lbl -> do
+      (_, ty) <- dataConFieldType_maybe dc $ flLabel lbl
+      pure (mkVarOccFS $ flLabel lbl, CType ty)
+
+
 ------------------------------------------------------------------------------
 -- | Is this an algebraic type?
 algebraicTyCon :: Type -> Maybe TyCon

test/functional/Tactic.hs

@@ -117,6 +117,7 @@ tests = testGroup
   , expectFail "GoldenFish.hs"              5 18 Auto ""
   , goldenTest "GoldenArbitrary.hs"         25 13 Auto ""
   , goldenTest "FmapBoth.hs"                2 12 Auto ""
+  , goldenTest "RecordCon.hs"               7  8 Auto ""
   ]
 
 

test/testdata/tactic/RecordCon.hs

@@ -0,0 +1,9 @@
+data MyRecord a = Record
+    { field1 :: a
+    , field2 :: Int
+    }
+
+blah :: (a -> Int) -> a -> MyRecord a
+blah = _
+
+

test/testdata/tactic/RecordCon.hs.expected

@@ -0,0 +1,9 @@
+data MyRecord a = Record
+    { field1 :: a
+    , field2 :: Int
+    }
+
+blah :: (a -> Int) -> a -> MyRecord a
+blah = (\ fai a -> Record {field1 = a, field2 = fai a})
+
+