method-0.1.0.0: rebindable methods for improving testability
LicenseBSD-3
Maintainerautotaker@gmail.com
Stabilityexperimental
Safe HaskellNone
LanguageHaskell2010

Test.Method

Description

 
Synopsis

Documentation

This module provides DSLs for mocking methods and for validating method calls

Mock

Usage

fizzbuzz :: Int -> IO String
fizzbuzz = mockup $ do
  when (args (x -> mod x 15 == 0)) `thenReturn` "fizzbuzz"
  when (args (x -> mod x 3 == 0)) `thenReturn` "fizz"
  when (args (x -> mod x 5 == 0)) `thenReturn` "buzz"
  when (args (>=0)) `thenMethod` (x -> pure $ show x)
  throwNoStubShow $ when anything
>>> fizzbuzz 0
"fizzbuzz"
>>> fizzbuzz 1
"1"
>>> fizzbuzz 3
"fizz"
>>> fizzbuzz 5
"buzz"
>>> fizzbuzz (-1)
*** Exception: NoStubException "-1"

References

mockup :: (Method method, MonadThrow (Base method)) => Mock method -> method Source #

generate a method from Mock DSL. Mock DSL consists of rules. On a call of generated method, the first rule matched the arguments is applied.

thenReturn :: (Method method, Applicative (Base method)) => Matcher (Args method) -> Ret method -> Mock method Source #

matcher `thenReturn` value means the method return value if the arguments matches matcher.

thenAction :: Method method => Matcher (Args method) -> Base method (Ret method) -> Mock method Source #

matcher `thenAction` action means the method executes action if the arguments matches matcher.

thenMethod :: Method method => Matcher (Args method) -> method -> Mock method Source #

matcher `thenMethod` action means the method call method with the arguments if the arguments matches matcher.

throwNoStubShow :: (Method method, Show (AsTuple (Args method)), MonadThrow (Base method), TupleLike (Args method)) => Matcher (Args method) -> Mock method Source #

throwNoStubShow matcher means the method throws a NoStubException if the arguments matches matcher. The argument tuple is converted to String by using show function.

throwNoStub :: (Method method, MonadThrow (Base method)) => (Args method -> String) -> (Args method -> Bool) -> Mock method Source #

throwNoStubShow fshow matcher means the method throws a NoStubException if the arguments matches matcher. The argument tuple is converted to String by using fshow function.

Monitor

Usage

type ExampleMethod = Int -> String -> IO String
example :: ExampleMethod
example n s | n < 0 = throwString "negative n"
            | otherwise = pure $ concat $ replicate n s

doit :: ExampleMethod -> IO ()
doit example = (do
  example 2 "foo" >>= putStrLn
  example 3 "foo" >>= putStrLn
  example (-1) "bar" >>= putStrLn
  example 3 "bar" >>= putStrLn) catchAny (const $ pure ())
spec :: Spec
spec = describe "doit" $ do
  before (withMonitor_ $ \monitor -> doit (watch monitor example))

  it "calls example _ "foo" twice" $ \logs -> do
    logs `shouldSatisfy` ((==2) `times` call (args (anything, (=="foo"))))

  it "calls example (-1) "bar" once" $ \logs -> do
    logs `shouldSatisfy` ((==1) `times` call (args ((==(-1)), (=="bar"))))

  it "does not call example 3 "bar" " $ \logs -> do
    logs `shouldSatisfy` ((==0) `times` call (args ((==3), (=="bar"))))

References

data Monitor args ret Source #

Monitor arg ret is an event monitor of methods, which logs method calls.

data Event args ret Source #

Event args ret is a function call event

Instances

Instances details
(Eq args, Eq ret) => Eq (Event args ret) Source # 
Instance details

Defined in Test.Method.Monitor.Internal

Methods

(==) :: Event args ret -> Event args ret -> Bool #

(/=) :: Event args ret -> Event args ret -> Bool #

(Ord args, Ord ret) => Ord (Event args ret) Source # 
Instance details

Defined in Test.Method.Monitor.Internal

Methods

compare :: Event args ret -> Event args ret -> Ordering #

(<) :: Event args ret -> Event args ret -> Bool #

(<=) :: Event args ret -> Event args ret -> Bool #

(>) :: Event args ret -> Event args ret -> Bool #

(>=) :: Event args ret -> Event args ret -> Bool #

max :: Event args ret -> Event args ret -> Event args ret #

min :: Event args ret -> Event args ret -> Event args ret #

(Show args, Show ret) => Show (Event args ret) Source # 
Instance details

Defined in Test.Method.Monitor.Internal

Methods

showsPrec :: Int -> Event args ret -> ShowS #

show :: Event args ret -> String #

showList :: [Event args ret] -> ShowS #

watchBy :: (Method method, MonadUnliftIO (Base method)) => (Args method -> args) -> (Ret method -> ret) -> Monitor args ret -> method -> method Source #

