From abec75bcd2bf337c2e6298ccdbfafd199d0ae8bc Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 15 Apr 2023 23:42:52 -0400
Subject: [PATCH] add TimeZone/Date/TimeOfDay to TH

---
 dhall/src/Dhall/TH.hs        | 13 +++++++++++++
 dhall/tests/Dhall/Test/TH.hs | 15 +++++++++++++++
 dhall/tests/th/Time.dhall    |  1 +
 3 files changed, 29 insertions(+)
 create mode 100644 dhall/tests/th/Time.dhall

diff --git a/dhall/src/Dhall/TH.hs b/dhall/src/Dhall/TH.hs
index 08410ad22..ed08d0334 100644
--- a/dhall/src/Dhall/TH.hs
+++ b/dhall/src/Dhall/TH.hs
@@ -47,6 +47,7 @@ import qualified Data.List                   as List
 import qualified Data.Map                    as Map
 import qualified Data.Set                    as Set
 import qualified Data.Text                   as Text
+import qualified Data.Time                   as Time
 import qualified Data.Typeable               as Typeable
 import qualified Dhall
 import qualified Dhall.Core                  as Core
@@ -145,6 +146,9 @@ toNestedHaskellType typeParams haskellTypes = loop
       , "• ❰Integer❱                                                                     \n"
       , "• ❰Natural❱                                                                     \n"
       , "• ❰Text❱                                                                        \n"
+      , "• ❰Date❱                                                                        \n"
+      , "• ❰TimeOfDay❱                                                                   \n"
+      , "• ❰TimeZone❱                                                                    \n"
       , "• ❰List a❱     (where ❰a❱ is also a valid nested type)                          \n"
       , "• ❰Optional a❱ (where ❰a❱ is also a valid nested type)                          \n"
       , "• Another matching datatype declaration                                         \n"
@@ -175,6 +179,15 @@ toNestedHaskellType typeParams haskellTypes = loop
         Text ->
             return (ConT ''Text)
 
+        Date ->
+            return (ConT ''Time.Day)
+
+        Time ->
+            return (ConT ''Time.TimeOfDay)
+
+        TimeZone ->
+            return (ConT ''Time.TimeZone)
+
         App List dhallElementType -> do
             haskellElementType <- loop dhallElementType
 
diff --git a/dhall/tests/Dhall/Test/TH.hs b/dhall/tests/Dhall/Test/TH.hs
index 84e262969..b61a47e56 100644
--- a/dhall/tests/Dhall/Test/TH.hs
+++ b/dhall/tests/Dhall/Test/TH.hs
@@ -10,6 +10,7 @@ module Dhall.Test.TH where
 
 import Control.Exception      (throwIO)
 import Data.Either.Validation (Validation (..))
+import Data.Time              (TimeOfDay (..), TimeZone (..), fromGregorian)
 import Dhall.TH               (HaskellType (..))
 import Test.Tasty             (TestTree)
 
@@ -27,6 +28,7 @@ deriving instance Show T
 Dhall.TH.makeHaskellTypes
     [ MultipleConstructors "Department" "./tests/th/Department.dhall"
     , SingleConstructor "Employee" "MakeEmployee" "./tests/th/Employee.dhall"
+    , SingleConstructor "TimeExample" "TimeExample" "./tests/th/Time.dhall"
     ]
 
 deriving instance Eq   Department
@@ -35,6 +37,9 @@ deriving instance Show Department
 deriving instance Eq   Employee
 deriving instance Show Employee
 
+deriving instance Eq   TimeExample
+deriving instance Show TimeExample
+
 Dhall.TH.makeHaskellTypes
   [ SingleConstructor "Bar" "MakeBar" "(./tests/th/issue2066.dhall).Bar"
   , SingleConstructor "Foo" "MakeFoo" "(./tests/th/issue2066.dhall).Foo"
@@ -75,6 +80,16 @@ makeHaskellTypeFromUnion = Tasty.HUnit.testCase "makeHaskellTypeFromUnion" $ do
 
     Tasty.HUnit.assertEqual "" qux (Foo MakeFoo{ foo = 2, bar = MakeBar{ baz = 3 } })
 
+    timex <- Dhall.input Dhall.auto "let T = ./tests/th/Time.dhall in { txTime = 21:12:00, txDate = 1976-04-01, txTimeZone = +05:00 } : T"
+
+    Tasty.HUnit.assertEqual "" timex TimeExample { txTime = tod, txDate = day, txTimeZone = tz}
+
+    where
+      tod = TimeOfDay { todHour = 21, todMin = 12, todSec = 0 }
+      day = fromGregorian 1976 4 1
+      tz = TimeZone { timeZoneMinutes = 300, timeZoneSummerOnly = False, timeZoneName = "" }
+  
+
 Dhall.TH.makeHaskellTypesWith (Dhall.TH.defaultGenerateOptions
     { Dhall.TH.constructorModifier = ("My" <>)
     , Dhall.TH.fieldModifier = ("my" <>) . Data.Text.toTitle
diff --git a/dhall/tests/th/Time.dhall b/dhall/tests/th/Time.dhall
new file mode 100644
index 000000000..d60644000
--- /dev/null
+++ b/dhall/tests/th/Time.dhall
@@ -0,0 +1 @@
+{ txTime : Time, txDate : Date, txTimeZone : TimeZone }