diff --git a/models b/models
index 8ec481079..fa564bc26 100644
--- a/models
+++ b/models
@@ -200,6 +200,6 @@ Exam
ExamUser
userId UserId
examId ExamId
- -- CONTINUE HERE: Inlcude rating in this table or seperatly?
+ -- CONTINUE HERE: Include rating in this table or separately?
UniqueExamUser userId examId
-- By default this file is used in Model.hs (which is imported by Foundation.hs)
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 56190ce78..aaf4f97c5 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -277,8 +277,8 @@ newCourseForm template = identForm FIDcourse $ \html -> do
-- & addAttr "disabled" "disabled"
& setTooltip "Muss innerhalb des Semesters eindeutig sein")
(cfShort <$> template)
- <*> areq termExistsField (fsb "Semester") (cfTerm <$> template)
- <*> areq (selectField schools) (fsb "Institut") (cfSchool <$> template)
+ <*> areq termActiveField (fsb "Semester") (cfTerm <$> template)
+ <*> areq schoolField (fsb "Institut") (cfSchool <$> template)
<*> aopt (natField "Kapazität") (fsb "Kapazität") (cfCapacity <$> template)
<*> areq checkBoxField (fsb "Anmeldung") (cfHasReg <$> template)
<*> aopt utcTimeField (fsb "Anmeldung von:") (cfRegFrom <$> template)
@@ -302,11 +302,6 @@ newCourseForm template = identForm FIDcourse $ \html -> do
where
-- cid :: Maybe CourseId
-- cid = join $ cfCourseId <$> template
---
--- schools :: GHandler UniWorX UniWorX (OptionList SchoolId)
- schools = do
- entities <- runDB $ selectList [] [Asc SchoolShorthand]
- optionsPairs $ map (\school -> (schoolShorthand $ entityVal school, entityKey school)) entities
validateCourse :: CourseForm -> [Text]
validateCourse (CourseForm{..}) =
diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index da0c56050..fde3533b5 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -218,9 +218,12 @@ posIntField d = checkBool (>= 1) (T.append d " muss eine positive Zahl sein.")
minIntField :: (Monad m, Integral i, Show i, RenderMessage (HandlerSite m) FormMessage) => i -> Text -> Field m i
minIntField m d = checkBool (>= m) (T.concat [d," muss größer als ", T.pack $ show m, " sein."]) $ intField
+--termField: see Utils.Term
-schoolField :: (Monad m, RenderMessage (HandlerSite m) FormMessage) => Field m SchoolId
-schoolField = undefined -- TODO
+schoolField :: Field Handler SchoolId
+schoolField = selectField schools
+ where
+ schools = optionsPersistKey [] [Asc SchoolName] schoolName
utcTimeField :: (Monad m, RenderMessage (HandlerSite m) FormMessage) => Field m UTCTime
-- StackOverflow: dayToUTC <$> (areq (jqueryDayField def {...}) settings Nothing)
@@ -229,19 +232,20 @@ utcTimeField = Field
, fieldView = \theId name attrs val isReq ->
[whamlet|
$newline never
-
+
|]
, fieldEnctype = UrlEncoded
}
where
fieldTimeFormat :: String
- fieldTimeFormat = "%e.%m.%y %k:%M"
+ --fieldTimeFormat = "%e.%m.%y %k:%M"
+ fieldTimeFormat = "%Y-%m-%eT%H:%M"
readTime :: Text -> Either FormMessage UTCTime
readTime t =
case parseTimeM True germanTimeLocale fieldTimeFormat (T.unpack t) of
(Just time) -> Right time
- Nothing -> Left $ MsgInvalidEntry "Datum/Zeit Format: tt.mm.yy hh:mm"
+ Nothing -> Left $ MsgInvalidEntry $ "Datum/Zeit Format: tt.mm.yy hh:mm " ++ t
showTime :: UTCTime -> Text
showTime = fromString . (formatTime germanTimeLocale fieldTimeFormat)
diff --git a/src/Handler/Utils/Term.hs b/src/Handler/Utils/Term.hs
index 73f705330..b3c9c4f9d 100644
--- a/src/Handler/Utils/Term.hs
+++ b/src/Handler/Utils/Term.hs
@@ -13,15 +13,11 @@ import Model.Types
-- import Data.Maybe
-termExistsField :: Field Handler TermIdentifier
-termExistsField = termField True
- -- TODO: Change this to an option list of active terms
+termActiveField :: Field Handler TermIdentifier
+termActiveField = convertField unTermKey TermKey $ selectField $ optionsPersistKey [TermActive ==. True] [Desc TermStart] termName
termNewField :: Field Handler TermIdentifier
-termNewField = termField False
-
-termField :: Bool -> Field Handler TermIdentifier
-termField mustexist = checkMMap checkTerm termToText textField
+termNewField = checkMMap checkTerm termToText textField
where
errTextParse :: Text
errTextParse = "Semester: S oder W gefolgt von Jahreszahl"
@@ -31,12 +27,8 @@ termField mustexist = checkMMap checkTerm termToText textField
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
+ Left _ -> return $ Left errTextParse
+ res@(Right _) -> return res
validateTerm :: Term -> [Text]
validateTerm (Term{..}) =
diff --git a/src/Import/NoFoundation.hs b/src/Import/NoFoundation.hs
index 9b688de60..1cc175101 100644
--- a/src/Import/NoFoundation.hs
+++ b/src/Import/NoFoundation.hs
@@ -11,6 +11,7 @@ import Yesod.Auth as Import
import Yesod.Core.Types as Import (loggerSet)
import Yesod.Default.Config2 as Import
+
import Data.Fixed as Import
import CryptoID as Import
diff --git a/src/Model/Types.hs b/src/Model/Types.hs
index ee5048292..38274f64f 100644
--- a/src/Model/Types.hs
+++ b/src/Model/Types.hs
@@ -4,6 +4,9 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric, DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+
+
module Model.Types where
import ClassyPrelude
@@ -22,6 +25,7 @@ import Data.Text (Text)
import qualified Data.Text as Text
import Text.Read (readMaybe)
+import Text.Shakespeare.I18N
-- import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI
@@ -113,6 +117,9 @@ instance ToJSON TermIdentifier where
instance FromJSON TermIdentifier where
parseJSON = withText "Term" $ either (fail . Text.unpack) return . termFromText
+instance RenderMessage site TermIdentifier where -- TODO: I18N
+ renderMessage _ _ = termToText
+
{- Must be defined in a later module:
termField :: Field (HandlerT UniWorX IO) TermIdentifier
termField = checkMMap (return . termFromText) termToText textField