Add UE2 A2 and tests
This commit is contained in:
parent
90818eee64
commit
ae702c772a
@ -1,7 +1,6 @@
|
|||||||
module Angabe2 where
|
module Angabe2 where
|
||||||
|
|
||||||
import Data.List
|
import Data.Time
|
||||||
import Data.Maybe
|
|
||||||
|
|
||||||
{- 1. Vervollstaendigen Sie gemaess Angabentext!
|
{- 1. Vervollstaendigen Sie gemaess Angabentext!
|
||||||
2. Vervollständigen Sie auch die vorgegebenen Kommentaranfänge!
|
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
|
| (day_to_num (tag d)) > (day_to_num XXX) && not(monat d `elem` full_months) = False
|
||||||
| otherwise = True
|
| 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
|
-- 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 :: Stunde -> Nat1
|
||||||
hour_to_num Eins = 1
|
hour_to_num Eins = 1
|
||||||
hour_to_num Zwei = 2
|
hour_to_num Zwei = 2
|
||||||
@ -171,8 +203,11 @@ month_to_num Nov = 11
|
|||||||
month_to_num Dez = 12
|
month_to_num Dez = 12
|
||||||
|
|
||||||
-- Aufgabe A.2
|
-- 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
|
einzulassen :: (Person,Regel,Kontrollzeitpunkt) -> Kontrollergebnis
|
||||||
@ -193,20 +228,26 @@ should_allow p ZweieinhalbG k
|
|||||||
|
|
||||||
should_allow p DreiG k = check_cert_validity p 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 :: Person -> Kontrollzeitpunkt -> Kontrollergebnis
|
||||||
check_cert_validity p k
|
check_cert_validity p k
|
||||||
| not(is_date_valid k) = Ungueltig
|
| 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
|
| 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
|
| otherwise = Abweisen
|
||||||
|
|
||||||
is_test_fresh :: DreiG_Status -> Kontrollzeitpunkt -> Bool
|
{-
|
||||||
is_test_fresh g k
|
check vaccine correctness:
|
||||||
| not(is_date_valid ((datum g), (uhrzeit g))) = False
|
if the vaccine is JandJ, only one vaccine is enough
|
||||||
| testart g == Antigen = False
|
if the vaccine is of other type, two vaccines are required
|
||||||
| otherwise = True
|
-}
|
||||||
|
|
||||||
is_vaccine_fresh :: DreiG_Status -> Bool
|
is_vaccine_fresh :: DreiG_Status -> Bool
|
||||||
is_vaccine_fresh g
|
is_vaccine_fresh g
|
||||||
| impfstoff g == JundJ =
|
| impfstoff g == JundJ =
|
||||||
@ -216,6 +257,33 @@ is_vaccine_fresh g
|
|||||||
if (anzahl g) == Zweimal then True
|
if (anzahl g) == Zweimal then True
|
||||||
else False
|
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
|
-- Aufgabe A.3
|
||||||
|
|
||||||
--einzulassende :: Einlassbegehrende -> Regel -> Kontrollzeitpunkt -> Einzulassende
|
--einzulassende :: Einlassbegehrende -> Regel -> Kontrollzeitpunkt -> Einzulassende
|
||||||
|
|||||||
157
code/Test2.hs
Normal file
157
code/Test2.hs
Normal file
@ -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"
|
||||||
|
]
|
||||||
Reference in New Issue
Block a user