Fix unused variable warnings in TH-generated code for empty records

When a record has zero fields, the TH code generators for various tool
instances would bind variables (e.g. lambda parameters) that were never
referenced in the body. With -Wall/-Wunused-matches, GHC flags these
as warnings in the generated splices.

Fix by using wildcard patterns (wildP) instead of named bindings (varP)
when srFields is empty, across all affected generators:

- Tools/JSON.hs (ToJSON): \x -> object [] => \_ -> object []
- Tools/JSON.hs (FromJSONWithErrs): (Object x) => (Object _)
- Tools/QuickCheck.hs (Arbitrary): sized (\x -> pure Con) => sized (\_ -> ...)
- Tools/DeepSeq.hs (NFData): \x -> () => \_ -> ()
- Tools/Example.hs (Example): sized (\x -> pure Con) => sized (\_ -> ...)
- Tools/Traversal.hs (traversal): \f r -> pure Con => \_ _ -> pure Con

Author: adinapoli

src/Data/API/Tools/DeepSeq.hs

@@ -31,8 +31,10 @@ gen_sr = mkTool $ \ ts (an, sr) -> do
     x <- newName "x"
     optionalInstanceD ts ''NFData [nodeRepT an] [simpleD 'rnf (bdy an sr x)]
   where
-    bdy an sr x = lamE [varP x] $ foldr f [e|()|] (srFields sr)
+    bdy an sr x = lamE [pat] $ foldr f [e|()|] (srFields sr)
       where
+        pat | null (srFields sr) = wildP
+            | otherwise          = varP x
         f (fn,_) r = [e| rnf ($(nodeFieldE an fn) $(varE x)) `seq` $r |]
 
 gen_su :: Tool (APINode, SpecUnion)

src/Data/API/Tools/Example.hs

@@ -108,7 +108,9 @@ gen_sr_ex :: Tool (APINode, SpecRecord)
 gen_sr_ex = mkTool $ \ ts (an, sr) -> optionalInstanceD ts ''Example [nodeRepT an] [simpleD 'example (bdy an sr)]
   where
     bdy an sr = do x <- newName "x"
-                   appE (varE 'QC.sized) $ lamE [varP x] $
+                   let pat | null (srFields sr) = wildP
+                           | otherwise          = varP x
+                   appE (varE 'QC.sized) $ lamE [pat] $
                        applicativeE (nodeConE an) $
                        replicate (length $ srFields sr) $
                        [e| QC.resize ($(varE x) `div` 2) example |]

src/Data/API/Tools/JSON.hs

@@ -118,10 +118,13 @@ gen_sr_to = mkTool $ \ ts (an, sr) -> do
     x <- newName "x"
     optionalInstanceD ts ''ToJSON [nodeRepT an] [simpleD 'toJSON (bdy an sr x)]
   where
-    bdy an sr x = lamE [varP x] $
+    bdy an sr x = lamE [pat] $
             varE 'object `appE`
             listE [ [e| $(fieldNameE fn) .= $(nodeFieldE an fn) $(varE x) |]
                   | (fn, _) <- srFields sr ]
+      where
+        pat | null (srFields sr) = wildP
+            | otherwise          = varP x
 
 
 {-
@@ -142,8 +145,10 @@ gen_sr_fm = mkTool $ \ ts (an, sr) -> do
     optionalInstanceD ts ''FromJSONWithErrs [nodeRepT an]
                       [funD 'parseJSONWithErrs [cl an sr x, clNull, cl' x]]
   where
-    cl an sr x  = clause [conP 'Object [varP x]] (normalB bdy) []
+    cl an sr x  = clause [conP 'Object [pat]] (normalB bdy) []
       where
+        pat | null (srFields sr) = wildP
+            | otherwise          = varP x
         bdy = applicativeE (nodeConE an) $ map project (srFields sr)
         project (fn, ft) = [e| withDefaultField ro (fmap defaultValueAsJsValue mb_dv) $(fieldNameE fn) parseJSONWithErrs $(varE x) |]
           where ro    = ftReadOnly ft

src/Data/API/Tools/QuickCheck.hs

@@ -125,7 +125,9 @@ gen_sr_ab = mkTool $ \ ts (an, sr) -> mkArbitraryInstance ts (nodeRepT an) (bdy
     -- by giving an arbitrary implementation like this:
     --   sized (\ x -> JobSpecId <$> resize (x `div` 2) arbitrary <*> ...)
     bdy an sr = do x <- newName "x"
-                   appE (varE 'QC.sized) $ lamE [varP x] $
+                   let pat | null (srFields sr) = wildP
+                           | otherwise          = varP x
+                   appE (varE 'QC.sized) $ lamE [pat] $
                      applicativeE (nodeConE an) $
                      replicate (length $ srFields sr) $
                      [e| QC.resize ($(varE x) `div` 2) arbitrary |]

src/Data/API/Tools/Traversal.hs

@@ -112,7 +112,9 @@ traversalRecord napi targets x an sr
     bdy = do
       f <- newName "f"
       r <- newName "r"
-      lamE [varP f, varP r] $ applicativeE (nodeConE an) $ map (traverseField f r) (srFields sr)
+      let (patF, patR) | null (srFields sr) = (wildP, wildP)
+                        | otherwise          = (varP f, varP r)
+      lamE [patF, patR] $ applicativeE (nodeConE an) $ map (traverseField f r) (srFields sr)
     traverseField f r (fn, fty) = [e| $(traverser napi targets x (ftType fty)) $(varE f) ($(nodeFieldE an fn) $(varE r)) |]