fprog2021WS/code/Angabe2.hs

module Angabe2 where

import Data.List
import Data.Maybe

{- 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 :: Impfstoff,
                           anzahl :: 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

-- Dumb conversion functions
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
{- Knapp, aber gut nachvollziehbar geht einzulassen folgendermassen vor:
   ...
-}

einzulassen :: (Person,Regel,Kontrollzeitpunkt) -> Kontrollergebnis
einzulassen (p, r, k)
   | 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_cert_validity :: Person -> Kontrollzeitpunkt -> Kontrollergebnis
check_cert_validity p k
   | not(is_date_valid k) = Ungueltig
   | is_tested p && (is_test_fresh (dreig_status p) k) = Einlassen
   | is_vaccinated p && is_vaccine_fresh (dreig_status p) = Einlassen
   | was_sick p = Einlassen
   | otherwise = Abweisen

is_test_fresh :: DreiG_Status -> Kontrollzeitpunkt -> Bool
is_test_fresh g k
   | not(is_date_valid ((datum g), (uhrzeit g))) = False
   | testart g == Antigen = False
   | otherwise = True

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

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