diff --git a/ChangeLog.md b/ChangeLog.md index 9f997b7..445ae07 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,29 @@ # Changelog for polysemy + +## 1.3.0.0 (2020-02-14) + +### Breaking Changes +- The semantics for `runNonDet` when `<|>` is used inside a higher-order action + of another effect has been reverted to that of 1.1.0.0 and earlier. + (See [issue #246](https://github.com/polysemy-research/polysemy/issues/246)) +- Type parameters for `outputToTrace` have been rearranged (thanks to + @juanpaucar) + +### Other Changes +- Added `Bundle` effect, for bundling multiple effects into a single one. +- Added `Tagged` effect, for annotating and disambiguating identical effects. +- Added `View` effect, an `Input`-like effect for caching an expensive computation. +- Added `catchJust` +- Added `fromException`/`Via` and `fromExceptionSem`/`Via` +- Added `note` +- Added `try` and `tryJust` +- Added `runStateSTRef` and `stateToST` +- Added `execState` and `execLazyState` +- Added `Polysemy.Law`, which offers machinery for creating laws for effects. +- Added `Polysemy.Membership` for retrieving and making use of effect membership + proofs. + ## 1.2.3.0 (2019-10-29) - Polysemy now works on GHC 8.8.1 (thanks to @googleson78 and @sevanspowell) @@ -32,7 +56,7 @@ - Type variables for certain internal functions, `failToEmbed`, and `atomicState'` have been rearranged. -## Other changes +### Other changes - Added `Final` effect, an effect for embedding higher-order actions in the final monad of the effect stack. Any interpreter should use this instead of @@ -260,4 +284,3 @@ - Changed the tyvars of `fromEitherM`, `runErrorAsAnother`, `runEmbedded`, `asks` and `gets` - diff --git a/package.yaml b/package.yaml index b62d936..4ab1e97 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: polysemy -version: 1.2.3.0 +version: 1.3.0.0 github: "isovector/polysemy" license: BSD3 author: "Sandy Maguire" diff --git a/polysemy-plugin/ChangeLog.md b/polysemy-plugin/ChangeLog.md index 323ee78..5fdfe20 100644 --- a/polysemy-plugin/ChangeLog.md +++ b/polysemy-plugin/ChangeLog.md @@ -1,5 +1,11 @@ # Changelog for polysemy-plugin + +## 0.2.5.0 (2020-10-14) +- Updated the lower bounds to `polysemy-1.3.0.0` because of changes to + `polysemy` internals +- Updated the test suite to test against `polysemy-1.3.0.0`. + ## 0.2.4.0 (2019-10-29) - The plugin now works on GHC 8.8.1 (thanks to @googleson78 and @sevanspowell) diff --git a/polysemy-plugin/package.yaml b/polysemy-plugin/package.yaml index f1b9336..ce9a722 100644 --- a/polysemy-plugin/package.yaml +++ b/polysemy-plugin/package.yaml @@ -1,5 +1,5 @@ name: polysemy-plugin -version: 0.2.4.0 +version: 0.2.5.0 github: "isovector/polysemy" license: BSD3 author: "Sandy Maguire" @@ -20,7 +20,7 @@ dependencies: - base >= 4.9 && < 5 - ghc >= 8.4.4 && < 9 - ghc-tcplugins-extra >= 0.3 && < 0.4 -- polysemy >= 0.6 +- polysemy >= 1.3 - syb >= 0.7 && < 0.8 - transformers >= 0.5.2.0 && < 0.6 - containers >= 0.5 && < 0.7 @@ -57,7 +57,7 @@ tests: build-tools: - hspec-discover dependencies: - - polysemy >= 1.2.0.0 + - polysemy >= 1.3.0.0 - polysemy-plugin - hspec >= 2.6.0 && < 3 - should-not-typecheck >= 2.1.0 && < 3 diff --git a/polysemy-plugin/polysemy-plugin.cabal b/polysemy-plugin/polysemy-plugin.cabal index 953b46e..7318b2c 100644 --- a/polysemy-plugin/polysemy-plugin.cabal +++ b/polysemy-plugin/polysemy-plugin.cabal @@ -4,10 +4,10 @@ cabal-version: 1.24 -- -- see: https://github.com/sol/hpack -- --- hash: 82e62a325b42351fc99bb87c3d491920a5a047c179e686cd398c82a9870f5e46 +-- hash: 48094f708e51c9466f041c84159f98dd8116f8573bdf02908880f68e2d8ed787 name: polysemy-plugin -version: 0.2.4.0 +version: 0.2.5.0 synopsis: Disambiguate obvious uses of effects. description: Please see the README on GitHub at category: Polysemy @@ -56,7 +56,7 @@ library , containers >=0.5 && <0.7 , ghc >=8.4.4 && <9 , ghc-tcplugins-extra >=0.3 && <0.4 - , polysemy >=0.6 + , polysemy >=1.3 , syb >=0.7 && <0.8 , transformers >=0.5.2.0 && <0.6 default-language: Haskell2010 @@ -88,7 +88,7 @@ test-suite polysemy-plugin-test , ghc-tcplugins-extra >=0.3 && <0.4 , hspec >=2.6.0 && <3 , inspection-testing >=0.4.2 && <0.5 - , polysemy >=1.2.0.0 + , polysemy >=1.3.0.0 , polysemy-plugin , should-not-typecheck >=2.1.0 && <3 , syb >=0.7 && <0.8 diff --git a/polysemy.cabal b/polysemy.cabal index 9614e4f..23783c1 100644 --- a/polysemy.cabal +++ b/polysemy.cabal @@ -4,10 +4,10 @@ cabal-version: 1.24 -- -- see: https://github.com/sol/hpack -- --- hash: 582807c5d69a34a9e991a77c6111532c05dbb54a5d7aa6662267b7af2d3047ee +-- hash: 0f1599ec8e1caf24489536a197f2eb261ecdfb3613fdc2f2221186cdb0f31a5e name: polysemy -version: 1.2.3.0 +version: 1.3.0.0 synopsis: Higher-order, low-boilerplate, zero-cost free monads. description: Please see the README on GitHub at category: Language @@ -96,7 +96,7 @@ library , async >=2.2 && <3 , base >=4.9 && <5 , containers >=0.5 && <0.7 - , first-class-families >=0.5.0.0 && <0.7 + , first-class-families >=0.5.0.0 && <0.8 , mtl >=2.2.2 && <3 , stm >=2 && <3 , syb >=0.7 && <0.8 @@ -157,7 +157,7 @@ test-suite polysemy-test , base >=4.9 && <5 , containers >=0.5 && <0.7 , doctest >=0.16.0.1 && <0.17 - , first-class-families >=0.5.0.0 && <0.7 + , first-class-families >=0.5.0.0 && <0.8 , hspec >=2.6.0 && <3 , inspection-testing >=0.4.2 && <0.5 , mtl >=2.2.2 && <3 @@ -189,7 +189,7 @@ benchmark polysemy-bench , base >=4.9 && <5 , containers >=0.5 && <0.7 , criterion - , first-class-families >=0.5.0.0 && <0.7 + , first-class-families >=0.5.0.0 && <0.8 , free , freer-simple , mtl diff --git a/src/Polysemy/Error.hs b/src/Polysemy/Error.hs index a43da6d..de27c5e 100644 --- a/src/Polysemy/Error.hs +++ b/src/Polysemy/Error.hs @@ -203,9 +203,9 @@ runError (Sem m) = Sem $ \k -> E.runExceptT $ m $ \u -> hush x Right (Weaving (Throw e) _ _ _ _) -> E.throwE e - Right (Weaving (Catch try handle) s d y _) -> + Right (Weaving (Catch main handle) s d y _) -> E.ExceptT $ usingSem k $ do - ma <- runError $ d $ try <$ s + ma <- runError $ d $ main <$ s case ma of Right a -> pure . Right $ y a Left e -> do @@ -329,11 +329,11 @@ runErrorAsExc -> Sem r a runErrorAsExc lower = interpretH $ \case Throw e -> embed $ X.throwIO $ WrappedExc e - Catch try handle -> do + Catch main handle -> do is <- getInitialStateT - t <- runT try + m <- runT main h <- bindT handle let runIt = lower . runErrorAsExc lower - embed $ X.catch (runIt t) $ \(se :: WrappedExc e) -> + embed $ X.catch (runIt m) $ \(se :: WrappedExc e) -> runIt $ h $ unwrapExc se <$ is {-# INLINE runErrorAsExc #-} diff --git a/src/Polysemy/Internal.hs b/src/Polysemy/Internal.hs index e215b72..681b6bf 100644 --- a/src/Polysemy/Internal.hs +++ b/src/Polysemy/Internal.hs @@ -415,7 +415,7 @@ subsume = subsumeUsing membership -- _ -> Nothing -- @ -- --- @since TODO +-- @since 1.3.0.0 subsumeUsing :: forall e r a. ElemOf e r -> Sem (e ': r) a -> Sem r a subsumeUsing pr = let diff --git a/src/Polysemy/Internal/Combinators.hs b/src/Polysemy/Internal/Combinators.hs index 27d7578..3a4a5f81 100644 --- a/src/Polysemy/Internal/Combinators.hs +++ b/src/Polysemy/Internal/Combinators.hs @@ -294,6 +294,8 @@ interceptH = interceptUsingH membership -- -- This is useful in conjunction with 'Polysemy.Membership.tryMembership' -- in order to conditionally perform 'intercept'. +-- +-- @since 1.3.0.0 interceptUsing :: FirstOrder e "interceptUsing" => ElemOf e r @@ -317,6 +319,8 @@ interceptUsing pr f = interceptUsingH pr $ \(e :: e m x) -> liftT @m $ f e -- in order to conditionally perform 'interceptH'. -- -- See the notes on 'Tactical' for how to use this function. +-- +-- @since 1.3.0.0 interceptUsingH :: ElemOf e r -- ^ A proof that the handled effect exists in @r@. diff --git a/src/Polysemy/Internal/Union.hs b/src/Polysemy/Internal/Union.hs index dd6623e..3c6a184 100644 --- a/src/Polysemy/Internal/Union.hs +++ b/src/Polysemy/Internal/Union.hs @@ -171,6 +171,8 @@ type MemberNoError e r = -- Due to technical reasons, @'ElemOf' e r@ is not powerful enough to -- prove @'Member' e r@; however, it can still be used send actions of @e@ -- into @r@ by using 'Polysemy.Internal.subsumeUsing'. +-- +-- @since 1.3.0.0 data ElemOf e r where -- | @e@ is located at the head of the list. Here :: ElemOf e (e ': r) diff --git a/src/Polysemy/Internal/Writer.hs b/src/Polysemy/Internal/Writer.hs index 8b4b4b7..1bd1de8 100644 --- a/src/Polysemy/Internal/Writer.hs +++ b/src/Polysemy/Internal/Writer.hs @@ -90,68 +90,97 @@ runWriterSTMAction write = interpretH $ \case tvar <- newTVarIO mempty switch <- newTVarIO False fa <- - restore (wv (runWriterSTMAction (write' tvar switch) m' <$ s)) - `onException` commit tvar switch id - o <- commit tvar switch id + restore (wv (runWriterSTMAction (writeListen tvar switch) m' <$ s)) + `onException` commitListen tvar switch + o <- commitListen tvar switch return $ (fmap . fmap) (o, ) fa Pass m -> do m' <- runT m ins <- getInspectorT raise $ withWeavingToFinal $ \s wv ins' -> mask $ \restore -> do + -- See below to understand how this works tvar <- newTVarIO mempty switch <- newTVarIO False t <- - restore (wv (runWriterSTMAction (write' tvar switch) m' <$ s)) - `onException` commit tvar switch id - _ <- commit tvar switch + restore (wv (runWriterSTMAction (writePass tvar switch) m' <$ s)) + `onException` commitPass tvar switch id + commitPass tvar switch (maybe id fst $ ins' t >>= inspect ins) return $ (fmap . fmap) snd t where {- KingoftheHomeless: - 'write'' is used by the argument computation to a 'listen' or 'pass' - in order to 'tell', rather than directly using the 'write'. + 'writeListen'/'writePass' is used by the argument computation to a + 'listen' or 'pass' in order to 'tell', rather than directly using + the provided 'write'. This is because we need to temporarily store its - 'tell's seperately in order for the 'listen'/'pass' to work - properly. Once the 'listen'/'pass' completes, we 'commit' the - changes done to the local tvar globally through 'write'. + 'tell's locally in order for the 'listen'/'pass' to work + properly. In the case of 'listen', this is done in parallel with + the global 'write's. In the case of 'pass', the argument computation + doesn't use 'write' at all, and instead, when the computation completes, + commit the changes it made to the local tvar by 'commitPass', + globally 'write'ing it all at once. + ('commitListen' serves only as a (likely unneeded) + safety measure.) - 'commit' is protected by 'mask'+'onException'. Combine this - with the fact that the 'withWeavingToFinal' can't be interrupted - by pure errors emitted by effects (since these will be + 'commitListen'/'commitPass' is protected by 'mask'+'onException'. + Combine this with the fact that the 'withWeavingToFinal' can't be + interrupted by pure errors emitted by effects (since these will be represented as part of the functorial state), and we guarantee that no writes will be lost if the argument computation fails for whatever reason. - The argument computation to a 'listen'/'pass' may also spawn + The argument computation to a 'pass' may also spawn asynchronous computations which do 'tell's of their own. In order to make sure these 'tell's won't be lost once a - 'listen'/'pass' completes, a switch is used to - control which tvar 'write'' writes to. The switch is flipped + 'pass' completes, a switch is used to + control which tvar 'writePass' writes to. The switch is flipped atomically together with commiting the writes of the local tvar as part of 'commit'. Once the switch is flipped, - any asynchrounous computations spawned by the argument + any asynchronous computations spawned by the argument computation will write to the global tvar instead of the local tvar (which is no longer relevant), and thus no writes will be lost. -} - write' :: TVar o - -> TVar Bool - -> o - -> STM () - write' tvar switch = \o -> do + + writeListen :: TVar o + -> TVar Bool + -> o + -> STM () + writeListen tvar switch = \o -> do + alreadyCommited <- readTVar switch + unless alreadyCommited $ do + s <- readTVar tvar + writeTVar tvar $! s <> o + write o + {-# INLINE writeListen #-} + + writePass :: TVar o + -> TVar Bool + -> o + -> STM () + writePass tvar switch = \o -> do useGlobal <- readTVar switch if useGlobal then write o else do s <- readTVar tvar writeTVar tvar $! s <> o + {-# INLINE writePass #-} - commit :: TVar o - -> TVar Bool - -> (o -> o) - -> IO o - commit tvar switch f = atomically $ do + commitListen :: TVar o + -> TVar Bool + -> IO o + commitListen tvar switch = atomically $ do + writeTVar switch True + readTVar tvar + {-# INLINE commitListen #-} + + commitPass :: TVar o + -> TVar Bool + -> (o -> o) + -> IO () + commitPass tvar switch f = atomically $ do o <- readTVar tvar let !o' = f o -- Likely redundant, but doesn't hurt. @@ -159,7 +188,7 @@ runWriterSTMAction write = interpretH $ \case unless alreadyCommited $ write o' writeTVar switch True - return o' + {-# INLINE commitPass #-} {-# INLINE runWriterSTMAction #-} diff --git a/src/Polysemy/State.hs b/src/Polysemy/State.hs index 6f74bc6..a1dfe30 100644 --- a/src/Polysemy/State.hs +++ b/src/Polysemy/State.hs @@ -186,7 +186,7 @@ stateToIO s sem = do ------------------------------------------------------------------------------ -- | Run a 'State' effect by transforming it into operations over an 'STRef'. -- --- @since TODO: version +-- @since 1.3.0.0 runStateSTRef :: forall s st r a . Member (Embed (ST st)) r @@ -224,7 +224,7 @@ runStateSTRef ref = interpret $ \case -- stResult = runST ( (runM $ stateToST \@_ \@st undefined $ pure undefined) :: forall st. ST st (s, a) ) -- @ -- --- @since TODO: version +-- @since 1.3.0.0 stateToST :: forall s st r a . Member (Embed (ST st)) r