packages feed

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 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 $