fprog2021WS/code/Angabe2.hs

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