polysemy 0.1.1.0 → 0.1.2.0

raw patch · 26 files changed

+527/−343 lines, 26 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +11/−1
• README.md +18/−14
• polysemy.cabal +10/−1
• src/Polysemy.hs +50/−18
• src/Polysemy/Error.hs +17/−19
• src/Polysemy/Fixpoint.hs +6/−6
• src/Polysemy/IO.hs +6/−4
• src/Polysemy/Input.hs +6/−7
• src/Polysemy/Internal.hs +107/−74
• src/Polysemy/Internal/Combinators.hs +72/−79
• src/Polysemy/Internal/Effect.hs +2/−8
• src/Polysemy/Internal/Lift.hs +8/−8
• src/Polysemy/Internal/TH/Effect.hs +26/−22
• src/Polysemy/Internal/TH/Performance.hs +1/−1
• src/Polysemy/Internal/Tactics.hs +23/−25
• src/Polysemy/Internal/Union.hs +3/−3
• src/Polysemy/NonDet.hs +2/−2
• src/Polysemy/Output.hs +43/−6
• src/Polysemy/Random.hs +5/−7
• src/Polysemy/Reader.hs +8/−6
• src/Polysemy/Resource.hs +8/−9
• src/Polysemy/State.hs +25/−7
• src/Polysemy/Trace.hs +25/−5
• src/Polysemy/Writer.hs +9/−7
• test/FusionSpec.hs +4/−4
• test/OutputSpec.hs +32/−0

@@ -1,8 +1,17 @@ # Changelog for polysemy +## 0.1.2.0 (2019-04-26)++- `runInputAsReader`, `runTraceAsOutput` and `runOutputAsWriter` have more+    generalized types+- Added `runStateInIO`+- Added `runOutputAsTrace`+- Added `Members` (thanks to @TheMatten)++ ## 0.1.1.0 (2019-04-14) -- Added 'runIO' interpretation (thanks to @adamConnerSax)+- Added `runIO` interpretation (thanks to @adamConnerSax) - Minor documentation fixes  @@ -11,3 +20,4 @@ - Initial release  ## Unreleased changes+

@@ -44,6 +44,10 @@  ## Examples +Make sure you read the [Necessary Language+Extensions](https://github.com/isovector/polysemy#necessary-language-extensions)+before trying these yourself!+ Console effect:  ```haskell@@ -52,15 +56,15 @@ import Polysemy  data Console m a where-  GetLine :: Console m String-  PutLine :: String -> Console m ()+  ReadTTY  :: Console m String+  WriteTTY :: String -> Console m () -makeSemantic ''Console+makeSem ''Console -runConsoleIO :: Member (Lift IO) r => Semantic (Console ': r) a -> Semantic r a+runConsoleIO :: Member (Lift IO) r => Sem (Console ': r) a -> Sem r a runConsoleIO = interpret $ \case-  GetLine     -> sendM getLine-  PutLine msg -> sendM $ putStrLn msg+  ReadTTY      -> sendM getLine+  WriteTTY msg -> sendM $ putStrLn msg ```  @@ -75,21 +79,21 @@ data Resource m a where   Bracket :: m a -> (a -> m ()) -> (a -> m b) -> Resource m b -makeSemantic ''Resource+makeSem ''Resource  runResource     :: forall r a      . Member (Lift IO) r-    => (∀ x. Semantic r x -> IO x)-    -> Semantic (Resource ': r) a-    -> Semantic r a+    => (∀ x. Sem r x -> IO x)+    -> Sem (Resource ': r) a+    -> Sem r a runResource finish = interpretH $ \case   Bracket alloc dealloc use -> do     a <- runT  alloc     d <- bindT dealloc     u <- bindT use -    let runIt :: Semantic (Resource ': r) x -> IO x+    let runIt :: Sem (Resource ': r) x -> IO x         runIt = finish .@ runResource      sendM $ X.bracket (runIt a) (runIt . d) (runIt . u)@@ -111,9 +115,9 @@ runResource     :: forall r a      . Member (Lift IO) r-    => (∀ x. Semantic r x -> IO x)-    -> Semantic (Resource ': r) a-    -> Semantic r a+    => (∀ x. Sem r x -> IO x)+    -> Sem (Resource ': r) a+    -> Sem r a runResource finish = interpret $ \case   ... ```

@@ -1,6 +1,6 @@ cabal-version: 1.12 name: polysemy-version: 0.1.1.0+version: 0.1.2.0 license: BSD3 license-file: LICENSE copyright: 2019 Sandy Maguire@@ -89,8 +89,13 @@     hs-source-dirs: test     other-modules:         FusionSpec+        OutputSpec         Paths_polysemy     default-language: Haskell2010+    default-extensions: DataKinds DeriveFunctor FlexibleContexts GADTs+                        LambdaCase PolyKinds RankNTypes ScopedTypeVariables+                        StandaloneDeriving TypeApplications TypeOperators TypeFamilies+                        UnicodeSyntax     ghc-options: -threaded -rtsopts -with-rtsopts=-N     build-depends:         base >=4.7 && <5,@@ -111,6 +116,10 @@         Poly         Paths_polysemy     default-language: Haskell2010+    default-extensions: DataKinds DeriveFunctor FlexibleContexts GADTs+                        LambdaCase PolyKinds RankNTypes ScopedTypeVariables+                        StandaloneDeriving TypeApplications TypeOperators TypeFamilies+                        UnicodeSyntax     build-depends:         base >=4.7 && <5,         criterion >=1.5.3.0 && <1.6,

