module Test.Fluent.Tasty.TestCase (fluentTestCase) where
import Control.Exception (try)
import Data.Data (Typeable)
import Data.List (intercalate)
import GHC.Exception (SrcLoc (srcLocFile, srcLocStartLine))
import Test.Fluent.Assertions
( FluentTestFailure (FluentTestFailure),
)
import Test.Tasty.Providers
( IsTest (..),
TestName,
TestTree,
singleTest,
testFailedDetails,
testPassed,
)
import Test.Tasty.Providers.ConsoleFormat
( ResultDetailsPrinter (..),
failFormat,
)
newtype FluentTestCase = FluentTestCase (IO String)
deriving (Typeable)
failedAssertionResultPrinter :: Int -> Int -> ResultDetailsPrinter
failedAssertionResultPrinter :: Int -> Int -> ResultDetailsPrinter
failedAssertionResultPrinter Int
errors Int
successes = (Int -> ConsoleFormatPrinter -> IO ()) -> ResultDetailsPrinter
ResultDetailsPrinter ((Int -> ConsoleFormatPrinter -> IO ()) -> ResultDetailsPrinter)
-> (Int -> ConsoleFormatPrinter -> IO ()) -> ResultDetailsPrinter
forall a b. (a -> b) -> a -> b
$ \Int
ident ConsoleFormatPrinter
formater ->
ConsoleFormatPrinter
formater ConsoleFormat
failFormat (String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
ident Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"passed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
successes String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
errors String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", total: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
errors Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
successes))
instance IsTest FluentTestCase where
run :: OptionSet -> FluentTestCase -> (Progress -> IO ()) -> IO Result
run OptionSet
_ (FluentTestCase IO String
assertions) Progress -> IO ()
_ = do
Either FluentTestFailure String
result <- IO String -> IO (Either FluentTestFailure String)
forall e a. Exception e => IO a -> IO (Either e a)
try IO String
assertions
Result -> IO Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$
case Either FluentTestFailure String
result of
Right String
info -> String -> Result
testPassed String
info
Left (FluentTestFailure Maybe SrcLoc
_ [(String, Maybe SrcLoc)]
msg Int
errors Int
successes) -> String -> ResultDetailsPrinter -> Result
testFailedDetails ([(String, Maybe SrcLoc)] -> String
prependLocation [(String, Maybe SrcLoc)]
msg) (Int -> Int -> ResultDetailsPrinter
failedAssertionResultPrinter Int
errors Int
successes)
testOptions :: Tagged FluentTestCase [OptionDescription]
testOptions = [OptionDescription] -> Tagged FluentTestCase [OptionDescription]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
prependLocation :: [(String, Maybe SrcLoc)] -> String
prependLocation :: [(String, Maybe SrcLoc)] -> String
prependLocation [(String, Maybe SrcLoc)]
assertionErrors = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((String, Maybe SrcLoc) -> String)
-> [(String, Maybe SrcLoc)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, Maybe SrcLoc) -> String
toLine [(String, Maybe SrcLoc)]
assertionErrors
where
toLine :: (String, Maybe SrcLoc) -> String
toLine (String
s, Maybe SrcLoc
mbloc) = case Maybe SrcLoc
mbloc of
Maybe SrcLoc
Nothing -> String
s
Just SrcLoc
loc -> String
"(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> SrcLoc -> String
srcLocFile SrcLoc
loc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (SrcLoc -> Int
srcLocStartLine SrcLoc
loc) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"): \n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s
fluentTestCase :: TestName -> IO () -> TestTree
fluentTestCase :: String -> IO () -> TestTree
fluentTestCase String
name = String -> FluentTestCase -> TestTree
forall t. IsTest t => String -> t -> TestTree
singleTest String
name (FluentTestCase -> TestTree)
-> (IO () -> FluentTestCase) -> IO () -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO String -> FluentTestCase
FluentTestCase (IO String -> FluentTestCase)
-> (IO () -> IO String) -> IO () -> FluentTestCase
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> String) -> IO () -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> () -> String
forall a b. a -> b -> a
const String
"")