3
3
{-# LANGUAGE DerivingStrategies #-}
4
4
{-# LANGUAGE FlexibleInstances #-}
5
5
{-# LANGUAGE OverloadedStrings #-}
6
+ {-# LANGUAGE RecordWildCards #-}
6
7
{-# LANGUAGE StandaloneDeriving #-}
7
8
{-# LANGUAGE TemplateHaskell #-}
8
9
@@ -14,11 +15,14 @@ import Data.Time (TimeOfDay (..), TimeZone (..), fromGregorian)
14
15
import Dhall.TH (HaskellType (.. ))
15
16
import Test.Tasty (TestTree )
16
17
18
+ import qualified Data.Map
19
+ import qualified Data.Sequence
17
20
import qualified Data.Text
18
21
import qualified Dhall
19
22
import 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
22
26
23
27
Dhall.TH. makeHaskellTypeFromUnion " T" " ./tests/th/example.dhall"
24
28
@@ -88,7 +92,7 @@ makeHaskellTypeFromUnion = Tasty.HUnit.testCase "makeHaskellTypeFromUnion" $ do
88
92
tod = TimeOfDay { todHour = 21 , todMin = 12 , todSec = 0 }
89
93
day = fromGregorian 1976 4 1
90
94
tz = TimeZone { timeZoneMinutes = 300 , timeZoneSummerOnly = False , timeZoneName = " " }
91
-
95
+
92
96
93
97
Dhall.TH. makeHaskellTypesWith (Dhall.TH. defaultGenerateOptions
94
98
{ Dhall.TH. constructorModifier = (" My" <> )
@@ -99,15 +103,15 @@ Dhall.TH.makeHaskellTypesWith (Dhall.TH.defaultGenerateOptions
99
103
, SingleConstructor " MyEmployee" " Employee" " ./tests/th/Employee.dhall"
100
104
]
101
105
102
-
106
+
103
107
deriving instance Eq MyT
104
108
deriving instance Eq MyDepartment
105
109
deriving instance Eq MyEmployee
106
110
deriving instance Show MyT
107
111
deriving instance Show MyDepartment
108
112
deriving instance Show MyEmployee
109
113
110
-
114
+
111
115
Dhall.TH. makeHaskellTypesWith (Dhall.TH. defaultGenerateOptions
112
116
{ Dhall.TH. constructorModifier = (" My" <> )
113
117
, Dhall.TH. fieldModifier = (" my" <> ) . Data.Text. toTitle
@@ -217,3 +221,57 @@ Dhall.TH.makeHaskellTypesWith (Dhall.TH.defaultGenerateOptions
217
221
})
218
222
[ MultipleConstructors " StrictFields" " ./tests/th/example.dhall"
219
223
]
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