Suppose we have two monads, m and m'. Now, suppose we have variables,
-- in real problems, the restriction is some subclass MyMonad, so don't worry
-- if it's the case here that mx and f must essentially be pure.
mx :: Monad m'' => m'' a
f :: Monad m'' => a -> m'' b
Is there a way to create anything similar to the product m x m'? I know this is possible with Arrows, but it seems more complicated (impossible?) for monads, especially when trying to write what mx >>= f should do.
To see this, define
data ProdM a = ProdM (m a) (m' a)
instance Monad ProdM where
return x = ProdM (return x) (return x)
but now, when we define mx >>= f, it's not clear which value from mx to pass to f,
(ProdM mx mx') >>= f
{- result 1 -} = mx >>= f
{- result 2 -} = mx' >>= f
I want (mx >>= f) :: ProdM to be isomorphic to ((mx >>= f) :: m) x ((mx >>= f) :: m').
Yes, this type is a monad. The key is simply to pass both results to f, and only keep the matching field from the result. That is, we keep the first element from the result of passing mx's result, and the second element from the result of passing mx''s result. The instance looks like this:
instance (Monad m, Monad m') => Monad (ProdM m m') where
return a = ProdM (return a) (return a)
ProdM mx mx' >>= f = ProdM (mx >>= fstProd . f) (mx' >>= sndProd . f)
where fstProd (ProdM my _) = my
sndProd (ProdM _ my') = my'
ProdM is available in the monad-products package under the name Product.
Related
As a part of self-learning exercise in Haskell, I am trying to derive a Monad instance for my type. The type is defined as:
newtype ParsePackUnpack f a = ParsePackUnpack
{
unparse:: State PackUnpackState (Ap f a)
}
where Ap f a comes from Data.Monoid. With my type, I'm trying to say that parsing is a stateful operation with the result being any monoid.
So far, I have been successful in implementing Functor and Applicative instances for this 3 level deep type by lifting:
instance Functor f => Functor (ParsePackUnpack f) where
fmap f ma =
let f' = fmap f -- lift (a -> b) to (Ap f a -> Ap f b)
in ParsePackUnpack $ f' <$> (unparse ma)
instance Applicative f => Applicative (ParsePackUnpack f) where
pure = ParsePackUnpack . pure . pure
f <*> ma =
let f' = liftA2 (<*>) . unparse $ f -- lift Ap f (a -> b) -> Ap f a -> Ap f b to State s (Ap f a) -> State s (Ap f b)
in ParsePackUnpack $ f' (unparse ma) -- Apply to State s (Ap f a)
But I could not derive a Monad instance for my type correctly. After some type-golfing, this is my latest attempt:
instance Monad f => Monad (ParsePackUnpack f) where
return = ParsePackUnpack . return . return
ma >>= f = ParsePackUnpack . state $ \st ->
let (a, s) = runState (unparse ma) st
res = a >>= fst . flip runState s . unparse . f -- fst ignores state from the result
in (res, s)
Which I believe is incorrect because I am ignoring the state from res operation.
What is correct way to implement the >>= operation for my type? As this is a learning exercise, I'm trying to avoid Monad transformers. If Monad transformers is the way to go, could you also explain why that is the case?
Monads do not compose as nicely as applicatives. While f (g a) is an applicative whenever f and g are (thus your ability to write the applicative instance), it is not in general a monad when f and g are monads. That's why we need monad transformers but not applicative transformers.
Here's a related exercise. Forget about using State from the library, let's just work with its representation manually. State s (IO a) unrolls into s -> (IO a, s). To implement bind, you would be given
f :: s -> (IO a, s)
g :: a -> s -> (IO b, s)
Can you come up with how to feed the first to the second, passing s through "statefully"?
bound :: s -> (IO b, s)
bound s0 = ??
Give it a try. And (spoiler) after you've convinced yourself it's impossible, think about what makes it impossible, and how you would need to modify the types to make it possible. Then use that pattern to define a "StateIO s" monad.
The streaming package defines a Stream type that looks like the following:
data Stream f m r
= Step !(f (Stream f m r))
| Effect (m (Stream f m r))
| Return r
There is a comment on the Stream type that says the following:
The Stream data type is equivalent to FreeT and can represent any effectful succession of steps, where the form of the steps or 'commands' is specified by the first (functor) parameter.
I'm wondering how the Stream type is equivalent to FreeT?
Here is the definition of FreeT:
data FreeF f a b = Pure a | Free (f b)
newtype FreeT f m a = FreeT { runFreeT :: m (FreeF f a (FreeT f m a)) }
It looks like it is not possible to create an isomorphism between these two types.
To be specific, I don't see a way to write the following two functions that makes them an isomorphism:
freeTToStream :: FreeT f m a -> Stream f m a
streamToFreeT :: Stream f m a -> FreeT f m a
For instance, I'm not sure how to express a value like Return "hello" :: Stream f m String as a FreeT.
I guess it could be done like the following, but the Pure "hello" is necessarily going to be wrapped in an m, while in Return "hello" :: Stream f m String it is not:
FreeT $ pure $ Pure "hello" :: Applicative m => FreeT f m a
Can Stream be considered equivalent to FreeT even though it doesn't appear possible to create an isomorphism between them?
There are some small differences that make them not literally equivalent. In particular, FreeT enforces an alternation of f and m,
FreeT f m a = m (Either a (f (FreeT f m a) = m (Either a (f (m (...))))
-- m f m -- alternating
whereas Stream allows stuttering, e.g., we can construct the following with no Step between two Effect:
Effect (return (Effect (return (Return r))))
which should be equivalent in some sense to
Return r
Thus we shall take a quotient of Stream by the following equations that flatten the layers of Effect:
Effect (m >>= \a -> return (Effect (k a))) = Effect (m >>= k)
Effect (return x) = x
Under that quotient, the following are isomorphisms
freeT_stream :: (Functor f, Monad m) => FreeT f m a -> Stream f m a
freeT_stream (FreeT m) = Effect (m >>= \case
Pure r -> return (Return r)
Free f -> return (Step (fmap freeT_stream f))
stream_freeT :: (Functor f, Monad m) => Stream f m a -> FreeT f m a
stream_freeT = FreeT . go where
go = \case
Step f -> return (Free (fmap stream_freeT f))
Effect m -> m >>= go
Return r -> return (Pure r)
Note the go loop to flatten multiple Effect constructors.
Pseudoproof: (freeT_stream . stream_freeT) = id
We proceed by induction on a stream x. To be honest, I'm pulling the induction hypotheses out of thin air. There are certainly cases where induction is not applicable. It depends on what m and f are, and there might also be some nontrivial setup to ensure this approach makes sense for a quotient type. But there should still be many concrete m and f where this scheme is applicable. I hope there is some categorical interpretation that translates this pseudoproof to something meaningful.
(freeT_stream . stream_freeT) x
= freeT_stream (FreeT (go x))
= Effect (go x >>= \case
Pure r -> return (Return r)
Free f -> return (Step (fmap freeT_stream f)))
Case x = Step f, induction hypothesis (IH) fmap (freeT_stream . stream_freeT) f = f:
= Effect (return (Step (fmap freeT_stream (fmap stream_freeT f))))
= Effect (return (Step f)) -- by IH
= Step f -- by quotient
Case x = Return r
= Effect (return (Return r))
= Return r -- by quotient
Case x = Effect m, induction hypothesis m >>= (return . freeT_stream . stream_freeT)) = m
= Effect ((m >>= go) >>= \case ...)
= Effect (m >>= \x' -> go x' >>= \case ...) -- monad law
= Effect (m >>= \x' -> return (Effect (go x' >>= \case ...))) -- by quotient
= Effect (m >>= \x' -> (return . freeT_stream . stream_freeT) x') -- by the first two equations above in reverse
= Effect m -- by IH
Converse left as an exercise.
Both your example with Return and my example with nested Effect constructors cannot be represented by FreeT with the same parameters f and m. There are more counterexamples, too. The underlying difference in the data types can best be seen in a hand-wavey space where the data constructors are stripped out and infinite types are allowed.
Both Stream f m a and FreeT f m a are for nesting an a type inside a bunch of f and m type constructors. Stream allows arbitrary nesting of f and m, while FreeT is more rigid. It always has an outer m. That contains either an f and another m and repeats, or an a and terminates.
But that doesn't mean there isn't an equivalence of some sort between the types. You can show some equivalence by showing that each type can be embedded inside the other faithfully.
Embedding a Stream inside a FreeT can be done on the back of one observation: if you choose an f' and m' such that the f and m type constructors are optional at each level, you can model arbitrary nesting of f and m. One quick way to do that is use Data.Functor.Sum, then write a function:
streamToFreeT :: Stream f m a -> FreeT (Sum Identity f) (Sum Identity m) a
streamToFreeT = undefined -- don't have a compiler nearby, not going to even try
Note that the type won't have the necessary instances to function. That could be corrected by switching Sum Identity to a more direct type that actually has an appropriate Monad instance.
The transformation back the other direction doesn't need any type-changing trickery. The more restricted shape of FreeT is already directly embeddable inside Stream.
I'd say this makes the documentation correct, though possibly it should use a more precise term than "equivalent". Anything you can construct with one type, you can construct with the other - but there might be some extra interpretation of the embedding and a change of variables involved.
I've just read this very interesting article about an alternative implementation for the Prompt Monad : http://joeysmandatory.blogspot.com/2012/06/explaining-prompt-monad-with-simpler.html
Here is a simplified code that can be run :
data Request a where
GetLine :: Request String
PutStrLn :: String -> Request ()
data Prompt p r
= forall a. Ask (p a) (a -> Prompt p r)
| Answer r
instance Monad (Prompt p) where
return = Answer
Ask req cont >>= k = Ask req (\ans -> cont ans >>= k)
Answer x >>= k = k x
prompt :: p a -> Prompt p a
prompt req = Ask req Answer
runPromptM :: Monad m => (forall a. p a -> m a) -> Prompt p r -> m r
runPromptM perform (Ask req cont) = perform req
>>= runPromptM perform . cont
runPromptM _ (Answer r) = return r
handleIO :: Request a -> IO a
handleIO GetLine = return ""
handleIO (PutStrLn s) = putStrLn s
req :: Prompt Request ()
req = do
answers <- sequence $ replicate 20000 (prompt GetLine)
prompt $ PutStrLn (concat answers)
main = runPromptM handleIO req
A comment in the article mentions that :
it has a problem that left recursion of >>= takes quadratic time to evaluate (it's the same as the left-recursion of ++ problem!)
I don't understand where the quadratic time (which I checked experimentally) come from. Is it related to lazy evaluation ?
Can someone explain me why ?
I feel this is a little easier to explain using the Free monad over Prompt, though they are very similar.
data Free f a = Pure a | Free (f (Free f a)) deriving Functor
The Free monad is either a completed operation marked by Pure or an f-indexed effect marked by Free. If f is a Functor then Free f is a Monad
instance Functor f => Monad (Free f) where
return = Pure
Pure a >>= f = f a
Free m >>= f = Free (fmap (>>= f) m)
This Monad instance work by "pushing" binds down through the layers of the Functor to reach the Pure nodes at the bottom and then applying f. What's important about this is that the number of Functor layers does not change. To wit, here's an example bind occurring in Free Maybe ().
Free (Just (Free (Just (Free Nothing)))) >>= (const (return ()))
Free (fmap (>>= (const (return ()))) (Just (Free (Just (Free Nothing))))
Free (Just (Free (Just (Free Nothing)) >>= (const (return ())))
Free (Just (Free (fmap (>>= (const (return ()))) (Just (Free Nothing))))
Free (Just (Free (Just (Free Nothing >>= (const (return ()))))))
Free (Just (Free (Just (Free Nothing))))
We see here a hint of what's to come—we had to traverse the entire tree down to the root just to do nothing at all.
The "Tree-Grafting" Substitution Monad
One way to see the Free monad is to think of it as the "substitution monad". Its bind looks like
(=<<) :: (a -> Free f b) -> Free f a -> Free f b
and if you think of a -> Free f b as converting Pure leaf values into new trees of effects then (=<<) just descends through the tree of effects Free f a and performs substitution over the a values.
Now if we have a chain of right associating binds (written using Kleisli composition (>=>) to prove that reassociation is valid—Kleisli arrows are a category)
f >=> (g >=> h)
then we only must descend into the tree once—the substitution function is computed at all of the nodes of the tree. However, if we're associated the other direction
(f >=> g) >=> h
we get the same result, but must compute the entire result (f >=> g) before we're able to apply the substitution function in h. What this means is that if we have a deeply nested left-associated bind sequence
((((f >=> g) >=> h) >=> i) >=> j) >=> k
then we're continually recomputing the left results so that we can recurse on them. This is where the quadratic slowdown appears.
Speedup with Codensity
There's a really strange type called Codensity which is related to continuation passing style and the ContT monad.
data Codensity m a = Codensity { runCodensity :: forall b . (a -> m b) -> m b }
-- Codensity m a = forall b . ContT b m a
Codensity has the interesting property that it's a Functor even when m isn't:
instance Functor (Codensity m) where
fmap f m = Codensity (\amb -> runCodensity m (amb . f))
and the unique property that it's a Monad even when m isn't:
instance Monad (Codensity m) where
return a = Codensity (\amb -> amb a)
m >>= f = Codensity (\bmc -> runCodensity m (\a -> runCodensity (f a) bmc))
We can also round-trip Monads through Codensity
toCodensity :: Monad m => m a -> Codensity m a
toCodensity ma = Codensity (\amb -> ma >>= amb)
fromCodensity :: Monad m => Codensity m a -> m a
fromCodensity m = runCodensity m return
roundtrip :: Monad m => m a -> m a
roundtrip = fromCodensity . toCodensity
but when we do this something very, very interesting happens: all of the binds become right-associated!.
Consider the classic left associated append problem. You are probably aware that whenever you have a series of left associated append-like functions (I'll use (++) here), you run into O(n^2) issues:
(((as ++ bs) ++ cs) ++ ds) ++ ...
It is easy to see that each additional append will have to traverse the entire length of the previously appended list, resulting in horrendously slow O(n^2) algorithm.
The solution is to right associate:
as ++ (bs ++ (cs ++ (ds ++ ...)))
This is O(a + b + c + d + ...) where a is the length of as, etc. or simply O(n) in the length of the total list.
Now, what does this have to do with Free? Let's suggestively compare the definition of Free with []:
data Free f r = Pure r | Free (f (Free f r))
data [] a = [] | Cons a [a]
While [] has values at each Cons node, Free only has a value at the Pure tip. Apart from that the definitions are very similar. A good intuition for Free is that it is a list-like data structure of Functors.
Now the Monad instance for Free, we only care about (>>=):
Pure r >>= f = f r
Free x >>= f = Free (fmap (>>= f) x)
Notice that (>>=) traverses the structure of Free until it reaches the Pure value, and then grafts (appends) additional Free structure onto the end. Remarkably similar to (++)!
With this intuition of Free as a list of Functor, and (>>=) behaving as (++), it should be clear why left associated (>>=) causes problems.
I am looking for a function that basically is like mapM on a list -- it performs a series of monadic actions taking every value in the list as a parameter -- and each monadic function returns m (Maybe b). However, I want it to stop after the first parameter that causes the function to return a Just value, not execute any more after that, and return that value.
Well, it'll probably be easier to just show the type signature:
findM :: (Monad m) => (a -> m (Maybe b)) -> [a] -> m (Maybe b)
where b is the first Just value. The Maybe in the result is from the finding (in case of an empty list, etc.), and has nothing to do with the Maybe returned by the Monadic function.
I can't seem to implement this with a straightforward application of library functions. I could use
findM f xs = fmap (fmap fromJust . find isJust) $ mapM f xs
which will work, but I tested this and it seems that all of the monadic actions are executed before calling find, so I can't rely on laziness here.
ghci> findM (\x -> print x >> return (Just x)) [1,2,3]
1
2
3
-- returning IO (Just 1)
What is the best way to implement this function that won't execute the monadic actions after the first "just" return? Something that would do:
ghci> findM (\x -> print x >> return (Just x)) [1,2,3]
1
-- returning IO (Just 1)
or even, ideally,
ghci> findM (\x -> print x >> return (Just x)) [1..]
1
-- returning IO (Just 1)
Hopefully there is an answer that doesn't use explicit recursion, and are compositions of library functions if possible? Or maybe even a point-free one?
One simple point-free solution is using the MaybeT transformer. Whenever we see m (Maybe a) we can wrap it into MaybeT and we get all MonadPlus functions immediately. Since mplus for MaybeT does exactly we need - it runs the second given action only if the first one resulted in Nothing - msum does exactly what we need:
import Control.Monad
import Control.Monad.Trans.Maybe
findM :: (Monad m) => (a -> m (Maybe b)) -> [a] -> m (Maybe b)
findM f = runMaybeT . msum . map (MaybeT . f)
Update: In this case, we were lucky that there exists a monad transformer (MaybeT) whose mplus has just the semantic we need. But in a general case, it can be that it won't be possible to construct such a transformer. MonadPlus has some laws that must be satisfied with respect to other monadic operations. However, all is not lost, as we actually don't need a MonadPlus, all we need is a proper monoid to fold with.
So let's pretend we don't (can't) have MaybeT. Computing the first value of some sequence of operations is described by the First monoid. We just need to make a monadic variant that won't execute the right part, if the left part has a value:
newtype FirstM m a = FirstM { getFirstM :: m (Maybe a) }
instance (Monad m) => Monoid (FirstM m a) where
mempty = FirstM $ return Nothing
mappend (FirstM x) (FirstM y) = FirstM $ x >>= maybe y (return . Just)
This monoid exactly describes the process without any reference to lists or other structures. Now we just fold over the list using this monoid:
findM' :: (Monad m) => (a -> m (Maybe b)) -> [a] -> m (Maybe b)
findM' f = getFirstM . mconcat . map (FirstM . f)
Moreover, it allows us to create a more generic (and even shorter) function using Data.Foldable:
findM'' :: (Monad m, Foldable f)
=> (a -> m (Maybe b)) -> f a -> m (Maybe b)
findM'' f = getFirstM . foldMap (FirstM . f)
I like Cirdec's answer if you don't mind recursion, but I think the equivalent fold based answer is quite pretty.
findM f = foldr test (return Nothing)
where test x m = do
curr <- f x
case curr of
Just _ -> return curr
Nothing -> m
A nice little test of how well you understand folds.
This should do it:
findM _ [] = return Nothing
findM filter (x:xs) =
do
match <- filter x
case match of
Nothing -> findM filter xs
_ -> return match
If you really want to do it points free (added as an edit)
The following would find something in a list using an Alternative functor, using a fold as in jozefg's answer
findA :: (Alternative f) => (a -> f b) -> [a] -> f b
findA = flip foldr empty . ((<|>) .)
I don't thing we can make (Monad m) => m . Maybe an instance of Alternative, but we could pretend there's an existing function:
-- Left biased choice
(<||>) :: (Monad m) => m (Maybe a) -> m (Maybe a) -> m (Maybe a)
(<||>) left right = left >>= fromMaybe right . fmap (return . Just)
-- Or its hideous points-free version
(<||>) = flip ((.) . (>>=)) (flip ((.) . ($) . fromMaybe) (fmap (return . Just)))
Then we can define findM in the same vein as findA
findM :: (Monad m) => (a -> m (Maybe b)) -> [a] -> m (Maybe b)
findM = flip foldr (return Nothing) . ((<||>) .)
This can be expressed pretty nicely with the MaybeT monad transformer and Data.Foldable.
import Data.Foldable (msum)
import Control.Monad.Trans.Maybe (MaybeT(..))
findM :: Monad m => (a -> m (Maybe b)) -> [a] -> m (Maybe b)
findM f = runMaybeT . msum . map (MaybeT . f)
And if you change your search function to produce a MaybeT stack, it becomes even nicer:
findM' :: Monad m => (a -> MaybeT m b) -> [a] -> MaybeT m b
findM' f = msum . map f
Or in point-free:
findM' = (.) msum . map
The original version can be made fully point-free as well, but it becomes pretty unreadable:
findM = (.) runMaybeT . (.) msum . map . (.) MaybeT
The problem is this. I have:
f :: MonadIO m => ReaderT FooBar m Answer;
f = (liftIO getArgs) >>= ...
I need to run this with modified arguments. However, since m is unknown, I cannot simply use
mapReaderT (withArgs args) :: ReaderT r IO b -> ReaderT r IO b
since I need somehow to transform (withArgs args) into m for all m.
One possibility I found is to define my own withArgs, thus:
import System.Environment (setArgs, freeArgv);
withArgv new_args act = do {
pName <- liftIO System.Environment.getProgName;
existing_args <- liftIO System.Environment.getArgs;
bracket (liftIO $ setArgs new_args)
(\argv -> do {
_ <- liftIO $ setArgs (pName:existing_args);
liftIO $ freeArgv argv;
})
(const act);
};
withArgs xs act = do {
p <- liftIO System.Environment.getProgName;
withArgv (p:xs) act;
};
However, this is a kludge, and specific to one function -- I would need to re-write every withX :: X -> IO a -> IO a, e.g. Control.Exception.handle
What, if any, is a better way to do this?
Edit: In the case of handle, I found Control.Monad.CatchIO. In the other case, I used yet another, briefer kludge (not worth posting) to avoid the kludge above. Still seeking a better solution!
Part of what you are looking for is a hoisting of a monad homomorphism into a monad transformer.
class MonadHoist t where
hoist :: (Monad m, Monad n) => (forall a. m a -> n a) -> t m a -> t n a
t :: Monad m => t Identity a -> t m a
t = hoist (return . runIdentity)
That is to say, given a monad homomorphism f from m to n, you can obtain a monad homomorphism from t m to t n using hoist.
A monad homomorphism is slightly stronger than the types above enforce, namely it is responsible for preserving the monad laws.
f . return = return
f . fmap g = fmap g . f
f . join = join . f . fmap f
= join . fmap f . f -- by the second law
= (>>= f) . f -- >>= in terms of join
Notice the quantifier that I snuck in the type of hoist, MonadHoist turns out to need that flexibility for almost all instances! (Reader happens to be the one case where it doesn't. Try to write MaybeT without it.)
Monad transformers can, in general, instantiate this class. For instance:
instance MonadHoist (StateT s) where
hoist f (StateT m) = StateT (f . m)
instance MonadHoist (ReaderT e) where
hoist f (ReaderT m) = ReaderT (f . m)
instance MonadHoist MaybeT where
hoist f (MaybeT m) = MaybeT (f m)
We don't currently provide it in transformers or mtl package because it would require a Rank2Type, but it is pretty straightforward to implement.
If there is enough demand for it, I'll happily package it up in a monad-extras package.
Now, I said part, because while this answers the question given by the type in the topic of your post, it doesn't address the need reflected by the bulk of the text associated with your question!
For that, you probably want to follow luqui's advice. =)
The monad-control package will do this. I think you want the function liftIOOp_ from Control.Monad.IO.Control.
Specifically,
liftIOOp_ (withArgs newArgs) f
should do what you want. You can lift things like bracket too, with the liftIOOp function.
I believe the interleavableIO package addresses this problem. It is discussed in this cafe thread.
It seems you can use runReaderT to get the effect you want, as well:
*> :t withArgs [] (runReaderT f FooBar)
withArgs [] (runReaderT f FooBar) :: IO Answer
where FooBar is some data constructor and f is defined as above.