This repository has been archived on 2021-11-27. You can view files and clone it, but cannot push or open issues or pull requests.
fprog2021WS/code/Angabe2.hs

327 lines
9.8 KiB
Haskell
Raw Normal View History

2021-10-24 08:33:12 +00:00
module Angabe2 where
2021-10-28 16:44:41 +00:00
import Data.Time
2021-10-24 08:33:12 +00:00
{- 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)
2021-10-24 08:33:12 +00:00
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)
2021-10-24 08:33:12 +00:00
data Tag = I | II | III | IV | V | VI | VII | VIII | IX | X
| XI | XII | XIII | XIV | XV | XVI | XVII | XVIII
2021-10-24 08:33:12 +00:00
| 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)
2021-10-24 08:33:12 +00:00
type Jahr = Nat1
2021-10-24 11:25:20 +00:00
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)
2021-10-28 17:27:02 +00:00
data DreiG_Status = Geimpft (Impfstoff, Anzahl)
| Genesen
| Getestet {
testart :: Testart,
datum :: Datum,
uhrzeit :: Uhrzeit
}
| Udrei deriving (Eq,Show,Ord)
2021-10-24 08:33:12 +00:00
-- 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)
2021-10-24 08:33:12 +00:00
type Einlassbegehrende = [Person]
type VorUndNachname = String
type Einzulassende = [VorUndNachname]
type Abzuweisende = [VorUndNachname]
type Kontrollzeitpunkt = (Datum,Uhrzeit)
data Kontrollergebnis = Einlassen | Abweisen | Ungueltig deriving (Eq,Show)
2021-10-24 11:25:20 +00:00
-- 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
2021-10-28 17:27:02 +00:00
Geimpft (_, _) -> True
2021-10-24 11:25:20 +00:00
_ -> 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
2021-10-24 11:25:20 +00:00
else
if y `mod` 100 == 0 && y `mod` 400 /= 0 then False
else
if (day_to_num t) > (day_to_num XXIX) then False
2021-10-24 11:25:20 +00:00
else True
| (day_to_num (tag d)) > (day_to_num XXX) && not(monat d `elem` full_months) = False
2021-10-24 11:25:20 +00:00
| otherwise = True
2021-10-24 08:33:12 +00:00
2021-10-28 16:44:41 +00:00
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
2021-10-28 17:27:02 +00:00
impfstoff :: DreiG_Status -> Impfstoff
impfstoff (Geimpft (i, _)) = i
anzahl :: DreiG_Status -> Anzahl
anzahl (Geimpft (_, a)) = a
-- Dumb conversion functions
2021-10-28 16:44:41 +00:00
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))
2021-10-28 17:44:46 +00:00
hour = (if vhds /= "0" then show (hour_to_num (uhrzeit_stunde u) - 1) else show (hour_to_num (uhrzeit_stunde u)))
2021-10-28 16:44:41 +00:00
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
2021-10-24 08:33:12 +00:00
-- Aufgabe A.2
2021-10-28 16:44:41 +00:00
{-
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
2021-10-24 08:33:12 +00:00
-}
einzulassen :: (Person,Regel,Kontrollzeitpunkt) -> Kontrollergebnis
einzulassen (p, r, k)
2021-10-28 17:44:46 +00:00
| not(is_date_valid k) = Ungueltig
| dreig_status p == Udrei = Abweisen
2021-10-24 11:25:20 +00:00
| 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
2021-10-24 11:25:20 +00:00
else check_cert_validity p k
| otherwise = check_cert_validity p k
should_allow p DreiG k = check_cert_validity p k
2021-10-28 16:44:41 +00:00
{-
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
-}
2021-10-24 11:25:20 +00:00
check_cert_validity :: Person -> Kontrollzeitpunkt -> Kontrollergebnis
check_cert_validity p k
| was_sick p = Einlassen
2021-10-28 16:44:41 +00:00
| is_vaccinated p && is_vaccine_fresh (dreig_status p) = Einlassen
2021-10-28 17:44:46 +00:00
| is_tested p && not(is_date_valid ((datum (dreig_status p)), (uhrzeit (dreig_status p)))) = Ungueltig
2021-10-28 16:44:41 +00:00
| is_tested p && (is_test_fresh (dreig_status p) k) = Einlassen
| otherwise = Abweisen
2021-10-28 16:44:41 +00:00
{-
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
2021-10-28 16:44:41 +00:00
{-
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
2021-10-28 17:44:46 +00:00
| testart g == Antigen = handle_test g k 1
2021-10-28 16:44:41 +00:00
| 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))
2021-10-24 08:33:12 +00:00
-- Aufgabe A.3
--einzulassende :: Einlassbegehrende -> Regel -> Kontrollzeitpunkt -> Einzulassende
2021-10-24 08:33:12 +00:00
{- Knapp, aber gut nachvollziehbar geht einzulassende folgendermassen vor:
...
2021-10-24 08:33:12 +00:00
-}
-- Aufgabe A.4
--einzulassende_abzuweisende :: Einlassbegehrende -> Regel -> Kontrollzeitpunkt -> ([Einzulassende],[Abzuweisende])
2021-10-24 08:33:12 +00:00
{- Knapp, aber gut nachvollziehbar geht einzulassende_abzuweisende folgendermassen vor:
...
2021-10-24 08:33:12 +00:00
-}
-- Aufgabe A.5
--instance Show Uhrzeit where
--show ...
2021-10-24 08:33:12 +00:00
{- Knapp, aber gut nachvollziehbar geht die Implementierung von show fuer Uhrzeit
2021-10-24 08:33:12 +00:00
folgendermassen vor:
...
-}
--instance Show Datum where
-- show ...
2021-10-24 08:33:12 +00:00
{- Knapp, aber gut nachvollziehbar geht die Implementierung von show fuer Datum
2021-10-24 08:33:12 +00:00
folgendermassen vor:
...
-}