summaryrefslogtreecommitdiff
path: root/test/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'test/Main.hs')
-rw-r--r--test/Main.hs47
1 files changed, 38 insertions, 9 deletions
diff --git a/test/Main.hs b/test/Main.hs
index 2b96ac9..769f0d7 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -18,22 +18,26 @@ 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 = TestType { testFoo :: Text, testBar :: Integer }
+data TestFlat = TestFlat { testFoo :: Text, testBar :: Integer }
deriving (Show, Eq)
instance Arbitrary TestFlat where
- arbitrary = TestType <$> arbitrary <*> arbitrary
+ 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 = TestType
+ readConfig = TestFlat
<$> readRequiredValue (Key ["foo"])
<*> readRequiredValue (Key ["bar"])
@@ -43,22 +47,28 @@ instance Config TestNested where
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 (TestType foo bar) = mkTrivialSource
+testTypeToTrivial (TestFlat foo bar) = mkTrivialSource
[(Key ["foo"], ConfigString (BS.encodeUtf8 foo)), (Key ["bar"], ConfigInteger bar)]
-testTypeToJson :: TestFlat -> SomeSource
-testTypeToJson (TestType foo bar) = mkJsonSource $
+testTypeToJson :: TestFlat -> A.Value
+testTypeToJson (TestFlat foo bar) =
A.object ["foo" A..= foo, "bar" A..= bar]
nestedToTrivial :: TestNested -> SomeSource
-nestedToTrivial (TestNested nfoo (TestType foo bar)) =
+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 (TestType foo bar)) =
+nestedToJson (TestNested nfoo (TestFlat foo bar)) =
mkJsonSource $ A.object
[ "foo" A..= nfoo
, "nested" A..= A.object
@@ -80,7 +90,7 @@ prop_nested :: TestNested -> Property
prop_nested = roundtripVia nestedToTrivial
prop_aeson_flat :: TestFlat -> Property
-prop_aeson_flat = roundtripVia testTypeToJson
+prop_aeson_flat = roundtripVia (mkJsonSource . testTypeToJson)
prop_aeson_nested :: TestNested -> Property
prop_aeson_nested = roundtripVia nestedToJson
@@ -95,6 +105,25 @@ 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