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,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_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)


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 (uhrzeit_stunde u) vhds)
      date = year ++ "-" ++ month ++ "-" ++ day
      time = hour ++ ":" ++ vhds ++ ":00"
      datetime = date ++ " " ++ time ++ " " ++ vm
   in
      understandTime datetime

convert_hour :: Stunde -> String -> String
convert_hour 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)


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

{- Knapp, aber gut nachvollziehbar geht einzulassende folgendermassen vor:
   ...
-}

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

-- 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:
   ...
-}