conftrack-0.0.1: test/Main.hs

{-# 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