monad-mock 0.1.1.2 → 0.2.0.0
raw patch · 5 files changed
+56/−20 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−0
- library/Control/Monad/Mock/TH.hs +28/−4
- monad-mock.cabal +3/−2
- package.yaml +3/−2
- test-suite/Control/Monad/MockSpec.hs +18/−12
CHANGELOG.md view
@@ -1,3 +1,7 @@+## 0.2.0.0 (September 14th, 2017)++- `Control.Monad.Mock.TH` is smarter about deriving instances for classes with superclass contexts: the derived context is based on superclasses rather than being hardcoded to `Monad m`.+ ## 0.1.1.2 (August 1st, 2017) - Added support for GHC 7.10.
library/Control/Monad/Mock/TH.hs view
@@ -146,13 +146,13 @@ when (length classArgs == length classVars) $ fail $ "makeAction: cannot derive instance for fully saturated constraint\n" ++ " in: " ++ show (ppr classType) ++ "\n"- ++ " expected: * -> " ++ constraintStr ++ "\n"+ ++ " expected: (* -> *) -> " ++ constraintStr ++ "\n" ++ " given: " ++ constraintStr when (length classArgs < length classVars - 1) $ fail $ "makeAction: cannot derive instance for multi-parameter typeclass\n" ++ " in: " ++ show (ppr classType) ++ "\n"- ++ " expected: * -> " ++ constraintStr ++ "\n"+ ++ " expected: (* -> *) -> " ++ constraintStr ++ "\n" ++ " given: " ++ show (ppr (mkClassKind $ drop (length classArgs) classVars)) -- | Converts a class’s methods to constructors for an action type. There@@ -206,9 +206,33 @@ mkInstance :: Type -> Type -> [Dec] -> Q Dec mkInstance actionT classT methodSigs = do mVar <- newName "m"- methodImpls <- traverse mkInstanceMethod methodSigs++ -- In order to calculate the constraints on the instance, we need to look+ -- at the superclasses of the class we're deriving an instance for. For+ -- example, given some class:+ --+ -- class (AsSomething e, MonadError e m) => MonadFoo e m | m -> e+ --+ -- ...if we are asked to derive an instance for @MonadFoo Something@, then+ -- we need to generate an instance with a constraint like the following:+ --+ -- instance (AsSomething Something, MonadError Something m)+ -- => MonadFoo Something (MockT Action m)+ --+ -- To do that, we just need to look at the binders of the class, then+ -- use that to build a substitution that can be applied to the superclass+ -- constraints.+ (ClassI (ClassD classContext _ classBindVars _ _) _) <- reify $ unappliedTypeName classT+ let classBinds = map tyVarBndrName classBindVars+ instanceBinds = typeArgs classT ++ [VarT mVar]+ classBindsToInstanceBinds = zip classBinds instanceBinds+ contextSubFns = map (uncurry substituteTypeVar) classBindsToInstanceBinds+ instanceContext = foldr map classContext contextSubFns+ let instanceHead = classT `AppT` (ConT ''MockT `AppT` actionT `AppT` VarT mVar)- return $ instanceD' [ConT ''Monad `AppT` VarT mVar] instanceHead methodImpls+ methodImpls <- traverse mkInstanceMethod methodSigs++ return $ instanceD' instanceContext instanceHead methodImpls mkInstanceMethod :: Dec -> Q Dec mkInstanceMethod (SigD name typ) = do
monad-mock.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: monad-mock-version: 0.1.1.2+version: 0.2.0.0 synopsis: A monad transformer for mocking mtl-style typeclasses description: This package provides a monad transformer that helps create “mocks” of @mtl@-style typeclasses, intended for use in unit tests. A mock can be@@ -67,8 +67,9 @@ ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N build-depends: base- , monad-mock , hspec+ , monad-mock+ , mtl other-modules: Control.Monad.MockSpec default-language: Haskell2010
package.yaml view
@@ -1,5 +1,5 @@ name: monad-mock-version: 0.1.1.2+version: 0.2.0.0 category: Testing synopsis: A monad transformer for mocking mtl-style typeclasses description: |@@ -60,8 +60,9 @@ monad-stub-test-suite: dependencies: - base- - monad-mock - hspec+ - monad-mock+ - mtl ghc-options: - -rtsopts - -threaded
test-suite/Control/Monad/MockSpec.hs view
@@ -1,23 +1,25 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FunctionalDependencies #-} module Control.Monad.MockSpec (spec) where import Prelude hiding (readFile, writeFile) import Control.Exception (evaluate)+import Control.Monad.Except (MonadError, runExcept) import Data.Function ((&)) import Test.Hspec import Control.Monad.Mock import Control.Monad.Mock.TH -class Monad m => MonadFileSystem m where+class MonadError e m => MonadFileSystem e m | m -> e where readFile :: FilePath -> m String writeFile :: FilePath -> String -> m ()-makeAction "FileSystemAction" [ts| MonadFileSystem |]+makeAction "FileSystemAction" [ts| MonadFileSystem String |] -copyFileAndReturn :: MonadFileSystem m => FilePath -> FilePath -> m String+copyFileAndReturn :: MonadFileSystem e m => FilePath -> FilePath -> m String copyFileAndReturn a b = do x <- readFile a writeFile b x@@ -27,14 +29,16 @@ spec = describe "MockT" $ do it "runs computations with mocked method implementations" $ do let result = copyFileAndReturn "foo.txt" "bar.txt"- & runMock [ ReadFile "foo.txt" :-> "file contents"- , WriteFile "bar.txt" "file contents" :-> () ]- result `shouldBe` "file contents"+ & runMockT [ ReadFile "foo.txt" :-> "file contents"+ , WriteFile "bar.txt" "file contents" :-> () ]+ & runExcept+ result `shouldBe` Right "file contents" it "raises an exception if calls are not in the right order" $ do let result = copyFileAndReturn "foo.txt" "bar.txt"- & runMock [ WriteFile "bar.txt" "file contents" :-> ()- , ReadFile "foo.txt" :-> "file contents" ]+ & runMockT [ WriteFile "bar.txt" "file contents" :-> ()+ , ReadFile "foo.txt" :-> "file contents" ]+ & runExcept exnMessage = "runMockT: argument mismatch in readFile\n\ \ given: ReadFile \"foo.txt\"\n\@@ -43,9 +47,10 @@ it "raises an exception if calls are missing" $ do let result = copyFileAndReturn "foo.txt" "bar.txt"- & runMock [ ReadFile "foo.txt" :-> "file contents"- , WriteFile "bar.txt" "file contents" :-> ()- , ReadFile "qux.txt" :-> "file contents 2" ]+ & runMockT [ ReadFile "foo.txt" :-> "file contents"+ , WriteFile "bar.txt" "file contents" :-> ()+ , ReadFile "qux.txt" :-> "file contents 2" ]+ & runExcept exnMessage = "runMockT: expected the following unexecuted actions to be run:\n\ \ ReadFile \"qux.txt\"\n"@@ -53,7 +58,8 @@ it "raises an exception if there are too many calls" $ do let result = copyFileAndReturn "foo.txt" "bar.txt"- & runMock [ ReadFile "foo.txt" :-> "file contents" ]+ & runMockT [ ReadFile "foo.txt" :-> "file contents" ]+ & runExcept exnMessage = "runMockT: expected end of program, called writeFile\n\ \ given action: WriteFile \"bar.txt\" \"file contents\"\n"