I have a task to implement a function that repeatly asks user for a password and says if it is not correct. If the password is OK, then it says "Storing in database and exits". I need to use ErrorT monad transformer to tell user, that his password is incorrect, so the basic behavior looks like this
GHCi>runErrorT askPassword'
Enter your new password:
qwerty
Incorrect input: password is too short!
qwertyuiop
Incorrect input: password must contain some digits!
qwertyuiop123
Incorrect input: password must contain some punctuations!
qwertyuiop123!!!
Storing in database...
GHCi>
askPassword' is like
data PwdError = PwdError String
type PwdErrorMonad = ErrorT PwdError IO
instance Error PwdError where
noMsg = PwdError "Unknown error"
strMsg s = PwdError s
instance Show PwdError where
show (PwdError s) = show s
askPassword' :: PwdErrorMonad ()
askPassword' = do
liftIO $ putStrLn "Enter your new password:"
value <- msum $ repeat getValidPassword'
liftIO $ putStrLn "Storing in database..."
and getValidPassword looks like this:
getValidPassword' :: PwdErrorMonad String
getValidPassword' = do
s <- liftIO getLine
if length s < 8
then throwError $ PwdError "Incorrect input: password is too short!"
else if (not $ any isNumber s)
then throwError $ PwdError "Incorrect input: password must contain some digits!"
else if (not $ any isPunctuation s)
then throwError $ PwdError "Incorrect input: password must contain some punctuations!"
else return s
What am i missing here?
Thanks for help!
The ErrorT datatype records errors in the Left field, which holds exactly one error. It cannot save each error. If you want to just "throw an error", use the IO monad and use throw/catch from Control.Exception.
If you want to use your current code, try the following:
withErr :: MonadError e m => (e -> m ()) -> m a -> m a
withErr f ac = catchError ac (\e -> f e >> throwError e)
This function applies an additional function to the error before it is rethrown. In your case, you just want to print the error:
askPassword' :: PwdErrorMonad ()
askPassword' = do
liftIO $ putStrLn "Enter your new password:"
_ <- msum $ repeat $ withErr (liftIO . print) getValidPassword'
liftIO $ putStrLn "Storing in database..."
Another approach is to use the mtl API to create a function which runs a function until it doesn't return an error.
try :: MonadError e m => (e -> m ()) -> m a -> m a
try h ac = go where go = catchError ac (\e -> h e >> go)
You can do anything with the errors, for example, collect them in a list:
recordErrors :: MonadError e m => m a -> m (a, [e])
recordErrors = runWriterT . try (tell . (:[])) . lift
However, what you want is to just print them:
askPassword' :: PwdErrorMonad ()
askPassword' = do
liftIO $ putStrLn "Enter your new password:"
_ <- try (liftIO . print) getValidPassword'
liftIO $ putStrLn "Storing in database..."
Related
I'm currently learning about free monads and I was toying with probably the simplest and most common example out there – Teletype:
{-# LANGUAGE DeriveFunctor #-}
import Control.Monad.Free
data TeletypeF a = Put String a
| Get (String -> a)
deriving Functor
type Teletype = Free TeletypeF
Many tutorials interpret Teletype programs in the IO monad. For example:
-- Utilities
get = liftF $ Get id
put s = liftF $ Put s ()
-- Sample programs
echo :: Teletype ()
echo = do word <- get
if word == "\04" -- Ctrl-D
then return ()
else put word >> echo
hello :: Teletype ()
hello = do put "What is your name?"
name <- get
put "What is your age?"
age <- get
put ("Hello, " ++ name ++ "!")
put ("You are " ++ age ++ " years old!")
-- Interpret to IO
interpIO :: Teletype a -> IO a
interpIO = foldFree lift
where
lift (Put s a) = putStrLn s >> return a
lift (Get f) = getLine >>= return . f
I was trying to interpret it in a different monad, namely the RWS monad.
This idea was motivated by the last exercise from this assignment.
I'm using the RWS datatype to fetch input from the Reader part and accumulate output in the State part.
But, unfortunately, I'm not able to get it working. Here is my attempt so far:
import Control.Monad.Trans.RWS.Lazy hiding (get, put)
type TeletypeRWS = RWS [String] () [String]
-- Interpret to TeletypeRWS
interpRWS :: Teletype a -> TeletypeRWS a
interpRWS = foldFree lift
where
lift (Put s a) = state (\t -> ((), t ++ [s])) >> return a
lift (Get f) = reader head >>= local tail . return . f -- This is wrong
mockConsole :: Teletype a -> [String] -> (a, [String])
mockConsole p inp = (a, s)
where
(a, s, _) = runRWS (interpRWS p) inp []
When running the TeletypeRWS "programs", the first value in the environment is not removed:
*Main> mockConsole hello ["john", "18"]
((),["What is your name?","What is your age?","Hello, john!","You are john years old!"])
I am a bit uneasy about updating the Reader, but I don't know how else I can access the next value in the list. The type of TeletypeRWS was chosen based on the exercise mentioned above – so I assume it should be possible to implement interpRWS.
We can't use foldFree: it needs to be parametric in the continuation, so we can't apply local there. In contrast, iterM explicitly gives us the actual continuation without generalization, so this will work.
interpRWS = iterM lift where
lift (Put s a) = modify (\t -> t ++ [s]) >> a
lift (Get f) = reader head >>= local tail . f
I have revisited Haskell lateley and constructed a toy programming language parser/interpreter. Using Parsec for lexing and parsing and a separate interpreter. I'm running in to some issues with feeding the result from the parser to my interpreter and handle the potential error from both the interpreter and parser. I end up with something like this:
main = do
fname <- getArgs
input <- readFile (head fname)
case lparse (head fname) input of
Left msg -> putStrLn $ show msg
Right p -> case intrp p of
Left msg -> putStrLn $ show msg
Right r -> putStrLn $ show r
This dosn't look pretty at all. My problem is that lparse returns Either ParseError [(String, Stmt)] and itrp returns the type Either ItrpError Stmt so I'm having a real hard time feeding the Right result from the parser to the interpreter and at the same time bail and print the possible ParseError or IntrpError.
The closest to what i want is something like this
main = do
fname <- getArgs
input <- readFile (head fname)
let prog = lparse (head fname) input
(putStrLn . show) (intrp <$> prog)
But this will not surprisingly yield a nested Either and not print pretty either.
So are there any nice Haskell ideomatic way of doing this threading results from one computation to another and handling errors (Lefts) in a nice way without nesting cases?
Edit
adding types of lparse and itrp
lparse :: Text.Parsec.Pos.SourceName -> String -> Either Text.Parsec.Error.ParseError [([Char], Stmt)]
intrp :: [([Char], Stmt)] -> Either IntrpError Stmt
While not perfect, I'd create a helper function for embedding any Showable error from Either into MonadError:
{-# LANGUAGE FlexibleContexts #-}
import Control.Monad.Except
strErr :: (MonadError String m, Show e) => Either e a -> m a
strErr = either (throwError . show) return
Then if you have a computation that can fail with errors, like
someFn :: ExceptT String IO ()
someFn = strErr (Left 42)
you can run it (printing errors to stdout) as
main :: IO ()
main = runExceptT someFn >>= either putStrLn return
In your case it'd be something like
main = either putStrLn return <=< runExceptT $ do
fname <- liftIO getArgs
input <- liftIO $ readFile (head fname)
prog <- strErr $ lparse (head fname) input
r <- strErr $ interp prog
print r
Well, if you want to chain successful computations, you can always use >>= to do that. For instance in your case:
lparse (head fname) input >>= intrp
And if you want to print out either your error message you can use the either class that takes two handler functions, one for the case when you have Left a (error in your case) and another for Right b (in your case a successful thing). An example:
either (putStrLn . show) (putStrLn . show) (lparse (head fname) input >>= intrp)
And if anything fails in your chain (any step of your monadic chain becomes Left a) it stops and can for instance print out the error message in the above case.
I am going through the tutorial at https://en.wikibooks.org/wiki/Haskell/Monad_transformers
I wrote following piece of codes. One without and other with MonadTransformer instance :
-- Simple Get Password functions.
getPassphrase1 :: IO (Maybe String)
getPassphrase1 = do
password <- getLine
if isValid password
then return $ Just password
else return Nothing
askPassphrase1 :: IO ()
askPassphrase1 = do
putStrLn "Enter password < 8 , alpha, number and punctuation:"
p <- getPassphrase1
case p of
Nothing -> do -- Q1. ### How to implement this with `MonadTrans` ?
putStrLn "Invalid password. Enter again:"
askPassphrase1
Just password ->
putStrLn $ "Your password is " ++ password
-- The validation test could be anything we want it to be.
isValid :: String -> Bool
isValid s = length s >= 8
&& any isAlpha s
&& any isNumber s
&& any isPunctuation s
Another using MonadT which i wrote myself.
getPassphrase2 :: MaybeT IO String
getPassphrase2 = do
password <- lift getLine
guard $ isValid password
return password
askPassphrase2 :: MaybeT IO ()
askPassphrase2 = do
lift $ putStrLn "Enter password < 8 , alpha, number and punctuation:"
p <- getPassphrase2
-- Q1. How to print "Invalid password" ?
lift $ putStrLn $ "Your password is " ++ p
-- The validation test could be anything we want it to be.
isValid :: String -> Bool
isValid s = length s >= 8
&& any isAlpha s
&& any isNumber s
&& any isPunctuation s
main :: IO ()
main = do
a <- runMaybeT askPassphrase2
return ()
Both works.
But i am unable to understand how to add wrong password support in MonadTrans example. ?
Also, is main method ok.. or it can be written in a better way ?
guard is the not what you want in the MaybeT approach. To check for an invalid password and be able to provide your own processing in that case you would just use your original version of getPassphase and lift it into the the MaybeT IO monad:
getPassphease2 = do result <- lift $ getPassphrase1
case result of
Nothing -> lift $ putStrLn "bad password"
Just pw -> lift $ putStrLn "your password is: " ++ pw
Explanation...
The MaybeT IO monad is for giving IO-actions the capability to fail and having that failure automatically handled by the monad. If any step fails, control goes all the way back to the runMaybeT and runMaybeT returns Nothing. It's like throwing an exception.
The point of using MaybeT is that you do no have to explicitly check to see if a step has failed - that checking is performed by the MaybeT monad after each step is called. That means you can write code assuming that each preceding step has succeeded - i.e. as if you were on the "happy path". This also means that you can't do something different if the previous step failed.
One possibility using the MaybeT version of getPassphrase is this:
main = do result <- runMaybeT askPassphrase2
case result of
Just _ -> return ()
Nothing -> putStrLn "Some failure happened... perhaps wrong password?"
The problem is that if runMaybeT returns Nothing it could mean that any step in askPassphrase failed, not just the guard.
Another way to use your MaybeT version of getPassphrase is to have askPassphrase run it with runMaybeT:
askPassphrase2 = do result <- lift $ runMaybeT getPassphrase2
case result of
Nothing -> lift $ putStrLn "bad password"
Just pw -> lift $ putStrLn $ "Your password is " ++ pw
Here we're using runMaybeT like a try-catch block.
I'll give an example of what I want to do right away.
version1 :: IO ()
version1 =
if boolCheck
then case maybeCheck of
Nothing -> putStrLn "Error: simple maybe failed"
Just v -> case eitherCheck of
Left e -> putStrLn $ "Error: " ++ show e
Right w -> monadicBoolCheck v >>= \case
False -> putStrLn "Error: monadic bool check failed"
True -> print "successfully doing the thing"
else putStrLn "simple bool check failed"
Basically I want to "do a thing" under the condition that a number of checks turns out positive.
Whenever a single check turns out negative, I want to preserve the information about the offending check and abort the mission.
In real life those checks have different types, therefore I called them
boolCheck :: Bool
maybeCheck :: Maybe a
eitherCheck :: Show a => Either a b
monadicBoolCheck :: Monad m => m Bool
Those are just examples.
Feel free to also think of monadic Maybe, EitherT or a a singleton list where I extract head and fail when it is not a singleton.
Now I am trying to improve the above implementation and the Either monad came into my mind, because it has the notion of aborting with an error message.
version2 :: IO ()
version2 = do
result <- runEitherT $ do
if boolCheck
then pure ()
else left "simple bool check failed"
v <- case maybeCheck of
Just x -> pure x
Nothing -> left "simple maybe check failed"
w <- hoistEither . mapLeft show $ eitherCheck
monadicBoolCheck v >>= \case
True -> pure ()
False -> left "monadic bool check failed"
case result of
Left msg -> putStrLn $ "Error: " ++ msg
Right _ -> print "successfully doing the thing"
While I prefer version2, the improvement in readability is probably marginal.
Version2 is superior when it comes to adding further checks.
Is there an ultimately elegant way of doing this?
What I don't like:
1) I am partly abusing the Either monad and what I actually do is more like a Maybe monad with the rolls of Just and Nothing switched in the monadic bind
2) The conversion of the checks to Either requires either rather verbose use of case or a conversion function (like hoistEither).
Ways of improving readability might be:
1) define helper functions to allow code like
v <- myMaybePairToEither "This check failed" monadicMaybePairCheck
monadicMaybePairCheck :: Monad m => m (Maybe x, y)
...
myMaybePairToEither :: String -> m (Maybe x, y) -> EitherT m e z
myMaybePairToEither _ (Just x, y) = pure $ f x y
myMaybePairToEither msg (Nothing, _) = left msg
2) consistently use explicit cases, not even use hoistEither
3) defining my own monad to stop the Either abuse ... I could provide all the conversion functions along with it (if no-one has already done something like that)
4) use maybe and either where possible
5) ... ?
Use maybe, either, and the mtl package. By the by, eitherCheck :: Show a => Either a b's Show a constraint is probably not what you want: it lets callers choose whatever type they want as long as the type implements Show a. You were probably intending having a be a type such that callers would only be able to call show on the value. Probably!
{-# LANGUAGE FlexibleContexts #-}
newtype Error = Error String
gauntlet :: MonadError Error m => m ()
gauntlet = do
unless boolCheck (throw "simple bool check failed")
_ <- maybe (throw "simple maybe check failed") pure maybeCheck
_ <- either throw pure eitherCheck
x <- monadicBoolCheck
unless x (throw "monadic bool check failed")
return ()
where
throw = throwError . Error
version2 :: IO ()
version2 =
putStrLn (case gauntlet of
Left (Error e) ->
"Error: " ++ e
Right _ ->
"successfully doing thing")
"Define helper functions" is exactly how I would handle this. The errors library provides many already, with the possible exception of satisfying Bool functions. For those I would just use when/unless.
And of course, to the extent possible, you should promote the actions you're calling to be suitably polymorphic so that no conversion is needed.
So I'd probably start by reworking your version2 into something like
import Control.Monad.Trans
import Control.Monad.Trans.Either hiding (left, right)
import Control.Monad
import Control.Applicative
import Control.Arrow
version3 :: IO ()
version3 = eitherT onFailure onSuccess $ do
guard boolCheck <|> fail "simple bool check failed"
v <- hoistEither $ maybe (Left "simple maybe check failed") Right maybeCheck
w <- hoistEither . left show $ eitherCheck
lift (guard =<< monadicBoolCheck v) <|> fail "monadic boolcheck failed"
where
onFailure msg = putStrLn $ "Error: "++msg
onSuccess _ = print "successfully doing the thing"
Which I find more readable, but is still a bit awkward, so if I was doing a lot
of code like this, I'd introduce some helpers:
version4 :: IO ()
version4 = eitherT onFailure onSuccess $ do
failUnless "simple bool check failed" boolCheck
v <- hoistMaybe "simple maybe check failed" maybeCheck
w <- hoistEitherWith show eitherCheck
failUnless "monadic boolcheck failed" =<< lift (monadicBoolCheck v)
where
onFailure msg = putStrLn $ "Error: "++msg
onSuccess _ = print "successfully doing the thing"
failUnless :: Monad m => String -> Bool -> m ()
failUnless _ True = return ()
failUnless msg _ = fail msg
hoistMaybe :: Monad m => e -> Maybe a -> EitherT e m a
hoistMaybe err = hoistEither . maybe (Left err) Right
hoistEitherWith :: Monad m => (e -> e') -> Either e a -> EitherT e' m a
hoistEitherWith f = hoistEither . left f
In order to have the full range of possible options here, check out this gist:
https://gist.github.com/rubenmoor/c390901247e4e7bb97cf
It defines several helper functions, basically combining maybe, either and such with throwError. and results in code like this.
gauntlet :: MonadError Error m => m (a, b, c)
gauntlet = do
assertTrue boolCheck $ Error "simple bool check failed"
v <- assertJust maybeCheck $ Error "simple maybe check failed"
assertNothing maybeCheck' $ Error . show
w <- assertRight eitherCheck $ Error . show
b <- monadicBoolCheck
assertTrue b $ Error "monadic bool check failed"
x <- assertSingletonList list $ Error "list not singleton"
pure (v, w, x)
version3 :: IO ()
version3 = putStrLn $
case gauntlet of
Left (Error e) -> "Error: " ++ e
Right result -> "successfully doing thing with result"
Given the proof of concept code below I'd like to be able to somehow perform my foo function with the ability to output the string Paul! and the possibility of getting its return value inside the InputT monad-transformer without using unsafePerformIO to remove the IO wrapper after runExceptT.
import Control.Monad.Except
import System.IO.Unsafe (unsafePerformIO)
import System.Console.Haskeline
type ErrorWithIO = ExceptT String IO
foo :: String -> ErrorWithIO String
foo "paul" = do liftIO $ putStrLn "Paul!"
return "OK!"
foo _ = throwError "ERROR!"
runRepl :: IO ()
runRepl = runInputT defaultSettings $ loop
loop :: InputT IO ()
loop = do
line <- getInputLine "> "
case line of
Nothing -> return ()
Just input -> do return $ putStrLn "asd"
case unsafePerformIO $ runExceptT $ foo input of
Left err -> outputStrLn err >> loop
Right res -> do
x <- outputStrLn . show $ res
loop
main :: IO ()
main = runRepl >> putStrLn "Goodbye!"
Am I missing something obvious here?
Since InputT IO is a MonadIO, you can use liftIO with this type:
liftIO :: IO a -> InputT IO a
So,
do ...
x <- liftIO $ runExceptT $ foo input
case x of
Left err -> ...
Right res -> ...
Alternatively, use Control.Monad.Trans.lift instead.