findM :: Monad m => (a -> m Bool) -> m [a] -> Maybe (m a)
I cannot implement it by myself. I could use some pointers
find looks like:
find f as = listToMaybe $ filter f as
so I tried:
findM f as = filterM f as >>= listToMaybe
but it doesnt work.
No. It is not possible. However, you can write a function with the signature:
findM :: Monad m => (a -> m Bool) -> m [a] -> m (Maybe a)
The reason it is not possible is because in order to figure out if the Maybe has constructor Just x or Nothing, you have to get the value out of the monad. Which means that the Maybe must be inside the monad at the end, since it is not possible in general to extract a value from inside a monad. (That is the whole point of monads, after all.)
For example, given your signature to findM, you could write some obviously incorrect functions:
findM :: Monad m => (a -> m Bool) -> m [a] -> Maybe (m a)
findM = magic
anyM :: Monad m => (a -> m Bool) -> m [a] -> Bool
anyM f = isJust . findM f
extractBool :: Monad m => m Bool -> Bool
extractBool = anyM id . liftM (:[])
The function extractBool is obviously impossible, so findM cannot have that signature.
Here is an implementation of findM:
findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
findM _ [] = return Nothing
findM f (x:xs) = do y <- f x
if y then return (Just x) else findM f xs
I am not sure of a simpler way to implement it -- this seems fairly clean, and it works on infinite lists.
Changing the signature from using an m [a] to using [a] makes it more useful and easier to use. You'll quickly figure out why, if you implement both interfaces.
Try
findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
findM p = foldr step (return Nothing)
where
step x r = do
b <- p x
if b then return (Just x) else r
This version only uses the predicate as much as it has to, whereas the filterM version uses it on every element. So for example:
ghci> let findM' p xs = filterM p xs >>= return . listToMaybe
ghci> let check x = putStrLn ("checking " ++ show x) >> doesDirectoryExist x
ghci> findM check ["test1", ".", "test2"]
checking "test1"
checking "."
Just "."
ghci> findM' check ["test1", ".", "test2"]
checking "test1"
checking "."
checking "test2"
Just "."
Others have already demonstrated that this isn't possible, however with a further constraint you can get a very similar function.
findM :: (Traversable m, Monad m) => (a -> m Bool) -> m [a] -> Maybe (m a)
findM p xs = Data.Traverse.sequence $ dietrichsFindM p xs
Not every Monad has a Traversable instance, but if it does this will work.
For the signature
findM :: Monad m => (a -> m Bool) -> m [a] -> m (Maybe a)
i suggest:
import Control.Monad
import Data.Maybe
findM :: Monad m => (a -> m Bool) -> m [a] -> m (Maybe a)
findM f m = m >>= filterM f >>= return . listToMaybe
or
findM :: Monad m => (a -> m Bool) -> m [a] -> m (Maybe a)
findM = ((return . listToMaybe =<<) .) . (=<<) . filterM
for a point-free style.
Related
As I understand it, each van Laarhoven optic type can be defined by a constraint on a type constructor:
type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t
-- etc.
If we choose Monad as the constraint, does it form some kind of "optic" in a meaningful way?
type Something s t a b = forall f. Monad f => (a -> f b) -> s -> f t
My intuition is that the Monad constraint might be too restrictive to get any value out of a structure like this: since the Const functor is not a Monad, we can't do the trick of specializing f to Const in order to derive a view-like function. Still, we can do some things with this Something type; it's just not clear to me if we can do anything particularly useful with it.
The reason I'm curious is because the type of a van Laarhoven optic is suspiciously similar to the type of a function that modifies a "mutable reference" type like IORef. For example, we can easily implement
modifyIORefM :: MonadIO m => IORef a -> (a -> m a) -> () -> m ()
which, when partially-applied to an IORef, has the shape
type SomethingIO s t a b = forall f. MonadIO f => (a -> f b) -> s -> f t
where a = b and s = t = (). I'm not sure whether this is a meaningful or meaningless coincidence.
Practically speaking, such an optic is a slightly inconvenient Traversal.
That's because, practically speaking, we use a Traversal:
type Traversal s t a b = forall f. (Applicative f) => (a -> f b) -> (s -> f t)
for two things. Getting a list of as from an s, which we can do with the Const functor:
toListOf :: Traversal s t a b -> s -> [a]
toListOf t = getConst . t (Const . (:[]))
and replacing the as with bs to turn the s into a t. One method is to use the State functor, and ignoring issues with matching the counts of as and bs, we have:
setListOf :: Traversal s t a b -> [b] -> s -> t
setListOf t bs s = evalState (t (\a -> state (\(b:bs) -> (b, bs))) s) bs
If we instead have an optic using a Monad constraint:
type TraversalM s t a b = forall f. (Monad f) => (a -> f b) -> (s -> f t)
we can still perform these two operations. Since State is a monad, the setListOf operation can use the same implementation:
setListOfM :: Traversal s t a b -> [b] -> s -> t
setListOfM t bs s = evalState (t (\a -> state (\(b:bs) -> (b, bs))) s) bs
For toListOf, there's no Monad instance for Const [a], but we can use a Writer monad to extract the a values, as long as we have a dummy b value to make the type checker happy:
toListOfM :: TraversalM s t a b -> b -> s -> [a]
toListOfM t dummy_b s = execWriter (t (\a -> tell [a] >> pure dummy_b) s)
or, since Haskell has bottom:
toListOfM' :: TraversalM s t a b -> s -> [a]
toListOfM' t s = execWriter (t (\a -> tell [a] >> pure undefined) s)
Self-contained code:
import Data.Functor.Const
import Control.Monad.State
import Control.Monad.Writer
type Traversal s t a b = forall f. (Applicative f) => (a -> f b) -> (s -> f t)
toListOf :: Traversal s t a b -> s -> [a]
toListOf t = getConst . t (Const . (:[]))
setListOf :: Traversal s t a b -> [b] -> s -> t
setListOf t bs s = evalState (t (\a -> state (\(b:bs) -> (b, bs))) s) bs
type TraversalM s t a b = forall f. (Monad f) => (a -> f b) -> (s -> f t)
toListOfM :: TraversalM s t a b -> b -> s -> [a]
toListOfM t dummy_b s = execWriter (t (\a -> tell [a] >> pure dummy_b) s)
toListOfM' :: TraversalM s t a b -> s -> [a]
toListOfM' t s = execWriter (t (\a -> tell [a] >> pure undefined) s)
setListOfM :: TraversalM s t a b -> [b] -> s -> t
setListOfM t bs s = evalState (t (\a -> state (\(b:bs) -> (b, bs))) s) bs
listItems :: Traversal [a] [b] a b
listItems = traverse
listItemsM :: TraversalM [a] [b] a b
listItemsM = mapM
main = do
-- as a getter
print $ toListOf listItems [1,2,3]
print $ toListOfM listItemsM 99 [1,2,3] -- dummy value
print $ toListOfM' listItemsM [1,2,3] -- use undefined
-- as a setter
print $ setListOf listItems [4,5,6] [1,2,3]
print $ setListOfM listItemsM [4,5,6] [1,2,3]
A function like (Monad m) => (s -> a -> m (s, b)) producing a new state and a new value based on the previous state and the current value is quite frequent.
We can use different approaches for implementing a traversal of a list of a to produce a m [b] given a function f :: s -> a -> m (s, b)
using Control.Monad.foldM but the code is not particularly nice
using traverse and a StateT (WriterT m) monad, which is a bit better
Is there a good use of existing libraries to decompose the "state-defined behaviour" with the "output behaviour" of f and get the desired traversal in a few combinators?
Up to newtype nonsense, we have:
traverse #[] #(StateT s m) :: (a -> s -> m (a, s)) -> [a] -> s -> m ([b], s)
Based on Will Ness's answer and because I have the opportunity to rearrange arguments in my code I can get the following
foldAccumulate :: (Monad m) => (a -> s -> m (b, s)) -> [a] -> s -> m [b]
foldAccumulate f = evalStateT . traverse (StateT . f)
Which is indeed a traverse with the appropriate StateT m monad, and there's no need for writing anything, I don't know why I did not see that :-). Thanks!
Plain StateT suffices,
foo :: Monad m => (s -> a -> m (s, b)) -> s -> [a] -> m [b]
foo g = flip (evalStateT . mapM (StateT . f))
where
f a s = liftM swap $ g s a
swap (a,b) = (b,a) -- or import Data.Tuple
flip and f make the pieces fit, if you must use your exact types instead of the more natural type a -> s -> m (b, s).
I have a function that apply a function to a file if it exists:
import System.Directory
import Data.Maybe
applyToFile :: (FilePath -> IO a) -> FilePath -> IO (Maybe a)
applyToFile f p = doesFileExist p >>= apply
where
apply True = f p >>= (pure . Just)
apply False = pure Nothing
Usage example:
applyToFile readFile "/tmp/foo"
applyToFile (\p -> writeFile p "bar") "/tmp/foo"
A level of abstraction can be added with:
import System.Directory
import Data.Maybe
applyToFileIf :: (FilePath -> IO Bool) -> (FilePath -> IO a) -> FilePath -> IO (Maybe a)
applyToFileIf f g p = f p >>= apply
where
apply True = g p >>= (pure . Just)
apply False = pure Nothing
applyToFile :: (FilePath -> IO a) -> FilePath -> IO (Maybe a)
applyToFile f p = applyToFileIf doesFileExist f p
That allow usages like:
applyToFileIf (\p -> doesFileExist p >>= (pure . not)) (\p -> writeFile p "baz") "/tmp/baz"
I have the feeling that I just scratched the surface and there is a more generic pattern hiding.
Are there better abstractions or more idiomatic ways to do this?
applyToFileIf can be given a more generic type and a more generic name
applyToIf :: Monad m => (a -> m Bool) -> (a -> m b) -> a -> m (Maybe b)
applyToIf f g p = f p >>= apply
where
apply True = g p >>= (return . Just)
apply False = return Nothing
In the type of applyToIf we see the composition of two Monads
Maybe is a monad ---v
applyToIf :: Monad m => (a -> m Bool) -> (a -> m b) -> a -> m (Maybe b)
^------------- m is a monad -------------^
When we see the composition of two monads, we can expect that it could be replaced with a monad transformer stack and some class describing what that monad transformer adds. The MaybeT transformer replaces m (Maybe a)
newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) }
And adds MonadPlus to what an m can do.
instance (Monad m) => MonadPlus (MaybeT m) where ...
We'll change the type of applyToIf to not have a composition of two monads and instead have a MonadPlus constraint on a single monad
import Control.Monad
applyToIf :: MonadPlus m => (a -> m Bool) -> (a -> m b) -> a -> m b
applyToIf f g p = f p >>= apply
where
apply True = g p
apply False = mzero
This could be rewritten in terms of guard from Control.Monad and given a more generic name.
guardBy :: MonadPlus m => (a -> m Bool) -> (a -> m b) -> a -> m b
guardBy f g p = f p >>= apply
where
apply b = guard b >> g p
The second g argument adds nothing to what guardBy can do. guardBy f g p can be replaced by guardBy f return p >>= g. We will drop the second argument.
guardBy :: MonadPlus m => (a -> m Bool) -> a -> m a
guardBy f p = f p >>= \b -> guard b >> return p
The MaybeT transformer adds possible failure to any computation. We can use it to recreate applyToIf or use it more generally to handle failure through complete programs.
import Control.Monad.Trans.Class
import Control.Monad.Trans.Maybe
applyToIf :: Monad m => (a -> m Bool) -> (a -> m b) -> a -> m (Maybe b)
applyToIf f g = runMaybeT . (>>= lift . g) . guardBy (lift . f)
If you instead rework the program to use monad style classes, it might include a snippet like
import Control.Monad.IO.Class
(MonadPlus m, MonadIO m) =>
...
guardBy (liftIO . doesFileExist) filename >>= liftIO . readFile
I was trying to implement the filterM function using foldr, but receiving an error which I can't understand why.
my implementation (It is just for understanding, I know i should use do notation...):
filterM :: (Monad m) => (a -> (m Bool)) -> [a] -> m [a]
filterM f list = foldr foldFn (return []) list
where
foldFn :: (Monad m) => a -> m [a] -> m [a]
foldFn x acc = let
m = f x
in acc >>=
\l -> m >>=
\b -> (if b == True then return (x:l) else return l)
I Get the following error
Could not deduce (a ~ a1)
from the context (Monad m)
bound by the type signature for
filterM :: Monad m => (a -> m Bool) -> [a] -> m [a]
at wadler.hs:124:12-55
or from (Monad m1)
bound by the type signature for
ff :: Monad m1 => a1 -> m1 [a1] -> m1 [a1]
at wadler.hs:127:23-54
`a' is a rigid type variable bound by
the type signature for
filterM :: Monad m => (a -> m Bool) -> [a] -> m [a]
at wadler.hs:124:12
`a1' is a rigid type variable bound by
the type signature for ff :: Monad m1 => a1 -> m1 [a1] -> m1 [a1]
at wadler.hs:127:23
In the first argument of `f', namely `x'
In the expression: f x
In an equation for `m': m = f x
I don't get why type a can't be deduced since foldr has type foldr :: (a -> b -> b) -> b -> [a] -> b
Thanks in advance,
Alex
I believe that you meant
filterM f list = foldr foldFn (return []) list
rather than xs at the end, so I'll assume that going forward.
The problem you're experiencing here is that the type variables in foldFn's type signature is completely separate from type variables in filterM's type signature. It's really equivalent to saying
filterM :: (Monad m) => (a -> (m Bool)) -> [a] -> m [a]
filterM f list = foldr foldFn (return []) list
where
foldFn :: (Monad m1) => a1 -> m1 [a1] -> m1 [a1]
foldFn x acc = let
m = f x
in acc >>=
\l -> m >>=
\b -> (if b == True then return (x:l) else return l)
But, you use f in the definition of foldFn, which says that m1 has to be the exact same as the m from above. You don't want the type of foldFn to work on any Monad, only the Monad that f is using. This is a subtle difference and a difficult one to spot at first. It also applies to the difference between a and b in these two signatures. What you can do is simply remove the type signature for foldFn and GHC can correctly infer the type of foldFn, but in cases where this doesn't work, you can use the ScopedTypeVariables extension. I would not recommend using it in this case, but there are times when it's really useful or even necessary:
{-# LANGUAGE ScopedTypeVariables #-}
filterM :: forall m a. (Monad m) => (a -> m Bool) -> [a] -> m [a]
filterM f = foldr foldFn (return [])
where
foldFn :: (Monad m) => a -> m [a] -> m [a]
foldFn x acc = do
l <- acc
b <- f x
return (if b then x:l else l)
And now the m and a in both type signatures refer to the same type variables. I've also let hlint tell me some improvements that could be made to your code, such as moving the return out of the if statement on the last line, using do notation for foldFn, and eta-reducing filterM to make the list argument implicit, as well as removing some unnecessary parentheses.
I would like to implement a function, iterateM, whose type would look like this:
iterateM :: Monad m => (a -> m a) -> a -> [m a]
However, my first go at writing this function:
iterateM f x = f x >>= (\x' -> return x' : iterateM f x')
Gives me the error:
Could not deduce (m ~ [])
from the context (Monad m)
bound by the type signature for
iterateM :: Monad m => (a -> m a) -> a -> [m a]
at main.hs:3:1-57
`m' is a rigid type variable bound by
the type signature for
iterateM :: Monad m => (a -> m a) -> a -> [m a]
at main.hs:3:1
Expected type: [a]
Actual type: m a
In the return type of a call of `f'
In the first argument of `(>>=)', namely `f x'
In the expression: f x >>= (\ x' -> return x' : iterateM f x')
If I remove my type-signature, ghci tells me the type of my function is:
iterateM :: Monad m => (a -> [a]) -> a -> [m a]
What am I missing here?
What I gather from your signature:
iterateM :: (Monad m) => (a -> m a) -> a -> [m a]
Is that the nth element iterateM f x will be an action that runs f n times. This is very close to iterate, I suspect we can implement it in terms of that.
iterate :: (b -> b) -> b -> [b]
iterate gives us a list of bs, and we want a list of m as, so I suspect b = m a.
iterate :: (m a -> m a) -> m a -> [m a]
Now we need a way to transform f :: a -> m a into something of type m a -> m a. Fortunately, that is exactly the definition of bind:
(=<<) :: (Monad m) => (a -> m b) -> (m a -> m b)
So:
\f -> iterate (f =<<) :: (a -> m a) -> m a -> [m a]
And to get our initial x :: a into the desired m a, we can use return:
return :: (Monad m) => a -> m a
So:
iterateM f x = iterate (f =<<) (return x)
Pointfreeize to taste.
Your recursive use of iterateM is forcing it to be in the list monad. You need to run the iterateM action and return its result.
Try:
iterateM f x = do
x' <- f x
xs <- iterateM f x'
return $ x':xs