@@ -1,9 +1,10 @@ module Polysemy   ( -- * Core Types-    Semantic ()+    Sem ()   , Member+  , Members -  -- * Running Semantic+  -- * Running Sem   , run   , runM @@ -26,21 +27,21 @@     --   ReadLine  :: Console m String     -- @     ---    -- Notice that the 'a' parameter gets instataniated at the /desired return+    -- Notice that the @a@ parameter gets instataniated at the /desired return     -- type/ of the actions. Writing a line returns a '()', but reading one     -- returns 'String'.     ---    -- By enabling @-XTemplateHaskell@, we can use the 'makeSemantic' function+    -- By enabling @-XTemplateHaskell@, we can use the 'makeSem' function     -- to generate smart constructors for the actions. These smart constructors-    -- can be invoked directly inside of the 'Semantic' monad.+    -- can be invoked directly inside of the 'Sem' monad.     ---    -- >>> makeSemantic ''Console+    -- >>> makeSem ''Console     --     -- results in the following definitions:     --     -- @-    -- writeLine :: 'Member' Console r => String -> 'Semantic' r ()-    -- readLine  :: 'Member' Console r => 'Semantic' r String+    -- writeLine :: 'Member' Console r => String -> 'Sem' r ()+    -- readLine  :: 'Member' Console r => 'Sem' r String     -- @     --     -- Effects which don't make use of the @m@ parameter are known as@@ -48,7 +49,7 @@      -- ** Higher-Order Effects     -- | Every effect has access to the @m@ parameter, which corresponds to the-    -- 'Semantic' monad it's used in. Using this parameter, we're capable of+    -- 'Sem' monad it's used in. Using this parameter, we're capable of     -- writing effects which themselves contain subcomputations.     --     -- For example, the definition of 'Polysemy.Error.Error' is@@ -62,16 +63,16 @@     -- where 'Polysemy.Error.Catch' is an action that can run an exception     -- handler if its first argument calls 'Polysemy.Error.throw'.     ---    -- >>> makeSemantic ''Error+    -- >>> makeSem ''Error     --     -- @-    -- 'Polysemy.Error.throw' :: 'Member' ('Polysemy.Error.Error' e) r => e -> 'Semantic' r a-    -- 'Polysemy.Error.catch'  :: 'Member' ('Polysemy.Error.Error' e) r => 'Semantic' r a -> (e -> 'Semantic' r a) -> 'Semantic' r a+    -- 'Polysemy.Error.throw' :: 'Member' ('Polysemy.Error.Error' e) r => e -> 'Sem' r a+    -- 'Polysemy.Error.catch'  :: 'Member' ('Polysemy.Error.Error' e) r => 'Sem' r a -> (e -> 'Sem' r a) -> 'Sem' r a     -- @     ---    -- As you see, in the smart constructors, the @m@ parameter has become @'Semantic' r@.-  , makeSemantic-  , makeSemantic_+    -- As you see, in the smart constructors, the @m@ parameter has become @'Sem' r@.+  , makeSem+  , makeSem_      -- * Combinators for Interpreting First-Order Effects   , interpret@@ -110,14 +111,45 @@   , runT   , bindT -  -- * Reexports-  , Typeable+  -- * Deprecated Names+  -- | The following exports are deprecated, and are exposed only for+  -- backwards compatability reasons. They will be removed in the next major+  -- release.+  , Semantic+  , runSemantic+  , makeSemantic+  , makeSemantic_   ) where -import Data.Typeable import Polysemy.Internal import Polysemy.Internal.Combinators import Polysemy.Internal.TH.Effect import Polysemy.Internal.TH.Performance import Polysemy.Internal.Tactics++-- Imported just for the deprecated names.+import Polysemy.Internal.Union+import Language.Haskell.TH++--------------------------------------------------------------------------------+-- Deprecated names+type Semantic = Sem+{-# DEPRECATED Semantic "Use 'Sem' instead" #-}++runSemantic :: ∀ m r a+  . Monad m+  => Semantic r a -> (∀ x. Union r (Sem r) x -> m x)+  -> m a+runSemantic = runSem+{-# DEPRECATED runSemantic "Use 'runSem' instead" #-}+++makeSemantic :: Name -> Q [Dec]+makeSemantic = makeSem+{-# DEPRECATED makeSemantic "Use 'makeSem' instead" #-}++makeSemantic_ :: Name -> Q [Dec]+makeSemantic_ = makeSem_+{-# DEPRECATED makeSemantic_ "Use 'makeSem_' instead" #-}+ 

@@ -27,23 +27,22 @@   Throw :: e -> Error e m a   Catch :: ∀ e m a. m a -> (e -> m a) -> Error e m a -makeSemantic ''Error+makeSem ''Error   ------------------------------------------------------------------------------ -- | Run an 'Error' effect in the style of -- 'Control.Monad.Trans.Except.ExceptT'. runError-    :: Typeable e-    => Semantic (Error e ': r) a-    -> Semantic r (Either e a)-runError (Semantic m) = Semantic $ \k -> E.runExceptT $ m $ \u ->+    :: Sem (Error e ': r) a+    -> Sem r (Either e a)+runError (Sem m) = Sem $ \k -> E.runExceptT $ m $ \u ->   case decomp u of     Left x -> E.ExceptT $ k $       weave (Right ()) (either (pure . Left) runError_b) x     Right (Yo (Throw e) _ _ _) -> E.throwE e     Right (Yo (Catch try handle) s d y) ->-      E.ExceptT $ usingSemantic k $ do+      E.ExceptT $ usingSem k $ do         ma <- runError_b $ d $ try <$ s         case ma of           Right a -> pure . Right $ y a@@ -55,9 +54,8 @@ {-# INLINE runError #-}  runError_b-    :: Typeable e-    => Semantic (Error e ': r) a-    -> Semantic r (Either e a)+    :: Sem (Error e ': r) a+    -> Sem r (Either e a) runError_b = runError {-# NOINLINE runError_b #-} @@ -78,12 +76,12 @@     :: ( Typeable e        , Member (Lift IO) r        )-    => (∀ x. Semantic r x -> IO x)-       -- ^ Strategy for lowering a 'Semantic' action down to 'IO'. This is+    => (∀ x. Sem r x -> IO x)+       -- ^ Strategy for lowering a 'Sem' action down to 'IO'. This is        -- likely some combination of 'runM' and other interpters composed via        -- '.@'.-    -> Semantic (Error e ': r) a-    -> Semantic r (Either e a)+    -> Sem (Error e ': r) a+    -> Sem r (Either e a) runErrorInIO lower     = sendM     . fmap (first unwrapExc)@@ -96,9 +94,9 @@     :: forall e r a. ( Typeable e        , Member (Lift IO) r        )-    => (∀ x. Semantic r x -> IO x)-    -> Semantic (Error e ': r) a-    -> Semantic r a+    => (∀ x. Sem r x -> IO x)+    -> Sem (Error e ': r) a+    -> Sem r a runErrorAsExc lower = interpretH $ \case   Throw e -> sendM $ X.throwIO $ WrappedExc e   Catch try handle -> do@@ -115,9 +113,9 @@     :: ( Typeable e        , Member (Lift IO) r        )-    => (∀ x. Semantic r x -> IO x)-    -> Semantic (Error e ': r) a-    -> Semantic r a+    => (∀ x. Sem r x -> IO x)+    -> Sem (Error e ': r) a+    -> Sem r a runErrorAsExc_b = runErrorAsExc {-# NOINLINE runErrorAsExc_b #-} 

@@ -16,9 +16,9 @@ ------------------------------------------------------------------------------ -- | Run a 'Fixpoint' effect purely. runFixpoint-    :: (∀ x. Semantic r x -> x)-    -> Semantic (Fixpoint ': r) a-    -> Semantic r a+    :: (∀ x. Sem r x -> x)+    -> Sem (Fixpoint ': r) a+    -> Sem r a runFixpoint lower = interpretH $ \case   Fixpoint mf -> do     c <- bindT mf@@ -31,9 +31,9 @@     :: ( MonadFix m        , Member (Lift m) r        )-    => (∀ x. Semantic r x -> m x)-    -> Semantic (Fixpoint ': r) a-    -> Semantic r a+    => (∀ x. Sem r x -> m x)+    -> Sem (Fixpoint ': r) a+    -> Sem r a runFixpointM lower = interpretH $ \case   Fixpoint mf -> do     c <- bindT mf

@@ -10,12 +10,14 @@   --------------------------------------------------------------------------------- | The 'MonadIO' class is conceptually an interpretation of 'IO' to some+-- | __If you trying to run 'Sem' in 'IO', the function you want is 'runM'.__+--+-- The 'MonadIO' class is conceptually an interpretation of 'IO' to some -- other monad. This function reifies that intuition, by transforming an 'IO' -- effect into some other 'MonadIO'. -- -- This function is especially useful when using the 'MonadIO' instance for--- 'Semantic' instance.+-- 'Sem' instance. -- -- Make sure to type-apply the desired 'MonadIO' instance when using 'runIO'. --@@ -34,8 +36,8 @@      . ( MonadIO m        , Member (Lift m) r        )-    => Semantic (Lift IO ': r) a-    -> Semantic r a+    => Sem (Lift IO ': r) a+    -> Sem r a runIO = interpret $ sendM . liftIO @m . unLift {-# INLINE runIO #-} 

@@ -25,12 +25,12 @@ data Input i m a where   Input :: Input i m i -makeSemantic ''Input+makeSem ''Input   ------------------------------------------------------------------------------ -- | Run an 'Input' effect by always giving back the same value.-runConstInput :: i -> Semantic (Input i ': r) a -> Semantic r a+runConstInput :: i -> Sem (Input i ': r) a -> Sem r a runConstInput c = interpret \case   Input -> pure c {-# INLINE runConstInput #-}@@ -40,10 +40,9 @@ -- | Run an 'Input' effect by providing a different element of a list each -- time. Returns 'Nothing' after the list is exhausted. runListInput-    :: Typeable i-    => [i]-    -> Semantic (Input (Maybe i) ': r) a-    -> Semantic r a+    :: [i]+    -> Sem (Input (Maybe i) ': r) a+    -> Sem r a runListInput is = fmap snd . runState is . reinterpret \case   Input -> do     s <- gets uncons@@ -54,7 +53,7 @@  ------------------------------------------------------------------------------ -- | Runs an 'Input' effect by evaluating a monadic action for each request.-runMonadicInput :: Semantic r i -> Semantic (Input i ': r) a -> Semantic r a+runMonadicInput :: Sem r i -> Sem (Input i ': r) a -> Sem r a runMonadicInput m = interpret \case   Input -> m {-# INLINE runMonadicInput #-}

@@ -4,17 +4,18 @@ {-# LANGUAGE UndecidableInstances #-}  module Polysemy.Internal-  ( Semantic (..)+  ( Sem (..)   , Member+  , Members   , send   , sendM   , run   , runM   , raise   , Lift (..)-  , usingSemantic-  , liftSemantic-  , hoistSemantic+  , usingSem+  , liftSem+  , hoistSem   , (.@)   , (.@@)   ) where@@ -23,6 +24,7 @@ import Control.Monad.Fix import Control.Monad.IO.Class import Data.Functor.Identity+import Data.Kind import Polysemy.Internal.Effect import Polysemy.Internal.Fixpoint import Polysemy.Internal.Lift@@ -31,12 +33,12 @@   --------------------------------------------------------------------------------- | The 'Semantic' monad handles computations of arbitrary extensible effects.--- A value of type @Semantic r@ describes a program with the capabilities of+-- | The 'Sem' monad handles computations of arbitrary extensible effects.+-- A value of type @Sem r@ describes a program with the capabilities of -- @r@. For best results, @r@ should always be kept polymorphic, but you can -- add capabilities via the 'Member' constraint. ----- The value of the 'Semantic' monad is that it allows you to write programs+-- The value of the 'Sem' monad is that it allows you to write programs -- against a set of effects without a predefined meaning, and provide that -- meaning later. For example, unlike with mtl, you can decide to interpret an -- 'Polysemy.Error.Error' effect tradtionally as an 'Either', or instead@@ -48,14 +50,14 @@ -- -- The effect stack @r@ can contain arbitrary other monads inside of it. These -- monads are lifted into effects via the 'Lift' effect. Monadic values can be--- lifted into a 'Semantic' via 'sendM'.+-- lifted into a 'Sem' via 'sendM'. ----- A 'Semantic' can be interpreted as a pure value (via 'run') or as any+-- A 'Sem' can be interpreted as a pure value (via 'run') or as any -- traditional 'Monad' (via 'runM'). Each effect @E@ comes equipped with some -- interpreters of the form: -- -- @--- runE :: 'Semantic' (E ': r) a -> 'Semantic' r a+-- runE :: 'Sem' (E ': r) a -> 'Sem' r a -- @ -- -- which is responsible for removing the effect @E@ from the effect stack. It@@ -63,7 +65,7 @@ -- monomorphic representation of the @r@ parameter. -- -- After all of your effects are handled, you'll be left with either--- a @'Semantic' '[] a@ or a @'Semantic' '[ 'Lift' m ] a@ value, which can be+-- a @'Sem' '[] a@ or a @'Sem' '[ 'Lift' m ] a@ value, which can be -- consumed respectively by 'run' and 'runM'. -- -- ==== Examples@@ -71,14 +73,14 @@ -- As an example of keeping @r@ polymorphic, we can consider the type -- -- @--- 'Member' ('Polysemy.State' String) r => 'Semantic' r ()+-- 'Member' ('Polysemy.State' String) r => 'Sem' r () -- @ -- -- to be a program with access to -- -- @--- 'Polysemy.State.get' :: 'Semantic' r String--- 'Polysemy.State.put' :: String -> 'Semantic' r ()+-- 'Polysemy.State.get' :: 'Sem' r String+-- 'Polysemy.State.put' :: String -> 'Sem' r () -- @ -- -- methods.@@ -92,25 +94,25 @@ -- constraint on @r@, we gain access to the -- -- @--- 'Polysemy.Error.throw' :: Bool -> 'Semantic' r a--- 'Polysemy.Error.catch' :: 'Semantic' r a -> (Bool -> 'Semantic' r a) -> 'Semantic' r a+-- 'Polysemy.Error.throw' :: Bool -> 'Sem' r a+-- 'Polysemy.Error.catch' :: 'Sem' r a -> (Bool -> 'Sem' r a) -> 'Sem' r a -- @ -- -- functions as well. -- -- In this sense, a @'Member' ('Polysemy.State.State' s) r@ constraint is -- analogous to mtl's @'Control.Monad.State.Class.MonadState' s m@ and should--- be thought of as such. However, /unlike/ mtl, a 'Semantic' monad may have+-- be thought of as such. However, /unlike/ mtl, a 'Sem' monad may have -- an arbitrary number of the same effect. ----- For example, we can write a 'Semantic' program which can output either+-- For example, we can write a 'Sem' program which can output either -- 'Int's or 'Bool's: -- -- @ -- foo :: ( 'Member' ('Polysemy.Output.Output' Int) r --        , 'Member' ('Polysemy.Output.Output' Bool) r --        )---     => 'Semantic' r ()+--     => 'Sem' r () -- foo = do --   'Polysemy.Output.output' @Int  5 --   'Polysemy.Output.output' True@@ -118,49 +120,80 @@ -- -- Notice that we must use @-XTypeApplications@ to specify that we'd like to -- use the ('Polysemy.Output.Output' 'Int') effect.-newtype Semantic r a = Semantic-  { runSemantic+--+-- @since 0.1.2.0+newtype Sem r a = Sem+  { runSem         :: ∀ m          . Monad m-        => (∀ x. Union r (Semantic r) x -> m x)+        => (∀ x. Union r (Sem r) x -> m x)         -> m a   } + --------------------------------------------------------------------------------- | Like 'runSemantic' but flipped for better ergonomics sometimes.-usingSemantic+-- | Makes constraints of functions that use multiple effects shorter by+-- translating single list of effects into multiple 'Member' constraints:+--+-- @+-- foo :: 'Members' \'[ 'Polysemy.Output.Output' Int+--                 , 'Polysemy.Output.Output' Bool+--                 , 'Polysemy.State' String+--                 ] r+--     => 'Sem' r ()+-- @+--+-- translates into:+--+-- @+-- foo :: ( 'Member' ('Polysemy.Output.Output' Int) r+--        , 'Member' ('Polysemy.Output.Output' Bool) r+--        , 'Member' ('Polysemy.State' String) r+--        )+--     => 'Sem' r ()+-- @+--+-- @since 0.1.2.0+type family Members es r :: Constraint where+  Members '[]       r = ()+  Members (e ': es) r = (Member e r, Members es r)+++------------------------------------------------------------------------------+-- | Like 'runSem' but flipped for better ergonomics sometimes.+usingSem     :: Monad m-    => (∀ x. Union r (Semantic r) x -> m x)-    -> Semantic r a+    => (∀ x. Union r (Sem r) x -> m x)+    -> Sem r a     -> m a-usingSemantic k m = runSemantic m k-{-# INLINE usingSemantic #-}+usingSem k m = runSem m k+{-# INLINE usingSem #-}  -instance Functor (Semantic f) where-  fmap f (Semantic m) = Semantic $ \k -> fmap f $ m k+instance Functor (Sem f) where+  fmap f (Sem m) = Sem $ \k -> fmap f $ m k   {-# INLINE fmap #-}  -instance Applicative (Semantic f) where-  pure a = Semantic $ const $ pure a+instance Applicative (Sem f) where+  pure a = Sem $ const $ pure a   {-# INLINE pure #-} -  Semantic f <*> Semantic a = Semantic $ \k -> f k <*> a k+  Sem f <*> Sem a = Sem $ \k -> f k <*> a k   {-# INLINE (<*>) #-}  -instance Monad (Semantic f) where+instance Monad (Sem f) where   return = pure   {-# INLINE return #-} -  Semantic ma >>= f = Semantic $ \k -> do+  Sem ma >>= f = Sem $ \k -> do     z <- ma k-    runSemantic (f z) k+    runSem (f z) k   {-# INLINE (>>=) #-}  -instance (Member NonDet r) => Alternative (Semantic r) where+instance (Member NonDet r) => Alternative (Sem r) where   empty = send Empty   {-# INLINE empty #-}   a <|> b = do@@ -174,68 +207,68 @@ -- | This instance will only lift 'IO' actions. If you want to lift into some -- other 'MonadIO' type, use this instance, and handle it via the -- 'Polysemy.IO.runIO' interpretation.-instance (Member (Lift IO) r) => MonadIO (Semantic r) where+instance (Member (Lift IO) r) => MonadIO (Sem r) where   liftIO = sendM   {-# INLINE liftIO #-} -instance Member Fixpoint r => MonadFix (Semantic r) where+instance Member Fixpoint r => MonadFix (Sem r) where   mfix f = send $ Fixpoint f   {-# INLINE mfix #-}  -liftSemantic :: Union r (Semantic r) a -> Semantic r a-liftSemantic u = Semantic $ \k -> k u-{-# INLINE liftSemantic #-}+liftSem :: Union r (Sem r) a -> Sem r a+liftSem u = Sem $ \k -> k u+{-# INLINE liftSem #-}  -hoistSemantic-    :: (∀ x. Union r (Semantic r) x -> Union r' (Semantic r') x)-    -> Semantic r a-    -> Semantic r' a-hoistSemantic nat (Semantic m) = Semantic $ \k -> m $ \u -> k $ nat u-{-# INLINE hoistSemantic #-}+hoistSem+    :: (∀ x. Union r (Sem r) x -> Union r' (Sem r') x)+    -> Sem r a+    -> Sem r' a+hoistSem nat (Sem m) = Sem $ \k -> m $ \u -> k $ nat u+{-# INLINE hoistSem #-}   --------------------------------------------------------------------------------- | Introduce an effect into 'Semantic'. Analogous to+-- | Introduce an effect into 'Sem'. Analogous to -- 'Control.Monad.Class.Trans.lift' in the mtl ecosystem-raise :: ∀ e r a. Semantic r a -> Semantic (e ': r) a-raise = hoistSemantic $ hoist raise_b . weaken+raise :: ∀ e r a. Sem r a -> Sem (e ': r) a+raise = hoistSem $ hoist raise_b . weaken {-# INLINE raise #-}  -raise_b :: Semantic r a -> Semantic (e ': r) a+raise_b :: Sem r a -> Sem (e ': r) a raise_b = raise {-# NOINLINE raise_b #-}   --------------------------------------------------------------------------------- | Lift an effect into a 'Semantic'. This is used primarily via--- 'Polysemy.makeSemantic' to implement smart constructors.-send :: Member e r => e (Semantic r) a -> Semantic r a-send = liftSemantic . inj+-- | Lift an effect into a 'Sem'. This is used primarily via+-- 'Polysemy.makeSem' to implement smart constructors.+send :: Member e r => e (Sem r) a -> Sem r a+send = liftSem . inj {-# INLINE[3] send #-}   --------------------------------------------------------------------------------- | Lift a monadic action @m@ into 'Semantic'.-sendM :: Member (Lift m) r => m a -> Semantic r a+-- | Lift a monadic action @m@ into 'Sem'.+sendM :: Member (Lift m) r => m a -> Sem r a sendM = send . Lift {-# INLINE sendM #-}   --------------------------------------------------------------------------------- | Run a 'Semantic' containing no effects as a pure value.-run :: Semantic '[] a -> a-run (Semantic m) = runIdentity $ m absurdU+-- | Run a 'Sem' containing no effects as a pure value.+run :: Sem '[] a -> a+run (Sem m) = runIdentity $ m absurdU {-# INLINE run #-}   --------------------------------------------------------------------------------- | Lower a 'Semantic' containing only a single lifted 'Monad' into that+-- | Lower a 'Sem' containing only a single lifted 'Monad' into that -- monad.-runM :: Monad m => Semantic '[Lift m] a -> m a-runM (Semantic m) = m $ \z ->+runM :: Monad m => Sem '[Lift m] a -> m a+runM (Sem m) = m $ \z ->   case extract z of     Yo e s _ f -> do       a <- unLift e@@ -269,12 +302,12 @@ -- precedence errors. (.@)     :: Monad m-    => (∀ x. Semantic r x -> m x)+    => (∀ x. Sem r x -> m x)        -- ^ The lowering function, likely 'runM'.-    -> (∀ y. (∀ x. Semantic r x -> m x)-          -> Semantic (e ': r) y-          -> Semantic r y)-    -> Semantic (e ': r) z+    -> (∀ y. (∀ x. Sem r x -> m x)+          -> Sem (e ': r) y+          -> Sem r y)+    -> Sem (e ': r) z     -> m z f .@ g = f . g f infixl 9 .@@@ -285,12 +318,12 @@ -- 'Polysemy.Error.runErrorInIO'. (.@@)     :: Monad m-    => (∀ x. Semantic r x -> m x)+    => (∀ x. Sem r x -> m x)        -- ^ The lowering function, likely 'runM'.-    -> (∀ y. (∀ x. Semantic r x -> m x)-          -> Semantic (e ': r) y-          -> Semantic r (f y))-    -> Semantic (e ': r) z+    -> (∀ y. (∀ x. Sem r x -> m x)+          -> Sem (e ': r) y+          -> Sem r (f y))+    -> Sem (e ': r) z     -> m (f z) f .@@ g = f . g f infixl 9 .@@

@@ -21,7 +21,6 @@  import qualified Control.Monad.Trans.State.Lazy as LS import qualified Control.Monad.Trans.State.Strict as S-import           Data.Typeable import           Polysemy.Internal import           Polysemy.Internal.CustomErrors import           Polysemy.Internal.Effect@@ -37,33 +36,33 @@   --------------------------------------------------------------------------------- | The simplest way to produce an effect handler. Interprets an effect 'e' by--- transforming it into other effects inside of 'r'.+-- | The simplest way to produce an effect handler. Interprets an effect @e@ by+-- transforming it into other effects inside of @r@. interpret     :: FirstOrder e "interpret"-    => (∀ x m. e m x -> Semantic r x)+    => (∀ x m. e m x -> Sem r x)        -- ^ A natural transformation from the handled effect to other effects-       -- already in 'Semantic'.-    -> Semantic (e ': r) a-    -> Semantic r a+       -- already in 'Sem'.+    -> Sem (e ': r) a+    -> Sem r a -- TODO(sandy): could probably give a `coerce` impl for `runTactics` here interpret f = interpretH $ \(e :: e m x) -> liftT @m $ f e   ------------------------------------------------------------------------------ -- | Like 'interpret', but for higher-order effects (ie. those which make use of--- the 'm' parameter.)+-- the @m@ parameter.) -- -- See the notes on 'Tactical' for how to use this function. interpretH     :: (∀ x m . e m x -> Tactical e m r x)        -- ^ A natural transformation from the handled effect to other effects-       -- already in 'Semantic'.-    -> Semantic (e ': r) a-    -> Semantic r a-interpretH f (Semantic m) = m $ \u ->+       -- already in 'Sem'.+    -> Sem (e ': r) a+    -> Sem r a+interpretH f (Sem m) = m $ \u ->   case decomp u of-    Left  x -> liftSemantic $ hoist (interpretH_b f) x+    Left  x -> liftSem $ hoist (interpretH_b f) x     Right (Yo e s d y) -> do       a <- runTactics s (raise . interpretH_b f . d) (f e)       pure $ y a@@ -73,12 +72,11 @@ -- | A highly-performant combinator for interpreting an effect statefully. See -- 'stateful' for a more user-friendly variety of this function. interpretInStateT-    :: Typeable s-    => (∀ x m. e m x -> S.StateT s (Semantic r) x)+    :: (∀ x m. e m x -> S.StateT s (Sem r) x)     -> s-    -> Semantic (e ': r) a-    -> Semantic r (s, a)-interpretInStateT f s (Semantic m) = Semantic $ \k ->+    -> Sem (e ': r) a+    -> Sem r (s, a)+interpretInStateT f s (Sem m) = Sem $ \k ->   fmap swap $ flip S.runStateT s $ m $ \u ->     case decomp u of         Left x -> S.StateT $ \s' ->@@ -86,19 +84,18 @@             . weave (s', ()) (uncurry $ interpretInStateT_b f)             $ x         Right (Yo e z _ y) ->-          fmap (y . (<$ z)) $ S.mapStateT (usingSemantic k) $ f e+          fmap (y . (<$ z)) $ S.mapStateT (usingSem k) $ f e {-# INLINE interpretInStateT #-}  ------------------------------------------------------------------------------ -- | A highly-performant combinator for interpreting an effect statefully. See -- 'stateful' for a more user-friendly variety of this function. interpretInLazyStateT-    :: Typeable s-    => (∀ x m. e m x -> LS.StateT s (Semantic r) x)+    :: (∀ x m. e m x -> LS.StateT s (Sem r) x)     -> s-    -> Semantic (e ': r) a-    -> Semantic r (s, a)-interpretInLazyStateT f s (Semantic m) = Semantic $ \k ->+    -> Sem (e ': r) a+    -> Sem r (s, a)+interpretInLazyStateT f s (Sem m) = Sem $ \k ->   fmap swap $ flip LS.runStateT s $ m $ \u ->     case decomp u of         Left x -> LS.StateT $ \s' ->@@ -106,17 +103,16 @@             . weave (s', ()) (uncurry $ interpretInLazyStateT_b f)             $ x         Right (Yo e z _ y) ->-          fmap (y . (<$ z)) $ LS.mapStateT (usingSemantic k) $ f e+          fmap (y . (<$ z)) $ LS.mapStateT (usingSem k) $ f e {-# INLINE interpretInLazyStateT #-}  ------------------------------------------------------------------------------ -- | Like 'interpret', but with access to an intermediate state @s@. stateful-    :: Typeable s-    => (∀ x m. e m x -> s -> Semantic r (s, x))+    :: (∀ x m. e m x -> s -> Sem r (s, x))     -> s-    -> Semantic (e ': r) a-    -> Semantic r (s, a)+    -> Sem (e ': r) a+    -> Sem r (s, a) stateful f = interpretInStateT $ \e -> S.StateT $ fmap swap . f e {-# INLINE[3] stateful #-} @@ -124,11 +120,10 @@ ------------------------------------------------------------------------------ -- | Like 'interpret', but with access to an intermediate state @s@. lazilyStateful-    :: Typeable s-    => (∀ x m. e m x -> s -> Semantic r (s, x))+    :: (∀ x m. e m x -> s -> Sem r (s, x))     -> s-    -> Semantic (e ': r) a-    -> Semantic r (s, a)+    -> Sem (e ': r) a+    -> Sem r (s, a) lazilyStateful f = interpretInLazyStateT $ \e -> LS.StateT $ fmap swap . f e {-# INLINE[3] lazilyStateful #-} @@ -140,13 +135,13 @@ reinterpretH     :: (∀ m x. e1 m x -> Tactical e1 m (e2 ': r) x)        -- ^ A natural transformation from the handled effect to the new effect.-    -> Semantic (e1 ': r) a-    -> Semantic (e2 ': r) a-reinterpretH f (Semantic m) = Semantic $ \k -> m $ \u ->+    -> Sem (e1 ': r) a+    -> Sem (e2 ': r) a+reinterpretH f (Sem m) = Sem $ \k -> m $ \u ->   case decompCoerce u of     Left x  -> k $ hoist (reinterpretH_b f) $ x     Right (Yo e s d y) -> do-      a <- usingSemantic k $ runTactics s (raise . reinterpretH_b f . d) $ f e+      a <- usingSem k $ runTactics s (raise . reinterpretH_b f . d) $ f e       pure $ y a {-# INLINE[3] reinterpretH #-} -- TODO(sandy): Make this fuse in with 'stateful' directly.@@ -159,10 +154,10 @@ -- the 'Polysemy.State.State' effect and immediately run it. reinterpret     :: FirstOrder e1 "reinterpret"-    => (∀ m x. e1 m x -> Semantic (e2 ': r) x)+    => (∀ m x. e1 m x -> Sem (e2 ': r) x)        -- ^ A natural transformation from the handled effect to the new effect.-    -> Semantic (e1 ': r) a-    -> Semantic (e2 ': r) a+    -> Sem (e1 ': r) a+    -> Sem (e2 ': r) a reinterpret f = reinterpretH $ \(e :: e m x) -> liftT @m $ f e {-# INLINE[3] reinterpret #-} -- TODO(sandy): Make this fuse in with 'stateful' directly.@@ -175,13 +170,13 @@ reinterpret2H     :: (∀ m x. e1 m x -> Tactical e1 m (e2 ': e3 ': r) x)        -- ^ A natural transformation from the handled effect to the new effects.-    -> Semantic (e1 ': r) a-    -> Semantic (e2 ': e3 ': r) a-reinterpret2H f (Semantic m) = Semantic $ \k -> m $ \u ->+    -> Sem (e1 ': r) a+    -> Sem (e2 ': e3 ': r) a+reinterpret2H f (Sem m) = Sem $ \k -> m $ \u ->   case decompCoerce u of     Left x  -> k $ weaken $ hoist (reinterpret2H_b f) $ x     Right (Yo e s d y) -> do-      a <- usingSemantic k $ runTactics s (raise . reinterpret2H_b f . d) $ f e+      a <- usingSem k $ runTactics s (raise . reinterpret2H_b f . d) $ f e       pure $ y a {-# INLINE[3] reinterpret2H #-} @@ -190,10 +185,10 @@ -- | Like 'reinterpret', but introduces /two/ intermediary effects. reinterpret2     :: FirstOrder e1 "reinterpret2"-    => (∀ m x. e1 m x -> Semantic (e2 ': e3 ': r) x)+    => (∀ m x. e1 m x -> Sem (e2 ': e3 ': r) x)        -- ^ A natural transformation from the handled effect to the new effects.-    -> Semantic (e1 ': r) a-    -> Semantic (e2 ': e3 ': r) a+    -> Sem (e1 ': r) a+    -> Sem (e2 ': e3 ': r) a reinterpret2 f = reinterpret2H $ \(e :: e m x) -> liftT @m $ f e {-# INLINE[3] reinterpret2 #-} @@ -205,13 +200,13 @@ reinterpret3H     :: (∀ m x. e1 m x -> Tactical e1 m (e2 ': e3 ': e4 ': r) x)        -- ^ A natural transformation from the handled effect to the new effects.-    -> Semantic (e1 ': r) a-    -> Semantic (e2 ': e3 ': e4 ': r) a-reinterpret3H f (Semantic m) = Semantic $ \k -> m $ \u ->+    -> Sem (e1 ': r) a+    -> Sem (e2 ': e3 ': e4 ': r) a+reinterpret3H f (Sem m) = Sem $ \k -> m $ \u ->   case decompCoerce u of     Left x  -> k . weaken . weaken . hoist (reinterpret3H_b f) $ x     Right (Yo e s d y) -> do-      a <- usingSemantic k $ runTactics s (raise . reinterpret3H_b f . d) $ f e+      a <- usingSem k $ runTactics s (raise . reinterpret3H_b f . d) $ f e       pure $ y a {-# INLINE[3] reinterpret3H #-} @@ -220,10 +215,10 @@ -- | Like 'reinterpret', but introduces /three/ intermediary effects. reinterpret3     :: FirstOrder e1 "reinterpret3"-    => (∀ m x. e1 m x -> Semantic (e2 ': e3 ': e4 ': r) x)+    => (∀ m x. e1 m x -> Sem (e2 ': e3 ': e4 ': r) x)        -- ^ A natural transformation from the handled effect to the new effects.-    -> Semantic (e1 ': r) a-    -> Semantic (e2 ': e3 ': e4 ': r) a+    -> Sem (e1 ': r) a+    -> Sem (e2 ': e3 ': e4 ': r) a reinterpret3 f = reinterpret3H $ \(e :: e m x) -> liftT @m $ f e {-# INLINE[3] reinterpret3 #-} @@ -236,12 +231,12 @@     :: ( Member e r        , FirstOrder e "intercept"        )-    => (∀ x m. e m x -> Semantic r x)+    => (∀ x m. e m x -> Sem r x)        -- ^ A natural transformation from the handled effect to other effects-       -- already in 'Semantic'.-    -> Semantic r a+       -- already in 'Sem'.+    -> Sem r a        -- ^ Unlike 'interpret', 'intercept' does not consume any effects.-    -> Semantic r a+    -> Sem r a intercept f = interceptH $ \(e :: e m x) -> liftT @m $ f e {-# INLINE intercept #-} @@ -254,14 +249,14 @@     :: Member e r     => (∀ x m. e m x -> Tactical e m r x)        -- ^ A natural transformation from the handled effect to other effects-       -- already in 'Semantic'.-    -> Semantic r a+       -- already in 'Sem'.+    -> Sem r a        -- ^ Unlike 'interpretH', 'interceptH' does not consume any effects.-    -> Semantic r a-interceptH f (Semantic m) = Semantic $ \k -> m $ \u ->+    -> Sem r a+interceptH f (Sem m) = Sem $ \k -> m $ \u ->   case prj u of     Just (Yo e s d y) ->-      usingSemantic k $ fmap y $ runTactics s (raise . d) $ f e+      usingSem k $ fmap y $ runTactics s (raise . d) $ f e     Nothing -> k u {-# INLINE interceptH #-} @@ -270,52 +265,50 @@ -- Loop breakers interpretH_b     :: (∀ x m . e m x -> Tactical e m r x)-    -> Semantic (e ': r) a-    -> Semantic r a+    -> Sem (e ': r) a+    -> Sem r a interpretH_b = interpretH {-# NOINLINE interpretH_b #-}   interpretInStateT_b-    :: Typeable s-    => (∀ x m. e m x -> S.StateT s (Semantic r) x)+    :: (∀ x m. e m x -> S.StateT s (Sem r) x)     -> s-    -> Semantic (e ': r) a-    -> Semantic r (s, a)+    -> Sem (e ': r) a+    -> Sem r (s, a) interpretInStateT_b = interpretInStateT {-# NOINLINE interpretInStateT_b #-}   interpretInLazyStateT_b-    :: Typeable s-    => (∀ x m. e m x -> LS.StateT s (Semantic r) x)+    :: (∀ x m. e m x -> LS.StateT s (Sem r) x)     -> s-    -> Semantic (e ': r) a-    -> Semantic r (s, a)+    -> Sem (e ': r) a+    -> Sem r (s, a) interpretInLazyStateT_b = interpretInLazyStateT {-# NOINLINE interpretInLazyStateT_b #-}   reinterpretH_b     :: (∀ m x. e1 m x -> Tactical e1 m (e2 ': r) x)-    -> Semantic (e1 ': r) a-    -> Semantic (e2 ': r) a+    -> Sem (e1 ': r) a+    -> Sem (e2 ': r) a reinterpretH_b = reinterpretH {-# NOINLINE reinterpretH_b #-}   reinterpret2H_b     :: (∀ m x. e1 m x -> Tactical e1 m (e2 ': e3 ': r) x)-    -> Semantic (e1 ': r) a-    -> Semantic (e2 ': e3 ': r) a+    -> Sem (e1 ': r) a+    -> Sem (e2 ': e3 ': r) a reinterpret2H_b = reinterpret2H {-# NOINLINE reinterpret2H_b #-}   reinterpret3H_b     :: (∀ m x. e1 m x -> Tactical e1 m (e2 ': e3 ': e4 ': r) x)-    -> Semantic (e1 ': r) a-    -> Semantic (e2 ': e3 ': e4 ': r) a+    -> Sem (e1 ': r) a+    -> Sem (e2 ': e3 ': e4 ': r) a reinterpret3H_b = reinterpret3H {-# NOINLINE reinterpret3H_b #-} 

@@ -5,19 +5,15 @@  import Data.Coerce import Data.Functor.Identity-import Data.Kind (Constraint)-import Data.Typeable  -type Typeable1 f = (∀ y. Typeable y => Typeable (f y) :: Constraint)- ------------------------------------------------------------------------------ -- | The class for semantic effects. -- -- An effect @e@ is a type @e m a@, where the other types are given by: -- -- * The @m@ type variable corresponds to a monad, which will eventually be--- instantiated at 'Polysemy.Semantic'---meaning it is capable of encoding+-- instantiated at 'Polysemy.Sem'---meaning it is capable of encoding -- arbitrary other effects. -- -- * The @a@ type is handled automatically and uninteresting.@@ -52,7 +48,7 @@   -- * If instead it is given the intial state, both computations will see the   -- same state, but the result of (at least) one will necessarily be ignored.   weave-      :: (Functor s, Functor m, Functor n, Typeable1 s, Typeable s)+      :: (Functor s, Functor m, Functor n)       => s ()       -> (∀ x. s (m x) -> n (s x))       -> e m a@@ -61,8 +57,6 @@   -- | When @e@ is first order, 'weave' can be given for free.   default weave       :: ( Coercible (e m (s a)) (e n (s a))-         , Typeable1 s-         , Typeable s          , Functor s          , Functor m          , Functor n

@@ -4,22 +4,22 @@   --------------------------------------------------------------------------------- | An effect which allows a regular 'Monad' @m@ into the 'Polysemy.Semantic'--- ecosystem. Monadic actions in @m@ can be lifted into 'Polysemy.Semantic' via+-- | An effect which allows a regular 'Monad' @m@ into the 'Polysemy.Sem'+-- ecosystem. Monadic actions in @m@ can be lifted into 'Polysemy.Sem' via -- 'Polysemy.sendM'. -- -- For example, you can use this effect to lift 'IO' actions directly into--- 'Polysemy.Semantic':+-- 'Polysemy.Sem': -- -- @--- 'Polysemy.sendM' (putStrLn "hello") :: 'Polysemy.Member' ('Polysemy.Lift' IO) r => 'Polysemy.Semantic' r ()+-- 'Polysemy.sendM' (putStrLn "hello") :: 'Polysemy.Member' ('Polysemy.Lift' IO) r => 'Polysemy.Sem' r () -- @ -- -- That being said, you lose out on a significant amount of the benefits of--- 'Polysemy.Semantic' by using 'sendM' directly in application code; doing so--- will tie your application code directly to the underlying monad, and prevent--- you from interpreting it differently. For best results, only use 'Lift' in--- your effect interpreters.+-- 'Polysemy.Sem' by using 'Polysemy.sendM' directly in application code; doing+-- so will tie your application code directly to the underlying monad, and+-- prevent you from interpreting it differently. For best results, only use+-- 'Lift' in your effect interpreters. -- -- Consider using 'Polysemy.Trace.trace' and 'Polysemy.Trace.runTraceIO' as -- a substitute for using 'putStrLn' directly.

@@ -15,22 +15,22 @@ data FileSystem m a where   ReadFile :: 'FilePath' -> FileSystem 'String'   WriteFile :: 'FilePath' -> 'String' -> FileSystem ()-'makeSemantic' ''FileSystem+'makeSem' ''FileSystem @  This will automatically generate the following functions:  @-readFile :: 'Member' FileSystem r => 'FilePath' -> 'Semantic' r 'String'+readFile :: 'Member' FileSystem r => 'FilePath' -> 'Sem' r 'String' readFile a = 'send' (ReadFile a) -writeFile :: 'Member' FileSystem r => 'FilePath' -> 'String' -> 'Semantic' r ()+writeFile :: 'Member' FileSystem r => 'FilePath' -> 'String' -> 'Sem' r () writeFile a b = 'send' (WriteFile a b) @ -} module Polysemy.Internal.TH.Effect-  ( makeSemantic-  , makeSemantic_+  ( makeSem+  , makeSem_   ) where @@ -39,17 +39,19 @@ import Data.List import Generics.SYB import Language.Haskell.TH-import Polysemy.Internal (send, Member, Semantic)+import Polysemy.Internal (send, Member, Sem) import Polysemy.Internal.CustomErrors (DefiningModule)   -- | If @T@ is a GADT representing an effect algebra, as described in the module--- documentation for "Polysemy", @$('makeSemantic' ''T)@ automatically+-- documentation for "Polysemy", @$('makeSem' ''T)@ automatically -- generates a smart constructor for every data constructor of @T@.-makeSemantic :: Name -> Q [Dec]-makeSemantic = genFreer True+--+-- @since 0.1.2.0+makeSem :: Name -> Q [Dec]+makeSem = genFreer True --- | Like 'makeSemantic', but does not provide type signatures. This can be used+-- | Like 'makeSem', but does not provide type signatures. This can be used -- to attach Haddock comments to individual arguments for each generated -- function. --@@ -57,25 +59,27 @@ -- data Lang m a where --   Output :: String -> Lang () ----- makeSemantic_ ''Lang+-- makeSem_ ''Lang -- -- -- | Output a string. -- output :: Member Lang r --        => String         -- ^ String to output.---        -> Semantic r ()  -- ^ No result.+--        -> Sem r ()  -- ^ No result. -- @ ----- Note that 'makeEffect_' must be used /before/ the explicit type signatures.-makeSemantic_ :: Name -> Q [Dec]-makeSemantic_ = genFreer False+-- Note that 'makeSem_' must be used /before/ the explicit type signatures.+--+-- @since 0.1.2.0+makeSem_ :: Name -> Q [Dec]+makeSem_ = genFreer False  -- | Generates declarations and possibly signatures for functions to lift GADT--- constructors into 'Semantic' actions.+-- constructors into 'Sem' actions. genFreer :: Bool -> Name -> Q [Dec] genFreer makeSigs tcName = do   -- The signatures for the generated definitions require FlexibleContexts.   isExtEnabled FlexibleContexts-    >>= flip unless (fail "makeSemantic requires FlexibleContexts to be enabled")+    >>= flip unless (fail "makeSem requires FlexibleContexts to be enabled")   hasTyFams <- isExtEnabled TypeFamilies    reify tcName >>= \case@@ -93,7 +97,7 @@         | hasTyFams         ] ++ sigs ++ decs -    _ -> fail "makeSemantic expects a type constructor"+    _ -> fail "makeSem expects a type constructor"  -- | Given the name of a GADT constructor, return the name of the corresponding -- lifted function.@@ -132,7 +136,7 @@ tyVarBndrKind (KindedTV _ k) = Just k  -- | Generates a function type from the corresponding GADT type constructor--- @x :: Member (Effect e) r => a -> b -> c -> Semantic r r@.+-- @x :: Member (Effect e) r => a -> b -> c -> Sem r r@. genType :: Con -> Q (Type, Maybe Name, Maybe Type) genType (ForallC tyVarBindings conCtx con) = do   (t, mn, _) <- genType con@@ -149,9 +153,9 @@   let     tArgs            = fmap snd tArgs'     memberConstraint = ConT ''Member `AppT` eff `AppT` VarT r-    resultType       = ConT ''Semantic `AppT` VarT r `AppT` tRet+    resultType       = ConT ''Sem `AppT` VarT r `AppT` tRet -    replaceMType t | t == m = ConT ''Semantic `AppT` VarT r+    replaceMType t | t == m = ConT ''Sem `AppT` VarT r                    | otherwise = t     ts = everywhere (mkT replaceMType) tArgs     tn = case tRet of@@ -180,7 +184,7 @@ simplifyBndr _ bndr = bndr  -- | Generates a type signature of the form--- @x :: Member (Effect e) r => a -> b -> c -> Semantic r r@.+-- @x :: Member (Effect e) r => a -> b -> c -> Sem r r@. genSig :: Con -> Q Dec genSig con = do   let

@@ -23,7 +23,7 @@ -- -- @ -- 'inlineRecursiveCalls' [d|---   'Polysemy.Reader.runReader' :: i -> 'Polysemy.Semantic' ('Polysemy.Reader.Reader' i ': r) a -> 'Polysemy.Semantic' r a+--   'Polysemy.Reader.runReader' :: i -> 'Polysemy.Sem' ('Polysemy.Reader.Reader' i ': r) a -> 'Polysemy.Sem' r a --   'Polysemy.Reader.runReader' i = 'Polysemy.interpretH' $ \\case --     'Polysemy.Reader.Ask' -> 'Polysemy.pureT' i --     'Polysemy.Reader.Local' f m -> do

@@ -49,9 +49,9 @@ -- where -- -- @--- alloc'   ::         'Polysemy.Semantic' ('Polysemy.Resource.Resource' ': r) (f a1)--- dealloc' :: f a1 -> 'Polysemy.Semantic' ('Polysemy.Resource.Resource' ': r) (f ())--- use'     :: f a1 -> 'Polysemy.Semantic' ('Polysemy.Resource.Resource' ': r) (f x)+-- alloc'   ::         'Polysemy.Sem' ('Polysemy.Resource.Resource' ': r) (f a1)+-- dealloc' :: f a1 -> 'Polysemy.Sem' ('Polysemy.Resource.Resource' ': r) (f ())+-- use'     :: f a1 -> 'Polysemy.Sem' ('Polysemy.Resource.Resource' ': r) (f x) -- @ -- -- The @f@ type here is existential and corresponds to "whatever@@ -69,21 +69,21 @@ -- -- Power users may explicitly use 'getInitialStateT' and 'bindT' to construct -- whatever data flow they'd like; although this is usually unnecessary.-type Tactical e m r x = ∀ f. (Functor f, Typeable1 f)-                          => Semantic (WithTactics e f m r) (f x)+type Tactical e m r x = ∀ f. Functor f+                          => Sem (WithTactics e f m r) (f x)  type WithTactics e f m r = Tactics f m (e ': r) ': r  data Tactics f n r m a where   GetInitialState     :: Tactics f n r m (f ())-  HoistInterpretation :: (a -> n b) -> Tactics f n r m (f a -> Semantic r (f b))+  HoistInterpretation :: (a -> n b) -> Tactics f n r m (f a -> Sem r (f b))   ------------------------------------------------------------------------------ -- | Get the stateful environment of the world at the moment the effect @e@ is -- to be run. Prefer 'pureT', 'runT' or 'bindT' instead of using this function -- directly.-getInitialStateT :: forall f m r e. Semantic (WithTactics e f m r) (f ())+getInitialStateT :: forall f m r e. Sem (WithTactics e f m r) (f ()) getInitialStateT = send @(Tactics _ m (e ': r)) GetInitialState  @@ -103,8 +103,8 @@     :: m a       -- ^ The monadic action to lift. This is usually a parameter in your       -- effect.-    -> Semantic (WithTactics e f m r)-                (Semantic (e ': r) (f a))+    -> Sem (WithTactics e f m r)+                (Sem (e ': r) (f a)) runT na = do   istate <- getInitialStateT   na'    <- bindT (const na)@@ -122,9 +122,9 @@        -- your effect.        --        -- Continuations lifted via 'bindT' will run in the same environment-       -- which produced the 'a'.-    -> Semantic (WithTactics e f m r)-                (f a -> Semantic (e ': r) (f b))+       -- which produced the @a@.+    -> Sem (WithTactics e f m r)+                (f a -> Sem (e ': r) (f b)) bindT f = send $ HoistInterpretation f {-# INLINE bindT #-} @@ -134,11 +134,9 @@ -- higher-order ones. liftT     :: forall m f r e a-     . ( Functor f-       , Typeable1 f-       )-    => Semantic r a-    -> Semantic (WithTactics e f m r) (f a)+     . Functor f+    => Sem r a+    -> Sem (WithTactics e f m r) (f a) liftT m = do   a <- raise m   pureT a@@ -150,12 +148,12 @@ runTactics    :: Functor f    => f ()-   -> (∀ x. f (m x) -> Semantic r2 (f x))-   -> Semantic (Tactics f m r2 ': r) a-   -> Semantic r a-runTactics s d (Semantic m) = m $ \u ->+   -> (∀ x. f (m x) -> Sem r2 (f x))+   -> Sem (Tactics f m r2 ': r) a+   -> Sem r a+runTactics s d (Sem m) = m $ \u ->   case decomp u of-    Left x -> liftSemantic $ hoist (runTactics_b s d) x+    Left x -> liftSem $ hoist (runTactics_b s d) x     Right (Yo GetInitialState s' _ y) ->       pure $ y $ s <$ s'     Right (Yo (HoistInterpretation na) s' _ y) -> do@@ -166,9 +164,9 @@ runTactics_b    :: Functor f    => f ()-   -> (∀ x. f (m x) -> Semantic r2 (f x))-   -> Semantic (Tactics f m r2 ': r) a-   -> Semantic r a+   -> (∀ x. f (m x) -> Sem r2 (f x))+   -> Sem (Tactics f m r2 ': r) a+   -> Sem r a runTactics_b = runTactics {-# NOINLINE runTactics_b #-} 

