SandwichDSL.hs

{- CSci 450/503, Fall 2014
   Homework #4: Sandwich DSL
   Clay McLeod
   5 November 2014

This is the SandwichDSL base code from the case study. It can be
expanded to build the module for Assignment #4.

-}

module SandwichDSL
where

-- Used functions from these modules in my implementation
import Data.Maybe
import Data.List

{- Haskell data type definitions from "Building the DSL" -}

data Platter   = Platter [Sandwich] 
                 deriving Show

data Sandwich  = Sandwich [Layer]
                 deriving Show

data Layer     = Bread Bread         | Meat Meat           |
                 Cheese Cheese       | Vegetable Vegetable | 
                 Condiment Condiment
                 deriving (Eq,Show)

data Bread     = White | Wheat | Rye
                 deriving (Eq,Show)

data Meat      = Turkey | Chicken | Ham | RoastBeef | Tofu
                 deriving (Eq,Show)

data Cheese    = American | Swiss | Jack | Cheddar
                 deriving (Eq,Show)

data Vegetable = Tomato | Onion | Lettuce | BellPepper
                 deriving (Eq,Show)

data Condiment = Mayo | Mustard | Ketchup | Relish | Tabasco
                 deriving (Eq,Show)

-- Function type signatures given in section
newSandwich :: Bread -> Sandwich
newSandwich b = Sandwich [Bread b]

addLayer :: Sandwich -> Layer -> Sandwich
addLayer (Sandwich current) layer = Sandwich (layer : current)

newPlatter ::  Platter
newPlatter = (Platter [])

addSandwich :: Platter -> Sandwich -> Platter
addSandwich (Platter current) sandwich = Platter (sandwich : current)

isBread :: Layer -> Bool
isBread (Bread b) = True
isBread _      	  = False

isMeat :: Layer -> Bool
isMeat (Meat m)   = True
isMeat _ 	  = False

isCheese :: Layer -> Bool
isCheese (Cheese c)  = True
isCheese _	     = False

isVegetable :: Layer -> Bool
isVegetable (Vegetable v) = True
isVegetable _ 	          = False

isCondiment :: Layer -> Bool
isCondiment (Condiment c) = True
isCondiment _ 	          = False

noMeat :: Sandwich -> Bool
noMeat (Sandwich current@(h:tail))
	| tail == [] = True
	| isMeat h = False
	| True = noMeat (Sandwich (tail))
	
inOSO :: Sandwich -> Bool
inOSO (Sandwich layers@((Bread b):xs)) = (head (dropWhile isMeat 
						 (dropWhile isCheese (dropWhile isVegetable
						 (dropWhile isCondiment xs))))) == (Bread b)
inOSO _ 				= False

intoOSO :: Sandwich -> Bread -> Sandwich
intoOSO (Sandwich layers@(head:tail)) b =  (Sandwich ((Bread b) : ((filter isCondiment tail) ++ (filter isVegetable tail) ++ (filter isCheese tail) ++ (filter isMeat tail) ++ [Bread b])))
intoOSO _ _ = error "Invalid Sandwich!"

prices = [(Bread White,20),(Bread Wheat,30),(Bread Rye,30), 
          (Meat Turkey,100),(Meat Chicken,80),(Meat Ham,120),
          (Meat RoastBeef,140),(Meat Tofu,50),
          (Cheese American,50),(Cheese Swiss,60),
          (Cheese Jack,60),(Cheese Cheddar,60),
          (Vegetable Tomato,25),(Vegetable Onion,20),
          (Vegetable Lettuce,20),(Vegetable BellPepper,25),
          (Condiment Mayo,5),(Condiment Mustard,4),
          (Condiment Ketchup,4),(Condiment Relish,10),
          (Condiment Tabasco,5) 
         ]

priceSandwich :: Sandwich -> Int
priceSandwich (Sandwich [])	= error "Invalid Sandwich. Must have at least bread."
priceSandwich (Sandwich layers) = auxPriceSandwich layers 0
	where auxPriceSandwich :: [Layer] -> Int -> Int
	      auxPriceSandwich [] curr 	   	    = curr
	      auxPriceSandwich (head:tail) curr     =  auxPriceSandwich tail ((extractPrice value) + curr) 
			where value = lookup head prices 
			      extractPrice :: Maybe Int -> Int
			      extractPrice Nothing  = error "Type not in prices!"
			      extractPrice (Just x) = x


-- Didn't do eqSandwich, assignment says pick 2 of 3 --

--- Exercise 2 ---

{- Haskell data type definitions from
   "Compiling the Program for the SueChef Controller"
-}

data SandwichOp = StartSandwich    | FinishSandwich |
                  AddBread Bread   | AddMeat Meat   |
                  AddCheese Cheese | AddVegetable Vegetable |
                  AddCondiment Condiment |
                  StartPlatter | MoveToPlatter | FinishPlatter
                  deriving (Eq, Show)

data Program = Program [SandwichOp]
               deriving Show

compileSandwich :: Sandwich -> [SandwichOp]
compileSandwich (Sandwich layers) = auxCompileSandwich layers [StartSandwich]
	where auxCompileSandwich :: [Layer] -> [SandwichOp] -> [SandwichOp]
	      auxCompileSandwich [] curr       = curr ++ [FinishSandwich, MoveToPlatter]
	      auxCompileSandwich (h:tail) curr = auxCompileSandwich tail (curr ++ [opFromLayer h])
			where opFromLayer :: Layer -> SandwichOp
			      opFromLayer (Bread b)	   = AddBread b
			      opFromLayer (Condiment c)    = AddCondiment c
			      opFromLayer (Meat m) 	   = AddMeat m
			      opFromLayer (Cheese c)	   = AddCheese c
			      opFromLayer (Vegetable v)    = AddVegetable v


compile :: Platter -> Program
compile (Platter sandwiches) = (Program (auxCompile sandwiches []))
	where auxCompile :: [Sandwich] -> [SandwichOp] -> [SandwichOp]
	      auxCompile [] curr                = curr
	      auxCompile (s:tail) curr = auxCompile tail (curr ++ (compileSandwich s)) 

testall =
	do
		putStr "newSandwich (White) = "
		putStrLn (show (newSandwich (White)))
		putStr "addLayer (newSandwich (White)) (Meat Ham) = "
		putStrLn (show (addLayer (newSandwich (White)) (Meat Ham)))
		putStr "newPlatter = "
		putStrLn (show (newPlatter))
		putStr "addSandwich newPlatter (Sandwich [Bread White, Meat Ham, Bread White]) = "
		putStrLn (show(addSandwich newPlatter (Sandwich [Bread White, Meat Ham, Bread White])))
		putStr "isBread (Bread White) = "
		putStrLn (show(isBread (Bread White)))
		putStr "isBread (Meat Ham) = "
		putStrLn (show(isBread (Meat Ham)))
		putStr "isMeat (Meat Ham) = "
		putStrLn (show(isMeat (Meat Ham)))
		putStr "isMeat (Bread White) = "
		putStrLn (show(isMeat (Bread White)))
                putStr "isCheese (Cheese American) = "
                putStrLn (show(isCheese (Cheese American)))
                putStr "isCheese (Bread White) = "
                putStrLn (show(isCheese (Bread White)))
                putStr "isVegetable (Vegetable Tomato) = "
                putStrLn (show(isVegetable (Vegetable Tomato)))
                putStr "isVegetable (Bread White) = "
                putStrLn (show(isVegetable (Bread White)))
                putStr "isCondiment (Condiment Ketchup) = "
                putStrLn (show(isCondiment (Condiment Ketchup)))
                putStr "isCondiment (Bread White) = "
                putStrLn (show(isCondiment (Bread White)))
		putStr "inOSO (Sandwich [Bread White, Condiment Ketchup, Cheese American, Meat Ham, Bread White]) = "
		putStrLn (show(inOSO (Sandwich [Bread White, Condiment Ketchup, Cheese American, Meat Ham, Bread White])))
                putStr "inOSO (Sandwich [Bread White, Condiment Ketchup, Meat Ham, Cheese American, Bread White]) = "
                putStrLn (show(inOSO (Sandwich [Bread White, Condiment Ketchup, Meat Ham, Cheese American, Bread White])))
                putStr "inOSO (Sandwich []) = "
                putStrLn (show(inOSO (Sandwich [])))
                putStr "inOSO (Sandwich [Bread White, Condiment Ketchup, Bread Wheat]) = "
                putStrLn (show(inOSO (Sandwich [Bread White, Condiment Ketchup, Bread Wheat])))
		putStr "intoOSO (Sandwich [Meat Turkey, Vegetable Tomato, Condiment Ketchup, Meat Ham, Condiment Mustard, Cheese American]) = "
		putStrLn (show(intoOSO (Sandwich [Meat Turkey, Vegetable Tomato, Condiment Ketchup, Meat Ham, Condiment Mustard, Cheese American]) (Wheat)))
		putStr "priceSandwich (Sandwich [Meat Turkey, Vegetable Tomato, Condiment Ketchup, Meat Ham, Condiment Mustard, Cheese American]) = "
		putStrLn (show(priceSandwich (Sandwich [Meat Turkey, Vegetable Tomato, Condiment Ketchup, Meat Ham, Condiment Mustard, Cheese American])))
		putStrLn ""
		putStr "compileSandwich (intoOSO (Sandwich [Bread White, Cheese American, Bread White, Condiment Ketchup, Meat Ham, Meat Turkey]) (Wheat)) = "
		putStrLn (show(compileSandwich (intoOSO (Sandwich [Bread White, Cheese American, Bread White, Condiment Ketchup, Meat Ham, Meat Turkey]) (Wheat))))
		putStrLn ""
		putStr "compile (Platter [(Sandwich [Bread Wheat,Condiment Ketchup,Cheese American,Meat Ham,Meat Turkey,Bread Wheat]), (Sandwich [Bread Wheat,Condiment Ketchup,Cheese American,Meat Ham,Meat Turkey,Bread Wheat])]) = "
		putStrLn (show(compile (Platter [(Sandwich [Bread Wheat,Condiment Ketchup,Cheese American,Meat Ham,Meat Turkey,Bread Wheat]), (Sandwich [Bread Wheat,Condiment Ketchup,Cheese American,Meat Ham,Meat Turkey,Bread Wheat])])))