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
|
{-# 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 ((\\))
data TestFlat = TestType { testFoo :: Text, testBar :: Integer }
deriving (Show, Eq)
instance Arbitrary TestFlat where
arbitrary = TestType <$> arbitrary <*> arbitrary
data TestNested = TestNested { nestedFoo :: Text, nestedTest :: TestFlat }
deriving (Show, Eq)
instance Arbitrary TestNested where
arbitrary = TestNested <$> arbitrary <*> arbitrary
instance Config TestFlat where
readConfig = TestType
<$> readRequiredValue (Key ["foo"])
<*> readRequiredValue (Key ["bar"])
instance Config TestNested where
readConfig = do
a <- readRequiredValue (Key ["foo"])
b <- readNested (Key ["nested"])
pure (TestNested a b)
testTypeToTrivial :: TestFlat -> SomeSource
testTypeToTrivial (TestType foo bar) = mkTrivialSource
[(Key ["foo"], ConfigString (BS.encodeUtf8 foo)), (Key ["bar"], ConfigInteger bar)]
testTypeToJson :: TestFlat -> SomeSource
testTypeToJson (TestType foo bar) = mkJsonSource $
A.object ["foo" A..= foo, "bar" A..= bar]
nestedToTrivial :: TestNested -> SomeSource
nestedToTrivial (TestNested nfoo (TestType 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 (TestType 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 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|] ]))
-- 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
|
