Merge branch 'master' into improved-labeled

effectful-core/CHANGELOG.md

@@ -1,5 +1,9 @@
 # effectful-core-2.4.0.0 (????-??-??)
-* Improve `Effectful.Labeled` and add `Effectful.Labeled.Error`,
+* Add utility functions for handling effects that take the effect handler as the
+  last parameter to `Effectful.Dispatch.Dynamic`.
+* Add utility functions for handling first order effects to
+  `Effectful.Dispatch.Dynamic`.
+* Improve `Effectful.Labeled`, add `Effectful.Labeled.Error`,
   `Effectful.Labeled.Reader`, `Effectful.Labeled.State` and
   `Effectful.Labeled.Writer`.
 

effectful-core/src/Effectful/Dispatch/Dynamic.hs

@@ -23,9 +23,13 @@ module Effectful.Dispatch.Dynamic
     -- * Handling effects
   , EffectHandler
   , interpret
+  , interpretWith
   , reinterpret
+  , reinterpretWith
   , interpose
+  , interposeWith
   , impose
+  , imposeWith
 
     -- ** Handling local 'Eff' computations
   , LocalEnv
@@ -53,6 +57,17 @@ module Effectful.Dispatch.Dynamic
   , localBorrow
   , SharedSuffix
 
+    -- ** Utils for first order effects
+  , EffectHandler_
+  , interpret_
+  , interpretWith_
+  , reinterpret_
+  , reinterpretWith_
+  , interpose_
+  , interposeWith_
+  , impose_
+  , imposeWith_
+
     -- * Re-exports
   , HasCallStack
   ) where
@@ -212,6 +227,9 @@ import Effectful.Internal.Utils
 --
 -- If an effect makes use of the @m@ parameter, it is a /higher order effect/.
 --
+-- /Note:/ for handling first order effects you can use 'interpret_' or
+-- 'reinterpret_' whose 'EffectHandler_' doesn't take the 'LocalEnv' parameter.
+--
 -- Interpretation of higher order effects is slightly more involving. To see
 -- why, let's consider the @Profiling@ effect for logging how much time a
 -- specific action took to run:
@@ -343,7 +361,7 @@ import Effectful.Internal.Utils
 --
 -- >>> :{
 --   runDummyRNG :: Eff (RNG : es) a -> Eff es a
---   runDummyRNG = interpret $ \_ -> \case
+--   runDummyRNG = interpret_ $ \case
 --     RandomInt -> pure 55
 -- :}
 --
@@ -418,6 +436,17 @@ interpret handler m = unsafeEff $ \es -> do
   where
     mkHandler es = Handler es (let ?callStack = thawCallStack ?callStack in handler)
 
+-- | 'interpret' with the effect handler as the last argument.
+--
+-- @since 2.4.0.0
+interpretWith
+  :: DispatchOf e ~ Dynamic
+  => Eff (e : es) a
+  -> EffectHandler e es
+  -- ^ The effect handler.
+  -> Eff      es  a
+interpretWith m handler = interpret handler m
+
 -- | Interpret an effect using other, private effects.
 --
 -- @'interpret' ≡ 'reinterpret' 'id'@
@@ -435,6 +464,19 @@ reinterpret runHandlerEs handler m = unsafeEff $ \es -> do
   where
     mkHandler es = Handler es (let ?callStack = thawCallStack ?callStack in handler)
 
+-- | 'reinterpret' with the effect handler as the last argument.
+--
+-- @since 2.4.0.0
+reinterpretWith
+  :: DispatchOf e ~ Dynamic
+  => (Eff handlerEs a -> Eff es b)
+  -- ^ Introduction of effects encapsulated within the handler.
+  -> Eff (e : es) a
+  -> EffectHandler e handlerEs
+  -- ^ The effect handler.
+  -> Eff      es  b
+reinterpretWith runHandlerEs m handler = reinterpret runHandlerEs handler m
+
 -- | Replace the handler of an existing effect with a new one.
 --
 -- /Note:/ this function allows for augmenting handlers with a new functionality
