FINAL ASSIGNMENT

import Data.List (find)

-- Product data structure

data Product = Product
{ productId :: Int
, name :: String
, category :: String
, price :: Double
, stock :: Int
} deriving (Show, Eq)

-- Customer data structure

data Customer = Customer {
customerID :: Int,
customerName :: String,
email :: String,
address :: String,
customLoyaltyPoints :: Int
} deriving (Show, Eq)

-- Order Status
data OrderStatus = Pending | Shipped | Delivered | Canceled deriving (Show,
Eq)

-- Order data structure

data Order = Order
{ orderId :: Int,
customer :: Customer,
productList :: [(Product, Int)], -- List of (Product, Quantity)
totalCost :: Double,
orderStatus :: OrderStatus
} deriving (Show, Eq)

-- Utility: Calculate total cost of an order

calculateTotalCost :: [(Product, Int)] -> Double
calculateTotalCost items = sum $ map productCost items
where
productCost (p, q) = price p * fromIntegral q

-- Create a new order

createOrder :: Int -> Customer -> [(Product, Int)] -> [Product] -> Either
String (Order, [Product])
createOrder newOrderId cust items products =
if all hasSufficientStock items then
let updatedProducts = map (updateStock items) products
totalCost = calculateTotalCost items
in Right (Order newOrderId cust items totalCost Pending, updatedProducts)
else Left "Currently, insufficient stock"
 where
hasSufficientStock (p, q) = q <= stock p

-- Update stock
updateStock :: [(Product, Int)] -> Product -> Product
updateStock items p = case find (matchesProduct p) items of
Just (_, q) -> p { stock = stock p - q }
Nothing -> p
where
matchesProduct :: Product -> (Product, Int) -> Bool
matchesProduct prod (p, _) = productId prod == productId p

-- Cancel an order
cancelOrder :: Order -> [Product] -> [Product]
cancelOrder order products
| orderStatus order == Pending = foldr restoreStock products (productList
order)
| otherwise = products
where
restoreStock (prod, qty) prods = map (restoreProductStock prod qty) prods

restoreProductStock prod qty p

| productId p == productId prod = p { stock = stock p + qty }
| otherwise = p

-- Apply loyalty points to reduce the total cost

applyLoyaltyPoints :: Order -> Int -> Either String Order
applyLoyaltyPoints order points
| points <= customLoyaltyPoints (customer order) =
let discount = fromIntegral points * 0.01
newCost = totalCost order * (1 - discount)
in Right order { totalCost = newCost }
| otherwise = Left "Not enough loyalty points"

-- Generate order statistics

generateStatistics :: [Order] -> (Double, Int, Double)
generateStatistics orders =
let completedOrders = filter isCompletedOrder orders
totalRevenue = sum $ map totalCost completedOrders
totalProductsSold = sum $ map getProductCount completedOrders
averageOrderValue = if null completedOrders then 0 else totalRevenue /
fromIntegral (length completedOrders)
in (totalRevenue, totalProductsSold, averageOrderValue)
where
isCompletedOrder o = orderStatus o == Delivered
getProductCount o = sum $ map snd (productList o)

-- Calculate total price of all finished orders

calculateTotalFinishedOrders :: [Order] -> Double
calculateTotalFinishedOrders orders =
sum $ map totalCost $ filter isNotCanceled orders
 where
isNotCanceled o = orderStatus o /= Canceled

printOrderedItem :: (Product, Int) -> IO ()

printOrderedItem (product, quantity) =
putStrLn $ "- " ++ name product ++ " (Quantity: " ++ show quantity ++ ")"

matchesOrderId :: Int -> Order -> Bool

matchesOrderId oid order = orderId order == oid

-- Example product catalog for the cosmetics shop

productCatalog :: [Product]
productCatalog =
[ Product 1 "Hydrating Face Cream" "Beauty" 19.99 20,
Product 2 "Vitamin C Serum" "Beauty" 29.99 15,
Product 3 "Mineral Sunscreen SPF 50" "Beauty" 24.99 18,
Product 4 "Nourishing Hair Oil" "Beauty" 15.99 25,
Product 5 "Matte Lipstick Set" "Beauty" 34.99 10,
Product 6 "Waterproof Mascara" "Beauty" 14.99 30,
Product 7 "Gel Nail Polish Kit" "Beauty" 49.99 8,
Product 8 "Charcoal Face Mask" "Beauty" 12.99 40,
Product 9 "Brightening Eye Cream" "Beauty" 22.50 15,
Product 10 "Aloe Vera Gel" "Beauty" 9.99 50,
Product 11 "Cleansing Micellar Water" "Beauty" 14.99 30,
Product 12 "Body Butter - Cocoa Scent" "Beauty" 19.50 25,
Product 13 "Organic Lip Balm Set" "Beauty" 12.99 35,
Product 14 "Argan Oil Hair Serum" "Beauty" 17.99 20,
Product 15 "Exfoliating Body Scrub" "Beauty" 16.50 25 ]

-- Main entry for the application

main :: IO ()
main = do
putStrLn "\n *** Online Marketplace Order Management System ***"
putStrLn "\n============== Online Marketplace =============="
putStrLn "Welcome to the Online Cosmetics Shop! \n"
putStrLn "Enter your name:"
name <- getLine
putStrLn "Enter your email:"
email <- getLine
putStrLn "Enter your address:"
address <- getLine
putStrLn "*** Get your loyal 100 points if u are new customer! *** "

let customer = Customer 1 (normalizeName name) email address 100

mainMenu productCatalog customer [] 1

-- Normalize customer name by trimming extra spaces

normalizeName :: String -> String
normalizeName = unwords . words