@@ -52,7 +52,7 @@   data Yo e m a where-  Yo :: (Functor f, Typeable1 f, Typeable f)+  Yo :: Functor f      => e m a      -> f ()      -> (forall x. f (m x) -> n (f x))@@ -98,8 +98,8 @@   --------------------------------------------------------------------------------- | A proof that the effect 'e' is available somewhere inside of the effect--- stack 'r'.+-- | A proof that the effect @e@ is available somewhere inside of the effect+-- stack @r@. type Member e r = Member' e r  type Member' e r =

@@ -54,8 +54,8 @@  ------------------------------------------------------------------------------ -- | Run a 'NonDet' effect in terms of some underlying 'Alternative' @f@.-runNonDet :: Alternative f => Semantic (NonDet ': r) a -> Semantic r (f a)-runNonDet (Semantic m) = Semantic $ \k -> runNonDetC $ m $ \u ->+runNonDet :: Alternative f => Sem (NonDet ': r) a -> Sem r (f a)+runNonDet (Sem m) = Sem $ \k -> runNonDetC $ m $ \u ->   case decomp u of     Left x  -> NonDetC $ \cons nil -> do       z <- k $ weave [()] (fmap concat . traverse runNonDet) x

@@ -11,6 +11,7 @@     -- * Interpretations   , runFoldMapOutput   , runIgnoringOutput+  , runBatchOutput   ) where  import Polysemy@@ -23,26 +24,62 @@ data Output o m a where   Output :: o -> Output o m () -makeSemantic ''Output+makeSem ''Output   ------------------------------------------------------------------------------ -- | Run an 'Output' effect by transforming it into a monoid. runFoldMapOutput     :: forall o m r a-     . (Typeable m, Monoid m)+     . Monoid m     => (o -> m)-    -> Semantic (Output o ': r) a-    -> Semantic r (m, a)+    -> Sem (Output o ': r) a+    -> Sem r (m, a) runFoldMapOutput f = runState mempty . reinterpret \case   Output o -> modify (<> f o) {-# INLINE runFoldMapOutput #-}   --------------------------------------------------------------------------------- | Run an 'Ouput' effect by ignoring it.-runIgnoringOutput :: Semantic (Output o ': r) a -> Semantic r a+-- | Run an 'Output' effect by ignoring it.+runIgnoringOutput :: Sem (Output o ': r) a -> Sem r a runIgnoringOutput = interpret \case   Output _ -> pure () {-# INLINE runIgnoringOutput #-}+++------------------------------------------------------------------------------+-- | Accumulate 'output's so they are delayed until they reach at least size+-- @size@.+--+-- If @size@ is 0, this interpretation will not emit anything in the resulting+-- 'Output' effect.+--+-- @since 0.1.2.0+runBatchOutput+    :: forall o r a+     . Int+    -> Sem (Output [o] ': r) a+    -> Sem (Output [[o]] ': r) a+runBatchOutput 0 m = raise $ runIgnoringOutput m+runBatchOutput size m = do+  ((_, res), a) <-+    runState (0 :: Int, [] :: [o]) $ reinterpret2 (\case+      Output o -> do+        (nacc, acc) <- get+        let no     = length o+            total  = acc <> o+            ntotal = nacc + no++            emitting n ls+              | n >= size = do+                  let (emit, acc') = splitAt size ls+                  output [emit]+                  emitting (n - size) acc'+              | otherwise = pure (n, ls)+        (nacc', acc') <- emitting ntotal total+        put (nacc', acc')+    ) m+  output [res]+  pure a 

@@ -24,19 +24,17 @@   Random :: R.Random x => Random m x   RandomR :: R.Random x => (x, x) -> Random m x -makeSemantic ''Random+makeSem ''Random   ------------------------------------------------------------------------------ -- | Run a 'Random' effect with an explicit 'R.RandomGen'. runRandom     :: forall q r a-     . ( Typeable q-       , R.RandomGen q-       )+     . R.RandomGen q     => q-    -> Semantic (Random ': r) a-    -> Semantic r (q, a)+    -> Sem (Random ': r) a+    -> Sem r (q, a) runRandom q = runState q . reinterpret \case   Random -> do     ~(a, q') <- gets @q R.random@@ -51,7 +49,7 @@  ------------------------------------------------------------------------------ -- | Run a 'Random' effect by using the 'IO' random generator.-runRandomIO :: Member (Lift IO) r => Semantic (Random ': r) a -> Semantic r a+runRandomIO :: Member (Lift IO) r => Sem (Random ': r) a -> Sem r a runRandomIO m = do   q <- sendM R.newStdGen   snd <$> runRandom q m

@@ -11,6 +11,8 @@      -- * Interpretations   , runReader++    -- * Interpretations for Other Effects   , runInputAsReader   ) where @@ -24,17 +26,17 @@   Ask   :: Reader i m i   Local :: (i -> i) -> m a -> Reader i m a -makeSemantic ''Reader+makeSem ''Reader  -asks :: Member (Reader i) r => (i -> j) -> Semantic r j+asks :: Member (Reader i) r => (i -> j) -> Sem r j asks f = f <$> ask {-# INLINABLE asks #-}   ------------------------------------------------------------------------------ -- | Run a 'Reader' effect with a constant value.-runReader :: i -> Semantic (Reader i ': r) a -> Semantic r a+runReader :: i -> Sem (Reader i ': r) a -> Sem r a runReader i = interpretH $ \case   Ask -> pureT i   Local f m -> do@@ -42,15 +44,15 @@     raise $ runReader_b (f i) mm {-# INLINE runReader #-} -runReader_b :: i -> Semantic (Reader i ': r) a -> Semantic r a+runReader_b :: i -> Sem (Reader i ': r) a -> Sem r a runReader_b = runReader {-# NOINLINE runReader_b #-}   ------------------------------------------------------------------------------ -- | Transform an 'Input' effect into a 'Reader' effect.-runInputAsReader :: Semantic (Input i ': r) a -> Semantic (Reader i ': r) a-runInputAsReader = reinterpret $ \case+runInputAsReader :: Member (Reader i) r => Sem (Input i ': r) a -> Sem r a+runInputAsReader = interpret $ \case   Input -> ask {-# INLINE runInputAsReader #-} 

@@ -16,7 +16,7 @@   --------------------------------------------------------------------------------- | An effect capable of providing 'X.bracket' semantic. Interpreters for this+-- | An effect capable of providing 'X.bracket' semantics. Interpreters for this -- will successfully run the deallocation action even in the presence of other -- short-circuiting effects. data Resource m a where@@ -30,7 +30,7 @@        -- ^ Action which uses the resource.     -> Resource m b -makeSemantic ''Resource+makeSem ''Resource   ------------------------------------------------------------------------------@@ -38,19 +38,18 @@ runResource     :: forall r a      . Member (Lift IO) r-    => (∀ x. Semantic r x -> IO x)-       -- ^ Strategy for lowering a 'Semantic' action down to 'IO'. This is-       -- likely some combination of 'runM' and other interpters composed via-       -- '.@'.-    -> Semantic (Resource ': r) a-    -> Semantic r a+    => (∀ x. Sem r x -> IO x)+       -- ^ Strategy for lowering a 'Sem' action down to 'IO'. This is likely+       -- some combination of 'runM' and other interpreters composed via '.@'.+    -> Sem (Resource ': r) a+    -> Sem r a runResource finish = interpretH $ \case   Bracket alloc dealloc use -> do     a <- runT  alloc     d <- bindT dealloc     u <- bindT use -    let runIt :: Semantic (Resource ': r) x -> IO x+    let runIt :: Sem (Resource ': r) x -> IO x         runIt = finish .@ runResource      sendM $ X.bracket (runIt a) (runIt . d) (runIt . u)

@@ -13,8 +13,10 @@     -- * Interpretations   , runState   , runLazyState+  , runStateInIORef   ) where +import Data.IORef import Polysemy import Polysemy.Internal.Combinators @@ -31,15 +33,15 @@   Get :: State s m s   Put :: s -> State s m () -makeSemantic ''State+makeSem ''State  -gets :: Member (State s) r => (s -> a) -> Semantic r a+gets :: Member (State s) r => (s -> a) -> Sem r a gets f = fmap f get {-# INLINABLE gets #-}  -modify :: Member (State s) r => (s -> s) -> Semantic r ()+modify :: Member (State s) r => (s -> s) -> Sem r () modify f = do   s <- get   put $ f s@@ -48,7 +50,7 @@  ------------------------------------------------------------------------------ -- | Run a 'State' effect with local state.-runState :: Typeable s => s -> Semantic (State s ': r) a -> Semantic r (s, a)+runState :: s -> Sem (State s ': r) a -> Sem r (s, a) runState = stateful $ \case   Get   -> \s -> pure (s, s)   Put s -> const $ pure (s, ())@@ -57,20 +59,36 @@  ------------------------------------------------------------------------------ -- | Run a 'State' effect with local state, lazily.-runLazyState :: Typeable s => s -> Semantic (State s ': r) a -> Semantic r (s, a)+runLazyState :: s -> Sem (State s ': r) a -> Sem r (s, a) runLazyState = lazilyStateful $ \case   Get   -> \s -> pure (s, s)   Put s -> const $ pure (s, ()) {-# INLINE[3] runLazyState #-}  +------------------------------------------------------------------------------+-- | Run a 'State' effect by transforming it into operations over an 'IORef'.+--+-- @since 0.1.2.0+runStateInIORef+    :: forall s r a+     . Member (Lift IO) r+    => IORef s+    -> Sem (State s ': r) a+    -> Sem r a+runStateInIORef ref = interpret $ \case+  Get   -> sendM $ readIORef ref+  Put s -> sendM $ writeIORef ref s+{-# INLINE runStateInIORef #-}++ {-# RULES "runState/reinterpret"-   forall s e (f :: forall m x. e m x -> Semantic (State s ': r) x).+   forall s e (f :: forall m x. e m x -> Sem (State s ': r) x).      runState s (reinterpret f e) = stateful (\x s' -> runState s' $ f x) s e      #-}  {-# RULES "runLazyState/reinterpret"-   forall s e (f :: forall m x. e m x -> Semantic (State s ': r) x).+   forall s e (f :: forall m x. e m x -> Sem (State s ': r) x).      runLazyState s (reinterpret f e) = lazilyStateful (\x s' -> runLazyState s' $ f x) s e      #-} 

@@ -11,6 +11,9 @@   , runTraceIO   , runIgnoringTrace   , runTraceAsOutput++    -- * Interpretations for Other Effects+  , runOutputAsTrace   ) where  import Polysemy@@ -22,12 +25,12 @@ data Trace m a where   Trace :: String -> Trace m () -makeSemantic ''Trace+makeSem ''Trace   ------------------------------------------------------------------------------ -- | Run a 'Trace' effect by printing the messages to stdout.-runTraceIO :: Member (Lift IO) r => Semantic (Trace ': r) a -> Semantic r a+runTraceIO :: Member (Lift IO) r => Sem (Trace ': r) a -> Sem r a runTraceIO = interpret $ \case   Trace m -> sendM $ putStrLn m {-# INLINE runTraceIO #-}@@ -35,7 +38,7 @@  ------------------------------------------------------------------------------ -- | Run a 'Trace' effect by ignoring all of its messages.-runIgnoringTrace :: Member (Lift IO) r => Semantic (Trace ': r) a -> Semantic r a+runIgnoringTrace :: Member (Lift IO) r => Sem (Trace ': r) a -> Sem r a runIgnoringTrace = interpret $ \case   Trace _ -> pure () {-# INLINE runIgnoringTrace #-}@@ -43,8 +46,25 @@  ------------------------------------------------------------------------------ -- | Transform a 'Trace' effect into a 'Output' 'String' effect.-runTraceAsOutput :: Semantic (Trace ': r) a -> Semantic (Output String ': r) a-runTraceAsOutput = reinterpret $ \case+runTraceAsOutput+    :: Member (Output String) r+    => Sem (Trace ': r) a+    -> Sem r a+runTraceAsOutput = interpret $ \case   Trace m -> output m {-# INLINE runTraceAsOutput #-}++------------------------------------------------------------------------------+-- | Transform a 'Trace' effect into a 'Output' 'String' effect.+--+-- @since 0.1.2.0+runOutputAsTrace+    :: ( Show w+       , Member Trace r+       )+    => Sem (Output w ': r) a+    -> Sem r a+runOutputAsTrace = interpret $ \case+  Output m -> trace $ show m+{-# INLINE runOutputAsTrace #-} 

@@ -12,8 +12,10 @@   , censor      -- * Interpretations-  , runOutputAsWriter   , runWriter++    -- * Interpretations for Other Effects+  , runOutputAsWriter   ) where  import Polysemy@@ -27,13 +29,13 @@   Listen :: ∀ o m a. m a -> Writer o m (o, a)   Censor :: (o -> o) -> m a -> Writer o m a -makeSemantic ''Writer+makeSem ''Writer   ------------------------------------------------------------------------------ -- | Transform an 'Output' effect into a 'Writer' effect.-runOutputAsWriter :: Semantic (Output o ': r) a -> Semantic (Writer o ': r) a-runOutputAsWriter = reinterpret \case+runOutputAsWriter :: Member (Writer o) r => Sem (Output o ': r) a -> Sem r a+runOutputAsWriter = interpret \case   Output o -> tell o {-# INLINE runOutputAsWriter #-} @@ -42,9 +44,9 @@ -- | Run a 'Writer' effect in the style of 'Control.Monad.Trans.Writer.WriterT' -- (but without the nasty space leak!) runWriter-    :: (Monoid o, Typeable o)-    => Semantic (Writer o ': r) a-    -> Semantic r (o, a)+    :: Monoid o+    => Sem (Writer o ': r) a+    -> Sem r (o, a) runWriter = runState mempty . reinterpretH \case   Tell o -> do     modify (<> o) >>= pureT

@@ -44,12 +44,12 @@       shouldSucceed $(inspectTest $ 'jank `doesNotUse` 'hoist)      it "who needs Sematic even?" $ do-      shouldSucceed $(inspectTest $ 'countDown `doesNotUse` 'Semantic)-      shouldSucceed $(inspectTest $ 'jank `doesNotUse` 'Semantic)-      shouldSucceed $(inspectTest $ 'tryIt `doesNotUse` 'Semantic)+      shouldSucceed $(inspectTest $ 'countDown `doesNotUse` 'Sem)+      shouldSucceed $(inspectTest $ 'jank `doesNotUse` 'Sem)+      shouldSucceed $(inspectTest $ 'tryIt `doesNotUse` 'Sem)  -go :: Semantic '[State Int] Int+go :: Sem '[State Int] Int go = do   n <- get   if n <= 0

@@ -0,0 +1,32 @@+module OutputSpec where++import Polysemy+import Polysemy.Output+import Data.Foldable+import Test.Hspec+++spec :: Spec+spec = do+  describe "runBatchOutput" $ do+    it "should return nothing at batch size 0" $ do+      let (ms, ()) = runOutput 0 $ output @[Int] [0..100]+      length ms `shouldBe` 0++    for_ (1 : [5..13] ++ [99..101]) $ \size -> do+      it ("should batch at size " ++ show size) $ do+          let (ms, ()) = runOutput size $ do+                output @[Int] [0]+                output @[Int] [1..4]+                output @[Int] [5..10]+                output @[Int] [11..12]+                output @[Int] [13..37]+                output @[Int] [38..99]+          length ms `shouldBe` (div 100 size + 1)+          length (head ms) `shouldBe` min size 100+          concat ms `shouldBe` [0..99]+++runOutput :: Int -> Sem '[Output [Int]] a -> ([[Int]], a)+runOutput size = run . runFoldMapOutput id . runBatchOutput size+