module Test.Daytripper
( MonadExpect (..)
, Expect
, expectBefore
, expectDuring
, expectAfter
, mkExpect
, RT
, mkPropRT
, mkFileRT
, mkUnitRT
, testRT
, DaytripperWriteMissing (..)
, daytripperIngredients
, daytripperMain
)
where
import Control.Monad (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 (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 ()
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 ()
(@?=)
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) -> (Var, x) -> Predicate xs
FR..$ (Var
"LHS", a
x) forall x (xs :: [*]).
Show x =>
Predicate (x : xs) -> (Var, x) -> Predicate xs
FR..$ (Var
"RHS", a
y))
type Expect m a b c = Either b a -> m (b, m c)
expectBefore :: Monad m => (a -> m ()) -> Expect m a b c -> Expect m a b c
expectBefore :: forall (m :: * -> *) a b c.
Monad m =>
(a -> m ()) -> Expect m a b c -> Expect m a b c
expectBefore a -> m ()
f Expect m a b c
ex Either b a
i = forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Either b a
i a -> m ()
f 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 => (a -> b -> m ()) -> Expect m a b c -> Expect m a b c
expectDuring :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m ()) -> Expect m a b c -> Expect m a b c
expectDuring 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
<$ forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Either b a
i (a -> b -> m ()
`f` b
b)
expectAfter :: Monad m => (a -> b -> c -> m ()) -> Expect m a b c -> Expect m a b c
expectAfter :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c -> m ()) -> Expect m a b c -> Expect m a b c
expectAfter 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
<$ forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Either b a
i (\a
a -> a -> b -> c -> m ()
f a
a b
b c
c)
mkExpect
:: (MonadExpect m, Eq (f a), Show (f a), Applicative f)
=> (a -> m b)
-> (b -> m (f a))
-> Expect m a b (f a)
mkExpect :: forall (m :: * -> *) (f :: * -> *) a b.
(MonadExpect m, Eq (f a), Show (f a), Applicative f) =>
(a -> m b) -> (b -> m (f a)) -> Expect m a b (f a)
mkExpect a -> m b
f b -> m (f a)
g 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
f a
fa <- b -> m (f a)
g b
b
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Either b a
i (forall (m :: * -> *) a.
(MonadExpect m, Eq a, Show a) =>
a -> a -> m ()
expectAssertEq f a
fa forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure)
forall (f :: * -> *) a. Applicative f => a -> f a
pure f a
fa
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 => Var -> Expect Property a b c -> Gen a -> RT
mkPropRT Var
name Expect Property a b c
expec Gen a
gen = PropRT -> RT
RTProp (forall a b c.
Show a =>
Var -> Expect Property a b c -> Gen a -> PropRT
PropRT Var
name Expect Property a b c
expec Gen a
gen)
testPropRT :: PropRT -> TestTree
testPropRT :: PropRT -> TestTree
testPropRT (PropRT Var
name Expect Property a b c
expec Gen a
gen) =
Var -> Property () -> TestTree
testProperty Var
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. Var -> Expect IO a ByteString c -> Var -> Maybe a -> RT
mkFileRT Var
name Expect IO a ByteString c
expec Var
fn Maybe a
mval = FileRT -> RT
RTFile (forall a b.
Var -> Expect IO a ByteString b -> Var -> Maybe a -> FileRT
FileRT Var
name Expect IO a ByteString c
expec Var
fn Maybe a
mval)
testFileRT :: FileRT -> TestTree
testFileRT :: FileRT -> TestTree
testFileRT (FileRT Var
name Expect IO a ByteString c
expec Var
fn Maybe a
mval) = forall v. IsOption v => (v -> TestTree) -> TestTree
askOption forall a b. (a -> b) -> a -> b
$ \DaytripperWriteMissing
dwm ->
Var -> IO () -> TestTree
testCase Var
name forall a b. (a -> b) -> a -> b
$ do
Bool
exists <- Var -> IO Bool
doesFileExist Var
fn
(Maybe ByteString
mcon, Either ByteString a
eval) <-
if Bool
exists
then do
ByteString
con <- Var -> IO ByteString
BS.readFile Var
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 => Var -> m a
fail (Var
"File missing: " forall a. [a] -> [a] -> [a]
++ Var
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 -> Var -> ByteString -> IO ()
BS.writeFile Var
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. Var -> Expect IO a b c -> a -> RT
mkUnitRT Var
name Expect IO a b c
expec a
val = UnitRT -> RT
RTUnit (forall a b c. Var -> Expect IO a b c -> a -> UnitRT
UnitRT Var
name Expect IO a b c
expec a
val)
testUnitRT :: UnitRT -> TestTree
testUnitRT :: UnitRT -> TestTree
testUnitRT (UnitRT Var
name Expect IO a b c
expec a
val) =
Var -> IO () -> TestTree
testCase Var
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 -> Var
forall a.
(Int -> a -> ShowS) -> (a -> Var) -> ([a] -> ShowS) -> Show a
showList :: [DaytripperWriteMissing] -> ShowS
$cshowList :: [DaytripperWriteMissing] -> ShowS
show :: DaytripperWriteMissing -> Var
$cshow :: DaytripperWriteMissing -> Var
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 :: Var -> 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 => Var -> Maybe a
safeRead
optionName :: Tagged DaytripperWriteMissing Var
optionName = forall (m :: * -> *) a. Monad m => a -> m a
return Var
"daytripper-write-missing"
optionHelp :: Tagged DaytripperWriteMissing Var
optionHelp = forall (m :: * -> *) a. Monad m => a -> m a
return Var
"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 => Var -> Mod f a
long (forall {k} (s :: k) b. Tagged s b -> b
untag (forall v. IsOption v => Tagged v Var
optionName :: Tagged DaytripperWriteMissing String))
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Var -> Mod f a
help (forall {k} (s :: k) b. Tagged s b -> b
untag (forall v. IsOption v => Tagged v Var
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