Make it easier to interpret actions in a polymorphic monad

Specifically, this adds sendM, which is identical to send but explicitly
selects the final effect to aid type inference, and it also includes a
MonadBase instance for Eff.

freer-effects.cabal

@@ -59,6 +59,7 @@ library
   build-depends:
       base >=4.9 && <5
     , natural-transformation >=0.2
+    , transformers-base
   if flag(pedantic)
     ghc-options: -Werror
   if impl(ghc >=8)

package.yaml

@@ -66,6 +66,7 @@ library:
   source-dirs: src
   dependencies:
   - natural-transformation >=0.2
+  - transformers-base
 
 executables:
   freer-examples:

src/Control/Monad/Freer.hs

@@ -20,9 +20,11 @@ module Control.Monad.Freer
     -- ** Effect Constraints
   , Member
   , Members
+  , LastMember
 
     -- ** Sending Arbitrary Effect
   , send
+  , sendM
 
     -- ** Lifting Effect Stacks
   , raise
@@ -47,6 +49,7 @@ import Control.Natural (type (~>))
 import Control.Monad.Freer.Internal
   ( Arr
   , Eff
+  , LastMember
   , Member
   , Members
   , Weakens
@@ -58,6 +61,7 @@ import Control.Monad.Freer.Internal
   , run
   , runM
   , send
+  , sendM
   )
 
 -- | The simplest way to produce an effect handler. Given a natural

src/Control/Monad/Freer/Internal.hs

@@ -1,7 +1,9 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -17,6 +19,8 @@
 
 -- Due to re-export of Data.FTCQueue, and Data.OpenUnion.
 {-# OPTIONS_GHC -fno-warn-missing-import-lists #-}
+-- Due to sendM.
+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
 
 -- |
 -- Module:       Control.Monad.Freer.Internal
@@ -54,6 +58,7 @@ module Control.Monad.Freer.Internal
 
     -- ** Sending Arbitrary Effect
     , send
+    , sendM
 
     -- ** Lifting Effect Stacks
     , raise
@@ -81,14 +86,9 @@ module Control.Monad.Freer.Internal
 
 import Prelude (error)  -- Function error is used for imposible cases.
 
-import Control.Applicative
-    ( Alternative((<|>), empty)
-    , Applicative((<*>), pure)
-    )
-import Control.Monad
-    ( Monad((>>=), return)
-    , MonadPlus(mplus, mzero)
-    )
+import Control.Applicative (Alternative((<|>), empty), Applicative((<*>), pure))
+import Control.Monad (Monad((>>=), return), MonadPlus(mplus, mzero))
+import Control.Monad.Base (MonadBase(liftBase))
 import Data.Bool (Bool)
 import Data.Either (Either(Left, Right))
 import Data.Function (($), (.))
@@ -156,10 +156,21 @@ instance Monad (Eff effs) where
     E u q >>= k = E u (q |> k)
     {-# INLINE (>>=) #-}
 
+instance (MonadBase b m, LastMember m effs) => MonadBase b (Eff effs) where
+    liftBase = sendM . liftBase
+    {-# INLINE liftBase #-}
+
 -- | Send a request and wait for a reply.
 send :: Member eff effs => eff a -> Eff effs a
 send t = E (inj t) (tsingleton Val)
 
+-- | Identical to 'send', but specialized to the final effect in @effs@ to
+-- assist type inference. This is useful for running actions in a monad
+-- transformer stack used in conjunction with 'runM'.
+sendM :: (Monad m, LastMember m effs) => m a -> Eff effs a
+sendM = send
+{-# INLINE sendM #-}
+
 --------------------------------------------------------------------------------
                        -- Base Effect Runner --
 --------------------------------------------------------------------------------

src/Data/OpenUnion.hs

@@ -37,6 +37,7 @@ module Data.OpenUnion
     -- * Open Union Membership Constraints
     , Member(..)
     , Members
+    , LastMember
     )
   where
 
@@ -60,3 +61,10 @@ import Data.OpenUnion.Internal
 type family Members m r :: Constraint where
     Members (t ': c) r = (Member t r, Members c r)
     Members '[] r = ()
+
+type family Last effs where
+  Last (eff ': '[]) = eff
+  Last (_ ': effs) = Last effs
+
+class (Member m effs, m ~ Last effs) => LastMember m effs
+instance (Member m effs, m ~ Last effs) => LastMember m effs