From Simple IO to Monad Transformers presents the following exercise:
The guts of our algorithm will be a function next_coin which does something like this
(amt,coins) -> (amt,coins)
Each transition either dispenses a coin and decreases amt accordingly, or removes the largest coin from coins. The first alternative takes precedence whenever amt is not smaller than the largest coin. Here is an example of how this sequence of pairs represents coin dispensing. Start with (11,[10,1]) which means we must make change for 11 cents with a dime and a penny.
The first step is to
(1,[10,1])representing that a dime has been dispensed. The second step is to
(1,)representing that we have recognized dimes are no longer useful. The last step is to
(0,)representing that a penny has been dispensed.
import Control.Monad.State import Data.List type Coins = [Int] type StMach a = StateT Coins IO a main :: IO () main = let coins = [1,5,10,25] in do putStrLn "Enter an amount: " input <- getLine number <- return $ read input make_change coins number make_change :: Coins -> Int -> IO () -- IO (Int, Coins) make_change coins amt = runStateT (recurs amt) coins *> return () -- author: Monad Book recurs :: Int -> StMach Int recurs amt = if amt == 0 then return amt else next_coin amt >>= recurs data CoinState a = CoinLargerThanAmount a | FoundChange a | PennyMatch --if amount is less than (max coins), then delete the max from coins --otherwise subtract amount and delete that elem from coins (unless it's 1) next_coin :: Int -> StMach Int next_coin amt = do coinsLeft <- get dispense amt coinsLeft state $ \coins -> case coinState coins amt of PennyMatch -> (amt-1, coins) FoundChange a -> (amt-a, delete a coins) CoinLargerThanAmount a -> (amt, delete a coins) coinState :: Ord a => [a] -> a -> CoinState a coinState xs a = let largerCoinInChange = find (> a) xs in case largerCoinInChange of Just a -> CoinLargerThanAmount a Nothing -> case filter (<= a) xs of  -> PennyMatch as -> FoundChange (maximum as) -- author: Monad Book dispense :: Int -> Coins -> StMach () dispense i coins = ( lift $ putStrLn ( "dispense " ++(show i) ++" cents" ++ remaining) ) where cents = (if i==1 then " cent" else " cents") ++ remaining remaining = " with remaining coins: " ++ (show coins)
*Main Control.Monad.State> main Enter an amount: 16 dispense 16 cents with remaining coins: [1,5,10,25] dispense 16 cents with remaining coins: [1,5,10] dispense 6 cents with remaining coins: [1,5] dispense 1 cents with remaining coins:  *Main Control.Monad.State> main Enter an amount: 10 dispense 10 cents with remaining coins: [1,5,10,25] dispense 10 cents with remaining coins: [1,5,10] *Main Control.Monad.State> main Enter an amount: 1 dispense 1 cents with remaining coins: [1,5,10,25] dispense 1 cents with remaining coins: [1,10,25] dispense 1 cents with remaining coins: [1,25] dispense 1 cents with remaining coins: