tu-wien
/
fprog2021WS
Archived
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
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

412 lines
13 KiB
Haskell
Raw Permalink Blame History

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
| null [p] = res
| length [p] /= 0 && null ps =
if ((einzulassen (p, r, k)) == Einlassen) then res ++ [person_to_string p]
else 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] -> Abzuweisende
disallowed_people (p:ps) r k res
| null [p] = res
| length [p] /= 0 && null ps =
if ((einzulassen (p, r, k)) == Abweisen) then res ++ [person_to_string p]
else 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
Reference in New Issue View Git Blame Copy Permalink