packages feed

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 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