From ae702c772a3ec87f5ed7d8d05a17c709f02005da Mon Sep 17 00:00:00 2001 From: Ivaylo Ivanov Date: Thu, 28 Oct 2021 18:44:41 +0200 Subject: [PATCH] Add UE2 A2 and tests --- code/Angabe2.hs | 92 ++++++++++++++++++++++++---- code/Test2.hs | 157 ++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 237 insertions(+), 12 deletions(-) create mode 100644 code/Test2.hs diff --git a/code/Angabe2.hs b/code/Angabe2.hs index 251f694..ac485ee 100644 --- a/code/Angabe2.hs +++ b/code/Angabe2.hs @@ -1,7 +1,6 @@ module Angabe2 where -import Data.List -import Data.Maybe +import Data.Time {- 1. Vervollstaendigen Sie gemaess Angabentext! 2. Vervollständigen Sie auch die vorgegebenen Kommentaranfänge! @@ -102,7 +101,40 @@ is_date_valid (d, u) | (day_to_num (tag d)) > (day_to_num XXX) && not(monat d `elem` full_months) = False | otherwise = True +uhrzeit_vhds :: Uhrzeit -> VHDS +uhrzeit_vhds (U (v, _, _)) = v + +uhrzeit_stunde :: Uhrzeit -> Stunde +uhrzeit_stunde (U (_, s, _)) = s + +uhrzeit_vornach :: Uhrzeit -> VorNachMittag +uhrzeit_vornach (U (_, _, v)) = v + -- Dumb conversion functions + +timeFormat = "%Y-%m-%d %l:%M:%S %p" +understandTime = parseTimeOrError True defaultTimeLocale timeFormat + +convert_to_utc :: (Datum, Uhrzeit) -> UTCTime +convert_to_utc (d, u) = + let + day = show (day_to_num (tag d)) + month = show (month_to_num (monat d)) + year = show (jahr d) + hour = show (hour_to_num (uhrzeit_stunde u)) + vm = vm_to_ampm (uhrzeit_vornach u) + vhds = show (vhds_to_num (uhrzeit_vhds u)) + date = year ++ "-" ++ month ++ "-" ++ day + time = hour ++ ":" ++ vhds ++ ":00" + datetime = date ++ " " ++ time ++ " " ++ vm + in + understandTime datetime + +vm_to_ampm :: VorNachMittag -> String +vm_to_ampm vm + | vm == VM = "am" + | otherwise = "pm" + hour_to_num :: Stunde -> Nat1 hour_to_num Eins = 1 hour_to_num Zwei = 2 @@ -171,8 +203,11 @@ month_to_num Nov = 11 month_to_num Dez = 12 -- Aufgabe A.2 -{- Knapp, aber gut nachvollziehbar geht einzulassen folgendermassen vor: - ... +{- + if the person is Udrei, deny + if the person is only tested and only 2g is allowed, deny + if the person is tested with antigen and 2.5g is allowed, deny + otherwise, check the cert validity with the special function -} einzulassen :: (Person,Regel,Kontrollzeitpunkt) -> Kontrollergebnis @@ -193,20 +228,26 @@ should_allow p ZweieinhalbG k should_allow p DreiG k = check_cert_validity p k +{- + check certificate validity: + if the control point is invalid, deny + if the person has been sick, allow + if the person is vaccinated, check for correctness of vaccines + if the person is tested, check for fresshness of test +-} check_cert_validity :: Person -> Kontrollzeitpunkt -> Kontrollergebnis check_cert_validity p k | not(is_date_valid k) = Ungueltig - | is_tested p && (is_test_fresh (dreig_status p) k) = Einlassen - | is_vaccinated p && is_vaccine_fresh (dreig_status p) = Einlassen | was_sick p = Einlassen + | is_vaccinated p && is_vaccine_fresh (dreig_status p) = Einlassen + | is_tested p && (is_test_fresh (dreig_status p) k) = Einlassen | otherwise = Abweisen -is_test_fresh :: DreiG_Status -> Kontrollzeitpunkt -> Bool -is_test_fresh g k - | not(is_date_valid ((datum g), (uhrzeit g))) = False - | testart g == Antigen = False - | otherwise = True - +{- + check vaccine correctness: + if the vaccine is JandJ, only one vaccine is enough + if the vaccine is of other type, two vaccines are required +-} is_vaccine_fresh :: DreiG_Status -> Bool is_vaccine_fresh g | impfstoff g == JundJ = @@ -216,6 +257,33 @@ is_vaccine_fresh g if (anzahl g) == Zweimal then True else False +{- + function that checks if the test is fresh + if the date of the test is invalid, then False + otherwise, convert the datetime of the vaccination and the control time to utc and compare the difference to the validity of the test +-} + +is_test_fresh :: DreiG_Status -> Kontrollzeitpunkt -> Bool +is_test_fresh g k + | not(is_date_valid ((datum g), (uhrzeit g))) = False + | testart g == Antigen = handle_test g k 2 + | testart g == PCR = handle_test g k 3 + | otherwise = False + +handle_test :: DreiG_Status -> Kontrollzeitpunkt -> Nat1 -> Bool +handle_test g k n + | (calculate_time_diff ((datum g), (uhrzeit g)) k) <= m = True + | otherwise = False + where m = toEnum(n * 24 * 60 * 60) + +{- + function that calculates the difference in seconds between two datetimes +-} +calculate_time_diff :: (Datum, Uhrzeit) -> (Datum, Uhrzeit) -> NominalDiffTime +calculate_time_diff u1 u2 = + abs(diffUTCTime (convert_to_utc u1) (convert_to_utc u2)) + + -- Aufgabe A.3 --einzulassende :: Einlassbegehrende -> Regel -> Kontrollzeitpunkt -> Einzulassende diff --git a/code/Test2.hs b/code/Test2.hs new file mode 100644 index 0000000..4715e96 --- /dev/null +++ b/code/Test2.hs @@ -0,0 +1,157 @@ +module Test2 where + +import Angabe2 +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.Ingredients (composeReporters) +import Test.Tasty.Ingredients.ConsoleReporter (consoleTestReporter) + +main :: IO () +main = defaultMainWithIngredients [consoleTestReporter] spec + +{-----TESTDATEN BEGINN-----} +ta = PCR :: Testart +dgs1 = Getestet PCR (D XX Okt 2021) (U (Viertel,Acht,VM)) :: DreiG_Status +dgs2 = Geimpft (BioNTec,Einmal) :: DreiG_Status +dgs3 = Genesen :: DreiG_Status +dgs4 = Getestet Antigen (D XXII Sep 2021) (U (Schlag,Acht,VM)) :: DreiG_Status +dsg5 = Getestet PCR (D XXX Dez 1999) (U (Schlag,Zwoelf,NM)) :: DreiG_Status +dsg6 = Getestet Antigen (D XXIX Feb 2020) (U (Dreiviertel,Eins,VM)) :: DreiG_Status +buergermeister = P (Vorname "Michael") (Nachname "Ludwig") dgs1 :: Person +bundesminister = P (Vorname "Wolfgang") (Nachname "Mueckstein") dgs2 :: Person +bundeskanzler = P (Vorname "Alexander") (Nachname "Schallenberg") dgs3 :: Person +bundespraesident = P (Vorname "Alexander") (Nachname "van der Bellen") dgs4 :: Person +testperson1 = P (Vorname "HAL") (Nachname "9000") dsg5 :: Person +testperson2 = P (Vorname "Deep") (Nachname "Thought") dsg6 :: Person +bgm = buergermeister +bm = bundesminister +bk = bundeskanzler +bp = bundespraesident +tp1 = testperson1 +tp2 = testperson2 +kzp1 = ((D XXII Okt 2021),(U (Dreiviertel,Acht,NM))) :: Kontrollzeitpunkt +kzp2 = ((D XXVIII Okt 2021),(U (Dreiviertel,Acht,NM))) :: Kontrollzeitpunkt +kzp3 = ((D XXXI Nov 2021),(U (Dreiviertel,Acht,NM))) :: Kontrollzeitpunkt +kzp4 = ((D XXX Dez 1999),(U (Schlag,Zwoelf,NM))) :: Kontrollzeitpunkt +kzp5 = ((D I Jan 2000),(U (Schlag,Zwoelf,NM))) :: Kontrollzeitpunkt +kzp6 = ((D I Mar 2020),(U (Dreiviertel,Eins,VM))) :: Kontrollzeitpunkt +{-----TESTDATEN ENDE-----} + +spec :: TestTree +spec = + testGroup + "Test2 Spec" + [ + einzulassen_tests, + einzulassende_tests, + einzulassende_abzuweisende_tests, + showDatum_tests, + showUhrzeit_tests + ] + +einzulassen_tests :: TestTree +einzulassen_tests = + testGroup + "-----einzulassen Tests-----" + [ + testCase "PCRgetestet, DreiG, Datum gültig" $ + einzulassen (bgm,DreiG,kzp1) @?= Einlassen, + testCase "PCR - Ungetestet, DreiG, Datum gültig" $ + einzulassen (bgm,DreiG,kzp2) @?= Abweisen, + testCase "PCR - Ungetestet, DreiG, Kontroll-Datum ungültig" $ + einzulassen (bgm,DreiG,kzp3) @?= Ungueltig, + testCase "Geimpft - Status: Ungeschuetzt, DreiG, Datum gültig" $ + einzulassen (bm,DreiG,kzp1) @?= Abweisen, + testCase "Geimpft - Status: Ungeschuetzt, DreiG, Datum gültig" $ + einzulassen (bm,DreiG,kzp2) @?= Abweisen, + testCase "Geimpft - Status: Ungeschuetzt, DreiG, Datum ungültig" $ + einzulassen (bm,DreiG,kzp3) @?= Ungueltig, + testCase "Genesen, DreiG, Datum gültig" $ + einzulassen (bk,DreiG,kzp1) @?= Einlassen, + testCase "Genesen, DreiG, Datum gültig" $ + einzulassen (bk,DreiG,kzp2) @?= Einlassen, + testCase "Genesen, DreiG, Datum ungültig" $ + einzulassen (bk,DreiG,kzp3) @?= Ungueltig, + testCase "AG - Ungetestet, ZweieinhalbG, Datum gültig" $ + einzulassen (bp,ZweieinhalbG,kzp1) @?= Abweisen, + testCase "AG - Ungetestet, ZweieinhalbG, Datum gültig" $ + einzulassen (bp,ZweieinhalbG,kzp2) @?= Abweisen, + testCase "AG - Ungetestet, ZweieinhalbG, Datum ungültig" $ + einzulassen (bp,ZweieinhalbG,kzp3) @?= Ungueltig, + testCase "PCRgetestet, ZweeinhalbiG, Datum gültig" $ + einzulassen (tp1,ZweieinhalbG,kzp4) @?= Einlassen, + testCase "PCRgetestet, ZweieinhalbG, kzp == tzp, Datum gültig" $ + einzulassen (tp1,ZweieinhalbG,kzp5) @?= Einlassen, + testCase "AGgetestet, ZweiG, Datum gültig" $ + einzulassen (tp2,ZweiG,kzp6) @?= Abweisen, + testCase "AGgetestet, DreiG, Datum gültig" $ + einzulassen (tp2,DreiG,kzp6) @?= Einlassen + ] + +einzulassende_tests :: TestTree +einzulassende_tests = + testGroup + "-----einzulassende Tests-----" + [ + testCase "2/4 Personen: [Michael Ludwig, Alexander Schallenberg]" $ + einzulassende [bgm,bm,bk,bp] DreiG kzp1 @?= ["Michael Ludwig","Alexander Schallenberg"], + testCase "0/4 Personen: [], ungültiges Kontrolldatum" $ + einzulassende [bgm,bm,bk,bp] DreiG kzp3 @?= [] + ] + +einzulassende_abzuweisende_tests :: TestTree +einzulassende_abzuweisende_tests = + testGroup + "-----einzulassende_abzuweisende Tests-----" + [ + testCase "2 Einlassen, 2 Abweisen" $ + einzulassende_abzuweisende [bgm,bm,bk,bp] DreiG kzp1 @?= (["Michael Ludwig","Alexander Schallenberg"],["Wolfgang Mueckstein","Alexander van der Bellen"]), + testCase "0 Einlassen, 0 Abweisen, ungültiges Kontrolldatum" $ + einzulassende_abzuweisende [bgm,bm,bk,bp] DreiG kzp3 @?= ([],[]) + ] + +showDatum_tests :: TestTree +showDatum_tests = + testGroup + "-----show Datum Tests-----" + [ + testCase "XXII Okt 2021" $ + show (D XXII Okt 2021) @?= "22.10.2021", + testCase "XXIV Dez 2412" $ + show (D XXIV Dez 2412) @?= "24.12.2412", + testCase "XXXI Feb 1234" $ + show (D XXXI Feb 1234) @?= "Datum ungueltig", + testCase "XXIX Feb 2000" $ + show (D XXIX Feb 2000) @?= "29.2.2000", + testCase "XXIX Feb 1900" $ + show (D XXIX Feb 1900) @?= "Datum ungueltig", + testCase "XXIX Feb 2004" $ + show (D XXIX Feb 2004) @?= "29.2.2004", + testCase "XXXI Jun 2021" $ + show (D XXXI Jun 2021) @?= "Datum ungueltig" + ] + +showUhrzeit_tests :: TestTree +showUhrzeit_tests = + testGroup + "-----show Uhrzeit Tests-----" + [ + testCase "Viertel, Zwoelf, VM" $ + show (U (Viertel, Zwoelf, VM)) @?= "11:15 Uhr", + testCase "Viertel, Zwoelf, NM" $ + show (U (Viertel, Zwoelf, NM)) @?= "23:15 Uhr", + testCase "Dreiviertel, Zwoelf, VM" $ + show (U (Dreiviertel, Zwoelf, VM)) @?= "11:45 Uhr", + testCase "Dreiviertel, Zwoelf, NM" $ + show (U (Dreiviertel, Zwoelf, NM)) @?= "23:45 Uhr", + testCase "Schlag, Zwoelf, VM" $ + show (U (Schlag, Zwoelf, VM)) @?= "12:00 Uhr", + testCase "Schlag, Zwoelf, NM" $ + show (U (Schlag, Zwoelf, NM)) @?= "24:00 Uhr", + testCase "Halb, Sechs, VM" $ + show (U (Halb, Sechs, VM)) @?= "05:30 Uhr", + testCase "Halb, Sechs, NM" $ + show (U (Halb, Sechs, NM)) @?= "17:30 Uhr", + testCase "Viertel, Eins, VM" $ + show (U (Viertel, Eins, VM)) @?= "00:15 Uhr" + ] \ No newline at end of file