From de1607ea1b040e463b5ac1b2cf6e7fb7462bf0b1 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Mon, 15 Jul 2019 12:40:42 -0400 Subject: [PATCH] Rename everything and its grandmother (#175) --- README.md | 16 +++++------ bench/Poly.hs | 6 ++--- polysemy-plugin/ChangeLog.md | 2 +- polysemy-plugin/test/ExampleSpec.hs | 6 ++--- polysemy-plugin/test/PluginSpec.hs | 2 +- src/Polysemy/Async.hs | 22 ++++++++-------- src/Polysemy/Embed/Type.hs | 2 +- src/Polysemy/Error.hs | 16 +++++------ src/Polysemy/Input.hs | 24 ++++++++--------- src/Polysemy/Internal.hs | 12 ++++----- src/Polysemy/Output.hs | 41 +++++++++++++++-------------- src/Polysemy/Reader.hs | 8 +++--- src/Polysemy/Resource.hs | 30 ++++++++++----------- src/Polysemy/State.hs | 23 +++++++++++++--- src/Polysemy/Trace.hs | 40 ++++++++++++++-------------- src/Polysemy/Writer.hs | 9 ++++--- test/AlternativeSpec.hs | 8 +++--- test/AsyncSpec.hs | 4 +-- test/BracketSpec.hs | 6 ++--- test/InterceptSpec.hs | 2 +- test/OutputSpec.hs | 14 +++++----- test/TypeErrors.hs | 8 +++--- 22 files changed, 157 insertions(+), 144 deletions(-) diff --git a/README.md b/README.md index 75b0ce2..df7ebd7 100644 --- a/README.md +++ b/README.md @@ -91,15 +91,15 @@ data Teletype m a where makeSem ''Teletype -runTeletypeIO :: Member (Embed IO) r => Sem (Teletype ': r) a -> Sem r a -runTeletypeIO = interpret $ \case +teletypeToIO :: Member (Lift IO) r => Sem (Teletype ': r) a -> Sem r a +teletypeToIO = interpret $ \case ReadTTY -> embed getLine WriteTTY msg -> embed $ putStrLn msg runTeletypePure :: [String] -> Sem (Teletype ': r) a -> Sem r ([String], a) runTeletypePure i - = runFoldMapOutput pure -- For each WriteTTY in our program, consume an output by appending it to the list in a ([String], a) - . runListInput i -- Treat each element of our list of strings as a line of input + = runOutputMonoid pure -- For each WriteTTY in our program, consume an output by appending it to the list in a ([String], a) + . runInputList i -- Treat each element of our list of strings as a line of input . reinterpret2 \case -- Reinterpret our effect in terms of Input and Output ReadTTY -> maybe "" id <$> input WriteTTY msg -> output msg @@ -120,13 +120,9 @@ echoPure = flip runTeletypePure echo pureOutput :: [String] -> [String] pureOutput = fst . run . echoPure --- Now let's do things -echoIO :: Sem '[Embed IO] () -echoIO = runTeletypeIO echo - -- echo forever main :: IO () -main = runM echoIO +main = runM . teletypeToIO $ echo ``` @@ -157,7 +153,7 @@ program = catch @CustomException work $ \e -> writeTTY ("Caught " ++ show e) _ -> writeTTY input >> writeTTY "no exceptions" main :: IO (Either CustomException ()) -main = (runM .@ runResourceInIO .@@ runErrorInIO @CustomException) . runTeletypeIO $ program +main = (runM .@ lowerResource .@@ lowerError @CustomException) . teletypeToIO $ program ``` Easy. diff --git a/bench/Poly.hs b/bench/Poly.hs index e692672..bb64666 100644 --- a/bench/Poly.hs +++ b/bench/Poly.hs @@ -42,7 +42,7 @@ prog = catch @Bool (throw True) (pure . not) zoinks :: IO (Either Bool Bool) zoinks = fmap (fmap snd) - . (runM .@ runResourceInIO .@@ runErrorInIO) + . (runM .@ lowerResource .@@ lowerError) . runState False $ prog @@ -54,8 +54,8 @@ makeSem ''Console runConsoleBoring :: [String] -> Sem (Console ': r) a -> Sem r ([String], a) runConsoleBoring inputs - = runFoldMapOutput (:[]) - . runListInput inputs + = runOutputMonoid (:[]) + . runInputList inputs . reinterpret2 (\case ReadLine -> maybe "" id <$> input diff --git a/polysemy-plugin/ChangeLog.md b/polysemy-plugin/ChangeLog.md index 57887f1..f43553a 100644 --- a/polysemy-plugin/ChangeLog.md +++ b/polysemy-plugin/ChangeLog.md @@ -50,5 +50,5 @@ ## Unreleased changes -- Added `runErrorAsAnother` +- Added `mapError` diff --git a/polysemy-plugin/test/ExampleSpec.hs b/polysemy-plugin/test/ExampleSpec.hs index b728fcb..5710f65 100644 --- a/polysemy-plugin/test/ExampleSpec.hs +++ b/polysemy-plugin/test/ExampleSpec.hs @@ -16,8 +16,8 @@ data Teletype m a where makeSem ''Teletype -runTeletypeIO :: Member (Embed IO) r => Sem (Teletype ': r) a -> Sem r a -runTeletypeIO = interpret $ \case +teletypeToIO :: Member (Embed IO) r => Sem (Teletype ': r) a -> Sem r a +teletypeToIO = interpret $ \case ReadTTY -> embed getLine WriteTTY msg -> embed $ putStrLn msg @@ -33,7 +33,7 @@ program = catch @CustomException work $ \e -> writeTTY ("Caught " ++ show e) _ -> writeTTY i >> writeTTY "no exceptions" foo :: IO (Either CustomException ()) -foo = (runM .@ runResourceInIO .@@ runErrorInIO @CustomException) $ runTeletypeIO program +foo = (runM .@ lowerResource .@@ lowerError @CustomException) $ teletypeToIO program spec :: Spec spec = describe "example" $ do diff --git a/polysemy-plugin/test/PluginSpec.hs b/polysemy-plugin/test/PluginSpec.hs index 7683710..c4b0f89 100644 --- a/polysemy-plugin/test/PluginSpec.hs +++ b/polysemy-plugin/test/PluginSpec.hs @@ -131,7 +131,7 @@ spec = do describe "Output effect" $ do it "should unify recursively with tyvars" $ do - flipShouldBe 11 . sum . fst . run . runFoldMapOutput id $ do + flipShouldBe 11 . sum . fst . run . runOutputMonoid id $ do output [1] output $ replicate 2 5 diff --git a/src/Polysemy/Async.hs b/src/Polysemy/Async.hs index 9df8c4e..645ee60 100644 --- a/src/Polysemy/Async.hs +++ b/src/Polysemy/Async.hs @@ -9,8 +9,8 @@ module Polysemy.Async , await -- * Interpretations - , runAsync - , runAsyncInIO + , asyncToIO + , lowerAsync ) where import qualified Control.Concurrent.Async as A @@ -32,7 +32,7 @@ data Async m a where makeSem ''Async ------------------------------------------------------------------------------ --- | A more flexible --- though less performant --- version of 'runAsyncInIO'. +-- | A more flexible --- though less performant --- version of 'lowerAsync'. -- -- This function is capable of running 'Async' effects anywhere within an -- effect stack, without relying on an explicit function to lower it into 'IO'. @@ -40,22 +40,22 @@ makeSem ''Async -- in the presence of 'Async'. -- -- @since 0.5.0.0 -runAsync +asyncToIO :: LastMember (Embed IO) r => Sem (Async ': r) a -> Sem r a -runAsync m = withLowerToIO $ \lower _ -> lower $ +asyncToIO m = withLowerToIO $ \lower _ -> lower $ interpretH ( \case Async a -> do ma <- runT a ins <- getInspectorT - fa <- embed $ A.async $ lower $ runAsync ma + fa <- embed $ A.async $ lower $ asyncToIO ma pureT $ fmap (inspect ins) fa Await a -> pureT =<< embed (A.wait a) ) m -{-# INLINE runAsync #-} +{-# INLINE asyncToIO #-} ------------------------------------------------------------------------------ @@ -63,22 +63,22 @@ runAsync m = withLowerToIO $ \lower _ -> lower $ -- -- -- @since 0.5.0.0 -runAsyncInIO +lowerAsync :: Member (Embed IO) r => (forall 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 (Async ': r) a -> Sem r a -runAsyncInIO lower m = interpretH +lowerAsync lower m = interpretH ( \case Async a -> do ma <- runT a ins <- getInspectorT - fa <- embed $ A.async $ lower $ runAsyncInIO lower ma + fa <- embed $ A.async $ lower $ lowerAsync lower ma pureT $ fmap (inspect ins) fa Await a -> pureT =<< embed (A.wait a) ) m -{-# INLINE runAsyncInIO #-} +{-# INLINE lowerAsync #-} diff --git a/src/Polysemy/Embed/Type.hs b/src/Polysemy/Embed/Type.hs index 2ad6665..a7edae4 100644 --- a/src/Polysemy/Embed/Type.hs +++ b/src/Polysemy/Embed/Type.hs @@ -28,7 +28,7 @@ import Data.Kind -- prevent you from interpreting it differently. For best results, only use -- 'Embed' in your effect interpreters. -- --- Consider using 'Polysemy.Trace.trace' and 'Polysemy.Trace.runTraceIO' as +-- Consider using 'Polysemy.Trace.trace' and 'Polysemy.Trace.traceToIO' as -- a substitute for using 'putStrLn' directly. newtype Embed m (z :: Type -> Type) a where Embed :: { unEmbed :: m a } -> Embed m z a diff --git a/src/Polysemy/Error.hs b/src/Polysemy/Error.hs index a4fe8b2..f782c0c 100644 --- a/src/Polysemy/Error.hs +++ b/src/Polysemy/Error.hs @@ -12,8 +12,8 @@ module Polysemy.Error -- * Interpretations , runError - , runErrorAsAnother - , runErrorInIO + , mapError + , lowerError ) where import qualified Control.Exception as X @@ -97,13 +97,13 @@ runError (Sem m) = Sem $ \k -> E.runExceptT $ m $ \u -> -- multiple errors into a single type. -- -- @since 0.2.2.0 -runErrorAsAnother +mapError :: forall e1 e2 r a . Member (Error e2) r => (e1 -> e2) -> Sem (Error e1 ': r) a -> Sem r a -runErrorAsAnother f = interpretH $ \case +mapError f = interpretH $ \case Throw e -> throw $ f e Catch action handler -> do a <- runT action @@ -118,7 +118,7 @@ runErrorAsAnother f = interpretH $ \case case mx' of Right x -> pure x Left e' -> throw $ f e' -{-# INLINE runErrorAsAnother #-} +{-# INLINE mapError #-} newtype WrappedExc e = WrappedExc { unwrapExc :: e } @@ -133,7 +133,7 @@ instance (Typeable e) => X.Exception (WrappedExc e) ------------------------------------------------------------------------------ -- | Run an 'Error' effect as an 'IO' 'X.Exception'. This interpretation is -- significantly faster than 'runError', at the cost of being less flexible. -runErrorInIO +lowerError :: ( Typeable e , Member (Embed IO) r ) @@ -143,12 +143,12 @@ runErrorInIO -- '.@'. -> Sem (Error e ': r) a -> Sem r (Either e a) -runErrorInIO lower +lowerError lower = embed . fmap (first unwrapExc) . X.try . (lower .@ runErrorAsExc) -{-# INLINE runErrorInIO #-} +{-# INLINE lowerError #-} -- TODO(sandy): Can we use the new withLowerToIO machinery for this? diff --git a/src/Polysemy/Input.hs b/src/Polysemy/Input.hs index fd38817..b019302 100644 --- a/src/Polysemy/Input.hs +++ b/src/Polysemy/Input.hs @@ -8,9 +8,9 @@ module Polysemy.Input , input -- * Interpretations - , runConstInput - , runListInput - , runMonadicInput + , runInputConst + , runInputList + , runInputSem ) where import Data.Foldable (for_) @@ -29,33 +29,33 @@ makeSem ''Input ------------------------------------------------------------------------------ -- | Run an 'Input' effect by always giving back the same value. -runConstInput :: i -> Sem (Input i ': r) a -> Sem r a -runConstInput c = interpret $ \case +runInputConst :: i -> Sem (Input i ': r) a -> Sem r a +runInputConst c = interpret $ \case Input -> pure c -{-# INLINE runConstInput #-} +{-# INLINE runInputConst #-} ------------------------------------------------------------------------------ -- | Run an 'Input' effect by providing a different element of a list each -- time. Returns 'Nothing' after the list is exhausted. -runListInput +runInputList :: [i] -> Sem (Input (Maybe i) ': r) a -> Sem r a -runListInput is = fmap snd . runState is . reinterpret +runInputList is = fmap snd . runState is . reinterpret (\case Input -> do s <- gets uncons for_ s $ put . snd pure $ fmap fst s ) -{-# INLINE runListInput #-} +{-# INLINE runInputList #-} ------------------------------------------------------------------------------ -- | Runs an 'Input' effect by evaluating a monadic action for each request. -runMonadicInput :: forall i r a. Sem r i -> Sem (Input i ': r) a -> Sem r a -runMonadicInput m = interpret $ \case +runInputSem :: forall i r a. Sem r i -> Sem (Input i ': r) a -> Sem r a +runInputSem m = interpret $ \case Input -> m -{-# INLINE runMonadicInput #-} +{-# INLINE runInputSem #-} diff --git a/src/Polysemy/Internal.hs b/src/Polysemy/Internal.hs index e3316c8..896eb24 100644 --- a/src/Polysemy/Internal.hs +++ b/src/Polysemy/Internal.hs @@ -54,7 +54,7 @@ import Polysemy.Internal.Union -- interpretations (and others that you might add) may be used interchangably -- without needing to write any newtypes or 'Monad' instances. The only -- change needed to swap interpretations is to change a call from --- 'Polysemy.Error.runError' to 'Polysemy.Error.runErrorInIO'. +-- 'Polysemy.Error.runError' to 'Polysemy.Error.lowerError'. -- -- The effect stack @r@ can contain arbitrary other monads inside of it. These -- monads are lifted into effects via the 'Embed' effect. Monadic values can be @@ -335,13 +335,13 @@ runM (Sem m) = m $ \z -> ------------------------------------------------------------------------------ -- | Some interpreters need to be able to lower down to the base monad (often -- 'IO') in order to function properly --- some good examples of this are --- 'Polysemy.Error.runErrorInIO' and 'Polysemy.Resource.runResourceInIO'. +-- 'Polysemy.Error.lowerError' and 'Polysemy.Resource.lowerResource'. -- -- However, these interpreters don't compose particularly nicely; for example, --- to run 'Polysemy.Resource.runResourceInIO', you must write: +-- to run 'Polysemy.Resource.lowerResource', you must write: -- -- @ --- runM . runErrorInIO runM +-- runM . lowerError runM -- @ -- -- Notice that 'runM' is duplicated in two places here. The situation gets @@ -351,7 +351,7 @@ runM (Sem m) = m $ \z -> -- Instead, '.@' performs the composition we'd like. The above can be written as -- -- @ --- (runM .@ runErrorInIO) +-- (runM .@ lowerError) -- @ -- -- The parentheses here are important; without them you'll run into operator @@ -376,7 +376,7 @@ infixl 8 .@ ------------------------------------------------------------------------------ -- | Like '.@', but for interpreters which change the resulting type --- eg. --- 'Polysemy.Error.runErrorInIO'. +-- 'Polysemy.Error.lowerError'. (.@@) :: Monad m => (∀ x. Sem r x -> m x) diff --git a/src/Polysemy/Output.hs b/src/Polysemy/Output.hs index 38471e3..0c1ad14 100644 --- a/src/Polysemy/Output.hs +++ b/src/Polysemy/Output.hs @@ -8,10 +8,10 @@ module Polysemy.Output , output -- * Interpretations - , runOutputAsList - , runFoldMapOutput - , runIgnoringOutput - , runBatchOutput + , runOutputList + , runOutputMonoid + , ignoreOutput + , runOutputBatched ) where import Data.Bifunctor (first) @@ -31,37 +31,37 @@ makeSem ''Output ------------------------------------------------------------------------------ -- | Run an 'Output' effect by transforming it into a list of its values. -runOutputAsList +runOutputList :: forall o r a . Sem (Output o ': r) a -> Sem r ([o], a) -runOutputAsList = fmap (first reverse) . runState [] . reinterpret +runOutputList = fmap (first reverse) . runState [] . reinterpret (\case Output o -> modify (o :) ) -{-# INLINE runOutputAsList #-} +{-# INLINE runOutputList #-} ------------------------------------------------------------------------------ -- | Run an 'Output' effect by transforming it into a monoid. -runFoldMapOutput +runOutputMonoid :: forall o m r a . Monoid m => (o -> m) -> Sem (Output o ': r) a -> Sem r (m, a) -runFoldMapOutput f = runState mempty . reinterpret +runOutputMonoid f = runState mempty . reinterpret (\case Output o -> modify (`mappend` f o) ) -{-# INLINE runFoldMapOutput #-} +{-# INLINE runOutputMonoid #-} ------------------------------------------------------------------------------ -- | Run an 'Output' effect by ignoring it. -runIgnoringOutput :: Sem (Output o ': r) a -> Sem r a -runIgnoringOutput = interpret $ \case +ignoreOutput :: Sem (Output o ': r) a -> Sem r a +ignoreOutput = interpret $ \case Output _ -> pure () -{-# INLINE runIgnoringOutput #-} +{-# INLINE ignoreOutput #-} ------------------------------------------------------------------------------ @@ -72,15 +72,16 @@ runIgnoringOutput = interpret $ \case -- 'Output' effect. -- -- @since 0.1.2.0 -runBatchOutput +runOutputBatched :: forall o r a - . Int + . Member (Output [o]) r + => Int -> Sem (Output o ': r) a - -> Sem (Output [o] ': r) a -runBatchOutput 0 m = raise $ runIgnoringOutput m -runBatchOutput size m = do + -> Sem r a +runOutputBatched 0 m = ignoreOutput m +runOutputBatched size m = do ((c, res), a) <- - runState (0 :: Int, [] :: [o]) $ reinterpret2 (\case + runState (0 :: Int, [] :: [o]) $ reinterpret (\case Output o -> do (count, acc) <- get let newCount = 1 + count @@ -91,6 +92,6 @@ runBatchOutput size m = do output (reverse newAcc) put (0 :: Int, [] :: [o]) ) m - when (c > 0) $ output (reverse res) + when (c > 0) $ output @[o] (reverse res) pure a diff --git a/src/Polysemy/Reader.hs b/src/Polysemy/Reader.hs index 902a11c..c504dea 100644 --- a/src/Polysemy/Reader.hs +++ b/src/Polysemy/Reader.hs @@ -13,7 +13,7 @@ module Polysemy.Reader , runReader -- * Interpretations for Other Effects - , runInputAsReader + , inputToReader ) where import Polysemy @@ -47,8 +47,8 @@ runReader i = interpretH $ \case ------------------------------------------------------------------------------ -- | Transform an 'Input' effect into a 'Reader' effect. -runInputAsReader :: Member (Reader i) r => Sem (Input i ': r) a -> Sem r a -runInputAsReader = interpret $ \case +inputToReader :: Member (Reader i) r => Sem (Input i ': r) a -> Sem r a +inputToReader = interpret $ \case Input -> ask -{-# INLINE runInputAsReader #-} +{-# INLINE inputToReader #-} diff --git a/src/Polysemy/Resource.hs b/src/Polysemy/Resource.hs index b52df3f..0b471da 100644 --- a/src/Polysemy/Resource.hs +++ b/src/Polysemy/Resource.hs @@ -12,8 +12,8 @@ module Polysemy.Resource -- * Interpretations , runResource - , runResourceInIO - , runResourceBase + , lowerResource + , resourceToIO ) where import qualified Control.Exception as X @@ -79,7 +79,7 @@ onException act end = bracketOnError (pure ()) (const end) (const act) -- __Note:__ This function used to be called @runResource@ prior to 0.4.0.0. -- -- @since 0.4.0.0 -runResourceInIO +lowerResource :: ∀ r a . Member (Embed IO) r => (∀ x. Sem r x -> IO x) @@ -87,14 +87,14 @@ runResourceInIO -- some combination of 'runM' and other interpreters composed via '.@'. -> Sem (Resource ': r) a -> Sem r a -runResourceInIO finish = interpretH $ \case +lowerResource finish = interpretH $ \case Bracket alloc dealloc use -> do a <- runT alloc d <- bindT dealloc u <- bindT use let run_it :: Sem (Resource ': r) x -> IO x - run_it = finish .@ runResourceInIO + run_it = finish .@ lowerResource embed $ X.bracket (run_it a) (run_it . d) (run_it . u) @@ -104,10 +104,10 @@ runResourceInIO finish = interpretH $ \case u <- bindT use let run_it :: Sem (Resource ': r) x -> IO x - run_it = finish .@ runResourceInIO + run_it = finish .@ lowerResource embed $ X.bracketOnError (run_it a) (run_it . d) (run_it . u) -{-# INLINE runResourceInIO #-} +{-# INLINE lowerResource #-} ------------------------------------------------------------------------------ @@ -150,28 +150,28 @@ runResource = interpretH $ \case ------------------------------------------------------------------------------ --- | A more flexible --- though less safe --- version of 'runResourceInIO'. +-- | A more flexible --- though less safe --- version of 'lowerResource'. -- -- This function is capable of running 'Resource' effects anywhere within an -- effect stack, without relying on an explicit function to lower it into 'IO'. -- Notably, this means that 'Polysemy.State.State' effects will be consistent -- in the presence of 'Resource'. -- --- 'runResourceBase' is safe whenever you're concerned about exceptions thrown +-- ResourceToIO' is safe whenever you're concerned about exceptions thrown -- by effects _already handled_ in your effect stack, or in 'IO' code run -- directly inside of 'bracket'. It is not safe against exceptions thrown -- explicitly at the main thread. If this is not safe enough for your use-case, --- use 'runResourceInIO' instead. +-- use 'lowerResource' instead. -- -- This function creates a thread, and so should be compiled with @-threaded@. -- -- @since 0.5.0.0 -runResourceBase +resourceToIO :: forall r a . LastMember (Embed IO) r => Sem (Resource ': r) a -> Sem r a -runResourceBase = interpretH $ \case +resourceToIO = interpretH $ \case Bracket a b c -> do ma <- runT a mb <- bindT b @@ -179,7 +179,7 @@ runResourceBase = interpretH $ \case withLowerToIO $ \lower finish -> do let done :: Sem (Resource ': r) x -> IO x - done = lower . raise . runResourceBase + done = lower . raise . resourceToIO X.bracket (done ma) (\x -> done (mb x) >> finish) @@ -192,9 +192,9 @@ runResourceBase = interpretH $ \case withLowerToIO $ \lower finish -> do let done :: Sem (Resource ': r) x -> IO x - done = lower . raise . runResourceBase + done = lower . raise . resourceToIO X.bracketOnError (done ma) (\x -> done (mb x) >> finish) (done . mc) -{-# INLINE runResourceBase #-} +{-# INLINE resourceToIO #-} diff --git a/src/Polysemy/State.hs b/src/Polysemy/State.hs index 522d9ad..62a9677 100644 --- a/src/Polysemy/State.hs +++ b/src/Polysemy/State.hs @@ -12,8 +12,10 @@ module Polysemy.State -- * Interpretations , runState + , evalState , runLazyState - , runStateInIORef + , evalLazyState + , runStateIORef -- * Interoperation with MTL , hoistStateIntoStateT @@ -64,6 +66,13 @@ runState = stateful $ \case {-# INLINE[3] runState #-} +------------------------------------------------------------------------------ +-- | Run a 'State' effect with local state. +evalState :: s -> Sem (State s ': r) a -> Sem r a +evalState s = fmap snd . runState s +{-# INLINE evalState #-} + + ------------------------------------------------------------------------------ -- | Run a 'State' effect with local state, lazily. runLazyState :: s -> Sem (State s ': r) a -> Sem r (s, a) @@ -72,21 +81,27 @@ runLazyState = lazilyStateful $ \case Put s -> const $ pure (s, ()) {-# INLINE[3] runLazyState #-} +------------------------------------------------------------------------------ +-- | Run a 'State' effect with local state, lazily. +evalLazyState :: s -> Sem (State s ': r) a -> Sem r a +evalLazyState s = fmap snd . runLazyState s +{-# INLINE evalLazyState #-} + ------------------------------------------------------------------------------ -- | Run a 'State' effect by transforming it into operations over an 'IORef'. -- -- @since 0.1.2.0 -runStateInIORef +runStateIORef :: forall s r a . Member (Embed IO) r => IORef s -> Sem (State s ': r) a -> Sem r a -runStateInIORef ref = interpret $ \case +runStateIORef ref = interpret $ \case Get -> embed $ readIORef ref Put s -> embed $ writeIORef ref s -{-# INLINE runStateInIORef #-} +{-# INLINE runStateIORef #-} ------------------------------------------------------------------------------ diff --git a/src/Polysemy/Trace.hs b/src/Polysemy/Trace.hs index 1c6ca87..3515029 100644 --- a/src/Polysemy/Trace.hs +++ b/src/Polysemy/Trace.hs @@ -8,13 +8,13 @@ module Polysemy.Trace , trace -- * Interpretations - , runTraceIO - , runTraceAsList - , runIgnoringTrace - , runTraceAsOutput + , traceToIO + , runTraceList + , ignoreTrace + , traceToOutput -- * Interpretations for Other Effects - , runOutputAsTrace + , outputToTrace ) where import Polysemy @@ -31,56 +31,56 @@ makeSem ''Trace ------------------------------------------------------------------------------ -- | Run a 'Trace' effect by printing the messages to stdout. -runTraceIO :: Member (Embed IO) r => Sem (Trace ': r) a -> Sem r a -runTraceIO = interpret $ \case +traceToIO :: Member (Embed IO) r => Sem (Trace ': r) a -> Sem r a +traceToIO = interpret $ \case Trace m -> embed $ putStrLn m -{-# INLINE runTraceIO #-} +{-# INLINE traceToIO #-} ------------------------------------------------------------------------------ -- | Run a 'Trace' effect by ignoring all of its messages. -runIgnoringTrace :: Member (Embed IO) r => Sem (Trace ': r) a -> Sem r a -runIgnoringTrace = interpret $ \case +ignoreTrace :: Member (Embed IO) r => Sem (Trace ': r) a -> Sem r a +ignoreTrace = interpret $ \case Trace _ -> pure () -{-# INLINE runIgnoringTrace #-} +{-# INLINE ignoreTrace #-} ------------------------------------------------------------------------------ -- | Transform a 'Trace' effect into a 'Output' 'String' effect. -runTraceAsOutput +traceToOutput :: Member (Output String) r => Sem (Trace ': r) a -> Sem r a -runTraceAsOutput = interpret $ \case +traceToOutput = interpret $ \case Trace m -> output m -{-# INLINE runTraceAsOutput #-} +{-# INLINE traceToOutput #-} ------------------------------------------------------------------------------ -- | Get the result of a 'Trace' effect as a list of 'String's. -- -- @since 0.5.0.0 -runTraceAsList +runTraceList :: Sem (Trace ': r) a -> Sem r ([String], a) -runTraceAsList = runOutputAsList . reinterpret ( +runTraceList = runOutputList . reinterpret ( \case Trace m -> output m ) -{-# INLINE runTraceAsList #-} +{-# INLINE runTraceList #-} ------------------------------------------------------------------------------ -- | Transform a 'Trace' effect into a 'Output' 'String' effect. -- -- @since 0.1.2.0 -runOutputAsTrace +outputToTrace :: ( Show w , Member Trace r ) => Sem (Output w ': r) a -> Sem r a -runOutputAsTrace = interpret $ \case +outputToTrace = interpret $ \case Output m -> trace $ show m -{-# INLINE runOutputAsTrace #-} +{-# INLINE outputToTrace #-} diff --git a/src/Polysemy/Writer.hs b/src/Polysemy/Writer.hs index 570e2b1..3b153e0 100644 --- a/src/Polysemy/Writer.hs +++ b/src/Polysemy/Writer.hs @@ -15,7 +15,7 @@ module Polysemy.Writer , runWriter -- * Interpretations for Other Effects - , runOutputAsWriter + , outputToWriter ) where import Polysemy @@ -43,10 +43,10 @@ censor f m = pass (fmap (f ,) m) ------------------------------------------------------------------------------ -- | Transform an 'Output' effect into a 'Writer' effect. -runOutputAsWriter :: Member (Writer o) r => Sem (Output o ': r) a -> Sem r a -runOutputAsWriter = interpret $ \case +outputToWriter :: Member (Writer o) r => Sem (Output o ': r) a -> Sem r a +outputToWriter = interpret $ \case Output o -> tell o -{-# INLINE runOutputAsWriter #-} +{-# INLINE outputToWriter #-} ------------------------------------------------------------------------------ @@ -75,3 +75,4 @@ runWriter = runState mempty . reinterpretH pure (fmap snd t) ) {-# INLINE runWriter #-} + diff --git a/test/AlternativeSpec.hs b/test/AlternativeSpec.hs index 7ea4f0e..e340418 100644 --- a/test/AlternativeSpec.hs +++ b/test/AlternativeSpec.hs @@ -41,13 +41,13 @@ spec = parallel $ do describe "runNonDetMaybe" $ do it "should skip second branch if the first branch succeeds" $ do - (run . runNonDetMaybe . runTraceAsList) failtrace + (run . runNonDetMaybe . runTraceList) failtrace `shouldBe` Just ([], ()) - (run . runTraceAsList . runNonDetMaybe) failtrace + (run . runTraceList . runNonDetMaybe) failtrace `shouldBe` ([], Just ()) it "should respect local/global state semantics" $ do - (run . runNonDetMaybe . runTraceAsList) failtrace' + (run . runNonDetMaybe . runTraceList) failtrace' `shouldBe` Just (["salabim"], ()) - (run . runTraceAsList . runNonDetMaybe) failtrace' + (run . runTraceList . runNonDetMaybe) failtrace' `shouldBe` (["sim", "salabim"], Just ()) diff --git a/test/AsyncSpec.hs b/test/AsyncSpec.hs index a61c2c2..e5278a4 100644 --- a/test/AsyncSpec.hs +++ b/test/AsyncSpec.hs @@ -15,9 +15,9 @@ spec :: Spec spec = describe "async" $ do it "should thread state and not lock" $ do (ts, (s, r)) <- runM - . runTraceAsList + . runTraceList . runState "hello" - . runAsync $ do + . asyncToIO $ do let message :: Member Trace r => Int -> String -> Sem r () message n msg = trace $ mconcat [ show n, "> ", msg ] diff --git a/test/BracketSpec.hs b/test/BracketSpec.hs index d30a4a6..e4f21f1 100644 --- a/test/BracketSpec.hs +++ b/test/BracketSpec.hs @@ -13,7 +13,7 @@ runTest :: Sem '[Error (), Resource, State [Char], Trace] a -> ([String], ([Char], Either () a)) runTest = run - . runTraceAsList + . runTraceList . runState "" . runResource . runError @() @@ -22,9 +22,9 @@ runTest2 :: Sem '[Error (), Resource, State [Char], Trace, Embed IO] a -> IO ([String], ([Char], Either () a)) runTest2 = runM - . runTraceAsList + . runTraceList . runState "" - . runResourceBase + . resourceToIO . runError @() diff --git a/test/InterceptSpec.hs b/test/InterceptSpec.hs index 714c64f..1898eb4 100644 --- a/test/InterceptSpec.hs +++ b/test/InterceptSpec.hs @@ -16,7 +16,7 @@ spec :: Spec spec = describe "intercept" $ do it "should weave through embedded computations" $ do let (msgs, ()) = run - . runTraceAsList + . runTraceList . runResource . withTraceLogging $ do trace "outside" diff --git a/test/OutputSpec.hs b/test/OutputSpec.hs index 53396f6..32237d7 100644 --- a/test/OutputSpec.hs +++ b/test/OutputSpec.hs @@ -8,7 +8,7 @@ import Test.Hspec spec :: Spec spec = parallel $ do - describe "runBatchOutput" $ do + describe "runOutputBatched" $ do it "should return nothing at batch size 0" $ do let (ms, _) = runOutput 0 $ traverse (output @Int) [0..99] length ms `shouldBe` 0 @@ -23,14 +23,14 @@ spec = parallel $ do it "returns all original elements in the correct order" $ concat ms `shouldBe` [0..99] - describe "runOutputAsList" $ + describe "runOutputList" $ it "should return elements in the order they were output" $ - let (xs, ()) = runOutputAsList' $ traverse_ (output @Int) [0..100] + let (xs, ()) = runOutputList' $ traverse_ (output @Int) [0..100] in xs `shouldBe` [0..100] -runOutput :: Int -> Sem '[Output Int] a -> ([[Int]], a) -runOutput size = run . runFoldMapOutput (:[]) . runBatchOutput size +runOutput :: Int -> Sem '[Output Int, Output [Int]] a -> ([[Int]], a) +runOutput size = run . runOutputMonoid (:[]) . runOutputBatched size -runOutputAsList' :: Sem '[Output Int] a -> ([Int], a) -runOutputAsList' = run . runOutputAsList +runOutputList' :: Sem '[Output Int] a -> ([Int], a) +runOutputList' = run . runOutputList diff --git a/test/TypeErrors.hs b/test/TypeErrors.hs index 1c0f0ca..c864e12 100644 --- a/test/TypeErrors.hs +++ b/test/TypeErrors.hs @@ -61,13 +61,13 @@ interpretBadFirstOrder = () -------------------------------------------------------------------------------- -- | -- >>> :{ --- runFoldMapOutput +-- runOutputMonoid -- :: forall o m r a -- . Monoid m -- => (o -> m) -- -> Sem (Output o ': r) a -- -> Sem r (m, a) --- runFoldMapOutput f = runState mempty . reinterpret $ \case +-- runOutputMonoid f = runState mempty . reinterpret $ \case -- Output o -> modify (`mappend` f o) -- :} -- ... @@ -85,7 +85,7 @@ tooFewArgumentsReinterpret = () -- foo = pure () -- foo' = reinterpretScrub foo -- foo'' = runState True foo' --- foo''' = runTraceIO foo'' +-- foo''' = traceToIO foo'' -- in runM foo''' -- :} -- ... @@ -116,7 +116,7 @@ ambiguousSendInConcreteR = () -- >>> :{ -- let foo :: Member Resource r => Sem r () -- foo = undefined --- in runM $ runResourceInIO foo +-- in runM $ lowerResource foo -- :} -- ... -- ... Couldn't match expected type ...