    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    -- |
    -- Module      : Test.Tasty.KAT
    -- License     : MIT
    -- Maintainer  : Vincent Hanquez <vincent@snarc.org>
    -- Stability   : experimental
    -- Portability : Good
    --
    -- Tasty support for KAT (Known Answer Tests)
    --
    module Test.Tasty.KAT
        (
        -- * Run tests
          testKatDetailed
        , testKatGrouped
        -- * Load KAT resources
        , testKatLoad
        , Resource(..)
        , katLoaderSimple
        , mapTestUnits
        ) where

    import Control.Applicative
    import Control.Exception
    import Data.Typeable
    import Test.Tasty (testGroup)
    import Test.Tasty.Providers
    import Test.Tasty.KAT.FileLoader

    newtype Resource a = Resource [(String, [a])]

    data TestKatSingle = TestKatSingle (IO Bool)
        deriving Typeable

    data TestKatGroup = TestKatGroup [(Int, IO Bool)]
        deriving Typeable

    data KatResult = KatFailed String | KatSuccess
        deriving (Int -> KatResult -> ShowS
    [KatResult] -> ShowS
    KatResult -> String
    (Int -> KatResult -> ShowS)
    -> (KatResult -> String)
    -> ([KatResult] -> ShowS)
    -> Show KatResult
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> KatResult -> ShowS
    showsPrec :: Int -> KatResult -> ShowS
    $cshow :: KatResult -> String
    show :: KatResult -> String
    $cshowList :: [KatResult] -> ShowS
    showList :: [KatResult] -> ShowS
    Show,KatResult -> KatResult -> Bool
    (KatResult -> KatResult -> Bool)
    -> (KatResult -> KatResult -> Bool) -> Eq KatResult
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: KatResult -> KatResult -> Bool
    == :: KatResult -> KatResult -> Bool
    $c/= :: KatResult -> KatResult -> Bool
    /= :: KatResult -> KatResult -> Bool
    Eq)

    tryResult :: IO Bool -> IO KatResult
    tryResult :: IO Bool -> IO KatResult
    tryResult IO Bool
    f = do
        er <- IO Bool -> IO (Either SomeException Bool)
    forall e a. Exception e => IO a -> IO (Either e a)
    try IO Bool
    f
        case er of
            Left (SomeException
    e :: SomeException)
                | SomeException -> String
    forall a. Show a => a -> String
    show SomeException
    e String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "<<timeout>>" -> SomeException -> IO KatResult
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO SomeException
    e
                | Bool
    otherwise               -> KatResult -> IO KatResult
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (KatResult -> IO KatResult) -> KatResult -> IO KatResult
    forall a b. (a -> b) -> a -> b
    $ String -> KatResult
    KatFailed (SomeException -> String
    forall a. Show a => a -> String
    show SomeException
    e)
            Right Bool
    r                       -> KatResult -> IO KatResult
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (KatResult -> IO KatResult) -> KatResult -> IO KatResult
    forall a b. (a -> b) -> a -> b
    $ if Bool
    r then KatResult
    KatSuccess else String -> KatResult
    KatFailed String
    "test failed"

    instance IsTest TestKatSingle where
        run :: OptionSet -> TestKatSingle -> (Progress -> IO ()) -> IO Result
    run OptionSet
    _ (TestKatSingle IO Bool
    tst) Progress -> IO ()
    _ = do
            r <- IO Bool -> IO KatResult
    tryResult IO Bool
    tst
            case r of
                KatResult
    KatSuccess  -> Result -> IO Result
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Result -> IO Result) -> Result -> IO Result
    forall a b. (a -> b) -> a -> b
    $ String -> Result
    testPassed String
    ""
                KatFailed String
    s -> Result -> IO Result
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Result -> IO Result) -> Result -> IO Result
    forall a b. (a -> b) -> a -> b
    $ String -> Result
    testFailed String
    s
        testOptions :: Tagged TestKatSingle [OptionDescription]
    testOptions = [OptionDescription] -> Tagged TestKatSingle [OptionDescription]
    forall a. a -> Tagged TestKatSingle a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
    instance IsTest TestKatGroup where
        run :: OptionSet -> TestKatGroup -> (Progress -> IO ()) -> IO Result
    run OptionSet
    _ (TestKatGroup [(Int, IO Bool)]
    groupTests) Progress -> IO ()
    _ = do
            (success, failed) <- [KatResult] -> (Int, Int)
    summarize ([KatResult] -> (Int, Int)) -> IO [KatResult] -> IO (Int, Int)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((Int, IO Bool) -> IO KatResult)
    -> [(Int, IO Bool)] -> IO [KatResult]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Int, IO Bool) -> IO KatResult
    runGroup [(Int, IO Bool)]
    groupTests
            return $
                (if failed == 0 then testPassed else testFailed)
                (if failed > 0 then (show failed) ++ " tests failed on " ++ show (failed + success)
                               else (show success) ++ " tests succeed")
          where summarize :: [KatResult] -> (Int, Int)
                summarize :: [KatResult] -> (Int, Int)
    summarize = ((Int, Int) -> KatResult -> (Int, Int))
    -> (Int, Int) -> [KatResult] -> (Int, Int)
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (\(Int
    s,Int
    f) KatResult
    k -> if KatResult
    k KatResult -> KatResult -> Bool
    forall a. Eq a => a -> a -> Bool
    == KatResult
    KatSuccess then (Int
    sInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1,Int
    f) else (Int
    s,Int
    fInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)) (Int
    0,Int
    0)

                runGroup :: (Int, IO Bool) -> IO KatResult
                runGroup :: (Int, IO Bool) -> IO KatResult
    runGroup (Int
    _, IO Bool
    tst) = IO Bool -> IO KatResult
    tryResult IO Bool
    tst
                --nbGroups = fromIntegral $ length groupTests
                --yieldProgress $ Progress { progressText = groupName, progressPercent = fromIntegral tstNb / nbGroups  }

        testOptions :: Tagged TestKatGroup [OptionDescription]
    testOptions = [OptionDescription] -> Tagged TestKatGroup [OptionDescription]
    forall a. a -> Tagged TestKatGroup a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

    -- | run one tasty test per vectors in each groups
    --
    -- This is useful to have detailed output on what failed
    -- and what succeeded. For a more concise output, use
    -- 'testKatGrouped'
    testKatDetailed :: TestName
                    -> Resource a
                    -> (String -> a -> IO Bool)
                    -> TestTree
    testKatDetailed :: forall a.
    String -> Resource a -> (String -> a -> IO Bool) -> TestTree
    testKatDetailed String
    name (Resource [(String, [a])]
    groups) String -> a -> IO Bool
    test = -- singleTest name $ mkTestKat resource test
        String -> [TestTree] -> TestTree
    testGroup String
    name ([TestTree] -> TestTree) -> [TestTree] -> TestTree
    forall a b. (a -> b) -> a -> b
    $ ((String, [a]) -> TestTree) -> [(String, [a])] -> [TestTree]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, [a]) -> TestTree
    groupToTests [(String, [a])]
    groups
      where groupToTests :: (String, [a]) -> TestTree
    groupToTests (String
    groupName, [a]
    vectors) =
                String -> [TestTree] -> TestTree
    testGroup String
    groupName ([TestTree] -> TestTree) -> [TestTree] -> TestTree
    forall a b. (a -> b) -> a -> b
    $ ((Int, a) -> TestTree) -> [(Int, a)] -> [TestTree]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Int
    i, a
    v) -> String -> TestKatSingle -> TestTree
    forall t. IsTest t => String -> t -> TestTree
    singleTest (Int -> String
    forall a. Show a => a -> String
    show (Int
    i :: Int)) (IO Bool -> TestKatSingle
    TestKatSingle (IO Bool -> TestKatSingle) -> IO Bool -> TestKatSingle
    forall a b. (a -> b) -> a -> b
    $ String -> a -> IO Bool
    test String
    groupName a
    v)) ([Int] -> [a] -> [(Int, a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    1..] [a]
    vectors)

    -- | run one tasty test per group
    testKatGrouped :: TestName
                   -> Resource a
                   -> (String -> a -> IO Bool)
                   -> TestTree
    testKatGrouped :: forall a.
    String -> Resource a -> (String -> a -> IO Bool) -> TestTree
    testKatGrouped String
    name (Resource [(String, [a])]
    groups) String -> a -> IO Bool
    test = -- singleTest name $ mkTestKat resource test
        String -> [TestTree] -> TestTree
    testGroup String
    name ([TestTree] -> TestTree) -> [TestTree] -> TestTree
    forall a b. (a -> b) -> a -> b
    $ ((String, [a]) -> TestTree) -> [(String, [a])] -> [TestTree]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, [a]) -> TestTree
    groupToTests [(String, [a])]
    groups
      where groupToTests :: (String, [a]) -> TestTree
    groupToTests (String
    groupName, [a]
    vectors) =
                String -> TestKatGroup -> TestTree
    forall t. IsTest t => String -> t -> TestTree
    singleTest String
    groupName (TestKatGroup -> TestTree) -> TestKatGroup -> TestTree
    forall a b. (a -> b) -> a -> b
    $ [(Int, IO Bool)] -> TestKatGroup
    TestKatGroup ([(Int, IO Bool)] -> TestKatGroup)
    -> [(Int, IO Bool)] -> TestKatGroup
    forall a b. (a -> b) -> a -> b
    $ ((Int, a) -> (Int, IO Bool)) -> [(Int, a)] -> [(Int, IO Bool)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Int
    i, a
    v) -> (Int
    i, String -> a -> IO Bool
    test String
    groupName a
    v)) ([Int] -> [a] -> [(Int, a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    1..] [a]
    vectors)

    -- | Read a KAT file into values that will be used for KATs tests
    testKatLoad :: FilePath
                -> ([String] -> [(String, [a])])
                -> IO (Resource a)
    testKatLoad :: forall a.
    String -> ([String] -> [(String, [a])]) -> IO (Resource a)
    testKatLoad String
    filepath [String] -> [(String, [a])]
    transform = [(String, [a])] -> Resource a
    forall a. [(String, [a])] -> Resource a
    Resource ([(String, [a])] -> Resource a)
    -> (String -> [(String, [a])]) -> String -> Resource a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [(String, [a])]
    transform ([String] -> [(String, [a])])
    -> (String -> [String]) -> String -> [(String, [a])]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    lines (String -> Resource a) -> IO String -> IO (Resource a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO String
    readFile String
    filepath