summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorisovector <>2019-07-11 03:03:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-07-11 03:03:00 (GMT)
commita518b114617d9a44d7373892730e78a144e147d7 (patch)
treeb8c313ac1eeb3301f63d0d0a5f53daaab193ce6f
parent5c5c50a6abaea85d4ce27b879f251631d83c7cad (diff)
version 0.4.0.1HEAD0.4.0.1master
-rw-r--r--ChangeLog.md9
-rw-r--r--polysemy-zoo.cabal4
-rw-r--r--src/Polysemy/Final.hs24
-rw-r--r--src/Polysemy/Final/Error.hs2
-rw-r--r--src/Polysemy/Final/Fixpoint.hs1
-rw-r--r--src/Polysemy/Final/MTL.hs5
6 files changed, 30 insertions, 15 deletions
diff --git a/ChangeLog.md b/ChangeLog.md
index dc404c9..b5b23d1 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,5 +1,9 @@
# Changelog for polysemy-zoo
+## 0.4.0.1 (2019-07-10)
+
+- Fixed an erroneous lower bound in the tests
+
## 0.4.0.0 (2019-07-10)
### Breaking Changes
@@ -10,6 +14,8 @@
- Added `SetStore` effect
- Added `Floodgate` effect
+- Added `Final` effect, together with submodules of interpreters using it
+ (thanks to @KingoftheHomeless)
- Added `lookupOrThrowKV`, `existsKV` and `modifyKV` actions to `KVStore`
- Added Redis interpretations of `SetStore` and `KVStore`
@@ -43,6 +49,3 @@
## Unreleased changes
-
-* In AbsorbMonadWriter, re-implemented mtl pass in terms of the new Polysemy.Writer
-pass and confirmed all tests.
diff --git a/polysemy-zoo.cabal b/polysemy-zoo.cabal
index 618582e..04c9f28 100644
--- a/polysemy-zoo.cabal
+++ b/polysemy-zoo.cabal
@@ -4,10 +4,10 @@ cabal-version: 1.12
--
-- see: https://github.com/sol/hpack
--
--- hash: 2a632f7d2c785cf339754bf2cf1895a7996a6b348cc8704e54e6b45769f39d91
+-- hash: 9c68e7c2421eb030fe99a14dcd7cc393f3aaf7a1f3874b559a2222ba3073e8ae
name: polysemy-zoo
-version: 0.4.0.0
+version: 0.4.0.1
synopsis: Experimental, user-contributed effects and interpreters for polysemy
description: Please see the README on GitHub at <https://github.com/isovector/polysemy-zoo#readme>
category: Polysemy
diff --git a/src/Polysemy/Final.hs b/src/Polysemy/Final.hs
index 6d65811..3c7e2fe 100644
--- a/src/Polysemy/Final.hs
+++ b/src/Polysemy/Final.hs
@@ -57,6 +57,7 @@ import Control.Monad.IO.Class
-- This is very useful for writing interpreters that interpret higher-order
-- effects in terms of the final monad - however, these interpreters
-- are subject to very different semantics than regular ones.
+--
-- For more information, see 'interpretFinal'.
data Final m z a where
WithWeaving :: (forall f.
@@ -113,11 +114,11 @@ withStrategic strat = withWeaving $ \s wv ins -> runStrategy s wv ins strat
-- interpret higher-order effects in terms of the final monad.
--
-- /Beware/: Any interpreters built using this (or 'Final' in general)
--- will _not_ respect local/global state semantics based on the order of
+-- will /not/ respect local/global state semantics based on the order of
-- interpreters run. You should signal interpreters that make use of
-- 'Final' by adding a "-Final" suffix to the names of these.
--
--- State semantics of effects that are _not_
+-- State semantics of effects that are /not/
-- interpreted in terms of the final monad will always
-- appear local to effects that are interpreted in terms of the final monad.
--
@@ -170,6 +171,7 @@ getInspectorS :: Sem (WithStrategy m f n) (Inspector f)
getInspectorS = getInspectorT
{-# INLINE getInspectorS #-}
+------------------------------------------------------------------------------
-- | Get the stateful environment of the world at the moment the
-- target monad is to be run.
-- Prefer 'pureS', 'runS' or 'bindS' instead of using this function
@@ -179,13 +181,13 @@ getInitialStateS = getInitialStateT
{-# INLINE getInitialStateS #-}
------------------------------------------------------------------------------
--- Lift a value into 'Strategic'.
+-- | Lift a value into 'Strategic'.
pureS :: Applicative m => a -> Strategic m n a
pureS = fmap pure . pureT
{-# INLINE pureS #-}
------------------------------------------------------------------------------
--- Lifts an action of the final monad into 'Strategic'.
+-- | Lifts an action of the final monad into 'Strategic'.
--
-- Note: you don't need to use this function if you already have a monadic
-- action with the functorial state woven into it, by the use of
@@ -230,9 +232,10 @@ runStrategy s wv ins (Sem m) = runIdentity $ m $ \u -> case extract u of
GetInitialState -> s
HoistInterpretation na -> sendM . wv . fmap na
GetInspector -> Inspector ins
+{-# INLINE runStrategy #-}
------------------------------------------------------------------------------
--- Lower a 'Sem' containing only a lifted, final monad into that monad.
+-- | Lower a 'Sem' containing only a lifted, final monad into that monad.
-- The appearance of 'Lift' as the final effect
-- is to allow the use of operations that rely on a @'LastMember' ('Lift' m)@
-- constraint.
@@ -242,16 +245,17 @@ runFinal = usingSem $ \u -> case decomp u of
ex <$> wav s (runFinal . wv) ins
Left g -> case extract g of
Weaving (Lift m) s _ ex _ -> ex . (<$ s) <$> m
+{-# INLINE runFinal #-}
------------------------------------------------------------------------------
--- Lower a 'Sem' containing two lifted monad into the final monad,
+-- | Lower a 'Sem' containing two lifted monad into the final monad,
-- by interpreting one of the monads in terms of the other one.
--
-- This allows for the use of operations that rely on a @'LastMember' ('Lift' m)@
-- constraint, as long as @m@ can be transformed to the final monad;
-- but be warned, this breaks the implicit contract of @'LastMember' ('Lift' m)@
--- that @m@ _is_ the final monad, so depending on the final monad and operations
--- used, 'runFinalTrans' may become _unsafe_.
+-- that @m@ /is/ the final monad, so depending on the final monad and operations
+-- used, 'runFinalTrans' may become /unsafe/.
--
-- For example, 'runFinalTrans' is unsafe with 'runAsync' if
-- the final monad is non-deterministic, or a continuation
@@ -267,10 +271,12 @@ runFinalLift nat = usingSem $ \u -> case decomp u of
Right (Weaving (Lift m) s _ ex _) -> ex . (<$ s) <$> m
Left g' -> case extract g' of
Weaving (Lift n) s _ ex _ -> ex . (<$ s) <$> nat n
+{-# INLINE runFinalLift #-}
------------------------------------------------------------------------------
--- | 'runFinalTrans', specialized to transform 'IO' to a 'MonadIO'.
+-- | 'runFinalLift', specialized to transform 'IO' to a 'MonadIO'.
runFinalLiftIO :: MonadIO m
=> Sem [Final m, Lift m, Lift IO] a
-> m a
runFinalLiftIO = runFinalLift liftIO
+{-# INLINE runFinalLiftIO #-}
diff --git a/src/Polysemy/Final/Error.hs b/src/Polysemy/Final/Error.hs
index 47a12be..a0ad07d 100644
--- a/src/Polysemy/Final/Error.hs
+++ b/src/Polysemy/Final/Error.hs
@@ -34,6 +34,7 @@ runErrorInIOFinal sem = withStrategic $ do
((<$ s) . Left . unwrapExc)
(fmap Right)
<$> try m'
+{-# INLINE runErrorInIOFinal #-}
runErrorAsExcFinal
:: forall e r a
@@ -50,6 +51,7 @@ runErrorAsExcFinal = interpretFinal $ \case
s <- getInitialStateS
pure $ X.catch m' $ \(se :: WrappedExc e) ->
h' (unwrapExc se <$ s)
+{-# INLINE runErrorAsExcFinal #-}
newtype WrappedExc e = WrappedExc { unwrapExc :: e }
diff --git a/src/Polysemy/Final/Fixpoint.hs b/src/Polysemy/Final/Fixpoint.hs
index bd51843..b46f3e8 100644
--- a/src/Polysemy/Final/Fixpoint.hs
+++ b/src/Polysemy/Final/Fixpoint.hs
@@ -20,3 +20,4 @@ runFixpointFinal = interpretFinal $ \case
Fixpoint f -> do
f' <- bindS f
pure $ mfix f'
+{-# INLINE runFixpointFinal #-}
diff --git a/src/Polysemy/Final/MTL.hs b/src/Polysemy/Final/MTL.hs
index 149e3fb..5d2a1de 100644
--- a/src/Polysemy/Final/MTL.hs
+++ b/src/Polysemy/Final/MTL.hs
@@ -35,7 +35,7 @@ runErrorFinal = interpretFinal $ \case
h' <- bindS h
s <- getInitialStateS
pure $ m' `catchError` (h' . (<$ s))
-
+{-# INLINE runErrorFinal #-}
-----------------------------------------------------------------------------
-- | Run a 'Reader' effect through a final 'MonadReader'
@@ -51,6 +51,7 @@ runReaderFinal = interpretFinal $ \case
Local f m -> do
m' <- runS m
pure $ local f m'
+{-# INLINE runReaderFinal #-}
-----------------------------------------------------------------------------
-- | Run a 'State' effect through a 'MonadState'
@@ -69,6 +70,7 @@ runStateFinal :: (Member (Lift m) r, MonadState s m)
runStateFinal = interpret $ \case
Get -> sendM get
Put s -> sendM (put s)
+{-# INLINE runStateFinal #-}
-----------------------------------------------------------------------------
-- | Run a 'Writer' effect through a final 'MonadWriter'
@@ -92,3 +94,4 @@ runWriterFinal = interpretFinal $ \case
t <- m'
let f = maybe id fst (inspect ins t)
pure (fmap snd t, f)
+{-# INLINE runWriterFinal #-}