Mixing Either and Maybe Monads - haskell

I think I understand how to cascade Monad of the same type. I would like to combine two Monads together to perform an operation based on them :
I think the code below resume the problem : suppose we have a function that validates that a String contains "Jo" and append "Bob" to it if it's the case, and another one that validates that the String length is > 8
The hello function would apply the first , then the second on the result of the first and return "Hello" to all that in case of success or 'Nothing' (I don't know what is this 'Nothing' btw , Left or Nothing) in case of error.
I believe that it's around Monad transformer what I need but I could not find a concise example that would help me to start.
I precise that this is nothing theoratical as there is around Haskell package that works with Either and others that works with Maybe
validateContainsJoAndAppendBob :: String -> Maybe String
validateContainsJoAndAppendBob l =
case isInfixOf "Jo" l of
False -> Nothing
True -> Just $ l ++ "Bob"
validateLengthFunction :: Foldable t => t a -> Either String (t a)
validateLengthFunction l =
case (length l > 8) of
False -> Left "to short"
True -> Right l
-- hello l = do
-- v <- validateContainsJoAndAppendBob l
-- r <- validateLengthFunction v
-- return $ "Hello " ++ r

Use a function to convert Maybe to Either
note :: Maybe a -> e -> Either e a
note Nothing e = Left e
note (Just a) _ = Right a
hello l = do
v <- validateContainsJoAndAppendBob l `note` "Does not contain \"Jo\""
r <- validateLengthFunction v
return $ "Hello " ++ r

In addition to the practical answer given by Li-yao Xia, there's other alternatives. Here's two.
Maybe-Either isomorphism
Maybe a is isomorphic to Either () a, which means that there's a lossless translation between the two:
eitherFromMaybe :: Maybe a -> Either () a
eitherFromMaybe (Just x) = Right x
eitherFromMaybe Nothing = Left ()
maybeFromEither :: Either () a -> Maybe a
maybeFromEither (Right x) = Just x
maybeFromEither (Left ()) = Nothing
You can use one of these to translate to the other. Since validateLengthFunction returns an error text on failure, it would be a lossy translation to turn its return value into a Maybe String value, so it's better to use eitherFromMaybe.
The problem with that, though, is that this will only give you an Either () String value, and you need an Either String String. You can solve this by taking advantage of Either being a Bifunctor instance. First,
import Data.Bifunctor
and then you can write hello as:
hello :: String -> Either String String
hello l = do
v <-
first (const "Doesn't contain 'Jo'.") $
eitherFromMaybe $
validateContainsJoAndAppendBob l
r <- validateLengthFunction v
return $ "Hello " ++ r
This essentially does the same as Li-yao Xia's answer - a little less practical, but also a little less ad-hoc.
The first function maps the first (left-most) case of an Either value. In this case, if the return value from validateContainsJoAndAppendBob is a Left value, it's always going to be Left (), so you can use const to ignore the () input and return a String value.
This gets the job done:
*Q49816908> hello "Job, "
Left "to short"
*Q49816908> hello "Cool job, "
Left "Doesn't contain 'Jo'."
*Q49816908> hello "Cool Job, "
Right "Hello Cool Job, Bob"
This alternative I prefer to the next one, but just for completeness' sake:
Monad transformers
Another option is using Monad transformers. You can either wrap the Maybe in an EitherT, or conversely wrap an Either in MaybeT. The following example does the latter.
import Control.Monad.Trans (lift)
import Control.Monad.Trans.Maybe (MaybeT(..))
helloT :: String -> MaybeT (Either String) String
helloT l = do
v <- MaybeT $ return $ validateContainsJoAndAppendBob l
r <- lift $ validateLengthFunction v
return $ "Hello " ++ r
This also works, but here you still have to deal with the various combinations of Just, Nothing, Left, and Right:
*Q49816908> helloT "Job, "
MaybeT (Left "to short")
*Q49816908> helloT "Cool job, "
MaybeT (Right Nothing)
*Q49816908> helloT "Cool Job, "
MaybeT (Right (Just "Hello Cool Job, Bob"))
If you want to peel off the MaybeT wrapper, you can use runMaybeT:
*Q49816908> runMaybeT $ helloT "Cool Job, "
Right (Just "Hello Cool Job, Bob")
In most cases, I'd probably go with the first option...

What you want is (in the categorical sense) a natural transformation from Maybe to Either String, which the maybe function can provide.
maybeToEither :: e -> Maybe a -> Either e a
maybeToEither e = maybe (Left e) Right
hello l = do
v <- maybeToEither "No Jo" (validateContainsJoAndAppendBob l)
r <- validateLengthFunction v
return $ "Hello " ++ r
You can use <=< from Control.Monad to compose the two validators.
hello l = do
r <- validateLengthFunction <=< maybeToEither "No Jo" . validateContainsJoAndAppendBob $ l
return $ "Hello " ++ r
You can also use >=> and return to turn the whole thing into a single monstrous point-free definition.
hello = maybeToEither "No Jo" . validateContainsJoAndAppendBob
>=> validateLengthFunction
>=> return . ("Hello " ++)

Related

Non-exhaustive patterns in lambda

I am getting Non-exhaustive patterns in lambda. I am not sure of the cause yet. Please anyone how to fix it. The code is below:
import Control.Monad
import Data.List
time_spent h1 h2 = max (abs (fst h1 - fst h2)) (abs (snd h1 - snd h2))
meeting_point xs = foldl' (find_min_time) maxBound xs
where
time_to_point p = foldl' (\tacc p' -> tacc + (time_spent p p')) 0 xs
find_min_time min_time p = let x = time_to_point p in if x < min_time then x else min_time
main = do
n <- readLn :: IO Int
points <- fmap (map (\[x,y] -> (x,y)) . map (map (read :: String->Int)) . map words . lines) getContents
putStrLn $ show $ meeting_point points
This is the lambda with the non-exhaustive patterns: \[x,y] -> (x,y).
The non-exhaustive pattern is because the argument you've specified, [x,y] doesn't match any possible list - it only matches lists with precisely two elements.
I would suggest replacing it with a separate function with an error case to print out the unexpected data in an error message so you can debug further, e.g.:
f [x,y] = (x, y)
f l = error $ "Unexpected list: " ++ show l
...
points <- fmap (map f . map ...)
As an addition to #GaneshSittampalam's answer, you could also do this with more graceful error handling using the Maybe monad, the mapM function from Control.Monad, and readMaybe from Text.Read. I would also recommend refactoring your code so that the parsing is its own function, it makes your main function much cleaner and easier to debug.
import Control.Monad (mapM)
import Text.Read (readMaybe)
toPoint :: [a] -> Maybe (a, a)
toPoint [x, y] = Just (x, y)
toPoint _ = Nothing
This is just a simple pattern matching function that returns Nothing if it gets a list with length not 2. Otherwise it turns it into a 2-tuple and wraps it in Just.
parseData :: String -> Maybe [(Int, Int)]
parseData text = do
-- returns Nothing if a non-Int is encountered
values <- mapM (mapM readMaybe . words) . lines $ text
-- returns Nothing if a line doesn't have exactly 2 values
mapM toPoint values
Your parsing can actually be simplified significantly by using mapM and readMaybe. The type of readMaybe is Read a => String -> Maybe a, and in this case since we've specified the type of parseData to return Maybe [(Int, Int)], the compiler can infer that readMaybe should have the local type of String -> Maybe Int. We still use lines and words in the same way, but now since we use mapM the type of the right hand side of the <- is Maybe [[Int]], so the type of values is [[Int]]. What mapM also does for us is if any of those actions fails, the overall computation exits early with Nothing. Then we simply use mapM toPoint to convert values into a list of points, but also with the failure mechanism built in. We actually could use the more general signature of parseData :: Read a => String -> Maybe [(a, a)], but it isn't necessary.
main = do
n <- readLn :: IO Int
points <- fmap parseData getContents
case points of
Just ps -> print $ meeting_point ps
Nothing -> putStrLn "Invalid data!"
Now we just use fmap parseData on getContents, making points have the type Maybe [(Int, Int)]. Finally, we pattern match on points to print out the result of the meeting_point computation or print a helpful message if something went wrong.
If you wanted even better error handling, you could leverage the Either monad in a similar fashion:
toPoint :: [a] -> Either String (a, a)
toPoint [x, y] = Right (x, y)
toPoint _ = Left "Invalid number of points"
readEither :: Read a => String -> Either String a
readEither text = maybe (Left $ "Invalid parse: " ++ text) Right $ readMaybe text
-- default value ^ Wraps output on success ^
-- Same definition with different type signature and `readEither`
parseData :: String -> Either String [(Int, Int)]
parseData text = do
values <- mapM (mapM readEither . words) . lines $ text
mapM toPoint values
main = do
points <- fmap parseData getContents
case points of
Right ps -> print $ meeting_point ps
Left err -> putStrLn $ "Error: " ++ err

How can I parse a string to a function in Haskell?

I want a function that looks something like this
readFunc :: String -> (Float -> Float)
which operates something like this
>(readFunc "sin") (pi/2)
>1.0
>(readFunc "(+2)") 3.0
>5.0
>(readFunc "(\x -> if x > 5.0 then 5.0 else x)") 2.0
>2.0
>(readFunc "(\x -> if x > 5.0 then 5.0 else x)") 7.0
>5.0
The incredibly naive approach (note this must be compiled with {-# LANGUAGE FlexibleContexts #-})
readFunc :: (Read (Float -> Float)) => String -> (Float -> Float)
readFunc s = read s
gives
No instance for (Read (Float -> Float)) ...
Which makes sense since no such instance exists. I understand that I can parse the input string character by character by writing a map from String to Float -> Float but I want to be able to parse at least the most common functions from prelude, and even that would be way more work than I want to commit to. Is there an easy way of doing this?
Just one solution using hint
import Language.Haskell.Interpreter hiding (typeOf)
import Data.Typeable (typeOf)
data Domain = Dom Float Float Float Float Domain
| SDom Float Float Float Float
deriving (Show, Read)
--gets all the points that will appear in the domain
points (SDom a b c d) m = [(x, y)|x <- [a, a+m .. b], y <- [c, c+m .. d]]
points (Dom a b c d next) m = points next m ++ [(x, y)|x <- [a, a+m .. b], y <- [c, c+m .. d]]
readFunc = do
putStrLn "Enter a domain (as Dom x-min x-max y-min y-max subdomain, or, SDom x-min x-max y-min y-max)"
domain' <- getLine
let domain = (read domain') :: Domain
--
putStrLn "Enter a mesh size"
meshSize' <- getLine
let meshSize = (read meshSize') :: Float
--
putStrLn "Enter an initial value function (as f(x,y))"
func' <- getLine
values' <- runInterpreter $ setImports["Prelude"] >>
eval ("map (\\(x,y) -> " ++ func' ++ ")" ++ show (points domain meshSize))
let values = (\(Right v) -> (read v)::([Float])) values'
--the haskell expression being evaluated
putStrLn $ ("map (\\(x,y) -> " ++ func' ++ ")" ++ show (points domain meshSize))
--prints the actual values
putStrLn $ show values
--the type is indeed [float]
putStrLn $ show $ typeOf values
You can use the hint package, or plugins. I'll show you the former (partly because my Windows installation is clearly a little broken in that cabal doesn't share my belief that I have C installed, so cabal install plugins fails).
String -> Function is easy:
import Language.Haskell.Interpreter
getF :: String -> IO (Either InterpreterError (Float -> Float))
getF xs = runInterpreter $ do
setImports ["Prelude"]
interpret xs (as :: Float -> Float)
You may want to add additional modules to the imports list. This tests out as
ghci> getF "sin" >>= \(Right f) -> print $ f (3.1415927/2)
1.0
ghci> getF "(\\x -> if x > 5.0 then 5.0 else x)" >>= \(Right f) -> print $ f 7
5.0
(Notice the escaping of the escape character \.)
Error messages
As you may have noticed, the result is wrapped in the Either data type. Right f is correct output, whereas Left err gives an InterpreterError message, which is quite helpful:
ghci> getF "sinhh" >>= \(Left err) -> print err
WontCompile [GhcError {errMsg = "Not in scope: `sinhh'\nPerhaps you meant `sinh' (imported from Prelude)"}]
Example toy program
Of course, you can use either with your code to deal with this. Let's make a fake example respond. Your real one will contain all the maths of your program.
respond :: (Float -> Float) -> IO ()
respond f = do
-- insert cunning numerical method instead of
let result = f 5
print result
A simple, one-try, unhelpful version of your program could then be
main =
putStrLn "Enter your function please:"
>> getLine
>>= getF
>>= either print respond
Example sessions
ghci> main
Enter your function please:
\x -> x^2 + 4
29.0
ghci> main
Enter your function please:
ln
WontCompile [GhcError {errMsg = "Not in scope: `ln'"}]
It does type checking for you:
ghci> main
Enter your function please:
(:"yo")
WontCompile [GhcError {errMsg = "Couldn't match expected type `GHC.Types.Float'\n with actual type `GHC.Types.Char'"}]

Avoid pattern matching inside a monad in Haskell

I have the following definitions:
env = DataMap.fromList [
("foo",42), ("bar",69),
("baz",27), ("qux",0)
]
doSomething:: String → Writer [String] Int
doSomething s = do
let v = DataMap.lookup s env
case v of
Nothing → fail $ s ++ " not found"
Just a → do
tell [s ++ " → " ++ (show a)]
return a
What really is annoying me about this code is the use of the pattern matching inside the doSomething. It completely defeats the purpose of using monads. Is there any way of re-writing the doSomething function using only monadic functions without using monad transformers?
As #larsmans said, the easiest way is to use maybe function:
doSomething:: String -> Writer [String] Int
doSomething s = maybe n (\a -> t a >> return a) $ DataMap.lookup s env where
n = fail $ s ++ " not found"
t a = tell [s ++ " -> " ++ show a]
Monad transformers are of little help here. You will need one to combine several calculations which both fail and write. In case of just one calculation you don't need monads.
Also, I'd use ErrorT transformer and throwError function to report error instead of fail. See http://www.haskell.org/haskellwiki/Error_reporting_strategies for possible ways to handle errors.
This is kind of clunky, but it's how I'd do it.
doSomething2 :: String -> Writer [String] Int
doSomething2 s =
maybe (fail $ s ++ " not found") id $ do
a <- DataMap.lookup s env
return $ (tell [s ++ " -> " ++ show a] >> return a)

"<-" and associated values

Say I've written the following amazin piece of code:
func = do
a <- Just 5
return a
It's pretty pointless, I know. Here, a is 5, and func returns Just 5.
Now I rewrite my awesome (yet pointless) function:
func' = do
a <- Nothing
return a
This function returns Nothing, but what the heck is a? There's nothing to extract from a Nothing value, yet the program doesn't whine when I do something like this:
func'' = do
a <- Nothing
b <- Just 5
return $ a+b
I just have a hard time seeing what actually happens. What is a? In other words: What does <- actually do? Saying it "extracts the value from right-side and binds it to the left-side" is obviously over-simplifying it. What is it I'm not getting?
Thanks :)
Let's try and desugar the do-notation of that last example.
func'' = Nothing >>= (\a -> Just 5 >>= (\b -> return $ a+b))
Now, let's see how >>= is defined for Maybe. It's in the Prelude:
instance Monad Maybe where
(Just x) >>= k = k x
Nothing >>= k = Nothing
return = Just
fail s = Nothing
So Nothing >>= foo is simply Nothing
The answer lies in the definition of the Monad instance of Maybe:
instance Monad Maybe where
(Just x) >>= k = k x
Nothing >>= _ = Nothing
(Just _) >> k = k
Nothing >> _ = Nothing
return = Just
Your func'' translates to:
Nothing >>= (\a -> (Just 5 >>= (\b -> return (a+b))))
From the definition of (>>=) you can see that the first Nothing is just threaded through to the result.
Let's look at the definition of Maybe monad.
instance Monad Maybe where
return = Just
Just a >>= f = f a
Nothing >>= _ = Nothing
And desugar the do-notation in your function:
func' =
Nothing >>= \a ->
return a
The first argument to >>= is Nothing and from the definition above we can see that >>= just ignores the second argument. So we get:
func' = Nothing
Since the function \a -> ... is never called, a never gets assigned. So the answer is: a is not even reached.
As for desugaring do-notation, here's a quick sketch of how it's done (there's one simplification I've made - handling of fail, i.e. patterns that do not match):
do {a; rest} → a >> do rest
Note that >> is usually implemented in terms of >>= as a >>= \_ -> do rest (i.e. the second function just ignores the argument).
do {p <- a; rest} → a >>= \p -> do rest
do {let x = a; rest} → let x = a in do rest
And finally:
do {a} = a
Here's an example:
main = do
name <- getLine
let msg = "Hello " ++ name
putStrLn msg
putStrLn "Good bye!"
desugars to:
main =
getLine >>= \name ->
let msg = "Hello " ++ name in
putStrLn msg >>
putStrLn "Good bye!"
And to make it complete for those who are curious, here's the "right" translation of do {p <- a; rest} (taken directly from Haskell report):
do {pattern <- a; rest} → let ok pattern = do rest
ok _ = fail "error message"
in a >>= ok
Nothing isn't really "nothing", it's actually a possible value of something in the Maybe monad:
data Maybe t = Nothing | Just t
That is, if you have something of type Maybe t for some type t, it can have the value Just x (where x is anything of type t) or Nothing; in this sense Maybe just extends t to have one more possible value, Nothing. (It has other properties because it's a monad, but that doesn't really concern us here, except for the syntactic sugar of do and <-.)
Let's take your example:
func = do
a <- Just 5
return a
Just like in other programming languages you can break this into two pieces correspond to "what's been done up to now" and "what's is yet to be done". For example we can make the break between Just 5 and
a <- ...
return a
In many popular programming languages you expect the Just 5 to be stuffed into the variable a and the code would continue.
Haskell does something different. The "rest of the code" can be thought of as a function describing what you would do with a if you had a value to put in it. This function is then applied to Just 5. But it's not applied directly. It's applied using whatever definition of >>= applies, depending on the type of your expression. For Maybe, >>= is defined so that when dealing with Just X, the "rest of the code" function is applied to X. But it's also defined so that when dealing with Nothing the "rest of the code" function is simply ignored and Nothing is returned.
We can now interpret your other example
func'' = do
a <- Nothing
b <- Just 5
return $ a+b
Break it into Nothing and:
a <- ...
b <- Just 5
return $ a+b
As I say above, this block of code can be thought of a function applied to a possible value of a. But it's being used with Nothing and in this case >>= is defined to ignore the "rest of the code" and just return Nothing. And that's the result you got.

What is the difference between forM and forM_ in haskell?

HLint suggests that I use forM_ rather than forM. Why? I see they have different type signatures but haven't found a good reason to use one over the other.
forM :: (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b)
forM_ :: (Foldable t, Monad m) => t a -> (a -> m b) -> m ()
The forM_ function is more efficient because it does not save the results of the operations. That is all. (This only makes sense when working with monads because a pure function of type a -> () is not particularly useful.)
Ok,
forM is mapM with its arguments flipped.
forM_ is mapM_ with its arguments flipped.
Let's see in mapM and mapM_ :
mapM :: Monad m => (a -> m b) -> [a] -> m [b]
mapM mf xs takes a monadic function mf (having type Monad m => (a -> m b)) and applies it to each element in list xs; the result is a list inside a monad.
The difference between mapM and mapM_ is, that mapM returns a list of the results, while mapM_ returns an empty result. The result of each action in mapM_ is not stored.
To understand the difference between (A): forM xs f and (B): forM_ xs f, it might help to compare the difference between the following:
-- Equivalent to (A)
do
r1 <- f x1
r2 <- f x2
...
rn <- f xn
return [r1, r2, ..., rn]
-- Equivalent to (B)
do
_ <- f x1
_ <- f x2
...
_ <- f xn
return ()
The crucial difference being that forM_ ignores the results r1, ... rn and just returns an empty result via return (). Think of the underscore as meaning "don't care" ... forM_ doesn't care about the results. forM however, does care about the results and returns them in as a list via return [r1, r2, ... rn].
Example 1
The code below asks for your name three times and prints the results of the forM.
import Control.Monad (forM, forM_)
main = do
let askName i = do
putStrLn $ "What's your name (" ++ (show i) ++ ")"
name <- getLine
return name
results <- forM [1,2,3] askName
putStrLn $ "Results = " ++ show results
An example execution with forM:
What's your name? (1)
> James
What's your name? (2)
> Susan
What's your name? (3)
> Alex
Results = ["James", "Susan", "Alex"]
But if we change the forM to a forM_, then we would have instead:
What's your name? (1)
> James
What's your name? (2)
> Susan
What's your name? (3)
> Alex
Results = ()
In your case, the linter is telling you that you're not using the return values of your forM (you don't have foo <- forM xs f, you probably have forM xs f by itself on a line) and so should use forM_ instead. This happens, for
example, when you are using a monadic action like putStrLn.
Example 2 The code below asks for your name and then says "Hello" – repeating three times.
import Control.Monad (forM, forM_)
main = do
let askThenGreet i = do
putStrLn $ "What's your name (" ++ (show i) ++ ")"
name <- getLine
putStrLn $ "Hello! " ++ name
forM [1,2,3] askThenGreet
An example execution with forM:
What's your name? (1)
> Sarah
Hello! Sarah
What's your name? (2)
> Dick
Hello! Dick
What's your name? (3)
> Peter
Hello! Peter
[(), (), ()]
The overall result of main comes from the result of the forM: [(), (), ()]. It's pretty useless and annoyingly, it appears in the console. But if we change the forM to a forM_, then we would have instead:
What's your name? (1)
> Sarah
Hello! Sarah
What's your name? (2)
> Dick
Hello! Dick
What's your name? (3)
> Peter
Hello! Peter
With that change, the overall result comes from the mapM_ and is now (). This doesn't show up in the console (a quirk of the IO monad)! Great!
Also, by using mapM_ here, it's clearer to other readers of your code – you're indirectly explaining / self-documenting that you don't care about the results [r1, ..., rn] = [(), (), ()] – and rightly so as they're useless here.

Resources