From 4348f2c75c4f00ddb41e0936bdc563e0a2864464 Mon Sep 17 00:00:00 2001
From: David Feuer <David.Feuer@gmail.com>
Date: Sun, 11 Jul 2021 15:25:28 -0400
Subject: [PATCH] Make liftF a method of MonadFree

This seems to work a bit better for things like `FT`.
---
 src/Control/Monad/Free.hs              |  1 -
 src/Control/Monad/Free/Church.hs       |  2 +-
 src/Control/Monad/Free/Class.hs        | 16 +++++++++++-----
 src/Control/Monad/Trans/Free.hs        |  1 -
 src/Control/Monad/Trans/Free/Ap.hs     |  1 -
 src/Control/Monad/Trans/Free/Church.hs |  2 +-
 6 files changed, 13 insertions(+), 10 deletions(-)

diff --git a/src/Control/Monad/Free.hs b/src/Control/Monad/Free.hs
index 4a2b7c4..248884a 100644
--- a/src/Control/Monad/Free.hs
+++ b/src/Control/Monad/Free.hs
@@ -30,7 +30,6 @@ module Control.Monad.Free
   ( MonadFree(..)
   , Free(..)
   , retract
-  , liftF
   , iter
   , iterA
   , iterM
diff --git a/src/Control/Monad/Free/Church.hs b/src/Control/Monad/Free/Church.hs
index aa1df70..dfd1c67 100644
--- a/src/Control/Monad/Free/Church.hs
+++ b/src/Control/Monad/Free/Church.hs
@@ -63,7 +63,6 @@ module Control.Monad.Free.Church
   , hoistF
   , foldF
   , MonadFree(..)
-  , liftF
   , cutoff
   ) where
 
@@ -157,6 +156,7 @@ instance MonadTrans F where
 
 instance Functor f => MonadFree f (F f) where
   wrap f = F (\kp kf -> kf (fmap (\ (F m) -> m kp kf) f))
+  liftF f = F (\kp kf -> kf (fmap kp f))
 
 instance MonadState s m => MonadState s (F m) where
   get = lift get
diff --git a/src/Control/Monad/Free/Class.hs b/src/Control/Monad/Free/Class.hs
index 1b5e3bf..7ad08da 100644
--- a/src/Control/Monad/Free/Class.hs
+++ b/src/Control/Monad/Free/Class.hs
@@ -7,6 +7,7 @@
 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 704
 {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DefaultSignatures #-}
 #endif
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
 {-# LANGUAGE Safe #-}
@@ -26,8 +27,8 @@
 ----------------------------------------------------------------------------
 module Control.Monad.Free.Class
   ( MonadFree(..)
-  , liftF
   , wrapT
+  , defaultWrap
   ) where
 
 import Control.Monad
@@ -109,6 +110,11 @@ class Monad m => MonadFree f m | m -> f where
   wrap = join . lift . wrap . fmap return
 #endif
 
+  -- | A version of lift that can be used with just a Functor for f.
+  liftF :: f a -> m a
+  default liftF :: Functor f => f a -> m a
+  liftF = wrap . fmap return
+
 instance (Functor f, MonadFree f m) => MonadFree f (ReaderT e m) where
   wrap fm = ReaderT $ \e -> wrap $ flip runReaderT e <$> fm
 
@@ -151,13 +157,13 @@ instance (Functor f, MonadFree f m) => MonadFree f (ExceptT e m) where
 -- instance (Functor f, MonadFree f m) => MonadFree f (EitherT e m) where
 --   wrap = EitherT . wrap . fmap runEitherT
 
--- | A version of lift that can be used with just a Functor for f.
-liftF :: (Functor f, MonadFree f m) => f a -> m a
-liftF = wrap . fmap return
-
 -- | A version of wrap for monad transformers over a free monad.
 --
 -- /Note:/ that this is the default implementation for 'wrap' for
 -- @MonadFree f (t m)@.
 wrapT :: (Functor f, MonadFree f m, MonadTrans t, Monad (t m)) => f (t m a) -> t m a
 wrapT = join . lift . liftF
+
+-- | An implementation of 'wrap' for 'MonadFree' instances that define 'liftF'.
+defaultWrap :: (Functor f, MonadFree f m) => f (m a) -> m a
+defaultWrap = join . liftF
diff --git a/src/Control/Monad/Trans/Free.hs b/src/Control/Monad/Trans/Free.hs
index 0985f09..54881c5 100644
--- a/src/Control/Monad/Trans/Free.hs
+++ b/src/Control/Monad/Trans/Free.hs
@@ -36,7 +36,6 @@ module Control.Monad.Trans.Free
   -- * The free monad
   , Free, free, runFree
   -- * Operations
-  , liftF
   , iterT
   , iterTM
   , hoistFreeT
diff --git a/src/Control/Monad/Trans/Free/Ap.hs b/src/Control/Monad/Trans/Free/Ap.hs
index f701b46..75ed877 100644
--- a/src/Control/Monad/Trans/Free/Ap.hs
+++ b/src/Control/Monad/Trans/Free/Ap.hs
@@ -28,7 +28,6 @@ module Control.Monad.Trans.Free.Ap
   -- * The free monad
   , Free, free, runFree
   -- * Operations
-  , liftF
   , iterT
   , iterTM
   , hoistFreeT
diff --git a/src/Control/Monad/Trans/Free/Church.hs b/src/Control/Monad/Trans/Free/Church.hs
index bb7a624..30a2400 100644
--- a/src/Control/Monad/Trans/Free/Church.hs
+++ b/src/Control/Monad/Trans/Free/Church.hs
@@ -44,7 +44,6 @@ module Control.Monad.Trans.Free.Church
   , iterM
   -- * Free Monads With Class
   , MonadFree(..)
-  , liftF
   ) where
 
 import Control.Applicative
@@ -122,6 +121,7 @@ instance Monad (FT f m) where
 
 instance MonadFree f (FT f m) where
   wrap f = FT (\kp kf -> kf (\ft -> runFT ft kp kf) f)
+  liftF f = FT (\kp kf -> kf kp f)
 
 instance MonadTrans (FT f) where
   lift m = FT (\a _ -> m >>= a)