Skip to content

Commit eb1b806

Browse files
committed
Added tests
1 parent 7e38f71 commit eb1b806

File tree

2 files changed

+64
-6
lines changed

2 files changed

+64
-6
lines changed

dhall/src/Dhall/TH.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -264,7 +264,7 @@ toDeclaration globalGenerateOptions haskellTypes typ =
264264
MultipleConstructorsWith{..} -> uncurry (fromMulti options typeName) $ getTypeParams code
265265
Predefined{} -> return []
266266
Scoped scopedHaskellTypes ->
267-
let haskellTypes' = haskellTypes <> scopedHaskellTypes
267+
let haskellTypes' = scopedHaskellTypes <> haskellTypes
268268
in
269269
concat <$> traverse (toDeclaration globalGenerateOptions haskellTypes') scopedHaskellTypes
270270
where

dhall/tests/Dhall/Test/TH.hs

Lines changed: 63 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@
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)
1415
import Dhall.TH (HaskellType (..))
1516
import Test.Tasty (TestTree)
1617

18+
import qualified Data.Map
19+
import qualified Data.Sequence
1720
import qualified Data.Text
1821
import qualified Dhall
1922
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
2226

2327
Dhall.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

9397
Dhall.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+
103107
deriving instance Eq MyT
104108
deriving instance Eq MyDepartment
105109
deriving instance Eq MyEmployee
106110
deriving instance Show MyT
107111
deriving instance Show MyDepartment
108112
deriving instance Show MyEmployee
109113

110-
114+
111115
Dhall.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

Comments
 (0)