This repository has been archived on 2024-10-24. You can view files and clone it, but cannot push or open issues or pull requests.
fradrive-old/src/Handler/Utils/Term.hs
2017-10-08 17:04:43 +02:00

64 lines
2.0 KiB
Haskell

{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
module Handler.Utils.Term where
import Import
import qualified Data.Text as T
import Model.Types
-- import Data.Maybe
termExistsField :: Field (HandlerT UniWorX IO) TermIdentifier
termExistsField = termField True
termNewField :: Field (HandlerT UniWorX IO) TermIdentifier
termNewField = termField False
termField :: Bool -> Field (HandlerT UniWorX IO) TermIdentifier
termField mustexist = checkMMap checkTerm termToText textField
where
errTextParse :: Text
errTextParse = "Semester: S oder W gefolgt von Jahreszahl"
errTextFreigabe :: TermIdentifier -> Text
errTextFreigabe ti = "Semester " `T.append` (termToText ti) `T.append` " wurde noch nicht freigegeben."
checkTerm :: Text -> HandlerT UniWorX IO (Either Text TermIdentifier)
checkTerm t = case termFromText t of
Left _ -> return $ Left errTextParse
res@(Right ti) -> do
term <- runDB $ get $ TermKey ti -- TODO: membershiptest instead?
return $ if mustexist && isNothing term
then Left $ errTextFreigabe ti
else res
validateTerm :: Term -> [Text]
validateTerm (Term{..}) =
[ msg | (False, msg) <-
[ --startOk
( termStart `withinTerm` termName
, "Jahreszahl im Namenskürzel stimmt nicht mit Semesterbeginn überein."
)
, -- endOk
( termStart < termEnd
, "Semester darf nicht enden, bevor es begann."
)
, -- startOk
( termLectureStart < termLectureEnd
, "Vorlesungszeit muss vor ihrem Ende anfgangen."
)
, -- lecStartOk
( termStart <= termLectureStart
, "Semester muss vor der Vorlesungszeit beginnen."
)
, -- lecEndOk
( termEnd >= termLectureEnd
, "Vorlesungszeit muss vor dem Semester enden."
)
] ]