{-# OPTIONS_GHC -fno-warn-orphans #-}

module Futhark.BenchTests (tests) where

import Data.Map qualified as M
import Data.Text qualified as T
import Futhark.Bench
import Futhark.ProfileTests ()
import Test.Tasty
import Test.Tasty.QuickCheck

instance Arbitrary RunResult where
  arbitrary :: Gen RunResult
arbitrary = Int -> RunResult
RunResult (Int -> RunResult)
-> (Positive Int -> Int) -> Positive Int -> RunResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Positive Int -> Int
forall a. Positive a -> a
getPositive (Positive Int -> RunResult) -> Gen (Positive Int) -> Gen RunResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Positive Int)
forall a. Arbitrary a => Gen a
arbitrary

printable :: Gen String
printable :: Gen String
printable = ASCIIString -> String
getASCIIString (ASCIIString -> String) -> Gen ASCIIString -> Gen String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ASCIIString
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary DataResult where
  arbitrary :: Gen DataResult
arbitrary =
    Text -> Either Text Result -> DataResult
DataResult
      (Text -> Either Text Result -> DataResult)
-> Gen Text -> Gen (Either Text Result -> DataResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Text
T.pack (String -> Text) -> Gen String -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
printable)
      Gen (Either Text Result -> DataResult)
-> Gen (Either Text Result) -> Gen DataResult
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Gen (Either Text Result)] -> Gen (Either Text Result)
forall a. HasCallStack => [Gen a] -> Gen a
oneof
        [ Text -> Either Text Result
forall a b. a -> Either a b
Left (Text -> Either Text Result)
-> Gen Text -> Gen (Either Text Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
arbText,
          Result -> Either Text Result
forall a b. b -> Either a b
Right
            (Result -> Either Text Result)
-> Gen Result -> Gen (Either Text Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( [RunResult]
-> Map Text Int -> Maybe Text -> Maybe ProfilingReport -> Result
Result
                    ([RunResult]
 -> Map Text Int -> Maybe Text -> Maybe ProfilingReport -> Result)
-> Gen [RunResult]
-> Gen
     (Map Text Int -> Maybe Text -> Maybe ProfilingReport -> Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [RunResult]
forall a. Arbitrary a => Gen a
arbitrary
                    Gen (Map Text Int -> Maybe Text -> Maybe ProfilingReport -> Result)
-> Gen (Map Text Int)
-> Gen (Maybe Text -> Maybe ProfilingReport -> Result)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Map Text Int)
arbMap
                    Gen (Maybe Text -> Maybe ProfilingReport -> Result)
-> Gen (Maybe Text) -> Gen (Maybe ProfilingReport -> Result)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Gen (Maybe Text)] -> Gen (Maybe Text)
forall a. HasCallStack => [Gen a] -> Gen a
oneof [Maybe Text -> Gen (Maybe Text)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing, Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Gen Text -> Gen (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
arbText]
                    Gen (Maybe ProfilingReport -> Result)
-> Gen (Maybe ProfilingReport) -> Gen Result
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe ProfilingReport)
forall a. Arbitrary a => Gen a
arbitrary
                )
        ]
    where
      arbText :: Gen Text
arbText = String -> Text
T.pack (String -> Text) -> Gen String -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
printable
      arbMap :: Gen (Map Text Int)
arbMap = [(Text, Int)] -> Map Text Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, Int)] -> Map Text Int)
-> Gen [(Text, Int)] -> Gen (Map Text Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Text, Int) -> Gen [(Text, Int)]
forall a. Gen a -> Gen [a]
listOf ((,) (Text -> Int -> (Text, Int))
-> Gen Text -> Gen (Int -> (Text, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
arbText Gen (Int -> (Text, Int)) -> Gen Int -> Gen (Text, Int)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int
forall a. Arbitrary a => Gen a
arbitrary)

-- XXX: we restrict this generator to single datasets to we don't have
-- to worry about duplicates.
instance Arbitrary BenchResult where
  arbitrary :: Gen BenchResult
arbitrary = String -> [DataResult] -> BenchResult
BenchResult (String -> [DataResult] -> BenchResult)
-> Gen String -> Gen ([DataResult] -> BenchResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
printable Gen ([DataResult] -> BenchResult)
-> Gen [DataResult] -> Gen BenchResult
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (DataResult -> [DataResult]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataResult -> [DataResult]) -> Gen DataResult -> Gen [DataResult]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen DataResult
forall a. Arbitrary a => Gen a
arbitrary)

encodeDecodeJSON :: TestTree
encodeDecodeJSON :: TestTree
encodeDecodeJSON = String -> (BenchResult -> Bool) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"encoding and decoding are inverse" BenchResult -> Bool
prop
  where
    prop :: BenchResult -> Bool
    prop :: BenchResult -> Bool
prop BenchResult
brs = ByteString -> Either String [BenchResult]
decodeBenchResults ([BenchResult] -> ByteString
encodeBenchResults [BenchResult
brs]) Either String [BenchResult] -> Either String [BenchResult] -> Bool
forall a. Eq a => a -> a -> Bool
== [BenchResult] -> Either String [BenchResult]
forall a b. b -> Either a b
Right [BenchResult
brs]

tests :: TestTree
tests :: TestTree
tests = String -> [TestTree] -> TestTree
testGroup String
"Futhark.BenchTests" [TestTree
encodeDecodeJSON]