nested values, tests, and aeson

1 files changed, 74 insertions, 20 deletions

diff --git a/test/Main.hs b/test/Main.hs
index fa6a3fb..99b01d8 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -1,37 +1,91 @@
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE TemplateHaskell #-}
 module Main (main) where
 
 import Conftrack
-import Conftrack.Value
-import Conftrack.Source
+import Conftrack.Source.Trivial (mkTrivialSource)
+import Conftrack.Source.Aeson (mkJsonSource)
 
-import qualified Data.Map.Strict as M
 import Data.Text (Text)
-import Control.Exception (assert)
+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
 
-data TestType = TestType { testFoo :: Text, testBar :: Integer }
+
+data TestFlat = TestType { testFoo :: Text, testBar :: Integer }
   deriving (Show, Eq)
 
-instance Config TestType where
+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
     <$> readValue (Key ["foo"])
     <*> readValue (Key ["bar"])
 
-main :: IO ()
-main = do
-  let trivial = Trivial (M.fromList [(Key ["foo"], ConfigText "foo"), (Key ["bar"], ConfigInteger 10)])
-  Right (config :: TestType, _, _) <- runFetchConfig [SomeSource (trivial, [])]
-  () <- assert (config == TestType "foo" 10) (pure ())
+instance Config TestNested where
+  readConfig = TestNested
+    <$> readValue (Key ["foo"])
+    <*> readNested (Key ["nested"])
+
+testTypeToTrivial :: TestFlat -> SomeSource
+testTypeToTrivial (TestType foo bar) = mkTrivialSource
+  [(Key ["foo"], ConfigString (BS.encodeUtf8 foo)), (Key ["bar"], ConfigInteger bar)]
 
-  let trivial = Trivial (M.fromList [(Key ["fo"], ConfigText "foo"), (Key ["bar"], ConfigInteger 10)])
-  Left [NotPresent] <- runFetchConfig @TestType [SomeSource (trivial, [])]
+testTypeToJson :: TestFlat -> SomeSource
+testTypeToJson (TestType foo bar) = mkJsonSource $
+  A.object ["foo" A..= foo, "bar" A..= bar]
 
-  let stack1 = Trivial (M.fromList [(Key ["foo"], ConfigText "foo")])
-  let stack2 = Trivial (M.fromList [(Key ["bar"], ConfigInteger 10), (Key ["foo"], ConfigText "blub")])
-  Right (config :: TestType, origins, warnings) <- runFetchConfig [SomeSource (stack1, []), SomeSource (stack2, [])]
-  () <- assert (config == TestType "foo" 11) (pure ())
-  print origins
-  print warnings
+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)]
 
-  print config
+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
+
+-- see quickcheck docs for why this return is here
+return []
+runTests = $quickCheckAll
+
+main :: IO ()
+main = do
+  good <- runTests
+  if good then exitSuccess else exitFailure