MealProject_Haskell/Proj.hs

158 lines
5.7 KiB
Haskell
Raw Normal View History

2024-05-27 16:14:35 +02:00
{-# LANGUAGE OverloadedStrings #-}
import Control.Exception
import Control.Monad
import Data.ByteString.Lazy qualified as BL
import Data.ByteString.Lazy.Char8 qualified as BLC
import Data.Csv
import Data.Function (on)
import Data.List (maximumBy)
import Data.Vector (Vector)
import Data.Vector qualified as V
import System.IO.Error (isDoesNotExistError)
import System.Random (randomRIO)
import Test.HUnit
-- Definicja typu Dish (Danie)
data Dish = Dish
{ dishName :: BLC.ByteString,
recipe :: BLC.ByteString,
calories :: Int
}
deriving (Show)
-- Definicja instancji Eq dla Dish
instance Eq Dish where
(Dish name1 _ cal1) == (Dish name2 _ cal2) = name1 == name2 && cal1 == cal2
-- Definicja instancji FromNamedRecord dla Dish do parsowania z CSV
instance FromNamedRecord Dish where
parseNamedRecord r =
Dish
<$> r .: "mealName"
<*> r .: "mealRecipe"
<*> r .: "mealCalories"
--instance FromNamedRecord Dish where
--parseNamedRecord r = do
--mealName <- r .: "mealName"
--mealRecipe <- r .: "mealRecipe"
--mealCalories <- r .: "mealCalories"
--return (Dish mealName mealRecipe mealCalories)
-- Definicja instancji ToNamedRecord dla Dish do zapisywania do CSV
instance ToNamedRecord Dish where
toNamedRecord (Dish name recipe cal) =
namedRecord ["mealName" .= name, "mealRecipe" .= recipe, "mealCalories" .= cal]
-- Definicja instancji DefaultOrdered dla Dish do zachowania kolejności nagłówków w CSV
instance DefaultOrdered Dish where
headerOrder _ = header ["mealName", "mealRecipe", "mealCalories"]
-- Wczytuje plik CSV i parsuje go na listę dań
readCSV :: FilePath -> IO [Dish]
readCSV path = do
contents <- BLC.readFile path
case decodeByName contents of
Left err -> do
putStrLn $ "Błąd parsowania CSV: " ++ err
return []
Right (_, v) -> return $ V.toList v
-- Zapisuje listę dań do pliku CSV
writeCSV :: FilePath -> [Dish] -> IO ()
writeCSV path dishes = do
let encoded = encodeDefaultOrderedByName dishes
BL.writeFile path encoded
-- Proponuje posiłki na podstawie podanej ilości kalorii
suggestMeals :: Int -> [Dish] -> IO (Dish, Dish, Dish)
suggestMeals _ [] = return (Dish "" "" 0, Dish "" "" 0, Dish "" "" 0)
suggestMeals targetCalories dishes = do
breakfast <- chooseRandomMeal $ filter (\d -> calories d <= targetCalories `div` 3) dishes
let remaining1 = filter (/= breakfast) dishes
let lunch = chooseBestMeal (targetCalories - calories breakfast) $ filter (\d -> calories d <= targetCalories `div` 2) remaining1
let remaining2 = filter (/= lunch) remaining1
let dinner = chooseBestMeal (targetCalories - calories breakfast - calories lunch) remaining2
return (breakfast, lunch, dinner)
-- Wybiera najlepsze danie na podstawie kalorii
chooseBestMeal :: Int -> [Dish] -> Dish
chooseBestMeal _ [] = Dish "" "" 0
chooseBestMeal targetCalories meals = maximumBy (compare `on` calories) $ filter (\d -> calories d <= targetCalories) meals
-- Wybiera losowe danie z listy
chooseRandomMeal :: [Dish] -> IO Dish
chooseRandomMeal [] = return $ Dish "" "" 0
chooseRandomMeal meals = do
idx <- randomRIO (0, length meals - 1)
return $ meals !! idx
-- Funkcja do wprowadzania nowych dań przez użytkownika
addNewDishes :: FilePath -> IO ()
addNewDishes path = do
putStrLn "Ile dań chcesz dodać?"
n <- readLn
newDishes <- forM [1 .. n] $ \_ -> do
putStrLn "Podaj nazwę dania:"
name <- BLC.pack <$> getLine
putStrLn "Podaj przepis:"
recipe <- BLC.pack <$> getLine
putStrLn "Podaj ilość kalorii:"
cal <- readLn
return $ Dish name recipe cal
existingDishes <- readCSV path
let allDishes = existingDishes ++ newDishes
writeCSV path allDishes
putStrLn "Nowe dania zostały zapisane do pliku."
-- Testy jednostkowe
testSuggestMeals :: Test
testSuggestMeals =
TestList
2024-05-27 16:18:49 +02:00
[ "Test suggestMeals for not exist list"
2024-05-27 16:14:35 +02:00
~: do
let csvFile = "empty.csv"
result <- tryJust (guard . isDoesNotExistError) $ readCSV csvFile
case result of
2024-05-27 16:18:49 +02:00
Left _ -> return ()
Right _ -> assertFailure ("Test suggestMeals for not exist list with file " ++ csvFile ++ ": should have failed to read CSV file"),
2024-05-27 16:14:35 +02:00
"Test suggestMeals for non-empty dish list"
~: do
let csvFile = "baza.csv"
targetCalories = 1400
result <- tryJust (guard . isDoesNotExistError) $ readCSV csvFile
case result of
Left _ -> assertFailure ("Test suggestMeals for non-empty dish list with file " ++ csvFile ++ ": could not read CSV file")
Right dishes -> do
(breakfast, lunch, dinner) <- suggestMeals targetCalories dishes
assertBool "Śniadanie nie powinno być puste" (dishName breakfast /= "" && calories breakfast > 0)
assertBool "Obiad nie powinien być pusty" (dishName lunch /= "" && calories lunch > 0)
assertBool "Kolacja nie powinna być pusta" (dishName dinner /= "" && calories dinner > 0)
]
main :: IO ()
main = do
testResult <- runTestTT testSuggestMeals
putStrLn "Co chcesz zrobić? (1) Otrzymać menu na pewną ilość kalorii (2) Dodać nowe dania"
choice <- getLine
let csvFile = "baza.csv"
case choice of
"1" -> do
putStrLn "Podaj średnią ilość kalorii na dzień:"
targetCalories <- readLn
result <- tryJust (guard . isDoesNotExistError) $ readCSV csvFile
case result of
Left _ -> putStrLn $ "Plik " ++ csvFile ++ " nie istnieje."
Right dishes -> do
(breakfast, lunch, dinner) <- suggestMeals targetCalories dishes
putStrLn "Śniadanie:"
print breakfast
putStrLn "Obiad:"
print lunch
putStrLn "Kolacja:"
print dinner
"2" -> addNewDishes csvFile
_ -> putStrLn "Niepoprawny wybór."