Is it possible to implement a MonadTransControl instance for FreeT? I started with the following, but got stuck:
instance (Functor f) => MonadTransControl (FreeT f) where
newtype StT (FreeT f) r = FreeTStT r
liftWith unlift = lift $ unlift $ error "Stuck here"
restoreT inner = do
FreeTStT r <- lift inner
return r
If it is unimplementable, than why and is it possible to extend a specific free functor implementation somehow to make it implementable?
Disclaimer: turns out you need Traversable f constraint for MonadTransControl instance.
Warning: the instance in this answer does not obey all the laws of MonadTransControl
Pragmas and imports
{-# LANGUAGE TypeFamilies #-}
import qualified Data.Traversable as T
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Control
import Control.Monad.Trans.Free
import qualified Control.Monad.Free as F
Free monadic state
As I said in comments, the proper "monadic state" of FreeT f should be Free f (the one from Control.Monad.Free):
instance T.Traversable f => MonadTransControl (FreeT f) where
newtype StT (FreeT f) a = StTFreeT { getStTFreeT :: F.Free f a }
Now the implementation of restoreT changes a bit:
restoreT inner = do
StTFreeT m <- lift inner
F.toFreeT m
liftWith implementation
Before we look at the implementation let's see what should the type of liftWith be:
liftWith :: Monad m => (Run (FreeT f) -> m a) -> FreeT f m a
And Run (FreeT f) is actually
forall n b. Monad n => FreeT f n b -> n (StTFreeT f b)
So the implementation would be like that:
liftWith unlift = lift $ unlift (liftM StTFreeT . pushFreeT)
The rest is simple:
pushFreeT :: (T.Traversable f, Monad m) => FreeT f m a -> m (F.Free f a)
pushFreeT m = do
f <- runFreeT m
case f of
Pure x -> return (return x)
Free y -> liftM wrap $ T.mapM pushFreeT y
Why Traversable?
As you can see the problem is with pushFreeT function: it uses T.mapM (which is traverse but with Monad constraint). Why do we need it there? If you look at the definition of FreeT you may notice that (NB: this is rough, I forget about Pure here):
FreeT f m a ~ m (f (m (f ... )))
And as a result of pushFreeT we need m (Free f a):
m (Free f a) ~ m (f (f (f ... )))
So we need to "push" all fs to the end and join all ms in the head. Thus we need an operation that lets us push a single f through single m and this is exactly what T.mapM pushFreeT gives us:
mapM :: (Monad m, Traversable t) => (a -> m b) -> t a -> m (t b)
mapM pushFreeT :: Traversable t => t (FreeT t m a) -> m (t (Free t a))
The laws
Every class instance usually come with laws. MonadTransControl is not an exception, so let's check if they hold for this instance:
liftWith . const . return = return
liftWith (const (m >>= f)) = liftWith (const m) >>= liftWith . const . f
These two laws obviously follow from laws for MonadTrans and the definition of liftWith.
liftWith (\run -> run t) >>= restoreT . return = t
Apparently, this law does not hold. This is because monad layers in t are collapsed when we pushFreeT. So the implemented liftWith merges effects in all layers of FreeT f m leaving us with the equivalent of m (Free f).
Related
I want to define deeply nested compositions of applicative functors. For example something like this:
{-# LANGUAGE TypeOperators #-}
import Control.Monad.Trans.Cont
import Control.Arrow (Kleisli (..))
import Data.Aeson
import Data.Aeson.Types
import Data.Functor.Compose
import Data.Functor
type Configurator = Kleisli Parser Value
type Allocator = ContT () IO
type Validator = Either String
someConfigurator :: Configurator Int
someConfigurator = undefined
someAllocator :: Allocator Char
someAllocator = undefined
-- the nested functor composition. left-associated
type Phases = Configurator `Compose` Allocator `Compose` Validator
data Foo = Foo Int Char
-- I want to streamline writing this, without spamming the Compose constructor
fooPhases :: Phases Foo
fooPhases = _
To streamline the syntax for creating the fooPhases value, I though of (ab)using QualifiedDo:
module Bind where
import Data.Functor
import Data.Functor.Compose
(>>=) :: Functor f => f a -> (a -> g b) -> Compose f g b
(>>=) f k = bindPhase f k
(>>) :: Functor f => f a -> g b -> Compose f g b
(>>) f g = Compose $ f <&> \_ -> g
fail :: MonadFail m => String -> m a
fail = Prelude.fail
bindPhase :: Functor f => f a -> (a -> g b) -> Compose f g b
bindPhase f k = Compose (f <&> k)
Somewhat to my surprise, it worked:
{-# LANGUAGE QualifiedDo #-}
import qualified Bind
fooPhases :: Phases Foo
fooPhases = Bind.do
i <- someConfigurator
c <- someAllocator
pure (Foo i c)
Alas, when I add applicative-like functions to the Bind module
return :: Applicative f => a -> f a
return = Prelude.pure
pure :: Applicative f => a -> f a
pure = Prelude.pure
fmap :: Functor f => (a -> b) -> f a -> f b
fmap = Prelude.fmap
join :: f (g a) -> Compose f g a
join = Compose
(<*>) :: (Applicative f, Applicative g) => f (a -> b) -> g a -> Compose f g b
(<*>) f g = Compose $ f <&> \z -> Prelude.fmap (z $) g
and then enable ApplicativeDo in Main, I start to get errors like the following:
* Couldn't match type: Compose (Kleisli Parser Value) (ContT () IO)
with: Kleisli Parser Value
Expected: Configurator (Compose Allocator Validator Foo)
Actual: Compose
(Kleisli Parser Value)
(ContT () IO)
(Compose Allocator Validator Foo)
Is there a way to use my Bind.do when both QualifiedDo and ApplicativeDo are enabled in Main?
To make this easier to reason about, first manually desugar fooPhases each way:
fooPhasesMonad =
someConfigurator Bind.>>= \i ->
someAllocator Bind.>>= \c ->
pure (Foo i c)
fooPhasesApplicative = Bind.fmap Foo someConfigurator Bind.<*> someAllocator
If you check their types in GHCi, you'll see that fooPhasesMonad has the type you want (as expected, since it works), but fooPhasesApplicative has type (Configurator `Compose` Allocator) Foo.
The first problem is that Bind.fmap f m isn't equivalent to m Bind.>>= (pure . f). In particular, the latter produces an extra layer of Compose but the former does not. When you use ApplicativeDo, using the former instead means you end up with just (Configurator `Compose` Allocator) instead of (Configurator `Compose` Allocator `Compose` Validator), which is the cause of your type error. To fix it, replace your definition of Bind.fmap with this one:
fmap :: (Functor f, Applicative g) => (a -> b) -> f a -> Compose f g b
fmap f k = bindPhase k (Prelude.pure . f)
The "monads" of your do-notation fail all of the monad laws, though (even the types of the results can't be right), so some rewrites that you take for granted aren't still valid. In particular, you'll still get an error unless you settle for your types being composed like this instead:
type Phases = (Configurator `Compose` Validator) `Compose` Allocator
I'm solving some ploblem on generating ancestor instances in Haskell. Recently I found this on Haskell wiki: Class system extension proposal. So, I would like to know, are there any solutions for this proposal already?
Here are the examples from the Proposal:
The current class system in Haskell is based on the idea that you can
often provide default implementations for class methods at the same
time as defining the class, by using other methods of the class or its
ancestors. However consider the following hierarchy, adapted from
Functor hierarchy proposal and The Other Prelude:
class Functor m where
fmap :: (a -> b) -> m a -> m b
class Functor m => Applicative m where
return :: a -> m a
apply :: m (a -> b) -> m a -> m b
(>>) :: m a -> m b -> m b
ma >> mb = (fmap (const id) ma) `apply` mb
class Applicative m => Monad m where
(>>=) :: m a -> (a -> m b) -> m b
For all concrete instances of Monad we can define fmap, apply, and
(>>)in terms of return and (>>=) as follows:
fmap f ma = ma >>= (\a -> return (f a))
apply mf ma = mf >>= \f -> ma >>= \a -> return (f a)
ma >> mb = ma >>= \_ -> mb
In other words, we'd like to be able to write:
class Applicative m => Monad m where
(>>=) :: m a -> (a -> m b) -> m b
fmap f ma = ma >>= (\a -> return (f a))
apply mf ma = mf >>= \f -> ma >>= \a -> return (f a)
ma >> mb = ma >>= \_ -> mb
and be able to define new instances of Monad just by supplying
definitions for return and (>>=) by writing:
instance Monad T where
ma >>= a_mb = ... -- some definition
return a = ... -- some definition
Explicit import/export of instances
This is needed so that large programs can be built without fear of
colliding instance declarations between different packages. A possible
syntax could be:
module M
-- exported instances
( instance Monad T
, instance Functor (F a) hiding (Functor (F Int), Functor (F Char))
, F(..)
) where
import Foo (instance Monad a hiding Monad Maybe)
data T a
data F a b
where the context is elided because this isn't used in instance
selection (at the moment). The import directive tells the compiler to
use all Monad instances exported by Foo except for the Monad Maybe
instance (it doesn't matter whether or not Foo actually does export a
Monad Maybe instance - all that matters here is that we don't want it
if there is one).
Yes, the DefaultSignatures extension allows this. For example, for the Functor/Applicative example, one could write
{-# LANGUAGE DefaultSignatures #-}
class Functor f where
fmap :: (a -> b) -> f a -> f b
default fmap :: Applicative f => (a -> b) -> f a -> f b
fmap = liftA
Where are the Applicative transformer classes? I wanted to use transformer classes for the applicative transformer stack in a previous answer, but they don't seem to exist.
The transformers package and many others are full of transformers that preserver Applicative structure, even when the underlying structure isn't a Monad.
A quick glance at transformers has Applicative instances for most of the transformers.
Applicative f => Applicative (Backwards f)
Applicative f => Applicative (Lift f)
Applicative (ContT r m)
Applicative m => Applicative (IdentityT m)
Applicative m => Applicative (ReaderT r m)
(Monoid w, Applicative m) => Applicative (WriterT w m)
(Applicative f, Applicative g) => Applicative (Compose f g)
(Applicative f, Applicative g) => Applicative (Product f g)
Only transformers for state and alternation (ExceptT and MaybeT) require an underlying monad for the Applicative instance.
(Functor m, Monad m) => Applicative (ExceptT e m)
(Functor m, Monad m) => Applicative (MaybeT m)
(Monoid w, Functor m, Monad m) => Applicative (RWST r w s m)
(Functor m, Monad m) => Applicative (StateT s m)
There's a class for Monad transformers. I can see how something could require this Monad constraint, since it can't be introduced elsewhere.
class MonadTrans t where
lift :: (Monad m) => m a -> t m a
Where's the class for Applicative transformers?
class ApTrans t where
liftAp :: (Applicative f) => f a -> t f a
Or just plain old transformers (though I can't imagine any laws for this)?
class Trans t where
liftAny :: f a -> t f a
Due to the difference only in polymorphic constraints, these typeclasses have a strange variance pattern. Except for their laws, which have to consider unexpressible constraints, anything that is an instance of Trans should automatically be an instance of ApTrans and MonadTrans, and anything that's an instance of ApTrans should automatically be an instance of MonadTrans.
If we move on to the mtl library, the classes there are also incompatible with an Applicative transformer stack. All of the mtl classes I'm familiar with have a Monad constraint. For example, here's MonadReader
class Monad m => MonadReader r m | m -> r where
-- | Retrieves the monad environment.
ask :: m r
ask = reader id
-- | Executes a computation in a modified environment.
local :: (r -> r) -- ^ The function to modify the environment.
-> m a -- ^ #Reader# to run in the modified environment.
-> m a
-- | Retrieves a function of the current environment.
reader :: (r -> a) -- ^ The selector function to apply to the environment.
-> m a
reader f = do
r <- ask
return (f r)
What is the purpose of the Monad constraint? It makes MonadReader and the MonadReader instances for many of the above transformers incompatible with Applicative transformer stacks.
I would naively write something like
class Reader r m | m -> r where
ask :: m r
local :: (r -> r) -> m a -> m a
or even split local into a separate class.
class Reader r m | m -> r where
ask :: m r
class (Reader r m) => Local r m | m -> r where
local :: (r -> r) -> m a -> m a
local might be quite hard to use without a Monad instance. A more useful interface without the Monad constraint would be something like
class (Reader r m) => Local r m | m -> r where
local :: m (r -> r) -> m a -> m a
Are there existing transformer classes somewhere that don't have the Monad constraint, or is there an actual need for yet another transformer class library?
Applicatives, unlike Monads, are closed under products and composition and thus don't need a special class of things like "transformers". Here's a small library:
data (*) f g x = P (f x) (g x) deriving Functor
data C f g x = C (f (g x)) deriving Functor
instance (Applicative f, Applicative g) => Applicative (f * g) where
pure a = P (pure a) (pure a)
P ff gf <*> P fx gx = P (ff <*> fx) (gf <*> gx)
instance (Applicative f, Applicative g) => Applicative (C f g) where
pure = C . pure . pure
C fgf <*> C fgx = C (liftA2 (<*>) fgf fgx)
Moreover, all monads are Applicatives so we ought to be able to reuse that code. Sadly, the lack of Applicative-Monad subtyping forces monadic code to be more exclusionary than needed and thus outlaws such code. It could have been rectified if all of these libraries asked for an (Applicative m, Monad m) constraint, but they do not. Furthermore, given how often you might otherwise have to write
(MonadReader m, Monad m) => ...
the Monad superclass constraint is convenient. I'm not sure it's completely necessary however.
As J. Abrahamson said, Applicatives are closed under products and composition, so there's no need for dedicated transformer versions. However, there's also no need to roll your own Applicative product/composition types, because the Platform already has these:
Data.Functor.Compose
Data.Functor.Product
Data.Functor.Constant
Data.Functor.Identity
Control.Applicative.Lift
I've found that the easier way to use these is with the GeneralizedNewtypeDeriving extension, because then you can just define types like these:
newtype MyType m a = MyType (Compose (Const m) (Reader m) a)
deriving (Functor, Applicative)
-- Plus a bunch of utility definitions to hide the use of Compose and generally
-- keep you sane...
Another other useful tool in the Applicative toolset is the free applicative functor. I normally use Edward Kmett's free library's version, but it's easy to roll your own if you want fewer dependencies.
These definitions can also be useful (though I'd welcome suggestions on the naming scheme, particularly the "I/O" bit):
{-# LANGUAGE Rank2Types, TypeOperators #-}
import Control.Applicative
import Data.Functor.Compose
-- | A handy infix type synonym for 'Compose', which allows us to
-- stack 'Applicative's with less syntactic noise:
--
-- > type CalculationT s p f = Reader (Frame s p) :. Reader (Cell s p) :. f
-- > type Calculation s p = Calculation s p Identity
--
-- Note that 'Identity' and ':.' form something a type-level monoid
-- modulo #newtype# equivalence. The following isomorphisms hold:
--
-- > f :. Identity ~= Identity :. f ~= f
-- > f :. g :. h ~= (f :. g) :. h
--
type f :. g = Compose f g
infixr :.
-- | Lift an action from the outer functor into the composite.
-- Alternative reading: append an 'Applicative' to the right of #f#.
liftO :: (Functor f, Applicative g) => f a -> (f :. g) a
liftO = Compose . fmap pure
-- | Lift an action from the inner functor into the composite.
-- Alternative reading: prepend an 'Applicative' to the left of #g#.
liftI :: Applicative f => g a -> (f :. g) a
liftI = Compose . pure
-- | Lift a natural transformation from #g# to #h# into a morphism
-- from #f :. g# to #h :. g#.
hoistO :: (forall x. f x -> h x) -> (f :. g) a -> (h :. g) a
hoistO eta = Compose . eta . getCompose
-- | Lift a natural transformation from #g# to #h# into a morphism
-- from #f :. g# to #f :. h#.
hoistI :: Functor f => (forall x. g x -> h x) -> (f :. g) a -> (f :. h) a
hoistI eta = Compose . fmap eta . getCompose
I'm currently working on Data.Fresh and Control.Monad.Trans.Fresh, which resp. define an interface for generating fresh variables, and a monad transformer which implements this interface.
I initially thought it would be possible to implement the Applicative instance for my FreshT v m with the only requirement that Applicative m exists. However, I got stuck and it seemed like I need to require Monad m. Not trusting my Haskell-fu, I then turned to the transformers package, and was surprised by what I found in Control.Monad.Trans.State.Lazy and .Strict:
instance (Functor m, Monad m) => Applicative (StateT s m) where
pure = return
(<*>) = ap
So here is my question: is it possible to create an instance with equivalent semantics with the following instance head?
instance (Applicative m) => Applicative (StateT s m) where
Consider that you have two functions:
f :: s -> m (s, a -> b)
g :: s -> m (s, a)
And you want to create a function h = StateT f <*> StateF g
h :: s -> m (s, b)
From the above you have an s you can pass to f so you have:
f' :: m (s, a -> b)
g :: s -> m (s, a)
However to get s out of f' you need the Monad (whatever you'd do with applicative it would still be in form of m s so you would not be able to apply the value to g).
You can play with the definitions and use free monad but for the collapse of state you need join.
Weaker variant of an Applicative transformer
Although it isn't possible to define an applicative transformer for StateT, It's possible to define a weaker variant that works. Instead of having s -> m (a, s), where the state decides the next effect (therefore m must be a monad), we can use m (s -> (a, s)), or equivalently m (State s a).
import Control.Applicative
import Control.Monad
import Control.Monad.State
import Control.Monad.Trans
newtype StateTA s m a = StateTA (m (State s a))
This is strictly weaker than StateT. Every StateTA can be made into StateT (but not vice versa):
toStateTA :: Applicative m => StateTA s m a -> StateT s m a
toStateTA (StateTA k) = StateT $ \s -> flip runState s <$> k
Defining Functor and Applicative is just the matter of lifting operations of State into the underlying m:
instance (Functor m) => Functor (StateTA s m) where
fmap f (StateTA k) = StateTA $ liftM f <$> k
instance (Applicative m) => Applicative (StateTA s m) where
pure = StateTA . pure . return
(StateTA f) <*> (StateTA k) = StateTA $ ap <$> f <*> k
And we can define an applicative variant of lift:
lift :: (Applicative m) => m a -> StateTA s m a
lift = StateTA . fmap return
Update: Actually the above isn't necessary, as the composition of two applicative functors is always an applicative functor (unlike monads). Our StateTA is isomorphic to Compose m (State s), which is automatically Applicative:
instance (Applicative f, Applicative g) => Applicative (Compose f g) where
pure x = Compose (pure (pure x))
Compose f <*> Compose x = Compose ((<*>) <$> f <*> x)
Therefore we could write just
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
import Control.Applicative
import Control.Monad.State
import Data.Functor.Compose
newtype StateTA s m a = StateTA (Compose m (State s) a)
deriving (Functor, Applicative)
Although, as noted in the previous answer, this instance cannot be defined in general, it is worth noting that, when f is Applicative and s is a Monoid, StateT s f is also Applicative, since it can be regarded as a composition of applicative functors:
StateT s f = Reader s `Compose` f `Compose` Writer s
I know with the data constructor and the run*** function,
I can lift any function to a specific MonadTrans instance.
Like this,
import Control.Monad.Trans
import Control.Monad.Trans.Maybe
import Control.Monad
liftF :: (Monad m) => (a -> b) -> MaybeT m a -> MaybeT m b
liftF f x = MaybeT $ do
inner <- runMaybeT x
return $ liftM f inner
But how can I generalize this liftF to
liftF :: (MonadTrans t, Monad m) => (a -> b) -> t m a -> t m b
As #thoferon mentioned, you can just use liftM:
import Control.Monad.Trans
import Control.Monad.Trans.Maybe
import Control.Monad (liftM)
liftF :: (Monad m) => (a -> b) -> MaybeT m a -> MaybeT m b
liftF f m = liftM f m
liftF' :: (MonadTrans t, Monad m, Monad (t m)) => (a -> b) -> t m a -> t m b
liftF' f m = liftM f m
(I had to add an additional Monad constraint to liftF').
But why would you do this? Check out the source code for MaybeT -- there's already a Monad instance:
instance (Monad m) => Monad (MaybeT m) where
fail _ = MaybeT (return Nothing)
return = lift . return
x >>= f = MaybeT $ do
v <- runMaybeT x
case v of
Nothing -> return Nothing
Just y -> runMaybeT (f y)
And actually, as liftM is the same as Functor's fmap:
instance (Functor m) => Functor (MaybeT m) where
fmap f = mapMaybeT (fmap (fmap f))
You can find similar instances for all the transformers.
Is this what you are asking? Can you provide some more concrete examples that show what you're trying to do and why, and in what way the existing Functor and Monad instances fail to meet your needs?