module Test.Daytripper
( MonadExpect (..)
, Expect
, expectBefore
, expectDuring
, expectAfter
, mkExpect
, runExpect
, RT
, mkPropRT
, mkFileRT
, mkUnitRT
, testRT
, DaytripperWriteMissing (..)
, daytripperIngredients
, daytripperMain
)
where
import Control.Monad (unless, void)
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.Foldable (for_)
import Data.Proxy (Proxy (..))
import Data.Tagged (Tagged, untag)
import Options.Applicative (flag', help, long)
import System.Directory (doesFileExist)
import System.IO.Unsafe (unsafePerformIO)
import Test.Falsify.Generator (Gen)
import Test.Falsify.Predicate qualified as FR
import Test.Falsify.Property (Property)
import Test.Falsify.Property qualified as FP
import Test.Tasty (TestName, TestTree, askOption, defaultIngredients, defaultMainWithIngredients, includingOptions)
import Test.Tasty.Falsify (testProperty)
import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))
import Test.Tasty.Ingredients (Ingredient)
import Test.Tasty.Options (IsOption (..), OptionDescription (..), safeRead)
class (MonadFail m) => MonadExpect m where
expectLiftIO :: IO a -> m a
expectAssertEq :: (Eq a, Show a) => a -> a -> m ()
expectAssertFailure :: String -> m ()
expectAssertBool :: String -> Bool -> m ()
expectAssertBool String
s Bool
b = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b (forall (m :: * -> *). MonadExpect m => String -> m ()
expectAssertFailure String
s)
instance MonadExpect IO where
expectLiftIO :: forall a. IO a -> IO a
expectLiftIO = forall a. a -> a
id
expectAssertEq :: forall a. (Eq a, Show a) => a -> a -> IO ()
expectAssertEq = forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
(@?=)
expectAssertFailure :: String -> IO ()
expectAssertFailure = forall a. HasCallStack => String -> IO a
assertFailure
expectAssertBool :: String -> Bool -> IO ()
expectAssertBool = HasCallStack => String -> Bool -> IO ()
assertBool
instance MonadExpect Property where
expectLiftIO :: forall a. IO a -> Property a
expectLiftIO = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> a
unsafePerformIO
expectAssertEq :: forall a. (Eq a, Show a) => a -> a -> Property ()
expectAssertEq a
x a
y = Predicate '[] -> Property ()
FP.assert (forall a. Eq a => Predicate '[a, a]
FR.eq forall x (xs :: [*]).
Show x =>
Predicate (x : xs) -> (String, x) -> Predicate xs
FR..$ (String
"LHS", a
x) forall x (xs :: [*]).
Show x =>
Predicate (x : xs) -> (String, x) -> Predicate xs
FR..$ (String
"RHS", a
y))
expectAssertFailure :: String -> Property ()
expectAssertFailure = forall e a. e -> Property' e a
FP.testFailed
type Expect m a b c = Either b a -> m (b, m c)
eitherMay :: Either b a -> Maybe a
eitherMay :: forall b a. Either b a -> Maybe a
eitherMay = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just
expectBefore :: (Monad m) => (Maybe a -> m ()) -> Expect m a b c -> Expect m a b c
expectBefore :: forall (m :: * -> *) a b c.
Monad m =>
(Maybe a -> m ()) -> Expect m a b c -> Expect m a b c
expectBefore Maybe a -> m ()
f Expect m a b c
ex Either b a
i = Maybe a -> m ()
f (forall b a. Either b a -> Maybe a
eitherMay Either b a
i) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expect m a b c
ex Either b a
i
expectDuring :: (Monad m) => (Maybe a -> b -> m ()) -> Expect m a b c -> Expect m a b c
expectDuring :: forall (m :: * -> *) a b c.
Monad m =>
(Maybe a -> b -> m ()) -> Expect m a b c -> Expect m a b c
expectDuring Maybe a -> b -> m ()
f Expect m a b c
ex Either b a
i = Expect m a b c
ex Either b a
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \p :: (b, m c)
p@(b
b, m c
_) -> (b, m c)
p forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe a -> b -> m ()
f (forall b a. Either b a -> Maybe a
eitherMay Either b a
i) b
b
expectAfter :: (Monad m) => (Maybe a -> b -> c -> m ()) -> Expect m a b c -> Expect m a b c
expectAfter :: forall (m :: * -> *) a b c.
Monad m =>
(Maybe a -> b -> c -> m ()) -> Expect m a b c -> Expect m a b c
expectAfter Maybe a -> b -> c -> m ()
f Expect m a b c
ex Either b a
i = Expect m a b c
ex Either b a
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(b
b, m c
end) -> m c
end forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \c
c -> (b
b, forall (f :: * -> *) a. Applicative f => a -> f a
pure c
c) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe a -> b -> c -> m ()
f (forall b a. Either b a -> Maybe a
eitherMay Either b a
i) b
b c
c
mkExpect
:: (MonadExpect m)
=> (a -> m b)
-> (b -> m c)
-> (Maybe a -> c -> m ())
-> Expect m a b c
mkExpect :: forall (m :: * -> *) a b c.
MonadExpect m =>
(a -> m b)
-> (b -> m c) -> (Maybe a -> c -> m ()) -> Expect m a b c
mkExpect a -> m b
f b -> m c
g Maybe a -> c -> m ()
h Either b a
i = do
b
b <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> m b
f Either b a
i
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b
b,) forall a b. (a -> b) -> a -> b
$ do
c
c <- b -> m c
g b
b
Maybe a -> c -> m ()
h (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just Either b a
i) c
c
forall (f :: * -> *) a. Applicative f => a -> f a
pure c
c
runExpect :: (Monad m) => Expect m a b c -> a -> m c
runExpect :: forall (m :: * -> *) a b c. Monad m => Expect m a b c -> a -> m c
runExpect Expect m a b c
f a
a = Expect m a b c
f (forall a b. b -> Either a b
Right a
a) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. (a, b) -> b
snd
data PropRT where
PropRT :: (Show a) => TestName -> Expect Property a b c -> Gen a -> PropRT
mkPropRT :: (Show a) => TestName -> Expect Property a b c -> Gen a -> RT
mkPropRT :: forall a b c.
Show a =>
String -> Expect Property a b c -> Gen a -> RT
mkPropRT String
name Expect Property a b c
expec Gen a
gen = PropRT -> RT
RTProp (forall a b c.
Show a =>
String -> Expect Property a b c -> Gen a -> PropRT
PropRT String
name Expect Property a b c
expec Gen a
gen)
testPropRT :: PropRT -> TestTree
testPropRT :: PropRT -> TestTree
testPropRT (PropRT String
name Expect Property a b c
expec Gen a
gen) =
String -> Property () -> TestTree
testProperty String
name (forall a e. (HasCallStack, Show a) => Gen a -> Property' e a
FP.gen Gen a
gen forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b c. Monad m => Expect m a b c -> a -> m c
runExpect Expect Property a b c
expec)
data FileRT where
FileRT
:: TestName
-> Expect IO a ByteString c
-> FilePath
-> Maybe a
-> FileRT
mkFileRT
:: TestName
-> Expect IO a ByteString c
-> FilePath
-> Maybe a
-> RT
mkFileRT :: forall a c.
String -> Expect IO a ByteString c -> String -> Maybe a -> RT
mkFileRT String
name Expect IO a ByteString c
expec String
fn Maybe a
mval = FileRT -> RT
RTFile (forall a b.
String -> Expect IO a ByteString b -> String -> Maybe a -> FileRT
FileRT String
name Expect IO a ByteString c
expec String
fn Maybe a
mval)
testFileRT :: FileRT -> TestTree
testFileRT :: FileRT -> TestTree
testFileRT (FileRT String
name Expect IO a ByteString c
expec String
fn Maybe a
mval) = forall v. IsOption v => (v -> TestTree) -> TestTree
askOption forall a b. (a -> b) -> a -> b
$ \DaytripperWriteMissing
dwm ->
String -> IO () -> TestTree
testCase String
name forall a b. (a -> b) -> a -> b
$ do
Bool
exists <- String -> IO Bool
doesFileExist String
fn
(Maybe ByteString
mcon, Either ByteString a
eval) <-
if Bool
exists
then do
ByteString
con <- String -> IO ByteString
BS.readFile String
fn
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just ByteString
con, forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left ByteString
con) forall a b. b -> Either a b
Right Maybe a
mval)
else case (DaytripperWriteMissing
dwm, Maybe a
mval) of
(DaytripperWriteMissing Bool
True, Just a
val) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Maybe a
Nothing, forall a b. b -> Either a b
Right a
val)
(DaytripperWriteMissing, Maybe a)
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"File missing: " forall a. [a] -> [a] -> [a]
++ String
fn)
(ByteString
bs, IO c
end) <- Expect IO a ByteString c
expec Either ByteString a
eval
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe ByteString
mcon (ByteString
bs @?=)
c
_ <- IO c
end
case Maybe ByteString
mcon of
Maybe ByteString
Nothing -> String -> ByteString -> IO ()
BS.writeFile String
fn ByteString
bs
Just ByteString
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
data UnitRT where
UnitRT :: TestName -> Expect IO a b c -> a -> UnitRT
mkUnitRT :: TestName -> Expect IO a b c -> a -> RT
mkUnitRT :: forall a b c. String -> Expect IO a b c -> a -> RT
mkUnitRT String
name Expect IO a b c
expec a
val = UnitRT -> RT
RTUnit (forall a b c. String -> Expect IO a b c -> a -> UnitRT
UnitRT String
name Expect IO a b c
expec a
val)
testUnitRT :: UnitRT -> TestTree
testUnitRT :: UnitRT -> TestTree
testUnitRT (UnitRT String
name Expect IO a b c
expec a
val) =
String -> IO () -> TestTree
testCase String
name (forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (m :: * -> *) a b c. Monad m => Expect m a b c -> a -> m c
runExpect Expect IO a b c
expec a
val))
data RT
= RTProp !PropRT
| RTFile !FileRT
| RTUnit !UnitRT
testRT :: RT -> TestTree
testRT :: RT -> TestTree
testRT = \case
RTProp PropRT
x -> PropRT -> TestTree
testPropRT PropRT
x
RTFile FileRT
x -> FileRT -> TestTree
testFileRT FileRT
x
RTUnit UnitRT
x -> UnitRT -> TestTree
testUnitRT UnitRT
x
newtype DaytripperWriteMissing = DaytripperWriteMissing {DaytripperWriteMissing -> Bool
unDaytripperWriteMissing :: Bool}
deriving stock (Int -> DaytripperWriteMissing -> ShowS
[DaytripperWriteMissing] -> ShowS
DaytripperWriteMissing -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DaytripperWriteMissing] -> ShowS
$cshowList :: [DaytripperWriteMissing] -> ShowS
show :: DaytripperWriteMissing -> String
$cshow :: DaytripperWriteMissing -> String
showsPrec :: Int -> DaytripperWriteMissing -> ShowS
$cshowsPrec :: Int -> DaytripperWriteMissing -> ShowS
Show)
deriving newtype (DaytripperWriteMissing -> DaytripperWriteMissing -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DaytripperWriteMissing -> DaytripperWriteMissing -> Bool
$c/= :: DaytripperWriteMissing -> DaytripperWriteMissing -> Bool
== :: DaytripperWriteMissing -> DaytripperWriteMissing -> Bool
$c== :: DaytripperWriteMissing -> DaytripperWriteMissing -> Bool
Eq, Eq DaytripperWriteMissing
DaytripperWriteMissing -> DaytripperWriteMissing -> Bool
DaytripperWriteMissing -> DaytripperWriteMissing -> Ordering
DaytripperWriteMissing
-> DaytripperWriteMissing -> DaytripperWriteMissing
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
min :: DaytripperWriteMissing
-> DaytripperWriteMissing -> DaytripperWriteMissing
$cmin :: DaytripperWriteMissing
-> DaytripperWriteMissing -> DaytripperWriteMissing
max :: DaytripperWriteMissing
-> DaytripperWriteMissing -> DaytripperWriteMissing
$cmax :: DaytripperWriteMissing
-> DaytripperWriteMissing -> DaytripperWriteMissing
>= :: DaytripperWriteMissing -> DaytripperWriteMissing -> Bool
$c>= :: DaytripperWriteMissing -> DaytripperWriteMissing -> Bool
> :: DaytripperWriteMissing -> DaytripperWriteMissing -> Bool
$c> :: DaytripperWriteMissing -> DaytripperWriteMissing -> Bool
<= :: DaytripperWriteMissing -> DaytripperWriteMissing -> Bool
$c<= :: DaytripperWriteMissing -> DaytripperWriteMissing -> Bool
< :: DaytripperWriteMissing -> DaytripperWriteMissing -> Bool
$c< :: DaytripperWriteMissing -> DaytripperWriteMissing -> Bool
compare :: DaytripperWriteMissing -> DaytripperWriteMissing -> Ordering
$ccompare :: DaytripperWriteMissing -> DaytripperWriteMissing -> Ordering
Ord)
instance IsOption DaytripperWriteMissing where
defaultValue :: DaytripperWriteMissing
defaultValue = Bool -> DaytripperWriteMissing
DaytripperWriteMissing Bool
False
parseValue :: String -> Maybe DaytripperWriteMissing
parseValue = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> DaytripperWriteMissing
DaytripperWriteMissing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
safeRead
optionName :: Tagged DaytripperWriteMissing String
optionName = forall (m :: * -> *) a. Monad m => a -> m a
return String
"daytripper-write-missing"
optionHelp :: Tagged DaytripperWriteMissing String
optionHelp = forall (m :: * -> *) a. Monad m => a -> m a
return String
"Write missing test files"
optionCLParser :: Parser DaytripperWriteMissing
optionCLParser =
Bool -> DaytripperWriteMissing
DaytripperWriteMissing
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> Mod FlagFields a -> Parser a
flag'
Bool
True
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long (forall {k} (s :: k) b. Tagged s b -> b
untag (forall v. IsOption v => Tagged v String
optionName :: Tagged DaytripperWriteMissing String))
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help (forall {k} (s :: k) b. Tagged s b -> b
untag (forall v. IsOption v => Tagged v String
optionHelp :: Tagged DaytripperWriteMissing String))
)
daytripperIngredients :: [Ingredient]
daytripperIngredients :: [Ingredient]
daytripperIngredients =
[OptionDescription] -> Ingredient
includingOptions [forall v. IsOption v => Proxy v -> OptionDescription
Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy DaytripperWriteMissing)]
forall a. a -> [a] -> [a]
: [Ingredient]
defaultIngredients
daytripperMain :: TestTree -> IO ()
daytripperMain :: TestTree -> IO ()
daytripperMain = [Ingredient] -> TestTree -> IO ()
defaultMainWithIngredients [Ingredient]
daytripperIngredients