watchBy fArgs fRet monitor method decorates method so that monitor logs the method calls. This function is suited for monitoring multiple methods.

fArgs and fRet is converter for arguments/return values of given method.

foo :: Int -> IO String
foo = ...
bar :: Int -> String -> IO ()
bar = ...

data MonitorArgs = FooArgs Int | BarArgs (Int,String) deriving(Eq,Show)
data MonitorRet = FooRet String | BarRet () deriving(Eq, Show)

foo' :: Monitor MonitorArgs MonitorRet -> Int -> IO String
foo' monitor = watch monitor (FooArgs . toTuple) FooRet foo
bar' :: Monitor MonitorArgs MonitorRet -> Int -> String -> IO ()
bar' monitor = watch monitor (BarArgs . toTuple) BarRet bar

watch :: (Method method, MonadUnliftIO (Base method)) => Monitor (Args method) (Ret method) -> method -> method Source #

Simplified version of watchBy. It is suitable to monitor single method.

withMonitor :: MonadIO m => (Monitor args ret -> m a) -> m (a, [Event args ret]) Source #

withMonitor f calls f with Monitor, and then returns monitored event logs during the function call in addition to the return value of the function call

withMonitor_ :: MonadIO m => (Monitor args ret -> m ()) -> m [Event args ret] Source #

withMonitor_ f calls f with Monitor, and returns event logs during the call.

Matcher for events

call :: Matcher args -> Matcher (Event args ret) Source #

call matcher matches method call whose arguments matches matcher

times :: Matcher Int -> Matcher (Event args ret) -> Matcher [Event args ret] Source #

times countMatcher eventMatcher counts events that matches eventMatcher, and then the count matches countMatcher

Procedual api for monitor

newMonitor :: IO (Monitor args ret) Source #

Generate new instance of Monitor

listenEventLog :: MonadIO m => Monitor args ret -> m [Event args ret] Source #

Get current event logs from monitor

Matcher

References

Basics

type Matcher a = a -> Bool Source #

anything :: Matcher a Source #

Matcher that matches anything

when :: Matcher a -> Matcher a Source #

synonym of id function. Use this function for improving readability

Matcher for method arguments

class TupleLike a where Source #

Associated Types

type AsTuple a Source #

Methods

fromTuple :: AsTuple a -> a Source #

toTuple :: a -> AsTuple a Source #

Instances

Instances details
TupleLike Nil Source # 
Instance details

Defined in Control.Method.Internal

Associated Types

type AsTuple Nil Source #

TupleLike (a :* (b :* (c :* (d :* (e :* (f :* (g :* Nil))))))) Source # 
Instance details

Defined in Control.Method.Internal

Associated Types

type AsTuple (a :* (b :* (c :* (d :* (e :* (f :* (g :* Nil))))))) Source #

Methods

fromTuple :: AsTuple (a :* (b :* (c :* (d :* (e :* (f :* (g :* Nil))))))) -> a :* (b :* (c :* (d :* (e :* (f :* (g :* Nil)))))) Source #

toTuple :: (a :* (b :* (c :* (d :* (e :* (f :* (g :* Nil))))))) -> AsTuple (a :* (b :* (c :* (d :* (e :* (f :* (g :* Nil))))))) Source #

TupleLike (a :* (b :* (c :* (d :* (e :* (f :* Nil)))))) Source # 
Instance details

Defined in Control.Method.Internal

Associated Types

type AsTuple (a :* (b :* (c :* (d :* (e :* (f :* Nil)))))) Source #

Methods

fromTuple :: AsTuple (a :* (b :* (c :* (d :* (e :* (f :* Nil)))))) -> a :* (b :* (c :* (d :* (e :* (f :* Nil))))) Source #

toTuple :: (a :* (b :* (c :* (d :* (e :* (f :* Nil)))))) -> AsTuple (a :* (b :* (c :* (d :* (e :* (f :* Nil)))))) Source #

TupleLike (a :* (b :* (c :* (d :* (e :* Nil))))) Source # 
Instance details

Defined in Control.Method.Internal

Associated Types

type AsTuple (a :* (b :* (c :* (d :* (e :* Nil))))) Source #

Methods

fromTuple :: AsTuple (a :* (b :* (c :* (d :* (e :* Nil))))) -> a :* (b :* (c :* (d :* (e :* Nil)))) Source #

toTuple :: (a :* (b :* (c :* (d :* (e :* Nil))))) -> AsTuple (a :* (b :* (c :* (d :* (e :* Nil))))) Source #

TupleLike (a :* (b :* (c :* (d :* Nil)))) Source # 
Instance details

Defined in Control.Method.Internal

Associated Types

type AsTuple (a :* (b :* (c :* (d :* Nil)))) Source #

Methods

fromTuple :: AsTuple (a :* (b :* (c :* (d :* Nil)))) -> a :* (b :* (c :* (d :* Nil))) Source #

