polysemy-mocks 0.2.0.0 → 0.3.0.0

raw patch · 6 files changed

+43/−10 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−0
• README.md +1/−0
• polysemy-mocks.cabal +1/−1
• src/Test/Polysemy/Mock.hs +6/−5
• src/Test/Polysemy/Mock/TH.hs +27/−4
• test/Test/Polysemy/Mock/TeletypeTHSpec.hs +1/−0

@@ -1,5 +1,12 @@ # Changelog for polysemy-mocks +## 0.3.0.0++* Support template-haskell-2.17.0 (and so GHC 9.0)+* Add 'HasCallStack' constraint to 'evalMocks', {run,eval,exec}Mock and default+  implementations for the "returns" functions (which throws error, by default).+  'RankNTypes' is now needed to use the TH mocks.+ ## 0.2.0.0  * Support polysemy >= 1.7, drop support for older versions

@@ -13,6 +13,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-}

@@ -1,7 +1,7 @@ cabal-version: 1.12  name:           polysemy-mocks-version:        0.2.0.0+version:        0.3.0.0 description:    Please see the README on GitHub at <https://github.com/akshaymankar/polysemy-mocks#readme> homepage:       https://github.com/akshaymankar/polysemy-mocks#readme bug-reports:    https://github.com/akshaymankar/polysemy-mocks/issues

@@ -25,6 +25,7 @@ where  import Data.Kind+import GHC.Stack (HasCallStack) import Polysemy import Polysemy.State @@ -139,18 +140,18 @@   -- | Interpret all actions of 'MockImpl eff m' to get 'State (MockImpl eff   -- m)'. The 'State' effect could then be resolved using 'initialMockState'.   -- Use 'runMock', 'evalMock' or 'execMock' for convinience.-  mockToState :: Member (Embed m) r => Sem (MockImpl eff m ': r) a -> Sem (State (MockState eff m) ': r) a+  mockToState :: (Member (Embed m) r, HasCallStack) => Sem (MockImpl eff m ': r) a -> Sem (State (MockState eff m) ': r) a  -- | Run a mocked effect to get 'MockState' and the effect value-runMock :: (Mock eff m, Member (Embed m) r) => Sem (MockImpl eff m ': r) a -> Sem r (MockState eff m, a)+runMock :: (Mock eff m, Member (Embed m) r, HasCallStack) => Sem (MockImpl eff m ': r) a -> Sem r (MockState eff m, a) runMock = runState initialMockState . mockToState  -- | Like 'runMock' but discards the 'MockState'-evalMock :: (Mock eff m, Member (Embed m) r) => Sem (MockImpl eff m ': r) a -> Sem r a+evalMock :: (Mock eff m, Member (Embed m) r, HasCallStack) => Sem (MockImpl eff m ': r) a -> Sem r a evalMock = evalState initialMockState . mockToState  -- | Like 'runMock' but only returns the 'MockState'-execMock :: (Mock eff m, Member (Embed m) r) => Sem (MockImpl eff m ': r) a -> Sem r (MockState eff m)+execMock :: (Mock eff m, Member (Embed m) r, HasCallStack) => Sem (MockImpl eff m ': r) a -> Sem r (MockState eff m) execMock = execState initialMockState . mockToState  -- | Mock many effects@@ -159,7 +160,7 @@   mockMany :: MockChain effs m r => Sem (effs :++: r) a -> Sem r a    -- | Given a computation using Mock effects, evaluate the computation-  evalMocks :: (MocksExist effs m, Member (Embed m) r) => Sem (MockImpls effs m :++: r) a -> Sem r a+  evalMocks :: (MocksExist effs m, Member (Embed m) r, HasCallStack) => Sem (MockImpls effs m :++: r) a -> Sem r a  instance MockMany '[] r m where   mockMany = id

@@ -5,6 +5,7 @@  import Data.Bifunctor (first) import Data.List (foldl')+import GHC.Stack (HasCallStack) import Language.Haskell.TH hiding (Strict) import Polysemy (Embed, Members, Sem, interpret, pureT, reinterpretH) import Polysemy.Internal (embed, send)@@ -116,6 +117,13 @@       body = NormalB (AppE (AppTypeE sendFn t) theMock)    in Match pat body [] +#if MIN_VERSION_template_haskell(2,17,0)+#define UNQUALIFIED_DO Nothing+#else+#define UNQUALIFIED_DO+#endif++{- ORMOLU_DISABLE -} mkMockToStateMatch :: Type -> ConLiftInfo -> Match mkMockToStateMatch t c =   let pat = ConP (mockConName c) (map VarP vars)@@ -139,12 +147,14 @@       body =         NormalB           ( DoE+              UNQUALIFIED_DO               [ getState t,                 putState newState,                 returnAsPureT               ]           )    in Match pat body []+{- ORMOLU_ENABLE -}  mkReturnsToStateMatch :: Type -> ConLiftInfo -> Match mkReturnsToStateMatch t c =@@ -155,6 +165,7 @@       body =         NormalB           ( DoE+              UNQUALIFIED_DO               [ getState t,                 putState newState,                 returnNothing@@ -169,6 +180,7 @@       body =         NormalB           ( DoE+              UNQUALIFIED_DO               [ getState t,                 returnCalls               ]@@ -183,15 +195,22 @@   [Dec] mkReturnsSem mockImplEffType c =   let funcName = mkName ("mock" <> nameBase (cliConName c) <> "Returns")-      body = NormalB (InfixE (Just $ VarE 'send) (VarE '(.)) (Just $ ConE (returnsConName c)))+      f = mkName "f"+      body = NormalB $ VarE 'send `AppE` (ConE (returnsConName c) `AppE` VarE f)       appArrowT = AppT . AppT ArrowT       r = VarT $ mkName "r"       semr t = ConT ''Sem `AppT` r `AppT` t       typ = ForallT [] [membersEffListType mockImplEffType r] (returnsFunctionType c `appArrowT` semr (TupleT 0))    in [ SigD funcName typ,-        FunD funcName [Clause [] body []]+        FunD funcName [Clause [VarP f] body []]       ] +#if MIN_VERSION_template_haskell(2,17,0)+#define TY_VAR_SPECIFICTY SpecifiedSpec+#else+#define TY_VAR_SPECIFICTY+#endif+ mkCallsSem ::   -- | Should look like: @MockImpl Teletype n@   -- n is assumed to be 'stateEffectName', maybe this is problematic, but it works for now@@ -204,7 +223,11 @@       body = NormalB $ typeAppliedSend `AppE` ConE (callsConName c)       r = VarT $ mkName "r"       semr t = ConT ''Sem `AppT` r `AppT` t-      typ = ForallT [PlainTV returnsEffectName, PlainTV $ mkName "r"] [membersEffListType mockImplEffType r] (semr $ functionCallType c)+      typ =+        ForallT+          [PlainTV returnsEffectName TY_VAR_SPECIFICTY, PlainTV (mkName "r") TY_VAR_SPECIFICTY]+          [membersEffListType mockImplEffType r]+          (semr $ functionCallType c)    in [ SigD funcName typ,         FunD funcName [Clause [] body []]       ]@@ -254,7 +277,7 @@ returnsFunctionType c =   let argTypes = (map snd $ cliFunArgs c)       returnType = (AppT returnsEffect $ cliEffRes c)-   in foldr (AppT . AppT ArrowT) returnType argTypes+   in ForallT [] [ConT ''HasCallStack] $ foldr (AppT . AppT ArrowT) returnType argTypes  returnsEffect :: Type returnsEffect = VarT returnsEffectName

@@ -5,6 +5,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-}