StockLiquore State monad

StockLiquor.hs

{-
   Goal: Turn this bar into a liquor stock market

   ## Add Feature

   - Get prices from the a market
     - define the market
     - pass it through everywhere

   - Adjust the market based on orders
     - demand a drink
     - thread the market through
     - print out final market

   ## Refactor

   - Build helpers for threading the market state
     - carrying new market forward
     - ignoring the market
     - type synonym to clean it up

   - Enable the usage of do syntax
     - Functor, Applicative, Monad instances
     - go use it everywhere (except demandDrink!)

   - Add market accessors to clean up demandDrink, maintain encapsulation
     - access the market
     - save the new market
-}
module StockLiquor where

import qualified Data.Fixed as Fixed

data Drink
  = VodkaTonic
  | RumAndCoke
  deriving (Show, Eq, Ord)

data Receipt =
  Receipt
    { receiptDrink :: Drink
    , receiptPrice :: Fixed.Centi
    } deriving Show

drinkPrice :: Drink -> Fixed.Centi
drinkPrice drink =
  case drink of
    VodkaTonic -> 16.80
    RumAndCoke ->  4.75

orderDrink :: Drink -> Receipt
orderDrink drink =
  Receipt drink (drinkPrice drink)

orderDrinks :: [Drink] -> [Receipt]
orderDrinks drinks =
  case drinks of
    [] ->
      []

    firstDrink : restOfDrinks ->
      orderDrink firstDrink : orderDrinks restOfDrinks

main :: IO ()
main = do
  let
    drinkList = [VodkaTonic, RumAndCoke, VodkaTonic]
    receipts = orderDrinks drinkList

  putStrLn ":: Drink Receipts ::"
  mapM_ print receipts

StockLiquorFinal.hs

{-
   Goal: Turn this bar into a liquor stock market

   ## Add Feature

   - Get prices from the a market
     - define the market
     - pass it through everywhere

   - Adjust the market based on orders
     - demand a drink
     - thread the market through
     - print out final market

   ## Refactor

   - Build helpers for threading the market state
     - carrying new market forward
     - ignoring the market
     - type synonym to clean it up

   - Enable the usage of do syntax
     - Functor, Applicative, Monad instances
     - go use it everywhere (except demandDrink!)

   - Add market accessors to clean up demandDrink, maintain encapsulation
     - access the market
     - save the new market
-}
module StockLiquorFinal where

import qualified Data.Fixed as Fixed
import qualified Data.Map as Map

data Drink
  = VodkaTonic
  | RumAndCoke
  deriving (Show, Eq, Ord)

data Receipt =
  Receipt
    { receiptDrink :: Drink
    , receiptPrice :: Fixed.Centi
    } deriving Show

type Market = Map.Map Drink Fixed.Centi

newtype StockLiquor a =
  StockLiquor
    { runStockLiquor :: Market -> (a, Market)
    }

instance Functor StockLiquor where
  fmap f sl =
    linkMarket sl $ \a ->
      pureMarket (f a)

instance Applicative StockLiquor where
  pure =
    pureMarket

  slF <*> slA =
    linkMarket slF $ \f ->
    linkMarket slA $ \a ->
    pureMarket (f a)

instance Monad StockLiquor where
  (>>=) = linkMarket

linkMarket
  :: StockLiquor a
  -> (a -> StockLiquor b)
  -> StockLiquor b
linkMarket marketToA aToB =
  StockLiquor $ \market ->
    let
      (a, newMarket) = runStockLiquor marketToA market
    in
      runStockLiquor (aToB a) newMarket

pureMarket :: a -> StockLiquor a
pureMarket a =
  StockLiquor $ \market -> (a, market)

getMarket :: StockLiquor Market
getMarket =
  StockLiquor $ \market -> (market, market)

putMarket :: Market -> StockLiquor ()
putMarket newMarket =
  StockLiquor $ \_ -> ((), newMarket)

marketDrinkPrice :: Drink -> Market -> Fixed.Centi
marketDrinkPrice drink market =
  Map.findWithDefault (defaultDrinkPrice drink) drink market

defaultDrinkPrice :: Drink -> Fixed.Centi
defaultDrinkPrice drink =
  case drink of
    VodkaTonic -> 16.80
    RumAndCoke ->  4.75

demandDrink :: Drink -> StockLiquor Fixed.Centi
demandDrink drink = do
  market <- getMarket

  let
    thisPrice = marketDrinkPrice drink market
    nextPrice = thisPrice + 20.00
    newMarket = Map.insert drink nextPrice market

  putMarket newMarket
  pure thisPrice

orderDrink :: Drink -> StockLiquor Receipt
orderDrink drink = do
  price <- demandDrink drink
  pure (Receipt drink price)

orderDrinks :: [Drink] -> StockLiquor [Receipt]
orderDrinks drinks =
  case drinks of
    [] ->
      pure []

    firstDrink : restOfDrinks -> do
      firstReceipt <- orderDrink firstDrink
      restOfReceipts <- orderDrinks restOfDrinks
      pure (firstReceipt : restOfReceipts)

main :: IO ()
main = do
  let
    market = Map.fromList [(VodkaTonic, 18.00)]
    drinkList = [VodkaTonic, RumAndCoke, VodkaTonic]
    (receipts, finalMarket) = runStockLiquor (orderDrinks drinkList) market

  putStrLn ":: Drink Receipts ::"
  mapM_ print receipts

  putStrLn ":: Market ::"
  mapM_ print $ Map.toList finalMarket