@@ -448,15 +490,15 @@ reinterpret runHandlerEs handler m = unsafeEff $ \es -> do
 --
 -- >>> :{
 --   runE :: IOE :> es => Eff (E : es) a -> Eff es a
---   runE = interpret $ \_ Op -> liftIO (putStrLn "op")
+--   runE = interpret_ $ \Op -> liftIO (putStrLn "op")
 -- :}
 --
 -- >>> runEff . runE $ send Op
 -- op
 --
 -- >>> :{
 --   augmentE :: (E :> es, IOE :> es) => Eff es a -> Eff es a
---   augmentE = interpose $ \_ Op -> liftIO (putStrLn "augmented op") >> send Op
+--   augmentE = interpose_ $ \Op -> liftIO (putStrLn "augmented op") >> send Op
 -- :}
 --
 -- >>> runEff . runE . augmentE $ send Op
@@ -489,6 +531,17 @@ interpose handler m = unsafeEff $ \es -> do
   where
     mkHandler es = Handler es (let ?callStack = thawCallStack ?callStack in handler)
 
+-- | 'interpose' with the effect handler as the last argument.
+--
+-- @since 2.4.0.0
+interposeWith
+  :: (DispatchOf e ~ Dynamic, e :> es)
+  => Eff es a
+  -> EffectHandler e es
+  -- ^ The effect handler.
+  -> Eff es a
+interposeWith m handler = interpose handler m
+
 -- | Replace the handler of an existing effect with a new one that uses other,
 -- private effects.
 --
@@ -523,6 +576,127 @@ impose runHandlerEs handler m = unsafeEff $ \es -> do
   where
     mkHandler es = Handler es (let ?callStack = thawCallStack ?callStack in handler)
 
+-- | 'impose' with the effect handler as the last argument.
+--
+-- @since 2.4.0.0
+imposeWith
+  :: (DispatchOf e ~ Dynamic, e :> es)
+  => (Eff handlerEs a -> Eff es b)
+  -- ^ Introduction of effects encapsulated within the handler.
+  -> Eff es a
+  -> EffectHandler e handlerEs
+  -- ^ The effect handler.
+  -> Eff es b
+imposeWith runHandlerEs m handler = impose runHandlerEs handler m
+
+----------------------------------------
+-- First order effects
+
+-- | Type signature of a first order effect handler.
+--
+-- @since 2.4.0.0
+type EffectHandler_ (e :: Effect) (es :: [Effect])
+  = forall a localEs. HasCallStack
+  => e (Eff localEs) a
+  -- ^ The operation.
+  -> Eff es a
+
+-- | 'interpret' for first order effects.
+--
+-- @since 2.4.0.0
+interpret_
+  :: DispatchOf e ~ Dynamic
+  => EffectHandler_ e es
+  -- ^ The effect handler.
+  -> Eff (e : es) a
+  -> Eff      es  a
+interpret_ handler = interpret (const handler)
+
+-- | 'interpretWith' for first order effects.
+--
+-- @since 2.4.0.0
+interpretWith_
+  :: DispatchOf e ~ Dynamic
+  => Eff (e : es) a
+  -> EffectHandler_ e es
+  -- ^ The effect handler.
+  -> Eff      es  a
+interpretWith_ m handler = interpretWith m (const handler)
+
+-- | 'reinterpret' for first order effects.
+--
+-- @since 2.4.0.0
+reinterpret_
+  :: DispatchOf e ~ Dynamic
+  => (Eff handlerEs a -> Eff es b)
+  -- ^ Introduction of effects encapsulated within the handler.
+  -> EffectHandler_ e handlerEs
+  -- ^ The effect handler.
+  -> Eff (e : es) a
+  -> Eff      es  b
+reinterpret_ runHandlerEs handler = reinterpret runHandlerEs (const handler)
+
+-- | 'reinterpretWith' for first order effects.
+--
+-- @since 2.4.0.0
+reinterpretWith_
+  :: DispatchOf e ~ Dynamic
+  => (Eff handlerEs a -> Eff es b)
+  -- ^ Introduction of effects encapsulated within the handler.
+  -> Eff (e : es) a
+  -> EffectHandler_ e handlerEs
+  -- ^ The effect handler.
+  -> Eff      es  b
+reinterpretWith_ runHandlerEs m handler = reinterpretWith runHandlerEs m (const handler)
+
+-- | 'interpose' for first order effects.
+--
+-- @since 2.4.0.0
+interpose_
+  :: (DispatchOf e ~ Dynamic, e :> es)
+  => EffectHandler_ e es
+  -- ^ The effect handler.
+  -> Eff es a
+  -> Eff es a
+interpose_ handler = interpose (const handler)
+
+-- | 'interposeWith' for first order effects.
+--
+-- @since 2.4.0.0
+interposeWith_
+  :: (DispatchOf e ~ Dynamic, e :> es)
+  => Eff es a
+  -> EffectHandler_ e es
+  -- ^ The effect handler.
+  -> Eff es a
+interposeWith_ m handler = interposeWith m (const handler)
+
+-- | 'impose' for first order effects.
+--
+-- @since 2.4.0.0
+impose_
+  :: (DispatchOf e ~ Dynamic, e :> es)
+  => (Eff handlerEs a -> Eff es b)
+  -- ^ Introduction of effects encapsulated within the handler.
+  -> EffectHandler_ e handlerEs
+  -- ^ The effect handler.
+  -> Eff es a
+  -> Eff es b
+impose_ runHandlerEs handler = impose runHandlerEs (const handler)
+
+-- | 'imposeWith' for first order effects.
+--
+-- @since 2.4.0.0
+imposeWith_
+  :: (DispatchOf e ~ Dynamic, e :> es)
+  => (Eff handlerEs a -> Eff es b)
+  -- ^ Introduction of effects encapsulated within the handler.
+  -> Eff es a
+  -> EffectHandler_ e handlerEs
+  -- ^ The effect handler.
+  -> Eff es b
+imposeWith_ runHandlerEs m handler = imposeWith runHandlerEs m (const handler)
+
 ----------------------------------------
 -- Unlifts
 

