1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE QuasiQuotes #-}
module Main (main) where
import Conftrack
import Conftrack.Source.Trivial (mkTrivialSource)
import Conftrack.Source.Aeson (mkJsonSource)
import Data.Text (Text)
import qualified Data.Aeson as A
import Test.QuickCheck
import Test.QuickCheck.Monadic
import Test.QuickCheck.Instances ()
import System.Exit (exitFailure, exitSuccess)
import qualified Data.Text.Encoding as BS
import Data.List ((\\))
import Data.Maybe (isNothing)
data TestFlat = TestFlat { testFoo :: Text, testBar :: Integer }
deriving (Show, Eq)
instance Arbitrary TestFlat where
arbitrary = TestFlat <$> arbitrary <*> arbitrary
data TestNested = TestNested { nestedFoo :: Text, nestedTest :: TestFlat }
deriving (Show, Eq)
data TestOptionalNested = TestOptionalNested { opNestedFoo :: Text, opNestedTest :: Maybe TestFlat }
deriving (Show, Eq)
instance Arbitrary TestNested where
arbitrary = TestNested <$> arbitrary <*> arbitrary
instance Config TestFlat where
readConfig = TestFlat
<$> readRequiredValue (Key ["foo"])
<*> readRequiredValue (Key ["bar"])
instance Config TestNested where
readConfig = do
a <- readRequiredValue (Key ["foo"])
b <- readNested (Key ["nested"])
pure (TestNested a b)
instance Config TestOptionalNested where
readConfig = do
a <- readRequiredValue (Key ["foo"])
b <- readNestedOptional (Key ["nested"])
pure (TestOptionalNested a b)
testTypeToTrivial :: TestFlat -> SomeSource
testTypeToTrivial (TestFlat foo bar) = mkTrivialSource
[(Key ["foo"], ConfigString (BS.encodeUtf8 foo)), (Key ["bar"], ConfigInteger bar)]
testTypeToJson :: TestFlat -> A.Value
testTypeToJson (TestFlat foo bar) =
A.object ["foo" A..= foo, "bar" A..= bar]
nestedToTrivial :: TestNested -> SomeSource
nestedToTrivial (TestNested nfoo (TestFlat foo bar)) =
mkTrivialSource [ (Key ["foo"], ConfigString (BS.encodeUtf8 nfoo))
, (Key ["nested", "foo"], ConfigString (BS.encodeUtf8 foo))
, (Key ["nested", "bar"], ConfigInteger bar)]
nestedToJson :: TestNested -> SomeSource
nestedToJson (TestNested nfoo (TestFlat foo bar)) =
mkJsonSource $ A.object
[ "foo" A..= nfoo
, "nested" A..= A.object
[ "foo" A..= foo
, "bar" A..=bar
]
]
roundtripVia :: (Eq a, Config a) => (a -> SomeSource) -> a -> Property
roundtripVia f val = monadicIO $ do
let trivial = f val
Right (config :: a, _, _) <- run $ runFetchConfig [trivial]
assert (config == val)
prop_flat :: TestFlat -> Property
prop_flat = roundtripVia testTypeToTrivial
prop_nested :: TestNested -> Property
prop_nested = roundtripVia nestedToTrivial
prop_aeson_flat :: TestFlat -> Property
prop_aeson_flat = roundtripVia (mkJsonSource . testTypeToJson)
prop_aeson_nested :: TestNested -> Property
prop_aeson_nested = roundtripVia nestedToJson
prop_flat_keys :: Property
prop_flat_keys = monadicIO $ do
keys <- run $ configKeysOf @TestFlat
assert (null (keys \\ [ [key|foo|], [key|bar|] ]))
prop_nested_keys :: Property
prop_nested_keys = monadicIO $ do
keys <- run $ configKeysOf @TestNested
assert (null (keys \\ [ [key|foo|], [key|nested.bar|], [key|nested.foo|] ]))
prop_nested_optional_nothing :: Property
prop_nested_optional_nothing = monadicIO $ do
Right (conf, _, warnings) <- run $ runFetchConfig [ mkJsonSource (A.object ["foo" A..= ("bar" :: Text)]) ]
assert (null warnings)
assert (isNothing (opNestedTest conf))
prop_nested_optional_partial :: Property
prop_nested_optional_partial = monadicIO $ do
Left errors <- run $ runFetchConfig @TestOptionalNested [ mkJsonSource (A.object ["foo" A..= ("bar" :: Text), "nested" A..= A.object [ "foo" A..= ("bar" :: Text) ]]) ]
assert (not (null errors))
prop_nested_optional_just :: TestFlat -> Property
prop_nested_optional_just nested = monadicIO $ do
Right (conf, _, warnings) <- run $ runFetchConfig [
mkJsonSource (A.object ["foo" A..= ("bar" :: Text), "nested" A..= testTypeToJson nested ])
]
assert (null warnings)
assert (opNestedTest conf == Just nested)
-- see quickcheck docs for why this return is here
return []
runTests :: IO Bool
runTests = $quickCheckAll
main :: IO ()
main = do
good <- runTests
if good then exitSuccess else exitFailure
|
