typeable-mock (empty) → 0.1.0.0
raw patch · 7 files changed
+823/−0 lines, 7 filesdep +basedep +call-stackdep +containerssetup-changed
Dependencies added: base, call-stack, containers, hspec, typeable-mock, variadic-function
Files
- ChangeLog.md +4/−0
- LICENSE +30/−0
- README.md +22/−0
- Setup.hs +3/−0
- src/Test/TypeableMock.hs +479/−0
- test/Spec.hs +211/−0
- typeable-mock.cabal +74/−0
+ ChangeLog.md view
@@ -0,0 +1,4 @@+# Changelog for typeable-mock++## 0.1.0.0+- The first release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Boris Lykah (c) 2021++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,22 @@+Mock any `Typeable` function or expression anywhere.++A common approach to mocking in Haskell is with type classes, with instances for the real and test logic. Typeable-mock fills a niche for the projects that do not use granular type classes so much. It lets you mock any `Typeable` expression in context of nearly any monad. It works in a monad of a concrete type or a polymorphic one with class constraints.++```haskell+-- Use mock in application. Here `useMock` is a user-written helper that+-- is aware of the application context and can look up mocks in there.+useMock "writeFile" writeFile >>= \f -> liftIO (f path contents)++-- Declare mock in test.+writeFileMock <- makeMock "writeFile"+ ((\_ _ -> pure ()) :: FilePath -> String -> IO ())++-- Check assertions+assertHasCalls+ [ expectCall "/tmp/1.txt" "Hello world",+ expectCall AnyVal (PredicateVal $ elem "Hello" . words)+ ]+ writeFileMock+```++See the package documentation and [examples/App.hs](https://github.com/lykahb/typeable-mock/blob/master/examples/App.hs) for more.
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ src/Test/TypeableMock.hs view
@@ -0,0 +1,479 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-}++module Test.TypeableMock+ ( -- * Mocks and mock configuration+ Mock (..),+ MockConfig (..),+ defaultMockConfig,+ addMocksToConfig,++ -- * Creating and calling mocks+ makeMock,+ lookupMockFunction,+ constN,++ -- * Checking calls+ ActualCallRecord (..),+ ActualVal (..),+ ExpectedCallRecord (..),+ ExpectedVal (..),+ MockFailure (..),+ MockFailureReason (..),+ lookupMock,+ lookupMockTyped,+ useMockConvert,+ assertHasCalls,+ assertNotCalled,+ assertAnyCall,+ getCalls,+ expectCall,+ withResult,+ callMatches,+ resetMockCallRecords,+ resetAllCallRecords,++ -- * Mocking polymorphic monads+ -- $polymorphic+ MockMonadIO (..),+ fromMockMonadIO,+ unMockMonadIO1,+ unMockMonadIO2,+ unMockMonadIO3,+ unMockMonadIO4,+ unMockMonadIO5,+ -- $polymorphicAdvanced+ )+where++import Control.Applicative (Alternative ((<|>)))+import Control.Exception (Exception, throwIO)+import Control.Monad (unless)+import Control.Monad.IO.Class (MonadIO (liftIO))+import Data.CallStack (HasCallStack, SrcLoc (..), callStack)+import Data.Function.Variadic+import Data.Function.Variadic.Utils (composeN, constN)+import Data.IORef (IORef, modifyIORef, newIORef, readIORef, writeIORef)+import Data.List (foldl', intercalate)+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Maybe+import Data.Typeable (Proxy (Proxy), TypeRep, Typeable, cast, eqT, typeOf, typeRep, (:~:) (..))++data ActualCallRecord = ActualCallRecord [ActualVal] ActualVal++data ActualVal = forall a. Typeable a => ActualVal a++data Mock = forall x.+ Typeable x =>+ Mock+ { mockKey :: String,+ mockCallRecord :: IORef [ActualCallRecord],+ mockFunction :: IORef [ActualCallRecord] -> x+ }++instance Show Mock where+ show Mock {..} = "Mock (" <> mockKey <> " :: " <> show tRep <> ")"+ where+ tRep = typeRep mockFunction++-- | Mock configuration. When running production, use the `defaultMockConfig` without adding mocks to it -+-- it would call the real functions.+--+-- The key or type of the mock created in a test suite may accidentally mismatch the key or type at the place where a mock is used.+-- Silently calling the real functions would make the test suite fragile.+-- So, when running on a test suite, protect against the mismatches by requiring that the mocks are present.+-- Set `mcShouldFailOnNotFound` to return True or allow a few special cases:+--+-- > testMockConfig = defaultMockConfig {+-- > mcShouldFailOnNotFound = \\key tRep -> key ``notElem`` whitelist where+-- > -- Functions that are allowed to be called during tests.+-- > whitelist = ["readFile"]+-- > }+data MockConfig = MockConfig+ { -- | A map of mocks. The key of the inner map is the @TypeRep@ of the function supplied when making a mock.+ mcStorage :: Map String (Map TypeRep Mock),+ -- | Decide whether to throw an error when a mock is not found.+ mcShouldFailOnNotFound :: String -> TypeRep -> Bool+ }++instance Show MockConfig where+ show MockConfig {..} = "MockConfig " <> show mcStorage++defaultMockConfig :: MockConfig+defaultMockConfig = MockConfig mempty (\_ _ -> False)++data MockFailure = MockFailure+ { mfMock :: Mock,+ mfLocation :: Maybe SrcLoc,+ mfReason :: MockFailureReason+ }++data MockFailureReason+ = MockFailureArgumentCountMismatch ActualCallRecord ExpectedCallRecord+ | MockFailureArgumentTypeMismatch TypeRep TypeRep+ | forall a. Show a => MockFailureArgumentValueMismatch a a+ | forall a. Show a => MockFailureArgumentPredicateFailure a+ | MockFailureUnexpectedCall ActualCallRecord+ | MockFailureNotCalled ExpectedCallRecord++instance Show MockFailureReason where+ show reason = intercalate "\n" $ case reason of+ MockFailureArgumentCountMismatch (ActualCallRecord actArgs _) (ExpectedCallRecord expArgs _) ->+ ["Number of arguments does not match:", "expected: " ++ show (length expArgs), "but got: " ++ show (length actArgs)]+ MockFailureArgumentTypeMismatch actual expected ->+ ["Value type does not match:", "expected: " ++ show expected, "but got: " ++ show actual]+ MockFailureArgumentValueMismatch actual expected ->+ ["Value does not match:", "Expected: " ++ show expected, "but got: " ++ show actual]+ MockFailureArgumentPredicateFailure actual ->+ ["Predicate failed:", show actual]+ MockFailureUnexpectedCall _ ->+ ["Unexpected call"] -- We do not know if the arguments have an instance of Show to print them.+ MockFailureNotCalled (ExpectedCallRecord expArgs _) ->+ ["Expected call with arguments: " ++ show expArgs, "but was not called"]++instance Show MockFailure where+ show MockFailure {..} =+ intercalate "\n" $+ ["Assertion failed for " <> show mfMock, show mfReason] <> maybe [] (\loc -> ["at:", prettyLocation loc]) mfLocation+ where+ prettyLocation SrcLoc {..} = srcLocFile ++ ":" ++ show srcLocStartLine ++ ":" ++ show srcLocStartCol ++ " in " ++ srcLocPackage ++ ":" ++ srcLocModule++instance Exception MockFailure++-- | Wraps the function into a `Mock`. For successful lookup at the call site,+-- the type of the passed function must match the type of the mocked function.+--+-- If the mocked function has polymorphic arguments, such as @print :: Show a => a -> IO ()@,+-- create a mock for each case. For example, if an app prints Int and Strings, create+-- two mocks:+--+-- @+-- mockConf \<- 'addMocksToConfig' defaultConf \<$> sequence+-- [ makeMock "print" (const $ pure () :: Int -> IO ()),+-- , makeMock "print" (const $ pure () :: String -> IO ())+-- ]+-- @+--+-- For mocking functions with many arguments it is convenient to use `constN` and `asTypeOf`.+-- Using `asTypeOf` lets you omit the type annotation. These definitions create the same mock:+--+-- @+-- makeMock "someAction" ((\\_ _ _ -> pure "result") :: Arg1 -> Arg2 -> Arg3 -> SomeMonad ())+-- makeMock "someAction" ('constN' $ pure "result" :: Arg1 -> Arg2 -> Arg3 -> SomeMonad ())+-- makeMock "someAction" ('constN' $ pure "result" \`'asTypeOf'\` someAction)+-- @+makeMock ::+ (Function f args (m x) Typeable, Typeable f, Typeable x, MonadIO m) =>+ String ->+ f ->+ IO Mock+makeMock key f = do+ actualCallRecord <- newIORef []+ pure $ Mock key actualCallRecord (`recordArgs` f)++-- | A helper function to lookup the function. Likely you want to write a wrapper+-- that retrieves the @MockConfig@ from the environment.+--+-- > withMock :: String -> f -> AppMonad f+-- > withMock key f = do+-- > mockConf <- getMockConfig <$> getEnv+-- > pure $ fromMaybe f (lookupMockFunction mockConf key)+-- >+-- > withMock "getSomething" getSomething >>= \f -> f someArg+lookupMockFunction :: forall f. Typeable f => MockConfig -> String -> Maybe f+lookupMockFunction conf key = case lookupMockTyped @f conf key of+ Just Mock {..} -> case cast (mockFunction mockCallRecord) of+ Just val -> Just val+ Nothing ->+ error $+ "lookupMockFunction: impossible happened. Cast failed for " <> key <> " from "+ <> show (typeOf (mockFunction mockCallRecord))+ <> " to "+ <> show (typeRep (Proxy :: Proxy f))+ Nothing -> Nothing++recordArgs ::+ (Typeable x, MonadIO m, Function f args (m x) Typeable) =>+ IORef [ActualCallRecord] ->+ f ->+ f+recordArgs callsRef = transformFunction (Proxy :: Proxy Typeable) fa fr []+ where+ fa args a = ActualVal a : args+ fr args mx = do+ x <- mx+ liftIO $ modifyIORef callsRef (ActualCallRecord (reverse args) (ActualVal x) :)+ pure x++-- | Reuse the mocks between the test items+resetMockCallRecords :: Mock -> IO ()+resetMockCallRecords (Mock _ callsRef _) = writeIORef callsRef []++-- | Reuse the mocks between the test items+resetAllCallRecords :: MockConfig -> IO ()+resetAllCallRecords MockConfig {..} = mapM_ (mapM_ resetMockCallRecords) mcStorage++-- | Find a mock by name. If there are several mocks under the same name, use `lookupMockTyped`.+lookupMock :: HasCallStack => MockConfig -> String -> Mock+lookupMock MockConfig {..} key = case Map.lookup key mcStorage of+ Nothing -> error $ "lookupMock: Mock " <> key <> " not found"+ Just tMap -> case Map.elems tMap of+ [mock] -> mock+ _ -> error $ "lookupMock: There are " <> show (Map.size tMap) <> " mocks under the name \"" <> key <> "\". Use lookupMockTyped to disambiguate."++-- | Find a mock by name and type.+lookupMockTyped :: forall t. (HasCallStack, Typeable t) => MockConfig -> String -> Maybe Mock+lookupMockTyped MockConfig {..} key = do+ let tMap = Map.lookup key mcStorage+ case tMap >>= Map.lookup tRep of+ Just mock -> Just mock+ Nothing | mcShouldFailOnNotFound key tRep -> case tMap of+ Nothing ->+ error $+ "lookupMockTyped: cannot find mock " <> key <> " :: " <> show tRep <> ". "+ <> "There are no mocks under this name."+ Just tMap' ->+ error $+ "lookupMockTyped: cannot find mock " <> key <> " :: " <> show tRep <> ". "+ <> "There are mocks with other types under the same name:\n"+ <> unlines (map show $ Map.elems tMap')+ Nothing -> Nothing+ where+ tRep = typeRep (Proxy :: Proxy t)++-- | Build helpers using mocks in your application with this.+-- The conversion is for the case when the type of a function stored in mock+-- does not match the mocked function. Usually this is a case for a newtype+-- wrapper over a polymorphic monad like MockMonadIO.+useMockConvert ::+ (Monad m, Typeable mock) =>+ -- | Get mock config from the context+ -- | Convert the mock function. Usually it is @id@ or unwrapping function for an existential type like @MockMonadIO@.+ m MockConfig ->+ (mock -> f) ->+ -- | Key of the mock+ String ->+ -- | The function that is being mocked+ f ->+ m f+useMockConvert getMockConfig conv key f = do+ mockConfig <- getMockConfig+ pure $ maybe f conv (lookupMockFunction mockConfig key)++addMocksToConfig :: MockConfig -> [Mock] -> MockConfig+addMocksToConfig conf mocks = conf {mcStorage = mockMap}+ where+ mockMap = foldl' insertMock (mcStorage conf) mocks+ insertMock m mock@Mock {..} = Map.insertWith insert mockKey singleMock m+ where+ singleMock = Map.singleton tRep mock+ insert _ = Map.insert tRep mock+ tRep = typeOf $ mockFunction undefined++-- | Description of what value for mock call the assertions expect+data ExpectedVal+ = AnyVal+ | forall a. (Typeable a, Show a, Eq a) => ExpectedVal a+ | forall a. (Typeable a, Show a) => PredicateVal (a -> Bool)++instance Eq ExpectedVal where+ (==) = error "Eq ExpectedVal not implemented"++data ExpectedCallRecord = ExpectedCallRecord [ExpectedVal] ExpectedVal++instance Show ExpectedVal where+ show AnyVal = "AnyVal"+ show (ExpectedVal a) = show a+ show (PredicateVal p) = "PredicateVal p :: " <> show (typeOf p)++-- | Use this to create `ExpectedCallRecord`+--+-- Examples:+--+-- @+-- expectCall "email@example.com" True+-- @+expectCall ::+ (Function f args ExpectedCallRecord (Show & Eq & Typeable)) =>+ f+expectCall = createFunction (Proxy :: Proxy (Show & Eq & Typeable)) fa fr []+ where+ fa args arg = (: args) $ case cast arg of+ Just arg' -> arg'+ Nothing -> ExpectedVal arg+ fr args = ExpectedCallRecord (reverse args) AnyVal++-- | Assert that mock returned the given result.+-- Sometimes it is more convenient than checking arguments.+withResult :: (Show a, Eq a, Typeable a) => ExpectedCallRecord -> a -> ExpectedCallRecord+withResult (ExpectedCallRecord args _) arg = ExpectedCallRecord args r+ where+ r = case cast arg of+ Just arg' -> arg'+ Nothing -> ExpectedVal arg++checkCallRecord :: HasCallStack => ActualCallRecord -> ExpectedCallRecord -> Maybe MockFailureReason+checkCallRecord actCall@(ActualCallRecord actArgs actRes) expCall@(ExpectedCallRecord expArgs expRes) =+ argFailure <|> resFailure+ where+ argFailure =+ if length actArgs /= length expArgs+ then Just $ MockFailureArgumentCountMismatch actCall expCall+ else listToMaybe $ catMaybes $ zipWith matchArgs actArgs expArgs+ resFailure = matchArgs actRes expRes++matchArgs :: ActualVal -> ExpectedVal -> Maybe MockFailureReason+matchArgs _ AnyVal = Nothing+matchArgs (ActualVal actual) (ExpectedVal expected) =+ case cast actual of+ Just actual' | expected == actual' -> Nothing+ Just actual' ->+ Just $+ MockFailureArgumentValueMismatch actual' expected+ Nothing ->+ Just $+ MockFailureArgumentTypeMismatch (typeOf actual) (typeOf expected)+matchArgs (ActualVal (actual :: a)) (PredicateVal (p :: b -> Bool)) =+ case eqT :: Maybe (a :~: b) of+ Nothing -> Just $ MockFailureArgumentTypeMismatch (typeRep (Proxy :: Proxy a)) (typeRep (Proxy :: Proxy b))+ Just Refl ->+ if p actual+ then Nothing+ else Just $ MockFailureArgumentPredicateFailure actual++-- | Assert that all expected calls were made in the given order.+--+-- @+-- mock <- lookupMockInEnv "name" -- user-defined helper function for your app env+-- liftIO $ assertHasCalls [expectCall "arg1" "arg2"] mock+-- @+assertHasCalls :: HasCallStack => [ExpectedCallRecord] -> Mock -> IO ()+assertHasCalls expectedCalls mock = do+ actualCalls <- getCalls mock+ zipEqualLength actualCalls expectedCalls+ where+ throw = throwIO . MockFailure mock location+ zipEqualLength [] [] = pure ()+ zipEqualLength (a : as) (e : es) = do+ maybe (pure ()) throw $ checkCallRecord a e+ zipEqualLength as es+ zipEqualLength (a : _) _ = throw $ MockFailureUnexpectedCall a+ zipEqualLength _ (e : _) = throw $ MockFailureNotCalled e++-- | Assert the mock was never called.+assertNotCalled :: HasCallStack => Mock -> IO ()+assertNotCalled = assertHasCalls []++-- | The expected call record matches the actual one. Note that it throws+-- error for the logic bugs when a mismatch is caused by wrong number+-- of arguments or wrong types.+callMatches :: ActualCallRecord -> ExpectedCallRecord -> Bool+callMatches actCall expCall = case checkCallRecord actCall expCall of+ Nothing -> True+ Just MockFailureArgumentValueMismatch {} -> False+ Just MockFailureArgumentPredicateFailure {} -> False+ Just reason -> error $ "callMatches: invalid arguments\n" <> show reason++-- | Assert that the expected call happened at least once.+assertAnyCall :: ExpectedCallRecord -> Mock -> IO ()+assertAnyCall expCall mock = do+ actualCalls <- getCalls mock+ unless (any (\actCall -> isNothing $ checkCallRecord actCall expCall) actualCalls) $ do+ throwIO $ MockFailure mock location $ MockFailureNotCalled expCall++-- | Get list of calls. Use together with 'callMatches'+-- when the existing assert* functions are not flexible enough.+getCalls :: Mock -> IO [ActualCallRecord]+getCalls Mock {..} = reverse <$> readIORef mockCallRecord++location :: HasCallStack => Maybe SrcLoc+location = case reverse callStack of+ (_, loc) : _ -> Just loc+ [] -> Nothing++-- $polymorphic+-- It is common to have the application logic live in a polymorphic monad+-- that is constrained with several type classes.+-- However, only the monomorphic types have an instance of Typeable and can be mocked.+-- The solution is to wrap a polymorphic function with a concrete existential type.+--+-- The library provides MockMonadIO that lets you write a mock fitting in+-- any context that has @MonadIO@.+--+-- Define a mock and add it to the config:+--+-- > makeMock (const $ pure "getSomething" :: Int -> MockMonadIO String)+--+-- Then use it at the call site. Before calling the mock, you need to unwrap the existential type.+-- It is a good idea to define your own helpers for getting the mock config and mock lookup.+-- That would make calling mocks much more concise. See more at examples/App.hs.+--+-- Here is a verbose example that expands both retrieving and transforming the mock.+--+-- > insideAppPolymorphicMonad :: (HasEnv m, MonadIO m) => Int -> m ()+-- > insideAppPolymorphicMonad arg = do+-- > mockConf <- getMockConfig <$> getEnv+-- > let mock = lookupMockFunction mockConf "getSomething"+-- > (maybe unMockMonadIO1 getSomething mock) arg+--+-- With your own helpers it can look like this:+--+-- > insideAppPolymorphicMonad :: (HasEnv m, MonadIO m) => Int -> m ()+-- > insideAppPolymorphicMonad arg = do+-- > myMockHelper unMockMonadIO1 getSomething mock >>= \f -> f arg++-- $polymorphicAdvanced+-- === Advanced polymorphic mocks+-- If your mock needs to be aware of a custom class to return a result, and+-- be able to called from polymorphic code, make your own wrapper similar+-- to MockMonadIO. For example:+--+-- > newtype MockMonadHasMyEnv a = MockMonadHasMyEnv {+-- > unMockMonadHasMyEnv :: forall m. (MonadIO m, HasMyEnv m) => m a+-- > }+--+-- > makeMock (\a -> getMyEnv >>= makeFakeResult ... :: Int -> MockMonadHasMyEnv String)++-- | Helper for making polymorphic mock functions.+newtype MockMonadIO a = MockMonadIO {unMockMonadIO :: forall m. MonadIO m => m a}++instance Functor MockMonadIO where+ fmap f (MockMonadIO m) = MockMonadIO (fmap f m)++instance Applicative MockMonadIO where+ pure a = MockMonadIO (pure a)+ MockMonadIO f <*> MockMonadIO a = MockMonadIO (f <*> a)++instance Monad MockMonadIO where+ MockMonadIO ma >>= f = MockMonadIO $ ma >>= unMockMonadIO . f++instance MonadIO MockMonadIO where+ liftIO m = MockMonadIO (liftIO m)++-- | The family of functions unMockMonadIO<N> is specialized with the number of arguments.+-- Unlike @fromMockMonadIO@, the monad @m@ can be polymorphic at the call site.+unMockMonadIO1 :: (a -> MockMonadIO x) -> (forall m. MonadIO m => a -> m x)+unMockMonadIO1 f = unMockMonadIO . f++unMockMonadIO2 :: (a -> b -> MockMonadIO x) -> (forall m. MonadIO m => a -> b -> m x)+unMockMonadIO2 f = unMockMonadIO1 . f++unMockMonadIO3 :: (a -> b -> c -> MockMonadIO x) -> (forall m. MonadIO m => a -> b -> c -> m x)+unMockMonadIO3 f = unMockMonadIO2 . f++unMockMonadIO4 :: (a -> b -> c -> d -> MockMonadIO x) -> (forall m. MonadIO m => a -> b -> c -> d -> m x)+unMockMonadIO4 f = unMockMonadIO3 . f++unMockMonadIO5 :: (a -> b -> c -> d -> e -> MockMonadIO x) -> (forall m. MonadIO m => a -> b -> c -> d -> e -> m x)+unMockMonadIO5 f = unMockMonadIO4 . f++-- | Changes the return type of a function from @MockMonadIO x@ to @m x@.+-- The @m@ must be a concrete type at the call site.+-- If the caller is in a polymorphic monad, use one of the @unMockMonadIO<N>@ instead.+fromMockMonadIO ::+ forall m x args f' f.+ (MonadIO m, Function f' args (MockMonadIO x) EmptyConstraint, Function f args (m x) EmptyConstraint) =>+ f' ->+ f+fromMockMonadIO = composeN unMockMonadIO
+ test/Spec.hs view
@@ -0,0 +1,211 @@+{-# LANGUAGE TypeApplications #-}++import Control.Monad (void)+import Control.Monad.IO.Class (MonadIO (..))+import Data.Maybe (fromMaybe, isNothing)+import Data.Typeable (Typeable)+import Test.Hspec+import Test.TypeableMock++main :: IO ()+main = hspec $ do+ let withMock :: Typeable f => MockConfig -> String -> f -> f+ withMock conf key f = fromMaybe f (lookupMockFunction conf key)+ printWithMock :: (Show a, Typeable a) => MockConfig -> a -> IO ()+ printWithMock conf = withMock conf "print" print+ printStringMock <- runIO $ makeMock "print" (const $ pure () :: String -> IO ())++ let mockConf :: MockConfig+ mockConf = defaultMockConfig `addMocksToConfig` [printStringMock]++ before_ (resetAllCallRecords mockConf) $ do+ describe "Assertions" $ do+ describe "expectCall" $ do+ it "mocks a single argument function" $ do+ printWithMock mockConf "one"+ assertHasCalls [expectCall "one"] printStringMock++ it "mocks a multiple arguments function" $ do+ let print2 :: Int -> Int -> IO ()+ print2 a b = print (a, b)+ print2WithMock conf = withMock conf "print2" print2 1 2++ print2Mock <- makeMock "print2" ((\_ _ -> pure ()) :: Int -> Int -> IO ())+ print2WithMock $ defaultMockConfig `addMocksToConfig` [print2Mock]+ assertHasCalls [expectCall (1 :: Int) (2 :: Int)] print2Mock++ it "mocks polymorphic monads with MockMonadIO" $ do+ -- Polymorphic types cannot be used with Typeable typeOf. This library has a workaround for monads.+ let print5 a b c d e = liftIO $ print (a, b, c, d, e)+ let printInMonadIO :: forall m. MonadIO m => MockConfig -> Bool -> Char -> Char -> Char -> Char -> m ()+ printInMonadIO conf =+ maybe print5 unMockMonadIO5 (lookupMockFunction conf "print5")+ let printInIO :: MockConfig -> Bool -> Char -> Char -> Char -> Char -> IO ()+ printInIO conf =+ maybe print5 fromMockMonadIO (lookupMockFunction conf "print5")++ print5Mock <- makeMock "print5" (constN $ pure () :: Bool -> Char -> Char -> Char -> Char -> MockMonadIO ())++ let mockConf' :: MockConfig+ mockConf' = mockConf `addMocksToConfig` [print5Mock]+ printInMonadIO mockConf' True 'a' 'b' 'c' 'd'+ printInIO mockConf' True 'a' 'b' 'c' 'd'+ assertHasCalls [expectCall True 'a' 'b' 'c' 'd', expectCall True 'a' 'b' 'c' 'd'] print5Mock++ describe "assertHasCalls" $ do+ it "mocks multiple calls" $ do+ printWithMock mockConf "one"+ printWithMock mockConf "two"+ assertHasCalls+ [ expectCall "one",+ expectCall "two"+ ]+ printStringMock++ it "fails when there are more calls than expected" $+ do+ printWithMock mockConf "one"+ printWithMock mockConf "two"+ assertHasCalls [expectCall "one"] printStringMock+ `shouldThrow` \case+ MockFailure {mfReason = MockFailureUnexpectedCall {}} -> True+ _ -> False++ it "fails when there are fewer calls than expected" $ do+ printWithMock mockConf "one"+ assertHasCalls+ [ expectCall "one",+ expectCall "two"+ ]+ printStringMock+ `shouldThrow` \case+ MockFailure {mfReason = MockFailureNotCalled {}} -> True+ _ -> False++ it "fails when a call is with different arguments" $ do+ printWithMock mockConf "one"+ assertHasCalls [expectCall "two"] printStringMock `shouldThrow` \case+ MockFailure {mfReason = MockFailureArgumentValueMismatch {}} -> True+ _ -> False++ it "fails when a call returns different result" $ do+ let doubleFunc :: Int -> IO Int+ doubleFunc a = print a >> pure (a * 2)+ doubleMock <- makeMock "double" ((\a -> pure (a * 2)) `asTypeOf` doubleFunc)+ let mockConf' = mockConf `addMocksToConfig` [doubleMock]++ void $ withMock mockConf' "double" doubleFunc 5+ assertHasCalls [expectCall AnyVal `withResult` (10 :: Int)] doubleMock+ assertHasCalls [expectCall AnyVal `withResult` (11 :: Int)] doubleMock+ `shouldThrow` \case+ MockFailure {mfReason = MockFailureArgumentValueMismatch {}} -> True+ _ -> False++ describe "assertNotCalled" $ do+ it "succeeds when mock was not called" $ do+ assertNotCalled printStringMock++ it "fails when mock was called" $ do+ printWithMock mockConf "one"+ assertNotCalled printStringMock `shouldThrow` \case+ MockFailure {mfReason = MockFailureUnexpectedCall {}} -> True+ _ -> False++ describe "assertNotCalled" $ do+ it "fails when mock was not called" $ do+ printWithMock mockConf "two"+ assertAnyCall (expectCall "one") printStringMock+ `shouldThrow` \case+ MockFailure {mfReason = MockFailureNotCalled {}} -> True+ _ -> False++ describe "Config" $ do+ it "addMocksToConfig overrides mocks" $ do+ printIntMock1 <- makeMock "print" (const $ pure () :: Int -> IO ())+ printIntMock2 <- makeMock "print" (const $ pure () :: Int -> IO ())+ let mockConf' = mockConf `addMocksToConfig` [printIntMock1, printIntMock2]+ printWithMock mockConf' (1 :: Int)+ assertHasCalls [expectCall (1 :: Int)] printIntMock2++ printIntMock3 <- makeMock "print" (const $ pure () :: Int -> IO ())+ let mockConf'' = mockConf `addMocksToConfig` [printIntMock3]+ printWithMock mockConf'' (1 :: Int)+ assertHasCalls [expectCall (1 :: Int)] printIntMock3++ describe "Arguments comparison" $ do+ it "checks argument count" $ do+ printWithMock mockConf "one"+ assertHasCalls [expectCall "a" "b"] printStringMock `shouldThrow` \case+ MockFailure {mfReason = MockFailureArgumentCountMismatch {}} -> True+ _ -> False++ it "checks argument types" $ do+ printWithMock mockConf "one"+ assertHasCalls [expectCall ()] printStringMock `shouldThrow` \case+ MockFailure {mfReason = MockFailureArgumentTypeMismatch {}} -> True+ _ -> False++ it "checks predicate for argument" $ do+ printWithMock mockConf "one"+ assertHasCalls [expectCall (PredicateVal (== "one"))] printStringMock+ assertHasCalls [expectCall (PredicateVal (== "two"))] printStringMock+ `shouldThrow` \case+ MockFailure {mfReason = MockFailureArgumentPredicateFailure {}} -> True+ _ -> False++ it "ignores expected argument when it is AnyVal" $ do+ printWithMock mockConf "one"+ assertHasCalls [expectCall AnyVal] printStringMock++ describe "Retrieving mocks" $ do+ describe "lookupMock" $ do+ it "finds mock" $ do+ show (lookupMock mockConf "print") `shouldBe` show printStringMock++ it "finds mocks with different types" $ do+ printIntMock <- makeMock "print" (const $ pure () :: Int -> IO ())+ let mockConf' = mockConf `addMocksToConfig` [printIntMock]+ printWithMock mockConf' "one"+ printWithMock mockConf' (1 :: Int)+ assertHasCalls [expectCall "one"] printStringMock+ assertHasCalls [expectCall (1 :: Int)] printIntMock++ it "fails for multiple mocks with the same name" $ do+ printIntMock <- makeMock "print" ((\_ -> pure ()) :: Int -> IO ())+ let mockConf' = mockConf `addMocksToConfig` [printIntMock]+ (lookupMock mockConf' "print" `seq` pure ())+ `shouldThrow` errorCall "lookupMock: There are 2 mocks under the name \"print\". Use lookupMockTyped to disambiguate."++ it "fails when there is no mock" $ do+ (lookupMock mockConf "noSuchMock" `seq` pure ())+ `shouldThrow` errorCall "lookupMock: Mock noSuchMock not found"++ describe "lookupMockTyped" $ do+ it "finds mock" $ do+ printIntMock <- makeMock "print" ((\_ -> pure ()) :: Int -> IO ())+ let mockConf' = mockConf `addMocksToConfig` [printIntMock]+ let Just mock = lookupMockTyped @(Int -> IO ()) mockConf' "print"+ show mock `shouldBe` show printIntMock++ it "fails when mcShouldFailOnNotFound and there are no mocks with the given name " $ do+ let mockConf' = mockConf {mcShouldFailOnNotFound = \_ _ -> True}+ withMock mockConf' "printDoesNotExist" print ()+ `shouldThrow` errorCall "lookupMockTyped: cannot find mock printDoesNotExist :: () -> IO (). There are no mocks under this name."++ it "fails when mcShouldFailOnNotFound and there are other mocks with the same name" $ do+ let mockConf' = mockConf {mcShouldFailOnNotFound = \_ _ -> True}+ (lookupMockTyped @(Int -> IO ()) mockConf' "print" `seq` pure ())+ `shouldThrow` errorCall "lookupMockTyped: cannot find mock print :: Int -> IO (). There are mocks with other types under the same name:\nMock (print :: [Char] -> IO ())\n"++ it "returns Nothing when there are no mocks with the given name" $ do+ lookupMockTyped @(Int -> IO ()) mockConf "noSuchMock"+ `shouldSatisfy` isNothing++ it "returns Nothing when there are other mocks with the same name" $ do+ lookupMockTyped @(Int -> IO ()) mockConf "print"+ `shouldSatisfy` isNothing++ describe "Display" $ do+ it "shows Mock correctly" $ do+ mock <- makeMock "print" (const $ pure () :: Int -> IO ())+ show mock `shouldBe` "Mock (print :: Int -> IO ())"
+ typeable-mock.cabal view
@@ -0,0 +1,74 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name: typeable-mock+version: 0.1.0.0+description: Please see the README on GitHub at <https://github.com/lykahb/typeable-mock#readme>+homepage: https://github.com/lykahb/typeable-mock#readme+bug-reports: https://github.com/lykahb/typeable-mock/issues+author: Boris Lykah+maintainer: lykahb@gmail.com+copyright: 2021 Boris Lykah+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ ChangeLog.md++source-repository head+ type: git+ location: https://github.com/lykahb/typeable-mock++library+ exposed-modules:+ Test.TypeableMock+ other-modules:+ Paths_typeable_mock+ hs-source-dirs:+ src+ default-extensions:+ FlexibleContexts+ GADTs+ LambdaCase+ RankNTypes+ RecordWildCards+ ScopedTypeVariables+ TypeApplications+ TypeOperators+ ghc-options: -Wall+ build-depends:+ base >=4.7 && <5+ , call-stack >=0.2.0+ , containers+ , variadic-function >=0.1.0.0 && <0.2+ default-language: Haskell2010++test-suite typeable-mock-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_typeable_mock+ hs-source-dirs:+ test+ default-extensions:+ FlexibleContexts+ GADTs+ LambdaCase+ RankNTypes+ RecordWildCards+ ScopedTypeVariables+ TypeApplications+ TypeOperators+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , call-stack >=0.2.0+ , containers+ , hspec+ , typeable-mock+ , variadic-function >=0.1.0.0 && <0.2+ default-language: Haskell2010