{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TemplateHaskell #-}
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


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
    <$> readValue (Key ["foo"])
    <*> readValue (Key ["bar"])

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)]

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

-- see quickcheck docs for why this return is here
return []
runTests = $quickCheckAll

main :: IO ()
main = do
  good <- runTests
  if good then exitSuccess else exitFailure