-
-
Save tuohuang-li/699ce315ab3a5f3678e4af476715a00e to your computer and use it in GitHub Desktop.
An example of "railroad" error handling
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Result where | |
import Control.Monad | |
import Data.Monoid | |
data Result a b | |
= Failure a | |
| Success b | |
deriving (Show) | |
instance Monoid m => Functor (Result m) where | |
fmap _ (Failure x) = Failure x | |
fmap f (Success x) = Success (f x) | |
instance Monoid m => Applicative (Result m) where | |
pure = Success | |
Success f <*> Success x = Success (f x) | |
_ <*> Failure x = Failure x | |
instance Monoid m => Monad (Result m) where | |
return = Success | |
Success x >>= f = f x | |
Failure x >>= _ = Failure x | |
-- Example usage | |
data User = User | |
{ userID :: Int | |
, username :: String | |
, password :: String | |
} deriving (Show) | |
validateUserName :: User -> Result String User | |
validateUserName user | |
| null (username user) = Failure "Empty username" | |
| otherwise = Success user | |
validatePassword :: User -> Result String User | |
validatePassword user | |
| null (password user) = Failure "Empty password" | |
| otherwise = Success user | |
validateUserID :: User -> Result String User | |
validateUserID user | |
| userID user > 0 = Success user | |
| otherwise = Failure "Negative userID" | |
validateUser :: User -> Result String User | |
validateUser user = | |
return user >>= validateUserName | |
>>= validatePassword | |
>>= validateUserID | |
main :: IO () | |
main = do | |
let users = [ User { userID = 1, username = "good job", password = "very secret" } | |
, User { userID = 2, username = "", password = "secretive" } | |
] | |
forM_ users $ \user -> | |
case validateUser user of | |
Success u -> putStrLn $ "Yep, that's a good user: " ++ show u | |
Failure reason -> putStrLn $ "Come on, you even trying? " ++ show reason |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment