module Angabe2 where import Data.Time {- 1. Vervollstaendigen Sie gemaess Angabentext! 2. Vervollständigen Sie auch die vorgegebenen Kommentaranfänge! 3. Loeschen Sie keine Deklarationen aus diesem Rahmenprogramm, auch nicht die Modulanweisug! 4. Achten Sie darauf, dass `Gruppe' Leserechte fuer Ihre Abgabedatei hat! -} -- Aufgabe A.1 -- Ergaenzen Sie fehlende Typklassen in deriving-Klauseln, wo noetig und nicht explizit -- eine Instanz-Deklaration gefordert ist. type Nat1 = Int newtype Vorname = Vorname String deriving (Eq,Show,Ord) newtype Nachname = Nachname String deriving (Eq,Show,Ord) data VHDS = Viertel | Halb | Dreiviertel | Schlag deriving (Eq,Ord,Show) data Stunde = Eins | Zwei | Drei | Vier | Fuenf | Sechs | Sieben | Acht | Neun | Zehn | Elf | Zwoelf deriving (Eq,Ord,Show) data VorNachMittag = VM | NM deriving (Eq,Ord,Show) newtype Uhrzeit = U (VHDS,Stunde,VorNachMittag) deriving (Eq,Ord) data Tag = I | II | III | IV | V | VI | VII | VIII | IX | X | XI | XII | XIII | XIV | XV | XVI | XVII | XVIII | XIX | XX | XXI | XXII | XXIII | XXIV | XXV | XXVI | XXVII | XXVIII | XXIX | XXX | XXXI deriving (Eq,Ord,Show) data Monat = Jan | Feb | Mar | Apr | Mai | Jun | Jul | Aug | Sep | Okt | Nov | Dez deriving (Eq,Ord,Show) type Jahr = Nat1 data Datum = D { tag :: Tag, monat :: Monat, jahr :: Jahr } deriving (Eq,Ord) data Testart = PCR | Antigen deriving (Eq,Show,Ord) data Impfstoff = AstraZeneca | BioNTec | JundJ | Moderna | Sputnik | Sinovac deriving (Eq,Show,Ord) data Anzahl = Einmal | Zweimal deriving (Eq,Show,Ord) data DreiG_Status = Geimpft (Impfstoff, Anzahl) | Genesen | Getestet { testart :: Testart, datum :: Datum, uhrzeit :: Uhrzeit } | Udrei deriving (Eq,Show,Ord) -- Udrei: Ungetestet, Ungenesen, Ungeimpft data Regel = DreiG | ZweieinhalbG | ZweiG deriving Eq data Person = P { vorname :: Vorname, nachname :: Nachname, dreig_status :: DreiG_Status } deriving (Eq,Ord) type Einlassbegehrende = [Person] type VorUndNachname = String type Einzulassende = [VorUndNachname] type Abzuweisende = [VorUndNachname] type Kontrollzeitpunkt = (Datum,Uhrzeit) data Kontrollergebnis = Einlassen | Abweisen | Ungueltig deriving (Eq,Show) -- General functions was_sick :: Person -> Bool was_sick p | dreig_status p == Genesen = True | otherwise = False is_vaccinated :: Person -> Bool is_vaccinated p = case dreig_status p of Geimpft (_, _) -> True _ -> False is_tested :: Person -> Bool is_tested p = case dreig_status p of Getestet _ _ _ -> True _ -> False full_months::[Monat] full_months = [Jan, Mar, Mai, Jul, Aug, Okt, Dez] is_date_valid :: (Datum, Uhrzeit) -> Bool is_date_valid (d, u) | monat d == Feb = let y = jahr d in let t = tag d in if y `mod` 4 /= 0 && (day_to_str t) > (day_to_str XXVIII) then False else if y `mod` 100 == 0 && y `mod` 400 /= 0 then False else if (day_to_str t) > (day_to_str XXIX) then False else True | (day_to_str (tag d)) > (day_to_str 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 impfstoff :: DreiG_Status -> Impfstoff impfstoff (Geimpft (i, _)) = i anzahl :: DreiG_Status -> Anzahl anzahl (Geimpft (_, a)) = a -- Dumb conversion functions vorname_to_str :: Vorname -> String vorname_to_str (Vorname v) = v nachname_to_str :: Nachname -> String nachname_to_str (Nachname v) = v person_to_string :: Person -> VorUndNachname person_to_string p = v ++ " " ++ n where v = vorname_to_str (vorname p) n = nachname_to_str (nachname p) {- Convert datetime from our type to utc time (am/pm mode) -} timeFormat = "%Y-%m-%d %0I:%0M:%S %p" understandTime = parseTimeOrError True defaultTimeLocale timeFormat convert_to_utc :: (Datum, Uhrzeit) -> UTCTime convert_to_utc (d, u) = let day = day_to_str (tag d) month = month_to_str (monat d) year = show (jahr d) vm = vm_to_ampm (uhrzeit_vornach u) vhds = vhds_to_str (uhrzeit_vhds u) hour = (convert_hour_am_pm (uhrzeit_stunde u) vhds) date = year ++ "-" ++ month ++ "-" ++ day time = hour ++ ":" ++ vhds ++ ":00" datetime = date ++ " " ++ time ++ " " ++ vm in understandTime datetime {- Convert hour to string (am/pm mode) -} convert_hour_am_pm :: Stunde -> String -> String convert_hour_am_pm s v | v /= "00" = if (hour_to_num s - 1) <= 9 then "0" ++ show (hour_to_num s - 1) else show (hour_to_num s - 1) | otherwise = if hour_to_num s <= 9 then "0" ++ show (hour_to_num s) else show (hour_to_num s) {- Convert hour to string (24h mode) -} convert_hour :: Stunde -> String -> VorNachMittag -> String convert_hour s v vn | v /= "00" = if vn == VM then if (hour_to_num s - 1) <= 9 then "0" ++ show (hour_to_num s - 1) else show (hour_to_num s - 1) else show ((hour_to_num s + 12) - 1) | otherwise = if vn == VM then if hour_to_num s <= 9 then "0" ++ show (hour_to_num s) else show (hour_to_num s) else show ((hour_to_num s + 12)) 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 hour_to_num Drei = 3 hour_to_num Vier = 4 hour_to_num Fuenf = 5 hour_to_num Sechs = 6 hour_to_num Sieben = 7 hour_to_num Acht = 8 hour_to_num Neun = 9 hour_to_num Zehn = 10 hour_to_num Elf = 11 hour_to_num Zwoelf = 12 vhds_to_str :: VHDS -> String vhds_to_str Schlag = "00" vhds_to_str Viertel = "15" vhds_to_str Halb = "30" vhds_to_str Dreiviertel = "45" day_to_str :: Tag -> String day_to_str I = "01" day_to_str II = "02" day_to_str III = "03" day_to_str IV = "04" day_to_str V = "05" day_to_str VI = "06" day_to_str VII = "07" day_to_str VIII = "08" day_to_str IX = "09" day_to_str X = "10" day_to_str XI = "11" day_to_str XII = "12" day_to_str XIII = "13" day_to_str XIV = "14" day_to_str XV = "15" day_to_str XVI = "16" day_to_str XVII = "17" day_to_str XVIII = "18" day_to_str XIX = "19" day_to_str XX = "20" day_to_str XXI = "21" day_to_str XXII = "22" day_to_str XXIII = "23" day_to_str XXIV = "24" day_to_str XXV = "25" day_to_str XXVI = "26" day_to_str XXVII = "27" day_to_str XXVIII = "28" day_to_str XXIX = "29" day_to_str XXX = "30" day_to_str XXXI = "31" month_to_str :: Monat -> String month_to_str Jan = "01" month_to_str Feb = "02" month_to_str Mar = "03" month_to_str Apr = "04" month_to_str Mai = "05" month_to_str Jun = "06" month_to_str Jul = "07" month_to_str Aug = "08" month_to_str Sep = "09" month_to_str Okt = "10" month_to_str Nov = "11" month_to_str Dez = "12" -- Aufgabe A.2 {- 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 (p, r, k) | not(is_date_valid k) = Ungueltig | dreig_status p == Udrei = Abweisen | otherwise = should_allow p r k should_allow :: Person -> Regel -> Kontrollzeitpunkt -> Kontrollergebnis should_allow p ZweiG k | (not (was_sick p)) || (not (is_vaccinated p)) = Abweisen | otherwise = check_cert_validity p k should_allow p ZweieinhalbG k | is_tested p = if testart (dreig_status p) == Antigen then Abweisen else check_cert_validity p k | otherwise = 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 p k | was_sick p = Einlassen | is_vaccinated p && is_vaccine_fresh (dreig_status p) = Einlassen | is_tested p && not(is_date_valid ((datum (dreig_status p)), (uhrzeit (dreig_status p)))) = Ungueltig | is_tested p && (is_test_fresh (dreig_status p) k) = Einlassen | otherwise = Abweisen {- 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 = if ((anzahl g) == Einmal || (anzahl g) == Zweimal) then True else False | otherwise = 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 | testart g == Antigen = handle_test g k 24 | testart g == PCR = handle_test g k 72 | otherwise = False handle_test :: DreiG_Status -> Kontrollzeitpunkt -> Nat1 -> Bool handle_test g k n | (calculate_time_diff ((datum g), (uhrzeit g)) k) > 0 = False | abs(calculate_time_diff ((datum g), (uhrzeit g)) k) <= m = True | otherwise = False where m = (fromInteger (toInteger (n * 60 * 60))) :: NominalDiffTime {- function that calculates the difference in seconds between two datetimes -} calculate_time_diff :: (Datum, Uhrzeit) -> (Datum, Uhrzeit) -> NominalDiffTime calculate_time_diff u1 u2 = diffUTCTime (convert_to_utc u1) (convert_to_utc u2) -- Aufgabe A.3 {- loop through the list of people if the head is allowed, convert to string and add it to the result list, call the function recursively with the tail of the list if the head is not allowed, call the function recursively with the tail of the list when the tail is empty, terminate -} einzulassende :: Einlassbegehrende -> Regel -> Kontrollzeitpunkt -> Einzulassende einzulassende p r k = allowed_people p r k [] allowed_people :: Einlassbegehrende -> Regel -> Kontrollzeitpunkt -> [VorUndNachname] -> Einzulassende allowed_people (p:ps) r k res | ps == [] = res | (einzulassen (p, r, k)) == Einlassen = allowed_people ps r k (res ++ [person_to_string p]) | otherwise = allowed_people ps r k res disallowed_people :: Einlassbegehrende -> Regel -> Kontrollzeitpunkt -> [VorUndNachname] -> Einzulassende disallowed_people (p:ps) r k res | ps == [] = res | (einzulassen (p, r, k)) == Abweisen = disallowed_people ps r k (res ++ [person_to_string p]) | otherwise = disallowed_people ps r k res -- Aufgabe A.4 {- call the function from A.3 to calculate the allowed people, create a new function analogic to the one in A.3 but for disallowed people -} einzulassende_abzuweisende :: Einlassbegehrende -> Regel -> Kontrollzeitpunkt -> (Einzulassende,Abzuweisende) einzulassende_abzuweisende p r k = ((einzulassende p r k), (disallowed_people p r k [])) -- Aufgabe A.5 {- call the conversion methods that we defined for the utc conversion above and build the string -} instance Show Uhrzeit where show (U (m, h, a)) = hour ++ ":" ++ min ++ " Uhr" where min = vhds_to_str m hour = convert_hour h (vhds_to_str m) a {- call the conversion methods that we defined for the utc conversion above and build the string -} instance Show Datum where show (D d m y) = if (is_date_valid ((D d m y), (U (Dreiviertel,Acht,NM)))) == False then "Datum ungueltig" -- check with valid hour, cause the function also requires hours else day ++ "." ++ month ++ "." ++ year where day = (if head (day_to_str d) == '0' then tail (day_to_str d) else day_to_str d) month = (if head (month_to_str m) == '0' then tail (month_to_str m) else month_to_str m) year = show y