Skip to content

Instantly share code, notes, and snippets.

@ofan
Created April 2, 2014 01:52
Show Gist options
  • Save ofan/9926660 to your computer and use it in GitHub Desktop.
Save ofan/9926660 to your computer and use it in GitHub Desktop.
import Control.Monad.State.Lazy
import Control.Monad.Error
import Data.Char
type BalanceT e s m a = ErrorT e (StateT s m) a
type Balance a = BalanceT BalanceError Double IO a
data BalanceError = AmountIsNegative | NotEnoughBalance | InvalidCommand String | BalanceError String deriving Show
instance Error BalanceError where
noMsg = BalanceError "Error occurred"
strMsg s = BalanceError s
runBalanceT :: Balance () -> Double -> IO ()
runBalanceT b s = runStateT (runErrorT b) s >>= handleError
handleError (a,s) = case a of
Left err -> liftIO $ print err >> runBalanceT bank s
Right () -> return ()
Right _ -> runBalanceT bank s
balanceModify :: (Double -> Double -> Double) -> Double -> Balance ()
balanceModify f amt = lift get >>= balMod
where balMod bal
| amt < 0 = throwError AmountIsNegative
| f amt bal < 0 = throwError NotEnoughBalance
| otherwise = lift $ modify (f amt)
deposit :: Double -> Balance ()
deposit amt = balanceModify (+) amt
withdraw :: Double -> Balance ()
withdraw amt = balanceModify (flip (-)) amt
prompt :: Read a => String -> Balance a
prompt ppt = do
liftIO $ putStrLn ppt
liftIO readLn
showBalance :: Balance ()
showBalance = lift get >>= \bal -> liftIO $ putStrLn $ "Current balance: " ++ show bal
bank :: Balance ()
bank = bankLoop
where bankLoop = do
showBalance
cmd <- liftM (map toLower) $ liftIO $ putStrLn "Enter command:" >> getLine
case cmd of
"deposit" -> prompt ">>Enter amount: " >>= deposit >> bankLoop
"withdraw" -> prompt ">>Enter amount: " >>= withdraw >> bankLoop
"quit" -> liftIO (putStrLn "Bye.") >> return ()
_ -> throwError $ InvalidCommand "Unknown command. Commands: 'deposit', 'withdraw', 'quit'"
main = runBalanceT bank 0
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment