327 lines
9.8 KiB
Haskell
327 lines
9.8 KiB
Haskell
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,Show)
|
|
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,Show,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_num t) > (day_to_num XXVIII) then False
|
|
else
|
|
if y `mod` 100 == 0 && y `mod` 400 /= 0 then False
|
|
else
|
|
if (day_to_num t) > (day_to_num XXIX) then False
|
|
else True
|
|
| (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
|
|
|
|
|
|
impfstoff :: DreiG_Status -> Impfstoff
|
|
impfstoff (Geimpft (i, _)) = i
|
|
|
|
anzahl :: DreiG_Status -> Anzahl
|
|
anzahl (Geimpft (_, a)) = a
|
|
|
|
-- 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)
|
|
vm = vm_to_ampm (uhrzeit_vornach u)
|
|
vhds = show (vhds_to_num (uhrzeit_vhds u))
|
|
hour = (if vhds /= "0" then show (hour_to_num (uhrzeit_stunde u) - 1) else show (hour_to_num (uhrzeit_stunde 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
|
|
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_num :: VHDS -> Nat1
|
|
vhds_to_num Schlag = 0
|
|
vhds_to_num Viertel = 15
|
|
vhds_to_num Halb = 30
|
|
vhds_to_num Dreiviertel = 45
|
|
|
|
day_to_num :: Tag -> Nat1
|
|
day_to_num I = 1
|
|
day_to_num II = 2
|
|
day_to_num III = 3
|
|
day_to_num IV = 4
|
|
day_to_num V = 5
|
|
day_to_num VI = 6
|
|
day_to_num VII = 7
|
|
day_to_num VIII = 8
|
|
day_to_num IX = 9
|
|
day_to_num X = 10
|
|
day_to_num XI = 11
|
|
day_to_num XII = 12
|
|
day_to_num XIII = 13
|
|
day_to_num XIV = 14
|
|
day_to_num XV = 15
|
|
day_to_num XVI = 16
|
|
day_to_num XVII = 17
|
|
day_to_num XVIII = 18
|
|
day_to_num XIX = 19
|
|
day_to_num XX = 20
|
|
day_to_num XXI = 21
|
|
day_to_num XXII = 22
|
|
day_to_num XXIII = 23
|
|
day_to_num XXIV = 24
|
|
day_to_num XXV = 25
|
|
day_to_num XXVI = 26
|
|
day_to_num XXVII = 27
|
|
day_to_num XXVIII = 28
|
|
day_to_num XXIX = 29
|
|
day_to_num XXX = 30
|
|
day_to_num XXXI = 31
|
|
|
|
month_to_num :: Monat -> Nat1
|
|
month_to_num Jan = 1
|
|
month_to_num Feb = 2
|
|
month_to_num Mar = 3
|
|
month_to_num Apr = 4
|
|
month_to_num Mai = 5
|
|
month_to_num Jun = 6
|
|
month_to_num Jul = 7
|
|
month_to_num Aug = 8
|
|
month_to_num Sep = 9
|
|
month_to_num Okt = 10
|
|
month_to_num Nov = 11
|
|
month_to_num 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 1
|
|
| 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
|
|
|
|
|
|
{- Knapp, aber gut nachvollziehbar geht einzulassende folgendermassen vor:
|
|
...
|
|
-}
|
|
|
|
-- Aufgabe A.4
|
|
|
|
--einzulassende_abzuweisende :: Einlassbegehrende -> Regel -> Kontrollzeitpunkt -> ([Einzulassende],[Abzuweisende])
|
|
|
|
{- Knapp, aber gut nachvollziehbar geht einzulassende_abzuweisende folgendermassen vor:
|
|
...
|
|
-}
|
|
|
|
|
|
-- Aufgabe A.5
|
|
|
|
--instance Show Uhrzeit where
|
|
--show ...
|
|
|
|
{- Knapp, aber gut nachvollziehbar geht die Implementierung von show fuer Uhrzeit
|
|
folgendermassen vor:
|
|
...
|
|
-}
|
|
|
|
|
|
--instance Show Datum where
|
|
-- show ...
|
|
|
|
{- Knapp, aber gut nachvollziehbar geht die Implementierung von show fuer Datum
|
|
folgendermassen vor:
|
|
...
|
|
-}
|