daytripper 0.3.1 → 0.4.0
raw patch · 3 files changed
+48/−70 lines, 3 filesdep +hedgehogdep +prop-unitdep −falsifydep ~bytestringdep ~tastyPVP ok
version bump matches the API change (PVP)
Dependencies added: hedgehog, prop-unit
Dependencies removed: falsify
Dependency ranges changed: bytestring, tasty
API changes (from Hackage documentation)
- Test.Daytripper: class (MonadFail m) => MonadExpect m
- Test.Daytripper: expectAssertBool :: MonadExpect m => String -> Bool -> m ()
- Test.Daytripper: expectAssertEq :: (MonadExpect m, Eq a, Show a) => a -> a -> m ()
- Test.Daytripper: expectAssertFailure :: MonadExpect m => String -> m ()
- Test.Daytripper: expectLiftIO :: MonadExpect m => IO a -> m a
- Test.Daytripper: instance Test.Daytripper.MonadExpect GHC.Types.IO
- Test.Daytripper: instance Test.Daytripper.MonadExpect Test.Falsify.Property.Property
- Test.Daytripper: daytripperMain :: TestTree -> IO ()
+ Test.Daytripper: daytripperMain :: (TestLimit -> TestTree) -> IO ()
- Test.Daytripper: mkExpect :: MonadExpect m => (a -> m b) -> (b -> m c) -> (Maybe a -> c -> m ()) -> Expect m a b c
+ Test.Daytripper: mkExpect :: Monad m => (a -> m b) -> (b -> m c) -> (Maybe a -> c -> m ()) -> Expect m a b c
- Test.Daytripper: mkFileRT :: TestName -> Expect IO a ByteString c -> FilePath -> Maybe a -> RT
+ Test.Daytripper: mkFileRT :: TestName -> Expect (PropertyT IO) a ByteString c -> FilePath -> Maybe a -> RT
- Test.Daytripper: mkPropRT :: Show a => TestName -> Expect Property a b c -> Gen a -> RT
+ Test.Daytripper: mkPropRT :: Show a => TestName -> Expect (PropertyT IO) a b c -> Gen a -> RT
- Test.Daytripper: mkUnitRT :: TestName -> Expect IO a b c -> a -> RT
+ Test.Daytripper: mkUnitRT :: TestName -> Expect (PropertyT IO) a b c -> a -> RT
- Test.Daytripper: testRT :: RT -> TestTree
+ Test.Daytripper: testRT :: TestLimit -> RT -> TestTree
Files
- daytripper.cabal +10/−9
- src/Test/Daytripper.hs +27/−51
- test/Main.hs +11/−10
daytripper.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.36.0.+-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack name: daytripper-version: 0.3.1+version: 0.4.0 synopsis: Helpers for round-trip tests description: Please see the README on GitHub at <https://github.com/ejconlon/daytripper#readme> homepage: https://github.com/ejconlon/daytripper#readme@@ -16,7 +16,7 @@ license: BSD3 build-type: Simple tested-with:- GHC == 9.2.7+ GHC == 9.8.4 extra-source-files: README.md @@ -59,12 +59,12 @@ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -fno-warn-unused-top-binds build-depends: base >=4.12 && <5- , bytestring ==0.11.*+ , bytestring >=0.11 && <0.13 , directory ==1.3.*- , falsify ==0.2.* , optparse-applicative >=0.17 && <0.19+ , prop-unit ==0.2.* , tagged ==0.8.*- , tasty ==1.4.*+ , tasty >=1.4 && <1.6 , tasty-hunit ==0.10.* default-language: GHC2021 @@ -103,12 +103,13 @@ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -fno-warn-unused-top-binds -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.12 && <5- , bytestring ==0.11.*+ , bytestring >=0.11 && <0.13 , daytripper , directory ==1.3.*- , falsify ==0.2.*+ , hedgehog ==1.5.* , optparse-applicative >=0.17 && <0.19+ , prop-unit ==0.2.* , tagged ==0.8.*- , tasty ==1.4.*+ , tasty >=1.4 && <1.6 , tasty-hunit ==0.10.* default-language: GHC2021
src/Test/Daytripper.hs view
@@ -1,6 +1,5 @@ module Test.Daytripper- ( MonadExpect (..)- , Expect+ ( Expect , expectBefore , expectDuring , expectAfter@@ -17,45 +16,20 @@ ) where -import Control.Monad (unless, void)+import Control.Monad (void)+import Control.Monad.IO.Class (liftIO) 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 PropUnit (Gen, PropertyT, TestLimit, forAll, setupTests, testProp, testUnit, (===)) 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) --- | Interface for asserting and performing IO in tests.--- TODO Migrate to 'MonadIO' superclass when Falsify supports it.-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 s b = unless b (expectAssertFailure s)--instance MonadExpect IO where- expectLiftIO = id- expectAssertEq = (@?=)- expectAssertFailure = assertFailure- expectAssertBool = assertBool--instance MonadExpect Property where- expectLiftIO = pure . unsafePerformIO- expectAssertEq x y = FP.assert (FR.eq FR..$ ("LHS", x) FR..$ ("RHS", y))- expectAssertFailure = FP.testFailed- -- | A general type of test expectation. Captures two stages of processing an input, -- first encoding, then decoding. The monad is typically something implementing -- 'MonadExpect', with assertions performed before returning values for further processing.@@ -80,7 +54,7 @@ -- | A way of definining expectations from a pair of encode/decode functions and -- a comparison function. mkExpect- :: (MonadExpect m)+ :: (Monad m) => (a -> m b) -> (b -> m c) -> (Maybe a -> c -> m ())@@ -97,20 +71,20 @@ runExpect f a = f (Right a) >>= snd data PropRT where- PropRT :: (Show a) => TestName -> Expect Property a b c -> Gen a -> PropRT+ PropRT :: (Show a) => TestName -> Expect (PropertyT IO) a b c -> Gen a -> PropRT -- | Create a property-based roundtrip test-mkPropRT :: (Show a) => TestName -> Expect Property a b c -> Gen a -> RT+mkPropRT :: (Show a) => TestName -> Expect (PropertyT IO) a b c -> Gen a -> RT mkPropRT name expec gen = RTProp (PropRT name expec gen) -testPropRT :: PropRT -> TestTree-testPropRT (PropRT name expec gen) =- testProperty name (FP.gen gen >>= void . runExpect expec)+testPropRT :: TestLimit -> PropRT -> TestTree+testPropRT lim (PropRT name expec gen) =+ testProp name lim (forAll gen >>= void . runExpect expec) data FileRT where FileRT :: TestName- -> Expect IO a ByteString c+ -> Expect (PropertyT IO) a ByteString c -> FilePath -> Maybe a -> FileRT@@ -118,7 +92,7 @@ -- | Create a file-based ("golden") roundtrip test mkFileRT :: TestName- -> Expect IO a ByteString c+ -> Expect (PropertyT IO) a ByteString c -> FilePath -> Maybe a -> RT@@ -126,33 +100,33 @@ testFileRT :: FileRT -> TestTree testFileRT (FileRT name expec fn mval) = askOption $ \dwm ->- testCase name $ do- exists <- doesFileExist fn+ testUnit name $ do+ exists <- liftIO (doesFileExist fn) (mcon, eval) <- if exists then do- con <- BS.readFile fn+ con <- liftIO (BS.readFile fn) pure (Just con, maybe (Left con) Right mval) else case (dwm, mval) of (DaytripperWriteMissing True, Just val) -> pure (Nothing, Right val) _ -> fail ("File missing: " ++ fn) (bs, end) <- expec eval- for_ mcon (bs @?=)+ for_ mcon (bs ===) _ <- end case mcon of- Nothing -> BS.writeFile fn bs+ Nothing -> liftIO (BS.writeFile fn bs) Just _ -> pure () data UnitRT where- UnitRT :: TestName -> Expect IO a b c -> a -> UnitRT+ UnitRT :: TestName -> Expect (PropertyT IO) a b c -> a -> UnitRT -- | Create a unit roundtrip test-mkUnitRT :: TestName -> Expect IO a b c -> a -> RT+mkUnitRT :: TestName -> Expect (PropertyT IO) a b c -> a -> RT mkUnitRT name expec val = RTUnit (UnitRT name expec val) testUnitRT :: UnitRT -> TestTree testUnitRT (UnitRT name expec val) =- testCase name (void (runExpect expec val))+ testUnit name (void (runExpect expec val)) data RT = RTProp !PropRT@@ -160,9 +134,9 @@ | RTUnit !UnitRT -- | Run a roundtrip test-testRT :: RT -> TestTree-testRT = \case- RTProp x -> testPropRT x+testRT :: TestLimit -> RT -> TestTree+testRT lim = \case+ RTProp x -> testPropRT lim x RTFile x -> testFileRT x RTUnit x -> testUnitRT x @@ -193,5 +167,7 @@ : defaultIngredients -- | Tasty main with write-missing support-daytripperMain :: TestTree -> IO ()-daytripperMain = defaultMainWithIngredients daytripperIngredients+daytripperMain :: (TestLimit -> TestTree) -> IO ()+daytripperMain f = do+ lim <- setupTests+ defaultMainWithIngredients daytripperIngredients (f lim)
test/Main.hs view
@@ -9,13 +9,14 @@ import Data.ByteString (ByteString) import Data.ByteString qualified as BS import Data.Maybe (isJust, isNothing)-import Test.Daytripper (Expect, MonadExpect (..), daytripperMain, mkExpect, mkFileRT, mkPropRT, mkUnitRT, testRT)-import Test.Falsify.Generator qualified as Gen+import Hedgehog.Gen qualified as Gen+import PropUnit (MonadTest, assert, (===))+import Test.Daytripper (Expect, daytripperMain, mkExpect, mkFileRT, mkPropRT, mkUnitRT, testRT) import Test.Tasty (testGroup) type Cmp m = Maybe ByteString -> Maybe ByteString -> m () -expec :: (MonadExpect m) => Cmp m -> Expect m ByteString ByteString (Maybe ByteString)+expec :: (Monad m) => Cmp m -> Expect m ByteString ByteString (Maybe ByteString) expec = mkExpect enc dec where enc a = pure (a <> a)@@ -26,21 +27,21 @@ then Just a else Nothing -expecOk, expecFail :: (MonadExpect m) => Expect m ByteString ByteString (Maybe ByteString)+expecOk, expecFail :: (MonadTest m) => Expect m ByteString ByteString (Maybe ByteString) expecOk = expec $ maybe- (expectAssertBool "expected Just" . isJust)- (\a mc -> expectAssertEq mc (Just a))-expecFail = expec (const (expectAssertBool "expected Nothing" . isNothing))+ (assert . isJust)+ (\a mc -> mc === Just a)+expecFail = expec (const (assert . isNothing)) main :: IO () main =- daytripperMain $+ daytripperMain $ \lim -> testGroup "Daytripper" $ fmap- testRT- [ mkPropRT "prop" expecOk (Gen.choose (pure "a") (pure "b"))+ (testRT lim)+ [ mkPropRT "prop" expecOk (Gen.element ["a", "b"]) , mkUnitRT "unit" expecOk "a" , mkFileRT "file just" expecOk "testdata/b.txt" (Just "b") , mkFileRT "file nothing" expecOk "testdata/c.txt" Nothing