I’m currently trying to cram Haskell into my brain, and in an effort to do so, I’ve been writing a fake POS (point of sales) application. It has a command-line UI that prompts the user to add Pizza
s and a Customer
to an Order
.
I need to re-organize the code, but this is what about 50% of the code looks like right now. The other 50% is in a module that defines what a Pizza
is, and also defines its helper functions.
Example Haskell source code (pizza order entry system)
So, without further ado, here is some sample source code that represents what I know about Haskell so far:
import System.IO import Pizza -- -- ORDER, CUSTOMER -- -- TODO add breadsticks, soft drinks, etc. data Order = Order { customer :: Customer , pizzas :: [Pizza] } deriving (Show) -- TODO expand the concept of a customer data Customer = Customer { name :: String } deriving (Show) createEmptyOrder :: Order createEmptyOrder = Order {customer=(Customer "no name"), pizzas=[]} addPizzaToOrder :: Order -> Pizza -> Order addPizzaToOrder orderIn pizzaIn = -- return a new Order that has the new pizza in it Order {customer=(customer orderIn), pizzas=newPizzas} where oldPizzas = pizzas orderIn -- get the pizzas from the incoming order newPizzas = pizzaIn : oldPizzas -- add the new pizza to the old pizzas -- TODO pass in a Customer here, not a String -- TODO the `where` clause probably isn't needed here addCustomerToOrder :: Order -> String -> Order addCustomerToOrder orderIn customerNameIn = Order {customer=(Customer customerNameIn), pizzas=oldPizzas} where oldPizzas = pizzas orderIn orderToString :: Order -> String orderToString (Order {customer = c, pizzas = p}) = "Customer: " ++ (show c) ++ ", Pizzas: " ++ (show p) printOrder :: Order -> IO () printOrder order = do putStrLn (orderToString order) ---------- -- MAIN -- ---------- main = do putStrLn "\n--- MAIN ---" putStrLn "1 - New Order\nq - Quit" line <- getLine case line of "1" -> do let order = createEmptyOrder finishedOrder <- buildOrder order printOrder finishedOrder main _ -> exit ---------------- -- buildOrder -- ---------------- buildOrder :: Order -> IO Order buildOrder orderIn = do putStrLn "\n--- BUILD ORDER ---" putStrLn "1 - New Pizza\n2 - Customer\nr - Return" line <- getLine case line of "1" -> do let pizza = newPizza let order = addPizzaToOrder orderIn pizza putStrLn "(added a pizza to the order)" buildOrder order -- recursive "2" -> do customerName <- newCustomer let order = addCustomerToOrder orderIn customerName putStrLn "(added a customer to the order)" buildOrder order -- recursive "r" -> return orderIn _ -> return orderIn -- TODO return a Customer here, not a String newCustomer :: IO String newCustomer = do putStrLn "Enter Customer Name: " line <- getLine return line newPizza :: Pizza newPizza = Pizza {crustSize=Medium, crustType=Thin, toppings=[Cheese]} exit :: IO () exit = do putStrLn ("exited")
A big thing I am trying to do in this code is handle the concept of an “order,” and also add items in an Order
instance. There may be better ways to do this, but the way I handle an order that I can add things to (and eventually remove things from) is to call the buildOrder
function recursively.
The user interface (text menus)
FWIW, the two “menus” in the application look as follows. First, here’s the “main” menu:
--- MAIN --- 1 - New Order q - Quit
Next, here’s the “build order” menu:
--- BUILD ORDER --- 1 - New Pizza 2 - Customer r - Return
If you add a Pizza
and a Customer
to the order and return to the main menu, you’ll see output like this:
Customer: Customer {name = "John Doe"}, Pizzas: [Pizza {crustSize = Medium, crustType = Thin, toppings = [Cheese]}]
My Haskell Pizza module code
Update: I can never find this code when I went to look at it, so I’m posting it here as well. This is some Haskell code for a Pizza
module that works (I think) with the previous code. I left my original comments in the code so you can see the struggles I had in learning Haskell (insert smiley emoji here):
module Pizza where type Pennies = Int -- interface for things like Pizza, Topping, Breadsticks, SoftDrink class Product a where cost :: a -> Pennies -- i think this makes Pizza "an instance of the Product typeclass". -- base pizza price depends on CrustType and CrustSize. -- this works, but the prices should really come from a database. -- TODO: may be a better way to declare each pizza instance Product BaseProduct where cost Pizza {crustSize=Small, crustType=_, toppings=_} = 800 -- $8 cost Pizza {crustSize=Medium, crustType=_, toppings=_} = 1000 -- $10 cost Pizza {crustSize=Large, crustType=_, toppings=_} = 1200 -- $12 data Topping = Cheese | Pepperoni | Sausage | GreenOlives | BlackOlives | Onions | Mushrooms deriving (Show, Eq) data CrustType = Thin | Thick | Regular deriving (Show) data CrustSize = Small | Medium | Large deriving (Show) data BaseProduct = Pizza { crustSize :: CrustSize , crustType :: CrustType , toppings :: [Topping] } | Breadsticks | SoftDrink deriving (Show) -- data Item = Food { description :: String, tastiness :: Integer } -- | Wand { description :: String, magic :: Integer } -- can now use functions like this: -- `crustSize aPizza` -- `crustType aPizza` -- `toppings aPizza` -- those functions are automatically generated with the record syntax -- define a pizza instance: -- Pizza {crustSize=Medium, crustType=Thin, toppings=[Cheese]} data Address = Address { street1 :: String , street2 :: String , city :: String , state :: String , zipcode :: String } -- data Customer = Customer { firstName :: String -- , lastName :: String -- , address :: Address -- , phoneNumber :: String -- } -- add a single topping to a pizza, returning the new pizza. -- note: can use `in` instead of `where` addTopping :: BaseProduct -> Topping -> BaseProduct addTopping p t = Pizza {crustSize=(crustSize p), crustType=(crustType p), toppings=newToppings} where oldToppings = toppings p newToppings = t : oldToppings -- made this a little shorter than `addTopping` addToppings :: BaseProduct -> [Topping] -> BaseProduct addToppings p ts = Pizza {crustSize=(crustSize p), crustType=(crustType p), toppings=newToppings} where newToppings = ts ++ (toppings p) -- remove the given Topping removeTopping :: BaseProduct -> Topping -> BaseProduct removeTopping p t = Pizza {crustSize=(crustSize p), crustType=(crustType p), toppings=newToppings} where oldToppings = toppings p newToppings = filter (\top -> top /= t) oldToppings tellPizza :: BaseProduct -> String tellPizza (Pizza {crustSize = cs, crustType = ct, toppings = t}) = "Size: " ++ (show cs) ++ ", Type: " ++ (show ct) ++ ", Toppings: " ++ (show t) -- just an example getToppings :: BaseProduct -> [Topping] getToppings p = toppings p
Please bear in mind that I’m not a Haskell expert, so I have no idea if any of that code represents Haskell best practices or worst practices.
Summary
I have no doubt that this Haskell code can be improved (probably dramatically, lol), especially the way I handle a new Customer
, but as mentioned, it represents what I know today.