effectful-core/src/Effectful/Fail.hs

@@ -15,10 +15,10 @@ import Effectful.Internal.Monad (Fail(..))
 
 -- | Run the 'Fail' effect via 'Error'.
 runFail :: Eff (Fail : es) a -> Eff es (Either String a)
-runFail = reinterpret runErrorNoCallStack $ \_ -> \case
+runFail = reinterpret_ runErrorNoCallStack $ \case
   Fail msg -> throwError msg
 
 -- | Run the 'Fail' effect via the 'MonadFail' instance for 'IO'.
 runFailIO :: IOE :> es => Eff (Fail : es) a -> Eff es a
-runFailIO = interpret $ \_ -> \case
+runFailIO = interpret_ $ \case
   Fail msg -> liftIO $ fail msg

effectful-core/src/Effectful/Internal/Monad.hs

@@ -494,13 +494,13 @@ type role LocalEnv nominal nominal
 newtype LocalEnv (localEs :: [Effect]) (handlerEs :: [Effect]) = LocalEnv (Env localEs)
 
 -- | Type signature of the effect handler.
-type EffectHandler e es
+type EffectHandler (e :: Effect) (es :: [Effect])
   = forall a localEs. (HasCallStack, e :> localEs)
   => LocalEnv localEs es
   -- ^ Capture of the local environment for handling local 'Eff' computations
   -- when @e@ is a higher order effect.
   -> e (Eff localEs) a
-  -- ^ The effect performed in the local environment.
+  -- ^ The operation.
   -> Eff es a
 
 -- | An internal representation of dynamically dispatched effects, i.e. the

effectful-core/src/Effectful/Provider.hs

@@ -74,7 +74,7 @@ import Effectful.Internal.Utils
 --     => FilePath
 --     -> Eff (Write : es) a
 --     -> Eff es a
---   runWriteIO fp = interpret $ \_ -> \case
+--   runWriteIO fp = interpret_ $ \case
 --     Write msg -> liftIO . putStrLn $ fp ++ ": " ++ msg
 -- :}
 --
@@ -84,7 +84,7 @@ import Effectful.Internal.Utils
 --     => FilePath
 --     -> Eff (Write : es) a
 --     -> Eff es a
---   runWritePure fp = interpret $ \_ -> \case
+--   runWritePure fp = interpret_ $ \case
 --     Write msg -> modify $ M.insertWith (++) fp [msg]
 -- :}
 --

effectful-plugin/tests/PluginTests.hs

@@ -96,7 +96,7 @@ data TaggedState k s :: Effect where
 type instance DispatchOf (TaggedState k s) = Dynamic
 
 runTaggedState :: s -> Eff (TaggedState k s : es) a -> Eff es (a, s)
-runTaggedState s = reinterpret (runState s) $ \_ -> \case
+runTaggedState s = reinterpret_ (runState s) $ \case
   TaggedGet    -> get
   TaggedPut s' -> put s'
 
@@ -112,5 +112,5 @@ data DBAction whichDb :: Effect where
 type instance DispatchOf (DBAction whichDb) = Dynamic
 
 runDBAction :: Eff (DBAction which : es) a -> Eff es a
-runDBAction = interpret $ \_ -> \case
+runDBAction = interpret_ $ \case
   DoSelect (Select a) -> pure $ Just a

effectful-th/src/Effectful/TH.hs

@@ -53,6 +53,9 @@ import Effectful.Dispatch.Dynamic
 -- lowercase or removes the @:@ symbol in case of operators. Any fixity
 -- annotations defined for the constructors are preserved for the corresponding
 -- definitions.
+--
+-- If the constructor declaration has Haddock, then this is reused for the
+-- sending functions, otherwise a simple placeholder is used.
 makeEffect :: Name -> Q [Dec]
 makeEffect = makeEffectImpl True
 
@@ -246,10 +249,15 @@ makeTyp esVar substM resTy = \case
 
 withHaddock :: Name -> [Dec] -> Q [Dec]
 #if MIN_VERSION_template_haskell(2,18,0)
-withHaddock name dec = withDecsDoc
-  ("Perform the operation '" ++ nameBase name ++ "'.") (pure dec)
+withHaddock name decs = do 
+  existingHaddock <- getDoc (DeclDoc name)
+  let newDoc = 
+        case existingHaddock of
+          Just doc -> doc
+          Nothing -> "Perform the operation '" ++ nameBase name ++ "'."
+  withDecsDoc newDoc (pure decs)
 #else
-withHaddock _ dec = pure dec
+withHaddock _ decs = pure decs
 #endif
 
 checkRequiredExtensions :: Q ()

effectful-th/tests/ThTests.hs

@@ -15,6 +15,7 @@ main = pure () -- only compilation tests
 data SimpleADT (m :: Type -> Type) (a :: Type)
   = SimpleADTC1 Int
   | SimpleADTC2 String
+  -- ^ This one does the second thing
 
 -- Test generation of fixity information.
 infixl 1 `SimpleADTC1`
@@ -39,6 +40,7 @@ makeEffect ''ADTSyntax3
 
 data GADTSyntax :: Effect where
   GADTSyntaxC1 :: Int -> GADTSyntax m Int
+  -- | I am documented
   GADTSyntaxC2 :: String -> GADTSyntax m String
   GADTSyntaxC3 :: IOE :> es => Bool -> GADTSyntax (Eff es) a
 

effectful/CHANGELOG.md

@@ -1,5 +1,9 @@
 # effectful-2.4.0.0 (????-??-??)
-* Improve `Effectful.Labeled` and add `Effectful.Labeled.Error`,
+* Add utility functions for handling effects that take the effect handler as the
+  last parameter to `Effectful.Dispatch.Dynamic`.
+* Add utility functions for handling first order effects to
+  `Effectful.Dispatch.Dynamic`.
+* Improve `Effectful.Labeled`, add `Effectful.Labeled.Error`,
   `Effectful.Labeled.Reader`, `Effectful.Labeled.State` and
   `Effectful.Labeled.Writer`.