test-fixture 0.5.0.0 → 0.5.0.1
raw patch · 6 files changed
+54/−14 lines, 6 filesdep +data-default-classdep −data-defaultdep −th-to-expPVP ok
version bump matches the API change (PVP)
Dependencies added: data-default-class
Dependencies removed: data-default, th-to-exp
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−0
- src/Control/Monad/TestFixture/TH.hs +1/−1
- src/Control/Monad/TestFixture/TH/Internal.hs +8/−6
- test-fixture.cabal +3/−5
- test/Test/Control/Monad/TestFixture/DefaultSignaturesSpec.hs +37/−0
- test/Test/Control/Monad/TestFixture/THSpec.hs +1/−2
CHANGELOG.md view
@@ -1,3 +1,7 @@+# 0.5.0.1 (June 2, 2017)++ - Fixed an issue where using `mkFixture` with a typeclass that used the `DefaultSignatures` extension caused an internal error ([#30](https://github.com/cjdev/test-fixture/issues/30)).+ # 0.5.0.0 (November 28, 2016) - **Breaking**: `mkFixture` now supports constraints in the same form as a Haskell `deriving` clause, which permits “partially-applied” constraints. A new `ts` quasiquoter is provided for the purpose of writing a comma-separated list of Haskell types; see the documentation for more details ([#25](https://github.com/cjdev/test-fixture/issues/25)).
src/Control/Monad/TestFixture/TH.hs view
@@ -92,4 +92,4 @@ import Control.Monad.TestFixture.TH.Internal (mkFixture) import Control.Monad.TestFixture.TH.Internal.TypesQuasi (ts)-import Data.Default (def)+import Data.Default.Class (def)
src/Control/Monad/TestFixture/TH/Internal.hs view
@@ -1,6 +1,7 @@ {-# OPTIONS_HADDOCK hide, not-home #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} @@ -15,7 +16,7 @@ import Control.Monad (join, replicateM, when, zipWithM) import Control.Monad.TestFixture (TestFixture, TestFixtureT, unimplemented) import Data.Char (isPunctuation, isSymbol)-import Data.Default (Default(..))+import Data.Default.Class (Default(..)) import Data.List (foldl', nub, partition) import GHC.Exts (Constraint) import Language.Haskell.TH@@ -130,9 +131,7 @@ let instanceHead = AppT classType fixtureT classInfo <- reify (unappliedTypeName classType)- methods <- case classInfo of- ClassI (ClassD _ _ _ _ methods) _ -> return methods- _ -> fail $ "mkInstance: expected a class type, given " ++ show classType+ methods <- classMethods classInfo funDecls <- traverse mkDictInstanceFunc methods return $ mkInstanceD [AppT (ConT ''Monad) mVar] instanceHead funDecls@@ -175,8 +174,11 @@ Given some 'Info' about a class, get its methods as 'SigD' declarations. -} classMethods :: MonadFail m => Info -> m [Dec]-classMethods (ClassI (ClassD _ _ _ _ methods) _) = return methods-classMethods other = fail $ "classMethods: expected a class name, given " ++ show other+classMethods (ClassI (ClassD _ _ _ _ methods) _) = return $ removeDefaultSigs methods+ where removeDefaultSigs = filter $ \case+ DefaultSigD{} -> False+ _ -> True+classMethods other = fail $ "classMethods: expected a class type, given " ++ show other {-| Helper for applying `methodToField` over multiple methods using the same name
test-fixture.cabal view
@@ -1,7 +1,7 @@ name: test-fixture version:- 0.5.0.0+ 0.5.0.1 synopsis: Test monadic side-effects description:@@ -40,7 +40,7 @@ Control.Monad.TestFixture.TH.Internal.TypesQuasi build-depends: base >= 4.7 && < 5- , data-default+ , data-default-class , haskell-src-exts , haskell-src-meta , mtl@@ -61,6 +61,7 @@ ghc-options: -Wall other-modules: Test.Control.Monad.TestFixtureSpec+ Test.Control.Monad.TestFixture.DefaultSignaturesSpec Test.Control.Monad.TestFixture.THSpec build-depends: base >= 4.7 && < 5@@ -70,6 +71,3 @@ , mtl , template-haskell >= 2.10 && < 2.12 , transformers- if impl(ghc >= 8.0.0.0)- build-depends:- th-to-exp
+ test/Test/Control/Monad/TestFixture/DefaultSignaturesSpec.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE CPP #-}++#if MIN_VERSION_GLASGOW_HASKELL(8,0,0,0)+{-# OPTIONS_GHC -fno-warn-unused-top-binds -fno-warn-redundant-constraints #-}+#else+{-# OPTIONS_GHC -fno-warn-unused-binds #-}+#endif++{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++module Test.Control.Monad.TestFixture.DefaultSignaturesSpec (spec) where++import Test.Hspec++import Control.Monad.Trans.Class (MonadTrans(..))+import Control.Monad.TestFixture.TH++class Monad m => MonadFoo m where+ foo :: m ()++ default foo :: (MonadTrans t, MonadFoo m', m ~ t m') => m ()+ foo = lift foo++mkFixture "Fixture" [ts| MonadFoo |]++spec :: Spec+spec = describe "mkFixture" $+ it "can derive classes that use DefaultSignatures" $ example $+ return ()
test/Test/Control/Monad/TestFixture/THSpec.hs view
@@ -18,7 +18,6 @@ import Control.Monad.Except (runExcept, throwError) import Control.Monad.Fail (MonadFail(..)) import Language.Haskell.TH.Syntax-import Language.Haskell.TH.ToExp (toExp) import Control.Monad.TestFixture import Control.Monad.TestFixture.TH@@ -35,7 +34,7 @@ let fixture = def { _qReport = \b s -> when b $ throwError s , _qNewName = \s -> return $ Name (OccName s) (NameU 0)- , _qReify = \_ -> return $(toExp <$> reify ''MultiParam)+ , _qReify = \_ -> return $(lift =<< reify ''MultiParam) } let result = runExcept $ unTestFixtureT (runQ $ mkFixture "Fixture" [ts| MultiParam |]) fixture result `shouldBe` (Left $