module Testlib.PTest where

import Control.Monad.Trans.Class
import Control.Monad.Trans.Writer
import Data.Bifunctor (bimap)
import Data.Char (toLower)
import Data.Functor ((<&>))
import Data.Kind
import Data.Proxy
import Data.Traversable
import GHC.Generics
import GHC.TypeLits
import Testlib.Env
import Testlib.JSON
import Testlib.Types
import Prelude

type Test = (String, String, String, String, App ())

yieldTests :: (HasTests x) => String -> String -> String -> String -> x -> WriterT [Test] IO ()
yieldTests :: forall x.
HasTests x =>
String -> String -> String -> String -> x -> WriterT [Test] IO ()
yieldTests String
m String
n String
s String
f x
x = do
  [Test]
t <- IO [Test] -> WriterT [Test] IO [Test]
forall (m :: * -> *) a. Monad m => m a -> WriterT [Test] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> String -> String -> String -> x -> IO [Test]
forall x.
HasTests x =>
String -> String -> String -> String -> x -> IO [Test]
mkTests String
m String
n String
s String
f x
x)
  [Test] -> WriterT [Test] IO ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [Test]
t

class HasTests x where
  mkTests :: String -> String -> String -> String -> x -> IO [Test]

instance HasTests (App ()) where
  mkTests :: String -> String -> String -> String -> App () -> IO [Test]
mkTests String
m String
n String
s String
f App ()
x = [Test] -> IO [Test]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(String
m, String
n, String
s, String
f, App ()
x)]

instance (HasTests x, TestCases a) => HasTests (a -> x) where
  mkTests :: String -> String -> String -> String -> (a -> x) -> IO [Test]
mkTests String
m String
n String
s String
f a -> x
x = do
    [TestCase a]
tcs <- forall a. TestCases a => IO [TestCase a]
mkTestCases @a
    ([[Test]] -> [Test]) -> IO [[Test]] -> IO [Test]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Test]] -> [Test]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[Test]] -> IO [Test]) -> IO [[Test]] -> IO [Test]
forall a b. (a -> b) -> a -> b
$ [TestCase a] -> (TestCase a -> IO [Test]) -> IO [[Test]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [TestCase a]
tcs ((TestCase a -> IO [Test]) -> IO [[Test]])
-> (TestCase a -> IO [Test]) -> IO [[Test]]
forall a b. (a -> b) -> a -> b
$ \TestCase a
tc ->
      String -> String -> String -> String -> x -> IO [Test]
forall x.
HasTests x =>
String -> String -> String -> String -> x -> IO [Test]
mkTests String
m (String
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TestCase a
tc.testCaseName) String
s String
f (a -> x
x TestCase a
tc.testCase)

data TestCase a = MkTestCase {forall a. TestCase a -> String
testCaseName :: String, forall a. TestCase a -> a
testCase :: a}
  deriving stock (TestCase a -> TestCase a -> Bool
(TestCase a -> TestCase a -> Bool)
-> (TestCase a -> TestCase a -> Bool) -> Eq (TestCase a)
forall a. Eq a => TestCase a -> TestCase a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => TestCase a -> TestCase a -> Bool
== :: TestCase a -> TestCase a -> Bool
$c/= :: forall a. Eq a => TestCase a -> TestCase a -> Bool
/= :: TestCase a -> TestCase a -> Bool
Eq, Eq (TestCase a)
Eq (TestCase a) =>
(TestCase a -> TestCase a -> Ordering)
-> (TestCase a -> TestCase a -> Bool)
-> (TestCase a -> TestCase a -> Bool)
-> (TestCase a -> TestCase a -> Bool)
-> (TestCase a -> TestCase a -> Bool)
-> (TestCase a -> TestCase a -> TestCase a)
-> (TestCase a -> TestCase a -> TestCase a)
-> Ord (TestCase a)
TestCase a -> TestCase a -> Bool
TestCase a -> TestCase a -> Ordering
TestCase a -> TestCase a -> TestCase a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (TestCase a)
forall a. Ord a => TestCase a -> TestCase a -> Bool
forall a. Ord a => TestCase a -> TestCase a -> Ordering
forall a. Ord a => TestCase a -> TestCase a -> TestCase a
$ccompare :: forall a. Ord a => TestCase a -> TestCase a -> Ordering
compare :: TestCase a -> TestCase a -> Ordering
$c< :: forall a. Ord a => TestCase a -> TestCase a -> Bool
< :: TestCase a -> TestCase a -> Bool
$c<= :: forall a. Ord a => TestCase a -> TestCase a -> Bool
<= :: TestCase a -> TestCase a -> Bool
$c> :: forall a. Ord a => TestCase a -> TestCase a -> Bool
> :: TestCase a -> TestCase a -> Bool
$c>= :: forall a. Ord a => TestCase a -> TestCase a -> Bool
>= :: TestCase a -> TestCase a -> Bool
$cmax :: forall a. Ord a => TestCase a -> TestCase a -> TestCase a
max :: TestCase a -> TestCase a -> TestCase a
$cmin :: forall a. Ord a => TestCase a -> TestCase a -> TestCase a
min :: TestCase a -> TestCase a -> TestCase a
Ord, Int -> TestCase a -> String -> String
[TestCase a] -> String -> String
TestCase a -> String
(Int -> TestCase a -> String -> String)
-> (TestCase a -> String)
-> ([TestCase a] -> String -> String)
-> Show (TestCase a)
forall a. Show a => Int -> TestCase a -> String -> String
forall a. Show a => [TestCase a] -> String -> String
forall a. Show a => TestCase a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall a. Show a => Int -> TestCase a -> String -> String
showsPrec :: Int -> TestCase a -> String -> String
$cshow :: forall a. Show a => TestCase a -> String
show :: TestCase a -> String
$cshowList :: forall a. Show a => [TestCase a] -> String -> String
showList :: [TestCase a] -> String -> String
Show, (forall x. TestCase a -> Rep (TestCase a) x)
-> (forall x. Rep (TestCase a) x -> TestCase a)
-> Generic (TestCase a)
forall x. Rep (TestCase a) x -> TestCase a
forall x. TestCase a -> Rep (TestCase a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (TestCase a) x -> TestCase a
forall a x. TestCase a -> Rep (TestCase a) x
$cfrom :: forall a x. TestCase a -> Rep (TestCase a) x
from :: forall x. TestCase a -> Rep (TestCase a) x
$cto :: forall a x. Rep (TestCase a) x -> TestCase a
to :: forall x. Rep (TestCase a) x -> TestCase a
Generic, (forall a b. (a -> b) -> TestCase a -> TestCase b)
-> (forall a b. a -> TestCase b -> TestCase a) -> Functor TestCase
forall a b. a -> TestCase b -> TestCase a
forall a b. (a -> b) -> TestCase a -> TestCase b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> TestCase a -> TestCase b
fmap :: forall a b. (a -> b) -> TestCase a -> TestCase b
$c<$ :: forall a b. a -> TestCase b -> TestCase a
<$ :: forall a b. a -> TestCase b -> TestCase a
Functor, (forall m. Monoid m => TestCase m -> m)
-> (forall m a. Monoid m => (a -> m) -> TestCase a -> m)
-> (forall m a. Monoid m => (a -> m) -> TestCase a -> m)
-> (forall a b. (a -> b -> b) -> b -> TestCase a -> b)
-> (forall a b. (a -> b -> b) -> b -> TestCase a -> b)
-> (forall b a. (b -> a -> b) -> b -> TestCase a -> b)
-> (forall b a. (b -> a -> b) -> b -> TestCase a -> b)
-> (forall a. (a -> a -> a) -> TestCase a -> a)
-> (forall a. (a -> a -> a) -> TestCase a -> a)
-> (forall a. TestCase a -> [a])
-> (forall a. TestCase a -> Bool)
-> (forall a. TestCase a -> Int)
-> (forall a. Eq a => a -> TestCase a -> Bool)
-> (forall a. Ord a => TestCase a -> a)
-> (forall a. Ord a => TestCase a -> a)
-> (forall a. Num a => TestCase a -> a)
-> (forall a. Num a => TestCase a -> a)
-> Foldable TestCase
forall a. Eq a => a -> TestCase a -> Bool
forall a. Num a => TestCase a -> a
forall a. Ord a => TestCase a -> a
forall m. Monoid m => TestCase m -> m
forall a. TestCase a -> Bool
forall a. TestCase a -> Int
forall a. TestCase a -> [a]
forall a. (a -> a -> a) -> TestCase a -> a
forall m a. Monoid m => (a -> m) -> TestCase a -> m
forall b a. (b -> a -> b) -> b -> TestCase a -> b
forall a b. (a -> b -> b) -> b -> TestCase a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => TestCase m -> m
fold :: forall m. Monoid m => TestCase m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> TestCase a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> TestCase a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> TestCase a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> TestCase a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> TestCase a -> b
foldr :: forall a b. (a -> b -> b) -> b -> TestCase a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> TestCase a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> TestCase a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> TestCase a -> b
foldl :: forall b a. (b -> a -> b) -> b -> TestCase a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> TestCase a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> TestCase a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> TestCase a -> a
foldr1 :: forall a. (a -> a -> a) -> TestCase a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> TestCase a -> a
foldl1 :: forall a. (a -> a -> a) -> TestCase a -> a
$ctoList :: forall a. TestCase a -> [a]
toList :: forall a. TestCase a -> [a]
$cnull :: forall a. TestCase a -> Bool
null :: forall a. TestCase a -> Bool
$clength :: forall a. TestCase a -> Int
length :: forall a. TestCase a -> Int
$celem :: forall a. Eq a => a -> TestCase a -> Bool
elem :: forall a. Eq a => a -> TestCase a -> Bool
$cmaximum :: forall a. Ord a => TestCase a -> a
maximum :: forall a. Ord a => TestCase a -> a
$cminimum :: forall a. Ord a => TestCase a -> a
minimum :: forall a. Ord a => TestCase a -> a
$csum :: forall a. Num a => TestCase a -> a
sum :: forall a. Num a => TestCase a -> a
$cproduct :: forall a. Num a => TestCase a -> a
product :: forall a. Num a => TestCase a -> a
Foldable, Functor TestCase
Foldable TestCase
(Functor TestCase, Foldable TestCase) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> TestCase a -> f (TestCase b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    TestCase (f a) -> f (TestCase a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> TestCase a -> m (TestCase b))
-> (forall (m :: * -> *) a.
    Monad m =>
    TestCase (m a) -> m (TestCase a))
-> Traversable TestCase
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => TestCase (m a) -> m (TestCase a)
forall (f :: * -> *) a.
Applicative f =>
TestCase (f a) -> f (TestCase a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TestCase a -> m (TestCase b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TestCase a -> f (TestCase b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TestCase a -> f (TestCase b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TestCase a -> f (TestCase b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
TestCase (f a) -> f (TestCase a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
TestCase (f a) -> f (TestCase a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TestCase a -> m (TestCase b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TestCase a -> m (TestCase b)
$csequence :: forall (m :: * -> *) a. Monad m => TestCase (m a) -> m (TestCase a)
sequence :: forall (m :: * -> *) a. Monad m => TestCase (m a) -> m (TestCase a)
Traversable)

-- | enumerate all members of a bounded enum type
class TestCases a where
  mkTestCases :: IO [TestCase a]

type Tagged :: Symbol -> Type -> Type
newtype Tagged s a = MkTagged {forall (s :: Symbol) a. Tagged s a -> a
unTagged :: a}
  deriving stock (Tagged s a -> Tagged s a -> Bool
(Tagged s a -> Tagged s a -> Bool)
-> (Tagged s a -> Tagged s a -> Bool) -> Eq (Tagged s a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (s :: Symbol) a. Eq a => Tagged s a -> Tagged s a -> Bool
$c== :: forall (s :: Symbol) a. Eq a => Tagged s a -> Tagged s a -> Bool
== :: Tagged s a -> Tagged s a -> Bool
$c/= :: forall (s :: Symbol) a. Eq a => Tagged s a -> Tagged s a -> Bool
/= :: Tagged s a -> Tagged s a -> Bool
Eq, Eq (Tagged s a)
Eq (Tagged s a) =>
(Tagged s a -> Tagged s a -> Ordering)
-> (Tagged s a -> Tagged s a -> Bool)
-> (Tagged s a -> Tagged s a -> Bool)
-> (Tagged s a -> Tagged s a -> Bool)
-> (Tagged s a -> Tagged s a -> Bool)
-> (Tagged s a -> Tagged s a -> Tagged s a)
-> (Tagged s a -> Tagged s a -> Tagged s a)
-> Ord (Tagged s a)
Tagged s a -> Tagged s a -> Bool
Tagged s a -> Tagged s a -> Ordering
Tagged s a -> Tagged s a -> Tagged s a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (s :: Symbol) a. Ord a => Eq (Tagged s a)
forall (s :: Symbol) a. Ord a => Tagged s a -> Tagged s a -> Bool
forall (s :: Symbol) a.
Ord a =>
Tagged s a -> Tagged s a -> Ordering
forall (s :: Symbol) a.
Ord a =>
Tagged s a -> Tagged s a -> Tagged s a
$ccompare :: forall (s :: Symbol) a.
Ord a =>
Tagged s a -> Tagged s a -> Ordering
compare :: Tagged s a -> Tagged s a -> Ordering
$c< :: forall (s :: Symbol) a. Ord a => Tagged s a -> Tagged s a -> Bool
< :: Tagged s a -> Tagged s a -> Bool
$c<= :: forall (s :: Symbol) a. Ord a => Tagged s a -> Tagged s a -> Bool
<= :: Tagged s a -> Tagged s a -> Bool
$c> :: forall (s :: Symbol) a. Ord a => Tagged s a -> Tagged s a -> Bool
> :: Tagged s a -> Tagged s a -> Bool
$c>= :: forall (s :: Symbol) a. Ord a => Tagged s a -> Tagged s a -> Bool
>= :: Tagged s a -> Tagged s a -> Bool
$cmax :: forall (s :: Symbol) a.
Ord a =>
Tagged s a -> Tagged s a -> Tagged s a
max :: Tagged s a -> Tagged s a -> Tagged s a
$cmin :: forall (s :: Symbol) a.
Ord a =>
Tagged s a -> Tagged s a -> Tagged s a
min :: Tagged s a -> Tagged s a -> Tagged s a
Ord, Int -> Tagged s a -> String -> String
[Tagged s a] -> String -> String
Tagged s a -> String
(Int -> Tagged s a -> String -> String)
-> (Tagged s a -> String)
-> ([Tagged s a] -> String -> String)
-> Show (Tagged s a)
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall (s :: Symbol) a.
Show a =>
Int -> Tagged s a -> String -> String
forall (s :: Symbol) a. Show a => [Tagged s a] -> String -> String
forall (s :: Symbol) a. Show a => Tagged s a -> String
$cshowsPrec :: forall (s :: Symbol) a.
Show a =>
Int -> Tagged s a -> String -> String
showsPrec :: Int -> Tagged s a -> String -> String
$cshow :: forall (s :: Symbol) a. Show a => Tagged s a -> String
show :: Tagged s a -> String
$cshowList :: forall (s :: Symbol) a. Show a => [Tagged s a] -> String -> String
showList :: [Tagged s a] -> String -> String
Show, (forall x. Tagged s a -> Rep (Tagged s a) x)
-> (forall x. Rep (Tagged s a) x -> Tagged s a)
-> Generic (Tagged s a)
forall x. Rep (Tagged s a) x -> Tagged s a
forall x. Tagged s a -> Rep (Tagged s a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: Symbol) a x. Rep (Tagged s a) x -> Tagged s a
forall (s :: Symbol) a x. Tagged s a -> Rep (Tagged s a) x
$cfrom :: forall (s :: Symbol) a x. Tagged s a -> Rep (Tagged s a) x
from :: forall x. Tagged s a -> Rep (Tagged s a) x
$cto :: forall (s :: Symbol) a x. Rep (Tagged s a) x -> Tagged s a
to :: forall x. Rep (Tagged s a) x -> Tagged s a
Generic)

type TaggedBool s = Tagged s Bool

pattern TaggedBool :: Bool -> Tagged s Bool
pattern $mTaggedBool :: forall {r} {s :: Symbol}.
Tagged s Bool -> (Bool -> r) -> ((# #) -> r) -> r
$bTaggedBool :: forall (s :: Symbol). Bool -> Tagged s Bool
TaggedBool a = MkTagged a

{-# COMPLETE TaggedBool #-}

-- | only works for outer-most use of `Tagged` (not: `Maybe (Tagged "bla" Bool)`)
instance (GEnum (Rep a), KnownSymbol s, Generic a) => TestCases (Tagged s a) where
  mkTestCases :: IO [TestCase (Tagged s a)]
mkTestCases =
    [TestCase (Tagged s a)] -> IO [TestCase (Tagged s a)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TestCase (Tagged s a)] -> IO [TestCase (Tagged s a)])
-> [TestCase (Tagged s a)] -> IO [TestCase (Tagged s a)]
forall a b. (a -> b) -> a -> b
$
      forall {k} (f :: k -> *) (x :: k).
GEnum f =>
[([Either String String], f x)]
forall (f :: * -> *) x. GEnum f => [([Either String String], f x)]
uni @(Rep a) [([Either String String], Rep a Any)]
-> (([Either String String], Rep a Any) -> TestCase (Tagged s a))
-> [TestCase (Tagged s a)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        -- replace the toplevel
        (Left String
_ : [Either String String]
ls, Rep a Any
tc) ->
          MkTestCase
            { $sel:testCaseName:MkTestCase :: String
testCaseName = (Either String String -> String -> String)
-> String -> [Either String String] -> String
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Either String String -> String -> String
mkName String
"" (String -> Either String String
forall a b. a -> Either a b
Left (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal @s Proxy s
forall {k} (t :: k). Proxy t
Proxy) Either String String
-> [Either String String] -> [Either String String]
forall a. a -> [a] -> [a]
: [Either String String]
ls),
              $sel:testCase:MkTestCase :: Tagged s a
testCase = a -> Tagged s a
forall (s :: Symbol) a. a -> Tagged s a
MkTagged (a -> Tagged s a) -> a -> Tagged s a
forall a b. (a -> b) -> a -> b
$ Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to Rep a Any
tc
            }
        ([Either String String], Rep a Any)
_ -> String -> TestCase (Tagged s a)
forall a. HasCallStack => String -> a
error String
"tagged test cases: impossible"

instance TestCases Ciphersuite where
  mkTestCases :: IO [TestCase Ciphersuite]
mkTestCases = [TestCase Ciphersuite] -> IO [TestCase Ciphersuite]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TestCase Ciphersuite] -> IO [TestCase Ciphersuite])
-> [TestCase Ciphersuite] -> IO [TestCase Ciphersuite]
forall a b. (a -> b) -> a -> b
$ do
    Ciphersuite
suite <- [Ciphersuite]
allCiphersuites
    TestCase Ciphersuite -> [TestCase Ciphersuite]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestCase Ciphersuite -> [TestCase Ciphersuite])
-> TestCase Ciphersuite -> [TestCase Ciphersuite]
forall a b. (a -> b) -> a -> b
$
      MkTestCase
        { $sel:testCaseName:MkTestCase :: String
testCaseName = Either String String -> String -> String
mkName (String -> Either String String
forall a b. a -> Either a b
Left String
"suite") Ciphersuite
suite.code,
          $sel:testCase:MkTestCase :: Ciphersuite
testCase = Ciphersuite
suite
        }

instance TestCases CredentialType where
  mkTestCases :: IO [TestCase CredentialType]
mkTestCases =
    [TestCase CredentialType] -> IO [TestCase CredentialType]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      [ String -> CredentialType -> TestCase CredentialType
forall a. String -> a -> TestCase a
MkTestCase String
"[ctype=basic]" CredentialType
BasicCredentialType,
        String -> CredentialType -> TestCase CredentialType
forall a. String -> a -> TestCase a
MkTestCase String
"[ctype=x509]" CredentialType
X509CredentialType
      ]

-- | a default instance, normally we don't do such things but this is more convenient in
--   the test suite as you don't have to derive anything
instance {-# OVERLAPPABLE #-} (Generic a, GEnum (Rep a)) => TestCases a where
  mkTestCases :: IO [TestCase a]
mkTestCases =
    [TestCase a] -> IO [TestCase a]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TestCase a] -> IO [TestCase a])
-> [TestCase a] -> IO [TestCase a]
forall a b. (a -> b) -> a -> b
$
      forall {k} (f :: k -> *) (x :: k).
GEnum f =>
[([Either String String], f x)]
forall (f :: * -> *) x. GEnum f => [([Either String String], f x)]
uni @(Rep a) [([Either String String], Rep a Any)]
-> (([Either String String], Rep a Any) -> TestCase a)
-> [TestCase a]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \([Either String String]
tcn, Rep a Any
tc) ->
        MkTestCase
          { $sel:testCaseName:MkTestCase :: String
testCaseName = (Either String String -> String -> String)
-> String -> [Either String String] -> String
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Either String String -> String -> String
mkName String
"" [Either String String]
tcn,
            $sel:testCase:MkTestCase :: a
testCase = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to Rep a Any
tc
          }

{-# INLINE [1] mkName #-}
mkName :: Either String String -> String -> String
mkName :: Either String String -> String -> String
mkName (Left String
a) = \String
acc -> [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"[", Char -> Char
toLower (Char -> Char) -> String -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
a, String
"=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
acc String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"]"]
mkName (Right ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower -> String
a)) = \case
  [] -> String
a
  acc :: String
acc@(Char
'[' : String
_) -> String
a String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
acc
  String
acc -> String
a String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
acc

class GEnum f where
  uni :: [([Either String String], f x)]

instance (GEnum k, KnownSymbol n) => GEnum (D1 (MetaData n m p b) k) where
  uni :: forall (x :: k).
[([Either String String], D1 ('MetaData n m p b) k x)]
uni = ([Either String String] -> [Either String String])
-> (k x -> D1 ('MetaData n m p b) k x)
-> ([Either String String], k x)
-> ([Either String String], D1 ('MetaData n m p b) k x)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (String -> Either String String
forall a b. a -> Either a b
Left (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal @n Proxy n
forall {k} (t :: k). Proxy t
Proxy) :) k x -> D1 ('MetaData n m p b) k x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (([Either String String], k x)
 -> ([Either String String], D1 ('MetaData n m p b) k x))
-> [([Either String String], k x)]
-> [([Either String String], D1 ('MetaData n m p b) k x)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (f :: k -> *) (x :: k).
GEnum f =>
[([Either String String], f x)]
forall (f :: k -> *) (x :: k).
GEnum f =>
[([Either String String], f x)]
uni @k

instance (GEnum k) => GEnum (S1 md k) where
  uni :: forall (x :: k). [([Either String String], S1 md k x)]
uni = (k x -> S1 md k x)
-> ([Either String String], k x)
-> ([Either String String], S1 md k x)
forall a b.
(a -> b)
-> ([Either String String], a) -> ([Either String String], b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap k x -> S1 md k x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (([Either String String], k x)
 -> ([Either String String], S1 md k x))
-> [([Either String String], k x)]
-> [([Either String String], S1 md k x)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (f :: k -> *) (x :: k).
GEnum f =>
[([Either String String], f x)]
forall (f :: k -> *) (x :: k).
GEnum f =>
[([Either String String], f x)]
uni @k

instance (GEnum k, KnownSymbol n) => GEnum (C1 (MetaCons n p b) k) where
  uni :: forall (x :: k).
[([Either String String], C1 ('MetaCons n p b) k x)]
uni = ([Either String String] -> [Either String String])
-> (k x -> C1 ('MetaCons n p b) k x)
-> ([Either String String], k x)
-> ([Either String String], C1 ('MetaCons n p b) k x)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (String -> Either String String
forall a b. b -> Either a b
Right (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal @n Proxy n
forall {k} (t :: k). Proxy t
Proxy) :) k x -> C1 ('MetaCons n p b) k x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (([Either String String], k x)
 -> ([Either String String], C1 ('MetaCons n p b) k x))
-> [([Either String String], k x)]
-> [([Either String String], C1 ('MetaCons n p b) k x)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (f :: k -> *) (x :: k).
GEnum f =>
[([Either String String], f x)]
forall (f :: k -> *) (x :: k).
GEnum f =>
[([Either String String], f x)]
uni @k

instance (GEnum k1, GEnum k2) => GEnum (k1 :+: k2) where
  uni :: forall (x :: k). [([Either String String], (:+:) k1 k2 x)]
uni = ((k1 x -> (:+:) k1 k2 x)
-> ([Either String String], k1 x)
-> ([Either String String], (:+:) k1 k2 x)
forall a b.
(a -> b)
-> ([Either String String], a) -> ([Either String String], b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap k1 x -> (:+:) k1 k2 x
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (([Either String String], k1 x)
 -> ([Either String String], (:+:) k1 k2 x))
-> [([Either String String], k1 x)]
-> [([Either String String], (:+:) k1 k2 x)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (f :: k -> *) (x :: k).
GEnum f =>
[([Either String String], f x)]
forall (f :: k -> *) (x :: k).
GEnum f =>
[([Either String String], f x)]
uni @k1) [([Either String String], (:+:) k1 k2 x)]
-> [([Either String String], (:+:) k1 k2 x)]
-> [([Either String String], (:+:) k1 k2 x)]
forall a. Semigroup a => a -> a -> a
<> ((k2 x -> (:+:) k1 k2 x)
-> ([Either String String], k2 x)
-> ([Either String String], (:+:) k1 k2 x)
forall a b.
(a -> b)
-> ([Either String String], a) -> ([Either String String], b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap k2 x -> (:+:) k1 k2 x
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (([Either String String], k2 x)
 -> ([Either String String], (:+:) k1 k2 x))
-> [([Either String String], k2 x)]
-> [([Either String String], (:+:) k1 k2 x)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (f :: k -> *) (x :: k).
GEnum f =>
[([Either String String], f x)]
forall (f :: k -> *) (x :: k).
GEnum f =>
[([Either String String], f x)]
uni @k2)

instance GEnum U1 where
  uni :: forall (x :: k). [([Either String String], U1 x)]
uni = [([String -> Either String String
forall a b. b -> Either a b
Right String
""], U1 x
forall k (p :: k). U1 p
U1)]

instance (GEnum (Rep k), Generic k) => GEnum (K1 r k) where
  uni :: forall (x :: k). [([Either String String], K1 r k x)]
uni = (Rep k Any -> K1 r k x)
-> ([Either String String], Rep k Any)
-> ([Either String String], K1 r k x)
forall a b.
(a -> b)
-> ([Either String String], a) -> ([Either String String], b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (k -> K1 r k x
forall k i c (p :: k). c -> K1 i c p
K1 (k -> K1 r k x) -> (Rep k Any -> k) -> Rep k Any -> K1 r k x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep k Any -> k
forall a x. Generic a => Rep a x -> a
forall x. Rep k x -> k
to) (([Either String String], Rep k Any)
 -> ([Either String String], K1 r k x))
-> [([Either String String], Rep k Any)]
-> [([Either String String], K1 r k x)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (f :: k -> *) (x :: k).
GEnum f =>
[([Either String String], f x)]
forall (f :: * -> *) x. GEnum f => [([Either String String], f x)]
uni @(Rep k)

data OneOf a b = OneOfA a | OneOfB b

instance (MakesValue a, MakesValue b) => MakesValue (OneOf a b) where
  make :: HasCallStack => OneOf a b -> App Value
make (OneOfA a
a) = a -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make a
a
  make (OneOfB b
b) = b -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make b
b

instance (TestCases a, TestCases b) => TestCases (OneOf a b) where
  mkTestCases :: IO [TestCase (OneOf a b)]
mkTestCases = do
    [TestCase (OneOf a b)]
as <- ([TestCase a] -> [TestCase (OneOf a b)])
-> IO [TestCase a] -> IO [TestCase (OneOf a b)]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TestCase a -> TestCase (OneOf a b))
-> [TestCase a] -> [TestCase (OneOf a b)]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> OneOf a b) -> TestCase a -> TestCase (OneOf a b)
forall a b. (a -> b) -> TestCase a -> TestCase b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> OneOf a b
forall a b. a -> OneOf a b
OneOfA)) IO [TestCase a]
forall a. TestCases a => IO [TestCase a]
mkTestCases
    [TestCase (OneOf a b)]
bs <- ([TestCase b] -> [TestCase (OneOf a b)])
-> IO [TestCase b] -> IO [TestCase (OneOf a b)]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TestCase b -> TestCase (OneOf a b))
-> [TestCase b] -> [TestCase (OneOf a b)]
forall a b. (a -> b) -> [a] -> [b]
map ((b -> OneOf a b) -> TestCase b -> TestCase (OneOf a b)
forall a b. (a -> b) -> TestCase a -> TestCase b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> OneOf a b
forall a b. b -> OneOf a b
OneOfB)) IO [TestCase b]
forall a. TestCases a => IO [TestCase a]
mkTestCases
    [TestCase (OneOf a b)] -> IO [TestCase (OneOf a b)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TestCase (OneOf a b)] -> IO [TestCase (OneOf a b)])
-> [TestCase (OneOf a b)] -> IO [TestCase (OneOf a b)]
forall a b. (a -> b) -> a -> b
$ [TestCase (OneOf a b)]
as [TestCase (OneOf a b)]
-> [TestCase (OneOf a b)] -> [TestCase (OneOf a b)]
forall a. Semigroup a => a -> a -> a
<> [TestCase (OneOf a b)]
bs