I wound up with this skeleton:
f :: (Monad m) => b -> m ()
f x = traverse_ (f . g x) =<< h x -- how avoid explicit recursion?
g :: b -> a -> b
-- h :: (Foldable t) => b -> m (t a) -- why "Could not deduce (Foldable t0) arising from a use of ‘traverse_’"
h :: b -> m [a]
How can I avoid the explicit recursion in f?
Bonus: When I try to generalize h from [] to Foldable, f does not type check (Could not deduce (Foldable t0) arising from a use of ‘traverse_’) -- what am I doing wrong?
UPDATE:
Here's the real code. The Right side is for recursing down directories of security camera footage whose names are integers. Left is the base case to process leaves whose names are not integers.
a <|||> b = left a . right b
doDir (Right d) = traverse_ (doDir . doInt) =<< listDirectory d
where doInt s = ((<|||>) <$> (,) <*> const) (d </> s) $ (TR.readEither :: String -> Either String Int) s
f = doDir and g ~ doInt but got refactored a little. h = listDirectory. to answer the bonus, i was just being silly and wasn't seeing that i had to combine all the definitions to bind the types together:
f :: (Monad m, Foldable t) => (b -> a -> b) -> (b -> m (t a)) -> b -> m ()
f g h x = traverse_ (f g h . g x) =<< h x
If you don't mind leaking a bit of memory building a Tree and then throwing it away, you can use unfoldTreeM:
f = unfoldTreeM (\b -> (\as -> ((), g b <$> as)) <$> h b)
I do not believe there is a corresponding unfoldTreeM_, but you could write one (using explicit recursion). To generalize beyond the Tree/[] connection, you might also like refoldM; you can find several similar functions if you search for "hylomorphism" on Hackage.
Related
How Can I instantiate the following data types to be Functor ?
data LiftItOut f a = LiftItOut (f a)
data Parappa f g a = DaWrappa (f a) (g a)
data IgnoreOne f g a b = IgnoringSomething (f a) (g b)
data Notorious g o a t = Notorious (g o) (g a) (g t)
There are not very clear for the declaration themselves, inside the parantheses in the right member, is that function application (I ve never seen that, only basic type constructors)? I am new to haskell and I am just trying to understand the basics.
Ask the compiler to show you how. Use the command line flag -ddump-deriv, enable the DeriveFunctor language extension, and put deriving Functor at the end of each type definition, and then the compiler will print Functor instances for each of them:
==================== Derived instances ====================
Derived class instances:
instance GHC.Base.Functor g =>
GHC.Base.Functor (Main.Notorious g o a) where
GHC.Base.fmap f_aK1 (Main.Notorious a1_aK2 a2_aK3 a3_aK4)
= Main.Notorious a1_aK2 a2_aK3 (GHC.Base.fmap f_aK1 a3_aK4)
(GHC.Base.<$) z_aK5 (Main.Notorious a1_aK6 a2_aK7 a3_aK8)
= Main.Notorious a1_aK6 a2_aK7 ((GHC.Base.<$) z_aK5 a3_aK8)
instance forall k (f :: k -> *) (g :: * -> *) (a :: k).
GHC.Base.Functor g =>
GHC.Base.Functor (Main.IgnoreOne f g a) where
GHC.Base.fmap f_aK9 (Main.IgnoringSomething a1_aKa a2_aKb)
= Main.IgnoringSomething a1_aKa (GHC.Base.fmap f_aK9 a2_aKb)
(GHC.Base.<$) z_aKc (Main.IgnoringSomething a1_aKd a2_aKe)
= Main.IgnoringSomething a1_aKd ((GHC.Base.<$) z_aKc a2_aKe)
instance (GHC.Base.Functor f, GHC.Base.Functor g) =>
GHC.Base.Functor (Main.Parappa f g) where
GHC.Base.fmap f_aKf (Main.DaWrappa a1_aKg a2_aKh)
= Main.DaWrappa
(GHC.Base.fmap f_aKf a1_aKg) (GHC.Base.fmap f_aKf a2_aKh)
(GHC.Base.<$) z_aKi (Main.DaWrappa a1_aKj a2_aKk)
= Main.DaWrappa
((GHC.Base.<$) z_aKi a1_aKj) ((GHC.Base.<$) z_aKi a2_aKk)
instance GHC.Base.Functor f =>
GHC.Base.Functor (Main.LiftItOut f) where
GHC.Base.fmap f_aKl (Main.LiftItOut a1_aKm)
= Main.LiftItOut (GHC.Base.fmap f_aKl a1_aKm)
(GHC.Base.<$) z_aKn (Main.LiftItOut a1_aKo)
= Main.LiftItOut ((GHC.Base.<$) z_aKn a1_aKo)
That's kind of messy-looking, but it's rather straightforward to clean up:
data LiftItOut f a = LiftItOut (f a)
instance Functor f => Functor (LiftItOut f) where
fmap f (LiftItOut a) = LiftItOut (fmap f a)
data Parappa f g a = DaWrappa (f a) (g a)
instance (Functor f, Functor g) => Functor (Parappa f g) where
fmap f (DaWrappa a1 a2) = DaWrappa (fmap f a1) (fmap f a2)
data IgnoreOne f g a b = IgnoringSomething (f a) (g b)
instance Functor g => Functor (IgnoreOne f g a) where
fmap f (IgnoringSomething a1 a2) = IgnoringSomething a1 (fmap f a2)
data Notorious g o a t = Notorious (g o) (g a) (g t)
instance Functor g => Functor (Notorious g o a) where
fmap f (Notorious a1 a2 a3) = Notorious a1 a2 (fmap f a3)
Also worth noting that your LiftItOut is isomorphic to Ap and IdentityT, and your Parappa is isomorphic to Product.
A functor f is a type constructor with an associated function fmap that from a function of type (a -> b) creates a function of type (f a) -> (f b) which applies it "on the inside": (the parentheses are redundant and are used for clarity/emphasis only)
fmap :: (Functor f) => ( a -> b)
-> (f a) -> (f b)
-- i.e. g :: a -> b -- from this
-- --------------------------
-- fmap g :: (f a) -> (f b) -- we get this
(read it "fmap of g from a to b goes from f a to f b").
Put differently, something being a "Functor" means that it can be substituted for f in
fmap id (x :: f a) = x
(fmap g . fmap h) = fmap (g . h)
so that the expressions involved make sense (i.e. are well formed, i.e. have a type), and, importantly, the above equations hold -- they are in fact the two "Functor laws".
You have
data LiftItOut h a = MkLiftItOut (h a) -- "Mk..." for "Make..."
------------- ----------- ------
new type, data type of the data constructor's
defined here constructor one argument (one field)
This means h a is a type of a thing which can serve as an argument to MkLiftItOut. For example, Maybe Int (i.e. h ~ Maybe and a ~ Int), [(Float,String)] (i.e. h ~ [] and a ~ (Float,String)), etc.
h, a are type variables -- meaning, they can be replaced by any specific type so that the whole syntactic expressions make sense.
These syntactic expressions include MkLiftItOut x which is a thing of type LiftItOut h a provided x is a thing of type h a; LiftItOut h a which is a type; h a which is a type of a thing which can appear as an argument to MkLiftItOut. Thus we can have in our programs
v1 = MkLiftItOut ([1,2,3] :: [] Int ) :: LiftItOut [] Int
v2 = MkLiftItOut ((Just "") :: Maybe String) :: LiftItOut Maybe String
v3 = MkLiftItOut (Nothing :: Maybe () ) :: LiftItOut Maybe ()
.....
etc. Then we have
ghci> :i Functor
class Functor (f :: * -> *) where
fmap :: (a -> b) -> f a -> f b
(<$) :: a -> f b -> f a
..........
This means that Functor f => (f a) is a type of a thing which a variable can reference, e.g.
-- f a
v4 = Just 4 :: Maybe Int
v41 = 4 :: Int
v5 = [4.4, 5.5] :: [] Float
v51 = 4.4 :: Float
v52 = 5.5 :: Float
v6 = (1,"a") :: ((,) Int) String -- or simpler, `(Int, String)`
v61 = "a" :: String
v7 = (\x -> 7) :: ((->) Int) Int -- or simpler, `Int -> Int`
Here a is a type of a thing, f a is a type of a thing, f is a type which, when given a type of a thing, becomes a type of a thing; etc. There's no thing which can be referenced by a variable which would have the type f on its own.
All the above fs are instances of the Functor typeclass. This means that somewhere in the libraries there are definitions of
instance Functor Maybe where ....
instance Functor [] where ....
instance Functor ((,) a) where ....
instance Functor ((->) r) where ....
Notice we always have the f, and the a. f in particular can be made of more than one constituents, but a is always some one type.
Thus in this case we must have
instance Functor (LiftItOut h) where ....
(...why? do convince yourself in this; see how all the above statements apply and are correct)
Then the actual definition must be
-- fmap :: (a -> b) -> f a -> f b
-- fmap :: (a -> b) -> LiftItOut h a -> LiftItOut h b
fmap g (MkLiftItOut x ) = (MkLiftItOut y )
where
y = ....
In particular, we'll have
-- g :: a -> b -- x :: (h a) -- y :: (h b)
and we don't even know what the h is.
How can we solve this? How can we construct an h b-type of thing from an h a-type of thing when we don't even know anything about h, a, nor b?
We can't.
But what if we knew that h is also a Functor?
instance (Functor h) => Functor (LiftItOut h) where
-- fmap :: (a -> b) -> (f a) -> (f b)
-- fmap :: (a -> b) -> (LiftItOut h a) -> (LiftItOut h b)
fmap g (MkLiftItOut x ) = (MkLiftItOut y )
where
-- fmap :: (a -> b) -> (h a) -> (h b)
y = ....
Hopefully you can finish this up. And also do the other types in your question as well. If not, post a new question for the one type with which you might have any further problems.
class Applicative f => Monad f where
return :: a -> f a
(>>=) :: f a -> (a -> f b) -> f b
(<*>) can be derived from pure and (>>=):
fs <*> as =
fs >>= (\f -> as >>= (\a -> pure (f a)))
For the line
fs >>= (\f -> as >>= (\a -> pure (f a)))
I am confused by the usage of >>=. I think it takes a functor f a and a function, then return another functor f b. But in this expression, I feel lost.
Lets start with the type we're implementing:
(<*>) :: Monad f => f (a -> b) -> f a -> f b
(The normal type of <*> of course has an Applicative constraint, but here we're trying to use Monad to implement Applicative)
So in fs <*> as = _, fs is an "f of functions" (f (a -> b)), and as is an "f of as".
We'll start by binding fs:
(<*>) :: Monad f => f ( a -> b) -> f a -> f b
fs <*> as
= fs >>= _
If you actually compile that, GHC will tell us what type the hole (_) has:
foo.hs:4:12: warning: [-Wtyped-holes]
• Found hole: _ :: (a -> b) -> f b
Where: ‘a’, ‘f’, ‘b’ are rigid type variables bound by
the type signature for:
(Main.<*>) :: forall (f :: * -> *) a b.
Monad f =>
f (a -> b) -> f a -> f b
at foo.hs:2:1-45
That makes sense. Monad's >>= takes an f a on the left and a function a -> f b on the right, so by binding an f (a -> b) on the left the function on the right gets to receive an (a -> b) function "extracted" from fs. And provided we can write a function that can use that to return an f b, then the whole bind expression will return the f b we need to meet the type signature for <*>.
So it'll look like:
(<*>) :: Monad f => f ( a -> b) -> f a -> f b
fs <*> as
= fs >>= (\f -> _)
What can we do there? We've got f :: a -> b, and we've still got as :: f a, and we need to make an f b. If you're used to Functor that's obvious; just fmap f as. Monad implies Functor, so this does in fact work:
(<*>) :: Monad f => f ( a -> b) -> f a -> f b
fs <*> as
= fs >>= (\f -> fmap f as)
It's also, I think, a much easier way to understand the way Applicative can be implemented generically using the facilities from Monad.
So why is your example written using another >>= and pure instead of just fmap? It's kind of harkening back to the days when Monad did not have Applicative and Functor as superclasses. Monad always "morally" implied both of these (since you can implement Applicative and Functor using only the features of Monad), but Haskell didn't always require there to be these instances, which leads to books, tutorials, blog posts, etc explaining how to implement these using only Monad. The example line given is simply inlining the definition of fmap in terms of >>= and pure (return)1.
I'll continue to unpack as if we didn't have fmap, so that it leads to the version you're confused by.
If we're not going to use fmap to combine f :: a -> b and as :: f a, then we'll need to bind as so that we have an expression of type a to apply f to:
(<*>) :: Monad f => f ( a -> b) -> f a -> f b
fs <*> as
= fs >>= (\f -> as >>= (\a -> _))
Inside that hole we need to make an f b, and we have f :: a -> b and a :: a. f a gives us a b, so we'll need to call pure to turn that into an f b:
(<*>) :: Monad f => f ( a -> b) -> f a -> f b
fs <*> as
= fs >>= (\f -> as >>= (\a -> pure (f a)))
So that's what this line is doing.
Binding fs :: f (a -> b) to get access to an f :: a -> b
Inside the function that has access to f it's binding as to get access to a :: a
Inside the function that has access to a (which is still inside the function that has access to f as well), call f a to make a b, and call pure on the result to make it an f b
1 You can implement fmap using >>= and pure as fmap f xs = xs >>= (\x -> pure (f x)), which is also fmap f xs = xs >>= pure . f. Hopefully you can see that the inner bind of your example is simply inlining the first version.
Applicative is a Functor. Monad is also a Functor. We can see the "Functorial" values as standing for computations of their "contained" ⁄ produced pure values (like IO a, Maybe a, [] a, etc.), as being the allegories of ⁄ metaphors for the various kinds of computations.
Functors describe ⁄ denote notions ⁄ types of computations, and Functorial values are reified computations which are "run" ⁄ interpreted in a separate step which is thus akin to that famous additional indirection step by adding which, allegedly, any computational problem can be solved.
Both fs and as are your Functorial values, and bind ((>>=), or in do notation <-) "gets" the carried values "in" the functor. Bind though belongs to Monad.
What we can implement in Monad with (using return as just a synonym for pure)
do { f <- fs ; -- fs >>= ( \ f -> -- fs :: F (a -> b) -- f :: a -> b
a <- as ; -- as >>= ( \ a -> -- as :: F a -- a :: a
return (f a) -- return (f a) ) ) -- f a :: b
} -- :: F b
( or, with MonadComprehensions,
[ f a | f <- fs, a <- as ]
), we get from the Applicative's <*> which expresses the same computation combination, but without the full power of Monad. The difference is, with Applicative as is not dependent on the value f there, "produced by" the computation denoted by fs. Monadic Functors allow such dependency, with
[ bar x y | x <- xs, y <- foo x ]
but Applicative Functors forbid it.
With Applicative all the "computations" (like fs or as) must be known "in advance"; with Monad they can be calculated -- purely -- based on the results of the previous "computation steps" (like foo x is doing: for (each) value x that the computation xs will produce, new computation foo x will be (purely) calculated, the computation that will produce (some) y(s) in its turn).
If you want to see how the types are aligned in the >>= expressions, here's your expression with its subexpressions named, so they can be annotated with their types,
exp = fs >>= g -- fs >>=
where g f = xs >>= h -- (\ f -> xs >>=
where h x = return (f x) -- ( \ x -> pure (f x) ) )
x :: a
f :: a -> b
f x :: b
return (f x) :: F b
h :: a -> F b -- (>>=) :: F a -> (a -> F b) -> F b
xs :: F a -- xs h
-- <-----
xs >>= h :: F b
g f :: F b
g :: (a -> b) -> F b -- (>>=) :: F (a->b) -> ((a->b) -> F b) -> F b
fs :: F (a -> b) -- fs g
-- <----------
fs >>= g :: F b
exp :: F b
and the types of the two (>>=) applications fit:
(fs :: F (a -> b)) >>= (g :: (a -> b) -> F b)) :: F b
(xs :: F a ) >>= (h :: (a -> F b)) :: F b
Thus, the overall type is indeed
foo :: F (a -> b) -> F a -> F b
foo fs xs = fs >>= g -- foo = (<*>)
where g f = xs >>= h
where h x = return (f x)
In the end, we can see monadic bind as an implementation of do, and treat the do notation
do {
abstractly, axiomatically, as consisting of the lines of the form
a <- F a ;
b <- F b ;
......
n <- F n ;
return (foo a b .... n)
}
(with a, F b, etc. denoting values of the corresponding types), such that it describes the overall combined computation of the type F t, where foo :: a -> b -> ... -> n -> t. And when none of the <-'s right-hand side's expressions is dependent on no preceding left-hand side's variable, it's not essentially Monadic, but just an Applicative computation that this do block is describing.
Because of the Monad laws it is enough to define the meaning of do blocks with just two <- lines. For Functors, just one <- line is allowed ( fmap f xs = do { x <- xs; return (f x) }).
Thus, Functors/Applicative Functors/Monads are EDSLs, embedded domain-specific languages, because the computation-descriptions are themselves values of our language (those to the right of the arrows in do notation).
Lastly, a types mandala for you:
T a
T (a -> b)
(a -> T b)
-------------------
T (T b)
-------------------
T b
This contains three in one:
F a A a M a
a -> b A (a -> b) a -> M b
-------------- -------------- -----------------
F b A b M b
You can define (<*>) in terms of (>>=) and return because all monads are applicative functors. You can read more about this in the Functor-Applicative-Monad Proposal. In particular, pure = return and (<*>) = ap is the shortest way to achieve an Applicative definition given an existing Monad definition.
See the type signatures for (<*>), ap and (>>=):
(<*>) :: Applicative f => f (a -> b) -> f a -> f b
ap :: Monad m => m (a -> b) -> m a -> m b
(>>=) :: Monad m => m a -> (a -> m b) -> m b
The type signature for (<*>) and ap are nearly equivalent. Since ap is written using do-notation, it is equivalent to some use of (>>=). I'm not sure this helps, but I find the definition of ap readable. Here's a rewrite:
ap m1 m2 = do { x1 <- m1; x2 <- m2; return (x1 x2) }
≡ ap m1 m2 = do
x1 <- m1
x2 <- m2
return (x1 x2)
≡ ap m1 m2 =
m1 >>= \x1 ->
m2 >>= \x2 ->
return (x1 x2)
≡ ap m1 m2 = m1 >>= \x1 -> m2 >>= \x2 -> return (x1 x2)
≡ ap mf ma = mf >>= (\f -> ma >>= (\a -> pure (f a)))
Which is your definition. You could show that this definition upholds the applicative functor laws, since not everything defined in terms of (>>=) and return does that.
a line from FileIO.hs in Functional Programming Course exercise
getFile :: FilePath -> IO (FilePath, Chars)
getFile = lift2 (<$>) (,) readFile
According to its type signature, getFile returns IO ( FilePath, Chars), which means a tuple of filename and its content.
But I just can't figure out why it turns that way.
Why does FilePath turn out unchanged in the left, and readFile filename filled in the right?
Is (,) an Applicative instance too? (,) is not an IO, so what did lift2 lift?
And, is there a way to derive those type signatures and get proved?
The syntax I know is that a function follows by its arguments, and it eats one argument on its right hand and becomes a new function. But when it comes to code like that, it looks just like a magic cube to me...
Thank you for helping me out!
Ps. Extra Information as follows
instance Functor IO where
(<$>) =
P.fmap
lift2 ::
Applicative f =>
(a -> b -> c)
-> f a
-> f b
-> f c
lift2 f a b =
f <$> a <*> b
getFiles :: List FilePath -> IO (List (FilePath, Chars))
getFiles = sequence . (<$>) getFile
Let's look at
lift2 (<$>) (,) readFile
This is indeed straightforward function application:
((lift2 (<$>)) (,)) readFile
(or lift2 being applied to three arguments).
The types involved (with uniquely renamed type variables to reduce confusion) are:
lift2 :: (Applicative f) => (a -> b -> c) -> f a -> f b -> f c
(<$>) :: (Functor g) => (j -> k) -> g j -> g k
(,) :: m -> n -> (m, n)
readFile :: FilePath -> IO Chars
The first thing in our expression is applying lift2 to (<$>). That means we need to unify a -> b -> c (type of lift2's first argument) and (Functor g) => (j -> k) -> g j -> g k (type of <$>) somehow.
That is:
a -> b -> c = (j -> k) -> g j -> g k
-- where g is a Functor
a = j -> k
b = g j
c = g k
This works out. The result type is
f a -> f b -> f c
-- where f is an Applicative
which is
f (j -> k) -> f (g j) -> f (g k)
Now this expression (lift2 (<$>)) is applied to (,). Again we have to make the types line up:
f (j -> k) = m -> n -> (m, n)
Here we make use of the property that -> is right associative (i.e. a -> b -> c means a -> (b -> c)) and that we can use (curried) prefix notation in types (i.e. a -> b is the same as (->) a b, which is the same as ((->) a) b).
f (j -> k) = ((->) m) (n -> (m, n))
f = (->) m
j = n
k = (m, n)
This also works out. The result type is
f (g j) -> f (g k)
which (after substituting) becomes
((->) m) (g n) -> ((->) m) (g (m, n))
(m -> g n) -> (m -> g (m, n))
This expression (lift2 (<$>) (,)) is applied to readFile. Again, making the types line up:
m -> g n = FilePath -> IO Chars
m = FilePath
g = IO
n = Chars
And substituting into the result type:
m -> g (m, n)
FilePath -> IO (FilePath, Chars)
This is the type of the whole lift2 (<$>) (,) readFile expression. As expected, it matches the declaration of getFile :: FilePath -> IO (FilePath, Chars).
However, we still need to verify that our class constraints (Functor g, Applicative f) are resolved.
g is IO, which is indeed a Functor (as well as Applicative and Monad). There are no big surprises here.
f is more interesting: f = (->) m, so we need to look for an Applicative instance for (->) m. Such an instance does in fact exist, and its definition contains the answer to what getFile actually does.
We can derive what the instance must look like by just looking at the type of lift2 (as used in getFile):
lift2 :: (Applicative f) => (a -> b -> c) -> f a -> f b -> f c
lift2 :: (a -> b -> c) -> ((->) m) a -> ((->) m) b -> ((->) m) c
lift2 :: (a -> b -> c) -> (m -> a) -> (m -> b) -> (m -> c)
lift2 :: (a -> b -> c) -> (m -> a) -> (m -> b) -> m -> c
I.e. lift2 takes
a function that combines an a and a b into a c,
a function that transforms an m into an a,
a function that transforms an m into a b,
and an m,
and produces a c.
The only way it can do that is by passing the m into the second and third functions and combining their results using the first function:
lift2 f g h x = f (g x) (h x)
If we inline this definition in getFile, we get
getFile = lift2 (<$>) (,) readFile
getFile = \x -> (<$>) ((,) x) (readFile x)
getFile = \x -> (,) x <$> readFile x
Excercise for the reader:
lift2 is actually defined in terms of <$> and <*>. What are the types of <$> and <*> in the Applicative instance of (->) m? What must their definition look like?
I have come across several situations where I would like to use applicative style f <$> x1 <*> x2 <*> x3 but scanning the applicative arguments right to left instead of the usual left to right.
Naturally, if I bring this into a monadic context, I can do this without problem:
liftM3' :: Monad m => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3' f x1 x2 x3 = do { x3' <- x3; x2' <- x2; x1' <- x1; return f x1' x2' x3' }
So, for my question: is there some general method to accomplish this in the context of only Applicative (perhaps a newtype wrapper) and if not, why can there not be one. That said, any insight about elegant solutions or workarounds to this problem are welcome.
Aside: My solution had been to define new right associative operators, but the solution was by no means elegant.
Edit: Here is my solution (I'd be interested in knowing if there is something equivalent in the standard libraries), if I require Monad:
newtype Reverse m a = Reverse (m a)
instance Monad m => Functor (Reverse m) where
f `fmap` x = pure f <*> x
instance Monad m => Applicative (Reverse m) where
pure x = Reverse $ return x
(Reverse f) <*> (Reverse x) = Reverse $ do { x' <- x; f' <- f; return $ f' x' }
The Backwards type is like your Reverse, and in a semi-standard package.
Naturally, if I bring this into a monadic context, I can do this without problem:
Don't forget that f is just a function. As such, you can simply define another function that takes the arguments in another order and then fall back to the usual applicative combinators:
-- | Lifts the given function into an applicative context.
-- The applicative effects are handled from right-to-left
-- e.g.
-- >>> liftA3 (\_ _ _ -> ()) (putStr "a") (putStr "b") (putStr "c")
-- will put "cba" on your console.
liftA3Rev :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3Rev f x y z = f' <$> z <*> y <*> x
where
f' = \c b a -> f a b c
It's probably either impossible, or quite hard to write this with operators only, though. This is due to the nature of partial application. Remember that for f :: Int -> Char -> Bool and Applicative f => f Int, the expression f <$> x
has type Applicative f => f (Char -> Bool). We always "lose" types on the left end, not on the right end. If you change the order of arguments, it's easy again:
(>*>) :: Applicative f => f a -> f (a -> b) -> f b
(>*>) = flip (<*>)
infixr 4 >*> -- right associative
liftA3Rev' :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3Rev' f x y z = z >*> y >*> x >*> pure f
I'm trying to understand the <=< function:
ghci> :t (<=<)
(<=<) :: Monad m => (b -> m c) -> (a -> m b) -> a -> m c
As I understand it, I give it 2 functions and an a, and then I'll get an m c.
So, why doesn't this example compile?
import Control.Monad
f :: a -> Maybe a
f = \x -> Just x
g :: a -> [a]
g = \x -> [x]
foo :: Monad m => a -> m c
foo x = f <=< g x
For foo 3, I would expect Just 3 as a result.
But I get this error:
File.hs:10:15:
Couldn't match expected type `a0 -> Maybe c0'
with actual type `[a]'
In the return type of a call of `g'
Probable cause: `g' is applied to too many arguments
In the second argument of `(<=<)', namely `g x'
In the expression: f <=< g x Failed, modules loaded: none.
There are two errors here.
First, (<=<) only composes monadic functions if they share the same monad. In other words, you can use it to compose two Maybe functions:
(<=<) :: (b -> Maybe c) -> (a -> Maybe b) -> (a -> Maybe c)
... or two list functions:
(<=<) :: (b -> [c]) -> (a -> [b]) -> (a -> [c])
... but you cannot compose a list function and maybe function this way. The reason for this is that when you have a type signature like this:
(<=<) :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c)
... the compiler will ensure that all the ms must match.
The second error is that you forgot to parenthesize your composition. What you probably intended was this:
(f <=< g) x
... if you omit the parentheses the compiler interprets it like this:
f <=< (g x)
An easy way to fix your function is just to define a helper function that converts Maybes to lists:
maybeToList :: Maybe a -> [a]
maybeToList Nothing = []
maybeToList (Just a) = [a]
This function actually has the following two nice properties:
maybeToList . return = return
maybeToList . (f <=< g) = (maybeToList . f) <=< (maybeToList . g)
... which are functor laws if you treat (maybeToList .) as analogous to fmap and treat (<=<) as analogous to (.) and return as analogous to id.
Then the solution becomes:
(maybeToList . f <=< g) x
Note that, in
(<=<) :: Monad m => (b -> m c) -> (a -> m b) -> a -> m c
m is static -- You're trying to substitute both [] and Maybe for m in the definition -- that won't type check.
You can use <=< to compose functions of the form a -> m b where m is a single monad. Note that you can use different type arguments though, you don't need to be constrained to the polymorphic a.
Here's an example of using this pattern constrained to the list monad:
f :: Int -> [Int]
f x = [x, x^2]
g :: Int -> [String]
g 0 = []
g x = [show x]
λ> :t g <=< f
g <=< f :: Int -> [String]
λ> g <=< f $ 10
["10","100"]
You can't mix monads together. When you see the signature
(<=<) :: Monad m => (b -> m c) -> (a -> m b) -> a -> m c
The Monad m is only a single Monad, not two different ones. If it were, the signature would be something like
(<=<) :: (Monad m1, Monad m2) => (b -> m2 c) -> (a -> m1 b) -> a -> m2 c
But this is not the case, and in fact would not really be possible in general. You can do something like
f :: Int -> Maybe Int
f 0 = Just 0
f _ = Nothing
g :: Int -> Maybe Int
g x = if even x then Just x else Nothing
h :: Int -> Maybe Int
h = f <=< g