An example of "railroad" error handling

RailroadMonad.hs

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