60 lines
1.9 KiB
Haskell
60 lines
1.9 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
|
|
|
|
|
|
termActiveField :: Field Handler TermId
|
|
termActiveField = selectField $ optionsPersistKey [TermActive ==. True] [Desc TermStart] termName
|
|
|
|
termActiveOld :: Field Handler TermIdentifier
|
|
termActiveOld = convertField unTermKey TermKey $ selectField $ optionsPersistKey [TermActive ==. True] [Desc TermStart] termName
|
|
|
|
termNewField :: Field Handler TermIdentifier
|
|
termNewField = 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 _) -> return 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."
|
|
)
|
|
] ]
|