-- Main menu function

mainMenu :: [Product] -> Customer -> [Order] -> Int -> IO ()
mainMenu products customer orders nextOrderId = do
putStrLn "\nMain Menu:"
 putStrLn "1. View Products"
putStrLn "2. Place an Order"
putStrLn "3. View Orders"
putStrLn "4. Apply Loyalty Points to an Order"
putStrLn "5. Cancel an Order"
putStrLn "6. View Marketplace Statistics"
putStrLn "7. Finish Shopping and Show Total Price"
putStrLn "8. Update Order Status"
putStrLn "9. Exit"
putStr "Choose an option: "
choice <- getLine
case choice of
"1" -> do
putStrLn "\nAvailable Products:"
mapM_ printProduct products
mainMenu products customer orders nextOrderId
"2" -> do
putStrLn "\nEnter product IDs and quantities (e.g., 1 2 for Product
ID 1, Quantity 2):"
input <- getLine
let items = parseOrderInput input products
case items of
Nothing -> putStrLn "Invalid input! Try again." >> mainMenu
products customer orders nextOrderId
Just orderItems ->
case createOrder nextOrderId customer orderItems products of
Left err -> putStrLn ("Sorry! " ++ err) >> mainMenu
products customer orders nextOrderId
Right (newOrder, updatedProducts) -> do
putStrLn "Order placed successfully!"
putStrLn "\nOrdered Items:"
mapM_ printOrderedItem (productList newOrder)
mainMenu updatedProducts customer (newOrder : orders)
(nextOrderId + 1)
"3" -> do
putStrLn "\nCurrent Orders:"
if null orders then putStrLn "No orders placed yet."
else mapM_ print orders
mainMenu products customer orders nextOrderId
"4" -> do
putStrLn "\nEnter Order ID to apply loyalty points:"
oid <- readLn
putStrLn "Enter loyalty points to apply:"
points <- readLn
let orderToUpdate = find (matchesOrderId oid) orders
case orderToUpdate of
Nothing -> putStrLn "Order not found!" >> mainMenu products
customer orders nextOrderId
Just order -> case applyLoyaltyPoints order points of
Left err -> putStrLn ("Error: " ++ err) >> mainMenu products
customer orders nextOrderId
Right updatedOrder -> do
let updatedOrders = updatedOrder : filter (notSameOrder
oid) orders
putStrLn "\nLoyalty points applied successfully!"
putStrLn $ "Updated Total Cost: $" ++ show (totalCost
updatedOrder)
 mainMenu products customer updatedOrders nextOrderId
"5" -> do
putStrLn "\nEnter Order ID to cancel:"
oid <- readLn
let orderToCancel = find (isSameOrder oid) orders
case orderToCancel of
Nothing -> putStrLn "Order not found!" >> mainMenu products
customer orders nextOrderId
Just order -> do
let updatedProducts = cancelOrder order products
let updatedOrders = filter (notSameOrder oid) orders
putStrLn "Order canceled successfully!"
mainMenu updatedProducts customer updatedOrders nextOrderId
"6" -> do
let stats = generateStatistics orders
putStrLn $ "Total Revenue: " ++ show (fst3 stats)
putStrLn $ "Products Sold: " ++ show (snd3 stats)
putStrLn $ "Average Order Value: " ++ show (trd3 stats)
mainMenu products customer orders nextOrderId
"7" -> do
let totalPrice = calculateTotalFinishedOrders orders
putStrLn $ "Total price of all finished orders: $" ++ show totalPrice
mainMenu products customer orders nextOrderId
"8" -> do
putStrLn "\nEnter Order ID to update status:"
oid <- readLn
putStrLn "Enter new status (1: Pending, 2: Shipped, 3: Delivered, 4:
Canceled):"
statusChoice <- readLn
let newStatus = case statusChoice of
1 -> Pending
2 -> Shipped
3 -> Delivered
4 -> Canceled
_ -> Pending
let orderToUpdate = find (isSameOrder oid) orders
case orderToUpdate of
Nothing -> putStrLn "Order not found!" >> mainMenu products customer
orders nextOrderId
Just order -> do
let updatedOrder = order { orderStatus = newStatus }
let updatedOrders = updatedOrder : filter (notSameOrder oid) orders
putStrLn "Order status updated successfully!"
mainMenu products customer updatedOrders nextOrderId
"9" -> putStrLn "Thank you for shopping with us!"
_ -> putStrLn "Invalid option!" >> mainMenu products customer orders
nextOrderId

-- Helper functions
notSameOrder :: Int -> Order -> Bool
notSameOrder oid order = orderId order /= oid

isSameOrder :: Int -> Order -> Bool

isSameOrder oid order = orderId order == oid
fst3 :: (a, b, c) -> a
fst3 (x, _, _) = x

snd3 :: (a, b, c) -> b

snd3 (_, x, _) = x

trd3 :: (a, b, c) -> c

trd3 (_, _, x) = x

-- Parse order input

parseOrderInput :: String -> [Product] -> Maybe [(Product, Int)]
parseOrderInput input products =
let items = words input
in if even (length items) then Just (parseItems items products) else
Nothing

parseItems :: [String] -> [Product] -> [(Product, Int)]

parseItems [] _ = []
parseItems (pId:qId:rest) products =
case find (\p -> show (productId p) == pId) products of
Just p -> (p, read qId) : parseItems rest products
Nothing -> []

printProduct :: Product -> IO ()

printProduct p = putStrLn $ "ID: " ++ show (productId p) ++ ", Name: " ++
name p ++ ", Price: $" ++ show (price p) ++ ", Stock: " ++ show (stock p)