toTuple :: (a :* (b :* (c :* (d :* Nil)))) -> AsTuple (a :* (b :* (c :* (d :* Nil)))) Source #

TupleLike (a :* (b :* (c :* Nil))) Source # 
Instance details

Defined in Control.Method.Internal

Associated Types

type AsTuple (a :* (b :* (c :* Nil))) Source #

Methods

fromTuple :: AsTuple (a :* (b :* (c :* Nil))) -> a :* (b :* (c :* Nil)) Source #

toTuple :: (a :* (b :* (c :* Nil))) -> AsTuple (a :* (b :* (c :* Nil))) Source #

TupleLike (a :* (b :* Nil)) Source # 
Instance details

Defined in Control.Method.Internal

Associated Types

type AsTuple (a :* (b :* Nil)) Source #

Methods

fromTuple :: AsTuple (a :* (b :* Nil)) -> a :* (b :* Nil) Source #

toTuple :: (a :* (b :* Nil)) -> AsTuple (a :* (b :* Nil)) Source #

TupleLike (a :* Nil) Source # 
Instance details

Defined in Control.Method.Internal

Associated Types

type AsTuple (a :* Nil) Source #

Methods

fromTuple :: AsTuple (a :* Nil) -> a :* Nil Source #

toTuple :: (a :* Nil) -> AsTuple (a :* Nil) Source #

class TupleLike a => ArgsMatcher a where Source #

Matcher for Args

>>> args ((==2), (>3)) (2 :* 4 :* Nil)
True
>>> args even (1 :* Nil)
False
>>> args () Nil
True

Methods

args :: EachMatcher a -> Matcher a Source #

Convert a tuple of matchers to a matcher of tuples

Instances

Instances details
ArgsMatcher Nil Source # 
Instance details

Defined in Test.Method.Matcher

Associated Types

type EachMatcher Nil Source #

ArgsMatcher (a :* (b :* (c :* (d :* (e :* (f :* (g :* Nil))))))) Source # 
Instance details

Defined in Test.Method.Matcher

Associated Types

type EachMatcher (a :* (b :* (c :* (d :* (e :* (f :* (g :* Nil))))))) Source #

Methods

args :: EachMatcher (a :* (b :* (c :* (d :* (e :* (f :* (g :* Nil))))))) -> Matcher (a :* (b :* (c :* (d :* (e :* (f :* (g :* Nil))))))) Source #

ArgsMatcher (a :* (b :* (c :* (d :* (e :* (f :* Nil)))))) Source # 
Instance details

Defined in Test.Method.Matcher

Associated Types

type EachMatcher (a :* (b :* (c :* (d :* (e :* (f :* Nil)))))) Source #

Methods

args :: EachMatcher (a :* (b :* (c :* (d :* (e :* (f :* Nil)))))) -> Matcher (a :* (b :* (c :* (d :* (e :* (f :* Nil)))))) Source #

ArgsMatcher (a :* (b :* (c :* (d :* (e :* Nil))))) Source # 
Instance details

Defined in Test.Method.Matcher

Associated Types

type EachMatcher (a :* (b :* (c :* (d :* (e :* Nil))))) Source #

Methods

args :: EachMatcher (a :* (b :* (c :* (d :* (e :* Nil))))) -> Matcher (a :* (b :* (c :* (d :* (e :* Nil))))) Source #

ArgsMatcher (a :* (b :* (c :* (d :* Nil)))) Source # 
Instance details

Defined in Test.Method.Matcher

Associated Types

type EachMatcher (a :* (b :* (c :* (d :* Nil)))) Source #

Methods

args :: EachMatcher (a :* (b :* (c :* (d :* Nil)))) -> Matcher (a :* (b :* (c :* (d :* Nil)))) Source #

ArgsMatcher (a :* (b :* (c :* Nil))) Source # 
Instance details

Defined in Test.Method.Matcher

Associated Types

type EachMatcher (a :* (b :* (c :* Nil))) Source #

Methods

args :: EachMatcher (a :* (b :* (c :* Nil))) -> Matcher (a :* (b :* (c :* Nil))) Source #

ArgsMatcher (a :* (b :* Nil)) Source # 
Instance details

Defined in Test.Method.Matcher

Associated Types

type EachMatcher (a :* (b :* Nil)) Source #

Methods

args :: EachMatcher (a :* (b :* Nil)) -> Matcher (a :* (b :* Nil)) Source #

ArgsMatcher (a :* Nil) Source # 
Instance details

Defined in Test.Method.Matcher

Associated Types

type EachMatcher (a :* Nil) Source #

Methods

args :: EachMatcher (a :* Nil) -> Matcher (a :* Nil) Source #

args' :: TupleLike a => Matcher (AsTuple a) -> Matcher a Source #

Convert a tuple matcher to a tuple-like matcher.

>>> args' (\(a, b) -> a * b == 10) (2 :* 5 :* Nil)
True
>>> args' (\(a, b) -> a * b == 10) (2 :* 4 :* Nil)
False