monad-mock 0.1.1.1 → 0.1.1.2
raw patch · 6 files changed
+88/−26 lines, 6 filesdep +transformersdep ~basedep ~template-haskell
Dependencies added: transformers
Dependency ranges changed: base, template-haskell
Files
- CHANGELOG.md +4/−0
- library/Control/Monad/Mock.hs +11/−3
- library/Control/Monad/Mock/TH.hs +54/−13
- library/Control/Monad/Mock/TH/Internal/TypesQuasi.hs +5/−3
- monad-mock.cabal +7/−4
- package.yaml +7/−3
CHANGELOG.md view
@@ -1,3 +1,7 @@+## 0.1.1.2 (August 1st, 2017)++- Added support for GHC 7.10.+ ## 0.1.1.1 (June 28th, 2017) - Added support for GHC 8.2.
library/Control/Monad/Mock.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE CPP #-} {-| This module provides a monad transformer that helps create “mocks” of@@ -89,6 +90,13 @@ import Data.Functor.Identity (Identity, runIdentity) import Data.Type.Equality ((:~:)(..)) +error' :: String -> a+#if MIN_VERSION_base(4,9,0)+error' = errorWithoutStackTrace+#else+error' = error+#endif+ -- | A class of types that represent typeclass method calls. The type must be of -- kind @* -> *@, and its type parameter should represent type of the method’s -- return type.@@ -149,7 +157,7 @@ runMockT :: forall f m a. (Action f, Monad m) => [WithResult f] -> MockT f m a -> m a runMockT actions (MockT x) = runStateT x actions >>= \case (r, []) -> return r- (_, remainingActions) -> errorWithoutStackTrace+ (_, remainingActions) -> error' $ "runMockT: expected the following unexecuted actions to be run:\n" ++ unlines (map (\(action :-> _) -> " " ++ showAction action) remainingActions) @@ -159,12 +167,12 @@ -- | Logs a method call within a mock. mockAction :: (Action f, Monad m) => String -> f r -> MockT f m r mockAction fnName action = MockT $ get >>= \case- [] -> errorWithoutStackTrace+ [] -> error' $ "runMockT: expected end of program, called " ++ fnName ++ "\n" ++ " given action: " ++ showAction action ++ "\n" (action' :-> r) : actions | Just Refl <- action `eqAction` action' -> put actions >> return r- | otherwise -> errorWithoutStackTrace+ | otherwise -> error' $ "runMockT: argument mismatch in " ++ fnName ++ "\n" ++ " given: " ++ showAction action ++ "\n" ++ " expected: " ++ showAction action' ++ "\n"
library/Control/Monad/Mock/TH.hs view
@@ -1,5 +1,10 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE PatternSynonyms #-}+#if MIN_VERSION_GLASGOW_HASKELL(8,0,1,0) {-# LANGUAGE TemplateHaskellQuotes #-}+#else+{-# LANGUAGE TemplateHaskell #-}+#endif {-| This module provides Template Haskell functions for automatically generating@@ -104,12 +109,13 @@ actionParamName <- newName "r" let actionName = mkName actionNameStr actionTypeCon = ConT actionName+ actionTypeParam = VarT actionParamName classInfos <- traverse reify (map unappliedTypeName classTs) methods <- traverse classMethods classInfos- actionCons <- concat <$> zipWithM (methodsToConstructors actionTypeCon) classTs methods+ actionCons <- concat <$> zipWithM (methodsToConstructors actionTypeCon actionTypeParam) classTs methods - let actionDec = DataD [] actionName [PlainTV actionParamName] Nothing actionCons []+ let actionDec = DataD' [] actionName [PlainTV actionParamName] actionCons mkStandaloneDec derivT = standaloneDeriveD' [] (derivT `AppT` (actionTypeCon `AppT` VarT actionParamName)) standaloneDecs = [mkStandaloneDec (ConT ''Eq), mkStandaloneDec (ConT ''Show)] actionInstanceDec <- deriveAction' actionTypeCon actionCons@@ -177,19 +183,18 @@ -- To accomplish this, 'methodToConstructors' accepts two 'Type's, -- where the first is the action type constructor, and the second is -- the constraint which must be removed.- methodsToConstructors :: Type -> Type -> [Dec] -> Q [Con]- methodsToConstructors actionT classT = traverse (methodToConstructor actionT classT)+ methodsToConstructors :: Type -> Type -> Type -> [Dec] -> Q [Con]+ methodsToConstructors actionConT actionParamT classT = traverse (methodToConstructor actionConT actionParamT classT) -- | Converts a single class method into a constructor for an action type.- methodToConstructor :: Type -> Type -> Dec -> Q Con- methodToConstructor actionT classT (SigD name typ) = do+ methodToConstructor :: Type -> Type -> Type -> Dec -> Q Con+ methodToConstructor actionConT actionParamT classT (SigD name typ) = do let constructorName = methodNameToConstructorName name- newT <- replaceClassConstraint classT actionT typ+ newT <- replaceClassConstraint classT actionConT typ let (tyVars, ctx, argTs, resultT) = splitFnType newT- noStrictness = Bang NoSourceUnpackedness NoSourceStrictness- gadtCon = GadtC [constructorName] (map (noStrictness,) argTs) resultT+ gadtCon = gadtC' constructorName [actionParamT] argTs resultT return $ ForallC tyVars ctx gadtCon- methodToConstructor _ _ _ = fail "methodToConstructor: internal error; report a bug with the monad-mock package"+ methodToConstructor _ _ _ _ = fail "methodToConstructor: internal error; report a bug with the monad-mock package" -- | Converts an ordinary term-level identifier, which starts with a -- lower-case letter, to a data constructor, which starts with an upper-@@ -203,7 +208,7 @@ mVar <- newName "m" methodImpls <- traverse mkInstanceMethod methodSigs let instanceHead = classT `AppT` (ConT ''MockT `AppT` actionT `AppT` VarT mVar)- return $ InstanceD Nothing [ConT ''Monad `AppT` VarT mVar] instanceHead methodImpls+ return $ instanceD' [ConT ''Monad `AppT` VarT mVar] instanceHead methodImpls mkInstanceMethod :: Dec -> Q Dec mkInstanceMethod (SigD name typ) = do@@ -276,7 +281,7 @@ -- | Given an 'Info', asserts that it represents a type constructor and extracts -- its type and constructors. extractActionInfo :: Info -> Q (Type, [Con])- extractActionInfo (TyConI (DataD _ actionName _ _ cons _))+ extractActionInfo (TyConI (DataD' _ actionName _ cons)) = return (ConT actionName, cons) extractActionInfo _ = fail "deriveAction: expected type constructor"@@ -289,7 +294,7 @@ deriveAction' tyCon dataCons = do eqActionDec <- deriveEqAction dataCons let instanceHead = ConT ''Action `AppT` tyCon- return $ InstanceD Nothing [] instanceHead [eqActionDec]+ return $ instanceD' [] instanceHead [eqActionDec] where -- | Given a list of constructors for a particular type, generates a definition -- of 'eqAction'.@@ -326,10 +331,12 @@ conName (RecC name _) = name conName (InfixC _ name _) = name conName (ForallC _ _ con) = conName con+#if MIN_VERSION_template_haskell(2,11,0) conName (GadtC [name] _ _) = name conName (GadtC names _ _) = error $ "conName: internal error; non-singleton GADT constructor names: " ++ show names conName (RecGadtC [name] _ _) = name conName (RecGadtC names _ _) = error $ "conName: internal error; non-singleton GADT record constructor names: " ++ show names+#endif -- | Extracts the number of arguments a 'Con' accepts. conNumArgs :: Con -> Int@@ -337,8 +344,10 @@ conNumArgs (RecC _ vbts) = length vbts conNumArgs (InfixC _ _ _) = 2 conNumArgs (ForallC _ _ con) = conNumArgs con+#if MIN_VERSION_template_haskell(2,11,0) conNumArgs (GadtC _ bts _) = length bts conNumArgs (RecGadtC _ vbts _) = length vbts+#endif -- | Given a potentially applied type, like @T a b@, returns the base, unapplied -- type name, like @T@.@@ -413,9 +422,41 @@ | without writing CPP everywhere and ending up with a small mess. | |------------------------------------------------------------------------------} +pattern DataD' :: Cxt -> Name -> [TyVarBndr] -> [Con] -> Dec+#if MIN_VERSION_template_haskell(2,11,0)+pattern DataD' a b c d = DataD a b c Nothing d []+#else+pattern DataD' a b c d = DataD a b c d []+#endif++instanceD' :: Cxt -> Type -> [Dec] -> Dec+#if MIN_VERSION_template_haskell(2,11,0)+instanceD' = InstanceD Nothing+#else+instanceD' = InstanceD+#endif+ standaloneDeriveD' :: Cxt -> Type -> Dec #if MIN_VERSION_template_haskell(2,12,0) standaloneDeriveD' = StandaloneDerivD Nothing #else standaloneDeriveD' = StandaloneDerivD+#endif++#if MIN_VERSION_template_haskell(2,11,0)+noStrictness :: Bang+noStrictness = Bang NoSourceUnpackedness NoSourceStrictness+#else+noStrictness :: Strict+noStrictness = NotStrict+#endif++gadtC' :: Name -> [Type] -> [Type] -> Type -> Con+#if MIN_VERSION_template_haskell(2,11,0)+gadtC' nm _ args result = GadtC [nm] (map (noStrictness,) args) result+#else+gadtC' nm vars args result = ForallC [] equalities (NormalC nm (map (noStrictness,) args))+ where+ equalities = reverse $ zipWith equalsT (reverse vars) (reverse $ typeArgs result)+ equalsT x y = EqualityT `AppT` x `AppT` y #endif
library/Control/Monad/Mock/TH/Internal/TypesQuasi.hs view
@@ -86,10 +86,7 @@ resolveTypeNames (AppT a b) = AppT <$> resolveTypeNames a <*> resolveTypeNames b resolveTypeNames (ConT nm) = ConT <$> resolveTypeName nm resolveTypeNames (ForallT tyVars ctx t) = ForallT tyVars <$> mapM resolveTypeNames ctx <*> resolveTypeNames t-resolveTypeNames (InfixT a n b) = InfixT <$> resolveTypeNames a <*> resolveTypeName n <*> resolveTypeNames b-resolveTypeNames (ParensT t) = ParensT <$> resolveTypeNames t resolveTypeNames (SigT t k) = SigT <$> resolveTypeNames t <*> resolveTypeNames k-resolveTypeNames (UInfixT a n b) = UInfixT <$> resolveTypeNames a <*> resolveTypeName n <*> resolveTypeNames b resolveTypeNames t@ArrowT{} = return t resolveTypeNames t@ConstraintT = return t resolveTypeNames t@EqualityT = return t@@ -103,7 +100,12 @@ resolveTypeNames t@TupleT{} = return t resolveTypeNames t@UnboxedTupleT{} = return t resolveTypeNames t@VarT{} = return t+#if MIN_VERSION_template_haskell(2,11,0)+resolveTypeNames (InfixT a n b) = InfixT <$> resolveTypeNames a <*> resolveTypeName n <*> resolveTypeNames b+resolveTypeNames (UInfixT a n b) = UInfixT <$> resolveTypeNames a <*> resolveTypeName n <*> resolveTypeNames b+resolveTypeNames (ParensT t) = ParensT <$> resolveTypeNames t resolveTypeNames t@WildCardT = return t+#endif #if MIN_VERSION_template_haskell(2,12,0) resolveTypeNames t@UnboxedSumT{} = return t #endif
monad-mock.cabal view
@@ -1,9 +1,9 @@--- This file has been generated from package.yaml by hpack version 0.17.0.+-- This file has been generated from package.yaml by hpack version 0.17.1. -- -- see: https://github.com/sol/hpack name: monad-mock-version: 0.1.1.1+version: 0.1.1.2 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@@ -39,7 +39,7 @@ default-extensions: DefaultSignatures FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses ScopedTypeVariables StandaloneDeriving TupleSections TypeFamilies TypeOperators ghc-options: -Wall build-depends:- base >= 4.9.0.0 && < 5+ base >= 4.8.0.0 && < 5 , constraints >= 0.3.1 , exceptions >= 0.6 , haskell-src-exts@@ -47,8 +47,11 @@ , th-orphans , monad-control >= 1.0.0.0 && < 2 , mtl- , template-haskell >= 2.11.0.0 && < 2.13+ , template-haskell >= 2.10.0.0 && < 2.13 , transformers-base+ if impl(ghc < 8)+ build-depends:+ transformers exposed-modules: Control.Monad.Mock Control.Monad.Mock.TH
package.yaml view
@@ -1,5 +1,5 @@ name: monad-mock-version: 0.1.1.1+version: 0.1.1.2 category: Testing synopsis: A monad transformer for mocking mtl-style typeclasses description: |@@ -40,7 +40,7 @@ library: dependencies:- - base >= 4.9.0.0 && < 5+ - base >= 4.8.0.0 && < 5 - constraints >= 0.3.1 - exceptions >= 0.6 - haskell-src-exts@@ -48,8 +48,12 @@ - th-orphans - monad-control >= 1.0.0.0 && < 2 - mtl- - template-haskell >= 2.11.0.0 && < 2.13+ - template-haskell >= 2.10.0.0 && < 2.13 - transformers-base+ when:+ - condition: impl(ghc < 8)+ dependencies:+ - transformers source-dirs: library tests: