From 3a925ddd7968fac64c537e5e21241b1369fa9c18 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 8 Apr 2023 16:29:32 -0400
Subject: [PATCH] make option for adding strictness to TH-generated fields

---
 dhall/src/Dhall/TH.hs        |  7 ++++++-
 dhall/tests/Dhall/Test/TH.hs | 16 ++++++++++++----
 2 files changed, 18 insertions(+), 5 deletions(-)

diff --git a/dhall/src/Dhall/TH.hs b/dhall/src/Dhall/TH.hs
index cd265d9b1..f0271bd63 100644
--- a/dhall/src/Dhall/TH.hs
+++ b/dhall/src/Dhall/TH.hs
@@ -305,7 +305,9 @@ toConstructor
 toConstructor GenerateOptions{..} haskellTypes outerTypeName (constructorName, maybeAlternativeType) = do
     let name = Syntax.mkName (Text.unpack $ constructorModifier constructorName)
 
-    let bang = Bang NoSourceUnpackedness NoSourceStrictness
+    let strictness = if makeStrict then SourceStrict else NoSourceStrictness
+
+    let bang = Bang NoSourceUnpackedness strictness
 
     case maybeAlternativeType of
         Just dhallType
@@ -400,6 +402,8 @@ data GenerateOptions = GenerateOptions
     -- ^ Generate a `FromDhall` instance for the Haskell type
     , generateToDhallInstance :: Bool
     -- ^ Generate a `ToDhall` instance for the Haskell type
+    , makeStrict :: Bool
+    -- ^ Make all fields strict.
     }
 
 -- | A default set of options used by `makeHaskellTypes`. That means:
@@ -412,6 +416,7 @@ defaultGenerateOptions = GenerateOptions
     , fieldModifier = id
     , generateFromDhallInstance = True
     , generateToDhallInstance = True
+    , makeStrict = False
     }
 
 -- | This function generates `Dhall.InterpretOptions` that can be used for the
diff --git a/dhall/tests/Dhall/Test/TH.hs b/dhall/tests/Dhall/Test/TH.hs
index 0824a6bfc..5bd6a368c 100644
--- a/dhall/tests/Dhall/Test/TH.hs
+++ b/dhall/tests/Dhall/Test/TH.hs
@@ -7,10 +7,10 @@
 
 module Dhall.Test.TH where
 
-import Control.Exception (throwIO)
-import Data.Either.Validation (Validation(..))
-import Dhall.TH   (HaskellType (..))
-import Test.Tasty (TestTree)
+import Control.Exception      (throwIO)
+import Data.Either.Validation (Validation (..))
+import Dhall.TH               (HaskellType (..))
+import Test.Tasty             (TestTree)
 
 import qualified Data.Text
 import qualified Dhall
@@ -153,3 +153,11 @@ Dhall.TH.makeHaskellTypesWith (Dhall.TH.defaultGenerateOptions
 deriving instance Dhall.Generic NoInstancesT
 instance Dhall.FromDhall NoInstancesT
 instance Dhall.ToDhall NoInstancesT
+
+Dhall.TH.makeHaskellTypesWith (Dhall.TH.defaultGenerateOptions
+    { Dhall.TH.constructorModifier = ("Strict" <>)
+    , Dhall.TH.fieldModifier = ("strict" <>) . Data.Text.toTitle
+    , Dhall.TH.makeStrict = True
+    })
+    [ MultipleConstructors "StrictFields" "./tests/th/example.dhall"
+    ]