33{-# LANGUAGE DerivingStrategies #-}
44{-# LANGUAGE FlexibleInstances #-}
55{-# LANGUAGE OverloadedStrings #-}
6+ {-# LANGUAGE RecordWildCards #-}
67{-# LANGUAGE StandaloneDeriving #-}
78{-# LANGUAGE TemplateHaskell #-}
89
@@ -14,11 +15,14 @@ import Data.Time (TimeOfDay (..), TimeZone (..), fromGregorian)
1415import Dhall.TH (HaskellType (.. ))
1516import Test.Tasty (TestTree )
1617
18+ import qualified Data.Map
19+ import qualified Data.Sequence
1720import qualified Data.Text
1821import qualified Dhall
1922import qualified Dhall.TH
20- import qualified Test.Tasty as Tasty
21- import qualified Test.Tasty.HUnit as Tasty.HUnit
23+ import qualified Language.Haskell.TH as TH
24+ import qualified Test.Tasty as Tasty
25+ import qualified Test.Tasty.HUnit as Tasty.HUnit
2226
2327Dhall.TH. makeHaskellTypeFromUnion " T" " ./tests/th/example.dhall"
2428
@@ -88,7 +92,7 @@ makeHaskellTypeFromUnion = Tasty.HUnit.testCase "makeHaskellTypeFromUnion" $ do
8892 tod = TimeOfDay { todHour = 21 , todMin = 12 , todSec = 0 }
8993 day = fromGregorian 1976 4 1
9094 tz = TimeZone { timeZoneMinutes = 300 , timeZoneSummerOnly = False , timeZoneName = " " }
91-
95+
9296
9397Dhall.TH. makeHaskellTypesWith (Dhall.TH. defaultGenerateOptions
9498 { Dhall.TH. constructorModifier = (" My" <> )
@@ -99,15 +103,15 @@ Dhall.TH.makeHaskellTypesWith (Dhall.TH.defaultGenerateOptions
99103 , SingleConstructor " MyEmployee" " Employee" " ./tests/th/Employee.dhall"
100104 ]
101105
102-
106+
103107deriving instance Eq MyT
104108deriving instance Eq MyDepartment
105109deriving instance Eq MyEmployee
106110deriving instance Show MyT
107111deriving instance Show MyDepartment
108112deriving instance Show MyEmployee
109113
110-
114+
111115Dhall.TH. makeHaskellTypesWith (Dhall.TH. defaultGenerateOptions
112116 { Dhall.TH. constructorModifier = (" My" <> )
113117 , Dhall.TH. fieldModifier = (" my" <> ) . Data.Text. toTitle
@@ -217,3 +221,57 @@ Dhall.TH.makeHaskellTypesWith (Dhall.TH.defaultGenerateOptions
217221 })
218222 [ MultipleConstructors " StrictFields" " ./tests/th/example.dhall"
219223 ]
224+
225+ Dhall.TH. makeHaskellTypes
226+ [ let options = Dhall.TH. defaultGenerateOptions
227+ { Dhall.TH. fieldModifier = (" singleConstructorWithTest_" <> )
228+ }
229+ expr = " { field : Bool }"
230+ in
231+ SingleConstructorWith options " SingleConstructorWithTest" " SingleConstructorWithTest" expr
232+ , let options = Dhall.TH. defaultGenerateOptions
233+ { Dhall.TH. fieldModifier = (" multipleConstructorsWithTest_" <> )
234+ }
235+ expr = " < MultipleConstructorsWithTest1 : { field1 : Bool } | MultipleConstructorsWithTest2 : { field2 : Bool } >"
236+ in
237+ MultipleConstructorsWith options " MultipleConstructorsWithTest" expr
238+ ]
239+
240+ singleConstructorWithTest :: SingleConstructorWithTest -> Bool
241+ singleConstructorWithTest = singleConstructorWithTest_field
242+
243+ multipleConstructorsWithTest :: MultipleConstructorsWithTest -> Bool
244+ multipleConstructorsWithTest MultipleConstructorsWithTest1 {.. } = multipleConstructorsWithTest_field1
245+ multipleConstructorsWithTest MultipleConstructorsWithTest2 {.. } = multipleConstructorsWithTest_field2
246+
247+ Dhall.TH. makeHaskellTypes
248+ [ Predefined (TH. ConT ''Data. Sequence. Seq `TH. AppT ` TH. ConT ''Bool) " List Bool"
249+ , SingleConstructor " PredefinedTest1" " PredefinedTest1" " { predefinedField1 : List Bool }"
250+ , Predefined (TH. ConT ''Data. Map. Map `TH. AppT ` TH. ConT ''Data. Text. Text `TH. AppT ` TH. ConT ''Bool) " List { mapKey : Text, mapValue : Bool }"
251+ , SingleConstructor " PredefinedTest2" " PredefinedTest2" " { predefinedField2 : List { mapKey : Text, mapValue : Bool } }"
252+ ]
253+
254+ predefinedTest1 :: PredefinedTest1 -> Data.Sequence. Seq Bool
255+ predefinedTest1 (PredefinedTest1 xs) = xs
256+
257+ predefinedTest2 :: PredefinedTest2 -> Data.Map. Map Data.Text. Text Bool
258+ predefinedTest2 (PredefinedTest2 xs) = xs
259+
260+ Dhall.TH. makeHaskellTypes
261+ [ SingleConstructor " ScopedTestEmbedded1" " ScopedTestEmbedded1" " { scopedTestField : Bool }"
262+ , SingleConstructor " ScopedTest1" " ScopedTest1" " { scopedTestField1 : { scopedTestField : Bool } }"
263+ , Scoped
264+ [ SingleConstructor " ScopedTestEmbedded2" " ScopedTestEmbedded2" " { scopedTestField : Bool }"
265+ , SingleConstructor " ScopedTest2" " ScopedTest2" " { scopedTestField2 : { scopedTestField : Bool } }"
266+ ]
267+ , SingleConstructor " ScopedTest3" " ScopedTest3" " { scopedField3 : { scopedTestField : Bool } }"
268+ ]
269+
270+ scopedTest1 :: ScopedTest1 -> ScopedTestEmbedded1
271+ scopedTest1 (ScopedTest1 xs) = xs
272+
273+ scopedTest2 :: ScopedTest2 -> ScopedTestEmbedded2
274+ scopedTest2 (ScopedTest2 xs) = xs
275+
276+ scopedTest3 :: ScopedTest3 -> ScopedTestEmbedded1
277+ scopedTest3 (ScopedTest3 xs) = xs
0 commit comments